diff --git a/src/monaco.contribution.ts b/src/monaco.contribution.ts index 0342ec3e..8ac5bfa3 100644 --- a/src/monaco.contribution.ts +++ b/src/monaco.contribution.ts @@ -47,3 +47,4 @@ import './yaml/yaml.contribution'; import './scheme/scheme.contribution'; import './clojure/clojure.contribution'; import './shell/shell.contribution'; +import './perl/perl.contribution'; diff --git a/src/perl/perl.contribution.ts b/src/perl/perl.contribution.ts new file mode 100644 index 00000000..0f18b87f --- /dev/null +++ b/src/perl/perl.contribution.ts @@ -0,0 +1,17 @@ +/*--------------------------------------------------------------------------------------------- +* Copyright (c) Microsoft Corporation. All rights reserved. +* Licensed under the MIT License. See License.txt in the project root for license information. +*--------------------------------------------------------------------------------------------*/ +'use strict'; + +import { registerLanguage } from '../_.contribution'; + +// Allow for running under nodejs/requirejs in tests +const _monaco: typeof monaco = typeof monaco === 'undefined' ? (self).monaco : monaco; + +registerLanguage({ + id: 'perl', + extensions: ['.pl'], + aliases: ['Perl', 'pl'], + loader: () => _monaco.Promise.wrap(import('./perl')), +}); diff --git a/src/perl/perl.test.ts b/src/perl/perl.test.ts new file mode 100644 index 00000000..879c2b3c --- /dev/null +++ b/src/perl/perl.test.ts @@ -0,0 +1,432 @@ +/*--------------------------------------------------------------------------------------------- +* Copyright (c) Microsoft Corporation. All rights reserved. +* Licensed under the MIT License. See License.txt in the project root for license information. +*--------------------------------------------------------------------------------------------*/ +'use strict'; + +import { testTokenization } from '../test/testRunner'; + +testTokenization('perl', [ + // Keywords + [ + { + line: 'if $msg', + tokens: [ + { startIndex: 0, type: 'keyword.perl' }, + { startIndex: 2, type: 'white.perl' }, + { startIndex: 3, type: 'variable.perl' }, + ], + }, + ], + + // Builtins + [ + { + line: 'log $ARGV', + tokens: [ + { startIndex: 0, type: 'type.identifier.perl' }, + { startIndex: 3, type: 'white.perl' }, + { startIndex: 4, type: 'variable.predefined.perl' }, + ], + }, + ], + + // Shebang + [ + { + line: '#!/bin/env perl', + tokens: [{ startIndex: 0, type: 'metatag.perl' }], + }, + ], + + // Comments - single line + [ + { + line: '#', + tokens: [{ startIndex: 0, type: 'comment.perl' }], + }, + ], + + [ + { + line: ' # a comment', + tokens: [ + { startIndex: 0, type: 'white.perl' }, + { startIndex: 4, type: 'comment.perl' }, + ], + }, + ], + + [ + { + line: '# a comment', + tokens: [{ startIndex: 0, type: 'comment.perl' }], + }, + ], + + // number + [ + { + line: '0', + tokens: [{ startIndex: 0, type: 'number.perl' }], + }, + ], + + [ + { + line: '0.0', + tokens: [{ startIndex: 0, type: 'number.float.perl' }], + }, + ], + + [ + { + line: '0x123', + tokens: [{ startIndex: 0, type: 'number.hex.perl' }], + }, + ], + + [ + { + line: '23.5', + tokens: [{ startIndex: 0, type: 'number.float.perl' }], + }, + ], + + [ + { + line: '23.5e3', + tokens: [{ startIndex: 0, type: 'number.float.perl' }], + }, + ], + + [ + { + line: '23.5E3', + tokens: [{ startIndex: 0, type: 'number.float.perl' }], + }, + ], + + [ + { + line: '1.72e-3', + tokens: [{ startIndex: 0, type: 'number.float.perl' }], + }, + ], + + [ + { + line: '0+0', + tokens: [ + { startIndex: 0, type: 'number.perl' }, + { startIndex: 1, type: 'operators.perl' }, + { startIndex: 2, type: 'number.perl' }, + ], + }, + ], + + [ + { + line: '100+10', + tokens: [ + { startIndex: 0, type: 'number.perl' }, + { startIndex: 3, type: 'operators.perl' }, + { startIndex: 4, type: 'number.perl' }, + ], + }, + ], + + [ + { + line: '0 + 0', + tokens: [ + { startIndex: 0, type: 'number.perl' }, + { startIndex: 1, type: 'white.perl' }, + { startIndex: 2, type: 'operators.perl' }, + { startIndex: 3, type: 'white.perl' }, + { startIndex: 4, type: 'number.perl' }, + ], + }, + ], + + // Strings + + // Double quoted string + [ + { + line: '"string"', + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + ], + + [ + { + line: '"test $foo"', + tokens: [ + { startIndex: 0, type: 'string.perl' }, + { startIndex: 6, type: 'variable.perl' }, + { startIndex: 10, type: 'string.perl' }, + ], + }, + ], + + [ + { + line: '"test', + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + { + line: '', + tokens: [], + }, + { + line: 'string $foo string2"', + tokens: [ + { startIndex: 0, type: 'string.perl' }, + { startIndex: 7, type: 'variable.perl' }, + { startIndex: 11, type: 'string.perl' }, + ], + }, + ], + + [ + { + line: '"string\\t"', + tokens: [ + { startIndex: 0, type: 'string.perl' }, + { + startIndex: 7, + type: 'string.escape.perl', + }, + { startIndex: 9, type: 'string.perl' }, + ], + }, + ], + + // Single quoted string + [ + { + line: "'string'", + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + ], + + [ + { + line: "'test $foo'", + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + ], + + [ + { + line: "'test", + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + { + line: '', + tokens: [], + }, + { + line: "string $foo string2'", + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + ], + + [ + { + line: "'string\\t'", + tokens: [{ startIndex: 0, type: 'string.perl' }], + }, + ], + + [ + { + line: "'string\\'string2'", + tokens: [ + { startIndex: 0, type: 'string.perl' }, + { + startIndex: 7, + type: 'string.escape.perl', + }, + { startIndex: 9, type: 'string.perl' }, + ], + }, + ], + + // Variables + [ + { + line: '$msg $_ $1', + tokens: [ + { startIndex: 0, type: 'variable.perl' }, + { startIndex: 4, type: 'white.perl' }, + { startIndex: 5, type: 'variable.predefined.perl' }, + { startIndex: 7, type: 'white.perl' }, + { startIndex: 8, type: 'variable.perl' }, + ], + }, + ], + + [ + { + line: '@array1 @array2', + tokens: [ + { startIndex: 0, type: 'variable.perl' }, + { startIndex: 7, type: 'white.perl' }, + { + startIndex: 8, + type: 'variable.perl', + }, + ], + }, + ], + + [ + { + line: '%var1 %var2', + tokens: [ + { startIndex: 0, type: 'variable.perl' }, + { + startIndex: 5, + type: 'white.perl', + }, + { + startIndex: 6, + type: 'variable.perl', + }, + ], + }, + ], + + // RegExp + [ + { + line: '/abc/', + tokens: [{ startIndex: 0, type: 'regexp.perl' }], + }, + ], + + [ + { + line: 'm/abc/', + tokens: [{ startIndex: 0, type: 'regexp.perl' }], + }, + ], + + [ + { + line: 'm/[abc]+/e', + tokens: [{ startIndex: 0, type: 'regexp.perl' }], + }, + ], + + // Operators + [ + { + line: '$a + $b', + tokens: [ + { startIndex: 0, type: 'variable.predefined.perl' }, + { + startIndex: 2, + type: 'white.perl', + }, + { + startIndex: 3, + type: 'operators.perl', + }, + { startIndex: 4, type: 'white.perl' }, + { startIndex: 5, type: 'variable.predefined.perl' }, + ], + }, + ], + + // Embedded Doc + [ + { + line: '=begin', + tokens: [ + { + startIndex: 0, + type: 'comment.doc.perl', + }, + ], + }, + { + line: 'this is my doc', + tokens: [ + { + startIndex: 0, + type: 'comment.doc.perl', + }, + ], + }, + { + line: '=cut', + tokens: [{ startIndex: 0, type: 'type.identifier.perl' }], + }, + ], + + // Here Doc + [ + { + line: '<< HTML', + tokens: [{ startIndex: 0, type: 'string.heredoc.delimiter.perl' }], + }, + { + line: 'test here doc', + tokens: [ + { + startIndex: 0, + type: 'string.heredoc.perl', + }, + ], + }, + { + line: 'HTML', + tokens: [{ startIndex: 0, type: 'string.heredoc.delimiter.perl' }], + }, + { + line: 'my $msg', + tokens: [ + { startIndex: 0, type: 'type.identifier.perl' }, + { + startIndex: 2, + type: 'white.perl', + }, + { startIndex: 3, type: 'variable.perl' }, + ], + }, + ], + + [ + { + line: '<<"HTML"', + tokens: [{ startIndex: 0, type: 'string.heredoc.delimiter.perl' }], + }, + { + line: 'test here doc', + tokens: [ + { + startIndex: 0, + type: 'string.heredoc.perl', + }, + ], + }, + { + line: 'HTML', + tokens: [{ startIndex: 0, type: 'string.heredoc.delimiter.perl' }], + }, + { + line: 'my $msg', + tokens: [ + { startIndex: 0, type: 'type.identifier.perl' }, + { + startIndex: 2, + type: 'white.perl', + }, + { startIndex: 3, type: 'variable.perl' }, + ], + }, + ], +]); diff --git a/src/perl/perl.ts b/src/perl/perl.ts new file mode 100644 index 00000000..edacb28a --- /dev/null +++ b/src/perl/perl.ts @@ -0,0 +1,591 @@ +/*--------------------------------------------------------------------------------------------- +* Copyright (c) Microsoft Corporation. All rights reserved. +* Licensed under the MIT License. See License.txt in the project root for license information. +*--------------------------------------------------------------------------------------------*/ + +'use strict'; + +import IRichLanguageConfiguration = monaco.languages.LanguageConfiguration; +import ILanguage = monaco.languages.IMonarchLanguage; + +export const conf: IRichLanguageConfiguration = { + comments: { + lineComment: '#', + }, + brackets: [['{', '}'], ['[', ']'], ['(', ')']], + autoClosingPairs: [ + { open: '{', close: '}' }, + { open: '[', close: ']' }, + { open: '(', close: ')' }, + { open: '"', close: '"' }, + { open: "'", close: "'" }, + { open: '`', close: '`' }, + ], + surroundingPairs: [ + { open: '{', close: '}' }, + { open: '[', close: ']' }, + { open: '(', close: ')' }, + { open: '"', close: '"' }, + { open: "'", close: "'" }, + { open: '`', close: '`' }, + ], +}; + +export const language = { + defaultToken: '', + tokenPostfix: '.perl', + + brackets: [ + { token: 'delimiter.bracket', open: '{', close: '}' }, + { token: 'delimiter.parenthesis', open: '(', close: ')' }, + { token: 'delimiter.square', open: '[', close: ']' }, + ], + + // https://learn.perl.org/docs/keywords.html + + // Perl syntax + keywords: [ + '__DATA__', + 'else', + 'lock', + 'qw', + '__END__', + 'elsif', + 'lt', + 'qx', + '__FILE__', + 'eq', + 'm', + 's', + '__LINE__', + 'exp', + 'ne', + 'sub', + '__PACKAGE__', + 'for', + 'no', + 'tr', + 'and', + 'foreach', + 'or', + 'unless', + 'cmp', + 'ge', + 'package', + 'until', + 'continue', + 'gt', + 'q', + 'while', + 'CORE', + 'if', + 'qq', + 'xor', + 'do', + 'le', + 'qr', + 'y', + + '__DIE__', + '__WARN__', + ], + + // Perl functions + builtinFunctions: [ + '-A', + 'END', + 'length', + 'setpgrp', + '-B', + 'endgrent', + 'link', + 'setpriority', + '-b', + 'endhostent', + 'listen', + 'setprotoent', + '-C', + 'endnetent', + 'local', + 'setpwent', + '-c', + 'endprotoent', + 'localtime', + 'setservent', + '-d', + 'endpwent', + 'log', + 'setsockopt', + '-e', + 'endservent', + 'lstat', + 'shift', + '-f', + 'eof', + 'map', + 'shmctl', + '-g', + 'eval', + 'mkdir', + 'shmget', + '-k', + 'exec', + 'msgctl', + 'shmread', + '-l', + 'exists', + 'msgget', + 'shmwrite', + '-M', + 'exit', + 'msgrcv', + 'shutdown', + '-O', + 'fcntl', + 'msgsnd', + 'sin', + '-o', + 'fileno', + 'my', + 'sleep', + '-p', + 'flock', + 'next', + 'socket', + '-r', + 'fork', + 'not', + 'socketpair', + '-R', + 'format', + 'oct', + 'sort', + '-S', + 'formline', + 'open', + 'splice', + '-s', + 'getc', + 'opendir', + 'split', + '-T', + 'getgrent', + 'ord', + 'sprintf', + '-t', + 'getgrgid', + 'our', + 'sqrt', + '-u', + 'getgrnam', + 'pack', + 'srand', + '-w', + 'gethostbyaddr', + 'pipe', + 'stat', + '-W', + 'gethostbyname', + 'pop', + 'state', + '-X', + 'gethostent', + 'pos', + 'study', + '-x', + 'getlogin', + 'print', + 'substr', + '-z', + 'getnetbyaddr', + 'printf', + 'symlink', + 'abs', + 'getnetbyname', + 'prototype', + 'syscall', + 'accept', + 'getnetent', + 'push', + 'sysopen', + 'alarm', + 'getpeername', + 'quotemeta', + 'sysread', + 'atan2', + 'getpgrp', + 'rand', + 'sysseek', + 'AUTOLOAD', + 'getppid', + 'read', + 'system', + 'BEGIN', + 'getpriority', + 'readdir', + 'syswrite', + 'bind', + 'getprotobyname', + 'readline', + 'tell', + 'binmode', + 'getprotobynumber', + 'readlink', + 'telldir', + 'bless', + 'getprotoent', + 'readpipe', + 'tie', + 'break', + 'getpwent', + 'recv', + 'tied', + 'caller', + 'getpwnam', + 'redo', + 'time', + 'chdir', + 'getpwuid', + 'ref', + 'times', + 'CHECK', + 'getservbyname', + 'rename', + 'truncate', + 'chmod', + 'getservbyport', + 'require', + 'uc', + 'chomp', + 'getservent', + 'reset', + 'ucfirst', + 'chop', + 'getsockname', + 'return', + 'umask', + 'chown', + 'getsockopt', + 'reverse', + 'undef', + 'chr', + 'glob', + 'rewinddir', + 'UNITCHECK', + 'chroot', + 'gmtime', + 'rindex', + 'unlink', + 'close', + 'goto', + 'rmdir', + 'unpack', + 'closedir', + 'grep', + 'say', + 'unshift', + 'connect', + 'hex', + 'scalar', + 'untie', + 'cos', + 'index', + 'seek', + 'use', + 'crypt', + 'INIT', + 'seekdir', + 'utime', + 'dbmclose', + 'int', + 'select', + 'values', + 'dbmopen', + 'ioctl', + 'semctl', + 'vec', + 'defined', + 'join', + 'semget', + 'wait', + 'delete', + 'keys', + 'semop', + 'waitpid', + 'DESTROY', + 'kill', + 'send', + 'wantarray', + 'die', + 'last', + 'setgrent', + 'warn', + 'dump', + 'lc', + 'sethostent', + 'write', + 'each', + 'lcfirst', + 'setnetent', + ], + + // File handlers + builtinFileHandlers: ['ARGV', 'STDERR', 'STDOUT', 'ARGVOUT', 'STDIN', 'ENV'], + + // Perl variables + builtinVariables: [ + '$!', + '$^RE_TRIE_MAXBUF', + '$LAST_REGEXP_CODE_RESULT', + '$"', + '$^S', + '$LIST_SEPARATOR', + '$#', + '$^T', + '$MATCH', + '$$', + '$^TAINT', + '$MULTILINE_MATCHING', + '$%', + '$^UNICODE', + '$NR', + '$&', + '$^UTF8LOCALE', + '$OFMT', + "$'", + '$^V', + '$OFS', + '$(', + '$^W', + '$ORS', + '$)', + '$^WARNING_BITS', + '$OS_ERROR', + '$*', + '$^WIDE_SYSTEM_CALLS', + '$OSNAME', + '$+', + '$^X', + '$OUTPUT_AUTO_FLUSH', + '$,', + '$_', + '$OUTPUT_FIELD_SEPARATOR', + '$-', + '$`', + '$OUTPUT_RECORD_SEPARATOR', + '$.', + '$a', + '$PERL_VERSION', + '$/', + '$ACCUMULATOR', + '$PERLDB', + '$0', + '$ARG', + '$PID', + '$:', + '$ARGV', + '$POSTMATCH', + '$;', + '$b', + '$PREMATCH', + '$<', + '$BASETIME', + '$PROCESS_ID', + '$=', + '$CHILD_ERROR', + '$PROGRAM_NAME', + '$>', + '$COMPILING', + '$REAL_GROUP_ID', + '$?', + '$DEBUGGING', + '$REAL_USER_ID', + '$@', + '$EFFECTIVE_GROUP_ID', + '$RS', + '$[', + '$EFFECTIVE_USER_ID', + '$SUBSCRIPT_SEPARATOR', + '$\\', + '$EGID', + '$SUBSEP', + '$]', + '$ERRNO', + '$SYSTEM_FD_MAX', + '$^', + '$EUID', + '$UID', + '$^A', + '$EVAL_ERROR', + '$WARNING', + '$^C', + '$EXCEPTIONS_BEING_CAUGHT', + '$|', + '$^CHILD_ERROR_NATIVE', + '$EXECUTABLE_NAME', + '$~', + '$^D', + '$EXTENDED_OS_ERROR', + '%!', + '$^E', + '$FORMAT_FORMFEED', + '%^H', + '$^ENCODING', + '$FORMAT_LINE_BREAK_CHARACTERS', + '%ENV', + '$^F', + '$FORMAT_LINES_LEFT', + '%INC', + '$^H', + '$FORMAT_LINES_PER_PAGE', + '%OVERLOAD', + '$^I', + '$FORMAT_NAME', + '%SIG', + '$^L', + '$FORMAT_PAGE_NUMBER', + '@+', + '$^M', + '$FORMAT_TOP_NAME', + '@-', + '$^N', + '$GID', + '@_', + '$^O', + '$INPLACE_EDIT', + '@ARGV', + '$^OPEN', + '$INPUT_LINE_NUMBER', + '@INC', + '$^P', + '$INPUT_RECORD_SEPARATOR', + '@LAST_MATCH_START', + '$^R', + '$LAST_MATCH_END', + '$^RE_DEBUG_FLAGS', + '$LAST_PAREN_MATCH', + ], + + // operators + symbols: /[:+\-\^*$&%@=<>!?|\/~\.]/, + + escapes: /\\(?:[abfnrtv\\"']|x[0-9A-Fa-f]{1,4}|u[0-9A-Fa-f]{4}|U[0-9A-Fa-f]{8})/, + + // The main tokenizer for our languages + tokenizer: { + root: [ + { include: '@whitespace' }, + + [ + /[a-zA-Z\-_][\w\-_]+/, + { + cases: { + '@keywords': 'keyword', + '@builtinFunctions': 'type.identifier', + '@builtinFileHandlers': 'variable.predefined', + '@default': '', + }, + }, + ], + + // Perl variables + [ + /[\$@%][*@#?\+\-\$!\w\\\^><~:;\.]+/, + { + cases: { + '@builtinVariables': 'variable.predefined', + '@default': 'variable', + }, + }, + ], + + { include: '@strings' }, + { include: '@dblStrings' }, + + // Perl Doc + { include: '@perldoc' }, + + // Here Doc + { include: '@heredoc' }, + + [/[{}\[\]()]/, '@brackets'], + + // RegExp + [ + /[goseximacplud]*[\/](?:(?:\[(?:\\]|[^\]])+\])|(?:\\\/|[^\]\/]))*[\/]\w*\s*(?=[).,;]|$)/, + 'regexp', + ], + + [/@symbols/, 'operators'], + + { include: '@numbers' }, + + [/[,;]/, 'delimiter'], + ], + + whitespace: [ + [/\s+/, 'white'], + [/(^#!.*$)/, 'metatag'], + [/(^#.*$)/, 'comment'], + ], + + numbers: [ + [/\d*\.\d+([eE][\-+]?\d+)?/, 'number.float'], + [/0[xX][0-9a-fA-F_]*[0-9a-fA-F]/, 'number.hex'], + [/\d+/, 'number'], + ], + + // Single quote string + strings: [[/'/, 'string', '@stringBody']], + + stringBody: [ + [/'/, 'string', '@popall'], + [/\\'/, 'string.escape'], + [/./, 'string'], + ], + + // Double quote string + dblStrings: [[/"/, 'string', '@dblStringBody']], + + dblStringBody: [ + [/"/, 'string', '@popall'], + [/@escapes/, 'string.escape'], + [/\\./, 'string.escape.invalid'], + { include: '@variables' }, + [/./, 'string'], + ], + + heredoc: [ + [ + /<<\s*['"`]?([\w\-]+)['"`]?/, + { token: 'string.heredoc.delimiter', next: '@heredocBody.$1' }, + ], + ], + + heredocBody: [ + [ + /^([\w\-]+)$/, + { + cases: { + '$1==$S2': [{ token: 'string.heredoc.delimiter', next: '@popall' }], + '@default': 'string.heredoc', + }, + }, + ], + [/./, 'string.heredoc'], + ], + + perldoc: [[/^=\w/, 'comment.doc', '@perldocBody']], + + perldocBody: [ + [/^=cut\b/, 'type.identifier', '@popall'], + [/./, 'comment.doc'], + ], + + variables: [ + [/\$\w+/, 'variable'], // scalar + [/@\w+/, 'variable'], // array + [/%\w+/, 'variable'], // key/value + ], + }, +}; diff --git a/test/setup.js b/test/setup.js index e2f48733..1cbff462 100644 --- a/test/setup.js +++ b/test/setup.js @@ -67,7 +67,8 @@ define(['require'], function (require) { 'release/dev/st/st.test', 'release/dev/scheme/scheme.test', 'release/dev/clojure/clojure.test', - 'release/dev/shell/shell.test' + 'release/dev/shell/shell.test', + 'release/dev/perl/perl.test' ], function () { run(); // We can launch the tests! }, function (err) {