XEmacs 21.2.45 "Thelxepeia".
[chise/xemacs-chise.git.1] / lisp / font-lock.el
1 ;;; font-lock.el --- decorating source files with fonts/colors based on syntax
2
3 ;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Amdahl Corporation.
5 ;; Copyright (C) 1996, 2000 Ben Wing.
6
7 ;; Author: Jamie Zawinski <jwz@jwz.org>, for the LISPM Preservation Society.
8 ;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
9 ;; Then (partially) synched with FSF 19.30, leading to:
10 ;; Next Author: RMS
11 ;; Next Author: Simon Marshall <simon@gnu.ai.mit.edu>
12 ;; Latest XEmacs Author: Ben Wing
13 ;; Maintainer: XEmacs Development Team
14 ;; Keywords: languages, faces
15
16 ;; This file is part of XEmacs.
17
18 ;; XEmacs is free software; you can redistribute it and/or modify it
19 ;; under the terms of the GNU General Public License as published by
20 ;; the Free Software Foundation; either version 2, or (at your option)
21 ;; any later version.
22
23 ;; XEmacs is distributed in the hope that it will be useful, but
24 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
26 ;; General Public License for more details.
27
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with XEmacs; see the file COPYING.  If not, write to the 
30 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
31 ;; Boston, MA 02111-1307, USA.
32
33 ;;; Synched up with: FSF 19.30 except for the code to initialize the faces.
34
35 ;;; Commentary:
36
37 ;; Font-lock-mode is a minor mode that causes your comments to be
38 ;; displayed in one face, strings in another, reserved words in another,
39 ;; documentation strings in another, and so on.
40 ;;
41 ;; Comments will be displayed in `font-lock-comment-face'.
42 ;; Strings will be displayed in `font-lock-string-face'.
43 ;; Doc strings will be displayed in `font-lock-doc-string-face'.
44 ;; Function and variable names (in their defining forms) will be
45 ;;  displayed in `font-lock-function-name-face'.
46 ;; Reserved words will be displayed in `font-lock-keyword-face'.
47 ;;
48 ;; Don't let the name fool you: you can highlight things using different
49 ;; colors or background stipples instead of fonts, though that is not the
50 ;; default.  See the variables `font-lock-use-colors' and
51 ;; `font-lock-use-fonts' for broad control over this, or see the
52 ;; documentation on faces and how to change their attributes for
53 ;; fine-grained control.
54 ;;
55 ;; To make the text you type be fontified, use M-x font-lock-mode.  When
56 ;; this minor mode is on, the fonts of the current line will be updated
57 ;; with every insertion or deletion.
58 ;;
59 ;; By default, font-lock will automatically put newly loaded files
60 ;; into font-lock-mode if it knows about the file's mode.  See the
61 ;; variables `font-lock-auto-fontify', `font-lock-mode-enable-list',
62 ;; and `font-lock-mode-disable-list' for control over this.
63 ;;
64 ;; The `font-lock-keywords' variable defines other patterns to highlight.
65 ;; The default font-lock-mode-hook sets it to the value of the variables
66 ;; lisp-font-lock-keywords, c-font-lock-keywords, etc, as appropriate.
67 ;; The easiest way to change the highlighting patterns is to change the
68 ;; values of c-font-lock-keywords and related variables.  See the doc
69 ;; string of the variable `font-lock-keywords' for the appropriate syntax.
70 ;;
71 ;; The default value for `lisp-font-lock-keywords' is the value of the variable
72 ;; `lisp-font-lock-keywords-1'.  You may like `lisp-font-lock-keywords-2' 
73 ;; better; it highlights many more words, but is slower and makes your buffers
74 ;; be very visually noisy.
75 ;;
76 ;; The same is true of `c-font-lock-keywords-1' and `c-font-lock-keywords-2';
77 ;; the former is subdued, the latter is loud.
78 ;;
79 ;; You can make font-lock default to the gaudier variety of keyword
80 ;; highlighting by setting the variable `font-lock-maximum-decoration'
81 ;; before loading font-lock, or by calling the functions
82 ;; `font-lock-use-default-maximal-decoration' or
83 ;; `font-lock-use-default-minimal-decoration'.
84 ;;
85 ;; On a Sparc10, the initial fontification takes about 6 seconds for a typical
86 ;; 140k file of C code, using the default configuration.  The actual speed
87 ;; depends heavily on the type of code in the file, and how many non-syntactic
88 ;; patterns match; for example, Xlib.h takes 23 seconds for 101k, because many
89 ;; patterns match in it.  You can speed this up substantially by removing some
90 ;; of the patterns that are highlighted by default.  Fontifying lisp code is
91 ;; significantly faster, because lisp has a more regular syntax than C, so the
92 ;; regular expressions don't have to be as complicated.
93 ;;
94 ;; It's called font-lock-mode here because on the Lispms it was called
95 ;; "Electric Font Lock Mode."  It was called that because there was an older
96 ;; mode called "Electric Caps Lock Mode" which had the function of causing all
97 ;; of your source code to be in upper case except for strings and comments,
98 ;; without you having to blip the caps lock key by hand all the time (thus the
99 ;; "electric", as in `electric-c-brace'.)
100
101 ;; See also the related packages `fast-lock' and `lazy-lock'.  Both
102 ;; attempt to speed up the initial fontification.  `fast-lock' saves
103 ;; the fontification info when you exit Emacs and reloads it next time
104 ;; you load the file, so that the file doesn't have to be fontified
105 ;; again.  `lazy-lock' does "lazy" fontification -- i.e. it only
106 ;; fontifies the text as it becomes visible rather than fontifying
107 ;; the whole file when it's first loaded in.
108
109 ;; Further comments from the FSF:
110
111 ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo"
112 ;; are made thusly: (regexp-opt '("foo" "fu" "fubar" "bar" "barlo" "lo")) for
113 ;; efficiency.
114
115 ;; What is fontification for?  You might say, "It's to make my code look nice."
116 ;; I think it should be for adding information in the form of cues.  These cues
117 ;; should provide you with enough information to both (a) distinguish between
118 ;; different items, and (b) identify the item meanings, without having to read
119 ;; the items and think about it.  Therefore, fontification allows you to think
120 ;; less about, say, the structure of code, and more about, say, why the code
121 ;; doesn't work.  Or maybe it allows you to think less and drift off to sleep.
122 ;;
123 ;; So, here are my opinions/advice/guidelines:
124 ;; 
125 ;; - Use the same face for the same conceptual object, across all modes.
126 ;;   i.e., (b) above, all modes that have items that can be thought of as, say,
127 ;;   keywords, should be highlighted with the same face, etc.
128 ;; - Keep the faces distinct from each other as far as possible.
129 ;;   i.e., (a) above.
130 ;; - Make the face attributes fit the concept as far as possible.
131 ;;   i.e., function names might be a bold color such as blue, comments might
132 ;;   be a bright color such as red, character strings might be brown, because,
133 ;;   err, strings are brown (that was not the reason, please believe me).
134 ;; - Don't use a non-nil OVERRIDE unless you have a good reason.
135 ;;   Only use OVERRIDE for special things that are easy to define, such as the
136 ;;   way `...' quotes are treated in strings and comments in Emacs Lisp mode.
137 ;;   Don't use it to, say, highlight keywords in commented out code or strings.
138 ;; - Err, that's it.
139
140 \f
141 ;;; Code:
142
143 (require 'fontl-hooks)
144
145 ;;;;;;;;;;;;;;;;;;;;;;      user variables       ;;;;;;;;;;;;;;;;;;;;;;
146
147 (defgroup font-lock nil
148   "Decorate source files with fonts/colors based on syntax.
149 Font-lock-mode is a minor mode that causes your comments to be
150 displayed in one face, strings in another, reserved words in another,
151 documentation strings in another, and so on.
152
153 Comments will be displayed in `font-lock-comment-face'.
154 Strings will be displayed in `font-lock-string-face'.
155 Doc strings will be displayed in `font-lock-doc-string-face'.
156 Function and variable names (in their defining forms) will be displayed
157  in `font-lock-function-name-face'.
158 Reserved words will be displayed in `font-lock-keyword-face'.
159 Preprocessor conditionals will be displayed in `font-lock-preprocessor-face'."
160   :group 'languages)
161
162 (defgroup font-lock-faces nil
163   "Faces used by the font-lock package."
164   :group 'font-lock
165   :group 'faces)
166
167
168 (defcustom font-lock-verbose t
169   "*If non-nil, means show status messages when fontifying.
170 See also `font-lock-message-threshold'."
171   :type 'boolean
172   :group 'font-lock)
173
174 (defcustom font-lock-message-threshold 6000
175   "*Minimum size of region being fontified for status messages to appear.
176
177 The size is measured in characters.  This affects `font-lock-fontify-region'
178 but not `font-lock-fontify-buffer'. (In other words, when you first visit
179 a file and it gets fontified, you will see status messages no matter what
180 size the file is.  However, if you do something else like paste a
181 chunk of text, you will see status messages only if the changed region is
182 large enough.)
183
184 Note that setting `font-lock-verbose' to nil disables the status
185 messages entirely."
186   :type 'integer
187   :group 'font-lock)
188
189 ;;;###autoload
190 (defcustom font-lock-auto-fontify t
191   "*Whether font-lock should automatically fontify files as they're loaded.
192 This will only happen if font-lock has fontifying keywords for the major
193 mode of the file.  You can get finer-grained control over auto-fontification
194 by using this variable in combination with `font-lock-mode-enable-list' or
195 `font-lock-mode-disable-list'."
196   :type 'boolean
197   :group 'font-lock)
198
199 ;;;###autoload
200 (defcustom font-lock-mode-enable-list nil
201   "*List of modes to auto-fontify, if `font-lock-auto-fontify' is nil."
202   :type '(repeat (symbol :tag "Mode"))
203   :group 'font-lock)
204
205 ;;;###autoload
206 (defcustom font-lock-mode-disable-list nil
207   "*List of modes not to auto-fontify, if `font-lock-auto-fontify' is t."
208   :type '(repeat (symbol :tag "Mode"))
209   :group 'font-lock)
210
211 ;;;###autoload
212 (defcustom font-lock-use-colors '(color)
213   "*Specification for when Font Lock will set up color defaults.
214 Normally this should be '(color), meaning that Font Lock will set up
215 color defaults that are only used on color displays.  Set this to nil
216 if you don't want Font Lock to set up color defaults at all.  This
217 should be one of
218
219 -- a list of valid tags, meaning that the color defaults will be used
220    when all of the tags apply. (e.g. '(color x))
221 -- a list whose first element is 'or and whose remaining elements are
222    lists of valid tags, meaning that the defaults will be used when
223    any of the tag lists apply.
224 -- nil, meaning that the defaults should not be set up at all.
225
226 \(If you specify face values in your init file, they will override any
227 that Font Lock specifies, regardless of whether you specify the face
228 values before or after loading Font Lock.)
229
230 See also `font-lock-use-fonts'.  If you want more control over the faces
231 used for fontification, see the documentation of `font-lock-mode' for
232 how to do it."
233   ;; Hard to do right.
234   :type 'sexp
235   :group 'font-lock)
236
237 ;;;###autoload
238 (defcustom font-lock-use-fonts '(or (mono) (grayscale))
239   "*Specification for when Font Lock will set up non-color defaults.
240
241 Normally this should be '(or (mono) (grayscale)), meaning that Font
242 Lock will set up non-color defaults that are only used on either mono
243 or grayscale displays.  Set this to nil if you don't want Font Lock to
244 set up non-color defaults at all.  This should be one of
245
246 -- a list of valid tags, meaning that the non-color defaults will be used
247    when all of the tags apply. (e.g. '(grayscale x))
248 -- a list whose first element is 'or and whose remaining elements are
249    lists of valid tags, meaning that the defaults will be used when
250    any of the tag lists apply.
251 -- nil, meaning that the defaults should not be set up at all.
252
253 \(If you specify face values in your init file, they will override any
254 that Font Lock specifies, regardless of whether you specify the face
255 values before or after loading Font Lock.)
256
257 See also `font-lock-use-colors'.  If you want more control over the faces
258 used for fontification, see the documentation of `font-lock-mode' for
259 how to do it."
260   :type 'sexp
261   :group 'font-lock)
262
263 ;;;###autoload
264 (defcustom font-lock-maximum-decoration t
265   "*If non-nil, the maximum decoration level for fontifying.
266 If nil, use the minimum decoration (equivalent to level 0).
267 If t, use the maximum decoration available.
268 If a number, use that level of decoration (or if not available the maximum).
269 If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL),
270 where MAJOR-MODE is a symbol or t (meaning the default).  For example:
271  ((c++-mode . 2) (c-mode . t) (t . 1))
272 means use level 2 decoration for buffers in `c++-mode', the maximum decoration
273 available for buffers in `c-mode', and level 1 decoration otherwise."
274   :type '(choice (const :tag "default" nil)
275                  (const :tag "maximum" t)
276                  (integer :tag "level" 1)
277                  (repeat :menu-tag "mode specific" :tag "mode specific"
278                          :value ((t . t))
279                          (cons :tag "Instance"
280                                (radio :tag "Mode"
281                                       (const :tag "all" t)
282                                       (symbol :tag "name"))
283                                (radio :tag "Decoration"
284                                       (const :tag "default" nil)
285                                       (const :tag "maximum" t) 
286                                       (integer :tag "level" 1)))))
287   :group 'font-lock)
288
289 ;;;###autoload
290 (define-obsolete-variable-alias 'font-lock-use-maximal-decoration
291   'font-lock-maximum-decoration)
292
293 ;;;###autoload
294 (defcustom font-lock-maximum-size (* 250 1024)
295   "*If non-nil, the maximum size for buffers for fontifying.
296 Only buffers less than this can be fontified when Font Lock mode is turned on.
297 If nil, means size is irrelevant.
298 If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
299 where MAJOR-MODE is a symbol or t (meaning the default).  For example:
300  ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576))
301 means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one
302 megabyte for buffers in `rmail-mode', and size is irrelevant otherwise."
303   :type '(choice (const :tag "none" nil)
304                  (integer :tag "size")
305                  (repeat :menu-tag "mode specific" :tag "mode specific"
306                          :value ((t . nil))
307                          (cons :tag "Instance"
308                                (radio :tag "Mode"
309                                       (const :tag "all" t)
310                                       (symbol :tag "name"))
311                                (radio :tag "Size"
312                                       (const :tag "none" nil)
313                                       (integer :tag "size")))))
314   :group 'font-lock)
315
316 ;;;###autoload
317 (defcustom font-lock-fontify-string-delimiters nil
318   "*If non-nil, apply font-lock-string-face to string delimiters as well as
319 string text when fontifying."
320   :type 'boolean
321   :group 'font-lock)
322 \f
323 ;; Fontification variables:
324
325 ;;;###autoload
326 (defvar font-lock-keywords nil
327   "A list defining the keywords for `font-lock-mode' to highlight.
328
329  FONT-LOCK-KEYWORDS := List of FONT-LOCK-FORM's.
330
331  FONT-LOCK-FORM     :== MATCHER
332                       | (MATCHER . MATCH)
333                       | (MATCHER . FACE-FORM)
334                       | (MATCHER . HIGHLIGHT)
335                       | (MATCHER HIGHLIGHT ...)
336                       | (eval . FORM)
337
338  MATCHER            :== A string containing a regexp.
339                       | A variable containing a regexp to search for.
340                       | A function to call to make the search.
341                         It is called with one arg, the limit of the search,
342                         and should leave MATCH results in the XEmacs global
343                         match data.
344
345  MATCH              :== An integer match subexpression number from MATCHER.
346
347  FACE-FORM           :== The symbol naming a defined face.
348                       | Expression whos value is the face name to use.  If you
349                         want FACE-FORM to be a symbol that evaluates to a face,
350                         use a form like \"(progn sym)\".
351
352  HIGHLIGHT          :== MATCH-HIGHLIGHT
353                       | MATCH-ANCHORED
354
355  FORM               :== Expression returning a FONT-LOCK-FORM, evaluated when
356                         the FONT-LOCK-FORM is first used in a buffer.  This
357                         feature can be used to provide a FONT-LOCK-FORM that
358                         can only be generated when Font Lock mode is actually
359                         turned on.
360
361  MATCH-HIGHLIGHT    :== (MATCH FACE-FORM OVERRIDE LAXMATCH)
362
363  OVERRIDE           :== t        - overwrite existing fontification
364                       | 'keep    - only parts not already fontified are
365                                    highlighted.
366                       | 'prepend - merge faces, this fontification has
367                                    precedence over existing
368                       | 'append  - merge faces, existing fontification has
369                                    precedence over
370                                    this face.
371
372  LAXMATCH           :== If non-nil, no error is signalled if there is no MATCH
373                         in MATCHER.
374
375  MATCH-ANCHORED     :== (ANCHOR-MATCHER PRE-MATCH-FORM \\
376                                           POST-MATCH-FORM MATCH-HIGHLIGHT ...)
377
378  ANCHOR-MATCHER     :== Like a MATCHER, except that the limit of the search
379                         defaults to the end of the line after PRE-MATCH-FORM
380                         is evaluated.  However, if PRE-MATCH-FORM returns a
381                         position greater than the end of the line, that
382                         position is used as the limit of the search.  It is
383                         generally a bad idea to return a position greater than
384                         the end of the line, i.e., cause the ANCHOR-MATCHER
385                         search to span lines.
386
387  PRE-MATCH-FORM     :== Evaluated before the ANCHOR-MATCHER is used, therefore
388                         can be used to initialize before, ANCHOR-MATCHER is
389                         used.  Typically, PRE-MATCH-FORM is used to move to
390                         some position relative to the original MATCHER, before
391                         starting with the ANCHOR-MATCHER.
392
393  POST-MATCH-FORM    :== Like PRE-MATCH-FORM, but used to clean up after the
394                         ANCHOR-MATCHER.  It might be used to move, before
395                         resuming with MATCH-ANCHORED's parent's MATCHER.
396
397 For example, an element of the first form highlights (if not already highlighted):
398
399   \"\\\\\\=<foo\\\\\\=>\"                    Discrete occurrences of \"foo\" in the value
400                                  of the variable `font-lock-keyword-face'.
401
402   (\"fu\\\\(bar\\\\)\" . 1)            Substring \"bar\" within all occurrences of
403                                  \"fubar\" in the value of
404                                  `font-lock-keyword-face'.
405
406   (\"fubar\" . fubar-face)         Occurrences of \"fubar\" in the value of
407                                  `fubar-face'.
408
409   (\"foo\\\\|bar\" 0 foo-bar-face t) Occurrences of either \"foo\" or \"bar\" in the
410                                  value of `foo-bar-face', even if already
411                                  highlighted.
412
413   (fubar-match 1 fubar-face)     The first subexpression within all
414                                  occurrences of whatever the function
415                                  `fubar-match' finds and matches in the value
416                                  of `fubar-face'.
417
418   (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face)))
419    -------------- ---------------  ------------ --- --- -------------
420        |            |               |            |   |          |
421    MATCHER          |         ANCHOR-MATCHER     |   +------+ MATCH-HIGHLIGHT
422              MATCH-HIGHLIGHT                 PRE-MATCH-FORM |
423                                                            POST-MATCH-FORM
424
425   Discrete occurrences of \"anchor\" in the value of `anchor-face', and
426   subsequent discrete occurrences of \"item\" (on the same line) in the value
427   of `item-face'.  (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil.
428   Therefore \"item\" is initially searched for starting from the end of the
429   match of \"anchor\", and searching for subsequent instance of \"anchor\"
430   resumes from where searching for \"item\" concluded.)
431
432 For highlighting single items, typically only MATCH-HIGHLIGHT is required.
433 However, if an item or (typically) several items are to be highlighted
434 following the instance of another item (the anchor) then MATCH-ANCHORED may be
435 required.
436
437 These regular expressions should not match text which spans lines.  While
438 \\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating when you
439 edit the buffer does not, since it considers text one line at a time.
440
441 Be very careful composing regexps for this list; the wrong pattern can
442 dramatically slow things down!
443 ")
444 ;;;###autoload
445 (make-variable-buffer-local 'font-lock-keywords)
446
447 ;;;###autoload
448 (defvar font-lock-syntactic-keywords nil
449   "A list of the syntactic keywords to highlight.
450 Can be the list or the name of a function or variable whose value is the list.
451 See `font-lock-keywords' for a description of the form of this list;
452 the differences are listed below.  MATCH-HIGHLIGHT should be of the form:
453
454  (MATCH SYNTAX OVERRIDE LAXMATCH)
455
456 where SYNTAX can be of the form (SYNTAX-CODE . MATCHING-CHAR), the name of a
457 syntax table, or an expression whose value is such a form or a syntax table.
458 OVERRIDE cannot be `prepend' or `append'.
459
460 For example, an element of the form highlights syntactically:
461
462  (\"\\\\$\\\\(#\\\\)\" 1 (1 . nil))
463
464  a hash character when following a dollar character, with a SYNTAX-CODE of
465  1 (meaning punctuation syntax).  Assuming that the buffer syntax table does
466  specify hash characters to have comment start syntax, the element will only
467  highlight hash characters that do not follow dollar characters as comments
468  syntactically.
469
470  (\"\\\\('\\\\).\\\\('\\\\)\"
471   (1 (7 . ?'))
472   (2 (7 . ?')))
473
474  both single quotes which surround a single character, with a SYNTAX-CODE of
475  7 (meaning string quote syntax) and a MATCHING-CHAR of a single quote (meaning
476  a single quote matches a single quote).  Assuming that the buffer syntax table
477  does not specify single quotes to have quote syntax, the element will only
478  highlight single quotes of the form 'c' as strings syntactically.
479  Other forms, such as foo'bar or 'fubar', will not be highlighted as strings.
480
481 This is normally set via `font-lock-defaults'."
482 )
483 ;;;###autoload
484 (make-variable-buffer-local 'font-lock-syntactic-keywords)
485
486 (defvar font-lock-defaults nil
487   "The defaults font Font Lock mode for the current buffer.
488 Normally, do not set this directly.  If you are writing a major mode,
489 put a property of `font-lock-defaults' on the major-mode symbol with
490 the desired value.
491
492 It should be a list
493
494 \(KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN)
495
496 KEYWORDS may be a symbol (a variable or function whose value is the keywords
497 to use for fontification) or a list of symbols.  If KEYWORDS-ONLY is non-nil,
498 syntactic fontification (strings and comments) is not performed.  If CASE-FOLD
499 is non-nil, the case of the keywords is ignored when fontifying.  If
500 SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form (CHAR
501 . STRING) used to set the local Font Lock syntax table, for keyword and
502 syntactic fontification (see `modify-syntax-entry').
503
504 If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move
505 backwards outside any enclosing syntactic block, for syntactic fontification.
506 Typical values are `beginning-of-line' (i.e., the start of the line is known to
507 be outside a syntactic block), or `beginning-of-defun' for programming modes or
508 `backward-paragraph' for textual modes (i.e., the mode-dependent function is
509 known to move outside a syntactic block).  If nil, the beginning of the buffer
510 is used as a position outside of a syntactic block, in the worst case.
511
512 These item elements are used by Font Lock mode to set the variables
513 `font-lock-keywords', `font-lock-keywords-only',
514 `font-lock-keywords-case-fold-search', `font-lock-syntax-table' and
515 `font-lock-beginning-of-syntax-function', respectively.
516
517 Alternatively, if the value is a symbol, it should name a major mode,
518 and the defaults for that mode will apply.")
519 (make-variable-buffer-local 'font-lock-defaults)
520
521 ;; FSF uses `font-lock-defaults-alist' and expects the major mode to
522 ;; set a value for `font-lock-defaults', but I don't like either of
523 ;; these -- requiring the mode to set `font-lock-defaults' makes it
524 ;; impossible to have defaults for a minor mode, and using an alist is
525 ;; generally a bad idea for information that really should be
526 ;; decentralized. (Who knows what strange modes might want
527 ;; font-locking?)
528
529 (defvar font-lock-keywords-only nil
530   "Non-nil means Font Lock should not do syntactic fontification.
531 This is normally set via `font-lock-defaults'.
532
533 This should be nil for all ``language'' modes, but other modes, like
534 dired, do not have anything useful in the syntax tables (no comment
535 or string delimiters, etc) and so there is no need to use them and
536 this variable should have a value of t.
537
538 You should not set this variable directly; its value is computed
539 from `font-lock-defaults', or (if that does not specify anything)
540 by examining the syntax table to see whether it appears to contain
541 anything useful.")
542 (make-variable-buffer-local 'font-lock-keywords-only)
543
544 (defvar font-lock-keywords-case-fold-search nil
545   "Whether the strings in `font-lock-keywords' should be case-folded.
546 This variable is automatically buffer-local, as the correct value depends
547 on the language in use.")
548 (make-variable-buffer-local 'font-lock-keywords-case-fold-search)
549
550 (defvar font-lock-after-fontify-buffer-hook nil
551   "Function or functions to run after completion of font-lock-fontify-buffer.")
552
553 (defvar font-lock-syntax-table nil
554   "Non-nil means use this syntax table for fontifying.
555 If this is nil, the major mode's syntax table is used.
556 This is normally set via `font-lock-defaults'.")
557 (make-variable-buffer-local 'font-lock-syntax-table)
558
559 ;; These record the parse state at a particular position, always the start of a
560 ;; line.  Used to make `font-lock-fontify-syntactically-region' faster.
561 ;; Previously, `font-lock-cache-position' was just a buffer position.  However,
562 ;; under certain situations, this occasionally resulted in mis-fontification.
563 ;; I think the "situations" were deletion with Lazy Lock mode's deferral.  sm.
564 (defvar font-lock-cache-state nil)
565 (defvar font-lock-cache-position nil)
566 (make-variable-buffer-local 'font-lock-cache-state)
567 (make-variable-buffer-local 'font-lock-cache-position)
568
569 ;; If this is nil, we only use the beginning of the buffer if we can't use
570 ;; `font-lock-cache-position' and `font-lock-cache-state'.
571 (defvar font-lock-beginning-of-syntax-function nil
572   "Non-nil means use this function to move back outside of a syntactic block.
573 If this is nil, the beginning of the buffer is used (in the worst case).
574 This is normally set via `font-lock-defaults'.")
575 (make-variable-buffer-local 'font-lock-beginning-of-syntax-function)
576
577 (defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer
578   "Function to use for fontifying the buffer.
579 This is normally set via `font-lock-defaults'.")
580
581 (defvar font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer
582   "Function to use for unfontifying the buffer.
583 This is used when turning off Font Lock mode.
584 This is normally set via `font-lock-defaults'.")
585
586 (defvar font-lock-fontify-region-function 'font-lock-default-fontify-region
587   "Function to use for fontifying a region.
588 It should take two args, the beginning and end of the region, and an optional
589 third arg VERBOSE.  If non-nil, the function should print status messages.
590 This is normally set via `font-lock-defaults'.")
591
592 (defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region
593   "Function to use for unfontifying a region.
594 It should take two args, the beginning and end of the region.
595 This is normally set via `font-lock-defaults'.")
596
597 (defvar font-lock-inhibit-thing-lock nil
598   "List of Font Lock mode related modes that should not be turned on.
599 Currently, valid mode names as `fast-lock-mode' and `lazy-lock-mode'.
600 This is normally set via `font-lock-defaults'.")
601
602 ;;;###autoload
603 (defcustom font-lock-mode nil ;; customized for the option menu. dverna
604   "Non nil means `font-lock-mode' is on"
605   :group 'font-lock
606   :type 'boolean
607   :initialize 'custom-initialize-default
608   :require 'font-lock
609   :set #'(lambda (var val) (font-lock-mode (or val 0)))
610   )
611
612 (defvar font-lock-fontified nil) ; whether we have hacked this buffer
613 (put 'font-lock-fontified 'permanent-local t)
614
615 ;;;###autoload
616 (defvar font-lock-mode-hook nil
617   "Function or functions to run on entry to font-lock-mode.")
618
619 ; whether font-lock-set-defaults has already been run.
620 (defvar font-lock-defaults-computed nil)
621 (make-variable-buffer-local 'font-lock-defaults-computed)
622
623 \f
624 ;;; Initialization of faces.
625
626 ;; #### barf gag retch.  Horrid FSF lossage that we need to
627 ;; keep around for compatibility with font-lock-keywords that
628 ;; forget to properly quote their faces.  I tried just let-binding
629 ;; them when we eval the face expression, but that failes because
630 ;; some files actually use the variables directly in their init code
631 ;; without quoting them. --ben
632 (defvar font-lock-comment-face 'font-lock-comment-face
633   "This variable should not be set.
634 It is present only for horrid FSF compatibility reasons.
635 The corresponding face should be set using `edit-faces' or the
636 `set-face-*' functions.")
637 (defvar font-lock-doc-string-face 'font-lock-doc-string-face
638   "This variable should not be set.
639 It is present only for horrid FSF compatibility reasons.
640 The corresponding face should be set using `edit-faces' or the
641 `set-face-*' functions.")
642 (defvar font-lock-string-face 'font-lock-string-face
643   "This variable should not be set.
644 It is present only for horrid FSF compatibility reasons.
645 The corresponding face should be set using `edit-faces' or the
646 `set-face-*' functions.")
647 (defvar font-lock-keyword-face 'font-lock-keyword-face
648   "This variable should not be set.
649 It is present only for horrid FSF compatibility reasons.
650 The corresponding face should be set using `edit-faces' or the
651 `set-face-*' functions.")
652 (defvar font-lock-function-name-face 'font-lock-function-name-face
653   "This variable should not be set.
654 It is present only for horrid FSF compatibility reasons.
655 The corresponding face should be set using `edit-faces' or the
656 `set-face-*' functions.")
657 (defvar font-lock-variable-name-face 'font-lock-variable-name-face
658   "This variable should not be set.
659 It is present only for horrid FSF compatibility reasons.
660 The corresponding face should be set using `edit-faces' or the
661 `set-face-*' functions.")
662 (defvar font-lock-type-face 'font-lock-type-face
663   "This variable should not be set.
664 It is present only for horrid FSF compatibility reasons.
665 The corresponding face should be set using `edit-faces' or the
666 `set-face-*' functions.")
667 (defvar font-lock-reference-face 'font-lock-reference-face
668   "This variable should not be set.
669 It is present only for horrid FSF compatibility reasons.
670 The corresponding face should be set using `edit-faces' or the
671 `set-face-*' functions.")
672 (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face
673   "This variable should not be set.
674 It is present only for horrid FSF compatibility reasons.
675 The corresponding face should be set using `edit-faces' or the
676 `set-face-*' functions.")
677
678 (defconst font-lock-face-list
679   '(font-lock-comment-face
680     font-lock-string-face
681     font-lock-doc-string-face
682     font-lock-keyword-face
683     font-lock-function-name-face
684     font-lock-variable-name-face
685     font-lock-type-face
686     font-lock-reference-face
687     font-lock-preprocessor-face
688     font-lock-warning-face))
689
690 (defface font-lock-comment-face
691   '((((class color) (background dark)) (:foreground "gray80"))
692     ;; blue4 is hardly different from black on windows.
693     (((class color) (background light) (type mswindows)) (:foreground "blue"))
694     (((class color) (background light)) (:foreground "blue4"))
695     (((class grayscale) (background light))
696      (:foreground "DimGray" :bold t :italic t))
697     (((class grayscale) (background dark))
698      (:foreground "LightGray" :bold t :italic t))
699     (t (:bold t)))
700   "Font Lock mode face used to highlight comments."
701   :group 'font-lock-faces)
702
703 (defface font-lock-string-face
704   '((((class color) (background dark)) (:foreground "tan"))
705     (((class color) (background light)) (:foreground "green4"))
706     (((class grayscale) (background light)) (:foreground "DimGray" :italic t))
707     (((class grayscale) (background dark)) (:foreground "LightGray" :italic t))
708     (t (:bold t)))
709   "Font Lock mode face used to highlight strings."
710   :group 'font-lock-faces)
711
712 (defface font-lock-doc-string-face
713   '((((class color) (background dark)) (:foreground "light coral"))
714     (((class color) (background light)) (:foreground "green4"))
715     (t (:bold t)))
716   "Font Lock mode face used to highlight documentation strings.
717 This is currently supported only in Lisp-like modes, which are those
718 with \"lisp\" or \"scheme\" in their name.  You can explicitly make
719 a mode Lisp-like by putting a non-nil `font-lock-lisp-like' property
720 on the major mode's symbol."
721   :group 'font-lock-faces)
722
723 (defface font-lock-keyword-face
724   '((((class color) (background dark)) (:foreground "cyan"))
725     ;; red4 is hardly different from black on windows.
726     (((class color) (background light) (type mswindows)) (:foreground "red"))
727     (((class color) (background light)) (:foreground "red4"))
728     (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
729     (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
730     (t (:bold t)))
731   "Font Lock mode face used to highlight keywords."
732   :group 'font-lock-faces)
733
734 (defface font-lock-function-name-face
735   '((((class color) (background dark)) (:foreground "aquamarine"))
736     ;; brown4 is hardly different from black on windows.
737     ;; I changed it to red because IMO it's pointless and ugly to
738     ;; use a million slightly different colors for niggly syntactic
739     ;; differences. --ben
740     (((class color) (background light) (type mswindows)) (:foreground "red"))
741     (((class color) (background light)) (:foreground "brown4"))
742     (t (:bold t :underline t)))
743   "Font Lock mode face used to highlight function names."
744   :group 'font-lock-faces)
745
746 (defface font-lock-variable-name-face
747   '((((class color) (background dark)) (:foreground "cyan3"))
748     (((class color) (background light)) (:foreground "magenta4"))
749     (((class grayscale) (background light))
750      (:foreground "Gray90" :bold t :italic t))
751     (((class grayscale) (background dark))
752      (:foreground "DimGray" :bold t :italic t))
753     (t (:underline t)))
754   "Font Lock mode face used to highlight variable names."
755   :group 'font-lock-faces)
756
757 (defface font-lock-type-face
758   '((((class color) (background dark)) (:foreground "wheat"))
759     (((class color) (background light)) (:foreground "steelblue"))
760     (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
761     (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
762     (t (:bold t)))
763   "Font Lock mode face used to highlight types."
764   :group 'font-lock-faces)
765
766 (defface font-lock-reference-face
767   '((((class color) (background dark)) (:foreground "cadetblue2"))
768     (((class color) (background light)) (:foreground "red3"))
769     (((class grayscale) (background light))
770      (:foreground "LightGray" :bold t :underline t))
771     (((class grayscale) (background dark))
772      (:foreground "Gray50" :bold t :underline t)))
773   "Font Lock mode face used to highlight references."
774   :group 'font-lock-faces)
775
776 ;; #### FSF has font-lock-builtin-face.
777
778 (defface font-lock-preprocessor-face
779   '((((class color) (background dark)) (:foreground "steelblue1"))
780     (((class color) (background light)) (:foreground "blue3"))
781     (t (:underline t)))
782   "Font Lock Mode face used to highlight preprocessor conditionals."
783   :group 'font-lock-faces)
784
785 ;; #### Currently unused
786 (defface font-lock-warning-face
787   '((((class color) (background light)) (:foreground "Red" :bold t))
788     (((class color) (background dark)) (:foreground "Pink" :bold t))
789     (t (:inverse-video t :bold t)))
790   "Font Lock mode face used to highlight warnings."
791   :group 'font-lock-faces)
792
793 (defun font-lock-recompute-variables ()
794   ;; Is this a Draconian thing to do?
795   (mapc #'(lambda (buffer)
796             (with-current-buffer buffer
797               (font-lock-mode 0)
798               (font-lock-set-defaults t)))
799         (buffer-list)))
800
801 ;; Backwards-compatible crud.
802
803 (defun font-lock-reset-all-faces ()
804   (dolist (face font-lock-face-list)
805     (face-spec-set face (get face 'face-defface-spec))))
806
807 (defun font-lock-use-default-fonts ()
808   "Reset the font-lock faces to a default set of fonts."
809   (interactive)
810   ;; #### !!!!
811   (font-lock-reset-all-faces))
812
813 (defun font-lock-use-default-colors ()
814   "Reset the font-lock faces to a default set of colors."
815   (interactive)
816   ;; #### !!!!
817   (font-lock-reset-all-faces))
818
819 (defun font-lock-use-default-minimal-decoration ()
820   "Reset the font-lock patterns to a fast, minimal set of decorations."
821   (and font-lock-maximum-decoration
822        (setq font-lock-maximum-decoration nil)
823        (font-lock-recompute-variables)))
824
825 (defun font-lock-use-default-maximal-decoration ()
826   "Reset the font-lock patterns to a larger set of decorations."
827   (and (not (eq t font-lock-maximum-decoration))
828        (setq font-lock-maximum-decoration t)
829        (font-lock-recompute-variables)))
830
831 \f
832 ;;;;;;;;;;;;;;;;;;;;;;        actual code        ;;;;;;;;;;;;;;;;;;;;;;
833
834 ;;; To fontify the whole buffer by language syntax, we go through it a
835 ;;; character at a time, creating extents on the boundary of each syntactic
836 ;;; unit (that is, one extent for each block comment, one for each line
837 ;;; comment, one for each string, etc.)  This is done with the C function
838 ;;; syntactically-sectionize.  It's in C for speed (the speed of lisp function
839 ;;; calls was a real bottleneck for this task since it involves examining each
840 ;;; character in turn.)
841 ;;;
842 ;;; Then we make a second pass, to fontify the buffer based on other patterns
843 ;;; specified by regexp.  When we find a match for a region of text, we need
844 ;;; to change the fonts on those characters.  This is done with the
845 ;;; put-text-property function, which knows how to efficiently share extents.
846 ;;; Conceptually, we are attaching some particular face to each of the
847 ;;; characters in a range, but the implementation of this involves creating
848 ;;; extents, or resizing existing ones.
849 ;;;
850 ;;; Each time a modification happens to a line, we re-fontify the entire line.
851 ;;; We do this by first removing the extents (text properties) on the line,
852 ;;; and then doing the syntactic and keyword passes again on that line.  (More
853 ;;; generally, each modified region is extended to include the preceding and
854 ;;; following BOL or EOL.)
855 ;;;
856 ;;; This means that, as the user types, we repeatedly go back to the beginning
857 ;;; of the line, doing more work the longer the line gets.  This doesn't cost
858 ;;; much in practice, and if we don't, then we incorrectly fontify things when,
859 ;;; for example, inserting spaces into `intfoo () {}'.
860 ;;;
861
862 \f
863 ;; The user level functions
864
865 ;;;###autoload
866 (defun font-lock-mode (&optional arg)
867   "Toggle Font Lock Mode.
868 With arg, turn font-lock mode on if and only if arg is positive.
869
870 When Font Lock mode is enabled, text is fontified as you type it:
871
872  - Comments are displayed in `font-lock-comment-face';
873  - Strings are displayed in `font-lock-string-face';
874  - Documentation strings (in Lisp-like languages) are displayed in
875    `font-lock-doc-string-face';
876  - Language keywords (\"reserved words\") are displayed in
877    `font-lock-keyword-face';
878  - Function names in their defining form are displayed in
879    `font-lock-function-name-face';
880  - Variable names in their defining form are displayed in
881    `font-lock-variable-name-face';
882  - Type names are displayed in `font-lock-type-face';
883  - References appearing in help files and the like are displayed
884    in `font-lock-reference-face';
885  - Preprocessor declarations are displayed in
886   `font-lock-preprocessor-face';
887
888    and
889
890  - Certain other expressions are displayed in other faces according
891    to the value of the variable `font-lock-keywords'.
892
893 Where modes support different levels of fontification, you can use the variable
894 `font-lock-maximum-decoration' to specify which level you generally prefer.
895 When you turn Font Lock mode on/off the buffer is fontified/defontified, though
896 fontification occurs only if the buffer is less than `font-lock-maximum-size'.
897 To fontify a buffer without turning on Font Lock mode, and regardless of buffer
898 size, you can use \\[font-lock-fontify-buffer].
899
900 See the variable `font-lock-keywords' for customization."
901   (interactive "P")
902   (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode)))
903         (maximum-size (if (not (consp font-lock-maximum-size))
904                           font-lock-maximum-size
905                         (cdr (or (assq major-mode font-lock-maximum-size)
906                                  (assq t font-lock-maximum-size))))))
907     ;; Font-lock mode will refuse to turn itself on if in batch mode, or if
908     ;; the current buffer is "invisible".  The latter is because packages
909     ;; sometimes put their temporary buffers into some particular major mode
910     ;; to get syntax tables and variables and whatnot, but we don't want the
911     ;; fact that the user has font-lock-mode on a mode hook to slow these
912     ;; things down.
913     (if (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
914         (setq on-p nil))
915     (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp...
916         (setq on-p nil))
917     (cond (on-p
918            (make-local-hook 'after-change-functions)
919            (add-hook 'after-change-functions
920                      'font-lock-after-change-function nil t)
921            (add-hook 'pre-idle-hook 'font-lock-pre-idle-hook))
922           (t
923            (remove-hook 'after-change-functions
924                         'font-lock-after-change-function t)
925            (setq font-lock-defaults-computed nil
926                  font-lock-keywords nil)
927            ;; We have no business doing this here, since 
928            ;; pre-idle-hook is global.  Other buffers may
929            ;; still be in font-lock mode.  -dkindred@cs.cmu.edu
930            ;; (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook)
931            ))
932     (set (make-local-variable 'font-lock-mode) on-p)
933     (cond (on-p
934            (font-lock-set-defaults-1)
935            (run-hooks 'font-lock-mode-hook)
936            (cond (font-lock-fontified
937                   nil)
938                  ((or (null maximum-size) (<= (buffer-size) maximum-size))
939                   (font-lock-fontify-buffer))
940                  (font-lock-verbose
941                   (progress-feedback-with-label
942                    'font-lock
943                    "Fontifying %s... buffer too big." 'abort
944                    (buffer-name)))))
945           (font-lock-fontified
946            (setq font-lock-fontified nil)
947            (font-lock-unfontify-region (point-min) (point-max))
948            (font-lock-thing-lock-cleanup))
949           (t
950            (font-lock-thing-lock-cleanup)))
951     (redraw-modeline)))
952
953 ;; For init-file hooks
954 ;;;###autoload
955 (defun turn-on-font-lock ()
956   "Unconditionally turn on Font Lock mode."
957   (interactive)
958   (font-lock-mode 1))
959
960 ;;;###autoload
961 (defun turn-off-font-lock ()
962   "Unconditionally turn off Font Lock mode."
963   (interactive)
964   (font-lock-mode 0))
965
966 ;;; FSF has here:
967
968 ;; support for add-keywords, global-font-lock-mode and
969 ;; font-lock-support-mode (unified support for various *-lock modes).
970
971 \f
972 ;; Fontification functions.
973
974 ;; We first define some defsubsts to encapsulate the way we add
975 ;; faces to a region of text.  I am planning on modifying the
976 ;; text-property mechanism so that multiple independent classes
977 ;; of text properties can exist.  That way, for example, ediff's
978 ;; face text properties don't interfere with font lock's face
979 ;; text properties.  Due to the XEmacs implementation of text
980 ;; properties in terms of extents, doing this is fairly trivial:
981 ;; instead of using the `text-prop' property, you just use a
982 ;; specified property.
983
984 (defsubst font-lock-set-face (start end face)
985   ;; Set the face on the characters in the range.
986   (put-nonduplicable-text-property start end 'face face)
987   (put-nonduplicable-text-property start end 'font-lock t))
988
989 (defsubst font-lock-remove-face (start end)
990   ;; Remove any syntax highlighting on the characters in the range.
991   (put-nonduplicable-text-property start end 'face nil)
992   (put-nonduplicable-text-property start end 'font-lock nil)
993   (if lookup-syntax-properties
994       (put-nonduplicable-text-property start end 'syntax-table nil)))
995
996 (defsubst font-lock-set-syntax (start end syntax)
997   ;; Set the face on the characters in the range.
998   (put-nonduplicable-text-property start end 'syntax-table syntax)
999   (put-nonduplicable-text-property start end 'font-lock t))
1000
1001 (defsubst font-lock-any-faces-p (start end)
1002   ;; Return non-nil if we've put any syntax highlighting on
1003   ;; the characters in the range.
1004   ;;
1005   ;; used to look for 'text-prop property, but this has problems if
1006   ;; you put any other text properties in the vicinity.  Simon
1007   ;; Marshall suggested looking for the 'face property (this is what
1008   ;; FSF Emacs does) but that's equally bogus.  Only reliable way is
1009   ;; for font-lock to specially mark its extents.
1010   ;;
1011   ;; FSF's (equivalent) definition of this defsubst would be
1012   ;; (text-property-not-all start end 'font-lock nil)
1013   ;;
1014   ;; Perhaps our `map-extents' is faster than our definition
1015   ;; of `text-property-not-all'.  #### If so, `text-property-not-all'
1016   ;; should be fixed ...
1017   ;;
1018   (map-extents 'extent-property (current-buffer) start (1- end) 'font-lock))
1019
1020 \f
1021 ;; Fontification functions.
1022
1023 ;; Rather than the function, e.g., `font-lock-fontify-region' containing the
1024 ;; code to fontify a region, the function runs the function whose name is the
1025 ;; value of the variable, e.g., `font-lock-fontify-region-function'.  Normally,
1026 ;; the value of this variable is, e.g., `font-lock-default-fontify-region'
1027 ;; which does contain the code to fontify a region.  However, the value of the
1028 ;; variable could be anything and thus, e.g., `font-lock-fontify-region' could
1029 ;; do anything.  The indirection of the fontification functions gives major
1030 ;; modes the capability of modifying the way font-lock.el fontifies.  Major
1031 ;; modes can modify the values of, e.g., `font-lock-fontify-region-function',
1032 ;; via the variable `font-lock-defaults'.
1033 ;;
1034 ;; For example, Rmail mode sets the variable `font-lock-defaults' so that
1035 ;; font-lock.el uses its own function for buffer fontification.  This function
1036 ;; makes fontification be on a message-by-message basis and so visiting an
1037 ;; RMAIL file is much faster.  A clever implementation of the function might
1038 ;; fontify the headers differently than the message body.  (It should, and
1039 ;; correspondingly for Mail mode, but I can't be bothered to do the work.  Can
1040 ;; you?)  This hints at a more interesting use...
1041 ;;
1042 ;; Languages that contain text normally contained in different major modes
1043 ;; could define their own fontification functions that treat text differently
1044 ;; depending on its context.  For example, Perl mode could arrange that here
1045 ;; docs are fontified differently than Perl code.  Or Yacc mode could fontify
1046 ;; rules one way and C code another.  Neat!
1047 ;;
1048 ;; A further reason to use the fontification indirection feature is when the
1049 ;; default syntactual fontification, or the default fontification in general,
1050 ;; is not flexible enough for a particular major mode.  For example, perhaps
1051 ;; comments are just too hairy for `font-lock-fontify-syntactically-region' to
1052 ;; cope with.  You need to write your own version of that function, e.g.,
1053 ;; `hairy-fontify-syntactically-region', and make your own version of
1054 ;; `hairy-fontify-region' call that function before calling
1055 ;; `font-lock-fontify-keywords-region' for the normal regexp fontification
1056 ;; pass.  And Hairy mode would set `font-lock-defaults' so that font-lock.el
1057 ;; would call your region fontification function instead of its own.  For
1058 ;; example, TeX modes could fontify {\foo ...} and \bar{...}  etc. multi-line
1059 ;; directives correctly and cleanly.  (It is the same problem as fontifying
1060 ;; multi-line strings and comments; regexps are not appropriate for the job.)
1061
1062 ;;;###autoload
1063 (defun font-lock-fontify-buffer ()
1064   "Fontify the current buffer the way `font-lock-mode' would.
1065 See `font-lock-mode' for details.
1066
1067 This can take a while for large buffers."
1068   (interactive)
1069   (let ((font-lock-verbose (or font-lock-verbose (interactive-p))))
1070     (funcall font-lock-fontify-buffer-function)))
1071
1072 (defun font-lock-unfontify-buffer ()
1073   (funcall font-lock-unfontify-buffer-function))
1074
1075 (defun font-lock-fontify-region (beg end &optional loudly)
1076   (funcall font-lock-fontify-region-function beg end loudly))
1077
1078 (defun font-lock-unfontify-region (beg end &optional loudly)
1079   (funcall font-lock-unfontify-region-function beg end loudly))
1080
1081 (defun font-lock-default-fontify-buffer ()
1082   (interactive)
1083   ;; if we don't widen, then the C code will fail to
1084   ;; realize that we're inside a comment.
1085   (save-restriction
1086     (widen)
1087     (let ((was-on font-lock-mode)
1088           (font-lock-verbose (or font-lock-verbose (interactive-p)))
1089           (font-lock-message-threshold 0)
1090           (aborted nil))
1091       ;; Turn it on to run hooks and get the right font-lock-keywords.
1092       (or was-on (font-lock-mode 1))
1093       (font-lock-unfontify-region (point-min) (point-max) t)
1094       ;;    (buffer-syntactic-context-flush-cache)
1095     
1096       ;; If a ^G is typed during fontification, abort the fontification, but
1097       ;; return normally (do not signal.)  This is to make it easy to abort
1098       ;; fontification if it's taking a long time, without also causing the
1099       ;; buffer not to pop up.  If a real abort is desired, the user can ^G
1100       ;; again.
1101       ;;
1102       ;; Possibly this should happen down in font-lock-fontify-region instead
1103       ;; of here, but since that happens from the after-change-hook (meaning
1104       ;; much more frequently) I'm afraid of the bad consequences of stealing
1105       ;; the interrupt character at inopportune times.
1106       ;;
1107       (condition-case nil
1108           (save-excursion
1109             (font-lock-fontify-region (point-min) (point-max)))
1110         (t
1111          (setq aborted t)))
1112
1113       (or was-on                        ; turn it off if it was off.
1114           (let ((font-lock-fontified nil)) ; kludge to prevent defontification
1115             (font-lock-mode 0)))
1116       (set (make-local-variable 'font-lock-fontified) t)
1117       (when (and aborted font-lock-verbose)
1118         (progress-feedback-with-label 'font-lock "Fontifying %s... aborted."
1119                                       'abort (buffer-name))))
1120     (run-hooks 'font-lock-after-fontify-buffer-hook)))
1121
1122 (defun font-lock-default-unfontify-buffer ()
1123   (font-lock-unfontify-region (point-min) (point-max))
1124   (set (make-local-variable 'font-lock-fontified) nil))
1125
1126 ;; This used to be `font-lock-fontify-region', and before that,
1127 ;; `font-lock-fontify-region' used to be the name used for what is now
1128 ;; `font-lock-fontify-syntactically-region'.
1129 (defun font-lock-default-fontify-region (beg end &optional loudly)
1130   (let ((modified (buffer-modified-p))
1131         (buffer-undo-list t) (inhibit-read-only t)
1132         (old-syntax-table (syntax-table))
1133         buffer-file-name buffer-file-truename)
1134     (unwind-protect
1135         (progn
1136           ;; Use the fontification syntax table, if any.
1137           (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
1138           ;; Now do the fontification.
1139           (font-lock-unfontify-region beg end)
1140           (when font-lock-syntactic-keywords
1141             (font-lock-fontify-syntactic-keywords-region beg end))
1142           (unless font-lock-keywords-only
1143             (font-lock-fontify-syntactically-region beg end loudly))
1144           (font-lock-fontify-keywords-region beg end loudly))
1145       ;; Clean up.
1146       (set-syntax-table old-syntax-table)
1147       (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))
1148
1149 ;; The following must be rethought, since keywords can override fontification.
1150 ;      ;; Now scan for keywords, but not if we are inside a comment now.
1151 ;      (or (and (not font-lock-keywords-only)
1152 ;              (let ((state (parse-partial-sexp beg end nil nil 
1153 ;                                               font-lock-cache-state)))
1154 ;                (or (nth 4 state) (nth 7 state))))
1155 ;         (font-lock-fontify-keywords-region beg end))
1156
1157 (defun font-lock-default-unfontify-region (beg end &optional maybe-loudly)
1158   (when (and maybe-loudly font-lock-verbose
1159              (>= (- end beg) font-lock-message-threshold))
1160     (progress-feedback-with-label 'font-lock "Fontifying %s..." 0
1161                                   (buffer-name)))
1162   (let ((modified (buffer-modified-p))
1163         (buffer-undo-list t) (inhibit-read-only t)
1164         buffer-file-name buffer-file-truename)
1165     (font-lock-remove-face beg end)
1166     (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))
1167
1168 ;; Following is the original FSF version (similar to our original
1169 ;; version, before the deferred stuff was added).
1170 ;;
1171 ;; I think that lazy-lock v2 tries to do something similar.
1172 ;; Those efforts should be merged.
1173
1174 ;; Called when any modification is made to buffer text.
1175 ;(defun font-lock-after-change-function (beg end old-len)
1176 ;  (save-excursion
1177 ;    (save-match-data
1178 ;      ;; Rescan between start of line from `beg' and start of line after `end'.
1179 ;      (font-lock-fontify-region
1180 ;       (progn (goto-char beg) (beginning-of-line) (point))
1181 ;       (progn (goto-char end) (forward-line 1) (point))))))
1182
1183 (defvar font-lock-always-fontify-immediately nil
1184   "Set this to non-nil to disable font-lock deferral.
1185 Otherwise, changes to existing text will not be processed until the
1186 next redisplay cycle, avoiding excessive fontification when many
1187 buffer modifications are performed or a buffer is reverted.")
1188
1189 (defvar font-lock-pending-extent-table (make-hash-table :weakness 'key))
1190 (defvar font-lock-range-table (make-range-table))
1191
1192 (defun font-lock-pre-idle-hook ()
1193   (condition-case font-lock-error
1194       (if (> (hash-table-count font-lock-pending-extent-table) 0)
1195           (font-lock-fontify-pending-extents))
1196     (error (warn "Error caught in `font-lock-pre-idle-hook': %s"
1197                  font-lock-error))))
1198
1199 ;;; called when any modification is made to buffer text.  This function
1200 ;;; remembers the changed ranges until the next redisplay, at which point
1201 ;;; the extents are merged and pruned, and the resulting ranges fontified.
1202 ;;; This function could easily be adapted to other after-change-functions.
1203
1204 (defun font-lock-after-change-function (beg end old-len)
1205   (when font-lock-mode
1206     (let ((ex (make-extent beg end)))
1207       (set-extent-property ex 'detachable nil)
1208       (set-extent-property ex 'end-open nil)
1209       (let ((exs (gethash (current-buffer) font-lock-pending-extent-table)))
1210         (push ex exs)
1211         (puthash (current-buffer) exs font-lock-pending-extent-table)))
1212     (if font-lock-always-fontify-immediately
1213         (font-lock-fontify-pending-extents))))
1214
1215 (defun font-lock-fontify-pending-extents ()
1216   ;; ah, the beauty of mapping functions.
1217   ;; this function is actually shorter than the old version, which handled
1218   ;; only one buffer and one contiguous region!
1219   (save-match-data
1220     (maphash
1221      #'(lambda (buffer exs)
1222          ;; remove first, to avoid infinite reprocessing if error
1223          (remhash buffer font-lock-pending-extent-table)
1224          (when (buffer-live-p buffer)
1225            (clear-range-table font-lock-range-table)
1226            (with-current-buffer buffer
1227              (save-excursion
1228                (save-restriction
1229                  ;; if we don't widen, then the C code will fail to
1230                  ;; realize that we're inside a comment.
1231                  (widen)
1232                  (let ((zmacs-region-stays
1233                         zmacs-region-stays)) ; protect from change!
1234                    (mapc
1235                     #'(lambda (ex)
1236                         ;; paranoia.
1237                         (when (and (extent-live-p ex)
1238                                    (not (extent-detached-p ex)))
1239                           ;; first expand the ranges to full lines, because
1240                           ;; that is what will be fontified; then use a
1241                           ;; range table to merge the ranges.
1242                           (let* ((beg (extent-start-position ex))
1243                                  (end (extent-end-position ex))
1244                                  (beg (progn (goto-char beg)
1245                                              (beginning-of-line)
1246                                              (point)))
1247                                  (end (progn (goto-char end)
1248                                              (forward-line 1)
1249                                              (point))))
1250                             (detach-extent ex)
1251                             (put-range-table beg end t
1252                                              font-lock-range-table))))
1253                     exs)
1254                    (map-range-table
1255                     #'(lambda (beg end val)
1256                         ;; Maybe flush the internal cache used by
1257                         ;; syntactically-sectionize.  (It'd be nice if this
1258                         ;; was more automatic.)  Any deletions mean the
1259                         ;; cache is invalid, and insertions at beginning or
1260                         ;; end of line mean that the bol cache might be
1261                         ;; invalid.
1262                         ;; #### This code has been commented out for some time
1263                         ;; now and is bit-rotting.  Someone should look into
1264                         ;; this.
1265 ;;                      (if (or change-was-deletion (bobp)
1266 ;;                              (= (preceding-char) ?\n))
1267 ;;                          (buffer-syntactic-context-flush-cache))
1268                         ;; #### This creates some unnecessary progress gauges.
1269 ;;                      (if (and (= beg (point-min))
1270 ;;                               (= end (point-max)))
1271 ;;                          (font-lock-fontify-buffer)
1272 ;;                        (font-lock-fontify-region beg end)))
1273                         (font-lock-fontify-region beg end))
1274                     font-lock-range-table)))))))
1275      font-lock-pending-extent-table)))
1276 \f
1277 ;; Syntactic fontification functions.
1278
1279 (defun font-lock-lisp-like (mode)
1280   ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is
1281   ;; not enough because the property needs to be able to specify a nil
1282   ;; value.
1283   (if (plist-member (symbol-plist mode) 'font-lock-lisp-like)
1284       (get mode 'font-lock-lisp-like)
1285     ;; If the property is not specified, guess.  Similar logic exists
1286     ;; in add-log, but I think this encompasses more modes.
1287     (string-match "lisp\\|scheme" (symbol-name mode))))
1288
1289 ;; fontify-syntactically-region used to use syntactically-sectionize, which
1290 ;; was supposedly much faster than the FSF version because it was written in
1291 ;; C. However, the FSF version uses parse-partial-sexp, which is also
1292 ;; written in C, and the benchmarking I did showed the
1293 ;; syntactically-sectionize code to be slower overall. So here's the FSF
1294 ;; version, modified to support font-lock-doc-string-face.
1295 ;; -- mct 2000-12-29
1296 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
1297   "Put proper face on each string and comment between START and END.
1298 START should be at the beginning of a line."
1299   (if font-lock-keywords-only
1300       nil
1301
1302     ;; #### Shouldn't this just be using 'loudly??
1303     (when (and font-lock-verbose
1304                (>= (- end start) font-lock-message-threshold))
1305       (progress-feedback-with-label 'font-lock
1306                                     "Fontifying %s... (syntactically)" 5
1307                                     (buffer-name)))
1308     (goto-char start)
1309
1310     (let ((lisp-like (font-lock-lisp-like major-mode))
1311           (cache (marker-position font-lock-cache-position))
1312           state string beg depth)
1313       ;;
1314       ;; Find the state at the `beginning-of-line' before `start'.
1315       (if (eq start cache)
1316           ;; Use the cache for the state of `start'.
1317           (setq state font-lock-cache-state)
1318         ;; Find the state of `start'.
1319         (if (null font-lock-beginning-of-syntax-function)
1320             ;; Use the state at the previous cache position, if any, or
1321             ;; otherwise calculate from `point-min'.
1322             (if (or (null cache) (< start cache))
1323                 (setq state (parse-partial-sexp (point-min) start))
1324               (setq state (parse-partial-sexp cache start nil nil
1325                                               font-lock-cache-state)))
1326           ;; Call the function to move outside any syntactic block.
1327           (funcall font-lock-beginning-of-syntax-function)
1328           (setq state (parse-partial-sexp (point) start)))
1329         ;; Cache the state and position of `start'.
1330         (setq font-lock-cache-state state)
1331         (set-marker font-lock-cache-position start))
1332       ;;
1333       ;; If the region starts inside a string or comment, show the extent of it.
1334       (when (or (nth 3 state) (nth 4 state))
1335         (setq string (nth 3 state) beg (point))
1336         (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
1337         (font-lock-set-face beg (point) (if string 
1338                                             font-lock-string-face
1339                                           font-lock-comment-face)))
1340       ;;
1341       ;; Find each interesting place between here and `end'.
1342       (while (and (< (point) end)
1343                   (progn
1344                     (setq state (parse-partial-sexp (point) end nil nil state
1345                                                     'syntax-table))
1346                     (or (nth 3 state) (nth 4 state))))
1347         (setq depth (nth 0 state) string (nth 3 state) beg (nth 8 state))
1348         (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
1349         (if string
1350             ;; #### It would be nice if we handled Python and other
1351             ;; non-Lisp languages with docstrings correctly.
1352             (let ((face (if (and lisp-like (= depth 1))
1353                             'font-lock-doc-string-face
1354                           'font-lock-string-face)))
1355               (if font-lock-fontify-string-delimiters
1356                   (font-lock-set-face beg (point) face)
1357                 (font-lock-set-face (+ beg 1) (- (point) 1) face)))
1358           (font-lock-set-face beg (point)
1359                               font-lock-comment-face))))))
1360 \f
1361 ;;; Additional text property functions.
1362
1363 ;; The following three text property functions are not generally available (and
1364 ;; it's not certain that they should be) so they are inlined for speed.
1365 ;; The case for `fillin-text-property' is simple; it may or not be generally
1366 ;; useful.  (Since it is used here, it is useful in at least one place.;-)
1367 ;; However, the case for `append-text-property' and `prepend-text-property' is
1368 ;; more complicated.  Should they remove duplicate property values or not?  If
1369 ;; so, should the first or last duplicate item remain?  Or the one that was
1370 ;; added?  In our implementation, the first duplicate remains.
1371
1372 ;; XEmacs: modified all these functions to use
1373 ;; `put-nonduplicable-text-property' instead of `put-text-property', and
1374 ;; the first one to take both SETPROP and MARKPROP, in accordance with the
1375 ;; changed definitions of `font-lock-any-faces-p' and `font-lock-set-face'.
1376
1377 (defsubst font-lock-fillin-text-property (start end setprop markprop value &optional object)
1378   "Fill in one property of the text from START to END.
1379 Arguments PROP and VALUE specify the property and value to put where none are
1380 already in place.  Therefore existing property values are not overwritten.
1381 Optional argument OBJECT is the string or buffer containing the text."
1382   (let ((start (text-property-any start end markprop nil object)) next)
1383     (while start
1384       (setq next (next-single-property-change start markprop object end))
1385       (put-nonduplicable-text-property start next setprop value object)
1386       (put-nonduplicable-text-property start next markprop value object)
1387       (setq start (text-property-any next end markprop nil object)))))
1388
1389 ;; This function (from simon's unique.el) is rewritten and inlined for speed.
1390 ;(defun unique (list function)
1391 ;  "Uniquify LIST, deleting elements using FUNCTION.
1392 ;Return the list with subsequent duplicate items removed by side effects.
1393 ;FUNCTION is called with an element of LIST and a list of elements from LIST,
1394 ;and should return the list of elements with occurrences of the element removed,
1395 ;i.e., a function such as `delete' or `delq'.
1396 ;This function will work even if LIST is unsorted.  See also `uniq'."
1397 ;  (let ((list list))
1398 ;    (while list
1399 ;      (setq list (setcdr list (funcall function (car list) (cdr list))))))
1400 ;  list)
1401
1402 (defsubst font-lock-unique (list)
1403   "Uniquify LIST, deleting elements using `delq'.
1404 Return the list with subsequent duplicate items removed by side effects."
1405   (let ((list list))
1406     (while list
1407       (setq list (setcdr list (delq (car list) (cdr list))))))
1408   list)
1409
1410 ;; A generalisation of `facemenu-add-face' for any property, but without the
1411 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
1412 ;; treatment of `default'.  Uses `unique' to remove duplicate property values.
1413 (defsubst font-lock-prepend-text-property (start end prop value &optional object)
1414   "Prepend to one property of the text from START to END.
1415 Arguments PROP and VALUE specify the property and value to prepend to the value
1416 already in place.  The resulting property values are always lists, and unique.
1417 Optional argument OBJECT is the string or buffer containing the text."
1418   (let ((val (if (listp value) value (list value))) next prev)
1419     (while (/= start end)
1420       (setq next (next-single-property-change start prop object end)
1421             prev (get-text-property start prop object))
1422       (put-text-property
1423        start next prop
1424        (font-lock-unique (append val (if (listp prev) prev (list prev))))
1425        object)
1426       (setq start next))))
1427
1428 (defsubst font-lock-append-text-property (start end prop value &optional object)
1429   "Append to one property of the text from START to END.
1430 Arguments PROP and VALUE specify the property and value to append to the value
1431 already in place.  The resulting property values are always lists, and unique.
1432 Optional argument OBJECT is the string or buffer containing the text."
1433   (let ((val (if (listp value) value (list value))) next prev)
1434     (while (/= start end)
1435       (setq next (next-single-property-change start prop object end)
1436             prev (get-text-property start prop object))
1437       (put-text-property
1438        start next prop
1439        (font-lock-unique (append (if (listp prev) prev (list prev)) val))
1440        object)
1441       (setq start next))))
1442 \f
1443 ;;; Syntactic regexp fontification functions (taken from FSF Emacs 20.7.1)
1444
1445 ;; These syntactic keyword pass functions are identical to those keyword pass
1446 ;; functions below, with the following exceptions; (a) they operate on
1447 ;; `font-lock-syntactic-keywords' of course, (b) they are all `defun' as speed
1448 ;; is less of an issue, (c) eval of property value does not occur JIT as speed
1449 ;; is less of an issue, (d) OVERRIDE cannot be `prepend' or `append' as it
1450 ;; makes no sense for `syntax-table' property values, (e) they do not do it
1451 ;; LOUDLY as it is not likely to be intensive.
1452
1453 (defun font-lock-apply-syntactic-highlight (highlight)
1454   "Apply HIGHLIGHT following a match.
1455  HIGHLIGHT should be of the form MATCH-HIGHLIGHT,
1456  see `font-lock-syntactic-keywords'."
1457   (let* ((match (nth 0 highlight))
1458          (start (match-beginning match)) (end (match-end match))
1459          (value (nth 1 highlight))
1460          (override (nth 2 highlight)))
1461     (unless (numberp (car-safe value))
1462       (setq value (eval value)))
1463     (cond ((not start)
1464            ;; No match but we might not signal an error.
1465            (or (nth 3 highlight)
1466                (error "No match %d in highlight %S" match highlight)))
1467           ((not override)
1468            ;; Cannot override existing fontification.
1469            (or (map-extents 'extent-property (current-buffer)
1470                             start end 'syntax-table)
1471                (font-lock-set-syntax start end value)))
1472           ((eq override t)
1473            ;; Override existing fontification.
1474            (font-lock-set-syntax start end value))
1475           ((eq override 'keep)
1476            ;; Keep existing fontification.
1477            (font-lock-fillin-text-property start end
1478                                            'syntax-table 'font-lock value)))))
1479
1480 (defun font-lock-fontify-syntactic-anchored-keywords (keywords limit)
1481   "Fontify according to KEYWORDS until LIMIT.
1482  KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords',
1483  LIMIT can be modified by the value of its PRE-MATCH-FORM."
1484   (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
1485         ;; Evaluate PRE-MATCH-FORM.
1486         (pre-match-value (eval (nth 1 keywords))))
1487     ;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
1488     (if (and (numberp pre-match-value) (> pre-match-value (point)))
1489         (setq limit pre-match-value)
1490       (save-excursion (end-of-line) (setq limit (point))))
1491     (save-match-data
1492       ;; Find an occurrence of `matcher' before `limit'.
1493       (while (if (stringp matcher)
1494                  (re-search-forward matcher limit t)
1495                (funcall matcher limit))
1496         ;; Apply each highlight to this instance of `matcher'.
1497         (setq highlights lowdarks)
1498         (while highlights
1499           (font-lock-apply-syntactic-highlight (car highlights))
1500           (setq highlights (cdr highlights)))))
1501     ;; Evaluate POST-MATCH-FORM.
1502     (eval (nth 2 keywords))))
1503
1504 (defun font-lock-fontify-syntactic-keywords-region (start end)
1505   "Fontify according to `font-lock-syntactic-keywords' between START and END.
1506 START should be at the beginning of a line."
1507 ;;  ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
1508   (when (symbolp font-lock-syntactic-keywords)
1509     (setq font-lock-syntactic-keywords (font-lock-eval-keywords
1510                                         font-lock-syntactic-keywords)))
1511   ;; If `font-lock-syntactic-keywords' is not compiled, compile it.
1512   (unless (eq (car font-lock-syntactic-keywords) t)
1513     (setq font-lock-syntactic-keywords (font-lock-compile-keywords
1514                                         font-lock-syntactic-keywords)))
1515   ;; Get down to business.
1516   (let ((case-fold-search font-lock-keywords-case-fold-search)
1517         (keywords (cdr font-lock-syntactic-keywords))
1518         keyword matcher highlights)
1519     (while keywords
1520       ;; Find an occurrence of `matcher' from `start' to `end'.
1521       (setq keyword (car keywords) matcher (car keyword))
1522       (goto-char start)
1523       (while (if (stringp matcher)
1524                  (re-search-forward matcher end t)
1525                (funcall matcher end))
1526         ;; Apply each highlight to this instance of `matcher', which may be
1527         ;; specific highlights or more keywords anchored to `matcher'.
1528         (setq highlights (cdr keyword))
1529         (while highlights
1530           (if (numberp (car (car highlights)))
1531               (font-lock-apply-syntactic-highlight (car highlights))
1532             (font-lock-fontify-syntactic-anchored-keywords (car highlights)
1533                                                            end))
1534           (setq highlights (cdr highlights)))
1535         )
1536       (setq keywords (cdr keywords)))))
1537 \f
1538 ;;; Regexp fontification functions.
1539
1540 (defsubst font-lock-apply-highlight (highlight)
1541   "Apply HIGHLIGHT following a match.
1542 HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
1543   (let* ((match (nth 0 highlight))
1544          (start (match-beginning match)) (end (match-end match))
1545          (override (nth 2 highlight)))
1546     (let ((newface (nth 1 highlight)))
1547       (or (symbolp newface)
1548           (setq newface (eval newface)))
1549       (cond ((not start)
1550              ;; No match but we might not signal an error.
1551              (or (nth 3 highlight)
1552                  (error "No match %d in highlight %S" match highlight)))
1553             ((= start end) nil)
1554             ((not override)
1555              ;; Cannot override existing fontification.
1556              (or (font-lock-any-faces-p start end)
1557                  (font-lock-set-face start end newface)))
1558             ((eq override t)
1559              ;; Override existing fontification.
1560              (font-lock-set-face start end newface))
1561             ((eq override 'keep)
1562              ;; Keep existing fontification.
1563              (font-lock-fillin-text-property start end 'face 'font-lock
1564                                              newface))
1565             ((eq override 'prepend)
1566              ;; Prepend to existing fontification.
1567              (font-lock-prepend-text-property start end 'face newface))
1568             ((eq override 'append)
1569              ;; Append to existing fontification.
1570              (font-lock-append-text-property start end 'face newface))))))
1571
1572 (defsubst font-lock-fontify-anchored-keywords (keywords limit)
1573   "Fontify according to KEYWORDS until LIMIT.
1574 KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords',
1575 LIMIT can be modified by the value of its PRE-MATCH-FORM."
1576   (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
1577         ;; Evaluate PRE-MATCH-FORM.
1578         (pre-match-value (eval (nth 1 keywords))))
1579     ;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
1580     (if (and (numberp pre-match-value) (> pre-match-value (point)))
1581         (setq limit pre-match-value)
1582       (save-excursion (end-of-line) (setq limit (point))))
1583     (save-match-data
1584       ;; Find an occurrence of `matcher' before `limit'.
1585       (while (if (stringp matcher)
1586                  (re-search-forward matcher limit t)
1587                (funcall matcher limit))
1588         ;; Apply each highlight to this instance of `matcher'.
1589         (setq highlights lowdarks)
1590         (while highlights
1591           (font-lock-apply-highlight (car highlights))
1592           (setq highlights (cdr highlights)))))
1593     ;; Evaluate POST-MATCH-FORM.
1594     (eval (nth 2 keywords))))
1595
1596 (defun font-lock-fontify-keywords-region (start end &optional loudvar)
1597   "Fontify according to `font-lock-keywords' between START and END.
1598 START should be at the beginning of a line."
1599   (let ((loudly (and font-lock-verbose
1600                      (>= (- end start) font-lock-message-threshold))))
1601     (let* ((case-fold-search font-lock-keywords-case-fold-search)
1602            (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
1603                               font-lock-keywords
1604                             (font-lock-compile-keywords))))
1605            (bufname (buffer-name)) 
1606            (progress 5) (old-progress 5)
1607            (iter 0)
1608            (nkeywords (length keywords))
1609            keyword matcher highlights)
1610       ;;
1611       ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
1612       ;; In order to measure progress accurately we need to know how
1613       ;; many keywords we have and how big the region is. Then progress
1614       ;; is ((pos - start)/ (end - start) * nkeywords 
1615       ;;        + iteration / nkeywords) * 100
1616       (while keywords
1617         ;;
1618         ;; Find an occurrence of `matcher' from `start' to `end'.
1619         (setq keyword (car keywords) matcher (car keyword))
1620         (goto-char start)
1621         (while (and (< (point) end)
1622                     (if (stringp matcher)
1623                         (re-search-forward matcher end t)
1624                       (funcall matcher end)))
1625           ;; calculate progress
1626           (setq progress
1627                 (+ (/ (* (- (point) start) 95) (* (- end start) nkeywords))
1628                    (/ (* iter 95) nkeywords) 5))
1629           (when (and loudly (> progress old-progress))
1630             (progress-feedback-with-label 'font-lock
1631                                           "Fontifying %s... (regexps)"
1632                                           progress bufname))
1633           (setq old-progress progress)
1634           ;; Apply each highlight to this instance of `matcher', which may be
1635           ;; specific highlights or more keywords anchored to `matcher'.
1636           (setq highlights (cdr keyword))
1637           (while highlights
1638             (if (numberp (car (car highlights)))
1639                 (let ((end (match-end (car (car highlights)))))
1640                   (font-lock-apply-highlight (car highlights))
1641                   ;; restart search just after the end of the
1642                   ;; keyword so keywords can share bracketing
1643                   ;; expressions.
1644                   (and end (goto-char end)))
1645               (font-lock-fontify-anchored-keywords (car highlights) end))
1646             (setq highlights (cdr highlights))))
1647         (setq iter (1+ iter))
1648         (setq keywords (cdr keywords))))
1649     (if loudly
1650         (progress-feedback-with-label 'font-lock "Fontifying %s... " 100
1651                                       (buffer-name)))))
1652
1653 \f
1654 ;; Various functions.
1655
1656 ;; Turn off other related packages if they're on.  I prefer a hook. --sm.
1657 ;; These explicit calls are easier to understand
1658 ;; because people know what they will do.
1659 ;; A hook is a mystery because it might do anything whatever. --rms.
1660 (defun font-lock-thing-lock-cleanup ()
1661   (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
1662          (fast-lock-mode -1))
1663         ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
1664          (lazy-lock-mode -1))
1665         ((and (boundp 'lazy-shot-mode) lazy-shot-mode)
1666          (lazy-shot-mode -1))))
1667
1668 ;; Do something special for these packages after fontifying.  I prefer a hook.
1669 (defun font-lock-after-fontify-buffer ()
1670   (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
1671          (fast-lock-after-fontify-buffer))
1672         ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
1673          (lazy-lock-after-fontify-buffer))))
1674
1675 \f
1676 ;; Various functions.
1677
1678 (defun font-lock-compile-keywords (&optional keywords)
1679   ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD
1680   ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string.
1681   (let ((keywords (or keywords font-lock-keywords)))
1682     (setq font-lock-keywords 
1683      (if (eq (car-safe keywords) t)
1684          keywords
1685        (cons t (mapcar 'font-lock-compile-keyword keywords))))))
1686
1687 (defun font-lock-compile-keyword (keyword)
1688   (cond ((nlistp keyword)               ; Just MATCHER
1689          (list keyword '(0 font-lock-keyword-face)))
1690         ((eq (car keyword) 'eval)       ; Specified (eval . FORM)
1691          (font-lock-compile-keyword (eval (cdr keyword))))
1692         ((numberp (cdr keyword))        ; Specified (MATCHER . MATCH)
1693          (list (car keyword) (list (cdr keyword) 'font-lock-keyword-face)))
1694         ((symbolp (cdr keyword))        ; Specified (MATCHER . FACENAME)
1695          (list (car keyword) (list 0 (cdr keyword))))
1696         ((nlistp (nth 1 keyword))       ; Specified (MATCHER . HIGHLIGHT)
1697          (list (car keyword) (cdr keyword)))
1698         (t                              ; Hopefully (MATCHER HIGHLIGHT ...)
1699          keyword)))
1700
1701 (defun font-lock-eval-keywords (keywords)
1702   ;; Evalulate KEYWORDS if a function (funcall) or variable (eval) name.
1703   (if (listp keywords)
1704       keywords
1705     (font-lock-eval-keywords (if (fboundp keywords)
1706                                  (funcall keywords)
1707                                (eval keywords)))))
1708
1709 (defun font-lock-choose-keywords (keywords level)
1710   ;; Return LEVELth element of KEYWORDS.  A LEVEL of nil is equal to a
1711   ;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
1712   (let ((level (if (not (consp level))
1713                    level
1714                  (cdr (or (assq major-mode level) (assq t level))))))
1715     (cond ((symbolp keywords)
1716            keywords)
1717           ((numberp level)
1718            (or (nth level keywords) (car (reverse keywords))))
1719           ((eq level t)
1720            (car (reverse keywords)))
1721           (t
1722            (car keywords)))))
1723
1724 \f
1725 ;;; Determining which set of font-lock keywords to use.
1726
1727 (defun font-lock-find-font-lock-defaults (modesym)
1728   ;; Get the defaults based on the major mode.
1729   (let (raw-defaults)
1730     ;; I want a do-while loop!
1731     (while (progn
1732              (setq raw-defaults (get modesym 'font-lock-defaults))
1733              (and raw-defaults (symbolp raw-defaults)
1734                   (setq modesym raw-defaults)))
1735       )
1736     raw-defaults))
1737
1738 (defun font-lock-examine-syntax-table ()
1739   ; Computes the value of font-lock-keywords-only for this buffer.
1740   (if (eq (syntax-table) (standard-syntax-table))
1741       ;; Assume that modes which haven't bothered to install their own
1742       ;; syntax table don't do anything syntactically interesting.
1743       ;; Really, the standard-syntax-table shouldn't have comments and
1744       ;; strings in it, but changing that now might break things.
1745       nil
1746     ;; else map over the syntax table looking for strings or comments.
1747     (let (got-one)
1748       ;; XEmacs 20.0 ...
1749       (if (fboundp 'map-syntax-table)
1750           (setq got-one
1751                 (map-syntax-table
1752                  #'(lambda (key value)
1753                      (memq (char-syntax-from-code value)
1754                            '(?\" ?\< ?\> ?\$)))
1755                  (syntax-table)))
1756         ;; older Emacsen.
1757         (let ((i (1- (length (syntax-table)))))
1758           (while (>= i 0)
1759             (if (memq (char-syntax i) '(?\" ?\< ?\> ?\$))
1760                 (setq got-one t i 0))
1761             (setq i (1- i)))))
1762       (set (make-local-variable 'font-lock-keywords-only) (not got-one)))))
1763
1764 ;; font-lock-set-defaults is in fontl-hooks.el.
1765
1766 ;;;###autoload
1767 (defun font-lock-set-defaults-1 (&optional explicit-defaults)
1768   ;; does everything that font-lock-set-defaults does except
1769   ;; enable font-lock-mode.  This is called by `font-lock-mode'.
1770   ;; Note that the return value is used!
1771
1772   (if (and font-lock-defaults-computed (not explicit-defaults))
1773       ;; nothing to do.
1774       nil
1775
1776     (or font-lock-keywords
1777         (let* ((defaults (or (and (not (eq t explicit-defaults))
1778                                   explicit-defaults)
1779                              ;; in case modes decide to set
1780                              ;; `font-lock-defaults' themselves,
1781                              ;; as in FSF Emacs.
1782                              font-lock-defaults
1783                              (font-lock-find-font-lock-defaults major-mode)))
1784                (keywords (font-lock-choose-keywords
1785                           (nth 0 defaults) font-lock-maximum-decoration)))
1786
1787           ;; Keywords?
1788           (setq font-lock-keywords (if (fboundp keywords)
1789                                        (funcall keywords)
1790                                      (eval keywords)))
1791           (or font-lock-keywords
1792               ;; older way:
1793               ;; try to look for a variable `foo-mode-font-lock-keywords',
1794               ;; or similar.
1795               (let ((major (symbol-name major-mode))
1796                     (try #'(lambda (n)
1797                              (if (stringp n) (setq n (intern-soft n)))
1798                              (if (and n
1799                                       (boundp n))
1800                                  n
1801                                nil))))
1802                 (setq font-lock-keywords 
1803                       (symbol-value
1804                        (or (funcall try (get major-mode 'font-lock-keywords))
1805                            (funcall try (concat major "-font-lock-keywords"))
1806                            (funcall try (and (string-match "-mode\\'" major)
1807                                              (concat (substring 
1808                                                       major 0 
1809                                                       (match-beginning 0))
1810                                                      "-font-lock-keywords")))
1811                            'font-lock-keywords)))))
1812
1813           ;; Case fold?
1814           (if (>= (length defaults) 3)
1815               (setq font-lock-keywords-case-fold-search (nth 2 defaults))
1816             ;; older way:
1817             ;; look for a property 'font-lock-keywords-case-fold-search on
1818             ;; the major-mode symbol.
1819             (let* ((nonexist (make-symbol ""))
1820                    (value (get major-mode 'font-lock-keywords-case-fold-search
1821                                nonexist)))
1822               (if (not (eq nonexist value))
1823                   (setq font-lock-keywords-case-fold-search value))))
1824
1825           ;; Syntactic?
1826           (if (>= (length defaults) 2)
1827               (setq font-lock-keywords-only (nth 1 defaults))
1828             ;; older way:
1829             ;; cleverly examine the syntax table.
1830             (font-lock-examine-syntax-table))
1831            
1832           ;; Syntax table?
1833           (if (nth 3 defaults)
1834               (let ((slist (nth 3 defaults)))
1835                 (setq font-lock-syntax-table
1836                       (copy-syntax-table (syntax-table)))
1837                 (while slist
1838                   (modify-syntax-entry (car (car slist)) (cdr (car slist))
1839                                        font-lock-syntax-table)
1840                   (setq slist (cdr slist)))))
1841
1842           ;; Syntax function?
1843           (cond (defaults
1844                   (setq font-lock-beginning-of-syntax-function
1845                         (nth 4 defaults)))
1846                 (t
1847                  ;; older way:
1848                  ;; defaults not specified at all, so use `beginning-of-defun'.
1849                  (setq font-lock-beginning-of-syntax-function
1850                        'beginning-of-defun)))))
1851
1852     (setq font-lock-cache-position (make-marker))
1853     (setq font-lock-defaults-computed t)))
1854
1855 \f
1856 ;;;;;;;;;;;;;;;;;;;;;;         keywords         ;;;;;;;;;;;;;;;;;;;;;;
1857
1858 ;;; Various major-mode interfaces.
1859 ;;; Probably these should go in with the source of the respective major modes.
1860
1861 ;; The defaults and keywords listed here should perhaps be moved into
1862 ;; mode-specific files.
1863
1864 ;; For C and Lisp modes we use `beginning-of-defun', rather than nil,
1865 ;; for SYNTAX-BEGIN.  Thus the calculation of the cache is usually
1866 ;; faster but not infallible, so we risk mis-fontification.  --sm.
1867
1868 (put 'c-mode 'font-lock-defaults 
1869      '((c-font-lock-keywords
1870         c-font-lock-keywords-1 c-font-lock-keywords-2 c-font-lock-keywords-3)
1871        nil nil ((?_ . "w")) beginning-of-defun))
1872 (put 'c++-c-mode 'font-lock-defaults 'c-mode)
1873 (put 'elec-c-mode 'font-lock-defaults 'c-mode)
1874
1875 (put 'c++-mode 'font-lock-defaults
1876      '((c++-font-lock-keywords
1877         c++-font-lock-keywords-1 c++-font-lock-keywords-2
1878         c++-font-lock-keywords-3)
1879        nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun))
1880
1881 (put 'java-mode 'font-lock-defaults 
1882      '((java-font-lock-keywords
1883         java-font-lock-keywords-1 java-font-lock-keywords-2
1884         java-font-lock-keywords-3)
1885        nil nil ((?_ . "w")) beginning-of-defun
1886        (font-lock-mark-block-function . mark-defun)))
1887
1888 (put 'lisp-mode 'font-lock-defaults
1889      '((lisp-font-lock-keywords
1890         lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
1891        nil nil
1892        ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w")
1893         (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w")
1894         (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w"))
1895        beginning-of-defun))
1896 (put 'emacs-lisp-mode 'font-lock-defaults 'lisp-mode)
1897 (put 'lisp-interaction-mode 'font-lock-defaults 'lisp-mode)
1898
1899 (put 'scheme-mode 'font-lock-defaults
1900      '(scheme-font-lock-keywords
1901        nil t
1902        ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w")
1903         (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w")
1904         (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w"))
1905        beginning-of-defun))
1906 (put 'inferior-scheme-mode 'font-lock-defaults 'scheme-mode)
1907 (put 'scheme-interaction-mode 'font-lock-defaults 'scheme-mode)
1908
1909 (put 'tex-mode 'font-lock-defaults
1910      ;; For TeX modes we could use `backward-paragraph' for the same reason.
1911      '(tex-font-lock-keywords nil nil ((?$ . "\""))))
1912 ;; the nine billion names of TeX mode...
1913 (put 'bibtex-mode       'font-lock-defaults 'tex-mode)
1914 (put 'plain-tex-mode    'font-lock-defaults 'tex-mode)
1915 (put 'slitex-tex-mode   'font-lock-defaults 'tex-mode)
1916 (put 'SliTeX-mode       'font-lock-defaults 'tex-mode)
1917 (put 'slitex-mode       'font-lock-defaults 'tex-mode)
1918 (put 'latex-tex-mode    'font-lock-defaults 'tex-mode)
1919 (put 'LaTex-tex-mode    'font-lock-defaults 'tex-mode)
1920 (put 'latex-mode        'font-lock-defaults 'tex-mode)
1921 (put 'LaTeX-mode        'font-lock-defaults 'tex-mode)
1922 (put 'japanese-LaTeX-mode 'font-lock-defaults 'tex-mode)
1923 (put 'japanese-SliTeX-mode 'font-lock-defaults 'tex-mode)
1924 (put 'FoilTeX-mode      'font-lock-defaults 'tex-mode)
1925 (put 'LATeX-MoDe        'font-lock-defaults 'tex-mode)
1926 (put 'lATEx-mODe        'font-lock-defaults 'tex-mode)
1927 ;; ok, this is getting a bit silly ...
1928 (put 'eDOm-xETAl        'font-lock-defaults 'tex-mode)
1929
1930 ;;; Various regexp information shared by several modes.
1931 ;;; Information specific to a single mode should go in its load library.
1932
1933 (defconst lisp-font-lock-keywords-1
1934   (list
1935    ;; Anything not a variable or type declaration is fontified as a function.
1936    ;; It would be cleaner to allow preceding whitespace, but it would also be
1937    ;; about five times slower.
1938    (list (concat "^(\\(def\\("
1939                   ;; Variable declarations.
1940                   "\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|var\\|custom\\)\\|"
1941                   ;; Structure declarations.
1942                   "\\(class\\|struct\\|type\\)\\|"
1943                   ;; Everything else is a function declaration.
1944                   "\\([^ \t\n\(\)]+\\)"
1945                   "\\)\\)\\>"
1946                   ;; Any whitespace and declared object.
1947                   "[ \t'\(]*"
1948                   "\\([^ \t\n\)]+\\)?")
1949           '(1 font-lock-keyword-face)
1950           '(8 (cond ((match-beginning 3) 'font-lock-variable-name-face)
1951                     ((match-beginning 6) 'font-lock-type-face)
1952                     (t 'font-lock-function-name-face))
1953               nil t))
1954    )
1955  "Subdued level highlighting Lisp modes.")
1956
1957 (defconst lisp-font-lock-keywords-2
1958   (append lisp-font-lock-keywords-1
1959    (list
1960     ;;
1961     ;; Control structures.  ELisp and CLisp combined.
1962     ;;
1963     (cons
1964      (concat
1965       "(\\("
1966       ;; beginning of generated stuff
1967       ;; to regenerate, use the regexp-opt below, then delete the outermost
1968       ;; grouping, then use the macro below to break up the string.
1969       ;; (regexp-opt
1970       ;;   '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
1971       ;;     "prog2" "progv" "catch" "throw" "save-restriction"
1972       ;;     "save-excursion" "save-window-excursion"
1973       ;;     "save-current-buffer" "with-current-buffer"
1974       ;;     "save-selected-window" "with-selected-window"
1975       ;;     "save-selected-frame" "with-selected-frame"
1976       ;;     "with-temp-file" "with-temp-buffer" "with-output-to-string"
1977       ;;     "with-string-as-buffer-contents"
1978       ;;     "save-match-data" "unwind-protect" "call-with-condition-handler"
1979       ;;     "condition-case" "track-mouse" "autoload"
1980       ;;     "eval-after-load" "eval-and-compile" "eval-when-compile"
1981       ;;     "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
1982       ;;     "lambda" "block" "return" "return-from" "loop") t)
1983       ;; (setq last-kbd-macro
1984       ;;   (read-kbd-macro "\" C-7 C-1 <right> C-r \\\\| 3*<right> \" RET"))
1985       "autoload\\|block\\|c\\(?:a\\(?:ll-with-condition-handler\\|tch\\)\\|"
1986       "ond\\(?:ition-case\\)?\\)\\|do\\(?:list\\|times\\)?\\|"
1987       "eval-\\(?:a\\(?:fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|"
1988       "if\\|l\\(?:a\\(?:bels\\|mbda\\)\\|et\\*?\\|oop\\)\\|prog[12nv]?\\|"
1989       "return\\(?:-from\\)?\\|save-\\(?:current-buffer\\|excursion\\|"
1990       "match-data\\|restriction\\|selected-\\(?:frame\\|window\\)\\|"
1991       "window-excursion\\)\\|t\\(?:hrow\\|rack-mouse\\)\\|un\\(?:less\\|"
1992       "wind-protect\\)\\|w\\(?:h\\(?:en\\|ile\\)\\|ith-\\(?:current-buffer\\|"
1993       "output-to-string\\|s\\(?:elected-\\(?:frame\\|window\\)\\|"
1994       "tring-as-buffer-contents\\)\\|temp-\\(?:buffer\\|file\\)\\)\\)"
1995       ;; end of generated stuff
1996       "\\)\\>") 1)
1997     ;;
1998     ;; Feature symbols as references.
1999     '("(\\(featurep\\|provide\\|require\\)\\>[ \t']*\\(\\sw+\\)?"
2000       (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
2001     ;;
2002     ;; Words inside \\[] tend to be for `substitute-command-keys'.
2003     '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend)
2004     ;;
2005     ;; Words inside `' tend to be symbol names.
2006     '("`\\(\\sw\\sw+\\)'" 1 font-lock-reference-face prepend)
2007     ;;
2008     ;; CLisp `:' keywords as references.
2009     '("\\<:\\sw+\\>" 0 font-lock-reference-face prepend)
2010     ;;
2011     ;; ELisp and CLisp `&' keywords as types.
2012     '("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face)
2013     ))
2014   "Gaudy level highlighting for Lisp modes.")
2015
2016 (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1
2017   "Default expressions to highlight in Lisp modes.")
2018
2019 ;; The previous version, before replacing it with the FSF version.
2020 ;(defconst lisp-font-lock-keywords-1 (purecopy
2021 ; '(;;
2022 ;   ;; highlight defining forms.  This doesn't work too nicely for
2023 ;   ;; (defun (setf foo) ...) but it does work for (defvar foo) which
2024 ;   ;; is more important.
2025 ;   ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face)
2026 ;   ;;
2027 ;   ;; highlight CL keywords (three clauses seems faster than one)
2028 ;   ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1)
2029 ;   ("(:\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1)
2030 ;   ("':\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1)
2031 ;   ;;
2032 ;   ;; this is highlights things like (def* (setf foo) (bar baz)), but may
2033 ;   ;; be slower (I haven't really thought about it)
2034 ;;   ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)"
2035 ;;    1 font-lock-function-name-face)
2036 ;   ))
2037 ; "For consideration as a value of `lisp-font-lock-keywords'.
2038 ;This does fairly subdued highlighting.")
2039 ;
2040 ;(defconst lisp-font-lock-keywords-2 (purecopy
2041 ;  (append lisp-font-lock-keywords-1
2042 ;   '(;;
2043 ;     ;; Highlight control structures
2044 ;     ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1)
2045 ;     ("(\\(while\\|do\\|let\\*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1)
2046 ;     ("(\\(do\\*\\|dotimes\\|dolist\\|loop\\)[ \t\n]" . 1)
2047 ;     ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1)
2048 ;     ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1)
2049 ;     ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1)
2050 ;     ;;
2051 ;     ;; highlight function names in emacs-lisp docstrings (in the syntax
2052 ;     ;; that substitute-command-keys understands.)
2053 ;     ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t)
2054 ;     ;;
2055 ;     ;; highlight words inside `' which tend to be function names
2056 ;     ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'"
2057 ;      1 font-lock-keyword-face t)
2058 ;     )))
2059 ; "For consideration as a value of `lisp-font-lock-keywords'.
2060 ;
2061 ;This does a lot more highlighting.")
2062
2063 (defvar scheme-font-lock-keywords
2064   (eval-when-compile
2065     (list
2066      ;;
2067      ;; Declarations.  Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
2068      ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
2069      (list (concat "(\\(define\\("
2070                    ;; Function names.
2071                    "\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)\\|"
2072                    ;; Macro names, as variable names.  A bit dubious, this.
2073                    "\\(-syntax\\)\\|"
2074                    ;; Class names.
2075                    "\\(-class\\)"
2076                    "\\)\\)\\>"
2077                    ;; Any whitespace and declared object.
2078                    "[ \t]*(?"
2079                    "\\(\\sw+\\)?")
2080            '(1 font-lock-keyword-face)
2081            '(8 (cond ((match-beginning 3) 'font-lock-function-name-face)
2082                      ((match-beginning 6) 'font-lock-variable-name-face)
2083                      (t 'font-lock-type-face))
2084                nil t))
2085      ;;
2086      ;; Control structures.
2087 ;(regexp-opt '("begin" "call-with-current-continuation" "call/cc"
2088 ;              "call-with-input-file" "call-with-output-file" "case" "cond"
2089 ;              "do" "else" "for-each" "if" "lambda"
2090 ;              "let\\*?" "let-syntax" "letrec" "letrec-syntax"
2091 ;              ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
2092 ;              "and" "or" "delay"
2093 ;              ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
2094 ;              ;;"quasiquote" "quote" "unquote" "unquote-splicing"
2095 ;              "map" "syntax" "syntax-rules"))
2096      (cons
2097       (concat "(\\("
2098               "and\\|begin\\|c\\(a\\(ll\\(-with-\\(current-continuation\\|"
2099               "input-file\\|output-file\\)\\|/cc\\)\\|se\\)\\|ond\\)\\|"
2100               "d\\(elay\\|o\\)\\|else\\|for-each\\|if\\|"
2101               "l\\(ambda\\|et\\(-syntax\\|\\*?\\|rec\\(\\|-syntax\\)\\)\\)\\|"
2102               "map\\|or\\|syntax\\(\\|-rules\\)"
2103               "\\)\\>") 1)
2104      ;;
2105      ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
2106      '("\\<<\\sw+>\\>" . font-lock-type-face)
2107      ;;
2108      ;; Scheme `:' keywords as references.
2109      '("\\<:\\sw+\\>" . font-lock-reference-face)
2110      ))
2111 "Default expressions to highlight in Scheme modes.")
2112
2113 ;; The previous version, before replacing it with the FSF version.
2114 ;(defconst scheme-font-lock-keywords (purecopy
2115 ; '(("(define[ \t]+(?\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face)
2116 ;   ("(\\(cond\\|lambda\\|begin\\|if\\|else\\|case\\|do\\)[ \t\n]" . 1)
2117 ;   ("(\\(\\|letrec\\|let\\*?\\|set!\\|and\\|or\\)[ \t\n]" . 1)
2118 ;   ("(\\(quote\\|unquote\\|quasiquote\\|unquote-splicing\\)[ \t\n]" . 1)
2119 ;   ("(\\(syntax\\|syntax-rules\\|define-syntax\\|let-syntax\\|letrec-syntax\\)[ \t\n]" . 1)))
2120 ;  "Expressions to highlight in Scheme buffers.")
2121
2122 (defconst c-font-lock-keywords-1 nil
2123   "Subdued level highlighting for C modes.")
2124
2125 (defconst c-font-lock-keywords-2 nil
2126   "Medium level highlighting for C modes.")
2127
2128 (defconst c-font-lock-keywords-3 nil
2129   "Gaudy level highlighting for C modes.")
2130
2131 (defconst c++-font-lock-keywords-1 nil
2132   "Subdued level highlighting for C++ modes.")
2133
2134 (defconst c++-font-lock-keywords-2 nil
2135   "Medium level highlighting for C++ modes.")
2136
2137 (defconst c++-font-lock-keywords-3 nil
2138   "Gaudy level highlighting for C++ modes.")
2139
2140 (defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit)
2141   ;; Match, and move over, any declaration/definition item after point.
2142   ;; The expect syntax of an item is "word" or "word::word", possibly ending
2143   ;; with optional whitespace and a "(".  Everything following the item (but
2144   ;; belonging to it) is expected to by skip-able by `forward-sexp', and items
2145   ;; are expected to be separated with a "," or ";".
2146   (if (looking-at "[ \t*&]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\(::\\(\\(?:\\sw\\|\\s_\\)+\\)\\)?[ \t]*\\((\\)?")
2147       (save-match-data
2148         (condition-case nil
2149             (save-restriction
2150               ;; Restrict to the end of line, currently guaranteed to be LIMIT.
2151               (narrow-to-region (point-min) limit)
2152               (goto-char (match-end 1))
2153               ;; Move over any item value, etc., to the next item.
2154               (while (not (looking-at "[ \t]*\\([,;]\\|$\\)"))
2155                 (goto-char (or (scan-sexps (point) 1) (point-max))))
2156               (goto-char (match-end 0)))
2157           (error t)))))
2158
2159 (let ((c-keywords
2160 ;      ("break" "continue" "do" "else" "for" "if" "return" "switch" "while")
2161        "break\\|continue\\|do\\|else\\|for\\|if\\|return\\|switch\\|while")
2162       (c-type-types
2163 ;      ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
2164 ;       "signed" "unsigned" "short" "long" "int" "char" "float" "double"
2165 ;       "void" "volatile" "const")
2166        (concat "auto\\|c\\(har\\|onst\\)\\|double\\|e\\(num\\|xtern\\)\\|"
2167                "float\\|int\\|long\\|register\\|"
2168                "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|typedef\\|"
2169                "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)"))   ; 6 ()s deep.
2170       (c++-keywords
2171 ;      ("break" "continue" "do" "else" "for" "if" "return" "switch" "while"
2172 ;       "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try"
2173 ;       "protected" "private" "public" "const_cast" "dynamic_cast" "reinterpret_cast"
2174 ;       "static_cast" "and" "bitor" "or" "xor" "compl" "bitand" "and_eq"
2175 ;       "or_eq" "xor_eq" "not" "not_eq" "typeid" "false" "true")
2176        (concat "a\\(nd\\(\\|_eq\\)\\|sm\\)\\|"
2177                "b\\(it\\(or\\|and\\)\\|reak\\)\\|"
2178                "c\\(atch\\|o\\(mpl\\|n\\(tinue\\|st_cast\\)\\)\\)\\|"
2179                "d\\(elete\\|o\\|ynamic_cast\\)\\|"
2180                "else\\|"
2181                "f\\(alse\\|or\\)\\|if\\|"
2182                "n\\(ew\\|ot\\(\\|_eq\\)\\)\\|"
2183                "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|"
2184                "or\\(\\|_eq\\)\\|"
2185                "re\\(interpret_cast\\|turn\\)\\|"
2186                "s\\(izeof\\|tatic_cast\\|witch\\)\\|"
2187                "t\\(h\\(is\\|row\\)\\|r\\(ue\\|y\\)\\|ypeid\\)\\|"
2188                "xor\\(\\|_eq\\)\\|while"))
2189       (c++-type-types
2190 ;      ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
2191 ;       "signed" "unsigned" "short" "long" "int" "char" "float" "double"
2192 ;       "void" "volatile" "const" "class" "inline" "friend" "bool"
2193 ;       "virtual" "complex" "template" "explicit" "mutable" "export" "namespace"
2194 ;       "using" "typename" "wchar_t")
2195        (concat "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|"
2196                "double\\|"
2197                "e\\(num\\|x\\(p\\(licit\\|ort\\)\\|tern\\)\\)\\|"
2198                "f\\(loat\\|riend\\)\\|"
2199                "in\\(line\\|t\\)\\|long\\|mutable\\|namespace\\|register\\|"
2200                "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|"
2201                "t\\(emplate\\|ype\\(def\\|name\\)\\)\\|"
2202                "u\\(\\(n\\(ion\\|signed\\)\\|sing\\)\\)\\|"
2203                "v\\(irtual\\|o\\(id\\|latile\\)\\)\\|"
2204                "wchar_t"))              ; 11 ()s deep.
2205       (ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+")
2206       )
2207  (setq c-font-lock-keywords-1
2208   (list
2209    ;;
2210    ;; These are all anchored at the beginning of line for speed.
2211    ;;
2212    ;; Fontify function name definitions (GNU style; without type on line).
2213    
2214    ;; In FSF this has the simpler definition of "\\sw+" for ctoken.
2215    ;; I'm not sure if ours is more correct.
2216    ;; This is a subset of the next rule, and is slower when present. --dmoore
2217    ;; (list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face)
2218    ;;
2219    ;; fontify the names of functions being defined.
2220    ;; FSF doesn't have this but I think it should be fast for us because
2221    ;; our regexp routines are more intelligent than FSF's about handling
2222    ;; anchored-at-newline. (When I added this hack in regex.c, it halved
2223    ;; the time to do the regexp phase of font-lock for a C file!) Not
2224    ;; including this discriminates against those who don't follow the
2225    ;; GNU coding style. --ben
2226    ;; x?x?x?y?z should always be: (x(xx?)?)?y?z --dmoore
2227    (list (concat
2228           "^\\("
2229           "\\(" ctoken "[ \t]+\\)"      ; type specs; there can be no
2230           "\\("
2231           "\\(" ctoken "[ \t]+\\)"      ; more than 3 tokens, right?
2232           "\\(" ctoken "[ \t]+\\)"
2233           "?\\)?\\)?"
2234           "\\([*&]+[ \t]*\\)?"          ; pointer
2235           "\\(" ctoken "\\)[ \t]*(")    ; name
2236          10 'font-lock-function-name-face)
2237    ;;
2238    ;; This is faster but not by much.  I don't see why not.
2239    ;(list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face)
2240    ;;
2241    ;; Added next two; they're both jolly-good fastmatch candidates so
2242    ;; should be fast. --ben
2243    ;;
2244    ;; Fontify structure names (in structure definition form).
2245    (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)"
2246            "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)")
2247          2 'font-lock-function-name-face)
2248    ;;
2249    ;; Fontify case clauses.  This is fast because its anchored on the left.
2250    '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)[ \t]+:". 1)
2251    ;;
2252    '("\\<\\(default\\):". 1)
2253    ;; Fontify filenames in #include <...> preprocessor directives as strings.
2254    '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
2255    ;;
2256    ;; Fontify function macro names.
2257    '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face)
2258    ;;
2259    ;; Fontify symbol names in #if ... defined preprocessor directives.
2260    '("^#[ \t]*if\\>"
2261      ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
2262       (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t)))
2263    ;;
2264    ;; Fontify symbol names in #elif ... defined preprocessor directives.
2265    '("^#[ \t]*elif\\>"
2266      ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
2267       (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t)))
2268    ;;
2269    ;; Fontify otherwise as symbol names, and the preprocessor directive names.
2270    '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?"
2271      (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t))
2272    ))
2273
2274  (setq c-font-lock-keywords-2
2275   (append c-font-lock-keywords-1
2276    (list
2277     ;;
2278     ;; Simple regexps for speed.
2279     ;;
2280     ;; Fontify all type specifiers.
2281     (cons (concat "\\<\\(" c-type-types "\\)\\>") 'font-lock-type-face)
2282     ;;
2283     ;; Fontify all builtin keywords (except case, default and goto; see below).
2284     (cons (concat "\\<\\(" c-keywords "\\)\\>") 'font-lock-keyword-face)
2285     ;;
2286     ;; Fontify case/goto keywords and targets, and case default/goto tags.
2287     '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?"
2288       (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
2289     '("^[ \t]*\\(\\sw+\\)[ \t]*:" 1 font-lock-reference-face)
2290     )))
2291
2292  (setq c-font-lock-keywords-3
2293   (append c-font-lock-keywords-2
2294    ;;
2295    ;; More complicated regexps for more complete highlighting for types.
2296    ;; We still have to fontify type specifiers individually, as C is so hairy.
2297    (list
2298     ;;
2299     ;; Fontify all storage classes and type specifiers, plus their items.
2300     (list (concat "\\<\\(" c-type-types "\\)\\>"
2301                   "\\([ \t*&]+\\sw+\\>\\)*")
2302           ;; Fontify each declaration item.
2303           '(font-lock-match-c++-style-declaration-item-and-skip-to-next
2304             ;; Start with point after all type specifiers.
2305             (goto-char (or (match-beginning 8) (match-end 1)))
2306             ;; Finish with point after first type specifier.
2307             (goto-char (match-end 1))
2308             ;; Fontify as a variable or function name.
2309             (1 (if (match-beginning 4)
2310                    font-lock-function-name-face
2311                  font-lock-variable-name-face))))
2312     ;;
2313     ;; Fontify structures, or typedef names, plus their items.
2314     '("\\(}\\)[ \t*]*\\sw"
2315       (font-lock-match-c++-style-declaration-item-and-skip-to-next
2316        (goto-char (match-end 1)) nil
2317        (1 (if (match-beginning 4)
2318               font-lock-function-name-face
2319             font-lock-variable-name-face))))
2320     ;;
2321     ;; Fontify anything at beginning of line as a declaration or definition.
2322     '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
2323       (1 font-lock-type-face)
2324       (font-lock-match-c++-style-declaration-item-and-skip-to-next
2325        (goto-char (or (match-beginning 2) (match-end 1))) nil
2326        (1 (if (match-beginning 4)
2327               font-lock-function-name-face
2328             font-lock-variable-name-face))))
2329     )))
2330
2331  (setq c++-font-lock-keywords-1
2332   (append
2333    ;;
2334    ;; The list `c-font-lock-keywords-1' less that for function names.
2335    ;; the simple function form regexp has been removed. --dmoore
2336    ;;(cdr c-font-lock-keywords-1)
2337    c-font-lock-keywords-1
2338    ;;
2339    ;; Fontify function name definitions, possibly incorporating class name.
2340    (list
2341     '("^\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*("
2342       (1 (if (match-beginning 2)
2343              font-lock-type-face
2344            font-lock-function-name-face))
2345       (3 (if (match-beginning 2) font-lock-function-name-face) nil t))
2346     )))
2347
2348  (setq c++-font-lock-keywords-2
2349   (append c++-font-lock-keywords-1
2350    (list
2351     ;;
2352     ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading.
2353     (cons (concat "\\<\\(" c++-type-types "\\)\\>") 'font-lock-type-face)
2354     ;;
2355     ;; Fontify operator function name overloading.
2356     '("\\<\\(operator\\)\\>[ \t]*\\([][)(><!=+-][][)(><!=+-]?\\)?"
2357       (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
2358     ;;
2359     ;; Fontify case/goto keywords and targets, and case default/goto tags.
2360     '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?"
2361       (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
2362     '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-reference-face)
2363     ;;
2364     ;; Fontify other builtin keywords.
2365     (cons (concat "\\<\\(" c++-keywords "\\)\\>") 'font-lock-keyword-face)
2366     )))
2367
2368  (setq c++-font-lock-keywords-3
2369   (append c++-font-lock-keywords-2
2370    ;;
2371    ;; More complicated regexps for more complete highlighting for types.
2372    (list
2373     ;;
2374     ;; Fontify all storage classes and type specifiers, plus their items.
2375     (list (concat "\\<\\(" c++-type-types "\\)\\>"
2376                   "\\([ \t*&]+\\sw+\\>\\)*")
2377           ;; Fontify each declaration item.
2378           '(font-lock-match-c++-style-declaration-item-and-skip-to-next
2379             ;; Start with point after all type specifiers.
2380             (goto-char (or (match-beginning 13) (match-end 1)))
2381             ;; Finish with point after first type specifier.
2382             (goto-char (match-end 1))
2383             ;; Fontify as a variable or function name.
2384             (1 (cond ((match-beginning 2) 'font-lock-type-face)
2385                      ((match-beginning 4) 'font-lock-function-name-face)
2386                      (t 'font-lock-variable-name-face)))
2387             (3 (if (match-beginning 4)
2388                    'font-lock-function-name-face
2389                  'font-lock-variable-name-face) nil t)))
2390     ;;
2391     ;; Fontify structures, or typedef names, plus their items.
2392     '("\\(}\\)[ \t*]*\\sw"
2393       (font-lock-match-c++-style-declaration-item-and-skip-to-next
2394        (goto-char (match-end 1)) nil
2395        (1 (if (match-beginning 4)
2396               font-lock-function-name-face
2397             font-lock-variable-name-face))))
2398     ;;
2399     ;; Fontify anything at beginning of line as a declaration or definition.
2400     '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
2401       (1 font-lock-type-face)
2402       (font-lock-match-c++-style-declaration-item-and-skip-to-next
2403        (goto-char (or (match-beginning 2) (match-end 1))) nil
2404        (1 (cond ((match-beginning 2) 'font-lock-type-face)
2405                 ((match-beginning 4) 'font-lock-function-name-face)
2406                 (t 'font-lock-variable-name-face)))
2407        (3 (if (match-beginning 4)
2408               'font-lock-function-name-face
2409             'font-lock-variable-name-face) nil t)))
2410     )))
2411  )
2412
2413 (defvar c-font-lock-keywords c-font-lock-keywords-1
2414   "Default expressions to highlight in C mode.")
2415
2416 (defvar c++-font-lock-keywords c++-font-lock-keywords-1
2417   "Default expressions to highlight in C++ mode.")
2418 \f
2419 ;;; Java.
2420
2421 ;; Java support has been written by XEmacs people, and it's apparently
2422 ;; totally divergent from the FSF.  I don't know if it's better or
2423 ;; worse, so I'm leaving it in until someone convinces me the FSF
2424 ;; version is better.  --hniksic
2425
2426 (defconst java-font-lock-keywords-1 nil
2427  "For consideration as a value of `java-font-lock-keywords'.
2428 This does fairly subdued highlighting.")
2429
2430 (defconst java-font-lock-keywords-2 nil
2431  "For consideration as a value of `java-font-lock-keywords'.
2432 This adds highlighting of types and identifier names.")
2433
2434 (defconst java-font-lock-keywords-3 nil
2435  "For consideration as a value of `java-font-lock-keywords'.
2436 This adds highlighting of Java documentation tags, such as @see.")
2437
2438 (defvar java-font-lock-type-regexp
2439   (concat "\\<\\(boolean\\|byte\\|char\\|double\\|float\\|int"
2440          "\\|long\\|short\\|void\\)\\>")
2441   "Regexp which should match a primitive type.")
2442
2443 (defvar java-font-lock-identifier-regexp
2444   (let ((letter "a-zA-Z_$\300-\326\330-\366\370-\377")
2445         (digit  "0-9"))
2446     (concat "\\<\\([" letter "][" letter digit "]*\\)\\>"))
2447   "Regexp which should match all Java identifiers.")
2448
2449 (defvar java-font-lock-class-name-regexp
2450   (let ((capital-letter "A-Z\300-\326\330-\337")
2451         (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
2452         (digit  "0-9"))
2453     (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>"))
2454   "Regexp which should match a class or an interface name.
2455 The name is assumed to begin with a capital letter.")
2456
2457 (let ((java-modifier-regexp
2458        (concat "\\<\\(abstract\\|const\\|final\\|native\\|"
2459                "private\\|protected\\|public\\|"
2460                "static\\|synchronized\\|transient\\|volatile\\)\\>")))
2461
2462   ;; Basic font-lock support:
2463   (setq java-font-lock-keywords-1
2464         (list
2465          ;; Keywords:
2466          (list        
2467           (concat
2468            "\\<\\("
2469            "break\\|byvalue\\|"
2470            "case\\|cast\\|catch\\|class\\|continue\\|"
2471            "do\\|else\\|extends\\|"
2472            "finally\\|for\\|future\\|"
2473            "generic\\|goto\\|"
2474            "if\\|implements\\|import\\|"
2475            "instanceof\\|interface\\|"
2476            "new\\|package\\|return\\|switch\\|"
2477            "throws?\\|try\\|while\\)\\>")
2478           1 'font-lock-keyword-face)
2479
2480          ;; Modifiers:
2481          (list java-modifier-regexp 1 font-lock-type-face)
2482
2483          ;; Special constants:
2484          '("\\<\\(this\\|super\\)\\>" (1 font-lock-reference-face))
2485          '("\\<\\(false\\|null\\|true\\)\\>" (1 font-lock-keyword-face))
2486
2487          ;; Class names:
2488          (list (concat "\\<\\(class\\|interface\\)\\>\\s *"
2489                        java-font-lock-identifier-regexp)
2490                2 'font-lock-function-name-face)
2491         
2492          ;; Package declarations:
2493          (list (concat "\\<\\(package\\|import\\)\\>\\s *"
2494                        java-font-lock-identifier-regexp)
2495                '(2 font-lock-reference-face)
2496                (list (concat
2497                       "\\=\\.\\(" java-font-lock-identifier-regexp "\\)")
2498                      nil nil '(1 (if (equal (char-after (match-end 0)) ?.)
2499                                      'font-lock-reference-face
2500                                    'font-lock-type-face))))
2501          
2502          ;; Constructors:
2503          (list (concat
2504                 "^\\s *\\(" java-modifier-regexp "\\s +\\)*"
2505                 java-font-lock-class-name-regexp "\\s *\(")
2506                (list 3
2507                      '(condition-case nil
2508                           (save-excursion
2509                             (goto-char (scan-sexps (- (match-end 0) 1) 1))
2510                             (parse-partial-sexp (point) (point-max) nil t)
2511                             (and (looking-at "\\($\\|\\<throws\\>\\|{\\)")
2512                                  'font-lock-function-name-face))
2513                         (error 'font-lock-function-name-face))))
2514
2515          ;; Methods:
2516          (list (concat "\\(" java-font-lock-type-regexp "\\|"
2517                        java-font-lock-class-name-regexp "\\)"
2518                        "\\s *\\(\\[\\s *\\]\\s *\\)*"
2519                        java-font-lock-identifier-regexp "\\s *\(")
2520                5
2521                'font-lock-function-name-face)
2522
2523          ;; Labels:
2524          (list ":"
2525                (list
2526                 (concat "^\\s *" java-font-lock-identifier-regexp "\\s *:")
2527                 '(beginning-of-line) '(end-of-line)
2528                 '(1 font-lock-reference-face)))
2529
2530          ;; `break' and continue' destination labels:
2531          (list (concat "\\<\\(break\\|continue\\)\\>\\s *"
2532                        java-font-lock-identifier-regexp)
2533                2 'font-lock-reference-face)
2534
2535          ;; Case statements:
2536          ;; In Java, any constant expression is allowed.
2537          '("\\<case\\>\\s *\\(.*\\):" 1 font-lock-reference-face)))
2538
2539   ;; Types and declared variable names:
2540   (setq java-font-lock-keywords-2
2541         (append 
2542
2543          java-font-lock-keywords-1
2544          (list
2545           ;; Keywords followed by a type:
2546           (list (concat "\\<\\(extends\\|instanceof\\|new\\)\\>\\s *"
2547                         java-font-lock-identifier-regexp)
2548                 '(2 (if (equal (char-after (match-end 0)) ?.)
2549                         'font-lock-reference-face 'font-lock-type-face))
2550                 (list (concat "\\=\\." java-font-lock-identifier-regexp)
2551                       '(goto-char (match-end 0)) nil
2552                       '(1 (if (equal (char-after (match-end 0)) ?.)
2553                               'font-lock-reference-face 'font-lock-type-face))))
2554
2555           ;; Keywords followed by a type list:
2556           (list (concat "\\<\\(implements\\|throws\\)\\>\\ s*"
2557                         java-font-lock-identifier-regexp)
2558                 '(2 (if (equal (char-after (match-end 0)) ?.)
2559                         font-lock-reference-face font-lock-type-face))
2560                 (list (concat "\\=\\(\\.\\|\\s *\\(,\\)\\s *\\)"
2561                               java-font-lock-identifier-regexp)
2562                       '(goto-char (match-end 0)) nil
2563                       '(3 (if (equal (char-after (match-end 0)) ?.)
2564                               font-lock-reference-face font-lock-type-face))))
2565
2566           ;; primitive types, can't be confused with anything else.
2567           (list java-font-lock-type-regexp
2568                 '(1 font-lock-type-face)
2569                 '(font-lock-match-java-declarations
2570                   (goto-char (match-end 0))
2571                   (goto-char (match-end 0))
2572                   (0 font-lock-variable-name-face)))
2573
2574           ;; Declarations, class types and capitalized variables:
2575           ;;
2576           ;; Declarations are easy to recognize.  Capitalized words
2577           ;; followed by a closing parenthesis are treated as casts if they
2578           ;; also are followed by an expression.  Expressions beginning with
2579           ;; a unary numerical operator, e.g. +, can't be cast to an object
2580           ;; type.
2581           ;;
2582           ;; The path of a fully qualified type, e.g. java.lang.Foo, is
2583           ;; fontified in the reference face.
2584           ;;
2585           ;; An access to a static field, e.g. System.out.println, is
2586           ;; not fontified since it can't be distinguished from the
2587           ;; usage of a capitalized variable, e.g. Foo.out.println.
2588
2589           (list (concat java-font-lock-class-name-regexp
2590                         "\\s *\\(\\[\\s *\\]\\s *\\)*"
2591                         "\\(\\<\\|$\\|)\\s *\\([\(\"]\\|\\<\\)\\)")
2592                 '(1 (save-match-data
2593                       (save-excursion
2594                         (goto-char
2595                          (match-beginning 3))
2596                         (if (not (looking-at "\\<instanceof\\>"))
2597                             'font-lock-type-face))))
2598                 (list (concat "\\=" java-font-lock-identifier-regexp "\\.")
2599                       '(progn
2600                          (goto-char (match-beginning 0))
2601                          (while (or (= (preceding-char) ?.)
2602                                     (= (char-syntax (preceding-char)) ?w))
2603                            (backward-char)))
2604                       '(goto-char (match-end 0))
2605                       '(1 font-lock-reference-face)
2606                       '(0 nil))         ; Workaround for bug in XEmacs.
2607                 '(font-lock-match-java-declarations
2608                   (goto-char (match-end 1))
2609                   (goto-char (match-end 0))
2610                   (1 font-lock-variable-name-face))))))
2611         
2612   ;; Modifier keywords and Java doc tags
2613   (setq java-font-lock-keywords-3
2614         (append
2615  
2616          '(
2617            ;; Feature scoping:
2618            ;; These must come first or the Modifiers from keywords-1 will
2619            ;; catch them.  We don't want to use override fontification here
2620            ;; because then these terms will be fontified within comments.
2621            ("\\<private\\>"   0 font-lock-string-face)
2622            ("\\<protected\\>" 0 font-lock-preprocessor-face)
2623            ("\\<public\\>"    0 font-lock-reference-face))
2624          java-font-lock-keywords-2
2625  
2626          (list
2627
2628           ;; Javadoc tags
2629           '("@\\(author\\|deprecated\\|exception\\|throws\\|param\\|return\\|see\\|since\\|version\\|serial\\|serialData\\|serialField\\)\\s "
2630             0 font-lock-keyword-face t)
2631
2632           ;; Doc tag - Parameter identifiers
2633           (list (concat "@param\\s +" java-font-lock-identifier-regexp)
2634                 1 'font-lock-variable-name-face t)
2635
2636           ;; Doc tag - Exception types
2637           (list (concat "@\\(exception\\|throws\\)\\s +"
2638                         java-font-lock-identifier-regexp)
2639                 '(2 (if (equal (char-after (match-end 0)) ?.)
2640                         font-lock-reference-face font-lock-type-face) t)
2641                 (list (concat "\\=\\." java-font-lock-identifier-regexp)
2642                       '(goto-char (match-end 0)) nil
2643                       '(1 (if (equal (char-after (match-end 0)) ?.)
2644                               'font-lock-reference-face 'font-lock-type-face) t)))
2645     
2646           ;; Doc tag - Cross-references, usually to methods 
2647           '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)"
2648             1 font-lock-function-name-face t)
2649     
2650           ;; Doc tag - docRoot (1.3)
2651           '("\\({ *@docRoot *}\\)"
2652             0 font-lock-keyword-face t)
2653           ;; Doc tag - beaninfo, unofficial but widely used, even by Sun
2654           '("\\(@beaninfo\\)"
2655             0 font-lock-keyword-face t)
2656           ;; Doc tag - Links
2657           '("{ *@link\\s +\\([^}]+\\)}"
2658             0 font-lock-keyword-face t)
2659           ;; Doc tag - Links
2660           '("{ *@link\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}"
2661             1 font-lock-function-name-face t)
2662     
2663           )))
2664   )
2665
2666 (defvar java-font-lock-keywords java-font-lock-keywords-1
2667   "Additional expressions to highlight in Java mode.")
2668
2669 ;; Match and move over any declaration/definition item after
2670 ;; point.  Does not match items which look like a type declaration
2671 ;; (primitive types and class names, i.e. capitalized words.)
2672 ;; Should the variable name be followed by a comma, we reposition
2673 ;; the cursor to fontify more identifiers.
2674 (defun font-lock-match-java-declarations (limit)
2675   "Match and skip over variable definitions."
2676   (if (looking-at "\\s *\\(\\[\\s *\\]\\s *\\)*")
2677       (goto-char (match-end 0)))
2678   (and
2679    (looking-at java-font-lock-identifier-regexp)
2680    (save-match-data
2681      (not (string-match java-font-lock-type-regexp
2682                         (buffer-substring (match-beginning 1)
2683                                           (match-end 1)))))
2684    (save-match-data
2685      (save-excursion
2686        (goto-char (match-beginning 1))
2687        (not (looking-at
2688              (concat java-font-lock-class-name-regexp
2689                      "\\s *\\(\\[\\s *\\]\\s *\\)*\\<")))))
2690    (save-match-data
2691      (condition-case nil
2692          (save-restriction
2693            (narrow-to-region (point-min) limit)
2694            (goto-char (match-end 0))
2695            ;; Note: Both `scan-sexps' and the second goto-char can
2696            ;; generate an error which is caught by the
2697            ;; `condition-case' expression.
2698            (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)"))
2699              (goto-char (or (scan-sexps (point) 1) (point-max))))
2700            (goto-char (match-end 2)))   ; non-nil
2701        (error t)))))
2702
2703
2704 (defvar tex-font-lock-keywords
2705 ;  ;; Regexps updated with help from Ulrik Dickow <dickow@nbi.dk>.
2706 ;  '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
2707 ;     2 font-lock-function-name-face)
2708 ;    ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}"
2709 ;     2 font-lock-reference-face)
2710 ;    ;; It seems a bit dubious to use `bold' and `italic' faces since we might
2711 ;    ;; not be able to display those fonts.
2712 ;    ("{\\\\bf\\([^}]+\\)}" 1 'bold keep)
2713 ;    ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep)
2714 ;    ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face)
2715 ;    ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
2716   ;; Rewritten and extended for LaTeX2e by Ulrik Dickow <dickow@nbi.dk>.
2717   '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
2718      2 font-lock-function-name-face)
2719     ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}"
2720      2 font-lock-reference-face)
2721     ("^[ \t]*\\\\def\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face)
2722     "\\\\\\([a-zA-Z@]+\\|.\\)"
2723     ;; It seems a bit dubious to use `bold' and `italic' faces since we might
2724     ;; not be able to display those fonts.
2725     ;; LaTeX2e: \emph{This is emphasized}.
2726     ("\\\\emph{\\([^}]+\\)}" 1 'italic keep)
2727     ;; LaTeX2e: \textbf{This is bold}, \textit{...}, \textsl{...}
2728     ("\\\\text\\(\\(bf\\)\\|it\\|sl\\){\\([^}]+\\)}"
2729      3 (if (match-beginning 2) 'bold 'italic) keep)
2730     ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for good tables.
2731     ("\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)"
2732      3 (if (match-beginning 2) 'bold 'italic) keep))
2733   "Default expressions to highlight in TeX modes.")
2734
2735 (defconst ksh-font-lock-keywords 
2736   (list
2737    '("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
2738    '("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|foreach\\|in\\|end\\|select\\|while\\|repeat\\|time\\|function\\|until\\|exec\\|command\\|coproc\\|noglob\\|nohup\\|nocorrect\\|source\\|autoload\\|alias\\|unalias\\|export\\|set\\|echo\\|eval\\|cd\\|log\\|compctl\\)\\>" . font-lock-keyword-face)
2739    '("\\<\\[\\[.*\\]\\]\\>" . font-lock-type-face)
2740    '("\$\(.*\)" . font-lock-type-face)
2741    )
2742   "Additional expressions to highlight in ksh-mode.")
2743
2744 (defconst sh-font-lock-keywords 
2745   (list
2746    '("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
2747    '("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|in\\|while\\|exec\\|export\\|set\\|echo\\|eval\\|cd\\)\\>" . font-lock-keyword-face)
2748    '("\\[.*\\]" . font-lock-type-face)
2749    '("`.*`" . font-lock-type-face)
2750    )
2751   "Additional expressions to highlight in sh-mode.")
2752
2753 \f
2754 ;; Install ourselves:
2755
2756 (add-hook 'find-file-hooks 'font-lock-set-defaults t)
2757
2758 ;;;###autoload
2759 (add-minor-mode 'font-lock-mode " Font")
2760
2761 ;; Provide ourselves:
2762
2763 (provide 'font-lock)
2764
2765 ;;; font-lock.el ends here