[Emacs-diffs] master 842cc05: Remove some compat code from cperl-mode.el

[Lars Ingebrigtsen]

branch: master
commit 842cc05d5ca5e54aef5c455a92203fd512e89202
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Remove some compat code from cperl-mode.el
    
    * lisp/progmodes/cperl-mode.el: Remove old-Emacs compat code.
---
 lisp/progmodes/cperl-mode.el | 112 ++++++++++---------------------------------
 1 file changed, 24 insertions(+), 88 deletions(-)

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 3c06d23..5d4cf96 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)