-;;; jit-lock.el --- just-in-time fontification.
+;;; jit-lock.el --- just-in-time fontification
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Keywords: faces files
-;; Version: 1.0
;; This file is part of GNU Emacs.
;;; Code:
-(require 'font-lock)
-
(eval-when-compile
- (defmacro with-buffer-prepared-for-font-lock (&rest body)
+ (defmacro with-buffer-unmodified (&rest body)
+ "Eval BODY, preserving the current buffer's modified state."
+ (let ((modified (make-symbol "modified")))
+ `(let ((,modified (buffer-modified-p)))
+ (unwind-protect
+ (progn ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil))))))
+
+ (defmacro with-buffer-prepared-for-jit-lock (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
- `(let ((modified (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- before-change-functions
- after-change-functions
- deactivate-mark
- buffer-file-name
- buffer-file-truename)
- ,@body
- ;; Calling set-buffer-modified causes redisplay to consider
- ;; all windows because that function sets update_mode_lines.
- (set-buffer-modified-p modified))))
-
+ `(with-buffer-unmodified
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)
+ ,@body))))
+
\f
;;; Customization.
(defcustom jit-lock-chunk-size 500
- "*Font-lock chunks of this many characters, or smaller."
+ "*Jit-lock chunks of this many characters, or smaller."
:type 'integer
:group 'jit-lock)
(defcustom jit-lock-stealth-time 3
"*Time in seconds to wait before beginning stealth fontification.
Stealth fontification occurs if there is no input within this time.
-If nil, means stealth fontification is never performed.
+If nil, stealth fontification is never performed.
The value of this variable is used when JIT Lock mode is turned on."
:type '(choice (const :tag "never" nil)
taking longer to fontify, you could increase the value of this variable.
See also `jit-lock-stealth-load'."
:type '(choice (const :tag "never" nil)
- (number :tag "seconds"))
+ (number :tag "seconds"))
:group 'jit-lock)
-
+
(defcustom jit-lock-stealth-load
(if (condition-case nil (load-average) (error)) 200)
(other :tag "syntax-driven" syntax-driven))
:group 'jit-lock)
-
+(defcustom jit-lock-defer-time nil ;; 0.25
+ "Idle time after which deferred fontification should take place.
+If nil, fontification is not deferred."
+ :group 'jit-lock
+ :type '(choice (const :tag "never" nil)
+ (number :tag "seconds")))
\f
;;; Variables that are not customizable.
"Non-nil means Just-in-time Lock mode is active.")
(make-variable-buffer-local 'jit-lock-mode)
+(defvar jit-lock-functions nil
+ "Functions to do the actual fontification.
+They are called with two arguments: the START and END of the region to fontify.")
+(make-variable-buffer-local 'jit-lock-functions)
(defvar jit-lock-first-unfontify-pos nil
- "Consider text after this position as unfontified.")
+ "Consider text after this position as contextually unfontified.
+If nil, contextual fontification is disabled.")
(make-variable-buffer-local 'jit-lock-first-unfontify-pos)
(defvar jit-lock-stealth-timer nil
"Timer for stealth fontification in Just-in-time Lock mode.")
+(defvar jit-lock-defer-timer nil
+ "Timer for deferred fontification in Just-in-time Lock mode.")
+(defvar jit-lock-buffers nil
+ "List of buffers with pending deferred fontification.")
\f
;;; JIT lock mode
-;;;###autoload
(defun jit-lock-mode (arg)
"Toggle Just-in-time Lock mode.
-With arg, turn Just-in-time Lock mode on if and only if arg is positive.
+Turn Just-in-time Lock mode on if and only if ARG is non-nil.
Enable it automatically by customizing group `font-lock'.
When Just-in-time Lock mode is enabled, fontification is different in the
Stealth fontification only occurs while the system remains unloaded.
If the system load rises above `jit-lock-stealth-load' percent, stealth
fontification is suspended. Stealth fontification intensity is controlled via
-the variable `jit-lock-stealth-nice' and `jit-lock-stealth-lines'."
- (interactive "P")
- (setq jit-lock-mode (if arg
- (> (prefix-numeric-value arg) 0)
- (not jit-lock-mode)))
- (cond ((and jit-lock-mode
- (or (not (boundp 'font-lock-mode))
- (not font-lock-mode)))
- ;; If font-lock is not on, turn it on, with Just-in-time
- ;; Lock mode as support mode; font-lock will call us again.
- (let ((font-lock-support-mode 'jit-lock-mode))
- (font-lock-mode t)))
-
- ;; Turn Just-in-time Lock mode on.
- (jit-lock-mode
- ;; Setting `font-lock-fontified' makes font-lock believe the
- ;; buffer is already fontified, so that it won't highlight
- ;; the whole buffer.
- (make-local-variable 'font-lock-fontified)
- (setq font-lock-fontified t)
-
- (setq jit-lock-first-unfontify-pos nil)
-
+the variable `jit-lock-stealth-nice'."
+ (setq jit-lock-mode arg)
+ (cond (;; Turn Just-in-time Lock mode on.
+ jit-lock-mode
+
+ ;; Mark the buffer for refontification.
+ (jit-lock-refontify)
+
;; Install an idle timer for stealth fontification.
- (when (and jit-lock-stealth-time
- (null jit-lock-stealth-timer))
- (setq jit-lock-stealth-timer
- (run-with-idle-timer jit-lock-stealth-time
- jit-lock-stealth-time
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
+ (setq jit-lock-stealth-timer
+ (run-with-idle-timer jit-lock-stealth-time t
'jit-lock-stealth-fontify)))
- ;; Add a hook for deferred contectual fontification.
- (when (or (eq jit-lock-defer-contextually 'always)
- (and (not (eq jit-lock-defer-contextually 'never))
- (null font-lock-keywords-only)))
- (add-hook 'after-change-functions 'jit-lock-after-change))
-
- ;; Install the fontification hook.
+ ;; Init deferred fontification timer.
+ (when (and jit-lock-defer-time (null jit-lock-defer-timer))
+ (setq jit-lock-defer-timer
+ (run-with-idle-timer jit-lock-defer-time t
+ 'jit-lock-deferred-fontify)))
+
+ ;; Initialize deferred contextual fontification if requested.
+ (when (eq jit-lock-defer-contextually t)
+ (setq jit-lock-first-unfontify-pos
+ (or jit-lock-first-unfontify-pos (point-max))))
+
+ ;; Setup our hooks.
+ (add-hook 'after-change-functions 'jit-lock-after-change nil t)
(add-hook 'fontification-functions 'jit-lock-function))
;; Turn Just-in-time Lock mode off.
(t
- ;; Cancel our idle timer.
- (when jit-lock-stealth-timer
- (cancel-timer jit-lock-stealth-timer)
- (setq jit-lock-stealth-timer nil))
+ ;; Cancel our idle timers.
+ (when (and (or jit-lock-stealth-timer jit-lock-defer-timer)
+ ;; Only if there's no other buffer using them.
+ (not (catch 'found
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when jit-lock-mode (throw 'found t)))))))
+ (when jit-lock-stealth-timer
+ (cancel-timer jit-lock-stealth-timer)
+ (setq jit-lock-stealth-timer nil))
+ (when jit-lock-defer-timer
+ (cancel-timer jit-lock-defer-timer)
+ (setq jit-lock-defer-timer nil)))
;; Remove hooks.
- (remove-hook 'after-change-functions 'jit-lock-after-change)
+ (remove-hook 'after-change-functions 'jit-lock-after-change t)
(remove-hook 'fontification-functions 'jit-lock-function))))
-
;;;###autoload
-(defun turn-on-jit-lock ()
- "Unconditionally turn on Just-in-time Lock mode."
- (jit-lock-mode 1))
-
-
+(defun jit-lock-register (fun &optional contextual)
+ "Register FUN as a fontification function to be called in this buffer.
+FUN will be called with two arguments START and END indicating the region
+that needs to be (re)fontified.
+If non-nil, CONTEXTUAL means that a contextual fontification would be useful."
+ (add-hook 'jit-lock-functions fun nil t)
+ (when (and contextual jit-lock-defer-contextually)
+ (set (make-local-variable 'jit-lock-defer-contextually) t))
+ (jit-lock-mode t))
+
+(defun jit-lock-unregister (fun)
+ "Unregister FUN as a fontification function.
+Only applies to the current buffer."
+ (remove-hook 'jit-lock-functions fun t)
+ (unless jit-lock-functions (jit-lock-mode nil)))
+
+;; This function is used to prevent font-lock-fontify-buffer from
+;; fontifying eagerly the whole buffer. This is important for
+;; things like CWarn mode which adds/removes a few keywords and
+;; does a refontify (which takes ages on large files).
+(defun jit-lock-refontify (&optional beg end)
+ "Force refontification of the region BEG..END (default whole buffer)."
+ (with-buffer-prepared-for-jit-lock
+ (save-restriction
+ (widen)
+ (put-text-property (or beg (point-min)) (or end (point-max))
+ 'fontified nil))))
\f
;;; On demand fontification.
This function is added to `fontification-functions' when `jit-lock-mode'
is active."
(when jit-lock-mode
- (with-buffer-prepared-for-font-lock
- (save-excursion
- (save-restriction
- (widen)
- (let ((end (min (point-max) (+ start jit-lock-chunk-size)))
- (parse-sexp-lookup-properties font-lock-syntactic-keywords)
- (font-lock-beginning-of-syntax-function nil)
- (old-syntax-table (syntax-table))
- next font-lock-start font-lock-end)
- (when font-lock-syntax-table
- (set-syntax-table font-lock-syntax-table))
- (save-match-data
- (condition-case error
- ;; Fontify chunks beginning at START. The end of a
- ;; chunk is either `end', or the start of a region
- ;; before `end' that has already been fontified.
- (while start
- ;; Determine the end of this chunk.
- (setq next (or (text-property-any start end 'fontified t)
- end))
-
- ;; Decide which range of text should be fontified.
- ;; The problem is that START and NEXT may be in the
- ;; middle of something matched by a font-lock regexp.
- ;; Until someone has a better idea, let's start
- ;; at the start of the line containing START and
- ;; stop at the start of the line following NEXT.
- (goto-char next)
- (setq font-lock-end (line-beginning-position 2))
- (goto-char start)
- (setq font-lock-start (line-beginning-position))
-
- ;; Fontify the chunk, and mark it as fontified.
- (font-lock-fontify-region font-lock-start font-lock-end nil)
- (add-text-properties start next '(fontified t))
-
- ;; Find the start of the next chunk, if any.
- (setq start (text-property-any next end 'fontified nil)))
-
- ((error quit)
- (message "Fontifying region...%s" error))))
-
- ;; Restore previous buffer settings.
- (set-syntax-table old-syntax-table)))))))
-
-
-(defun jit-lock-after-fontify-buffer ()
- "Mark the current buffer as fontified.
-Called from `font-lock-after-fontify-buffer."
- (with-buffer-prepared-for-font-lock
- (add-text-properties (point-min) (point-max) '(fontified t))))
-
-
-(defun jit-lock-after-unfontify-buffer ()
- "Mark the current buffer as unfontified.
-Called from `font-lock-after-fontify-buffer."
- (with-buffer-prepared-for-font-lock
- (remove-text-properties (point-min) (point-max) '(fontified nil))))
-
+ (if (null jit-lock-defer-time)
+ ;; No deferral.
+ (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
+ ;; Record the buffer for later fontification.
+ (unless (memq (current-buffer) jit-lock-buffers)
+ (push (current-buffer) jit-lock-buffers))
+ ;; Mark the area as defer-fontified so that the redisplay engine
+ ;; is happy and so that the idle timer can find the places to fontify.
+ (with-buffer-prepared-for-jit-lock
+ (put-text-property start
+ (next-single-property-change
+ start 'fontified nil
+ (min (point-max) (+ start jit-lock-chunk-size)))
+ 'fontified 'defer)))))
+
+(defun jit-lock-fontify-now (&optional start end)
+ "Fontify current buffer from START to END.
+Defaults to the whole buffer. END can be out of bounds."
+ (with-buffer-prepared-for-jit-lock
+ (save-excursion
+ (unless start (setq start (point-min)))
+ (setq end (if end (min end (point-max)) (point-max)))
+ ;; This did bind `font-lock-beginning-of-syntax-function' to
+ ;; nil at some point, for an unknown reason. Don't do this; it
+ ;; can make highlighting slow due to expensive calls to
+ ;; `parse-partial-sexp' in function
+ ;; `font-lock-fontify-syntactically-region'. Example: paging
+ ;; from the end of a buffer to its start, can do repeated
+ ;; `parse-partial-sexp' starting from `point-min', which can
+ ;; take a long time in a large buffer.
+ (let (next)
+ (save-match-data
+ ;; Fontify chunks beginning at START. The end of a
+ ;; chunk is either `end', or the start of a region
+ ;; before `end' that has already been fontified.
+ (while start
+ ;; Determine the end of this chunk.
+ (setq next (or (text-property-any start end 'fontified t)
+ end))
+
+ ;; Decide which range of text should be fontified.
+ ;; The problem is that START and NEXT may be in the
+ ;; middle of something matched by a font-lock regexp.
+ ;; Until someone has a better idea, let's start
+ ;; at the start of the line containing START and
+ ;; stop at the start of the line following NEXT.
+ (goto-char next) (setq next (line-beginning-position 2))
+ (goto-char start) (setq start (line-beginning-position))
+
+ ;; Fontify the chunk, and mark it as fontified.
+ ;; We mark it first, to make sure that we don't indefinitely
+ ;; re-execute this fontification if an error occurs.
+ (put-text-property start next 'fontified t)
+ (run-hook-with-args 'jit-lock-functions start next)
+
+ ;; Find the start of the next chunk, if any.
+ (setq start (text-property-any next end 'fontified nil))))))))
\f
;;; Stealth fontification.
nil
(save-restriction
(widen)
- (let* ((next (text-property-any around (point-max) 'fontified nil))
+ (let* ((next (text-property-not-all around (point-max) 'fontified t))
(prev (previous-single-property-change around 'fontified))
(prop (get-text-property (max (point-min) (1- around))
'fontified))
;; and the start of the buffer. If PROP is
;; non-nil, everything in front of AROUND is
;; fontified, otherwise nothing is fontified.
- (if prop
+ (if (eq prop t)
nil
(max (point-min)
(- around (/ jit-lock-chunk-size 2)))))
- (prop
+ ((eq prop t)
;; PREV is the start of a region of fontified
- ;; text containing AROUND. Start fontfifying a
+ ;; text containing AROUND. Start fontifying a
;; chunk size before the end of the unfontified
;; region in front of that.
(max (or (previous-single-property-change prev 'fontified)
((< (- around start) (- next around)) start)
(t next))))
result))))
-
+
(defun jit-lock-stealth-fontify ()
"Fontify buffers stealthily.
This functions is called after Emacs has been idle for
`jit-lock-stealth-time' seconds."
+ ;; I used to check `inhibit-read-only' here, but I can't remember why. -stef
(unless (or executing-kbd-macro
(window-minibuffer-p (selected-window)))
(let ((buffers (buffer-list))
(while (and buffers (not (input-pending-p)))
(let ((buffer (car buffers)))
(setq buffers (cdr buffers))
-
+
(with-current-buffer buffer
(when jit-lock-mode
;; This is funny. Calling sit-for with 3rd arg non-nil
(widen)
(when (and (>= jit-lock-first-unfontify-pos (point-min))
(< jit-lock-first-unfontify-pos (point-max)))
- (with-buffer-prepared-for-font-lock
- (put-text-property jit-lock-first-unfontify-pos
- (point-max) 'fontified nil))
- (setq jit-lock-first-unfontify-pos nil))))
-
+ ;; If we're in text that matches a complex multi-line
+ ;; font-lock pattern, make sure the whole text will be
+ ;; redisplayed eventually.
+ (when (get-text-property jit-lock-first-unfontify-pos
+ 'jit-lock-defer-multiline)
+ (setq jit-lock-first-unfontify-pos
+ (or (previous-single-property-change
+ jit-lock-first-unfontify-pos
+ 'jit-lock-defer-multiline)
+ (point-min))))
+ (with-buffer-prepared-for-jit-lock
+ (remove-text-properties
+ jit-lock-first-unfontify-pos (point-max)
+ '(fontified nil jit-lock-defer-multiline nil)))
+ (setq jit-lock-first-unfontify-pos (point-max)))))
+
+ ;; In the following code, the `sit-for' calls cause a
+ ;; redisplay, so it's required that the
+ ;; buffer-modified flag of a buffer that is displayed
+ ;; has the right value---otherwise the mode line of
+ ;; an unmodified buffer would show a `*'.
(let (start
(nice (or jit-lock-stealth-nice 0))
- (point (point)))
- (while (and (setq start (jit-lock-stealth-chunk-start point))
+ (point (point-min)))
+ (while (and (setq start
+ (jit-lock-stealth-chunk-start point))
(sit-for nice))
-
+
+ ;; fontify a block.
+ (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
+ ;; If stealth jit-locking is done backwards, this leads to
+ ;; excessive O(n^2) refontification. -stef
+ ;; (when (>= jit-lock-first-unfontify-pos start)
+ ;; (setq jit-lock-first-unfontify-pos end))
+
;; Wait a little if load is too high.
(when (and jit-lock-stealth-load
(> (car (load-average)) jit-lock-stealth-load))
- (sit-for (or jit-lock-stealth-time 30)))
-
- ;; Unless there's input pending now, fontify.
- (unless (input-pending-p)
- (jit-lock-function start))))))))))))
+ (sit-for (or jit-lock-stealth-time 30)))))))))))))
\f
;;; Deferred fontification.
+(defun jit-lock-deferred-fontify ()
+ "Fontify what was deferred."
+ (when jit-lock-buffers
+ ;; Mark the deferred regions back to `fontified = nil'
+ (dolist (buffer jit-lock-buffers)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ ;; (message "Jit-Defer %s" (buffer-name))
+ (with-buffer-prepared-for-jit-lock
+ (let ((pos (point-min)))
+ (while
+ (progn
+ (when (eq (get-text-property pos 'fontified) 'defer)
+ (put-text-property
+ pos (setq pos (next-single-property-change
+ pos 'fontified nil (point-max)))
+ 'fontified nil))
+ (setq pos (next-single-property-change pos 'fontified)))))))))
+ (setq jit-lock-buffers nil)
+ ;; Force fontification of the visible parts.
+ (let ((jit-lock-defer-time nil))
+ ;; (message "Jit-Defer Now")
+ (sit-for 0)
+ ;; (message "Jit-Defer Done")
+ )))
+
+
(defun jit-lock-after-change (start end old-len)
"Mark the rest of the buffer as not fontified after a change.
Installed on `after-change-functions'.
This function ensures that lines following the change will be refontified
in case the syntax of those lines has changed. Refontification
will take place when text is fontified stealthily."
- ;; Don't do much here---removing text properties is too slow for
- ;; fast typers, giving them the impression of Emacs not being
- ;; very responsive.
(when jit-lock-mode
- (setq jit-lock-first-unfontify-pos
- (if jit-lock-first-unfontify-pos
- (min jit-lock-first-unfontify-pos start)
- start))))
-
+ (save-excursion
+ (with-buffer-prepared-for-jit-lock
+ ;; It's important that the `fontified' property be set from the
+ ;; beginning of the line, else font-lock will properly change the
+ ;; text's face, but the display will have been done already and will
+ ;; be inconsistent with the buffer's content.
+ (goto-char start)
+ (setq start (line-beginning-position))
+
+ ;; If we're in text that matches a multi-line font-lock pattern,
+ ;; make sure the whole text will be redisplayed.
+ ;; I'm not sure this is ever necessary and/or sufficient. -stef
+ (when (get-text-property start 'font-lock-multiline)
+ (setq start (or (previous-single-property-change
+ start 'font-lock-multiline)
+ (point-min))))
+
+ ;; Make sure we change at least one char (in case of deletions).
+ (setq end (min (max end (1+ start)) (point-max)))
+ ;; Request refontification.
+ (put-text-property start end 'fontified nil))
+ ;; Mark the change for deferred contextual refontification.
+ (when jit-lock-first-unfontify-pos
+ (setq jit-lock-first-unfontify-pos
+ (min jit-lock-first-unfontify-pos start))))))
(provide 'jit-lock)
-;; jit-lock.el ends here
+;;; arch-tag: 56b5de6e-f581-453b-bb97-49c39372ff9e
+;;; jit-lock.el ends here
HCoop / bpt / emacs.git / blobdiff