1 ;;; jit-lock.el --- just-in-time fontification
3 ;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
6 ;; Author: Gerd Moellmann <gerd@gnu.org>
7 ;; Keywords: faces files
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 3, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; Just-in-time fontification, triggered by C redisplay code.
36 (defmacro with-buffer-unmodified
(&rest body
)
37 "Eval BODY, preserving the current buffer's modified state."
39 (let ((modified (make-symbol "modified")))
40 `(let ((,modified
(buffer-modified-p)))
44 (restore-buffer-modified-p nil
))))))
46 (defmacro with-buffer-prepared-for-jit-lock
(&rest body
)
47 "Execute BODY in current buffer, overriding several variables.
48 Preserves the `buffer-modified-p' state of the current buffer."
50 `(with-buffer-unmodified
51 (let ((buffer-undo-list t
)
53 (inhibit-point-motion-hooks t
)
54 (inhibit-modification-hooks t
)
64 (defgroup jit-lock nil
65 "Font Lock support mode to fontify just-in-time."
69 (defcustom jit-lock-chunk-size
500
70 "*Jit-lock fontifies chunks of at most this many characters at a time.
72 This variable controls both display-time and stealth fontification."
77 (defcustom jit-lock-stealth-time nil
78 "*Time in seconds to wait before beginning stealth fontification.
79 Stealth fontification occurs if there is no input within this time.
80 If nil, stealth fontification is never performed.
82 The value of this variable is used when JIT Lock mode is turned on."
83 :type
'(choice (const :tag
"never" nil
)
84 (number :tag
"seconds" :value
16))
88 (defcustom jit-lock-stealth-nice
0.5
89 "*Time in seconds to pause between chunks of stealth fontification.
90 Each iteration of stealth fontification is separated by this amount of time,
91 thus reducing the demand that stealth fontification makes on the system.
92 If nil, means stealth fontification is never paused.
93 To reduce machine load during stealth fontification, at the cost of stealth
94 taking longer to fontify, you could increase the value of this variable.
95 See also `jit-lock-stealth-load'."
96 :type
'(choice (const :tag
"never" nil
)
97 (number :tag
"seconds"))
101 (defcustom jit-lock-stealth-load
102 (if (condition-case nil
(load-average) (error)) 200)
103 "*Load in percentage above which stealth fontification is suspended.
104 Stealth fontification pauses when the system short-term load average (as
105 returned by the function `load-average' if supported) goes above this level,
106 thus reducing the demand that stealth fontification makes on the system.
107 If nil, means stealth fontification is never suspended.
108 To reduce machine load during stealth fontification, at the cost of stealth
109 taking longer to fontify, you could reduce the value of this variable.
110 See also `jit-lock-stealth-nice'."
111 :type
(if (condition-case nil
(load-average) (error))
112 '(choice (const :tag
"never" nil
)
113 (integer :tag
"load"))
114 '(const :format
"%t: unsupported\n" nil
))
118 (defcustom jit-lock-stealth-verbose nil
119 "*If non-nil, means stealth fontification should show status messages."
124 (defvaralias 'jit-lock-defer-contextually
'jit-lock-contextually
)
125 (defcustom jit-lock-contextually
'syntax-driven
126 "*If non-nil, means fontification should be syntactically true.
127 If nil, means fontification occurs only on those lines modified. This
128 means where modification on a line causes syntactic change on subsequent lines,
129 those subsequent lines are not refontified to reflect their new context.
130 If t, means fontification occurs on those lines modified and all
131 subsequent lines. This means those subsequent lines are refontified to reflect
132 their new syntactic context, after `jit-lock-context-time' seconds.
133 If any other value, e.g., `syntax-driven', means syntactically true
134 fontification occurs only if syntactic fontification is performed using the
135 buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
137 The value of this variable is used when JIT Lock mode is turned on."
138 :type
'(choice (const :tag
"never" nil
)
139 (const :tag
"always" t
)
140 (other :tag
"syntax-driven" syntax-driven
))
143 (defcustom jit-lock-context-time
0.5
144 "Idle time after which text is contextually refontified, if applicable."
145 :type
'(number :tag
"seconds")
148 (defcustom jit-lock-defer-time nil
;; 0.25
149 "Idle time after which deferred fontification should take place.
150 If nil, fontification is not deferred."
152 :type
'(choice (const :tag
"never" nil
)
153 (number :tag
"seconds")))
155 ;;; Variables that are not customizable.
157 (defvar jit-lock-mode nil
158 "Non-nil means Just-in-time Lock mode is active.")
159 (make-variable-buffer-local 'jit-lock-mode
)
161 (defvar jit-lock-functions nil
162 "Functions to do the actual fontification.
163 They are called with two arguments: the START and END of the region to fontify.")
164 (make-variable-buffer-local 'jit-lock-functions
)
166 (defvar jit-lock-context-unfontify-pos nil
167 "Consider text after this position as contextually unfontified.
168 If nil, contextual fontification is disabled.")
169 (make-variable-buffer-local 'jit-lock-context-unfontify-pos
)
172 (defvar jit-lock-stealth-timer nil
173 "Timer for stealth fontification in Just-in-time Lock mode.")
174 (defvar jit-lock-stealth-repeat-timer nil
175 "Timer for repeated stealth fontification in Just-in-time Lock mode.")
176 (defvar jit-lock-context-timer nil
177 "Timer for context fontification in Just-in-time Lock mode.")
178 (defvar jit-lock-defer-timer nil
179 "Timer for deferred fontification in Just-in-time Lock mode.")
181 (defvar jit-lock-defer-buffers nil
182 "List of buffers with pending deferred fontification.")
183 (defvar jit-lock-stealth-buffers nil
184 "List of buffers that are being fontified stealthily.")
188 (defun jit-lock-mode (arg)
189 "Toggle Just-in-time Lock mode.
190 Turn Just-in-time Lock mode on if and only if ARG is non-nil.
191 Enable it automatically by customizing group `font-lock'.
193 When Just-in-time Lock mode is enabled, fontification is different in the
196 - Demand-driven buffer fontification triggered by Emacs C code.
197 This means initial fontification of the whole buffer does not occur.
198 Instead, fontification occurs when necessary, such as when scrolling
199 through the buffer would otherwise reveal unfontified areas. This is
200 useful if buffer fontification is too slow for large buffers.
202 - Stealthy buffer fontification if `jit-lock-stealth-time' is non-nil.
203 This means remaining unfontified areas of buffers are fontified if Emacs has
204 been idle for `jit-lock-stealth-time' seconds, while Emacs remains idle.
205 This is useful if any buffer has any deferred fontification.
207 - Deferred context fontification if `jit-lock-contextually' is
208 non-nil. This means fontification updates the buffer corresponding to
209 true syntactic context, after `jit-lock-context-time' seconds of Emacs
210 idle time, while Emacs remains idle. Otherwise, fontification occurs
211 on modified lines only, and subsequent lines can remain fontified
212 corresponding to previous syntactic contexts. This is useful where
213 strings or comments span lines.
215 Stealth fontification only occurs while the system remains unloaded.
216 If the system load rises above `jit-lock-stealth-load' percent, stealth
217 fontification is suspended. Stealth fontification intensity is controlled via
218 the variable `jit-lock-stealth-nice'."
219 (setq jit-lock-mode arg
)
220 (cond (;; Turn Just-in-time Lock mode on.
223 ;; Mark the buffer for refontification.
226 ;; Install an idle timer for stealth fontification.
227 (when (and jit-lock-stealth-time
(null jit-lock-stealth-timer
))
228 (setq jit-lock-stealth-timer
229 (run-with-idle-timer jit-lock-stealth-time t
230 'jit-lock-stealth-fontify
)))
232 ;; Create, but do not activate, the idle timer for repeated
233 ;; stealth fontification.
234 (when (and jit-lock-stealth-time
(null jit-lock-stealth-repeat-timer
))
235 (setq jit-lock-stealth-repeat-timer
(timer-create))
236 (timer-set-function jit-lock-stealth-repeat-timer
237 'jit-lock-stealth-fontify
'(t)))
239 ;; Init deferred fontification timer.
240 (when (and jit-lock-defer-time
(null jit-lock-defer-timer
))
241 (setq jit-lock-defer-timer
242 (run-with-idle-timer jit-lock-defer-time t
243 'jit-lock-deferred-fontify
)))
245 ;; Initialize contextual fontification if requested.
246 (when (eq jit-lock-contextually t
)
247 (unless jit-lock-context-timer
248 (setq jit-lock-context-timer
249 (run-with-idle-timer jit-lock-context-time t
250 'jit-lock-context-fontify
)))
251 (setq jit-lock-context-unfontify-pos
252 (or jit-lock-context-unfontify-pos
(point-max))))
255 (add-hook 'after-change-functions
'jit-lock-after-change nil t
)
256 (add-hook 'fontification-functions
'jit-lock-function
))
258 ;; Turn Just-in-time Lock mode off.
260 ;; Cancel our idle timers.
261 (when (and (or jit-lock-stealth-timer jit-lock-defer-timer
262 jit-lock-context-timer
)
263 ;; Only if there's no other buffer using them.
265 (dolist (buf (buffer-list))
266 (with-current-buffer buf
267 (when jit-lock-mode
(throw 'found t
)))))))
268 (when jit-lock-stealth-timer
269 (cancel-timer jit-lock-stealth-timer
)
270 (setq jit-lock-stealth-timer nil
))
271 (when jit-lock-context-timer
272 (cancel-timer jit-lock-context-timer
)
273 (setq jit-lock-context-timer nil
))
274 (when jit-lock-defer-timer
275 (cancel-timer jit-lock-defer-timer
)
276 (setq jit-lock-defer-timer nil
)))
279 (remove-hook 'after-change-functions
'jit-lock-after-change t
)
280 (remove-hook 'fontification-functions
'jit-lock-function
))))
282 (defun jit-lock-register (fun &optional contextual
)
283 "Register FUN as a fontification function to be called in this buffer.
284 FUN will be called with two arguments START and END indicating the region
285 that needs to be (re)fontified.
286 If non-nil, CONTEXTUAL means that a contextual fontification would be useful."
287 (add-hook 'jit-lock-functions fun nil t
)
288 (when (and contextual jit-lock-contextually
)
289 (set (make-local-variable 'jit-lock-contextually
) t
))
292 (defun jit-lock-unregister (fun)
293 "Unregister FUN as a fontification function.
294 Only applies to the current buffer."
295 (remove-hook 'jit-lock-functions fun t
)
296 (unless jit-lock-functions
(jit-lock-mode nil
)))
298 ;; This function is used to prevent font-lock-fontify-buffer from
299 ;; fontifying eagerly the whole buffer. This is important for
300 ;; things like CWarn mode which adds/removes a few keywords and
301 ;; does a refontify (which takes ages on large files).
302 (defun jit-lock-refontify (&optional beg end
)
303 "Force refontification of the region BEG..END (default whole buffer)."
304 (with-buffer-prepared-for-jit-lock
307 (put-text-property (or beg
(point-min)) (or end
(point-max))
310 ;;; On demand fontification.
312 (defun jit-lock-function (start)
313 "Fontify current buffer starting at position START.
314 This function is added to `fontification-functions' when `jit-lock-mode'
316 (when (and jit-lock-mode
(not memory-full
))
317 (if (null jit-lock-defer-timer
)
319 (jit-lock-fontify-now start
(+ start jit-lock-chunk-size
))
320 ;; Record the buffer for later fontification.
321 (unless (memq (current-buffer) jit-lock-defer-buffers
)
322 (push (current-buffer) jit-lock-defer-buffers
))
323 ;; Mark the area as defer-fontified so that the redisplay engine
324 ;; is happy and so that the idle timer can find the places to fontify.
325 (with-buffer-prepared-for-jit-lock
326 (put-text-property start
327 (next-single-property-change
329 (min (point-max) (+ start jit-lock-chunk-size
)))
330 'fontified
'defer
)))))
332 (defun jit-lock-fontify-now (&optional start end
)
333 "Fontify current buffer from START to END.
334 Defaults to the whole buffer. END can be out of bounds."
335 (with-buffer-prepared-for-jit-lock
337 (unless start
(setq start
(point-min)))
338 (setq end
(if end
(min end
(point-max)) (point-max)))
339 ;; This did bind `font-lock-beginning-of-syntax-function' to
340 ;; nil at some point, for an unknown reason. Don't do this; it
341 ;; can make highlighting slow due to expensive calls to
342 ;; `parse-partial-sexp' in function
343 ;; `font-lock-fontify-syntactically-region'. Example: paging
344 ;; from the end of a buffer to its start, can do repeated
345 ;; `parse-partial-sexp' starting from `point-min', which can
346 ;; take a long time in a large buffer.
347 (let ((orig-start start
) next
)
349 ;; Fontify chunks beginning at START. The end of a
350 ;; chunk is either `end', or the start of a region
351 ;; before `end' that has already been fontified.
352 (while (and start
(< start end
))
353 ;; Determine the end of this chunk.
354 (setq next
(or (text-property-any start end
'fontified t
)
357 ;; Decide which range of text should be fontified.
358 ;; The problem is that START and NEXT may be in the
359 ;; middle of something matched by a font-lock regexp.
360 ;; Until someone has a better idea, let's start
361 ;; at the start of the line containing START and
362 ;; stop at the start of the line following NEXT.
363 (goto-char next
) (setq next
(line-beginning-position 2))
364 (goto-char start
) (setq start
(line-beginning-position))
366 ;; Make sure the contextual refontification doesn't re-refontify
367 ;; what's already been refontified.
368 (when (and jit-lock-context-unfontify-pos
369 (< jit-lock-context-unfontify-pos next
)
370 (>= jit-lock-context-unfontify-pos start
)
371 ;; Don't move boundary forward if we have to
372 ;; refontify previous text. Otherwise, we risk moving
373 ;; it past the end of the multiline property and thus
374 ;; forget about this multiline region altogether.
375 (not (get-text-property start
'jit-lock-defer-multiline
)))
376 (setq jit-lock-context-unfontify-pos next
))
378 ;; Fontify the chunk, and mark it as fontified.
379 ;; We mark it first, to make sure that we don't indefinitely
380 ;; re-execute this fontification if an error occurs.
381 (put-text-property start next
'fontified t
)
383 (run-hook-with-args 'jit-lock-functions start next
)
384 ;; If the user quits (which shouldn't happen in normal on-the-fly
385 ;; jit-locking), make sure the fontification will be performed
386 ;; before displaying the block again.
387 (quit (put-text-property start next
'fontified nil
)
388 (funcall 'signal
(car err
) (cdr err
))))
390 ;; The redisplay engine has already rendered the buffer up-to
391 ;; `orig-start' and won't notice if the above jit-lock-functions
392 ;; changed the appearance of any part of the buffer prior
393 ;; to that. So if `start' is before `orig-start', we need to
394 ;; cause a new redisplay cycle after this one so that any changes
395 ;; are properly reflected on screen.
396 ;; To make such repeated redisplay happen less often, we can
397 ;; eagerly extend the refontified region with
398 ;; jit-lock-after-change-extend-region-functions.
399 (when (< start orig-start
)
400 (run-with-timer 0 nil
'jit-lock-force-redisplay
401 (current-buffer) start orig-start
))
403 ;; Find the start of the next chunk, if any.
404 (setq start
(text-property-any next end
'fontified nil
))))))))
406 (defun jit-lock-force-redisplay (buf start end
)
407 "Force the display engine to re-render buffer BUF from START to END."
408 (with-current-buffer buf
409 (with-buffer-prepared-for-jit-lock
410 ;; Don't cause refontification (it's already been done), but just do
411 ;; some random buffer change, so as to force redisplay.
412 (put-text-property start end
'fontified t
))))
416 ;;; Stealth fontification.
418 (defsubst jit-lock-stealth-chunk-start
(around)
419 "Return the start of the next chunk to fontify around position AROUND..
420 Value is nil if there is nothing more to fontify."
421 (if (zerop (buffer-size))
425 (let* ((next (text-property-not-all around
(point-max) 'fontified t
))
426 (prev (previous-single-property-change around
'fontified
))
427 (prop (get-text-property (max (point-min) (1- around
))
431 ;; There is no property change between AROUND
432 ;; and the start of the buffer. If PROP is
433 ;; non-nil, everything in front of AROUND is
434 ;; fontified, otherwise nothing is fontified.
438 (- around
(/ jit-lock-chunk-size
2)))))
440 ;; PREV is the start of a region of fontified
441 ;; text containing AROUND. Start fontifying a
442 ;; chunk size before the end of the unfontified
443 ;; region in front of that.
444 (max (or (previous-single-property-change prev
'fontified
)
446 (- prev jit-lock-chunk-size
)))
448 ;; PREV is the start of a region of unfontified
449 ;; text containing AROUND. Start at PREV or
450 ;; chunk size in front of AROUND, whichever is
452 (max prev
(- around jit-lock-chunk-size
)))))
453 (result (cond ((null start
) next
)
455 ((< (- around start
) (- next around
)) start
)
459 (defun jit-lock-stealth-fontify (&optional repeat
)
460 "Fontify buffers stealthily.
461 This function is called repeatedly after Emacs has become idle for
462 `jit-lock-stealth-time' seconds. Optional argument REPEAT is expected
463 non-nil in a repeated invocation of this function."
464 ;; Cancel timer for repeated invocations.
466 (cancel-timer jit-lock-stealth-repeat-timer
))
467 (unless (or executing-kbd-macro
469 (window-minibuffer-p (selected-window))
470 ;; For first invocation set up `jit-lock-stealth-buffers'.
471 ;; In repeated invocations it's already been set up.
473 jit-lock-stealth-buffers
474 (setq jit-lock-stealth-buffers
(buffer-list)))))
475 (let ((buffer (car jit-lock-stealth-buffers
))
477 minibuffer-auto-raise
480 (if (and jit-lock-stealth-load
481 (> (car (load-average)) jit-lock-stealth-load
))
482 ;; Wait a little if load is too high.
483 (setq delay jit-lock-stealth-time
)
484 (if (buffer-live-p buffer
)
485 (with-current-buffer buffer
486 (if (and jit-lock-mode
487 (setq start
(jit-lock-stealth-chunk-start (point))))
488 ;; Fontify one block of at most `jit-lock-chunk-size'
490 (with-temp-message (if jit-lock-stealth-verbose
491 (concat "JIT stealth lock "
493 (jit-lock-fontify-now start
494 (+ start jit-lock-chunk-size
))
495 ;; Run again after `jit-lock-stealth-nice' seconds.
496 (setq delay
(or jit-lock-stealth-nice
0)))
497 ;; Nothing to fontify here. Remove this buffer from
498 ;; `jit-lock-stealth-buffers' and run again immediately.
499 (setq jit-lock-stealth-buffers
(cdr jit-lock-stealth-buffers
))))
500 ;; Buffer is no longer live. Remove it from
501 ;; `jit-lock-stealth-buffers' and run again immediately.
502 (setq jit-lock-stealth-buffers
(cdr jit-lock-stealth-buffers
))))
504 (when jit-lock-stealth-buffers
505 (timer-set-idle-time jit-lock-stealth-repeat-timer
(current-idle-time))
506 (timer-inc-time jit-lock-stealth-repeat-timer delay
)
507 (timer-activate-when-idle jit-lock-stealth-repeat-timer t
)))))
510 ;;; Deferred fontification.
512 (defun jit-lock-deferred-fontify ()
513 "Fontify what was deferred."
514 (when (and jit-lock-defer-buffers
(not memory-full
))
515 ;; Mark the deferred regions back to `fontified = nil'
516 (dolist (buffer jit-lock-defer-buffers
)
517 (when (buffer-live-p buffer
)
518 (with-current-buffer buffer
519 ;; (message "Jit-Defer %s" (buffer-name))
520 (with-buffer-prepared-for-jit-lock
521 (let ((pos (point-min)))
524 (when (eq (get-text-property pos
'fontified
) 'defer
)
526 pos
(setq pos
(next-single-property-change
527 pos
'fontified nil
(point-max)))
529 (setq pos
(next-single-property-change pos
'fontified
)))))))))
530 (setq jit-lock-defer-buffers nil
)
531 ;; Force fontification of the visible parts.
532 (let ((jit-lock-defer-timer nil
))
533 ;; (message "Jit-Defer Now")
535 ;; (message "Jit-Defer Done")
539 (defun jit-lock-context-fontify ()
540 "Refresh fontification to take new context into account."
542 (dolist (buffer (buffer-list))
543 (with-current-buffer buffer
544 (when jit-lock-context-unfontify-pos
545 ;; (message "Jit-Context %s" (buffer-name))
548 (when (and (>= jit-lock-context-unfontify-pos
(point-min))
549 (< jit-lock-context-unfontify-pos
(point-max)))
550 ;; If we're in text that matches a complex multi-line
551 ;; font-lock pattern, make sure the whole text will be
552 ;; redisplayed eventually.
553 ;; Despite its name, we treat jit-lock-defer-multiline here
554 ;; rather than in jit-lock-defer since it has to do with multiple
555 ;; lines, i.e. with context.
556 (when (get-text-property jit-lock-context-unfontify-pos
557 'jit-lock-defer-multiline
)
558 (setq jit-lock-context-unfontify-pos
559 (or (previous-single-property-change
560 jit-lock-context-unfontify-pos
561 'jit-lock-defer-multiline
)
563 (with-buffer-prepared-for-jit-lock
564 ;; Force contextual refontification.
565 (remove-text-properties
566 jit-lock-context-unfontify-pos
(point-max)
567 '(fontified nil jit-lock-defer-multiline nil
)))
568 (setq jit-lock-context-unfontify-pos
(point-max)))))))))
570 (defvar jit-lock-start
) (defvar jit-lock-end
) ; Dynamically scoped variables.
571 (defvar jit-lock-after-change-extend-region-functions nil
572 "Hook that can extend the text to refontify after a change.
573 This is run after every buffer change. The functions are called with
574 the three arguments of `after-change-functions': START END OLD-LEN.
575 The extended region to refontify is returned indirectly by modifying
576 the variables `jit-lock-start' and `jit-lock-end'.
578 Note that extending the region this way is not strictly necessary, except
579 that the nature of the redisplay code tends to otherwise leave some of
580 the rehighlighted text displayed with the old highlight until the next
581 redisplay (see comment about repeated redisplay in `jit-lock-fontify-now').")
583 (defun jit-lock-after-change (start end old-len
)
584 "Mark the rest of the buffer as not fontified after a change.
585 Installed on `after-change-functions'.
586 START and END are the start and end of the changed text. OLD-LEN
587 is the pre-change length.
588 This function ensures that lines following the change will be refontified
589 in case the syntax of those lines has changed. Refontification
590 will take place when text is fontified stealthily."
591 (when (and jit-lock-mode
(not memory-full
))
592 (let ((jit-lock-start start
)
594 (with-buffer-prepared-for-jit-lock
595 (run-hook-with-args 'jit-lock-after-change-extend-region-functions
597 ;; Make sure we change at least one char (in case of deletions).
598 (setq jit-lock-end
(min (max jit-lock-end
(1+ start
)) (point-max)))
599 ;; Request refontification.
600 (put-text-property jit-lock-start jit-lock-end
'fontified nil
))
601 ;; Mark the change for deferred contextual refontification.
602 (when jit-lock-context-unfontify-pos
603 (setq jit-lock-context-unfontify-pos
604 ;; Here we use `start' because nothing guarantees that the
605 ;; text between start and end will be otherwise refontified:
606 ;; usually it will be refontified by virtue of being
607 ;; displayed, but if it's outside of any displayed area in the
608 ;; buffer, only jit-lock-context-* will re-fontify it.
609 (min jit-lock-context-unfontify-pos jit-lock-start
))))))
613 ;; arch-tag: 56b5de6e-f581-453b-bb97-49c39372ff9e
614 ;;; jit-lock.el ends here