X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/42be8f2ecab18c3ba0474a524f1b5e2cd7d2be40..b70d9316bbf3e2482c1345d8135ddd1ee7e25ba7:/lisp/progmodes/perl-mode.el diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 626310a226..ad4633e20e 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -1,6 +1,6 @@ ;;; 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 @@ -96,7 +96,7 @@ ;; /{/; 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#' ;; [$DB'line#' @@ -161,10 +161,11 @@ The expansion is entirely correct because it uses the C preprocessor." (defvar perl-imenu-generic-expression '(;; Functions - (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 ) + (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) ;;Variables - ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 ) - ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1 )) + ("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 @@ -260,15 +261,17 @@ The expansion is entirely correct because it uses the C preprocessor." ;; Funny things in sub arg specifications like `sub myfunc ($$)' ("\\\\s-*\\([^])}> \n\t]\\)" + ("[?:.,;=!~({[][ \t\n]*\\(/\\)" (1 '(7))) + ("[?:.,;=!~({[ \t\n]\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\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)))))) + '(15) '(7)))) + ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + )) (defvar perl-empty-syntax-table (let ((st (copy-syntax-table))) @@ -337,7 +340,7 @@ The expansion is entirely correct because it uses the C preprocessor." (put-text-property (point) (progn (forward-comment (point-max)) (point)) 'font-lock-multiline t) - ;; + ;; (unless (save-excursion (let* ((char2 (char-after)) @@ -365,45 +368,37 @@ The expansion is entirely correct because it uses the C preprocessor." ;; ;; 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 - :group 'perl) + :type 'integer) (defcustom perl-continued-statement-offset 4 "*Extra indent for lines not starting new statements." - :type 'integer - :group 'perl) + :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'." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-brace-offset 0 "*Extra indentation for braces, compared with other text in same context." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-brace-imaginary-offset 0 "*Imagined indentation of an open brace that actually follows a statement." - :type 'integer - :group 'perl) + :type 'integer) (defcustom perl-label-offset -2 "*Offset of Perl label lines relative to usual indentation." - :type 'integer - :group 'perl) + :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)) - :group 'perl) + :type '(choice integer (const nil))) -(defcustom perl-tab-always-indent t - "*Non-nil means TAB in Perl mode always indents the current line. +(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." - :type 'boolean - :group 'perl) + :type 'boolean) ;; I changed the default to nil for consistency with general Emacs ;; conventions -- rms. @@ -412,13 +407,25 @@ nonwhite character on the line." 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." - :type 'boolean - :group 'perl) + :type 'boolean) -(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:" +(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]" "*Lines starting with this regular expression are not auto-indented." - :type 'regexp - :group 'perl) + :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 () @@ -435,7 +442,7 @@ Variables controlling indentation style: regardless of where in the line point is when the TAB command is used. `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' Lines starting with this regular expression are not auto-indented. @@ -484,7 +491,7 @@ 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) @@ -506,9 +513,12 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." . perl-font-lock-syntactic-face-function) (parse-sexp-lookup-properties . t))) ;; Tell imenu how to handle Perl. - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression perl-imenu-generic-expression) + (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 @@ -535,7 +545,7 @@ If at end-of-line, and not in a comment or a quote, correct the's indentation." (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 @@ -622,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))) @@ -638,8 +648,16 @@ changed by, or (parse-state) if line starts in a quoted string." (skip-chars-forward " \t\f") (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))))) @@ -671,6 +689,12 @@ changed by, or (parse-state) if line starts in a quoted string." ;; 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. @@ -715,10 +739,24 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." ;; line is expression, not statement: ;; indent to just after the surrounding open. (goto-char (1+ containing-sexp)) - (if perl-indent-continued-arguments - (+ perl-indent-continued-arguments (current-indentation)) - (skip-chars-forward " \t") - (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? (if (perl-continuation-line-p containing-sexp) @@ -740,21 +778,16 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." ;; 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 + ;; 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_\\)+:") + ((looking-at "\\(\\w\\|\\s_\\)+:[^:]") (save-excursion (end-of-line) (setq colon-line-end (point))) @@ -827,7 +860,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'." (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)))) @@ -870,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 @@ -914,4 +947,5 @@ With argument, repeat that many times; negative args move backward." (provide 'perl-mode) +;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826 ;;; perl-mode.el ends here