Mercurial > emacs
annotate lisp/font-lock.el @ 5020:94de08fd8a7c
(Fnext_single_property_change): Fix missing \n\.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 15 Nov 1993 06:41:45 +0000 |
| parents | c3db6fd69f1f |
| children | 64211dda414c |
| rev | line source |
|---|---|
| 4053 | 1 ;; Electric Font Lock Mode |
| 2 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. | |
| 3 | |
| 4 ;; Author: jwz, then rms | |
| 5 ;; Maintainer: FSF | |
| 6 ;; Keywords: languages, faces | |
| 7 | |
| 8 ;; This file is part of GNU Emacs. | |
| 9 | |
| 10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 11 ;; it under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 13 ;; any later version. | |
| 14 | |
| 15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 18 ;; GNU General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
| 22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 23 | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;; Font-lock-mode is a minor mode that causes your comments to be | |
| 28 ;; displayed in one face, strings in another, reserved words in another, | |
| 29 ;; documentation strings in another, and so on. | |
| 30 ;; | |
| 31 ;; Comments will be displayed in `font-lock-comment-face'. | |
| 32 ;; Strings will be displayed in `font-lock-string-face'. | |
| 33 ;; Doc strings will be displayed in `font-lock-doc-string-face'. | |
| 34 ;; Function and variable names (in their defining forms) will be | |
| 35 ;; displayed in `font-lock-function-name-face'. | |
| 36 ;; Reserved words will be displayed in `font-lock-keyword-face'. | |
| 37 ;; | |
| 38 ;; To make the text you type be fontified, use M-x font-lock-mode. | |
| 39 ;; When this minor mode is on, the fonts of the current line are | |
| 40 ;; updated with every insertion or deletion. | |
| 41 ;; | |
| 42 ;; To define new reserved words or other patterns to highlight, use | |
| 43 ;; the `font-lock-keywords' variable. This should be mode-local. | |
| 44 ;; | |
| 45 ;; To turn this on automatically, add this to your .emacs file: | |
| 46 ;; | |
| 47 ;; (setq emacs-lisp-mode-hook '(lambda () (font-lock-mode 1))) | |
| 48 ;; | |
| 49 ;; On a Sparc2, the initial fontification takes about 12 seconds for a 120k | |
| 50 ;; file of C code, using the default configuration. You can speed this up | |
| 51 ;; substantially by removing some of the patterns that are highlighted by | |
| 52 ;; default. Fontifying Lisp code is significantly faster, because Lisp has a | |
| 53 ;; more regular syntax than C, so the expressions don't have to be as hairy. | |
| 54 | |
| 55 ;;; Code: | |
| 56 | |
| 57 (or (internal-find-face 'underline) | |
| 58 (copy-face 'default 'underline)) | |
| 59 (set-face-underline-p 'underline t) | |
| 60 | |
| 61 (defvar font-lock-comment-face | |
| 62 'italic | |
| 63 "Face to use for comments.") | |
| 64 | |
| 65 (defvar font-lock-doc-string-face | |
| 66 'italic | |
| 67 "Face to use for documentation strings.") | |
| 68 | |
| 69 (defvar font-lock-string-face | |
| 70 'underline | |
| 71 "Face to use for string constants.") | |
| 72 | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
73 (defvar font-lock-function-name-face |
| 4053 | 74 'bold-italic |
| 75 "Face to use for function names.") | |
| 76 | |
| 77 (defvar font-lock-keyword-face | |
| 78 'bold | |
| 79 "Face to use for keywords.") | |
| 80 | |
| 81 (defvar font-lock-type-face | |
| 82 'italic | |
| 83 "Face to use for data types.") | |
| 84 | |
| 85 (make-variable-buffer-local 'font-lock-keywords) | |
| 86 (defvar font-lock-keywords nil | |
| 87 "*The keywords to highlight. | |
| 88 If this is a list, then elements may be of the forms: | |
| 89 | |
|
4727
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
90 \"string\" ; A regexp to highlight in the |
| 4053 | 91 ; `font-lock-keyword-face'. |
|
4727
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
92 (\"string\" . N) ; Highlight subexpression N of the regexp. |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
93 (\"string\" . face-name) ; Use the named face |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
94 (\"string\" N face-name) ; Both of the above |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
95 (\"string\" N face-name t) ; This allows highlighting to override |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
96 ; already-highlighted regions. |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
97 (\"string\" N face-name keep) ; This allows highlighting to occur |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
98 ; even if some parts of what STRING matches |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
99 ; are already highlighted--but does not alter |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
100 ; the existing highlighting of those parts. |
| 4053 | 101 |
| 102 These regular expressions should not match text which spans lines. | |
| 103 While \\[font-lock-fontify-buffer] handles multi-line patterns correctly, | |
| 104 updating when you edit the buffer does not, | |
| 105 since it considers text one line at a time. | |
| 106 | |
| 107 Be careful composing regexps for this list; the wrong pattern can dramatically | |
| 108 slow things down!") | |
| 109 | |
| 110 (defvar font-lock-keywords-case-fold-search nil | |
| 111 "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") | |
| 112 | |
| 113 (defvar font-lock-verbose t | |
| 114 "*Non-nil means `font-lock-fontify-buffer' should print status messages.") | |
| 115 | |
| 4054 | 116 ;;;###autoload |
| 4053 | 117 (defvar font-lock-mode-hook nil |
| 118 "Function or functions to run on entry to Font Lock mode.") | |
| 119 | |
| 120 ;;; These variables record, for each buffer, | |
| 121 ;;; the parse state at a particular position, always the start of a line. | |
| 122 ;;; This is used to make font-lock-fontify-region faster. | |
| 123 (defvar font-lock-cache-position nil) | |
| 124 (defvar font-lock-cache-state nil) | |
| 125 (make-variable-buffer-local 'font-lock-cache-position) | |
| 126 (make-variable-buffer-local 'font-lock-cache-state) | |
| 127 | |
| 128 (defun font-lock-fontify-region (start end) | |
| 129 "Put proper face on each string and comment between START and END." | |
| 130 (save-excursion | |
| 131 (goto-char start) | |
| 132 (beginning-of-line) | |
| 133 (setq end (min end (point-max))) | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
134 (let ((buffer-read-only nil) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
135 state startline prev prevstate |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
136 (modified (buffer-modified-p))) |
| 4053 | 137 ;; Find the state at the line-beginning before START. |
| 138 (setq startline (point)) | |
| 139 (if (eq (point) font-lock-cache-position) | |
| 140 (setq state font-lock-cache-state) | |
| 141 ;; Find outermost containing sexp. | |
| 142 (beginning-of-defun) | |
| 143 ;; Find the state at STARTLINE. | |
| 144 (while (< (point) startline) | |
| 145 (setq state (parse-partial-sexp (point) startline 0))) | |
| 146 (setq font-lock-cache-state state | |
| 147 font-lock-cache-position (point))) | |
| 148 ;; Now find the state precisely at START. | |
| 149 (setq state (parse-partial-sexp (point) start nil nil state)) | |
| 150 ;; If the region starts inside a string, show the extent of it. | |
| 151 (if (nth 3 state) | |
| 152 (let ((beg (point))) | |
| 153 (while (and (re-search-forward "\\s\"" end 'move) | |
| 154 (nth 3 (parse-partial-sexp beg (point) | |
| 155 nil nil state)))) | |
| 156 (put-text-property beg (point) 'face font-lock-string-face) | |
| 157 (setq state (parse-partial-sexp beg (point) nil nil state)))) | |
| 158 ;; Likewise for a comment. | |
| 159 (if (or (nth 4 state) (nth 7 state)) | |
| 160 (let ((beg (point))) | |
| 161 (while (and (re-search-forward (if comment-end | |
| 162 (concat "\\s>\\|" | |
| 163 (regexp-quote comment-end)) | |
| 164 "\\s>") | |
| 165 end 'move) | |
| 166 (nth 3 (parse-partial-sexp beg (point) | |
| 167 nil nil state)))) | |
| 168 (put-text-property beg (point) 'face font-lock-comment-face) | |
| 169 (setq state (parse-partial-sexp beg (point) nil nil state)))) | |
| 170 ;; Find each interesting place between here and END. | |
| 171 (while (and (< (point) end) | |
| 172 (setq prev (point) prevstate state) | |
|
4459
2d8f7239f2ca
(font-lock-fontify-region): Handle comment-start-skip = nil.
Richard M. Stallman <rms@gnu.org>
parents:
4239
diff
changeset
|
173 (re-search-forward (if comment-start-skip |
|
2d8f7239f2ca
(font-lock-fontify-region): Handle comment-start-skip = nil.
Richard M. Stallman <rms@gnu.org>
parents:
4239
diff
changeset
|
174 (concat "\\s\"\\|" comment-start-skip) |
|
2d8f7239f2ca
(font-lock-fontify-region): Handle comment-start-skip = nil.
Richard M. Stallman <rms@gnu.org>
parents:
4239
diff
changeset
|
175 "\\s\"") |
|
2d8f7239f2ca
(font-lock-fontify-region): Handle comment-start-skip = nil.
Richard M. Stallman <rms@gnu.org>
parents:
4239
diff
changeset
|
176 end t) |
| 4053 | 177 ;; Clear out the fonts of what we skip over. |
| 178 (progn (remove-text-properties prev (point) '(face nil)) t) | |
| 179 ;; Verify the state at that place | |
| 180 ;; so we don't get fooled by \" or \;. | |
| 181 (setq state (parse-partial-sexp prev (point) | |
| 182 nil nil state))) | |
| 183 (let ((here (point))) | |
| 184 (if (or (nth 4 state) (nth 7 state)) | |
| 185 ;; We found a real comment start. | |
| 186 (let ((beg (match-beginning 0))) | |
| 187 (goto-char beg) | |
| 188 (save-restriction | |
| 189 (narrow-to-region (point-min) end) | |
| 190 (condition-case nil | |
| 191 (progn | |
| 192 (forward-comment 1) | |
| 193 ;; forward-comment skips all whitespace, | |
| 194 ;; so go back to the real end of the comment. | |
| 195 (skip-chars-backward " \t")) | |
| 196 (error (goto-char end)))) | |
| 197 (put-text-property beg (point) 'face font-lock-comment-face) | |
| 198 (setq state (parse-partial-sexp here (point) nil nil state))) | |
| 199 (if (nth 3 state) | |
| 200 (let ((beg (match-beginning 0))) | |
| 201 (while (and (re-search-forward "\\s\"" end 'move) | |
| 202 (nth 3 (parse-partial-sexp here (point) | |
| 203 nil nil state)))) | |
| 204 (put-text-property beg (point) 'face font-lock-string-face) | |
| 205 (setq state (parse-partial-sexp here (point) nil nil state)))) | |
| 206 )) | |
| 207 ;; Make sure PREV is non-nil after the loop | |
| 208 ;; only if it was set on the very last iteration. | |
| 209 (setq prev nil)) | |
| 210 (and prev | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
211 (remove-text-properties prev end '(face nil))) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
212 (set-buffer-modified-p modified)))) |
| 4053 | 213 |
| 214 ;; This code used to be used to show a string on reaching the end of it. | |
| 215 ;; It is probably not needed due to later changes to handle strings | |
| 216 ;; starting before the region in question. | |
| 217 ;; (if (and (null (nth 3 state)) | |
| 218 ;; (eq (char-syntax (preceding-char)) ?\") | |
| 219 ;; (save-excursion | |
| 220 ;; (nth 3 (parse-partial-sexp prev (1- (point)) | |
| 221 ;; nil nil prevstate)))) | |
| 222 ;; ;; We found the end of a string. | |
| 223 ;; (save-excursion | |
| 224 ;; (setq foo2 (point)) | |
| 225 ;; (let ((ept (point))) | |
| 226 ;; (forward-sexp -1) | |
| 227 ;; ;; Highlight the string when we see the end. | |
| 228 ;; ;; Doing it at the start leads to trouble: | |
| 229 ;; ;; either it fails to handle multiline strings | |
| 230 ;; ;; or it can run away when an unmatched " is inserted. | |
| 231 ;; (put-text-property (point) ept 'face | |
| 232 ;; (if (= (car state) 1) | |
| 233 ;; font-lock-doc-string-face | |
| 234 ;; font-lock-string-face))))) | |
| 235 | |
| 236 (defun font-lock-unfontify-region (beg end) | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
237 (let ((modified (buffer-modified-p)) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
238 (buffer-read-only nil)) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
239 (remove-text-properties beg end '(face nil)) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
240 (set-buffer-modified-p modified))) |
| 4053 | 241 |
| 242 ;; Called when any modification is made to buffer text. | |
| 243 (defun font-lock-after-change-function (beg end old-len) | |
| 244 (save-excursion | |
| 245 (save-match-data | |
| 246 (goto-char beg) | |
| 247 ;; Discard the cache info if text before it has changed. | |
| 248 (and font-lock-cache-position | |
| 249 (> font-lock-cache-position beg) | |
| 250 (setq font-lock-cache-position nil)) | |
| 251 ;; Rescan till end of line. yes! | |
| 252 (goto-char end) | |
| 253 (end-of-line) | |
| 254 (setq end (point)) | |
| 255 (goto-char beg) | |
| 256 (beginning-of-line) | |
| 257 (setq beg (point)) | |
|
4239
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
258 ;; First scan for strings and comments. |
|
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
259 ;; Must scan from line start in case of |
|
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
260 ;; inserting space into `intfoo () {}'. |
|
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
261 (font-lock-fontify-region beg (1+ end)) |
| 4053 | 262 ;; Now scan for keywords. |
| 263 (font-lock-hack-keywords beg end)))) | |
| 264 | |
| 265 ;;; Fontifying arbitrary patterns | |
| 266 | |
| 267 (defsubst font-lock-any-properties-p (start end) | |
|
4727
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
268 (or (get-text-property start 'face) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
269 (let ((next (next-single-property-change start 'face))) |
| 4053 | 270 (and next (< next end))))) |
| 271 | |
| 272 (defun font-lock-hack-keywords (start end &optional loudly) | |
| 273 (goto-char start) | |
| 274 (let ((case-fold-search font-lock-keywords-case-fold-search) | |
| 275 (rest font-lock-keywords) | |
| 276 (count 0) | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
277 (buffer-read-only nil) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
278 (modified (buffer-modified-p)) |
| 4053 | 279 first str match face s e allow-overlap-p) |
| 280 (while rest | |
| 281 (setq first (car rest) rest (cdr rest)) | |
| 282 (goto-char start) | |
| 283 (cond ((consp first) | |
| 284 (setq str (car first)) | |
| 285 (cond ((consp (cdr first)) | |
| 286 (setq match (nth 1 first) | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
287 face (eval (nth 2 first)) |
| 4053 | 288 allow-overlap-p (nth 3 first))) |
| 289 ((symbolp (cdr first)) | |
| 290 (setq match 0 allow-overlap-p nil | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
291 face (eval (cdr first)))) |
| 4053 | 292 (t |
| 293 (setq match (cdr first) | |
| 294 allow-overlap-p nil | |
| 295 face font-lock-keyword-face)))) | |
| 296 (t | |
| 297 (setq str first match 0 allow-overlap-p nil | |
| 298 face font-lock-keyword-face))) | |
| 299 ;(message "regexp: %s" str) | |
| 300 (while (re-search-forward str end t) | |
| 301 (setq s (match-beginning match) | |
| 302 e (match-end match)) | |
| 303 (or s (error "expression did not match subexpression %d" match)) | |
| 304 ;; don't fontify this keyword if we're already in some other context. | |
| 305 (or (if allow-overlap-p nil (font-lock-any-properties-p s e)) | |
|
4727
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
306 (if (not (memq allow-overlap-p '(t nil))) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
307 (save-excursion |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
308 (goto-char s) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
309 (save-restriction |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
310 (narrow-to-region s e) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
311 (while (not (eobp)) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
312 (let ((next (next-single-property-change (point) 'face))) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
313 (if (> next (point-max)) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
314 (setq next (point-max))) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
315 (if (not (get-text-property (point) 'face)) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
316 (put-text-property (point) next 'face face)) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
317 (goto-char next))))) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
318 (put-text-property s e 'face face)))) |
| 4053 | 319 (if loudly (message "Fontifying %s... (regexps...%s)" |
| 320 (buffer-name) | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
321 (make-string (setq count (1+ count)) ?.)))) |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
322 (set-buffer-modified-p modified))) |
| 4053 | 323 |
| 324 ;; The user level functions | |
| 325 | |
| 326 (defvar font-lock-mode nil) ; for modeline | |
| 327 (or (assq 'font-lock-mode minor-mode-alist) | |
| 328 (setq minor-mode-alist | |
| 329 (append minor-mode-alist | |
| 330 '((font-lock-mode " Font"))))) | |
| 331 | |
| 332 (defvar font-lock-fontified nil) ; whether we have hacked this buffer | |
| 333 (put 'font-lock-fontified 'permanent-local t) | |
| 334 | |
| 335 ;;;###autoload | |
| 336 (defun font-lock-mode (&optional arg) | |
| 337 "Toggle Font Lock mode. | |
| 338 With arg, turn Font Lock mode on if and only if arg is positive. | |
| 339 | |
| 340 When Font Lock mode is enabled, text is fontified as you type it: | |
| 341 | |
| 342 - comments are displayed in `font-lock-comment-face'; | |
| 343 (That is a variable whose value should be a face name.) | |
| 344 - strings are displayed in `font-lock-string-face'; | |
| 345 - documentation strings are displayed in `font-lock-doc-string-face'; | |
| 346 - function and variable names in their defining forms are displayed | |
| 347 in `font-lock-function-name-face'; | |
| 348 - and certain other expressions are displayed in other faces | |
| 349 according to the value of the variable `font-lock-keywords'. | |
| 350 | |
| 351 When you turn Font Lock mode on/off, the buffer is fontified/defontified. | |
| 352 To fontify a buffer without having newly typed text become fontified, you | |
| 353 can use \\[font-lock-fontify-buffer]." | |
| 354 (interactive "P") | |
| 355 (let ((on-p (if (null arg) | |
| 356 (not font-lock-mode) | |
| 357 (> (prefix-numeric-value arg) 0)))) | |
| 358 (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... | |
| 359 (setq on-p nil)) | |
| 360 (or (memq after-change-function | |
| 361 '(nil font-lock-after-change-function)) | |
| 362 (error "after-change-function is %s" after-change-function)) | |
| 363 (set (make-local-variable 'after-change-function) | |
| 364 (if on-p 'font-lock-after-change-function nil)) | |
| 365 (set (make-local-variable 'font-lock-mode) on-p) | |
| 366 (cond (on-p | |
| 367 (font-lock-set-defaults) | |
| 368 (run-hooks 'font-lock-mode-hook) | |
| 369 (or font-lock-fontified (font-lock-fontify-buffer))) | |
| 370 (font-lock-fontified | |
| 371 (setq font-lock-fontified nil) | |
| 372 (font-lock-unfontify-region (point-min) (point-max)))) | |
| 373 (force-mode-line-update))) | |
| 374 | |
| 375 | |
| 376 (defun font-lock-fontify-buffer () | |
| 377 "Fontify the current buffer the way `font-lock-mode' would: | |
| 378 | |
| 379 - comments are displayed in `font-lock-comment-face'; | |
| 380 - strings are displayed in `font-lock-string-face'; | |
| 381 - documentation strings are displayed in `font-lock-doc-string-face'; | |
| 382 - function and variable names in their defining forms are displayed | |
| 383 in `font-lock-function-name-face'; | |
| 384 - and certain other expressions are displayed in other faces | |
| 385 according to the value of the variable `font-lock-keywords'. | |
| 386 | |
| 387 This can take a while for large buffers." | |
| 388 (interactive) | |
| 389 (let ((was-on font-lock-mode) | |
| 390 (font-lock-verbose (or font-lock-verbose (interactive-p)))) | |
| 391 (if font-lock-verbose (message "Fontifying %s..." (buffer-name))) | |
| 392 ;; Turn it on to run hooks and get the right font-lock-keywords. | |
|
4897
c3db6fd69f1f
(font-lock-fontify-buffer): Don't turn
Richard M. Stallman <rms@gnu.org>
parents:
4727
diff
changeset
|
393 (or was-on (font-lock-set-defaults)) |
| 4053 | 394 (font-lock-unfontify-region (point-min) (point-max)) |
| 395 (if font-lock-verbose (message "Fontifying %s... (syntactically...)" | |
| 396 (buffer-name))) | |
| 397 ;; (buffer-syntactic-context-flush-cache) | |
| 398 (save-excursion | |
| 399 (font-lock-fontify-region (point-min) (point-max)) | |
| 400 (if font-lock-verbose (message "Fontifying %s... (regexps...)" | |
| 401 (buffer-name))) | |
| 402 (font-lock-hack-keywords (point-min) (point-max) font-lock-verbose)) | |
| 403 (set (make-local-variable 'font-lock-fontified) t) | |
| 404 (if font-lock-verbose (message "Fontifying %s... done." (buffer-name))) | |
| 405 )) | |
| 406 | |
| 407 | |
| 408 ;;; Various mode-specific information. | |
| 409 | |
| 410 (defun font-lock-set-defaults () | |
|
4727
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
411 "Set `font-lock-keywords' to something appropriate for this mode." |
| 4053 | 412 (setq font-lock-keywords |
| 413 (cond ((eq major-mode 'lisp-mode) lisp-font-lock-keywords) | |
| 414 ((eq major-mode 'emacs-lisp-mode) lisp-font-lock-keywords) | |
| 415 ((eq major-mode 'c-mode) c-font-lock-keywords) | |
| 416 ((eq major-mode 'c++-c-mode) c-font-lock-keywords) | |
| 417 ((eq major-mode 'c++-mode) c++-font-lock-keywords) | |
| 418 ((eq major-mode 'perl-mode) perl-font-lock-keywords) | |
| 419 ((eq major-mode 'tex-mode) tex-font-lock-keywords) | |
| 420 ((eq major-mode 'texinfo-mode) texi-font-lock-keywords) | |
| 421 (t nil)))) | |
| 422 | |
| 423 (defconst lisp-font-lock-keywords-1 | |
| 424 '(;; | |
| 425 ;; highlight defining forms. This doesn't work too nicely for | |
| 426 ;; (defun (setf foo) ...) but it does work for (defvar foo) which | |
| 427 ;; is more important. | |
| 428 ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) | |
| 429 ;; | |
| 430 ;; highlight CL keywords | |
| 431 ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) | |
| 432 ;; | |
| 433 ;; this is highlights things like (def* (setf foo) (bar baz)), but may | |
| 434 ;; be slower (I haven't really thought about it) | |
| 435 ; ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)" | |
| 436 ; 1 font-lock-function-name-face) | |
| 437 ) | |
| 438 "For consideration as a value of `lisp-font-lock-keywords'. | |
| 439 This does fairly subdued highlighting.") | |
| 440 | |
| 441 (defconst lisp-font-lock-keywords-2 | |
| 442 (append | |
| 443 lisp-font-lock-keywords-1 | |
| 444 '(;; | |
| 445 ;; Highlight control structures | |
| 446 ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1) | |
| 447 ("(\\(while\\|do\\|let*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1) | |
| 448 ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1) | |
| 449 ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1) | |
| 450 ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1) | |
| 451 ;; | |
| 452 ;; highlight function names in emacs-lisp docstrings (in the syntax | |
| 453 ;; that substitute-command-keys understands.) | |
| 454 ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) | |
| 455 ;; | |
| 456 ;; highlight words inside `' which tend to be function names | |
| 457 ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" | |
| 458 1 font-lock-keyword-face t) | |
| 459 )) | |
| 460 "For consideration as a value of `lisp-font-lock-keywords'. | |
| 461 This does a lot more highlighting.") | |
| 462 | |
| 463 ;; default to the gaudier variety? | |
| 464 ;(defvar lisp-font-lock-keywords lisp-font-lock-keywords-2 | |
| 465 ; "Additional expressions to highlight in Lisp modes.") | |
| 466 (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 | |
| 467 "Additional expressions to highlight in Lisp modes.") | |
| 468 | |
| 469 | |
| 470 (defconst c-font-lock-keywords-1 nil | |
| 471 "For consideration as a value of `c-font-lock-keywords'. | |
| 472 This does fairly subdued highlighting.") | |
| 473 | |
| 474 (defconst c-font-lock-keywords-2 nil | |
| 475 "For consideration as a value of `c-font-lock-keywords'. | |
| 476 This does a lot more highlighting.") | |
| 477 | |
| 478 (let ((storage "auto\\|extern\\|register\\|static\\|volatile") | |
| 479 (prefixes "unsigned\\|short\\|long") | |
| 480 (types (concat "int\\|char\\|float\\|double\\|void\\|struct\\|" | |
| 481 "union\\|enum\\|typedef")) | |
| 482 (ctoken "[a-zA-Z0-9_:~*]+") | |
| 483 ) | |
| 484 (setq c-font-lock-keywords-1 | |
| 485 (list | |
| 486 ;; fontify preprocessor directives as comments. | |
| 487 '("^#[ \t]*[a-z]+" . font-lock-comment-face) | |
| 488 ;; | |
| 489 ;; fontify names being defined. | |
| 490 '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 | |
| 491 font-lock-function-name-face) | |
| 492 ;; | |
| 493 ;; fontify other preprocessor lines. | |
|
4727
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
494 '("^#[ \t]*\\(if\\)[ \t]+\\([^\n]+\\)" |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
495 2 font-lock-function-name-face keep) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
496 '("^#[ \t]*\\(endif\\|else\\)[ \t]+\\([^\n]+\\)" |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
497 2 font-lock-function-name-face keep) |
|
ca337641008d
(font-lock-fontify-region): Don't add `font-lock' props.
Richard M. Stallman <rms@gnu.org>
parents:
4700
diff
changeset
|
498 '("^#[ \t]*\\(ifn?def\\)[ \t]+\\([^ \t\n]+\\)" |
| 4053 | 499 2 font-lock-function-name-face t) |
| 500 ;; | |
| 501 ;; fontify the filename in #include <...> | |
| 502 ;; don't need to do this for #include "..." because those were | |
| 503 ;; already fontified as strings by the syntactic pass. | |
| 504 '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) | |
| 505 ;; | |
| 506 ;; fontify the names of functions being defined. | |
| 507 (list (concat | |
| 508 "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no | |
| 509 "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? | |
| 510 "\\(" ctoken "[ \t]+\\)?" | |
|
4239
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
511 "\\([*&]+[ \t]*\\)?" ; pointer |
| 4053 | 512 "\\(" ctoken "\\)[ \t]*(") ; name |
| 513 5 'font-lock-function-name-face) | |
| 514 ;; | |
| 515 ;; | |
| 516 ;; Fontify structure names (in structure definition form). | |
| 517 (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)" | |
| 518 "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") | |
| 519 2 'font-lock-function-name-face) | |
| 520 ;; | |
| 521 ;; Fontify case clauses. This is fast because its anchored on the left. | |
| 522 '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) | |
| 523 '("\\<\\(default\\):". 1) | |
| 524 )) | |
| 525 | |
| 526 (setq c-font-lock-keywords-2 | |
| 527 (append c-font-lock-keywords-1 | |
| 528 (list | |
| 529 ;; | |
| 530 ;; fontify all storage classes and type specifiers | |
| 531 (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) | |
| 532 (cons (concat "\\<\\(" types "\\)\\>") 'font-lock-type-face) | |
| 533 (cons (concat "\\<\\(" prefixes "[ \t]+" types "\\)\\>") | |
| 534 'font-lock-type-face) | |
| 535 ;; | |
| 536 ;; fontify all builtin tokens | |
| 537 (cons (concat | |
| 538 "[ \t]\\(" | |
| 539 (mapconcat 'identity | |
| 540 '("for" "while" "do" "return" "goto" "case" "break" "switch" | |
| 541 "if" "then" "else if" "else" "return" "default" "continue" | |
| 542 "default" | |
| 543 ) | |
| 544 "\\|") | |
| 545 "\\)[ \t\n(){};,]") | |
| 546 1) | |
| 547 ;; | |
| 548 ;; fontify case targets and goto-tags. This is slow because the | |
| 549 ;; expression is anchored on the right. | |
| 550 "\\(\\(\\sw\\|\\s_\\)+\\):" | |
| 551 ;; | |
| 552 ;; Fontify variables declared with structures, or typedef names. | |
| 553 '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" | |
| 554 1 font-lock-function-name-face) | |
| 555 ;; | |
| 556 ;; Fontify global variables without a type. | |
| 557 ; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) | |
| 558 | |
| 559 ))) | |
| 560 ) | |
| 561 | |
| 562 ; default to the gaudier variety? | |
| 563 ;(defvar c-font-lock-keywords c-font-lock-keywords-2 | |
| 564 ; "Additional expressions to highlight in C mode.") | |
| 565 (defvar c-font-lock-keywords c-font-lock-keywords-1 | |
| 566 "Additional expressions to highlight in C mode.") | |
| 567 | |
| 568 (defvar c++-font-lock-keywords c-font-lock-keywords | |
| 569 "Additional expressions to highlight in C++ mode.") | |
| 570 | |
| 571 | |
| 572 (defvar perl-font-lock-keywords | |
| 573 (list | |
|
4219
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
574 (cons (concat "[ \n\t{]*\\(" |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
575 (mapconcat 'identity |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
576 '("if" "until" "while" "elsif" "else" "unless" "for" |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
577 "foreach" "continue" "exit" "die" "last" "goto" "next" |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
578 "redo" "return" "local" "exec") |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
579 "\\|") |
|
24f3ca095be9
(perl-font-lock-keywords): Add a `(... . 1)' to the
Richard M. Stallman <rms@gnu.org>
parents:
4054
diff
changeset
|
580 "\\)[ \n\t;(]") 1) |
| 4053 | 581 (mapconcat 'identity |
| 582 '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" | |
| 583 "#define" "#undef") | |
| 584 "\\|") | |
|
4239
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
585 '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) |
|
e8cf7a7d0102
(font-lock-after-change-function):
Richard M. Stallman <rms@gnu.org>
parents:
4219
diff
changeset
|
586 '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) |
| 4053 | 587 '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face) |
| 588 ) | |
| 589 "Additional expressions to highlight in Perl mode.") | |
| 590 | |
| 591 (defvar tex-font-lock-keywords | |
| 592 (list | |
| 593 '("\\(\\\\\\w+\\)" 1 font-lock-keyword-face t) | |
| 594 '("{\\\\em\\([^}]+\\)}" 1 font-lock-comment-face t) | |
| 595 '("{\\\\bf\\([^}]+\\)}" 1 font-lock-keyword-face t) | |
| 596 '("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face t) | |
| 597 '("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" | |
| 598 2 font-lock-function-name-face t) | |
| 599 '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) | |
| 600 ; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) | |
| 601 ) | |
| 602 "Additional expressions to highlight in TeX mode.") | |
| 603 | |
| 604 (defvar texi-font-lock-keywords | |
| 605 (list | |
| 606 "@\\(@\\|[^}\t \n{]+\\)" ;commands | |
| 607 '("^\\(@c\\|@comment\\)[ \t].*$" . font-lock-comment-face) ;comments | |
| 608 '("^\\(*.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items | |
| 609 '("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face t) | |
| 610 '("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face t) | |
| 611 '("@\\(samp\\|code\\|var\\){\\([^}]+\\)" 2 font-lock-function-name-face t) | |
| 612 '("@\\(xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-keyword-face t) | |
| 613 '("@end *\\([a-zA-Z0-9]+\\)[ \t]*$" 1 font-lock-function-name-face t) | |
| 614 '("@item \\(.*\\)$" 1 font-lock-function-name-face t) | |
| 615 '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) | |
| 616 ) | |
| 617 "Additional expressions to highlight in TeXinfo mode.") | |
| 618 | |
| 619 (provide 'font-lock) | |
| 620 | |
| 621 ;;; font-lock.el ends here |
