Remove some compat code from cperl-mode.el

* lisp/progmodes/cperl-mode.el: Remove old-Emacs compat code.

1 files changed, 24 insertions, 88 deletions

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 3c06d230950..5d4cf96d4c4 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -77,43 +77,17 @@
 
 (eval-when-compile (require 'cl-lib))
 
+(defvar msb-menu-cond)
+(defvar gud-perldb-history)
 (defvar vc-rcs-header)
 (defvar vc-sccs-header)
 
-(eval-when-compile
-      (condition-case nil
-          (require 'custom)
-        (error nil))
-      (condition-case nil
-          (require 'man)
-        (error nil))
-      (defvar msb-menu-cond)
-      (defvar gud-perldb-history)
-      (defmacro cperl-is-face (arg)     ; Takes quoted arg
-        (cond ((fboundp 'find-face)
-               `(find-face ,arg))
-              (;;(and (fboundp 'face-list)
-               ;;       (face-list))
-               (fboundp 'face-list)
-               `(member ,arg (and (fboundp 'face-list)
-                                  (face-list))))
-              (t
-               `(boundp ,arg))))
-      (defmacro cperl-make-face (arg descr) ; Takes unquoted arg
-        (cond ((fboundp 'make-face)
-               `(make-face (quote ,arg)))
-              (t
-               `(defvar ,arg (quote ,arg) ,descr))))
-      (defmacro cperl-force-face (arg descr) ; Takes unquoted arg
-        `(progn
-             (or (cperl-is-face (quote ,arg))
-                 (cperl-make-face ,arg ,descr))
-             (or (boundp (quote ,arg)) ; We use unquoted variants too
-                 (defvar ,arg (quote ,arg) ,descr))))
-      (defmacro cperl-etags-snarf-tag (_file _line)
-        '(etags-snarf-tag))
-      (defmacro cperl-etags-goto-tag-location (elt)
-        `(etags-goto-tag-location ,elt)))
+(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)
@@ -5788,10 +5762,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
                 font-lock-variable-name-face)      ; Just to put something
               t)
              ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
-              (1 cperl-array-face)
+              (1 'cperl-array-face)
               (2 font-lock-variable-name-face))
              ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
-              (1 cperl-hash-face)
+              (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
@@ -5907,10 +5881,6 @@ indentation and initial hashes.  Behaves usually outside of comment."
                             "Face for comments")
           (cperl-force-face font-lock-function-name-face
                             "Face for function names")
-          (cperl-force-face cperl-hash-face
-                            "Face for hashes")
-          (cperl-force-face cperl-array-face
-                            "Face for arrays")
           ;;(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)
@@ -5922,16 +5892,16 @@ indentation and initial hashes.  Behaves usually outside of comment."
           ;;    'cperl-nonoverridable-face
           ;;    "Face to use for data types from another group."))
           (if (and
-               (not (cperl-is-face 'cperl-array-face))
-               (cperl-is-face 'font-lock-emphasized-face))
+               (not (facep 'cperl-array-face))
+               (facep 'font-lock-emphasized-face))
               (copy-face 'font-lock-emphasized-face 'cperl-array-face))
           (if (and
-               (not (cperl-is-face 'cperl-hash-face))
-               (cperl-is-face 'font-lock-other-emphasized-face))
+               (not (facep 'cperl-hash-face))
+               (facep 'font-lock-other-emphasized-face))
               (copy-face 'font-lock-other-emphasized-face 'cperl-hash-face))
           (if (and
-               (not (cperl-is-face 'cperl-nonoverridable-face))
-               (cperl-is-face 'font-lock-other-type-face))
+               (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
@@ -5942,10 +5912,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
           ;;    'cperl-array-face
           ;;    "Face to use for arrays."))
           (let ((background 'light))
-            (and (not (cperl-is-face 'font-lock-constant-face))
-                 (cperl-is-face 'font-lock-reference-face)
+            (and (not (facep 'font-lock-constant-face))
+                 (facep 'font-lock-reference-face)
                  (copy-face 'font-lock-reference-face 'font-lock-constant-face))
-            (if (cperl-is-face 'font-lock-type-face) nil
+            (if (facep 'font-lock-type-face) nil
               (copy-face 'default 'font-lock-type-face)
               (cond
                ((eq background 'light)
@@ -5960,7 +5930,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
                                        "pink")))
                (t
                 (set-face-background 'font-lock-type-face "gray90"))))
-            (if (cperl-is-face 'cperl-nonoverridable-face)
+            (if (facep 'cperl-nonoverridable-face)
                 nil
               (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
               (cond
@@ -5974,43 +5944,9 @@ 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-variable-name-face) nil
+            (if (facep 'font-lock-variable-name-face) nil
               (copy-face 'italic 'font-lock-variable-name-face))
-            (if (cperl-is-face 'font-lock-constant-face) nil
+            (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))))
@@ -6961,7 +6897,7 @@ Use as
                   file (file-of-tag)
                   fileind (format "%s:%s" file line)
                   ;; Moves to beginning of the next line:
-                  info (cperl-etags-snarf-tag file line))
+                  info (etags-snarf-tag))
             ;; Move back
             (forward-char -1)
             ;; Make new member of hierarchy name ==> file ==> pos if needed
@@ -7033,7 +6969,7 @@ One may build such TAGS files from CPerl mode menu."
   (if (vectorp update)
       (progn
         (find-file (elt update 0))
-        (cperl-etags-goto-tag-location (elt update 1))))
+        (etags-goto-tag-location (elt update 1))))
   (if (eq update -999) (cperl-tags-hier-init t)))
 
 (defun cperl-tags-treeify (to level)