Mercurial > emacs
comparison lisp/font-lock.el @ 9389:fec6bd86e836
(compilation-mode-font-lock-keywords,
rmail-summary-font-lock-keywords, dired-font-lock-keywords,
shell-font-lock-keywords, texi-font-lock-keywords,
perl-font-lock-keywords): Deleted.
(font-lock-mode): Doc fix; use add/remove-hook, not
setq; removed make-local-variable of font-lock-no-comments.
(font-lock-set-defaults): Do it there, and use:
(font-lock-defaults-alist): Use it to set font-lock-keywords,
font-lock-keywords-case-fold-search and font-lock-no-comments.
(turn-on-font-lock): New function.
(font-lock-fontify-buffer): Made interruptible; deleted messages.
(font-lock-fontify-region): Made syntax state reliable
by widening within new restriction; let cstart and cend for speed;
outputs message.
(font-lock-after-change-function): Remove spurious goto-char and use
forward-line, not 1+ end-of-line, for end of fontification region.
(font-lock-any-properties-p): Removed, use text-property-not-all.
(font-lock-*-face): facename values are themselves.
(font-lock-variable-name-face, font-lock-reference-face): New vars.
(font-lock-doc-string-face): Removed.
(font-lock-keywords): Extended value syntax.
(font-lock-hack-keywords): Cope with it; outputs initial message.
Merged in face-lock.el:
(font-lock-display-type, font-lock-background-mode)
(font-lock-face-attributes): New variables, use it.
(font-lock-make-face): New function, use them.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 07 Oct 1994 10:23:26 +0000 |
parents | 85b9cce28fd3 |
children | a7c6e2858f8b |
comparison
equal
deleted
inserted
replaced
9388:c9b5541ec9f5 | 9389:fec6bd86e836 |
---|---|
1 ;; Electric Font Lock Mode | 1 ;; Electric Font Lock Mode |
2 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | 2 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. |
3 | 3 |
4 ;; Author: jwz, then rms | 4 ;; Author: jwz, then rms and sm (simon.marshall@mail.esrin.esa.it) |
5 ;; Maintainer: FSF | 5 ;; Maintainer: FSF |
6 ;; Keywords: languages, faces | 6 ;; Keywords: languages, faces |
7 | 7 |
8 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
9 | 9 |
28 ;; displayed in one face, strings in another, reserved words in another, | 28 ;; displayed in one face, strings in another, reserved words in another, |
29 ;; documentation strings in another, and so on. | 29 ;; documentation strings in another, and so on. |
30 ;; | 30 ;; |
31 ;; Comments will be displayed in `font-lock-comment-face'. | 31 ;; Comments will be displayed in `font-lock-comment-face'. |
32 ;; Strings will be displayed in `font-lock-string-face'. | 32 ;; Strings will be displayed in `font-lock-string-face'. |
33 ;; Doc strings will be displayed in `font-lock-doc-string-face'. | 33 ;; Regexps are used to display selected patterns in other faces. |
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 ;; | 34 ;; |
38 ;; To make the text you type be fontified, use M-x font-lock-mode. | 35 ;; 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 | 36 ;; When this minor mode is on, the fonts of the current line are |
40 ;; updated with every insertion or deletion. | 37 ;; updated with every insertion or deletion. |
41 ;; | 38 ;; |
42 ;; To define new reserved words or other patterns to highlight, use | 39 ;; To define new reserved words or other patterns to highlight, use |
43 ;; the `font-lock-keywords' variable. This should be mode-local. | 40 ;; the `font-lock-keywords' variable. This should be mode-local. |
44 ;; | 41 ;; |
45 ;; To turn this on automatically, add this to your .emacs file: | 42 ;; To turn this on automatically, add this to your .emacs file: |
46 ;; | 43 ;; |
47 ;; (setq emacs-lisp-mode-hook '(lambda () (font-lock-mode 1))) | 44 ;; (setq emacs-lisp-mode-hook 'turn-on-font-lock) |
48 ;; | 45 ;; |
49 ;; On a Sparc2, the initial fontification takes about 12 seconds for a 120k | 46 ;; On a Sparc2, the initial fontification takes about 10 seconds for a 120k |
50 ;; file of C code, using the default configuration. You can speed this up | 47 ;; file of C code using the default configuration, and about 25 seconds using |
51 ;; substantially by removing some of the patterns that are highlighted by | 48 ;; the more extensive configuration, though times also depend on file contents. |
52 ;; default. Fontifying Lisp code is significantly faster, because Lisp has a | 49 ;; You can speed this up substantially by removing some of the patterns that |
53 ;; more regular syntax than C, so the expressions don't have to be as hairy. | 50 ;; are highlighted by default. Fontifying Lisp code is significantly faster, |
54 | 51 ;; because Lisp has a more regular syntax than C, so the expressions don't have |
52 ;; to be as hairy. | |
53 ;; | |
54 ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" | |
55 ;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for | |
56 ;; efficiency. See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on | |
57 ;; archive.cis.ohio-state.edu for this and other functions. | |
58 | |
55 ;;; Code: | 59 ;;; Code: |
56 | 60 |
57 (defvar font-lock-comment-face | 61 (or window-system (error "Can't fontify on an ASCII terminal")) |
58 'italic | 62 |
63 (defvar font-lock-comment-face 'font-lock-comment-face | |
59 "Face to use for comments.") | 64 "Face to use for comments.") |
60 | 65 |
61 (defvar font-lock-doc-string-face | 66 (defvar font-lock-string-face 'font-lock-string-face |
62 'italic | 67 "Face to use for strings.") |
63 "Face to use for documentation strings.") | 68 |
64 | 69 (defvar font-lock-function-name-face 'font-lock-function-name-face |
65 (defvar font-lock-string-face | |
66 'underline | |
67 "Face to use for string constants.") | |
68 | |
69 (defvar font-lock-function-name-face | |
70 'bold-italic | |
71 "Face to use for function names.") | 70 "Face to use for function names.") |
72 | 71 |
73 (defvar font-lock-keyword-face | 72 (defvar font-lock-variable-name-face 'font-lock-variable-name-face |
74 'bold | 73 "Face to use for variable names.") |
74 | |
75 (defvar font-lock-keyword-face 'font-lock-keyword-face | |
75 "Face to use for keywords.") | 76 "Face to use for keywords.") |
76 | 77 |
77 (defvar font-lock-type-face | 78 (defvar font-lock-type-face 'font-lock-type-face |
78 'italic | |
79 "Face to use for data types.") | 79 "Face to use for data types.") |
80 | |
81 (defvar font-lock-reference-face 'font-lock-reference-face | |
82 "Face to use for references.") | |
80 | 83 |
81 (defvar font-lock-no-comments nil | 84 (defvar font-lock-no-comments nil |
82 "Non-nil means Font-Lock shouldn't check for comments or strings.") | 85 "Non-nil means Font-Lock shouldn't check for comments or strings.") |
83 | 86 |
84 (make-variable-buffer-local 'font-lock-keywords) | 87 (make-variable-buffer-local 'font-lock-keywords) |
85 (defvar font-lock-keywords nil | 88 (defvar font-lock-keywords nil |
86 "*The keywords to highlight. | 89 "*The keywords to highlight. |
87 If this is a list, then elements may be of the forms: | 90 Elements should be of the form: |
88 | 91 |
89 \"string\" ; A regexp to highlight in the | 92 REGEXP |
90 ; `font-lock-keyword-face'. | 93 (REGEXP . MATCH) |
91 (\"string\" . N) ; Highlight subexpression N of the regexp. | 94 (REGEXP . FACENAME) |
92 (\"string\" . face-name) ; Use the named face | 95 (REGEXP . HIGHLIGHT) |
93 (\"string\" N face-name) ; Both of the above | 96 (REGEXP HIGHLIGHT ...) |
94 (\"string\" N face-name t) ; This allows highlighting to override | 97 |
95 ; already-highlighted regions. | 98 where HIGHLIGHT should be of the form (MATCH FACENAME OVERRIDE LAXMATCH). |
96 (\"string\" N face-name keep) ; This allows highlighting to occur | 99 REGEXP is the regexp to search for, MATCH is the subexpression of REGEXP to be |
97 ; even if some parts of what STRING matches | 100 highlighted, FACENAME is an expression whose value is the face name to use. |
98 ; are already highlighted--but does not alter | 101 FACENAME's default attributes may be defined in `font-lock-face-attributes'. |
99 ; the existing highlighting of those parts. | 102 |
100 | 103 OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may |
101 These regular expressions should not match text which spans lines. | 104 be overriden. If `keep', only parts not already fontified are highlighted. |
102 While \\[font-lock-fontify-buffer] handles multi-line patterns correctly, | 105 If LAXMATCH is non-nil, no error is signalled if there is no MATCH in REGEXP. |
103 updating when you edit the buffer does not, | 106 |
104 since it considers text one line at a time. | 107 These regular expressions should not match text which spans lines. While |
105 | 108 \\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating |
106 Be careful composing regexps for this list; the wrong pattern can dramatically | 109 when you edit the buffer does not, since it considers text one line at a time. |
107 slow things down!") | 110 |
111 Be careful composing regexps for this list; | |
112 the wrong pattern can dramatically slow things down!") | |
108 | 113 |
109 (defvar font-lock-keywords-case-fold-search nil | 114 (defvar font-lock-keywords-case-fold-search nil |
110 "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") | 115 "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") |
111 | 116 |
112 (defvar font-lock-syntax-table nil | 117 (defvar font-lock-syntax-table nil |
117 "*Non-nil means `font-lock-fontify-buffer' should print status messages.") | 122 "*Non-nil means `font-lock-fontify-buffer' should print status messages.") |
118 | 123 |
119 ;;;###autoload | 124 ;;;###autoload |
120 (defvar font-lock-mode-hook nil | 125 (defvar font-lock-mode-hook nil |
121 "Function or functions to run on entry to Font Lock mode.") | 126 "Function or functions to run on entry to Font Lock mode.") |
122 | 127 |
123 ;;; These variables record, for each buffer, | 128 ;; Colour etc. support. |
124 ;;; the parse state at a particular position, always the start of a line. | 129 |
125 ;;; This is used to make font-lock-fontify-region faster. | 130 (defvar font-lock-display-type |
131 (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) | |
132 (cond (display-resource (intern (downcase display-resource))) | |
133 ((x-display-color-p) 'color) | |
134 ((x-display-grayscale-p) 'grayscale) | |
135 (t 'mono))) | |
136 "A symbol indicating the display Emacs is running under. | |
137 The symbol should be one of `color', `grayscale' or `mono'. | |
138 If Emacs guesses this display attribute wrongly, either set this variable in | |
139 your `~/.emacs' file, or set the resource `Emacs.displayType' | |
140 in your `~/.Xdefaults' file. | |
141 See also `font-lock-background-mode' and `font-lock-face-attributes'.") | |
142 | |
143 (defvar font-lock-background-mode | |
144 (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode")) | |
145 (params (frame-parameters))) | |
146 (cond (bg-resource (intern (downcase bg-resource))) | |
147 ((or (string-equal (cdr (assq 'foreground-color params)) "white") | |
148 (string-equal (cdr (assq 'background-color params)) "black")) | |
149 'dark) | |
150 (t 'light))) | |
151 "A symbol indicating the Emacs background brightness. | |
152 The symbol should be one of `light' or `dark'. | |
153 If Emacs guesses this frame attribute wrongly, either set this variable in | |
154 your `~/.emacs' file or set the resource `Emacs.backgroundMode' | |
155 in your `~/.Xdefaults' file. | |
156 See also `font-lock-display-type' and `font-lock-face-attributes'.") | |
157 | |
158 (defvar font-lock-face-attributes | |
159 (let ((light-bg (eq font-lock-background-mode 'light))) | |
160 (cond ((memq font-lock-display-type '(mono monochrome)) | |
161 ;; Emacs 19.25's font-lock defaults: | |
162 ;;'((font-lock-comment-face nil nil nil t nil) | |
163 ;; (font-lock-string-face nil nil nil nil t) | |
164 ;; (font-lock-keyword-face nil nil t nil nil) | |
165 ;; (font-lock-function-name-face nil nil t t nil) | |
166 ;; (font-lock-type-face nil nil nil t nil)) | |
167 (list '(font-lock-comment-face nil nil t t nil) | |
168 '(font-lock-string-face nil nil nil t nil) | |
169 '(font-lock-keyword-face nil nil t nil nil) | |
170 (list 'font-lock-function-name-face | |
171 (cdr (assq 'background-color (frame-parameters))) | |
172 (cdr (assq 'foreground-color (frame-parameters))) | |
173 t nil nil) | |
174 '(font-lock-variable-name-face nil nil t t nil) | |
175 '(font-lock-type-face nil nil t nil t) | |
176 '(font-lock-reference-face nil nil t nil t))) | |
177 ((memq font-lock-display-type '(grayscale greyscale | |
178 grayshade greyshade)) | |
179 (list (list 'font-lock-comment-face | |
180 (if light-bg "DimGray" "Gray80") nil t t nil) | |
181 (list 'font-lock-string-face | |
182 (if light-bg "Gray50" "LightGray") nil nil t nil) | |
183 (list 'font-lock-keyword-face | |
184 (if light-bg "DimGray" "Gray90") nil t nil nil) | |
185 (list 'font-lock-function-name-face | |
186 (cdr (assq 'background-color (frame-parameters))) | |
187 (cdr (assq 'foreground-color (frame-parameters))) | |
188 t nil nil) | |
189 (list 'font-lock-variable-name-face | |
190 (if light-bg "DimGray" "Gray90") nil t t nil) | |
191 (list 'font-lock-type-face | |
192 (if light-bg "DimGray" "Gray80") nil t nil t))) | |
193 (light-bg ; light colour background | |
194 '((font-lock-comment-face "Firebrick") | |
195 (font-lock-string-face "RosyBrown") | |
196 (font-lock-keyword-face "Purple") | |
197 (font-lock-function-name-face "Blue") | |
198 (font-lock-variable-name-face "DarkGoldenrod") | |
199 (font-lock-type-face "DarkOliveGreen") | |
200 (font-lock-reference-face "CadetBlue"))) | |
201 (t ; dark colour background | |
202 '((font-lock-comment-face "OrangeRed") | |
203 (font-lock-string-face "LightSalmon") | |
204 (font-lock-keyword-face "LightSteelBlue") | |
205 (font-lock-function-name-face "LightSkyBlue") | |
206 (font-lock-variable-name-face "LightGoldenrod") | |
207 (font-lock-type-face "PaleGreen") | |
208 (font-lock-reference-face "Aquamarine"))))) | |
209 "A list of default attributes to use for face attributes. | |
210 Each element of the list should be of the form | |
211 | |
212 (FACE FOREGROUND BACKGROUND BOLD-P ITALIC-P UNDERLINE-P) | |
213 | |
214 where FACE should be one of the face symbols `font-lock-comment-face', | |
215 `font-lock-string-face', `font-lock-keyword-face', `font-lock-type-face', | |
216 `font-lock-function-name-face', `font-lock-variable-name-face', and | |
217 `font-lock-reference-face'. A form for each of these face symbols should be | |
218 provided in the list, but other face symbols and attributes may be given and | |
219 used in highlighting. See `font-lock-keywords'. | |
220 | |
221 Subsequent element items should be the attributes for the corresponding | |
222 Font Lock mode faces. Attributes FOREGROUND and BACKGROUND should be strings | |
223 \(default if nil), while BOLD-P, ITALIC-P, and UNDERLINE-P should specify the | |
224 corresponding face attributes (yes if non-nil). | |
225 | |
226 Emacs uses default attributes based on display type and background brightness. | |
227 See variables `font-lock-display-type' and `font-lock-background-mode'. | |
228 | |
229 Resources can be used to over-ride these face attributes. For example, the | |
230 resource `Emacs.font-lock-comment-face.attributeUnderline' can be used to | |
231 specify the UNDERLINE-P attribute for face `font-lock-comment-face'.") | |
232 | |
233 (defun font-lock-make-face (face-attributes) | |
234 "Make a face from FACE-ATTRIBUTES. | |
235 FACE-ATTRIBUTES should be like an element `font-lock-face-attributes', so that | |
236 the face name is the first item in the list. A variable with the same name as | |
237 the face is also set; its value is the face name." | |
238 (let* ((face (nth 0 face-attributes)) | |
239 (face-name (symbol-name face)) | |
240 (set-p (function (lambda (face-name resource) | |
241 (x-get-resource (concat face-name ".attribute" resource) | |
242 (concat "Face.Attribute" resource))))) | |
243 (on-p (function (lambda (face-name resource) | |
244 (let ((set (funcall set-p face-name resource))) | |
245 (and set (member (downcase set) '("on" "true")))))))) | |
246 (make-face face) | |
247 ;; Set attributes not set from X resources (and therefore `make-face'). | |
248 (or (funcall set-p face-name "Foreground") | |
249 (condition-case nil | |
250 (set-face-foreground face (nth 1 face-attributes)) | |
251 (error nil))) | |
252 (or (funcall set-p face-name "Background") | |
253 (condition-case nil | |
254 (set-face-background face (nth 2 face-attributes)) | |
255 (error nil))) | |
256 (if (funcall set-p face-name "Bold") | |
257 (and (funcall on-p face-name "Bold") (make-face-bold face nil t)) | |
258 (and (nth 3 face-attributes) (make-face-bold face nil t))) | |
259 (if (funcall set-p face-name "Italic") | |
260 (and (funcall on-p face-name "Italic") (make-face-italic face nil t)) | |
261 (and (nth 4 face-attributes) (make-face-italic face nil t))) | |
262 (or (funcall set-p face-name "Underline") | |
263 (set-face-underline-p face (nth 5 face-attributes))) | |
264 (set face face))) | |
265 | |
266 ;; Fontification. | |
267 | |
268 ;; These variables record, for each buffer, the parse state at a particular | |
269 ;; position, always the start of a line. Used to make font-lock-fontify-region | |
270 ;; faster. | |
126 (defvar font-lock-cache-position nil) | 271 (defvar font-lock-cache-position nil) |
127 (defvar font-lock-cache-state nil) | 272 (defvar font-lock-cache-state nil) |
128 (make-variable-buffer-local 'font-lock-cache-position) | 273 (make-variable-buffer-local 'font-lock-cache-position) |
129 (make-variable-buffer-local 'font-lock-cache-state) | 274 (make-variable-buffer-local 'font-lock-cache-state) |
130 | 275 |
131 (defun font-lock-fontify-region (start end) | 276 (defun font-lock-fontify-region (start end &optional loudly) |
132 "Put proper face on each string and comment between START and END." | 277 "Put proper face on each string and comment between START and END." |
133 (save-excursion | 278 (save-excursion |
134 (goto-char start) | 279 (save-restriction |
135 (beginning-of-line) | 280 (widen) |
136 (setq end (min end (point-max))) | 281 (goto-char start) |
137 (let ((buffer-read-only nil) | 282 (beginning-of-line) |
138 state startline prev prevstate | 283 (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) |
139 (modified (buffer-modified-p))) | 284 (let ((buffer-read-only nil) |
140 ;; Find the state at the line-beginning before START. | 285 (modified (buffer-modified-p)) |
141 (setq startline (point)) | 286 (cstart (if comment-start-skip |
142 (if (eq (point) font-lock-cache-position) | 287 (concat "\\s\"\\|" comment-start-skip) |
143 (setq state font-lock-cache-state) | 288 "\\s\"")) |
144 ;; Find outermost containing sexp. | 289 (cend (if comment-end |
145 (beginning-of-defun) | 290 (concat "\\s>\\|" (regexp-quote comment-end)) |
146 ;; Find the state at STARTLINE. | 291 "\\s>")) |
147 (while (< (point) startline) | 292 (startline (point)) |
148 (setq state (parse-partial-sexp (point) startline 0))) | 293 state prev prevstate) |
149 (setq font-lock-cache-state state | 294 ;; Find the state at the line-beginning before START. |
150 font-lock-cache-position (point))) | 295 (if (eq (point) font-lock-cache-position) |
151 ;; Now find the state precisely at START. | 296 (setq state font-lock-cache-state) |
152 (setq state (parse-partial-sexp (point) start nil nil state)) | 297 ;; Find outermost containing sexp. |
153 ;; If the region starts inside a string, show the extent of it. | 298 (beginning-of-defun) |
154 (if (nth 3 state) | 299 ;; Find the state at STARTLINE. |
155 (let ((beg (point))) | 300 (while (< (point) startline) |
156 (while (and (re-search-forward "\\s\"" end 'move) | 301 (setq state (parse-partial-sexp (point) startline 0))) |
157 (nth 3 (parse-partial-sexp beg (point) | 302 (setq font-lock-cache-state state |
158 nil nil state)))) | 303 font-lock-cache-position (point))) |
159 (put-text-property beg (point) 'face font-lock-string-face) | 304 ;; Now find the state precisely at START. |
160 (setq state (parse-partial-sexp beg (point) nil nil state)))) | 305 (setq state (parse-partial-sexp (point) start nil nil state)) |
161 ;; Likewise for a comment. | 306 ;; If the region starts inside a string, show the extent of it. |
162 (if (or (nth 4 state) (nth 7 state)) | 307 (if (nth 3 state) |
163 (let ((beg (point))) | 308 (let ((beg (point))) |
164 (while (and (re-search-forward (if comment-end | 309 (while (and (re-search-forward "\\s\"" end 'move) |
165 (concat "\\s>\\|" | 310 (nth 3 (parse-partial-sexp beg (point) |
166 (regexp-quote comment-end)) | 311 nil nil state)))) |
167 "\\s>") | 312 (put-text-property beg (point) 'face font-lock-string-face) |
168 end 'move) | 313 (setq state (parse-partial-sexp beg (point) nil nil state)))) |
169 (nth 3 (parse-partial-sexp beg (point) | 314 ;; Likewise for a comment. |
170 nil nil state)))) | 315 (if (or (nth 4 state) (nth 7 state)) |
171 (put-text-property beg (point) 'face font-lock-comment-face) | 316 (let ((beg (point))) |
172 (setq state (parse-partial-sexp beg (point) nil nil state)))) | 317 (while (and (re-search-forward cend end 'move) |
173 ;; Find each interesting place between here and END. | 318 (nth 3 (parse-partial-sexp beg (point) |
174 (while (and (< (point) end) | 319 nil nil state)))) |
175 (setq prev (point) prevstate state) | 320 (put-text-property beg (point) 'face font-lock-comment-face) |
176 (re-search-forward (if comment-start-skip | 321 (setq state (parse-partial-sexp beg (point) nil nil state)))) |
177 (concat "\\s\"\\|" comment-start-skip) | 322 ;; Find each interesting place between here and END. |
178 "\\s\"") | 323 (while (and (< (point) end) |
179 end t) | 324 (setq prev (point) prevstate state) |
180 ;; Clear out the fonts of what we skip over. | 325 (re-search-forward cstart end t) |
181 (progn (remove-text-properties prev (point) '(face nil)) t) | 326 (progn |
182 ;; Verify the state at that place | 327 ;; Clear out the fonts of what we skip over. |
183 ;; so we don't get fooled by \" or \;. | 328 (remove-text-properties prev (point) '(face nil)) |
184 (setq state (parse-partial-sexp prev (point) | 329 ;; Verify the state at that place |
185 nil nil state))) | 330 ;; so we don't get fooled by \" or \;. |
186 (let ((here (point))) | 331 (setq state (parse-partial-sexp prev (point) |
187 (if (or (nth 4 state) (nth 7 state)) | 332 nil nil state)))) |
188 ;; We found a real comment start. | 333 (let ((here (point))) |
189 (let ((beg (match-beginning 0))) | 334 (if (or (nth 4 state) (nth 7 state)) |
190 (goto-char beg) | 335 ;; We found a real comment start. |
191 (save-restriction | |
192 (narrow-to-region (point-min) end) | |
193 (condition-case nil | |
194 (progn | |
195 (forward-comment 1) | |
196 ;; forward-comment skips all whitespace, | |
197 ;; so go back to the real end of the comment. | |
198 (skip-chars-backward " \t")) | |
199 (error (goto-char end)))) | |
200 (put-text-property beg (point) 'face font-lock-comment-face) | |
201 (setq state (parse-partial-sexp here (point) nil nil state))) | |
202 (if (nth 3 state) | |
203 (let ((beg (match-beginning 0))) | 336 (let ((beg (match-beginning 0))) |
204 (while (and (re-search-forward "\\s\"" end 'move) | 337 (goto-char beg) |
205 (nth 3 (parse-partial-sexp here (point) | 338 (save-restriction |
206 nil nil state)))) | 339 (narrow-to-region (point-min) end) |
207 (put-text-property beg (point) 'face font-lock-string-face) | 340 (condition-case nil |
208 (setq state (parse-partial-sexp here (point) nil nil state)))) | 341 (progn |
209 )) | 342 (forward-comment 1) |
210 ;; Make sure PREV is non-nil after the loop | 343 ;; forward-comment skips all whitespace, |
211 ;; only if it was set on the very last iteration. | 344 ;; so go back to the real end of the comment. |
212 (setq prev nil)) | 345 (skip-chars-backward " \t")) |
213 (and prev | 346 (error (goto-char end)))) |
214 (remove-text-properties prev end '(face nil))) | 347 (put-text-property beg (point) 'face font-lock-comment-face) |
215 (and (buffer-modified-p) | 348 (setq state (parse-partial-sexp here (point) nil nil state))) |
216 (not modified) | 349 (if (nth 3 state) |
217 (set-buffer-modified-p nil))))) | 350 (let ((beg (match-beginning 0))) |
351 (while (and (re-search-forward "\\s\"" end 'move) | |
352 (nth 3 (parse-partial-sexp here (point) | |
353 nil nil state)))) | |
354 (put-text-property beg (point) 'face font-lock-string-face) | |
355 (setq state (parse-partial-sexp here (point) | |
356 nil nil state)))))) | |
357 ;; Make sure PREV is non-nil after the loop | |
358 ;; only if it was set on the very last iteration. | |
359 (setq prev nil)) | |
360 (and prev | |
361 (remove-text-properties prev end '(face nil))) | |
362 (and (buffer-modified-p) | |
363 (not modified) | |
364 (set-buffer-modified-p nil)))))) | |
218 | 365 |
219 ;; This code used to be used to show a string on reaching the end of it. | 366 ;; This code used to be used to show a string on reaching the end of it. |
220 ;; It is probably not needed due to later changes to handle strings | 367 ;; It is probably not needed due to later changes to handle strings |
221 ;; starting before the region in question. | 368 ;; starting before the region in question. |
222 ;; (if (and (null (nth 3 state)) | 369 ;; (if (and (null (nth 3 state)) |
246 | 393 |
247 ;; Called when any modification is made to buffer text. | 394 ;; Called when any modification is made to buffer text. |
248 (defun font-lock-after-change-function (beg end old-len) | 395 (defun font-lock-after-change-function (beg end old-len) |
249 (save-excursion | 396 (save-excursion |
250 (save-match-data | 397 (save-match-data |
251 (goto-char beg) | |
252 ;; Discard the cache info if text before it has changed. | 398 ;; Discard the cache info if text before it has changed. |
253 (and font-lock-cache-position | 399 (and font-lock-cache-position |
254 (> font-lock-cache-position beg) | 400 (> font-lock-cache-position beg) |
255 (setq font-lock-cache-position nil)) | 401 (setq font-lock-cache-position nil)) |
256 ;; Rescan till end of line. yes! | 402 ;; Rescan between start of line from `beg' and start of line after `end'. |
257 (goto-char end) | |
258 (end-of-line) | |
259 (setq end (point)) | |
260 (goto-char beg) | 403 (goto-char beg) |
261 (beginning-of-line) | 404 (beginning-of-line) |
262 (setq beg (point)) | 405 (setq beg (point)) |
406 (goto-char end) | |
407 (forward-line 1) | |
408 (setq end (point)) | |
263 ;; First scan for strings and comments. | 409 ;; First scan for strings and comments. |
264 ;; Must scan from line start in case of | 410 ;; Must scan from line start in case of |
265 ;; inserting space into `intfoo () {}'. | 411 ;; inserting space into `intfoo () {}', and after widened. |
266 (if font-lock-no-comments | 412 (if font-lock-no-comments |
267 (remove-text-properties beg (min (1+ end) (point-max)) '(face nil)) | 413 (remove-text-properties beg end '(face nil)) |
268 (font-lock-fontify-region beg (min (1+ end) (point-max)))) | 414 (font-lock-fontify-region beg end)) |
269 ;; Now scan for keywords. | 415 ;; Now scan for keywords. |
270 (font-lock-hack-keywords beg end)))) | 416 (font-lock-hack-keywords beg end)))) |
271 | 417 |
272 ;;; Fontifying arbitrary patterns | 418 ;;; Fontifying arbitrary patterns |
273 | 419 |
274 (defsubst font-lock-any-properties-p (start end) | |
275 (or (get-text-property start 'face) | |
276 (let ((next (next-single-property-change start 'face))) | |
277 (and next (< next end))))) | |
278 | |
279 (defun font-lock-hack-keywords (start end &optional loudly) | 420 (defun font-lock-hack-keywords (start end &optional loudly) |
280 (goto-char start) | 421 "Fontify according to `font-lock-keywords' between START and END." |
281 (let ((case-fold-search font-lock-keywords-case-fold-search) | 422 (let ((case-fold-search font-lock-keywords-case-fold-search) |
282 (rest font-lock-keywords) | 423 (keywords font-lock-keywords) |
283 (count 0) | 424 (count 0) |
284 (buffer-read-only nil) | 425 (buffer-read-only nil) |
285 (modified (buffer-modified-p)) | 426 (modified (buffer-modified-p)) |
286 first str match face s e allow-overlap-p | 427 (old-syntax (syntax-table)) |
287 (old-syntax (syntax-table))) | 428 (bufname (buffer-name))) |
288 (unwind-protect | 429 (unwind-protect |
289 (progn | 430 (let (keyword regexp match highlights hs h s e) |
290 (if font-lock-syntax-table | 431 (if loudly (message "Fontifying %s... (regexps...)" bufname)) |
291 (set-syntax-table font-lock-syntax-table)) | 432 (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) |
292 (while rest | 433 (while keywords |
293 (setq first (car rest) rest (cdr rest)) | 434 (setq keyword (car keywords) keywords (cdr keywords) |
435 regexp (if (stringp keyword) keyword (car keyword)) | |
436 highlights (cond ((stringp keyword) | |
437 '((0 font-lock-keyword-face))) | |
438 ((numberp (cdr keyword)) | |
439 (list (list (cdr keyword) | |
440 'font-lock-keyword-face))) | |
441 ((symbolp (cdr keyword)) | |
442 (list (list 0 (cdr keyword)))) | |
443 ((nlistp (nth 1 keyword)) | |
444 (list (cdr keyword))) | |
445 (t | |
446 (cdr keyword)))) | |
294 (goto-char start) | 447 (goto-char start) |
295 (cond ((consp first) | 448 (while (re-search-forward regexp end t) |
296 (setq str (car first)) | 449 (setq hs highlights) |
297 (cond ((consp (cdr first)) | 450 (while hs |
298 (setq match (nth 1 first) | 451 (setq h (car hs) match (nth 0 h) |
299 face (eval (nth 2 first)) | 452 s (match-beginning match) e (match-end match) |
300 allow-overlap-p (nth 3 first))) | 453 hs (cdr hs)) |
301 ((symbolp (cdr first)) | 454 (cond ((not s) |
302 (setq match 0 allow-overlap-p nil | 455 ;; No match but we might not signal an error |
303 face (eval (cdr first)))) | 456 (or (nth 3 h) |
304 (t | 457 (error "No subexpression %d in expression %d" |
305 (setq match (cdr first) | 458 match (1+ count)))) |
306 allow-overlap-p nil | 459 ((and (not (nth 2 h)) |
307 face font-lock-keyword-face)))) | 460 (text-property-not-all s e 'face nil)) |
308 (t | 461 ;; Can't override and already fontified |
309 (setq str first match 0 allow-overlap-p nil | 462 nil) |
310 face font-lock-keyword-face))) | 463 ((not (eq (nth 2 h) 'keep)) |
311 ;(message "regexp: %s" str) | 464 ;; Can override but need not keep existing fontification |
312 (while (re-search-forward str end t) | 465 (put-text-property s e 'face (eval (nth 1 h)))) |
313 (setq s (match-beginning match) | 466 (t |
314 e (match-end match)) | 467 ;; Can override but must keep existing fontification |
315 (or s (error "expression did not match subexpression %d" match)) | 468 ;; (Does anyone use this? sm.) |
316 ;; don't fontify this keyword if we're already in some other context. | 469 (let ((p (text-property-any s e 'face nil)) n |
317 (or (if allow-overlap-p nil (font-lock-any-properties-p s e)) | 470 (face (eval (nth 1 h)))) |
318 (if (not (memq allow-overlap-p '(t nil))) | 471 (while p |
319 (save-excursion | 472 (setq n (next-single-property-change p 'face nil e)) |
320 (goto-char s) | 473 (put-text-property p n 'face face) |
321 (while (< (point) e) | 474 (setq p (text-property-any n e 'face nil)))))))) |
322 (let ((next (next-single-property-change (point) 'face | 475 ;; the above form was: |
323 nil e))) | 476 ; (save-excursion |
324 (if (or (null next) (> next e)) | 477 ; (goto-char s) |
325 (setq next e)) | 478 ; (while (< (point) e) |
326 (if (not (get-text-property (point) 'face)) | 479 ; (let ((next (next-single-property-change (point) 'face |
327 (put-text-property (point) next 'face face)) | 480 ; nil e))) |
328 (goto-char next)))) | 481 ; (if (or (null next) (> next e)) |
329 (put-text-property s e 'face face)))) | 482 ; (setq next e)) |
330 (if loudly (message "Fontifying %s... (regexps...%s)" | 483 ; (if (not (get-text-property (point) 'face)) |
331 (buffer-name) | 484 ; (put-text-property (point) next 'face face)) |
485 ; (goto-char next)))) | |
486 | |
487 (if loudly (message "Fontifying %s... (regexps...%s)" bufname | |
332 (make-string (setq count (1+ count)) ?.))))) | 488 (make-string (setq count (1+ count)) ?.))))) |
333 (set-syntax-table old-syntax)) | 489 (set-syntax-table old-syntax)) |
334 (and (buffer-modified-p) | 490 (and (buffer-modified-p) |
335 (not modified) | 491 (not modified) |
336 (set-buffer-modified-p nil)))) | 492 (set-buffer-modified-p nil)))) |
337 | 493 |
338 ;; The user level functions | 494 ;; The user level functions |
339 | 495 |
340 (defvar font-lock-mode nil) ; for modeline | 496 (defvar font-lock-mode nil) ; for modeline |
341 (or (assq 'font-lock-mode minor-mode-alist) | |
342 (setq minor-mode-alist | |
343 (append minor-mode-alist | |
344 '((font-lock-mode " Font"))))) | |
345 | 497 |
346 (defvar font-lock-fontified nil) ; whether we have hacked this buffer | 498 (defvar font-lock-fontified nil) ; whether we have hacked this buffer |
347 (put 'font-lock-fontified 'permanent-local t) | 499 (put 'font-lock-fontified 'permanent-local t) |
348 | 500 |
349 ;;;###autoload | 501 ;;;###autoload |
351 "Toggle Font Lock mode. | 503 "Toggle Font Lock mode. |
352 With arg, turn Font Lock mode on if and only if arg is positive. | 504 With arg, turn Font Lock mode on if and only if arg is positive. |
353 | 505 |
354 When Font Lock mode is enabled, text is fontified as you type it: | 506 When Font Lock mode is enabled, text is fontified as you type it: |
355 | 507 |
356 - comments are displayed in `font-lock-comment-face'; | 508 - Comments are displayed in `font-lock-comment-face'; |
357 (That is a variable whose value should be a face name.) | 509 - Strings are displayed in `font-lock-string-face'; |
358 - strings are displayed in `font-lock-string-face'; | 510 - Certain other expressions are displayed in other faces according to the |
359 - documentation strings are displayed in `font-lock-doc-string-face'; | 511 value of the variable `font-lock-keywords'. |
360 - function and variable names in their defining forms are displayed | 512 |
361 in `font-lock-function-name-face'; | 513 You can enable Font Lock mode in any major mode automatically by turning on in |
362 - and certain other expressions are displayed in other faces | 514 the major mode's hook. For example, put in your ~/.emacs: |
363 according to the value of the variable `font-lock-keywords'. | 515 |
516 (add-hook 'c-mode-hook 'turn-on-font-lock) | |
517 | |
518 Or for any visited file with the following in your ~/.emacs: | |
519 | |
520 (add-hook 'find-file-hooks 'turn-on-font-lock) | |
521 | |
522 The default Font Lock mode faces and their attributes are defined in the | |
523 variable `font-lock-face-attributes', and Font Lock mode default settings in | |
524 the variable `font-lock-defaults-alist'. | |
364 | 525 |
365 When you turn Font Lock mode on/off, the buffer is fontified/defontified. | 526 When you turn Font Lock mode on/off, the buffer is fontified/defontified. |
366 To fontify a buffer without having newly typed text become fontified, you | 527 To fontify a buffer without having newly typed text become fontified, you |
367 can use \\[font-lock-fontify-buffer]." | 528 can use \\[font-lock-fontify-buffer]." |
368 (interactive "P") | 529 (interactive "P") |
369 (let ((on-p (if (null arg) | 530 (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode)))) |
370 (not font-lock-mode) | |
371 (> (prefix-numeric-value arg) 0)))) | |
372 (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... | 531 (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... |
373 (setq on-p nil)) | 532 (setq on-p nil)) |
374 (make-local-variable 'after-change-functions) | 533 (if (not on-p) |
375 (if on-p | 534 (remove-hook 'after-change-functions 'font-lock-after-change-function) |
376 (or (memq 'font-lock-after-change-function after-change-functions) | 535 (make-local-variable 'after-change-functions) |
377 (setq after-change-functions (cons 'font-lock-after-change-function | 536 (add-hook 'after-change-functions 'font-lock-after-change-function)) |
378 after-change-functions))) | |
379 (setq after-change-functions | |
380 (delq 'font-lock-after-change-function | |
381 (copy-sequence after-change-functions)))) | |
382 (set (make-local-variable 'font-lock-mode) on-p) | 537 (set (make-local-variable 'font-lock-mode) on-p) |
383 (make-local-variable 'font-lock-no-comments) | |
384 (cond (on-p | 538 (cond (on-p |
385 (font-lock-set-defaults) | 539 (font-lock-set-defaults) |
386 (make-local-variable 'before-revert-hook) | 540 (make-local-variable 'before-revert-hook) |
387 (make-local-variable 'after-revert-hook) | 541 (make-local-variable 'after-revert-hook) |
388 ;; If buffer is reverted, must clean up the state. | 542 ;; If buffer is reverted, must clean up the state. |
395 (remove-hook 'before-revert-hook 'font-lock-revert-setup) | 549 (remove-hook 'before-revert-hook 'font-lock-revert-setup) |
396 (remove-hook 'after-revert-hook 'font-lock-revert-cleanup) | 550 (remove-hook 'after-revert-hook 'font-lock-revert-cleanup) |
397 (font-lock-unfontify-region (point-min) (point-max)))) | 551 (font-lock-unfontify-region (point-min) (point-max)))) |
398 (force-mode-line-update))) | 552 (force-mode-line-update))) |
399 | 553 |
554 ;;;###autoload | |
555 (defun turn-on-font-lock () | |
556 "Unconditionally turn on Font Lock mode." | |
557 (font-lock-mode 1)) | |
558 | |
400 ;; If the buffer is about to be reverted, it won't be fontified. | 559 ;; If the buffer is about to be reverted, it won't be fontified. |
401 (defun font-lock-revert-setup () | 560 (defun font-lock-revert-setup () |
402 (setq font-lock-fontified nil)) | 561 (setq font-lock-fontified nil)) |
403 | 562 |
404 ;; If the buffer has just been reverted, we might not even be in font-lock | 563 ;; If the buffer has just been reverted, we might not even be in font-lock |
407 (defun font-lock-revert-cleanup () | 566 (defun font-lock-revert-cleanup () |
408 (and font-lock-mode | 567 (and font-lock-mode |
409 (not font-lock-fontified) | 568 (not font-lock-fontified) |
410 (font-lock-mode 1))) | 569 (font-lock-mode 1))) |
411 | 570 |
571 ;;;###autoload | |
412 (defun font-lock-fontify-buffer () | 572 (defun font-lock-fontify-buffer () |
413 "Fontify the current buffer the way `font-lock-mode' would: | 573 "Fontify the current buffer the way `font-lock-mode' would." |
414 | |
415 - comments are displayed in `font-lock-comment-face'; | |
416 - strings are displayed in `font-lock-string-face'; | |
417 - documentation strings are displayed in `font-lock-doc-string-face'; | |
418 - function and variable names in their defining forms are displayed | |
419 in `font-lock-function-name-face'; | |
420 - and certain other expressions are displayed in other faces | |
421 according to the value of the variable `font-lock-keywords'. | |
422 | |
423 This can take a while for large buffers." | |
424 (interactive) | 574 (interactive) |
425 (let ((was-on font-lock-mode) | 575 (let ((was-on font-lock-mode) |
426 (font-lock-verbose (or font-lock-verbose (interactive-p)))) | 576 (verbose (or font-lock-verbose (interactive-p))) |
427 (if font-lock-verbose (message "Fontifying %s..." (buffer-name))) | 577 (modified (buffer-modified-p))) |
578 (make-local-variable 'font-lock-fontified) | |
579 (if verbose (message "Fontifying %s..." (buffer-name))) | |
428 ;; Turn it on to run hooks and get the right font-lock-keywords. | 580 ;; Turn it on to run hooks and get the right font-lock-keywords. |
429 (or was-on (font-lock-set-defaults)) | 581 (or was-on (font-lock-set-defaults)) |
430 (font-lock-unfontify-region (point-min) (point-max)) | 582 (condition-case nil |
431 (if (and font-lock-verbose (not font-lock-no-comments)) | 583 (save-excursion |
432 (message "Fontifying %s... (syntactically...)" (buffer-name))) | 584 (font-lock-unfontify-region (point-min) (point-max)) |
433 (save-excursion | 585 (if (not font-lock-no-comments) |
434 (or font-lock-no-comments | 586 (font-lock-fontify-region (point-min) (point-max) verbose)) |
435 (font-lock-fontify-region (point-min) (point-max))) | 587 (font-lock-hack-keywords (point-min) (point-max) verbose) |
436 (if font-lock-verbose (message "Fontifying %s... (regexps...)" | 588 (setq font-lock-fontified t)) |
437 (buffer-name))) | 589 ;; We don't restore the old fontification, so it's best to unfontify. |
438 (font-lock-hack-keywords (point-min) (point-max) font-lock-verbose)) | 590 (quit (font-lock-unfontify-region (point-min) (point-max)) |
439 (set (make-local-variable 'font-lock-fontified) t) | 591 (setq font-lock-fontified nil))) |
440 (if font-lock-verbose (message "Fontifying %s... done." (buffer-name))) | 592 (if verbose (message "Fontifying %s... %s." (buffer-name) |
441 )) | 593 (if font-lock-fontified "done" "aborted"))) |
594 (and (buffer-modified-p) | |
595 (not modified) | |
596 (set-buffer-modified-p nil)))) | |
442 | 597 |
443 | 598 |
444 ;;; Various mode-specific information. | 599 ;;; Various information shared by several modes. |
600 ;;; Information specific to a single mode should go in its load library. | |
445 | 601 |
446 (defconst lisp-font-lock-keywords-1 | 602 (defconst lisp-font-lock-keywords-1 |
447 '(;; | 603 (list |
448 ;; highlight defining forms. This doesn't work too nicely for | 604 ;; highlight defining forms. This doesn't work too nicely for |
449 ;; (defun (setf foo) ...) but it does work for (defvar foo) which | 605 ;; (defun (setf foo) ...) but it does work for (defvar foo) which |
450 ;; is more important. | 606 ;; is more important. |
451 ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) | 607 (list (concat "^(\\(def\\(const\\|ine-key\\(\\|-after\\)\\|var\\)\\)\\>" |
452 ;; | 608 "\\s *\\([^ \t\n\)]+\\)?") |
453 ;; highlight CL keywords | 609 '(1 font-lock-keyword-face) '(4 font-lock-variable-name-face nil t)) |
454 ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) | 610 (list (concat "^(\\(def\\(a\\(dvice\\|lias\\)\\|macro\\|subst\\|un\\)\\)\\>" |
611 "\\s *\\([^ \t\n\)]+\\)?") | |
612 '(1 font-lock-keyword-face) '(4 font-lock-function-name-face nil t)) | |
455 ;; | 613 ;; |
456 ;; this is highlights things like (def* (setf foo) (bar baz)), but may | 614 ;; this is highlights things like (def* (setf foo) (bar baz)), but may |
457 ;; be slower (I haven't really thought about it) | 615 ;; be slower (I haven't really thought about it) |
458 ; ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)" | 616 ; ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)" |
459 ; 1 font-lock-function-name-face) | 617 ; 1 font-lock-function-name-face) |
462 This does fairly subdued highlighting.") | 620 This does fairly subdued highlighting.") |
463 | 621 |
464 (defconst lisp-font-lock-keywords-2 | 622 (defconst lisp-font-lock-keywords-2 |
465 (append | 623 (append |
466 lisp-font-lock-keywords-1 | 624 lisp-font-lock-keywords-1 |
467 '(;; | 625 (list |
468 ;; Highlight control structures | 626 ;; |
469 ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1) | 627 ;; Control structures. |
470 ("(\\(while\\|do\\|let\\*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1) | 628 ;; ELisp: |
471 ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1) | 629 ; ("cond" "if" "while" "let\\*?" "prog[nv12*]?" "catch" "throw" |
472 ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1) | 630 ; "save-restriction" "save-excursion" |
473 ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1) | 631 ; "save-window-excursion" "save-match-data" "unwind-protect" |
474 ;; | 632 ; "condition-case" "track-mouse") |
475 ;; highlight function names in emacs-lisp docstrings (in the syntax | 633 (cons |
476 ;; that substitute-command-keys understands.) | 634 (concat "(\\(" |
477 ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) | 635 "c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|if\\|let\\*?\\|prog[nv12*]?\\|" |
478 ;; | 636 "save-\\(excursion\\|match-data\\|restriction\\|window-excursion\\)\\|" |
479 ;; highlight words inside `' which tend to be function names | 637 "t\\(hrow\\|rack-mouse\\)\\|unwind-protect\\|while" |
480 ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" | 638 "\\)[ \t\n]") 1) |
481 1 font-lock-keyword-face t) | 639 ;; CLisp: |
482 )) | 640 ; ("when" "unless" "do" "flet" "labels" "return" "return-from") |
641 '("(\\(do\\|flet\\|labels\\|return\\(\\|-from\\)\\|unless\\|when\\)\\>" | |
642 . 1) | |
643 ;; | |
644 ;; Fontify CLisp keywords. | |
645 '("\\s :\\([-a-zA-Z0-9]+\\)\\>" . 1) | |
646 ;; | |
647 ;; Function names in emacs-lisp docstrings (in the syntax that | |
648 ;; substitute-command-keys understands.) | |
649 '("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-reference-face t) | |
650 ;; | |
651 ;; Words inside `' which tend to be function names | |
652 (let ((word-char "[-+a-zA-Z0-9_.*]")) | |
653 (list (concat "`\\(" word-char word-char "+\\)'") | |
654 1 'font-lock-reference-face t)) | |
655 ;; | |
656 ;; & keywords as types | |
657 '("\\&\\(optional\\|rest\\)\\>" . font-lock-type-face) | |
658 )) | |
483 "For consideration as a value of `lisp-font-lock-keywords'. | 659 "For consideration as a value of `lisp-font-lock-keywords'. |
484 This does a lot more highlighting.") | 660 This does a lot more highlighting.") |
485 | 661 |
486 ;; default to the gaudier variety? | 662 ;; default to the gaudier variety? |
487 ;(defvar lisp-font-lock-keywords lisp-font-lock-keywords-2 | 663 ;(defvar lisp-font-lock-keywords lisp-font-lock-keywords-2 |
504 | 680 |
505 (defconst c++-font-lock-keywords-2 nil | 681 (defconst c++-font-lock-keywords-2 nil |
506 "For consideration as a value of `c++-font-lock-keywords'. | 682 "For consideration as a value of `c++-font-lock-keywords'. |
507 This does a lot more highlighting.") | 683 This does a lot more highlighting.") |
508 | 684 |
509 (let* ((storage "auto\\|extern\\|register\\|static\\|typedef") | 685 (let ((type-types |
510 (struct "struct\\|union\\|enum") | 686 ; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum" |
511 (prefixes "signed\\|unsigned\\|short\\|long") | 687 ; "signed" "unsigned" "short" "long" "int" "char" "float" "double" |
512 (types (concat prefixes "\\|int\\|char\\|float\\|double\\|void")) | 688 ; "void") |
513 (ctoken "[a-zA-Z0-9_:~*]+") | 689 (concat "auto\\|char\\|double\\|e\\(num\\|xtern\\)\\|float\\|int\\|" |
514 (c++-things (concat | 690 "long\\|register\\|s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|" |
515 "const\\|class\\|protected:\\|private:\\|public:\\|inline\\|" | 691 "typedef\\|un\\(ion\\|signed\\)\\|void")) ; 4 ()s deep. |
516 "new\\|delete"))) | 692 (c++-types |
693 ; ("const" "class" "protected" "private" "public" "inline" "bool" | |
694 ; "virtual") | |
695 (concat "bool\\|c\\(lass\\|onst\\)\\|inline\\|" | |
696 "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|virtual")) | |
697 (ctoken "[a-zA-Z0-9_:~]+")) | |
517 (setq c-font-lock-keywords-1 | 698 (setq c-font-lock-keywords-1 |
518 (list | 699 (list |
519 ;; fontify preprocessor directives as comments. | |
520 '("^#[ \t]*[a-z]+" . font-lock-comment-face) | |
521 ;; | 700 ;; |
522 ;; fontify names being defined. | 701 ;; Fontify filenames in #include <...> preprocessor directives. |
523 '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 | |
524 font-lock-function-name-face) | |
525 ;; | |
526 ;; fontify other preprocessor lines. | |
527 '("^#[ \t]*\\(if\\|elif\\|else\\|endif\\)[ \t]+\\([^\n]+\\)" | |
528 2 font-lock-function-name-face keep) | |
529 '("^#[ \t]*\\(ifn?def\\)[ \t]+\\([^ \t\n]+\\)" | |
530 2 font-lock-function-name-face t) | |
531 ;; | |
532 ;; fontify the filename in #include <...> | |
533 ;; don't need to do this for #include "..." because those were | |
534 ;; already fontified as strings by the syntactic pass. | |
535 '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) | 702 '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) |
536 ;; | 703 ;; |
537 ;; fontify the names of functions being defined. | 704 ;; Fontify function macro names. |
538 (list (concat | 705 '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face) |
539 "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no | |
540 "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? | |
541 "\\(" ctoken "[ \t]+\\)?" | |
542 "\\([*&]+[ \t]*\\)?" ; pointer | |
543 "\\(" ctoken "\\)[ \t]*(") ; name | |
544 5 'font-lock-function-name-face) | |
545 ;; | 706 ;; |
707 ;; Fontify otherwise as symbol names, and the preprocessor directive names. | |
708 '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?" | |
709 (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)) | |
546 ;; | 710 ;; |
547 ;; Fontify structure names (in structure definition form). | 711 ;; Fontify function name definitions (without type on line). |
548 (list (concat "^\\(" storage "\\)?[ \t]*\\<\\(" struct "\\)" | 712 (list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face) |
549 "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") | |
550 3 'font-lock-function-name-face) | |
551 ;; | |
552 ;; Fontify declarations of simple identifiers (including typedefs). | |
553 ;; (Should this be in c-font-lock-keywords-2 instead?) | |
554 (list (concat "^[ \t]*\\(\\(" storage "\\)[ \t]+\\)?\\(\\(\\(" prefixes | |
555 "\\)\\>[ \t]*\\)*\\(" types "\\)\\)[ \t]+\\(" ctoken | |
556 "\\)[ \t]*[=;]") | |
557 7 'font-lock-function-name-face 'keep) | |
558 ;; | |
559 ;; And likewise for structs | |
560 (list (concat "^[ \t]*\\(\\(" storage "\\)[ \t]+\\)?\\(" struct | |
561 "\\)[ \t]+" ctoken "[ \t]+\\(" ctoken "\\);") | |
562 4 'font-lock-function-name-face 'keep) | |
563 ;; | |
564 ;; Fontify case clauses. This is fast because its anchored on the left. | |
565 '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) | |
566 '("\\<\\(default\\):". 1) | |
567 )) | 713 )) |
568 | 714 |
569 (setq c-font-lock-keywords-2 | 715 (setq c-font-lock-keywords-2 |
570 (append c-font-lock-keywords-1 | 716 (append c-font-lock-keywords-1 |
571 (list | 717 (list |
572 ;; | 718 ;; |
573 ;; fontify all storage classes and type specifiers | 719 ;; Fontify all storage classes and type specifiers (before declarations). |
574 (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) | 720 (cons (concat "\\<\\(" type-types "\\)\\>") 'font-lock-type-face) |
575 (cons (concat "\\<\\(" types "\\)\\>") 'font-lock-type-face) | 721 ;; |
576 (cons (concat "\\<\\(\\(\\(" prefixes "\\)\\>[ \t]*\\)*\\(" types | 722 ;; Fontify variable/structure name declarations and definitions, or |
577 "\\)\\)\\>") | 723 ;; function name declarations (plus definitions with type on same line). |
578 'font-lock-type-face) | 724 (list (concat "\\<\\(" type-types "\\)[ \t*&]+" |
579 (list (concat "\\<\\(" struct "\\)[ \t]+" ctoken) | 725 "\\(" ctoken "[ \t*&]+\\)*" |
580 0 'font-lock-type-face 'keep) | 726 "\\(" ctoken "\\)[ \t]*\\((\\)?") |
581 ;; | 727 7 |
582 ;; fontify all builtin tokens | 728 '(if (match-beginning 8) |
729 'font-lock-function-name-face | |
730 'font-lock-variable-name-face)) | |
731 ;; Is highlighting above using (6 font-lock-type-face nil t) a good idea? | |
732 ;; | |
733 ;; Fontify variable names declared with structures, or typedef names. | |
734 '("}[ \t]*\\(\\sw+\\)[ \t]*[;,[]" 1 font-lock-variable-name-face) | |
735 ;; | |
736 ;; Fontify all builtin keywords (except case and goto; see below). | |
583 (cons (concat | 737 (cons (concat |
584 "[ \t]\\(" | 738 ; ("for" "while" "do" "return" "goto" "case" "break" "switch" |
585 (mapconcat 'identity | 739 ; "if" "else" "default" "continue" "default") |
586 '("for" "while" "do" "return" "goto" "case" "break" "switch" | 740 "\\<\\(break\\|continue\\|d\\(efault\\|o\\)\\|else\\|" |
587 "if" "else" "default" "continue" "default") | 741 "for\\|if\\|return\\|switch\\|while\\)\\>") |
588 "\\|") | 742 'font-lock-keyword-face) |
589 "\\)[ \t\n(){};,]") | 743 ;; |
590 1) | 744 ;; Fontify case/goto keywords and targets, and goto tags. |
591 ;; | 745 '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?" |
592 ;; fontify case targets and goto-tags. This is slow because the | 746 (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) |
593 ;; expression is anchored on the right. | 747 '("^[ \t]*\\(\\sw+\\)[ \t]*:" 1 font-lock-reference-face) |
594 '("[ \t\n]\\(\\(\\sw\\|\\s_\\)+\\):" . 1) | |
595 ;; | |
596 ;; Fontify variables declared with structures, or typedef names. | |
597 '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" | |
598 1 font-lock-function-name-face) | |
599 ;; | |
600 ;; Fontify global variables without a type. | |
601 ; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) | |
602 ))) | 748 ))) |
603 | 749 |
604 (setq c++-font-lock-keywords-1 | 750 (setq c++-font-lock-keywords-1 c-font-lock-keywords-1) |
605 (cons | |
606 (concat "\\(" c++-things "\\)[ \t\n]") | |
607 c-font-lock-keywords-1)) | |
608 (setq c++-font-lock-keywords-2 | 751 (setq c++-font-lock-keywords-2 |
609 (cons | 752 (append |
610 (cons (concat "\\<\\(" c++-things "\\)\\>") 'font-lock-type-face) | 753 (list |
611 c-font-lock-keywords-2)) | 754 ;; |
755 ;; Fontify C++ type specifiers (before case targets/goto tags). | |
756 (cons (concat "\\<\\(" c++-types "\\)\\>") 'font-lock-type-face) | |
757 ;; | |
758 ;; Fontify C++ builtin keywords. | |
759 '("\\<\\(delete\\|new\\)\\>" . font-lock-keyword-face)) | |
760 c-font-lock-keywords-2)) | |
612 ) | 761 ) |
613 | 762 |
614 ; default to the gaudier variety? | 763 ; default to the gaudier variety? |
615 (defvar c-font-lock-keywords c-font-lock-keywords-1 | 764 (defvar c-font-lock-keywords c-font-lock-keywords-1 |
616 "Additional expressions to highlight in C mode.") | 765 "Additional expressions to highlight in C mode.") |
617 | 766 |
618 (defvar c++-font-lock-keywords c++-font-lock-keywords-1 | 767 (defvar c++-font-lock-keywords c++-font-lock-keywords-1 |
619 "Additional expressions to highlight in C++ mode.") | 768 "Additional expressions to highlight in C++ mode.") |
620 | |
621 | |
622 (defvar perl-font-lock-keywords | |
623 (list | |
624 (cons (concat "[ \n\t{]*\\(" | |
625 (mapconcat 'identity | |
626 '("if" "until" "while" "elsif" "else" "unless" "for" | |
627 "foreach" "continue" "exit" "die" "last" "goto" "next" | |
628 "redo" "return" "local" "exec") | |
629 "\\|") | |
630 "\\)[ \n\t;(]") 1) | |
631 (mapconcat 'identity | |
632 '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" | |
633 "#define" "#undef") | |
634 "\\|") | |
635 '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) | |
636 '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) | |
637 '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face) | |
638 ) | |
639 "Additional expressions to highlight in Perl mode.") | |
640 | 769 |
641 (defvar tex-font-lock-keywords | 770 (defvar tex-font-lock-keywords |
642 (list | 771 (list |
643 '("\\(\\\\\\([a-zA-Z@]+\\|.\\)\\)" 1 font-lock-keyword-face t) | 772 '("\\(\\\\\\([a-zA-Z@]+\\|.\\)\\)" 1 font-lock-keyword-face t) |
644 '("{\\\\em\\([^}]+\\)}" 1 font-lock-comment-face t) | 773 '("{\\\\em\\([^}]+\\)}" 1 font-lock-comment-face t) |
649 '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) | 778 '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) |
650 ; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) | 779 ; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) |
651 ) | 780 ) |
652 "Additional expressions to highlight in TeX mode.") | 781 "Additional expressions to highlight in TeX mode.") |
653 | 782 |
654 (defvar texi-font-lock-keywords | 783 ;; There is no html-mode.el shipped with Emacs... Yet. |
655 (list | 784 ;(defvar html-font-lock-keywords |
656 "@\\(@\\|[^}\t \n{]+\\)" ;commands | 785 ; '(("<!--[^>]*>" 0 font-lock-comment-face t) ; Comment. |
657 '("^\\(@c\\|@comment\\)[ \t].*$" . font-lock-comment-face) ;comments | 786 ; ("</?\\sw+" . font-lock-type-face) ; Normal tag start. |
658 '("^\\(*.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items | 787 ; (">" . font-lock-type-face) ; Normal tag end. |
659 '("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face t) | 788 ; ("<\\(/?\\(a\\|form\\|img\\|input\\)\\)\\>" ; Special tag name. |
660 '("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face t) | 789 ; 1 font-lock-function-name-face t) |
661 '("@\\(samp\\|code\\|var\\){\\([^}]+\\)" 2 font-lock-function-name-face t) | 790 ; ("\\<\\(\\sw+\\)[>=]" 1 font-lock-keyword-face)) ; Tag attribute. |
662 '("@\\(xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-keyword-face t) | 791 ; "Additional expressions to highlight in HTML mode.") |
663 '("@end *\\([a-zA-Z0-9]+\\)[ \t]*$" 1 font-lock-function-name-face t) | 792 |
664 '("@item \\(.*\\)$" 1 font-lock-function-name-face t) | 793 (defvar font-lock-defaults-alist |
665 '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) | 794 '((bibtex-mode . (tex-font-lock-keywords)) |
666 ) | 795 (c++-c-mode . (c-font-lock-keywords)) |
667 "Additional expressions to highlight in TeXinfo mode.") | 796 (c++-mode . (c++-font-lock-keywords)) |
668 | 797 (c-mode . (c-font-lock-keywords)) |
669 (defvar shell-font-lock-keywords | 798 (emacs-lisp-mode . (lisp-font-lock-keywords)) |
670 (list (cons shell-prompt-pattern 'font-lock-keyword-face) | 799 (html-mode . (html-font-lock-keywords)) |
671 '("[ \t]\\([+-][^ \t\n]+\\)" 1 font-lock-comment-face) | 800 (latex-mode . (tex-font-lock-keywords)) |
672 '("^[^ \t]+:.*$" . font-lock-string-face) | 801 (lisp-mode . (lisp-font-lock-keywords)) |
673 '("^\\[[1-9][0-9]*\\]" . font-lock-string-face)) | 802 (plain-tex-mode . (tex-font-lock-keywords)) |
674 "Additional expressions to highlight in Shell mode.") | 803 (slitex-mode . (tex-font-lock-keywords)) |
675 | 804 (tex-mode . (tex-font-lock-keywords))) |
676 (defvar dired-font-lock-keywords | 805 "*Alist of major mode and Font Lock defaults. |
677 '(;; Put directory headers in italics. | 806 Each item should be a cons pair of the form: |
678 ("^ \\(/.+\\)$" 1 font-lock-type-face) | 807 (MAJOR-MODE . (FONT-LOCK-KEYWORDS NOT-SYNTACTICALLY CASE-FOLD) |
679 ;; Put symlinks in bold italics. | 808 where both MAJOR-MODE and FONT-LOCK-KEYWORDS are symbols. If NOT-SYNTACTICALLY |
680 ("\\([^ ]+\\) -> [^ ]+$" . font-lock-function-name-face) | 809 is non-nil, syntactic fontification (strings and comments) is not performed. |
681 ;; Put marks in bold. | 810 If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying.") |
682 ("^\\([^ ]\\).*$" 1 font-lock-keyword-face t) | |
683 ;; Put files that are subdirectories in bold. | |
684 ("^..d.* \\([^ ]+\\)$" 1 font-lock-keyword-face)) | |
685 "Additional expressions to highlight in Dired mode.") | |
686 | |
687 (defvar rmail-font-lock-keywords | |
688 '(;; Put From field in bold. | |
689 ("^From: \\(.*\\)$" 1 font-lock-keyword-face) | |
690 ;; Put subject in bold italics | |
691 ("^Subject: \\(.*\\)$" 1 font-lock-function-name-face)) | |
692 "Additional expressions to highlight in Rmail mode.") | |
693 | |
694 (defvar rmail-summary-font-lock-keywords | |
695 '(("^\\s *[0-9]+D.*$" . font-lock-doc-string-face) | |
696 ("^\\s *[0-9]+-.*$" . font-lock-keyword-face)) | |
697 "Additional expressions to highlight in Rmail Summary mode.") | |
698 | |
699 (defvar compilation-mode-font-lock-keywords | |
700 '(("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 1 font-lock-function-name-face)) | |
701 ;;; ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep) | |
702 "Additional expressions to highlight in Compilation mode.") | |
703 | 811 |
704 (defun font-lock-set-defaults () | 812 (defun font-lock-set-defaults () |
705 "Set `font-lock-keywords' to something appropriate for this mode." | 813 "Set fontification defaults appropriately for this mode. |
706 (if (memq major-mode '(rmail-mode dired-mode compilation-mode shell-mode)) | 814 Sets `font-lock-keywords', `font-lock-keywords-case-fold-search' and |
707 (setq font-lock-no-comments t)) | 815 `font-lock-no-comments' using `font-lock-defaults-alist'. |
708 (if (not font-lock-keywords) ; if not already set. | 816 Also sets `font-lock-syntax-table' for C and C++ modes." |
709 (setq font-lock-keywords | 817 (let ((defaults (cdr (assq major-mode font-lock-defaults-alist)))) |
710 (cond ((eq major-mode 'lisp-mode) lisp-font-lock-keywords) | 818 ;; Keywords? |
711 ((eq major-mode 'emacs-lisp-mode) lisp-font-lock-keywords) | 819 (if (not font-lock-keywords) ; if not already set. |
712 ((eq major-mode 'c-mode) | 820 (setq font-lock-keywords (eval (nth 0 defaults)))) |
713 (make-local-variable 'font-lock-syntax-table) | 821 ;; Syntactic? |
714 (setq font-lock-syntax-table | 822 (if (nth 1 defaults) |
715 (copy-syntax-table (syntax-table))) | 823 (set (make-local-variable 'font-lock-no-comments) t)) |
716 (modify-syntax-entry ?_ "w" font-lock-syntax-table) | 824 ;; Case fold? |
717 c-font-lock-keywords) | 825 (if (nth 2 defaults) |
718 ((eq major-mode 'c++-c-mode) | 826 (set (make-local-variable 'font-lock-keywords-case-fold-search) t)) |
719 (make-local-variable 'font-lock-syntax-table) | 827 ;; Syntax table? |
720 (setq font-lock-syntax-table | 828 (cond ((eq major-mode 'c-mode) |
721 (copy-syntax-table (syntax-table))) | 829 (make-local-variable 'font-lock-syntax-table) |
722 (modify-syntax-entry ?_ "w" font-lock-syntax-table) | 830 (setq font-lock-syntax-table (copy-syntax-table (syntax-table))) |
723 c-font-lock-keywords) | 831 (modify-syntax-entry ?_ "w" font-lock-syntax-table)) |
724 ((eq major-mode 'c++-mode) c++-font-lock-keywords) | 832 ((eq major-mode 'c++-c-mode) |
725 ((eq major-mode 'perl-mode) perl-font-lock-keywords) | 833 (make-local-variable 'font-lock-syntax-table) |
726 ((eq major-mode 'plain-tex-mode) tex-font-lock-keywords) | 834 (setq font-lock-syntax-table (copy-syntax-table (syntax-table))) |
727 ((eq major-mode 'latex-mode) tex-font-lock-keywords) | 835 (modify-syntax-entry ?_ "w" font-lock-syntax-table))))) |
728 ((eq major-mode 'slitex-mode) tex-font-lock-keywords) | 836 |
729 ((eq major-mode 'texinfo-mode) texi-font-lock-keywords) | 837 ;; Install ourselves: |
730 ((eq major-mode 'shell-mode) shell-font-lock-keywords) | 838 |
731 ((eq major-mode 'dired-mode) dired-font-lock-keywords) | 839 (mapcar 'font-lock-make-face font-lock-face-attributes) |
732 ((eq major-mode 'rmail-mode) rmail-font-lock-keywords) | 840 |
733 ((eq major-mode 'rmail-summary-mode) | 841 (or (assq 'font-lock-mode minor-mode-alist) |
734 rmail-summary-font-lock-keywords) | 842 (setq minor-mode-alist (cons '(font-lock-mode " Font") minor-mode-alist))) |
735 ((eq major-mode 'compilation-mode) | 843 |
736 compilation-mode-font-lock-keywords) | 844 ;; Provide ourselves: |
737 (t nil))))) | |
738 | 845 |
739 (provide 'font-lock) | 846 (provide 'font-lock) |
740 | 847 |
741 ;;; font-lock.el ends here | 848 ;;; font-lock.el ends here |