;;; cperl-mode.el --- Perl code editing commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
-;; 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1991-2014 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich
;; Bob Olson
"use cperl-vc-rcs-header or cperl-vc-sccs-header instead."
"22.1")
-(defcustom cperl-clobber-mode-lists
- (not
- (and
- (boundp 'interpreter-mode-alist)
- (assoc "miniperl" interpreter-mode-alist)
- (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
- "*Whether to install us into `interpreter-' and `extension' mode lists."
- :type 'boolean
- :group 'cperl)
+;; (defcustom cperl-clobber-mode-lists
+;; (not
+;; (and
+;; (boundp 'interpreter-mode-alist)
+;; (assoc "miniperl" interpreter-mode-alist)
+;; (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
+;; "*Whether to install us into `interpreter-' and `extension' mode lists."
+;; :type 'boolean
+;; :group 'cperl)
(defcustom cperl-info-on-command-no-prompt nil
"*Not-nil (and non-null) means not to prompt on C-h f.
"*Non-nil means that the _ (underline) should be treated as word char."
:type 'boolean
:group 'cperl)
+(make-obsolete-variable 'cperl-under-as-char 'superword-mode "24.4")
(defcustom cperl-extra-perl-args ""
"*Extra arguments to use when starting Perl.
(defcustom cperl-syntaxify-by-font-lock
(and cperl-can-font-lock
(boundp 'parse-sexp-lookup-properties))
- "*Non-nil means that CPerl uses `font-lock's routines for syntaxification."
+ "*Non-nil means that CPerl uses the `font-lock' routines for syntaxification."
:type '(choice (const message) boolean)
:group 'cperl-speed)
b) Can lineup vertically \"middles\" of rows, like `=' in
a = b;
cc = d;
- c) Can insert spaces where this impoves readability (in one
+ c) Can insert spaces where this improves readability (in one
interactive sweep over the buffer);
d) Has support for imenu, including:
1) Separate unordered list of \"interesting places\";
9) When doing indentation of control constructs, may correct
line-breaks/spacing between elements of the construct.
-10) Uses a linear-time algorith for indentation of regions (on Emaxen with
+10) Uses a linear-time algorithm for indentation of regions (on Emaxen with
capable syntax engines).
11) Syntax-highlight, indentation, sexp-recognition inside regular expressions.
A1) CPerl may work around these deficiencies (for big chunks, mostly
PODs and HERE-documents), or
- A2) On capable Emaxen CPerl will use improved syntax-handlings
+ A2) On capable Emaxen CPerl will use improved syntax-handling
which reads mark-up hints directly.
The scan in case A2 is much more comprehensive, thus may be slower.
`cperl-array-face' Array names
`cperl-hash-face' Hash names
`font-lock-comment-face' Comments, PODs and whatever is considered
- syntaxically to be not code
+ syntactically to be not code
`font-lock-constant-face' HERE-doc delimiters, labels, delimiters of
2-arg operators s/y/tr/ or of RExen,
`font-lock-warning-face' Special-cased m// and s//foo/,
`cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen
`font-lock-string-face' Strings, qw() constructs, RExen, POD sections,
literal parts and the terminator of formats
- and whatever is syntaxically considered
+ and whatever is syntactically considered
as string literals
`font-lock-type-face' Overridable keywords
`font-lock-variable-name-face' Variable declarations, indirect array and
"----"
["Ispell PODs" cperl-pod-spell
;; Better not to update syntaxification here:
- ;; debugging syntaxificatio can be broken by this???
+ ;; debugging syntaxification can be broken by this???
(or
(get-text-property (point-min) 'in-pod)
(< (progn
(get-text-property (point) 'syntax-type))
'(here-doc pod))]
"----"
- ["CPerl pretty print (exprmntl)" cperl-ps-print
+ ["CPerl pretty print (experimental)" cperl-ps-print
(fboundp 'ps-extend-face-list)]
"----"
["Syntaxify region" cperl-find-pods-heres-region
;;; These two must be unwound, otherwise take exponential time
(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
-"Regular expression to match optional whitespace with interpspersed comments.
+"Regular expression to match optional whitespace with interspersed comments.
Should contain exactly one group.")
;;; This one is tricky to unwind; still very inefficient...
(defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+"
-"Regular expression to match whitespace with interpspersed comments.
+"Regular expression to match whitespace with interspersed comments.
Should contain exactly one group.")
(defvar cperl-font-locking nil)
;; NB as it stands the code in cperl-mode assumes this only has one
-;; element. If Xemacs 19 support were dropped, this could all be simplified.
+;; element. If XEmacs 19 support were dropped, this could all be simplified.
(defvar cperl-compilation-error-regexp-alist
;; This look like a paranoiac regexp: could anybody find a better one? (which WORKS).
'(("^[^\n]* \\(file\\|at\\) \\([^ \t\n]+\\) [^\n]*line \\([0-9]+\\)[\\., \n]"
(defvar compilation-error-regexp-alist)
;;;###autoload
-(defun cperl-mode ()
+(define-derived-mode cperl-mode prog-mode "CPerl"
"Major mode for editing Perl code.
Expression and list commands understand all C brackets.
Tab indents for Perl code.
since most the time you mean \"less\". CPerl mode tries to guess
whether you want to type pair <>, and inserts is if it
appropriate. You can set `cperl-electric-parens-string' to the string that
-contains the parenths from the above list you want to be electrical.
-Electricity of parenths is controlled by `cperl-electric-parens'.
+contains the parens from the above list you want to be electrical.
+Electricity of parens is controlled by `cperl-electric-parens'.
You may also set `cperl-electric-parens-mark' to have electric parens
look for active mark and \"embrace\" a region if possible.'
The user types the keyword immediately followed by a space, which
causes the construct to be expanded, and the point is positioned where
-she is most likely to want to be. eg. when the user types a space
+she is most likely to want to be. E.g., when the user types a space
following \"if\" the following appears in the buffer: if () { or if ()
} { } and the cursor is between the parentheses. The user can then
type some boolean expression within the parens. Having done that,
DO NOT FORGET to read micro-docs (available from `Perl' menu)
or as help on variables `cperl-tips', `cperl-problems',
`cperl-praise', `cperl-speed'."
- (interactive)
- (kill-all-local-variables)
- (use-local-map cperl-mode-map)
(if (cperl-val 'cperl-electric-linefeed)
(progn
(local-set-key "\C-J" 'cperl-linefeed)
(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])))
- (setq major-mode cperl-use-major-mode)
- (setq mode-name "CPerl")
(let ((prev-a-c abbrevs-changed))
(define-abbrev-table 'cperl-mode-abbrev-table '(
("if" "if" cperl-electric-keyword 0)
(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
+ (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)
(funcall f))
(make-local-variable 'compilation-error-regexp-alist)
(push 'cperl compilation-error-regexp-alist)))
- ((boundp 'compilation-error-regexp-alist);; xmeacs 19.x
+ ((boundp 'compilation-error-regexp-alist);; xemacs 19.x
(make-local-variable 'compilation-error-regexp-alist)
(set 'compilation-error-regexp-alist
(append cperl-compilation-error-regexp-alist
(make-local-variable 'cperl-syntax-state)
(setq cperl-syntax-state nil) ; reset syntaxification cache
(if cperl-use-syntax-table-text-property
- (if (boundp 'syntax-propertize-function)
+ (if (eval-when-compile (fboundp 'syntax-propertize-rules))
(progn
;; Reset syntaxification cache.
(set (make-local-variable 'cperl-syntax-done-to) nil)
(set (make-local-variable 'syntax-propertize-function)
(lambda (start end)
- (goto-char start) (cperl-fontify-syntaxically end))))
+ (goto-char start)
+ ;; Even if cperl-fontify-syntaxically has already gone
+ ;; beyond `start', syntax-propertize has just removed
+ ;; syntax-table properties between start and end, so we have
+ ;; 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)
(and (boundp 'msb-menu-cond)
(not cperl-msb-fixed)
(cperl-msb-fix))
- (if (featurep 'easymenu)
+ (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
nil t)))) ; Only one
(progn
(forward-word 1)
- (setq name (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name)))
+ (setq name (file-name-base)
p (point))
(insert " NAME\n\n" name
" - \n\n=head1 SYNOPSIS\n\n\n\n"
(goto-char (cperl-beginning-of-property p look-prop))
(beginning-of-line)
(setq pre-indent-point (point)))))
- (goto-char pre-indent-point) ; Orig line skipping preceeding pod/etc
+ (goto-char pre-indent-point) ; Orig line skipping preceding pod/etc
(let* ((case-fold-search nil)
(s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
(start (or (nth 2 parse-data) ; last complete sexp terminated
(cperl-1+ char-after-pos) 'indentable)
p (1+ (cperl-beginning-of-property
(point) 'indentable))
- is-block ; misused for: preceeding line in REx
- (save-excursion ; Find preceeding line
+ is-block ; misused for: preceding line in REx
+ (save-excursion ; Find preceding line
(cperl-backward-to-noncomment p)
(beginning-of-line)
(if (<= (point) p)
(skip-chars-forward " \t")
(if (memq (char-after (point))
(append "#\n" nil))
- nil ; Can't use intentation of this line...
+ nil ; Can't use indentation of this line...
(point)))
(skip-chars-forward " \t")
(point)))
prop (parse-partial-sexp p char-after-pos))
(cond ((not delim) ; End the REx, ignore is-block
(vector 'indentable 'terminator p is-block))
- (is-block ; Indent w.r.t. preceeding line
+ (is-block ; Indent w.r.t. preceding line
(vector 'indentable 'cont-line char-after-pos
is-block char-after p))
- (t ; No preceeding line...
+ (t ; No preceding line...
(vector 'indentable 'first-line p))))
((get-text-property char-after-pos 'REx-part2)
(vector 'REx-part2 (point)))
(cperl-backward-to-start-of-continued-exp containing-sexp))
(beginning-of-line)
(cperl-backward-to-noncomment containing-sexp))
- ;; Now we get non-label preceeding the indent point
+ ;; Now we get non-label preceding the indent point
(if (not (or (eq (1- (point)) containing-sexp)
(memq (preceding-char)
(append (if is-block " ;{" " ,;{") '(nil)))
((eq 'continuation (elt i 0))
;; [continuation statement-start char-after is-block is-brace]
(goto-char (elt i 1)) ; statement-start
- (+ (if (memq (elt i 2) (append "}])" nil)) ; char-after
- 0 ; Closing parenth
+ (+ (if (or (memq (elt i 2) (append "}])" nil)) ; char-after
+ (eq 'continuation ; do not stagger continuations
+ (elt (cperl-sniff-for-indent parse-data) 0)))
+ 0 ; Closing parenth or continuation of a continuation
cperl-continued-statement-offset)
(if (or (elt i 3) ; is-block
(not (elt i 4)) ; is-brace
(if end
;; Do the same for end, going small steps
(save-excursion
- (while (and end (get-text-property end 'syntax-type))
+ (while (and end (< end (point-max))
+ (get-text-property end 'syntax-type))
(setq pos end
end (next-single-property-change end 'syntax-type nil (point-max)))
(if end (progn (goto-char end)
(defvar font-lock-warning-face)
(defun cperl-find-sub-attrs (&optional st-l b-fname e-fname pos)
- "Syntaxically mark (and fontify) attributes of a subroutine.
+ "Syntactically mark (and fontify) attributes of a subroutine.
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 '()
(forward-char 2))
(and (eq (following-char) ?\] )
(forward-char 1)))
- (setq REx-subgr-end qtag) ;EndOf smart-highlighed
+ (setq REx-subgr-end qtag) ;End smart-highlighted
;; Apparently, I can't put \] into a charclass
;; in m]]: m][\\\]\]] produces [\\]]
;;; POSIX? [:word:] [:^word:] only inside []
;;; Moreover, one takes positive approach (looks for else,grep etc)
;;; another negative (looks for bless,tr etc)
(defun cperl-after-block-p (lim &optional pre-block)
- "Return true if the preceeding } (if PRE-BLOCK, following {) delimits a block.
+ "Return true if the preceding } (if PRE-BLOCK, following {) delimits a block.
Would not look before LIM. Assumes that LIM is a good place to begin a
statement. The kind of block we treat here is one after which a new
statement would start; thus the block in ${func()} does not count."
(progn
(forward-sexp -1)
(looking-at "sub[ \t\n\f#]"))))))
- ;; What preceeds is not word... XXXX Last statement in sub???
+ ;; What precedes is not word... XXXX Last statement in sub???
(cperl-after-expr-p lim))))
(error nil))))
(setq top (point))
;; Plan A: if line has an unfinished paren-group, go to end-of-group
(while (= -1 (nth 0 (parse-partial-sexp (point) tmp-end -1)))
- (setq top (point))) ; Get the outermost parenths in line
+ (setq top (point))) ; Get the outermost parens in line
(goto-char top)
(while (< (point) tmp-end)
(parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
;; "\\|")
'("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
- ;; This highlights declarations and definitions differenty.
+ ;; This highlights declarations and definitions differently.
;; We do not try to highlight in the case of attributes:
;; it is already done by `cperl-find-pods-heres'
(list (concat "\\<sub"
3 font-lock-variable-name-face)))
'("\\<for\\(each\\)?\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
4 font-lock-variable-name-face)
- ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntaxically
+ ;; Avoid $!, and s!!, qq!! etc. when not fontifying syntactically
'("\\(?:^\\|[^smywqrx$]\\)\\(!\\)" 1 font-lock-negation-char-face)
'("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)))
(setq
(error (message "cperl-init-faces (ignored): %s" errs))))
+(defvar ps-bold-faces)
+(defvar ps-italic-faces)
+(defvar ps-underlined-faces)
+
(defun cperl-ps-print-init ()
"Initialization of `ps-print' components for faces used in CPerl."
(eval-after-load "ps-print"
The current value of style is memorized (unless there is a memorized
data already), may be restored by `cperl-set-style-back'.
-Chosing \"Current\" style will not change style, so this may be used for
+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))))
(let ((perl-dbg-flags (concat cperl-extra-perl-args " -wc")))
(eval '(mode-compile)))) ; Avoid a warning
+(declare-function Info-find-node "info"
+ (filename nodename &optional no-going-back strict-case))
+
(defun cperl-info-buffer (type)
;; Returns buffer with documentation. Creates if missing.
;; If TYPE, this vars buffer.
(buffer-substring
(match-beginning 1) (match-end 1)))
+(declare-function imenu-choose-buffer-index "imenu" (&optional prompt alist))
+
(defun cperl-imenu-on-info ()
"Shows imenu for Perl Info Buffer.
Opens Perl Info buffer if needed."
(interactive)
+ (require 'imenu)
(let* ((buffer (current-buffer))
imenu-create-index-function
imenu-prev-index-position-function
(defvar cperl-hierarchy '(() ())
"Global hierarchy of classes.")
+;; Follows call to (autoloaded) visit-tags-table.
+(declare-function file-of-tag "etags" (&optional relative))
+(declare-function etags-snarf-tag "etags" (&optional use-explicit))
+
(defun cperl-tags-hier-fill ()
;; Suppose we are in a tag table cooked by cperl.
(goto-char 1)
(end-of-line))))
(declare-function x-popup-menu "menu.c" (position menu))
+(declare-function etags-goto-tag-location "etags" (tag-info))
(defun cperl-tags-hier-init (&optional update)
"Show hierarchical menu of classes and methods.
... &= ... Bitwise and assignment.
... * ... Multiplication.
... ** ... Exponentiation.
-*NAME Glob: all objects refered by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
+*NAME Glob: all objects referred by NAME. *NAM1 = *NAM2 aliases NAM1 to NAM2.
&NAME(arg0, ...) Subroutine call. Arguments go to @_.
... + ... Addition. +EXPR Makes EXPR into scalar context.
++ Auto-increment (magical on strings). ++EXPR EXPR++
;;(error "Not at `if', `unless', `while', `until', `for' or `foreach'")
(cperl-invert-if-unless-modifiers)))
+(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'.
(pargs (cdr (car flist))))
(setq command
(concat command " | " pcom " "
- (mapconcat '(lambda (phrase)
- (if (not (stringp phrase))
- (error "Malformed Man-filter-list"))
- phrase)
+ (mapconcat (lambda (phrase)
+ (if (not (stringp phrase))
+ (error "Malformed Man-filter-list"))
+ phrase)
pargs " ")))
(setq flist (cdr flist))))
command))
(beginning-of-line)
(eq (get-text-property (setq beg (point)) 'syntax-type)
'multiline)))
- (if (setq beg (cperl-beginning-of-property beg 'syntax-type))
- (goto-char beg)))
+ (let ((new-beg (cperl-beginning-of-property beg 'syntax-type)))
+ (setq beg (if (= new-beg beg) nil new-beg))
+ (goto-char new-beg)))
(setq beg (point))
(goto-char end)
(while (and end
;; Called when any modification is made to buffer text.
(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 defered, do it ourselves
+ ;; does not inform as which calls are deferred, do it ourselves
(if cperl-syntax-done-to
(setq cperl-syntax-done-to (min cperl-syntax-done-to beg))))
(defun cperl-update-syntaxification (from to)
- (if (and cperl-use-syntax-table-text-property
- cperl-syntaxify-by-font-lock
- (or (null cperl-syntax-done-to)
- (< cperl-syntax-done-to to)))
- (progn
- (save-excursion
- (goto-char from)
- (cperl-fontify-syntaxically to)))))
+ (cond
+ ((not cperl-use-syntax-table-text-property) nil)
+ ((fboundp 'syntax-propertize) (syntax-propertize to))
+ ((and cperl-syntaxify-by-font-lock
+ (or (null cperl-syntax-done-to)
+ (< cperl-syntax-done-to to)))
+ (save-excursion
+ (goto-char from)
+ (cperl-fontify-syntaxically to)))))
(defvar cperl-version
(let ((v "Revision: 6.2"))
(substring v (match-beginning 1) (match-end 1)))
"Version of IZ-supported CPerl package this file is based on.")
-(defun cperl-mode-unload-function ()
- "Unload the Cperl mode library."
- (let ((new-mode (if (eq (symbol-function 'perl-mode) 'cperl-mode)
- 'fundamental-mode
- 'perl-mode)))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (eq major-mode 'cperl-mode)
- (funcall new-mode)))))
- ;; continue standard unloading
- nil)
-
(provide 'cperl-mode)
;;; cperl-mode.el ends here
HCoop / bpt / emacs.git / blobdiff