From eaef395b7d21f6174909c0f68ca15436e874679c Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Tue, 14 Aug 2007 03:48:52 +0000 Subject: [PATCH] update cperl mode --- emacs_el/cperl-mode.el | 1920 +++++++++++++++++++++++++++------------- 1 file changed, 1285 insertions(+), 635 deletions(-) diff --git a/emacs_el/cperl-mode.el b/emacs_el/cperl-mode.el index 26149f9..e795286 100644 --- a/emacs_el/cperl-mode.el +++ b/emacs_el/cperl-mode.el @@ -1,11 +1,11 @@ ;;; cperl-mode.el --- Perl code editing commands for Emacs ;; Copyright (C) 1985, 86, 87, 91, 92, 93, 94, 95, 96, 97, 98, 99, -;; 2000, 2003, 2005 +;; 2000, 2003, 2005, 2006 ;; Free Software Foundation, Inc. ;; Author: Ilya Zakharevich and Bob Olson -;; Maintainer: Ilya Zakharevich +;; Maintainer: Ilya Zakharevich ;; Keywords: languages, Perl ;; This file is part of GNU Emacs. @@ -40,12 +40,12 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Corrections made by Ilya Zakharevich cperl@ilyaz.org +;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de ;;; Commentary: -;; $Id: cperl-mode.el,v 5.19 2006/06/01 11:11:57 vera Exp vera $ +;; $Id: cperl-mode.el,v 5.23 2007/02/15 11:34:23 vera Exp vera $ ;;; If your Emacs does not default to `cperl-mode' on Perl files: ;;; To use this mode put the following into @@ -1354,8 +1354,8 @@ ;;; `cperl-unwind-to-safe': `cperl-beginning-of-property' won't return nil ;;; `cperl-syntaxify-for-menu': New customization variable ;;; `cperl-select-this-pod-or-here-doc': New function -;;; `cperl-get-here-doc-region': Extra argument. -;;; Do not adjust pos by 1. +;;; `cperl-get-here-doc-region': Extra argument +;;; Do not adjust pos by 1 ;;; New menu entries (Perl/Tools): selection of current POD or HERE-DOC section ;;; (Debugging CPerl:) backtrace on fontification @@ -1365,13 +1365,13 @@ ;;; `cperl-forward-re': Remove spurious argument SET-ST ;;; Add documentation ;;; `cperl-forward-group-in-re': New function -;;; `cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen. +;;; `cperl-find-pods-heres': Find and highlight (?{}) blocks in RExen ;;; (XXXX Temporary (?) hack is to syntax-mark them as comment) ;;; After 5.13: ;;; `cperl-string-syntax-table': Make { and } not-grouping ;;; (Sometimes they ARE grouping in RExen, but matching them would only -;;; confuse in many situations when they are not). +;;; confuse in many situations when they are not) ;;; `beginning-of-buffer': Replaced two occurences with goto-char... ;;; `cperl-calculate-indent': `char-after' could be nil... ;;; `cperl-find-pods-heres': REx can start after "[" too @@ -1379,7 +1379,7 @@ ;;; `cperl-maybe-white-and-comment-rex': New constant ;;; `cperl-white-and-comment-rex': Likewise ;;; XXXX Not very efficient, but hard to make -;;; better while keeping 1 group. +;;; better while keeping 1 group ;;; After 5.13: ;;; `cperl-find-pods-heres': $foo << identifier() is not a HERE-DOC @@ -1399,7 +1399,7 @@ ;;; Invert highlighting of charclasses: ;;; now the envelop is highlighted ;;; Highlight many others 0-length builtins -;;; `cperl-praise': Mention indenting and highlight in RExen. +;;; `cperl-praise': Mention indenting and highlight in RExen ;;; After 5.15: ;;; `cperl-find-pods-heres': Highlight capturing parens in REx @@ -1415,7 +1415,7 @@ ;;; batch processing) etc ;;; Use `font-lock-builtin-face' for builtin in REx ;;; Now `font-lock-variable-name-face' -;;; is used for interpolated variables. +;;; is used for interpolated variables ;;; Use "talking aliases" for faces inside REx ;;; Highlight parts of REx (except in charclasses) ;;; according to the syntax and/or semantic @@ -1433,21 +1433,75 @@ ;;; `cperl-find-pods-heres': Misprint in REx for parsing REx ;;; Very minor optimization ;;; `my-cperl-REx-modifiers-face' got quoted -;;; Recognize "print $foo < indent 0) (setq indent (max cperl-min-label-indent (+ indent cperl-label-offset))))) @@ -4148,41 +4234,37 @@ Will not look before LIM." ;;; (point-min)))) ) -(defun cperl-calculate-indent (&optional parse-data) ; was parse-start - "Return appropriate indentation for current line as Perl code. -In usual case returns an integer: the column to indent to. -Returns nil if line starts inside a string, t if in a comment. - -Will not correct the indentation for labels, but will correct it for braces -and closing parentheses and brackets." +(defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start + ;; Old workhorse for calculation of indentation; the major problem + ;; is that it mixes the sniffer logic to understand what the current line + ;; MEANS with the logic to actually calculate where to indent it. + ;; The latter part should be eventually moved to `cperl-calculate-indent'; + ;; actually, this is mostly done now... (cperl-update-syntaxification (point) (point)) - (save-excursion - (if (or - (and (memq (get-text-property (point) 'syntax-type) - '(pod here-doc here-doc-delim format)) - (not (get-text-property (point) 'indentable))) - ;; before start of POD - whitespace found since do not have 'pod! - (and (looking-at "[ \t]*\n=") - (error "Spaces before POD section!")) - (and (not cperl-indent-left-aligned-comments) - (looking-at "^#"))) - nil - (beginning-of-line) - (let* ((indent-point (point)) - (char-after-pos (save-excursion - (skip-chars-forward " \t") - (point))) - (char-after (char-after char-after-pos)) - (in-pod (get-text-property (point) 'in-pod)) - (pre-indent-point (point)) - p prop look-prop is-block delim) - (cond - (in-pod - ;; In the verbatim part, probably code example. What to do??? - ) - (t - (save-excursion - ;; Not in POD + (let ((res (get-text-property (point) 'syntax-type))) + (save-excursion + (cond + ((and (memq res '(pod here-doc here-doc-delim format)) + (not (get-text-property (point) 'indentable))) + (vector res)) + ;; before start of POD - whitespace found since do not have 'pod! + ((looking-at "[ \t]*\n=") + (error "Spaces before POD section!")) + ((and (not cperl-indent-left-aligned-comments) + (looking-at "^#")) + [comment-special:at-beginning-of-line]) + ((get-text-property (point) 'in-pod) + [in-pod]) + (t + (beginning-of-line) + (let* ((indent-point (point)) + (char-after-pos (save-excursion + (skip-chars-forward " \t") + (point))) + (char-after (char-after char-after-pos)) + (pre-indent-point (point)) + p prop look-prop is-block delim) + (save-excursion ; Know we are not in POD, find appropriate pos before (cperl-backward-to-noncomment nil) (setq p (max (point-min) (1- (point))) prop (get-text-property p 'syntax-type) @@ -4192,493 +4274,430 @@ and closing parentheses and brackets." (progn (goto-char (cperl-beginning-of-property p look-prop)) (beginning-of-line) - (setq pre-indent-point (point))))))) - (goto-char pre-indent-point) - (let* ((case-fold-search nil) - (s-s (cperl-get-state (car parse-data) (nth 1 parse-data))) - (start (or (nth 2 parse-data) - (nth 0 s-s))) - (state (nth 1 s-s)) - (containing-sexp (car (cdr state))) - old-indent) - (if (and - ;;containing-sexp ;; We are buggy at toplevel :-( - parse-data) - (progn - (setcar parse-data pre-indent-point) - (setcar (cdr parse-data) state) - (or (nth 2 parse-data) - (setcar (cddr parse-data) start)) - ;; Before this point: end of statement - (setq old-indent (nth 3 parse-data)))) - (cond ((get-text-property (point) 'indentable) - ;; indent to "after" the surrounding open - ;; (same offset as `cperl-beautify-regexp-piece'), - ;; skip blanks if we do not close the expression. - (setq delim ; We do not close the expression - (get-text-property - (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 - (cperl-backward-to-noncomment p) - (beginning-of-line) - (if (<= (point) p) - (progn ; get indent from the first line - (goto-char p) - (skip-chars-forward " \t") - (if (memq (char-after (point)) - (append "#\n" nil)) - nil ; Can't use intentation of this line... - (point))) - (skip-chars-forward " \t") - (point))) - prop (parse-partial-sexp p char-after-pos)) - (cond ((not delim) - (goto-char p) ; beginning of REx etc - (1- (current-column))) ; End the REx, ignore is-block - (is-block - ;; Indent as the level after closing parens - (goto-char char-after-pos) - (skip-chars-forward " \t)") - (setq char-after-pos (point)) - (goto-char is-block) - (skip-chars-forward " \t)") - (setq p (parse-partial-sexp (point) char-after-pos)) - (goto-char is-block) - (+ (* (nth 0 p) - (or cperl-regexp-indent-step cperl-indent-level)) - (cond ((eq char-after ?\) ) - (- cperl-close-paren-offset)) ; compensate - ((eq char-after ?\| ) - (- (or cperl-regexp-indent-step cperl-indent-level))) - (t 0)) - (if (eq (following-char) ?\| ) - (or cperl-regexp-indent-step cperl-indent-level) - 0) - (current-column))) - ;; Now we have no preceeding line... - (t - (goto-char p) - (+ (or cperl-regexp-indent-step cperl-indent-level) - -1 - (current-column))))) - ((get-text-property char-after-pos 'REx-part2) - (condition-case nil ; Use indentation of the 1st part - (forward-sexp -1)) - (current-column)) - ((or (nth 3 state) (nth 4 state)) - ;; return nil or t if should not change this line - (nth 4 state)) - ;; XXXX Do we need to special-case this? - ((null containing-sexp) - ;; Line is at top level. May be data or function definition, - ;; or may be function argument declaration. - ;; Indent like the previous top level line - ;; unless that ends in a closeparen without semicolon, - ;; in which case this line is the first argument decl. - (skip-chars-forward " \t") - (+ (save-excursion - (goto-char start) - (- (current-indentation) - (if (nth 2 s-s) cperl-indent-level 0))) - (if (eq char-after ?{) cperl-continued-brace-offset 0) - (progn - (cperl-backward-to-noncomment (or old-indent (point-min))) - ;; Look at previous line that's at column 0 - ;; to determine whether we are in top-level decls - ;; or function's arg decls. Set basic-indent accordingly. - ;; Now add a little if this is a continuation line. - (if (or (bobp) - (eq (point) old-indent) ; old-indent was at comment - (eq (preceding-char) ?\;) - ;; Had ?\) too - (and (eq (preceding-char) ?\}) - (cperl-after-block-and-statement-beg - (point-min))) ; Was start - too close - (memq char-after (append ")]}" nil)) - (and (eq (preceding-char) ?\:) ; label - (progn - (forward-sexp -1) - (skip-chars-backward " \t") - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))) - (get-text-property (point) 'first-format-line)) - (progn - (if (and parse-data - (not (eq char-after ?\C-j))) - (setcdr (cddr parse-data) - (list pre-indent-point))) - 0) - cperl-continued-statement-offset)))) - ((not - (or (setq is-block - (and (setq delim (= (char-after containing-sexp) ?{)) - (save-excursion ; Is it a hash? - (goto-char containing-sexp) - (cperl-block-p)))) - cperl-indent-parens-as-block)) - ;; group is an expression, not a block: - ;; indent to just after the surrounding open parens, - ;; skip blanks if we do not close the expression. - (goto-char (1+ containing-sexp)) - (or (memq char-after - (append (if delim "}" ")]}") nil)) - (looking-at "[ \t]*\\(#\\|$\\)") - (skip-chars-forward " \t")) - (+ (current-column) - (if (and delim - (eq char-after ?\})) - ;; Correct indentation of trailing ?\} - (+ cperl-indent-level cperl-close-paren-offset) - 0))) -;;; ((and (/= (char-after containing-sexp) ?{) -;;; (not cperl-indent-parens-as-block)) -;;; ;; line is expression, not statement: -;;; ;; indent to just after the surrounding open, -;;; ;; skip blanks if we do not close the expression. -;;; (goto-char (1+ containing-sexp)) -;;; (or (memq char-after (append ")]}" nil)) -;;; (looking-at "[ \t]*\\(#\\|$\\)") -;;; (skip-chars-forward " \t")) -;;; (current-column)) -;;; ((progn -;;; ;; Containing-expr starts with \{. Check whether it is a hash. -;;; (goto-char containing-sexp) -;;; (and (not (cperl-block-p)) -;;; (not cperl-indent-parens-as-block))) -;;; (goto-char (1+ containing-sexp)) -;;; (or (eq char-after ?\}) -;;; (looking-at "[ \t]*\\(#\\|$\\)") -;;; (skip-chars-forward " \t")) -;;; (+ (current-column) ; Correct indentation of trailing ?\} -;;; (if (eq char-after ?\}) (+ cperl-indent-level -;;; cperl-close-paren-offset) -;;; 0))) - (t - ;; Statement level. Is it a continuation or a new statement? - ;; Find previous non-comment character. - (goto-char pre-indent-point) - (cperl-backward-to-noncomment containing-sexp) - ;; Back up over label lines, since they don't - ;; affect whether our line is a continuation. - ;; (Had \, too) - (while;;(or (eq (preceding-char) ?\,) - (and (eq (preceding-char) ?:) - (or;;(eq (char-after (- (point) 2)) ?\') ; ???? - (memq (char-syntax (char-after (- (point) 2))) - '(?w ?_)))) - ;;) - (if (eq (preceding-char) ?\,) - ;; Will go to beginning of line, essentially. - ;; Will ignore embedded sexpr XXXX. - (cperl-backward-to-start-of-continued-exp containing-sexp)) - (beginning-of-line) - (cperl-backward-to-noncomment containing-sexp)) - ;; Now we get the answer. - (if (not (or (eq (1- (point)) containing-sexp) - (memq (preceding-char) - (append (if is-block " ;{" " ,;{") '(nil))) - (and (eq (preceding-char) ?\}) - (cperl-after-block-and-statement-beg - containing-sexp)) - (get-text-property (point) 'first-format-line))) - ;; This line is continuation of preceding line's statement; - ;; indent `cperl-continued-statement-offset' more than the - ;; previous line of the statement. - ;; - ;; There might be a label on this line, just - ;; consider it bad style and ignore it. - (progn - (cperl-backward-to-start-of-continued-exp containing-sexp) - (+ (if (memq char-after (append "}])" nil)) - 0 ; Closing parenth - cperl-continued-statement-offset) - (if (or is-block - (not delim) - (not (eq char-after ?\}))) - 0 - ;; Now it is a hash reference - (+ cperl-indent-level cperl-close-paren-offset)) - ;; Labels do not take :: ... - (if (looking-at "\\(\\w\\|_\\)+[ \t]*:") - (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - ;; Do not move `parse-data', this should - ;; be quick anyway (this comment comes - ;; from different location): - (cperl-calculate-indent)) - (current-column)) - (if (eq char-after ?\{) - cperl-continued-brace-offset 0))) - ;; This line starts a new statement. - ;; Position following last unclosed open. - (goto-char containing-sexp) - ;; Is line first statement after an open-brace? - (or - ;; If no, find that first statement and indent like - ;; it. If the first statement begins with label, do - ;; not believe when the indentation of the label is too - ;; small. - (save-excursion - (forward-char 1) - (setq old-indent (current-indentation)) - (let ((colon-line-end 0)) - (while - (progn (skip-chars-forward " \t\n") - (looking-at "#\\|[a-zA-Z0-9_$]*:[^:]\\|=[a-zA-Z]")) - ;; Skip over comments and labels following openbrace. - (cond ((= (following-char) ?\#) - (forward-line 1)) - ((= (following-char) ?\=) - (goto-char - (or (next-single-property-change (point) 'in-pod) - (point-max)))) ; do not loop if no syntaxification - ;; label: - (t - (save-excursion (end-of-line) - (setq colon-line-end (point))) - (search-forward ":")))) - ;; The first following code counts - ;; if it is before the line we want to indent. - (and (< (point) indent-point) - (if (> colon-line-end (point)) ; After label - (if (> (current-indentation) - cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - ;; Do not believe: `max' is involved - (+ old-indent cperl-indent-level)) - (current-column))))) - ;; If no previous statement, - ;; indent it relative to line brace is on. - ;; For open brace in column zero, don't let statement - ;; start there too. If cperl-indent-level is zero, - ;; use cperl-brace-offset + cperl-continued-statement-offset instead. - ;; For open-braces not the first thing in a line, - ;; add in cperl-brace-imaginary-offset. - - ;; If first thing on a line: ????? - (+ (if (and (bolp) (zerop cperl-indent-level)) - (+ cperl-brace-offset cperl-continued-statement-offset) - cperl-indent-level) - (if (or is-block - (not delim) - (not (eq char-after ?\}))) - 0 - ;; Now it is a hash reference - (+ cperl-indent-level cperl-close-paren-offset)) - ;; Move back over whitespace before the openbrace. - ;; If openbrace is not first nonwhite thing on the line, - ;; add the cperl-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 cperl-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; - ;; possibly a different line + (setq pre-indent-point (point))))) + (goto-char pre-indent-point) ; Orig line skipping preceeding 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 + (nth 0 s-s))) ; Good place to start parsing + (state (nth 1 s-s)) + (containing-sexp (car (cdr state))) + old-indent) + (if (and + ;;containing-sexp ;; We are buggy at toplevel :-( + parse-data) + (progn + (setcar parse-data pre-indent-point) + (setcar (cdr parse-data) state) + (or (nth 2 parse-data) + (setcar (cddr parse-data) start)) + ;; Before this point: end of statement + (setq old-indent (nth 3 parse-data)))) + (cond ((get-text-property (point) 'indentable) + ;; indent to "after" the surrounding open + ;; (same offset as `cperl-beautify-regexp-piece'), + ;; skip blanks if we do not close the expression. + (setq delim ; We do not close the expression + (get-text-property + (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 + (cperl-backward-to-noncomment p) + (beginning-of-line) + (if (<= (point) p) + (progn ; get indent from the first line + (goto-char p) + (skip-chars-forward " \t") + (if (memq (char-after (point)) + (append "#\n" nil)) + nil ; Can't use intentation 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 + (vector 'indentable 'cont-line char-after-pos + is-block char-after p)) + (t ; No preceeding line... + (vector 'indentable 'first-line p)))) + ((get-text-property char-after-pos 'REx-part2) + (vector 'REx-part2 (point))) + ((nth 4 state) + [comment]) + ((nth 3 state) + [string]) + ;; XXXX Do we need to special-case this? + ((null containing-sexp) + ;; Line is at top level. May be data or function definition, + ;; or may be function argument declaration. + ;; Indent like the previous top level line + ;; unless that ends in a closeparen without semicolon, + ;; in which case this line is the first argument decl. + (skip-chars-forward " \t") + (cperl-backward-to-noncomment (or old-indent (point-min))) + (setq state + (or (bobp) + (eq (point) old-indent) ; old-indent was at comment + (eq (preceding-char) ?\;) + ;; Had ?\) too + (and (eq (preceding-char) ?\}) + (cperl-after-block-and-statement-beg + (point-min))) ; Was start - too close + (memq char-after (append ")]}" nil)) + (and (eq (preceding-char) ?\:) ; label + (progn + (forward-sexp -1) + (skip-chars-backward " \t") + (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*[ \t]*:"))) + (get-text-property (point) 'first-format-line))) + + ;; Look at previous line that's at column 0 + ;; to determine whether we are in top-level decls + ;; or function's arg decls. Set basic-indent accordingly. + ;; Now add a little if this is a continuation line. + (and state + parse-data + (not (eq char-after ?\C-j)) + (setcdr (cddr parse-data) + (list pre-indent-point))) + (vector 'toplevel start char-after state (nth 2 s-s))) + ((not + (or (setq is-block + (and (setq delim (= (char-after containing-sexp) ?{)) + (save-excursion ; Is it a hash? + (goto-char containing-sexp) + (cperl-block-p)))) + cperl-indent-parens-as-block)) + ;; group is an expression, not a block: + ;; indent to just after the surrounding open parens, + ;; skip blanks if we do not close the expression. + (goto-char (1+ containing-sexp)) + (or (memq char-after + (append (if delim "}" ")]}") nil)) + (looking-at "[ \t]*\\(#\\|$\\)") + (skip-chars-forward " \t")) + (setq old-indent (point)) ; delim=is-brace + (vector 'in-parens char-after (point) delim containing-sexp)) + (t + ;; Statement level. Is it a continuation or a new statement? + ;; Find previous non-comment character. + (goto-char pre-indent-point) ; Skip one level of POD/etc + (cperl-backward-to-noncomment containing-sexp) + ;; Back up over label lines, since they don't + ;; affect whether our line is a continuation. + ;; (Had \, too) + (while;;(or (eq (preceding-char) ?\,) + (and (eq (preceding-char) ?:) + (or;;(eq (char-after (- (point) 2)) ?\') ; ???? + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_)))) + ;;) + ;; This is always FALSE? + (if (eq (preceding-char) ?\,) + ;; Will go to beginning of line, essentially. + ;; Will ignore embedded sexpr XXXX. + (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 + (if (not (or (eq (1- (point)) containing-sexp) + (memq (preceding-char) + (append (if is-block " ;{" " ,;{") '(nil))) + (and (eq (preceding-char) ?\}) + (cperl-after-block-and-statement-beg + containing-sexp)) + (get-text-property (point) 'first-format-line))) + ;; This line is continuation of preceding line's statement; + ;; indent `cperl-continued-statement-offset' more than the + ;; previous line of the statement. + ;; + ;; There might be a label on this line, just + ;; consider it bad style and ignore it. (progn - (cperl-backward-to-noncomment (point-min)) - (if (eq (preceding-char) ?\)) - (forward-sexp -1)) - ;; In the case it starts a subroutine, indent with - ;; respect to `sub', not with respect to the - ;; first thing on the line, say in the case of - ;; anonymous sub in a hash. - ;; - ;;(skip-chars-backward " \t") - (cperl-backward-to-noncomment (point-min)) - (if (and - (or - (and (get-text-property (point) 'attrib-group) - (goto-char - (cperl-beginning-of-property - (point) 'attrib-group))) - (and (eq (preceding-char) ?b) - (progn - (forward-sexp -1) - (looking-at "sub\\>")))) - (setq old-indent - (nth 1 - (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))))) - (progn (goto-char (1+ old-indent)) - (skip-chars-forward " \t") - (current-column)) - ;; Get initial indentation of the line we are on. - ;; If line starts with label, calculate label indentation - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) - (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - ;; Do not move `parse-data', this should - ;; be quick anyway: - (cperl-calculate-indent)) - (current-indentation)))))))))))))) - -(defvar cperl-indent-alist - '((string nil) - (comment nil) - (toplevel 0) - (toplevel-after-parenth 2) - (toplevel-continued 2) - (expression 1)) + (cperl-backward-to-start-of-continued-exp containing-sexp) + (vector 'continuation (point) char-after is-block delim)) + ;; This line starts a new statement. + ;; Position following last unclosed open brace + (goto-char containing-sexp) + ;; Is line first statement after an open-brace? + (or + ;; If no, find that first statement and indent like + ;; it. If the first statement begins with label, do + ;; not believe when the indentation of the label is too + ;; small. + (save-excursion + (forward-char 1) + (let ((colon-line-end 0)) + (while + (progn (skip-chars-forward " \t\n") + ;; s: foo : bar :x is NOT label + (and (looking-at "#\\|\\([a-zA-Z0-9_$]+\\):[^:]\\|=[a-zA-Z]") + (not (looking-at "[sym]:\\|tr:")))) + ;; Skip over comments and labels following openbrace. + (cond ((= (following-char) ?\#) + (forward-line 1)) + ((= (following-char) ?\=) + (goto-char + (or (next-single-property-change (point) 'in-pod) + (point-max)))) ; do not loop if no syntaxification + ;; label: + (t + (save-excursion (end-of-line) + (setq colon-line-end (point))) + (search-forward ":")))) + ;; We are at beginning of code (NOT label or comment) + ;; First, the following code counts + ;; if it is before the line we want to indent. + (and (< (point) indent-point) + (vector 'have-prev-sibling (point) colon-line-end + containing-sexp)))) + (progn + ;; If no previous statement, + ;; indent it relative to line brace is on. + + ;; For open-braces not the first thing in a line, + ;; add in cperl-brace-imaginary-offset. + + ;; If first thing on a line: ????? + ;; Move back over whitespace before the openbrace. + (setq ; brace first thing on a line + old-indent (progn (skip-chars-backward " \t") (bolp))) + ;; Should we indent w.r.t. earlier than start? + ;; Move to start of control group, possibly on a different line + (or cperl-indent-wrt-brace + (cperl-backward-to-noncomment (point-min))) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; + (if (eq (preceding-char) ?\)) + (progn + (forward-sexp -1) + (cperl-backward-to-noncomment (point-min)))) + ;; In the case it starts a subroutine, indent with + ;; respect to `sub', not with respect to the + ;; first thing on the line, say in the case of + ;; anonymous sub in a hash. + (if (and;; Is it a sub in group starting on this line? + (cond ((get-text-property (point) 'attrib-group) + (goto-char (cperl-beginning-of-property + (point) 'attrib-group))) + ((eq (preceding-char) ?b) + (forward-sexp -1) + (looking-at "sub\\>"))) + (setq p (nth 1 ; start of innermost containing list + (parse-partial-sexp + (save-excursion (beginning-of-line) + (point)) + (point))))) + (progn + (goto-char (1+ p)) ; enclosing block on the same line + (skip-chars-forward " \t") + (vector 'code-start-in-block containing-sexp char-after + (and delim (not is-block)) ; is a HASH + old-indent ; brace first thing on a line + t (point) ; have something before... + ) + ;;(current-column) + ) + ;; Get initial indentation of the line we are on. + ;; If line starts with label, calculate label indentation + (vector 'code-start-in-block containing-sexp char-after + (and delim (not is-block)) ; is a HASH + old-indent ; brace first thing on a line + nil (point))))))))))))))) ; nothing interesting before + +(defvar cperl-indent-rules-alist + '((pod nil) ; via `syntax-type' property + (here-doc nil) ; via `syntax-type' property + (here-doc-delim nil) ; via `syntax-type' property + (format nil) ; via `syntax-type' property + (in-pod nil) ; via `in-pod' property + (comment-special:at-beginning-of-line nil) + (string t) + (comment nil)) "Alist of indentation rules for CPerl mode. The values mean: nil: do not indent; - number: add this amount of indentation. + number: add this amount of indentation.") -Not finished, not used.") - -(defun cperl-where-am-i (&optional parse-start start-state) - ;; Unfinished - "Return a list of lists ((TYPE POS)...) of good points before the point. -POS may be nil if it is hard to find, say, when TYPE is `string' or `comment'. +(defun cperl-calculate-indent (&optional parse-data) ; was parse-start + "Return appropriate indentation for current line as Perl code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment. -Not finished, not used." +Will not correct the indentation for labels, but will correct it for braces +and closing parentheses and brackets." + ;; This code is still a broken architecture: in some cases we need to + ;; compensate for some modifications which `cperl-indent-line' will add later (save-excursion - (let* ((start-point (point)) unused - (s-s (cperl-get-state)) - (start (nth 0 s-s)) - (state (nth 1 s-s)) - (prestart (nth 3 s-s)) - (containing-sexp (car (cdr state))) - (case-fold-search nil) - (res (list (list 'parse-start start) (list 'parse-prestart prestart)))) - (cond ((nth 3 state) ; In string - (setq res (cons (list 'string nil (nth 3 state)) res))) ; What started string - ((nth 4 state) ; In comment - (setq res (cons '(comment) res))) - ((null containing-sexp) - ;; Line is at top level. - ;; Indent like the previous top level line - ;; unless that ends in a closeparen without semicolon, - ;; in which case this line is the first argument decl. - (cperl-backward-to-noncomment (or parse-start (point-min))) - ;;(skip-chars-backward " \t\f\n") - (cond - ((or (bobp) - (memq (preceding-char) (append ";}" nil))) - (setq res (cons (list 'toplevel start) res))) - ((eq (preceding-char) ?\) ) - (setq res (cons (list 'toplevel-after-parenth start) res))) - (t - (setq res (cons (list 'toplevel-continued start) res))))) - ((/= (char-after containing-sexp) ?{) - ;; line is expression, not statement: - ;; indent to just after the surrounding open. - ;; skip blanks if we do not close the expression. - (setq res (cons (list 'expression-blanks - (progn - (goto-char (1+ containing-sexp)) - (or (looking-at "[ \t]*\\(#\\|$\\)") - (skip-chars-forward " \t")) - (point))) - (cons (list 'expression containing-sexp) res)))) - ((progn - ;; Containing-expr starts with \{. Check whether it is a hash. - (goto-char containing-sexp) - (not (cperl-block-p))) - (setq res (cons (list 'expression-blanks - (progn - (goto-char (1+ containing-sexp)) - (or (looking-at "[ \t]*\\(#\\|$\\)") - (skip-chars-forward " \t")) - (point))) - (cons (list 'expression containing-sexp) res)))) - (t - ;; Statement level. - (setq res (cons (list 'in-block containing-sexp) res)) - ;; Is it a continuation or a new statement? - ;; Find previous non-comment character. - (cperl-backward-to-noncomment containing-sexp) - ;; Back up over label lines, since they don't - ;; affect whether our line is a continuation. - ;; Back up comma-delimited lines too ????? - (while (or (eq (preceding-char) ?\,) - (save-excursion (cperl-after-label))) - (if (eq (preceding-char) ?\,) - ;; Will go to beginning of line, essentially - ;; Will ignore embedded sexpr XXXX. - (cperl-backward-to-start-of-continued-exp containing-sexp)) - (beginning-of-line) - (cperl-backward-to-noncomment containing-sexp)) - ;; Now we get the answer. - (if (not (memq (preceding-char) (append ";}{" '(nil)))) ; Was ?\, - ;; This line is continuation of preceding line's statement. - (list (list 'statement-continued containing-sexp)) - ;; This line starts a new statement. - ;; Position following last unclosed open. - (goto-char containing-sexp) - ;; Is line first statement after an open-brace? - (or - ;; If no, find that first statement and indent like - ;; it. If the first statement begins with label, do - ;; not believe when the indentation of the label is too - ;; small. - (save-excursion - (forward-char 1) - (let ((colon-line-end 0)) - (while (progn (skip-chars-forward " \t\n" start-point) - (and (< (point) start-point) - (looking-at - "#\\|[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))) - ;; Skip over comments and labels following openbrace. - (cond ((= (following-char) ?\#) - ;;(forward-line 1) - (end-of-line)) - ;; label: - (t - (save-excursion (end-of-line) - (setq colon-line-end (point))) - (search-forward ":")))) - ;; Now at the point, after label, or at start - ;; of first statement in the block. - (and (< (point) start-point) - (if (> colon-line-end (point)) - ;; Before statement after label - (if (> (current-indentation) - cperl-min-label-indent) - (list (list 'label-in-block (point))) - ;; Do not believe: `max' is involved - (list - (list 'label-in-block-min-indent (point)))) - ;; Before statement - (list 'statement-in-block (point)))))) - ;; If no previous statement, - ;; indent it relative to line brace is on. - ;; For open brace in column zero, don't let statement - ;; start there too. If cperl-indent-level is zero, - ;; use cperl-brace-offset + cperl-continued-statement-offset instead. - ;; For open-braces not the first thing in a line, - ;; add in cperl-brace-imaginary-offset. - - ;; If first thing on a line: ????? - (setq unused ; This is not finished... - (+ (if (and (bolp) (zerop cperl-indent-level)) - (+ cperl-brace-offset cperl-continued-statement-offset) - cperl-indent-level) - ;; Move back over whitespace before the openbrace. - ;; If openbrace is not first nonwhite thing on the line, - ;; add the cperl-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 cperl-brace-imaginary-offset)) - ;; If the openbrace is preceded by a parenthesized exp, - ;; move to the beginning of that; - ;; possibly a different line - (progn - (if (eq (preceding-char) ?\)) - (forward-sexp -1)) - ;; Get initial indentation of the line we are on. - ;; If line starts with label, calculate label indentation - (if (save-excursion - (beginning-of-line) - (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) - (if (> (current-indentation) cperl-min-label-indent) - (- (current-indentation) cperl-label-offset) - (cperl-calculate-indent)) - (current-indentation))))))))) - res))) + (let ((i (cperl-sniff-for-indent parse-data)) what p) + (cond + ;;((or (null i) (eq i t) (numberp i)) + ;; i) + ((vectorp i) + (setq what (assoc (elt i 0) cperl-indent-rules-alist)) + (cond + (what (cadr what)) ; Load from table + ;; + ;; Indenters for regular expressions with //x and qw() + ;; + ((eq 'REx-part2 (elt i 0)) ;; [self start] start of /REP in s//REP/x + (goto-char (elt i 1)) + (condition-case nil ; Use indentation of the 1st part + (forward-sexp -1)) + (current-column)) + ((eq 'indentable (elt i 0)) ; Indenter for REGEXP qw() etc + (cond ;;; [indentable terminator start-pos is-block] + ((eq 'terminator (elt i 1)) ; Lone terminator of "indentable string" + (goto-char (elt i 2)) ; After opening parens + (1- (current-column))) + ((eq 'first-line (elt i 1)); [indentable first-line start-pos] + (goto-char (elt i 2)) + (+ (or cperl-regexp-indent-step cperl-indent-level) + -1 + (current-column))) + ((eq 'cont-line (elt i 1)); [indentable cont-line pos prev-pos first-char start-pos] + ;; Indent as the level after closing parens + (goto-char (elt i 2)) ; indent line + (skip-chars-forward " \t)") ; Skip closing parens + (setq p (point)) + (goto-char (elt i 3)) ; previous line + (skip-chars-forward " \t)") ; Skip closing parens + ;; Number of parens in between: + (setq p (nth 0 (parse-partial-sexp (point) p)) + what (elt i 4)) ; First char on current line + (goto-char (elt i 3)) ; previous line + (+ (* p (or cperl-regexp-indent-step cperl-indent-level)) + (cond ((eq what ?\) ) + (- cperl-close-paren-offset)) ; compensate + ((eq what ?\| ) + (- (or cperl-regexp-indent-step cperl-indent-level))) + (t 0)) + (if (eq (following-char) ?\| ) + (or cperl-regexp-indent-step cperl-indent-level) + 0) + (current-column))) + (t + (error "Unrecognized value of indent: " i)))) + ;; + ;; Indenter for stuff at toplevel + ;; + ((eq 'toplevel (elt i 0)) ;; [toplevel start char-after state immed-after-block] + (+ (save-excursion ; To beg-of-defun, or end of last sexp + (goto-char (elt i 1)) ; start = Good place to start parsing + (- (current-indentation) ; + (if (elt i 4) cperl-indent-level 0))) ; immed-after-block + (if (eq (elt i 2) ?{) cperl-continued-brace-offset 0) ; char-after + ;; Look at previous line that's at column 0 + ;; to determine whether we are in top-level decls + ;; or function's arg decls. Set basic-indent accordingly. + ;; Now add a little if this is a continuation line. + (if (elt i 3) ; state (XXX What is the semantic???) + 0 + cperl-continued-statement-offset))) + ;; + ;; Indenter for stuff in "parentheses" (or brackets, braces-as-hash) + ;; + ((eq 'in-parens (elt i 0)) + ;; in-parens char-after old-indent-point is-brace containing-sexp + + ;; group is an expression, not a block: + ;; indent to just after the surrounding open parens, + ;; skip blanks if we do not close the expression. + (+ (progn + (goto-char (elt i 2)) ; old-indent-point + (current-column)) + (if (and (elt i 3) ; is-brace + (eq (elt i 1) ?\})) ; char-after + ;; Correct indentation of trailing ?\} + (+ cperl-indent-level cperl-close-paren-offset) + 0))) + ;; + ;; Indenter for continuation lines + ;; + ((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 + cperl-continued-statement-offset) + (if (or (elt i 3) ; is-block + (not (elt i 4)) ; is-brace + (not (eq (elt i 2) ?\}))) ; char-after + 0 + ;; Now it is a hash reference + (+ cperl-indent-level cperl-close-paren-offset)) + ;; Labels do not take :: ... + (if (looking-at "\\(\\w\\|_\\)+[ \t]*:") + (if (> (current-indentation) cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + ;; Do not move `parse-data', this should + ;; be quick anyway (this comment comes + ;; from different location): + (cperl-calculate-indent)) + (current-column)) + (if (eq (elt i 2) ?\{) ; char-after + cperl-continued-brace-offset 0))) + ;; + ;; Indenter for lines in a block which are not leading lines + ;; + ((eq 'have-prev-sibling (elt i 0)) + ;; [have-prev-sibling sibling-beg colon-line-end block-start] + (goto-char (elt i 1)) ; sibling-beg + (if (> (elt i 2) (point)) ; colon-line-end; have label before point + (if (> (current-indentation) + cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + ;; Do not believe: `max' was involved in calculation of indent + (+ cperl-indent-level + (save-excursion + (goto-char (elt i 3)) ; block-start + (current-indentation)))) + (current-column))) + ;; + ;; Indenter for the first line in a block + ;; + ((eq 'code-start-in-block (elt i 0)) + ;;[code-start-in-block before-brace char-after + ;; is-a-HASH-ref brace-is-first-thing-on-a-line + ;; group-starts-before-start-of-sub start-of-control-group] + (goto-char (elt i 1)) + ;; For open brace in column zero, don't let statement + ;; start there too. If cperl-indent-level=0, + ;; use cperl-brace-offset + cperl-continued-statement-offset instead. + (+ (if (and (bolp) (zerop cperl-indent-level)) + (+ cperl-brace-offset cperl-continued-statement-offset) + cperl-indent-level) + (if (and (elt i 3) ; is-a-HASH-ref + (eq (elt i 2) ?\})) ; char-after: End of a hash reference + (+ cperl-indent-level cperl-close-paren-offset) + 0) + ;; Unless openbrace is the first nonwhite thing on the line, + ;; add the cperl-brace-imaginary-offset. + (if (elt i 4) 0 ; brace-is-first-thing-on-a-line + cperl-brace-imaginary-offset) + (progn + (goto-char (elt i 6)) ; start-of-control-group + (if (elt i 5) ; group-starts-before-start-of-sub + (current-column) + ;; Get initial indentation of the line we are on. + ;; If line starts with label, calculate label indentation + (if (save-excursion + (beginning-of-line) + (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]")) + (if (> (current-indentation) cperl-min-label-indent) + (- (current-indentation) cperl-label-offset) + ;; Do not move `parse-data', this should + ;; be quick anyway: + (cperl-calculate-indent)) + (current-indentation)))))) + (t + (error "Unrecognized value of indent: " i)))) + (t + (error (format "Got strange value of indent: " i))))))) (defun cperl-calculate-indent-within-comment () "Return the indentation amount for line, assuming that @@ -4954,6 +4973,7 @@ Works before syntax recognition is done." ;; d) 'Q'uoted string: ;; part between markers inclusive is marked `syntax-type' ==> `string' ;; part between `q' and the first marker is marked `syntax-type' ==> `prestring' +;; second part of s///e is marked `syntax-type' ==> `multiline' ;; e) Attributes of subroutines: `attrib-group' ==> t ;; (or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'. ;; f) Multiline my/our declaration lists etc: `syntax-type' => `multiline' @@ -5073,8 +5093,10 @@ Should be called with the point before leading colon of an attribute." (set-syntax-table reset-st)))) (defsubst cperl-look-at-leading-count (is-x-REx e) - (if (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]") - (1- e) t) ; return nil on failure, no moving + (if (and + (< (point) e) + (re-search-forward (concat "\\=" (if is-x-REx "[ \t\n]*" "") "[{?+*]") + (1- e) t)) ; return nil on failure, no moving (if (eq ?\{ (preceding-char)) nil (cperl-postpone-fontification (1- (point)) (point) @@ -5400,7 +5422,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (progn (forward-sexp -2) (not - (looking-at "print\\>"))) + (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>"))) (error t))))))) (error nil))) ; func(< e1 b1)) + (progn ; No errors finding the second part... (cperl-postpone-fontification (1- e1) e1 'face my-cperl-delimiters-face) (if (assoc (char-after b) cperl-starters) @@ -6211,14 +6235,16 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (beginning-of-line) (if (memq (setq pr (get-text-property (point) 'syntax-type)) '(pod here-doc here-doc-delim)) - (cperl-unwind-to-safe nil) - (or (and (looking-at "^[ \t]*\\(#\\|$\\)") - (not (memq pr '(string prestring)))) - (progn (cperl-to-comment-or-eol) (bolp)) - (progn - (skip-chars-backward " \t") - (if (< p (point)) (goto-char p)) - (setq stop t))))))) + (progn + (cperl-unwind-to-safe nil) + (setq pr (get-text-property (point) 'syntax-type)))) + (or (and (looking-at "^[ \t]*\\(#\\|$\\)") + (not (memq pr '(string prestring)))) + (progn (cperl-to-comment-or-eol) (bolp)) + (progn + (skip-chars-backward " \t") + (if (< p (point)) (goto-char p)) + (setq stop t)))))) ;; Used only in `cperl-calculate-indent'... (defun cperl-block-p () ; Do not C-M-q ! One string contains ";" ! @@ -6340,20 +6366,28 @@ CHARS is a string that contains good characters to have before us (however, (while (and (or (not lim) (> (point) lim)) (not (cperl-after-expr-p lim))) - (forward-sexp -1))) + (forward-sexp -1) + ;; May be after $, @, $# etc of a variable + (skip-chars-backward "$@%#"))) (error nil))) (defun cperl-at-end-of-expr (&optional lim) - (condition-case nil - (save-excursion - ;; If nothing interesting after, same as (forward-sexp -1); otherwise - ;; fails, or at a start of following sexp: - (let ((p (point))) - (forward-sexp 1) - (forward-sexp -1) - (or (< (point) p) - (cperl-after-expr-p lim)))) - (error t))) + ;; Since the SEXP approach below is very fragile, do some overengineering + (or (looking-at (concat cperl-maybe-white-and-comment-rex "[;}]")) + (condition-case nil + (save-excursion + ;; If nothing interesting after, does as (forward-sexp -1); + ;; otherwise fails, or ends at a start of following sexp. + ;; XXXX PROBLEMS: if what follows (after ";") @FOO, or ${bar} + ;; may be stuck after @ or $; just put some stupid workaround now: + (let ((p (point))) + (forward-sexp 1) + (forward-sexp -1) + (while (memq (preceding-char) (append "%&@$*" nil)) + (forward-char -1)) + (or (< (point) p) + (cperl-after-expr-p lim)))) + (error t)))) (defun cperl-forward-to-end-of-expr (&optional lim) (let ((p (point)))) @@ -6407,18 +6441,51 @@ conditional/loop constructs." (beginning-of-line) (while (null done) (setq top (point)) - (while (= (nth 0 (parse-partial-sexp (point) tmp-end - -1)) -1) + ;; 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 (goto-char top) (while (< (point) tmp-end) (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol (or (eolp) (forward-sexp 1))) - (if (> (point) tmp-end) - (save-excursion - (end-of-line) - (setq tmp-end (point))) - (setq done t))) + (if (> (point) tmp-end) ; Yes, there an unfinished block + nil + (if (eq ?\) (preceding-char)) + (progn ;; Plan B: find by REGEXP block followup this line + (setq top (point)) + (condition-case nil + (progn + (forward-sexp -2) + (if (eq (following-char) ?$ ) ; for my $var (list) + (progn + (forward-sexp -1) + (if (looking-at "\\(my\\|local\\|our\\)\\>") + (forward-sexp -1)))) + (if (looking-at + (concat "\\(\\elsif\\|if\\|unless\\|while\\|until" + "\\|for\\(each\\)?\\>\\(\\(" + cperl-maybe-white-and-comment-rex + "\\(my\\|local\\|our\\)\\)?" + cperl-maybe-white-and-comment-rex + "\\$[_a-zA-Z0-9]+\\)?\\)\\>")) + (progn + (goto-char top) + (forward-sexp 1) + (setq top (point))))) + (error (setq done t))) + (goto-char top)) + (if (looking-at ; Try Plan C: continuation block + (concat cperl-maybe-white-and-comment-rex + "\\<\\(else\\|elsif\|continue\\)\\>")) + (progn + (goto-char (match-end 0)) + (save-excursion + (end-of-line) + (setq tmp-end (point)))) + (setq done t)))) + (save-excursion + (end-of-line) + (setq tmp-end (point)))) (goto-char tmp-end) (setq tmp-end (point-marker))) (if cperl-indent-region-fix-constructs @@ -6447,16 +6514,26 @@ Returns some position at the last line." ;; Looking at: ;; } ;; else - (if (and cperl-merge-trailing-else - (looking-at - "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>")) - (progn - (search-forward "}") - (setq p (point)) - (skip-chars-forward " \t\n") - (delete-region p (point)) - (insert (make-string cperl-indent-region-fix-constructs ?\ )) - (beginning-of-line))) + (if cperl-merge-trailing-else + (if (looking-at + "[ \t]*}[ \t]*\n[ \t\n]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + (progn + (search-forward "}") + (setq p (point)) + (skip-chars-forward " \t\n") + (delete-region p (point)) + (insert (make-string cperl-indent-region-fix-constructs ?\ )) + (beginning-of-line))) + (if (looking-at "[ \t]*}[ \t]*\\(els\\(e\\|if\\)\\|continue\\)\\>") + (save-excursion + (search-forward "}") + (delete-horizontal-space) + (insert "\n") + (setq ret (point)) + (if (cperl-indent-line parse-data) + (progn + (cperl-fix-line-spacing end parse-data) + (setq ret (point))))))) ;; Looking at: ;; } else (if (looking-at "[ \t]*}\\(\t*\\|[ \t][ \t]+\\)\\<\\(els\\(e\\|if\\)\\|continue\\)\\>") @@ -6493,19 +6570,19 @@ Returns some position at the last line." (insert (make-string cperl-indent-region-fix-constructs ?\ )) (beginning-of-line))) - ;; Looking at: - ;; } foreach my $var () { + ;; Looking at (with or without "}" at start, ending after "({"): + ;; } foreach my $var () OR { (if (looking-at "[ \t]*\\(}[ \t]*\\)?\\<\\(\\els\\(e\\|if\\)\\|continue\\|if\\|unless\\|while\\|for\\(each\\)?\\(\\([ \t]+\\(my\\|local\\|our\\)\\)?[ \t]*\\$[_a-zA-Z0-9]+\\)?\\|until\\)\\>\\([ \t]*(\\|[ \t\n]*{\\)\\|[ \t]*{") (progn - (setq ml (match-beginning 8)) + (setq ml (match-beginning 8)) ; "(" or "{" after control word (re-search-forward "[({]") (forward-char -1) (setq p (point)) (if (eq (following-char) ?\( ) (progn (forward-sexp 1) - (setq pp (point))) + (setq pp (point))) ; past parenth-group ;; after `else' or nothing (if ml ; after `else' (skip-chars-backward " \t\n") @@ -6515,13 +6592,13 @@ Returns some position at the last line." ;; Multiline expr should be special (setq ml (and pp (save-excursion (goto-char p) (search-forward "\n" pp t)))) - (if (and (or (not pp) (< pp end)) + (if (and (or (not pp) (< pp end)) ; Do not go too far... (looking-at "[ \t\n]*{")) (progn (cond ((bolp) ; Were before `{', no if/else/etc nil) - ((looking-at "\\(\t*\\| [ \t]+\\){") + ((looking-at "\\(\t*\\| [ \t]+\\){") ; Not exactly 1 SPACE (delete-horizontal-space) (if (if ml cperl-extra-newline-before-brace-multiline @@ -6544,7 +6621,17 @@ Returns some position at the last line." (skip-chars-forward " \t\n") (delete-region pp (point)) (insert - (make-string cperl-indent-region-fix-constructs ?\ )))) + (make-string cperl-indent-region-fix-constructs ?\ ))) + ((and (looking-at "[\t ]*{") + (if ml cperl-extra-newline-before-brace-multiline + cperl-extra-newline-before-brace)) + (delete-horizontal-space) + (insert "\n") + (setq ret (point)) + (if (cperl-indent-line parse-data) + (progn + (cperl-fix-line-spacing end parse-data) + (setq ret (point)))))) ;; Now we are before `{' (if (looking-at "[ \t\n]*{[ \t]*[^ \t\n#]") (progn @@ -7010,19 +7097,23 @@ indentation and initial hashes. Behaves usually outside of comment." (defun cperl-windowed-init () "Initialization under windowed version." - (if (or (featurep 'ps-print) cperl-faces-init) - ;; Need to init anyway: - (or cperl-faces-init (cperl-init-faces)) - (add-hook 'font-lock-mode-hook - (function - (lambda () - (if (memq major-mode '(perl-mode cperl-mode)) - (progn - (or cperl-faces-init (cperl-init-faces))))))) - (if (fboundp 'eval-after-load) - (eval-after-load - "ps-print" - '(or cperl-faces-init (cperl-init-faces)))))) + (cond ((featurep 'ps-print) + (or cperl-faces-init + (progn + (and (boundp 'font-lock-multiline) + (setq cperl-font-lock-multiline t)) + (cperl-init-faces)))) + ((not cperl-faces-init) + (add-hook 'font-lock-mode-hook + (function + (lambda () + (if (memq major-mode '(perl-mode cperl-mode)) + (progn + (or cperl-faces-init (cperl-init-faces))))))) + (if (fboundp 'eval-after-load) + (eval-after-load + "ps-print" + '(or cperl-faces-init (cperl-init-faces))))))) (defun cperl-load-font-lock-keywords () (or cperl-faces-init (cperl-init-faces)) @@ -7319,6 +7410,12 @@ indentation and initial hashes. Behaves usually outside of comment." cperl-array-face) ; arrays and hashes font-lock-variable-name-face) ; Just to put something t) + ("\\(@\\|\\$#\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-array-face) + (2 font-lock-variable-name-face)) + ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)" + (1 cperl-hash-face) + (2 font-lock-variable-name-face)) ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") ;;; Too much noise from \s* @s[ and friends ;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^ \t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)" @@ -7330,7 +7427,7 @@ indentation and initial hashes. Behaves usually outside of comment." (if cperl-highlight-variables-indiscriminately (setq t-font-lock-keywords-1 (append t-font-lock-keywords-1 - (list '("[$*]{?\\(\\sw+\\)" 1 + (list '("\\([$*]{?\\sw+\\)" 1 font-lock-variable-name-face))))) (setq perl-font-lock-keywords-1 (if cperl-syntaxify-by-font-lock @@ -7666,79 +7763,211 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'." (defconst cperl-styles-entries '(cperl-indent-level cperl-brace-offset cperl-continued-brace-offset cperl-label-offset cperl-extra-newline-before-brace + cperl-extra-newline-before-brace-multiline cperl-merge-trailing-else cperl-continued-statement-offset)) +(defconst cperl-style-examples +"##### Numbers etc are: cperl-indent-level cperl-brace-offset +##### cperl-continued-brace-offset cperl-label-offset +##### cperl-continued-statement-offset +##### cperl-merge-trailing-else cperl-extra-newline-before-brace + +########### (Do not forget cperl-extra-newline-before-brace-multiline) + +### CPerl (=GNU - extra-newline-before-brace + merge-trailing-else) 2/0/0/-2/2/t/nil +if (foo) { + bar + baz; + label: + { + boon; + } +} else { + stop; +} + +### PerlStyle (=CPerl with 4 as indent) 4/0/0/-4/4/t/nil +if (foo) { + bar + baz; + label: + { + boon; + } +} else { + stop; +} + +### GNU 2/0/0/-2/2/nil/t +if (foo) + { + bar + baz; + label: + { + boon; + } + } +else + { + stop; + } + +### C++ (=PerlStyle with braces aligned with control words) 4/0/-4/-4/4/nil/t +if (foo) +{ + bar + baz; + label: + { + boon; + } +} +else +{ + stop; +} + +### BSD (=C++, but will not change preexisting merge-trailing-else +### and extra-newline-before-brace ) 4/0/-4/-4/4 +if (foo) +{ + bar + baz; + label: + { + boon; + } +} +else +{ + stop; +} + +### K&R (=C++ with indent 5 - merge-trailing-else, but will not +### change preexisting extra-newline-before-brace) 5/0/-5/-5/5/nil +if (foo) +{ + bar + baz; + label: + { + boon; + } +} +else +{ + stop; +} + +### Whitesmith (=PerlStyle, but will not change preexisting +### extra-newline-before-brace and merge-trailing-else) 4/0/0/-4/4 +if (foo) + { + bar + baz; + label: + { + boon; + } + } +else + { + stop; + } +" +"Examples of if/else with different indent styles (with v4.23).") + (defconst cperl-style-alist - '(("CPerl" ; =GNU without extra-newline-before-brace + '(("CPerl" ;; =GNU - extra-newline-before-brace + cperl-merge-trailing-else (cperl-indent-level . 2) (cperl-brace-offset . 0) (cperl-continued-brace-offset . 0) (cperl-label-offset . -2) + (cperl-continued-statement-offset . 2) (cperl-extra-newline-before-brace . nil) - (cperl-merge-trailing-else . t) - (cperl-continued-statement-offset . 2)) + (cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . t)) + ("PerlStyle" ; CPerl with 4 as indent (cperl-indent-level . 4) (cperl-brace-offset . 0) (cperl-continued-brace-offset . 0) (cperl-label-offset . -4) + (cperl-continued-statement-offset . 4) (cperl-extra-newline-before-brace . nil) - (cperl-merge-trailing-else . t) - (cperl-continued-statement-offset . 4)) + (cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . t)) + ("GNU" (cperl-indent-level . 2) (cperl-brace-offset . 0) (cperl-continued-brace-offset . 0) (cperl-label-offset . -2) + (cperl-continued-statement-offset . 2) (cperl-extra-newline-before-brace . t) - (cperl-merge-trailing-else . nil) - (cperl-continued-statement-offset . 2)) + (cperl-extra-newline-before-brace-multiline . t) + (cperl-merge-trailing-else . nil)) + ("K&R" (cperl-indent-level . 5) (cperl-brace-offset . 0) (cperl-continued-brace-offset . -5) (cperl-label-offset . -5) + (cperl-continued-statement-offset . 5) ;;(cperl-extra-newline-before-brace . nil) ; ??? - (cperl-merge-trailing-else . nil) - (cperl-continued-statement-offset . 5)) + ;;(cperl-extra-newline-before-brace-multiline . nil) + (cperl-merge-trailing-else . nil)) + ("BSD" (cperl-indent-level . 4) (cperl-brace-offset . 0) (cperl-continued-brace-offset . -4) (cperl-label-offset . -4) + (cperl-continued-statement-offset . 4) ;;(cperl-extra-newline-before-brace . nil) ; ??? - (cperl-continued-statement-offset . 4)) + ;;(cperl-extra-newline-before-brace-multiline . nil) + ;;(cperl-merge-trailing-else . nil) ; ??? + ) + ("C++" (cperl-indent-level . 4) (cperl-brace-offset . 0) (cperl-continued-brace-offset . -4) (cperl-label-offset . -4) (cperl-continued-statement-offset . 4) - (cperl-merge-trailing-else . nil) - (cperl-extra-newline-before-brace . t)) - ("Current") + (cperl-extra-newline-before-brace . t) + (cperl-extra-newline-before-brace-multiline . t) + (cperl-merge-trailing-else . nil)) + ("Whitesmith" (cperl-indent-level . 4) (cperl-brace-offset . 0) (cperl-continued-brace-offset . 0) (cperl-label-offset . -4) + (cperl-continued-statement-offset . 4) ;;(cperl-extra-newline-before-brace . nil) ; ??? - (cperl-continued-statement-offset . 4))) - "(Experimental) list of variables to set to get a particular indentation style. -Should be used via `cperl-set-style' or via Perl menu.") + ;;(cperl-extra-newline-before-brace-multiline . nil) + ;;(cperl-merge-trailing-else . nil) ; ??? + ) + ("Current")) + "List of variables to set to get a particular indentation style. +Should be used via `cperl-set-style' or via Perl menu. + +See examples in `cperl-style-examples'.") (defun cperl-set-style (style) "Set CPerl mode variables to use one of several different indentation styles. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles -are GNU, K&R, BSD, C++ and Whitesmith. +are CPerl, PerlStyle, GNU, K&R, BSD, C++ and Whitesmith. 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 -side-effect of memorizing only." +side-effect of memorizing only. Examples in `cperl-style-examples'." (interactive (let ((list (mapcar (function (lambda (elt) (list (car elt)))) cperl-style-alist))) @@ -8825,7 +9054,426 @@ than a line. Your contribution to update/shorten it is appreciated." (defvar cperl-short-docs 'please-ignore-this-line ;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl) - "") + "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5] +... Range (list context); flip/flop [no flop when flip] (scalar context). +! ... Logical negation. +... != ... Numeric inequality. +... !~ ... Search pattern, substitution, or translation (negated). +$! In numeric context: errno. In a string context: error string. +$\" The separator which joins elements of arrays interpolated in strings. +$# The output format for printed numbers. Default is %.15g or close. +$$ Process number of this script. Changes in the fork()ed child process. +$% The current page number of the currently selected output channel. + + The following variables are always local to the current block: + +$1 Match of the 1st set of parentheses in the last match (auto-local). +$2 Match of the 2nd set of parentheses in the last match (auto-local). +$3 Match of the 3rd set of parentheses in the last match (auto-local). +$4 Match of the 4th set of parentheses in the last match (auto-local). +$5 Match of the 5th set of parentheses in the last match (auto-local). +$6 Match of the 6th set of parentheses in the last match (auto-local). +$7 Match of the 7th set of parentheses in the last match (auto-local). +$8 Match of the 8th set of parentheses in the last match (auto-local). +$9 Match of the 9th set of parentheses in the last match (auto-local). +$& The string matched by the last pattern match (auto-local). +$' The string after what was matched by the last match (auto-local). +$` The string before what was matched by the last match (auto-local). + +$( The real gid of this process. +$) The effective gid of this process. +$* Deprecated: Set to 1 to do multiline matching within a string. +$+ The last bracket matched by the last search pattern. +$, The output field separator for the print operator. +$- The number of lines left on the page. +$. The current input line number of the last filehandle that was read. +$/ The input record separator, newline by default. +$0 Name of the file containing the current perl script (read/write). +$: String may be broken after these characters to fill ^-lines in a format. +$; Subscript separator for multi-dim array emulation. Default \"\\034\". +$< The real uid of this process. +$= The page length of the current output channel. Default is 60 lines. +$> The effective uid of this process. +$? The status returned by the last ``, pipe close or `system'. +$@ The perl error message from the last eval or do @var{EXPR} command. +$ARGV The name of the current file used with <> . +$[ Deprecated: The index of the first element/char in an array/string. +$\\ The output record separator for the print operator. +$] The perl version string as displayed with perl -v. +$^ The name of the current top-of-page format. +$^A The current value of the write() accumulator for format() lines. +$^D The value of the perl debug (-D) flags. +$^E Information about the last system error other than that provided by $!. +$^F The highest system file descriptor, ordinarily 2. +$^H The current set of syntax checks enabled by `use strict'. +$^I The value of the in-place edit extension (perl -i option). +$^L What formats output to perform a formfeed. Default is \f. +$^M A buffer for emergency memory allocation when running out of memory. +$^O The operating system name under which this copy of Perl was built. +$^P Internal debugging flag. +$^T The time the script was started. Used by -A/-M/-C file tests. +$^W True if warnings are requested (perl -w flag). +$^X The name under which perl was invoked (argv[0] in C-speech). +$_ The default input and pattern-searching space. +$| Auto-flush after write/print on current output channel? Default 0. +$~ The name of the current report format. +... % ... Modulo division. +... %= ... Modulo division assignment. +%ENV Contains the current environment. +%INC List of files that have been require-d or do-ne. +%SIG Used to set signal handlers for various signals. +... & ... Bitwise and. +... && ... Logical and. +... &&= ... Logical and assignment. +... &= ... Bitwise and assignment. +... * ... Multiplication. +... ** ... Exponentiation. +*NAME Glob: all objects refered 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++ +... += ... Addition assignment. +, Comma operator. +... - ... Subtraction. +-- Auto-decrement (NOT magical on strings). --EXPR EXPR-- +... -= ... Subtraction assignment. +-A Access time in days since script started. +-B File is a non-text (binary) file. +-C Inode change time in days since script started. +-M Age in days since script started. +-O File is owned by real uid. +-R File is readable by real uid. +-S File is a socket . +-T File is a text file. +-W File is writable by real uid. +-X File is executable by real uid. +-b File is a block special file. +-c File is a character special file. +-d File is a directory. +-e File exists . +-f File is a plain file. +-g File has setgid bit set. +-k File has sticky bit set. +-l File is a symbolic link. +-o File is owned by effective uid. +-p File is a named pipe (FIFO). +-r File is readable by effective uid. +-s File has non-zero size. +-t Tests if filehandle (STDIN by default) is opened to a tty. +-u File has setuid bit set. +-w File is writable by effective uid. +-x File is executable by effective uid. +-z File has zero size. +. Concatenate strings. +.. Range (list context); flip/flop (scalar context) operator. +.= Concatenate assignment strings +... / ... Division. /PATTERN/ioxsmg Pattern match +... /= ... Division assignment. +/PATTERN/ioxsmg Pattern match. +... < ... Numeric less than. Glob. See , <> as well. + Reads line from filehandle NAME (a bareword or dollar-bareword). + Glob (Unless pattern is bareword/dollar-bareword - see ). +<> Reads line from union of files in @ARGV (= command line) and STDIN. +... << ... Bitwise shift left. << start of HERE-DOCUMENT. +... <= ... Numeric less than or equal to. +... <=> ... Numeric compare. +... = ... Assignment. +... == ... Numeric equality. +... =~ ... Search pattern, substitution, or translation +... > ... Numeric greater than. +... >= ... Numeric greater than or equal to. +... >> ... Bitwise shift right. +... >>= ... Bitwise shift right assignment. +... ? ... : ... Condition=if-then-else operator. ?PAT? One-time pattern match. +?PATTERN? One-time pattern match. +@ARGV Command line arguments (not including the command name - see $0). +@INC List of places to look for perl scripts during do/include/use. +@_ Parameter array for subroutines; result of split() unless in list context. +\\ Creates reference to what follows, like \$var, or quotes non-\w in strings. +\\0 Octal char, e.g. \\033. +\\E Case modification terminator. See \\Q, \\L, and \\U. +\\L Lowercase until \\E . See also \\l, lc. +\\U Upcase until \\E . See also \\u, uc. +\\Q Quote metacharacters until \\E . See also quotemeta. +\\a Alarm character (octal 007). +\\b Backspace character (octal 010). +\\c Control character, e.g. \\c[ . +\\e Escape character (octal 033). +\\f Formfeed character (octal 014). +\\l Lowercase the next character. See also \\L and \\u, lcfirst. +\\n Newline character (octal 012 on most systems). +\\r Return character (octal 015 on most systems). +\\t Tab character (octal 011). +\\u Upcase the next character. See also \\U and \\l, ucfirst. +\\x Hex character, e.g. \\x1b. +... ^ ... Bitwise exclusive or. +__END__ Ends program source. +__DATA__ Ends program source. +__FILE__ Current (source) filename. +__LINE__ Current line in current source. +__PACKAGE__ Current package. +ARGV Default multi-file input filehandle. is a synonym for <>. +ARGVOUT Output filehandle with -i flag. +BEGIN { ... } Immediately executed (during compilation) piece of code. +END { ... } Pseudo-subroutine executed after the script finishes. +CHECK { ... } Pseudo-subroutine executed after the script is compiled. +INIT { ... } Pseudo-subroutine executed before the script starts running. +DATA Input filehandle for what follows after __END__ or __DATA__. +accept(NEWSOCKET,GENERICSOCKET) +alarm(SECONDS) +atan2(X,Y) +bind(SOCKET,NAME) +binmode(FILEHANDLE) +caller[(LEVEL)] +chdir(EXPR) +chmod(LIST) +chop[(LIST|VAR)] +chown(LIST) +chroot(FILENAME) +close(FILEHANDLE) +closedir(DIRHANDLE) +... cmp ... String compare. +connect(SOCKET,NAME) +continue of { block } continue { block }. Is executed after `next' or at end. +cos(EXPR) +crypt(PLAINTEXT,SALT) +dbmclose(%HASH) +dbmopen(%HASH,DBNAME,MODE) +defined(EXPR) +delete($HASH{KEY}) +die(LIST) +do { ... }|SUBR while|until EXPR executes at least once +do(EXPR|SUBR([LIST])) (with while|until executes at least once) +dump LABEL +each(%HASH) +endgrent +endhostent +endnetent +endprotoent +endpwent +endservent +eof[([FILEHANDLE])] +... eq ... String equality. +eval(EXPR) or eval { BLOCK } +exec([TRUENAME] ARGV0, ARGVs) or exec(SHELL_COMMAND_LINE) +exit(EXPR) +exp(EXPR) +fcntl(FILEHANDLE,FUNCTION,SCALAR) +fileno(FILEHANDLE) +flock(FILEHANDLE,OPERATION) +for (EXPR;EXPR;EXPR) { ... } +foreach [VAR] (@ARRAY) { ... } +fork +... ge ... String greater than or equal. +getc[(FILEHANDLE)] +getgrent +getgrgid(GID) +getgrnam(NAME) +gethostbyaddr(ADDR,ADDRTYPE) +gethostbyname(NAME) +gethostent +getlogin +getnetbyaddr(ADDR,ADDRTYPE) +getnetbyname(NAME) +getnetent +getpeername(SOCKET) +getpgrp(PID) +getppid +getpriority(WHICH,WHO) +getprotobyname(NAME) +getprotobynumber(NUMBER) +getprotoent +getpwent +getpwnam(NAME) +getpwuid(UID) +getservbyname(NAME,PROTO) +getservbyport(PORT,PROTO) +getservent +getsockname(SOCKET) +getsockopt(SOCKET,LEVEL,OPTNAME) +gmtime(EXPR) +goto LABEL +... gt ... String greater than. +hex(EXPR) +if (EXPR) { ... } [ elsif (EXPR) { ... } ... ] [ else { ... } ] or EXPR if EXPR +index(STR,SUBSTR[,OFFSET]) +int(EXPR) +ioctl(FILEHANDLE,FUNCTION,SCALAR) +join(EXPR,LIST) +keys(%HASH) +kill(LIST) +last [LABEL] +... le ... String less than or equal. +length(EXPR) +link(OLDFILE,NEWFILE) +listen(SOCKET,QUEUESIZE) +local(LIST) +localtime(EXPR) +log(EXPR) +lstat(EXPR|FILEHANDLE|VAR) +... lt ... String less than. +m/PATTERN/iogsmx +mkdir(FILENAME,MODE) +msgctl(ID,CMD,ARG) +msgget(KEY,FLAGS) +msgrcv(ID,VAR,SIZE,TYPE.FLAGS) +msgsnd(ID,MSG,FLAGS) +my VAR or my (VAR1,...) Introduces a lexical variable ($VAR, @ARR, or %HASH). +our VAR or our (VAR1,...) Lexically enable a global variable ($V, @A, or %H). +... ne ... String inequality. +next [LABEL] +oct(EXPR) +open(FILEHANDLE[,EXPR]) +opendir(DIRHANDLE,EXPR) +ord(EXPR) ASCII value of the first char of the string. +pack(TEMPLATE,LIST) +package NAME Introduces package context. +pipe(READHANDLE,WRITEHANDLE) Create a pair of filehandles on ends of a pipe. +pop(ARRAY) +print [FILEHANDLE] [(LIST)] +printf [FILEHANDLE] (FORMAT,LIST) +push(ARRAY,LIST) +q/STRING/ Synonym for 'STRING' +qq/STRING/ Synonym for \"STRING\" +qx/STRING/ Synonym for `STRING` +rand[(EXPR)] +read(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) +readdir(DIRHANDLE) +readlink(EXPR) +recv(SOCKET,SCALAR,LEN,FLAGS) +redo [LABEL] +rename(OLDNAME,NEWNAME) +require [FILENAME | PERL_VERSION] +reset[(EXPR)] +return(LIST) +reverse(LIST) +rewinddir(DIRHANDLE) +rindex(STR,SUBSTR[,OFFSET]) +rmdir(FILENAME) +s/PATTERN/REPLACEMENT/gieoxsm +scalar(EXPR) +seek(FILEHANDLE,POSITION,WHENCE) +seekdir(DIRHANDLE,POS) +select(FILEHANDLE | RBITS,WBITS,EBITS,TIMEOUT) +semctl(ID,SEMNUM,CMD,ARG) +semget(KEY,NSEMS,SIZE,FLAGS) +semop(KEY,...) +send(SOCKET,MSG,FLAGS[,TO]) +setgrent +sethostent(STAYOPEN) +setnetent(STAYOPEN) +setpgrp(PID,PGRP) +setpriority(WHICH,WHO,PRIORITY) +setprotoent(STAYOPEN) +setpwent +setservent(STAYOPEN) +setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL) +shift[(ARRAY)] +shmctl(ID,CMD,ARG) +shmget(KEY,SIZE,FLAGS) +shmread(ID,VAR,POS,SIZE) +shmwrite(ID,STRING,POS,SIZE) +shutdown(SOCKET,HOW) +sin(EXPR) +sleep[(EXPR)] +socket(SOCKET,DOMAIN,TYPE,PROTOCOL) +socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL) +sort [SUBROUTINE] (LIST) +splice(ARRAY,OFFSET[,LENGTH[,LIST]]) +split[(/PATTERN/[,EXPR[,LIMIT]])] +sprintf(FORMAT,LIST) +sqrt(EXPR) +srand(EXPR) +stat(EXPR|FILEHANDLE|VAR) +study[(SCALAR)] +sub [NAME [(format)]] { BODY } sub NAME [(format)]; sub [(format)] {...} +substr(EXPR,OFFSET[,LEN]) +symlink(OLDFILE,NEWFILE) +syscall(LIST) +sysread(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) +system([TRUENAME] ARGV0 [,ARGV]) or system(SHELL_COMMAND_LINE) +syswrite(FILEHANDLE,SCALAR,LENGTH[,OFFSET]) +tell[(FILEHANDLE)] +telldir(DIRHANDLE) +time +times +tr/SEARCHLIST/REPLACEMENTLIST/cds +truncate(FILE|EXPR,LENGTH) +umask[(EXPR)] +undef[(EXPR)] +unless (EXPR) { ... } [ else { ... } ] or EXPR unless EXPR +unlink(LIST) +unpack(TEMPLATE,EXPR) +unshift(ARRAY,LIST) +until (EXPR) { ... } EXPR until EXPR +utime(LIST) +values(%HASH) +vec(EXPR,OFFSET,BITS) +wait +waitpid(PID,FLAGS) +wantarray Returns true if the sub/eval is called in list context. +warn(LIST) +while (EXPR) { ... } EXPR while EXPR +write[(EXPR|FILEHANDLE)] +... x ... Repeat string or array. +x= ... Repetition assignment. +y/SEARCHLIST/REPLACEMENTLIST/ +... | ... Bitwise or. +... || ... Logical or. +~ ... Unary bitwise complement. +#! OS interpreter indicator. If contains `perl', used for options, and -x. +AUTOLOAD {...} Shorthand for `sub AUTOLOAD {...}'. +CORE:: Prefix to access builtin function if imported sub obscures it. +SUPER:: Prefix to lookup for a method in @ISA classes. +DESTROY Shorthand for `sub DESTROY {...}'. +... EQ ... Obsolete synonym of `eq'. +... GE ... Obsolete synonym of `ge'. +... GT ... Obsolete synonym of `gt'. +... LE ... Obsolete synonym of `le'. +... LT ... Obsolete synonym of `lt'. +... NE ... Obsolete synonym of `ne'. +abs [ EXPR ] absolute value +... and ... Low-precedence synonym for &&. +bless REFERENCE [, PACKAGE] Makes reference into an object of a package. +chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''! +chr Converts a number to char with the same ordinal. +else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. +elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}. +exists $HASH{KEY} True if the key exists. +format [NAME] = Start of output format. Ended by a single dot (.) on a line. +formline PICTURE, LIST Backdoor into \"format\" processing. +glob EXPR Synonym of . +lc [ EXPR ] Returns lowercased EXPR. +lcfirst [ EXPR ] Returns EXPR with lower-cased first letter. +grep EXPR,LIST or grep {BLOCK} LIST Filters LIST via EXPR/BLOCK. +map EXPR, LIST or map {BLOCK} LIST Applies EXPR/BLOCK to elts of LIST. +no PACKAGE [SYMBOL1, ...] Partial reverse for `use'. Runs `unimport' method. +not ... Low-precedence synonym for ! - negation. +... or ... Low-precedence synonym for ||. +pos STRING Set/Get end-position of the last match over this string, see \\G. +quotemeta [ EXPR ] Quote regexp metacharacters. +qw/WORD1 .../ Synonym of split('', 'WORD1 ...') +readline FH Synonym of . +readpipe CMD Synonym of `CMD`. +ref [ EXPR ] Type of EXPR when dereferenced. +sysopen FH, FILENAME, MODE [, PERM] (MODE is numeric, see Fcntl.) +tie VAR, PACKAGE, LIST Hide an object behind a simple Perl variable. +tied Returns internal object for a tied data. +uc [ EXPR ] Returns upcased EXPR. +ucfirst [ EXPR ] Returns EXPR with upcased first letter. +untie VAR Unlink an object from a simple Perl variable. +use PACKAGE [SYMBOL1, ...] Compile-time `require' with consequent `import'. +... xor ... Low-precedence synonym for exclusive or. +prototype \&SUB Returns prototype of the function given a reference. +=head1 Top-level heading. +=head2 Second-level heading. +=head3 Third-level heading (is there such?). +=over [ NUMBER ] Start list. +=item [ TITLE ] Start new item in the list. +=back End list. +=cut Switch from POD to Perl. +=pod Switch from Perl to POD. +") (defun cperl-switch-to-doc-buffer () "Go to the perl documentation buffer and insert the documentation." @@ -9180,6 +9828,8 @@ We suppose that the regexp is scanned already." (goto-char pre-if) (forward-sexp 2) (forward-sexp -1) + ;; May be after $, @, $# etc of a variable + (skip-chars-backward "$@%#") (setq pre-A (point)) (cperl-forward-to-end-of-expr) (setq post-A (point)) @@ -9781,7 +10431,7 @@ do extra unwind via `cperl-unwind-to-safe'." (cperl-fontify-syntaxically to))))) (defvar cperl-version - (let ((v "$Revision: 5.19 $")) + (let ((v "$Revision: 5.23 $")) (string-match ":\\s *\\([0-9.]+\\)" v) (substring v (match-beginning 1) (match-end 1))) "Version of IZ-supported CPerl package this file is based on.") -- 2.39.2