X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0003d2e3191b1eb64ac347323f52c8649cbe0100..1b74c4346e92c9ac1ae0575c2ad69f8d81126d7e:/lisp/font-lock.el diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d2ffdf44bd..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, 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: @@ -430,7 +430,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. @@ -563,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. @@ -620,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)) @@ -634,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. @@ -683,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 a Lisp program (such as a minor mode), it is recommended to -use nil for MODE (and place the call 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', @@ -704,7 +716,8 @@ 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. + ;; This is a no-op if it has been done already in this buffer + ;; for the correct major mode. (font-lock-set-defaults) (let ((was-compiled (eq (car font-lock-keywords) t))) ;; Bring back the user-level (uncompiled) keywords. @@ -774,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 a Lisp program (such as a minor mode), it is recommended to -use nil for MODE (and place the call 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) @@ -889,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 @@ -1311,10 +1326,20 @@ 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) ;; @@ -1329,7 +1354,21 @@ 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))) + (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))))) @@ -1420,6 +1459,7 @@ LOUDLY, if non-nil, allows progress-meter bar." (let ((case-fold-search font-lock-keywords-case-fold-search) (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'. @@ -1433,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)) @@ -1454,12 +1498,14 @@ LOUDLY, if non-nil, allows progress-meter bar." (while highlights (if (numberp (car (car highlights))) (font-lock-apply-highlight (car highlights)) - (let ((pos (point))) - (font-lock-fontify-anchored-keywords (car highlights) end) - ;; Ensure forward progress. - (if (< (point) pos) (goto-char pos)))) + (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. @@ -1544,12 +1590,15 @@ 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) @@ -1637,27 +1686,6 @@ Sets various variables using `font-lock-defaults' (or, if nil, using ;; But now we do it the custom way. Note that `defface' will not overwrite any ;; faces declared above via `custom-declare-face'. -(defface font-lock-comment-delimiter-face - '((((class grayscale) (background light)) - (:foreground "DimGray" :weight bold :slant italic)) - (((class grayscale) (background dark)) - (:foreground "LightGray" :weight bold :slant italic)) - (((class color) (min-colors 88) (background light)) - (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) - (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) - (:foreground "red")) - (((class color) (min-colors 16) (background dark)) - (:foreground "red1")) - (((class color) (min-colors 8) (background light)) - (:foreground "red")) - (((class color) (min-colors 8) (background dark)) - (:foreground "red1")) - (t (:weight bold :slant italic))) - "Font Lock mode face used to highlight comment delimiters." - :group 'font-lock-highlighting-faces) - (defface font-lock-comment-face '((((class grayscale) (background light)) (:foreground "DimGray" :weight bold :slant italic)) @@ -1679,6 +1707,17 @@ Sets various variables using `font-lock-defaults' (or, if nil, using "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)) @@ -1780,13 +1819,8 @@ Sets various variables using `font-lock-defaults' (or, if nil, using "Font Lock mode face used to highlight warnings." :group 'font-lock-highlighting-faces) -;; Matches font-lock-builtin-face, because that is used for #ifndef and -;; font-lock-keyword-face, which alas make-mode uses for ifndef (defface font-lock-negation-char-face - '((((class color) (min-colors 88) (background light)) (:foreground "VioletRed" :weight bold)) - (((class color) (min-colors 88) (background dark)) (:foreground "MediumOrchid1" :weight bold)) - (((class color) (min-colors 8)) (:foreground "red" :weight bold)) - (t (:inverse-video t :weight bold))) + '((t nil)) "Font Lock mode face used to highlight easy to overlook negation." :group 'font-lock-highlighting-faces) @@ -1795,6 +1829,16 @@ 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-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. @@ -1838,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)) @@ -1872,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 @@ -1893,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)) @@ -1901,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 @@ -1955,109 +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\\|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) - )) + `(;; 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" - "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. - (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\\|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) - ;; -;;; 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) + ;; 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) +;;; ("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) ))) "Gaudy level highlighting for Lisp modes.")