X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/15cb2300cf80b1b3180c10fdc3fb96bff9c2a342..b70d9316bbf3e2482c1345d8135ddd1ee7e25ba7:/lisp/progmodes/perl-mode.el diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index d8ee5feeb7..ad4633e20e 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -1,8 +1,9 @@ ;;; perl-mode.el --- Perl code editing commands for GNU Emacs -;; Copyright (C) 1990, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1994, 2003, 2005 Free Software Foundation, Inc. ;; Author: William F. Mann +;; Maintainer: FSF ;; Adapted-By: ESR ;; Keywords: languages @@ -22,15 +23,16 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") ;; to your .emacs file and change the first line of your perl script to: ;; #!/usr/bin/perl -- # -*-Perl-*- -;; With argments to perl: +;; With arguments to perl: ;; #!/usr/bin/perl -P- # -*-Perl-*- ;; To handle files included with do 'filename.pl';, add something like ;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode)) @@ -48,13 +50,13 @@ ;; the line ends in a quoted string, or has a # which should be a \#. ;; If your machine is slow, you may want to remove some of the bindings -;; to electric-perl-terminator. I changed the indenting defaults to be +;; to perl-electric-terminator. I changed the indenting defaults to be ;; what Larry Wall uses in perl/lib, but left in all the options. ;; I also tuned a few things: comments and labels starting in column -;; zero are left there by indent-perl-exp; perl-beginning-of-function +;; zero are left there by perl-indent-exp; perl-beginning-of-function ;; goes back to the first open brace/paren in column zero, the open brace -;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp +;; in 'sub ... {', or the equal sign in 'format ... ='; perl-indent-exp ;; (meta-^q) indents from the current line through the close of the next ;; brace/paren, so you don't need to start exactly at a brace or paren. @@ -64,16 +66,19 @@ ;; Known problems (these are all caused by limitations in the Emacs Lisp ;; parsing routine (parse-partial-sexp), which was not designed for such ;; a rich language; writing a more suitable parser would be a big job): +;; 2) The globbing syntax is not recognized, so special +;; characters in the pattern string must be backslashed. +;; 3) The << quoting operators are not recognized; see below. +;; 5) To make '$' work correctly, $' is not recognized as a variable. +;; Use "$'" or $POSTMATCH instead. +;; +;; If you don't use font-lock, additional problems will appear: ;; 1) Regular expression delimiters do not act as quotes, so special ;; characters such as `'"#:;[](){} may need to be backslashed ;; in regular expressions and in both parts of s/// and tr///. -;; 2) The globbing syntax is not recognized, so special -;; characters in the pattern string must be backslashed. -;; 3) The q, qq, and << quoting operators are not recognized; see below. -;; 4) \ (backslash) always quotes the next character, so '\' is -;; treated as the start of a string. Use "\\" as a work-around. +;; 4) The q and qq quoting operators are not recognized; see below. ;; 5) To make variables such a $' and $#array work, perl-mode treats -;; $ just like backslash, so '$' is the same as problem 5. +;; $ just like backslash, so '$' is not treated correctly. ;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an ;; unmatched }. See below. ;; 7) When ' (quote) is used as a package name separator, perl-mode @@ -87,8 +92,10 @@ ;; ;; /`/; $ugly = q?"'$?; /`/; ;; -;; To solve problem 6, add a /{/; before each use of ${var}: -;; /{/; while (<${glob_me}>) ... +;; The same trick can be used for problem 6 as in: +;; /{/; while (<${glob_me}>) +;; but a simpler solution is to add a space between the $ and the {: +;; while (<$ {glob_me}>) ;; ;; Problem 7 is even worse, but this 'fix' does work :-( ;; $DB'stop#' @@ -97,103 +104,328 @@ ;;; Code: +(eval-when-compile (require 'cl)) + +(defgroup perl nil + "Major mode for editing Perl code." + :prefix "perl-" + :group 'languages) + (defvar perl-mode-abbrev-table nil "Abbrev table in use in perl-mode buffers.") (define-abbrev-table 'perl-mode-abbrev-table ()) -(defvar perl-mode-map () +(defvar perl-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "{" 'perl-electric-terminator) + (define-key map "}" 'perl-electric-terminator) + (define-key map ";" 'perl-electric-terminator) + (define-key map ":" 'perl-electric-terminator) + (define-key map "\e\C-a" 'perl-beginning-of-function) + (define-key map "\e\C-e" 'perl-end-of-function) + (define-key map "\e\C-h" 'perl-mark-function) + (define-key map "\e\C-q" 'perl-indent-exp) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map "\t" 'perl-indent-command) + map) "Keymap used in Perl mode.") -(if perl-mode-map - () - (setq perl-mode-map (make-sparse-keymap)) - (define-key perl-mode-map "{" 'electric-perl-terminator) - (define-key perl-mode-map "}" 'electric-perl-terminator) - (define-key perl-mode-map ";" 'electric-perl-terminator) - (define-key perl-mode-map ":" 'electric-perl-terminator) - (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function) - (define-key perl-mode-map "\e\C-e" 'perl-end-of-function) - (define-key perl-mode-map "\e\C-h" 'mark-perl-function) - (define-key perl-mode-map "\e\C-q" 'indent-perl-exp) - (define-key perl-mode-map "\177" 'backward-delete-char-untabify) - (define-key perl-mode-map "\t" 'perl-indent-command)) (autoload 'c-macro-expand "cmacexp" "Display the result of expanding all C macros occurring in the region. The expansion is entirely correct because it uses the C preprocessor." t) -(defvar perl-mode-syntax-table nil - "Syntax table in use in perl-mode buffers.") - -(if perl-mode-syntax-table - () - (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table))) - (modify-syntax-entry ?\n ">" perl-mode-syntax-table) - (modify-syntax-entry ?# "<" perl-mode-syntax-table) - (modify-syntax-entry ?$ "/" perl-mode-syntax-table) - (modify-syntax-entry ?% "." perl-mode-syntax-table) - (modify-syntax-entry ?& "." perl-mode-syntax-table) - (modify-syntax-entry ?\' "\"" perl-mode-syntax-table) - (modify-syntax-entry ?* "." perl-mode-syntax-table) - (modify-syntax-entry ?+ "." perl-mode-syntax-table) - (modify-syntax-entry ?- "." perl-mode-syntax-table) - (modify-syntax-entry ?/ "." perl-mode-syntax-table) - (modify-syntax-entry ?< "." perl-mode-syntax-table) - (modify-syntax-entry ?= "." perl-mode-syntax-table) - (modify-syntax-entry ?> "." perl-mode-syntax-table) - (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table) - (modify-syntax-entry ?` "\"" perl-mode-syntax-table) - (modify-syntax-entry ?| "." perl-mode-syntax-table) -) - -(defvar perl-font-lock-keywords - (list -; ("if" "until" "while" "elsif" "else" "unless" "for" "foreach" "continue" -; "exit" "die" "last" "goto" "next" "redo" "return" "local" "exec") - (concat "\\<\\(" - "continue\\|die\\|e\\(ls\\(e\\|if\\)\\|x\\(ec\\|it\\)\\)\\|" - "for\\(\\|each\\)\\|goto\\|if\\|l\\(ast\\|ocal\\)\\|next\\|" - "re\\(do\\|turn\\)\\|un\\(less\\|til\\)\\|while" - "\\)\\>") -; ("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" "#define" "#undef") - (cons (concat "#\\(define\\|e\\(lse\\|ndif\\)\\|" - "i\\(f\\(\\|def\\|ndef\\)\\|nclude\\)\\|undef\\)\\>") - 'font-lock-reference-face) - '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) - '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) - '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face) - ) - "Additional expressions to highlight in Perl mode.") - -(defvar perl-indent-level 4 - "*Indentation of Perl statements with respect to containing block.") -(defvar perl-continued-statement-offset 4 - "*Extra indent for lines not starting new statements.") -(defvar perl-continued-brace-offset -4 +(defvar perl-mode-syntax-table + (let ((st (make-syntax-table (standard-syntax-table)))) + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?# "<" st) + ;; `$' is also a prefix char so I was tempted to say "/ p", + ;; but the `p' thingy basically overrides the `/' :-( --stef + (modify-syntax-entry ?$ "/" st) + (modify-syntax-entry ?% ". p" st) + (modify-syntax-entry ?@ ". p" st) + (modify-syntax-entry ?& "." st) + (modify-syntax-entry ?\' "\"" st) + (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?- "." st) + (modify-syntax-entry ?/ "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?` "\"" st) + (modify-syntax-entry ?| "." st) + st) + "Syntax table in use in `perl-mode' buffers.") + +(defvar perl-imenu-generic-expression + '(;; Functions + (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) + ;;Variables + ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) + ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) + ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) + "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") + +;; Regexps updated with help from Tom Tromey and +;; Jim Campbell . + +(defconst perl-font-lock-keywords-1 + '(;; What is this for? + ;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face) + ;; + ;; Fontify preprocessor statements as we do in `c-font-lock-keywords'. + ;; Ilya Zakharevich thinks this is a bad idea. + ;; ("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) + ;; ("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face) + ;; ("^#[ \t]*if\\>" + ;; ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil + ;; (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t))) + ;; ("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" + ;; (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)) + ;; + ;; Fontify function and package names in declarations. + ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + ("\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))) + "Subdued level highlighting for Perl mode.") + +(defconst perl-font-lock-keywords-2 + (append perl-font-lock-keywords-1 + (list + ;; + ;; Fontify keywords, except those fontified otherwise. + (concat "\\<" + (regexp-opt '("if" "until" "while" "elsif" "else" "unless" + "do" "dump" "for" "foreach" "exit" "die" + "BEGIN" "END" "return" "exec" "eval") t) + "\\>") + ;; + ;; Fontify local and my keywords as types. + '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ;; + ;; Fontify function, variable and file name references. + '("&\\(\\sw+\\)" 1 font-lock-function-name-face) + ;; Additionally underline non-scalar variables. Maybe this is a bad idea. + ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) + '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face) + '("\\([@%]\\|\\$#\\)\\(\\sw+\\)" + (2 (cons font-lock-variable-name-face '(underline)))) + '("<\\(\\sw+\\)>" 1 font-lock-constant-face) + ;; + ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. + '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) + '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face))) + "Gaudy level highlighting for Perl mode.") + +(defvar perl-font-lock-keywords perl-font-lock-keywords-1 + "Default expressions to highlight in Perl mode.") + +(defvar perl-quote-like-pairs + '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>))) + +;; FIXME: handle here-docs and regexps. +;; < /.../ +;; s '...'...' +;; tr /.../.../ +;; y /.../.../ +;; +;; +(defvar perl-font-lock-syntactic-keywords + ;; Turn POD into b-style comments + '(("^\\(=\\)\\sw" (1 "< b")) + ("^=cut[ \t]*\\(\n\\)" (1 "> b")) + ;; Catch ${ so that ${var} doesn't screw up indentation. + ;; This also catches $' to handle 'foo$', although it should really + ;; check that it occurs inside a '..' string. + ("\\(\\$\\)[{']" (1 ". p")) + ;; Handle funny names like $DB'stop. + ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) + ;; format statements + ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) + ;; Funny things in sub arg specifications like `sub myfunc ($$)' + ("\\\\s-*\\([^])}> \n\t]\\)" + ;; Nasty cases: + ;; /foo/m $a->m $#m $m @m %m + ;; \s (appears often in regexps). + ;; -s file + (2 (if (assoc (char-after (match-beginning 2)) + perl-quote-like-pairs) + '(15) '(7)))) + ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + )) + +(defvar perl-empty-syntax-table + (let ((st (copy-syntax-table))) + ;; Make all chars be of punctuation syntax. + (dotimes (i 256) (aset st i '(1))) + (modify-syntax-entry ?\\ "\\" st) + st) + "Syntax table used internally for processing quote-like operators.") + +(defun perl-quote-syntax-table (char) + (let ((close (cdr (assq char perl-quote-like-pairs))) + (st (copy-syntax-table perl-empty-syntax-table))) + (if (not close) + (modify-syntax-entry char "\"" st) + (modify-syntax-entry char "(" st) + (modify-syntax-entry close ")" st)) + st)) + +(defun perl-font-lock-syntactic-face-function (state) + (let ((char (nth 3 state))) + (cond + ((not char) + ;; Comment or docstring. + (if (nth 7 state) font-lock-doc-face font-lock-comment-face)) + ((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")) + ;; Normal string. + font-lock-string-face) + ((eq (nth 3 state) ?\n) + ;; A `format' command. + (save-excursion + (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) + (not (eobp))) + (put-text-property (point) (1+ (point)) 'syntax-table '(7))) + font-lock-string-face)) + (t + ;; This is regexp like quote thingy. + (setq char (char-after (nth 8 state))) + (save-excursion + (let ((twoargs (save-excursion + (goto-char (nth 8 state)) + (skip-syntax-backward " ") + (skip-syntax-backward "w") + (member (buffer-substring + (point) (progn (forward-word 1) (point))) + '("tr" "s" "y")))) + (close (cdr (assq char perl-quote-like-pairs))) + (pos (point)) + (st (perl-quote-syntax-table char))) + (if (not close) + ;; The closing char is the same as the opening char. + (with-syntax-table st + (parse-partial-sexp (point) (point-max) + nil nil state 'syntax-table) + (when twoargs + (parse-partial-sexp (point) (point-max) + nil nil state 'syntax-table))) + ;; The open/close chars are matched like () [] {} and <>. + (let ((parse-sexp-lookup-properties nil)) + (ignore-errors + (with-syntax-table st + (goto-char (nth 8 state)) (forward-sexp 1)) + (when twoargs + (save-excursion + ;; Skip whitespace and make sure that font-lock will + ;; refontify the second part in the proper context. + (put-text-property + (point) (progn (forward-comment (point-max)) (point)) + 'font-lock-multiline t) + ;; + (unless + (save-excursion + (let* ((char2 (char-after)) + (st2 (perl-quote-syntax-table char2))) + (with-syntax-table st2 (forward-sexp 1)) + (put-text-property pos (line-end-position) + 'jit-lock-defer-multiline t) + (looking-at "\\s-*\\sw*e"))) + (put-text-property (point) (1+ (point)) + 'syntax-table + (if (assoc (char-after) + perl-quote-like-pairs) + '(15) '(7))))))))) + ;; Erase any syntactic marks within the quoted text. + (put-text-property pos (1- (point)) 'syntax-table nil) + (when (eq (char-before (1- (point))) ?$) + (put-text-property (- (point) 2) (1- (point)) + 'syntax-table '(1))) + (put-text-property (1- (point)) (point) + 'syntax-table (if close '(15) '(7))) + font-lock-string-face)))))) + ;; (if (or twoargs (not (looking-at "\\s-*\\sw*e"))) + ;; font-lock-string-face + ;; (font-lock-fontify-syntactically-region + ;; ;; FIXME: `end' is accessed via dyn-scoping. + ;; pos (min end (1- (point))) nil '(nil)) + ;; nil))))))) + + +(defcustom perl-indent-level 4 + "*Indentation of Perl statements with respect to containing block." + :type 'integer) +(defcustom perl-continued-statement-offset 4 + "*Extra indent for lines not starting new statements." + :type 'integer) +(defcustom perl-continued-brace-offset -4 "*Extra indent for substatements that start with open-braces. -This is in addition to `perl-continued-statement-offset'.") -(defvar perl-brace-offset 0 - "*Extra indentation for braces, compared with other text in same context.") -(defvar perl-brace-imaginary-offset 0 - "*Imagined indentation of an open brace that actually follows a statement.") -(defvar perl-label-offset -2 - "*Offset of Perl label lines relative to usual indentation.") - -(defvar perl-tab-always-indent t - "*Non-nil means TAB in Perl mode always indents the current line. +This is in addition to `perl-continued-statement-offset'." + :type 'integer) +(defcustom perl-brace-offset 0 + "*Extra indentation for braces, compared with other text in same context." + :type 'integer) +(defcustom perl-brace-imaginary-offset 0 + "*Imagined indentation of an open brace that actually follows a statement." + :type 'integer) +(defcustom perl-label-offset -2 + "*Offset of Perl label lines relative to usual indentation." + :type 'integer) +(defcustom perl-indent-continued-arguments nil + "*If non-nil offset of argument lines relative to usual indentation. +If nil, continued arguments are aligned with the first argument." + :type '(choice integer (const nil))) + +(defcustom perl-tab-always-indent tab-always-indent + "Non-nil means TAB in Perl mode always indents the current line. Otherwise it inserts a tab character if you type it past the first -nonwhite character on the line.") +nonwhite character on the line." + :type 'boolean) ;; I changed the default to nil for consistency with general Emacs ;; conventions -- rms. -(defvar perl-tab-to-comment nil +(defcustom perl-tab-to-comment nil "*Non-nil means TAB moves to eol or makes a comment in some cases. For lines which don't need indenting, TAB either indents an existing comment, moves to end-of-line, or if at end-of-line already, -create a new comment.") - -(defvar perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:" - "*Lines starting with this regular expression are not auto-indented.") +create a new comment." + :type 'boolean) + +(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]" + "*Lines starting with this regular expression are not auto-indented." + :type 'regexp) + +;; Outline support + +(defvar perl-outline-regexp + (concat (mapconcat 'cadr perl-imenu-generic-expression "\\|") + "\\|^=cut\\>")) + +(defun perl-outline-level () + (cond + ((looking-at "package\\s-") 0) + ((looking-at "sub\\s-") 1) + ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0)) + ((looking-at "=cut") 1) + (t 3))) ;;;###autoload (defun perl-mode () @@ -205,32 +437,34 @@ Paragraphs are separated by blank lines only. Delete converts tabs to spaces as it moves back. \\{perl-mode-map} Variables controlling indentation style: - perl-tab-always-indent + `perl-tab-always-indent' Non-nil means TAB in Perl mode should always indent the current line, regardless of where in the line point is when the TAB command is used. - perl-tab-to-comment + `perl-tab-to-comment' Non-nil means that for lines which don't need indenting, TAB will - either delete an empty comment, indent an existing comment, move + either delete an empty comment, indent an existing comment, move to end-of-line, or if at end-of-line already, create a new comment. - perl-nochange + `perl-nochange' Lines starting with this regular expression are not auto-indented. - perl-indent-level + `perl-indent-level' Indentation of Perl statements within surrounding block. The surrounding block's indentation is the indentation of the line on which the open-brace appears. - perl-continued-statement-offset + `perl-continued-statement-offset' Extra indentation given to a substatement, such as the then-clause of an if or body of a while. - perl-continued-brace-offset + `perl-continued-brace-offset' Extra indentation given to a brace that starts a substatement. This is in addition to `perl-continued-statement-offset'. - perl-brace-offset + `perl-brace-offset' Extra indentation for line if it starts with an open brace. - perl-brace-imaginary-offset + `perl-brace-imaginary-offset' An open brace following other text is treated as if it were this far to the right of the start of its line. - perl-label-offset + `perl-label-offset' Extra indentation for line that is a label. + `perl-indent-continued-arguments' + Offset of argument lines relative to usual indentation. Various indentation styles: K&R BSD BLK GNU LW perl-indent-level 5 8 0 2 4 @@ -249,7 +483,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (setq local-abbrev-table perl-mode-abbrev-table) (set-syntax-table perl-mode-syntax-table) (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "^$\\|" page-delimiter)) + (setq paragraph-start (concat "$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'paragraph-ignore-fill-prefix) @@ -257,21 +491,34 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (make-local-variable 'indent-line-function) (setq indent-line-function 'perl-indent-line) (make-local-variable 'require-final-newline) - (setq require-final-newline t) + (setq require-final-newline mode-require-final-newline) (make-local-variable 'comment-start) (setq comment-start "# ") (make-local-variable 'comment-end) (setq comment-end "") - (make-local-variable 'comment-column) - (setq comment-column 32) (make-local-variable 'comment-start-skip) (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'perl-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(perl-font-lock-keywords)) + ;; Tell font-lock.el how to handle Perl. + (setq font-lock-defaults '((perl-font-lock-keywords + perl-font-lock-keywords-1 + perl-font-lock-keywords-2) + nil nil ((?\_ . "w")) nil + (font-lock-syntactic-keywords + . perl-font-lock-syntactic-keywords) + (font-lock-syntactic-face-function + . perl-font-lock-syntactic-face-function) + (parse-sexp-lookup-properties . t))) + ;; Tell imenu how to handle Perl. + (set (make-local-variable 'imenu-generic-expression) + perl-imenu-generic-expression) + (setq imenu-case-fold-search nil) + ;; Setup outline-minor-mode. + (set (make-local-variable 'outline-regexp) perl-outline-regexp) + (set (make-local-variable 'outline-level) 'perl-outline-level) (run-hooks 'perl-mode-hook)) ;; This is used by indent-for-comment @@ -280,12 +527,10 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (defun perl-comment-indent () (if (and (bolp) (not (eolp))) 0 ;Existing comment at bol stays there. - (save-excursion - (skip-chars-backward " \t") - (max (1+ (current-column)) ;Else indent at comment column - comment-column)))) ; except leave at least one space. + comment-column)) -(defun electric-perl-terminator (arg) +(defalias 'electric-perl-terminator 'perl-electric-terminator) +(defun perl-electric-terminator (arg) "Insert character and adjust indentation. If at end-of-line, and not in a comment or a quote, correct the's indentation." (interactive "P") @@ -295,11 +540,12 @@ If at end-of-line, and not in a comment or a quote, correct the's indentation." (save-excursion (beginning-of-line) (and (not ; eliminate comments quickly - (re-search-forward comment-start-skip insertpos t)) + (and comment-start-skip + (re-search-forward comment-start-skip insertpos t)) ) (or (/= last-command-char ?:) ;; Colon is special only after a label .... (looking-at "\\s-*\\(\\w\\|\\s_\\)+$")) - (let ((pps (parse-partial-sexp + (let ((pps (parse-partial-sexp (perl-beginning-of-function) insertpos))) (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))) (progn ; must insert, indent, delete @@ -344,23 +590,22 @@ possible action from the following list: (if (and (not perl-tab-always-indent) (> (current-column) (current-indentation))) (insert-tab) - (let (bof lsexp delta (oldpnt (point))) - (beginning-of-line) - (setq lsexp (point)) - (setq bof (perl-beginning-of-function)) - (goto-char oldpnt) - (setq delta (perl-indent-line "\f\\|;?#" bof)) + (let* ((oldpnt (point)) + (lsexp (progn (beginning-of-line) (point))) + (bof (perl-beginning-of-function)) + (delta (progn + (goto-char oldpnt) + (perl-indent-line "\f\\|;?#" bof)))) (and perl-tab-to-comment (= oldpnt (point)) ; done if point moved (if (listp delta) ; if line starts in a quoted string (setq lsexp (or (nth 2 delta) bof)) (= delta 0)) ; done if indenting occurred - (let (eol state) - (end-of-line) - (setq eol (point)) + (let ((eol (progn (end-of-line) (point))) + state) (if (= (char-after bof) ?=) (if (= oldpnt eol) - (message "In a format statement")) + (message "In a format statement")) (setq state (parse-partial-sexp lsexp eol)) (if (nth 3 state) (if (= oldpnt eol) ; already at eol in a string @@ -370,7 +615,8 @@ possible action from the following list: (if (= oldpnt eol) ; no comment, create one? (indent-for-comment)) (beginning-of-line) - (if (re-search-forward comment-start-skip eol 'move) + (if (and comment-start-skip + (re-search-forward comment-start-skip eol 'move)) (if (eolp) (progn ; kill existing comment (goto-char (match-beginning 0)) @@ -386,7 +632,7 @@ possible action from the following list: (defun perl-indent-line (&optional nochange parse-start) "Indent current line as Perl code. -Return the amount the indentation +Return the amount the indentation changed by, or (parse-state) if line starts in a quoted string." (let ((case-fold-search nil) (pos (- (point-max) (point))) @@ -395,15 +641,23 @@ changed by, or (parse-state) if line starts in a quoted string." (beginning-of-line) (setq beg (point)) (setq shift-amt - (cond ((= (char-after bof) ?=) 0) - ((listp (setq indent (calculate-perl-indent bof))) indent) + (cond ((eq (char-after bof) ?=) 0) + ((listp (setq indent (perl-calculate-indent bof))) indent) ((looking-at (or nochange perl-nochange)) 0) (t (skip-chars-forward " \t\f") - (cond ((looking-at "\\(\\w\\|\\s_\\)+:") + (cond ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") (setq indent (max 1 (+ indent perl-label-offset)))) - ((= (following-char) ?}) - (setq indent (- indent perl-indent-level))) + ((= (char-syntax (following-char)) ?\)) + (setq indent + (save-excursion + (forward-char 1) + (forward-sexp -1) + (forward-char 1) + (if (perl-hanging-paren-p) + (- indent perl-indent-level) + (forward-char -1) + (current-column))))) ((= (following-char) ?{) (setq indent (+ indent perl-brace-offset)))) (- indent (current-column))))) @@ -417,10 +671,35 @@ changed by, or (parse-state) if line starts in a quoted string." (goto-char (- (point-max) pos))) shift-amt)) -(defun calculate-perl-indent (&optional parse-start) +(defun perl-continuation-line-p (limit) + "Move to end of previous line and return non-nil if continued." + ;; Statement level. Is it a continuation or a new statement? + ;; Find previous non-comment character. + (perl-backward-to-noncomment) + ;; Back up over label lines, since they don't + ;; affect whether our line is a continuation. + (while (or (eq (preceding-char) ?\,) + (and (eq (preceding-char) ?:) + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_)))) + (if (eq (preceding-char) ?\,) + (perl-backward-to-start-of-continued-exp limit) + (beginning-of-line)) + (perl-backward-to-noncomment)) + ;; Now we get the answer. + (not (memq (preceding-char) '(?\; ?\} ?\{)))) + +(defun perl-hanging-paren-p () + "Non-nil if we are right after a hanging parenthesis-like char." + (and (looking-at "[ \t]*$") + (save-excursion + (skip-syntax-backward " (") (not (bolp))))) + +(defun perl-calculate-indent (&optional parse-start) "Return appropriate indentation for current line as Perl code. In usual case returns an integer: the column to indent to. -Returns (parse-state) if line starts inside a string." +Returns (parse-state) if line starts inside a string. +Optional argument PARSE-START should be the position of `beginning-of-defun'." (save-excursion (beginning-of-line) (let ((indent-point (point)) @@ -430,19 +709,27 @@ Returns (parse-state) if line starts inside a string." (if parse-start ;used to avoid searching (goto-char parse-start) (perl-beginning-of-function)) + ;; We might be now looking at a local function that has nothing to + ;; do with us because `indent-point' is past it. In this case + ;; look further back up for another `perl-beginning-of-function'. + (while (and (looking-at "{") + (save-excursion + (beginning-of-line) + (looking-at "\\s-+sub\\>")) + (> indent-point (save-excursion (forward-sexp 1) (point)))) + (perl-beginning-of-function)) (while (< (point) indent-point) ;repeat until right sexp - (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) -; state = (depth_in_parens innermost_containing_list last_complete_sexp -; string_terminator_or_nil inside_commentp following_quotep -; minimum_paren-depth_this_scan) -; Parsing stops if depth in parentheses becomes equal to third arg. + ;; state = (depth_in_parens innermost_containing_list + ;; last_complete_sexp string_terminator_or_nil inside_commentp + ;; following_quotep minimum_paren-depth_this_scan) + ;; Parsing stops if depth in parentheses becomes equal to third arg. (setq containing-sexp (nth 1 state))) (cond ((nth 3 state) state) ; In a quoted string? ((null containing-sexp) ; Line is at top level. (skip-chars-forward " \t\f") (if (= (following-char) ?{) - 0 ; move to beginning of line if it starts a function body + 0 ; move to beginning of line if it starts a function body ;; indent a little if this is a continuation line (perl-backward-to-noncomment) (if (or (bobp) @@ -452,29 +739,38 @@ Returns (parse-state) if line starts inside a string." ;; line is expression, not statement: ;; indent to just after the surrounding open. (goto-char (1+ containing-sexp)) - (current-column)) + (if (perl-hanging-paren-p) + ;; We're indenting an arg of a call like: + ;; $a = foobarlongnamefun ( + ;; arg1 + ;; arg2 + ;; ); + (progn + (skip-syntax-backward "(") + (condition-case err + (while (save-excursion + (skip-syntax-backward " ") (not (bolp))) + (forward-sexp -1)) + (scan-error nil)) + (+ (current-column) perl-indent-level)) + (if perl-indent-continued-arguments + (+ perl-indent-continued-arguments (current-indentation)) + (skip-chars-forward " \t") + (current-column)))) (t ;; Statement level. Is it a continuation or a new statement? - ;; Find previous non-comment character. - (perl-backward-to-noncomment) - ;; Back up over label lines, since they don't - ;; affect whether our line is a continuation. - (while (or (eq (preceding-char) ?\,) - (and (eq (preceding-char) ?:) - (memq (char-syntax (char-after (- (point) 2))) - '(?w ?_)))) - (if (eq (preceding-char) ?\,) - (perl-backward-to-start-of-continued-exp containing-sexp)) - (beginning-of-line) - (perl-backward-to-noncomment)) - ;; Now we get the answer. - (if (not (memq (preceding-char) '(?\; ?\} ?\{))) + (if (perl-continuation-line-p containing-sexp) ;; This line is continuation of preceding line's statement; ;; indent perl-continued-statement-offset more than the ;; previous line of the statement. (progn (perl-backward-to-start-of-continued-exp containing-sexp) - (+ perl-continued-statement-offset (current-column) + (+ (if (save-excursion + (perl-continuation-line-p containing-sexp)) + ;; If the continued line is itself a continuation + ;; line, then align, otherwise add an offset. + 0 perl-continued-statement-offset) + (current-column) (if (save-excursion (goto-char indent-point) (looking-at "[ \t]*{")) perl-continued-brace-offset 0))) @@ -482,69 +778,54 @@ Returns (parse-state) if line starts inside a string." ;; Position at last unclosed open. (goto-char containing-sexp) (or - ;; If open paren is in col 0, close brace is special - (and (bolp) - (save-excursion (goto-char indent-point) - (looking-at "[ \t]*}")) - perl-indent-level) - ;; Is line first statement after an open-brace? - ;; If no, find that first statement and indent like it. - (save-excursion - (forward-char 1) - ;; Skip over comments and labels following openbrace. - (while (progn - (skip-chars-forward " \t\f\n") - (cond ((looking-at ";?#") - (forward-line 1) t) - ((looking-at "\\(\\w\\|\\s_\\)+:") - (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)) - (- (current-indentation) perl-label-offset) - (current-column)))) - ;; If no previous statement, - ;; indent it relative to line brace is on. - ;; For open paren in column zero, don't let statement - ;; start there too. If perl-indent-level is zero, - ;; use perl-brace-offset + perl-continued-statement-offset - ;; For open-braces not the first thing in a line, - ;; add in perl-brace-imaginary-offset. - (+ (if (and (bolp) (zerop perl-indent-level)) - (+ perl-brace-offset perl-continued-statement-offset) - perl-indent-level) - ;; Move back over whitespace before the openbrace. - ;; If openbrace is not first nonwhite thing on the line, - ;; add the perl-brace-imaginary-offset. - (progn (skip-chars-backward " \t") - (if (bolp) 0 perl-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. - (current-indentation)))))))))) + ;; Is line first statement after an open-brace? + ;; If no, find that first statement and indent like it. + (save-excursion + (forward-char 1) + ;; Skip over comments and labels following openbrace. + (while (progn + (skip-chars-forward " \t\f\n") + (cond ((looking-at ";?#") + (forward-line 1) t) + ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") + (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)) + (- (current-indentation) perl-label-offset) + (current-column)))) + ;; If no previous statement, + ;; indent it relative to line brace is on. + ;; For open paren in column zero, don't let statement + ;; start there too. If perl-indent-level is zero, + ;; use perl-brace-offset + perl-continued-statement-offset + ;; For open-braces not the first thing in a line, + ;; add in perl-brace-imaginary-offset. + (+ (if (and (bolp) (zerop perl-indent-level)) + (+ perl-brace-offset perl-continued-statement-offset) + perl-indent-level) + ;; Move back over whitespace before the openbrace. + ;; If openbrace is not first nonwhite thing on the line, + ;; add the perl-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 perl-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. + (current-indentation)))))))))) (defun perl-backward-to-noncomment () "Move point backward to after the first non-white-space, skipping comments." (interactive) - (let (opoint stop) - (while (not stop) - (setq opoint (point)) - (beginning-of-line) - (if (re-search-forward comment-start-skip opoint 'move 1) - (progn (goto-char (match-end 1)) - (skip-chars-forward ";"))) - (skip-chars-backward " \t\f") - (setq stop (or (bobp) - (not (bolp)) - (forward-char -1)))))) + (forward-comment (- (point-max)))) (defun perl-backward-to-start-of-continued-exp (lim) (if (= (preceding-char) ?\)) @@ -555,7 +836,8 @@ Returns (parse-state) if line starts inside a string." (skip-chars-forward " \t\f")) ;; note: this may be slower than the c-mode version, but I can understand it. -(defun indent-perl-exp () +(defalias 'indent-perl-exp 'perl-indent-exp) +(defun perl-indent-exp () "Indent each line of the Perl grouping following point." (interactive) (let* ((case-fold-search nil) @@ -578,7 +860,7 @@ Returns (parse-state) if line starts inside a string." (while (< (point) (marker-position last-mark)) (setq delta (perl-indent-line nil (marker-position bof-mark))) (if (numberp delta) ; unquoted start-of-line? - (progn + (progn (if (eolp) (delete-horizontal-space)) (setq lsexp-mark (point-marker)))) @@ -591,7 +873,8 @@ Returns (parse-state) if line starts inside a string." (listp delta) (and (/= 0 delta) (= (- (current-indentation) delta) comment-column))) - (if (re-search-forward comment-start-skip eol t) + (if (and comment-start-skip + (re-search-forward comment-start-skip eol t)) (indent-for-comment))))) ; indent existing comment (forward-line 1)) (goto-char (marker-position oldpnt)) @@ -620,7 +903,7 @@ With argument, repeat that many times; negative args move backward." (or arg (setq arg 1)) (let ((first t)) (while (and (> arg 0) (< (point) (point-max))) - (let ((pos (point)) npos) + (let ((pos (point))) (while (progn (if (and first (progn @@ -652,7 +935,8 @@ With argument, repeat that many times; negative args move backward." (goto-char (point-min))))) (setq arg (1+ arg))))) -(defun mark-perl-function () +(defalias 'mark-perl-function 'perl-mark-function) +(defun perl-mark-function () "Put mark at end of Perl function, point at beginning." (interactive) (push-mark (point)) @@ -661,4 +945,7 @@ With argument, repeat that many times; negative args move backward." (perl-beginning-of-function) (backward-paragraph)) -;;;;;;;; That's all, folks! ;;;;;;;;; +(provide 'perl-mode) + +;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826 +;;; perl-mode.el ends here