more perl overhaul

--HG--
branch : pmacs2

mode/perl.py

@@ -16,27 +16,6 @@ from tab import StackTabber, StackTabber2
 from parse import Any, And, Or, Optional, Name, Match, Matchs
 import term
 
-class PerlGrammar(Grammar): pass
-
-class WhitespaceGrammar(Grammar):
-    rules = [
-        PatternRule('spaces', ' +'),
-        PatternRule('eol', r'\n'),
-    ]
-
-class PodDataGrammar(Grammar):
-    rules = [PatternRule(r'data', r'[^\n]+\n$')]
-
-class PodGrammar(Grammar):
-    rules = [
-        RegionRule('entry', '(?<=^=head[1-4]) +.*$', PodDataGrammar, r'^\n$'),
-        RegionRule('entry', '(?<=^=over) +.*$', PodDataGrammar, r'^\n$'),
-        RegionRule('entry', '(?<=^=item) +.*$', PodDataGrammar, r'^\n$'),
-        RegionRule('entry', '(?:(?<=^=begin)|(?<=^=end)) +.*$',
-                   PodDataGrammar, r'^\n$'),
-        RegionRule('entry', '(?<=^=encoding) +.*$', PodDataGrammar, r'^\n$'),
-    ]
-
 strg1 = r"'(?:\\.|[^'\\])*'"
 strg2 = r'"(?:\\.|[^"\\])*"'
 wchr1 = '[a-zA-Z_]'
@@ -47,63 +26,95 @@ word1 = wchr1 + wchr2 + '*'
 word2 = '(?:' + word1 + "(?:'|::))*" + word1
 pname = '[.a-zA-Z0-9_]+'
 
+spaces = PatternRule('spaces', ' +')
+eol    = PatternRule('eol', r'\n')
+length = PatternRule('perl.length', r"\$#" + word2)
+
+class PerlGrammar(Grammar):
+    pass
+
+class WhitespaceGrammar(Grammar):
+    rules = [spaces, eol]
+
+class PodDataGrammar(Grammar):
+    rules = [PatternRule(r'data', r'[^\n]+\n$')]
+
+class PodGrammar(Grammar):
+    rules = [
+        RegionRule('entry', '(?<=^=head[1-4]) +.*$', PodDataGrammar, r'^\n$'),
+        RegionRule('entry', '(?<=^=over) +.*$', PodDataGrammar, r'^\n$'),
+        RegionRule('entry', '(?<=^=item) +.*$', PodDataGrammar, r'^\n$'),
+        RegionRule('entry', '(?:(?<=^=begin)|(?<=^=end)) +.*$', PodDataGrammar, r'^\n$'),
+        RegionRule('entry', '(?<=^=encoding) +.*$', PodDataGrammar, r'^\n$'),
+    ]
+
+scalar_rules = [
+    PatternRule('perl.array', r"\@_"),
+    PatternRule('perl.array', r"\@(?= *{)"),
+    PatternRule('perl.array', r'\@[\+\-]'),
+    PatternRule('perl.array', r"\@\$*" + word2),
+    PatternRule('perl.array', r'\$' + word2 + '(?= *\[)'),
+
+    PatternRule('perl.hash', r"\%(?= *{)"),
+    PatternRule('perl.hash', r'\%(?:[!]|^H)'),
+    PatternRule('perl.hash', r"\%\$*" + word2),
+    PatternRule('perl.hash', r'\$' + word2 + '(?= *\{)'),
+
+    PatternRule('perl.scalar', r'\$[_ab&`\'\+\*\./|,\\";#\%=\-~\^:\?!@\$<>()\[\]](?!' + wchr2 + ')'),
+    PatternRule('perl.scalar', r'\$\d+(?!' + wchr2 +')'),
+    PatternRule('perl.scalar', r'\$\^(?:' + word1 + '|' + wchr1 + ')'),
+    PatternRule('perl.scalar', r'\$\^O'),
+    PatternRule('perl.scalar', r'\${\^' + word1 + '}'),
+
+    PatternRule('perl.scalar', r"\$[\[\]<>ab/'\"_@\?#\$!%^|&*()](?!" + wchr2 + ")"),
+    PatternRule('perl.scalar', r"\$[0-9]+"),
+    PatternRule('perl.scalar', r"\$\$*" + word2),
+]
+
 def _make_string_rules(forbidden):
     rules = [
         PatternRule('octal', r'\\[0-7]{3}'),
         PatternRule('escaped', r'\\.'),
-        #PatternRule('perl.deref', r"\$+" + word2 + "(?:" + "(?:->)?{\$?(?:" +
+        PatternRule('perl.deref', r"\$+" + word2 + "(?:" + "(?:->)?{\$?(?:" +
-        #            hword + "|" + strg1 + "|" + strg2 + ")}|" +
+                    hword + "|" + strg1 + "|" + strg2 + ")}|" +
-        #            "(?:->)?\[\$?"+hword+"\]"+ ")+"),
+                    "(?:->)?\[\$?"+hword+"\]"+ ")+"),
-        PatternRule('perl.length', r"\$#" + word2),
+        length,
-        PatternRule('perl.array', r"\$\$*" + word2 + '(?= *\[)'),
+    ] + scalar_rules
-        PatternRule('perl.hash', r"\$\$*" + word2 + '(?= *\{)'),
-        PatternRule('perl.scalar', r"\$[0-9]+"),
-        PatternRule('perl.array', r"@\$*" + word2),
-        PatternRule('perl.hash', r"\%\$*" + word2),
 
-        PatternMatchRule('x', r"(\$\$*" + word2 + ')(->)', 'perl.scalar', 'delimiter'),
-        PatternRule('perl.scalar', r"\$\$*" + word2),
-        PatternRule('perl.scalar', r"\$\$*" + word2),
-        #RegionRule('perl.interpolate', r'\[', PerlGrammar, r'\]'),
-        #RegionRule('perl.interpolate', '{', PerlGrammar, '}'),
-    ]
     if forbidden == ')':
-        rules.append(PatternRule('data', r"\([^$%@\(\)]*\)"))
+        return rules + [PatternRule('data', r"[^$\%@\(\)]+")]
     elif forbidden == '}':
-        rules.append(PatternRule('data', r"{[^$%@{}]*}"))
+        return rules + [PatternRule('data', r"[^$\%@{}]+")]
     elif forbidden == ']':
-        rules.append(PatternRule('data', r"\[[^$%@\[\]]*\]"))
+        return rules + [PatternRule('data', r"[^$\%@\[\]]+")]
     elif forbidden == '>':
-        rules.append(PatternRule('data', r"<[^$%@<>]*>"))
+        return rules + [PatternRule('data', r"[^$\%@<>]+")]
+    else:
         return rules
 
-class QuotedWords(Grammar): rules = [
+class DataGrammar(Grammar):
-    PatternRule('data', hword),
+    rules = [PatternRule('data', '.+')]
-    PatternRule('eol', r'\n'),
-    PatternRule('spaces', ' +'),
-]
-class NoParen(Grammar):     rules = [PatternRule('data', '[^)]+')]
-class NoBrace(Grammar):     rules = [PatternRule('data', r'[^\}]+')]
-class NoBracket(Grammar):   rules = [PatternRule('data', r'[^\]]+')]
-class NoAngle(Grammar):     rules = [PatternRule('data', '[^>]+')]
-class NoHash(Grammar):      rules = [PatternRule('data', '[^#]+')]
-class DataGrammar(Grammar): rules = [PatternRule('data', '.+')]
 
-class StrictStringGrammar(Grammar): rules = [
+class QuotedWords(Grammar):
+    rules = [PatternRule('data', hword), eol, spaces]
+
+class StrictStringGrammar(Grammar):
+    rules = [
         PatternRule('escaped', r"\\[\\']"),
         PatternRule('data', r"[^\\']+"),
-]
+    ]
 class StringGrammar(Grammar):
-    rules = _make_string_rules('"') #+ [PatternRule('data', r'[^$%@\\"]+')]
+    rules = _make_string_rules('"') + [PatternRule('data', r'[^$%@\\"]+')]
 class EvalGrammar(Grammar):
     rules = _make_string_rules('`') + [PatternRule('data', r'[^$%@\\`]+')]
 
-class TranslateGrammar1(Grammar):
+class TranslateGrammar1(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\/])")]
-    rules = [PatternRule('data', r"(?:\\.|[^\\/])")]
+class TranslateGrammar2(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\#])")]
-class TranslateGrammar2(Grammar):
+class TranslateGrammar3(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\\)])")]
-    rules = [PatternRule('data', r"(?:\\.|[^\\#])")]
+class TranslateGrammar4(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\\]])")]
-class TranslateGrammarX(Grammar):
+class TranslateGrammar5(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\}])")]
-    rules = [PatternRule('data', r"(?:\\.|[^\\%(delim)s])")]
+class TranslateGrammar6(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\>])")]
+class TranslateGrammarX(Grammar): rules = [PatternRule('data', r"(?:\\.|[^\\%(delim)s])")]
 
 class MatchGrammar0(Grammar): rules = _make_string_rules(None)
 class MatchGrammar1(Grammar): rules = _make_string_rules('/')
@@ -113,11 +124,6 @@ class MatchGrammar4(Grammar): rules = _make_string_rules(']')
 class MatchGrammar5(Grammar): rules = _make_string_rules('}')
 class MatchGrammar6(Grammar): rules = _make_string_rules('>')
 
-class QuotedGrammar1(Grammar): rules = _make_string_rules(')')
-class QuotedGrammar2(Grammar): rules = _make_string_rules('}')
-class QuotedGrammar3(Grammar): rules = _make_string_rules('>')
-class QuotedGrammar4(Grammar): rules = _make_string_rules(']')
-
 PerlGrammar.rules = [
     RegionRule('perl.heredoc', r"<<(?P<heredoc>" + word1 + ")", None,
                r';\n', StringGrammar, r'^%(heredoc)s$'),
@@ -137,47 +143,26 @@ PerlGrammar.rules = [
     PatternMatchRule('x', '(sub)( +)(' + word2 +
                      r')( *)(\()( *)([\[\]\\@$%&*;]+)( *)(\))',
                      'perl.keyword', 'spaces', 'perl.sub', 'spaces',
-                     'delimiter', 'spaces', 'perl.prototype',
+                     'delimiter', 'spaces', 'perl.prototype', 'spaces',
-                     'spaces', 'delimiter'),
+                     'delimiter'),
 
     PatternRule('perl.comment', '#.*$'),
     RegionRule('perl.string', '"', StringGrammar, '"'),
     RegionRule('perl.string', "'", StrictStringGrammar, "'"),
     RegionRule('perl.evalstring', "`", EvalGrammar, "`"),
-    PatternRule('perl.keyword', "(?<!->)(?:continue|do|else|elsif|eval|foreach|for|if|last|my|next|no|our|package|require|return|sub|undef|unless|until|use|while)(?![a-zA-Z0-9_])"),
+    PatternRule('perl.keyword', "(?<!->)(?:while|use|until|unless|undef|sub|return|require|package|our|no|next|my|last|if|foreach|for|eval|elsif|else|do|continue)(?![a-zA-Z0-9_])"),
     PatternRule('perl.reserved', "(?<!->)(?:STDIN|STDERR|STDOUT|__PACKAGE__)(?![a-zA-Z0-9_])"),
     PatternRule('perl.hashkey', '(?<={)' + wchr2 + '+(?=})'),
     PatternRule('perl.method', '(?<=->)' + word1),
     PatternRule('perl.hashkey', wchr2 + '+(?= *=>)'),
     PatternRule('perl.length', r"\$#" + word2),
-    #PatternRule('perl.cast', r'[\$\@\%\&\*](?= *{)'),
 
     PatternRule('perl.number', r'0[xX][0-9A-Fa-f]+'),
     PatternRule('perl.number', r'-?0?\.[0-9]+|-?[0-9]+(?:\.[0-9]+)?'),
 
-    # built-in scalars
-    PatternRule('perl.array', r'\$' + word2 + '(?= *\[)'),
-    PatternRule('perl.hash', r'\$' + word2 + '(?= *\{)'),
-
-    PatternRule('perl.scalar', r'\$[_ab&`\'\+\*\./|,\\";#\%=\-~\^:\?!@\$<>()\[\]](?!' + wchr2 + ')'),
-    PatternRule('perl.scalar', r'\$\d+(?!' + wchr2 +')'),
-    PatternRule('perl.scalar', r'\$\^(?:' + word1 + '|' + wchr1 + ')'),
-    PatternRule('perl.scalar', r'\$\^O'),
-    PatternRule('perl.scalar', r'\${\^' + word1 + '}'),
-
-    PatternRule('perl.array', r'\@[\+\-]'),
-    PatternRule('perl.hash', r'\%(?:[!]|^H)'),
-
-    PatternRule('perl.scalar', r"\$[\[\]<>ab/'\"_@\?#\$!%^|&*()](?!" +
-                wchr2 + ")"),
-    PatternRule('perl.array', r"\@_"),
     PatternRule('perl.function', r"\$\$*" + word2 + "(?=-> *\()"),
-    PatternRule('perl.scalar', r"\$[0-9]+"),
+
-    PatternRule('perl.scalar', r"\$\$*" + word2),
+] + scalar_rules + [
-    PatternRule('perl.array', r"\@(?= *{)"),
-    PatternRule('perl.array', r"\@\$*" + word2),
-    PatternRule('perl.hash', r"\%(?= *{)"),
-    PatternRule('perl.hash', r"\%\$*" + word2),
 
     # match regexes; paired delimiters
     RegionRule('perl.match', r'm *(?P<delim>\()',
@@ -215,6 +200,16 @@ PerlGrammar.rules = [
                MatchGrammar0, '%(delim)s',
                MatchGrammar0, '%(delim)s[a-z]*'),
 
+    # translate operator; paired delimiters #XYZ
+    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\()', TranslateGrammar3,
+               r'\)', WhitespaceGrammar, '\(', TranslateGrammar3, r'\)[a-z]*'),
+    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\[)', TranslateGrammar4,
+               r'\]', WhitespaceGrammar, '\[', TranslateGrammar4, r'\][a-z]*'),
+    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\{)', TranslateGrammar5,
+               r'\}', WhitespaceGrammar, '\{', TranslateGrammar5, r'\}[a-z]*'),
+    RegionRule('perl.translate', r'(?:y|tr) *(?P<delim>\<)', TranslateGrammar6,
+               r'\>', WhitespaceGrammar, '\<', TranslateGrammar6, r'\>[a-z]*'),
+
     # translate operator
     RegionRule('perl.translate', '(?:y|tr) *(?P<delim>/)',
                TranslateGrammar1, '/', TranslateGrammar1, '/[a-z]*'),
@@ -236,21 +231,21 @@ PerlGrammar.rules = [
     PatternRule('perl.builtin', "(?<!->)&?(?:write|warn|wantarray|waitpid|wait|vec|values|utime|use|untie|unshift|unpack|unlink|undef|umask|ucfirst|uc|truncate|times|time|tied|tie|telldir|tell|syswrite|system|sysseek|sysread|sysopen|syscall|symlink|substr|sub|study|stat|srand|sqrt|sprintf|split|splice|sort|socketpair|socket|sleep|sin|shutdown|shmwrite|shmread|shmget|shmctl|shift|setsockopt|setservent|setpwent|setprotoent|setpriority|setpgrp|setnetent|sethostent|setgrent|send|semop|semget|semctl|select|seekdir|seek|scalar|rmdir|rindex|rewinddir|reverse|return|reset|require|rename|ref|redo|recv|readpipe|readlink|readline|readdir|read|rand|quotemeta|push|prototype|printf|print|pos|pop|pipe|package|pack|our|ord|opendir|open|oct|no|next|my|msgsnd|msgrcv|msgget|msgctl|mkdir|map|lstat|log|lock|localtime|local|listen|link|length|lcfirst|lc|last|kill|keys|join|ioctl|int|index|import|hex|grep|goto|gmtime|glob|getsockopt|getsockname|getservent|getservbyport|getservbyname|getpwuid|getpwnam|getpwent|getprotoent|getprotobynumber|getprotobyname|getpriority|getppid|getpgrp|getpeername|getnetent|getnetbyname|getnetbyaddr|getlogin|gethostent|gethostbyname|gethostbyaddr|getgrnam|getgrgid|getgrent|getc|formline|format|fork|flock|fileno|fcntl|exp|exit|exists|exec|eval|eof|endservent|endpwent|endprotoent|endnetent|endhostent|endgrent|each|dump|do|die|delete|defined|dbmopen|dbmclose|crypt|cos|continue|connect|closedir|close|chroot|chr|chown|chop|chomp|chmod|chdir|caller|bless|binmode|bind|atan2|alarm|accept|abs)(?![a-zA-Z0-9_])"),
 
     # quote operator: qq(), qx() and qr() usually interpolate
-    RegionRule('perl.quoted', r'q[rqx] *(?P<delim>\()', QuotedGrammar1, r'\)'),
+    RegionRule('perl.quoted', r'q[rqx] *(?P<delim>\()', MatchGrammar3, r'\)'),
-    RegionRule('perl.quoted', 'q[rqx] *(?P<delim>{)', QuotedGrammar2, '}'),
+    RegionRule('perl.quoted', 'q[rqx] *(?P<delim>{)', MatchGrammar4, '}'),
-    RegionRule('perl.quoted', 'q[rqx] *(?P<delim><)', QuotedGrammar3, '>'),
+    RegionRule('perl.quoted', 'q[rqx] *(?P<delim><)', MatchGrammar5, '>'),
-    RegionRule('perl.quoted', r'q[rqx] *(?P<delim>\[)', QuotedGrammar4, r'\]'),
+    RegionRule('perl.quoted', r'q[rqx] *(?P<delim>\[)', MatchGrammar6, r'\]'),
-    RegionRule('perl.quoted', "q[rqx] *(?P<delim>')", Grammar, "'"),
+    RegionRule('perl.quoted', 'q[rqx](?P<delim>#)', MatchGrammar2, '#'),
-    RegionRule('perl.quoted', 'q[rqx](?P<delim>#)', MatchGrammar0, '#'),
+    RegionRule('perl.quoted', 'q[rqx] *(?P<delim>/)', MatchGrammar1, '/'),
     RegionRule('perl.quoted', 'q[rqx] *(?P<delim>[^ a-zA-Z0-9#])', MatchGrammar0, '%(delim)s'),
 
     # quote operator: q() and qw() do not interpolate
     RegionRule('perl.quoted', r'qw? *\(', QuotedWords, r'\)'),
-    RegionRule('perl.quoted', 'qw? *{', NoBrace, '}'),
+    RegionRule('perl.quoted', 'qw? *{', QuotedWords, '}'),
-    RegionRule('perl.quoted', 'qw? *<', NoAngle, '>'),
+    RegionRule('perl.quoted', 'qw? *<', QuotedWords, '>'),
-    RegionRule('perl.quoted', r'qw? *\[', NoBracket, r'\]'),
+    RegionRule('perl.quoted', r'qw? *\[', QuotedWords, r'\]'),
-    RegionRule('perl.quoted', 'qw?#', NoHash, '#'),
+    RegionRule('perl.quoted', 'qw?#', QuotedWords, '#'),
-    RegionRule('perl.quoted', 'qw? *(?P<delim>[^ a-zA-Z0-9#])', Grammar, '%(delim)s'),
+    RegionRule('perl.quoted', 'qw? *(?P<delim>[^ a-zA-Z0-9#])', QuotedWords, '%(delim)s'),
 
     PatternRule('perl.function', word2 + r"(?= *\()"),
     PatternRule('perl.class', word2 + "(?=->)"),
@@ -265,10 +260,11 @@ PerlGrammar.rules = [
     PatternRule('perl.operator', r"\+=|-=|\*=|/=|//=|%=|&=\|\^=|>>=|<<=|\*\*=|\\"),
     PatternRule('perl.operator', r"\+\+|\+|<=>|<>|<<|<=|<|-|>>|>=|>|\*\*|\*|&&|&|\|\||\||/|\^|==|//|~|=~|!~|!=|%|!|\.\.|\.|x(?![a-zA-Z_])"),
     PatternRule('perl.noperator', "(?:xor|or|not|ne|lt|le|gt|ge|eq|cmp|and)(?![a-zA-Z_])"),
+    PatternRule('perl.function', word2 + r'(?= *[a-zA_Z0-9_$@%&*\\\'(){}\[\]\"])'),
     PatternRule('perl.bareword', word2),
 
-    PatternRule('spaces', ' +'),
+    spaces,
-    PatternRule('eol', r"\n$"),
+    eol,
 ]
 
 class PerlTabber(StackTabber2):
@@ -799,7 +795,7 @@ class Perl(Fundamental):
         'perl.prototype': hi_yellow,
         'perl.scalar':    hi_yellow,
         'perl.length':    hi_yellow,
-        #'perl.deref':     hi_yellow,
+        'perl.deref':     hi_yellow,
         'perl.array':     hi_orange,
         'perl.hash':      lo_orange,
         'perl.hashkey':   hi_green,
@@ -868,6 +864,7 @@ class Perl(Fundamental):
         # translate regex
         'translate.start':   lo_magenta,
         'translate.middle0': lo_magenta,
+        'translate.middle1': lo_magenta,
         'translate.end':     lo_magenta,
         'translate.data':    hi_magenta,
         'translate.null':    hi_magenta,