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