-;;; cperl-mode.el --- Perl code editing commands for Emacs
+;;; cperl-mode.el --- Perl code editing commands for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985-1987, 1991-2017 Free Software Foundation, Inc.
(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))
(defvar msb-menu-cond)
(defvar gud-perldb-history)
(defvar font-lock-background-mode) ; not in Emacs
(defvar font-lock-display-type) ; ditto
(defvar paren-backwards-message) ; Not in newer XEmacs?
(or (fboundp 'defgroup)
- (defmacro defgroup (name val doc &rest arr)
+ (defmacro defgroup (_name _val _doc &rest _)
nil))
(or (fboundp 'custom-declare-variable)
- (defmacro defcustom (name val doc &rest arr)
+ (defmacro defcustom (name val doc &rest _)
`(defvar ,name ,val ,doc)))
- (or (and (fboundp 'custom-declare-variable)
- (string< "19.31" emacs-version)) ; Checked with 19.30: defface does not work
- (defmacro defface (&rest arr)
+ (or (fboundp 'custom-declare-variable)
+ (defmacro defface (&rest _)
nil))
;; Avoid warning (tmp definitions)
(or (fboundp 'x-color-defined-p)
`(progn
(beginning-of-line 2)
(list ,file ,line)))
- (defmacro cperl-etags-snarf-tag (file line)
+ (defmacro cperl-etags-snarf-tag (_file _line)
`(etags-snarf-tag)))
(if (featurep 'xemacs)
(defmacro cperl-etags-goto-tag-location (elt)
(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)
(let (answer)
(while list
:group 'cperl-indentation-details)
(defcustom cperl-syntaxify-by-font-lock
- (and cperl-can-font-lock
- (boundp 'parse-sexp-lookup-properties))
+ (boundp 'parse-sexp-lookup-properties)
"Non-nil means that CPerl uses the `font-lock' routines for syntaxification."
:type '(choice (const message) boolean)
:group 'cperl-speed)
(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)))
- (defun cperl-use-region-p ()
- (if transient-mark-mode mark-active t))
- (defun cperl-mark-active () mark-active))
-
-(defsubst cperl-enable-font-lock ()
- cperl-can-font-lock)
-
(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 (eval '(character-to-event c)) unread-command-events)))
+ (push (character-to-event c) unread-command-events)))
(or (fboundp 'uncomment-region)
(defun uncomment-region (beg end)
(comment-region beg end -1)))
(defvar cperl-do-not-fontify
+ ;; FIXME: This is not doing what it claims!
(if (string< emacs-version "19.30")
'fontified
'lazy-lock)
(defvar cperl-syntax-state nil)
(defvar cperl-syntax-done-to nil)
-(defvar cperl-emacs-can-parse (> (length (save-excursion
- (parse-partial-sexp (point) (point)))) 9))
\f
;; Make customization possible "in reverse"
(defsubst cperl-val (symbol &optional default hairy)
(put-text-property (point) (match-end 0)
'syntax-type prop)))))))
-;;; Probably it is too late to set these guys already, but it can help later:
+;; Probably it is too late to set these guys already, but it can help later:
-;;;(and cperl-clobber-mode-lists
-;;;(setq auto-mode-alist
-;;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist ))
-;;;(and (boundp 'interpreter-mode-alist)
-;;; (setq interpreter-mode-alist (append interpreter-mode-alist
-;;; '(("miniperl" . perl-mode))))))
+;;(and cperl-clobber-mode-lists
+;;(setq auto-mode-alist
+;; (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode)) auto-mode-alist ))
+;;(and (boundp 'interpreter-mode-alist)
+;; (setq interpreter-mode-alist (append interpreter-mode-alist
+;; '(("miniperl" . perl-mode))))))
(eval-when-compile
(mapc (lambda (p)
(condition-case nil
(if (fboundp 'ps-extend-face-list)
(defmacro cperl-ps-extend-face-list (arg)
`(ps-extend-face-list ,arg))
- (defmacro cperl-ps-extend-face-list (arg)
+ (defmacro cperl-ps-extend-face-list (_)
`(error "This version of Emacs has no `ps-extend-face-list'")))
;; Calling `cperl-enable-font-lock' below doesn't compile on XEmacs,
;; macros instead of defsubsts don't work on Emacs, so we do the
("head2" "head2" cperl-electric-pod :system t)))
"Abbrev table in use in CPerl mode buffers.")
-(add-hook 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-")))
-
-(defvar cperl-mode-map () "Keymap used in CPerl mode.")
-
-(if cperl-mode-map nil
- (setq cperl-mode-map (make-sparse-keymap))
- (cperl-define-key "{" 'cperl-electric-lbrace)
- (cperl-define-key "[" 'cperl-electric-paren)
- (cperl-define-key "(" 'cperl-electric-paren)
- (cperl-define-key "<" 'cperl-electric-paren)
- (cperl-define-key "}" 'cperl-electric-brace)
- (cperl-define-key "]" 'cperl-electric-rparen)
- (cperl-define-key ")" 'cperl-electric-rparen)
- (cperl-define-key ";" 'cperl-electric-semi)
- (cperl-define-key ":" 'cperl-electric-terminator)
- (cperl-define-key "\C-j" 'newline-and-indent)
- (cperl-define-key "\C-c\C-j" 'cperl-linefeed)
- (cperl-define-key "\C-c\C-t" 'cperl-invert-if-unless)
- (cperl-define-key "\C-c\C-a" 'cperl-toggle-auto-newline)
- (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
- (cperl-define-key "\C-c\C-w" 'cperl-toggle-construct-fix)
- (cperl-define-key "\C-c\C-f" 'auto-fill-mode)
- (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
- (cperl-define-key "\C-c\C-b" 'cperl-find-bad-style)
- (cperl-define-key "\C-c\C-p" 'cperl-pod-spell)
- (cperl-define-key "\C-c\C-d" 'cperl-here-doc-spell)
- (cperl-define-key "\C-c\C-n" 'cperl-narrow-to-here-doc)
- (cperl-define-key "\C-c\C-v" 'cperl-next-interpolated-REx)
- (cperl-define-key "\C-c\C-x" 'cperl-next-interpolated-REx-0)
- (cperl-define-key "\C-c\C-y" 'cperl-next-interpolated-REx-1)
- (cperl-define-key "\C-c\C-ha" 'cperl-toggle-autohelp)
- (cperl-define-key "\C-c\C-hp" 'cperl-perldoc)
- (cperl-define-key "\C-c\C-hP" 'cperl-perldoc-at-point)
- (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
- (cperl-define-key [?\C-\M-\|] 'cperl-lineup
- [(control meta |)])
- ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
- ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
- (cperl-define-key "\177" 'cperl-electric-backspace)
- (cperl-define-key "\t" 'cperl-indent-command)
- ;; don't clobber the backspace binding:
- (cperl-define-key "\C-c\C-hF" 'cperl-info-on-command
- [(control c) (control h) F])
- (if (cperl-val 'cperl-clobber-lisp-bindings)
- (progn
- (cperl-define-key "\C-hf"
- ;;(concat (char-to-string help-char) "f") ; does not work
- 'cperl-info-on-command
- [(control h) f])
- (cperl-define-key "\C-hv"
- ;;(concat (char-to-string help-char) "v") ; does not work
- 'cperl-get-help
- [(control h) v])
- (cperl-define-key "\C-c\C-hf"
- ;;(concat (char-to-string help-char) "f") ; does not work
- (key-binding "\C-hf")
- [(control c) (control h) f])
- (cperl-define-key "\C-c\C-hv"
- ;;(concat (char-to-string help-char) "v") ; does not work
- (key-binding "\C-hv")
- [(control c) (control h) v]))
- (cperl-define-key "\C-c\C-hf" 'cperl-info-on-current-command
- [(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)
- (cperl-define-key "\e\C-\\" 'cperl-indent-region))
+(when (boundp 'edit-var-mode-alist)
+ (add-to-list 'edit-var-mode-alist '(perl-mode (regexp . "^cperl-"))))
+
+(defvar cperl-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "{" 'cperl-electric-lbrace)
+ (define-key map "[" 'cperl-electric-paren)
+ (define-key map "(" 'cperl-electric-paren)
+ (define-key map "<" 'cperl-electric-paren)
+ (define-key map "}" 'cperl-electric-brace)
+ (define-key map "]" 'cperl-electric-rparen)
+ (define-key map ")" 'cperl-electric-rparen)
+ (define-key map ";" 'cperl-electric-semi)
+ (define-key map ":" 'cperl-electric-terminator)
+ (define-key map "\C-j" 'newline-and-indent)
+ (define-key map "\C-c\C-j" 'cperl-linefeed)
+ (define-key map "\C-c\C-t" 'cperl-invert-if-unless)
+ (define-key map "\C-c\C-a" 'cperl-toggle-auto-newline)
+ (define-key map "\C-c\C-k" 'cperl-toggle-abbrev)
+ (define-key map "\C-c\C-w" 'cperl-toggle-construct-fix)
+ (define-key map "\C-c\C-f" 'auto-fill-mode)
+ (define-key map "\C-c\C-e" 'cperl-toggle-electric)
+ (define-key map "\C-c\C-b" 'cperl-find-bad-style)
+ (define-key map "\C-c\C-p" 'cperl-pod-spell)
+ (define-key map "\C-c\C-d" 'cperl-here-doc-spell)
+ (define-key map "\C-c\C-n" 'cperl-narrow-to-here-doc)
+ (define-key map "\C-c\C-v" 'cperl-next-interpolated-REx)
+ (define-key map "\C-c\C-x" 'cperl-next-interpolated-REx-0)
+ (define-key map "\C-c\C-y" 'cperl-next-interpolated-REx-1)
+ (define-key map "\C-c\C-ha" 'cperl-toggle-autohelp)
+ (define-key map "\C-c\C-hp" 'cperl-perldoc)
+ (define-key map "\C-c\C-hP" 'cperl-perldoc-at-point)
+ (define-key map "\e\C-q" 'cperl-indent-exp) ; Usually not bound
+ (define-key map [(control meta ?|)] 'cperl-lineup)
+ ;;(define-key map "\M-q" 'cperl-fill-paragraph)
+ ;;(define-key map "\e;" 'cperl-indent-for-comment)
+ (define-key map "\177" 'cperl-electric-backspace)
+ (define-key map "\t" 'cperl-indent-command)
+ ;; don't clobber the backspace binding:
+ (define-key map [(control ?c) (control ?h) ?F] 'cperl-info-on-command)
+ (if (cperl-val 'cperl-clobber-lisp-bindings)
+ (progn
+ (define-key map [(control ?h) ?f]
+ ;;(concat (char-to-string help-char) "f") ; does not work
+ 'cperl-info-on-command)
+ (define-key map [(control ?h) ?v]
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ 'cperl-get-help)
+ (define-key map [(control ?c) (control ?h) ?f]
+ ;;(concat (char-to-string help-char) "f") ; does not work
+ (key-binding "\C-hf"))
+ (define-key map [(control ?c) (control ?h) ?v]
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ (key-binding "\C-hv")))
+ (define-key map [(control ?c) (control ?h) ?f]
+ 'cperl-info-on-current-command)
+ (define-key map [(control ?c) (control ?h) ?v]
+ ;;(concat (char-to-string help-char) "v") ; does not work
+ 'cperl-get-help))
(or (boundp 'fill-paragraph-function)
- (substitute-key-definition
- 'fill-paragraph 'cperl-fill-paragraph
- cperl-mode-map global-map))
+ (substitute-key-definition
+ 'fill-paragraph 'cperl-fill-paragraph
+ map global-map))
(substitute-key-definition
'indent-sexp 'cperl-indent-exp
- cperl-mode-map global-map)
+ map global-map)
(substitute-key-definition
'indent-region 'cperl-indent-region
- cperl-mode-map global-map)
+ map global-map)
(substitute-key-definition
'indent-for-comment 'cperl-indent-for-comment
- cperl-mode-map global-map)))
+ map global-map)
+ map)
+ "Keymap used in CPerl mode.")
(defvar cperl-menu)
(defvar cperl-lazy-installed)
["Indent expression" cperl-indent-exp t]
["Fill paragraph/comment" fill-paragraph t]
"----"
- ["Line up a construction" cperl-lineup (cperl-use-region-p)]
+ ["Line up a construction" cperl-lineup (use-region-p)]
["Invert if/unless/while etc" cperl-invert-if-unless t]
("Regexp"
["Beautify" cperl-beautify-regexp
["Insert spaces if needed to fix style" cperl-find-bad-style t]
["Refresh \"hard\" constructions" cperl-find-pods-heres t]
"----"
- ["Indent region" cperl-indent-region (cperl-use-region-p)]
- ["Comment region" cperl-comment-region (cperl-use-region-p)]
- ["Uncomment region" cperl-uncomment-region (cperl-use-region-p)]
+ ["Indent region" cperl-indent-region (use-region-p)]
+ ["Comment region" cperl-comment-region (use-region-p)]
+ ["Uncomment region" cperl-uncomment-region (use-region-p)]
"----"
["Run" mode-compile (fboundp 'mode-compile)]
["Kill" mode-compile-kill (and (fboundp 'mode-compile-kill)
(fboundp 'ps-extend-face-list)]
"----"
["Syntaxify region" cperl-find-pods-heres-region
- (cperl-use-region-p)]
+ (use-region-p)]
["Profile syntaxification" cperl-time-fontification t]
["Debug errors in delayed fontification" cperl-emulate-lazy-lock t]
["Debug unwind for syntactic scan" cperl-toggle-set-debug-unwind t]
["Perldoc on word at point" cperl-perldoc-at-point t]
["View manpage of POD in this file" cperl-build-manpage t]
["Auto-help on" cperl-lazy-install
- (and (fboundp 'run-with-idle-timer)
- (not cperl-lazy-installed))]
+ (not cperl-lazy-installed)]
["Auto-help off" cperl-lazy-unstall
- (and (fboundp 'run-with-idle-timer)
- cperl-lazy-installed)])
+ cperl-lazy-installed])
("Toggle..."
["Auto newline" cperl-toggle-auto-newline t]
["Electric parens" cperl-toggle-electric t]
["CPerl mode" (describe-function 'cperl-mode) t]
["CPerl version"
(message "The version of master-file for this CPerl is %s-Emacs"
- cperl-version) t]))))
+ cperl-version)
+ t]))))
(error nil))
(autoload 'c-macro-expand "cmacexp"
Should contain exactly one group.")
-;;; Is incorporated in `cperl-imenu--function-name-regexp-perl'
-;;; `cperl-outline-regexp', `defun-prompt-regexp'.
-;;; Details of groups in this may be used in several functions; see comments
-;;; near mentioned above variable(s)...
-;;; sub($$):lvalue{} sub:lvalue{} Both allowed...
+;; Is incorporated in `cperl-imenu--function-name-regexp-perl'
+;; `cperl-outline-regexp', `defun-prompt-regexp'.
+;; Details of groups in this may be used in several functions; see comments
+;; near mentioned above variable(s)...
+;; sub($$):lvalue{} sub:lvalue{} Both allowed...
(defsubst cperl-after-sub-regexp (named attr) ; 9 groups without attr...
"Match the text after `sub' in a subroutine declaration.
If NAMED is nil, allows anonymous subroutines. Matches up to the first \":\"
"\\)?" ; END n+6=proto-group
))
-;;; Tired of editing this in 8 places every time I remember that there
-;;; is another method-defining keyword
+;; Tired of editing this in 8 places every time I remember that there
+;; is another method-defining keyword
(defvar cperl-sub-keywords
'("sub"))
This is regulated by variable `cperl-lazy-help-time'. Default with
`cperl-hairy' (if the value of `cperl-lazy-help-time' is nil) is 5
secs idle time . It is also possible to switch this on/off from the
-menu, or via \\[cperl-toggle-autohelp]. Requires `run-with-idle-timer'.
+menu, or via \\[cperl-toggle-autohelp].
Use \\[cperl-lineup] to vertically lineup some construction - put the
beginning of the region at the start of construction, and make region
;; Until Emacs is multi-threaded, we do not actually need it local:
(make-local-variable 'cperl-font-lock-multiline-start)
(make-local-variable 'cperl-font-locking)
- (make-local-variable 'outline-regexp)
- ;; (setq outline-regexp imenu-example--function-name-regexp-perl)
- (setq outline-regexp cperl-outline-regexp)
- (make-local-variable 'outline-level)
- (setq outline-level 'cperl-outline-level)
- (make-local-variable 'add-log-current-defun-function)
- (setq add-log-current-defun-function
+ (set (make-local-variable 'outline-regexp) cperl-outline-regexp)
+ (set (make-local-variable 'outline-level) 'cperl-outline-level)
+ (set (make-local-variable 'add-log-current-defun-function)
(lambda ()
(save-excursion
(if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
(match-string-no-properties 1)))))
- (make-local-variable 'paragraph-start)
- (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)
+ (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)
- (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)
- (make-local-variable 'require-final-newline)
- (setq require-final-newline mode-require-final-newline)
- (make-local-variable 'comment-start)
- (setq comment-start "# ")
- (make-local-variable 'comment-end)
- (setq comment-end "")
- (make-local-variable 'comment-column)
- (setq comment-column cperl-comment-column)
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "#+ *")
- (make-local-variable 'defun-prompt-regexp)
-;;; "[ \t]*sub"
-;;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
-;;; cperl-maybe-white-and-comment-rex ; 15=pre-block
- (setq defun-prompt-regexp
- (concat "^[ \t]*\\("
- cperl-sub-regexp
- (cperl-after-sub-regexp 'named 'attr-groups)
- "\\|" ; per toke.c
- "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
- "\\)"
- cperl-maybe-white-and-comment-rex))
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'cperl-comment-indent)
+ (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) "# ")
+ (set (make-local-variable 'comment-end) "")
+ (set (make-local-variable 'comment-column) cperl-comment-column)
+ (set (make-local-variable 'comment-start-skip) "#+ *")
+
+;; "[ \t]*sub"
+;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
+;; cperl-maybe-white-and-comment-rex ; 15=pre-block
+ (set (make-local-variable 'defun-prompt-regexp)
+ (concat "^[ \t]*\\("
+ cperl-sub-regexp
+ (cperl-after-sub-regexp 'named 'attr-groups)
+ "\\|" ; per toke.c
+ "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
+ "\\)"
+ cperl-maybe-white-and-comment-rex))
+ (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent)
(and (boundp 'fill-paragraph-function)
- (progn
- (make-local-variable 'fill-paragraph-function)
- (set 'fill-paragraph-function 'cperl-fill-paragraph)))
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
- (make-local-variable 'indent-region-function)
- (setq indent-region-function 'cperl-indent-region)
- ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off!
- (make-local-variable 'imenu-create-index-function)
- (setq imenu-create-index-function
- (function cperl-imenu--create-perl-index))
- (make-local-variable 'imenu-sort-function)
- (setq imenu-sort-function nil)
- (make-local-variable 'vc-rcs-header)
- (set 'vc-rcs-header cperl-vc-rcs-header)
- (make-local-variable 'vc-sccs-header)
- (set 'vc-sccs-header cperl-vc-sccs-header)
+ (set (make-local-variable 'fill-paragraph-function)
+ #'cperl-fill-paragraph))
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'indent-region-function) #'cperl-indent-region)
+ ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off!
+ (set (make-local-variable 'imenu-create-index-function)
+ #'cperl-imenu--create-perl-index)
+ (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...
- (make-local-variable 'vc-header-alist)
- (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
- `((SCCS ,(car cperl-vc-sccs-header))
- (RCS ,(car cperl-vc-rcs-header))))))
+ (set (make-local-variable 'vc-header-alist)
+ (or cperl-vc-header-alist ; Avoid warning
+ `((SCCS ,(car cperl-vc-sccs-header))
+ (RCS ,(car cperl-vc-rcs-header))))))
(cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (make-local-variable 'compilation-error-regexp-alist-alist)
- (set 'compilation-error-regexp-alist-alist
+ (set (make-local-variable 'compilation-error-regexp-alist-alist)
(cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
- (symbol-value 'compilation-error-regexp-alist-alist)))
+ compilation-error-regexp-alist-alist))
(if (fboundp 'compilation-build-compilation-error-regexp-alist)
(let ((f 'compilation-build-compilation-error-regexp-alist))
(funcall f))
(make-local-variable 'compilation-error-regexp-alist)
(push 'cperl compilation-error-regexp-alist)))
((boundp 'compilation-error-regexp-alist);; xemacs 19.x
- (make-local-variable 'compilation-error-regexp-alist)
- (set 'compilation-error-regexp-alist
+ (set (make-local-variable 'compilation-error-regexp-alist)
(append cperl-compilation-error-regexp-alist
- (symbol-value 'compilation-error-regexp-alist)))))
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- (cond
- ((string< emacs-version "19.30")
- '(cperl-font-lock-keywords-2 nil nil ((?_ . "w"))))
- ((string< emacs-version "19.33") ; Which one to use?
- '((cperl-font-lock-keywords
- cperl-font-lock-keywords-1
- cperl-font-lock-keywords-2) nil nil ((?_ . "w"))))
- (t
- '((cperl-load-font-lock-keywords
- cperl-load-font-lock-keywords-1
- cperl-load-font-lock-keywords-2) nil nil ((?_ . "w"))))))
- (make-local-variable 'cperl-syntax-state)
- (setq cperl-syntax-state nil) ; reset syntaxification cache
+ compilation-error-regexp-alist))))
+ (set (make-local-variable 'font-lock-defaults)
+ '((cperl-load-font-lock-keywords
+ cperl-load-font-lock-keywords-1
+ cperl-load-font-lock-keywords-2) nil nil ((?_ . "w"))))
+ ;; Reset syntaxification cache.
+ (set (make-local-variable 'cperl-syntax-state) nil)
(if cperl-use-syntax-table-text-property
(if (eval-when-compile (fboundp 'syntax-propertize-rules))
(progn
;; to re-apply them.
(setq cperl-syntax-done-to start)
(cperl-fontify-syntaxically end))))
- (make-local-variable 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
- (set 'parse-sexp-lookup-properties t)
+ (set (make-local-variable '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))
+ (setq 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
- (make-local-variable 'font-lock-syntactic-keywords)
- (setq font-lock-syntactic-keywords
+ (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)
(if cperl-syntaxify-by-font-lock
'((cperl-fontify-syntaxically))
;; unless font-lock-syntactic-keywords, font-lock (pre-22.1)
(progn
(setq cperl-font-lock-multiline t) ; Not localized...
(set (make-local-variable 'font-lock-multiline) t))
- (make-local-variable 'font-lock-fontify-region-function)
- (set 'font-lock-fontify-region-function ; not present with old Emacs
- 'cperl-font-lock-fontify-region-function))
- (make-local-variable 'font-lock-fontify-region-function)
- (set 'font-lock-fontify-region-function ; not present with old Emacs
- 'cperl-font-lock-fontify-region-function)
+ (set (make-local-variable 'font-lock-fontify-region-function)
+ ;; not present with old Emacs
+ #'cperl-font-lock-fontify-region-function))
+ (set (make-local-variable 'font-lock-fontify-region-function)
+ #'cperl-font-lock-fontify-region-function)
(make-local-variable 'cperl-old-style)
- (if (boundp 'normal-auto-fill-function) ; 19.33 and later
- (set (make-local-variable 'normal-auto-fill-function)
- 'cperl-do-auto-fill)
- (or (fboundp 'cperl-old-auto-fill-mode)
- (progn
- (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
- (defun auto-fill-mode (&optional arg)
- (interactive "P")
- (eval '(cperl-old-auto-fill-mode arg)) ; Avoid a warning
- (and auto-fill-function (memq major-mode '(perl-mode cperl-mode))
- (setq auto-fill-function 'cperl-do-auto-fill))))))
- (if (cperl-enable-font-lock)
- (if (cperl-val 'cperl-font-lock)
- (progn (or cperl-faces-init (cperl-init-faces))
- (font-lock-mode 1))))
+ (set (make-local-variable 'normal-auto-fill-function)
+ #'cperl-do-auto-fill)
+ (if (cperl-val 'cperl-font-lock)
+ (progn (or cperl-faces-init (cperl-init-faces))
+ (font-lock-mode 1)))
(set (make-local-variable 'facemenu-add-face-function)
- 'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
+ #'cperl-facemenu-add-face-function) ; XXXX What this guy is for???
(and (boundp 'msb-menu-cond)
(not cperl-msb-fixed)
(cperl-msb-fix))
(if (fboundp 'easy-menu-add)
(easy-menu-add cperl-menu)) ; A NOP in Emacs.
- (run-mode-hooks 'cperl-mode-hook)
(if cperl-hook-after-change
- (add-hook 'after-change-functions 'cperl-after-change-function nil t))
+ (add-hook 'after-change-functions #'cperl-after-change-function nil t))
;; After hooks since fontification will break this
(if cperl-pod-here-scan
(or cperl-syntaxify-by-font-lock
(progn (or cperl-faces-init (cperl-init-faces-weak))
(cperl-find-pods-heres))))
;; Setup Flymake
- (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t))
+ (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
\f
;; Fix for perldb - make default reasonable
(defun cperl-db ()
(interactive "P")
(let (insertpos
(other-end (if (and cperl-electric-parens-mark
- (cperl-mark-active)
+ (region-active-p)
(< (mark) (point)))
(mark)
nil)))
(cperl-auto-newline cperl-auto-newline)
(other-end (or end
(if (and cperl-electric-parens-mark
- (cperl-mark-active)
+ (region-active-p)
(> (mark) (point)))
(save-excursion
(goto-char (mark))
(point-marker))
nil)))
- pos after)
+ pos)
(and (cperl-val 'cperl-electric-lbrace-space)
(eq (preceding-char) ?$)
(save-excursion
"Insert an opening parenthesis or a matching pair of parentheses.
See `cperl-electric-parens'."
(interactive "P")
- (let ((beg (point-at-bol))
- (other-end (if (and cperl-electric-parens-mark
- (cperl-mark-active)
+ (let ((other-end (if (and cperl-electric-parens-mark
+ (region-active-p)
(> (mark) (point)))
(save-excursion
(goto-char (mark))
(memq last-command-event
(append cperl-electric-parens-string nil))
(>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
- ;;(not (save-excursion (search-backward "#" beg t)))
(if (eq last-command-event ?<)
(progn
;; This code is too electric, see Bug#3943.
If not, or if we are not at the end of marking range, would self-insert.
Affected by `cperl-electric-parens'."
(interactive "P")
- (let ((beg (point-at-bol))
- (other-end (if (and cperl-electric-parens-mark
+ (let ((other-end (if (and cperl-electric-parens-mark
(cperl-val 'cperl-electric-parens)
(memq last-command-event
(append cperl-electric-parens-string nil))
- (cperl-mark-active)
+ (region-active-p)
(< (mark) (point)))
(mark)
nil))
(cperl-val 'cperl-electric-parens)
(memq last-command-event '( ?\) ?\] ?\} ?\> ))
(>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
- ;;(not (save-excursion (search-backward "#" beg t)))
)
(progn
(self-insert-command (prefix-numeric-value arg))
Return the amount the indentation changed by."
(let ((case-fold-search nil)
(pos (- (point-max) (point)))
- indent i beg shift-amt)
+ indent i shift-amt)
(setq indent (cperl-calculate-indent parse-data)
i indent)
(beginning-of-line)
- (setq beg (point))
(cond ((or (eq indent nil) (eq indent t))
(setq indent (current-indentation) i nil))
;;((eq indent t) ; Never?
(zerop shift-amt))
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
- ;;;(delete-region beg (point))
- ;;;(indent-to indent)
+ ;;(delete-region beg (point))
+ ;;(indent-to indent)
(cperl-make-indent indent)
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))))
(defun cperl-get-state (&optional parse-start start-state)
- ;; returns list (START STATE DEPTH PRESTART),
- ;; START is a good place to start parsing, or equal to
- ;; PARSE-START if preset,
- ;; STATE is what is returned by `parse-partial-sexp'.
- ;; DEPTH is true is we are immediately after end of block
- ;; which contains START.
- ;; PRESTART is the position basing on which START was found.
+ "Return list (START STATE DEPTH PRESTART),
+START is a good place to start parsing, or equal to
+PARSE-START if preset,
+STATE is what is returned by `parse-partial-sexp'.
+DEPTH is true is we are immediately after end of block
+which contains START.
+PRESTART is the position basing on which START was found."
(save-excursion
(let ((start-point (point)) depth state start prestart)
(if (and parse-start
(defun cperl-calculate-indent-within-comment ()
"Return the indentation amount for line, assuming that
the current line is to be regarded as part of a block comment."
- (let (end star-start)
+ (let (end)
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(defun cperl-unwind-to-safe (before &optional end)
;; if BEFORE, go to the previous start-of-line on each step of unwinding
- (let ((pos (point)) opos)
+ (let ((pos (point)))
(while (and pos (progn
(beginning-of-line)
(get-text-property (setq pos (point)) 'syntax-type)))
- (setq opos pos
- pos (cperl-beginning-of-property pos 'syntax-type))
+ (setq pos (cperl-beginning-of-property pos 'syntax-type))
(if (eq pos (point-min))
(setq pos nil))
(if pos
Should be called with the point before leading colon of an attribute."
;; Works *before* syntax recognition is done
(or st-l (setq st-l (list nil))) ; Avoid overwriting '()
- (let (st b p reset-st after-first (start (point)) start1 end1)
+ (let (st p reset-st after-first (start (point)) start1 end1)
(condition-case b
(while (looking-at
(concat
'face dashface))
;; save match data (for looking-at)
(setq lll (mapcar (function (lambda (elt) (cons (match-beginning elt)
- (match-end elt)))) l))
+ (match-end elt))))
+ l))
(while lll
(setq ll (car lll))
(setq lle (cdr ll)
CHARS is a string that contains good characters to have before us (however,
`}' is treated \"smartly\" if it is not in the list)."
(let ((lim (or lim (point-min)))
- stop p pr)
+ stop p)
(cperl-update-syntaxification (point) (point))
(save-excursion
(while (and (not stop) (> (point) lim))
(error t))))
(defun cperl-forward-to-end-of-expr (&optional lim)
- (let ((p (point))))
(condition-case nil
(progn
(while (and (< (point) (or lim (point-max)))
(defvar cperl-update-start) ; Do not need to make them local
(defvar cperl-update-end)
-(defun cperl-delay-update-hook (beg end old-len)
+(defun cperl-delay-update-hook (beg end _old-len)
(setq cperl-update-start (min beg (or cperl-update-start (point-max))))
(setq cperl-update-end (max end (or cperl-update-end (point-min)))))
(cperl-update-syntaxification end end)
(save-excursion
(let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
- (let ((indent-info (if cperl-emacs-can-parse
- (list nil nil nil) ; Cannot use '(), since will modify
- nil))
- (pm 0)
+ (let ((indent-info (list nil nil nil) ; Cannot use '(), since will modify
+ )
after-change-functions ; Speed it up!
- st comm old-comm-indent new-comm-indent p pp i empty)
- (if h-a-c (add-hook 'after-change-functions 'cperl-delay-update-hook))
+ comm old-comm-indent new-comm-indent i empty)
+ (if h-a-c (add-hook 'after-change-functions #'cperl-delay-update-hook))
(goto-char start)
(setq old-comm-indent (and (cperl-to-comment-or-eol)
(current-column))
(setq end (set-marker (make-marker) end)) ; indentation changes pos
(or (bolp) (beginning-of-line 2))
(while (and (<= (point) end) (not (eobp))) ; bol to check start
- (setq st (point))
(if (or
(setq empty (looking-at "[ \t]*\n"))
(and (setq comm (looking-at "[ \t]*#"))
(defun cperl-imenu--create-perl-index (&optional regexp)
(require 'imenu) ; May be called from TAGS creator
(let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '())
- (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
+ (index-unsorted-alist '())
(index-meth-alist '()) meth
packages ends-ranges p marker is-proto
- (prev-pos 0) is-pack index index1 name (end-range 0) package)
+ is-pack index index1 name (end-range 0) package)
(goto-char (point-min))
(cperl-update-syntaxification (point-max) (point-max))
;; Search for the function
(concat
"\\(^\\|[^$@%&\\]\\)\\<\\("
(mapconcat
- 'identity
+ #'identity
(append
cperl-sub-keywords
'("if" "until" "while" "elsif" "else"
"u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
"wh\\(en\\|ile\\)\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
"\\|[sm]" ; Added manually
- "\\)\\>") 2 'cperl-nonoverridable-face)
- ;; (mapconcat 'identity
+ "\\)\\>")
+ 2 'cperl-nonoverridable-face)
+ ;; (mapconcat #'identity
;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
;; "#include" "#define" "#undef")
;; "\\|")
(if (boundp 'font-lock-background-mode)
font-lock-background-mode
'light))
- (face-list (and (fboundp 'face-list) (face-list))))
-;;;; (fset 'cperl-is-face
-;;;; (cond ((fboundp 'find-face)
-;;;; (symbol-function 'find-face))
-;;;; (face-list
-;;;; (function (lambda (face) (member face face-list))))
-;;;; (t
-;;;; (function (lambda (face) (boundp face))))))
+ ;; (face-list (and (fboundp 'face-list) (face-list)))
+ )
+ ;; (fset 'cperl-is-face
+ ;; (cond ((fboundp 'find-face)
+ ;; (symbol-function 'find-face))
+ ;; (face-list
+ ;; (function (lambda (face) (member face face-list))))
+ ;; (t
+ ;; (function (lambda (face) (boundp face))))))
(defvar cperl-guessed-background
(if (and (boundp 'font-lock-display-type)
(eq font-lock-display-type 'grayscale))
(cperl-ps-extend-face-list cperl-ps-print-face-properties)
(ps-print-buffer-with-faces file)))
-;;; (defun cperl-ps-print-init ()
-;;; "Initialization of `ps-print' components for faces used in CPerl."
-;;; ;; Guard against old versions
-;;; (defvar ps-underlined-faces nil)
-;;; (defvar ps-bold-faces nil)
-;;; (defvar ps-italic-faces nil)
-;;; (setq ps-bold-faces
-;;; (append '(font-lock-emphasized-face
-;;; cperl-array-face
-;;; font-lock-keyword-face
-;;; font-lock-variable-name-face
-;;; font-lock-constant-face
-;;; font-lock-reference-face
-;;; font-lock-other-emphasized-face
-;;; cperl-hash-face)
-;;; ps-bold-faces))
-;;; (setq ps-italic-faces
-;;; (append '(cperl-nonoverridable-face
-;;; font-lock-constant-face
-;;; font-lock-reference-face
-;;; font-lock-other-emphasized-face
-;;; cperl-hash-face)
-;;; ps-italic-faces))
-;;; (setq ps-underlined-faces
-;;; (append '(font-lock-emphasized-face
-;;; cperl-array-face
-;;; font-lock-other-emphasized-face
-;;; cperl-hash-face
-;;; cperl-nonoverridable-face font-lock-type-face)
-;;; ps-underlined-faces))
-;;; (cons 'font-lock-type-face ps-underlined-faces))
-
-
-(if (cperl-enable-font-lock) (cperl-windowed-init))
+;; (defun cperl-ps-print-init ()
+;; "Initialization of `ps-print' components for faces used in CPerl."
+;; ;; Guard against old versions
+;; (defvar ps-underlined-faces nil)
+;; (defvar ps-bold-faces nil)
+;; (defvar ps-italic-faces nil)
+;; (setq ps-bold-faces
+;; (append '(font-lock-emphasized-face
+;; cperl-array-face
+;; font-lock-keyword-face
+;; font-lock-variable-name-face
+;; font-lock-constant-face
+;; font-lock-reference-face
+;; font-lock-other-emphasized-face
+;; cperl-hash-face)
+;; ps-bold-faces))
+;; (setq ps-italic-faces
+;; (append '(cperl-nonoverridable-face
+;; font-lock-constant-face
+;; font-lock-reference-face
+;; font-lock-other-emphasized-face
+;; cperl-hash-face)
+;; ps-italic-faces))
+;; (setq ps-underlined-faces
+;; (append '(font-lock-emphasized-face
+;; cperl-array-face
+;; font-lock-other-emphasized-face
+;; cperl-hash-face
+;; cperl-nonoverridable-face font-lock-type-face)
+;; ps-underlined-faces))
+;; (cons 'font-lock-type-face ps-underlined-faces))
+
+
+(cperl-windowed-init)
(defconst cperl-styles-entries
'(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset
Choosing \"Current\" style will not change style, so this may be used for
side-effect of memorizing only. Examples in `cperl-style-examples'."
(interactive
- (let ((list (mapcar (function (lambda (elt) (list (car elt))))
- cperl-style-alist)))
- (list (completing-read "Enter style: " list nil 'insist))))
+ (list (completing-read "Enter style: " cperl-style-alist nil 'insist)))
(or cperl-old-style
(setq cperl-old-style
(mapcar (function
(lambda (name)
(cons name (eval name))))
cperl-styles-entries)))
- (let ((style (cdr (assoc style cperl-style-alist))) setting str sym)
+ (let ((style (cdr (assoc style cperl-style-alist))) setting)
(while style
(setq setting (car style) style (cdr style))
(set (car setting) (cdr setting)))))
cperl-old-style (cdr cperl-old-style))
(set (car setting) (cdr setting)))))
+(defvar perl-dbg-flags)
(defun cperl-check-syntax ()
(interactive)
(require 'mode-compile)
(set-buffer "*info-perl-tmp*")
(rename-buffer "*info*")
(set-buffer bname)))
- (make-local-variable 'window-min-height)
- (setq window-min-height 2)
+ (set (make-local-variable 'window-min-height) 2)
(current-buffer)))))
(defun cperl-word-at-point (&optional p)
default
read))))
- (let ((buffer (current-buffer))
- (cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
+ (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///"
pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner
max-height char-height buf-list)
(if (string-match "^-[a-zA-Z]$" command)
(setq imenu-create-index-function
'imenu-default-create-index-function
imenu-prev-index-position-function
- 'cperl-imenu-info-imenu-search
+ #'cperl-imenu-info-imenu-search
imenu-extract-index-name-function
- 'cperl-imenu-info-imenu-name)
+ #'cperl-imenu-info-imenu-name)
(imenu-choose-buffer-index)))))
(and index-item
(progn
\(or `cperl-indent-level', if `cperl-lineup-step' is nil).
Will not move the position at the start to the left."
(interactive "r")
- (let (search col tcol seen b)
+ (let (search col tcol seen)
(save-excursion
(goto-char end)
(end-of-line)
(if (cperl-val 'cperl-electric-parens) "" "not ")))
(defun cperl-toggle-autohelp ()
+ ;; FIXME: Turn me into a minor mode. Fix menu entries for "Auto-help on" as
+ ;; well.
"Toggle the state of Auto-Help on Perl constructs (put in the message area).
Delay of auto-help controlled by `cperl-lazy-help-time'."
(interactive)
- (if (fboundp 'run-with-idle-timer)
- (progn
- (if cperl-lazy-installed
- (cperl-lazy-unstall)
- (cperl-lazy-install))
- (message "Perl help messages will %sbe automatically shown now."
- (if cperl-lazy-installed "" "not ")))
- (message "Cannot automatically show Perl help messages - run-with-idle-timer missing.")))
+ (if cperl-lazy-installed
+ (cperl-lazy-unstall)
+ (cperl-lazy-install))
+ (message "Perl help messages will %sbe automatically shown now."
+ (if cperl-lazy-installed "" "not ")))
(defun cperl-toggle-construct-fix ()
"Toggle whether `indent-region'/`indent-sexp' fix whitespace too."
(interactive "P")
(or arg
(setq arg (if (eq cperl-syntaxify-by-font-lock
- (if backtrace 'backtrace 'message)) 0 1)))
+ (if backtrace 'backtrace 'message))
+ 0 1)))
(setq arg (if (> arg 0) (if backtrace 'backtrace 'message) t))
(setq cperl-syntaxify-by-font-lock arg)
(message "Debugging messages of syntax unwind %sabled."
(auto-fill-mode 0)
(if cperl-use-syntax-table-text-property-for-tags
(progn
- (make-local-variable 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
- (set 'parse-sexp-lookup-properties t))))
+ (set (make-local-variable 'parse-sexp-lookup-properties) t))))
;; Copied from imenu-example--name-and-position.
(defvar imenu-use-markers)
(defun cperl-xsub-scan ()
(require 'imenu)
(let ((index-alist '())
- (prev-pos 0) index index1 name package prefix)
+ index index1 name package prefix)
(goto-char (point-min))
;; Search for the function
(progn ;;save-match-data
(defun cperl-find-tags (ifile xs topdir)
(let ((b (get-buffer cperl-tmp-buffer)) ind lst elt pos ret rel
- (cperl-pod-here-fontify nil) f file)
+ (cperl-pod-here-fontify nil) file)
(save-excursion
(if b (set-buffer b)
(cperl-setup-tmp-buf))
(erase-buffer)
- (condition-case err
+ (condition-case nil
(setq file (car (insert-file-contents ifile)))
(error (if cperl-unreadable-ok nil
(if (y-or-n-p
(not xs))
(condition-case err ; after __END__ may have garbage
(cperl-find-pods-heres nil nil noninteractive)
- (error (message "While scanning for syntax: %s" err))))
+ (error (message "While scanning for syntax: %S" err))))
(if xs
(setq lst (cperl-xsub-scan))
(setq ind (cperl-imenu--create-perl-index))
(setq topdir default-directory))
(let ((tags-file-name "TAGS")
(case-fold-search (and (featurep 'xemacs) (eq system-type 'emx)))
- xs rel tm)
+ xs rel)
(save-excursion
(cond (inbuffer nil) ; Already there
((file-exists-p tags-file-name)
(erase-buffer)
(setq erase 'ignore)))
(let ((files
- (condition-case err
+ (condition-case nil
(directory-files file t
(if recurse nil cperl-scan-files-regexp)
t)
(if cperl-unreadable-ok nil
(if (y-or-n-p
(format "Directory %s unreadable. Continue? " file))
- (setq cperl-unreadable-ok t
- tm nil) ; Return empty list
+ (progn
+ (setq cperl-unreadable-ok t)
+ nil) ; Return empty list
(error "Aborting: unreadable directory %s" file)))))))
(mapc (function
(lambda (file)
(defun cperl-tags-hier-fill ()
;; Suppose we are in a tag table cooked by cperl.
(goto-char 1)
- (let (type pack name pos line chunk ord cons1 file str info fileind)
+ (let (pack name line ord cons1 file info fileind)
(while (re-search-forward cperl-tags-hier-regexp-list nil t)
- (setq pos (match-beginning 0)
- pack (match-beginning 2))
+ (setq pack (match-beginning 2))
(beginning-of-line)
(if (looking-at (concat
"\\([^\n]+\\)"
(or (nthcdr 2 elt)
;; Only in one file
(setcdr elt (cdr (nth 1 elt)))))))
- pack name cons1 to l1 l2 l3 l4 b)
+ to l1 l2 l3)
;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
(setq cperl-hierarchy (list l1 l2 l3))
(if (featurep 'xemacs) ; Not checked
(or (nth 2 cperl-hierarchy)
(error "No items found"))
(setq update
-;;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
+ ;; (imenu-choose-buffer-index "Packages: " (nth 2 cperl-hierarchy))
(if (if (fboundp 'display-popup-menus-p)
(let ((f 'display-popup-menus-p))
(funcall f))
(defun cperl-tags-treeify (to level)
;; cadr of `to' is read-write. On start it is a cons
(let* ((regexp (concat "^\\(" (mapconcat
- 'identity
+ #'identity
(make-list level "[_a-zA-Z0-9]+")
"::")
"\\)\\(::\\)?"))
(packages (cdr (nth 1 to)))
(methods (cdr (nth 2 to)))
- l1 head tail cons1 cons2 ord writeto packs recurse
- root-packages root-functions ms many_ms same_name ps
+ l1 head cons1 cons2 ord writeto recurse
+ root-packages root-functions
(move-deeper
(function
(lambda (elt)
(cond ((and (string-match regexp (car elt))
(or (eq ord 1) (match-end 2)))
(setq head (substring (car elt) 0 (match-end 1))
- tail (if (match-end 2) (substring (car elt)
- (match-end 2)))
recurse t)
(if (setq cons1 (assoc head writeto)) nil
;; Need to init new head
;;Now clean up leaders with one child only
(mapc (function (lambda (elt)
(if (not (and (listp (cdr elt))
- (eq (length elt) 2))) nil
+ (eq (length elt) 2)))
+ nil
(setcar elt (car (nth 1 elt)))
(setcdr elt (cdr (nth 1 elt))))))
(cdr to))
(sort root-packages (default-value 'imenu-sort-function)))
root-packages))))
-;;;(x-popup-menu t
-;;; '(keymap "Name1"
-;;; ("Ret1" "aa")
-;;; ("Head1" "ab"
-;;; keymap "Name2"
-;;; ("Tail1" "x") ("Tail2" "y"))))
+;;(x-popup-menu t
+;; '(keymap "Name1"
+;; ("Ret1" "aa")
+;; ("Head1" "ab"
+;; keymap "Name2"
+;; ("Tail1" "x") ("Tail2" "y"))))
(defun cperl-list-fold (list name limit)
(let (list1 list2 elt1 (num 0))
(nreverse list2))
list1)))))
-(defun cperl-menu-to-keymap (menu &optional name)
+(defun cperl-menu-to-keymap (menu)
(let (list)
(cons 'keymap
(mapcar
\f
(defvar cperl-bad-style-regexp
- (mapconcat 'identity
+ (mapconcat #'identity
'("[^-\n\t <>=+!.&|(*/'`\"#^][-=+<>!|&^]" ; char sign
"[-<>=+^&|]+[^- \t\n=+<>~]") ; sign+ char
"\\|")
(defvar cperl-not-bad-style-regexp
(mapconcat
- 'identity
+ #'identity
'("[^-\t <>=+]\\(--\\|\\+\\+\\)" ; var-- var++
"[a-zA-Z0-9_][|&][a-zA-Z0-9_$]" ; abc|def abc&def are often used.
"&[(a-zA-Z0-9_$]" ; &subroutine &(var->field)
(setq last-nonmenu-event 13) ; To disable popup
(goto-char (point-min))
(map-y-or-n-p "Insert space here? "
- (lambda (arg) (insert " "))
+ (lambda (_) (insert " "))
'cperl-next-bad-style
'("location" "locations" "insert a space into")
- '((?\C-r (lambda (arg)
- (let ((buffer-quit-function
- 'exit-recursive-edit))
- (message "Exit with Esc Esc")
- (recursive-edit)
- t)) ; Consider acted upon
+ `((?\C-r ,(lambda (_)
+ (let ((buffer-quit-function
+ #'exit-recursive-edit))
+ (message "Exit with Esc Esc")
+ (recursive-edit)
+ t)) ; Consider acted upon
"edit, exit with Esc Esc")
- (?e (lambda (arg)
- (let ((buffer-quit-function
- 'exit-recursive-edit))
- (message "Exit with Esc Esc")
- (recursive-edit)
- t)) ; Consider acted upon
+ (?e ,(lambda (_)
+ (let ((buffer-quit-function
+ #'exit-recursive-edit))
+ (message "Exit with Esc Esc")
+ (recursive-edit)
+ t)) ; Consider acted upon
"edit, exit with Esc Esc"))
t)
(if found-bad (goto-char found-bad)
(message "No appropriate place found"))))
(defun cperl-next-bad-style ()
- (let (p (not-found t) (point (point)) found)
+ (let (p (not-found t) found)
(while (and not-found
(re-search-forward cperl-bad-style-regexp nil 'to-end))
(setq p (point))
(defvar cperl-have-help-regexp
;;(concat "\\("
(mapconcat
- 'identity
+ #'identity
'("[$@%*&][0-9a-zA-Z_:]+\\([ \t]*[[{]\\)?" ; Usual variable
"[$@]\\^[a-zA-Z]" ; Special variable
"[$@][^ \n\t]" ; Special variable
(defun cperl-describe-perl-symbol (val)
"Display the documentation of symbol at point, a Perl operator."
(let ((enable-recursive-minibuffers t)
- args-file regexp)
+ regexp)
(cond
((string-match "^[&*][a-zA-Z_]" val)
(setq val (concat (substring val 0 1) "NAME")))
;; The REx is guaranteed to have //x
;; LEVEL shows how many levels deep to go
;; position at enter and at leave is not defined
- (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code pos)
+ (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline pos)
(if embed
(progn
(goto-char b)
(goto-char (match-end 1))
(re-search-backward "\\s|"))) ; Assume it is scanned already.
;;(forward-char 1)
- (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
- (sub-p (eq (preceding-char) ?s)) s)
+ (let ((b (point)) (e (make-marker)) have-x delim
+ (sub-p (eq (preceding-char) ?s)))
(forward-sexp 1)
(set-marker e (1- (point)))
(setq delim (preceding-char))
(cperl-regext-to-level-start)
(error ; We are outside outermost group
(goto-char (cperl-make-regexp-x))))
- (let ((b (point)) (e (make-marker)) s c)
+ (let ((b (point)) (e (make-marker)))
(forward-sexp 1)
(set-marker e (1- (point)))
(goto-char (1+ b))
(declare-function Man-getpage-in-background "man" (topic))
-;;
; By Anthony Foiani <afoiani@uswest.com>
-;;; Getting help on modules in C-h f ?
-;;; This is a modified version of `man'.
-;;; Need to teach it how to lookup functions
+;; By Anthony Foiani <afoiani@uswest.com>
+;; Getting help on modules in C-h f ?
+;; This is a modified version of `man'.
+;; Need to teach it how to lookup functions
;;;###autoload
(defun cperl-perldoc (word)
"Run `perldoc' on WORD."
(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)))
(require 'man)
(cond
((featurep 'xemacs)
+ (defvar Manual-program)
(let ((Manual-program "perldoc"))
(manual-entry buffer-file-name)))
(t
(and (eq (get-text-property beg 'syntax-type) 'string)
(setq beg (next-single-property-change beg 'syntax-type nil limit)))
(cperl-map-pods-heres
- (function (lambda (s e p)
+ (function (lambda (s _e _p)
(if (memq (get-text-property s 'REx-interpolated) skip)
t
(setq pp s)
(message "No more interpolated REx"))))
;;; Initial version contributed by Trey Belew
-(defun cperl-here-doc-spell (&optional beg end)
+(defun cperl-here-doc-spell ()
"Spell-check HERE-documents in the Perl buffer.
If a region is highlighted, restricts to the region."
- (interactive "")
- (cperl-pod-spell t beg end))
+ (interactive)
+ (cperl-pod-spell t))
-(defun cperl-pod-spell (&optional do-heres beg end)
+(defun cperl-pod-spell (&optional do-heres)
"Spell-check POD documentation.
If invoked with prefix argument, will do HERE-DOCs instead.
If a region is highlighted, restricts to the region."
(interactive "P")
(save-excursion
(let (beg end)
- (if (cperl-mark-active)
+ (if (region-active-p)
(setq beg (min (mark) (point))
end (max (mark) (point)))
(setq beg (point-min)
end (point-max)))
(cperl-map-pods-heres (function
- (lambda (s e p)
+ (lambda (s e _p)
(if do-heres
(setq e (save-excursion
(goto-char e)
(push-mark (cdr p) nil t)) ; Message, activate in transient-mode
(message "I do not think POS is in POD or a HERE-doc..."))))
-(defun cperl-facemenu-add-face-function (face end)
+(defun cperl-facemenu-add-face-function (face _end)
"A callback to process user-initiated font-change requests.
Translates `bold', `italic', and `bold-italic' requests to insertion of
corresponding POD directives, and `underline' to C<> POD directive.
(italic . "I<")
(bold-italic . "B<I<")
(underline . "C<")))
- (error "Face %s not configured for cperl-mode"
+ (error "Face %S not configured for cperl-mode"
face))))
\f
(defun cperl-time-fontification (&optional l step lim)
(setq pos p))))
\f
-(defun cperl-lazy-install ()) ; Avoid a warning
-(defun cperl-lazy-unstall ()) ; Avoid a warning
-
-(if (fboundp 'run-with-idle-timer)
- (progn
- (defvar cperl-help-shown nil
- "Non-nil means that the help was already shown now.")
+(defvar cperl-help-shown nil
+ "Non-nil means that the help was already shown now.")
- (defvar cperl-lazy-installed nil
- "Non-nil means that the lazy-help handlers are installed now.")
+(defvar cperl-lazy-installed nil
+ "Non-nil means that the lazy-help handlers are installed now.")
- (defun cperl-lazy-install ()
- "Switches on Auto-Help on Perl constructs (put in the message area).
+;; FIXME: Use eldoc?
+(defun cperl-lazy-install ()
+ "Switch on Auto-Help on Perl constructs (put in the message area).
Delay of auto-help controlled by `cperl-lazy-help-time'."
- (interactive)
- (make-local-variable 'cperl-help-shown)
- (if (and (cperl-val 'cperl-lazy-help-time)
- (not cperl-lazy-installed))
- (progn
- (add-hook 'post-command-hook 'cperl-lazy-hook)
- (run-with-idle-timer
- (cperl-val 'cperl-lazy-help-time 1000000 5)
- t
- 'cperl-get-help-defer)
- (setq cperl-lazy-installed t))))
-
- (defun cperl-lazy-unstall ()
- "Switches off Auto-Help on Perl constructs (put in the message area).
+ (interactive)
+ (make-local-variable 'cperl-help-shown)
+ (if (and (cperl-val 'cperl-lazy-help-time)
+ (not cperl-lazy-installed))
+ (progn
+ (add-hook 'post-command-hook #'cperl-lazy-hook)
+ (run-with-idle-timer
+ (cperl-val 'cperl-lazy-help-time 1000000 5)
+ t
+ #'cperl-get-help-defer)
+ (setq cperl-lazy-installed t))))
+
+(defun cperl-lazy-unstall ()
+ "Switch off Auto-Help on Perl constructs (put in the message area).
Delay of auto-help controlled by `cperl-lazy-help-time'."
- (interactive)
- (remove-hook 'post-command-hook 'cperl-lazy-hook)
- (cancel-function-timers 'cperl-get-help-defer)
- (setq cperl-lazy-installed nil))
+ (interactive)
+ (remove-hook 'post-command-hook #'cperl-lazy-hook)
+ (cancel-function-timers #'cperl-get-help-defer)
+ (setq cperl-lazy-installed nil))
- (defun cperl-lazy-hook ()
- (setq cperl-help-shown nil))
+(defun cperl-lazy-hook ()
+ (setq cperl-help-shown nil))
- (defun cperl-get-help-defer ()
- (if (not (memq major-mode '(perl-mode cperl-mode))) nil
- (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
- (cperl-get-help)
- (setq cperl-help-shown t))))
- (cperl-lazy-install)))
+(defun cperl-get-help-defer ()
+ (if (not (memq major-mode '(perl-mode cperl-mode))) nil
+ (let ((cperl-message-on-help-error nil) (cperl-help-from-timer t))
+ (cperl-get-help)
+ (setq cperl-help-shown t))))
+(cperl-lazy-install)
;;; Plug for wrong font-lock:
(defun cperl-font-lock-unfontify-region-function (beg end)
- (let* ((modified (buffer-modified-p)) (buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark buffer-file-name buffer-file-truename)
- (remove-text-properties beg end '(face nil))
- (if (and (not modified) (buffer-modified-p))
- (set-buffer-modified-p nil))))
+ (with-silent-modifications
+ (remove-text-properties beg end '(face nil))))
(defun cperl-font-lock-fontify-region-function (beg end loudly)
"Extends the region to safe positions, then calls the default function.
(font-lock-default-fontify-region beg end loudly))
(defvar cperl-d-l nil)
+(defvar edebug-backtrace-buffer)
(defun cperl-fontify-syntaxically (end)
;; Some vars for debugging only
;; (message "Syntaxifying...")
nil) ; Do not iterate
;; Called when any modification is made to buffer text.
-(defun cperl-after-change-function (beg end old-len)
+(defun cperl-after-change-function (beg _end _old-len)
;; We should have been informed about changes by `font-lock'. Since it
;; does not inform as which calls are deferred, do it ourselves
(if cperl-syntax-done-to
projects / emacs.git / commitdiff