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.

1 files changed, 29 insertions, 104 deletions

diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index ba007d67c0d..254269ddf1a 100644
--- 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."