X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Ffont-lock.el;h=d72aeebfc9e6cddd4f666d25564d0b393e294946;hp=d71c4fa5d7382e1982fe78c16376b963047ee97f;hb=eeca41d3213b7a3b7efcf6508693e748c1590748;hpb=ea1ea793fe6e244ef5555ed983423a204101af13 diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d71c4fa..d72aeeb 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2,9 +2,9 @@ ;; 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 , for the LISPM Preservation Society. +;; Author: Jamie Zawinski , for the LISPM Preservation Society. ;; Minimally merged with FSF 19.34 by Barry Warsaw ;; Then (partially) synched with FSF 19.30, leading to: ;; Next Author: RMS @@ -178,8 +178,8 @@ The size is measured in characters. This affects `font-lock-fontify-region' 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." @@ -282,7 +282,7 @@ available for buffers in `c-mode', and level 1 decoration otherwise." (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) @@ -313,103 +313,202 @@ megabyte for buffers in `rmail-mode', and size is irrelevant otherwise." (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) ;; 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): + + \"\\\\\\=\" 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'. + + (\"\\\\\\=\" (0 anchor-face) (\"\\\\\\=\" 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): - - \"\\\\\\=\" 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): - - (\"\\\\\\=\" (0 anchor-face) (\"\\\\\\=\" 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, @@ -483,15 +582,15 @@ If this is nil, the major mode's syntax table is used. 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'. @@ -552,43 +651,92 @@ This is normally set via `font-lock-defaults'.") ;; #### 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)) @@ -611,11 +759,17 @@ This is normally set via `font-lock-defaults'.") '((((class color) (background dark)) (:foreground "light coral")) (((class color) (background light)) (:foreground "green4")) (t (:bold t))) - "Font Lock mode face used to highlight documentation strings." + "Font Lock mode face used to highlight documentation strings. +This is currently supported only in Lisp-like modes, which are those +with \"lisp\" or \"scheme\" in their name. You can explicitly make +a mode Lisp-like by putting a non-nil `font-lock-lisp-like' property +on the major mode's symbol." :group 'font-lock-faces) (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)) @@ -623,8 +777,22 @@ This is normally set via `font-lock-defaults'.") "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." @@ -650,6 +818,17 @@ This is normally set via `font-lock-defaults'.") "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")) @@ -660,8 +839,6 @@ This is normally set via `font-lock-defaults'.") "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")) @@ -669,7 +846,6 @@ This is normally set via `font-lock-defaults'.") "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)) @@ -715,6 +891,188 @@ This is normally set via `font-lock-defaults'.") (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 . +;; +;; 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))))))) ;;;;;;;;;;;;;;;;;;;;;; actual code ;;;;;;;;;;;;;;;;;;;;;; @@ -791,15 +1149,12 @@ See the variable `font-lock-keywords' for customization." 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) @@ -819,28 +1174,21 @@ See the variable `font-lock-keywords' for customization." (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))) @@ -848,11 +1196,13 @@ See the variable `font-lock-keywords' for customization." ;;;###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: @@ -881,7 +1231,14 @@ See the variable `font-lock-keywords' for customization." (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 @@ -963,45 +1320,46 @@ This can take a while for large buffers." (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)) @@ -1020,8 +1378,10 @@ This can take a while for large buffers." ;; 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. @@ -1039,7 +1399,8 @@ This can take a while for large buffers." (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) @@ -1047,10 +1408,7 @@ This can take a while for large buffers." (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. @@ -1064,268 +1422,193 @@ This can take a while for large buffers." ; (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))) ;; 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 + ;; value. + (if (plist-member (symbol-plist mode) 'font-lock-lisp-like) + (get mode 'font-lock-lisp-like) + ;; If the property is not specified, guess. Similar logic exists + ;; 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))) - (syntactically-sectionize - #'(lambda (s e context depth) - (let (face) - (cond ((eq context 'string) - ;;#### Should only do this is Lisp-like modes! - (setq face - (if (= 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)))))) ;;; Additional text property functions. @@ -1409,6 +1692,100 @@ Optional argument OBJECT is the string or buffer containing the text." object) (setq start next)))) +;;; 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))))) + ;;; Regexp fontification functions. (defsubst font-lock-apply-highlight (highlight) @@ -1472,18 +1849,23 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM." 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)) @@ -1492,6 +1874,15 @@ START should be at the beginning of a line." (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)) @@ -1505,8 +1896,11 @@ START should be at the beginning of a line." (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))))) ;; Various functions. @@ -1530,30 +1924,15 @@ START should be at the beginning of a line." ((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 ()) - ;; 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 @@ -1569,6 +1948,14 @@ START should be at the beginning of a line." (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)). @@ -1646,7 +2033,7 @@ START should be at the beginning of a line." (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) @@ -1712,6 +2099,7 @@ START should be at the beginning of a line." (setq font-lock-beginning-of-syntax-function 'beginning-of-defun))))) + (setq font-lock-cache-position (make-marker)) (setq font-lock-defaults-computed t))) @@ -1807,7 +2195,7 @@ START should be at the beginning of a line." "\\)\\)\\>" ;; 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) @@ -1822,30 +2210,39 @@ START should be at the beginning of a line." ;; ;; 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 C-r \\\\| 3* \" 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. @@ -2023,22 +2420,38 @@ START should be at the beginning of a line." (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 @@ -2277,19 +2690,19 @@ This adds highlighting of Java documentation tags, such as @see.") "\\|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\\|" @@ -2303,9 +2716,10 @@ The name is assumed to begin with a capital letter.") (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\\|" @@ -2322,8 +2736,9 @@ The name is assumed to begin with a capital letter.") '("\\<\\(false\\|null\\|true\\)\\>" (1 font-lock-keyword-face)) ;; Class names: - (list (concat "\\\\s *" java-font-lock-identifier-regexp) - 1 'font-lock-function-name-face) + (list (concat "\\<\\(class\\|interface\\)\\>\\s *" + java-font-lock-identifier-regexp) + 2 'font-lock-function-name-face) ;; Package declarations: (list (concat "\\<\\(package\\|import\\)\\>\\s *" @@ -2461,8 +2876,8 @@ The name is assumed to begin with a capital letter.") (list - ;; Java doc tags - '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s " + ;; Javadoc tags + '("@\\(author\\|deprecated\\|exception\\|throws\\|param\\|return\\|see\\|since\\|version\\|serial\\|serialData\\|serialField\\)\\s " 0 font-lock-keyword-face t) ;; Doc tag - Parameter identifiers @@ -2470,34 +2885,30 @@ The name is assumed to begin with a capital letter.") 1 'font-lock-variable-name-face t) ;; Doc tag - Exception types - (list (concat "@exception\\s +" + (list (concat "@\\(exception\\|throws\\)\\s +" java-font-lock-identifier-regexp) - '(1 (if (equal (char-after (match-end 0)) ?.) + '(2 (if (equal (char-after (match-end 0)) ?.) font-lock-reference-face font-lock-type-face) t) (list (concat "\\=\\." java-font-lock-identifier-regexp) '(goto-char (match-end 0)) nil '(1 (if (equal (char-after (match-end 0)) ?.) 'font-lock-reference-face 'font-lock-type-face) t))) - ;; Doc tag - Exception types - (list (concat "@exception\\s +" - java-font-lock-identifier-regexp) - '(1 (if (equal (char-after (match-end 0)) ?.) - font-lock-reference-face font-lock-type-face) t) - (list (concat "\\=\\." java-font-lock-identifier-regexp) - '(goto-char (match-end 0)) nil - '(1 (if (equal (char-after (match-end 0)) ?.) - 'font-lock-reference-face 'font-lock-type-face) t))) - ;; Doc tag - Cross-references, usually to methods '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)" 1 font-lock-function-name-face t) + ;; Doc tag - docRoot (1.3) + '("\\({ *@docRoot *}\\)" + 0 font-lock-keyword-face t) + ;; Doc tag - beaninfo, unofficial but widely used, even by Sun + '("\\(@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 +\\)}" + '("{ *@link\\(?:plain\\)?\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}" 1 font-lock-function-name-face t) ))) @@ -2513,32 +2924,34 @@ The name is assumed to begin with a capital letter.") ;; 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 @@ -2572,22 +2985,22 @@ The name is assumed to begin with a capital letter.") 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.")