;;; 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
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1991-2011 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich
;; Bob Olson
(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.
(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
(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.
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)
(set 'vc-rcs-header cperl-vc-rcs-header)
(make-local-variable 'vc-sccs-header)
(set 'vc-sccs-header cperl-vc-sccs-header)
- ;; This one is obsolete...
- (make-local-variable 'vc-header-alist)
- (with-no-warnings
- (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
- `((SCCS ,(car cperl-vc-sccs-header))
- (RCS ,(car cperl-vc-rcs-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))))))
(cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
(make-local-variable 'compilation-error-regexp-alist-alist)
(set 'compilation-error-regexp-alist-alist
(make-local-variable 'cperl-syntax-state)
(setq cperl-syntax-state nil) ; reset syntaxification cache
(if cperl-use-syntax-table-text-property
- (progn
+ (if (boundp 'syntax-propertize-function)
+ (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))))
(make-local-variable 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
(set 'parse-sexp-lookup-properties t)
"Insert an opening parenthesis or a matching pair of parentheses.
See `cperl-electric-parens'."
(interactive "P")
- (let ((beg (save-excursion (beginning-of-line) (point)))
+ (let ((beg (point-at-bol))
(other-end (if (and cperl-electric-parens-mark
(cperl-mark-active)
(> (mark) (point)))
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 (save-excursion (beginning-of-line) (point)))
+ (let ((beg (point-at-bol))
(other-end (if (and cperl-electric-parens-mark
(cperl-val 'cperl-electric-parens)
(memq last-command-event
"Insert a construction appropriate after a keyword.
Help message may be switched off by setting `cperl-message-electric-keyword'
to nil."
- (let ((beg (save-excursion (beginning-of-line) (point)))
+ (let ((beg (point-at-bol))
(dollar (and (eq last-command-event ?$)
(eq this-command 'self-insert-command)))
(delete (and (memq last-command-event '(?\s ?\n ?\t ?\f))
"Insert a construction appropriate after a keyword.
Help message may be switched off by setting `cperl-message-electric-keyword'
to nil."
- (let ((beg (save-excursion (beginning-of-line) (point))))
+ (let ((beg (point-at-bol)))
(and (save-excursion
(backward-sexp 1)
(cperl-after-expr-p nil "{;:"))
"Go to end of line, open a new line and indent appropriately.
If in POD, insert appropriate lines."
(interactive)
- (let ((beg (save-excursion (beginning-of-line) (point)))
- (end (save-excursion (end-of-line) (point)))
+ (let ((beg (point-at-bol))
+ (end (point-at-eol))
(pos (point)) start over cut res)
(if (and ; Check if we need to split:
; i.e., on a boundary and inside "{...}"
(forward-paragraph -1)
(forward-word 1)
(setq pos (point))
- (setq cut (buffer-substring (point)
- (save-excursion
- (end-of-line)
- (point))))
- (delete-char (- (save-excursion (end-of-line) (point))
- (point)))
+ (setq cut (buffer-substring (point) (point-at-eol)))
+ (delete-char (- (point-at-eol) (point)))
(setq res (expand-abbrev))
(save-excursion
(goto-char pos)
(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)))
(point-max)))) ; do not loop if no syntaxification
;; label:
(t
- (save-excursion (end-of-line)
- (setq colon-line-end (point)))
+ (setq colon-line-end (point-at-eol))
(search-forward ":"))))
;; We are at beginning of code (NOT label or comment)
;; First, the following code counts
(looking-at "sub\\>")))
(setq p (nth 1 ; start of innermost containing list
(parse-partial-sexp
- (save-excursion (beginning-of-line)
- (point))
+ (point-at-bol)
(point)))))
(progn
(goto-char (1+ p)) ; enclosing block on the same line
Returns true if comment is found. In POD will not move the point."
;; If the line is inside other syntax groups (qq-style strings, HERE-docs)
;; then looks for literal # or end-of-line.
- (let (state stop-in cpoint (lim (progn (end-of-line) (point))) pr e)
+ (let (state stop-in cpoint (lim (point-at-eol)) pr e)
(or cperl-font-locking
(cperl-update-syntaxification lim lim))
(beginning-of-line)
indentable t))
;; Need to remove face as well...
(goto-char min)
- (and (eq system-type 'emx)
+ ;; '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
- (save-excursion (end-of-line) (point))
+ (point-at-eol)
nil))
(while (and
(< (point) max)
"")
tb (match-beginning 0))
(setq argument nil)
- (put-text-property (save-excursion
- (beginning-of-line)
- (point))
- b 'first-format-line 't)
+ (put-text-property (point-at-bol) b 'first-format-line 't)
(if cperl-pod-here-fontify
(while (and (eq (forward-line) 0)
(not (looking-at "^[.;]$")))
(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))))
conditional/loop constructs."
(interactive)
(save-excursion
- (let ((tmp-end (progn (end-of-line) (point))) top done)
+ (let ((tmp-end (point-at-eol)) top done)
(save-excursion
(beginning-of-line)
(while (null done)
"\\<\\(else\\|elsif\|continue\\)\\>"))
(progn
(goto-char (match-end 0))
- (save-excursion
- (end-of-line)
- (setq tmp-end (point))))
+ (setq tmp-end (point-at-eol)))
(setq done t))))
- (save-excursion
- (end-of-line)
- (setq tmp-end (point))))
+ (setq tmp-end (point-at-eol)))
(goto-char tmp-end)
(setq tmp-end (point-marker)))
(if cperl-indent-region-fix-constructs
(interactive)
(or end
(setq end (point-max)))
- (let ((ee (save-excursion (end-of-line) (point)))
+ (let ((ee (point-at-eol))
(cperl-indent-region-fix-constructs
(or cperl-indent-region-fix-constructs 1))
p pp ml have-brace ret)
(if (cperl-indent-line parse-data)
(setq ret (cperl-fix-line-spacing end parse-data)))))))))))
(beginning-of-line)
- (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
+ (setq p (point) pp (point-at-eol)) ; May be different from ee.
;; Now check whether there is a hanging `}'
;; Looking at:
;; } blah
;; "\\|")
'("-[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"
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))))
(or topdir
(setq topdir default-directory))
(let ((tags-file-name "TAGS")
- (case-fold-search (eq system-type 'emx))
+ (case-fold-search (and (featurep 'xemacs) (eq system-type 'emx)))
xs rel tm)
(save-excursion
(cond (inbuffer nil) ; Already there
;; Get to the something meaningful
(or (eobp) (eolp) (forward-char 1))
(re-search-backward "[-a-zA-Z0-9_:!&*+,-./<=>?\\\\^|~$%@]"
- (save-excursion (beginning-of-line) (point))
+ (point-at-bol)
'to-beg)
;; (cond
;; ((or (eobp) (looking-at "[][ \t\n{}();,]")) ; Not at a symbol
(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))
;; 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))))
(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)
-;; arch-tag: 42e5b19b-e187-4537-929f-1a7408980ce6
;;; cperl-mode.el ends here
HCoop / bpt / emacs.git / blobdiff