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