X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e2cd29bdb4ab9ebcc99e136108f3f156577c9541..d5468dff8757b2ad06d1b6ae72b18445f337d017:/lisp/font-lock.el diff --git a/lisp/font-lock.el b/lisp/font-lock.el index cf47f77d40..d3017e3b3f 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1,7 +1,7 @@ ;;; font-lock.el --- Electric font lock mode -;; Copyright (C) 1992, 93, 94, 95, 96, 97, 98, 1999, 2000, 2001, 2002 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: jwz, then rms, then sm ;; Maintainer: FSF @@ -21,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -153,8 +153,8 @@ ;; ;; (add-hook 'foo-mode-hook ;; (lambda () -;; (make-local-variable 'font-lock-defaults) -;; (setq font-lock-defaults '(foo-font-lock-keywords t)))) +;; (set (make-local-variable 'font-lock-defaults) +;; '(foo-font-lock-keywords t)))) ;;; Adding Font Lock support for modes: @@ -174,8 +174,8 @@ ;; ;; and within `bar-mode' there could be: ;; -;; (make-local-variable 'font-lock-defaults) -;; (setq font-lock-defaults '(bar-font-lock-keywords nil t)) +;; (set (make-local-variable 'font-lock-defaults) +;; '(bar-font-lock-keywords nil t)) ;; What is fontification for? You might say, "It's to make my code look nice." ;; I think it should be for adding information in the form of cues. These cues @@ -210,13 +210,13 @@ (require 'syntax) ;; Define core `font-lock' group. -(defgroup font-lock nil +(defgroup font-lock '((jit-lock custom-group)) "Font Lock mode text highlighting package." - :link '(custom-manual "(emacs)Font Lock") - :link '(custom-manual "(elisp)Font Lock Mode") + :link '(custom-manual :tag "Emacs Manual" "(emacs)Font Lock") + :link '(custom-manual :tag "Elisp Manual" "(elisp)Font Lock Mode") :group 'faces) -(defgroup font-lock-highlighting-faces nil +(defgroup font-lock-faces nil "Faces for highlighting text." :prefix "font-lock-" :group 'font-lock) @@ -224,26 +224,6 @@ (defgroup font-lock-extra-types nil "Extra mode-specific type names for highlighting declarations." :group 'font-lock) - -;; Define support mode groups here to impose `font-lock' group order. -(defgroup fast-lock nil - "Font Lock support mode to cache fontification." - :link '(custom-manual "(emacs)Support Modes") - :load 'fast-lock - :group 'font-lock) - -(defgroup lazy-lock nil - "Font Lock support mode to fontify lazily." - :link '(custom-manual "(emacs)Support Modes") - :load 'lazy-lock - :group 'font-lock) - -(defgroup jit-lock nil - "Font Lock support mode to fontify just-in-time." - :link '(custom-manual "(emacs)Support Modes") - :version "21.1" - :load 'jit-lock - :group 'font-lock) ;; User variables. @@ -312,6 +292,9 @@ If a number, only buffers greater than this size have fontification messages." (defvar font-lock-comment-face 'font-lock-comment-face "Face name to use for comments.") +(defvar font-lock-comment-delimiter-face 'font-lock-comment-delimiter-face + "Face name to use for comment delimiters.") + (defvar font-lock-string-face 'font-lock-string-face "Face name to use for strings.") @@ -339,25 +322,41 @@ If a number, only buffers greater than this size have fontification messages." (defvar font-lock-warning-face 'font-lock-warning-face "Face name to use for things that should stand out.") -(defvar font-lock-reference-face 'font-lock-constant-face - "This variable is obsolete. Use `font-lock-constant-face'.") +(defvar font-lock-negation-char-face 'font-lock-negation-char-face + "Face name to use for easy to overlook negation. +This can be an \"!\" or the \"n\" in \"ifndef\".") + +(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face + "Face name to use for preprocessor directives.") + +(defvar font-lock-reference-face 'font-lock-constant-face) +(make-obsolete-variable 'font-lock-reference-face 'font-lock-constant-face) ;; Fontification variables: (defvar font-lock-keywords nil "A list of the keywords to highlight. -Each element should have one of these forms: +There are two kinds of values: user-level, and compiled. + +A user-level keywords list is what a major mode or the user would +set up. Normally the list would come from `font-lock-defaults'. +through selection of a fontification level and evaluation of any +contained expressions. You can also alter it by calling +`font-lock-add-keywords' or `font-lock-remove-keywords' with MODE = nil. + +Each element in a user-level keywords list should have one of these forms: MATCHER - (MATCHER . MATCH) + (MATCHER . SUBEXP) (MATCHER . FACENAME) (MATCHER . HIGHLIGHT) (MATCHER HIGHLIGHT ...) (eval . FORM) where MATCHER can be either the regexp to search for, or the function name to -call to make the search (called with one argument, the limit of the search) and -return non-nil if it succeeds (and set `match-data' appropriately). +call to make the search (called with one argument, the limit of the search; +it should return non-nil, move point, and set `match-data' appropriately iff +it succeeds; like `re-search-forward' would). MATCHER regexps can be generated via the function `regexp-opt'. FORM is an expression, whose value should be a keyword element, evaluated when @@ -374,14 +373,15 @@ word \"bar\" following the word \"anchor\" then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: - (MATCH FACENAME OVERRIDE LAXMATCH) + (SUBEXP FACENAME [OVERRIDE [LAXMATCH]]) + +SUBEXP is the number of the subexpression of MATCHER to be highlighted. -MATCH is the subexpression of MATCHER to be highlighted. FACENAME is an -expression whose value is the face name to use. Face default attributes -can be modified via \\[customize]. Instead of a face, FACENAME can -evaluate to a property list of the form (face VAL1 PROP2 VAL2 PROP3 VAL3 ...) +FACENAME is an expression whose value is the face name to use. +Instead of a face, FACENAME can evaluate to a property list +of the form (face FACE PROP1 VAL1 PROP2 VAL2 ...) in which case all the listed text-properties will be set rather than -just `face'. In such a case, you will most likely want to put those +just FACE. In such a case, you will most likely want to put those properties in `font-lock-extra-managed-props' or to override `font-lock-unfontify-region-function'. @@ -389,7 +389,8 @@ OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification can 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 signaled if there is no MATCH in MATCHER. +If LAXMATCH is non-nil, that means don't signal an error if there is +no match for SUBEXP in MATCHER. For example, an element of the form highlights (if not already highlighted): @@ -414,10 +415,10 @@ where MATCHER is a regexp to search for or the function name to call to make the search, as for MATCH-HIGHLIGHT above, but 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 initialise before, and cleanup after, MATCHER is used. Typically, +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. +be used to move back, before resuming with MATCH-ANCHORED's parent's MATCHER. For example, an element of the form highlights (if not already highlighted): @@ -427,7 +428,7 @@ For example, an element of the form highlights (if not already highlighted): 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 + searching for subsequent instances of \"anchor\" resumes from where searching for \"item\" concluded.) The above-mentioned exception is as follows. The limit of the MATCHER search @@ -444,15 +445,37 @@ support modes like jit-lock or lazy-lock. This variable is set by major modes via the variable `font-lock-defaults'. Be careful when composing regexps for this list; a poorly written pattern can -dramatically slow things down!") +dramatically slow things down! + +A compiled keywords list starts with t. It is produced internal +by `font-lock-compile-keywords' from a user-level keywords list. +Its second element is the user-level keywords list that was +compiled. The remaining elements have the same form as +user-level keywords, but normally their values have been +optimized.") (defvar font-lock-keywords-alist nil - "*Alist of `font-lock-keywords' local to a `major-mode'. + "Alist of additional `font-lock-keywords' elements for major modes. + +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' removed from `major-mode'. + "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'.") @@ -477,39 +500,38 @@ sometimes be slightly incorrect.") "Function to determine which face to use when fontifying syntactically. The function is called with a single parameter (the state as returned by `parse-partial-sexp' at the beginning of the region to highlight) and -should return a face.") +should return a face. This is normally set via `font-lock-defaults'.") (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. + "A list of the syntactic keywords to put syntax properties on. +The value can be the list itself, 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: +only the differences are stated here. MATCH-HIGHLIGHT should be of the form: - (MATCH SYNTAX OVERRIDE LAXMATCH) + (SUBEXP SYNTAX OVERRIDE LAXMATCH) where SYNTAX can be a string (as taken by `modify-syntax-entry'), a syntax table, a cons cell (as returned by `string-to-syntax') or an expression whose value is such a form. OVERRIDE cannot be `prepend' or `append'. -For example, an element of the form highlights syntactically: +Here are two examples of elements of `font-lock-syntactic-keywords' +and what they do: (\"\\\\$\\\\(#\\\\)\" 1 \".\") - a hash character when following a dollar character, with a SYNTAX of - \".\" (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. + gives a hash character punctuation syntax (\".\") when following a + dollar-sign character. Hash characters in other contexts will still + follow whatever the syntax table says about the hash character. (\"\\\\('\\\\).\\\\('\\\\)\" (1 \"\\\"\") (2 \"\\\"\")) - both single quotes which surround a single character, with a SYNTAX of - \"\\\"\" (meaning string quote syntax). 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. + gives a pair single-quotes, which surround a single character, a SYNTAX of + \"\\\"\" (meaning string quote syntax). Single-quote characters in other + contexts will not be affected. This is normally set via `font-lock-defaults'.") @@ -525,11 +547,11 @@ is not in a string or comment and not within any bracket-pairs (or else, a place such that any bracket-pairs outside it can be ignored for Emacs syntax analysis and fontification). -If this is nil, the beginning of the buffer is used, which is -always correct but tends to be slow. -This is normally set via `font-lock-defaults'. -This variable is semi-obsolete; we recommend setting -`syntax-begin-function' instead.") +If this is nil, Font Lock uses `syntax-begin-function' to move back +outside of any comment, string, or sexp. This variable is semi-obsolete; +we recommend setting `syntax-begin-function' instead. + +This is normally set via `font-lock-defaults'.") (defvar font-lock-mark-block-function nil "*Non-nil means use this function to mark a block of text. @@ -549,8 +571,8 @@ This is normally set via `font-lock-defaults'.") (defvar font-lock-fontify-region-function 'font-lock-default-fontify-region "Function to use for fontifying a region. It should take two args, the beginning and end of the region, and an optional -third arg VERBOSE. If non-nil, the function should print status messages. -This is normally set via `font-lock-defaults'.") +third arg VERBOSE. If VERBOSE is non-nil, the function should print status +messages. This is normally set via `font-lock-defaults'.") (defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region "Function to use for unfontifying a region. @@ -562,6 +584,14 @@ This is normally set via `font-lock-defaults'.") Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and `lazy-lock-mode'. This is normally set via `font-lock-defaults'.") +(defvar font-lock-multiline nil + "Whether font-lock should cater to multiline keywords. +If nil, don't try to handle multiline patterns. +If t, always handle multiline patterns. +If `undecided', don't try to handle multiline patterns until you see one. +Major/minor modes can set this variable if they know which option applies.") + +(defvar font-lock-fontified nil) ; Whether we have fontified the buffer. ;; Font Lock mode. @@ -574,6 +604,7 @@ Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and ;; We use this to preserve or protect things when modifying text properties. (defmacro save-buffer-state (varlist &rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." + (declare (indent 1) (debug let)) (let ((modified (make-symbol "modified"))) `(let* ,(append varlist `((,modified (buffer-modified-p)) @@ -588,21 +619,40 @@ Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and ,@body) (unless ,modified (restore-buffer-modified-p nil))))) - (put 'save-buffer-state 'lisp-indent-function 1) - (def-edebug-spec save-buffer-state let) ;; ;; Shut up the byte compiler. (defvar font-lock-face-attributes)) ; Obsolete but respected if set. -;;;###autoload -(defun font-lock-add-keywords (mode keywords &optional append) +(defun font-lock-mode-internal (arg) + ;; Turn on Font Lock mode. + (when arg + (add-hook 'after-change-functions 'font-lock-after-change-function t t) + (font-lock-set-defaults) + (font-lock-turn-on-thing-lock) + ;; Fontify the buffer if we have to. + (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size))) + (cond (font-lock-fontified + nil) + ((or (null max-size) (> max-size (buffer-size))) + (font-lock-fontify-buffer)) + (font-lock-verbose + (message "Fontifying %s...buffer size greater than font-lock-maximum-size" + (buffer-name)))))) + ;; Turn off Font Lock mode. + (unless font-lock-mode + (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (font-lock-unfontify-buffer) + (font-lock-turn-off-thing-lock))) + +(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 APPEND is `set', they are used to replace the current -highlighting list. If APPEND is any other non-nil value, they are added at the +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: @@ -614,42 +664,64 @@ For example: adds two fontification patterns for C mode, to fontify `FIXME:' words, even in comments, and to fontify `and', `or' and `not' words as keywords. -When used from an elisp package (such as a minor mode), it is recommended -to use nil for MODE (and place the call in a loop or on a hook) to avoid -subtle problems due to details of the implementation. +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 APPEND spec to + ;; 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 append)) cell) + (let ((spec (cons keywords how)) cell) (if (setq cell (assq mode font-lock-keywords-alist)) - (if (eq append 'set) + (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 append)) + (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) - (if (eq append '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 append - (append old keywords) - (append keywords old)))))))) - -(defun font-lock-update-removed-keyword-alist (mode keywords append) - ;; Update `font-lock-removed-keywords-alist' when adding new - ;; KEYWORDS to MODE. - ;; + (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 t))))))) + +(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 @@ -658,7 +730,7 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', ;; will not take effect. (let ((cell (assq mode font-lock-removed-keywords-alist))) (if cell - (if (eq append 'set) + (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 @@ -690,16 +762,17 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', ;; is added and removed several times. ;; ;; (II) The keywords are removed from the current buffer. -;;;###autoload (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. -When used from an elisp package (such as a minor mode), it is recommended -to use nil for MODE (and place the call in a loop or on a hook) to avoid -subtle problems due to details of the implementation." +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) @@ -707,14 +780,14 @@ subtle problems due to details of the implementation." ;; If MODE is non-nil, remove the KEYWORD from ;; `font-lock-keywords-alist'. (when top-cell - (dolist (keyword-list-append-pair (cdr top-cell)) - ;; `keywords-list-append-pair' is a cons with a list of - ;; keywords in the car top-cell and the original append + (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-append-pair - (delete keyword (car keyword-list-append-pair)))) - ;; Remove keyword list/append pair when the keyword list - ;; is empty and append doesn't specify `set'. (If it + (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)) @@ -738,13 +811,21 @@ subtle problems due to details of the implementation." (t ;; Otherwise remove it immediately. (font-lock-set-defaults) - (setq font-lock-keywords (copy-sequence font-lock-keywords)) - (dolist (keyword keywords) - (setq font-lock-keywords - (delete keyword - ;; The keywords might be compiled. - (delete (font-lock-compile-keyword keyword) - font-lock-keywords))))))) + (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 t))))))) ;;; Font Lock Support mode. @@ -757,9 +838,13 @@ subtle problems due to details of the implementation." (defcustom font-lock-support-mode 'jit-lock-mode "*Support mode for Font Lock mode. Support modes speed up Font Lock mode by being choosy about when fontification -occurs. Known support modes are Fast Lock mode (symbol `fast-lock-mode'), -Lazy Lock mode (symbol `lazy-lock-mode'), and Just-in-time Lock mode (symbol -`jit-lock-mode'. See those modes for more info. +occurs. The default support mode, Just-in-time Lock mode (symbol +`jit-lock-mode'), is recommended. + +Other, older support modes are Fast Lock mode (symbol `fast-lock-mode') and +Lazy Lock mode (symbol `lazy-lock-mode'). See those modes for more info. +However, they are no longer recommended, as Just-in-time Lock mode is better. + If nil, means support for Font Lock mode is never performed. If a symbol, use that support mode. If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE), @@ -804,7 +889,7 @@ The value of this variable is used when Font Lock mode is turned on." 'font-lock-after-change-function t) (set (make-local-variable 'font-lock-fontify-buffer-function) 'jit-lock-refontify) - ;; Don't fontify eagerly (and don't abort is the buffer is large). + ;; Don't fontify eagerly (and don't abort if the buffer is large). (set (make-local-variable 'font-lock-fontified) t) ;; Use jit-lock. (jit-lock-register 'font-lock-fontify-region @@ -886,10 +971,10 @@ The value of this variable is used when Font Lock mode is turned on." ;; directives correctly and cleanly. (It is the same problem as fontifying ;; multi-line strings and comments; regexps are not appropriate for the job.) -;;;###autoload (defun font-lock-fontify-buffer () "Fontify the current buffer the way the function `font-lock-mode' would." (interactive) + (font-lock-set-defaults) (let ((font-lock-verbose (or font-lock-verbose (interactive-p)))) (funcall font-lock-fontify-buffer-function))) @@ -897,10 +982,12 @@ The value of this variable is used when Font Lock mode is turned on." (funcall font-lock-unfontify-buffer-function)) (defun font-lock-fontify-region (beg end &optional loudly) + (font-lock-set-defaults) (funcall font-lock-fontify-region-function beg end loudly)) (defun font-lock-unfontify-region (beg end) - (funcall font-lock-unfontify-region-function beg end)) + (save-buffer-state nil + (funcall font-lock-unfontify-region-function beg end))) (defun font-lock-default-fontify-buffer () (let ((verbose (if (numberp font-lock-verbose) @@ -909,9 +996,6 @@ The value of this variable is used when Font Lock mode is turned on." (with-temp-message (when verbose (format "Fontifying %s..." (buffer-name))) - ;; Make sure we have the right `font-lock-keywords' etc. - (unless font-lock-mode - (font-lock-set-defaults)) ;; Make sure we fontify etc. in the whole buffer. (save-restriction (widen) @@ -939,7 +1023,8 @@ a very meaningful entity to highlight.") (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state - ((parse-sexp-lookup-properties font-lock-syntactic-keywords) + ((parse-sexp-lookup-properties + (or parse-sexp-lookup-properties font-lock-syntactic-keywords)) (old-syntax-table (syntax-table))) (unwind-protect (save-restriction @@ -947,10 +1032,11 @@ a very meaningful entity to highlight.") ;; Use the fontification syntax table, if any. (when font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) + (goto-char beg) + (setq beg (line-beginning-position)) ;; check to see if we should expand the beg/end area for ;; proper multiline matches - (when (and font-lock-multiline - (> beg (point-min)) + (when (and (> beg (point-min)) (get-text-property (1- beg) 'font-lock-multiline)) ;; We are just after or in a multiline match. (setq beg (or (previous-single-property-change @@ -958,12 +1044,12 @@ a very meaningful entity to highlight.") (point-min))) (goto-char beg) (setq beg (line-beginning-position))) - (when font-lock-multiline - (setq end (or (text-property-any end (point-max) - 'font-lock-multiline nil) - (point-max)))) + (setq end (or (text-property-any end (point-max) + 'font-lock-multiline nil) + (point-max))) (goto-char end) - (setq end (line-beginning-position 2)) + ;; Round up to a whole line. + (unless (bolp) (setq end (line-beginning-position 2))) ;; Now do the fontification. (font-lock-unfontify-region beg end) (when font-lock-syntactic-keywords @@ -975,12 +1061,12 @@ a very meaningful entity to highlight.") (set-syntax-table old-syntax-table)))) ;; The following must be rethought, since keywords can override fontification. -; ;; Now scan for keywords, but not if we are inside a comment now. -; (or (and (not font-lock-keywords-only) -; (let ((state (parse-partial-sexp beg end nil nil -; font-lock-cache-state))) -; (or (nth 4 state) (nth 7 state)))) -; (font-lock-fontify-keywords-region beg end)) +;; ;; Now scan for keywords, but not if we are inside a comment now. +;; (or (and (not font-lock-keywords-only) +;; (let ((state (parse-partial-sexp beg end nil nil +;; font-lock-cache-state))) +;; (or (nth 4 state) (nth 7 state)))) +;; (font-lock-fontify-keywords-region beg end)) (defvar font-lock-extra-managed-props nil "Additional text properties managed by font-lock. @@ -988,23 +1074,27 @@ This is used by `font-lock-default-unfontify-region' to decide what properties to clear before refontifying a region.") (defun font-lock-default-unfontify-region (beg end) - (save-buffer-state nil - (remove-list-of-text-properties - beg end (append - font-lock-extra-managed-props - (if font-lock-syntactic-keywords - '(syntax-table face font-lock-multiline) - '(face font-lock-multiline)))))) + (remove-list-of-text-properties + beg end (append + font-lock-extra-managed-props + (if font-lock-syntactic-keywords + '(syntax-table face font-lock-multiline) + '(face font-lock-multiline))))) ;; Called when any modification is made to buffer text. (defun font-lock-after-change-function (beg end old-len) - (let ((inhibit-point-motion-hooks t)) + (let ((inhibit-point-motion-hooks t) + (inhibit-quit t) + (region (font-lock-extend-region beg end old-len))) (save-excursion (save-match-data - ;; Rescan between start of lines enclosing the region. - (font-lock-fontify-region - (progn (goto-char beg) (beginning-of-line) (point)) - (progn (goto-char end) (forward-line 1) (point))))))) + (if region + ;; Fontify the region the major mode has specified. + (setq beg (car region) end (cdr region)) + ;; Fontify the whole lines which enclose the region. + (setq beg (progn (goto-char beg) (line-beginning-position)) + end (progn (goto-char end) (line-beginning-position 2)))) + (font-lock-fontify-region beg end))))) (defun font-lock-fontify-block (&optional arg) "Fontify some lines the way `font-lock-fontify-buffer' would. @@ -1030,8 +1120,9 @@ delimit the region to fontify." (font-lock-fontify-region (point) (mark))) ((error quit) (message "Fontifying block...%s" error-data))))))) -(if (boundp 'facemenu-keymap) - (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)) +(unless (featurep 'facemenu) + (error "facemenu must be loaded before font-lock")) +(define-key facemenu-keymap "\M-o" 'font-lock-fontify-block) ;;; End of Fontification functions. @@ -1084,35 +1175,35 @@ Optional argument OBJECT is the string or buffer containing the text." ;; For completeness: this is to `remove-text-properties' as `put-text-property' ;; is to `add-text-properties', etc. -;(defun remove-text-property (start end property &optional object) -; "Remove a property from text from START to END. -;Argument PROPERTY is the property to remove. -;Optional argument OBJECT is the string or buffer containing the text. -;Return t if the property was actually removed, nil otherwise." -; (remove-text-properties start end (list property) object)) +;;(defun remove-text-property (start end property &optional object) +;; "Remove a property from text from START to END. +;;Argument PROPERTY is the property to remove. +;;Optional argument OBJECT is the string or buffer containing the text. +;;Return t if the property was actually removed, nil otherwise." +;; (remove-text-properties start end (list property) object)) ;; For consistency: maybe this should be called `remove-single-property' like ;; `next-single-property-change' (not `next-single-text-property-change'), etc. -;(defun remove-single-text-property (start end prop value &optional object) -; "Remove a specific property value from text from START to END. -;Arguments PROP and VALUE specify the property and value to remove. The -;resulting property values are not equal to VALUE nor lists containing VALUE. -;Optional argument OBJECT is the string or buffer containing the text." -; (let ((start (text-property-not-all start end prop nil object)) next prev) -; (while start -; (setq next (next-single-property-change start prop object end) -; prev (get-text-property start prop object)) -; (cond ((and (symbolp prev) (eq value prev)) -; (remove-text-property start next prop object)) -; ((and (listp prev) (memq value prev)) -; (let ((new (delq value prev))) -; (cond ((null new) -; (remove-text-property start next prop object)) -; ((= (length new) 1) -; (put-text-property start next prop (car new) object)) -; (t -; (put-text-property start next prop new object)))))) -; (setq start (text-property-not-all next end prop nil object))))) +;;(defun remove-single-text-property (start end prop value &optional object) +;; "Remove a specific property value from text from START to END. +;;Arguments PROP and VALUE specify the property and value to remove. The +;;resulting property values are not equal to VALUE nor lists containing VALUE. +;;Optional argument OBJECT is the string or buffer containing the text." +;; (let ((start (text-property-not-all start end prop nil object)) next prev) +;; (while start +;; (setq next (next-single-property-change start prop object end) +;; prev (get-text-property start prop object)) +;; (cond ((and (symbolp prev) (eq value prev)) +;; (remove-text-property start next prop object)) +;; ((and (listp prev) (memq value prev)) +;; (let ((new (delq value prev))) +;; (cond ((null new) +;; (remove-text-property start next prop object)) +;; ((= (length new) 1) +;; (put-text-property start next prop (car new) object)) +;; (t +;; (put-text-property start next prop new object)))))) +;; (setq start (text-property-not-all next end prop nil object))))) ;;; End of Additional text property functions. @@ -1199,7 +1290,7 @@ START should be at the beginning of a line." font-lock-syntactic-keywords))) ;; Get down to business. (let ((case-fold-search font-lock-keywords-case-fold-search) - (keywords (cdr font-lock-syntactic-keywords)) + (keywords (cddr font-lock-syntactic-keywords)) keyword matcher highlights) (while keywords ;; Find an occurrence of `matcher' from `start' to `end'. @@ -1223,14 +1314,24 @@ START should be at the beginning of a line." ;;; Syntactic fontification functions. +(defvar font-lock-comment-start-skip nil + "If non-nil, Font Lock mode uses this instead of `comment-start-skip'.") + +(defvar font-lock-comment-end-skip nil + "If non-nil, Font Lock mode uses this instead of `comment-end'.") + (defun font-lock-fontify-syntactically-region (start end &optional loudly ppss) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." - (let (state face beg) + (let ((comment-end-regexp + (or font-lock-comment-end-skip + (regexp-quote + (replace-regexp-in-string "^ *" "" comment-end)))) + state face beg) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) (goto-char start) ;; - ;; Find the state at the `beginning-of-line' before `start'. + ;; Find the `start' state. (setq state (or ppss (syntax-ppss start))) ;; ;; Find each interesting place between here and `end'. @@ -1241,10 +1342,24 @@ START should be at the beginning of a line." (setq beg (max (nth 8 state) start)) (setq state (parse-partial-sexp (point) end nil nil state 'syntax-table)) - (when face (put-text-property beg (point) 'face face))) - (setq state (parse-partial-sexp (point) end nil nil state - 'syntax-table)) - (< (point) end))))) + (when face (put-text-property beg (point) 'face face)) + (when (and (eq face 'font-lock-comment-face) + (or font-lock-comment-start-skip + comment-start-skip)) + ;; Find the comment delimiters + ;; and use font-lock-comment-delimiter-face for them. + (save-excursion + (goto-char beg) + (if (looking-at (or font-lock-comment-start-skip + comment-start-skip)) + (put-text-property beg (match-end 0) 'face + font-lock-comment-delimiter-face))) + (if (looking-back comment-end-regexp (point-at-bol) t) + (put-text-property (match-beginning 0) (point) 'face + font-lock-comment-delimiter-face)))) + (< (point) end)) + (setq state (parse-partial-sexp (point) end nil nil state + 'syntax-table))))) ;;; End of Syntactic fontification functions. @@ -1265,6 +1380,12 @@ HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'." (add-text-properties start end (cddr val)) (setq val (cadr val))) (cond + ((not (or val (eq override t))) + ;; If `val' is nil, don't do anything. It is important to do it + ;; explicitly, because when adding nil via things like + ;; font-lock-append-text-property, the property is actually + ;; changed from to () which is undesirable. --Stef + nil) ((not override) ;; Cannot override existing fontification. (or (text-property-not-all start end 'face nil) @@ -1324,8 +1445,9 @@ LOUDLY, if non-nil, allows progress-meter bar." (setq font-lock-keywords (font-lock-compile-keywords font-lock-keywords t))) (let ((case-fold-search font-lock-keywords-case-fold-search) - (keywords (cdr font-lock-keywords)) + (keywords (cddr font-lock-keywords)) (bufname (buffer-name)) (count 0) + (pos (make-marker)) keyword matcher highlights) ;; ;; Fontify each item in `font-lock-keywords' from `start' to `end'. @@ -1339,7 +1461,11 @@ LOUDLY, if non-nil, allows progress-meter bar." (while (and (< (point) end) (if (stringp matcher) (re-search-forward matcher end t) - (funcall matcher end))) + (funcall matcher end)) + ;; Beware empty string matches since they will + ;; loop indefinitely. + (or (> (point) (match-beginning 0)) + (progn (forward-char 1) t))) (when (and font-lock-multiline (>= (point) (save-excursion (goto-char (match-beginning 0)) @@ -1360,23 +1486,37 @@ LOUDLY, if non-nil, allows progress-meter bar." (while highlights (if (numberp (car (car highlights))) (font-lock-apply-highlight (car highlights)) - (font-lock-fontify-anchored-keywords (car highlights) end)) + (set-marker pos (point)) + (font-lock-fontify-anchored-keywords (car highlights) end) + ;; Ensure forward progress. `pos' is a marker because anchored + ;; keyword may add/delete text (this happens e.g. in grep.el). + (if (< (point) pos) (goto-char pos))) (setq highlights (cdr highlights)))) - (setq keywords (cdr keywords))))) + (setq keywords (cdr keywords))) + (set-marker pos nil))) ;;; End of Keyword regexp fontification functions. ;; Various functions. (defun font-lock-compile-keywords (keywords &optional regexp) - "Compile KEYWORDS into the form (t KEYWORD ...). -Here KEYWORD is of the form (MATCHER HIGHLIGHT ...) as shown in the + "Compile KEYWORDS into the form (t KEYWORDS COMPILED...) +Here each COMPILED is of the form (MATCHER HIGHLIGHT ...) as shown in the `font-lock-keywords' doc string. If REGEXP is non-nil, it means these keywords are used for `font-lock-keywords' rather than for `font-lock-syntactic-keywords'." + (if (not font-lock-set-defaults) + ;; This should never happen. But some external packages sometimes + ;; call font-lock in unexpected and incorrect ways. It's important to + ;; stop processing at this point, otherwise we may end up changing the + ;; global value of font-lock-keywords and break highlighting in many + ;; other buffers. + (error "Font-lock trying to use keywords before setting them up")) (if (eq (car-safe keywords) t) keywords - (setq keywords (cons t (mapcar 'font-lock-compile-keyword keywords))) + (setq keywords + (cons t (cons keywords + (mapcar 'font-lock-compile-keyword keywords)))) (if (and regexp (eq (or syntax-begin-function font-lock-beginning-of-syntax-function) @@ -1389,10 +1529,11 @@ If REGEXP is non-nil, it means these keywords are used for (concat "^\\(?:" defun-prompt-regexp "\\)?\\s(") "^\\s(") (0 - (if (memq (get-text-property (1- (point)) 'face) + (if (memq (get-text-property (match-beginning 0) 'face) '(font-lock-string-face font-lock-doc-face font-lock-comment-face)) - font-lock-warning-face) + (list 'face font-lock-warning-face + 'help-echo "Looks like a toplevel defun: escape the parenthesis")) prepend))))) keywords)) @@ -1437,188 +1578,233 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to (cond ((not (and (listp keywords) (symbolp (car keywords)))) keywords) ((numberp level) - (or (nth level keywords) (car (reverse keywords)))) + (or (nth level keywords) (car (last keywords)))) ((eq level t) - (car (reverse keywords))) + (car (last keywords))) (t (car keywords)))) -(defun font-lock-set-defaults-1 () - (let* ((defaults (or font-lock-defaults - (cdr (assq major-mode font-lock-defaults-alist)))) - (keywords - (font-lock-choose-keywords (nth 0 defaults) - (font-lock-value-in-major-mode font-lock-maximum-decoration))) - (local (cdr (assq major-mode font-lock-keywords-alist))) - (removed-keywords - (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) - (set (make-local-variable 'font-lock-defaults) defaults) - ;; Syntactic fontification? - (when (nth 1 defaults) - (set (make-local-variable 'font-lock-keywords-only) t)) - ;; Case fold during regexp fontification? - (when (nth 2 defaults) - (set (make-local-variable 'font-lock-keywords-case-fold-search) t)) - ;; Syntax table for regexp and syntactic fontification? - (when (nth 3 defaults) - (set (make-local-variable 'font-lock-syntax-table) - (copy-syntax-table (syntax-table))) - (dolist (selem (nth 3 defaults)) - ;; The character to modify may be a single CHAR or a STRING. - (let ((syntax (cdr selem))) - (dolist (char (if (numberp (car selem)) - (list (car selem)) - (mapcar 'identity (car selem)))) - (modify-syntax-entry char syntax font-lock-syntax-table))))) - ;; Syntax function for syntactic fontification? - (when (nth 4 defaults) - (set (make-local-variable 'font-lock-beginning-of-syntax-function) - (nth 4 defaults))) - ;; Variable alist? - (dolist (x (nthcdr 5 defaults)) - (set (make-local-variable (car x)) (cdr x))) - ;; Setup `font-lock-keywords' last because its value might depend - ;; on other settings (e.g. font-lock-compile-keywords uses - ;; font-lock-beginning-of-syntax-function). - (set (make-local-variable 'font-lock-keywords) - (font-lock-compile-keywords (font-lock-eval-keywords keywords) t)) - ;; Local fontification? - (while local - (font-lock-add-keywords nil (car (car local)) (cdr (car local))) - (setq local (cdr local))) - (when removed-keywords - (font-lock-remove-keywords nil removed-keywords)))) +(defvar font-lock-set-defaults nil) ; Whether we have set up defaults. + +(defvar font-lock-mode-major-mode) +(defun font-lock-set-defaults () + "Set fontification defaults appropriately for this mode. +Sets various variables using `font-lock-defaults' (or, if nil, using +`font-lock-defaults-alist') and `font-lock-maximum-decoration'." + ;; Set fontification defaults iff not previously set for correct major mode. + (unless (and font-lock-set-defaults + (eq font-lock-mode-major-mode major-mode)) + (setq font-lock-mode-major-mode major-mode) + (set (make-local-variable 'font-lock-set-defaults) t) + (make-local-variable 'font-lock-fontified) + (make-local-variable 'font-lock-multiline) + (let* ((defaults (or font-lock-defaults + (cdr (assq major-mode + (with-no-warnings + font-lock-defaults-alist))))) + (keywords + (font-lock-choose-keywords (nth 0 defaults) + (font-lock-value-in-major-mode font-lock-maximum-decoration))) + (local (cdr (assq major-mode font-lock-keywords-alist))) + (removed-keywords + (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) + (set (make-local-variable 'font-lock-defaults) defaults) + ;; Syntactic fontification? + (when (nth 1 defaults) + (set (make-local-variable 'font-lock-keywords-only) t)) + ;; Case fold during regexp fontification? + (when (nth 2 defaults) + (set (make-local-variable 'font-lock-keywords-case-fold-search) t)) + ;; Syntax table for regexp and syntactic fontification? + (when (nth 3 defaults) + (set (make-local-variable 'font-lock-syntax-table) + (copy-syntax-table (syntax-table))) + (dolist (selem (nth 3 defaults)) + ;; The character to modify may be a single CHAR or a STRING. + (let ((syntax (cdr selem))) + (dolist (char (if (numberp (car selem)) + (list (car selem)) + (mapcar 'identity (car selem)))) + (modify-syntax-entry char syntax font-lock-syntax-table))))) + ;; Syntax function for syntactic fontification? + (when (nth 4 defaults) + (set (make-local-variable 'font-lock-beginning-of-syntax-function) + (nth 4 defaults))) + ;; Variable alist? + (dolist (x (nthcdr 5 defaults)) + (set (make-local-variable (car x)) (cdr x))) + ;; Set up `font-lock-keywords' last because its value might depend + ;; on other settings (e.g. font-lock-compile-keywords uses + ;; font-lock-beginning-of-syntax-function). + (set (make-local-variable 'font-lock-keywords) + (font-lock-eval-keywords keywords)) + ;; Local fontification? + (while local + (font-lock-add-keywords nil (car (car local)) (cdr (car local))) + (setq local (cdr local))) + (when removed-keywords + (font-lock-remove-keywords nil removed-keywords)) + ;; Now compile the keywords. + (unless (eq (car font-lock-keywords) t) + (setq font-lock-keywords + (font-lock-compile-keywords font-lock-keywords t)))))) ;;; Colour etc. support. -;; Originally face attributes were specified via `font-lock-face-attributes'. -;; Users then changed the default face attributes by setting that variable. -;; However, we try and be back-compatible and respect its value if set except -;; for faces where M-x customize has been used to save changes for the face. -(when (boundp 'font-lock-face-attributes) - (let ((face-attributes font-lock-face-attributes)) - (while face-attributes - (let* ((face-attribute (pop face-attributes)) - (face (car face-attribute))) - ;; Rustle up a `defface' SPEC from a `font-lock-face-attributes' entry. - (unless (get face 'saved-face) - (let ((foreground (nth 1 face-attribute)) - (background (nth 2 face-attribute)) - (bold-p (nth 3 face-attribute)) - (italic-p (nth 4 face-attribute)) - (underline-p (nth 5 face-attribute)) - face-spec) - (when foreground - (setq face-spec (cons ':foreground (cons foreground face-spec)))) - (when background - (setq face-spec (cons ':background (cons background face-spec)))) - (when bold-p - (setq face-spec (append '(:weight bold) face-spec))) - (when italic-p - (setq face-spec (append '(:slant italic) face-spec))) - (when underline-p - (setq face-spec (append '(:underline t) face-spec))) - (custom-declare-face face (list (list t face-spec)) nil))))))) - -;; But now we do it the custom way. Note that `defface' will not overwrite any -;; faces declared above via `custom-declare-face'. +;; Note that `defface' will not overwrite any faces declared above via +;; `custom-declare-face'. (defface font-lock-comment-face - '((((type tty pc) (class color) (background light)) (:foreground "red")) - (((type tty pc) (class color) (background dark)) (:foreground "red1")) - (((class grayscale) (background light)) + '((((class grayscale) (background light)) (:foreground "DimGray" :weight bold :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :weight bold :slant italic)) - (((class color) (background light)) (:foreground "Firebrick")) - (((class color) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 88) (background light)) + (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) + (:foreground "chocolate1")) + (((class color) (min-colors 16) (background light)) + (:foreground "red")) + (((class color) (min-colors 16) (background dark)) + (:foreground "red1")) + (((class color) (min-colors 8) (background light)) + ) + (((class color) (min-colors 8) (background dark)) + ) (t (:weight bold :slant italic))) "Font Lock mode face used to highlight comments." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) + +(defface font-lock-comment-delimiter-face + '((default :inherit font-lock-comment-face) + (((class grayscale))) + (((class color) (min-colors 16))) + (((class color) (min-colors 8) (background light)) + :foreground "red") + (((class color) (min-colors 8) (background dark)) + :foreground "red1")) + "Font Lock mode face used to highlight comment delimiters." + :group 'font-lock-faces) (defface font-lock-string-face - '((((type tty) (class color)) (:foreground "green")) - (((class grayscale) (background light)) (:foreground "DimGray" :slant italic)) + '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic)) - (((class color) (background light)) (:foreground "RosyBrown")) - (((class color) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 88) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8)) (:foreground "green")) (t (:slant italic))) "Font Lock mode face used to highlight strings." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-doc-face '((t :inherit font-lock-string-face)) "Font Lock mode face used to highlight documentation." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-keyword-face - '((((type tty) (class color)) (:foreground "cyan" :weight bold)) - (((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) + '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) + (((class color) (min-colors 88) (background light)) (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) + (((class color) (min-colors 16) (background light)) (:foreground "Purple")) + (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) + (((class color) (min-colors 8)) (:foreground "cyan" :weight bold)) (t (:weight bold))) "Font Lock mode face used to highlight keywords." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-builtin-face - '((((type tty) (class color)) (:foreground "blue" :weight light)) - (((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) + '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (background light)) (:foreground "Orchid")) - (((class color) (background dark)) (:foreground "LightSteelBlue")) + (((class color) (min-colors 88) (background light)) (:foreground "Orchid")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Orchid")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) (t (:weight bold))) "Font Lock mode face used to highlight builtins." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-function-name-face - '((((type tty) (class color)) (:foreground "blue" :weight bold)) - (((class color) (background light)) (:foreground "Blue")) - (((class color) (background dark)) (:foreground "LightSkyBlue")) + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :weight bold)) (t (:inverse-video t :weight bold))) "Font Lock mode face used to highlight function names." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-variable-name-face - '((((type tty) (class color)) (:foreground "yellow" :weight light)) - (((class grayscale) (background light)) + '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold :slant italic)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold :slant italic)) - (((class color) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 88) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)) (t (:weight bold :slant italic))) "Font Lock mode face used to highlight variable names." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-type-face - '((((type tty) (class color)) (:foreground "green")) - (((class grayscale) (background light)) (:foreground "Gray90" :weight bold)) + '((((class grayscale) (background light)) (:foreground "Gray90" :weight bold)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (background light)) (:foreground "ForestGreen")) - (((class color) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 88) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) (t (:weight bold :underline t))) "Font Lock mode face used to highlight type and classes." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-constant-face - '((((type tty) (class color)) (:foreground "magenta")) - (((class grayscale) (background light)) + '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold :underline t)) (((class grayscale) (background dark)) (:foreground "Gray50" :weight bold :underline t)) - (((class color) (background light)) (:foreground "CadetBlue")) - (((class color) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 88) (background light)) (:foreground "CadetBlue")) + (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) + (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 8)) (:foreground "magenta")) (t (:weight bold :underline t))) "Font Lock mode face used to highlight constants and labels." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) (defface font-lock-warning-face - '((((type tty) (class color)) (:foreground "red")) - (((class color) (background light)) (:foreground "Red" :weight bold)) - (((class color) (background dark)) (:foreground "Pink" :weight bold)) + '((((class color) (min-colors 88) (background light)) (:foreground "Red1" :weight bold)) + (((class color) (min-colors 88) (background dark)) (:foreground "Pink" :weight bold)) + (((class color) (min-colors 16) (background light)) (:foreground "Red1" :weight bold)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold)) + (((class color) (min-colors 8)) (:foreground "red")) (t (:inverse-video t :weight bold))) "Font Lock mode face used to highlight warnings." - :group 'font-lock-highlighting-faces) + :group 'font-lock-faces) + +(defface font-lock-negation-char-face + '((t nil)) + "Font Lock mode face used to highlight easy to overlook negation." + :group 'font-lock-faces) + +(defface font-lock-preprocessor-face + '((t :inherit font-lock-builtin-face)) + "Font Lock mode face used to highlight preprocessor directives." + :group 'font-lock-faces) + +(defface font-lock-regexp-grouping-backslash + '((t :inherit bold)) + "Font Lock mode face for backslashes in Lisp regexp grouping constructs." + :group 'font-lock-faces) + +(defface font-lock-regexp-grouping-construct + '((t :inherit bold)) + "Font Lock mode face used to highlight grouping constructs in Lisp regexps." + :group 'font-lock-faces) ;;; End of Colour etc. support. @@ -1638,98 +1824,98 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to ;; buttons and when they are on or off needs tweaking. I have assumed that the ;; mechanism is via `menu-toggle' and `menu-selected' symbol properties. sm. -;;;;###autoload -;(progn -; ;; Make the Font Lock menu. -; (defvar font-lock-menu (make-sparse-keymap "Syntax Highlighting")) -; ;; Add the menu items in reverse order. -; (define-key font-lock-menu [fontify-less] -; '("Less In Current Buffer" . font-lock-fontify-less)) -; (define-key font-lock-menu [fontify-more] -; '("More In Current Buffer" . font-lock-fontify-more)) -; (define-key font-lock-menu [font-lock-sep] -; '("--")) -; (define-key font-lock-menu [font-lock-mode] -; '("In Current Buffer" . font-lock-mode)) -; (define-key font-lock-menu [global-font-lock-mode] -; '("In All Buffers" . global-font-lock-mode))) -; -;;;;###autoload -;(progn -; ;; We put the appropriate `menu-enable' etc. symbol property values on when -; ;; font-lock.el is loaded, so we don't need to autoload the three variables. -; (put 'global-font-lock-mode 'menu-toggle t) -; (put 'font-lock-mode 'menu-toggle t) -; (put 'font-lock-fontify-more 'menu-enable '(identity)) -; (put 'font-lock-fontify-less 'menu-enable '(identity))) -; -;;; Put the appropriate symbol property values on now. See above. -;(put 'global-font-lock-mode 'menu-selected 'global-font-lock-mode) -;(put 'font-lock-mode 'menu-selected 'font-lock-mode) -;(put 'font-lock-fontify-more 'menu-enable '(nth 2 font-lock-fontify-level)) -;(put 'font-lock-fontify-less 'menu-enable '(nth 1 font-lock-fontify-level)) -; -;(defvar font-lock-fontify-level nil) ; For less/more fontification. -; -;(defun font-lock-fontify-level (level) -; (let ((font-lock-maximum-decoration level)) -; (when font-lock-mode -; (font-lock-mode)) -; (font-lock-mode) -; (when font-lock-verbose -; (message "Fontifying %s... level %d" (buffer-name) level)))) -; -;(defun font-lock-fontify-less () -; "Fontify the current buffer with less decoration. -;See `font-lock-maximum-decoration'." -; (interactive) -; ;; Check in case we get called interactively. -; (if (nth 1 font-lock-fontify-level) -; (font-lock-fontify-level (1- (car font-lock-fontify-level))) -; (error "No less decoration"))) -; -;(defun font-lock-fontify-more () -; "Fontify the current buffer with more decoration. -;See `font-lock-maximum-decoration'." -; (interactive) -; ;; Check in case we get called interactively. -; (if (nth 2 font-lock-fontify-level) -; (font-lock-fontify-level (1+ (car font-lock-fontify-level))) -; (error "No more decoration"))) -; -;;; This should be called by `font-lock-set-defaults'. -;(defun font-lock-set-menu () -; ;; Activate less/more fontification entries if there are multiple levels for -; ;; the current buffer. Sets `font-lock-fontify-level' to be of the form -; ;; (CURRENT-LEVEL IS-LOWER-LEVEL-P IS-HIGHER-LEVEL-P) for menu activation. -; (let ((keywords (or (nth 0 font-lock-defaults) -; (nth 1 (assq major-mode font-lock-defaults-alist)))) -; (level (font-lock-value-in-major-mode font-lock-maximum-decoration))) -; (make-local-variable 'font-lock-fontify-level) -; (if (or (symbolp keywords) (= (length keywords) 1)) -; (font-lock-unset-menu) -; (cond ((eq level t) -; (setq level (1- (length keywords)))) -; ((or (null level) (zerop level)) -; ;; The default level is usually, but not necessarily, level 1. -; (setq level (- (length keywords) -; (length (member (eval (car keywords)) -; (mapcar 'eval (cdr keywords)))))))) -; (setq font-lock-fontify-level (list level (> level 1) -; (< level (1- (length keywords)))))))) -; -;;; This should be called by `font-lock-unset-defaults'. -;(defun font-lock-unset-menu () -; ;; Deactivate less/more fontification entries. -; (setq font-lock-fontify-level nil)) +;;;;;###autoload +;;(progn +;; ;; Make the Font Lock menu. +;; (defvar font-lock-menu (make-sparse-keymap "Syntax Highlighting")) +;; ;; Add the menu items in reverse order. +;; (define-key font-lock-menu [fontify-less] +;; '("Less In Current Buffer" . font-lock-fontify-less)) +;; (define-key font-lock-menu [fontify-more] +;; '("More In Current Buffer" . font-lock-fontify-more)) +;; (define-key font-lock-menu [font-lock-sep] +;; '("--")) +;; (define-key font-lock-menu [font-lock-mode] +;; '("In Current Buffer" . font-lock-mode)) +;; (define-key font-lock-menu [global-font-lock-mode] +;; '("In All Buffers" . global-font-lock-mode))) +;; +;;;;;###autoload +;;(progn +;; ;; We put the appropriate `menu-enable' etc. symbol property values on when +;; ;; font-lock.el is loaded, so we don't need to autoload the three variables. +;; (put 'global-font-lock-mode 'menu-toggle t) +;; (put 'font-lock-mode 'menu-toggle t) +;; (put 'font-lock-fontify-more 'menu-enable '(identity)) +;; (put 'font-lock-fontify-less 'menu-enable '(identity))) +;; +;; ;; Put the appropriate symbol property values on now. See above. +;;(put 'global-font-lock-mode 'menu-selected 'global-font-lock-mode) +;;(put 'font-lock-mode 'menu-selected 'font-lock-mode) +;;(put 'font-lock-fontify-more 'menu-enable '(nth 2 font-lock-fontify-level)) +;;(put 'font-lock-fontify-less 'menu-enable '(nth 1 font-lock-fontify-level)) +;; +;;(defvar font-lock-fontify-level nil) ; For less/more fontification. +;; +;;(defun font-lock-fontify-level (level) +;; (let ((font-lock-maximum-decoration level)) +;; (when font-lock-mode +;; (font-lock-mode)) +;; (font-lock-mode) +;; (when font-lock-verbose +;; (message "Fontifying %s... level %d" (buffer-name) level)))) +;; +;;(defun font-lock-fontify-less () +;; "Fontify the current buffer with less decoration. +;;See `font-lock-maximum-decoration'." +;; (interactive) +;; ;; Check in case we get called interactively. +;; (if (nth 1 font-lock-fontify-level) +;; (font-lock-fontify-level (1- (car font-lock-fontify-level))) +;; (error "No less decoration"))) +;; +;;(defun font-lock-fontify-more () +;; "Fontify the current buffer with more decoration. +;;See `font-lock-maximum-decoration'." +;; (interactive) +;; ;; Check in case we get called interactively. +;; (if (nth 2 font-lock-fontify-level) +;; (font-lock-fontify-level (1+ (car font-lock-fontify-level))) +;; (error "No more decoration"))) +;; +;; ;; This should be called by `font-lock-set-defaults'. +;;(defun font-lock-set-menu () +;; ;; Activate less/more fontification entries if there are multiple levels for +;; ;; the current buffer. Sets `font-lock-fontify-level' to be of the form +;; ;; (CURRENT-LEVEL IS-LOWER-LEVEL-P IS-HIGHER-LEVEL-P) for menu activation. +;; (let ((keywords (or (nth 0 font-lock-defaults) +;; (nth 1 (assq major-mode font-lock-defaults-alist)))) +;; (level (font-lock-value-in-major-mode font-lock-maximum-decoration))) +;; (make-local-variable 'font-lock-fontify-level) +;; (if (or (symbolp keywords) (= (length keywords) 1)) +;; (font-lock-unset-menu) +;; (cond ((eq level t) +;; (setq level (1- (length keywords)))) +;; ((or (null level) (zerop level)) +;; ;; The default level is usually, but not necessarily, level 1. +;; (setq level (- (length keywords) +;; (length (member (eval (car keywords)) +;; (mapcar 'eval (cdr keywords)))))))) +;; (setq font-lock-fontify-level (list level (> level 1) +;; (< level (1- (length keywords)))))))) +;; +;; ;; This should be called by `font-lock-unset-defaults'. +;;(defun font-lock-unset-menu () +;; ;; Deactivate less/more fontification entries. +;; (setq font-lock-fontify-level nil)) ;;; End of Menu support. ;;; Various regexp information shared by several modes. -;;; Information specific to a single mode should go in its load library. +;; ;; Information specific to a single mode should go in its load library. -;; Font Lock support for C, C++, Objective-C and Java modes will one day be in -;; some cc-font.el (and required by cc-mode.el). However, the below function +;; Font Lock support for C, C++, Objective-C and Java modes is now in +;; cc-fonts.el (and required by cc-mode.el). However, the below function ;; should stay in font-lock.el, since it is used by other libraries. sm. (defun font-lock-match-c-style-declaration-item-and-skip-to-next (limit) @@ -1740,7 +1926,7 @@ Does not move further than LIMIT. The expected syntax of a declaration/definition item is `word' (preceded by optional whitespace and `*' characters and proceeded by optional whitespace) optionally followed by a `('. Everything following the item (but belonging to -it) is expected to by skip-able by `scan-sexps', and items are expected to be +it) is expected to be skip-able by `scan-sexps', and items are expected to be separated with a `,' and to be terminated with a `;'. Thus the regexp matches after point: word ( @@ -1759,7 +1945,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." (let ((pos (point))) (skip-chars-backward " \t\n") (skip-syntax-backward "w") - (unless (looking-at "\\(\\sw+\\)[ \t\n]*\\sw*_\\sw*[ \t\n]*\\((\\)?") + (unless (looking-at "\\(\\sw+\\)[ \t\n]*\\sw+[ \t\n]*\\(((?\\)?") ;; Looks like it was something else, so go back to where we ;; were and reset the match data by rematching. (goto-char pos) @@ -1775,962 +1961,198 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." (goto-char (or (scan-sexps (point) 1) (point-max)))) (goto-char (match-end 2))) (error t))))) + +;; C preprocessor(cpp) is used outside of C, C++ and Objective-C source file. +;; e.g. assembler code and GNU linker script in Linux kernel. +;; `cpp-font-lock-keywords' is handy for modes for the files. +;; +;; Here we cannot use `regexp-opt' because because regex-opt is not preloaded +;; while font-lock.el is preloaded to emacs. So values pre-calculated with +;; regexp-opt are used here. + +;; `cpp-font-lock-keywords-source-directives' is calculated from: +;; +;; (regexp-opt +;; '("define" "elif" "else" "endif" "error" "file" "if" "ifdef" +;; "ifndef" "include" "line" "pragma" "undef")) +;; +(defconst cpp-font-lock-keywords-source-directives + "define\\|e\\(?:l\\(?:if\\|se\\)\\|ndif\\|rror\\)\\|file\\|i\\(?:f\\(?:n?def\\)?\\|nclude\\)\\|line\\|pragma\\|undef" + "Regular expressoin used in `cpp-font-lock-keywords'.") + +;; `cpp-font-lock-keywords-source-depth' is calculated from: +;; +;; (regexp-opt-depth (regexp-opt +;; '("define" "elif" "else" "endif" "error" "file" "if" "ifdef" +;; "ifndef" "include" "line" "pragma" "undef"))) +;; +(defconst cpp-font-lock-keywords-source-depth 0 + "An integer representing regular expression depth of `cpp-font-lock-keywords-source-directives'. +Used in `cpp-font-lock-keywords'.") + +(defconst cpp-font-lock-keywords + (let* ((directives cpp-font-lock-keywords-source-directives) + (directives-depth cpp-font-lock-keywords-source-depth)) + (list + ;; + ;; Fontify error directives. + '("^#[ \t]*error[ \t]+\\(.+\\)" 1 font-lock-warning-face prepend) + ;; + ;; Fontify filenames in #include <...> preprocessor directives as strings. + '("^#[ \t]*\\(?:import\\|include\\)[ \t]*\\(<[^>\"\n]*>?\\)" + 1 font-lock-string-face prepend) + ;; + ;; Fontify function macro names. + '("^#[ \t]*define[ \t]+\\([[:alpha:]_][[:alnum:]_$]*\\)(" + (1 font-lock-function-name-face prepend) + ;; + ;; Macro arguments. + ((lambda (limit) + (re-search-forward + "\\(?:\\([[:alpha:]_][[:alnum:]_]*\\)[,]?\\)" + (or (save-excursion (re-search-forward ")" limit t)) + limit) + t)) + nil nil (1 font-lock-variable-name-face prepend))) + ;; + ;; Fontify symbol names in #elif or #if ... defined preprocessor directives. + '("^#[ \t]*\\(?:elif\\|if\\)\\>" + ("\\<\\(defined\\)\\>[ \t]*(?\\([[:alpha:]_][[:alnum:]_]*\\)?" nil nil + (1 font-lock-builtin-face prepend) (2 font-lock-variable-name-face prepend t))) + ;; + ;; Fontify otherwise as symbol names, and the preprocessor directive names. + (list + (concat "^\\(#[ \t]*\\(?:" directives + "\\)\\)\\>[ \t!]*\\([[:alpha:]_][[:alnum:]_]*\\)?") + '(1 font-lock-preprocessor-face prepend) + (list (+ 2 directives-depth) + 'font-lock-variable-name-face nil t)))) + "Font lock keyords for C preprocessor directives. +`c-mode', `c++-mode' and `objc-mode' have their own +font lock keyords for C preprocessor directives. This definition is for the +other modes in which C preprocessor directives are used. e.g. `asm-mode' and +`ld-script-mode'.") + ;; Lisp. (defconst lisp-font-lock-keywords-1 (eval-when-compile - (list - ;; - ;; Definitions. - (list (concat "(\\(def\\(" - ;; Function declarations. - "\\(advice\\|varalias\\|alias\\|generic\\|macro\\*?\\|method\\|" - "setf\\|subst\\*?\\|un\\*?\\|" - "ine-\\(condition\\|\\(?:derived\\|minor\\)-mode\\|" - "method-combination\\|setf-expander\\|skeleton\\|widget\\|" - "function\\|\\(compiler\\|modify\\|symbol\\)-macro\\)\\)\\|" - ;; Variable declarations. - "\\(const\\(ant\\)?\\|custom\\|face\\|parameter\\|var\\)\\|" - ;; Structure declarations. - "\\(class\\|group\\|theme\\|package\\|struct\\|type\\)" - "\\)\\)\\>" - ;; Any whitespace and defined object. - "[ \t'\(]*" - "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?") - '(1 font-lock-keyword-face) - '(9 (cond ((match-beginning 3) font-lock-function-name-face) - ((match-beginning 6) font-lock-variable-name-face) - (t font-lock-type-face)) - nil t)) - ;; - ;; Emacs Lisp autoload cookies. - '("^;;;###\\(autoload\\)" 1 font-lock-warning-face prepend) - )) + `(;; Definitions. + (,(concat "(\\(def\\(" + ;; Function declarations. + "\\(advice\\|alias\\|generic\\|macro\\*?\\|method\\|" + "setf\\|subst\\*?\\|un\\*?\\|" + "ine-\\(condition\\|" + "\\(?:derived\\|\\(?:global-\\)?minor\\|generic\\)-mode\\|" + "method-combination\\|setf-expander\\|skeleton\\|widget\\|" + "function\\|\\(compiler\\|modify\\|symbol\\)-macro\\)\\)\\|" + ;; Variable declarations. + "\\(const\\(ant\\)?\\|custom\\|varalias\\|face\\|parameter\\|var\\)\\|" + ;; Structure declarations. + "\\(class\\|group\\|theme\\|package\\|struct\\|type\\)" + "\\)\\)\\>" + ;; Any whitespace and defined object. + "[ \t'\(]*" + "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?") + (1 font-lock-keyword-face) + (9 (cond ((match-beginning 3) font-lock-function-name-face) + ((match-beginning 6) font-lock-variable-name-face) + (t font-lock-type-face)) + nil t)) + ;; Emacs Lisp autoload cookies. + ("^;;;###\\(autoload\\)" 1 font-lock-warning-face prepend) + ;; Regexp negated char group. + ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend))) "Subdued level highlighting for Lisp modes.") (defconst lisp-font-lock-keywords-2 (append lisp-font-lock-keywords-1 (eval-when-compile - (list - ;; - ;; Control structures. Emacs Lisp forms. - (cons (concat - "(" (regexp-opt - '("cond" "if" "while" "let" "let*" - "prog" "progn" "progv" "prog1" "prog2" "prog*" - "inline" "lambda" "save-restriction" "save-excursion" - "save-window-excursion" "save-selected-window" - "save-match-data" "save-current-buffer" "unwind-protect" - "condition-case" "track-mouse" - "eval-after-load" "eval-and-compile" "eval-when-compile" - "eval-when" - "with-current-buffer" "with-electric-help" - "with-output-to-string" "with-output-to-temp-buffer" - "with-temp-buffer" "with-temp-file" "with-temp-message" - "with-timeout") t) - "\\>") - 1) - ;; - ;; Control structures. Common Lisp forms. - (cons (concat - "(" (regexp-opt - '("when" "unless" "case" "ecase" "typecase" "etypecase" - "ccase" "ctypecase" "handler-case" "handler-bind" - "restart-bind" "restart-case" "in-package" - "cerror" "break" "ignore-errors" - "loop" "do" "do*" "dotimes" "dolist" "the" "locally" - "proclaim" "declaim" "declare" "symbol-macrolet" - "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" - "destructuring-bind" "macrolet" "tagbody" "block" - "return" "return-from") t) - "\\>") - 1) - ;; - ;; Exit/Feature symbols as constants. - (list (concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>" - "[ \t']*\\(\\sw+\\)?") - '(1 font-lock-keyword-face) - '(2 font-lock-constant-face nil t)) - ;; - ;; Erroneous structures. - '("(\\(abort\\|assert\\|error\\|signal\\)\\>" 1 font-lock-warning-face) - ;; - ;; Words inside \\[] tend to be for `substitute-command-keys'. - '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-constant-face prepend) - ;; - ;; Words inside `' tend to be symbol names. - '("`\\(\\sw\\sw+\\)'" 1 font-lock-constant-face prepend) - ;; - ;; Constant values. - '("\\<:\\sw+\\>" 0 font-lock-builtin-face) - ;; - ;; ELisp and CLisp `&' keywords as types. - '("\\&\\sw+\\>" . font-lock-type-face) - ;; - ;; CL `with-' and `do-' constructs - '("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + `(;; Control structures. Emacs Lisp forms. + (,(concat + "(" (regexp-opt + '("cond" "if" "while" "while-no-input" "let" "let*" + "prog" "progn" "progv" "prog1" "prog2" "prog*" + "inline" "lambda" "save-restriction" "save-excursion" + "save-window-excursion" "save-selected-window" + "save-match-data" "save-current-buffer" "unwind-protect" + "condition-case" "track-mouse" + "eval-after-load" "eval-and-compile" "eval-when-compile" + "eval-when" "eval-at-startup" "eval-next-after-load" + "with-category-table" + "with-current-buffer" "with-electric-help" + "with-local-quit" "with-no-warnings" + "with-output-to-string" "with-output-to-temp-buffer" + "with-selected-window" "with-syntax-table" + "with-temp-buffer" "with-temp-file" "with-temp-message" + "with-timeout" "with-timeout-handler") t) + "\\>") + . 1) + ;; Control structures. Common Lisp forms. + (,(concat + "(" (regexp-opt + '("when" "unless" "case" "ecase" "typecase" "etypecase" + "ccase" "ctypecase" "handler-case" "handler-bind" + "restart-bind" "restart-case" "in-package" + "break" "ignore-errors" + "loop" "do" "do*" "dotimes" "dolist" "the" "locally" + "proclaim" "declaim" "declare" "symbol-macrolet" + "lexical-let" "lexical-let*" "flet" "labels" "compiler-let" + "destructuring-bind" "macrolet" "tagbody" "block" "go" + "multiple-value-bind" "multiple-value-prog1" + "return" "return-from" + "with-accessors" "with-compilation-unit" + "with-condition-restarts" "with-hash-table-iterator" + "with-input-from-string" "with-open-file" + "with-open-stream" "with-output-to-string" + "with-package-iterator" "with-simple-restart" + "with-slots" "with-standard-io-syntax") t) + "\\>") + . 1) + ;; Exit/Feature symbols as constants. + (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\>" + "[ \t']*\\(\\sw+\\)?") + (1 font-lock-keyword-face) + (2 font-lock-constant-face nil t)) + ;; Erroneous structures. + ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\>" 1 font-lock-warning-face) + ;; Words inside \\[] tend to be for `substitute-command-keys'. + ("\\\\\\\\\\[\\(\\sw+\\)\\]" 1 font-lock-constant-face prepend) + ;; Words inside `' tend to be symbol names. + ("`\\(\\sw\\sw+\\)'" 1 font-lock-constant-face prepend) + ;; Constant values. + ("\\<:\\sw+\\>" 0 font-lock-builtin-face) + ;; ELisp and CLisp `&' keywords as types. + ("\\<\\&\\sw+\\>" . font-lock-type-face) + ;; ELisp regexp grouping constructs + ((lambda (bound) + (catch 'found + ;; The following loop is needed to continue searching after matches + ;; that do not occur in strings. The associated regexp matches one + ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to + ;; avoid highlighting, for example, `\\(' in `\\\\('. + (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?:\\)?\\|[|)]\\)\\)" bound t) + (unless (match-beginning 2) + (let ((face (get-text-property (1- (point)) 'face))) + (when (or (and (listp face) + (memq 'font-lock-string-face face)) + (eq 'font-lock-string-face face)) + (throw 'found t))))))) + (1 'font-lock-regexp-grouping-backslash prepend) + (3 'font-lock-regexp-grouping-construct prepend)) +;;; This is too general -- rms. +;;; A user complained that he has functions whose names start with `do' +;;; and that they get the wrong color. +;;; ;; CL `with-' and `do-' constructs +;;; ("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) ))) "Gaudy level highlighting for Lisp modes.") (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 "Default expressions to highlight in Lisp modes.") -;;; User choices. - -;; These provide a means to fontify types not defined by the language. Those -;; types might be the user's own or they might be generally accepted and used. -;; Generally accepted types are used to provide default variable values. - -(define-widget 'font-lock-extra-types-widget 'radio - "Widget `:type' for members of the custom group `font-lock-extra-types'. -Members should `:load' the package `font-lock' to use this widget." - :args '((const :tag "none" nil) - (repeat :tag "types" regexp))) - -(defcustom c-font-lock-extra-types '("FILE" "\\sw+_t" "Lisp_Object") - "*List of extra types to fontify in C mode. -Each list item should be a regexp not containing word-delimiters. -For example, a value of (\"FILE\" \"\\\\sw+_t\") means the word FILE and words -ending in _t are treated as type names. - -The value of this variable is used when Font Lock mode is turned on." - :type 'font-lock-extra-types-widget - :group 'font-lock-extra-types) - -(defcustom c++-font-lock-extra-types - '("\\sw+_t" - - "string" "rope" - - "list" "slist" - "deque" "vector" "bit_vector" - - "set" "multiset" - "map" "multimap" - "stack" "queue" "priority_queue" - "type_info" - - ;; (regexp-opt '("ios_base" "ios" "istream" "ostream" "istringstream" "ifstream" "iostream" "ofstream" "ostringstream" "fstream" "stringstream")) - "fstream\\|i\\(?:fstream\\|os\\(?:_base\\|tream\\)?\\|str\\(?:\\(?:ingstr\\)?eam\\)\\)\\|\\(?:o\\(?:f\\|string\\)?\\|string\\)stream" - - ;; (regexp-opt '("hash" "hash_set" "hash_map" "hash_multiset" "hash_multimap")) - "hash\\(?:_\\(?:m\\(?:ap\\|ulti\\(?:map\\|set\\)\\)\\|set\\)\\)?" - - ;; (regexp-opt '("pointer" "const_pointer" "reference" "const_reference" "iterator" "const_iterator" "reverse_iterator" "const_reverse_iterator" "size_type" "difference_type" "allocator_type")) - "allocator_type\\|const_\\(?:iterator\\|pointer\\|re\\(?:ference\\|verse_iterator\\)\\)\\|difference_type\\|iterator\\|pointer\\|re\\(?:ference\\|verse_iterator\\)\\|size_type" - ) - "*List of extra types to fontify in C++ mode. -Each list item should be a regexp not containing word-delimiters. -For example, a value of (\"string\") means the word string is treated as a type -name. - -The value of this variable is used when Font Lock mode is turned on." - :type 'font-lock-extra-types-widget - :group 'font-lock-extra-types) - -(defcustom objc-font-lock-extra-types '("Class" "BOOL" "IMP" "SEL") - "*List of extra types to fontify in Objective-C mode. -Each list item should be a regexp not containing word-delimiters. -For example, a value of (\"Class\" \"BOOL\" \"IMP\" \"SEL\") means the words -Class, BOOL, IMP and SEL are treated as type names. - -The value of this variable is used when Font Lock mode is turned on." - :type 'font-lock-extra-types-widget - :group 'font-lock-extra-types) - -(defcustom java-font-lock-extra-types - '("[A-Z\300-\326\330-\337]\\sw*[a-z]\\sw*" "URL") - "*List of extra types to fontify in Java mode. -Each list item should be a regexp not containing word-delimiters. -For example, a value of (\"[A-Z\300-\326\330-\337]\\\\sw*[a-z]\\\\sw*\" \"URL\") means -capitalised words (that conform to the Java id spec) and URL are treated as -type names. - -The value of this variable is used when Font Lock mode is turned on." - :type 'font-lock-extra-types-widget - :group 'font-lock-extra-types) - -;;; C. - -;; [Murmur murmur murmur] Maestro, drum-roll please... [Murmur murmur murmur.] -;; Ahem. [Murmur murmur murmur] Lay-dees an Gennel-men. [Murmur murmur shhh!] -;; I am most proud and humbly honoured today [murmur murmur cough] to present -;; to you good people, the winner of the Second Millennium Award for The Most -;; Hairy Language Syntax. [Ahhh!] All rise please. [Shuffle shuffle -;; shuffle.] And a round of applause please. For... The C Language! [Roar.] -;; -;; Thank you... You are too kind... It is with a feeling of great privilege -;; and indeed emotion [sob] that I accept this award. It has been a long hard -;; road. But we know our destiny. And our future. For we must not rest. -;; There are more tokens to overload, more shoehorn, more methodologies. But -;; more is a plus! [Ha ha ha.] And more means plus! [Ho ho ho.] The future -;; is C++! [Ohhh!] The Third Millennium Award... Will be ours! [Roar.] - -(let* ((c-keywords - (eval-when-compile - (regexp-opt '("break" "continue" "do" "else" "for" "if" "return" - "switch" "while" "sizeof" - ;; Type related, but we don't do anything special. - "typedef" "extern" "auto" "register" "static" - "volatile" "const" - ;; Dan Nicolaescu says this is new. - "restrict" - ;; Henrik Enberg says this is new. - "inline")))) - (c-type-specs - (eval-when-compile - (regexp-opt '("enum" "struct" "union")))) - (c-type-specs-depth - (regexp-opt-depth c-type-specs)) - (c-type-names - `(mapconcat 'identity - (cons - ,(eval-when-compile - (regexp-opt - '("char" "short" "int" "long" "signed" "unsigned" - "float" "double" "void" "complex" - ;; Henrik Enberg says these are new. - "_Complex" "_Imaginary" "_Bool"))) - c-font-lock-extra-types) - "\\|")) - (c-type-names-depth - `(regexp-opt-depth ,c-type-names)) - (c-preprocessor-directives - (eval-when-compile - (regexp-opt - '("define" "elif" "else" "endif" "error" "file" "if" "ifdef" - "ifndef" "include" "line" "pragma" "undef")))) - (c-preprocessor-directives-depth - (regexp-opt-depth c-preprocessor-directives))) - - (defconst c-font-lock-keywords-1 - (list - ;; - ;; These are all anchored at the beginning of line for speed. - ;; Note that `c++-font-lock-keywords-1' depends on `c-font-lock-keywords-1'. - ;; - ;; Fontify function name definitions (GNU style; without type on line). - '("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face) - ;; - ;; Fontify error directives. - '("^#[ \t]*error[ \t]+\\(.+\\)" 1 font-lock-warning-face prepend) - ;; - ;; Fontify filenames in #include <...> preprocessor directives as strings. - '("^#[ \t]*\\(import\\|include\\)[ \t]*\\(<[^>\"\n]*>?\\)" - 2 font-lock-string-face) - ;; - ;; Fontify function macro names. - '("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face) - ;; - ;; Fontify symbol names in #elif or #if ... defined preprocessor directives. - '("^#[ \t]*\\(elif\\|if\\)\\>" - ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil - (1 font-lock-builtin-face) (2 font-lock-variable-name-face nil t))) - ;; - ;; Fontify otherwise as symbol names, and the preprocessor directive names. - (list - (concat "^#[ \t]*\\(" c-preprocessor-directives - "\\)\\>[ \t!]*\\(\\sw+\\)?") - '(1 font-lock-builtin-face) - (list (+ 2 c-preprocessor-directives-depth) - 'font-lock-variable-name-face nil t))) - "Subdued level highlighting for C mode.") - - (defconst c-font-lock-keywords-2 - (append c-font-lock-keywords-1 - (list - ;; - ;; Simple regexps for speed. - ;; - ;; Fontify all type names. - `(eval . - (cons (concat "\\<\\(" ,c-type-names "\\)\\>") 'font-lock-type-face)) - ;; - ;; Fontify all builtin keywords (except case, default and goto; see below). - (concat "\\<\\(" c-keywords "\\|" c-type-specs "\\)\\>") - ;; - ;; Fontify case/goto keywords and targets, and case default/goto tags. - '("\\<\\(case\\|goto\\)\\>" - (1 font-lock-keyword-face) - ("\\(-[0-9]+\\|\\sw+\\)" - ;; Return limit of search. - (save-excursion (skip-chars-forward "^:\n") (point)) - nil - (1 font-lock-constant-face nil t))) - ;; Anders Lindgren points out that it is quicker - ;; to use MATCH-ANCHORED to effectively anchor the regexp on the left. - ;; This must come after the one for keywords and targets. - ;; Note: the lack of `:' in the first char-range prevents `bar' from being - ;; highlighted in "foo: bar:". But adding `:' would break cases like - ;; "test1 ? test2 ? foo : bar : baz". - '(":" ("\\(?:^\\|[{};]\\)[ \t]*\\(\\sw+\\)[ \t]*:" - (beginning-of-line) (end-of-line) - (1 font-lock-constant-face))) - )) - "Medium level highlighting for C mode. See also `c-font-lock-extra-types'.") - - (defconst c-font-lock-keywords-3 - (append c-font-lock-keywords-2 - ;; - ;; More complicated regexps for more complete highlighting for types. - ;; We still have to fontify type specifiers individually, as C is so hairy. - (list - ;; - ;; Fontify all storage types, plus their items. - `(eval . - (list (concat "\\<\\(" ,c-type-names "\\)\\>" - "\\([ \t*&]+\\sw+\\>\\)*") - ;; Fontify each declaration item. - `(font-lock-match-c-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (or (match-beginning - ,(+ ,c-type-names-depth 2)) - (match-end 1)))) - ;; Finish with point after first type specifier. - (goto-char (match-end 1)) - ;; Fontify as a variable or function name. - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face))))) - ;; - ;; Fontify all storage specs and types, plus their items. - `(,(concat "\\<\\(" c-type-specs "\\)\\>" "[ \t]*\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (,(+ c-type-specs-depth 2) font-lock-type-face nil t) - (font-lock-match-c-style-declaration-item-and-skip-to-next - (save-excursion (skip-chars-forward "^;{}") (point)) - ;; Finish with point after the variable name if - ;; there is one. - (if (match-end 2) - (goto-char (match-end 2))) - ;; Fontify as a variable or function name. - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face) nil t))) - ;; - ;; Fontify structures, or typedef names, plus their items. - '("\\(}\\)[ \t*]*\\sw" - (font-lock-match-c-style-declaration-item-and-skip-to-next - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (match-end 1))) nil - (1 font-lock-type-face))) - ;; - ;; Fontify anything at beginning of line as a declaration or definition. - '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*" - (1 font-lock-type-face) - (font-lock-match-c-style-declaration-item-and-skip-to-next - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (or (match-beginning 2) (match-end 1)))) nil - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face)))) - )) - "Gaudy level highlighting for C mode. -See also `c-font-lock-extra-types'.")) - -(defun c-font-lock-syntactic-face-function (state) - (save-excursion - (if (nth 3 state) - ;; Check whether the string is properly terminated. - (let ((nstate (parse-partial-sexp (point) (line-end-position) - nil nil state 'syntax-table))) - (if (and (eolp) (not (nth 5 nstate)) (nth 3 nstate)) - ;; We're inside a string, at EOL and there was no \. - font-lock-warning-face - font-lock-string-face)) - (goto-char (nth 8 state)) - ;; `doxygen' uses /*! while others use /**. - (if (looking-at "/\\*[*!]\n") - font-lock-doc-face font-lock-comment-face)))) - -(defvar c-font-lock-keywords c-font-lock-keywords-1 - "Default expressions to highlight in C mode. -See also `c-font-lock-extra-types'.") - -;;; C++. - -(defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit) - ;; Regexp matches after point: word::word ( - ;; ^^^^ ^^^^ ^^^^ ^ - ;; Where the match subexpressions are: 1 3 5 6 - ;; - ;; Item is delimited by (match-beginning 1) and (match-end 1). - ;; If (match-beginning 3) is non-nil, that part of the item incloses a `<>'. - ;; If (match-beginning 5) is non-nil, that part of the item follows a `::'. - ;; If (match-beginning 6) is non-nil, the item is followed by a `('. - (when (looking-at (eval-when-compile - (concat - ;; Skip any leading whitespace. - "[ \t\n*&]*" - ;; This is `c++-type-spec' from below. (Hint hint!) - "\\(\\sw+\\)" ; The instance? - "\\([ \t\n]*<\\(\\(?:[^<>]\\|<[^>]+>\\)+\\)[ \t\n*&]*>\\)?" ; Or template? - "\\([ \t\n]*::[ \t\n*~]*\\(\\sw+\\)\\)*" ; Or member? - ;; Match any trailing parenthesis. - "[ \t\n]*\\((\\)?"))) - (save-match-data - (condition-case nil - (save-restriction - ;; Restrict to the end of line, currently guaranteed to be LIMIT. - (narrow-to-region (point-min) limit) - (goto-char (match-end 1)) - ;; Move over any item value, etc., to the next item. - (while (not (looking-at "[ \t\n]*\\(\\(,\\)\\|;\\|\\'\\)")) - (goto-char (or (scan-sexps (point) 1) (point-max)))) - (goto-char (match-end 2))) - (error t))))) - -(defun font-lock-match-c++-structor-declaration (limit) - ;; Match C++ constructors and destructors inside class declarations. - (let ((res nil) - (regexp (concat "^\\s-+\\(\\(virtual\\|explicit\\)\\s-+\\)*~?\\(\\<" - (mapconcat 'identity - c++-font-lock-extra-types "\\|") - "\\>\\)\\s-*(" - ;; Don't match function pointer declarations, e.g.: - ;; Foo (*fptr)(); - "\\s-*[^*( \t]"))) - (while (progn (setq res (re-search-forward regexp limit t)) - (and res - (save-excursion - (beginning-of-line) - (save-match-data - (not (vectorp (c-at-toplevel-p)))))))) - res)) - -(let* ((c++-keywords - (eval-when-compile - (regexp-opt - '("break" "continue" "do" "else" "for" "if" "return" "switch" - "while" "asm" "catch" "delete" "new" "sizeof" "this" "throw" "try" - "typeid" - ;; Branko Cibej says this is new. - "export" - ;; Copied from C. wsnyder@wsnyder.org says C++ needs it too. - "restrict" - ;; Mark Mitchell says these are new. - "mutable" "explicit" - ;; Alain Picard suggests treating these - ;; as keywords not types. - "typedef" "template" - "extern" "auto" "register" "const" "volatile" "static" - "inline" "friend" "virtual" - ;; Standard C++ operator names. - "and" "and_eq" "bitand" "bitor" "compl" "not" "not_eq" - "or" "or_eq" "xor" "xor_eq")))) - (c++-operators - (eval-when-compile - (regexp-opt - ;; Taken from Stroustrup, minus keywords otherwise fontified. - '("+" "-" "*" "/" "%" "^" "&" "|" "~" "!" "=" "<" ">" "+=" "-=" - "*=" "/=" "%=" "^=" "&=" "|=" "<<" ">>" ">>=" "<<=" "==" "!=" - "<=" ">=" "&&" "||" "++" "--" "->*" "," "->" "[]" "()")))) - (c++-type-specs - (eval-when-compile - (regexp-opt - '("class" "public" "private" "protected" "typename" - "struct" "union" "enum" "namespace" "using" - ;; Eric Hopper says these are new. - "static_cast" "dynamic_cast" "const_cast" "reinterpret_cast") t))) - (c++-type-specs-depth - (regexp-opt-depth c++-type-specs)) - (c++-type-names - `(mapconcat 'identity - (cons - ,(eval-when-compile - (regexp-opt - '("signed" "unsigned" "short" "long" - "int" "char" "float" "double" "void" - "bool" "complex"))) - c++-font-lock-extra-types) - "\\|")) - (c++-type-names-depth `(regexp-opt-depth ,c++-type-names)) - ;; - ;; A brave attempt to match templates following a type and/or match - ;; class membership. See and sync the above function - ;; `font-lock-match-c++-style-declaration-item-and-skip-to-next'. - (c++-type-suffix (concat "\\([ \t]*<\\(\\(?:[^<>\n]\\|<[^>\n]+>\\)+\\)[ \t*&]*>\\)?" - "\\([ \t]*::[ \t*~]*\\(\\sw+\\)\\)*")) - (c++-type-suffix-depth (regexp-opt-depth c++-type-suffix)) - ;; If the string is a type, it may be followed by the cruft above. - (c++-type-spec (concat "\\(\\sw+\\)\\>" c++-type-suffix)) - (c++-type-spec-depth (regexp-opt-depth c++-type-spec)) - ;; - ;; Parenthesis depth of user-defined types not forgetting their cruft. - (c++-type-depth `(regexp-opt-depth - (concat ,c++-type-names ,c++-type-suffix))) - ) - (defconst c++-font-lock-keywords-1 - (append - ;; - ;; The list `c-font-lock-keywords-1' less that for function names. - (cdr c-font-lock-keywords-1) - (list - ;; - ;; Fontify function name definitions, possibly incorporating class names. - (list (concat "^" c++-type-spec "[ \t]*(") - '(1 (if (or (match-beginning 2) (match-beginning 4)) - font-lock-type-face - font-lock-function-name-face)) - '(3 font-lock-type-face nil t) - '(5 font-lock-function-name-face nil t)) - )) - "Subdued level highlighting for C++ mode.") - - (defconst c++-font-lock-keywords-2 - (append c++-font-lock-keywords-1 - (list - ;; - ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading. - `(eval . - (cons (concat "\\<\\(" ,c++-type-names "\\)\\>") - 'font-lock-type-face)) - ;; - ;; Fontify operator overloading. - (list (concat "\\<\\(operator\\)\\>[ \t]*\\(" c++-operators "\\)?") - '(1 font-lock-keyword-face) - '(2 font-lock-builtin-face nil t)) - ;; - ;; Fontify case/goto keywords and targets, and case default/goto tags. - '("\\<\\(case\\|goto\\)\\>" - (1 font-lock-keyword-face) - ("\\(-[0-9]+\\|\\sw+\\)[ \t]*\\(::\\)?" - ;; Return limit of search. - (save-excursion - (while (progn - (skip-chars-forward "^:\n") - (looking-at "::")) - (forward-char 2)) - (point)) - nil - (1 (if (match-beginning 2) - font-lock-type-face - font-lock-constant-face) nil t))) - ;; This must come after the one for keywords and targets. - '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:\\($\\|[^:]\\)" - (beginning-of-line) (end-of-line) - (1 font-lock-constant-face))) - ;; - ;; Fontify other builtin keywords. - (concat "\\<\\(" c++-keywords "\\|" c++-type-specs "\\)\\>") - ;; - ;; Eric Hopper says `true' and `false' are new. - '("\\<\\(false\\|true\\)\\>" . font-lock-constant-face) - )) - "Medium level highlighting for C++ mode. -See also `c++-font-lock-extra-types'.") - - (defconst c++-font-lock-keywords-3 - (append c++-font-lock-keywords-2 - ;; - ;; More complicated regexps for more complete highlighting for types. - (list - ;; - ;; Fontify all storage classes and type specifiers, plus their items. - `(eval . - (list (concat "\\<\\(" ,c++-type-names "\\)\\>" ,c++-type-suffix - "\\([ \t*&]+" ,c++-type-spec "\\)*") - ;; The name of any template type. - `(,(+ ,c++-type-names-depth 3) font-lock-type-face nil t) - ;; Fontify each declaration item. - `(font-lock-match-c++-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (or (match-beginning - ,(+ ,c++-type-depth 2)) - (match-end 1)))) - ;; Finish with point after first type specifier. - (goto-char (match-end 1)) - ;; Fontify as a variable or function name. - (1 (cond ((or (match-beginning 2) (match-beginning 4)) - font-lock-type-face) - ((and (match-beginning 6) (c-at-toplevel-p)) - font-lock-function-name-face) - (t - font-lock-variable-name-face))) - (3 font-lock-type-face nil t) - (5 (if (match-beginning 6) - font-lock-function-name-face - font-lock-variable-name-face) nil t)))) - ;; - ;; Fontify all storage specs and types, plus their items. - `(,(concat "\\<" c++-type-specs "\\>" c++-type-suffix - "[ \t]*\\(" c++-type-spec "\\)?") - ;; The name of any template type. - (,(+ c++-type-specs-depth 2) 'font-lock-type-face nil t) - ;; The name of any type. - (,(+ c++-type-specs-depth c++-type-suffix-depth 2) - font-lock-type-face nil t) - ;; Fontify each declaration item. - (font-lock-match-c++-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (save-excursion (skip-chars-forward "^;{}") (point)) - ;; Finish with point after first type specifier. - nil - ;; Fontify as a variable or function name. - (1 (cond ((or (match-beginning 2) (match-beginning 4)) - font-lock-type-face) - ((and (match-beginning 6) (c-at-toplevel-p)) - font-lock-function-name-face) - (t - font-lock-variable-name-face))) - (3 font-lock-type-face nil t) - (5 (if (match-beginning 6) - font-lock-function-name-face - font-lock-variable-name-face) nil t))) - ;; - ;; Fontify structures, or typedef names, plus their items. - '("\\(}\\)[ \t*]*\\sw" - (font-lock-match-c++-style-declaration-item-and-skip-to-next - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (match-end 1))) nil - (1 font-lock-type-face))) - ;; - ;; Fontify anything at beginning of line as a declaration or definition. - `(,(concat "^\\(" c++-type-spec "[ \t*&]*\\)+") - (font-lock-match-c++-style-declaration-item-and-skip-to-next - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (match-beginning 1))) - (goto-char (match-end 1)) - (1 (cond ((or (match-beginning 2) (match-beginning 4)) - font-lock-type-face) - ((match-beginning 6) font-lock-function-name-face) - (t font-lock-variable-name-face))) - (3 font-lock-type-face nil t) - (5 (if (match-beginning 6) - font-lock-function-name-face - font-lock-variable-name-face) nil t))) - ;; - ;; Fontify constructors and destructors inside class declarations. - '(font-lock-match-c++-structor-declaration - (3 font-lock-function-name-face t)) - )) - "Gaudy level highlighting for C++ mode. -See also `c++-font-lock-extra-types'.") - ) - -(defvar c++-font-lock-keywords c++-font-lock-keywords-1 - "Default expressions to highlight in C++ mode. -See also `c++-font-lock-extra-types'.") - -;;; Objective-C. - -;; Regexps written with help from Stephen Peters and -;; Jacques Duthen Prestataire . -(let* ((objc-keywords - (eval-when-compile - (regexp-opt '("break" "continue" "do" "else" "for" "if" "return" - "switch" "while" "sizeof" "self" "super" - "typedef" "auto" "extern" "static" - "volatile" "const")))) - (objc-type-specs - (eval-when-compile - (regexp-opt - '("register" "struct" "union" "enum" - "oneway" "in" "out" "inout" "bycopy" "byref") t))) - (objc-type-specs-depth - (regexp-opt-depth objc-type-specs)) - (objc-type-names - `(mapconcat 'identity - (cons - ,(eval-when-compile - (regexp-opt - '("signed" "unsigned" "short" "long" - "int" "char" "float" "double" "void" - "id"))) - objc-font-lock-extra-types) - "\\|")) - (objc-type-names-depth - `(regexp-opt-depth ,objc-type-names)) - ) - (defconst objc-font-lock-keywords-1 - (append - ;; - ;; The list `c-font-lock-keywords-1' less that for function names. - (cdr c-font-lock-keywords-1) - (list - ;; - ;; Fontify compiler directives. - '("@\\(\\sw+\\)\\>" - (1 font-lock-keyword-face) - ("\\=[ \t:<,]*\\(\\sw+\\)" nil nil - (1 font-lock-type-face))) - ;; - ;; Fontify method names and arguments. Oh Lordy! - ;; First, on the same line as the function declaration. - '("^[+-][ \t]*\\(PRIVATE\\>\\)?[ \t]*\\(([^)\n]+)\\)?[ \t]*\\(\\sw+\\)" - (1 font-lock-keyword-face nil t) - (3 font-lock-function-name-face) - ("\\=[ \t]*\\(\\sw+\\)?:[ \t]*\\(([^)\n]+)\\)?[ \t]*\\(\\sw+\\)" - nil nil - (1 font-lock-function-name-face nil t) - (3 font-lock-variable-name-face))) - ;; Second, on lines following the function declaration. - '(":" ("^[ \t]*\\(\\sw+\\)?:[ \t]*\\(([^)\n]+)\\)?[ \t]*\\(\\sw+\\)" - (beginning-of-line) (end-of-line) - (1 font-lock-function-name-face nil t) - (3 font-lock-variable-name-face))) - )) - "Subdued level highlighting for Objective-C mode.") - - (defconst objc-font-lock-keywords-2 - (append objc-font-lock-keywords-1 - (list - ;; - ;; Simple regexps for speed. - ;; - ;; Fontify all type specifiers. - `(eval . - (cons (concat "\\<\\(" ,objc-type-names "\\)\\>") - 'font-lock-type-face)) - ;; - ;; Fontify all builtin keywords (except case, default and goto; see below). - (concat "\\<\\(" objc-keywords "\\|" objc-type-specs "\\)\\>") - ;; - ;; Fontify case/goto keywords and targets, and case default/goto tags. - '("\\<\\(case\\|goto\\)\\>[ \t]*\\(-?\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - ;; Fontify tags iff sole statement on line, otherwise we detect selectors. - ;; This must come after the one for keywords and targets. - '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:[ \t]*$" - (beginning-of-line) (end-of-line) - (1 font-lock-constant-face))) - ;; - ;; Fontify null object pointers. - '("\\<[Nn]il\\>" . font-lock-constant-face) - )) - "Medium level highlighting for Objective-C mode. -See also `objc-font-lock-extra-types'.") - - (defconst objc-font-lock-keywords-3 - (append objc-font-lock-keywords-2 - ;; - ;; More complicated regexps for more complete highlighting for types. - ;; We still have to fontify type specifiers individually, as C is so hairy. - (list - ;; - ;; Fontify all storage classes and type specifiers, plus their items. - `(eval . - (list (concat "\\<\\(" ,objc-type-names "\\)\\>" - "\\([ \t*&]+\\sw+\\>\\)*") - ;; Fontify each declaration item. - `(font-lock-match-c-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (or (match-beginning - ,(+ ,objc-type-names-depth 2)) - (match-end 1)))) - ;; Finish with point after first type specifier. - (goto-char (match-end 1)) - ;; Fontify as a variable or function name. - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face))))) - ;; - ;; Fontify all storage specs and types, plus their items. - `(,(concat "\\<\\(" objc-type-specs "[ \t]*\\)+\\>" "[ \t]*\\(\\sw+\\)?") - ;; The name of any type. - (,(+ objc-type-specs-depth 2) font-lock-type-face nil t) - ;; Fontify each declaration item. - (font-lock-match-c++-style-declaration-item-and-skip-to-next - (save-excursion (skip-chars-forward "^;{}") (point)) nil - ;; Fontify as a variable or function name. - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face)))) - ;; - ;; Fontify structures, or typedef names, plus their items. - '("\\(}\\)[ \t*]*\\sw" - (font-lock-match-c-style-declaration-item-and-skip-to-next - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (match-end 1))) nil - (1 font-lock-type-face))) - ;; - ;; Fontify anything at beginning of line as a declaration or definition. - '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*" - (1 font-lock-type-face) - (font-lock-match-c-style-declaration-item-and-skip-to-next - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (or (match-beginning 2) (match-end 1)))) nil - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face)))) - )) - "Gaudy level highlighting for Objective-C mode. -See also `objc-font-lock-extra-types'.") - ) - -(defvar objc-font-lock-keywords objc-font-lock-keywords-1 - "Default expressions to highlight in Objective-C mode. -See also `objc-font-lock-extra-types'.") - -;;; Java. - -;; Regexps written with help from Fred White , -;; Anders Lindgren and Carl Manning . -(let* ((java-keywords - (eval-when-compile - (regexp-opt - '("catch" "do" "else" "super" "this" "finally" "for" "if" - ;; Anders Lindgren says these have gone. - ;; "cast" "byvalue" "future" "generic" "operator" "var" - ;; "inner" "outer" "rest" - "implements" "extends" "throws" "instanceof" "new" - "interface" "return" "switch" "throw" "try" "while")))) - ;; - ;; Classes immediately followed by an object name. - (java-type-names - `(mapconcat 'identity - (cons - ,(eval-when-compile - (regexp-opt '("boolean" "char" "byte" "short" "int" "long" - "float" "double" "void"))) - java-font-lock-extra-types) - "\\|")) - (java-type-names-depth `(regexp-opt-depth ,java-type-names)) - ;; - ;; These are eventually followed by an object name. - (java-type-specs - (eval-when-compile - (regexp-opt - '("abstract" "const" "final" "synchronized" "transient" "static" - ;; Anders Lindgren says this has gone. - ;; "threadsafe" - "volatile" "public" "private" "protected" "native" - ;; Carl Manning says this is new. - "strictfp")))) - ) - (defconst java-font-lock-keywords-1 - (list - ;; - ;; Fontify class names. - '("\\<\\(class\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-type-face nil t)) - ;; - ;; Fontify package names in import directives. - '("\\<\\(import\\|package\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) - (2 font-lock-constant-face nil t) - ("\\=\\.\\(\\*\\|\\sw+\\)" nil nil - (1 font-lock-constant-face nil t))) - ) - "Subdued level highlighting for Java mode.") - - (defconst java-font-lock-keywords-2 - (append java-font-lock-keywords-1 - (list - ;; - ;; Fontify class names. - `(eval . - (cons (concat "\\<\\(" ,java-type-names "\\)\\>[^.]") - '(1 font-lock-type-face))) - ;; - ;; Fontify all builtin keywords (except below). - (concat "\\<\\(" java-keywords "\\|" java-type-specs "\\)\\>") - ;; - ;; Fontify keywords and targets, and case default/goto tags. - (list "\\<\\(break\\|case\\|continue\\|goto\\)\\>[ \t]*\\(-?\\sw+\\)?" - '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t)) - ;; This must come after the one for keywords and targets. - '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:[ \t]*$" - (beginning-of-line) (end-of-line) - (1 font-lock-constant-face))) - ;; - ;; Fontify all constants. - '("\\<\\(false\\|null\\|true\\)\\>" . font-lock-constant-face) - ;; - ;; Javadoc tags within comments. - (list - (concat "@\\(" - "author\\|deprecated\\|exception" - "\\|link\\|return\\|see\\|serial\\|serialData\\|serialField" - "\\|since\\|throws" - "\\|version" - "\\)\\>") - '(1 font-lock-constant-face prepend)) - '("@\\(param\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-constant-face prepend) - (2 font-lock-variable-name-face prepend t)) - '("@\\(exception\\|throws\\)\\>[ \t]*\\(\\S-+\\)?" - (1 font-lock-constant-face prepend) - (2 font-lock-type-face prepend t)) - )) - "Medium level highlighting for Java mode. -See also `java-font-lock-extra-types'.") - - (defconst java-font-lock-keywords-3 - (append java-font-lock-keywords-2 - ;; - ;; More complicated regexps for more complete highlighting for types. - ;; We still have to fontify type specifiers individually, as Java is hairy. - (list - ;; - ;; Fontify random types immediately followed by an item or items. - `(eval . - (list (concat "\\<\\(" ,java-type-names "\\)\\>" - "\\([ \t]*\\[[ \t]*\\]\\)*" - "\\([ \t]*\\sw\\)") - ;; Fontify each declaration item. - `(font-lock-match-c-style-declaration-item-and-skip-to-next - ;; Start and finish with point after the type specifier. - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (match-beginning ,(+ ,java-type-names-depth 3)))) - (goto-char (match-beginning ,(+ ,java-type-names-depth 3))) - ;; Fontify as a variable or function name. - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face))))) - ;; - ;; Fontify those that are eventually followed by an item or items. - `(,(concat "\\<\\(" java-type-specs "\\)\\>" - "\\([ \t]+\\sw+\\>" - "\\([ \t]*\\[[ \t]*\\]\\)*" - "\\)*") - ;; Fontify each declaration item. - (font-lock-match-c-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (prog1 (progn (skip-chars-forward "^;{}") (point)) - (goto-char (or (match-beginning 5) (match-end 1)))) - ;; Finish with point after first type specifier. - (goto-char (match-end 1)) - ;; Fontify as a variable or function name. - (1 (if (match-beginning 2) - font-lock-function-name-face - font-lock-variable-name-face)))) - )) - "Gaudy level highlighting for Java mode. -See also `java-font-lock-extra-types'.") - ) - -(defvar java-font-lock-keywords java-font-lock-keywords-1 - "Default expressions to highlight in Java mode. -See also `java-font-lock-extra-types'.") - -;; Provide ourselves: - -(defun java-font-lock-syntactic-face-function (state) - (save-excursion - (if (nth 3 state) - ;; Check whether the string is properly terminated. - (let ((nstate (parse-partial-sexp (point) (line-end-position) - nil nil state 'syntax-table))) - (if (and (eolp) (nth 3 nstate)) - ;; We're inside a string, at EOL. The JLS says that: - ;; It is a compile-time error for a line terminator to - ;; appear after the opening " and before the closing - ;; matching ". - font-lock-warning-face - font-lock-string-face)) - (goto-char (nth 8 state)) - (if (looking-at "/\\*\\*") - font-lock-doc-face - font-lock-comment-face)))) - (provide 'font-lock) -(when (eq font-lock-support-mode 'jit-lock-mode) - (require 'jit-lock)) - +;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c ;;; font-lock.el ends here