* emulation/cua-base.el (cua-rectangle, cua-rectangle-noselect)
[bpt/emacs.git] / lisp / font-lock.el
index 11d9ba7..f75c081 100644 (file)
@@ -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
@@ -292,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")
 \f
 
 ;; Originally these variable values were face names such as `bold' etc.
@@ -303,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.")
 
@@ -330,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.")
 
@@ -340,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)
@@ -350,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
@@ -368,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'.
 
@@ -411,7 +433,7 @@ the last, instance MATCH-ANCHORED's MATCHER is used.  Therefore they can be
 used to initialise 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):
 
@@ -421,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
@@ -438,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'.")
 
@@ -471,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.
@@ -519,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.
@@ -543,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.
@@ -621,6 +665,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'.
@@ -638,9 +683,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 'c-mode
+    '((\"\\\\\\=<\\\\(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',
@@ -659,21 +717,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
@@ -721,9 +788,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)
@@ -762,13 +831,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)))))))
 \f
 ;;; Font Lock Support mode.
 
@@ -828,7 +905,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
@@ -924,7 +1001,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)
@@ -963,7 +1041,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
@@ -1012,13 +1091,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)
@@ -1028,7 +1106,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)
@@ -1056,7 +1135,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.
 \f
@@ -1224,7 +1303,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'.
@@ -1248,14 +1327,24 @@ START should be at the beginning of a line."
 \f
 ;;; 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'.
@@ -1266,10 +1355,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.
 \f
@@ -1290,6 +1393,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 <face> to (<face>) which is undesirable.  --Stef
+         nil)
         ((not override)
          ;; Cannot override existing fontification.
          (or (text-property-not-all start end 'face nil)
@@ -1349,8 +1458,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'.
@@ -1385,23 +1495,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.
 \f
 ;; 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)
@@ -1414,7 +1531,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)
@@ -1470,17 +1587,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)))
@@ -1512,17 +1634,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))))))
 \f
 ;;; Colour etc. support.
 
@@ -1562,22 +1688,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))
@@ -1599,7 +1736,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))
@@ -1620,7 +1757,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"))
@@ -1670,19 +1807,36 @@ 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-backslash
+  '((((class color) (min-colors 16)) :inherit escape-glyph)
+    (t :inherit bold))
+  "Font Lock mode face used to highlight a backslash in Lisp regexps."
+  :group 'font-lock-highlighting-faces)
+
+(defface font-lock-regexp-backslash-construct
+  '((t :inherit bold))
+  "Font Lock mode face used to highlight `\' constructs in Lisp regexps."
+  :group 'font-lock-highlighting-faces)
+
 ;;; End of Colour etc. support.
 \f
 ;;; Menu support.
@@ -1726,7 +1880,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))
@@ -1760,7 +1914,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
@@ -1781,7 +1935,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))
@@ -1789,7 +1943,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
 ;;; End of Menu support.
 \f
 ;;; 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
@@ -1843,108 +1997,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-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.
-      (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"
-                   "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.
-      (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)
-      ;;
-;;; This is too general -- rms.
-;;; A user complained that he has functions whose names start with `do'
-;;; and that they get the wrong color.
+     `(;; 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)
+       ;; Make regexp grouping constructs bold, so they stand out, but only
+       ;; in strings.
+       ((lambda (bound)
+         (if (re-search-forward "\\(\\\\\\\\\\)\\((\\(?:?:\\)?\\|[|)]\\)" bound t)
+              (let ((face (get-text-property (1- (point)) 'face)))
+                (if (listp face)
+                    (memq 'font-lock-string-face face)
+                  (eq 'font-lock-string-face face)))))
+       (1 'font-lock-regexp-backslash prepend)
+       (2 'font-lock-regexp-backslash-construct prepend))
+
+       ;; Underline innermost grouping, so that you can more easily see what
+       ;; belongs together.  2005-05-12: Font-lock can go into an
+       ;; unbreakable endless loop on this -- something's broken.
+       ;;("[\\][\\][(]\\(?:\\?:\\)?\\(\\(?:[^\\\"]+\\|[\\]\\(?:[^\\]\\|[\\][^(]\\)\\)+?\\)[\\][\\][)]"
+        ;;1 'underline 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)
+;;;      ("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
       )))
   "Gaudy level highlighting for Lisp modes.")
 
@@ -1953,5 +2112,5 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
 \f
 (provide 'font-lock)
 
-;;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c
+;; arch-tag: 682327e4-64d8-4057-b20b-1fbb9f1fc54c
 ;;; font-lock.el ends here