;;; 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 Free Software Foundation, Inc.
;; Author: jwz, then rms, then sm
;; Maintainer: FSF
(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)
(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
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'.
(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.
(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
(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)))))))
\f
;;; Font Lock Support mode.
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'.
(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'.
(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)))))
+ (< (point) end))
+ (setq state (parse-partial-sexp (point) end nil nil state
+ 'syntax-table)))))
;;; End of Syntactic fontification functions.
\f
(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 <face> to (<face>) which is undesirable. --Stef
+ nil)
((not override)
;; Cannot override existing fontification.
(or (text-property-not-all start end 'face nil)
(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)
keyword matcher highlights)
;;
;; 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)
(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)))
;; 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))))))
\f
;;; Colour etc. support.
'("when" "unless" "case" "ecase" "typecase" "etypecase"
"ccase" "ctypecase" "handler-case" "handler-bind"
"restart-bind" "restart-case" "in-package"
- "cerror" "break" "ignore-errors"
+ "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"
+ "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"
'(2 font-lock-constant-face nil t))
;;
;; Erroneous structures.
- '("(\\(abort\\|assert\\|error\\|signal\\)\\>" 1 font-lock-warning-face)
+ '("(\\(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)
\f
(provide 'font-lock)
-;;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c
+;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c
;;; font-lock.el ends here