diff options
Diffstat (limited to 'lisp/progmodes/cperl-mode.el')
| -rw-r--r-- | lisp/progmodes/cperl-mode.el | 481 |
1 files changed, 155 insertions, 326 deletions
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5fee2df5863..a42ace105aa 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -7,6 +7,7 @@ ;; Jonathan Rockway <jon@jrock.us> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: languages, Perl +;; Package-Requires: ((emacs "26.1")) ;; This file is part of GNU Emacs. @@ -32,7 +33,7 @@ ;; support. ;; The latest version is available from -;; http://github.com/jrockway/cperl-mode +;; https://github.com/jrockway/cperl-mode ;; ;; (perhaps in the moosex-declare branch) @@ -47,6 +48,10 @@ ;; DO NOT FORGET to read micro-docs (available from `Perl' menu) <<<<<< ;; or as help on variables `cperl-tips', `cperl-problems', <<<<<< ;; `cperl-praise', `cperl-speed'. <<<<<< +;; +;; Or search for "Short extra-docs" further down in this file for +;; details on how to use `cperl-mode' instead of `perl-mode' and lots +;; of other details. ;; The mode information (on C-h m) provides some customization help. ;; If you use font-lock feature of this mode, it is advisable to use @@ -66,15 +71,28 @@ ;; (define-key global-map [M-S-down-mouse-3] 'imenu) -;;;; Font lock bugs as of v4.32: - -;; The following kinds of Perl code erroneously start strings: -;; \$` \$' \$" -;; $opt::s $opt_s $opt{s} (s => ...) /\s+.../ -;; likewise with m, tr, y, q, qX instead of s - ;;; Code: +;;; Compatibility with older versions (for publishing on ELPA) +;; The following helpers allow cperl-mode.el to work with older +;; versions of Emacs. +;; +;; Whenever the minimum version is bumped (see "Package-Requires" +;; above), please eliminate the corresponding compatibility-helpers. +;; Whenever you create a new compatibility-helper, please add it here. + +;; Available in Emacs 27.1: time-convert +(defalias 'cperl--time-convert + (if (fboundp 'time-convert) 'time-convert + 'encode-time)) + +;; Available in Emacs 28: format-prompt +(defalias 'cperl--format-prompt + (if (fboundp 'format-prompt) 'format-prompt + (lambda (msg default) + (if default (format "%s (default %s): " msg default) + (concat msg ": "))))) + (eval-when-compile (require 'cl-lib)) (defvar msb-menu-cond) @@ -82,13 +100,6 @@ (defvar vc-rcs-header) (defvar vc-sccs-header) -(defmacro cperl-force-face (arg descr) ; Takes unquoted arg - `(progn - (or (facep (quote ,arg)) - (make-face ,arg)) - (or (boundp (quote ,arg)) ; We use unquoted variants too - (defvar ,arg (quote ,arg) ,descr)))) - (defun cperl-choose-color (&rest list) (let (answer) (while list @@ -451,8 +462,7 @@ Older version of this page was called `perl5', newer `perl'." :type 'string :group 'cperl-help-system) -(defcustom cperl-use-syntax-table-text-property - (boundp 'parse-sexp-lookup-properties) +(defcustom cperl-use-syntax-table-text-property t "Non-nil means CPerl sets up and uses `syntax-table' text property." :type 'boolean :group 'cperl-speed) @@ -535,8 +545,7 @@ One should tune up `cperl-close-paren-offset' as well." :type 'boolean :group 'cperl-indentation-details) -(defcustom cperl-syntaxify-by-font-lock - (boundp 'parse-sexp-lookup-properties) +(defcustom cperl-syntaxify-by-font-lock t "Non-nil means that CPerl uses the `font-lock' routines for syntaxification." :type '(choice (const message) boolean) :group 'cperl-speed) @@ -665,10 +674,6 @@ micro-docs on what I know about CPerl problems.") (defvar cperl-problems 'please-ignore-this-line "Description of problems in CPerl mode. -Some faces will not be shown on some versions of Emacs unless you -install choose-color.el, available from - http://ilyaz.org/software/emacs - `fill-paragraph' on a comment may leave the point behind the paragraph. It also triggers a bug in some versions of Emacs (CPerl tries to detect it and bulk out). @@ -816,7 +821,7 @@ capable syntax engines). (defvar cperl-speed 'please-ignore-this-line "This is an incomplete compendium of what is available in other parts -of CPerl documentation. (Please inform me if I skept anything.) +of CPerl documentation. (Please inform me if I skipped anything.) There is a perception that CPerl is slower than alternatives. This part of documentation is designed to overcome this misconception. @@ -1081,10 +1086,6 @@ versions of Emacs." (define-key map [(control ?c) (control ?h) ?v] ;;(concat (char-to-string help-char) "v") ; does not work 'cperl-get-help)) - (or (boundp 'fill-paragraph-function) - (substitute-key-definition - 'fill-paragraph 'cperl-fill-paragraph - map global-map)) (substitute-key-definition 'indent-sexp 'cperl-indent-exp map global-map) @@ -1240,6 +1241,7 @@ versions of Emacs." ["Auto fill" auto-fill-mode t]) ("Indent styles..." ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] ["GNU" (cperl-set-style "GNU") t] ["C++" (cperl-set-style "C++") t] @@ -1306,7 +1308,7 @@ the last)." cperl-maybe-white-and-comment-rex ; whitespace-comments "\\(\\sw\\|_\\)+" ; attr-name ;; attr-arg (1 level of internal parens allowed!) - "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?" + "\\((\\(\\\\.\\|[^\\()]\\|([^\\()]*)\\)*)\\)?" "\\(" ; optional : (XXX allows trailing???) cperl-maybe-white-and-comment-rex ; whitespace-comments ":\\)?" @@ -1406,7 +1408,7 @@ the last)." (defvar cperl-font-locking nil) ;; NB as it stands the code in cperl-mode assumes this only has one -;; element. If XEmacs 19 support were dropped, this could all be simplified. +;; element. Since XEmacs 19 support has been dropped, this could all be simplified. (defvar cperl-compilation-error-regexp-alist ;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS). '(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]" @@ -1559,12 +1561,12 @@ Variables controlling indentation style: `cperl-min-label-indent' Minimal indentation for line that is a label. -Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith - `cperl-indent-level' 5 4 2 4 - `cperl-brace-offset' 0 0 0 0 - `cperl-continued-brace-offset' -5 -4 0 0 - `cperl-label-offset' -5 -4 -2 -4 - `cperl-continued-statement-offset' 5 4 2 4 +Settings for classic indent-styles: K&R BSD=C++ GNU PBP PerlStyle=Whitesmith + `cperl-indent-level' 5 4 2 4 4 + `cperl-brace-offset' 0 0 0 0 0 + `cperl-continued-brace-offset' -5 -4 0 0 0 + `cperl-label-offset' -5 -4 -2 -2 -4 + `cperl-continued-statement-offset' 5 4 2 4 4 CPerl knows several indentation styles, and may bulk set the corresponding variables. Use \\[cperl-set-style] to do this. Use @@ -1604,6 +1606,9 @@ or as help on variables `cperl-tips', `cperl-problems', (if (cperl-val 'cperl-electric-keywords) (abbrev-mode 1)) (set-syntax-table cperl-mode-syntax-table) + ;; Workaround for Bug#30393, needed for Emacs 26. + (when (< emacs-major-version 27) + (setq-local open-paren-in-column-0-is-defun-start nil)) ;; Until Emacs is multi-threaded, we do not actually need it local: (make-local-variable 'cperl-font-lock-multiline-start) (make-local-variable 'cperl-font-locking) @@ -1637,9 +1642,8 @@ or as help on variables `cperl-tips', `cperl-problems', "\\)" cperl-maybe-white-and-comment-rex)) (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent) - (and (boundp 'fill-paragraph-function) - (set (make-local-variable 'fill-paragraph-function) - #'cperl-fill-paragraph)) + (set (make-local-variable 'fill-paragraph-function) + #'cperl-fill-paragraph) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'indent-region-function) #'cperl-indent-region) ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off! @@ -1701,13 +1705,8 @@ or as help on variables `cperl-tips', `cperl-problems', ;; to make font-lock think that font-lock-syntactic-keywords ;; are defined. '(t))))) - (if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities - (progn - (setq cperl-font-lock-multiline t) ; Not localized... - (set (make-local-variable 'font-lock-multiline) t)) - (set (make-local-variable 'font-lock-fontify-region-function) - ;; not present with old Emacs - #'cperl-font-lock-fontify-region-function)) + (setq cperl-font-lock-multiline t) ; Not localized... + (set (make-local-variable 'font-lock-multiline) t) (set (make-local-variable 'font-lock-fontify-region-function) #'cperl-font-lock-fontify-region-function) (make-local-variable 'cperl-old-style) @@ -1726,10 +1725,9 @@ or as help on variables `cperl-tips', `cperl-problems', (if cperl-hook-after-change (add-hook 'after-change-functions #'cperl-after-change-function nil t)) ;; After hooks since fontification will break this - (if cperl-pod-here-scan - (or cperl-syntaxify-by-font-lock - (progn (or cperl-faces-init (cperl-init-faces-weak)) - (cperl-find-pods-heres)))) + (when (and cperl-pod-here-scan + (not cperl-syntaxify-by-font-lock)) + (cperl-find-pods-heres)) ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) @@ -3253,8 +3251,8 @@ Return the error message (if any). Does not work if delimiter is `)'. Works before syntax recognition is done." ;; Works *before* syntax recognition is done (or st-l (setq st-l (list nil))) ; Avoid overwriting '() - (let (st b reset-st) - (condition-case b + (let (st result reset-st) + (condition-case err (progn (setq st (cperl-cached-syntax-table st-l)) (modify-syntax-entry ?\( "()" st) @@ -3262,8 +3260,7 @@ Works before syntax recognition is done." (setq reset-st (syntax-table)) (set-syntax-table st) (forward-sexp 1)) - (error (message - "cperl-forward-group-in-re: error %s" b))) + (error (setq result err))) ;; now restore the initial state (if st (progn @@ -3271,12 +3268,9 @@ Works before syntax recognition is done." (modify-syntax-entry ?\) "." st))) (if reset-st (set-syntax-table reset-st)) - b)) + result)) -(defvar font-lock-string-face) -;;(defvar font-lock-reference-face) -(defvar font-lock-constant-face) (defsubst cperl-postpone-fontification (b e type val &optional now) ;; Do after syntactic fontification? (if cperl-syntaxify-by-font-lock @@ -3342,16 +3336,6 @@ Works before syntax recognition is done." (setq end (point))))) (or end pos))))) -;; These are needed for byte-compile (at least with v19) -(defvar cperl-nonoverridable-face) -(defvar font-lock-variable-name-face) -(defvar font-lock-function-name-face) -(defvar font-lock-keyword-face) -(defvar font-lock-builtin-face) -(defvar font-lock-type-face) -(defvar font-lock-comment-face) -(defvar font-lock-warning-face) - (defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos) "Syntactically mark (and fontify) attributes of a subroutine. Should be called with the point before leading colon of an attribute." @@ -3457,8 +3441,8 @@ Should be called with the point before leading colon of an attribute." (match-beginning 4) (match-end 4) 'face dashface)) ;; save match data (for looking-at) - (setq lll (mapcar (function (lambda (elt) (cons (match-beginning elt) - (match-end elt)))) + (setq lll (mapcar (lambda (elt) (cons (match-beginning elt) + (match-end elt))) l)) (while lll (setq ll (car lll)) @@ -3560,19 +3544,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\`\n?\\|^\n\\)=" ; POD "\\|" ;; One extra () before this: - "<<~?" ; HERE-DOC - "\\(" ; 1 + 1 + "<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2 + "\\(" ; 2 + 1 ;; First variant "BLAH" or just ``. "[ \t]*" ; Yes, whitespace is allowed! - "\\([\"'`]\\)" ; 2 + 1 = 3 - "\\([^\"'`\n]*\\)" ; 3 + 1 - "\\3" + "\\([\"'`]\\)" ; 3 + 1 = 4 + "\\([^\"'`\n]*\\)" ; 4 + 1 + "\\4" "\\|" ;; Second variant: Identifier or \ID (same as 'ID') or empty - "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 + "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1 ;; Do not have <<= or << 30 or <<30 or << $blah. ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 - "\\(\\)" ; To preserve count of pars :-( 6 + 1 "\\)" "\\|" ;; 1+6 extra () before this: @@ -3762,11 +3745,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 ;; "\\)" - ((match-beginning 2) ; 1 + 1 + ((match-beginning 3) ; 2 + 1 (setq b (point) tb (match-beginning 0) c (and ; not HERE-DOC - (match-beginning 5) + (match-beginning 6) (save-match-data (or (looking-at "[ \t]*(") ; << function_call() (save-excursion ; 1 << func_name, or $foo << 10 @@ -3793,17 +3776,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>"))) (error t))))))) (error nil))) ; func(<<EOF) - (and (not (match-beginning 6)) ; Empty + (and (not (match-beginning 7)) ; Empty (looking-at "[ \t]*[=0-9$@%&(]")))))) (if c ; Not here-doc nil ; Skip it. - (setq c (match-end 2)) ; 1 + 1 - (if (match-beginning 5) ;4 + 1 - (setq b1 (match-beginning 5) ; 4 + 1 - e1 (match-end 5)) ; 4 + 1 - (setq b1 (match-beginning 4) ; 3 + 1 - e1 (match-end 4))) ; 3 + 1 + (setq c (match-end 3)) ; 2 + 1 + (if (match-beginning 6) ;6 + 1 + (setq b1 (match-beginning 6) ; 5 + 1 + e1 (match-end 6)) ; 5 + 1 + (setq b1 (match-beginning 5) ; 4 + 1 + e1 (match-end 5))) ; 4 + 1 (setq tag (buffer-substring b1 e1) qtag (regexp-quote tag)) (cond (cperl-pod-here-fontify @@ -3818,8 +3801,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq b (point)) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (and (re-search-forward (concat "^[ \t]*" qtag "$") - stop-point 'toend) + (or (and (re-search-forward + (concat "^" (when (equal (match-string 2) "~") "[ \t]*") + qtag "$") + stop-point 'toend) ;;;(eq (following-char) ?\n) ; XXXX WHY??? ) (progn ; Pretend we matched at the end @@ -3978,6 +3963,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (and (eq (preceding-char) ?.) (eq (char-after (- (point) 2)) ?.)) (bobp)) + ;; { $a++ / $b } doesn't start a regex, nor does $a-- + (not (and (memq (preceding-char) '(?+ ?-)) + (eq (preceding-char) (char-before (1- (point)))))) ;; m|blah| ? foo : bar; (not (and (eq c ?\?) @@ -4494,7 +4482,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', 'syntax-table cperl-st-cfence)))) (setq was-subgr nil)) (t ; (?#)-comment - ;; Inside "(" and "\" arn't special in any way + ;; Inside "(" and "\" aren't special in any way ;; Works also if the outside delimiters are (). (or;;(if (eq (char-after b) ?\) ) ;;(re-search-forward @@ -4828,9 +4816,10 @@ conditional/loop constructs." (while (< (point) tmp-end) (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol (or (eolp) (forward-sexp 1))) - (if (> (point) tmp-end) ; Yes, there an unfinished block + (if (> (point) tmp-end) ; Check for an unfinished block nil (if (eq ?\) (preceding-char)) + ;; closing parens can be preceded by up to three sexps (progn ;; Plan B: find by REGEXP block followup this line (setq top (point)) (condition-case nil @@ -4851,7 +4840,9 @@ conditional/loop constructs." (progn (goto-char top) (forward-sexp 1) - (setq top (point))))) + (setq top (point))) + ;; no block to be processed: expression ends here + (setq done t))) (error (setq done t))) (goto-char top)) (if (looking-at ; Try Plan C: continuation block @@ -4884,7 +4875,7 @@ Returns some position at the last line." ;; }? continue ;; blah; } (if (not - (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|until\\)") + (or (looking-at "[ \t]*\\(els\\(e\\|if\\)\\|continue\\|if\\|while\\|for\\(each\\)?\\|unless\\|until\\)\\_>") (setq have-brace (save-excursion (search-forward "}" ee t))))) nil ; Do not need to do anything ;; Looking at: @@ -4892,7 +4883,7 @@ Returns some position at the last line." ;; else (if cperl-merge-trailing-else (if (looking-at - "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\_>") (progn (search-forward "}") (setq p (point)) @@ -4900,7 +4891,7 @@ Returns some position at the last line." (delete-region p (point)) (insert (make-string cperl-indent-region-fix-constructs ?\s)) (beginning-of-line))) - (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\_>") (save-excursion (search-forward "}") (delete-horizontal-space) @@ -4912,7 +4903,7 @@ Returns some position at the last line." (setq ret (point))))))) ;; Looking at: ;; } else - (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") + (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\_>") (progn (search-forward "}") (delete-horizontal-space) @@ -5447,8 +5438,7 @@ indentation and initial hashes. Behaves usually outside of comment." (cond ((featurep 'ps-print) (or cperl-faces-init (progn - (and (boundp 'font-lock-multiline) - (setq cperl-font-lock-multiline t)) + (setq cperl-font-lock-multiline t) (cperl-init-faces)))) ((not cperl-faces-init) (add-hook 'font-lock-mode-hook @@ -5480,27 +5470,12 @@ indentation and initial hashes. Behaves usually outside of comment." (or cperl-faces-init (cperl-init-faces)) cperl-font-lock-keywords-2) -(defun cperl-init-faces-weak () - ;; Allow `cperl-find-pods-heres' to run. - (or (boundp 'font-lock-constant-face) - (cperl-force-face font-lock-constant-face - "Face for constant and label names")) - (or (boundp 'font-lock-warning-face) - (cperl-force-face font-lock-warning-face - "Face for things which should stand out")) - ;;(setq font-lock-constant-face 'font-lock-constant-face) - ) - (defun cperl-init-faces () (condition-case errs (progn (require 'font-lock) - (and (fboundp 'font-lock-fontify-anchored-keywords) - (featurep 'font-lock-extra) - (message "You have an obsolete package `font-lock-extra'. Install `choose-color'.")) (let (t-font-lock-keywords t-font-lock-keywords-1 font-lock-anchored) - (if (fboundp 'font-lock-fontify-anchored-keywords) - (setq font-lock-anchored t)) + (setq font-lock-anchored t) (setq t-font-lock-keywords (list @@ -5622,7 +5597,7 @@ indentation and initial hashes. Behaves usually outside of comment." "wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually "\\|[sm]" ; Added manually "\\)\\>") - 2 'cperl-nonoverridable-face) + 2 ''cperl-nonoverridable-face) ; unbound as var, so: doubly quoted ;; (mapconcat #'identity ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" ;; "#include" "#define" "#undef") @@ -5658,17 +5633,13 @@ indentation and initial hashes. Behaves usually outside of comment." 2 font-lock-function-name-face) '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) - (cond ((featurep 'font-lock-extra) - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" - (2 font-lock-string-face t) - (0 '(restart 2 t)))) ; To highlight $a{bc}{ef} - (font-lock-anchored - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (cond (font-lock-anchored + '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" nil nil (1 font-lock-string-face t)))) - (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (t '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 2 font-lock-string-face t))) '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) @@ -5680,15 +5651,7 @@ indentation and initial hashes. Behaves usually outside of comment." ;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) ;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" ;;; (2 (cons font-lock-variable-name-face '(underline)))) - (cond ((featurep 'font-lock-extra) - '("^[ \t]*\\(state\\|my\\|local\\|our\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" - (3 font-lock-variable-name-face) - (4 '(another 4 nil - ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)\\([ \t]*,\\)?" - (1 font-lock-variable-name-face) - (2 '(restart 2 nil) nil t))) - nil t))) ; local variables, multiple - (font-lock-anchored + (cond (font-lock-anchored ;; 1=my_etc, 2=white? 3=(+white? 4=white? 5=var `(,(concat "\\<\\(state\\|my\\|local\\|our\\)" cperl-maybe-white-and-comment-rex @@ -5752,7 +5715,7 @@ indentation and initial hashes. Behaves usually outside of comment." (if (eq (char-after (match-beginning 2)) ?%) 'cperl-hash-face 'cperl-array-face) - t) ; arrays and hashes + nil) ; arrays and hashes ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 1 (if (= (- (match-end 2) (match-beginning 2)) 1) @@ -5787,167 +5750,9 @@ indentation and initial hashes. Behaves usually outside of comment." t-font-lock-keywords) cperl-font-lock-keywords cperl-font-lock-keywords-1 cperl-font-lock-keywords-2 (append - cperl-font-lock-keywords-1 - t-font-lock-keywords-1))) + t-font-lock-keywords-1 + cperl-font-lock-keywords-1))) (if (fboundp 'ps-print-buffer) (cperl-ps-print-init)) - (if (or (featurep 'choose-color) (featurep 'font-lock-extra)) - (eval ; Avoid a warning - '(font-lock-require-faces - (list - ;; Color-light Color-dark Gray-light Gray-dark Mono - (list 'font-lock-comment-face - ["Firebrick" "OrangeRed" "DimGray" "Gray80"] - nil - [nil nil t t t] - [nil nil t t t] - nil) - (list 'font-lock-string-face - ["RosyBrown" "LightSalmon" "Gray50" "LightGray"] - nil - nil - [nil nil t t t] - nil) - (list 'font-lock-function-name-face - (vector - "Blue" "LightSkyBlue" "Gray50" "LightGray" - (cdr (assq 'background-color ; if mono - (frame-parameters)))) - (vector - nil nil nil nil - (cdr (assq 'foreground-color ; if mono - (frame-parameters)))) - [nil nil t t t] - nil - nil) - (list 'font-lock-variable-name-face - ["DarkGoldenrod" "LightGoldenrod" "DimGray" "Gray90"] - nil - [nil nil t t t] - [nil nil t t t] - nil) - (list 'font-lock-type-face - ["DarkOliveGreen" "PaleGreen" "DimGray" "Gray80"] - nil - [nil nil t t t] - nil - [nil nil t t t]) - (list 'font-lock-warning-face - ["Pink" "Red" "Gray50" "LightGray"] - ["gray20" "gray90" - "gray80" "gray20"] - [nil nil t t t] - nil - [nil nil t t t] - ) - (list 'font-lock-constant-face - ["CadetBlue" "Aquamarine" "Gray50" "LightGray"] - nil - [nil nil t t t] - nil - [nil nil t t t]) - (list 'cperl-nonoverridable-face - ["chartreuse3" ("orchid1" "orange") - nil "Gray80"] - [nil nil "gray90"] - [nil nil nil t t] - [nil nil t t] - [nil nil t t t]) - (list 'cperl-array-face - ["blue" "yellow" nil "Gray80"] - ["lightyellow2" ("navy" "os2blue" "darkgreen") - "gray90"] - t - nil - nil) - (list 'cperl-hash-face - ["red" "red" nil "Gray80"] - ["lightyellow2" ("navy" "os2blue" "darkgreen") - "gray90"] - t - t - nil)))) - ;; Do it the dull way, without choose-color - (cperl-force-face font-lock-constant-face - "Face for constant and label names") - (cperl-force-face font-lock-variable-name-face - "Face for variable names") - (cperl-force-face font-lock-type-face - "Face for data types") - (cperl-force-face cperl-nonoverridable-face - "Face for data types from another group") - (cperl-force-face font-lock-warning-face - "Face for things which should stand out") - (cperl-force-face font-lock-comment-face - "Face for comments") - (cperl-force-face font-lock-function-name-face - "Face for function names") - ;;(defvar font-lock-constant-face 'font-lock-constant-face) - ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) - ;;(or (boundp 'font-lock-type-face) - ;; (defconst font-lock-type-face - ;; 'font-lock-type-face - ;; "Face to use for data types.")) - ;;(or (boundp 'cperl-nonoverridable-face) - ;; (defconst cperl-nonoverridable-face - ;; 'cperl-nonoverridable-face - ;; "Face to use for data types from another group.")) - (if (and - (not (facep 'cperl-array-face)) - (facep 'font-lock-emphasized-face)) - (copy-face 'font-lock-emphasized-face 'cperl-array-face)) - (if (and - (not (facep 'cperl-hash-face)) - (facep 'font-lock-other-emphasized-face)) - (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face)) - (if (and - (not (facep 'cperl-nonoverridable-face)) - (facep 'font-lock-other-type-face)) - (copy-face 'font-lock-other-type-face 'cperl-nonoverridable-face)) - ;;(or (boundp 'cperl-hash-face) - ;; (defconst cperl-hash-face - ;; 'cperl-hash-face - ;; "Face to use for hashes.")) - ;;(or (boundp 'cperl-array-face) - ;; (defconst cperl-array-face - ;; 'cperl-array-face - ;; "Face to use for arrays.")) - (let ((background 'light)) - (and (not (facep 'font-lock-constant-face)) - (facep 'font-lock-reference-face) - (copy-face 'font-lock-reference-face 'font-lock-constant-face)) - (if (facep 'font-lock-type-face) nil - (copy-face 'default 'font-lock-type-face) - (cond - ((eq background 'light) - (set-face-foreground 'font-lock-type-face - (if (x-color-defined-p "seagreen") - "seagreen" - "sea green"))) - ((eq background 'dark) - (set-face-foreground 'font-lock-type-face - (if (x-color-defined-p "os2pink") - "os2pink" - "pink"))) - (t - (set-face-background 'font-lock-type-face "gray90")))) - (if (facep 'cperl-nonoverridable-face) - nil - (copy-face 'font-lock-type-face 'cperl-nonoverridable-face) - (cond - ((eq background 'light) - (set-face-foreground 'cperl-nonoverridable-face - (if (x-color-defined-p "chartreuse3") - "chartreuse3" - "chartreuse"))) - ((eq background 'dark) - (set-face-foreground 'cperl-nonoverridable-face - (if (x-color-defined-p "orchid1") - "orchid1" - "orange"))))) - (if (facep 'font-lock-variable-name-face) nil - (copy-face 'italic 'font-lock-variable-name-face)) - (if (facep 'font-lock-constant-face) nil - (copy-face 'italic 'font-lock-constant-face)))) (setq cperl-faces-init t)) (error (message "cperl-init-faces (ignored): %s" errs)))) @@ -6057,7 +5862,19 @@ if (foo) { stop; } -### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil +### PBP (=Perl Best Practices) 4/0/0/-4/4/nil/nil +if (foo) { + bar + baz; + label: + { + boon; + } +} +else { + stop; +} +### PerlStyle (=CPerl with 4 as indent) 4/0/0/-2/4/t/nil if (foo) { bar baz; @@ -6160,6 +5977,19 @@ else (cperl-extra-newline-before-brace-multiline . nil) (cperl-merge-trailing-else . t)) + ("PBP" ;; Perl Best Practices by Damian Conway + (cperl-indent-level . 4) + (cperl-brace-offset . 0) + (cperl-continued-brace-offset . 0) + (cperl-label-offset . -2) + (cperl-continued-statement-offset . 4) + (cperl-close-paren-offset . -4) + (cperl-extra-newline-before-brace . nil) + (cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . nil) + (cperl-indent-parens-as-block . t) + (cperl-tab-always-indent . t)) + ("PerlStyle" ; CPerl with 4 as indent (cperl-indent-level . 4) (cperl-brace-offset . 0) @@ -6231,7 +6061,8 @@ See examples in `cperl-style-examples'.") "Set CPerl mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles -are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. +are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" +and \"Whitesmith\". The current value of style is memorized (unless there is a memorized data already), may be restored by `cperl-set-style-back'. @@ -6317,8 +6148,7 @@ Customized by setting variables `cperl-shrink-wrap-info-frame', (interactive (let* ((default (cperl-word-at-point)) (read (read-string - (format "Find doc for Perl function (default %s): " - default)))) + (cperl--format-prompt "Find doc for Perl function" default)))) (list (if (equal read "") default read)))) @@ -6499,9 +6329,10 @@ If optional argument ALL is `recursive', will process Perl files in subdirectories too." (interactive) (let ((cmd "etags") - (args '("-l" "none" "-r" + (args `("-l" "none" "-r" ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) - "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/" + ,(concat + "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/") "-r" "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/" "-r" @@ -6786,6 +6617,7 @@ Use as (or topdir (setq topdir default-directory)) (let ((tags-file-name "TAGS") + (inhibit-read-only t) (case-fold-search nil) xs rel) (save-excursion @@ -6851,7 +6683,7 @@ Use as (insert (cperl-find-tags file xs topdir)))))) (if inbuffer nil ; Delegate to the caller (save-buffer 0) ; No backup - (if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs? + (if (fboundp 'initialize-new-tags-table) (initialize-new-tags-table)))))) (defvar cperl-tags-hier-regexp-list @@ -6926,10 +6758,10 @@ One may build such TAGS files from CPerl mode menu." (require 'etags) (require 'imenu) (if (or update (null (nth 2 cperl-hierarchy))) - (let ((remover (function (lambda (elt) ; (name (file1...) (file2..)) - (or (nthcdr 2 elt) - ;; Only in one file - (setcdr elt (cdr (nth 1 elt))))))) + (let ((remover (lambda (elt) ; (name (file1...) (file2..)) + (or (nthcdr 2 elt) + ;; Only in one file + (setcdr elt (cdr (nth 1 elt)))))) to l1 l2 l3) ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later! (setq cperl-hierarchy (list l1 l2 l3)) @@ -7009,33 +6841,33 @@ One may build such TAGS files from CPerl mode menu." (setq ord 2) (mapc move-deeper methods) (if recurse - (mapc (function (lambda (elt) - (cperl-tags-treeify elt (1+ level)))) + (mapc (lambda (elt) + (cperl-tags-treeify elt (1+ level))) (cdr to))) ;;Now clean up leaders with one child only - (mapc (function (lambda (elt) - (if (not (and (listp (cdr elt)) - (eq (length elt) 2))) - nil - (setcar elt (car (nth 1 elt))) - (setcdr elt (cdr (nth 1 elt)))))) + (mapc (lambda (elt) + (if (not (and (listp (cdr elt)) + (eq (length elt) 2))) + nil + (setcar elt (car (nth 1 elt))) + (setcdr elt (cdr (nth 1 elt))))) (cdr to)) ;; Sort the roots of subtrees (if (default-value 'imenu-sort-function) (setcdr to (sort (cdr to) (default-value 'imenu-sort-function)))) ;; Now add back functions removed from display - (mapc (function (lambda (elt) - (setcdr to (cons elt (cdr to))))) + (mapc (lambda (elt) + (setcdr to (cons elt (cdr to)))) (if (default-value 'imenu-sort-function) (nreverse (sort root-functions (default-value 'imenu-sort-function))) root-functions)) ;; Now add back packages removed from display - (mapc (function (lambda (elt) - (setcdr to (cons (cons (concat "package " (car elt)) - (cdr elt)) - (cdr to))))) + (mapc (lambda (elt) + (setcdr to (cons (cons (concat "package " (car elt)) + (cdr elt)) + (cdr to)))) (if (default-value 'imenu-sort-function) (nreverse (sort root-packages (default-value 'imenu-sort-function))) @@ -8275,10 +8107,7 @@ the appropriate statement modifier." (interactive (list (let* ((default-entry (cperl-word-at-point)) (input (read-string - (format "perldoc entry%s: " - (if (string= default-entry "") - "" - (format " (default %s)" default-entry)))))) + (cperl--format-prompt "perldoc entry" default-entry)))) (if (string= input "") (if (string= default-entry "") (error "No perldoc args given") @@ -8382,11 +8211,11 @@ a result of qr//, this is not a performance hit), t for the rest." (and (eq (get-text-property beg 'syntax-type) 'string) (setq beg (next-single-property-change beg 'syntax-type nil limit))) (cperl-map-pods-heres - (function (lambda (s _e _p) - (if (memq (get-text-property s 'REx-interpolated) skip) - t - (setq pp s) - nil))) ; nil stops + (lambda (s _e _p) + (if (memq (get-text-property s 'REx-interpolated) skip) + t + (setq pp s) + nil)) ; nil stops 'REx-interpolated beg limit) (if pp (goto-char pp) (message "No more interpolated REx")))) @@ -8505,7 +8334,7 @@ start with default arguments, then refine the slowdown regions." (or l (setq l 1)) (or step (setq step 500)) (or lim (setq lim 40)) - (let* ((timems (function (lambda () (car (time-convert nil 1000))))) + (let* ((timems (lambda () (car (cperl--time-convert nil 1000)))) (tt (funcall timems)) (c 0) delta tot) (goto-char (point-min)) (forward-line (1- l)) |