lisp/font-lock.el

   1 ;; Electric Font Lock Mode
   2 ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: jwz, then rms, then sm <simon@gnu.ai.mit.edu>
   5 ;; Maintainer: FSF
   6 ;; Keywords: languages, faces
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Font Lock mode is a minor mode that causes your comments to be displayed in
  27 ;; one face, strings in another, reserved words in another, and so on.
  28 ;;
  29 ;; Comments will be displayed in `font-lock-comment-face'.
  30 ;; Strings will be displayed in `font-lock-string-face'.
  31 ;; Regexps are used to display selected patterns in other faces.
  32 ;;
  33 ;; To make the text you type be fontified, use M-x font-lock-mode RET.
  34 ;; When this minor mode is on, the faces of the current line are updated with
  35 ;; every insertion or deletion.
  36 ;;
  37 ;; To turn Font Lock mode on automatically, add this to your .emacs file:
  38 ;;
  39 ;;  (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock)
  40 ;;
  41 ;; Fontification for a particular mode may be available in a number of levels
  42 ;; of decoration.  The higher the level, the more decoration, but the more time
  43 ;; it takes to fontify.  See the variable `font-lock-maximum-decoration', and
  44 ;; also the variable `font-lock-maximum-size'.
  45
  46 ;; If you add patterns for a new mode, say foo.el's `foo-mode', say in which
  47 ;; you don't want syntactic fontification to occur, you can make Font Lock mode
  48 ;; use your regexps when turning on Font Lock by adding to `foo-mode-hook':
  49 ;;
  50 ;;  (add-hook 'foo-mode-hook
  51 ;;   '(lambda () (make-local-variable 'font-lock-defaults)
  52 ;;               (setq font-lock-defaults '(foo-font-lock-keywords t))))
  53 ;;
  54 ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo"
  55 ;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for
  56 ;; efficiency.  See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on
  57 ;; archive.cis.ohio-state.edu for this and other functions.
  58
  59 ;; What is fontification for?  You might say, "It's to make my code look nice."
  60 ;; I think it should be for adding information in the form of cues.  These cues
  61 ;; should provide you with enough information to both (a) distinguish between
  62 ;; different items, and (b) identify the item meanings, without having to read
  63 ;; the items and think about it.  Therefore, fontification allows you to think
  64 ;; less about, say, the structure of code, and more about, say, why the code
  65 ;; doesn't work.  Or maybe it allows you to think less and drift off to sleep.
  66 ;;
  67 ;; So, here are my opinions/advice/guidelines:
  68 ;;
  69 ;; - Use the same face for the same conceptual object, across all modes.
  70 ;;   i.e., (b) above, all modes that have items that can be thought of as, say,
  71 ;;   keywords, should be highlighted with the same face, etc.
  72 ;; - Keep the faces distinct from each other as far as possible.
  73 ;;   i.e., (a) above.
  74 ;; - Make the face attributes fit the concept as far as possible.
  75 ;;   i.e., function names might be a bold colour such as blue, comments might
  76 ;;   be a bright colour such as red, character strings might be brown, because,
  77 ;;   err, strings are brown (that was not the reason, please believe me).
  78 ;; - Don't use a non-nil OVERRIDE unless you have a good reason.
  79 ;;   Only use OVERRIDE for special things that are easy to define, such as the
  80 ;;   way `...' quotes are treated in strings and comments in Emacs Lisp mode.
  81 ;;   Don't use it to, say, highlight keywords in commented out code or strings.
  82 ;; - Err, that's it.
  83 \f
  84 ;; User variables.
  85
  86 (defvar font-lock-verbose t
  87   "*If non-nil, means show status messages when fontifying.")
  88
  89 ;;;###autoload
  90 (defvar font-lock-maximum-decoration nil
  91   "*If non-nil, the maximum decoration level for fontifying.
  92 If nil, use the default decoration (typically the minimum available).
  93 If t, use the maximum decoration available.
  94 If a number, use that level of decoration (or if not available the maximum).
  95 If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL),
  96 where MAJOR-MODE is a symbol or t (meaning the default).  For example:
  97  ((c++-mode . 2) (c-mode . t) (t . 1))
  98 means use level 2 decoration for buffers in `c++-mode', the maximum decoration
  99 available for buffers in `c-mode', and level 1 decoration otherwise.")
 100
 101 ;;;###autoload
 102 (defvar font-lock-maximum-size (* 250 1024)
 103   "*If non-nil, the maximum size for buffers for fontifying.
 104 Only buffers less than this can be fontified when Font Lock mode is turned on.
 105 If nil, means size is irrelevant.
 106 If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
 107 where MAJOR-MODE is a symbol or t (meaning the default).  For example:
 108  ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576))
 109 means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one
 110 megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.")
 111 \f
 112 ;; Fontification variables:
 113
 114 (defvar font-lock-comment-face          'font-lock-comment-face
 115   "Face to use for comments.")
 116
 117 (defvar font-lock-string-face           'font-lock-string-face
 118   "Face to use for strings.")
 119
 120 (defvar font-lock-keyword-face          'font-lock-keyword-face
 121   "Face to use for keywords.")
 122
 123 (defvar font-lock-function-name-face    'font-lock-function-name-face
 124   "Face to use for function names.")
 125
 126 (defvar font-lock-variable-name-face    'font-lock-variable-name-face
 127   "Face to use for variable names.")
 128
 129 (defvar font-lock-type-face             'font-lock-type-face
 130   "Face to use for type names.")
 131
 132 (defvar font-lock-reference-face        'font-lock-reference-face
 133   "Face to use for reference names.")
 134
 135 (defvar font-lock-keywords nil
 136   "*A list of the keywords to highlight.
 137 Each element should be of the form:
 138
 139  MATCHER
 140  (MATCHER . MATCH)
 141  (MATCHER . FACENAME)
 142  (MATCHER . HIGHLIGHT)
 143  (MATCHER HIGHLIGHT ...)
 144
 145 where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED.
 146
 147 For highlighting single items, typically only MATCH-HIGHLIGHT is required.
 148 However, if an item or (typically) items is to be hightlighted following the
 149 instance of another item (the anchor) then MATCH-ANCHORED may be required.
 150
 151 MATCH-HIGHLIGHT should be of the form:
 152
 153  (MATCH FACENAME OVERRIDE LAXMATCH)
 154
 155 Where MATCHER can be either the regexp to search for, or the function name to
 156 call to make the search (called with one argument, the limit of the search).
 157 MATCH is the subexpression of MATCHER to be highlighted.  FACENAME is an
 158 expression whose value is the face name to use.  FACENAME's default attributes
 159 may be defined in `font-lock-face-attributes'.
 160
 161 OVERRIDE and LAXMATCH are flags.  If OVERRIDE is t, existing fontification may
 162 be overwritten.  If `keep', only parts not already fontified are highlighted.
 163 If `prepend' or `append', existing fontification is merged with the new, in
 164 which the new or existing fontification, respectively, takes precedence.
 165 If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER.
 166
 167 For example, an element of the form highlights (if not already highlighted):
 168
 169  \"foo\"                        Occurrences of \"foo\" in `font-lock-keyword-face'.
 170  (\"fu\\\\(bar\\\\)\" . 1)      Substring \"bar\" within all occurrences of \"fubar\" in
 171                         the value of `font-lock-keyword-face'.
 172  (\"fubar\" . fubar-face)       Occurrences of \"fubar\" in the value of `fubar-face'.
 173  (\"foo\\\\|bar\" 0 foo-bar-face t)
 174                         Occurrences of either \"foo\" or \"bar\" in the value
 175                         of `foo-bar-face', even if already highlighted.
 176
 177 MATCH-ANCHORED should be of the form:
 178
 179  (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...)
 180
 181 Where MATCHER is as for MATCH-HIGHLIGHT.  PRE-MATCH-FORM and POST-MATCH-FORM
 182 are evaluated before the first, and after the last, instance MATCH-ANCHORED's
 183 MATCHER is used.  Therefore they can be used to initialise before, and cleanup
 184 after, MATCHER is used.  Typically, PRE-MATCH-FORM is used to move to some
 185 position relative to the original MATCHER, before starting with
 186 MATCH-ANCHORED's MATCHER.  POST-MATCH-FORM might be used to move, before
 187 resuming with MATCH-ANCHORED's parent's MATCHER.
 188
 189 For example, an element of the form highlights (if not already highlighted):
 190
 191  (\"anchor\" (0 anchor-face) (\".*\\\\(item\\\\)\" nil nil (1 item-face)))
 192
 193  Occurrences of \"anchor\" in the value of `anchor-face', and subsequent
 194  occurrences of \"item\" on the same line (by virtue of the `.*' regexp) in the
 195  value of `item-face'.  (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil.
 196  Therefore \"item\" is initially searched for starting from the end of the match
 197  of \"anchor\", and searching for subsequent instance of \"anchor\" resumes from
 198  where searching for \"item\" concluded.)
 199
 200 Note that the MATCH-ANCHORED feature is experimental; in the future, we may
 201 replace it with other ways of providing this functionality.
 202
 203 These regular expressions should not match text which spans lines.  While
 204 \\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating
 205 when you edit the buffer does not, since it considers text one line at a time.
 206
 207 Be very careful composing regexps for this list;
 208 the wrong pattern can dramatically slow things down!")
 209 (make-variable-buffer-local 'font-lock-keywords)
 210
 211 (defvar font-lock-defaults nil
 212   "If set by a major mode, should be the defaults for Font Lock mode.
 213 The value should be like the `cdr' of an item in `font-lock-defaults-alist'.")
 214
 215 (defvar font-lock-defaults-alist
 216   (let (;; For C and Lisp modes we use `beginning-of-defun', rather than nil,
 217         ;; for SYNTAX-BEGIN.  Thus the calculation of the cache is usually
 218         ;; faster but not infallible, so we risk mis-fontification.  --sm.
 219         (c-mode-defaults
 220          '((c-font-lock-keywords c-font-lock-keywords-1
 221             c-font-lock-keywords-2 c-font-lock-keywords-3)
 222            nil nil ((?_ . "w")) beginning-of-defun))
 223         (c++-mode-defaults
 224          '((c++-font-lock-keywords c++-font-lock-keywords-1
 225             c++-font-lock-keywords-2 c++-font-lock-keywords-3)
 226            nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun))
 227         (lisp-mode-defaults
 228          '((lisp-font-lock-keywords
 229             lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
 230            nil nil
 231            ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w")
 232             (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w")
 233             (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w"))
 234            beginning-of-defun))
 235         (scheme-mode-defaults
 236          '(scheme-font-lock-keywords nil t
 237            ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w")
 238             (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w")
 239             (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w"))
 240            beginning-of-defun))
 241         ;; For TeX modes we could use `backward-paragraph' for the same reason.
 242         (tex-mode-defaults '(tex-font-lock-keywords nil nil ((?$ . "\""))))
 243         )
 244     (list
 245      (cons 'bibtex-mode                 tex-mode-defaults)
 246      (cons 'c++-c-mode                  c-mode-defaults)
 247      (cons 'c++-mode                    c++-mode-defaults)
 248      (cons 'c-mode                      c-mode-defaults)
 249      (cons 'elec-c-mode                 c-mode-defaults)
 250      (cons 'emacs-lisp-mode             lisp-mode-defaults)
 251      (cons 'inferior-scheme-mode        scheme-mode-defaults)
 252      (cons 'latex-mode                  tex-mode-defaults)
 253      (cons 'lisp-mode                   lisp-mode-defaults)
 254      (cons 'lisp-interaction-mode       lisp-mode-defaults)
 255      (cons 'plain-tex-mode              tex-mode-defaults)
 256      (cons 'scheme-mode                 scheme-mode-defaults)
 257      (cons 'scheme-interaction-mode     scheme-mode-defaults)
 258      (cons 'slitex-mode                 tex-mode-defaults)
 259      (cons 'tex-mode                    tex-mode-defaults)))
 260   "Alist of default major mode and Font Lock defaults.
 261 Each item should be a list of the form:
 262
 263  (MAJOR-MODE . (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN))
 264
 265 where MAJOR-MODE is a symbol.  KEYWORDS may be a symbol (a variable or function
 266 whose value is the keywords to use for fontification) or a list of symbols.
 267 If KEYWORDS-ONLY is non-nil, syntactic fontification (strings and comments) is
 268 not performed.  If CASE-FOLD is non-nil, the case of the keywords is ignored
 269 when fontifying.  If SYNTAX-ALIST is non-nil, it should be a list of cons pairs
 270 of the form (CHAR . STRING) used to set the local Font Lock syntax table, for
 271 keyword and syntactic fontification (see `modify-syntax-entry').
 272
 273 If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move
 274 backwards outside any enclosing syntactic block, for syntactic fontification.
 275 Typical values are `beginning-of-line' (i.e., the start of the line is known to
 276 be outside a syntactic block), or `beginning-of-defun' for programming modes or
 277 `backward-paragraph' for textual modes (i.e., the mode-dependent function is
 278 known to move outside a syntactic block).  If nil, the beginning of the buffer
 279 is used as a position outside of a syntactic block, in the worst case.
 280
 281 These item elements are used by Font Lock mode to set the variables
 282 `font-lock-keywords', `font-lock-keywords-only',
 283 `font-lock-keywords-case-fold-search', `font-lock-syntax-table' and
 284 `font-lock-beginning-of-syntax-function', respectively.")
 285
 286 (defvar font-lock-keywords-only nil
 287   "*Non-nil means Font Lock should not fontify comments or strings.
 288 This is normally set via `font-lock-defaults'.")
 289
 290 (defvar font-lock-keywords-case-fold-search nil
 291   "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
 292 This is normally set via `font-lock-defaults'.")
 293
 294 (defvar font-lock-syntax-table nil
 295   "Non-nil means use this syntax table for fontifying.
 296 If this is nil, the major mode's syntax table is used.
 297 This is normally set via `font-lock-defaults'.")
 298
 299 ;; If this is nil, we only use the beginning of the buffer if we can't use
 300 ;; `font-lock-cache-position' and `font-lock-cache-state'.
 301 (defvar font-lock-beginning-of-syntax-function nil
 302   "*Non-nil means use this function to move back outside of a syntactic block.
 303 If this is nil, the beginning of the buffer is used (in the worst case).
 304 This is normally set via `font-lock-defaults'.")
 305
 306 ;; These record the parse state at a particular position, always the start of a
 307 ;; line.  Used to make `font-lock-fontify-syntactically-region' faster.
 308 (defvar font-lock-cache-position nil)
 309 (defvar font-lock-cache-state nil)
 310 (make-variable-buffer-local 'font-lock-cache-position)
 311 (make-variable-buffer-local 'font-lock-cache-state)
 312
 313 (defvar font-lock-mode nil)             ; For the modeline.
 314 (defvar font-lock-fontified nil)        ; Whether we have fontified the buffer.
 315 (put 'font-lock-fontified 'permanent-local t)
 316
 317 ;;;###autoload
 318 (defvar font-lock-mode-hook nil
 319   "Function or functions to run on entry to Font Lock mode.")
 320 \f
 321 ;; User functions.
 322
 323 ;;;###autoload
 324 (defun font-lock-mode (&optional arg)
 325   "Toggle Font Lock mode.
 326 With arg, turn Font Lock mode on if and only if arg is positive.
 327
 328 When Font Lock mode is enabled, text is fontified as you type it:
 329
 330  - Comments are displayed in `font-lock-comment-face';
 331  - Strings are displayed in `font-lock-string-face';
 332  - Certain other expressions are displayed in other faces according to the
 333    value of the variable `font-lock-keywords'.
 334
 335 You can enable Font Lock mode in any major mode automatically by turning on in
 336 the major mode's hook.  For example, put in your ~/.emacs:
 337
 338  (add-hook 'c-mode-hook 'turn-on-font-lock)
 339
 340 Or for any visited file with the following in your ~/.emacs:
 341
 342  (add-hook 'find-file-hooks 'turn-on-font-lock)
 343
 344 The default Font Lock mode faces and their attributes are defined in the
 345 variable `font-lock-face-attributes', and Font Lock mode default settings in
 346 the variable `font-lock-defaults-alist'.  You can set your own default settings
 347 for some mode, by setting a buffer local value for `font-lock-defaults', via
 348 its mode hook.
 349
 350 Where modes support different levels of fontification, you can use the variable
 351 `font-lock-maximum-decoration' to specify which level you generally prefer.
 352 When you turn Font Lock mode on/off the buffer is fontified/defontified, though
 353 fontification occurs only if the buffer is less than `font-lock-maximum-size'.
 354 To fontify a buffer without turning on Font Lock mode, and regardless of buffer
 355 size, you can use \\[font-lock-fontify-buffer]."
 356   (interactive "P")
 357   (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode)))
 358         (maximum-size (if (not (consp font-lock-maximum-size))
 359                           font-lock-maximum-size
 360                         (cdr (or (assq major-mode font-lock-maximum-size)
 361                                  (assq t font-lock-maximum-size))))))
 362     (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp...
 363         (setq on-p nil))
 364     (if (not on-p)
 365         (remove-hook 'after-change-functions 'font-lock-after-change-function)
 366       (make-local-variable 'after-change-functions)
 367       (add-hook 'after-change-functions 'font-lock-after-change-function))
 368     (set (make-local-variable 'font-lock-mode) on-p)
 369     (cond (on-p
 370            (font-lock-set-defaults)
 371            (make-local-variable 'before-revert-hook)
 372            (make-local-variable 'after-revert-hook)
 373            ;; If buffer is reverted, must clean up the state.
 374            (add-hook 'before-revert-hook 'font-lock-revert-setup)
 375            (add-hook 'after-revert-hook 'font-lock-revert-cleanup)
 376            (run-hooks 'font-lock-mode-hook)
 377            (cond (font-lock-fontified
 378                   nil)
 379                  ((or (null maximum-size) (<= (buffer-size) maximum-size))
 380                   (font-lock-fontify-buffer))
 381                  (font-lock-verbose
 382                   (message "Fontifying %s... buffer too big." (buffer-name)))))
 383           (font-lock-fontified
 384            (setq font-lock-fontified nil)
 385            (remove-hook 'before-revert-hook 'font-lock-revert-setup)
 386            (remove-hook 'after-revert-hook 'font-lock-revert-cleanup)
 387            (font-lock-unfontify-region (point-min) (point-max))
 388            (font-lock-thing-lock-cleanup))
 389           (t
 390            (remove-hook 'before-revert-hook 'font-lock-revert-setup)
 391            (remove-hook 'after-revert-hook 'font-lock-revert-cleanup)
 392            (font-lock-thing-lock-cleanup)))
 393     (force-mode-line-update)))
 394
 395 ;;;###autoload
 396 (defun turn-on-font-lock ()
 397   "Unconditionally turn on Font Lock mode."
 398   (font-lock-mode 1))
 399
 400 ;;;###autoload
 401 (defun font-lock-fontify-buffer ()
 402   "Fontify the current buffer the way `font-lock-mode' would."
 403   (interactive)
 404   (let ((verbose (and (or font-lock-verbose (interactive-p))
 405                       (not (zerop (buffer-size)))))
 406         (modified (buffer-modified-p)))
 407     (set (make-local-variable 'font-lock-fontified) nil)
 408     (if verbose (message "Fontifying %s..." (buffer-name)))
 409     ;; Turn it on to run hooks and get the right `font-lock-keywords' etc.
 410     (or font-lock-mode (font-lock-set-defaults))
 411     (condition-case nil
 412         (save-excursion
 413           (font-lock-fontify-region (point-min) (point-max) verbose)
 414           (setq font-lock-fontified t))
 415       ;; We don't restore the old fontification, so it's best to unfontify.
 416       (quit (font-lock-unfontify-region (point-min) (point-max))))
 417     (if verbose (message "Fontifying %s... %s." (buffer-name)
 418                          (if font-lock-fontified "done" "aborted")))
 419     (and (buffer-modified-p)
 420          (not modified)
 421          (set-buffer-modified-p nil))
 422     (font-lock-after-fontify-buffer)))
 423 \f
 424 ;; Fontification functions.
 425
 426 ;; We use this wrapper.  However, `font-lock-fontify-region' used to be the
 427 ;; name used for `font-lock-fontify-syntactically-region', so a change isn't
 428 ;; back-compatible.  But you shouldn't be calling these directly, should you?
 429 (defun font-lock-fontify-region (beg end &optional loudly)
 430   (if font-lock-keywords-only
 431       (font-lock-unfontify-region beg end)
 432     (font-lock-fontify-syntactically-region beg end loudly))
 433   (font-lock-fontify-keywords-region beg end loudly))
 434
 435 ;; The following must be rethought, since keywords can override fontification.
 436 ;      ;; Now scan for keywords, but not if we are inside a comment now.
 437 ;      (or (and (not font-lock-keywords-only)
 438 ;              (let ((state (parse-partial-sexp beg end nil nil
 439 ;                                               font-lock-cache-state)))
 440 ;                (or (nth 4 state) (nth 7 state))))
 441 ;         (font-lock-fontify-keywords-region beg end))
 442
 443 (defun font-lock-unfontify-region (beg end)
 444   (let ((modified (buffer-modified-p))
 445         (buffer-undo-list t) (inhibit-read-only t)
 446         buffer-file-name buffer-file-truename)
 447     (remove-text-properties beg end '(face nil))
 448     (and (buffer-modified-p)
 449          (not modified)
 450          (set-buffer-modified-p nil))))
 451
 452 ;; Called when any modification is made to buffer text.
 453 (defun font-lock-after-change-function (beg end old-len)
 454   (save-excursion
 455     (save-match-data
 456       ;; Rescan between start of line from `beg' and start of line after `end'.
 457       (font-lock-fontify-region
 458        (progn (goto-char beg) (beginning-of-line) (point))
 459        (progn (goto-char end) (forward-line 1) (point))))))
 460 \f
 461 ;; Syntactic fontification functions.
 462
 463 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
 464   "Put proper face on each string and comment between START and END.
 465 START should be at the beginning of a line."
 466   (let ((inhibit-read-only t) (buffer-undo-list t)
 467         (modified (buffer-modified-p))
 468         (old-syntax (syntax-table))
 469         (synstart (if comment-start-skip
 470                       (concat "\\s\"\\|" comment-start-skip)
 471                     "\\s\""))
 472         (comstart (if comment-start-skip
 473                       (concat "\\s<\\|" comment-start-skip)
 474                     "\\s<"))
 475         buffer-file-name buffer-file-truename
 476         state prev prevstate)
 477     (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
 478     (unwind-protect
 479       (save-restriction
 480         (widen)
 481         (goto-char start)
 482         ;;
 483         ;; Use the fontification syntax table, if any.
 484         (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
 485         ;;
 486         ;; Find the state at the `beginning-of-line' before `start'.
 487         (if (eq start font-lock-cache-position)
 488             ;; Use the cache for the state of `start'.
 489             (setq state font-lock-cache-state)
 490           ;; Find the state of `start'.
 491           (if (null font-lock-beginning-of-syntax-function)
 492               ;; Use the state at the previous cache position, if any, or
 493               ;; otherwise calculate from `point-min'.
 494               (if (or (null font-lock-cache-position)
 495                       (< start font-lock-cache-position))
 496                   (setq state (parse-partial-sexp (point-min) start))
 497                 (setq state (parse-partial-sexp
 498                              font-lock-cache-position start
 499                              nil nil font-lock-cache-state)))
 500             ;; Call the function to move outside any syntactic block.
 501             (funcall font-lock-beginning-of-syntax-function)
 502             (setq state (parse-partial-sexp (point) start)))
 503           ;; Cache the state and position of `start'.
 504           (setq font-lock-cache-state state
 505                 font-lock-cache-position start))
 506         ;;
 507         ;; If the region starts inside a string, show the extent of it.
 508         (if (nth 3 state)
 509             (let ((beg (point)))
 510               (while (and (re-search-forward "\\s\"" end 'move)
 511                           (nth 3 (parse-partial-sexp beg (point)
 512                                                      nil nil state))))
 513               (put-text-property beg (point) 'face font-lock-string-face)
 514               (setq state (parse-partial-sexp beg (point) nil nil state))))
 515         ;;
 516         ;; Likewise for a comment.
 517         (if (or (nth 4 state) (nth 7 state))
 518             (let ((beg (point)))
 519               (save-restriction
 520                 (narrow-to-region (point-min) end)
 521                 (condition-case nil
 522                     (progn
 523                       (re-search-backward comstart (point-min) 'move)
 524                       (forward-comment 1)
 525                       ;; forward-comment skips all whitespace,
 526                       ;; so go back to the real end of the comment.
 527                       (skip-chars-backward " \t"))
 528                   (error (goto-char end))))
 529               (put-text-property beg (point) 'face font-lock-comment-face)
 530               (setq state (parse-partial-sexp beg (point) nil nil state))))
 531         ;;
 532         ;; Find each interesting place between here and `end'.
 533         (while (and (< (point) end)
 534                     (setq prev (point) prevstate state)
 535                     (re-search-forward synstart end t)
 536                     (progn
 537                       ;; Clear out the fonts of what we skip over.
 538                       (remove-text-properties prev (point) '(face nil))
 539                       ;; Verify the state at that place
 540                       ;; so we don't get fooled by \" or \;.
 541                       (setq state (parse-partial-sexp prev (point)
 542                                                       nil nil state))))
 543           (let ((here (point)))
 544             (if (or (nth 4 state) (nth 7 state))
 545                 ;;
 546                 ;; We found a real comment start.
 547                 (let ((beg (match-beginning 0)))
 548                   (goto-char beg)
 549                   (save-restriction
 550                     (narrow-to-region (point-min) end)
 551                     (condition-case nil
 552                         (progn
 553                           (forward-comment 1)
 554                           ;; forward-comment skips all whitespace,
 555                           ;; so go back to the real end of the comment.
 556                           (skip-chars-backward " \t"))
 557                       (error (goto-char end))))
 558                   (put-text-property beg (point) 'face
 559                                      font-lock-comment-face)
 560                   (setq state (parse-partial-sexp here (point) nil nil state)))
 561               (if (nth 3 state)
 562                   ;;
 563                   ;; We found a real string start.
 564                   (let ((beg (match-beginning 0)))
 565                     (while (and (re-search-forward "\\s\"" end 'move)
 566                                 (nth 3 (parse-partial-sexp here (point)
 567                                                            nil nil state))))
 568                     (put-text-property beg (point) 'face font-lock-string-face)
 569                     (setq state (parse-partial-sexp here (point)
 570                                                     nil nil state))))))
 571           ;;
 572           ;; Make sure `prev' is non-nil after the loop
 573           ;; only if it was set on the very last iteration.
 574           (setq prev nil)))
 575       ;;
 576       ;; Clean up.
 577       (set-syntax-table old-syntax)
 578       (if prev (remove-text-properties prev end '(face nil)))
 579       (and (buffer-modified-p)
 580            (not modified)
 581            (set-buffer-modified-p nil)))))
 582 \f
 583 ;;; Additional text property functions.
 584
 585 ;; The following three text property functions are not generally available (and
 586 ;; it's not certain that they should be) so they are inlined for speed.
 587 ;; The case for `fillin-text-property' is simple; it may or not be generally
 588 ;; useful.  (Since it is used here, it is useful in at least one place.;-)
 589 ;; However, the case for `append-text-property' and `prepend-text-property' is
 590 ;; more complicated.  Should they remove duplicate property values or not?  If
 591 ;; so, should the first or last duplicate item remain?  Or the one that was
 592 ;; added?  In our implementation, the first duplicate remains.
 593
 594 (defsubst font-lock-fillin-text-property (start end prop value &optional object)
 595   "Fill in one property of the text from START to END.
 596 Arguments PROP and VALUE specify the property and value to put where none are
 597 already in place.  Therefore existing property values are not overwritten.
 598 Optional argument OBJECT is the string or buffer containing the text."
 599   (let ((start (text-property-any start end prop nil object)) next)
 600     (while start
 601       (setq next (next-single-property-change start prop object end))
 602       (put-text-property start next prop value object)
 603       (setq start (text-property-any next end prop nil object)))))
 604
 605 ;; This function (from simon's unique.el) is rewritten and inlined for speed.
 606 ;(defun unique (list function)
 607 ;  "Uniquify LIST, deleting elements using FUNCTION.
 608 ;Return the list with subsequent duplicate items removed by side effects.
 609 ;FUNCTION is called with an element of LIST and a list of elements from LIST,
 610 ;and should return the list of elements with occurrences of the element removed,
 611 ;i.e., a function such as `delete' or `delq'.
 612 ;This function will work even if LIST is unsorted.  See also `uniq'."
 613 ;  (let ((list list))
 614 ;    (while list
 615 ;      (setq list (setcdr list (funcall function (car list) (cdr list))))))
 616 ;  list)
 617
 618 (defsubst font-lock-unique (list)
 619   "Uniquify LIST, deleting elements using `delq'.
 620 Return the list with subsequent duplicate items removed by side effects."
 621   (let ((list list))
 622     (while list
 623       (setq list (setcdr list (delq (car list) (cdr list))))))
 624   list)
 625
 626 ;; A generalisation of `facemenu-add-face' for any property, but without the
 627 ;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
 628 ;; treatment of `default'.  Uses `unique' to remove duplicate property values.
 629 (defsubst font-lock-prepend-text-property (start end prop value &optional object)
 630   "Prepend to one property of the text from START to END.
 631 Arguments PROP and VALUE specify the property and value to prepend to the value
 632 already in place.  The resulting property values are always lists, and unique.
 633 Optional argument OBJECT is the string or buffer containing the text."
 634   (let ((val (if (listp value) value (list value))) next prev)
 635     (while (/= start end)
 636       (setq next (next-single-property-change start prop object end)
 637             prev (get-text-property start prop object))
 638       (put-text-property
 639        start next prop
 640        (font-lock-unique (append val (if (listp prev) prev (list prev))))
 641        object)
 642       (setq start next))))
 643
 644 (defsubst font-lock-append-text-property (start end prop value &optional object)
 645   "Append to one property of the text from START to END.
 646 Arguments PROP and VALUE specify the property and value to append to the value
 647 already in place.  The resulting property values are always lists, and unique.
 648 Optional argument OBJECT is the string or buffer containing the text."
 649   (let ((val (if (listp value) value (list value))) next prev)
 650     (while (/= start end)
 651       (setq next (next-single-property-change start prop object end)
 652             prev (get-text-property start prop object))
 653       (put-text-property
 654        start next prop
 655        (font-lock-unique (append (if (listp prev) prev (list prev)) val))
 656        object)
 657       (setq start next))))
 658 \f
 659 ;;; Regexp fontification functions.
 660
 661 (defsubst font-lock-apply-highlight (highlight)
 662   "Apply HIGHLIGHT following a match.
 663 HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
 664   (let* ((match (nth 0 highlight))
 665          (start (match-beginning match)) (end (match-end match))
 666          (override (nth 2 highlight)))
 667     (cond ((not start)
 668            ;; No match but we might not signal an error.
 669            (or (nth 3 highlight)
 670                (error "No match %d in highlight %S" match highlight)))
 671           ((not override)
 672            ;; Cannot override existing fontification.
 673            (or (text-property-not-all start end 'face nil)
 674                (put-text-property start end 'face (eval (nth 1 highlight)))))
 675           ((eq override t)
 676            ;; Override existing fontification.
 677            (put-text-property start end 'face (eval (nth 1 highlight))))
 678           ((eq override 'keep)
 679            ;; Keep existing fontification.
 680            (font-lock-fillin-text-property start end 'face
 681                                            (eval (nth 1 highlight))))
 682           ((eq override 'prepend)
 683            ;; Prepend to existing fontification.
 684            (font-lock-prepend-text-property start end 'face
 685                                             (eval (nth 1 highlight))))
 686           ((eq override 'append)
 687            ;; Append to existing fontification.
 688            (font-lock-append-text-property start end 'face
 689                                            (eval (nth 1 highlight)))))))
 690
 691 (defsubst font-lock-fontify-anchored-keywords (keywords limit)
 692   "Fontify according to KEYWORDS until LIMIT.
 693 KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords'."
 694   (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights)
 695     (eval (nth 1 keywords))
 696     (save-match-data
 697       (while (if (stringp matcher)
 698                  (re-search-forward matcher limit t)
 699                (funcall matcher limit))
 700         (setq highlights lowdarks)
 701         (while highlights
 702           (font-lock-apply-highlight (car highlights))
 703           (setq highlights (cdr highlights)))))
 704     (eval (nth 2 keywords))))
 705
 706 (defun font-lock-fontify-keywords-region (start end &optional loudly)
 707   "Fontify according to `font-lock-keywords' between START and END.
 708 START should be at the beginning of a line."
 709   (let ((case-fold-search font-lock-keywords-case-fold-search)
 710         (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
 711                            font-lock-keywords
 712                          (font-lock-compile-keywords))))
 713         (inhibit-read-only t) (buffer-undo-list t)
 714         (modified (buffer-modified-p))
 715         (old-syntax (syntax-table))
 716         (bufname (buffer-name)) (count 0)
 717         buffer-file-name buffer-file-truename)
 718     (unwind-protect
 719         (let (keyword matcher highlights)
 720           ;;
 721           ;; Use the fontification syntax table, if any.
 722           (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
 723           ;;
 724           ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
 725           (while keywords
 726             (if loudly (message "Fontifying %s... (regexps..%s)" bufname
 727                                 (make-string (setq count (1+ count)) ?.)))
 728             ;;
 729             ;; Find an occurrence of `matcher' from `start' to `end'.
 730             (setq keyword (car keywords) matcher (car keyword))
 731             (goto-char start)
 732             (while (if (stringp matcher)
 733                        (re-search-forward matcher end t)
 734                      (funcall matcher end))
 735               ;; Apply each highlight to this instance of `matcher', which may
 736               ;; be specific highlights or more keywords anchored to `matcher'.
 737               (setq highlights (cdr keyword))
 738               (while highlights
 739                 (if (numberp (car (car highlights)))
 740                     (font-lock-apply-highlight (car highlights))
 741                   (font-lock-fontify-anchored-keywords (car highlights) end))
 742                 (setq highlights (cdr highlights))))
 743             (setq keywords (cdr keywords))))
 744       ;;
 745       ;; Clean up.
 746       (set-syntax-table old-syntax)
 747       (and (buffer-modified-p)
 748            (not modified)
 749            (set-buffer-modified-p nil)))))
 750 \f
 751 ;; Various functions.
 752
 753 ;; Turn off other related packages if they're on.  I prefer a hook. --sm.
 754 ;; These explicit calls are easier to understand
 755 ;; because people know what they will do.
 756 ;; A hook is a mystery because it might do anything whatever. --rms.
 757 (defun font-lock-thing-lock-cleanup ()
 758   (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
 759          (fast-lock-mode -1))
 760         ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
 761          (lazy-lock-mode -1))))
 762
 763 ;; Do something special for these packages after fontifying.  I prefer a hook.
 764 (defun font-lock-after-fontify-buffer ()
 765   (cond ((and (boundp 'fast-lock-mode) fast-lock-mode)
 766          (fast-lock-after-fontify-buffer))
 767         ((and (boundp 'lazy-lock-mode) lazy-lock-mode)
 768          (lazy-lock-after-fontify-buffer))))
 769
 770 ;; If the buffer is about to be reverted, it won't be fontified afterward.
 771 (defun font-lock-revert-setup ()
 772   (setq font-lock-fontified nil))
 773
 774 ;; If the buffer has just been reverted, normally that turns off
 775 ;; Font Lock mode.  So turn the mode back on if necessary.
 776 (defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
 777
 778 (defun font-lock-compile-keywords (&optional keywords)
 779   ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD
 780   ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string.
 781   (let ((keywords (or keywords font-lock-keywords)))
 782     (setq font-lock-keywords
 783      (if (eq (car-safe keywords) t)
 784          keywords
 785        (cons t
 786         (mapcar
 787          (function (lambda (item)
 788             (cond ((nlistp item)
 789                    (list item '(0 font-lock-keyword-face)))
 790                   ((numberp (cdr item))
 791                    (list (car item) (list (cdr item) 'font-lock-keyword-face)))
 792                   ((symbolp (cdr item))
 793                    (list (car item) (list 0 (cdr item))))
 794                   ((nlistp (nth 1 item))
 795                    (list (car item) (cdr item)))
 796                   (t
 797                    item))))
 798          keywords))))))
 799
 800 (defun font-lock-choose-keywords (keywords level)
 801   ;; Return LEVELth element of KEYWORDS.  A LEVEL of nil is equal to a
 802   ;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
 803   (let ((level (if (not (consp level))
 804                    level
 805                  (cdr (or (assq major-mode level) (assq t level))))))
 806     (cond ((symbolp keywords)
 807            keywords)
 808           ((numberp level)
 809            (or (nth level keywords) (car (reverse keywords))))
 810           ((eq level t)
 811            (car (reverse keywords)))
 812           (t
 813            (car keywords)))))
 814
 815 (defun font-lock-set-defaults ()
 816   "Set fontification defaults appropriately for this mode.
 817 Sets `font-lock-keywords', `font-lock-keywords-only', `font-lock-syntax-table',
 818 `font-lock-beginning-of-syntax-function' and
 819 `font-lock-keywords-case-fold-search' using `font-lock-defaults' (or, if nil,
 820 using `font-lock-defaults-alist') and `font-lock-maximum-decoration'."
 821   ;; Set face defaults.
 822   (font-lock-make-faces)
 823   ;; Set fontification defaults.
 824   (or font-lock-keywords
 825       (let* ((defaults (or font-lock-defaults
 826                            (cdr (assq major-mode font-lock-defaults-alist))))
 827              (keywords (font-lock-choose-keywords
 828                         (nth 0 defaults) font-lock-maximum-decoration)))
 829         ;; Keywords?
 830         (setq font-lock-keywords (if (fboundp keywords)
 831                                      (funcall keywords)
 832                                    (eval keywords)))
 833         ;; Syntactic?
 834         (if (nth 1 defaults)
 835             (set (make-local-variable 'font-lock-keywords-only) t))
 836         ;; Case fold?
 837         (if (nth 2 defaults)
 838             (set (make-local-variable 'font-lock-keywords-case-fold-search) t))
 839         ;; Syntax table?
 840         (if (nth 3 defaults)
 841             (let ((slist (nth 3 defaults)))
 842               (set (make-local-variable 'font-lock-syntax-table)
 843                    (copy-syntax-table (syntax-table)))
 844               (while slist
 845                 (modify-syntax-entry (car (car slist)) (cdr (car slist))
 846                                      font-lock-syntax-table)
 847                 (setq slist (cdr slist)))))
 848         ;; Syntax function?
 849         (if (nth 4 defaults)
 850             (set (make-local-variable 'font-lock-beginning-of-syntax-function)
 851                  (nth 4 defaults))))))
 852 \f
 853 ;; Colour etc. support.
 854
 855 (defvar font-lock-display-type nil
 856   "A symbol indicating the display Emacs is running under.
 857 The symbol should be one of `color', `grayscale' or `mono'.
 858 If Emacs guesses this display attribute wrongly, either set this variable in
 859 your `~/.emacs' or set the resource `Emacs.displayType' in your `~/.Xdefaults'.
 860 See also `font-lock-background-mode' and `font-lock-face-attributes'.")
 861
 862 (defvar font-lock-background-mode nil
 863   "A symbol indicating the Emacs background brightness.
 864 The symbol should be one of `light' or `dark'.
 865 If Emacs guesses this frame attribute wrongly, either set this variable in
 866 your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
 867 `~/.Xdefaults'.
 868 See also `font-lock-display-type' and `font-lock-face-attributes'.")
 869
 870 (defvar font-lock-face-attributes nil
 871   "A list of default attributes to use for face attributes.
 872 Each element of the list should be of the form
 873
 874  (FACE FOREGROUND BACKGROUND BOLD-P ITALIC-P UNDERLINE-P)
 875
 876 where FACE should be one of the face symbols `font-lock-comment-face',
 877 `font-lock-string-face', `font-lock-keyword-face', `font-lock-type-face',
 878 `font-lock-function-name-face', `font-lock-variable-name-face', and
 879 `font-lock-reference-face'.  A form for each of these face symbols should be
 880 provided in the list, but other face symbols and attributes may be given and
 881 used in highlighting.  See `font-lock-keywords'.
 882
 883 Subsequent element items should be the attributes for the corresponding
 884 Font Lock mode faces.  Attributes FOREGROUND and BACKGROUND should be strings
 885 \(default if nil), while BOLD-P, ITALIC-P, and UNDERLINE-P should specify the
 886 corresponding face attributes (yes if non-nil).
 887
 888 Emacs uses default attributes based on display type and background brightness.
 889 See variables `font-lock-display-type' and `font-lock-background-mode'.
 890
 891 Resources can be used to over-ride these face attributes.  For example, the
 892 resource `Emacs.font-lock-comment-face.attributeUnderline' can be used to
 893 specify the UNDERLINE-P attribute for face `font-lock-comment-face'.")
 894
 895 (defun font-lock-make-faces (&optional override)
 896   "Make faces from `font-lock-face-attributes'.
 897 A default list is used if this is nil.
 898 If optional OVERRIDE is non-nil, faces that already exist are reset.
 899 See `font-lock-make-face' and `list-faces-display'."
 900   ;; We don't need to `setq' any of these variables, but the user can see what
 901   ;; is being used if we do.
 902   (if (null font-lock-display-type)
 903       (setq font-lock-display-type
 904             (let ((display-resource (x-get-resource ".displayType"
 905                                                     "DisplayType")))
 906               (cond (display-resource (intern (downcase display-resource)))
 907                     ((x-display-color-p) 'color)
 908                     ((x-display-grayscale-p) 'grayscale)
 909                     (t 'mono)))))
 910   (if (null font-lock-background-mode)
 911       (setq font-lock-background-mode
 912             (let ((bg-resource (x-get-resource ".backgroundMode"
 913                                                "BackgroundMode"))
 914                   (params (frame-parameters)))
 915               (cond (bg-resource (intern (downcase bg-resource)))
 916                     ((< (apply '+ (x-color-values
 917                                    (cdr (assq 'background-color params))))
 918                         (/ (apply '+ (x-color-values "white")) 3))
 919                      'dark)
 920                     (t 'light)))))
 921   (if (null font-lock-face-attributes)
 922       (setq font-lock-face-attributes
 923             (let ((light-bg (eq font-lock-background-mode 'light)))
 924               (cond ((memq font-lock-display-type '(mono monochrome))
 925                      ;; Emacs 19.25's font-lock defaults:
 926                      ;;'((font-lock-comment-face nil nil nil t nil)
 927                      ;;  (font-lock-string-face nil nil nil nil t)
 928                      ;;  (font-lock-keyword-face nil nil t nil nil)
 929                      ;;  (font-lock-function-name-face nil nil t t nil)
 930                      ;;  (font-lock-type-face nil nil nil t nil))
 931                      (list '(font-lock-comment-face nil nil t t nil)
 932                            '(font-lock-string-face nil nil nil t nil)
 933                            '(font-lock-keyword-face nil nil t nil nil)
 934                            (list
 935                             'font-lock-function-name-face
 936                             (cdr (assq 'background-color (frame-parameters)))
 937                             (cdr (assq 'foreground-color (frame-parameters)))
 938                             t nil nil)
 939                            '(font-lock-variable-name-face nil nil t t nil)
 940                            '(font-lock-type-face nil nil t nil t)
 941                            '(font-lock-reference-face nil nil t nil t)))
 942                     ((memq font-lock-display-type '(grayscale greyscale
 943                                                     grayshade greyshade))
 944                      (list
 945                       (list 'font-lock-comment-face
 946                             nil (if light-bg "Gray80" "DimGray") t t nil)
 947                       (list 'font-lock-string-face
 948                             nil (if light-bg "Gray50" "LightGray") nil t nil)
 949                       (list 'font-lock-keyword-face
 950                             nil (if light-bg "Gray90" "DimGray") t nil nil)
 951                       (list 'font-lock-function-name-face
 952                             (cdr (assq 'background-color (frame-parameters)))
 953                             (cdr (assq 'foreground-color (frame-parameters)))
 954                             t nil nil)
 955                       (list 'font-lock-variable-name-face
 956                             nil (if light-bg "Gray90" "DimGray") t t nil)
 957                       (list 'font-lock-type-face
 958                             nil (if light-bg "Gray80" "DimGray") t nil t)
 959                       (list 'font-lock-reference-face
 960                             nil (if light-bg "LightGray" "Gray50") t nil t)))
 961                     (light-bg           ; light colour background
 962                      '((font-lock-comment-face "Firebrick")
 963                        (font-lock-string-face "RosyBrown")
 964                        (font-lock-keyword-face "Purple")
 965                        (font-lock-function-name-face "Blue")
 966                        (font-lock-variable-name-face "DarkGoldenrod")
 967                        (font-lock-type-face "DarkOliveGreen")
 968                        (font-lock-reference-face "CadetBlue")))
 969                     (t                  ; dark colour background
 970                      '((font-lock-comment-face "OrangeRed")
 971                        (font-lock-string-face "LightSalmon")
 972                        (font-lock-keyword-face "LightSteelBlue")
 973                        (font-lock-function-name-face "LightSkyBlue")
 974                        (font-lock-variable-name-face "LightGoldenrod")
 975                        (font-lock-type-face "PaleGreen")
 976                        (font-lock-reference-face "Aquamarine")))))))
 977   ;; Now make the faces if we have to.
 978   (mapcar (function
 979            (lambda (face-attributes)
 980              (let ((face (nth 0 face-attributes)))
 981                (cond (override
 982                       ;; We can stomp all over it anyway.  Get outta my face!
 983                       (font-lock-make-face face-attributes))
 984                      ((and (boundp face) (facep (symbol-value face)))
 985                       ;; The variable exists and is already bound to a face.
 986                       nil)
 987                      ((facep face)
 988                       ;; We already have a face so we bind the variable to it.
 989                       (set face face))
 990                      (t
 991                       ;; No variable or no face.
 992                       (font-lock-make-face face-attributes))))))
 993           font-lock-face-attributes))
 994
 995 (defun font-lock-make-face (face-attributes)
 996   "Make a face from FACE-ATTRIBUTES.
 997 FACE-ATTRIBUTES should be like an element `font-lock-face-attributes', so that
 998 the face name is the first item in the list.  A variable with the same name as
 999 the face is also set; its value is the face name."
1000   (let* ((face (nth 0 face-attributes))
1001          (face-name (symbol-name face))
1002          (set-p (function (lambda (face-name resource)
1003                  (x-get-resource (concat face-name ".attribute" resource)
1004                                  (concat "Face.Attribute" resource)))))
1005          (on-p (function (lambda (face-name resource)
1006                 (let ((set (funcall set-p face-name resource)))
1007                   (and set (member (downcase set) '("on" "true"))))))))
1008     (make-face face)
1009     ;; Set attributes not set from X resources (and therefore `make-face').
1010     (or (funcall set-p face-name "Foreground")
1011         (condition-case nil
1012             (set-face-foreground face (nth 1 face-attributes))
1013           (error nil)))
1014     (or (funcall set-p face-name "Background")
1015         (condition-case nil
1016             (set-face-background face (nth 2 face-attributes))
1017           (error nil)))
1018     (if (funcall set-p face-name "Bold")
1019         (and (funcall on-p face-name "Bold") (make-face-bold face nil t))
1020       (and (nth 3 face-attributes) (make-face-bold face nil t)))
1021     (if (funcall set-p face-name "Italic")
1022         (and (funcall on-p face-name "Italic") (make-face-italic face nil t))
1023       (and (nth 4 face-attributes) (make-face-italic face nil t)))
1024     (or (funcall set-p face-name "Underline")
1025         (set-face-underline-p face (nth 5 face-attributes)))
1026     (set face face)))
1027 \f
1028 ;;; Various regexp information shared by several modes.
1029 ;;; Information specific to a single mode should go in its load library.
1030
1031 (defconst lisp-font-lock-keywords-1
1032   (list
1033    ;; Anything not a variable or type declaration is fontified as a function.
1034    ;; It would be cleaner to allow preceding whitespace, but it would also be
1035    ;; about five times slower.
1036    (list (concat "^(\\(def\\("
1037                  ;; Variable declarations.
1038                  "\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|var\\)\\|"
1039                  ;; Structure declarations.
1040                  "\\(class\\|struct\\|type\\)\\|"
1041                  ;; Everything else is a function declaration.
1042                  "\\([^ \t\n\(\)]+\\)"
1043                  "\\)\\)\\>"
1044                  ;; Any whitespace and declared object.
1045                  "[ \t'\(]*"
1046                  "\\([^ \t\n\)]+\\)?")
1047          '(1 font-lock-keyword-face)
1048          '(8 (cond ((match-beginning 3) font-lock-variable-name-face)
1049                    ((match-beginning 6) font-lock-type-face)
1050                    (t font-lock-function-name-face))
1051              nil t))
1052    )
1053  "Subdued level highlighting Lisp modes.")
1054
1055 (defconst lisp-font-lock-keywords-2
1056   (append lisp-font-lock-keywords-1
1057    (list
1058     ;;
1059     ;; Control structures.  ELisp and CLisp combined.
1060 ;      (make-regexp
1061 ;       '("cond" "if" "while" "let\\*?" "prog[nv12*]?" "catch" "throw"
1062 ;        "save-restriction" "save-excursion" "save-window-excursion"
1063 ;        "save-selected-window" "save-match-data" "unwind-protect"
1064 ;        "condition-case" "track-mouse"
1065 ;        "eval-after-load" "eval-and-compile" "eval-when-compile"
1066 ;        "when" "unless" "do" "flet" "labels" "return" "return-from"))
1067     (cons
1068      (concat
1069       "(\\("
1070       "\\(c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|do\\|"
1071       "eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|"
1072       "if\\|l\\(abels\\|et\\*?\\)\\|prog[nv12*]?\\|return\\(\\|-from\\)\\|"
1073       "save-\\(excursion\\|match-data\\|restriction\\|selected-window\\|"
1074       "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|"
1075       "un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)"
1076       "\\)\\>") 1)
1077     ;;
1078     ;; Words inside \\[] tend to be for `substitute-command-keys'.
1079     '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend)
1080     ;;
1081     ;; Words inside `' tend to be symbol names.
1082     '("`\\(\\sw\\sw+\\)'" 1 font-lock-reference-face prepend)
1083     ;;
1084     ;; CLisp `:' keywords as references.
1085     '("\\<:\\sw+\\>" 0 font-lock-reference-face prepend)
1086     ;;
1087     ;; ELisp and CLisp `&' keywords as types.
1088     '("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face)
1089     ))
1090   "Gaudy level highlighting for Lisp modes.")
1091
1092 (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1
1093   "Default expressions to highlight in Lisp modes.")
1094
1095
1096 (defvar scheme-font-lock-keywords
1097   (eval-when-compile
1098     (list
1099      ;;
1100      ;; Declarations.  Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
1101      ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
1102      (list (concat "(\\(define\\("
1103                    ;; Function names.
1104                    "\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)\\|"
1105                    ;; Macro names, as variable names.  A bit dubious, this.
1106                    "\\(-syntax\\)\\|"
1107                    ;; Class names.
1108                    "\\(-class\\)"
1109                    "\\)\\)\\>"
1110                    ;; Any whitespace and declared object.
1111                    "[ \t]*(?"
1112                    "\\(\\sw+\\)?")
1113            '(1 font-lock-keyword-face)
1114            '(8 (cond ((match-beginning 3) font-lock-function-name-face)
1115                      ((match-beginning 6) font-lock-variable-name-face)
1116                      (t font-lock-type-face))
1117                nil t))
1118      ;;
1119      ;; Control structures.
1120 ;(make-regexp '("begin" "call-with-current-continuation" "call/cc"
1121 ;              "call-with-input-file" "call-with-output-file" "case" "cond"
1122 ;              "do" "else" "for-each" "if" "lambda"
1123 ;              "let\\*?" "let-syntax" "letrec" "letrec-syntax"
1124 ;              ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
1125 ;              "and" "or" "delay"
1126 ;              ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
1127 ;              ;;"quasiquote" "quote" "unquote" "unquote-splicing"
1128 ;              "map" "syntax" "syntax-rules"))
1129      (cons
1130       (concat "(\\("
1131               "and\\|begin\\|c\\(a\\(ll\\(-with-\\(current-continuation\\|"
1132               "input-file\\|output-file\\)\\|/cc\\)\\|se\\)\\|ond\\)\\|"
1133               "d\\(elay\\|o\\)\\|else\\|for-each\\|if\\|"
1134               "l\\(ambda\\|et\\(-syntax\\|\\*?\\|rec\\(\\|-syntax\\)\\)\\)\\|"
1135               "map\\|or\\|syntax\\(\\|-rules\\)"
1136               "\\)\\>") 1)
1137      ;;
1138      ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
1139      '("\\<<\\sw+>\\>" . font-lock-type-face)
1140      ;;
1141      ;; Scheme `:' keywords as references.
1142      '("\\<:\\sw+\\>" . font-lock-reference-face)
1143      ))
1144 "Default expressions to highlight in Scheme modes.")
1145
1146
1147 (defconst c-font-lock-keywords-1 nil
1148   "Subdued level highlighting for C modes.")
1149
1150 (defconst c-font-lock-keywords-2 nil
1151   "Medium level highlighting for C modes.")
1152
1153 (defconst c-font-lock-keywords-3 nil
1154   "Gaudy level highlighting for C modes.")
1155
1156 (defconst c++-font-lock-keywords-1 nil
1157   "Subdued level highlighting for C++ modes.")
1158
1159 (defconst c++-font-lock-keywords-2 nil
1160   "Medium level highlighting for C++ modes.")
1161
1162 (defconst c++-font-lock-keywords-3 nil
1163   "Gaudy level highlighting for C++ modes.")
1164
1165 (defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit)
1166   ;; Match, and move over, any declaration/definition item after point.
1167   ;; The expect syntax of an item is "word" or "word::word", possibly ending
1168   ;; with optional whitespace and a "(".  Everything following the item (but
1169   ;; belonging to it) is expected to by skip-able by `forward-sexp', and items
1170   ;; are expected to be separated with a "," or ";".
1171   (if (looking-at "[ \t*&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*\\((\\)?")
1172       (save-match-data
1173         (condition-case nil
1174             (save-restriction
1175               ;; Restrict ourselves to the end of the line.
1176               (end-of-line)
1177               (narrow-to-region (point-min) (min limit (point)))
1178               (goto-char (match-end 1))
1179               ;; Move over any item value, etc., to the next item.
1180               (while (not (looking-at "[ \t]*\\([,;]\\|$\\)"))
1181                 (goto-char (or (scan-sexps (point) 1) (point-max))))
1182               (goto-char (match-end 0)))
1183           (error t)))))
1184
1185 (let ((c-keywords
1186 ;      ("break" "continue" "do" "else" "for" "if" "return" "switch" "while")
1187        "break\\|continue\\|do\\|else\\|for\\|if\\|return\\|switch\\|while")
1188       (c-type-types
1189 ;      ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
1190 ;       "signed" "unsigned" "short" "long" "int" "char" "float" "double"
1191 ;       "void" "volatile" "const")
1192        (concat "auto\\|c\\(har\\|onst\\)\\|double\\|e\\(num\\|xtern\\)\\|"
1193                "float\\|int\\|long\\|register\\|"
1194                "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|typedef\\|"
1195                "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)"))   ; 6 ()s deep.
1196       (c++-keywords
1197 ;      ("break" "continue" "do" "else" "for" "if" "return" "switch" "while"
1198 ;       "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try"
1199 ;       "protected" "private" "public")
1200        (concat "asm\\|break\\|c\\(atch\\|ontinue\\)\\|d\\(elete\\|o\\)\\|"
1201                "else\\|for\\|if\\|new\\|"
1202                "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|"
1203                "s\\(izeof\\|witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while"))
1204       (c++-type-types
1205 ;      ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
1206 ;       "signed" "unsigned" "short" "long" "int" "char" "float" "double"
1207 ;       "void" "volatile" "const" "class" "inline" "friend" "bool"
1208 ;       "virtual" "complex" "template")
1209        (concat "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|"
1210                "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|"
1211                "in\\(line\\|t\\)\\|long\\|register\\|"
1212                "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|"
1213                "t\\(emplate\\|ypedef\\)\\|un\\(ion\\|signed\\)\\|"
1214                "v\\(irtual\\|o\\(id\\|latile\\)\\)"))           ; 11 ()s deep.
1215       )
1216  (setq c-font-lock-keywords-1
1217   (list
1218    ;;
1219    ;; These are all anchored at the beginning of line for speed.
1220    ;;
1221    ;; Fontify function name definitions (GNU style; without type on line).
1222    (list (concat "^\\(\\sw+\\)[ \t]*(") 1 'font-lock-function-name-face)
1223    ;;
1224    ;; Fontify filenames in #include <...> preprocessor directives as strings.
1225    '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
1226    ;;
1227    ;; Fontify function macro names.
1228    '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face)
1229    ;;
1230    ;; Fontify symbol names in #if ... defined preprocessor directives.
1231    '("^#[ \t]*if\\>"
1232      ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
1233       (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)))
1234    ;;
1235    ;; Fontify otherwise as symbol names, and the preprocessor directive names.
1236    '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?"
1237      (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))
1238    ))
1239
1240  (setq c-font-lock-keywords-2
1241   (append c-font-lock-keywords-1
1242    (list
1243     ;;
1244     ;; Simple regexps for speed.
1245     ;;
1246     ;; Fontify all type specifiers.
1247     (cons (concat "\\<\\(" c-type-types "\\)\\>") 'font-lock-type-face)
1248     ;;
1249     ;; Fontify all builtin keywords (except case, default and goto; see below).
1250     (cons (concat "\\<\\(" c-keywords "\\)\\>") 'font-lock-keyword-face)
1251     ;;
1252     ;; Fontify case/goto keywords and targets, and case default/goto tags.
1253     '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?"
1254       (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
1255     '("^[ \t]*\\(\\sw+\\)[ \t]*:" 1 font-lock-reference-face)
1256     )))
1257
1258  (setq c-font-lock-keywords-3
1259   (append c-font-lock-keywords-2
1260    ;;
1261    ;; More complicated regexps for more complete highlighting for types.
1262    ;; We still have to fontify type specifiers individually, as C is so hairy.
1263    (list
1264     ;;
1265     ;; Fontify all storage classes and type specifiers, plus their items.
1266     (list (concat "\\<\\(" c-type-types "\\)\\>"
1267                   "\\([ \t*&]+\\sw+\\>\\)*")
1268           ;; Fontify each declaration item.
1269           '(font-lock-match-c++-style-declaration-item-and-skip-to-next
1270             ;; Start with point after all type specifiers.
1271             (goto-char (or (match-beginning 8) (match-end 1)))
1272             ;; Finish with point after first type specifier.
1273             (goto-char (match-end 1))
1274             ;; Fontify as a variable or function name.
1275             (1 (if (match-beginning 4)
1276                    font-lock-function-name-face
1277                  font-lock-variable-name-face))))
1278     ;;
1279     ;; Fontify structures, or typedef names, plus their items.
1280     '("\\(}\\)[ \t*]*\\sw"
1281       (font-lock-match-c++-style-declaration-item-and-skip-to-next
1282        (goto-char (match-end 1)) nil
1283        (1 (if (match-beginning 4)
1284               font-lock-function-name-face
1285             font-lock-variable-name-face))))
1286     ;;
1287     ;; Fontify anything at beginning of line as a declaration or definition.
1288     '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
1289       (1 font-lock-type-face)
1290       (font-lock-match-c++-style-declaration-item-and-skip-to-next
1291        (goto-char (or (match-beginning 2) (match-end 1))) nil
1292        (1 (if (match-beginning 4)
1293               font-lock-function-name-face
1294             font-lock-variable-name-face))))
1295     )))
1296
1297  (setq c++-font-lock-keywords-1
1298   (append
1299    ;;
1300    ;; The list `c-font-lock-keywords-1' less that for function names.
1301    (cdr c-font-lock-keywords-1)
1302    ;;
1303    ;; Fontify function name definitions, possibly incorporating class name.
1304    (list
1305     '("^\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*("
1306       (1 (if (match-beginning 2)
1307              font-lock-type-face
1308            font-lock-function-name-face))
1309       (3 (if (match-beginning 2) font-lock-function-name-face) nil t))
1310     )))
1311
1312  (setq c++-font-lock-keywords-2
1313   (append c++-font-lock-keywords-1
1314    (list
1315     ;;
1316     ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading.
1317     (cons (concat "\\<\\(" c++-type-types "\\)\\>") 'font-lock-type-face)
1318     ;;
1319     ;; Fontify operator function name overloading.
1320     '("\\<\\(operator\\)\\>[ \t]*\\([][)(><!=+-][][)(><!=+-]?\\)?"
1321       (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
1322     ;;
1323     ;; Fontify case/goto keywords and targets, and case default/goto tags.
1324     '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?"
1325       (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
1326     '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-reference-face)
1327     ;;
1328     ;; Fontify other builtin keywords.
1329     (cons (concat "\\<\\(" c++-keywords "\\)\\>") 'font-lock-keyword-face)
1330     )))
1331
1332  (setq c++-font-lock-keywords-3
1333   (append c++-font-lock-keywords-2
1334    ;;
1335    ;; More complicated regexps for more complete highlighting for types.
1336    (list
1337     ;;
1338     ;; Fontify all storage classes and type specifiers, plus their items.
1339     (list (concat "\\<\\(" c++-type-types "\\)\\>"
1340                   "\\([ \t*&]+\\sw+\\>\\)*")
1341           ;; Fontify each declaration item.
1342           '(font-lock-match-c++-style-declaration-item-and-skip-to-next
1343             ;; Start with point after all type specifiers.
1344             (goto-char (or (match-beginning 13) (match-end 1)))
1345             ;; Finish with point after first type specifier.
1346             (goto-char (match-end 1))
1347             ;; Fontify as a variable or function name.
1348             (1 (cond ((match-beginning 2) font-lock-type-face)
1349                      ((match-beginning 4) font-lock-function-name-face)
1350                      (t font-lock-variable-name-face)))
1351             (3 (if (match-beginning 4)
1352                    font-lock-function-name-face
1353                  font-lock-variable-name-face) nil t)))
1354     ;;
1355     ;; Fontify structures, or typedef names, plus their items.
1356     '("\\(}\\)[ \t*]*\\sw"
1357       (font-lock-match-c++-style-declaration-item-and-skip-to-next
1358        (goto-char (match-end 1)) nil
1359        (1 (if (match-beginning 4)
1360               font-lock-function-name-face
1361             font-lock-variable-name-face))))
1362     ;;
1363     ;; Fontify anything at beginning of line as a declaration or definition.
1364     '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
1365       (1 font-lock-type-face)
1366       (font-lock-match-c++-style-declaration-item-and-skip-to-next
1367        (goto-char (or (match-beginning 2) (match-end 1))) nil
1368        (1 (cond ((match-beginning 2) font-lock-type-face)
1369                 ((match-beginning 4) font-lock-function-name-face)
1370                 (t font-lock-variable-name-face)))
1371        (3 (if (match-beginning 4)
1372               font-lock-function-name-face
1373             font-lock-variable-name-face) nil t)))
1374     )))
1375  )
1376
1377 (defvar c-font-lock-keywords c-font-lock-keywords-1
1378   "Default expressions to highlight in C mode.")
1379
1380 (defvar c++-font-lock-keywords c++-font-lock-keywords-1
1381   "Default expressions to highlight in C++ mode.")
1382
1383
1384 (defvar tex-font-lock-keywords
1385 ;  ;; Regexps updated with help from Ulrik Dickow <dickow@nbi.dk>.
1386 ;  '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
1387 ;     2 font-lock-function-name-face)
1388 ;    ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}"
1389 ;     2 font-lock-reference-face)
1390 ;    ;; It seems a bit dubious to use `bold' and `italic' faces since we might
1391 ;    ;; not be able to display those fonts.
1392 ;    ("{\\\\bf\\([^}]+\\)}" 1 'bold keep)
1393 ;    ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep)
1394 ;    ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face)
1395 ;    ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
1396   ;; Rewritten and extended for LaTeX2e by Ulrik Dickow <dickow@nbi.dk>.
1397   '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
1398      2 font-lock-function-name-face)
1399     ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}"
1400      2 font-lock-reference-face)
1401     ("^[ \t]*\\\\def\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face)
1402     "\\\\\\([a-zA-Z@]+\\|.\\)"
1403     ;; It seems a bit dubious to use `bold' and `italic' faces since we might
1404     ;; not be able to display those fonts.
1405     ;; LaTeX2e: \emph{This is emphasized}.
1406     ("\\\\emph{\\([^}]+\\)}" 1 'italic keep)
1407     ;; LaTeX2e: \textbf{This is bold}, \textit{...}, \textsl{...}
1408     ("\\\\text\\(\\(bf\\)\\|it\\|sl\\){\\([^}]+\\)}"
1409      3 (if (match-beginning 2) 'bold 'italic) keep)
1410     ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for good tables.
1411     ("\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)"
1412      3 (if (match-beginning 2) 'bold 'italic) keep))
1413   "Default expressions to highlight in TeX modes.")
1414 \f
1415 ;; Install ourselves:
1416
1417 (or (assq 'font-lock-mode minor-mode-alist)
1418     (setq minor-mode-alist (cons '(font-lock-mode " Font") minor-mode-alist)))
1419
1420 ;; Provide ourselves:
1421
1422 (provide 'font-lock)
1423
1424 ;;; font-lock.el ends here