X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Ffont-lock.el;h=d72aeebfc9e6cddd4f666d25564d0b393e294946;hp=d927539e15a025aecafdd9f8e1602dd43c628123;hb=566b3d194e2d5c783808ac39437bd7e1a28b1c5c;hpb=21db8709c0c2dcedbd278c7fe571290d5ce80a71 diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d927539..d72aeeb 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -282,7 +282,7 @@ available for buffers in `c-mode', and level 1 decoration otherwise." (symbol :tag "name")) (radio :tag "Decoration" (const :tag "default" nil) - (const :tag "maximum" t) + (const :tag "maximum" t) (integer :tag "level" 1))))) :group 'font-lock) @@ -441,6 +441,32 @@ edit the buffer does not, since it considers text one line at a time. Be very careful composing regexps for this list; the wrong pattern can dramatically slow things down! ") + +(defvar font-lock-keywords-alist nil + "Alist of additional `font-lock-keywords' elements for major modes. + +Each element has the form (MODE KEYWORDS . HOW). +`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 HOW 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 HOW 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' 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'.") + ;;;###autoload (make-variable-buffer-local 'font-lock-keywords) @@ -626,7 +652,7 @@ This is normally set via `font-lock-defaults'.") ;; #### barf gag retch. Horrid FSF lossage that we need to ;; keep around for compatibility with font-lock-keywords that ;; forget to properly quote their faces. I tried just let-binding -;; them when we eval the face expression, but that failes because +;; them when we eval the face expression, but that fails because ;; some files actually use the variables directly in their init code ;; without quoting them. --ben (defvar font-lock-comment-face 'font-lock-comment-face @@ -639,6 +665,9 @@ The corresponding face should be set using `edit-faces' or the It is present only for horrid FSF compatibility reasons. The corresponding face should be set using `edit-faces' or the `set-face-*' functions.") +;; GNU compatibility +(define-compatible-variable-alias + 'font-lock-doc-face 'font-lock-doc-string-face) (defvar font-lock-string-face 'font-lock-string-face "This variable should not be set. It is present only for horrid FSF compatibility reasons. @@ -649,6 +678,11 @@ The corresponding face should be set using `edit-faces' or the It is present only for horrid FSF compatibility reasons. The corresponding face should be set using `edit-faces' or the `set-face-*' functions.") +(defvar font-lock-builtin-face 'font-lock-builtin-face + "This variable should not be set. +It is present only for horrid FSF compatibility reasons. +The corresponding face should be set using `edit-faces' or the +`set-face-*' functions.") (defvar font-lock-function-name-face 'font-lock-function-name-face "This variable should not be set. It is present only for horrid FSF compatibility reasons. @@ -664,6 +698,11 @@ The corresponding face should be set using `edit-faces' or the It is present only for horrid FSF compatibility reasons. The corresponding face should be set using `edit-faces' or the `set-face-*' functions.") +(defvar font-lock-constant-face 'font-lock-constant-face + "This variable should not be set. +It is present only for horrid FSF compatibility reasons. +The corresponding face should be set using `edit-faces' or the +`set-face-*' functions.") (defvar font-lock-reference-face 'font-lock-reference-face "This variable should not be set. It is present only for horrid FSF compatibility reasons. @@ -674,15 +713,22 @@ The corresponding face should be set using `edit-faces' or the It is present only for horrid FSF compatibility reasons. The corresponding face should be set using `edit-faces' or the `set-face-*' functions.") +(defvar font-lock-warning-face 'font-lock-warning-face + "This variable should not be set. +It is present only for horrid FSF compatibility reasons. +The corresponding face should be set using `edit-faces' or the +`set-face-*' functions.") (defconst font-lock-face-list '(font-lock-comment-face font-lock-string-face font-lock-doc-string-face font-lock-keyword-face + font-lock-builtin-face font-lock-function-name-face font-lock-variable-name-face font-lock-type-face + font-lock-constant-face font-lock-reference-face font-lock-preprocessor-face font-lock-warning-face)) @@ -731,6 +777,15 @@ on the major mode's symbol." "Font Lock mode face used to highlight keywords." :group 'font-lock-faces) +(defface font-lock-builtin-face + '((((class color) (background light)) (:foreground "Purple")) + (((class color) (background dark)) (:foreground "Cyan")) + (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) + (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) + (t (:bold t))) + "Font Lock mode face used to highlight builtins." +:group 'font-lock-faces) + (defface font-lock-function-name-face '((((class color) (background dark)) (:foreground "aquamarine")) ;; brown4 is hardly different from black on windows. @@ -763,6 +818,17 @@ on the major mode's symbol." "Font Lock mode face used to highlight types." :group 'font-lock-faces) +(defface font-lock-constant-face + '((((class color) (background light)) (:foreground "CadetBlue")) + (((class color) (background dark)) (:foreground "Aquamarine")) + (((class grayscale) (background light)) + (:foreground "LightGray" :bold t :underline t)) + (((class grayscale) (background dark)) + (:foreground "Gray50" :bold t :underline t)) + (t (:bold t :underline t))) + "Font Lock mode face used to highlight constants and labels." +:group 'font-lock-faces) + (defface font-lock-reference-face '((((class color) (background dark)) (:foreground "cadetblue2")) (((class color) (background light)) (:foreground "red3")) @@ -773,8 +839,6 @@ on the major mode's symbol." "Font Lock mode face used to highlight references." :group 'font-lock-faces) -;; #### FSF has font-lock-builtin-face. - (defface font-lock-preprocessor-face '((((class color) (background dark)) (:foreground "steelblue1")) (((class color) (background light)) (:foreground "blue3")) @@ -782,7 +846,6 @@ on the major mode's symbol." "Font Lock Mode face used to highlight preprocessor conditionals." :group 'font-lock-faces) -;; #### Currently unused (defface font-lock-warning-face '((((class color) (background light)) (:foreground "Red" :bold t)) (((class color) (background dark)) (:foreground "Pink" :bold t)) @@ -828,6 +891,188 @@ on the major mode's symbol." (setq font-lock-maximum-decoration t) (font-lock-recompute-variables))) +(defun font-lock-add-keywords (mode keywords &optional how) + "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'. +By default they are added at the beginning of the current highlighting list. +If optional argument HOW is `set', they are used to replace the current +highlighting list. If HOW is any other non-nil value, they are added at the +end of the current highlighting list. + +For example: + + (font-lock-add-keywords 'c-mode + '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend) + (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face))) + +adds two fontification patterns for C mode, to fontify `FIXME:' words, even in +comments, and to fontify `and', `or' and `not' words as keywords. + +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', +`objc-font-lock-extra-types' and `java-font-lock-extra-types'." + (cond (mode + ;; If MODE is non-nil, add the KEYWORDS and HOW spec to + ;; `font-lock-keywords-alist' so `font-lock-set-defaults' uses them. + (let ((spec (cons keywords how)) cell) + (if (setq cell (assq mode font-lock-keywords-alist)) + (if (eq how 'set) + (setcdr cell (list spec)) + (setcdr cell (append (cdr cell) (list spec)))) + (push (list mode spec) font-lock-keywords-alist))) + ;; Make sure that `font-lock-removed-keywords-alist' does not + ;; contain the new keywords. + (font-lock-update-removed-keyword-alist mode keywords how)) + (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) + (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 how '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 how + (append old keywords) + (append keywords old))))) + ;; If the keywords were compiled before, compile them again. + (if was-compiled + (setq font-lock-keywords + (font-lock-compile-keywords font-lock-keywords))))))) + +(defun font-lock-update-removed-keyword-alist (mode keywords how) + "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 + ;; keyword was once added, removed, and then added again it must be + ;; removed from the removed-keywords list. Otherwise the second add + ;; will not take effect. + (let ((cell (assq mode font-lock-removed-keywords-alist))) + (if cell + (if (eq how 'set) + ;; A new set of keywords is defined. Forget all about + ;; our old keywords that should be removed. + (setq font-lock-removed-keywords-alist + (delq cell font-lock-removed-keywords-alist)) + ;; Delete all previously removed keywords. + (dolist (kword keywords) + (setcdr cell (delete kword (cdr cell)))) + ;; Delete the mode cell if empty. + (if (null (cdr cell)) + (setq font-lock-removed-keywords-alist + (delq cell font-lock-removed-keywords-alist))))))) + +;; Written by Anders Lindgren . +;; +;; Case study: +;; (I) The keywords are removed from a major mode. +;; In this case the keyword could be local (i.e. added earlier by +;; `font-lock-add-keywords'), global, or both. +;; +;; (a) In the local case we remove the keywords from the variable +;; `font-lock-keywords-alist'. +;; +;; (b) The actual global keywords are not known at this time. +;; All keywords are added to `font-lock-removed-keywords-alist', +;; when font-lock is enabled those keywords are removed. +;; +;; Note that added keywords are taken out of the list of removed +;; keywords. This ensure correct operation when the same keyword +;; is added and removed several times. +;; +;; (II) The keywords are removed from the current buffer. +(defun font-lock-remove-keywords (mode keywords) + "Remove 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 removed for the current buffer. + +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) + (let ((top-cell (assq mode font-lock-keywords-alist))) + ;; If MODE is non-nil, remove the KEYWORD from + ;; `font-lock-keywords-alist'. + (when top-cell + (dolist (keyword-list-how-pair (cdr top-cell)) + ;; `keywords-list-how-pair' is a cons with a list of + ;; keywords in the car top-cell and the original how + ;; argument in the cdr top-cell. + (setcar keyword-list-how-pair + (delete keyword (car keyword-list-how-pair)))) + ;; Remove keyword list/how pair when the keyword list + ;; is empty and how doesn't specify `set'. (If it + ;; should be deleted then previously deleted keywords + ;; would appear again.) + (let ((cell top-cell)) + (while (cdr cell) + (if (and (null (car (car (cdr cell)))) + (not (eq (cdr (car (cdr cell))) 'set))) + (setcdr cell (cdr (cdr cell))) + (setq cell (cdr cell))))) + ;; Final cleanup, remove major mode cell if last keyword + ;; was deleted. + (if (null (cdr top-cell)) + (setq font-lock-keywords-alist + (delq top-cell font-lock-keywords-alist)))) + ;; Remember the keyword in case it is not local. + (let ((cell (assq mode font-lock-removed-keywords-alist))) + (if cell + (unless (member keyword (cdr cell)) + (nconc cell (list keyword))) + (push (cons mode (list keyword)) + font-lock-removed-keywords-alist)))))) + (t + ;; Otherwise remove it immediately. + (font-lock-set-defaults) + (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 + (setq font-lock-keywords + (font-lock-compile-keywords font-lock-keywords))))))) ;;;;;;;;;;;;;;;;;;;;;; actual code ;;;;;;;;;;;;;;;;;;;;;; @@ -1291,12 +1536,18 @@ buffer modifications are performed or a buffer is reverted.") ;; was supposedly much faster than the FSF version because it was written in ;; C. However, the FSF version uses parse-partial-sexp, which is also ;; written in C, and the benchmarking I did showed the -;; syntactically-sectionize code to be slower overall. So here's the FSF -;; version, modified to support font-lock-doc-string-face. +;; syntactically-sectionize code to be slower overall. So here's the +;; FSF version, modified to support font-lock-doc-string-face. ;; -- mct 2000-12-29 +;; #### Andy conditionally reverted Matt's change when we were experimenting +;; with making lookup-syntax-properties an optional feature. I don't see how +;; this code relates to lookup-syntax-properties, though. I wonder if the +;; bug is in our (?) version of parse-partial-sexp. Andy says no. Of course, +;; Matt benchmarked ... WTF knows? sjt 2002-09-28 (defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. -START should be at the beginning of a line." +START should be at the beginning of a line. Optional argument LOUDLY +is currently ignored." (if font-lock-keywords-only nil @@ -1453,8 +1704,8 @@ Optional argument OBJECT is the string or buffer containing the text." (defun font-lock-apply-syntactic-highlight (highlight) "Apply HIGHLIGHT following a match. - HIGHLIGHT should be of the form MATCH-HIGHLIGHT, - see `font-lock-syntactic-keywords'." +HIGHLIGHT should be of the form MATCH-HIGHLIGHT, +see `font-lock-syntactic-keywords'." (let* ((match (nth 0 highlight)) (start (match-beginning match)) (end (match-end match)) (value (nth 1 highlight)) @@ -1532,8 +1783,7 @@ START should be at the beginning of a line." (font-lock-apply-syntactic-highlight (car highlights)) (font-lock-fontify-syntactic-anchored-keywords (car highlights) end)) - (setq highlights (cdr highlights))) - ) + (setq highlights (cdr highlights)))) (setq keywords (cdr keywords))))) ;;; Regexp fontification functions. @@ -1599,10 +1849,11 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM." START should be at the beginning of a line." (let ((loudly (and font-lock-verbose (>= (- end start) font-lock-message-threshold)))) + (unless (eq (car-safe font-lock-keywords) t) + (setq font-lock-keywords + (font-lock-compile-keywords font-lock-keywords))) (let* ((case-fold-search font-lock-keywords-case-fold-search) - (keywords (cdr (if (eq (car-safe font-lock-keywords) t) - font-lock-keywords - (font-lock-compile-keywords)))) + (keywords (cdr font-lock-keywords)) (bufname (buffer-name)) (progress 5) (old-progress 5) (iter 0) @@ -1676,14 +1927,12 @@ START should be at the beginning of a line." ;; Various functions. -(defun font-lock-compile-keywords (&optional keywords) - ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD - ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string. - (let ((keywords (or keywords font-lock-keywords))) - (setq font-lock-keywords - (if (eq (car-safe keywords) t) - keywords - (cons t (mapcar 'font-lock-compile-keyword keywords)))))) +(defun font-lock-compile-keywords (keywords) + "Compile KEYWORDS (a list) and return the list of compiled keywords. +Each keyword has the form (MATCHER HIGHLIGHT ...). See `font-lock-keywords'." + (if (eq (car-safe keywords) t) + keywords + (cons t (mapcar 'font-lock-compile-keyword keywords)))) (defun font-lock-compile-keyword (keyword) (cond ((nlistp keyword) ; Just MATCHER @@ -1700,7 +1949,7 @@ START should be at the beginning of a line." keyword))) (defun font-lock-eval-keywords (keywords) - ;; Evalulate KEYWORDS if a function (funcall) or variable (eval) name. + "Evaluate KEYWORDS if a function (funcall) or variable (eval) name." (if (listp keywords) keywords (font-lock-eval-keywords (if (fboundp keywords) @@ -1946,7 +2195,7 @@ START should be at the beginning of a line." "\\)\\)\\>" ;; Any whitespace and declared object. "[ \t'\(]*" - "\\([^ \t\n\)]+\\)?") + "\\([^ \t\n\(\)]+\\)?") '(1 font-lock-keyword-face) '(8 (cond ((match-beginning 3) 'font-lock-variable-name-face) ((match-beginning 6) 'font-lock-type-face) @@ -2467,9 +2716,10 @@ The name is assumed to begin with a capital letter.") (list (concat "\\<\\(" + "assert\\|" "break\\|byvalue\\|" "case\\|cast\\|catch\\|class\\|continue\\|" - "do\\|else\\|extends\\|" + "do\\|else\\|enum\\|extends\\|" "finally\\|for\\|future\\|" "generic\\|goto\\|" "if\\|implements\\|import\\|" @@ -2655,10 +2905,10 @@ The name is assumed to begin with a capital letter.") '("\\(@beaninfo\\)" 0 font-lock-keyword-face t) ;; Doc tag - Links - '("{ *@link\\s +\\([^}]+\\)}" + '("{ *@link\\(?:plain\\)?\\s +\\([^}]+\\)}" 0 font-lock-keyword-face t) ;; Doc tag - Links - '("{ *@link\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}" + '("{ *@link\\(?:plain\\)?\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}" 1 font-lock-function-name-face t) ))) @@ -2674,32 +2924,34 @@ The name is assumed to begin with a capital letter.") ;; the cursor to fontify more identifiers. (defun font-lock-match-java-declarations (limit) "Match and skip over variable definitions." - (if (looking-at "\\s *\\(\\[\\s *\\]\\s *\\)*") - (goto-char (match-end 0))) - (and - (looking-at java-font-lock-identifier-regexp) - (save-match-data - (not (string-match java-font-lock-type-regexp - (buffer-substring (match-beginning 1) - (match-end 1))))) - (save-match-data - (save-excursion - (goto-char (match-beginning 1)) - (not (looking-at - (concat java-font-lock-class-name-regexp - "\\s *\\(\\[\\s *\\]\\s *\\)*\\<"))))) - (save-match-data - (condition-case nil - (save-restriction - (narrow-to-region (point-min) limit) - (goto-char (match-end 0)) - ;; Note: Both `scan-sexps' and the second goto-char can - ;; generate an error which is caught by the - ;; `condition-case' expression. - (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)")) - (goto-char (or (scan-sexps (point) 1) (point-max)))) - (goto-char (match-end 2))) ; non-nil - (error t))))) + (save-restriction + (narrow-to-region (point-min) limit) + + (if (looking-at "\\s *\\(\\[\\s *\\]\\s *\\)*") + (goto-char (match-end 0))) + (and + (looking-at java-font-lock-identifier-regexp) + (save-match-data + (not (string-match java-font-lock-type-regexp + (buffer-substring (match-beginning 1) + (match-end 1))))) + (save-match-data + (save-excursion + (goto-char (match-beginning 1)) + (not (looking-at + (concat java-font-lock-class-name-regexp + "\\s *\\(\\[\\s *\\]\\s *\\)*\\<"))))) + (save-match-data + (condition-case nil + (progn + (goto-char (match-end 0)) + ;; Note: Both `scan-sexps' and the second goto-char can + ;; generate an error which is caught by the + ;; `condition-case' expression. + (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)")) + (goto-char (or (scan-sexps (point) 1) (point-max)))) + (goto-char (match-end 2))) ; non-nil + (error t)))))) (defvar tex-font-lock-keywords