From 87cb39a670224e69b8899b968854935ba9e167d6 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Harald=20J=C3=B6rg?= Date: Mon, 10 Jun 2024 12:19:04 +0200 Subject: [PATCH] cperl-mode.el: Update for the current Perl version 5.040 * etc/NEWS: Announce new features of cperl-mode. * lisp/progmodes/cperl-mode.el (cperl-menu): Add toggle for extra paired delimiters. (defconst): new rx expressions `cperl--sub-name-generated-rx' and `cperl--field-declaration-rx' (cperl--imenu-entries-rx): Use the new expressions (cperl--extra-paired-delimiters): New variable holding the paired delimiters for Perl 5.36 and newer (cperl-imenu-sub-keywords): Add autogenerated methods to imenu (cperl-init-faces): Add the __CLASS__ token, builtin constants, and attributes for field declarations. (cperl-short-docs): Add __CLASS__ to one-line docs. (cperl-extra-paired-delimiters-mode): new minor mode to handle non-ASCII paired delimiters. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-builtin-constants): new test. (cperl-test-fontify-class): New test clauses for attributes. (cperl-test-field-declaration-rx): new test. (cperl-test-autogenerated-reader-rx): new unit test for the rx expression. (cperl-test-extra-delimiters): new test. (cperl-test-imenu-index): new clauses for imenu capture of autogenerated methods. * test/lisp/progmodes/cperl-mode-resources/grammar.pl: Add examples for Perl 5.40 syntax. * test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl: New resource for non-ASCII paired delimiters. (cherry picked from commit 060c48435f49eb03019cc9eb7f1657f756f56ceb) --- etc/NEWS | 9 +- lisp/progmodes/cperl-mode.el | 444 +++++++++++++++++- .../cperl-mode-resources/extra-delimiters.pl | 23 + .../progmodes/cperl-mode-resources/grammar.pl | 12 + .../cperl-mode-resources/perl-class.pl | 4 + test/lisp/progmodes/cperl-mode-tests.el | 130 ++++- 6 files changed, 599 insertions(+), 23 deletions(-) create mode 100644 test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl diff --git a/etc/NEWS b/etc/NEWS index 98d39f6153e..b02d2d2bc6d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1744,9 +1744,9 @@ fit on fewer lines without negatively impacting readability. CPerl mode fontifies subroutine signatures like variable declarations which makes them visually distinct from subroutine prototypes. -*** Syntax of Perl up to version 5.38 is supported. +*** Syntax of Perl up to version 5.40 is supported. CPerl mode supports the new keywords for exception handling and the -object oriented syntax which were added in Perl 5.36 and 5.38. +object oriented syntax which were added in Perl 5.36, 5.38 and 5.40. *** New user option 'cperl-fontify-trailer'. This user option takes the values 'perl-code' or 'comment' and treats @@ -1760,6 +1760,11 @@ This command sets the indentation style for the current buffer. To change the default style, either use the user option with the same name or use the command 'cperl-set-style'. +*** New minor mode cperl-extra-paired-delimiters-mode +Perl 5.36 and newer allows using more than 200 non-ASCII paired +delimiters for quote-like constructs, eg. "q«text»". Use this minor +mode in buffers where this feature is activated. + *** Commands using the Perl info page are obsolete. The Perl documentation in info format is no longer distributed with Perl or on CPAN since more than 10 years. Perl documentation can be diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index cbc23507fca..5dba24ae76a 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1130,6 +1130,7 @@ Unless KEEP, removes the old indentation." ["Auto newline" cperl-toggle-auto-newline t] ["Electric parens" cperl-toggle-electric t] ["Electric keywords" cperl-toggle-abbrev t] + ["Extra paired delimiters" cperl-extra-paired-delimiters-mode t] ["Fix whitespace on indent" cperl-toggle-construct-fix t] ["Auto-help on Perl constructs" cperl-toggle-autohelp t] ["Auto fill" auto-fill-mode t]) @@ -1436,6 +1437,33 @@ Contains three groups: One to distinguish lexical from \"normal\" subroutines, for the keyword \"sub\" or \"method\", and one for the subroutine name.") + (defconst cperl--sub-name-generated-rx + `(sequence symbol-start + (optional (group-n 3 unmatchable)) + ;; autogenerated methods are not lexicals, so enforce the + ;; first capture group to be nil + "field" + ,cperl--ws+-rx + (or + (sequence (in "$%@") + (group-n 2 ,cperl--basic-identifier-rx) + (1+ (not (in ";={"))) + ":" + (group-n 1 "reader") + (not "(")) + (sequence ,cperl--basic-variable-rx + (1+ (not (in ";={"))) + ":" + (group-n 1 "reader") + "(" + (group-n 2 ,cperl--basic-identifier-rx) + ")"))) + "A regular expression to capture autogenerated reader methods. +The name of the method is either the field name without its sigil, or +given in parentheses after the \":reader\" keyword.") + ;; I don't dare to think about :writer where the generated name does + ;; not even occur in the text. + (defconst cperl--block-declaration-rx `(sequence (or "class" "method" "package" "sub") @@ -1445,16 +1473,16 @@ the subroutine name.") Used for indentation. These declarations introduce a block which does not need a semicolon to terminate the statement.") -;;; Initializer blocks are not (yet) part of the Perl core. -;; (defconst cperl--field-declaration-rx -;; `(sequence -;; "field" -;; (1+ ,cperl--ws-or-comment-rx) -;; ,cperl--basic-variable-rx) -;; "A regular expression to find a declaration for a field. -;; Used for indentation. These declarations allow an initializer -;; block which does not need a semicolon to terminate the -;; statement.") +(defconst cperl--field-declaration-rx + `(sequence + "field" + (1+ ,cperl--ws-or-comment-rx) + ,cperl--basic-variable-rx + (optional (sequence ,cperl--ws+-rx ,cperl--attribute-list-rx)) + ) + "A regular expression to find a declaration for a field. +Fields can have attributes for fontification, and even for imenu because +for example \":reader\" implicitly declares a method.") (defconst cperl--pod-heading-rx `(sequence line-start @@ -1470,6 +1498,7 @@ heading text.") `(or ,cperl--package-for-imenu-rx ,cperl--class-for-imenu-rx ,cperl--sub-name-for-imenu-rx + ,cperl--sub-name-generated-rx ,cperl--pod-heading-rx) "A regular expression to collect stuff that goes into the `imenu' index. Covers packages and classes, subroutines and methods, and POD headings.") @@ -3351,10 +3380,333 @@ fontified. Do nothing if BEGIN and END are equal. If (put-text-property begin end 'face (if string 'font-lock-string-face 'font-lock-comment-face))))) -(defvar cperl-starters '(( ?\( . ?\) ) - ( ?\[ . ?\] ) - ( ?\{ . ?\} ) - ( ?\< . ?\> ))) +(defvar cperl--basic-paired-delimiters '(( ?\( . ?\) ) + ( ?\[ . ?\] ) + ( ?\{ . ?\} ) + ( ?\< . ?\> ))) +;; -------- The following definition is generated code from "perlop" +;; https://metacpan.org/release/HAARG/perl-5.40.0/view/pod/perlop.pod +(defvar cperl--extra-paired-delimiters '(( ?\N{U+0028} . ?\N{U+0029} ) + ( ?\N{U+003C} . ?\N{U+003E} ) + ( ?\N{U+005B} . ?\N{U+005D} ) + ( ?\N{U+007B} . ?\N{U+007D} ) + ( ?\N{U+00AB} . ?\N{U+00BB} ) + ( ?\N{U+00BB} . ?\N{U+00AB} ) + ( ?\N{U+0F3A} . ?\N{U+0F3B} ) + ( ?\N{U+0F3C} . ?\N{U+0F3D} ) + ( ?\N{U+169B} . ?\N{U+169C} ) + ( ?\N{U+2018} . ?\N{U+2019} ) + ( ?\N{U+2019} . ?\N{U+2018} ) + ( ?\N{U+201C} . ?\N{U+201D} ) + ( ?\N{U+201D} . ?\N{U+201C} ) + ( ?\N{U+2035} . ?\N{U+2032} ) + ( ?\N{U+2036} . ?\N{U+2033} ) + ( ?\N{U+2037} . ?\N{U+2034} ) + ( ?\N{U+2039} . ?\N{U+203A} ) + ( ?\N{U+203A} . ?\N{U+2039} ) + ( ?\N{U+2045} . ?\N{U+2046} ) + ( ?\N{U+204D} . ?\N{U+204C} ) + ( ?\N{U+207D} . ?\N{U+207E} ) + ( ?\N{U+208D} . ?\N{U+208E} ) + ( ?\N{U+2192} . ?\N{U+2190} ) + ( ?\N{U+219B} . ?\N{U+219A} ) + ( ?\N{U+219D} . ?\N{U+219C} ) + ( ?\N{U+21A0} . ?\N{U+219E} ) + ( ?\N{U+21A3} . ?\N{U+21A2} ) + ( ?\N{U+21A6} . ?\N{U+21A4} ) + ( ?\N{U+21AA} . ?\N{U+21A9} ) + ( ?\N{U+21AC} . ?\N{U+21AB} ) + ( ?\N{U+21B1} . ?\N{U+21B0} ) + ( ?\N{U+21B3} . ?\N{U+21B2} ) + ( ?\N{U+21C0} . ?\N{U+21BC} ) + ( ?\N{U+21C1} . ?\N{U+21BD} ) + ( ?\N{U+21C9} . ?\N{U+21C7} ) + ( ?\N{U+21CF} . ?\N{U+21CD} ) + ( ?\N{U+21D2} . ?\N{U+21D0} ) + ( ?\N{U+21DB} . ?\N{U+21DA} ) + ( ?\N{U+21DD} . ?\N{U+21DC} ) + ( ?\N{U+21E2} . ?\N{U+21E0} ) + ( ?\N{U+21E5} . ?\N{U+21E4} ) + ( ?\N{U+21E8} . ?\N{U+21E6} ) + ( ?\N{U+21F4} . ?\N{U+2B30} ) + ( ?\N{U+21F6} . ?\N{U+2B31} ) + ( ?\N{U+21F8} . ?\N{U+21F7} ) + ( ?\N{U+21FB} . ?\N{U+21FA} ) + ( ?\N{U+21FE} . ?\N{U+21FD} ) + ( ?\N{U+2208} . ?\N{U+220B} ) + ( ?\N{U+2209} . ?\N{U+220C} ) + ( ?\N{U+220A} . ?\N{U+220D} ) + ( ?\N{U+2264} . ?\N{U+2265} ) + ( ?\N{U+2266} . ?\N{U+2267} ) + ( ?\N{U+2268} . ?\N{U+2269} ) + ( ?\N{U+226A} . ?\N{U+226B} ) + ( ?\N{U+226E} . ?\N{U+226F} ) + ( ?\N{U+2270} . ?\N{U+2271} ) + ( ?\N{U+2272} . ?\N{U+2273} ) + ( ?\N{U+2274} . ?\N{U+2275} ) + ( ?\N{U+227A} . ?\N{U+227B} ) + ( ?\N{U+227C} . ?\N{U+227D} ) + ( ?\N{U+227E} . ?\N{U+227F} ) + ( ?\N{U+2280} . ?\N{U+2281} ) + ( ?\N{U+2282} . ?\N{U+2283} ) + ( ?\N{U+2284} . ?\N{U+2285} ) + ( ?\N{U+2286} . ?\N{U+2287} ) + ( ?\N{U+2288} . ?\N{U+2289} ) + ( ?\N{U+228A} . ?\N{U+228B} ) + ( ?\N{U+22A3} . ?\N{U+22A2} ) + ( ?\N{U+22A6} . ?\N{U+2ADE} ) + ( ?\N{U+22A8} . ?\N{U+2AE4} ) + ( ?\N{U+22A9} . ?\N{U+2AE3} ) + ( ?\N{U+22B0} . ?\N{U+22B1} ) + ( ?\N{U+22D0} . ?\N{U+22D1} ) + ( ?\N{U+22D6} . ?\N{U+22D7} ) + ( ?\N{U+22D8} . ?\N{U+22D9} ) + ( ?\N{U+22DC} . ?\N{U+22DD} ) + ( ?\N{U+22DE} . ?\N{U+22DF} ) + ( ?\N{U+22E0} . ?\N{U+22E1} ) + ( ?\N{U+22E6} . ?\N{U+22E7} ) + ( ?\N{U+22E8} . ?\N{U+22E9} ) + ( ?\N{U+22F2} . ?\N{U+22FA} ) + ( ?\N{U+22F3} . ?\N{U+22FB} ) + ( ?\N{U+22F4} . ?\N{U+22FC} ) + ( ?\N{U+22F6} . ?\N{U+22FD} ) + ( ?\N{U+22F7} . ?\N{U+22FE} ) + ( ?\N{U+2308} . ?\N{U+2309} ) + ( ?\N{U+230A} . ?\N{U+230B} ) + ( ?\N{U+2326} . ?\N{U+232B} ) + ( ?\N{U+2348} . ?\N{U+2347} ) + ( ?\N{U+23ED} . ?\N{U+23EE} ) + ( ?\N{U+261B} . ?\N{U+261A} ) + ( ?\N{U+261E} . ?\N{U+261C} ) + ( ?\N{U+269E} . ?\N{U+269F} ) + ( ?\N{U+2768} . ?\N{U+2769} ) + ( ?\N{U+276A} . ?\N{U+276B} ) + ( ?\N{U+276C} . ?\N{U+276D} ) + ( ?\N{U+276E} . ?\N{U+276F} ) + ( ?\N{U+2770} . ?\N{U+2771} ) + ( ?\N{U+2772} . ?\N{U+2773} ) + ( ?\N{U+2774} . ?\N{U+2775} ) + ( ?\N{U+27C3} . ?\N{U+27C4} ) + ( ?\N{U+27C5} . ?\N{U+27C6} ) + ( ?\N{U+27C8} . ?\N{U+27C9} ) + ( ?\N{U+27DE} . ?\N{U+27DD} ) + ( ?\N{U+27E6} . ?\N{U+27E7} ) + ( ?\N{U+27E8} . ?\N{U+27E9} ) + ( ?\N{U+27EA} . ?\N{U+27EB} ) + ( ?\N{U+27EC} . ?\N{U+27ED} ) + ( ?\N{U+27EE} . ?\N{U+27EF} ) + ( ?\N{U+27F4} . ?\N{U+2B32} ) + ( ?\N{U+27F6} . ?\N{U+27F5} ) + ( ?\N{U+27F9} . ?\N{U+27F8} ) + ( ?\N{U+27FC} . ?\N{U+27FB} ) + ( ?\N{U+27FE} . ?\N{U+27FD} ) + ( ?\N{U+27FF} . ?\N{U+2B33} ) + ( ?\N{U+2900} . ?\N{U+2B34} ) + ( ?\N{U+2901} . ?\N{U+2B35} ) + ( ?\N{U+2903} . ?\N{U+2902} ) + ( ?\N{U+2905} . ?\N{U+2B36} ) + ( ?\N{U+2907} . ?\N{U+2906} ) + ( ?\N{U+290D} . ?\N{U+290C} ) + ( ?\N{U+290F} . ?\N{U+290E} ) + ( ?\N{U+2910} . ?\N{U+2B37} ) + ( ?\N{U+2911} . ?\N{U+2B38} ) + ( ?\N{U+2914} . ?\N{U+2B39} ) + ( ?\N{U+2915} . ?\N{U+2B3A} ) + ( ?\N{U+2916} . ?\N{U+2B3B} ) + ( ?\N{U+2917} . ?\N{U+2B3C} ) + ( ?\N{U+2918} . ?\N{U+2B3D} ) + ( ?\N{U+291A} . ?\N{U+2919} ) + ( ?\N{U+291C} . ?\N{U+291B} ) + ( ?\N{U+291E} . ?\N{U+291D} ) + ( ?\N{U+2920} . ?\N{U+291F} ) + ( ?\N{U+2933} . ?\N{U+2B3F} ) + ( ?\N{U+2937} . ?\N{U+2936} ) + ( ?\N{U+2945} . ?\N{U+2946} ) + ( ?\N{U+2947} . ?\N{U+2B3E} ) + ( ?\N{U+2953} . ?\N{U+2952} ) + ( ?\N{U+2957} . ?\N{U+2956} ) + ( ?\N{U+295B} . ?\N{U+295A} ) + ( ?\N{U+295F} . ?\N{U+295E} ) + ( ?\N{U+2964} . ?\N{U+2962} ) + ( ?\N{U+296C} . ?\N{U+296A} ) + ( ?\N{U+296D} . ?\N{U+296B} ) + ( ?\N{U+2971} . ?\N{U+2B40} ) + ( ?\N{U+2972} . ?\N{U+2B41} ) + ( ?\N{U+2974} . ?\N{U+2B4B} ) + ( ?\N{U+2975} . ?\N{U+2B42} ) + ( ?\N{U+2979} . ?\N{U+297B} ) + ( ?\N{U+2983} . ?\N{U+2984} ) + ( ?\N{U+2985} . ?\N{U+2986} ) + ( ?\N{U+2987} . ?\N{U+2988} ) + ( ?\N{U+2989} . ?\N{U+298A} ) + ( ?\N{U+298B} . ?\N{U+298C} ) + ( ?\N{U+298D} . ?\N{U+2990} ) + ( ?\N{U+298F} . ?\N{U+298E} ) + ( ?\N{U+2991} . ?\N{U+2992} ) + ( ?\N{U+2993} . ?\N{U+2994} ) + ( ?\N{U+2995} . ?\N{U+2996} ) + ( ?\N{U+2997} . ?\N{U+2998} ) + ( ?\N{U+29A8} . ?\N{U+29A9} ) + ( ?\N{U+29AA} . ?\N{U+29AB} ) + ( ?\N{U+29B3} . ?\N{U+29B4} ) + ( ?\N{U+29C0} . ?\N{U+29C1} ) + ( ?\N{U+29D8} . ?\N{U+29D9} ) + ( ?\N{U+29DA} . ?\N{U+29DB} ) + ( ?\N{U+29FC} . ?\N{U+29FD} ) + ( ?\N{U+2A79} . ?\N{U+2A7A} ) + ( ?\N{U+2A7B} . ?\N{U+2A7C} ) + ( ?\N{U+2A7D} . ?\N{U+2A7E} ) + ( ?\N{U+2A7F} . ?\N{U+2A80} ) + ( ?\N{U+2A81} . ?\N{U+2A82} ) + ( ?\N{U+2A83} . ?\N{U+2A84} ) + ( ?\N{U+2A85} . ?\N{U+2A86} ) + ( ?\N{U+2A87} . ?\N{U+2A88} ) + ( ?\N{U+2A89} . ?\N{U+2A8A} ) + ( ?\N{U+2A8D} . ?\N{U+2A8E} ) + ( ?\N{U+2A95} . ?\N{U+2A96} ) + ( ?\N{U+2A97} . ?\N{U+2A98} ) + ( ?\N{U+2A99} . ?\N{U+2A9A} ) + ( ?\N{U+2A9B} . ?\N{U+2A9C} ) + ( ?\N{U+2A9D} . ?\N{U+2A9E} ) + ( ?\N{U+2A9F} . ?\N{U+2AA0} ) + ( ?\N{U+2AA1} . ?\N{U+2AA2} ) + ( ?\N{U+2AA6} . ?\N{U+2AA7} ) + ( ?\N{U+2AA8} . ?\N{U+2AA9} ) + ( ?\N{U+2AAA} . ?\N{U+2AAB} ) + ( ?\N{U+2AAC} . ?\N{U+2AAD} ) + ( ?\N{U+2AAF} . ?\N{U+2AB0} ) + ( ?\N{U+2AB1} . ?\N{U+2AB2} ) + ( ?\N{U+2AB3} . ?\N{U+2AB4} ) + ( ?\N{U+2AB5} . ?\N{U+2AB6} ) + ( ?\N{U+2AB7} . ?\N{U+2AB8} ) + ( ?\N{U+2AB9} . ?\N{U+2ABA} ) + ( ?\N{U+2ABB} . ?\N{U+2ABC} ) + ( ?\N{U+2ABD} . ?\N{U+2ABE} ) + ( ?\N{U+2ABF} . ?\N{U+2AC0} ) + ( ?\N{U+2AC1} . ?\N{U+2AC2} ) + ( ?\N{U+2AC3} . ?\N{U+2AC4} ) + ( ?\N{U+2AC5} . ?\N{U+2AC6} ) + ( ?\N{U+2AC7} . ?\N{U+2AC8} ) + ( ?\N{U+2AC9} . ?\N{U+2ACA} ) + ( ?\N{U+2ACB} . ?\N{U+2ACC} ) + ( ?\N{U+2ACF} . ?\N{U+2AD0} ) + ( ?\N{U+2AD1} . ?\N{U+2AD2} ) + ( ?\N{U+2AD5} . ?\N{U+2AD6} ) + ( ?\N{U+2AE5} . ?\N{U+22AB} ) + ( ?\N{U+2AF7} . ?\N{U+2AF8} ) + ( ?\N{U+2AF9} . ?\N{U+2AFA} ) + ( ?\N{U+2B46} . ?\N{U+2B45} ) + ( ?\N{U+2B47} . ?\N{U+2B49} ) + ( ?\N{U+2B48} . ?\N{U+2B4A} ) + ( ?\N{U+2B4C} . ?\N{U+2973} ) + ( ?\N{U+2B62} . ?\N{U+2B60} ) + ( ?\N{U+2B6C} . ?\N{U+2B6A} ) + ( ?\N{U+2B72} . ?\N{U+2B70} ) + ( ?\N{U+2B7C} . ?\N{U+2B7A} ) + ( ?\N{U+2B86} . ?\N{U+2B84} ) + ( ?\N{U+2B8A} . ?\N{U+2B88} ) + ( ?\N{U+2B95} . ?\N{U+2B05} ) + ( ?\N{U+2B9A} . ?\N{U+2B98} ) + ( ?\N{U+2B9E} . ?\N{U+2B9C} ) + ( ?\N{U+2BA1} . ?\N{U+2BA0} ) + ( ?\N{U+2BA3} . ?\N{U+2BA2} ) + ( ?\N{U+2BA9} . ?\N{U+2BA8} ) + ( ?\N{U+2BAB} . ?\N{U+2BAA} ) + ( ?\N{U+2BB1} . ?\N{U+2BB0} ) + ( ?\N{U+2BB3} . ?\N{U+2BB2} ) + ( ?\N{U+2BEE} . ?\N{U+2BEC} ) + ( ?\N{U+2E02} . ?\N{U+2E03} ) + ( ?\N{U+2E03} . ?\N{U+2E02} ) + ( ?\N{U+2E04} . ?\N{U+2E05} ) + ( ?\N{U+2E05} . ?\N{U+2E04} ) + ( ?\N{U+2E09} . ?\N{U+2E0A} ) + ( ?\N{U+2E0A} . ?\N{U+2E09} ) + ( ?\N{U+2E0C} . ?\N{U+2E0D} ) + ( ?\N{U+2E0D} . ?\N{U+2E0C} ) + ( ?\N{U+2E11} . ?\N{U+2E10} ) + ( ?\N{U+2E1C} . ?\N{U+2E1D} ) + ( ?\N{U+2E1D} . ?\N{U+2E1C} ) + ( ?\N{U+2E20} . ?\N{U+2E21} ) + ( ?\N{U+2E21} . ?\N{U+2E20} ) + ( ?\N{U+2E22} . ?\N{U+2E23} ) + ( ?\N{U+2E24} . ?\N{U+2E25} ) + ( ?\N{U+2E26} . ?\N{U+2E27} ) + ( ?\N{U+2E28} . ?\N{U+2E29} ) + ( ?\N{U+2E36} . ?\N{U+2E37} ) + ( ?\N{U+2E42} . ?\N{U+201E} ) + ( ?\N{U+2E55} . ?\N{U+2E56} ) + ( ?\N{U+2E57} . ?\N{U+2E58} ) + ( ?\N{U+2E59} . ?\N{U+2E5A} ) + ( ?\N{U+2E5B} . ?\N{U+2E5C} ) + ( ?\N{U+A9C1} . ?\N{U+A9C2} ) + ( ?\N{U+FD3E} . ?\N{U+FD3F} ) + ( ?\N{U+FF62} . ?\N{U+FF63} ) + ( ?\N{U+FFEB} . ?\N{U+FFE9} ) + ( ?\N{U+1D103} . ?\N{U+1D102} ) + ( ?\N{U+1D106} . ?\N{U+1D107} ) + ( ?\N{U+1F57B} . ?\N{U+1F57D} ) + ( ?\N{U+1F599} . ?\N{U+1F598} ) + ( ?\N{U+1F59B} . ?\N{U+1F59A} ) + ( ?\N{U+1F59D} . ?\N{U+1F59C} ) + ( ?\N{U+1F5E6} . ?\N{U+1F5E7} ) + ( ?\N{U+1F802} . ?\N{U+1F800} ) + ( ?\N{U+1F806} . ?\N{U+1F804} ) + ( ?\N{U+1F80A} . ?\N{U+1F808} ) + ( ?\N{U+1F812} . ?\N{U+1F810} ) + ( ?\N{U+1F816} . ?\N{U+1F814} ) + ( ?\N{U+1F81A} . ?\N{U+1F818} ) + ( ?\N{U+1F81E} . ?\N{U+1F81C} ) + ( ?\N{U+1F822} . ?\N{U+1F820} ) + ( ?\N{U+1F826} . ?\N{U+1F824} ) + ( ?\N{U+1F82A} . ?\N{U+1F828} ) + ( ?\N{U+1F82E} . ?\N{U+1F82C} ) + ( ?\N{U+1F832} . ?\N{U+1F830} ) + ( ?\N{U+1F836} . ?\N{U+1F834} ) + ( ?\N{U+1F83A} . ?\N{U+1F838} ) + ( ?\N{U+1F83E} . ?\N{U+1F83C} ) + ( ?\N{U+1F842} . ?\N{U+1F840} ) + ( ?\N{U+1F846} . ?\N{U+1F844} ) + ( ?\N{U+1F852} . ?\N{U+1F850} ) + ( ?\N{U+1F862} . ?\N{U+1F860} ) + ( ?\N{U+1F86A} . ?\N{U+1F868} ) + ( ?\N{U+1F872} . ?\N{U+1F870} ) + ( ?\N{U+1F87A} . ?\N{U+1F878} ) + ( ?\N{U+1F882} . ?\N{U+1F880} ) + ( ?\N{U+1F892} . ?\N{U+1F890} ) + ( ?\N{U+1F896} . ?\N{U+1F894} ) + ( ?\N{U+1F89A} . ?\N{U+1F898} ) + ( ?\N{U+1F8A1} . ?\N{U+1F8A0} ) + ( ?\N{U+1F8A3} . ?\N{U+1F8A2} ) + ( ?\N{U+1F8A5} . ?\N{U+1F8A6} ) + ( ?\N{U+1F8A7} . ?\N{U+1F8A4} ) + ( ?\N{U+1F8A9} . ?\N{U+1F8A8} ) + ( ?\N{U+1F8AB} . ?\N{U+1F8AA} )) + "Full list of paired delimiters for quote-like constructs. +As an experimental feature, Perl uses these under \"feature +\='extra_paired_delimiters\='\" or in feature bundles of Perl 5.40 or +newer. To activate the extra delimiters, switch on the minor mode +`cperl-extra-paired-delimiters-mode'. This is also available from the +\"Perl\" menu in section \"Toggle...\". +The character pairs available are: +(), <>, [], {}, «», »«, ༺༻, ༼༽, ᚛᚜, ‘’, ’‘, “”, ”“, ‵′, ‶″, ‷‴, ‹›, ›‹, ⁅⁆, +⁍⁌, ⁽⁾, ₍₎, →←, ↛↚, ↝↜, ↠↞, ↣↢, ↦↤, ↪↩, ↬↫, ↱↰, ↳↲, ⇀↼, ⇁↽, ⇉⇇, ⇏⇍, ⇒⇐, ⇛⇚, +⇝⇜, ⇢⇠, ⇥⇤, ⇨⇦, ⇴⬰, ⇶⬱, ⇸⇷, ⇻⇺, ⇾⇽, ∈∋, ∉∌, ∊∍, ≤≥, ≦≧, ≨≩, ≪≫, ≮≯, ≰≱, ≲≳, +≴≵, ≺≻, ≼≽, ≾≿, ⊀⊁, ⊂⊃, ⊄⊅, ⊆⊇, ⊈⊉, ⊊⊋, ⊣⊢, ⊦⫞, ⊨⫤, ⊩⫣, ⊰⊱, ⋐⋑, ⋖⋗, ⋘⋙, ⋜⋝, +⋞⋟, ⋠⋡, ⋦⋧, ⋨⋩, ⋲⋺, ⋳⋻, ⋴⋼, ⋶⋽, ⋷⋾, ⌈⌉, ⌊⌋, ⌦⌫, ⍈⍇, ⏭⏮, ☛☚, ☞☜, ⚞⚟, ❨❩, ❪❫, +❬❭, ❮❯, ❰❱, ❲❳, ❴❵, ⟃⟄, ⟅⟆, ⟈⟉, ⟞⟝, ⟦⟧, ⟨⟩, ⟪⟫, ⟬⟭, ⟮⟯, ⟴⬲, ⟶⟵, ⟹⟸, ⟼⟻, ⟾⟽, +⟿⬳, ⤀⬴, ⤁⬵, ⤃⤂, ⤅⬶, ⤇⤆, ⤍⤌, ⤏⤎, ⤐⬷, ⤑⬸, ⤔⬹, ⤕⬺, ⤖⬻, ⤗⬼, ⤘⬽, ⤚⤙, ⤜⤛, ⤞⤝, ⤠⤟, +⤳⬿, ⤷⤶, ⥅⥆, ⥇⬾, ⥓⥒, ⥗⥖, ⥛⥚, ⥟⥞, ⥤⥢, ⥬⥪, ⥭⥫, ⥱⭀, ⥲⭁, ⥴⭋, ⥵⭂, ⥹⥻, ⦃⦄, ⦅⦆, ⦇⦈, +⦉⦊, ⦋⦌, ⦍⦐, ⦏⦎, ⦑⦒, ⦓⦔, ⦕⦖, ⦗⦘, ⦨⦩, ⦪⦫, ⦳⦴, ⧀⧁, ⧘⧙, ⧚⧛, ⧼⧽, ⩹⩺, ⩻⩼, ⩽⩾, ⩿⪀, +⪁⪂, ⪃⪄, ⪅⪆, ⪇⪈, ⪉⪊, ⪍⪎, ⪕⪖, ⪗⪘, ⪙⪚, ⪛⪜, ⪝⪞, ⪟⪠, ⪡⪢, ⪦⪧, ⪨⪩, ⪪⪫, ⪬⪭, ⪯⪰, ⪱⪲, +⪳⪴, ⪵⪶, ⪷⪸, ⪹⪺, ⪻⪼, ⪽⪾, ⪿⫀, ⫁⫂, ⫃⫄, ⫅⫆, ⫇⫈, ⫉⫊, ⫋⫌, ⫏⫐, ⫑⫒, ⫕⫖, ⫥⊫, ⫷⫸, ⫹⫺, +⭆⭅, ⭇⭉, ⭈⭊, ⭌⥳, ⭢⭠, ⭬⭪, ⭲⭰, ⭼⭺, ⮆⮄, ⮊⮈, ⮕⬅, ⮚⮘, ⮞⮜, ⮡⮠, ⮣⮢, ⮩⮨, ⮫⮪, ⮱⮰, ⮳⮲, +⯮⯬, ⸂⸃, ⸃⸂, ⸄⸅, ⸅⸄, ⸉⸊, ⸊⸉, ⸌⸍, ⸍⸌, ⸑⸐, ⸜⸝, ⸝⸜, ⸠⸡, ⸡⸠, ⸢⸣, ⸤⸥, ⸦⸧, ⸨⸩, ⸶⸷, +⹂„, ⹕⹖, ⹗⹘, ⹙⹚, ⹛⹜, ꧁꧂, ﴾﴿, ｢｣, ￫￩, 𝄃𝄂, 𝄆𝄇, 🕻🕽, 🖙🖘, 🖛🖚, 🖝🖜, 🗦🗧, 🠂🠀, 🠆🠄, 🠊🠈, +🠒🠐, 🠖🠔, 🠚🠘, 🠞🠜, 🠢🠠, 🠦🠤, 🠪🠨, 🠮🠬, 🠲🠰, 🠶🠴, 🠺🠸, 🠾🠼, 🡂🡀, 🡆🡄, 🡒🡐, 🡢🡠, 🡪🡨, 🡲🡰, 🡺🡸, +🢂🢀, 🢒🢐, 🢖🢔, 🢚🢘, 🢡🢠, 🢣🢢, 🢥🢦, 🢧🢤, 🢩🢨, 🢫🢪") + +;; --------End of generated code +(defvar cperl-starters cperl--basic-paired-delimiters) (defun cperl-cached-syntax-table (st) "Get a syntax table cached in ST, or create and cache into ST a syntax table. @@ -5672,7 +6024,8 @@ indentation and initial hashes. Behaves usually outside of comment." ;; The following lists are used for categorizing the entries found by ;; `cperl-imenu--create-perl-index'. (defvar cperl-imenu-package-keywords '("package" "class" "role")) -(defvar cperl-imenu-sub-keywords '("sub" "method" "function" "fun")) +(defvar cperl-imenu-sub-keywords '("sub" "method" "function" "fun" + "reader")) ;; for autogenerated (defvar cperl-imenu-pod-keywords '("=head")) (defun cperl-imenu--create-perl-index () @@ -5973,7 +6326,7 @@ functions (which they are not). Inherits from `default'.") (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" (regexp-opt - '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__" + '("CORE" "__FILE__" "__LINE__" "__SUB__" "__PACKAGE__" "__CLASS__" "abs" "accept" "alarm" "and" "atan2" "bind" "binmode" "bless" "caller" "chdir" "chmod" "chown" "chr" "chroot" "close" @@ -6087,7 +6440,7 @@ functions (which they are not). Inherits from `default'.") ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var ;; -------- variable declarations ;; (matcher (subexp facespec) ... - `(,(rx (sequence (or "state" "my" "local" "our" "field")) + `(,(rx (sequence (or "state" "my" "local" "our")) (eval cperl--ws*-rx) (opt (group (sequence "(" (eval cperl--ws*-rx)))) (group @@ -6137,6 +6490,44 @@ functions (which they are not). Inherits from `default'.") (forward-char -2)) ; disable continued expr nil (1 font-lock-variable-name-face))) + ;; -------- builtin constants with and without package prefix + ;; (matcher subexp facespec) + `(,(rx (or space (in "=<>-")) + (group (optional "&") + (optional "builtin::") + (or "inf" "nan") + symbol-end)) + 1 'font-lock-constant-face) + ;; -------- field declarations + `(,(rx "field" + (eval cperl--ws+-rx) + (group (eval cperl--basic-variable-rx)) + (optional (sequence + (eval cperl--ws+-rx) + (group (eval cperl--attribute-list-rx))))) + (1 font-lock-variable-name-face) + ;; -------- optional attributes + ;; (anchored-matcher pre-form post-form subex-highlighters) + (,(rx + (group (optional ":" (eval cperl--ws*-rx)) + (eval cperl--basic-identifier-rx)) + (optional "(" + (group (eval cperl--basic-identifier-rx)) + ")")) + ;; pre-form: Define range for anchored matcher + (if (match-beginning 2) + (progn + (goto-char (match-beginning 2)) + (match-end 2)) + ;; If there's no attribute list in match 2, set a short + ;; limit to the search for the anchored matcher, + ;; otherwise it might interpret stuff from the + ;; initializer expression as attribute. + (1+ (point))) + nil + (1 font-lock-constant-face) + (2 font-lock-string-face nil t) ; lax match, value is optional + )) ;; ----- foreach my $foo ( ;; (matcher subexp facespec) `(,(rx symbol-start "for" (opt "each") @@ -7773,6 +8164,7 @@ x= ... Repetition assignment. \\u Upcase the next character. See also \\U and \\l, ucfirst. \\x Hex character, e.g. \\x1b. ... ^ ... Bitwise exclusive or. +__CLASS__ The class of an object in construction __DATA__ Ends program source. __END__ Ends program source. ADJUST {...} Callback for object creation @@ -8984,6 +9376,24 @@ do extra unwind via `cperl-unwind-to-safe'." "Text property which inhibits refontification.") (make-obsolete-variable 'cperl-do-not-fontify nil "28.1") +;;; Minor mode for optional Perl features +(define-minor-mode cperl-extra-paired-delimiters-mode + "Toggle treatment of extra paired delimiters in Perl. +Many non-ASCII paired delimiters can be used for quote-like constructs +by activating the feature \"extra_paired_delimiters\" either explicitly +or as part of the Perl 5.40 feature bundle. This command allows +`cperl-mode' to recognize the same set of paired delimiters, see the +variable `cperl--extra-paired-delimiters'." + :group 'cperl + :lighter "«»" + :interactive (cperl-mode) + (if cperl-extra-paired-delimiters-mode + (progn + (setq-local cperl-starters cperl--extra-paired-delimiters) + (cperl-find-pods-heres (point-min) (point-max))) + (setq-local cperl-starters cperl--basic-paired-delimiters) + (cperl-find-pods-heres (point-min) (point-max)))) + (provide 'cperl-mode) ;;; cperl-mode.el ends here diff --git a/test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl b/test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl new file mode 100644 index 00000000000..8d2f6397e9d --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/extra-delimiters.pl @@ -0,0 +1,23 @@ +use utf8; + +my $string_with_strange_delimiters = q«a»; +my $printed = 0; + +label: +print $string_with_strange_delimiters; +$printed = 1; + +# With cperl-extra-delimiters-mode=on the previous lines are a label +# and a a print statement. This line here is a comment. Without +# cperl-extra-delimiters-mode, all this is part of the variable +# declaration. + +# Perl will print hist an "a" if called like this: +# perl -M5.040 extra.pl +# ...and, if called without that -M switch, +# perl extra.pl +# will print everything until here: «; + +$printed or print $string_with_strange_delimiters; + +my $sanity = "eventually recovered."; diff --git a/test/lisp/progmodes/cperl-mode-resources/grammar.pl b/test/lisp/progmodes/cperl-mode-resources/grammar.pl index 9420c0d1fa8..14da28b0fd8 100644 --- a/test/lisp/progmodes/cperl-mode-resources/grammar.pl +++ b/test/lisp/progmodes/cperl-mode-resources/grammar.pl @@ -194,4 +194,16 @@ class Class::Class 0.01 { } } +=head1 Perl 5.40 brings new stuff + +The __CLASS__ token (only for fontification) and the :reader +method-generator for classes are available with Perl 5.40. + +=cut + +class With::Readers { + field $simple; + field $auto_reader :reader; + field $named_reader :reader(named); +} 1; diff --git a/test/lisp/progmodes/cperl-mode-resources/perl-class.pl b/test/lisp/progmodes/cperl-mode-resources/perl-class.pl index 032690d20a5..ebcb52c8ffd 100644 --- a/test/lisp/progmodes/cperl-mode-resources/perl-class.pl +++ b/test/lisp/progmodes/cperl-mode-resources/perl-class.pl @@ -16,4 +16,8 @@ class C } } +class D { + field $decorated :param :reader(get_decoration); + field $no_attributes = not_an(attribute) +} say "done!"; diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 9d9718f719c..7c8cc3931bc 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -216,6 +216,39 @@ attributes, prototypes and signatures." 'font-lock-variable-name-face))) (goto-char end-of-sub)))))) +(ert-deftest cperl-test-fontify-builtin-constants () + "Test fontificiation of the floating point constants \"nan\" and \"inf\"." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((constants '("my $min=-builtin::inf;" + "my $unknown = builtin::nan;" + "if ($big == inf) {" + "my $with_ampersand = &inf"))) + (dolist (code constants) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward-regexp "&?\\(builtin::\\)?\\(inf\\|nan\\)") + (should (equal (get-text-property (match-beginning 0) 'face) + 'font-lock-constant-face))))) + ;; Also, test some things that are not these constants + (let ((lookalikes '(("sub inf { ... }" . font-lock-function-name-face) + ("my $inf = 1E6;" . font-lock-variable-name-face) + ("$object->inf;" . cperl-method-call)))) + (dolist (doppelganger lookalikes) + (let ((code (car doppelganger)) + (face (cdr doppelganger))) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + (search-forward-regexp "&?\\(builtin::\\)?\\(inf\\|nan\\)") + (should (equal (get-text-property (match-beginning 0) 'face) + face))))))) + + (ert-deftest cperl-test-fontify-class () "Test fontification of the various elements in a Perl class." (skip-unless (eq cperl-test-mode #'cperl-mode)) @@ -241,6 +274,24 @@ attributes, prototypes and signatures." 'font-lock-variable-name-face)) (should (equal (get-text-property (match-beginning 1) 'face) 'font-lock-variable-name-face)) + ;; Fields + (goto-char (point-min)) + (search-forward-regexp "\\(field\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-keyword-face)) + (search-forward-regexp "\\(decorated\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-variable-name-face)) + (search-forward-regexp "\\(:param\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) + (search-forward-regexp "\\(get_decoration\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-string-face)) + ;; Initializers are no attributes + (search-forward-regexp "\\(not_an\\)") + (should-not (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-constant-face)) ))) (ert-deftest cperl-test-fontify-special-variables () @@ -516,7 +567,7 @@ Also includes valid cases with whitespace in strange places." valid invalid))) (ert-deftest cperl-test-attribute-list-rx () - "Test attributes and attribute lists" + "Test attributes and attribute lists." (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid '(":" ":foo" ": bar()" ":baz(quux):" @@ -533,7 +584,26 @@ Also includes valid cases with whitespace in strange places." (cperl-test--validate-regexp (rx (eval cperl--attribute-list-rx)) valid invalid))) -(ert-deftest cperl-test-prototype-rx () +(ert-deftest cperl-test-field-declaration-rx () + "Test field declarations with and without attributes." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (let ((valid + '("field $fold" + "field @many" + "field %ofStrawberries" + "field $required :param" + "field $renamed :param(alias)" + "field $readable : param reader(get_readable)")) + (invalid + '("field name" ; missing sigil + "field $else::where" ; invalid qualification + "field &code"))) ; invalid sigil + (cperl-test--validate-regexp (rx (eval cperl--field-declaration-rx)) + valid invalid))) + + + + (ert-deftest cperl-test-prototype-rx () "Test subroutine prototypes" (skip-unless (eq cperl-test-mode #'cperl-mode)) (let ((valid @@ -562,6 +632,21 @@ Also includes valid cases with whitespace in strange places." (cperl-test--validate-regexp (rx (eval cperl--signature-rx)) valid invalid))) +(ert-deftest cperl-test-autogenerated-reader-rx () + (let ((code-examples '("field $name :reader;" + "field $field :reader(name);" + "field $name :param :reader;" + "field $field :param :reader(name);" + "field $field :reader(name) :param;" + "field $field :reader(name) = 'value';"))) + (dolist (code code-examples) + (with-temp-buffer + (insert code) + (goto-char (point-min)) + (search-forward-regexp (rx (eval cperl--sub-name-generated-rx))) + (should (string= (match-string 1) "reader")) + (should (string= (match-string 2) "name")))))) + ;;; Test unicode identifier in various places (defun cperl--test-unicode-setup (code string) @@ -604,7 +689,7 @@ point after the first occurrence of STRING (no regexp!)." (goto-char (point-min)) (search-forward "-34") (beginning-of-defun) - (should (looking-at "sub"))))) + (should (looking-at "sub"))))) (ert-deftest cperl-test-unicode-varname () (with-temp-buffer @@ -827,6 +912,41 @@ perl-mode generally does not stringify bareword hash keys." (insert word) (should (string= word (cperl-word-at-point-hard))))))) +(ert-deftest cperl-test-extra-delimiters () + "Test whether cperl-mode can process unicode delimiters. +The minor mode `cperl-extra-paired-delimiters-mode' controls whether we +have extra paired delimiters." + (skip-unless (eq cperl-test-mode #'cperl-mode)) + (with-temp-buffer + (insert-file-contents (ert-resource-file "extra-delimiters.pl")) + (funcall cperl-test-mode) + (cperl-extra-paired-delimiters-mode t) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward-regexp "\\(label:\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-constant-face)) + (search-forward-regexp "\\(comment\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-comment-face)) + (search-forward-regexp "\\(sanity\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-variable-name-face)) + ;; Now switch off the minor mode and redo + (cperl-extra-paired-delimiters-mode -1) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward-regexp "\\(label:\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-string-face)) + (search-forward-regexp "\\(comment\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-string-face)) + (search-forward-regexp "\\(sanity\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + font-lock-variable-name-face)))) + + ;;; Function test: Building an index for imenu (ert-deftest cperl-test-imenu-index () @@ -853,7 +973,9 @@ created by CPerl mode, so skip it for Perl mode." "Package::in_package_again" "Erdős::Number::erdős_number" "Class::Class::init" - "Class::Inner::init_again"))) + "Class::Inner::init_again" + "With::Readers::auto_reader" + "With::Readers::named"))) (dolist (sub expected) (should (assoc-string sub index))))))) -- 2.39.2