comparison lisp/progmodes/cperl-mode.el @ 85762:29e75576e47f

* calc/calc.el (calc-emacs-type-lucid): Remove. (calc-digit-map, calcDigit-start, calc-read-key) (calc-clear-unread-commands): * calc/calc-ext.el (calc-user-key-map): Replace uses of calc-emacs-type-lucid with (featurep 'xemacs) * emulation/tpu-mapper.el: Replace tpu-lucid-emacs19-p with (featurep 'xemacs). (tpu-lucid-emacs19-p): Remove. (tpu-map-key): Make it a function instead of using fset. Inline tpu-emacs-map-key and tpu-lucid-map-key. Use featurep 'xemacs. (tpu-emacs-map-key, tpu-lucid-map-key): Remove. * ielm.el: Use featurep 'xemacs. * progmodes/cperl-mode.el (cperl-xemacs-p): Remove. (condition-case, cperl-can-font-lock, cperl-singly-quote-face) (cperl-define-key, cperl-mode-map, cperl-mode, cperl-init-faces) (cperl-write-tags, cperl-tags-hier-init, cperl-perldoc): Replace cperl-xemacs-p with (featurep 'xemacs). (font-lock-cache-position): Pacify byte compiler.

85761:7d711fbfe5b5

	  (require 'custom)
	(error nil))
      (condition-case nil
	  (require 'man)
	(error nil))
      (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
      (defvar cperl-can-font-lock
	(or cperl-xemacs-p
	    (and (boundp 'emacs-major-version)
		 (or window-system
		     (> emacs-major-version 20)))))
      (if cperl-can-font-lock
	  (require 'font-lock))

	`(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))))
      (if cperl-xemacs-p
	  (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 cperl-xemacs-p
	  (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???

            `(goto-line (string-to-int (elt ,elt 1))))
	;;)
	(defmacro cperl-etags-goto-tag-location (elt)
	  `(etags-goto-tag-location ,elt))))

(defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))

(defvar cperl-can-font-lock
  (or cperl-xemacs-p
      (and (boundp 'emacs-major-version)
	   (or window-system
	       (> emacs-major-version 20)))))

(defun cperl-choose-color (&rest list)

  "*Face for here-docs highlighting."
  :type 'face
  :group 'cperl-faces)

;;; Some double-evaluation happened with font-locks...  Needed with 21.2...
(defvar cperl-singly-quote-face cperl-xemacs-p)

(defcustom cperl-invalid-face 'underline
  "*Face for highlighting trailing whitespace."
  :type 'face
  :version "21.1"

;;; Portability stuff:

(defmacro cperl-define-key (emacs-key definition &optional xemacs-key)
  `(define-key cperl-mode-map
     ,(if xemacs-key
	  `(if cperl-xemacs-p ,xemacs-key ,emacs-key)
	emacs-key)
     ,definition))

(defvar cperl-del-back-ch
  (car (append (where-is-internal 'delete-backward-char)

(and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1)
     (setq cperl-del-back-ch (aref cperl-del-back-ch 0)))

(defun cperl-mark-active () (mark))	; Avoid undefined warning
(if cperl-xemacs-p
    (progn
      ;; "Active regions" are on: use region only if active
      ;; "Active regions" are off: use region unconditionally
      (defun cperl-use-region-p ()
	(if zmacs-regions (mark) t)))

  cperl-can-font-lock)

(defun cperl-putback-char (c)		; Emacs 19
  (set 'unread-command-events (list c))) ; Avoid undefined warning

(if cperl-xemacs-p
    (defun cperl-putback-char (c)	; XEmacs >= 19.12
      (setq unread-command-events (list (eval '(character-to-event c))))))

(or (fboundp 'uncomment-region)
    (defun uncomment-region (beg end)

		      [(control c) (control h) f])
    (cperl-define-key "\C-c\C-hv"
		      ;;(concat (char-to-string help-char) "v") ; does not work
		      'cperl-get-help
		      [(control c) (control h) v]))
  (if (and cperl-xemacs-p
	   (<= emacs-minor-version 11) (<= emacs-major-version 19))
      (progn
	;; substitute-key-definition is usefulness-deenhanced...
	;;;;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
	(cperl-define-key "\e;" 'cperl-indent-for-comment)

  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
  (if cperl-xemacs-p
    (progn
      (make-local-variable 'paren-backwards-message)
      (set 'paren-backwards-message t)))
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'cperl-indent-line)

	(set 'parse-sexp-lookup-properties t)
	;; Fix broken font-lock:
	(or (boundp 'font-lock-unfontify-region-function)
	    (set 'font-lock-unfontify-region-function
		 'font-lock-default-unfontify-region))
	(unless cperl-xemacs-p		; Our: just a plug for wrong font-lock
	  (make-local-variable 'font-lock-unfontify-region-function)
	  (set 'font-lock-unfontify-region-function ; not present with old Emacs
	       'cperl-font-lock-unfontify-region-function))
	(make-local-variable 'cperl-syntax-done-to)
	(setq cperl-syntax-done-to nil)	; reset syntaxification cache

	  (setq
	   t-font-lock-keywords-1
	   (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
		;; not yet as of XEmacs 19.12, works with 21.1.11
		(or
		 (not cperl-xemacs-p)
		 (string< "21.1.9" emacs-version)
		 (and (string< "21.1.10" emacs-version)
		      (string< emacs-version "21.1.2")))
		'(
		  ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1

	  ;;	"Face to use for data types."))
	  ;;(or (boundp 'cperl-nonoverridable-face)
	  ;;    (defconst cperl-nonoverridable-face
	  ;;	'cperl-nonoverridable-face
	  ;;	"Face to use for data types from another group."))
	  ;;(if (not cperl-xemacs-p) nil
	  ;;  (or (boundp 'font-lock-comment-face)
	  ;;	(defconst font-lock-comment-face
	  ;;	  'font-lock-comment-face
	  ;;	  "Face to use for comments."))
	  ;;  (or (boundp 'font-lock-keyword-face)

	(case-fold-search (eq system-type 'emx))
	xs rel tm)
    (save-excursion
      (cond (inbuffer nil)		; Already there
	    ((file-exists-p tags-file-name)
	     (if cperl-xemacs-p
		 (visit-tags-table-buffer)
	       (visit-tags-table-buffer tags-file-name)))
	    (t (set-buffer (find-file-noselect tags-file-name))))
      (cond
       (dir

				     ;; Only in one file
				     (setcdr elt (cdr (nth 1 elt)))))))
	    pack name cons1 to l1 l2 l3 l4 b)
	;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
	(setq cperl-hierarchy (list l1 l2 l3))
	(if cperl-xemacs-p		; Not checked
	    (progn
	      (or tags-file-name
		  ;; Does this work in XEmacs?
	    (call-interactively 'visit-tags-table))
	(message "Updating list of classes...")

				 (documentation-property
				  'cperl-short-docs
				  'variable-documentation))))
	 (manual-program (if is-func "perldoc -f" "perldoc")))
    (cond
     (cperl-xemacs-p
      (let ((Manual-program "perldoc")
	    (Manual-switches (if is-func (list "-f"))))
	(manual-entry word)))
     (t
      (Man-getpage-in-background word)))))

(defun cperl-build-manpage ()
  "Create a virtual manpage in Emacs from the POD in the file."
  (interactive)
  (require 'man)
  (cond
   (cperl-xemacs-p
    (let ((Manual-program "perldoc"))
      (manual-entry buffer-file-name)))
   (t
    (let* ((manual-program "perldoc"))
      (Man-getpage-in-background buffer-file-name)))))

      (setq c (1+ c))
      (cperl-update-syntaxification (point) (point))
      (setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta))
      (message "to %s:%6s,%7s" l delta tot))
    tot))

(defun cperl-emulate-lazy-lock (&optional window-size)
  "Emulate `lazy-lock' without `condition-case', so `debug-on-error' works.
Start fontifying the buffer from the start (or end) using the given
WINDOW-SIZE (units is lines).  Negative WINDOW-SIZE starts at end, and

85762:29e75576e47f

	  (require 'custom)
	(error nil))
      (condition-case nil
	  (require 'man)
	(error nil))
      (defvar cperl-can-font-lock
	(or (featurep 'xemacs)
	    (and (boundp 'emacs-major-version)
		 (or window-system
		     (> emacs-major-version 20)))))
      (if cperl-can-font-lock
	  (require 'font-lock))

	`(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))))
      (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???

            `(goto-line (string-to-int (elt ,elt 1))))
	;;)
	(defmacro cperl-etags-goto-tag-location (elt)
	  `(etags-goto-tag-location ,elt))))

(defvar cperl-can-font-lock
  (or (featurep 'xemacs)
      (and (boundp 'emacs-major-version)
	   (or window-system
	       (> emacs-major-version 20)))))

(defun cperl-choose-color (&rest list)

  "*Face for here-docs highlighting."
  :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
  :version "21.1"

;;; 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)

(and (vectorp cperl-del-back-ch) (= (length cperl-del-back-ch) 1)
     (setq cperl-del-back-ch (aref cperl-del-back-ch 0)))

(defun cperl-mark-active () (mark))	; Avoid undefined warning
(if (featurep 'xemacs)
    (progn
      ;; "Active regions" are on: use region only if active
      ;; "Active regions" are off: use region unconditionally
      (defun cperl-use-region-p ()
	(if zmacs-regions (mark) t)))

  cperl-can-font-lock)

(defun cperl-putback-char (c)		; Emacs 19
  (set 'unread-command-events (list c))) ; Avoid undefined warning

(if (featurep 'xemacs)
    (defun cperl-putback-char (c)	; XEmacs >= 19.12
      (setq unread-command-events (list (eval '(character-to-event c))))))

(or (fboundp 'uncomment-region)
    (defun uncomment-region (beg end)

		      [(control c) (control h) f])
    (cperl-define-key "\C-c\C-hv"
		      ;;(concat (char-to-string help-char) "v") ; does not work
		      'cperl-get-help
		      [(control c) (control h) v]))
  (if (and (featurep 'xemacs)
	   (<= emacs-minor-version 11) (<= emacs-major-version 19))
      (progn
	;; substitute-key-definition is usefulness-deenhanced...
	;;;;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
	(cperl-define-key "\e;" 'cperl-indent-for-comment)

  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (setq paragraph-ignore-fill-prefix t)
  (if (featurep 'xemacs)
    (progn
      (make-local-variable 'paren-backwards-message)
      (set 'paren-backwards-message t)))
  (make-local-variable 'indent-line-function)
  (setq indent-line-function 'cperl-indent-line)

	(set 'parse-sexp-lookup-properties t)
	;; Fix broken font-lock:
	(or (boundp 'font-lock-unfontify-region-function)
	    (set 'font-lock-unfontify-region-function
		 'font-lock-default-unfontify-region))
	(unless (featurep 'xemacs)		; Our: just a plug for wrong font-lock
	  (make-local-variable 'font-lock-unfontify-region-function)
	  (set 'font-lock-unfontify-region-function ; not present with old Emacs
	       'cperl-font-lock-unfontify-region-function))
	(make-local-variable 'cperl-syntax-done-to)
	(setq cperl-syntax-done-to nil)	; reset syntaxification cache

	  (setq
	   t-font-lock-keywords-1
	   (and (fboundp 'turn-on-font-lock) ; Check for newer font-lock
		;; not yet as of XEmacs 19.12, works with 21.1.11
		(or
		 (not (featurep 'xemacs))
		 (string< "21.1.9" emacs-version)
		 (and (string< "21.1.10" emacs-version)
		      (string< emacs-version "21.1.2")))
		'(
		  ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1

	  ;;	"Face to use for data types."))
	  ;;(or (boundp 'cperl-nonoverridable-face)
	  ;;    (defconst cperl-nonoverridable-face
	  ;;	'cperl-nonoverridable-face
	  ;;	"Face to use for data types from another group."))
	  ;;(if (not (featurep 'xemacs)) nil
	  ;;  (or (boundp 'font-lock-comment-face)
	  ;;	(defconst font-lock-comment-face
	  ;;	  'font-lock-comment-face
	  ;;	  "Face to use for comments."))
	  ;;  (or (boundp 'font-lock-keyword-face)

	(case-fold-search (eq system-type 'emx))
	xs rel tm)
    (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))))
      (cond
       (dir

				     ;; Only in one file
				     (setcdr elt (cdr (nth 1 elt)))))))
	    pack name cons1 to l1 l2 l3 l4 b)
	;; (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...")

				 (documentation-property
				  'cperl-short-docs
				  'variable-documentation))))
	 (manual-program (if is-func "perldoc -f" "perldoc")))
    (cond
     ((featurep 'xemacs)
      (let ((Manual-program "perldoc")
	    (Manual-switches (if is-func (list "-f"))))
	(manual-entry word)))
     (t
      (Man-getpage-in-background word)))))

(defun cperl-build-manpage ()
  "Create a virtual manpage in Emacs from the POD in the file."
  (interactive)
  (require 'man)
  (cond
   ((featurep 'xemacs)
    (let ((Manual-program "perldoc"))
      (manual-entry buffer-file-name)))
   (t
    (let* ((manual-program "perldoc"))
      (Man-getpage-in-background buffer-file-name)))))

      (setq c (1+ c))
      (cperl-update-syntaxification (point) (point))
      (setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta))
      (message "to %s:%6s,%7s" l delta tot))
    tot))

(defvar font-lock-cache-position)

(defun cperl-emulate-lazy-lock (&optional window-size)
  "Emulate `lazy-lock' without `condition-case', so `debug-on-error' works.
Start fontifying the buffer from the start (or end) using the given
WINDOW-SIZE (units is lines).  Negative WINDOW-SIZE starts at end, and