emacs: lisp/progmodes/perl-mode.el comparison

comparison lisp/progmodes/perl-mode.el @ 88155:d7ddb3e565de

sync with trunk

author	Henrik Enberg <henrik.enberg@telia.com>
date	Mon, 16 Jan 2006 00:03:54 +0000
parents	0d8b17d428b5
children

comparison

equal deleted inserted replaced

-:8ce476d3ba36
+:d7ddb3e565de
 ;;; perl-mode.el --- Perl code editing commands for GNU Emacs
-;; Copyright (C) 1990, 1994  Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1994, 2001, 2002, 2003, 2004, 2005
+;; Free Software Foundation, Inc.
 ;; Author: William F. Mann
 ;; Maintainer: FSF
 ;; Adapted-By: ESR
 ;; Keywords: languages
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; 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, Inc., 59 Temple Place - Suite 330,
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02111-1307, USA.
+;; Boston, MA 02110-1301, 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:
 ;;; Code:
 (eval-when-compile (require 'cl))
+(defvar font-lock-comment-face)
+(defvar font-lock-doc-face)
+(defvar font-lock-string-face)
 (defgroup perl nil
 "Major mode for editing Perl code."
+:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
 :prefix "perl-"
 :group 'languages)
 (defvar perl-mode-abbrev-table nil
 "Abbrev table in use in perl-mode buffers.")
 st)
 "Syntax table in use in `perl-mode' buffers.")
 (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 )
+("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1)
-("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 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 <tromey@cambric.colorado.edu> and
 ;; Jim Campbell <jec@murzim.ca.boeing.com>.
 ;;
 ;; 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)
+'("&\\(\\sw+\\(::\\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+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face)
-'("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
+'("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\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+\\)?"
 ;; tr /.../.../
 ;; y /.../.../
 ;;
 ;; <file*glob>
 (defvar perl-font-lock-syntactic-keywords
-;; Turn POD into b-style comments
+;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
-'(("^\\(=\\)\\sw" (1 "< b"))
+'(;; 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"))
 ;; format statements
 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7)))
 ;; Funny things in sub arg specifications like `sub myfunc ($$)'
 ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1))
 ;; regexp and funny quotes
-("[;(=!~{][ \t\n]*\\(/\\)" (1 '(7)))
+("[?:.,;=!~({[][ \t\n]*\\(/\\)" (1 '(7)))
-("[;( =!~{\t\n]\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
+("\\(^\\|[?:.,;=!~({[ \t]\\)\\([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))
+(3 (if (assoc (char-after (match-beginning 3))
 		   perl-quote-like-pairs)
-	    '(15) '(7))))))
+	    '(15) '(7))))
+;; Find and mark the end of funny quotes and format statements.
+(perl-font-lock-special-syntactic-constructs)
+))
 (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 char "\"" st)
 (modify-syntax-entry char "(" st)
 (modify-syntax-entry close ")" st))
 st))
-(defun perl-font-lock-syntactic-face-function (state)
+(defun perl-font-lock-special-syntactic-constructs (limit)
-(let ((char (nth 3 state)))
+;; We used to do all this in a font-lock-syntactic-face-function, which
-(cond
+;; did not work correctly because sometimes some parts of the buffer are
-((not char)
+;; treated with font-lock-syntactic-keywords but not with
-;; Comment or docstring.
+;; font-lock-syntactic-face-function (mostly because of
-(if (nth 7 state) font-lock-doc-face font-lock-comment-face))
+;; font-lock-syntactically-fontified).  That meant that some syntax-table
-((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\"))
+;; properties were missing.  So now we do the parse-partial-sexp loop
-;; Normal string.
+;; ourselves directly from font-lock-syntactic-keywords, so we're sure
-font-lock-string-face)
+;; it's done when necessary.
-((eq (nth 3 state) ?\n)
+(let ((state (syntax-ppss))
-;; A `format' command.
+char)
-(save-excursion
+(while (< (point) limit)
-	(when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
+(cond
-		   (not (eobp)))
+((or (null (setq char (nth 3 state)))
-	  (put-text-property (point) (1+ (point)) 'syntax-table '(7)))
+(and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")))
-	font-lock-string-face))
+;; Normal text, or comment, or docstring, or normal string.
-(t
+nil)
-;; This is regexp like quote thingy.
+((eq (nth 3 state) ?\n)
-(setq char (char-after (nth 8 state)))
+;; A `format' command.
 (save-excursion
-	(let ((twoargs (save-excursion
+(when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
-			 (goto-char (nth 8 state))
+(not (eobp)))
-			 (skip-syntax-backward " ")
+(put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
-			 (skip-syntax-backward "w")
+(t
-			 (member (buffer-substring
+;; This is regexp like quote thingy.
-				  (point) (progn (forward-word 1) (point)))
+(setq char (char-after (nth 8 state)))
-				 '("tr" "s" "y"))))
+(save-excursion
-	      (close (cdr (assq char perl-quote-like-pairs)))
+(let ((twoargs (save-excursion
-	      (pos (point))
+(goto-char (nth 8 state))
-	      (st (perl-quote-syntax-table char)))
+(skip-syntax-backward " ")
-	  (if (not close)
+(skip-syntax-backward "w")
-	      ;; The closing char is the same as the opening char.
+(member (buffer-substring
-	      (with-syntax-table st
+(point) (progn (forward-word 1) (point)))
-		(parse-partial-sexp (point) (point-max)
+'("tr" "s" "y"))))
-				    nil nil state 'syntax-table)
+(close (cdr (assq char perl-quote-like-pairs)))
-		(when twoargs
+(pos (point))
-		  (parse-partial-sexp (point) (point-max)
+(st (perl-quote-syntax-table char)))
-				      nil nil state 'syntax-table)))
+(if (not close)
-	    ;; The open/close chars are matched like () [] {} and <>.
+;; The closing char is the same as the opening char.
-	    (let ((parse-sexp-lookup-properties nil))
+(with-syntax-table st
-	      (ignore-errors
+(parse-partial-sexp (point) (point-max)
-		(with-syntax-table st
+nil nil state 'syntax-table)
-		  (goto-char (nth 8 state)) (forward-sexp 1))
+(when twoargs
-		(when twoargs
+(parse-partial-sexp (point) (point-max)
-		  (save-excursion
+nil nil state 'syntax-table)))
-		    ;; Skip whitespace and make sure that font-lock will
+;; The open/close chars are matched like () [] {} and <>.
-		    ;; refontify the second part in the proper context.
+(let ((parse-sexp-lookup-properties nil))
-		    (put-text-property
+(condition-case err
-		     (point) (progn (forward-comment (point-max)) (point))
+(progn
-		     'font-lock-multiline t)
+(with-syntax-table st
-		    ;;
+(goto-char (nth 8 state)) (forward-sexp 1))
-		    (unless
+(when twoargs
-			(save-excursion
+(save-excursion
-			  (let* ((char2 (char-after))
+;; Skip whitespace and make sure that font-lock will
-				 (st2 (perl-quote-syntax-table char2)))
+;; refontify the second part in the proper context.
-			    (with-syntax-table st2 (forward-sexp 1))
+(put-text-property
-			    (put-text-property pos (line-end-position)
+(point) (progn (forward-comment (point-max)) (point))
-					       'jit-lock-defer-multiline t)
+'font-lock-multiline t)
-			    (looking-at "\\s-*\\sw*e")))
+;;
-		      (put-text-property (point) (1+ (point))
+(unless
-					 'syntax-table
+(save-excursion
-					 (if (assoc (char-after)
+(with-syntax-table
-						    perl-quote-like-pairs)
+(perl-quote-syntax-table (char-after))
-					     '(15) '(7)))))))))
+(forward-sexp 1))
-	  ;; Erase any syntactic marks within the quoted text.
+(put-text-property pos (line-end-position)
-	  (put-text-property pos (1- (point)) 'syntax-table nil)
+'jit-lock-defer-multiline t)
-	  (when (eq (char-before (1- (point))) ?$)
+(looking-at "\\s-*\\sw*e"))
-	    (put-text-property (- (point) 2) (1- (point))
+(put-text-property (point) (1+ (point))
-			       'syntax-table '(1)))
+'syntax-table
-	  (put-text-property (1- (point)) (point)
+(if (assoc (char-after)
-			     'syntax-table (if close '(15) '(7)))
+perl-quote-like-pairs)
-	  font-lock-string-face))))))
+'(15) '(7)))))))
-	    ;; (if (or twoargs (not (looking-at "\\s-*\\sw*e")))
+;; The arg(s) is not terminated, so it extends until EOB.
-	    ;; 	font-lock-string-face
+(scan-error (goto-char (point-max))))))
-	    ;;   (font-lock-fontify-syntactically-region
+;; Point is now right after the arg(s).
-	    ;;    ;; FIXME: `end' is accessed via dyn-scoping.
+;; Erase any syntactic marks within the quoted text.
-	    ;;    pos (min end (1- (point))) nil '(nil))
+(put-text-property pos (1- (point)) 'syntax-table nil)
-	    ;;   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)))))))
+(setq state (parse-partial-sexp (point) limit nil nil state
+				      'syntax-table))))
+;; Tell font-lock that this needs not further processing.
+nil)
 (defcustom perl-indent-level 4
 "*Indentation of Perl statements with respect to containing block."
 :type 'integer
 "*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)
-(defcustom perl-tab-always-indent t
+(defcustom perl-tab-always-indent tab-always-indent
-"*Non-nil means TAB in Perl mode always indents the current line.
+"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)
 existing comment, moves to end-of-line, or if at end-of-line already,
 create a new comment."
 :type 'boolean
 :group 'perl)
-(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)
+;; 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)))
+(defvar perl-mode-hook nil
+"Normal hook to run when entering Perl mode.")
 ;;;###autoload
 (defun perl-mode ()
 "Major mode for editing Perl code.
 Expression and list commands understand all Perl brackets.
 Tab indents for Perl code.
 (make-local-variable 'paragraph-ignore-fill-prefix)
 (setq paragraph-ignore-fill-prefix t)
 (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-start-skip)
 			      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.
-(make-local-variable 'imenu-generic-expression)
+(set (make-local-variable 'imenu-generic-expression)
-(setq imenu-generic-expression perl-imenu-generic-expression)
+perl-imenu-generic-expression)
 (setq imenu-case-fold-search nil)
-(run-hooks 'perl-mode-hook))
+;; Setup outline-minor-mode.
+(set (make-local-variable 'outline-regexp) perl-outline-regexp)
+(set (make-local-variable 'outline-level) 'perl-outline-level)
+(run-mode-hooks 'perl-mode-hook))
 ;; This is used by indent-for-comment
 ;; to decide how much to indent a comment in Perl code
 ;; based on its context.
 (defun perl-comment-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_\\)+:[^:]")
+		 (setq indent (perl-indent-new-calculate nil indent bof))
-			(setq indent (max 1 (+ indent perl-label-offset))))
-		       ((= (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)))))
 (skip-chars-forward " \t\f")
 (if (and (numberp shift-amt) (/= 0 shift-amt))
 	(progn (delete-region beg (point))
 	       (indent-to indent)))
 "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-indent-new-calculate (&optional virtual default parse-start)
+(or
+(and virtual (save-excursion (skip-chars-backward " \t") (bolp))
+	(current-column))
+(and (looking-at "\\(\\w\\|\\s_\\)+:[^:]")
+	(max 1 (+ (or default (perl-calculate-indent parse-start))
+		  perl-label-offset)))
+(and (= (char-syntax (following-char)) ?\))
+	(save-excursion
+	  (forward-char 1)
+	  (forward-sexp -1)
+	  (perl-indent-new-calculate 'virtual nil parse-start)))
+(and (and (= (following-char) ?{)
+	     (save-excursion (forward-char) (perl-hanging-paren-p)))
+	(+ (or default (perl-calculate-indent parse-start))
+	   perl-brace-offset))
+(or default (perl-calculate-indent parse-start))))
 (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.
 Optional argument PARSE-START should be the position of `beginning-of-defun'."
 (save-excursion
-(beginning-of-line)
 (let ((indent-point (point))
 	  (case-fold-search nil)
 	  (colon-line-end 0)
 	  state containing-sexp)
 (if parse-start			;used to avoid searching
 		  ;; 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)))
 				  (search-forward ":")))))
 		  ;; The first following code counts
 With argument, repeat that many times; negative args move backward."
 (interactive "p")
 (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
 			  (forward-char 1)
 			  (perl-beginning-of-function 1)
 (perl-beginning-of-function)
 (backward-paragraph))
 (provide 'perl-mode)
+;; arch-tag: 8c7ff68d-15f3-46a2-ade2-b7c41f176826
 ;;; perl-mode.el ends here

Mercurial > emacs

comparison lisp/progmodes/perl-mode.el @ 88155:d7ddb3e565de