* 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.

1 files 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 <https://www.gnu.org/licenses/>.
 
-;;; 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 <Nick.Roberts@src.bae.co.uk> (with changes)
+;; By Nick Roberts <Nick.Roberts@src.bae.co.uk> (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...")