X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/97cc3d15d408a14cd7171c58fb419309b9b35a99..1b74c4346e92c9ac1ae0575c2ad69f8d81126d7e:/lisp/font-lock.el diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 4deacb9e87..feed15f18d 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, 02, 2003, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004 2005 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: @@ -228,13 +228,11 @@ ;; 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) @@ -294,6 +292,12 @@ If a number, only buffers greater than this size have fontification messages." (other :tag "always" t) (integer :tag "size")) :group 'font-lock) + +(defcustom font-lock-lines-before 1 + "*Number of lines before the changed text to include in refontification." + :type 'integer + :group 'font-lock + :version "22.1") ;; Originally these variable values were face names such as `bold' etc. @@ -305,6 +309,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.") @@ -332,6 +339,10 @@ 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-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.") @@ -342,7 +353,15 @@ If a number, only buffers greater than this size have fontification messages." (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) @@ -352,8 +371,9 @@ Each element should have one of these forms: (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 @@ -370,14 +390,14 @@ word \"bar\" following the word \"anchor\" then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: - (MATCH FACENAME OVERRIDE LAXMATCH) + (MATCH FACENAME [OVERRIDE [LAXMATCH]]) 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 ...) +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'. @@ -410,10 +430,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): @@ -423,7 +443,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 @@ -440,15 +460,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 . APPEND). +`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 APPEND 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 APPEND 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'.") @@ -473,7 +515,7 @@ 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. @@ -521,11 +563,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. @@ -545,8 +587,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. @@ -578,6 +620,7 @@ Major/minor modes can set this variable if they know which option applies.") ;; 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)) @@ -592,8 +635,6 @@ Major/minor modes can set this variable if they know which option applies.") ,@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. @@ -623,6 +664,7 @@ Major/minor modes can set this variable if they know which option applies.") ;;;###autoload (defun font-lock-add-keywords (mode keywords &optional append) "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'. @@ -640,9 +682,22 @@ 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', @@ -661,21 +716,30 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', (font-lock-update-removed-keyword-alist mode keywords append)) (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)))))))) + (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 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))))) + ;; If the keywords were compiled before, compile them again. + (if was-compiled + (set (make-local-variable 'font-lock-keywords) + (font-lock-compile-keywords font-lock-keywords t))))))) (defun font-lock-update-removed-keyword-alist (mode keywords append) - ;; Update `font-lock-removed-keywords-alist' when adding new - ;; KEYWORDS to MODE. - ;; + "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 @@ -723,9 +787,11 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', 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) @@ -764,13 +830,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 + (set (make-local-variable 'font-lock-keywords) + (font-lock-compile-keywords font-lock-keywords t))))))) ;;; Font Lock Support mode. @@ -830,7 +904,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 @@ -926,7 +1000,8 @@ The value of this variable is used when Font Lock mode is turned on." (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) @@ -965,7 +1040,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 @@ -1014,13 +1090,12 @@ 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) @@ -1030,7 +1105,8 @@ what properties to clear before refontifying a region.") (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 beg) + (forward-line (- font-lock-lines-before)) (point)) (progn (goto-char end) (forward-line 1) (point))))))) (defun font-lock-fontify-block (&optional arg) @@ -1058,7 +1134,7 @@ delimit the region to fontify." ((error quit) (message "Fontifying block...%s" error-data))))))) (if (boundp 'facemenu-keymap) - (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)) + (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block)) ;;; End of Fontification functions. @@ -1226,7 +1302,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'. @@ -1250,14 +1326,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'. @@ -1268,10 +1354,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. @@ -1292,6 +1392,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) @@ -1351,8 +1457,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'. @@ -1366,7 +1473,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)) @@ -1387,23 +1498,30 @@ 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 (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) @@ -1416,7 +1534,7 @@ 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) @@ -1472,17 +1590,22 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to (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. - (unless font-lock-set-defaults + ;; 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 font-lock-defaults-alist)))) + (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))) @@ -1514,17 +1637,21 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ;; 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 + ;; 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-compile-keywords (font-lock-eval-keywords keywords) t)) + (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))))) + (font-lock-remove-keywords nil removed-keywords)) + ;; Now compile the keywords. + (unless (eq (car font-lock-keywords) t) + (set (make-local-variable 'font-lock-keywords) + (font-lock-compile-keywords font-lock-keywords t)))))) ;;; Colour etc. support. @@ -1564,22 +1691,33 @@ Sets various variables using `font-lock-defaults' (or, if nil, using (:foreground "DimGray" :weight bold :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :weight bold :slant italic)) - (((class color) (min-colors 88) (background light)) + (((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) + (((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)) - (:foreground "red")) - (((class color) (min-colors 8) (background dark)) + (((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) +(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-highlighting-faces) + (defface font-lock-string-face '((((class grayscale) (background light)) (:foreground "DimGray" :slant italic)) (((class grayscale) (background dark)) (:foreground "LightGray" :slant italic)) @@ -1601,7 +1739,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) (((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan")) + (((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)) @@ -1622,7 +1760,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using :group 'font-lock-highlighting-faces) (defface font-lock-function-name-face - '((((class color) (min-colors 88) (background light)) (:foreground "Blue")) + '((((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")) @@ -1672,19 +1810,35 @@ Sets various variables using `font-lock-defaults' (or, if nil, using :group 'font-lock-highlighting-faces) (defface font-lock-warning-face - '((((class color) (min-colors 88) (background light)) (:foreground "Red" :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 "Red" :weight bold)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :weight bold)) (((class color) (min-colors 8)) (:foreground "red")) + (((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) +(defface font-lock-negation-char-face + '((t nil)) + "Font Lock mode face used to highlight easy to overlook negation." + :group 'font-lock-highlighting-faces) + (defface font-lock-preprocessor-face - '((t :inherit 'font-lock-builtin-face)) + '((t :inherit font-lock-builtin-face)) "Font Lock mode face used to highlight preprocessor directives." :group 'font-lock-highlighting-faces) +(defface font-lock-regexp-grouping-backslash + '((t :inherit bold)) + "Font Lock mode face for backslashes in Lisp regexp grouping constructs." + :group 'font-lock-highlighting-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-highlighting-faces) + ;;; End of Colour etc. support. ;;; Menu support. @@ -1728,7 +1882,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ; (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 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)) @@ -1762,7 +1916,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ; (font-lock-fontify-level (1+ (car font-lock-fontify-level))) ; (error "No more decoration"))) ; -;;; This should be called by `font-lock-set-defaults'. +; ;; 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 @@ -1783,7 +1937,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ; (setq font-lock-fontify-level (list level (> level 1) ; (< level (1- (length keywords)))))))) ; -;;; This should be called by `font-lock-unset-defaults'. +; ;; 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)) @@ -1791,7 +1945,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ;;; 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 is now in ;; cc-fonts.el (and required by cc-mode.el). However, the below function @@ -1845,96 +1999,113 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." (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\\|varalias\\|alias\\|generic\\|macro\\*?\\|method\\|" + "setf\\|subst\\*?\\|un\\*?\\|" + "ine-\\(condition\\|\\(?:derived\\|minor\\|generic\\)-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) + ;; 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" + "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.") @@ -1943,5 +2114,5 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item." (provide 'font-lock) -;;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c +;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c ;;; font-lock.el ends here