Mercurial > emacs
changeset 66638:4ac8c6441408
(perl-font-lock-special-syntactic-constructs):
Rename from perl-font-lock-syntactic-face-function.
Change the calling convention so it can be used as a font-lock MATCHER.
Do the parse-partial-sexp loop outselves.
(perl-font-lock-syntactic-keywords): Use it.
(perl-mode): Don't set font-lock-syntactic-face-function any more.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Wed, 02 Nov 2005 17:33:28 +0000 |
| parents | 7567f8b4780e |
| children | 4408f56ebb87 |
| files | lisp/progmodes/perl-mode.el |
| diffstat | 1 files changed, 92 insertions(+), 87 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/perl-mode.el Wed Nov 02 10:44:00 2005 +0000 +++ b/lisp/progmodes/perl-mode.el Wed Nov 02 17:33:28 2005 +0000 @@ -252,8 +252,9 @@ ;; ;; <file*glob> (defvar perl-font-lock-syntactic-keywords - ;; Turn POD into b-style comments - '(("^\\(=\\)\\sw" (1 "< b")) + ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + '(;; 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 @@ -275,7 +276,8 @@ (3 (if (assoc (char-after (match-beginning 3)) perl-quote-like-pairs) '(15) '(7)))) - ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + ;; Find and mark the end of funny quotes and format statements. + (perl-font-lock-special-syntactic-constructs) )) (defvar perl-empty-syntax-table @@ -295,88 +297,93 @@ (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)) - (condition-case err - (progn - (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 - (with-syntax-table - (perl-quote-syntax-table (char-after)) - (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))))))) - ;; The arg(s) is not terminated, so it extends until EOB. - (scan-error (goto-char (point-max)))))) - ;; Point is now right after the arg(s). - ;; 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))))))) +(defun perl-font-lock-special-syntactic-constructs (limit) + ;; We used to do all this in a font-lock-syntactic-face-function, which + ;; did not work correctly because sometimes some parts of the buffer are + ;; treated with font-lock-syntactic-keywords but not with + ;; font-lock-syntactic-face-function (mostly because of + ;; font-lock-syntactically-fontified). That meant that some syntax-table + ;; properties were missing. So now we do the parse-partial-sexp loop + ;; ourselves directly from font-lock-syntactic-keywords, so we're sure + ;; it's done when necessary. + (let ((state (syntax-ppss)) + char) + (while (< (point) limit) + (cond + ((or (null (setq char (nth 3 state))) + (and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\"))) + ;; Normal text, or comment, or docstring, or normal string. + nil) + ((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))))) + (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)) + (condition-case err + (progn + (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 + (with-syntax-table + (perl-quote-syntax-table (char-after)) + (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))))))) + ;; The arg(s) is not terminated, so it extends until EOB. + (scan-error (goto-char (point-max)))))) + ;; Point is now right after the arg(s). + ;; 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))))))) + + (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 @@ -531,8 +538,6 @@ 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)