;;;###autoload
(defvar font-lock-maximum-decoration nil
- "*If non-nil, the maximum decoration level for fontifying.
+ "*Maximum decoration level for fontification.
If nil, use the default decoration (typically the minimum available).
If t, use the maximum decoration available.
If a number, use that level of decoration (or if not available the maximum).
;;;###autoload
(defvar font-lock-maximum-size (* 250 1024)
- "*If non-nil, the maximum size for buffers for fontifying.
+ "*Maximum size of a buffer for buffer fontification.
Only buffers less than this can be fontified when Font Lock mode is turned on.
If nil, means size is irrelevant.
If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
(MATCHER . FACENAME)
(MATCHER . HIGHLIGHT)
(MATCHER HIGHLIGHT ...)
+ (eval . FORM)
where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED.
+FORM is an expression, whose value should be a keyword element, evaluated when
+the keyword is (first) used in a buffer. This feature can be used to provide a
+keyword that can only be generated when Font Lock mode is actually turned on.
+
For highlighting single items, typically only MATCH-HIGHLIGHT is required.
However, if an item or (typically) items are to be highlighted following the
instance of another item (the anchor) then MATCH-ANCHORED may be required.
(c-mode-defaults
'((c-font-lock-keywords c-font-lock-keywords-1
c-font-lock-keywords-2 c-font-lock-keywords-3)
- nil nil ((?_ . "w")) beginning-of-defun))
+ nil nil ((?_ . "w")) beginning-of-defun
+ (font-lock-mark-block-function . mark-defun)))
(c++-mode-defaults
'((c++-font-lock-keywords c++-font-lock-keywords-1
c++-font-lock-keywords-2 c++-font-lock-keywords-3)
- nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun))
+ nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun
+ (font-lock-mark-block-function . mark-defun)))
(lisp-mode-defaults
'((lisp-font-lock-keywords
lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w")
(?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w")
(?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w"))
- beginning-of-defun))
+ beginning-of-defun (font-lock-mark-block-function . mark-defun)))
(scheme-mode-defaults
'(scheme-font-lock-keywords nil t
((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w")
(?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w")
(?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w"))
- beginning-of-defun))
+ beginning-of-defun (font-lock-mark-block-function . mark-defun)))
;; For TeX modes we could use `backward-paragraph' for the same reason.
- (tex-mode-defaults '(tex-font-lock-keywords nil nil ((?$ . "\""))))
+ ;; But we don't, because paragraph breaks are arguably likely enough to
+ ;; occur within a genuine syntactic block to make it too risky.
+ ;; However, we do specify a MARK-BLOCK function as that cannot result
+ ;; in a mis-fontification even if it might not fontify enough. --sm.
+ (tex-mode-defaults '(tex-font-lock-keywords nil nil ((?$ . "\"")) nil
+ (font-lock-mark-block-function . mark-paragraph)))
)
(list
(cons 'bibtex-mode tex-mode-defaults)
Each item should be a list of the form:
(MAJOR-MODE . (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN
- LOCAL-FONTIFICATION))
+ ...))
where MAJOR-MODE is a symbol. KEYWORDS may be a symbol (a variable or function
whose value is the keywords to use for fontification) or a list of symbols.
`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and
`font-lock-beginning-of-syntax-function', respectively.
-LOCAL-FONTIFICATION should be of the form:
+Further item elements are alists of the form (VARIABLE . VALUE) and are in no
+particular order. Each VARIABLE is made buffer-local before set to VALUE.
- (FONTIFY-BUFFER-FUNCTION UNFONTIFY-BUFFER-FUNCTION FONTIFY-REGION-FUNCTION
- UNFONTIFY-REGION-FUNCTION INHIBIT-THING-LOCK)
+Currently, appropriate variables include `font-lock-mark-block-function'.
+If this is non-nil, it should be a function with no args used to mark any
+enclosing block of text, for fontification via \\[font-lock-fontify-block].
+Typical values are `mark-defun' for programming modes or `mark-paragraph' for
+textual modes (i.e., the mode-dependent function is known to put point and mark
+around a text block relevant to that mode).
-where the first four elements are function names used to set the variables
+Other variables include those for buffer-specialised fontification functions,
`font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function',
-`font-lock-fontify-region-function' and `font-lock-unfontify-region-function'.
-INHIBIT-THING-LOCK is a list of mode names whose modes should not be turned on.
-It is used to set the variable `font-lock-inhibit-thing-lock'.")
+`font-lock-fontify-region-function', `font-lock-unfontify-region-function' and
+`font-lock-inhibit-thing-lock'.")
(defvar font-lock-keywords-only nil
"*Non-nil means Font Lock should not fontify comments or strings.
;; `font-lock-cache-position' and `font-lock-cache-state'.
(defvar font-lock-beginning-of-syntax-function nil
"*Non-nil means use this function to move back outside of a syntactic block.
+When called with no args it should leave point at the beginning of any
+enclosing syntactic block.
If this is nil, the beginning of the buffer is used (in the worst case).
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.
+When called with no args it should leave point at the beginning of any
+enclosing textual block and mark at the end.
+This is normally set via `font-lock-defaults'.")
+
(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'.")
Currently, valid mode names as `fast-lock-mode' and `lazy-lock-mode'.
This is normally set via `font-lock-defaults'.")
-;; These record the parse state at a particular position, always the start of a
-;; line. Used to make `font-lock-fontify-syntactically-region' faster.
-(defvar font-lock-cache-position nil)
-(defvar font-lock-cache-state nil)
-(make-variable-buffer-local 'font-lock-cache-position)
-(make-variable-buffer-local 'font-lock-cache-state)
-
(defvar font-lock-mode nil) ; For the modeline.
(defvar font-lock-fontified nil) ; Whether we have fontified the buffer.
(put 'font-lock-fontified 'permanent-local t)
(add-hook 'c-mode-hook 'turn-on-font-lock)
-Or for any visited file with the following in your ~/.emacs:
-
- (add-hook 'find-file-hooks 'turn-on-font-lock)
-
Alternatively, you can use Global Font Lock mode to automagically turn on Font
Lock mode in buffers whose major mode supports it, or in buffers whose major
mode is one of `font-lock-global-modes'. For example, put in your ~/.emacs:
To fontify a buffer, without turning on Font Lock mode and regardless of buffer
size, you can use \\[font-lock-fontify-buffer].
-To fontify a window, perhaps because modification on the current line caused
-syntactic change on other lines, you can use \\[font-lock-fontify-window]."
+
+To fontify a block (the function or paragraph containing point, or a number of
+lines around point), perhaps because modification on the current line caused
+syntactic change on other lines, you can use \\[font-lock-fontify-block]."
(interactive "P")
;; Don't turn on Font Lock mode if we don't have a display (we're running a
;; batch job) or if the buffer is invisible (the name starts with a space).
- (let ((on-p (and (not noninteractive)
+ (let ((maximum-size (font-lock-value-in-major-mode font-lock-maximum-size))
+ (on-p (and (not noninteractive)
(not (eq (aref (buffer-name) 0) ?\ ))
(if arg
(> (prefix-numeric-value arg) 0)
- (not font-lock-mode))))
- (maximum-size (if (not (consp font-lock-maximum-size))
- font-lock-maximum-size
- (cdr (or (assq major-mode font-lock-maximum-size)
- (assq t font-lock-maximum-size))))))
+ (not font-lock-mode)))))
(if (not on-p)
(remove-hook 'after-change-functions 'font-lock-after-change-function
t)
;;;###autoload
(defun turn-on-font-lock ()
- "Turn on Font Lock mode, if the terminal can display it."
- (if window-system (font-lock-mode t)))
+ "Turn on Font Lock mode conditionally.
+Turn on only if the buffer mode supports it and the terminal can display it."
+ (if (and window-system
+ (not font-lock-mode)
+ (or font-lock-defaults (assq major-mode font-lock-defaults-alist)))
+ (font-lock-mode t)))
\f
;; Code for Global Font Lock mode.
;; hook is run, the major mode is in the process of being changed and we do not
;; know what the final major mode will be. So, `font-lock-change-major-mode'
;; only (a) notes the name of the current buffer, and (b) adds our function
-;; `turn-on-font-lock-if-supported' to the hook variable `post-command-hook'.
+;; `turn-on-font-lock-if-enabled' to the hook variable `post-command-hook'.
;; By the time the functions on `post-command-hook' are run, the new major mode
;; is assumed to be in place.
;; `major-mode-hook' is simpler), but maybe someone can come up with another
;; solution? --sm.
+(defvar font-lock-buffers nil) ; For remembering buffers.
+(defvar change-major-mode-hook nil) ; Make sure it's not void.
+
;;;###autoload
(defvar font-lock-global-modes t
- "*List of modes for which Font Lock mode is automatically turned on.
+ "*Modes for which Font Lock mode is automatically turned on.
Global Font Lock mode is controlled by the `global-font-lock-mode' command.
If nil, means no modes have Font Lock mode automatically turned on.
If t, all modes that support Font Lock mode have it automatically turned on.
is in this list. The sense of the list is negated if it begins with `not'.")
;;;###autoload
-(defun global-font-lock-mode (&optional arg)
+(defun global-font-lock-mode (&optional arg message)
"Toggle Global Font Lock mode.
-With arg, turn Global Font Lock mode on if and only if arg is positive.
+With prefix ARG, turn Global Font Lock mode on if and only if ARG is positive.
+Displays a message saying whether the mode is on or off if MESSAGE is non-nil.
+Returns the new status of Global Font Lock mode (non-nil means on).
When Global Font Lock mode is enabled, Font Lock mode is automagically
turned on in a buffer if its major mode is one of `font-lock-global-modes'."
- (interactive "P")
- (if (if arg
- (<= (prefix-numeric-value arg) 0)
- (memq 'font-lock-change-major-mode change-major-mode-hook))
- (remove-hook 'change-major-mode-hook 'font-lock-change-major-mode)
- (add-hook 'change-major-mode-hook 'font-lock-change-major-mode)
- (add-hook 'post-command-hook 'turn-on-font-lock-if-supported)
- (setq font-lock-cache-buffers (buffer-list))))
-
-(defvar font-lock-cache-buffers nil) ; For remembering buffers.
-(defvar change-major-mode-hook nil) ; Make sure it's not void.
+ (interactive "P\np")
+ (let ((off-p (if arg
+ (<= (prefix-numeric-value arg) 0)
+ (memq 'font-lock-change-major-mode change-major-mode-hook))))
+ (if off-p
+ (remove-hook 'change-major-mode-hook 'font-lock-change-major-mode)
+ (add-hook 'change-major-mode-hook 'font-lock-change-major-mode)
+ (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled)
+ (setq font-lock-buffers (buffer-list)))
+ (if message
+ (message "Global Font Lock mode is now %s." (if off-p "OFF" "ON")))
+ (not off-p)))
(defun font-lock-change-major-mode ()
;; Gross hack warning: Delicate readers should avert eyes now.
- ;; Something is running `kill-all-local-variables', which generally means
- ;; the major mode is being changed. Run `turn-on-font-lock-if-supported'
- ;; after the current command has finished.
- (add-hook 'post-command-hook 'turn-on-font-lock-if-supported)
- (add-to-list 'font-lock-cache-buffers (current-buffer)))
+ ;; Something is running `kill-all-local-variables', which generally means the
+ ;; major mode is being changed. Run `turn-on-font-lock-if-enabled' after the
+ ;; current command has finished.
+ (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled)
+ (add-to-list 'font-lock-buffers (current-buffer)))
-(defun turn-on-font-lock-if-supported ()
+(defun turn-on-font-lock-if-enabled ()
;; Gross hack warning: Delicate readers should avert eyes now.
- ;; Turn on Font Lock mode if (a) it's not already on, (b) the major mode
- ;; supports Font Lock mode, and (c) it's one of `font-lock-global-modes'.
- (remove-hook 'post-command-hook 'turn-on-font-lock-if-supported)
- (while font-lock-cache-buffers
- (if (buffer-name (car font-lock-cache-buffers))
+ ;; Turn on Font Lock mode if it's one of `font-lock-global-modes'.
+ (remove-hook 'post-command-hook 'turn-on-font-lock-if-enabled)
+ (while font-lock-buffers
+ (if (buffer-live-p (car font-lock-buffers))
(save-excursion
- (set-buffer (car font-lock-cache-buffers))
- (if (and (not font-lock-mode)
- (or font-lock-defaults
- (assq major-mode font-lock-defaults-alist))
- (or (eq font-lock-global-modes t)
- (if (eq (car-safe font-lock-global-modes) 'not)
- (not (memq major-mode (cdr font-lock-global-modes)))
- (memq major-mode font-lock-global-modes))))
- (turn-on-font-lock))))
- (setq font-lock-cache-buffers (cdr font-lock-cache-buffers))))
+ (set-buffer (car font-lock-buffers))
+ (if (or (eq font-lock-global-modes t)
+ (if (eq (car-safe font-lock-global-modes) 'not)
+ (not (memq major-mode (cdr font-lock-global-modes)))
+ (memq major-mode font-lock-global-modes)))
+ (let (inhibit-quit)
+ (turn-on-font-lock)))))
+ (setq font-lock-buffers (cdr font-lock-buffers))))
;; End of Global Font Lock mode.
\f
(condition-case nil
(save-excursion
(save-match-data
- (setq font-lock-fontified nil)
(font-lock-fontify-region (point-min) (point-max) verbose)
(font-lock-after-fontify-buffer)
(setq font-lock-fontified t)))
;; We don't restore the old fontification, so it's best to unfontify.
- (quit (font-lock-unfontify-region (point-min) (point-max))))
- (if verbose (message "Fontifying %s... %s." (buffer-name)
- (if font-lock-fontified "done" "aborted"))))))
+ (quit (font-lock-unfontify-buffer))))
+ (if verbose (message "Fontifying %s... %s." (buffer-name)
+ (if font-lock-fontified "done" "aborted")))))
(defun font-lock-default-unfontify-buffer ()
(save-restriction
before-change-functions after-change-functions
buffer-file-name buffer-file-truename)
(unwind-protect
- (progn
+ (save-restriction
+ (widen)
;; Use the fontification syntax table, if any.
(if font-lock-syntax-table (set-syntax-table font-lock-syntax-table))
;; Now do the fontification.
(progn (goto-char beg) (beginning-of-line) (point))
(progn (goto-char end) (forward-line 1) (point))))))
-(defun font-lock-fontify-window ()
- "Fontify the current window the way `font-lock-mode' would."
- (interactive)
- (let ((font-lock-beginning-of-syntax-function nil))
+(defun font-lock-fontify-block (&optional arg)
+ "Fontify some lines the way `font-lock-fontify-buffer' would.
+The lines could be a function or paragraph, or a specified number of lines.
+If ARG is given, fontify that many lines before and after point, or 16 lines if
+no ARG is given and `font-lock-mark-block-function' is nil.
+If `font-lock-mark-block-function' non-nil and no ARG is given, it is used to
+delimit the region to fontify."
+ (interactive "P")
+ (let (font-lock-beginning-of-syntax-function deactivate-mark)
+ ;; Make sure we have the right `font-lock-keywords' etc.
+ (if (not font-lock-mode) (font-lock-set-defaults))
(save-excursion
(save-match-data
(condition-case error-data
- (font-lock-fontify-region (window-start) (window-end))
- (error (message "Fontifying window... %s" error-data)))))))
-
-(define-key ctl-x-map "w" 'font-lock-fontify-window)
+ (if (or arg (not font-lock-mark-block-function))
+ (let ((lines (if arg (prefix-numeric-value arg) 16)))
+ (font-lock-fontify-region
+ (save-excursion (forward-line (- lines)) (point))
+ (save-excursion (forward-line lines) (point))))
+ (funcall font-lock-mark-block-function)
+ (font-lock-fontify-region (point) (mark)))
+ ((error quit) (message "Fontifying block... %s" error-data)))))))
+
+(define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)
\f
;; Syntactic fontification functions.
+;; These record the parse state at a particular position, always the start of a
+;; line. Used to make `font-lock-fontify-syntactically-region' faster.
+(defvar font-lock-cache-position nil)
+(defvar font-lock-cache-state nil)
+(make-variable-buffer-local 'font-lock-cache-position)
+(make-variable-buffer-local 'font-lock-cache-state)
+
(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."
"\\s<"))
state prev prevstate)
(if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
- (save-restriction
- (widen)
- (goto-char start)
- ;;
- ;; Find the state at the `beginning-of-line' before `start'.
- (if (eq start font-lock-cache-position)
- ;; Use the cache for the state of `start'.
- (setq state font-lock-cache-state)
- ;; Find the state of `start'.
- (if (null font-lock-beginning-of-syntax-function)
- ;; Use the state at the previous cache position, if any, or
- ;; otherwise calculate from `point-min'.
- (if (or (null font-lock-cache-position)
- (< start font-lock-cache-position))
- (setq state (parse-partial-sexp (point-min) start))
- (setq state (parse-partial-sexp font-lock-cache-position start
- nil nil font-lock-cache-state)))
- ;; Call the function to move outside any syntactic block.
- (funcall font-lock-beginning-of-syntax-function)
- (setq state (parse-partial-sexp (point) start)))
- ;; Cache the state and position of `start'.
- (setq font-lock-cache-state state
- font-lock-cache-position start))
- ;;
- ;; If the region starts inside a string, show the extent of it.
- (if (nth 3 state)
- (let ((beg (point)))
- (while (and (re-search-forward "\\s\"" end 'move)
- (nth 3 (parse-partial-sexp beg (point)
- nil nil state))))
- (put-text-property beg (point) 'face font-lock-string-face)
- (setq state (parse-partial-sexp beg (point) nil nil state))))
- ;;
- ;; Likewise for a comment.
- (if (or (nth 4 state) (nth 7 state))
- (let ((beg (point)))
- (save-restriction
- (narrow-to-region (point-min) end)
- (condition-case nil
- (progn
- (re-search-backward comstart (point-min) 'move)
- (forward-comment 1)
- ;; forward-comment skips all whitespace,
- ;; so go back to the real end of the comment.
- (skip-chars-backward " \t"))
- (error (goto-char end))))
- (put-text-property beg (point) 'face font-lock-comment-face)
- (setq state (parse-partial-sexp beg (point) nil nil state))))
- ;;
- ;; Find each interesting place between here and `end'.
- (while (and (< (point) end)
- (setq prev (point) prevstate state)
- (re-search-forward synstart end t)
- (progn
- ;; Clear out the fonts of what we skip over.
- (remove-text-properties prev (point) '(face nil))
- ;; Verify the state at that place
- ;; so we don't get fooled by \" or \;.
- (setq state (parse-partial-sexp prev (point)
- nil nil state))))
- (let ((here (point)))
- (if (or (nth 4 state) (nth 7 state))
+ (goto-char start)
+ ;;
+ ;; Find the state at the `beginning-of-line' before `start'.
+ (if (eq start font-lock-cache-position)
+ ;; Use the cache for the state of `start'.
+ (setq state font-lock-cache-state)
+ ;; Find the state of `start'.
+ (if (null font-lock-beginning-of-syntax-function)
+ ;; Use the state at the previous cache position, if any, or
+ ;; otherwise calculate from `point-min'.
+ (if (or (null font-lock-cache-position)
+ (< start font-lock-cache-position))
+ (setq state (parse-partial-sexp (point-min) start))
+ (setq state (parse-partial-sexp font-lock-cache-position start
+ nil nil font-lock-cache-state)))
+ ;; Call the function to move outside any syntactic block.
+ (funcall font-lock-beginning-of-syntax-function)
+ (setq state (parse-partial-sexp (point) start)))
+ ;; Cache the state and position of `start'.
+ (setq font-lock-cache-state state
+ font-lock-cache-position start))
+ ;;
+ ;; If the region starts inside a string, show the extent of it.
+ (if (nth 3 state)
+ (let ((beg (point)))
+ (while (and (re-search-forward "\\s\"" end 'move)
+ (nth 3 (parse-partial-sexp beg (point) nil nil state))))
+ (put-text-property beg (point) 'face font-lock-string-face)
+ (setq state (parse-partial-sexp beg (point) nil nil state))))
+ ;;
+ ;; Likewise for a comment.
+ (if (or (nth 4 state) (nth 7 state))
+ (let ((beg (point)))
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (condition-case nil
+ (progn
+ (re-search-backward comstart (point-min) 'move)
+ (forward-comment 1)
+ ;; forward-comment skips all whitespace,
+ ;; so go back to the real end of the comment.
+ (skip-chars-backward " \t"))
+ (error (goto-char end))))
+ (put-text-property beg (point) 'face font-lock-comment-face)
+ (setq state (parse-partial-sexp beg (point) nil nil state))))
+ ;;
+ ;; Find each interesting place between here and `end'.
+ (while (and (< (point) end)
+ (setq prev (point) prevstate state)
+ (re-search-forward synstart end t)
+ (progn
+ ;; Clear out the fonts of what we skip over.
+ (remove-text-properties prev (point) '(face nil))
+ ;; Verify the state at that place
+ ;; so we don't get fooled by \" or \;.
+ (setq state (parse-partial-sexp prev (point)
+ nil nil state))))
+ (let ((here (point)))
+ (if (or (nth 4 state) (nth 7 state))
+ ;;
+ ;; We found a real comment start.
+ (let ((beg (match-beginning 0)))
+ (goto-char beg)
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (condition-case nil
+ (progn
+ (forward-comment 1)
+ ;; forward-comment skips all whitespace,
+ ;; so go back to the real end of the comment.
+ (skip-chars-backward " \t"))
+ (error (goto-char end))))
+ (put-text-property beg (point) 'face font-lock-comment-face)
+ (setq state (parse-partial-sexp here (point) nil nil state)))
+ (if (nth 3 state)
;;
- ;; We found a real comment start.
+ ;; We found a real string start.
(let ((beg (match-beginning 0)))
- (goto-char beg)
- (save-restriction
- (narrow-to-region (point-min) end)
- (condition-case nil
- (progn
- (forward-comment 1)
- ;; forward-comment skips all whitespace,
- ;; so go back to the real end of the comment.
- (skip-chars-backward " \t"))
- (error (goto-char end))))
- (put-text-property beg (point) 'face font-lock-comment-face)
- (setq state (parse-partial-sexp here (point) nil nil state)))
- (if (nth 3 state)
- ;;
- ;; We found a real string start.
- (let ((beg (match-beginning 0)))
- (while (and (re-search-forward "\\s\"" end 'move)
- (nth 3 (parse-partial-sexp here (point)
- nil nil state))))
- (put-text-property beg (point) 'face font-lock-string-face)
- (setq state (parse-partial-sexp here (point)
- nil nil state))))))
- ;;
- ;; Make sure `prev' is non-nil after the loop
- ;; only if it was set on the very last iteration.
- (setq prev nil)))
+ (while (and (re-search-forward "\\s\"" end 'move)
+ (nth 3 (parse-partial-sexp here (point)
+ nil nil state))))
+ (put-text-property beg (point) 'face font-lock-string-face)
+ (setq state (parse-partial-sexp here (point)
+ nil nil state))))))
+ ;;
+ ;; Make sure `prev' is non-nil after the loop
+ ;; only if it was set on the very last iteration.
+ (setq prev nil))
;;
;; Clean up.
(and prev (remove-text-properties prev end '(face nil)))))
(t ; Hopefully (MATCHER HIGHLIGHT ...)
keyword)))
+(defun font-lock-value-in-major-mode (alist)
+ ;; Return value in ALIST for `major-mode', or ALIST if it is not an alist.
+ ;; Alist structure is ((MAJOR-MODE . VALUE)) where MAJOR-MODE may be t.
+ (if (consp alist)
+ (cdr (or (assq major-mode alist) (assq t alist)))
+ alist))
+
(defun font-lock-choose-keywords (keywords level)
;; Return LEVELth element of KEYWORDS. A LEVEL of nil is equal to a
;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
- (let ((level (if (not (consp level))
- level
- (cdr (or (assq major-mode level) (assq t level))))))
- (cond ((symbolp keywords)
- keywords)
- ((numberp level)
- (or (nth level keywords) (car (reverse keywords))))
- ((eq level t)
- (car (reverse keywords)))
- (t
- (car keywords)))))
+ (cond ((symbolp keywords)
+ keywords)
+ ((numberp level)
+ (or (nth level keywords) (car (reverse keywords))))
+ ((eq level t)
+ (car (reverse keywords)))
+ (t
+ (car keywords))))
(defun font-lock-set-defaults ()
"Set fontification defaults appropriately for this mode.
(font-lock-make-faces)
;; Set fontification defaults.
(make-local-variable 'font-lock-fontified)
- (if font-lock-keywords
- nil
- (let* ((defaults (or font-lock-defaults
- (cdr (assq major-mode font-lock-defaults-alist))))
- (keywords (font-lock-choose-keywords
- (nth 0 defaults) font-lock-maximum-decoration)))
- ;; Regexp fontification?
- (setq font-lock-keywords (if (fboundp keywords)
- (funcall keywords)
- (eval keywords)))
- ;; Syntactic fontification?
- (if (nth 1 defaults)
- (set (make-local-variable 'font-lock-keywords-only) t))
- ;; Case fold during regexp fontification?
- (if (nth 2 defaults)
- (set (make-local-variable 'font-lock-keywords-case-fold-search) t))
- ;; Syntax table for regexp and syntactic fontification?
- (if (nth 3 defaults)
- (let ((slist (nth 3 defaults)))
- (set (make-local-variable 'font-lock-syntax-table)
- (copy-syntax-table (syntax-table)))
- (while slist
- (modify-syntax-entry (car (car slist)) (cdr (car slist))
- font-lock-syntax-table)
- (setq slist (cdr slist)))))
- ;; Syntax function for syntactic fontification?
- (if (nth 4 defaults)
- (set (make-local-variable 'font-lock-beginning-of-syntax-function)
- (nth 4 defaults)))
- ;; Local fontification?
- (if (nth 5 defaults)
- (let ((local (nth 5 defaults)))
- (if (nth 0 local)
- (set (make-local-variable 'font-lock-fontify-buffer-function)
- (nth 0 local)))
- (if (nth 1 local)
- (set (make-local-variable 'font-lock-unfontify-buffer-function)
- (nth 1 local)))
- (if (nth 2 local)
- (set (make-local-variable 'font-lock-fontify-region-function)
- (nth 2 local)))
- (if (nth 3 local)
- (set (make-local-variable 'font-lock-unfontify-region-function)
- (nth 3 local)))
- (if (nth 4 local)
- (set (make-local-variable 'font-lock-inhibit-thing-lock)
- (nth 4 local)))
- )))))
+ (if (member font-lock-keywords '(nil (t)))
+ (let* ((defaults (or font-lock-defaults
+ (cdr (assq major-mode font-lock-defaults-alist))))
+ (keywords
+ (font-lock-choose-keywords (nth 0 defaults)
+ (font-lock-value-in-major-mode font-lock-maximum-decoration))))
+ ;; Regexp fontification?
+ (setq font-lock-keywords (if (fboundp keywords)
+ (funcall keywords)
+ (eval keywords)))
+ ;; Syntactic fontification?
+ (if (nth 1 defaults)
+ (set (make-local-variable 'font-lock-keywords-only) t))
+ ;; Case fold during regexp fontification?
+ (if (nth 2 defaults)
+ (set (make-local-variable 'font-lock-keywords-case-fold-search) t))
+ ;; Syntax table for regexp and syntactic fontification?
+ (if (nth 3 defaults)
+ (let ((slist (nth 3 defaults)))
+ (set (make-local-variable 'font-lock-syntax-table)
+ (copy-syntax-table (syntax-table)))
+ (while slist
+ (modify-syntax-entry (car (car slist)) (cdr (car slist))
+ font-lock-syntax-table)
+ (setq slist (cdr slist)))))
+ ;; Syntax function for syntactic fontification?
+ (if (nth 4 defaults)
+ (set (make-local-variable 'font-lock-beginning-of-syntax-function)
+ (nth 4 defaults)))
+ ;; Variable alist?
+ (let ((alist (nthcdr 5 defaults)))
+ (while alist
+ (set (make-local-variable (car (car alist))) (cdr (car alist)))
+ (setq alist (cdr alist)))))))
(defun font-lock-unset-defaults ()
"Unset fontification defaults. See `font-lock-set-defaults'."
font-lock-keywords-only nil
font-lock-keywords-case-fold-search nil
font-lock-syntax-table nil
- font-lock-beginning-of-syntax-function nil
- font-lock-fontify-buffer-function
- (default-value 'font-lock-fontify-buffer-function)
- font-lock-unfontify-buffer-function
- (default-value 'font-lock-unfontify-buffer-function)
- font-lock-fontify-region-function
- (default-value 'font-lock-fontify-region-function)
- font-lock-unfontify-region-function
- (default-value 'font-lock-unfontify-region-function)
- font-lock-inhibit-thing-lock nil))
+ font-lock-beginning-of-syntax-function nil)
+ (let* ((defaults (or font-lock-defaults
+ (cdr (assq major-mode font-lock-defaults-alist))))
+ (alist (nthcdr 5 defaults)))
+ (while alist
+ (set (car (car alist)) (default-value (car (car alist))))
+ (setq alist (cdr alist)))))
\f
;; Colour etc. support.
+;; This section of code is crying out for revision.
+
+;; To begin with, `display-type' and `background-mode' are `frame-parameters'
+;; so we don't have to calculate them here anymore. But all the face stuff
+;; should be frame-local (and thus display-local) anyway. Because we're not
+;; sure what support Emacs is going to have for general frame-local face
+;; attributes, we leave this section of code as it is. For now. --sm.
+
(defvar font-lock-display-type nil
"A symbol indicating the display Emacs is running under.
The symbol should be one of `color', `grayscale' or `mono'.
; "save-selected-window" "save-match-data" "unwind-protect"
; "condition-case" "track-mouse"
; "eval-after-load" "eval-and-compile" "eval-when-compile"
-; "when" "unless" "do" "flet" "labels" "return" "return-from"))
+; "when" "unless" "do" "flet" "labels" "return" "return-from"
+; "with-output-to-temp-buffer" "with-timeout"))
(cons
(concat
"(\\("
- "\\(c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|do\\|"
+ "c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|do\\|"
"eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|flet\\|"
"i\\(f\\|nline\\)\\|l\\(abels\\|et\\*?\\)\\|prog[nv12*]?\\|"
- "return\\(\\|-from\\)\\|"
- "save-\\(excursion\\|match-data\\|restriction\\|selected-window\\|"
- "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|"
- "un\\(less\\|wind-protect\\)\\|wh\\(en\\|ile\\)\\)"
+ "return\\(\\|-from\\)\\|save-\\(excursion\\|match-data\\|restriction\\|"
+ "selected-window\\|window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|"
+ "un\\(less\\|wind-protect\\)\\|"
+ "w\\(h\\(en\\|ile\\)\\|ith-\\(output-to-temp-buffer\\|timeout\\)\\)"
"\\)\\>") 1)
;;
;; Feature symbols as references.
'("\\<:\\sw+\\>" 0 font-lock-reference-face prepend)
;;
;; ELisp and CLisp `&' keywords as types.
- '("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face)
+ '("\\<\\&\\sw+\\>" . font-lock-type-face)
))
"Gaudy level highlighting for Lisp modes.")