;;; 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 <cperl@ilyaz.org>
+;; Maintainer: Ilya Zakharevich <ilyaz@cpan.org>
;; Keywords: languages, Perl
;; This file is part of GNU Emacs.
;; 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
;;; `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
;;; `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
;;; `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
;;; 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
;;; 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
;;; `cperl-find-pods-heres': Misprint in REx for parsing REx
;;; Very minor optimization
;;; `my-cperl-REx-modifiers-face' got quoted
-;;; Recognize "print $foo <<END" as HERE-doc.
+;;; Recognize "print $foo <<END" as HERE-doc
;;; Put `REx-interpolated' text attribute if needed
-;;; `cperl-invert-if-unless-modifiers': New function.
+;;; `cperl-invert-if-unless-modifiers': New function
;;; `cperl-backward-to-start-of-expr': Likewise
;;; `cperl-forward-to-end-of-expr': Likewise
-;;; `cperl-invert-if-unless': Works in "the opposite way" too.
+;;; `cperl-invert-if-unless': Works in "the opposite way" too
;;; Cursor position on return is on the switch-word
;;; Indents comments better
;;; `REx-interpolated': New text attribute
-;;; `cperl-next-interpolated-REx': New function.
-;;; `cperl-next-interpolated-REx-0': Likewise.
-;;; `cperl-next-interpolated-REx-1': Likewise.
+;;; `cperl-next-interpolated-REx': New function
+;;; `cperl-next-interpolated-REx-0': Likewise
+;;; `cperl-next-interpolated-REx-1': Likewise
;;; "\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions
;;; Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'
-;;; `cperl-praise': Mention finded interpolated RExen.
+;;; `cperl-praise': Mention finded interpolated RExen
+
+;;; After 5.19:
+;;; `cperl-init-faces': Highlight %$foo, @$foo too
+;;; `cperl-short-docs': Better docs for system, exec
+;;; `cperl-find-pods-heres': Better detect << after print {FH} <<EOF etc.
+;;; Would not find HERE-doc ended by EOF without NL
+;;; `cperl-short-docs': Correct not-doubled \-escapes
+;;; start block: Put some `defvar' for stuff gone from XEmacs
+
+;;; After 5.20:
+;;; initial comment: Extend copyright, fix email address
+;;; `cperl-indent-comment-at-column-0': New customization variable
+;;; `cperl-comment-indent': Indentation after $#a would increasy by 1
+;;; `cperl-mode': Make `defun-prompt-regexp' grok BEGIN/END etc
+;;; `cperl-find-pods-heres': Mark CODE of s///e as `syntax-type' `multiline'
+;;; `cperl-at-end-of-expr': Would fail if @BAR=12 follows after ";"
+;;; `cperl-init-faces': If `cperl-highlight-variables-indiscriminately'
+;;; highlight $ in $foo too (UNTESTED)
+;;; `cperl-set-style': Docstring missed some available styles
+;;; toplevel: Menubar/Perl/Indent-Styles had FSF, now K&R
+;;; Change "Current" to "Memorize Current"
+;;; `cperl-indent-wrt-brace': New customization variable; the default is
+;;; as for pre-5.2 version
+;;; `cperl-styles-entries': Keep `cperl-extra-newline-before-brace-multiline'
+;;; `cperl-style-alist': Likewise
+;;; `cperl-fix-line-spacing': Support `cperl-merge-trailing-else' being nil,
+;;; and `cperl-extra-newline-before-brace' etc
+;;; being t
+;;; `cperl-indent-exp': Plans B and C to find continuation blocks even
+;;; if `cperl-extra-newline-before-brace' is t
+
+;;; After 5.21:
+;;; Improve some docstrings concerning indentation.
+;;; `cperl-indent-rules-alist': New variable
+;;; `cperl-sniff-for-indent': New function name
+;; (separated from `cperl-calculate-indent')
+;;; `cperl-calculate-indent': Separated the sniffer and the indenter;
+;;; uses `cperl-sniff-for-indent' now
+;;; `cperl-comment-indent': Test for `cperl-indent-comment-at-column-0'
+;;; was inverted;
+;;; Support `comment-column' = 0
+
+;;; After 5.22:
+;;; `cperl-where-am-i': Remove function
+;;; `cperl-backward-to-noncomment': Would go too far when skipping POD/HEREs
+;;; `cperl-sniff-for-indent': [string] and [comment] were inverted
+;;; When looking for label, skip s:m:y:tr
+;;; `cperl-indent-line': Likewise.
+;;; `cperl-mode': `font-lock-multiline' was assumed auto-local
+;;; `cperl-windowed-init': Wrong `ps-print' handling
+;;; (both thanks to Chong Yidong)
+;;; `cperl-look-at-leading-count': Could fail with unfinished RExen
+;;; `cperl-find-pods-heres': If the second part of s()[] is missing,
+;;; could try to highlight delimiters...
;;; Code:
\f
(defvar gud-perldb-history)
(defvar font-lock-background-mode) ; not in Emacs
(defvar font-lock-display-type) ; ditto
+ (defvar paren-backwards-message) ; Not in newer XEmacs?
+ (defvar vc-rcs-header) ; likewise?
+ (defvar vc-sccs-header) ; likewise?
(or (fboundp 'defgroup)
(defmacro defgroup (name val doc &rest arr)
nil))
:type 'integer
:group 'cperl-indentation-details)
+(defcustom cperl-indent-wrt-brace t
+ "*Non-nil means indent statements in if/etc block relative brace, not if/etc.
+Versions 5.2 ... 5.20 behaved as if this were `nil'."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
(defcustom cperl-auto-newline nil
"*Non-nil means automatically newline before and after braces,
and after colons and semicolons, inserted in CPerl code. The following
:type 'integer
:group 'cperl-indentation-details)
+(defcustom cperl-indent-comment-at-column-0 nil
+ "*Non-nil means that comment started at column 0 should be indentable."
+ :type 'boolean
+ :group 'cperl-indentation-details)
+
(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
"*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
:type '(repeat string)
(defun cperl-make-indent (column &optional minimum keep)
"Makes indent of the current line the requested amount.
-If ANEW, removes the old indentation. Works around a bug in ancient
+Unless KEEP, removes the old indentation. Works around a bug in ancient
versions of Emacs."
(let ((prop (get-text-property (point) 'syntax-type)))
(or keep
["PerlStyle" (cperl-set-style "PerlStyle") t]
["GNU" (cperl-set-style "GNU") t]
["C++" (cperl-set-style "C++") t]
- ["FSF" (cperl-set-style "FSF") t]
+ ["K&R" (cperl-set-style "K&R") t]
["BSD" (cperl-set-style "BSD") t]
["Whitesmith" (cperl-set-style "Whitesmith") t]
- ["Current" (cperl-set-style "Current") t]
+ ["Memorize Current" (cperl-set-style "Current") t]
["Memorized" (cperl-set-style-back) cperl-old-style])
("Micro-docs"
["Tips" (describe-variable 'cperl-tips) t]
`cperl-min-label-indent'
Minimal indentation for line that is a label.
-Settings for K&R and BSD indentation styles are
- `cperl-indent-level' 5 8
- `cperl-continued-statement-offset' 5 8
- `cperl-brace-offset' -5 -8
- `cperl-label-offset' -5 -8
+Settings for classic indent-styles: K&R BSD=C++ GNU PerlStyle=Whitesmith
+ `cperl-indent-level' 5 4 2 4
+ `cperl-brace-offset' 0 0 0 0
+ `cperl-continued-brace-offset' -5 -4 0 0
+ `cperl-label-offset' -5 -4 -2 -4
+ `cperl-continued-statement-offset' 5 4 2 4
CPerl knows several indentation styles, and may bulk set the
corresponding variables. Use \\[cperl-set-style] to do this. Use
\\[cperl-set-style-back] to restore the memorized preexisting values
-\(both available from menu).
+\(both available from menu). See examples in `cperl-style-examples'.
+
+Part of the indentation style is how different parts of if/elsif/else
+statements are broken into lines; in CPerl, this is reflected on how
+templates for these constructs are created (controlled by
+`cperl-extra-newline-before-brace'), and how reflow-logic should treat \"continuation\" blocks of else/elsif/continue, controlled by the same variable,
+and by `cperl-extra-newline-before-brace-multiline',
+`cperl-merge-trailing-else', `cperl-indent-region-fix-constructs'.
If `cperl-indent-level' is 0, the statement after opening brace in
column 0 is indented on
;;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
;;; cperl-maybe-white-and-comment-rex ; 15=pre-block
(setq defun-prompt-regexp
- (concat "[ \t]*sub"
+ (concat "[ \t]*\\(sub"
(cperl-after-sub-regexp 'named 'attr-groups)
+ "\\|" ; per toke.c
+ "\\(BEGIN\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
+ "\\)"
cperl-maybe-white-and-comment-rex))
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'cperl-comment-indent)
(if (boundp 'font-lock-multiline) ; Newer font-lock; use its facilities
(progn
(setq cperl-font-lock-multiline t) ; Not localized...
- (set 'font-lock-multiline t)) ; not present with old Emacs; auto-local
+ (set (make-local-variable 'font-lock-multiline) t))
(make-local-variable 'font-lock-fontify-region-function)
(set 'font-lock-fontify-region-function ; not present with old Emacs
'cperl-font-lock-fontify-region-function))
(defvar cperl-st-ket '(5 . ?\<))
-(defun cperl-comment-indent ()
+(defun cperl-comment-indent () ; called at point at supposed comment
(let ((p (point)) (c (current-column)) was phony)
- (if (looking-at "^#") 0 ; Existing comment at bol stays there.
+ (if (and (not cperl-indent-comment-at-column-0)
+ (looking-at "^#"))
+ 0 ; Existing comment at bol stays there.
;; Wrong comment found
(save-excursion
(setq was (cperl-to-comment-or-eol)
phony (eq (get-text-property (point) 'syntax-table)
cperl-st-cfence))
(if phony
- (progn
+ (progn ; Too naive???
(re-search-forward "#\\|$") ; Hmm, what about embedded #?
(if (eq (preceding-char) ?\#)
(forward-char -1))
(setq was nil)))
- (if (= (point) p)
+ (if (= (point) p) ; Our caller found a correct place
(progn
(skip-chars-backward " \t")
- (max (1+ (current-column)) ; Else indent at comment column
- comment-column))
+ (setq was (current-column))
+ (if (eq was 0)
+ comment-column
+ (max (1+ was) ; Else indent at comment column
+ comment-column)))
+ ;; No, the caller found a random place; we need to edit ourselves
(if was nil
(insert comment-start)
(backward-char (length comment-start)))
(setq cperl-wrong-comment t)
- (cperl-make-indent comment-column 1 'keep) ; Indent minimum 1
- c))))) ; except leave at least one space.
+ (cperl-make-indent comment-column 1) ; Indent min 1
+ c)))))
;;;(defun cperl-comment-indent-fallback ()
;;; "Is called if the standard comment-search procedure fails.
(t
(skip-chars-forward " \t")
(if (listp indent) (setq indent (car indent)))
- (cond ((looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
+ (cond ((and (looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
+ (not (looking-at "[smy]:\\|tr:")))
(and (> indent 0)
(setq indent (max cperl-min-label-indent
(+ indent cperl-label-offset)))))
;;; (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)
(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
;; 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'
(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)
(progn
(forward-sexp -2)
(not
- (looking-at "print\\>")))
+ (looking-at "\\(printf?\\|system\\|exec\\|sort\\)\\>")))
(error t)))))))
(error nil))) ; func(<<EOF)
(and (not (match-beginning 6)) ; Empty
;; some hook of fontification, and max is random
(or (and (re-search-forward (concat "^" qtag "$")
stop-point 'toend)
- (eq (following-char) ?\n))
+ ;;;(eq (following-char) ?\n) ; XXXX WHY???
+ )
(progn ; Pretend we matched at the end
(goto-char (point-max))
(re-search-forward "\\'")
(cperl-modify-syntax-type (1- (point)) cperl-st-ket)
(cperl-modify-syntax-type i cperl-st-bra)))
(put-text-property b i 'syntax-type 'string)
+ (put-text-property i (point) 'syntax-type 'multiline)
(if is-x-REx
(put-text-property b i 'indentable t)))
(cperl-commentify b1 (point) t)
(if (and is-REx is-x-REx)
(put-text-property (1+ b) (1- e)
'syntax-subtype 'x-REx)))
- (if i2
- (progn
+ (if (and i2 e1 b1 (> 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)
(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 ";" !
(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))))
(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
;; 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\\)\\>")
(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")
;; 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
(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
(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))
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_]\\)\\|\\(/\\)\\)"
(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
(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)))
(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. <pattern> Glob. See <NAME>, <> as well.
+<NAME> Reads line from filehandle NAME (a bareword or dollar-bareword).
+<pattern> Glob (Unless pattern is bareword/dollar-bareword - see <NAME>).
+<> 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. <ARGV> 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 <EXPR>.
+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 <FH>.
+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."
(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))
(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.")
projects / lib.git / commitdiff