Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-95
[bpt/emacs.git] / lisp / font-lock.el
index 4457f9c..bde2469 100644 (file)
@@ -1,7 +1,7 @@
 ;;; font-lock.el --- Electric font lock mode
 
 ;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;;   2000, 2001, 2002, 2003, 2004 2005  Free Software Foundation, Inc.
+;;   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:
 
 (defgroup font-lock-extra-types nil
   "Extra mode-specific type names for highlighting declarations."
   :group 'font-lock)
-
-;; Define support mode groups here to impose `font-lock' group order.
-(defgroup fast-lock nil
-  "Font Lock support mode to cache fontification."
-  :load 'fast-lock
-  :group 'font-lock)
-
-(defgroup lazy-lock nil
-  "Font Lock support mode to fontify lazily."
-  :load 'lazy-lock
-  :group 'font-lock)
 \f
 ;; User variables.
 
@@ -293,7 +282,7 @@ If a number, only buffers greater than this size have fontification messages."
                 (integer :tag "size"))
   :group 'font-lock)
 
-(defcustom font-lock-lines-before 1
+(defcustom font-lock-lines-before 0
   "*Number of lines before the changed text to include in refontification."
   :type 'integer
   :group 'font-lock
@@ -351,6 +340,7 @@ This can be an \"!\" or the \"n\" in \"ifndef\".")
 
 ;; Fontification variables:
 
+;;;###autoload
 (defvar font-lock-keywords nil
   "A list of the keywords to highlight.
 There are two kinds of values: user-level, and compiled.
@@ -364,7 +354,7 @@ contained expressions.  You can also alter it by calling
 Each element in a user-level keywords list should have one of these forms:
 
  MATCHER
- (MATCHER . MATCH)
+ (MATCHER . SUBEXP)
  (MATCHER . FACENAME)
  (MATCHER . HIGHLIGHT)
  (MATCHER HIGHLIGHT ...)
@@ -390,12 +380,13 @@ word \"bar\" following the word \"anchor\" then MATCH-ANCHORED may be required.
 
 MATCH-HIGHLIGHT should be of the form:
 
- (MATCH FACENAME [OVERRIDE [LAXMATCH]])
+ (SUBEXP FACENAME [OVERRIDE [LAXMATCH]])
 
-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 FACE PROP1 VAL1 PROP2 VAL2 ...)
+SUBEXP is the number of the subexpression of MATCHER to be highlighted.
+
+FACENAME is an expression whose value is the face name to use.
+Instead of a face, FACENAME can evaluate to a property list
+of the form (face FACE PROP1 VAL1 PROP2 VAL2 ...)
 in which case all the listed text-properties will be set rather than
 just FACE.  In such a case, you will most likely want to put those
 properties in `font-lock-extra-managed-props' or to override
@@ -405,7 +396,8 @@ OVERRIDE and LAXMATCH are flags.  If OVERRIDE is t, existing fontification can
 be overwritten.  If `keep', only parts not already fontified are highlighted.
 If `prepend' or `append', existing fontification is merged with the new, in
 which the new or existing fontification, respectively, takes precedence.
-If LAXMATCH is non-nil, no error is signaled if there is no MATCH in MATCHER.
+If LAXMATCH is non-nil, that means don't signal an error if there is
+no match for SUBEXP in MATCHER.
 
 For example, an element of the form highlights (if not already highlighted):
 
@@ -430,7 +422,7 @@ 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 back, before resuming with MATCH-ANCHORED's parent's MATCHER.
@@ -518,36 +510,35 @@ The function is called with a single parameter (the state as returned by
 should return a face.  This is normally set via `font-lock-defaults'.")
 
 (defvar font-lock-syntactic-keywords nil
-  "A list of the syntactic keywords to highlight.
-Can be the list or the name of a function or variable whose value is the list.
+  "A list of the syntactic keywords to put syntax properties on.
+The value can be the list itself, or the name of a function or variable
+whose value is the list.
+
 See `font-lock-keywords' for a description of the form of this list;
-the differences are listed below.  MATCH-HIGHLIGHT should be of the form:
+only the differences are stated here.  MATCH-HIGHLIGHT should be of the form:
 
- (MATCH SYNTAX OVERRIDE LAXMATCH)
+ (SUBEXP SYNTAX OVERRIDE LAXMATCH)
 
 where SYNTAX can be a string (as taken by `modify-syntax-entry'), a syntax
 table, a cons cell (as returned by `string-to-syntax') or an expression whose
 value is such a form.  OVERRIDE cannot be `prepend' or `append'.
 
-For example, an element of the form highlights syntactically:
+Here are two examples of elements of `font-lock-syntactic-keywords'
+and what they do:
 
  (\"\\\\$\\\\(#\\\\)\" 1 \".\")
 
- a hash character when following a dollar character, with a SYNTAX of
- \".\" (meaning punctuation syntax).  Assuming that the buffer syntax table does
- specify hash characters to have comment start syntax, the element will only
- highlight hash characters that do not follow dollar characters as comments
- syntactically.
+ gives a hash character punctuation syntax (\".\") when following a
+ dollar-sign character.  Hash characters in other contexts will still
+ follow whatever the syntax table says about the hash character.
 
  (\"\\\\('\\\\).\\\\('\\\\)\"
   (1 \"\\\"\")
   (2 \"\\\"\"))
 
- both single quotes which surround a single character, with a SYNTAX of
- \"\\\"\" (meaning string quote syntax).  Assuming that the buffer syntax table
- does not specify single quotes to have quote syntax, the element will only
- highlight single quotes of the form 'c' as strings syntactically.
- Other forms, such as foo'bar or 'fubar', will not be highlighted as strings.
+ gives a pair single-quotes, which surround a single character, a SYNTAX of
+ \"\\\"\" (meaning string quote syntax).  Single-quote characters in other
+ contexts will not be affected.
 
 This is normally set via `font-lock-defaults'.")
 
@@ -620,6 +611,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))
@@ -634,8 +626,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.
@@ -858,9 +848,13 @@ happens, so the major mode can be corrected."
 (defcustom font-lock-support-mode 'jit-lock-mode
   "*Support mode for Font Lock mode.
 Support modes speed up Font Lock mode by being choosy about when fontification
-occurs.  Known support modes are Fast Lock mode (symbol `fast-lock-mode'),
-Lazy Lock mode (symbol `lazy-lock-mode'), and Just-in-time Lock mode (symbol
-`jit-lock-mode'.  See those modes for more info.
+occurs.  The default support mode, Just-in-time Lock mode (symbol
+`jit-lock-mode'), is recommended.
+
+Other, older support modes are Fast Lock mode (symbol `fast-lock-mode') and
+Lazy Lock mode (symbol `lazy-lock-mode').  See those modes for more info.
+However, they are no longer recommended, as Just-in-time Lock mode is better.
+
 If nil, means support for Font Lock mode is never performed.
 If a symbol, use that support mode.
 If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE),
@@ -1050,10 +1044,11 @@ a very meaningful entity to highlight.")
          ;; Use the fontification syntax table, if any.
          (when font-lock-syntax-table
            (set-syntax-table font-lock-syntax-table))
+          (goto-char beg)
+          (setq beg (line-beginning-position (- 1 font-lock-lines-before)))
          ;; check to see if we should expand the beg/end area for
          ;; proper multiline matches
-         (when (and font-lock-multiline
-                    (> beg (point-min))
+         (when (and (> beg (point-min))
                     (get-text-property (1- beg) 'font-lock-multiline))
            ;; We are just after or in a multiline match.
            (setq beg (or (previous-single-property-change
@@ -1061,12 +1056,12 @@ a very meaningful entity to highlight.")
                          (point-min)))
            (goto-char beg)
            (setq beg (line-beginning-position)))
-         (when font-lock-multiline
-           (setq end (or (text-property-any end (point-max)
-                                            'font-lock-multiline nil)
-                         (point-max))))
+          (setq end (or (text-property-any end (point-max)
+                                           'font-lock-multiline nil)
+                        (point-max)))
          (goto-char end)
-         (setq end (line-beginning-position 2))
+         ;; Round up to a whole line.
+          (unless (bolp) (setq end (line-beginning-position 2)))
          ;; Now do the fontification.
          (font-lock-unfontify-region beg end)
          (when font-lock-syntactic-keywords
@@ -1078,12 +1073,12 @@ a very meaningful entity to highlight.")
       (set-syntax-table old-syntax-table))))
 
 ;; The following must be rethought, since keywords can override fontification.
-;      ;; Now scan for keywords, but not if we are inside a comment now.
-;      (or (and (not font-lock-keywords-only)
-;             (let ((state (parse-partial-sexp beg end nil nil
-;                                              font-lock-cache-state)))
-;               (or (nth 4 state) (nth 7 state))))
-;        (font-lock-fontify-keywords-region beg end))
+;;    ;; Now scan for keywords, but not if we are inside a comment now.
+;;    (or (and (not font-lock-keywords-only)
+;;             (let ((state (parse-partial-sexp beg end nil nil
+;;                                              font-lock-cache-state)))
+;;               (or (nth 4 state) (nth 7 state))))
+;;        (font-lock-fontify-keywords-region beg end))
 
 (defvar font-lock-extra-managed-props nil
   "Additional text properties managed by font-lock.
@@ -1106,8 +1101,7 @@ 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)
-               (forward-line (- font-lock-lines-before)) (point))
+        (progn (goto-char beg) (forward-line 0) (point))
         (progn (goto-char end) (forward-line 1) (point)))))))
 
 (defun font-lock-fontify-block (&optional arg)
@@ -1188,35 +1182,35 @@ Optional argument OBJECT is the string or buffer containing the text."
 
 ;; For completeness: this is to `remove-text-properties' as `put-text-property'
 ;; is to `add-text-properties', etc.
-;(defun remove-text-property (start end property &optional object)
-;  "Remove a property from text from START to END.
-;Argument PROPERTY is the property to remove.
-;Optional argument OBJECT is the string or buffer containing the text.
-;Return t if the property was actually removed, nil otherwise."
-;  (remove-text-properties start end (list property) object))
+;;(defun remove-text-property (start end property &optional object)
+;;  "Remove a property from text from START to END.
+;;Argument PROPERTY is the property to remove.
+;;Optional argument OBJECT is the string or buffer containing the text.
+;;Return t if the property was actually removed, nil otherwise."
+;;  (remove-text-properties start end (list property) object))
 
 ;; For consistency: maybe this should be called `remove-single-property' like
 ;; `next-single-property-change' (not `next-single-text-property-change'), etc.
-;(defun remove-single-text-property (start end prop value &optional object)
-;  "Remove a specific property value from text from START to END.
-;Arguments PROP and VALUE specify the property and value to remove.  The
-;resulting property values are not equal to VALUE nor lists containing VALUE.
-;Optional argument OBJECT is the string or buffer containing the text."
-;  (let ((start (text-property-not-all start end prop nil object)) next prev)
-;    (while start
-;      (setq next (next-single-property-change start prop object end)
-;          prev (get-text-property start prop object))
-;      (cond ((and (symbolp prev) (eq value prev))
-;           (remove-text-property start next prop object))
-;          ((and (listp prev) (memq value prev))
-;           (let ((new (delq value prev)))
-;             (cond ((null new)
-;                    (remove-text-property start next prop object))
-;                   ((= (length new) 1)
-;                    (put-text-property start next prop (car new) object))
-;                   (t
-;                    (put-text-property start next prop new object))))))
-;      (setq start (text-property-not-all next end prop nil object)))))
+;;(defun remove-single-text-property (start end prop value &optional object)
+;;  "Remove a specific property value from text from START to END.
+;;Arguments PROP and VALUE specify the property and value to remove.  The
+;;resulting property values are not equal to VALUE nor lists containing VALUE.
+;;Optional argument OBJECT is the string or buffer containing the text."
+;;  (let ((start (text-property-not-all start end prop nil object)) next prev)
+;;    (while start
+;;      (setq next (next-single-property-change start prop object end)
+;;         prev (get-text-property start prop object))
+;;      (cond ((and (symbolp prev) (eq value prev))
+;;          (remove-text-property start next prop object))
+;;         ((and (listp prev) (memq value prev))
+;;          (let ((new (delq value prev)))
+;;            (cond ((null new)
+;;                   (remove-text-property start next prop object))
+;;                  ((= (length new) 1)
+;;                   (put-text-property start next prop (car new) object))
+;;                  (t
+;;                   (put-text-property start next prop new object))))))
+;;      (setq start (text-property-not-all next end prop nil object)))))
 
 ;;; End of Additional text property functions.
 \f
@@ -1474,7 +1468,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))
@@ -1534,7 +1532,8 @@ If REGEXP is non-nil, it means these keywords are used for
                   (if (memq (get-text-property (match-beginning 0) 'face)
                             '(font-lock-string-face font-lock-doc-face
                               font-lock-comment-face))
-                      font-lock-warning-face)
+                      (list 'face font-lock-warning-face
+                             'help-echo "Looks like a toplevel defun: escape the parenthesis"))
                   prepend)))))
     keywords))
 
@@ -1602,7 +1601,7 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
     (let* ((defaults (or font-lock-defaults
                         (cdr (assq major-mode
                                    (with-no-warnings
-                                    font-lock-defaults-alist)))))
+                                      font-lock-defaults-alist)))))
           (keywords
            (font-lock-choose-keywords (nth 0 defaults)
                                       (font-lock-value-in-major-mode font-lock-maximum-decoration)))
@@ -1826,15 +1825,14 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
   "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."
+(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-backslash-construct
+(defface font-lock-regexp-grouping-construct
   '((t :inherit bold))
-  "Font Lock mode face used to highlight `\' constructs in Lisp regexps."
+  "Font Lock mode face used to highlight grouping constructs in Lisp regexps."
   :group 'font-lock-highlighting-faces)
 
 ;;; End of Colour etc. support.
@@ -1855,95 +1853,95 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
 ;; buttons and when they are on or off needs tweaking.  I have assumed that the
 ;; mechanism is via `menu-toggle' and `menu-selected' symbol properties.  sm.
 
-;;;;###autoload
-;(progn
-;  ;; Make the Font Lock menu.
-;  (defvar font-lock-menu (make-sparse-keymap "Syntax Highlighting"))
-;  ;; Add the menu items in reverse order.
-;  (define-key font-lock-menu [fontify-less]
-;    '("Less In Current Buffer" . font-lock-fontify-less))
-;  (define-key font-lock-menu [fontify-more]
-;    '("More In Current Buffer" . font-lock-fontify-more))
-;  (define-key font-lock-menu [font-lock-sep]
-;    '("--"))
-;  (define-key font-lock-menu [font-lock-mode]
-;    '("In Current Buffer" . font-lock-mode))
-;  (define-key font-lock-menu [global-font-lock-mode]
-;    '("In All Buffers" . global-font-lock-mode)))
-;
-;;;;###autoload
-;(progn
-;  ;; We put the appropriate `menu-enable' etc. symbol property values on when
-;  ;; font-lock.el is loaded, so we don't need to autoload the three variables.
-;  (put 'global-font-lock-mode 'menu-toggle t)
-;  (put 'font-lock-mode 'menu-toggle t)
-;  (put 'font-lock-fontify-more 'menu-enable '(identity))
-;  (put 'font-lock-fontify-less 'menu-enable '(identity)))
-;
-; ;; Put the appropriate symbol property values on now.  See above.
-;(put 'global-font-lock-mode 'menu-selected 'global-font-lock-mode)
-;(put 'font-lock-mode 'menu-selected 'font-lock-mode)
-;(put 'font-lock-fontify-more 'menu-enable '(nth 2 font-lock-fontify-level))
-;(put 'font-lock-fontify-less 'menu-enable '(nth 1 font-lock-fontify-level))
-;
-;(defvar font-lock-fontify-level nil)  ; For less/more fontification.
-;
-;(defun font-lock-fontify-level (level)
-;  (let ((font-lock-maximum-decoration level))
-;    (when font-lock-mode
-;      (font-lock-mode))
-;    (font-lock-mode)
-;    (when font-lock-verbose
-;      (message "Fontifying %s... level %d" (buffer-name) level))))
-;
-;(defun font-lock-fontify-less ()
-;  "Fontify the current buffer with less decoration.
-;See `font-lock-maximum-decoration'."
-;  (interactive)
-;  ;; Check in case we get called interactively.
-;  (if (nth 1 font-lock-fontify-level)
-;      (font-lock-fontify-level (1- (car font-lock-fontify-level)))
-;    (error "No less decoration")))
-;
-;(defun font-lock-fontify-more ()
-;  "Fontify the current buffer with more decoration.
-;See `font-lock-maximum-decoration'."
-;  (interactive)
-;  ;; Check in case we get called interactively.
-;  (if (nth 2 font-lock-fontify-level)
-;      (font-lock-fontify-level (1+ (car font-lock-fontify-level)))
-;    (error "No more decoration")))
-;
-; ;; This should be called by `font-lock-set-defaults'.
-;(defun font-lock-set-menu ()
-;  ;; Activate less/more fontification entries if there are multiple levels for
-;  ;; the current buffer.  Sets `font-lock-fontify-level' to be of the form
-;  ;; (CURRENT-LEVEL IS-LOWER-LEVEL-P IS-HIGHER-LEVEL-P) for menu activation.
-;  (let ((keywords (or (nth 0 font-lock-defaults)
-;                    (nth 1 (assq major-mode font-lock-defaults-alist))))
-;      (level (font-lock-value-in-major-mode font-lock-maximum-decoration)))
-;    (make-local-variable 'font-lock-fontify-level)
-;    (if (or (symbolp keywords) (= (length keywords) 1))
-;      (font-lock-unset-menu)
-;      (cond ((eq level t)
-;           (setq level (1- (length keywords))))
-;          ((or (null level) (zerop level))
-;           ;; The default level is usually, but not necessarily, level 1.
-;           (setq level (- (length keywords)
-;                          (length (member (eval (car keywords))
-;                                          (mapcar 'eval (cdr keywords))))))))
-;      (setq font-lock-fontify-level (list level (> level 1)
-;                                        (< level (1- (length keywords))))))))
-;
-; ;; This should be called by `font-lock-unset-defaults'.
-;(defun font-lock-unset-menu ()
-;  ;; Deactivate less/more fontification entries.
-;  (setq font-lock-fontify-level nil))
+;;;;;###autoload
+;;(progn
+;;  ;; Make the Font Lock menu.
+;;  (defvar font-lock-menu (make-sparse-keymap "Syntax Highlighting"))
+;;  ;; Add the menu items in reverse order.
+;;  (define-key font-lock-menu [fontify-less]
+;;    '("Less In Current Buffer" . font-lock-fontify-less))
+;;  (define-key font-lock-menu [fontify-more]
+;;    '("More In Current Buffer" . font-lock-fontify-more))
+;;  (define-key font-lock-menu [font-lock-sep]
+;;    '("--"))
+;;  (define-key font-lock-menu [font-lock-mode]
+;;    '("In Current Buffer" . font-lock-mode))
+;;  (define-key font-lock-menu [global-font-lock-mode]
+;;    '("In All Buffers" . global-font-lock-mode)))
+;;
+;;;;;###autoload
+;;(progn
+;;  ;; We put the appropriate `menu-enable' etc. symbol property values on when
+;;  ;; font-lock.el is loaded, so we don't need to autoload the three variables.
+;;  (put 'global-font-lock-mode 'menu-toggle t)
+;;  (put 'font-lock-mode 'menu-toggle t)
+;;  (put 'font-lock-fontify-more 'menu-enable '(identity))
+;;  (put 'font-lock-fontify-less 'menu-enable '(identity)))
+;;
+;; ;; Put the appropriate symbol property values on now.  See above.
+;;(put 'global-font-lock-mode 'menu-selected 'global-font-lock-mode)
+;;(put 'font-lock-mode 'menu-selected 'font-lock-mode)
+;;(put 'font-lock-fontify-more 'menu-enable '(nth 2 font-lock-fontify-level))
+;;(put 'font-lock-fontify-less 'menu-enable '(nth 1 font-lock-fontify-level))
+;;
+;;(defvar font-lock-fontify-level nil) ; For less/more fontification.
+;;
+;;(defun font-lock-fontify-level (level)
+;;  (let ((font-lock-maximum-decoration level))
+;;    (when font-lock-mode
+;;      (font-lock-mode))
+;;    (font-lock-mode)
+;;    (when font-lock-verbose
+;;      (message "Fontifying %s... level %d" (buffer-name) level))))
+;;
+;;(defun font-lock-fontify-less ()
+;;  "Fontify the current buffer with less decoration.
+;;See `font-lock-maximum-decoration'."
+;;  (interactive)
+;;  ;; Check in case we get called interactively.
+;;  (if (nth 1 font-lock-fontify-level)
+;;      (font-lock-fontify-level (1- (car font-lock-fontify-level)))
+;;    (error "No less decoration")))
+;;
+;;(defun font-lock-fontify-more ()
+;;  "Fontify the current buffer with more decoration.
+;;See `font-lock-maximum-decoration'."
+;;  (interactive)
+;;  ;; Check in case we get called interactively.
+;;  (if (nth 2 font-lock-fontify-level)
+;;      (font-lock-fontify-level (1+ (car font-lock-fontify-level)))
+;;    (error "No more decoration")))
+;;
+;; ;; This should be called by `font-lock-set-defaults'.
+;;(defun font-lock-set-menu ()
+;;  ;; Activate less/more fontification entries if there are multiple levels for
+;;  ;; the current buffer.  Sets `font-lock-fontify-level' to be of the form
+;;  ;; (CURRENT-LEVEL IS-LOWER-LEVEL-P IS-HIGHER-LEVEL-P) for menu activation.
+;;  (let ((keywords (or (nth 0 font-lock-defaults)
+;;                   (nth 1 (assq major-mode font-lock-defaults-alist))))
+;;     (level (font-lock-value-in-major-mode font-lock-maximum-decoration)))
+;;    (make-local-variable 'font-lock-fontify-level)
+;;    (if (or (symbolp keywords) (= (length keywords) 1))
+;;     (font-lock-unset-menu)
+;;      (cond ((eq level t)
+;;          (setq level (1- (length keywords))))
+;;         ((or (null level) (zerop level))
+;;          ;; The default level is usually, but not necessarily, level 1.
+;;          (setq level (- (length keywords)
+;;                         (length (member (eval (car keywords))
+;;                                         (mapcar 'eval (cdr keywords))))))))
+;;      (setq font-lock-fontify-level (list level (> level 1)
+;;                                       (< level (1- (length keywords))))))))
+;;
+;; ;; This should be called by `font-lock-unset-defaults'.
+;;(defun font-lock-unset-menu ()
+;;  ;; Deactivate less/more fontification entries.
+;;  (setq font-lock-fontify-level nil))
 
 ;;; End of Menu support.
 \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
@@ -2084,22 +2082,22 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
        ("\\<:\\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.
+       ;; ELisp regexp grouping constructs
        ((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)
+          (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.