Remove XEmacs support from cperl-mode

* lisp/progmodes/cperl-mode.el (condition-case)
(cperl-electric-parens-mark, cperl-del-back-ch)
(cperl-do-not-fontify, cperl-mode, cperl-find-pods-heres)
(cperl-write-tags, cperl-tags-hier-init, cperl-perldoc)
(cperl-build-manpage): Remove XEmacs support.

There's a lot of support code in here for older versions of Emacs that
could be removed, too.

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ba007d67c0d2b6555cbc3ace9d3b22290d3bbc38..254269ddf1ab89f5796f156802d63cfd0303bff0 100644 (file)
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -113,25 +113,10 @@
                 (cperl-make-face ,arg ,descr))
             (or (boundp (quote ,arg)) ; We use unquoted variants too
                 (defvar ,arg (quote ,arg) ,descr))))
-      (if (featurep 'xemacs)
-         (defmacro cperl-etags-snarf-tag (file line)
-           `(progn
-               (beginning-of-line 2)
-               (list ,file ,line)))
-       (defmacro cperl-etags-snarf-tag (_file _line)
-         '(etags-snarf-tag)))
-      (if (featurep 'xemacs)
-         (defmacro cperl-etags-goto-tag-location (elt)
-           ;;(progn
-            ;; (switch-to-buffer (get-file-buffer (elt ,elt 0)))
-            ;; (set-buffer (get-file-buffer (elt ,elt 0)))
-            ;; Probably will not work due to some save-excursion???
-            ;; Or save-file-position?
-            ;; (message "Did I get to line %s?" (elt ,elt 1))
-            `(goto-line (string-to-int (elt ,elt 1))))
-       ;;)
-       (defmacro cperl-etags-goto-tag-location (elt)
-         `(etags-goto-tag-location ,elt))))
+      (defmacro cperl-etags-snarf-tag (_file _line)
+       '(etags-snarf-tag))
+      (defmacro cperl-etags-goto-tag-location (elt)
+       `(etags-goto-tag-location ,elt)))
 
 (defun cperl-choose-color (&rest list)
   (let (answer)
@@ -322,14 +307,7 @@ Can be overwritten by `cperl-hairy' if nil."
   :type '(choice (const null) boolean)
   :group 'cperl-affected-by-hairy)
 
-(defvar zmacs-regions)                 ; Avoid warning
-
-(defcustom cperl-electric-parens-mark
-  (and window-system
-       (or (and (boundp 'transient-mark-mode) ; For Emacs
-               transient-mark-mode)
-          (and (boundp 'zmacs-regions) ; For XEmacs
-               zmacs-regions)))
+(defcustom cperl-electric-parens-mark window-system
   "Not-nil means that electric parens look for active mark.
 Default is yes if there is visual feedback on mark."
   :type 'boolean
@@ -436,9 +414,6 @@ Font for POD headers."
   :type 'face
   :group 'cperl-faces)
 
-;; Some double-evaluation happened with font-locks...  Needed with 21.2...
-(defvar cperl-singly-quote-face (featurep 'xemacs))
-
 (defcustom cperl-invalid-face 'underline
   "Face for highlighting trailing whitespace."
   :type 'face
@@ -972,13 +947,6 @@ In regular expressions (including character classes):
 
 ;;; Portability stuff:
 
-(defmacro cperl-define-key (emacs-key definition &optional xemacs-key)
-  `(define-key cperl-mode-map
-     ,(if xemacs-key
-         `(if (featurep 'xemacs) ,xemacs-key ,emacs-key)
-       emacs-key)
-     ,definition))
-
 (defvar cperl-del-back-ch
   (car (append (where-is-internal 'delete-backward-char)
               (where-is-internal 'backward-delete-char-untabify)))
@@ -990,10 +958,6 @@ In regular expressions (including character classes):
 (defun cperl-putback-char (c)          ; Emacs 19
   (push c unread-command-events))       ; Avoid undefined warning
 
-(if (featurep 'xemacs)
-    (defun cperl-putback-char (c)      ; XEmacs >= 19.12
-      (push (character-to-event c) unread-command-events)))
-
 (defvar cperl-do-not-fontify
   ;; FIXME: This is not doing what it claims!
   (if (string< emacs-version "19.30")
@@ -1664,9 +1628,8 @@ or as help on variables `cperl-tips', `cperl-problems',
        (cperl-val 'cperl-info-on-command-no-prompt))
       (progn
        ;; don't clobber the backspace binding:
-       (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f])
-       (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command
-                         [(control c) (control h) f])))
+       (define-key cperl-mode-map "\C-hf" 'cperl-info-on-current-command)
+       (define-key cperl-mode-map "\C-c\C-hf" 'cperl-info-on-command)))
   (setq local-abbrev-table cperl-mode-abbrev-table)
   (if (cperl-val 'cperl-electric-keywords)
       (abbrev-mode 1))
@@ -1685,8 +1648,6 @@ or as help on variables `cperl-tips', `cperl-problems',
   (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
   (set (make-local-variable 'paragraph-separate) paragraph-start)
   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
-  (if (featurep 'xemacs)
-      (set (make-local-variable 'paren-backwards-message) t))
   (set (make-local-variable 'indent-line-function) #'cperl-indent-line)
   (set (make-local-variable 'require-final-newline) mode-require-final-newline)
   (set (make-local-variable 'comment-start) "# ")
@@ -1717,11 +1678,6 @@ or as help on variables `cperl-tips', `cperl-problems',
   (set (make-local-variable 'imenu-sort-function) nil)
   (set (make-local-variable 'vc-rcs-header) cperl-vc-rcs-header)
   (set (make-local-variable 'vc-sccs-header) cperl-vc-sccs-header)
-  (when (featurep 'xemacs)
-    ;; This one is obsolete...
-    (set (make-local-variable 'vc-header-alist)
-        `((SCCS ,(car cperl-vc-sccs-header))
-          (RCS ,(car cperl-vc-rcs-header)))))
   (cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
         (set (make-local-variable 'compilation-error-regexp-alist-alist)
              (cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
@@ -1761,10 +1717,10 @@ or as help on variables `cperl-tips', `cperl-problems',
        (or (boundp 'font-lock-unfontify-region-function)
            (setq font-lock-unfontify-region-function
                 #'font-lock-default-unfontify-region))
-       (unless (featurep 'xemacs)              ; Our: just a plug for wrong font-lock
-         (set (make-local-variable 'font-lock-unfontify-region-function)
-               ;; not present with old Emacs
-              #'cperl-font-lock-unfontify-region-function))
+       ;; Our: just a plug for wrong font-lock
+       (set (make-local-variable 'font-lock-unfontify-region-function)
+             ;; not present with old Emacs
+            #'cperl-font-lock-unfontify-region-function)
        ;; Reset syntaxification cache.
        (set (make-local-variable 'cperl-syntax-done-to) nil)
        (set (make-local-variable 'font-lock-syntactic-keywords)
@@ -3707,14 +3663,6 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                                  indentable t))
            ;; Need to remove face as well...
            (goto-char min)
-           ;; 'emx not supported by Emacs since at least 21.1.
-           (and (featurep 'xemacs) (eq system-type 'emx)
-                (eq (point) 1)
-                (let ((case-fold-search t))
-                  (looking-at "extproc[ \t]")) ; Analogue of #!
-                (cperl-commentify min
-                                  (point-at-eol)
-                                  nil))
            (while (and
                    (< (point) max)
                    (re-search-forward search max t))
@@ -6933,15 +6881,14 @@ Use as
   (or topdir
       (setq topdir default-directory))
   (let ((tags-file-name "TAGS")
-       (case-fold-search (and (featurep 'xemacs) (eq system-type 'emx)))
+       (case-fold-search nil)
        xs rel)
     (save-excursion
       (cond (inbuffer nil)             ; Already there
            ((file-exists-p tags-file-name)
-            (if (featurep 'xemacs)
-                (visit-tags-table-buffer)
-              (visit-tags-table-buffer tags-file-name)))
-           (t (set-buffer (find-file-noselect tags-file-name))))
+            (visit-tags-table-buffer tags-file-name))
+           (t
+             (set-buffer (find-file-noselect tags-file-name))))
       (cond
        (dir
        (cond ((eq erase 'ignore))
@@ -7081,24 +7028,16 @@ One may build such TAGS files from CPerl mode menu."
            to l1 l2 l3)
        ;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
        (setq cperl-hierarchy (list l1 l2 l3))
-       (if (featurep 'xemacs)          ; Not checked
-           (progn
-             (or tags-file-name
-                 ;; Does this work in XEmacs?
-                 (call-interactively 'visit-tags-table))
-             (message "Updating list of classes...")
-             (set-buffer (get-file-buffer tags-file-name))
-             (cperl-tags-hier-fill))
-         (or tags-table-list
-             (call-interactively 'visit-tags-table))
-         (mapc
-          (function
-           (lambda (tagsfile)
-             (message "Updating list of classes... %s" tagsfile)
-             (set-buffer (get-file-buffer tagsfile))
-             (cperl-tags-hier-fill)))
-          tags-table-list)
-         (message "Updating list of classes... postprocessing..."))
+       (or tags-table-list
+           (call-interactively 'visit-tags-table))
+       (mapc
+        (function
+         (lambda (tagsfile)
+           (message "Updating list of classes... %s" tagsfile)
+           (set-buffer (get-file-buffer tagsfile))
+           (cperl-tags-hier-fill)))
+        tags-table-list)
+       (message "Updating list of classes... postprocessing...")
        (mapc remover (car cperl-hierarchy))
        (mapc remover (nth 1 cperl-hierarchy))
        (setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy))
@@ -8450,15 +8389,7 @@ the appropriate statement modifier."
                                  'variable-documentation))))
         (Man-switches "")
         (manual-program (if is-func "perldoc -f" "perldoc")))
-    (cond
-     ((featurep 'xemacs)
-      (defvar Manual-program)
-      (defvar Manual-switches)
-      (let ((Manual-program "perldoc")
-           (Manual-switches (if is-func (list "-f"))))
-       (manual-entry word)))
-     (t
-      (Man-getpage-in-background word)))))
+    (Man-getpage-in-background word)))
 
 ;;;###autoload
 (defun cperl-perldoc-at-point ()
@@ -8493,15 +8424,9 @@ the appropriate statement modifier."
   "Create a virtual manpage in Emacs from the POD in the file."
   (interactive)
   (require 'man)
-  (cond
-   ((featurep 'xemacs)
-    (defvar Manual-program)
-    (let ((Manual-program "perldoc"))
-      (manual-entry buffer-file-name)))
-   (t
-    (let* ((manual-program "perldoc")
-          (Man-switches ""))
-      (Man-getpage-in-background buffer-file-name)))))
+  (let ((manual-program "perldoc")
+       (Man-switches ""))
+    (Man-getpage-in-background buffer-file-name)))
 
 (defun cperl-pod2man-build-command ()
   "Builds the entire background manpage and cleaning command."