git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/font-lock.el

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