Perl: Handle 'method' the same as 'sub' for special cases

lexers/LexPerl.cxx

@@ -87,7 +87,7 @@ namespace {
 #define SUB_HAS_PROTO	1	// only 'prototype' attribute allows prototypes
 #define SUB_HAS_ATTRIB	2	// other attributes can exist leftward
 #define SUB_HAS_MODULE	3	// sub name can have a ::identifier part
-#define SUB_HAS_SUB		4	// 'sub' keyword
+#define SUB_HAS_SUB		4	// 'sub' (or 'method') keyword
 
 // all interpolated styles are different from their parent styles by a constant difference
 // we also assume SCE_PL_STRING_VAR is the interpolated style with the smallest value
@@ -131,8 +131,9 @@ int disambiguateBareword(LexAccessor &styler, Sci_PositionU bk, Sci_PositionU fw
 	        // ->bareword: part of variable spec
 	        || styler.Match(bk - 1, "::")
 	        // ::bareword: part of module spec
-	        || styler.Match(bk - 2, "sub")) {
-	        // sub bareword: subroutine declaration
+	        || styler.Match(bk - 2, "sub")
+	        || styler.Match(bk - 5, "method")) {
+	        // 'sub' or 'method' bareword: subroutine declaration
 	        // (implied BACK_KEYWORD, no keywords end in 'sub'!)
 		result |= 1;
 	}
@@ -299,9 +300,10 @@ bool styleCheckSubPrototype(LexAccessor &styler, Sci_PositionU bk) {
 				state = SUB_HAS_MODULE;
 			} else
 				break;
-		} else if (style1 == SCE_PL_WORD && len1 == 3 &&
-		           styler.Match(pos1, "sub")) {	// 'sub'
-			if (style2 == SCE_PL_IDENTIFIER) {	// 'sub' <identifier>
+		} else if ((style1 == SCE_PL_WORD || style1 == SCE_PL_IDENTIFIER) &&
+		           ((len1 == 3 && styler.Match(pos1, "sub")) || 	// 'sub'
+		            (len1 == 6 && styler.Match(pos1, "method")))) {	// or 'method
+			if (style2 == SCE_PL_IDENTIFIER) {	// ('sub' | 'method') <identifier>
 				state = SUB_HAS_SUB;
 			} else
 				break;

test/examples/perl/SciTE.properties

@@ -1,33 +1,36 @@
 lexer.*.pl=perl
 keywords.*.pl=\
-NULL __FILE__ __LINE__ __PACKAGE__ __DATA__ __END__ AUTOLOAD \
-BEGIN CORE DESTROY END EQ GE GT INIT LE LT NE CHECK abs accept \
-alarm and atan2 bind binmode bless caller chdir chmod chomp chop \
-chown chr chroot close closedir cmp connect continue cos crypt \
-dbmclose dbmopen defined delete die do dump each else elsif endgrent \
-endhostent endnetent endprotoent endpwent endservent eof eq eval \
-exec exists exit exp fcntl fileno flock for foreach fork format \
-formline ge getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname \
-gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername \
-getpgrp getppid getpriority getprotobyname getprotobynumber getprotoent \
-getpwent getpwnam getpwuid getservbyname getservbyport getservent \
-getsockname getsockopt glob gmtime goto grep gt hex if index \
-int ioctl join keys kill last lc lcfirst le length link listen \
-local localtime lock log lstat lt map mkdir msgctl msgget msgrcv \
-msgsnd my ne next no not oct open opendir or ord our pack package \
-pipe pop pos print printf prototype push quotemeta qu \
-rand read readdir readline readlink readpipe recv redo \
-ref rename require reset return reverse rewinddir rindex rmdir \
-scalar seek seekdir select semctl semget semop send setgrent \
-sethostent setnetent setpgrp setpriority setprotoent setpwent \
-setservent setsockopt shift shmctl shmget shmread shmwrite shutdown \
-sin sleep socket socketpair sort splice split sprintf sqrt srand \
-stat study sub substr symlink syscall sysopen sysread sysseek \
-system syswrite tell telldir tie tied time times truncate \
-uc ucfirst umask undef unless unlink unpack unshift untie until \
-use utime values vec wait waitpid wantarray warn while write \
-xor \
-given when default break say state UNITCHECK __SUB__ fc
+ADJUST AUTOLOAD BEGIN CHECK CORE DESTROY END EQ GE GT INIT LE LT NE NULL \
+UNITCHECK __CLASS__ __DATA__ __END__ __FILE__ __LINE__ __PACKAGE__ \
+__SUB__ abs accept alarm all and any atan2 attributes autodie autouse \
+base bigfloat bigint bignum bigrat bind binmode bless blib break builtin \
+bytes caller catch charnames chdir chmod chomp chop chown chr chroot \
+class close closedir cmp connect constant continue cos crypt dbmclose \
+dbmopen default defer defined delete deprecate diagnostics die do dump \
+each else elseif elsif encoding endgrent endhostent endnetent \
+endprotoent endpwent endservent eof eq eval evalbytes exec exists exit \
+exp experimental fc fcntl feature field fields fileno filetest finally \
+flock for foreach fork format formline ge getc getgrent getgrgid \
+getgrnam gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr \
+getnetbyname getnetent getpeername getpgrp getppid getpriority \
+getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid \
+getservbyname getservbyport getservent getsockname getsockopt given glob \
+gmtime goto grep gt hex if import index int integer ioctl isa join keys \
+kill last lc lcfirst le length less lib link listen local locale \
+localtime lock log lstat lt map meta_notation method mkdir mro msgctl \
+msgget msgrcv msgsnd my ne next no not oct ok open opendir ops or ord \
+our overload overloading pack package parent perlfaq pipe pop pos print \
+printf prototype push qu quotemeta rand re read readdir readline \
+readlink readpipe recv redo ref rename require reset return reverse \
+rewinddir rindex rmdir say scalar seek seekdir select semctl semget \
+semop send setgrent sethostent setnetent setpgrp setpriority setprotoent \
+setpwent setservent setsockopt shift shmctl shmget shmread shmwrite \
+shutdown sigtrap sin size sleep socket socketpair sort splice split \
+sprintf sqrt srand stable stat state strict study sub subs substr \
+symlink syscall sysopen sysread sysseek system syswrite tell telldir \
+threads tie tied time times truncate try uc ucfirst umask undef unless \
+unlink unpack unshift untie until use utf8 utime values vars vec version \
+vmsish wait waitpid wantarray warn warnings when while write xor
 
 fold=1
 fold.comment=1

test/examples/perl/class.pl

@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+use v5.38;
+use feature 'class';
+
+class MyClass::SubClass {
+    method inClass { return 1 }
+    method inClassProto($) { return $_[0] }
+    method inClassAttrib :prototype($) { return $_[0] }
+}

test/examples/perl/class.pl.folded

@@ -0,0 +1,10 @@
+ 0 400 400   #!/usr/bin/env perl
+ 0 400 400   use v5.38;
+ 0 400 400   use feature 'class';
+ 1 400 400   
+ 2 400 401 + class MyClass::SubClass {
+ 0 401 401 |     method inClass { return 1 }
+ 0 401 401 |     method inClassProto($) { return $_[0] }
+ 0 401 401 |     method inClassAttrib :prototype($) { return $_[0] }
+ 0 401 400 | }
+ 0 400   0   

test/examples/perl/class.pl.styled

@@ -0,0 +1,9 @@
+{2}#!/usr/bin/env perl
+{5}use{0} {6}v5.38{10};{0}
+{5}use{0} {5}feature{0} {7}'class'{10};{0}
+
+{5}class{0} {11}MyClass{10}::{11}SubClass{0} {10}{{0}
+    {5}method{0} {11}inClass{0} {10}{{0} {5}return{0} {4}1{0} {10}}{0}
+    {5}method{0} {11}inClassProto{40}($){0} {10}{{0} {5}return{0} {12}$_{10}[{4}0{10}]{0} {10}}{0}
+    {5}method{0} {11}inClassAttrib{0} {10}:{5}prototype{40}($){0} {10}{{0} {5}return{0} {12}$_{10}[{4}0{10}]{0} {10}}{0}
+{10}}{0}

test/examples/perl/perl-test-5220delta.pl.styled

@@ -19,8 +19,8 @@
 # New bitwise operators
 #--------------------------------------------------------------------------
 {0}
-{5}use{0} {11}feature{0} {7}'bitwise'{0}		{2}# enable feature, warning enabled
-{5}use{0} {11}experimental{0} {6}"bitwise"{10};{0}	{2}# enable feature, warning disabled
+{5}use{0} {5}feature{0} {7}'bitwise'{0}		{2}# enable feature, warning enabled
+{5}use{0} {5}experimental{0} {6}"bitwise"{10};{0}	{2}# enable feature, warning disabled
 {0}
 {2}# numerical operands
 {4}10{10}&{4}20{0}  {4}10{10}|{4}20{0}   {4}10{10}^{4}20{0} {10}~{4}10{0}
@@ -77,12 +77,12 @@
 
 {2}# example snippet from brian d foy's blog post
 {0}
-{5}use{0} {11}feature{0} {30}qw(refaliasing){10};{0}
+{5}use{0} {5}feature{0} {30}qw(refaliasing){10};{0}
 
 {10}\{14}%other_hash{0} {10}={0} {10}\{14}%hash{10};{0}
 
 {5}use{0} {6}v5.22{10};{0}
-{5}use{0} {11}feature{0} {30}qw(refaliasing){10};{0}
+{5}use{0} {5}feature{0} {30}qw(refaliasing){10};{0}
 
 {5}foreach{0} {10}\{5}my{0} {14}%hash{0} {10}({0} {13}@array_of_hashes{0} {10}){0} {10}{{0} {2}# named hash control variable
 {0}	{5}foreach{0} {5}my{0} {12}$key{0} {10}({0} {5}keys{0} {14}%hash{0} {10}){0} {10}{{0} {2}# named hash now!
@@ -115,7 +115,7 @@
 {5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0}
 
 {2}# built-in attributes for subroutines:
-{11}lvalue{0} {11}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0}
+{11}lvalue{0} {5}method{0} {11}prototype{10}(..){0} {11}locked{0} {11}const{0}
 
 {2}#--------------------------------------------------------------------------
 # Repetition in list assignment

test/examples/perl/perl-test-sub-prototypes.pl.styled

@@ -130,7 +130,7 @@
 # notation which are highlighted as operators (all other parameters are
 # highlighted as vars of some sort), a minor aesthetic issue
 {0}
-{5}use{0} {11}feature{0} {7}'signatures'{10};{0}
+{5}use{0} {5}feature{0} {7}'signatures'{10};{0}
 
 {5}sub{0} {11}foo{0} {10}({12}$left{10},{0} {12}$right{10}){0} {10}{{0}		{2}# mandatory positional parameters
 {0}    {5}return{0} {12}$left{0} {10}+{0} {12}$right{10};{0}
@@ -232,7 +232,7 @@
 {5}sub{0} {11}Y{10}::{11}bar{0} {10}:{0} {11}lvalue{0} {10};{0}
 
 {2}# built-in attributes for subroutines:
-{11}lvalue{0} {11}method{0} {5}prototype{10}(..){0} {11}locked{0} {11}const{0}
+{11}lvalue{0} {5}method{0} {11}prototype{10}(..){0} {11}locked{0} {11}const{0}
 
 {2}#--------------------------------------------------------------------------
 # end of test file

test/examples/perl/x.pl.styled

@@ -1,4 +1,4 @@
-{5}use{0} {11}strict{10};{0}
+{5}use{0} {5}strict{10};{0}
 {5}while{0} {10}({0} {12}$r{0} {10}){0} {10}{{0}
   {5}printf{0} {10}({0} {6}"Example text \n"{0} {10});{0}
   {5}sleep{0} {4}1{10};{0}