From: Lars Ingebrigtsen Date: Sat, 19 Oct 2019 09:31:58 +0000 (+0200) Subject: Remove some compat code from cperl-mode.el X-Git-Tag: emacs-27.0.90~987 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=842cc05d5ca5e54aef5c455a92203fd512e89202;p=emacs.git Remove some compat code from cperl-mode.el * lisp/progmodes/cperl-mode.el: Remove old-Emacs compat code. --- 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)