From 168382db92d7ab9b8d7997b0bb91165b338e41e6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 22 Dec 2017 10:06:49 -0500 Subject: [PATCH] * lisp/progmodes/cperl-mode.el: Use cl-lib. Fix comment convention (defgroup, defcustom, defface, x-color-defined-p, uncomment-region) (ps-extend-face-list, eval-after-load, turn-on-font-lock): Assume defined. (cperl-calculate-indent): Use 'functionp' to test if a value is a function. --- lisp/progmodes/cperl-mode.el | 343 ++++++++++++++++++------------------------- 1 file changed, 143 insertions(+), 200 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 64ee8c1b7e6..c4f1ff2ec76 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -23,7 +23,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org +;; Corrections made by Ilya Zakharevich ilyaz@cpan.org ;;; Commentary: @@ -66,7 +66,7 @@ ;; (define-key global-map [M-S-down-mouse-3] 'imenu) -;;; Font lock bugs as of v4.32: +;;;; Font lock bugs as of v4.32: ;; The following kinds of Perl code erroneously start strings: ;; \$` \$' \$" @@ -75,6 +75,8 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defvar vc-rcs-header) (defvar vc-sccs-header) @@ -90,24 +92,6 @@ (defvar font-lock-background-mode) ; not in Emacs (defvar font-lock-display-type) ; ditto (defvar paren-backwards-message) ; Not in newer XEmacs? - (or (fboundp 'defgroup) - (defmacro defgroup (_name _val _doc &rest _) - nil)) - (or (fboundp 'custom-declare-variable) - (defmacro defcustom (name val doc &rest _) - `(defvar ,name ,val ,doc))) - (or (fboundp 'custom-declare-variable) - (defmacro defface (&rest _) - nil)) - ;; Avoid warning (tmp definitions) - (or (fboundp 'x-color-defined-p) - (defmacro x-color-defined-p (col) - (cond ((fboundp 'color-defined-p) `(color-defined-p ,col)) - ;; XEmacs >= 19.12 - ((fboundp 'valid-color-name-p) `(valid-color-name-p ,col)) - ;; XEmacs 19.11 - ((fboundp 'x-valid-color-name-p) `(x-valid-color-name-p ,col)) - (t '(error "Cannot implement color-defined-p"))))) (defmacro cperl-is-face (arg) ; Takes quoted arg (cond ((fboundp 'find-face) `(find-face ,arg)) @@ -224,10 +208,10 @@ for constructs with multiline if/unless/while/until/for/foreach condition." :type 'integer :group 'cperl-indentation-details) -;; Is is not unusual to put both things like perl-indent-level and -;; cperl-indent-level in the local variable section of a file. If only +;; It is not unusual to put both things like perl-indent-level and +;; cperl-indent-level in the local variable section of a file. If only ;; one of perl-mode and cperl-mode is in use, a warning will be issued -;; about the variable. Autoload these here, so that no warning is +;; about the variable. Autoload these here, so that no warning is ;; issued when using either perl-mode or cperl-mode. ;;;###autoload(put 'cperl-indent-level 'safe-local-variable 'integerp) ;;;###autoload(put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -459,7 +443,7 @@ Font for POD headers." :type 'face :group 'cperl-faces) -;;; Some double-evaluation happened with font-locks... Needed with 21.2... +;; Some double-evaluation happened with font-locks... Needed with 21.2... (defvar cperl-singly-quote-face (featurep 'xemacs)) (defcustom cperl-invalid-face 'underline @@ -1017,11 +1001,6 @@ In regular expressions (including character classes): (defun cperl-putback-char (c) ; XEmacs >= 19.12 (push (character-to-event c) unread-command-events))) -(or (fboundp 'uncomment-region) - (defun uncomment-region (beg end) - (interactive "r") - (comment-region beg end -1))) - (defvar cperl-do-not-fontify ;; FIXME: This is not doing what it claims! (if (string< emacs-version "19.30") @@ -1079,20 +1058,7 @@ versions of Emacs." ;; (setq interpreter-mode-alist (append interpreter-mode-alist ;; '(("miniperl" . perl-mode)))))) (eval-when-compile - (mapc (lambda (p) - (condition-case nil - (require p) - (error nil))) - '(imenu easymenu etags timer man info)) - (if (fboundp 'ps-extend-face-list) - (defmacro cperl-ps-extend-face-list (arg) - `(ps-extend-face-list ,arg)) - (defmacro cperl-ps-extend-face-list (_) - `(error "This version of Emacs has no `ps-extend-face-list'"))) - ;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs, - ;; macros instead of defsubsts don't work on Emacs, so we do the - ;; expansion manually. Any other suggestions? - (require 'cl)) + (mapc #'require '(imenu easymenu etags timer man info))) (define-abbrev-table 'cperl-mode-abbrev-table ;; FIXME: Use a separate abbrev table for that, enabled conditionally, @@ -1299,15 +1265,15 @@ versions of Emacs." ["Class Hierarchy from TAGS" cperl-tags-hier-init t] ;;["Update classes" (cperl-tags-hier-init t) tags-table-list] ("Tags" -;;; ["Create tags for current file" cperl-etags t] -;;; ["Add tags for current file" (cperl-etags t) t] -;;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] -;;; ["Add tags for Perl files in directory" (cperl-etags t t) t] -;;; ["Create tags for Perl files in (sub)directories" -;;; (cperl-etags nil 'recursive) t] -;;; ["Add tags for Perl files in (sub)directories" -;;; (cperl-etags t 'recursive) t]) -;;;; cperl-write-tags (&optional file erase recurse dir inbuffer) + ;; ["Create tags for current file" cperl-etags t] + ;; ["Add tags for current file" (cperl-etags t) t] + ;; ["Create tags for Perl files in directory" (cperl-etags nil t) t] + ;; ["Add tags for Perl files in directory" (cperl-etags t t) t] + ;; ["Create tags for Perl files in (sub)directories" + ;; (cperl-etags nil 'recursive) t] + ;; ["Add tags for Perl files in (sub)directories" + ;; (cperl-etags t 'recursive) t]) + ;; ;;? cperl-write-tags (&optional file erase recurse dir inbuffer) ["Create tags for current file" (cperl-write-tags nil t) t] ["Add tags for current file" (cperl-write-tags) t] ["Create tags for Perl files in directory" @@ -1366,12 +1332,12 @@ versions of Emacs." The expansion is entirely correct because it uses the C preprocessor." t) -;;; These two must be unwound, otherwise take exponential time +;; These two must be unwound, otherwise take exponential time (defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*" "Regular expression to match optional whitespace with interspersed comments. Should contain exactly one group.") -;;; This one is tricky to unwind; still very inefficient... +;; This one is tricky to unwind; still very inefficient... (defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+" "Regular expression to match whitespace with interspersed comments. Should contain exactly one group.") @@ -1425,13 +1391,13 @@ the last)." (defun cperl-char-ends-sub-keyword-p (char) "Return T if CHAR is the last character of a perl sub keyword." - (loop for keyword in cperl-sub-keywords - when (eq char (aref keyword (1- (length keyword)))) - return t)) + (cl-loop for keyword in cperl-sub-keywords + when (eq char (aref keyword (1- (length keyword)))) + return t)) -;;; Details of groups in this are used in `cperl-imenu--create-perl-index' -;;; and `cperl-outline-level'. -;;;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) +;; Details of groups in this are used in `cperl-imenu--create-perl-index' +;; and `cperl-outline-level'. +;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3) (defvar cperl-imenu--function-name-regexp-perl (concat "^\\(" ; 1 = all @@ -1914,24 +1880,24 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-make-indent comment-column 1) ; Indent min 1 c))))) -;;;(defun cperl-comment-indent-fallback () -;;; "Is called if the standard comment-search procedure fails. -;;;Point is at start of real comment." -;;; (let ((c (current-column)) target cnt prevc) -;;; (if (= c comment-column) nil -;;; (setq cnt (skip-chars-backward "[ \t]")) -;;; (setq target (max (1+ (setq prevc -;;; (current-column))) ; Else indent at comment column -;;; comment-column)) -;;; (if (= c comment-column) nil -;;; (delete-backward-char cnt) -;;; (while (< prevc target) -;;; (insert "\t") -;;; (setq prevc (current-column))) -;;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) -;;; (while (< prevc target) -;;; (insert " ") -;;; (setq prevc (current-column))))))) +;;(defun cperl-comment-indent-fallback () +;; "Is called if the standard comment-search procedure fails. +;;Point is at start of real comment." +;; (let ((c (current-column)) target cnt prevc) +;; (if (= c comment-column) nil +;; (setq cnt (skip-chars-backward "[ \t]")) +;; (setq target (max (1+ (setq prevc +;; (current-column))) ; Else indent at comment column +;; comment-column)) +;; (if (= c comment-column) nil +;; (delete-backward-char cnt) +;; (while (< prevc target) +;; (insert "\t") +;; (setq prevc (current-column))) +;; (if (> prevc target) (progn (delete-char -1) (setq prevc (current-column)))) +;; (while (< prevc target) +;; (insert " ") +;; (setq prevc (current-column))))))) (defun cperl-indent-for-comment () "Substitute for `indent-for-comment' in CPerl." @@ -2647,17 +2613,17 @@ PRESTART is the position basing on which START was found." (defun cperl-beginning-of-property (p prop &optional lim) "Given that P has a property PROP, find where the property starts. Will not look before LIM." - ;;; XXXX What to do at point-max??? +;;; XXXX What to do at point-max??? (or (previous-single-property-change (cperl-1+ p) prop lim) (point-min)) -;;; (cond ((eq p (point-min)) -;;; p) -;;; ((and lim (<= p lim)) -;;; p) -;;; ((not (get-text-property (1- p) prop)) -;;; p) -;;; (t (or (previous-single-property-change p look-prop lim) -;;; (point-min)))) + ;; (cond ((eq p (point-min)) + ;; p) + ;; ((and lim (<= p lim)) + ;; p) + ;; ((not (get-text-property (1- p) prop)) + ;; p) + ;; (t (or (previous-single-property-change p look-prop lim) + ;; (point-min)))) ) (defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start @@ -2968,7 +2934,7 @@ and closing parentheses and brackets." (cond (what (let ((action (cadr what))) - (cond ((fboundp action) (apply action (list i parse-data))) + (cond ((functionp action) (apply action (list i parse-data))) ((numberp action) (+ action (current-indentation))) (t action)))) ;; @@ -3392,8 +3358,8 @@ Works before syntax recognition is done." (or now (put-text-property b e 'cperl-postpone (cons type val))) (put-text-property b e type val))) -;;; Here is how the global structures (those which cannot be -;;; recognized locally) are marked: +;; Here is how the global structures (those which cannot be +;; recognized locally) are marked: ;; a) PODs: ;; Start-to-end is marked `in-pod' ==> t ;; Each non-literal part is marked `syntax-type' ==> `pod' @@ -3413,8 +3379,8 @@ Works before syntax recognition is done." ;; (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'. ;; f) Multiline my/our declaration lists etc: `syntax-type' => `multiline' -;;; In addition, some parts of RExes may be marked as `REx-interpolated' -;;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). +;; In addition, some parts of RExes may be marked as `REx-interpolated' +;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise). (defun cperl-unwind-to-safe (before &optional end) ;; if BEFORE, go to the previous start-of-line on each step of unwinding @@ -3451,7 +3417,7 @@ Works before syntax recognition is done." (setq end (point))))) (or end pos))))) -;;; These are needed for byte-compile (at least with v19) +;; 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) @@ -3586,7 +3552,7 @@ Should be called with the point before leading colon of an attribute." (goto-char endbracket) ; just in case something misbehaves??? t)) -;;; Debugging this may require (setq max-specpdl-size 2000)... +;; Debugging this may require (setq max-specpdl-size 2000)... (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) "Scans the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify @@ -4489,7 +4455,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq REx-subgr-end qtag) ;End smart-highlighted ;; Apparently, I can't put \] into a charclass ;; in m]]: m][\\\]\]] produces [\\]] -;;; POSIX? [:word:] [:^word:] only inside [] +;;; POSIX? [:word:] [:^word:] only inside [] ;;; "\\=\\(\\\\.\\|[^][\\\\]\\|\\[:\\^?\sw+:]\\|\\[[^:]\\)*]") (while ; look for unescaped ] (and argument @@ -4769,12 +4735,12 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (forward-sexp -1) (looking-at (concat cperl-sub-regexp "[ \t\n\f#]")))))))))) -;;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? -;;; No save-excursion; condition-case ... In (cperl-block-p) the block -;;; may be a part of an in-statement construct, such as -;;; ${something()}, print {FH} $data. -;;; Moreover, one takes positive approach (looks for else,grep etc) -;;; another negative (looks for bless,tr etc) +;; What is the difference of (cperl-after-block-p lim t) and (cperl-block-p)? +;; No save-excursion; condition-case ... In (cperl-block-p) the block +;; may be a part of an in-statement construct, such as +;; ${something()}, print {FH} $data. +;; Moreover, one takes positive approach (looks for else,grep etc) +;; another negative (looks for bless,tr etc) (defun cperl-after-block-p (lim &optional pre-block) "Return true if the preceding } (if PRE-BLOCK, following {) delimits a block. Would not look before LIM. Assumes that LIM is a good place to begin a @@ -5551,7 +5517,7 @@ indentation and initial hashes. Behaves usually outside of comment." (defun cperl-outline-level () (looking-at outline-regexp) (cond ((not (match-beginning 1)) 0) ; beginning-of-file -;;;; 2=package-group, 5=package-name 8=sub-name 16=head-level + ;; 2=package-group, 5=package-name 8=sub-name 16=head-level ((match-beginning 2) 0) ; package ((match-beginning 8) 1) ; sub ((match-beginning 16) @@ -5574,10 +5540,9 @@ indentation and initial hashes. Behaves usually outside of comment." (if (memq major-mode '(perl-mode cperl-mode)) (progn (or cperl-faces-init (cperl-init-faces))))))) - (if (fboundp 'eval-after-load) - (eval-after-load - "ps-print" - '(or cperl-faces-init (cperl-init-faces))))))) + (eval-after-load + "ps-print" + '(or cperl-faces-init (cperl-init-faces)))))) (defvar cperl-font-lock-keywords-1 nil "Additional expressions to highlight in Perl mode. Minimal set.") @@ -5626,6 +5591,7 @@ indentation and initial hashes. Behaves usually outside of comment." (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" + ;; FIXME: Use regexp-opt. (mapconcat #'identity (append @@ -5647,6 +5613,7 @@ indentation and initial hashes. Behaves usually outside of comment." (list (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" + ;; FIXME: Use regexp-opt. ;; "CORE" "__FILE__" "__LINE__" "__SUB__" "abs" "accept" "alarm" ;; "and" "atan2" "bind" "binmode" "bless" "caller" ;; "chdir" "chmod" "chown" "chr" "chroot" "close" @@ -5863,41 +5830,34 @@ indentation and initial hashes. Behaves usually outside of comment." '("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) (setq t-font-lock-keywords-1 - (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock - ;; not yet as of XEmacs 19.12, works with 21.1.11 - (or - (not (featurep 'xemacs)) - (string< "21.1.9" emacs-version) - (and (string< "21.1.10" emacs-version) - (string< emacs-version "21.1.2"))) - '( - ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 - (if (eq (char-after (match-beginning 2)) ?%) - 'cperl-hash-face - 'cperl-array-face) - t) ; arrays and hashes - ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" - 1 - (if (= (- (match-end 2) (match-beginning 2)) 1) - (if (eq (char-after (match-beginning 3)) ?{) - 'cperl-hash-face - 'cperl-array-face) ; arrays and hashes - font-lock-variable-name-face) ; Just to put something - t) - ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" - (1 cperl-array-face) - (2 font-lock-variable-name-face)) - ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" - (1 cperl-hash-face) - (2 font-lock-variable-name-face)) - ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") - ;;; Too much noise from \s* @s[ and friends - ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" - ;;(3 font-lock-function-name-face t t) - ;;(4 - ;; (if (cperl-slash-is-regexp) - ;; font-lock-function-name-face 'default) nil t)) - ))) + '( + ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 + (if (eq (char-after (match-beginning 2)) ?%) + 'cperl-hash-face + 'cperl-array-face) + t) ; arrays and hashes + ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" + 1 + (if (= (- (match-end 2) (match-beginning 2)) 1) + (if (eq (char-after (match-beginning 3)) ?{) + 'cperl-hash-face + 'cperl-array-face) ; arrays and hashes + font-lock-variable-name-face) ; Just to put something + t) + ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-array-face) + (2 font-lock-variable-name-face)) + ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-hash-face) + (2 font-lock-variable-name-face)) +;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") +;;; Too much noise from \s* @s[ and friends + ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" + ;;(3 font-lock-function-name-face t t) + ;;(4 + ;; (if (cperl-slash-is-regexp) + ;; font-lock-function-name-face 'default) nil t)) + )) (if cperl-highlight-variables-indiscriminately (setq t-font-lock-keywords-1 (append t-font-lock-keywords-1 @@ -5992,13 +5952,6 @@ indentation and initial hashes. Behaves usually outside of comment." ;; Do it the dull way, without choose-color (defvar cperl-guessed-background nil "Display characteristics as guessed by cperl.") - ;; (or (fboundp 'x-color-defined-p) - ;; (defalias 'x-color-defined-p - ;; (cond ((fboundp 'color-defined-p) 'color-defined-p) - ;; ;; XEmacs >= 19.12 - ;; ((fboundp 'valid-color-name-p) 'valid-color-name-p) - ;; ;; XEmacs 19.11 - ;; (t 'x-valid-color-name-p)))) (cperl-force-face font-lock-constant-face "Face for constant and label names") (cperl-force-face font-lock-variable-name-face @@ -6064,16 +6017,7 @@ indentation and initial hashes. Behaves usually outside of comment." (let ((background (if (boundp 'font-lock-background-mode) font-lock-background-mode - 'light)) - ;; (face-list (and (fboundp 'face-list) (face-list))) - ) - ;; (fset 'cperl-is-face - ;; (cond ((fboundp 'find-face) - ;; (symbol-function 'find-face)) - ;; (face-list - ;; (function (lambda (face) (member face face-list)))) - ;; (t - ;; (function (lambda (face) (boundp face)))))) + 'light))) (defvar cperl-guessed-background (if (and (boundp 'font-lock-display-type) (eq font-lock-display-type 'grayscale)) @@ -6112,40 +6056,40 @@ indentation and initial hashes. Behaves usually outside of comment." (if (x-color-defined-p "orchid1") "orchid1" "orange"))))) -;;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil -;;; (copy-face 'bold-italic 'font-lock-other-emphasized-face) -;;; (cond -;;; ((eq background 'light) -;;; (set-face-background 'font-lock-other-emphasized-face -;;; (if (x-color-defined-p "lightyellow2") -;;; "lightyellow2" -;;; (if (x-color-defined-p "lightyellow") -;;; "lightyellow" -;;; "light yellow")))) -;;; ((eq background 'dark) -;;; (set-face-background 'font-lock-other-emphasized-face -;;; (if (x-color-defined-p "navy") -;;; "navy" -;;; (if (x-color-defined-p "darkgreen") -;;; "darkgreen" -;;; "dark green")))) -;;; (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) -;;; (if (cperl-is-face 'font-lock-emphasized-face) nil -;;; (copy-face 'bold 'font-lock-emphasized-face) -;;; (cond -;;; ((eq background 'light) -;;; (set-face-background 'font-lock-emphasized-face -;;; (if (x-color-defined-p "lightyellow2") -;;; "lightyellow2" -;;; "lightyellow"))) -;;; ((eq background 'dark) -;;; (set-face-background 'font-lock-emphasized-face -;;; (if (x-color-defined-p "navy") -;;; "navy" -;;; (if (x-color-defined-p "darkgreen") -;;; "darkgreen" -;;; "dark green")))) -;;; (t (set-face-background 'font-lock-emphasized-face "gray90")))) + ;; (if (cperl-is-face 'font-lock-other-emphasized-face) nil + ;; (copy-face 'bold-italic 'font-lock-other-emphasized-face) + ;; (cond + ;; ((eq background 'light) + ;; (set-face-background 'font-lock-other-emphasized-face + ;; (if (x-color-defined-p "lightyellow2") + ;; "lightyellow2" + ;; (if (x-color-defined-p "lightyellow") + ;; "lightyellow" + ;; "light yellow")))) + ;; ((eq background 'dark) + ;; (set-face-background 'font-lock-other-emphasized-face + ;; (if (x-color-defined-p "navy") + ;; "navy" + ;; (if (x-color-defined-p "darkgreen") + ;; "darkgreen" + ;; "dark green")))) + ;; (t (set-face-background 'font-lock-other-emphasized-face "gray90")))) + ;; (if (cperl-is-face 'font-lock-emphasized-face) nil + ;; (copy-face 'bold 'font-lock-emphasized-face) + ;; (cond + ;; ((eq background 'light) + ;; (set-face-background 'font-lock-emphasized-face + ;; (if (x-color-defined-p "lightyellow2") + ;; "lightyellow2" + ;; "lightyellow"))) + ;; ((eq background 'dark) + ;; (set-face-background 'font-lock-emphasized-face + ;; (if (x-color-defined-p "navy") + ;; "navy" + ;; (if (x-color-defined-p "darkgreen") + ;; "darkgreen" + ;; "dark green")))) + ;; (t (set-face-background 'font-lock-emphasized-face "gray90")))) (if (cperl-is-face 'font-lock-variable-name-face) nil (copy-face 'italic 'font-lock-variable-name-face)) (if (cperl-is-face 'font-lock-constant-face) nil @@ -6194,7 +6138,7 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." (require 'ps-print) ; To get ps-print-face-extension-alist (let ((ps-print-color-p t) (ps-print-face-extension-alist ps-print-face-extension-alist)) - (cperl-ps-extend-face-list cperl-ps-print-face-properties) + (ps-extend-face-list cperl-ps-print-face-properties) (ps-print-buffer-with-faces file))) ;; (defun cperl-ps-print-init () @@ -7171,8 +7115,7 @@ One may build such TAGS files from CPerl mode menu." (setq update ;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy)) (if (if (fboundp 'display-popup-menus-p) - (let ((f 'display-popup-menus-p)) - (funcall f)) + (display-popup-menus-p) window-system) (x-popup-menu t (nth 2 cperl-hierarchy)) (require 'tmm) @@ -8529,7 +8472,7 @@ the appropriate statement modifier." :type 'file :group 'cperl) -;;; By Nick Roberts (with changes) +;; By Nick Roberts (with changes) (defun cperl-pod-to-manpage () "Create a virtual manpage in Emacs from the Perl Online Documentation." (interactive) @@ -8546,7 +8489,7 @@ the appropriate statement modifier." (format (cperl-pod2man-build-command) pod2man-args)) 'Man-bgproc-sentinel))))) -;;; Updated version by him too +;; Updated version by him too (defun cperl-build-manpage () "Create a virtual manpage in Emacs from the POD in the file." (interactive) @@ -8619,7 +8562,7 @@ a result of qr//, this is not a performance hit), t for the rest." (if pp (goto-char pp) (message "No more interpolated REx")))) -;;; Initial version contributed by Trey Belew +;; Initial version contributed by Trey Belew (defun cperl-here-doc-spell () "Spell-check HERE-documents in the Perl buffer. If a region is highlighted, restricts to the region." @@ -8668,7 +8611,7 @@ function returns nil." (setq cont (funcall func pos posend prop))) (setq pos posend))))) -;;; Based on code by Masatake YAMATO: +;; Based on code by Masatake YAMATO: (defun cperl-get-here-doc-region (&optional pos pod) "Return HERE document region around the point. Return nil if the point is not in a HERE document region. If POD is non-nil, @@ -8857,7 +8800,7 @@ do extra unwind via `cperl-unwind-to-safe'." (font-lock-default-fontify-region beg end loudly)) (defvar cperl-d-l nil) -(defvar edebug-backtrace-buffer) +(defvar edebug-backtrace-buffer) ;FIXME: Why? (defun cperl-fontify-syntaxically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") -- 2.11.4.GIT