;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995 Amdahl Corporation.
-;; Copyright (C) 1996 Ben Wing.
+;; Copyright (C) 1996, 2000, 2001 Ben Wing.
;; Author: Jamie Zawinski <jwz@jwz.org>, for the LISPM Preservation Society.
;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org>
but not `font-lock-fontify-buffer'. (In other words, when you first visit
a file and it gets fontified, you will see status messages no matter what
size the file is. However, if you do something else like paste a
-chunk of text or revert a buffer, you will see status messages only if the
-changed region is large enough.)
+chunk of text, you will see status messages only if the changed region is
+large enough.)
Note that setting `font-lock-verbose' to nil disables the status
messages entirely."
(symbol :tag "name"))
(radio :tag "Decoration"
(const :tag "default" nil)
- (const :tag "maximum" t)
+ (const :tag "maximum" t)
(integer :tag "level" 1)))))
:group 'font-lock)
(integer :tag "size")))))
:group 'font-lock)
+;;;###autoload
+(defcustom font-lock-fontify-string-delimiters nil
+ "*If non-nil, apply font-lock-string-face to string delimiters as well as
+string text when fontifying."
+ :type 'boolean
+ :group 'font-lock)
\f
;; Fontification variables:
;;;###autoload
(defvar font-lock-keywords nil
- "A list of the keywords to highlight.
-Each element should be of the form:
+ "A list defining the keywords for `font-lock-mode' to highlight.
+
+ FONT-LOCK-KEYWORDS := List of FONT-LOCK-FORM's.
+
+ FONT-LOCK-FORM :== MATCHER
+ | (MATCHER . MATCH)
+ | (MATCHER . FACE-FORM)
+ | (MATCHER . HIGHLIGHT)
+ | (MATCHER HIGHLIGHT ...)
+ | (eval . FORM)
+
+ MATCHER :== A string containing a regexp.
+ | A variable containing a regexp to search for.
+ | A function to call to make the search.
+ It is called with one arg, the limit of the search,
+ and should leave MATCH results in the XEmacs global
+ match data.
+
+ MATCH :== An integer match subexpression number from MATCHER.
+
+ FACE-FORM :== The symbol naming a defined face.
+ | Expression whos value is the face name to use. If you
+ want FACE-FORM to be a symbol that evaluates to a face,
+ use a form like \"(progn sym)\".
+
+ HIGHLIGHT :== MATCH-HIGHLIGHT
+ | MATCH-ANCHORED
+
+ FORM :== Expression returning a FONT-LOCK-FORM, evaluated when
+ the FONT-LOCK-FORM is first used in a buffer. This
+ feature can be used to provide a FONT-LOCK-FORM that
+ can only be generated when Font Lock mode is actually
+ turned on.
+
+ MATCH-HIGHLIGHT :== (MATCH FACE-FORM OVERRIDE LAXMATCH)
+
+ OVERRIDE :== t - overwrite existing fontification
+ | 'keep - only parts not already fontified are
+ highlighted.
+ | 'prepend - merge faces, this fontification has
+ precedence over existing
+ | 'append - merge faces, existing fontification has
+ precedence over
+ this face.
+
+ LAXMATCH :== If non-nil, no error is signalled if there is no MATCH
+ in MATCHER.
+
+ MATCH-ANCHORED :== (ANCHOR-MATCHER PRE-MATCH-FORM \\
+ POST-MATCH-FORM MATCH-HIGHLIGHT ...)
+
+ ANCHOR-MATCHER :== Like a MATCHER, except that the limit of the search
+ defaults to the end of the line after PRE-MATCH-FORM
+ is evaluated. However, if PRE-MATCH-FORM returns a
+ position greater than the end of the line, that
+ position is used as the limit of the search. It is
+ generally a bad idea to return a position greater than
+ the end of the line, i.e., cause the ANCHOR-MATCHER
+ search to span lines.
+
+ PRE-MATCH-FORM :== Evaluated before the ANCHOR-MATCHER is used, therefore
+ can be used to initialize before, ANCHOR-MATCHER is
+ used. Typically, PRE-MATCH-FORM is used to move to
+ some position relative to the original MATCHER, before
+ starting with the ANCHOR-MATCHER.
+
+ POST-MATCH-FORM :== Like PRE-MATCH-FORM, but used to clean up after the
+ ANCHOR-MATCHER. It might be used to move, before
+ resuming with MATCH-ANCHORED's parent's MATCHER.
+
+For example, an element of the first form highlights (if not already highlighted):
+
+ \"\\\\\\=<foo\\\\\\=>\" Discrete occurrences of \"foo\" in the value
+ of the variable `font-lock-keyword-face'.
+
+ (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of
+ \"fubar\" in the value of
+ `font-lock-keyword-face'.
+
+ (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of
+ `fubar-face'.
+
+ (\"foo\\\\|bar\" 0 foo-bar-face t) Occurrences of either \"foo\" or \"bar\" in the
+ value of `foo-bar-face', even if already
+ highlighted.
+
+ (fubar-match 1 fubar-face) The first subexpression within all
+ occurrences of whatever the function
+ `fubar-match' finds and matches in the value
+ of `fubar-face'.
+
+ (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face)))
+ -------------- --------------- ------------ --- --- -------------
+ | | | | | |
+ MATCHER | ANCHOR-MATCHER | +------+ MATCH-HIGHLIGHT
+ MATCH-HIGHLIGHT PRE-MATCH-FORM |
+ POST-MATCH-FORM
+
+ Discrete occurrences of \"anchor\" in the value of `anchor-face', and
+ subsequent discrete occurrences of \"item\" (on the same line) in the value
+ of `item-face'. (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil.
+ Therefore \"item\" is initially searched for starting from the end of the
+ match of \"anchor\", and searching for subsequent instance of \"anchor\"
+ resumes from where searching for \"item\" concluded.)
- MATCHER
- (MATCHER . MATCH)
- (MATCHER . FACENAME)
- (MATCHER . HIGHLIGHT)
- (MATCHER HIGHLIGHT ...)
- (eval . FORM)
+For highlighting single items, typically only MATCH-HIGHLIGHT is required.
+However, if an item or (typically) several items are to be highlighted
+following the instance of another item (the anchor) then MATCH-ANCHORED may be
+required.
-where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED.
+These regular expressions should not match text which spans lines. While
+\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating when you
+edit the buffer does not, since it considers text one line at a time.
-FORM is an expression, whose value should be a keyword element,
-evaluated when the keyword is (first) used in a buffer. This feature
-can be used to provide a keyword that can only be generated when Font
-Lock mode is actually turned on.
+Be very careful composing regexps for this list; the wrong pattern can
+dramatically slow things down!
+")
-For highlighting single items, typically only MATCH-HIGHLIGHT is required.
-However, if an item or (typically) items is to be highlighted following the
-instance of another item (the anchor) then MATCH-ANCHORED may be required.
-
-MATCH-HIGHLIGHT should be of the form:
-
- (MATCH FACENAME OVERRIDE LAXMATCH)
-
-Where MATCHER can be either the regexp to search for, a variable
-containing the regexp to search for, or the function to call to make
-the search (called with one argument, the limit of the search). MATCH
-is the subexpression of MATCHER to be highlighted. FACENAME is either
-a symbol naming a face, or an expression whose value is the face name
-to use. If you want FACENAME to be a symbol that evaluates to a face,
-use a form like \"(progn sym)\".
-
-OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may
-be overwritten. If `keep', only parts not already fontified are highlighted.
-If `prepend' or `append', existing fontification is merged with the new, in
-which the new or existing fontification, respectively, takes precedence.
-If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER.
-
-For example, an element of the form highlights (if not already highlighted):
-
- \"\\\\\\=<foo\\\\\\=>\" Discrete occurrences of \"foo\" in the value of the
- variable `font-lock-keyword-face'.
- (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in
- the value of `font-lock-keyword-face'.
- (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'.
- (\"foo\\\\|bar\" 0 foo-bar-face t)
- Occurrences of either \"foo\" or \"bar\" in the value
- of `foo-bar-face', even if already highlighted.
-
-MATCH-ANCHORED should be of the form:
-
- (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...)
-
-Where MATCHER is as for MATCH-HIGHLIGHT with one exception; see below.
-PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after
-the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be
-used to initialize before, and cleanup after, MATCHER is used. Typically,
-PRE-MATCH-FORM is used to move to some position relative to the original
-MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might
-be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER.
-
-For example, an element of the form highlights (if not already highlighted):
-
- (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face)))
-
- Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent
- discrete occurrences of \"item\" (on the same line) in the value of `item-face'.
- (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is
- initially searched for starting from the end of the match of \"anchor\", and
- searching for subsequent instance of \"anchor\" resumes from where searching
- for \"item\" concluded.)
-
-The above-mentioned exception is as follows. The limit of the MATCHER search
-defaults to the end of the line after PRE-MATCH-FORM is evaluated.
-However, if PRE-MATCH-FORM returns a position greater than the position after
-PRE-MATCH-FORM is evaluated, that position is used as the limit of the search.
-It is generally a bad idea to return a position greater than the end of the
-line, i.e., cause the MATCHER search to span lines.
-
-Note that the MATCH-ANCHORED feature is experimental; in the future, we may
-replace it with other ways of providing this functionality.
+(defvar font-lock-keywords-alist nil
+ "Alist of additional `font-lock-keywords' elements for major modes.
-These regular expressions should not match text which spans lines. While
-\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating
-when you edit the buffer does not, since it considers text one line at a time.
+Each element has the form (MODE KEYWORDS . HOW).
+`font-lock-set-defaults' adds the elements in the list KEYWORDS to
+`font-lock-keywords' when Font Lock is turned on in major mode MODE.
+
+If HOW is nil, KEYWORDS are added at the beginning of
+`font-lock-keywords'. If it is `set', they are used to replace the
+value of `font-lock-keywords'. If HOW is any other non-nil value,
+they are added at the end.
+
+This is normally set via `font-lock-add-keywords' and
+`font-lock-remove-keywords'.")
+
+(defvar font-lock-removed-keywords-alist nil
+ "Alist of `font-lock-keywords' elements to be removed for major modes.
+
+Each element has the form (MODE . KEYWORDS). `font-lock-set-defaults'
+removes the elements in the list KEYWORDS from `font-lock-keywords'
+when Font Lock is turned on in major mode MODE.
+
+This is normally set via `font-lock-add-keywords' and
+`font-lock-remove-keywords'.")
-Be very careful composing regexps for this list;
-the wrong pattern can dramatically slow things down!")
;;;###autoload
(make-variable-buffer-local 'font-lock-keywords)
+;;;###autoload
+(defvar font-lock-syntactic-keywords nil
+ "A list of the syntactic keywords to highlight.
+Can be the list or the name of a function or variable whose value is the list.
+See `font-lock-keywords' for a description of the form of this list;
+the differences are listed below. MATCH-HIGHLIGHT should be of the form:
+
+ (MATCH SYNTAX OVERRIDE LAXMATCH)
+
+where SYNTAX can be of the form (SYNTAX-CODE . MATCHING-CHAR), the name of a
+syntax table, or an expression whose value is such a form or a syntax table.
+OVERRIDE cannot be `prepend' or `append'.
+
+For example, an element of the form highlights syntactically:
+
+ (\"\\\\$\\\\(#\\\\)\" 1 (1 . nil))
+
+ a hash character when following a dollar character, with a SYNTAX-CODE of
+ 1 (meaning punctuation syntax). Assuming that the buffer syntax table does
+ specify hash characters to have comment start syntax, the element will only
+ highlight hash characters that do not follow dollar characters as comments
+ syntactically.
+
+ (\"\\\\('\\\\).\\\\('\\\\)\"
+ (1 (7 . ?'))
+ (2 (7 . ?')))
+
+ both single quotes which surround a single character, with a SYNTAX-CODE of
+ 7 (meaning string quote syntax) and a MATCHING-CHAR of a single quote (meaning
+ a single quote matches a single quote). Assuming that the buffer syntax table
+ does not specify single quotes to have quote syntax, the element will only
+ highlight single quotes of the form 'c' as strings syntactically.
+ Other forms, such as foo'bar or 'fubar', will not be highlighted as strings.
+
+This is normally set via `font-lock-defaults'."
+)
+;;;###autoload
+(make-variable-buffer-local 'font-lock-syntactic-keywords)
+
(defvar font-lock-defaults nil
"The defaults font Font Lock mode for the current buffer.
Normally, do not set this directly. If you are writing a major mode,
This is normally set via `font-lock-defaults'.")
(make-variable-buffer-local 'font-lock-syntax-table)
-;; These are used in the FSF version in syntactic font-locking.
-;; We do this all in C.
-;;; These record the parse state at a particular position, always the
-;;; start of a line. Used to make
-;;; `font-lock-fontify-syntactically-region' faster.
-;(defvar font-lock-cache-position nil)
-;(defvar font-lock-cache-state nil)
-;(make-variable-buffer-local 'font-lock-cache-position)
-;(make-variable-buffer-local 'font-lock-cache-state)
+;; These record the parse state at a particular position, always the start of a
+;; line. Used to make `font-lock-fontify-syntactically-region' faster.
+;; Previously, `font-lock-cache-position' was just a buffer position. However,
+;; under certain situations, this occasionally resulted in mis-fontification.
+;; I think the "situations" were deletion with Lazy Lock mode's deferral. sm.
+(defvar font-lock-cache-state nil)
+(defvar font-lock-cache-position nil)
+(make-variable-buffer-local 'font-lock-cache-state)
+(make-variable-buffer-local 'font-lock-cache-position)
;; If this is nil, we only use the beginning of the buffer if we can't use
;; `font-lock-cache-position' and `font-lock-cache-state'.
;; #### barf gag retch. Horrid FSF lossage that we need to
;; keep around for compatibility with font-lock-keywords that
-;; forget to properly quote their faces.
+;; forget to properly quote their faces. I tried just let-binding
+;; them when we eval the face expression, but that fails because
+;; some files actually use the variables directly in their init code
+;; without quoting them. --ben
(defvar font-lock-comment-face 'font-lock-comment-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-doc-string-face 'font-lock-doc-string-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
+;; GNU compatibility
+(define-compatible-variable-alias
+ 'font-lock-doc-face 'font-lock-doc-string-face)
(defvar font-lock-string-face 'font-lock-string-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-keyword-face 'font-lock-keyword-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
+(defvar font-lock-builtin-face 'font-lock-builtin-face
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-function-name-face 'font-lock-function-name-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-variable-name-face 'font-lock-variable-name-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-type-face 'font-lock-type-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
+(defvar font-lock-constant-face 'font-lock-constant-face
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-reference-face 'font-lock-reference-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face
- "Don't even think of using this.")
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
+(defvar font-lock-warning-face 'font-lock-warning-face
+ "This variable should not be set.
+It is present only for horrid FSF compatibility reasons.
+The corresponding face should be set using `edit-faces' or the
+`set-face-*' functions.")
(defconst font-lock-face-list
'(font-lock-comment-face
font-lock-string-face
font-lock-doc-string-face
font-lock-keyword-face
+ font-lock-builtin-face
font-lock-function-name-face
font-lock-variable-name-face
font-lock-type-face
+ font-lock-constant-face
font-lock-reference-face
font-lock-preprocessor-face
font-lock-warning-face))
-;; #### There should be an emulation for the old font-lock-use-*
-;; settings!
-
(defface font-lock-comment-face
'((((class color) (background dark)) (:foreground "gray80"))
+ ;; blue4 is hardly different from black on windows.
+ (((class color) (background light) (type mswindows)) (:foreground "blue"))
(((class color) (background light)) (:foreground "blue4"))
(((class grayscale) (background light))
(:foreground "DimGray" :bold t :italic t))
(defface font-lock-keyword-face
'((((class color) (background dark)) (:foreground "cyan"))
+ ;; red4 is hardly different from black on windows.
+ (((class color) (background light) (type mswindows)) (:foreground "red"))
(((class color) (background light)) (:foreground "red4"))
(((class grayscale) (background light)) (:foreground "LightGray" :bold t))
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
"Font Lock mode face used to highlight keywords."
:group 'font-lock-faces)
+(defface font-lock-builtin-face
+ '((((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (t (:bold t)))
+ "Font Lock mode face used to highlight builtins."
+:group 'font-lock-faces)
+
(defface font-lock-function-name-face
'((((class color) (background dark)) (:foreground "aquamarine"))
+ ;; brown4 is hardly different from black on windows.
+ ;; I changed it to red because IMO it's pointless and ugly to
+ ;; use a million slightly different colors for niggly syntactic
+ ;; differences. --ben
+ (((class color) (background light) (type mswindows)) (:foreground "red"))
(((class color) (background light)) (:foreground "brown4"))
(t (:bold t :underline t)))
"Font Lock mode face used to highlight function names."
"Font Lock mode face used to highlight types."
:group 'font-lock-faces)
+(defface font-lock-constant-face
+ '((((class color) (background light)) (:foreground "CadetBlue"))
+ (((class color) (background dark)) (:foreground "Aquamarine"))
+ (((class grayscale) (background light))
+ (:foreground "LightGray" :bold t :underline t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray50" :bold t :underline t))
+ (t (:bold t :underline t)))
+ "Font Lock mode face used to highlight constants and labels."
+:group 'font-lock-faces)
+
(defface font-lock-reference-face
'((((class color) (background dark)) (:foreground "cadetblue2"))
(((class color) (background light)) (:foreground "red3"))
"Font Lock mode face used to highlight references."
:group 'font-lock-faces)
-;; #### FSF has font-lock-builtin-face.
-
(defface font-lock-preprocessor-face
'((((class color) (background dark)) (:foreground "steelblue1"))
(((class color) (background light)) (:foreground "blue3"))
"Font Lock Mode face used to highlight preprocessor conditionals."
:group 'font-lock-faces)
-;; #### Currently unused
(defface font-lock-warning-face
'((((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Pink" :bold t))
(setq font-lock-maximum-decoration t)
(font-lock-recompute-variables)))
+(defun font-lock-add-keywords (mode keywords &optional how)
+ "Add highlighting KEYWORDS for MODE.
+
+MODE should be a symbol, the major mode command name, such as `c-mode'
+or nil. If nil, highlighting keywords are added for the current buffer.
+KEYWORDS should be a list; see the variable `font-lock-keywords'.
+By default they are added at the beginning of the current highlighting list.
+If optional argument HOW is `set', they are used to replace the current
+highlighting list. If HOW is any other non-nil value, they are added at the
+end of the current highlighting list.
+
+For example:
+
+ (font-lock-add-keywords 'c-mode
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
+
+adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
+comments, and to fontify `and', `or' and `not' words as keywords.
+
+The above procedure will only add the keywords for C mode, not
+for modes derived from C mode. To add them for derived modes too,
+pass nil for MODE and add the call to c-mode-hook.
+
+For example:
+
+ (add-hook 'c-mode-hook
+ (lambda ()
+ (font-lock-add-keywords nil
+ '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
+ font-lock-keyword-face)))))
+
+The above procedure may fail to add keywords to derived modes if
+some involved major mode does not follow the standard conventions.
+File a bug report if this happens, so the major mode can be corrected.
+
+Note that some modes have specialized support for additional patterns, e.g.,
+see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
+`objc-font-lock-extra-types' and `java-font-lock-extra-types'."
+ (cond (mode
+ ;; If MODE is non-nil, add the KEYWORDS and HOW spec to
+ ;; `font-lock-keywords-alist' so `font-lock-set-defaults' uses them.
+ (let ((spec (cons keywords how)) cell)
+ (if (setq cell (assq mode font-lock-keywords-alist))
+ (if (eq how 'set)
+ (setcdr cell (list spec))
+ (setcdr cell (append (cdr cell) (list spec))))
+ (push (list mode spec) font-lock-keywords-alist)))
+ ;; Make sure that `font-lock-removed-keywords-alist' does not
+ ;; contain the new keywords.
+ (font-lock-update-removed-keyword-alist mode keywords how))
+ (t
+ ;; Otherwise set or add the keywords now.
+ ;; This is a no-op if it has been done already in this buffer
+ ;; for the correct major mode.
+ (font-lock-set-defaults)
+ (let ((was-compiled (eq (car font-lock-keywords) t)))
+ ;; Bring back the user-level (uncompiled) keywords.
+ (if was-compiled
+ (setq font-lock-keywords (cadr font-lock-keywords)))
+ ;; Now modify or replace them.
+ (if (eq how 'set)
+ (setq font-lock-keywords keywords)
+ (font-lock-remove-keywords nil keywords) ;to avoid duplicates
+ (let ((old (if (eq (car-safe font-lock-keywords) t)
+ (cdr font-lock-keywords)
+ font-lock-keywords)))
+ (setq font-lock-keywords (if how
+ (append old keywords)
+ (append keywords old)))))
+ ;; If the keywords were compiled before, compile them again.
+ (if was-compiled
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))))))
+
+(defun font-lock-update-removed-keyword-alist (mode keywords how)
+ "Update `font-lock-removed-keywords-alist' when adding new KEYWORDS to MODE."
+ ;; When font-lock is enabled first all keywords in the list
+ ;; `font-lock-keywords-alist' are added, then all keywords in the
+ ;; list `font-lock-removed-keywords-alist' are removed. If a
+ ;; keyword was once added, removed, and then added again it must be
+ ;; removed from the removed-keywords list. Otherwise the second add
+ ;; will not take effect.
+ (let ((cell (assq mode font-lock-removed-keywords-alist)))
+ (if cell
+ (if (eq how 'set)
+ ;; A new set of keywords is defined. Forget all about
+ ;; our old keywords that should be removed.
+ (setq font-lock-removed-keywords-alist
+ (delq cell font-lock-removed-keywords-alist))
+ ;; Delete all previously removed keywords.
+ (dolist (kword keywords)
+ (setcdr cell (delete kword (cdr cell))))
+ ;; Delete the mode cell if empty.
+ (if (null (cdr cell))
+ (setq font-lock-removed-keywords-alist
+ (delq cell font-lock-removed-keywords-alist)))))))
+
+;; Written by Anders Lindgren <andersl@andersl.com>.
+;;
+;; Case study:
+;; (I) The keywords are removed from a major mode.
+;; In this case the keyword could be local (i.e. added earlier by
+;; `font-lock-add-keywords'), global, or both.
+;;
+;; (a) In the local case we remove the keywords from the variable
+;; `font-lock-keywords-alist'.
+;;
+;; (b) The actual global keywords are not known at this time.
+;; All keywords are added to `font-lock-removed-keywords-alist',
+;; when font-lock is enabled those keywords are removed.
+;;
+;; Note that added keywords are taken out of the list of removed
+;; keywords. This ensure correct operation when the same keyword
+;; is added and removed several times.
+;;
+;; (II) The keywords are removed from the current buffer.
+(defun font-lock-remove-keywords (mode keywords)
+ "Remove highlighting KEYWORDS for MODE.
+
+MODE should be a symbol, the major mode command name, such as `c-mode'
+or nil. If nil, highlighting keywords are removed for the current buffer.
+
+To make the removal apply to modes derived from MODE as well,
+pass nil for MODE and add the call to MODE-hook. This may fail
+for some derived modes if some involved major mode does not
+follow the standard conventions. File a bug report if this
+happens, so the major mode can be corrected."
+ (cond (mode
+ ;; Remove one keyword at the time.
+ (dolist (keyword keywords)
+ (let ((top-cell (assq mode font-lock-keywords-alist)))
+ ;; If MODE is non-nil, remove the KEYWORD from
+ ;; `font-lock-keywords-alist'.
+ (when top-cell
+ (dolist (keyword-list-how-pair (cdr top-cell))
+ ;; `keywords-list-how-pair' is a cons with a list of
+ ;; keywords in the car top-cell and the original how
+ ;; argument in the cdr top-cell.
+ (setcar keyword-list-how-pair
+ (delete keyword (car keyword-list-how-pair))))
+ ;; Remove keyword list/how pair when the keyword list
+ ;; is empty and how doesn't specify `set'. (If it
+ ;; should be deleted then previously deleted keywords
+ ;; would appear again.)
+ (let ((cell top-cell))
+ (while (cdr cell)
+ (if (and (null (car (car (cdr cell))))
+ (not (eq (cdr (car (cdr cell))) 'set)))
+ (setcdr cell (cdr (cdr cell)))
+ (setq cell (cdr cell)))))
+ ;; Final cleanup, remove major mode cell if last keyword
+ ;; was deleted.
+ (if (null (cdr top-cell))
+ (setq font-lock-keywords-alist
+ (delq top-cell font-lock-keywords-alist))))
+ ;; Remember the keyword in case it is not local.
+ (let ((cell (assq mode font-lock-removed-keywords-alist)))
+ (if cell
+ (unless (member keyword (cdr cell))
+ (nconc cell (list keyword)))
+ (push (cons mode (list keyword))
+ font-lock-removed-keywords-alist))))))
+ (t
+ ;; Otherwise remove it immediately.
+ (font-lock-set-defaults)
+ (let ((was-compiled (eq (car font-lock-keywords) t)))
+ ;; Bring back the user-level (uncompiled) keywords.
+ (if was-compiled
+ (setq font-lock-keywords (cadr font-lock-keywords)))
+
+ ;; Edit them.
+ (setq font-lock-keywords (copy-sequence font-lock-keywords))
+ (dolist (keyword keywords)
+ (setq font-lock-keywords
+ (delete keyword font-lock-keywords)))
+
+ ;; If the keywords were compiled before, compile them again.
+ (if was-compiled
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))))))
\f
;;;;;;;;;;;;;;;;;;;;;; actual code ;;;;;;;;;;;;;;;;;;;;;;
font-lock-maximum-size
(cdr (or (assq major-mode font-lock-maximum-size)
(assq t font-lock-maximum-size))))))
- ;; Font-lock mode will refuse to turn itself on if in batch mode, or if
- ;; the current buffer is "invisible". The latter is because packages
- ;; sometimes put their temporary buffers into some particular major mode
- ;; to get syntax tables and variables and whatnot, but we don't want the
- ;; fact that the user has font-lock-mode on a mode hook to slow these
- ;; things down.
- (if (or noninteractive (eq (aref (buffer-name) 0) ?\ ))
- (setq on-p nil))
- (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp...
+ ;; Font-lock mode will refuse to turn itself on if in batch mode
+ ;; to avoid potential (probably not actual, though) slowdown. We
+ ;; used to try to "be nice" by avoiding doing this in temporary
+ ;; buffers. But with the deferral code we don't need this, and it
+ ;; definitely screws some things up.
+ (if (noninteractive)
(setq on-p nil))
(cond (on-p
(make-local-hook 'after-change-functions)
(set (make-local-variable 'font-lock-mode) on-p)
(cond (on-p
(font-lock-set-defaults-1)
- (make-local-hook 'before-revert-hook)
- (make-local-hook 'after-revert-hook)
- ;; If buffer is reverted, must clean up the state.
- (add-hook 'before-revert-hook 'font-lock-revert-setup nil t)
- (add-hook 'after-revert-hook 'font-lock-revert-cleanup nil t)
(run-hooks 'font-lock-mode-hook)
(cond (font-lock-fontified
nil)
((or (null maximum-size) (<= (buffer-size) maximum-size))
(font-lock-fontify-buffer))
(font-lock-verbose
- (lmessage 'command "Fontifying %s... buffer too big."
- (buffer-name)))))
+ (progress-feedback-with-label
+ 'font-lock
+ "Fontifying %s... buffer too big." 'abort
+ (buffer-name)))))
(font-lock-fontified
(setq font-lock-fontified nil)
- (remove-hook 'before-revert-hook 'font-lock-revert-setup t)
- (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t)
(font-lock-unfontify-region (point-min) (point-max))
(font-lock-thing-lock-cleanup))
(t
- (remove-hook 'before-revert-hook 'font-lock-revert-setup t)
- (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t)
(font-lock-thing-lock-cleanup)))
(redraw-modeline)))
;;;###autoload
(defun turn-on-font-lock ()
"Unconditionally turn on Font Lock mode."
+ (interactive)
(font-lock-mode 1))
;;;###autoload
(defun turn-off-font-lock ()
"Unconditionally turn off Font Lock mode."
+ (interactive)
(font-lock-mode 0))
;;; FSF has here:
(defsubst font-lock-remove-face (start end)
;; Remove any syntax highlighting on the characters in the range.
(put-nonduplicable-text-property start end 'face nil)
- (put-nonduplicable-text-property start end 'font-lock nil))
+ (put-nonduplicable-text-property start end 'font-lock nil)
+ (if lookup-syntax-properties
+ (put-nonduplicable-text-property start end 'syntax-table nil)))
+
+(defsubst font-lock-set-syntax (start end syntax)
+ ;; Set the face on the characters in the range.
+ (put-nonduplicable-text-property start end 'syntax-table syntax)
+ (put-nonduplicable-text-property start end 'font-lock t))
(defsubst font-lock-any-faces-p (start end)
;; Return non-nil if we've put any syntax highlighting on
(defun font-lock-unfontify-region (beg end &optional loudly)
(funcall font-lock-unfontify-region-function beg end loudly))
-;; #### In these functions, the FSF is careful to do
-;; (save-restriction
-;; (widen)
-;; before anything else. Should we copy?
(defun font-lock-default-fontify-buffer ()
(interactive)
- (let ((was-on font-lock-mode)
- (font-lock-verbose (or font-lock-verbose (interactive-p)))
- (font-lock-message-threshold 0)
- (aborted nil))
- ;; Turn it on to run hooks and get the right font-lock-keywords.
- (or was-on (font-lock-mode 1))
- (font-lock-unfontify-region (point-min) (point-max) t)
-;; (buffer-syntactic-context-flush-cache)
+ ;; if we don't widen, then the C code will fail to
+ ;; realize that we're inside a comment.
+ (save-restriction
+ (widen)
+ (let ((was-on font-lock-mode)
+ (font-lock-verbose (or font-lock-verbose (interactive-p)))
+ (font-lock-message-threshold 0)
+ (aborted nil))
+ ;; Turn it on to run hooks and get the right font-lock-keywords.
+ (or was-on (font-lock-mode 1))
+ (font-lock-unfontify-region (point-min) (point-max) t)
+ ;; (buffer-syntactic-context-flush-cache)
- ;; If a ^G is typed during fontification, abort the fontification, but
- ;; return normally (do not signal.) This is to make it easy to abort
- ;; fontification if it's taking a long time, without also causing the
- ;; buffer not to pop up. If a real abort is desired, the user can ^G
- ;; again.
- ;;
- ;; Possibly this should happen down in font-lock-fontify-region instead
- ;; of here, but since that happens from the after-change-hook (meaning
- ;; much more frequently) I'm afraid of the bad consequences of stealing
- ;; the interrupt character at inopportune times.
- ;;
- (condition-case nil
- (save-excursion
- (font-lock-fontify-region (point-min) (point-max)))
- (quit
- (setq aborted t)))
-
- (or was-on ; turn it off if it was off.
- (let ((font-lock-fontified nil)) ; kludge to prevent defontification
- (font-lock-mode 0)))
- (set (make-local-variable 'font-lock-fontified) t)
- (when (and aborted font-lock-verbose)
- (lmessage 'command "Fontifying %s... aborted." (buffer-name))))
- (run-hooks 'font-lock-after-fontify-buffer-hook))
+ ;; If a ^G is typed during fontification, abort the fontification, but
+ ;; return normally (do not signal.) This is to make it easy to abort
+ ;; fontification if it's taking a long time, without also causing the
+ ;; buffer not to pop up. If a real abort is desired, the user can ^G
+ ;; again.
+ ;;
+ ;; Possibly this should happen down in font-lock-fontify-region instead
+ ;; of here, but since that happens from the after-change-hook (meaning
+ ;; much more frequently) I'm afraid of the bad consequences of stealing
+ ;; the interrupt character at inopportune times.
+ ;;
+ (condition-case nil
+ (save-excursion
+ (font-lock-fontify-region (point-min) (point-max)))
+ (t
+ (setq aborted t)))
+
+ (or was-on ; turn it off if it was off.
+ (let ((font-lock-fontified nil)) ; kludge to prevent defontification
+ (font-lock-mode 0)))
+ (set (make-local-variable 'font-lock-fontified) t)
+ (when (and aborted font-lock-verbose)
+ (progress-feedback-with-label 'font-lock "Fontifying %s... aborted."
+ 'abort (buffer-name))))
+ (run-hooks 'font-lock-after-fontify-buffer-hook)))
(defun font-lock-default-unfontify-buffer ()
(font-lock-unfontify-region (point-min) (point-max))
;; Use the fontification syntax table, if any.
(if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
;; Now do the fontification.
- (if font-lock-keywords-only
- (font-lock-unfontify-region beg end)
+ (font-lock-unfontify-region beg end)
+ (when font-lock-syntactic-keywords
+ (font-lock-fontify-syntactic-keywords-region beg end))
+ (unless font-lock-keywords-only
(font-lock-fontify-syntactically-region beg end loudly))
(font-lock-fontify-keywords-region beg end loudly))
;; Clean up.
(defun font-lock-default-unfontify-region (beg end &optional maybe-loudly)
(when (and maybe-loudly font-lock-verbose
(>= (- end beg) font-lock-message-threshold))
- (lmessage 'progress "Fontifying %s..." (buffer-name)))
+ (progress-feedback-with-label 'font-lock "Fontifying %s..." 0
+ (buffer-name)))
(let ((modified (buffer-modified-p))
(buffer-undo-list t) (inhibit-read-only t)
buffer-file-name buffer-file-truename)
(and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))
;; Following is the original FSF version (similar to our original
-;; version, before all the crap I added below).
-;;
-;; Probably that crap should either be fixed up so it works better,
-;; or tossed away.
+;; version, before the deferred stuff was added).
;;
;; I think that lazy-lock v2 tries to do something similar.
;; Those efforts should be merged.
; (progn (goto-char beg) (beginning-of-line) (point))
; (progn (goto-char end) (forward-line 1) (point))))))
-(defvar font-lock-old-extent nil)
-(defvar font-lock-old-len 0)
-
-(defun font-lock-fontify-glumped-region ()
- ;; even if something goes wrong in the fontification, mark the glumped
- ;; region as fontified; otherwise, the same error might get signaled
- ;; after every command.
- (unwind-protect
- ;; buffer/extent may be deleted.
- (if (and (extent-live-p font-lock-old-extent)
- (buffer-live-p (extent-object font-lock-old-extent)))
- (save-excursion
- (set-buffer (extent-object font-lock-old-extent))
- (font-lock-after-change-function-1
- (extent-start-position font-lock-old-extent)
- (extent-end-position font-lock-old-extent)
- font-lock-old-len)))
- (detach-extent font-lock-old-extent)
- (setq font-lock-old-extent nil)))
+(defvar font-lock-always-fontify-immediately nil
+ "Set this to non-nil to disable font-lock deferral.
+Otherwise, changes to existing text will not be processed until the
+next redisplay cycle, avoiding excessive fontification when many
+buffer modifications are performed or a buffer is reverted.")
-(defun font-lock-pre-idle-hook ()
- (condition-case nil
- (if font-lock-old-extent
- (font-lock-fontify-glumped-region))
- (error (warn "Error caught in `font-lock-pre-idle-hook'"))))
+;; list of buffers in which there is a pending change.
+(defvar font-lock-pending-buffer-table (make-hash-table :weakness 'key))
+;; table used to keep track of ranges needing fontification.
+(defvar font-lock-range-table (make-range-table))
-(defvar font-lock-always-fontify-immediately nil
- "Set this to non-nil to disable font-lock deferral.")
+(defun font-lock-pre-idle-hook ()
+ (condition-case font-lock-error
+ (if (> (hash-table-count font-lock-pending-buffer-table) 0)
+ (font-lock-fontify-pending-extents))
+ (error (warn "Error caught in `font-lock-pre-idle-hook': %s"
+ font-lock-error))))
;;; called when any modification is made to buffer text. This function
-;;; attempts to glump adjacent changes together so that excessive
-;;; fontification is avoided. This function could easily be adapted
-;;; to other after-change-functions.
+;;; remembers the changed ranges until the next redisplay, at which point
+;;; the extents are merged and pruned, and the resulting ranges fontified.
+;;; This function could easily be adapted to other after-change-functions.
(defun font-lock-after-change-function (beg end old-len)
- (let ((obeg (and font-lock-old-extent
- (extent-start-position font-lock-old-extent)))
- (oend (and font-lock-old-extent
- (extent-end-position font-lock-old-extent)))
- (bc-end (+ beg old-len)))
-
- ;; If this change can't be merged into the glumped one,
- ;; we need to fontify the glumped one right now.
- (if (and font-lock-old-extent
- (or (not (eq (current-buffer)
- (extent-object font-lock-old-extent)))
- (< bc-end obeg)
- (> beg oend)))
- (font-lock-fontify-glumped-region))
-
- (if font-lock-old-extent
- ;; Update glumped region.
- (progn
- ;; Any characters in the before-change region that are
- ;; outside the glumped region go into the glumped
- ;; before-change region.
- (if (> bc-end oend)
- (setq font-lock-old-len (+ font-lock-old-len (- bc-end oend))))
- (if (> obeg beg)
- (setq font-lock-old-len (+ font-lock-old-len (- obeg beg))))
- ;; New glumped region is the union of the glumped region
- ;; and the new region.
- (set-extent-endpoints font-lock-old-extent
- (min obeg beg)
- (max oend end)))
-
- ;; No glumped region, so create one.
- (setq font-lock-old-extent (make-extent beg end))
- (set-extent-property font-lock-old-extent 'detachable nil)
- (set-extent-property font-lock-old-extent 'end-open nil)
- (setq font-lock-old-len old-len))
-
+ (when font-lock-mode
+ ;; treat deletions as if the following character (or previous, if
+ ;; there is no following) were inserted. (also use the previous
+ ;; character at end of line. this avoids a problem when you
+ ;; insert a comment on the line before a line of code: if we use
+ ;; the following char, then when you hit backspace, the following
+ ;; line of code turns the comment color.) this is a bit of a hack
+ ;; but allows us to use text properties for everything.
+ (if (= beg end)
+ (cond ((not (save-excursion (goto-char end) (eolp)))
+ (setq end (1+ end)))
+ ((/= beg (point-min)) (setq beg (1- beg)))
+ (t nil)))
+ (put-text-property beg end 'font-lock-pending t)
+ (puthash (current-buffer) t font-lock-pending-buffer-table)
(if font-lock-always-fontify-immediately
- (font-lock-fontify-glumped-region))))
-
-(defun font-lock-after-change-function-1 (beg end old-len)
- (if (null font-lock-mode)
- nil
- (save-excursion
- (save-restriction
- ;; if we don't widen, then fill-paragraph (and any command that
- ;; operates on a narrowed region) confuses things, because the C
- ;; code will fail to realize that we're inside a comment.
- (widen)
- (save-match-data
- (let ((zmacs-region-stays zmacs-region-stays)) ; protect from change!
- (goto-char beg)
- ;; Maybe flush the internal cache used by syntactically-sectionize.
- ;; (It'd be nice if this was more automatic.) Any deletions mean
- ;; the cache is invalid, and insertions at beginning or end of line
- ;; mean that the bol cache might be invalid.
-;; (if (or (> old-len 0) (bobp) (= (preceding-char) ?\n))
-;; (buffer-syntactic-context-flush-cache))
-
- ;; Always recompute the whole line.
- (goto-char end)
- (forward-line 1)
- (setq end (point))
- (goto-char beg)
- (beginning-of-line)
- (setq beg (point))
- ;; Rescan between start of line from `beg' and start of line after
- ;; `end'.
- (font-lock-fontify-region beg end)))))))
-
+ (font-lock-fontify-pending-extents))))
+
+(defun font-lock-fontify-pending-extents ()
+ ;; ah, the beauty of mapping functions.
+ ;; this function is actually shorter than the old version, which handled
+ ;; only one buffer and one contiguous region!
+ (save-match-data
+ (maphash
+ #'(lambda (buffer dummy)
+ ;; remove first, to avoid infinite reprocessing if error
+ (remhash buffer font-lock-pending-buffer-table)
+ (when (buffer-live-p buffer)
+ (clear-range-table font-lock-range-table)
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ ;; if we don't widen, then the C code in
+ ;; syntactically-sectionize will fail to realize that
+ ;; we're inside a comment. #### We don't actually use
+ ;; syntactically-sectionize any more. Do we still
+ ;; need the widen?
+ (widen)
+ (let ((zmacs-region-stays
+ zmacs-region-stays)) ; protect from change!
+ (map-extents
+ #'(lambda (ex dummy-maparg)
+ ;; first expand the ranges to full lines,
+ ;; because that is what will be fontified;
+ ;; then use a range table to merge the
+ ;; ranges. (we could also do this simply using
+ ;; text properties. the range table code was
+ ;; here from a previous version of this code
+ ;; and works just as well.)
+ (let* ((beg (extent-start-position ex))
+ (end (extent-end-position ex))
+ (beg (progn (goto-char beg)
+ (beginning-of-line)
+ (point)))
+ (end (progn (goto-char end)
+ (forward-line 1)
+ (point))))
+ (put-range-table beg end t
+ font-lock-range-table)))
+ nil nil nil nil nil 'font-lock-pending t)
+ ;; clear all pending extents first in case of error below.
+ (put-text-property (point-min) (point-max)
+ 'font-lock-pending nil)
+ (map-range-table
+ #'(lambda (beg end val)
+ ;; This creates some unnecessary progress gauges.
+;; (if (and (= beg (point-min))
+;; (= end (point-max)))
+;; (font-lock-fontify-buffer)
+;; (font-lock-fontify-region beg end)))
+ (font-lock-fontify-region beg end))
+ font-lock-range-table)))))))
+ font-lock-pending-buffer-table)))
\f
;; Syntactic fontification functions.
-;; Note: Here is the FSF version. Our version is much faster because
-;; of the C support we provide. This may be useful for reference,
-;; however, and perhaps there is something useful here that should
-;; be merged into our version.
-;;
-;(defun font-lock-fontify-syntactically-region (start end &optional loudly)
-; "Put proper face on each string and comment between START and END.
-;START should be at the beginning of a line."
-; (let ((synstart (if comment-start-skip
-; (concat "\\s\"\\|" comment-start-skip)
-; "\\s\""))
-; (comstart (if comment-start-skip
-; (concat "\\s<\\|" comment-start-skip)
-; "\\s<"))
-; state prev prevstate)
-; (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
-; (save-restriction
-; (widen)
-; (goto-char start)
-; ;;
-; ;; Find the state at the `beginning-of-line' before `start'.
-; (if (eq start font-lock-cache-position)
-; ;; Use the cache for the state of `start'.
-; (setq state font-lock-cache-state)
-; ;; Find the state of `start'.
-; (if (null font-lock-beginning-of-syntax-function)
-; ;; Use the state at the previous cache position, if any, or
-; ;; otherwise calculate from `point-min'.
-; (if (or (null font-lock-cache-position)
-; (< start font-lock-cache-position))
-; (setq state (parse-partial-sexp (point-min) start))
-; (setq state (parse-partial-sexp font-lock-cache-position start
-; nil nil font-lock-cache-state)))
-; ;; Call the function to move outside any syntactic block.
-; (funcall font-lock-beginning-of-syntax-function)
-; (setq state (parse-partial-sexp (point) start)))
-; ;; Cache the state and position of `start'.
-; (setq font-lock-cache-state state
-; font-lock-cache-position start))
-; ;;
-; ;; If the region starts inside a string, show the extent of it.
-; (if (nth 3 state)
-; (let ((beg (point)))
-; (while (and (re-search-forward "\\s\"" end 'move)
-; (nth 3 (parse-partial-sexp beg (point)
-; nil nil state))))
-; (put-text-property beg (point) 'face font-lock-string-face)
-; (setq state (parse-partial-sexp beg (point) nil nil state))))
-; ;;
-; ;; Likewise for a comment.
-; (if (or (nth 4 state) (nth 7 state))
-; (let ((beg (point)))
-; (save-restriction
-; (narrow-to-region (point-min) end)
-; (condition-case nil
-; (progn
-; (re-search-backward comstart (point-min) 'move)
-; (forward-comment 1)
-; ;; forward-comment skips all whitespace,
-; ;; so go back to the real end of the comment.
-; (skip-chars-backward " \t"))
-; (error (goto-char end))))
-; (put-text-property beg (point) 'face font-lock-comment-face)
-; (setq state (parse-partial-sexp beg (point) nil nil state))))
-; ;;
-; ;; Find each interesting place between here and `end'.
-; (while (and (< (point) end)
-; (setq prev (point) prevstate state)
-; (re-search-forward synstart end t)
-; (progn
-; ;; Clear out the fonts of what we skip over.
-; (remove-text-properties prev (point) '(face nil))
-; ;; Verify the state at that place
-; ;; so we don't get fooled by \" or \;.
-; (setq state (parse-partial-sexp prev (point)
-; nil nil state))))
-; (let ((here (point)))
-; (if (or (nth 4 state) (nth 7 state))
-; ;;
-; ;; We found a real comment start.
-; (let ((beg (match-beginning 0)))
-; (goto-char beg)
-; (save-restriction
-; (narrow-to-region (point-min) end)
-; (condition-case nil
-; (progn
-; (forward-comment 1)
-; ;; forward-comment skips all whitespace,
-; ;; so go back to the real end of the comment.
-; (skip-chars-backward " \t"))
-; (error (goto-char end))))
-; (put-text-property beg (point) 'face
-; font-lock-comment-face)
-; (setq state (parse-partial-sexp here (point) nil nil state)))
-; (if (nth 3 state)
-; ;;
-; ;; We found a real string start.
-; (let ((beg (match-beginning 0)))
-; (while (and (re-search-forward "\\s\"" end 'move)
-; (nth 3 (parse-partial-sexp here (point)
-; nil nil state))))
-; (put-text-property beg (point) 'face font-lock-string-face)
-; (setq state (parse-partial-sexp here (point)
-; nil nil state))))))
-; ;;
-; ;; Make sure `prev' is non-nil after the loop
-; ;; only if it was set on the very last iteration.
-; (setq prev nil)))
-; ;;
-; ;; Clean up.
-; (and prev (remove-text-properties prev end '(face nil)))))
-
(defun font-lock-lisp-like (mode)
;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is
;; not enough because the property needs to be able to specify a nil
;; in add-log, but I think this encompasses more modes.
(string-match "lisp\\|scheme" (symbol-name mode))))
+;; fontify-syntactically-region used to use syntactically-sectionize, which
+;; was supposedly much faster than the FSF version because it was written in
+;; C. However, the FSF version uses parse-partial-sexp, which is also
+;; written in C, and the benchmarking I did showed the
+;; syntactically-sectionize code to be slower overall. So here's the
+;; FSF version, modified to support font-lock-doc-string-face.
+;; -- mct 2000-12-29
+;; #### Andy conditionally reverted Matt's change when we were experimenting
+;; with making lookup-syntax-properties an optional feature. I don't see how
+;; this code relates to lookup-syntax-properties, though. I wonder if the
+;; bug is in our (?) version of parse-partial-sexp. Andy says no. Of course,
+;; Matt benchmarked ... WTF knows? sjt 2002-09-28
(defun font-lock-fontify-syntactically-region (start end &optional loudly)
"Put proper face on each string and comment between START and END.
-START should be at the beginning of a line."
+START should be at the beginning of a line. Optional argument LOUDLY
+is currently ignored."
(if font-lock-keywords-only
nil
+
+ ;; #### Shouldn't this just be using 'loudly??
(when (and font-lock-verbose
(>= (- end start) font-lock-message-threshold))
- (lmessage 'progress "Fontifying %s... (syntactically...)"
- (buffer-name)))
- (font-lock-unfontify-region start end loudly)
+ (progress-feedback-with-label 'font-lock
+ "Fontifying %s... (syntactically)" 5
+ (buffer-name)))
(goto-char start)
- (if (> end (point-max)) (setq end (point-max)))
- (let ((lisp-like (font-lock-lisp-like major-mode)))
- (syntactically-sectionize
- #'(lambda (s e context depth)
- (let (face)
- (cond ((eq context 'string)
- (setq face
- ;; #### It would be nice if we handled
- ;; Python and other non-Lisp languages with
- ;; docstrings correctly.
- (if (and lisp-like (= depth 1))
- ;; really we should only use this if
- ;; in position 3 depth 1, but that's
- ;; too expensive to compute.
- 'font-lock-doc-string-face
- 'font-lock-string-face)))
- ((or (eq context 'comment)
- (eq context 'block-comment))
- (setq face 'font-lock-comment-face)
-; ;; Don't fontify whitespace at the beginning of lines;
-; ;; otherwise comment blocks may not line up with code.
-; ;; (This is sometimes a good idea, sometimes not; in any
-; ;; event it should be in C for speed --jwz)
-; (save-excursion
-; (goto-char s)
-; (while (prog1 (search-forward "\n" (1- e) 'move)
-; (setq face 'font-lock-comment-face)
-; (setq e (point)))
-; (skip-chars-forward " \t\n")
-; (setq s (point)))
- ))
- (font-lock-set-face s e face)))
- start end)
- )))
+
+ (let ((lisp-like (font-lock-lisp-like major-mode))
+ (cache (marker-position font-lock-cache-position))
+ state string beg depth)
+ ;;
+ ;; Find the state at the `beginning-of-line' before `start'.
+ (if (eq start cache)
+ ;; Use the cache for the state of `start'.
+ (setq state font-lock-cache-state)
+ ;; Find the state of `start'.
+ (if (null font-lock-beginning-of-syntax-function)
+ ;; Use the state at the previous cache position, if any, or
+ ;; otherwise calculate from `point-min'.
+ (if (or (null cache) (< start cache))
+ (setq state (parse-partial-sexp (point-min) start))
+ (setq state (parse-partial-sexp cache start nil nil
+ font-lock-cache-state)))
+ ;; Call the function to move outside any syntactic block.
+ (funcall font-lock-beginning-of-syntax-function)
+ (setq state (parse-partial-sexp (point) start)))
+ ;; Cache the state and position of `start'.
+ (setq font-lock-cache-state state)
+ (set-marker font-lock-cache-position start))
+ ;;
+ ;; If the region starts inside a string or comment, show the extent of it.
+ (when (or (nth 3 state) (nth 4 state))
+ (setq string (nth 3 state) beg (point))
+ (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
+ (font-lock-set-face beg (point) (if string
+ font-lock-string-face
+ font-lock-comment-face)))
+ ;;
+ ;; Find each interesting place between here and `end'.
+ (while (and (< (point) end)
+ (progn
+ (setq state (parse-partial-sexp (point) end nil nil state
+ 'syntax-table))
+ (or (nth 3 state) (nth 4 state))))
+ (setq depth (nth 0 state) string (nth 3 state) beg (nth 8 state))
+ (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table))
+ (if string
+ ;; #### It would be nice if we handled Python and other
+ ;; non-Lisp languages with docstrings correctly.
+ (let ((face (if (and lisp-like (= depth 1))
+ 'font-lock-doc-string-face
+ 'font-lock-string-face)))
+ (if font-lock-fontify-string-delimiters
+ (font-lock-set-face beg (point) face)
+ (font-lock-set-face (+ beg 1) (- (point) 1) face)))
+ (font-lock-set-face beg (point)
+ font-lock-comment-face))))))
\f
;;; Additional text property functions.
object)
(setq start next))))
\f
+;;; Syntactic regexp fontification functions (taken from FSF Emacs 20.7.1)
+
+;; These syntactic keyword pass functions are identical to those keyword pass
+;; functions below, with the following exceptions; (a) they operate on
+;; `font-lock-syntactic-keywords' of course, (b) they are all `defun' as speed
+;; is less of an issue, (c) eval of property value does not occur JIT as speed
+;; is less of an issue, (d) OVERRIDE cannot be `prepend' or `append' as it
+;; makes no sense for `syntax-table' property values, (e) they do not do it
+;; LOUDLY as it is not likely to be intensive.
+
+(defun font-lock-apply-syntactic-highlight (highlight)
+ "Apply HIGHLIGHT following a match.
+HIGHLIGHT should be of the form MATCH-HIGHLIGHT,
+see `font-lock-syntactic-keywords'."
+ (let* ((match (nth 0 highlight))
+ (start (match-beginning match)) (end (match-end match))
+ (value (nth 1 highlight))
+ (override (nth 2 highlight)))
+ (unless (numberp (car-safe value))
+ (setq value (eval value)))
+ (cond ((not start)
+ ;; No match but we might not signal an error.
+ (or (nth 3 highlight)
+ (error "No match %d in highlight %S" match highlight)))
+ ((not override)
+ ;; Cannot override existing fontification.
+ (or (map-extents 'extent-property (current-buffer)
+ start end 'syntax-table)
+ (font-lock-set-syntax start end value)))
+ ((eq override t)
+ ;; Override existing fontification.
+ (font-lock-set-syntax start end value))
+ ((eq override 'keep)
+ ;; Keep existing fontification.
+ (font-lock-fillin-text-property start end
+ 'syntax-table 'font-lock value)))))
+
+(defun font-lock-fontify-syntactic-anchored-keywords (keywords limit)
+ "Fontify according to KEYWORDS until LIMIT.
+ KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords',
+ LIMIT can be modified by the value of its PRE-MATCH-FORM."
+ (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
+ ;; Evaluate PRE-MATCH-FORM.
+ (pre-match-value (eval (nth 1 keywords))))
+ ;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
+ (if (and (numberp pre-match-value) (> pre-match-value (point)))
+ (setq limit pre-match-value)
+ (save-excursion (end-of-line) (setq limit (point))))
+ (save-match-data
+ ;; Find an occurrence of `matcher' before `limit'.
+ (while (if (stringp matcher)
+ (re-search-forward matcher limit t)
+ (funcall matcher limit))
+ ;; Apply each highlight to this instance of `matcher'.
+ (setq highlights lowdarks)
+ (while highlights
+ (font-lock-apply-syntactic-highlight (car highlights))
+ (setq highlights (cdr highlights)))))
+ ;; Evaluate POST-MATCH-FORM.
+ (eval (nth 2 keywords))))
+
+(defun font-lock-fontify-syntactic-keywords-region (start end)
+ "Fontify according to `font-lock-syntactic-keywords' between START and END.
+START should be at the beginning of a line."
+;; ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
+ (when (symbolp font-lock-syntactic-keywords)
+ (setq font-lock-syntactic-keywords (font-lock-eval-keywords
+ font-lock-syntactic-keywords)))
+ ;; If `font-lock-syntactic-keywords' is not compiled, compile it.
+ (unless (eq (car font-lock-syntactic-keywords) t)
+ (setq font-lock-syntactic-keywords (font-lock-compile-keywords
+ font-lock-syntactic-keywords)))
+ ;; Get down to business.
+ (let ((case-fold-search font-lock-keywords-case-fold-search)
+ (keywords (cdr font-lock-syntactic-keywords))
+ keyword matcher highlights)
+ (while keywords
+ ;; Find an occurrence of `matcher' from `start' to `end'.
+ (setq keyword (car keywords) matcher (car keyword))
+ (goto-char start)
+ (while (if (stringp matcher)
+ (re-search-forward matcher end t)
+ (funcall matcher end))
+ ;; Apply each highlight to this instance of `matcher', which may be
+ ;; specific highlights or more keywords anchored to `matcher'.
+ (setq highlights (cdr keyword))
+ (while highlights
+ (if (numberp (car (car highlights)))
+ (font-lock-apply-syntactic-highlight (car highlights))
+ (font-lock-fontify-syntactic-anchored-keywords (car highlights)
+ end))
+ (setq highlights (cdr highlights))))
+ (setq keywords (cdr keywords)))))
+\f
;;; Regexp fontification functions.
(defsubst font-lock-apply-highlight (highlight)
START should be at the beginning of a line."
(let ((loudly (and font-lock-verbose
(>= (- end start) font-lock-message-threshold))))
- (let ((case-fold-search font-lock-keywords-case-fold-search)
- (keywords (cdr (if (eq (car-safe font-lock-keywords) t)
- font-lock-keywords
- (font-lock-compile-keywords))))
- (bufname (buffer-name)) (count 0)
- keyword matcher highlights)
+ (unless (eq (car-safe font-lock-keywords) t)
+ (setq font-lock-keywords
+ (font-lock-compile-keywords font-lock-keywords)))
+ (let* ((case-fold-search font-lock-keywords-case-fold-search)
+ (keywords (cdr font-lock-keywords))
+ (bufname (buffer-name))
+ (progress 5) (old-progress 5)
+ (iter 0)
+ (nkeywords (length keywords))
+ keyword matcher highlights)
;;
;; Fontify each item in `font-lock-keywords' from `start' to `end'.
+ ;; In order to measure progress accurately we need to know how
+ ;; many keywords we have and how big the region is. Then progress
+ ;; is ((pos - start)/ (end - start) * nkeywords
+ ;; + iteration / nkeywords) * 100
(while keywords
- (when loudly (lmessage 'progress "Fontifying %s... (regexps..%s)"
- bufname
- (make-string (setq count (1+ count)) ?.)))
;;
;; Find an occurrence of `matcher' from `start' to `end'.
(setq keyword (car keywords) matcher (car keyword))
(if (stringp matcher)
(re-search-forward matcher end t)
(funcall matcher end)))
+ ;; calculate progress
+ (setq progress
+ (+ (/ (* (- (point) start) 95) (* (- end start) nkeywords))
+ (/ (* iter 95) nkeywords) 5))
+ (when (and loudly (> progress old-progress))
+ (progress-feedback-with-label 'font-lock
+ "Fontifying %s... (regexps)"
+ progress bufname))
+ (setq old-progress progress)
;; Apply each highlight to this instance of `matcher', which may be
;; specific highlights or more keywords anchored to `matcher'.
(setq highlights (cdr keyword))
(and end (goto-char end)))
(font-lock-fontify-anchored-keywords (car highlights) end))
(setq highlights (cdr highlights))))
+ (setq iter (1+ iter))
(setq keywords (cdr keywords))))
- (if loudly (lmessage 'progress "Fontifying %s... done." (buffer-name)))))
+ (if loudly
+ (progress-feedback-with-label 'font-lock "Fontifying %s... " 100
+ (buffer-name)))))
\f
;; Various functions.
((and (boundp 'lazy-lock-mode) lazy-lock-mode)
(lazy-lock-after-fontify-buffer))))
-;; If the buffer is about to be reverted, it won't be fontified afterward.
-(defun font-lock-revert-setup ()
- (setq font-lock-fontified nil))
-
-;; If the buffer has just been reverted, normally that turns off
-;; Font Lock mode. So turn the mode back on if necessary.
-;; sb 1999-03-03 -- The above comment no longer appears to be operative as
-;; the first call to normal-mode *will* restore the font-lock state and
-;; this call forces a second font-locking to occur when reverting a buffer,
-;; which is wasteful at best.
-;(defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
-(defun font-lock-revert-cleanup ())
-
\f
;; Various functions.
-(defun font-lock-compile-keywords (&optional keywords)
- ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD
- ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string.
- (let ((keywords (or keywords font-lock-keywords)))
- (setq font-lock-keywords
- (if (eq (car-safe keywords) t)
- keywords
- (cons t (mapcar 'font-lock-compile-keyword keywords))))))
+(defun font-lock-compile-keywords (keywords)
+ "Compile KEYWORDS (a list) and return the list of compiled keywords.
+Each keyword has the form (MATCHER HIGHLIGHT ...). See `font-lock-keywords'."
+ (if (eq (car-safe keywords) t)
+ keywords
+ (cons t (mapcar 'font-lock-compile-keyword keywords))))
(defun font-lock-compile-keyword (keyword)
(cond ((nlistp keyword) ; Just MATCHER
(t ; Hopefully (MATCHER HIGHLIGHT ...)
keyword)))
+(defun font-lock-eval-keywords (keywords)
+ "Evaluate KEYWORDS if a function (funcall) or variable (eval) name."
+ (if (listp keywords)
+ keywords
+ (font-lock-eval-keywords (if (fboundp keywords)
+ (funcall keywords)
+ (eval keywords)))))
+
(defun font-lock-choose-keywords (keywords level)
;; Return LEVELth element of KEYWORDS. A LEVEL of nil is equal to a
;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
(font-lock-find-font-lock-defaults major-mode)))
(keywords (font-lock-choose-keywords
(nth 0 defaults) font-lock-maximum-decoration)))
-
+
;; Keywords?
(setq font-lock-keywords (if (fboundp keywords)
(funcall keywords)
(setq font-lock-beginning-of-syntax-function
'beginning-of-defun)))))
+ (setq font-lock-cache-position (make-marker))
(setq font-lock-defaults-computed t)))
\f
"\\)\\)\\>"
;; Any whitespace and declared object.
"[ \t'\(]*"
- "\\([^ \t\n\)]+\\)?")
+ "\\([^ \t\n\(\)]+\\)?")
'(1 font-lock-keyword-face)
'(8 (cond ((match-beginning 3) 'font-lock-variable-name-face)
((match-beginning 6) 'font-lock-type-face)
;;
;; Control structures. ELisp and CLisp combined.
;;
- ;;(regexp-opt
- ;; '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
- ;; "prog2" "progv" "catch" "throw" "save-restriction"
- ;; "save-excursion" "save-window-excursion"
- ;; "save-current-buffer" "with-current-buffer"
- ;; "with-temp-file" "with-temp-buffer" "with-output-to-string"
- ;; "with-string-as-buffer-contents"
- ;; "save-selected-window" "save-match-data" "unwind-protect"
- ;; "condition-case" "track-mouse" "autoload"
- ;; "eval-after-load" "eval-and-compile" "eval-when-compile"
- ;; "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
- ;; "lambda" "return" "return-from"))
(cons
(concat
"(\\("
- "autoload\\|c\\(atch\\|ond\\(ition-case\\)?\\)\\|do\\(list\\|"
- "times\\)?\\|eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|"
- "flet\\|if\\|l\\(a\\(bels\\|mbda\\)\\|et\\*?\\)\\|"
- "prog[nv12\\*]?\\|return\\(-from\\)?\\|save-\\(current-buffer\\|"
- "excursion\\|match-data\\|restriction\\|selected-window\\|"
- "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|"
- "wind-protect\\)\\|w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|"
- "output-to-string\\|string-as-buffer-contents\\|temp-\\(buffer\\|"
- "file\\)\\)\\)"
+ ;; beginning of generated stuff
+ ;; to regenerate, use the regexp-opt below, then delete the outermost
+ ;; grouping, then use the macro below to break up the string.
+ ;; (regexp-opt
+ ;; '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1"
+ ;; "prog2" "progv" "catch" "throw" "save-restriction"
+ ;; "save-excursion" "save-window-excursion"
+ ;; "save-current-buffer" "with-current-buffer"
+ ;; "save-selected-window" "with-selected-window"
+ ;; "save-selected-frame" "with-selected-frame"
+ ;; "with-temp-file" "with-temp-buffer" "with-output-to-string"
+ ;; "with-string-as-buffer-contents"
+ ;; "save-match-data" "unwind-protect" "call-with-condition-handler"
+ ;; "condition-case" "track-mouse" "autoload"
+ ;; "eval-after-load" "eval-and-compile" "eval-when-compile"
+ ;; "when" "unless" "do" "dolist" "dotimes" "flet" "labels"
+ ;; "lambda" "block" "return" "return-from" "loop") t)
+ ;; (setq last-kbd-macro
+ ;; (read-kbd-macro "\" C-7 C-1 <right> C-r \\\\| 3*<right> \" RET"))
+ "autoload\\|block\\|c\\(?:a\\(?:ll-with-condition-handler\\|tch\\)\\|"
+ "ond\\(?:ition-case\\)?\\)\\|do\\(?:list\\|times\\)?\\|"
+ "eval-\\(?:a\\(?:fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|"
+ "if\\|l\\(?:a\\(?:bels\\|mbda\\)\\|et\\*?\\|oop\\)\\|prog[12nv]?\\|"
+ "return\\(?:-from\\)?\\|save-\\(?:current-buffer\\|excursion\\|"
+ "match-data\\|restriction\\|selected-\\(?:frame\\|window\\)\\|"
+ "window-excursion\\)\\|t\\(?:hrow\\|rack-mouse\\)\\|un\\(?:less\\|"
+ "wind-protect\\)\\|w\\(?:h\\(?:en\\|ile\\)\\|ith-\\(?:current-buffer\\|"
+ "output-to-string\\|s\\(?:elected-\\(?:frame\\|window\\)\\|"
+ "tring-as-buffer-contents\\)\\|temp-\\(?:buffer\\|file\\)\\)\\)"
+ ;; end of generated stuff
"\\)\\>") 1)
;;
;; Feature symbols as references.
(c++-keywords
; ("break" "continue" "do" "else" "for" "if" "return" "switch" "while"
; "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try"
-; "protected" "private" "public")
- (concat "asm\\|break\\|c\\(atch\\|ontinue\\)\\|d\\(elete\\|o\\)\\|"
- "else\\|for\\|if\\|new\\|"
- "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|"
- "s\\(izeof\\|witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while"))
+; "protected" "private" "public" "const_cast" "dynamic_cast" "reinterpret_cast"
+; "static_cast" "and" "bitor" "or" "xor" "compl" "bitand" "and_eq"
+; "or_eq" "xor_eq" "not" "not_eq" "typeid" "false" "true")
+ (concat "a\\(nd\\(\\|_eq\\)\\|sm\\)\\|"
+ "b\\(it\\(or\\|and\\)\\|reak\\)\\|"
+ "c\\(atch\\|o\\(mpl\\|n\\(tinue\\|st_cast\\)\\)\\)\\|"
+ "d\\(elete\\|o\\|ynamic_cast\\)\\|"
+ "else\\|"
+ "f\\(alse\\|or\\)\\|if\\|"
+ "n\\(ew\\|ot\\(\\|_eq\\)\\)\\|"
+ "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|"
+ "or\\(\\|_eq\\)\\|"
+ "re\\(interpret_cast\\|turn\\)\\|"
+ "s\\(izeof\\|tatic_cast\\|witch\\)\\|"
+ "t\\(h\\(is\\|row\\)\\|r\\(ue\\|y\\)\\|ypeid\\)\\|"
+ "xor\\(\\|_eq\\)\\|while"))
(c++-type-types
; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
; "signed" "unsigned" "short" "long" "int" "char" "float" "double"
; "void" "volatile" "const" "class" "inline" "friend" "bool"
-; "virtual" "complex" "template")
+; "virtual" "complex" "template" "explicit" "mutable" "export" "namespace"
+; "using" "typename" "wchar_t")
(concat "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|"
- "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|"
- "in\\(line\\|t\\)\\|long\\|register\\|"
+ "double\\|"
+ "e\\(num\\|x\\(p\\(licit\\|ort\\)\\|tern\\)\\)\\|"
+ "f\\(loat\\|riend\\)\\|"
+ "in\\(line\\|t\\)\\|long\\|mutable\\|namespace\\|register\\|"
"s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|"
- "t\\(emplate\\|ypedef\\)\\|un\\(ion\\|signed\\)\\|"
- "v\\(irtual\\|o\\(id\\|latile\\)\\)")) ; 11 ()s deep.
+ "t\\(emplate\\|ype\\(def\\|name\\)\\)\\|"
+ "u\\(\\(n\\(ion\\|signed\\)\\|sing\\)\\)\\|"
+ "v\\(irtual\\|o\\(id\\|latile\\)\\)\\|"
+ "wchar_t")) ; 11 ()s deep.
(ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+")
)
(setq c-font-lock-keywords-1
"\\|long\\|short\\|void\\)\\>")
"Regexp which should match a primitive type.")
-(let ((capital-letter "A-Z\300-\326\330-\337")
- (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
- (digit "0-9"))
(defvar java-font-lock-identifier-regexp
- (concat "\\<\\([" letter "][" letter digit "]*\\)\\>")
+ (let ((letter "a-zA-Z_$\300-\326\330-\366\370-\377")
+ (digit "0-9"))
+ (concat "\\<\\([" letter "][" letter digit "]*\\)\\>"))
"Regexp which should match all Java identifiers.")
(defvar java-font-lock-class-name-regexp
- (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>")
+ (let ((capital-letter "A-Z\300-\326\330-\337")
+ (letter "a-zA-Z_$\300-\326\330-\366\370-\377")
+ (digit "0-9"))
+ (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>"))
"Regexp which should match a class or an interface name.
The name is assumed to begin with a capital letter.")
-)
-
(let ((java-modifier-regexp
(concat "\\<\\(abstract\\|const\\|final\\|native\\|"
(list
(concat
"\\<\\("
+ "assert\\|"
"break\\|byvalue\\|"
"case\\|cast\\|catch\\|class\\|continue\\|"
- "do\\|else\\|extends\\|"
+ "do\\|else\\|enum\\|extends\\|"
"finally\\|for\\|future\\|"
"generic\\|goto\\|"
"if\\|implements\\|import\\|"
;; Class names:
(list (concat "\\<\\(class\\|interface\\)\\>\\s *"
- java-font-lock-identifier-regexp)
+ java-font-lock-identifier-regexp)
2 'font-lock-function-name-face)
;; Package declarations:
(list
;; Javadoc tags
- '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s "
+ '("@\\(author\\|deprecated\\|exception\\|throws\\|param\\|return\\|see\\|since\\|version\\|serial\\|serialData\\|serialField\\)\\s "
0 font-lock-keyword-face t)
;; Doc tag - Parameter identifiers
'("\\(@beaninfo\\)"
0 font-lock-keyword-face t)
;; Doc tag - Links
- '("{ *@link\\s +\\([^}]+\\)}"
+ '("{ *@link\\(?:plain\\)?\\s +\\([^}]+\\)}"
0 font-lock-keyword-face t)
;; Doc tag - Links
- '("{ *@link\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}"
+ '("{ *@link\\(?:plain\\)?\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}"
1 font-lock-function-name-face t)
)))
;; the cursor to fontify more identifiers.
(defun font-lock-match-java-declarations (limit)
"Match and skip over variable definitions."
- (if (looking-at "\\s *\\(\\[\\s *\\]\\s *\\)*")
- (goto-char (match-end 0)))
- (and
- (looking-at java-font-lock-identifier-regexp)
- (save-match-data
- (not (string-match java-font-lock-type-regexp
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- (save-match-data
- (save-excursion
- (goto-char (match-beginning 1))
- (not (looking-at
- (concat java-font-lock-class-name-regexp
- "\\s *\\(\\[\\s *\\]\\s *\\)*\\<")))))
- (save-match-data
- (condition-case nil
- (save-restriction
- (narrow-to-region (point-min) limit)
- (goto-char (match-end 0))
- ;; Note: Both `scan-sexps' and the second goto-char can
- ;; generate an error which is caught by the
- ;; `condition-case' expression.
- (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)"))
- (goto-char (or (scan-sexps (point) 1) (point-max))))
- (goto-char (match-end 2))) ; non-nil
- (error t)))))
+ (save-restriction
+ (narrow-to-region (point-min) limit)
+
+ (if (looking-at "\\s *\\(\\[\\s *\\]\\s *\\)*")
+ (goto-char (match-end 0)))
+ (and
+ (looking-at java-font-lock-identifier-regexp)
+ (save-match-data
+ (not (string-match java-font-lock-type-regexp
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))
+ (save-match-data
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (not (looking-at
+ (concat java-font-lock-class-name-regexp
+ "\\s *\\(\\[\\s *\\]\\s *\\)*\\<")))))
+ (save-match-data
+ (condition-case nil
+ (progn
+ (goto-char (match-end 0))
+ ;; Note: Both `scan-sexps' and the second goto-char can
+ ;; generate an error which is caught by the
+ ;; `condition-case' expression.
+ (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)"))
+ (goto-char (or (scan-sexps (point) 1) (point-max))))
+ (goto-char (match-end 2))) ; non-nil
+ (error t))))))
(defvar tex-font-lock-keywords
3 (if (match-beginning 2) 'bold 'italic) keep))
"Default expressions to highlight in TeX modes.")
-(defconst ksh-font-lock-keywords (purecopy
+(defconst ksh-font-lock-keywords
(list
'("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
'("\\<\\(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)
'("\\<\\[\\[.*\\]\\]\\>" . font-lock-type-face)
'("\$\(.*\)" . font-lock-type-face)
- ))
+ )
"Additional expressions to highlight in ksh-mode.")
-(defconst sh-font-lock-keywords (purecopy
+(defconst sh-font-lock-keywords
(list
'("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)
'("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|in\\|while\\|exec\\|export\\|set\\|echo\\|eval\\|cd\\)\\>" . font-lock-keyword-face)
'("\\[.*\\]" . font-lock-type-face)
'("`.*`" . font-lock-type-face)
- ))
+ )
"Additional expressions to highlight in sh-mode.")
\f
projects / chise / xemacs-chise.git.1 / blobdiff