Mercurial > emacs
comparison lisp/progmodes/perl-mode.el @ 47469:531c20e5755b
(perl-mode-syntax-table): Mark $, % and @
such that backward-sexp correctly skips them.
(perl-font-lock-keywords-2): Use regexp-opt.
(perl-font-lock-syntactic-keywords)
(perl-font-lock-syntactic-face-function): Better handle PODs.
Handle package names with ' in them and ($$) in `sub' declarations.
Handle format staements. Handle regexp and quote-like ops.
(perl-empty-syntax-table): New var.
(perl-quote-syntax-table): New fun.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 13 Sep 2002 18:44:29 +0000 |
parents | b97054e2d931 |
children | db56d4bb5e01 |
comparison
equal
deleted
inserted
replaced
47468:de490e9b55fa | 47469:531c20e5755b |
---|---|
64 ;; main program. This will let you reindent it with meta-^q. | 64 ;; main program. This will let you reindent it with meta-^q. |
65 | 65 |
66 ;; Known problems (these are all caused by limitations in the Emacs Lisp | 66 ;; Known problems (these are all caused by limitations in the Emacs Lisp |
67 ;; parsing routine (parse-partial-sexp), which was not designed for such | 67 ;; parsing routine (parse-partial-sexp), which was not designed for such |
68 ;; a rich language; writing a more suitable parser would be a big job): | 68 ;; a rich language; writing a more suitable parser would be a big job): |
69 ;; 2) The globbing syntax <pattern> is not recognized, so special | |
70 ;; characters in the pattern string must be backslashed. | |
71 ;; 3) The << quoting operators are not recognized; see below. | |
72 ;; 5) To make '$' work correctly, $' is not recognized as a variable. | |
73 ;; Use "$'" or $POSTMATCH instead. | |
74 ;; | |
75 ;; If you don't use font-lock, additional problems will appear: | |
69 ;; 1) Regular expression delimiters do not act as quotes, so special | 76 ;; 1) Regular expression delimiters do not act as quotes, so special |
70 ;; characters such as `'"#:;[](){} may need to be backslashed | 77 ;; characters such as `'"#:;[](){} may need to be backslashed |
71 ;; in regular expressions and in both parts of s/// and tr///. | 78 ;; in regular expressions and in both parts of s/// and tr///. |
72 ;; 2) The globbing syntax <pattern> is not recognized, so special | 79 ;; 4) The q and qq quoting operators are not recognized; see below. |
73 ;; characters in the pattern string must be backslashed. | |
74 ;; 3) The q, qq, and << quoting operators are not recognized; see below. | |
75 ;; 5) To make '$' work correctly, $' is not recognized as a variable. | |
76 ;; Use "$'" or $POSTMATCH instead. | |
77 ;; 7) When ' (quote) is used as a package name separator, perl-mode | |
78 ;; doesn't understand, and thinks it is seeing a quoted string. | |
79 ;; | |
80 ;; If you don't use font-lock, additional problems will appear: | |
81 ;; 5) To make variables such a $' and $#array work, perl-mode treats | 80 ;; 5) To make variables such a $' and $#array work, perl-mode treats |
82 ;; $ just like backslash, so '$' is not treated correctly. | 81 ;; $ just like backslash, so '$' is not treated correctly. |
83 ;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an | 82 ;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an |
84 ;; unmatched }. See below. | 83 ;; unmatched }. See below. |
84 ;; 7) When ' (quote) is used as a package name separator, perl-mode | |
85 ;; doesn't understand, and thinks it is seeing a quoted string. | |
85 | 86 |
86 ;; Here are some ugly tricks to bypass some of these problems: the perl | 87 ;; Here are some ugly tricks to bypass some of these problems: the perl |
87 ;; expression /`/ (that's a back-tick) usually evaluates harmlessly, | 88 ;; expression /`/ (that's a back-tick) usually evaluates harmlessly, |
88 ;; but will trick perl-mode into starting a quoted string, which | 89 ;; but will trick perl-mode into starting a quoted string, which |
89 ;; can be ended with another /`/. Assuming you have no embedded | 90 ;; can be ended with another /`/. Assuming you have no embedded |
90 ;; back-ticks, this can used to help solve problem 3: | 91 ;; back-ticks, this can used to help solve problem 3: |
91 ;; | 92 ;; |
92 ;; /`/; $ugly = q?"'$?; /`/; | 93 ;; /`/; $ugly = q?"'$?; /`/; |
93 ;; | 94 ;; |
95 ;; The same trick can be used for problem 6 as in: | |
96 ;; /{/; while (<${glob_me}>) | |
97 ;; but a simpler solution is to add a space between the $ and the {: | |
98 ;; while (<$ {glob_me}>) | |
99 ;; | |
94 ;; Problem 7 is even worse, but this 'fix' does work :-( | 100 ;; Problem 7 is even worse, but this 'fix' does work :-( |
95 ;; $DB'stop#' | 101 ;; $DB'stop#' |
96 ;; [$DB'line#' | 102 ;; [$DB'line#' |
97 ;; ] =~ s/;9$//; | 103 ;; ] =~ s/;9$//; |
98 | 104 |
131 | 137 |
132 (defvar perl-mode-syntax-table | 138 (defvar perl-mode-syntax-table |
133 (let ((st (make-syntax-table (standard-syntax-table)))) | 139 (let ((st (make-syntax-table (standard-syntax-table)))) |
134 (modify-syntax-entry ?\n ">" st) | 140 (modify-syntax-entry ?\n ">" st) |
135 (modify-syntax-entry ?# "<" st) | 141 (modify-syntax-entry ?# "<" st) |
136 (modify-syntax-entry ?$ "/" st) | 142 (modify-syntax-entry ?$ "/ p" st) |
137 (modify-syntax-entry ?% "." st) | 143 (modify-syntax-entry ?% ". p" st) |
144 (modify-syntax-entry ?@ ". p" st) | |
138 (modify-syntax-entry ?& "." st) | 145 (modify-syntax-entry ?& "." st) |
139 (modify-syntax-entry ?\' "\"" st) | 146 (modify-syntax-entry ?\' "\"" st) |
140 (modify-syntax-entry ?* "." st) | 147 (modify-syntax-entry ?* "." st) |
141 (modify-syntax-entry ?+ "." st) | 148 (modify-syntax-entry ?+ "." st) |
142 (modify-syntax-entry ?- "." st) | 149 (modify-syntax-entry ?- "." st) |
185 (defconst perl-font-lock-keywords-2 | 192 (defconst perl-font-lock-keywords-2 |
186 (append perl-font-lock-keywords-1 | 193 (append perl-font-lock-keywords-1 |
187 (list | 194 (list |
188 ;; | 195 ;; |
189 ;; Fontify keywords, except those fontified otherwise. | 196 ;; Fontify keywords, except those fontified otherwise. |
190 ; (make-regexp '("if" "until" "while" "elsif" "else" "unless" "do" "dump" | 197 (concat "\\<" |
191 ; "for" "foreach" "exit" "die" | 198 (regexp-opt '("if" "until" "while" "elsif" "else" "unless" |
192 ; "BEGIN" "END" "return" "exec" "eval")) | 199 "do" "dump" "for" "foreach" "exit" "die" |
193 (concat "\\<\\(" | 200 "BEGIN" "END" "return" "exec" "eval") t) |
194 "BEGIN\\|END\\|d\\(ie\\|o\\|ump\\)\\|" | 201 "\\>") |
195 "e\\(ls\\(e\\|if\\)\\|val\\|x\\(ec\\|it\\)\\)\\|" | |
196 "for\\(\\|each\\)\\|if\\|return\\|un\\(less\\|til\\)\\|while" | |
197 "\\)\\>") | |
198 ;; | 202 ;; |
199 ;; Fontify local and my keywords as types. | 203 ;; Fontify local and my keywords as types. |
200 '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) | 204 '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) |
201 ;; | 205 ;; |
202 ;; Fontify function, variable and file name references. | 206 ;; Fontify function, variable and file name references. |
215 "Gaudy level highlighting for Perl mode.") | 219 "Gaudy level highlighting for Perl mode.") |
216 | 220 |
217 (defvar perl-font-lock-keywords perl-font-lock-keywords-1 | 221 (defvar perl-font-lock-keywords perl-font-lock-keywords-1 |
218 "Default expressions to highlight in Perl mode.") | 222 "Default expressions to highlight in Perl mode.") |
219 | 223 |
224 (defvar perl-quote-like-pairs | |
225 '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>))) | |
226 | |
227 ;; FIXME: handle here-docs and regexps. | |
228 ;; <<EOF <<"EOF" <<'EOF' (no space) | |
229 ;; see `man perlop' | |
230 ;; ?...? | |
231 ;; /.../ | |
232 ;; m [...] | |
233 ;; m /.../ | |
234 ;; q /.../ = '...' | |
235 ;; qq /.../ = "..." | |
236 ;; qx /.../ = `...` | |
237 ;; qr /.../ = precompiled regexp =~=~ m/.../ | |
238 ;; qw /.../ | |
239 ;; s /.../.../ | |
240 ;; s <...> /.../ | |
241 ;; s '...'...' | |
242 ;; tr /.../.../ | |
243 ;; y /.../.../ | |
244 ;; | |
245 ;; <file*glob> | |
220 (defvar perl-font-lock-syntactic-keywords | 246 (defvar perl-font-lock-syntactic-keywords |
221 ;; Turn POD into b-style comments | 247 ;; Turn POD into b-style comments |
222 '(("^\\(=\\)\\(head1\\|pod\\)\\([ \t]\\|$\\)" (1 "< b")) | 248 '(("^\\(=\\)\\sw" (1 "< b")) |
223 ("^=cut[ \t]*\\(\n\\)" (1 "> b")) | 249 ("^=cut[ \t]*\\(\n\\)" (1 "> b")) |
224 ;; Catch ${ so that ${var} doesn't screw up indentation. | 250 ;; Catch ${ so that ${var} doesn't screw up indentation. |
225 ("\\(\\$\\)[{']" (1 ".")))) | 251 ;; This also catches $' to handle 'foo$', although it should really |
252 ;; check that it occurs inside a '..' string. | |
253 ("\\(\\$\\)[{']" (1 ".")) | |
254 ;; Handle funny names like $DB'stop. | |
255 ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) | |
256 ;; format statements | |
257 ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) | |
258 ;; Funny things in sub arg specifications like `sub myfunc ($$)' | |
259 ("\\<sub\\s-+\\S-+\\s-*(\\([^)]+\\))" 1 '(1)) | |
260 ;; regexp and funny quotes | |
261 ("[;(=!~{][ \t\n]*\\(/\\)" (1 '(7))) | |
262 ("[;( =!~{\t\n]\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" | |
263 ;; Nasty cases: | |
264 ;; /foo/m $a->m $#m $m @m %m | |
265 ;; \s (appears often in regexps). | |
266 ;; -s file | |
267 (2 (if (assoc (char-after (match-beginning 2)) | |
268 perl-quote-like-pairs) | |
269 '(15) '(7)))))) | |
270 | |
271 (defvar perl-empty-syntax-table | |
272 (let ((st (copy-syntax-table))) | |
273 ;; Make all chars be of punctuation syntax. | |
274 (dotimes (i 256) (aset st i '(1))) | |
275 (modify-syntax-entry ?\\ "\\" st) | |
276 st) | |
277 "Syntax table used internally for processing quote-like operators.") | |
278 | |
279 (defun perl-quote-syntax-table (char) | |
280 (let ((close (cdr (assq char perl-quote-like-pairs))) | |
281 (st (copy-syntax-table perl-empty-syntax-table))) | |
282 (if (not close) | |
283 (modify-syntax-entry char "\"" st) | |
284 (modify-syntax-entry char "(" st) | |
285 (modify-syntax-entry close ")" st)) | |
286 st)) | |
226 | 287 |
227 (defun perl-font-lock-syntactic-face-function (state) | 288 (defun perl-font-lock-syntactic-face-function (state) |
228 (if (nth 3 state) | 289 (let ((char (nth 3 state))) |
229 font-lock-string-face | 290 (cond |
230 (if (nth 7 state) font-lock-doc-face font-lock-comment-face))) | 291 ((not char) |
292 ;; Comment or docstring. | |
293 (if (nth 7 state) font-lock-doc-face font-lock-comment-face)) | |
294 ((and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")) | |
295 ;; Normal string. | |
296 font-lock-string-face) | |
297 ((eq (nth 3 state) ?\n) | |
298 ;; A `format' command. | |
299 (save-excursion | |
300 (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) | |
301 (not (eobp))) | |
302 (put-text-property (point) (1+ (point)) 'syntax-table '(7))) | |
303 font-lock-string-face)) | |
304 (t | |
305 ;; This is regexp like quote thingy. | |
306 (setq char (char-after (nth 8 state))) | |
307 (save-excursion | |
308 (let ((twoargs (save-excursion | |
309 (goto-char (nth 8 state)) | |
310 (skip-syntax-backward " ") | |
311 (skip-syntax-backward "w") | |
312 (member (buffer-substring | |
313 (point) (progn (forward-word 1) (point))) | |
314 '("tr" "s" "y")))) | |
315 (close (cdr (assq char perl-quote-like-pairs))) | |
316 (pos (point)) | |
317 (st (perl-quote-syntax-table char))) | |
318 (if (not close) | |
319 ;; The closing char is the same as the opening char. | |
320 (with-syntax-table st | |
321 (parse-partial-sexp (point) (point-max) | |
322 nil nil state 'syntax-table) | |
323 (when twoargs | |
324 (parse-partial-sexp (point) (point-max) | |
325 nil nil state 'syntax-table))) | |
326 ;; The open/close chars are matched like () [] {} and <>. | |
327 (let ((parse-sexp-lookup-properties nil)) | |
328 (ignore-errors | |
329 (with-syntax-table st | |
330 (goto-char (nth 8 state)) (forward-sexp 1)) | |
331 (when twoargs | |
332 (save-excursion | |
333 ;; Skip whitespace and make sure that font-lock will | |
334 ;; refontify the second part in the proper context. | |
335 (put-text-property | |
336 (point) (progn (forward-comment (point-max)) (point)) | |
337 'font-lock-multiline t) | |
338 ;; | |
339 (unless | |
340 (save-excursion | |
341 (let* ((char2 (char-after)) | |
342 (st2 (perl-quote-syntax-table char2))) | |
343 (with-syntax-table st2 (forward-sexp 1)) | |
344 (put-text-property pos (line-end-position) | |
345 'jit-lock-defer-multiline t) | |
346 (looking-at "\\s-*\\sw*e"))) | |
347 (put-text-property (point) (1+ (point)) | |
348 'syntax-table | |
349 (if (assoc (char-after) | |
350 perl-quote-like-pairs) | |
351 '(15) '(7))))))))) | |
352 ;; Erase any syntactic marks within the quoted text. | |
353 (put-text-property pos (1- (point)) 'syntax-table nil) | |
354 (when (eq (char-before (1- (point))) ?$) | |
355 (put-text-property (- (point) 2) (1- (point)) | |
356 'syntax-table '(1))) | |
357 (put-text-property (1- (point)) (point) | |
358 'syntax-table (if close '(15) '(7))) | |
359 font-lock-string-face)))))) | |
360 ;; (if (or twoargs (not (looking-at "\\s-*\\sw*e"))) | |
361 ;; font-lock-string-face | |
362 ;; (font-lock-fontify-syntactically-region | |
363 ;; ;; FIXME: `end' is accessed via dyn-scoping. | |
364 ;; pos (min end (1- (point))) nil '(nil)) | |
365 ;; nil))))))) | |
366 | |
231 | 367 |
232 (defcustom perl-indent-level 4 | 368 (defcustom perl-indent-level 4 |
233 "*Indentation of Perl statements with respect to containing block." | 369 "*Indentation of Perl statements with respect to containing block." |
234 :type 'integer | 370 :type 'integer |
235 :group 'perl) | 371 :group 'perl) |
534 (not (memq (preceding-char) '(?\; ?\} ?\{)))) | 670 (not (memq (preceding-char) '(?\; ?\} ?\{)))) |
535 | 671 |
536 (defun perl-calculate-indent (&optional parse-start) | 672 (defun perl-calculate-indent (&optional parse-start) |
537 "Return appropriate indentation for current line as Perl code. | 673 "Return appropriate indentation for current line as Perl code. |
538 In usual case returns an integer: the column to indent to. | 674 In usual case returns an integer: the column to indent to. |
539 Returns (parse-state) if line starts inside a string." | 675 Returns (parse-state) if line starts inside a string. |
676 Optional argument PARSE-START should be the position of `beginning-of-defun'." | |
540 (save-excursion | 677 (save-excursion |
541 (beginning-of-line) | 678 (beginning-of-line) |
542 (let ((indent-point (point)) | 679 (let ((indent-point (point)) |
543 (case-fold-search nil) | 680 (case-fold-search nil) |
544 (colon-line-end 0) | 681 (colon-line-end 0) |
555 (looking-at "\\s-+sub\\>")) | 692 (looking-at "\\s-+sub\\>")) |
556 (> indent-point (save-excursion (forward-sexp 1) (point)))) | 693 (> indent-point (save-excursion (forward-sexp 1) (point)))) |
557 (perl-beginning-of-function)) | 694 (perl-beginning-of-function)) |
558 (while (< (point) indent-point) ;repeat until right sexp | 695 (while (< (point) indent-point) ;repeat until right sexp |
559 (setq state (parse-partial-sexp (point) indent-point 0)) | 696 (setq state (parse-partial-sexp (point) indent-point 0)) |
560 ; state = (depth_in_parens innermost_containing_list last_complete_sexp | 697 ;; state = (depth_in_parens innermost_containing_list |
561 ; string_terminator_or_nil inside_commentp following_quotep | 698 ;; last_complete_sexp string_terminator_or_nil inside_commentp |
562 ; minimum_paren-depth_this_scan) | 699 ;; following_quotep minimum_paren-depth_this_scan) |
563 ; Parsing stops if depth in parentheses becomes equal to third arg. | 700 ;; Parsing stops if depth in parentheses becomes equal to third arg. |
564 (setq containing-sexp (nth 1 state))) | 701 (setq containing-sexp (nth 1 state))) |
565 (cond ((nth 3 state) state) ; In a quoted string? | 702 (cond ((nth 3 state) state) ; In a quoted string? |
566 ((null containing-sexp) ; Line is at top level. | 703 ((null containing-sexp) ; Line is at top level. |
567 (skip-chars-forward " \t\f") | 704 (skip-chars-forward " \t\f") |
568 (if (= (following-char) ?{) | 705 (if (= (following-char) ?{) |
569 0 ; move to beginning of line if it starts a function body | 706 0 ; move to beginning of line if it starts a function body |
570 ;; indent a little if this is a continuation line | 707 ;; indent a little if this is a continuation line |
571 (perl-backward-to-noncomment) | 708 (perl-backward-to-noncomment) |
572 (if (or (bobp) | 709 (if (or (bobp) |
573 (memq (preceding-char) '(?\; ?\}))) | 710 (memq (preceding-char) '(?\; ?\}))) |
574 0 perl-continued-statement-offset))) | 711 0 perl-continued-statement-offset))) |
607 (looking-at "[ \t]*}")) | 744 (looking-at "[ \t]*}")) |
608 perl-indent-level) | 745 perl-indent-level) |
609 ;; Is line first statement after an open-brace? | 746 ;; Is line first statement after an open-brace? |
610 ;; If no, find that first statement and indent like it. | 747 ;; If no, find that first statement and indent like it. |
611 (save-excursion | 748 (save-excursion |
612 (forward-char 1) | 749 (forward-char 1) |
613 ;; Skip over comments and labels following openbrace. | 750 ;; Skip over comments and labels following openbrace. |
614 (while (progn | 751 (while (progn |
615 (skip-chars-forward " \t\f\n") | 752 (skip-chars-forward " \t\f\n") |
616 (cond ((looking-at ";?#") | 753 (cond ((looking-at ";?#") |
617 (forward-line 1) t) | 754 (forward-line 1) t) |
618 ((looking-at "\\(\\w\\|\\s_\\)+:") | 755 ((looking-at "\\(\\w\\|\\s_\\)+:") |
619 (save-excursion | 756 (save-excursion |
620 (end-of-line) | 757 (end-of-line) |
621 (setq colon-line-end (point))) | 758 (setq colon-line-end (point))) |
622 (search-forward ":"))))) | 759 (search-forward ":"))))) |
623 ;; The first following code counts | 760 ;; The first following code counts |
624 ;; if it is before the line we want to indent. | 761 ;; if it is before the line we want to indent. |
625 (and (< (point) indent-point) | 762 (and (< (point) indent-point) |
626 (if (> colon-line-end (point)) | 763 (if (> colon-line-end (point)) |
627 (- (current-indentation) perl-label-offset) | 764 (- (current-indentation) perl-label-offset) |
628 (current-column)))) | 765 (current-column)))) |
629 ;; If no previous statement, | 766 ;; If no previous statement, |
630 ;; indent it relative to line brace is on. | 767 ;; indent it relative to line brace is on. |
631 ;; For open paren in column zero, don't let statement | 768 ;; For open paren in column zero, don't let statement |
632 ;; start there too. If perl-indent-level is zero, | 769 ;; start there too. If perl-indent-level is zero, |
633 ;; use perl-brace-offset + perl-continued-statement-offset | 770 ;; use perl-brace-offset + perl-continued-statement-offset |
634 ;; For open-braces not the first thing in a line, | 771 ;; For open-braces not the first thing in a line, |
635 ;; add in perl-brace-imaginary-offset. | 772 ;; add in perl-brace-imaginary-offset. |
636 (+ (if (and (bolp) (zerop perl-indent-level)) | 773 (+ (if (and (bolp) (zerop perl-indent-level)) |
637 (+ perl-brace-offset perl-continued-statement-offset) | 774 (+ perl-brace-offset perl-continued-statement-offset) |
638 perl-indent-level) | 775 perl-indent-level) |
639 ;; Move back over whitespace before the openbrace. | 776 ;; Move back over whitespace before the openbrace. |
640 ;; If openbrace is not first nonwhite thing on the line, | 777 ;; If openbrace is not first nonwhite thing on the line, |
641 ;; add the perl-brace-imaginary-offset. | 778 ;; add the perl-brace-imaginary-offset. |
642 (progn (skip-chars-backward " \t") | 779 (progn (skip-chars-backward " \t") |
643 (if (bolp) 0 perl-brace-imaginary-offset)) | 780 (if (bolp) 0 perl-brace-imaginary-offset)) |
644 ;; If the openbrace is preceded by a parenthesized exp, | 781 ;; If the openbrace is preceded by a parenthesized exp, |
645 ;; move to the beginning of that; | 782 ;; move to the beginning of that; |
646 ;; possibly a different line | 783 ;; possibly a different line |
647 (progn | 784 (progn |
648 (if (eq (preceding-char) ?\)) | 785 (if (eq (preceding-char) ?\)) |
649 (forward-sexp -1)) | 786 (forward-sexp -1)) |
650 ;; Get initial indentation of the line we are on. | 787 ;; Get initial indentation of the line we are on. |
651 (current-indentation)))))))))) | 788 (current-indentation)))))))))) |
652 | 789 |
653 (defun perl-backward-to-noncomment () | 790 (defun perl-backward-to-noncomment () |
654 "Move point backward to after the first non-white-space, skipping comments." | 791 "Move point backward to after the first non-white-space, skipping comments." |
655 (interactive) ;why?? -stef | 792 (interactive) |
656 (forward-comment (- (point-max)))) | 793 (forward-comment (- (point-max)))) |
657 | 794 |
658 (defun perl-backward-to-start-of-continued-exp (lim) | 795 (defun perl-backward-to-start-of-continued-exp (lim) |
659 (if (= (preceding-char) ?\)) | 796 (if (= (preceding-char) ?\)) |
660 (forward-sexp -1)) | 797 (forward-sexp -1)) |