Mercurial > hg > xemacs-beta
diff lisp/font-lock.el @ 221:6c0ae1f9357f r20-4b9
Import from CVS: tag r20-4b9
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:10:02 +0200 |
parents | 262b8bb4a523 |
children | 0e522484dd2a |
line wrap: on
line diff
--- a/lisp/font-lock.el Mon Aug 13 10:09:36 2007 +0200 +++ b/lisp/font-lock.el Mon Aug 13 10:10:02 2007 +0200 @@ -153,9 +153,10 @@ Comments will be displayed in `font-lock-comment-face'. Strings will be displayed in `font-lock-string-face'. Doc strings will be displayed in `font-lock-doc-string-face'. -Function and variable names (in their defining forms) will be - displayed in `font-lock-function-name-face'. -Reserved words will be displayed in `font-lock-keyword-face'." +Function and variable names (in their defining forms) will be displayed + in `font-lock-function-name-face'. +Reserved words will be displayed in `font-lock-keyword-face'. +Preprocessor conditionals will be displayed in `font-lock-preprocessor-face'." :group 'languages) (defgroup font-lock-faces nil @@ -500,6 +501,31 @@ This is normally set via `font-lock-defaults'.") (make-variable-buffer-local 'font-lock-beginning-of-syntax-function) +(defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer + "Function to use for fontifying the buffer. +This is normally set via `font-lock-defaults'.") + +(defvar font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer + "Function to use for unfontifying the buffer. +This is used when turning off Font Lock mode. +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'.") + +(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region + "Function to use for unfontifying a region. +It should take two args, the beginning and end of the region. +This is normally set via `font-lock-defaults'.") + +(defvar font-lock-inhibit-thing-lock nil + "List of Font Lock mode related modes that should not be turned on. +Currently, valid mode names as `fast-lock-mode' and `lazy-lock-mode'. +This is normally set via `font-lock-defaults'.") + ;;;###autoload (defvar font-lock-mode nil) ; for modeline (defvar font-lock-fontified nil) ; whether we have hacked this buffer @@ -630,7 +656,7 @@ (defface font-lock-preprocessor-face '((((class color) (background dark)) (:foreground "steelblue1")) - (((class color) (background black)) (:foreground "blue3")) + (((class color) (background light)) (:foreground "blue3")) (t (:underline t))) "Font Lock Mode face used to highlight preprocessor conditionals." :group 'font-lock-faces) @@ -821,46 +847,11 @@ "Unconditionally turn off Font Lock mode." (font-lock-mode 0)) -;;;###autoload -(defun font-lock-fontify-buffer () - "Fontify the current buffer the way `font-lock-mode' would. -See `font-lock-mode' for details. +;;; FSF has here: -This can take a while for large buffers." - (interactive) - (let ((was-on font-lock-mode) - (font-lock-verbose (or font-lock-verbose (interactive-p))) - (font-lock-message-threshold 0) - (aborted nil)) - ;; Turn it on to run hooks and get the right font-lock-keywords. - (or was-on (font-lock-mode 1)) - (font-lock-unfontify-region (point-min) (point-max) t) -;; (buffer-syntactic-context-flush-cache) - - ;; If a ^G is typed during fontification, abort the fontification, but - ;; return normally (do not signal.) This is to make it easy to abort - ;; fontification if it's taking a long time, without also causing the - ;; buffer not to pop up. If a real abort is desired, the user can ^G - ;; again. - ;; - ;; Possibly this should happen down in font-lock-fontify-region instead - ;; of here, but since that happens from the after-change-hook (meaning - ;; much more frequently) I'm afraid of the bad consequences of stealing - ;; the interrupt character at inopportune times. - ;; - (condition-case nil - (save-excursion - (font-lock-fontify-region (point-min) (point-max))) - (quit - (setq aborted t))) +;; support for add-keywords, global-font-lock-mode and +;; font-lock-support-mode (unified support for various *-lock modes). - (or was-on ; turn it off if it was off. - (let ((font-lock-fontified nil)) ; kludge to prevent defontification - (font-lock-mode 0))) - (set (make-local-variable 'font-lock-fontified) t) - (when (and aborted font-lock-verbose) - (lmessage 'command "Fontifying %s... aborted." (buffer-name)))) - (run-hooks 'font-lock-after-fontify-buffer-hook)) ;; Fontification functions. @@ -906,10 +897,112 @@ ;; Fontification functions. -;; We use this wrapper. However, `font-lock-fontify-region' used to be the -;; name used for `font-lock-fontify-syntactically-region', so a change isn't -;; back-compatible. But you shouldn't be calling these directly, should you? +;; Rather than the function, e.g., `font-lock-fontify-region' containing the +;; code to fontify a region, the function runs the function whose name is the +;; value of the variable, e.g., `font-lock-fontify-region-function'. Normally, +;; the value of this variable is, e.g., `font-lock-default-fontify-region' +;; which does contain the code to fontify a region. However, the value of the +;; variable could be anything and thus, e.g., `font-lock-fontify-region' could +;; do anything. The indirection of the fontification functions gives major +;; modes the capability of modifying the way font-lock.el fontifies. Major +;; modes can modify the values of, e.g., `font-lock-fontify-region-function', +;; via the variable `font-lock-defaults'. +;; +;; For example, Rmail mode sets the variable `font-lock-defaults' so that +;; font-lock.el uses its own function for buffer fontification. This function +;; makes fontification be on a message-by-message basis and so visiting an +;; RMAIL file is much faster. A clever implementation of the function might +;; fontify the headers differently than the message body. (It should, and +;; correspondingly for Mail mode, but I can't be bothered to do the work. Can +;; you?) This hints at a more interesting use... +;; +;; Languages that contain text normally contained in different major modes +;; could define their own fontification functions that treat text differently +;; depending on its context. For example, Perl mode could arrange that here +;; docs are fontified differently than Perl code. Or Yacc mode could fontify +;; rules one way and C code another. Neat! +;; +;; A further reason to use the fontification indirection feature is when the +;; default syntactual fontification, or the default fontification in general, +;; is not flexible enough for a particular major mode. For example, perhaps +;; comments are just too hairy for `font-lock-fontify-syntactically-region' to +;; cope with. You need to write your own version of that function, e.g., +;; `hairy-fontify-syntactically-region', and make your own version of +;; `hairy-fontify-region' call that function before calling +;; `font-lock-fontify-keywords-region' for the normal regexp fontification +;; pass. And Hairy mode would set `font-lock-defaults' so that font-lock.el +;; would call your region fontification function instead of its own. For +;; example, TeX modes could fontify {\foo ...} and \bar{...} etc. multi-line +;; directives correctly and cleanly. (It is the same problem as fontifying +;; multi-line strings and comments; regexps are not appropriate for the job.) + +;;;###autoload +(defun font-lock-fontify-buffer () + "Fontify the current buffer the way `font-lock-mode' would. +See `font-lock-mode' for details. + +This can take a while for large buffers." + (interactive) + (let ((font-lock-verbose (or font-lock-verbose (interactive-p)))) + (funcall font-lock-fontify-buffer-function))) + +(defun font-lock-unfontify-buffer () + (funcall font-lock-unfontify-buffer-function)) + (defun font-lock-fontify-region (beg end &optional loudly) + (funcall font-lock-fontify-region-function beg end loudly)) + +(defun font-lock-unfontify-region (beg end &optional loudly) + (funcall font-lock-unfontify-region-function beg end loudly)) + +;; #### In these functions, the FSF is careful to do +;; (save-restriction +;; (widen) +;; before anything else. Should we copy? +(defun font-lock-default-fontify-buffer () + (interactive) + (let ((was-on font-lock-mode) + (font-lock-verbose (or font-lock-verbose (interactive-p))) + (font-lock-message-threshold 0) + (aborted nil)) + ;; Turn it on to run hooks and get the right font-lock-keywords. + (or was-on (font-lock-mode 1)) + (font-lock-unfontify-region (point-min) (point-max) t) +;; (buffer-syntactic-context-flush-cache) + + ;; If a ^G is typed during fontification, abort the fontification, but + ;; return normally (do not signal.) This is to make it easy to abort + ;; fontification if it's taking a long time, without also causing the + ;; buffer not to pop up. If a real abort is desired, the user can ^G + ;; again. + ;; + ;; Possibly this should happen down in font-lock-fontify-region instead + ;; of here, but since that happens from the after-change-hook (meaning + ;; much more frequently) I'm afraid of the bad consequences of stealing + ;; the interrupt character at inopportune times. + ;; + (condition-case nil + (save-excursion + (font-lock-fontify-region (point-min) (point-max))) + (quit + (setq aborted t))) + + (or was-on ; turn it off if it was off. + (let ((font-lock-fontified nil)) ; kludge to prevent defontification + (font-lock-mode 0))) + (set (make-local-variable 'font-lock-fontified) t) + (when (and aborted font-lock-verbose) + (lmessage 'command "Fontifying %s... aborted." (buffer-name)))) + (run-hooks 'font-lock-after-fontify-buffer-hook)) + +(defun font-lock-default-unfontify-buffer () + (font-lock-unfontify-region (point-min) (point-max)) + (set (make-local-variable 'font-lock-fontified) nil)) + +;; This used to be `font-lock-fontify-region', and before that, +;; `font-lock-fontify-region' used to be the name used for what is now +;; `font-lock-fontify-syntactically-region'. +(defun font-lock-default-fontify-region (beg end &optional loudly) (let ((modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) (old-syntax-table (syntax-table)) @@ -935,7 +1028,7 @@ ; (or (nth 4 state) (nth 7 state)))) ; (font-lock-fontify-keywords-region beg end)) -(defun font-lock-unfontify-region (beg end &optional maybe-loudly) +(defun font-lock-default-unfontify-region (beg end &optional maybe-loudly) (when (and maybe-loudly font-lock-verbose (>= (- end beg) font-lock-message-threshold)) (lmessage 'progress "Fontifying %s..." (buffer-name))) @@ -1437,6 +1530,8 @@ (defalias 'font-lock-revert-cleanup 'turn-on-font-lock) +;; 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. @@ -1739,6 +1834,10 @@ "file\\)\\)\\)" "\\)\\>") 1) ;; + ;; Feature symbols as references. + '("(\\(featurep\\|provide\\|require\\)\\>[ \t']*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) + ;; ;; Words inside \\[] tend to be for `substitute-command-keys'. '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend) ;; @@ -2139,182 +2238,13 @@ (defvar c++-font-lock-keywords c++-font-lock-keywords-1 "Default expressions to highlight in C++ mode.") + +;;; Java. -;; The previous version, before replacing it with the FSF version. -;(defconst c-font-lock-keywords-1 nil -; "For consideration as a value of `c-font-lock-keywords'. -;This does fairly subdued highlighting.") -; -;(defconst c-font-lock-keywords-2 nil -; "For consideration as a value of `c-font-lock-keywords'. -;This does a lot more highlighting.") -; -;(let ((storage "auto\\|extern\\|register\\|static\\|volatile") -; (prefixes "unsigned\\|short\\|long\\|const") -; (types (concat "int\\|long\\|char\\|float\\|double\\|void\\|struct\\|" -; "union\\|enum\\|typedef")) -; (ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+") -; ) -; (setq c-font-lock-keywords-1 (purecopy -; (list -; ;; fontify preprocessor directives. -; '("^#[ \t]*[a-z]+" . font-lock-preprocessor-face) -; ;; -; ;; fontify names being defined. -; '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 -; font-lock-function-name-face) -; ;; -; ;; fontify other preprocessor lines. -; '("^#[ \t]*\\(if\\|ifn?def\\|elif\\)[ \t]+\\([^\n]+\\)" -; 2 font-lock-function-name-face t) -; ;; -; ;; fontify the filename in #include <...> -; ;; don't need to do this for #include "..." because those were -; ;; already fontified as strings by the syntactic pass. -; ;; (Changed to not include the <> in the face, since "" aren't.) -; '("^#[ \t]*include[ \t]+<\\([^>\"\n]+\\)>" 1 font-lock-string-face) -; ;; -; ;; fontify the names of functions being defined. -; ;; I think this should be fast because it's anchored at bol, but it's not. -; (list (concat -; "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no -; "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? -; "\\(" ctoken "[ \t]+\\)?" -; "\\([*&]+[ \t]*\\)?" ; pointer -; "\\(" ctoken "\\)[ \t]*(") ; name -; 8 'font-lock-function-name-face) -; ;; -; ;; This is faster but not by much. I don't see why not. -;; (list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face) -; ;; -; ;; Fontify structure names (in structure definition form). -; (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)" -; "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") -; 2 'font-lock-function-name-face) -; ;; -; ;; Fontify case clauses. This is fast because its anchored on the left. -; '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) -; '("\\<\\(default\\):". 1) -; ))) -; -; (setq c-font-lock-keywords-2 (purecopy -; (append c-font-lock-keywords-1 -; (list -; ;; -; ;; fontify all storage classes and type specifiers -; ;; types should be surrounded by non alphanumerics (Raymond Toy) -; (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) -; (list (concat "\\([^a-zA-Z0-9_]\\|^\\)\\(" -; types -; "\\)\\([^a-zA-Z0-9_]\\|$\\)") -; 2 'font-lock-type-face) -; ;; fontify the prefixes now. The types should have been fontified -; ;; previously. -; (list (concat "\\<\\(" prefixes "\\)[ \t]+\\(" types "\\)\\>") -; 1 'font-lock-type-face) -; ;; -; ;; fontify all builtin tokens -; (cons (concat -; "[ \t]\\(" -; (mapconcat 'identity -; '("for" "while" "do" "return" "goto" "case" "break" "switch" -; "if" "then" "else if" "else" "return" "continue" "default" -; ) -; "\\|") -; "\\)[ \t\n(){};,]") -; 1) -; ;; -; ;; fontify case targets and goto-tags. This is slow because the -; ;; expression is anchored on the right. -; "\\(\\(\\sw\\|\\s_\\)+\\):" -; ;; -; ;; Fontify variables declared with structures, or typedef names. -; '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" -; 1 font-lock-function-name-face) -; ;; -; ;; Fontify global variables without a type. -;; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) -; -; )))) -; ) -; -; -;;; default to the gaudier variety? -;;(defconst c-font-lock-keywords c-font-lock-keywords-2 -;; "Additional expressions to highlight in C mode.") -;(defconst c-font-lock-keywords c-font-lock-keywords-1 -; "Additional expressions to highlight in C mode.") -; -;(defconst c++-font-lock-keywords-1 nil -; "For consideration as a value of `c++-font-lock-keywords'. -;This does fairly subdued highlighting.") -; -;(defconst c++-font-lock-keywords-2 nil -; "For consideration as a value of `c++-font-lock-keywords'. -;This does a lot more highlighting.") -; -;(let ((ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+") -; (c++-types (concat "complex\\|public\\|private\\|protected\\|virtual\\|" -; "friend\\|inline")) -; c++-font-lock-keywords-internal-1 -; c++-font-lock-keywords-internal-2 -; ) -; (setq c++-font-lock-keywords-internal-1 (purecopy -; (list -; ;; -; ;; fontify friend operator functions -; '("^\\(operator[^(]*\\)(" 1 font-lock-function-name-face) -; '("^\\(operator[ \\t]*([ \\t]*)[^(]*\\)(" 1 font-lock-function-name-face) -; -; ;; fontify the class names only in the definition -; (list (concat "^class[ \t]+" ctoken "[ \t\n{: ;]") 1 -; 'font-lock-function-name-face) -; -; (list (concat -; "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no -; "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? -; "\\(" ctoken "[ \t]+\\)?" -; "\\(\\*+[ \t]*\\)?" ; pointer -; "\\(" ctoken "\\(::\\)?~?\\(\\(operator[ \t]*[^ \ta-zA-Z]+\\)\\|" -; ctoken "\\)\\)[ \t]*(") ; name -; 8 'font-lock-function-name-face t) -; ))) -; -; (setq c++-font-lock-keywords-internal-2 (purecopy -; (list -; ;; fontify extra c++ storage classes and type specifiers -; (cons (concat "\\<\\(" c++-types "\\)\\>") 'font-lock-type-face) -; -; ;;special check for class -; '("^\\(\\<\\|template[ \t]+<[ \t]*\\)\\(class\\)[ \t\n]+" 2 -; font-lock-type-face) -; -; ;; special handling of template -; "^\\(template\\)\\>" -; ;; fontify extra c++ builtin tokens -; (cons (concat -; "[ \t]\\(" -; (mapconcat 'identity -; '("asm" "catch" "throw" "try" "delete" "new" "operator" -; "sizeof" "this" -; ) -; "\\|") -; "\\)[ \t\n(){};,]") -; 1) -; ))) -; -; (setq c++-font-lock-keywords-1 (purecopy -; (append c-font-lock-keywords-1 c++-font-lock-keywords-internal-1))) -; -; (setq c++-font-lock-keywords-2 (purecopy -; (append c-font-lock-keywords-2 c++-font-lock-keywords-internal-1 -; c++-font-lock-keywords-internal-2))) -; ) -; -;(defconst c++-font-lock-keywords c++-font-lock-keywords-1 -; "Additional expressions to highlight in C++ mode.") - -;; Java support from Anders Lindgren and Bob Weiner +;; Java support has been written by XEmacs people, and it's apparently +;; totally divergent from the FSF. I don't know if it's better or +;; worse, so I'm leaving it in until someone convinces me the FSF +;; version is better. --hniksic (defconst java-font-lock-keywords-1 nil "For consideration as a value of `java-font-lock-keywords'. @@ -2613,33 +2543,6 @@ 3 (if (match-beginning 2) 'bold 'italic) keep)) "Default expressions to highlight in TeX modes.") -;; The previous version, before replacing it with the FSF version. -;(defconst tex-font-lock-keywords (purecopy -; (list -; ;; Lionel Mallet: Thu Oct 14 09:41:38 1993 -; ;; I've added an exit condition to the regexp below, and the other -; ;; regexps for the second part. -; ;; What would be useful here is something like: -; ;; ("\\(\\\\\\w+\\)\\({\\(\\w+\\)}\\)+" 1 font-lock-keyword-face t 3 -; ;; font-lock-function-name-face t) -; '("\\(\\\\\\w+\\)\\W" 1 font-lock-keyword-face t) -; '("\\(\\\\\\w+\\){\\([^}\n]+\\)}" 2 font-lock-function-name-face t) -; '("\\(\\\\\\w+\\){\\(\\w+\\)}{\\(\\w+\\)}" 3 -; font-lock-function-name-face t) -; '("\\(\\\\\\w+\\){\\(\\w+\\)}{\\(\\w+\\)}{\\(\\w+\\)}" 4 -; font-lock-function-name-face t) -; '("{\\\\\\(em\\|tt\\)\\([^}]+\\)}" 2 font-lock-comment-face t) -; '("{\\\\bf\\([^}]+\\)}" 1 font-lock-keyword-face t) -; '("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)\\W" 1 font-lock-function-name-face t) -; ;; Lionel Mallet: Thu Oct 14 09:40:10 1993 -; ;; the regexp below is useless as it is now covered by the first 2 regexps -; ;; '("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" -; ;; 2 font-lock-function-name-face t) -; '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) -;; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) -; )) -; "Additional expressions to highlight in TeX mode.") - (defconst ksh-font-lock-keywords (purecopy (list '("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face)