Merge branch 'master' into comment-cache
[emacs.git] / lisp / jit-lock.el
blob8537dae7f8bfae77baf0c1cd2c61528c0bf71656
1 ;;; jit-lock.el --- just-in-time fontification -*- lexical-binding: t -*-
3 ;; Copyright (C) 1998, 2000-2017 Free Software Foundation, Inc.
5 ;; Author: Gerd Moellmann <gerd@gnu.org>
6 ;; Keywords: faces files
7 ;; Package: emacs
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 of the License, or
14 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; Just-in-time fontification, triggered by C redisplay code.
28 ;;; Code:
31 (eval-when-compile
32 (defmacro with-buffer-prepared-for-jit-lock (&rest body)
33 "Execute BODY in current buffer, overriding several variables.
34 Preserves the `buffer-modified-p' state of the current buffer."
35 (declare (debug t))
36 `(let ((inhibit-point-motion-hooks t))
37 (with-silent-modifications
38 ,@body))))
40 ;;; Customization.
42 (defgroup jit-lock nil
43 "Font Lock support mode to fontify just-in-time."
44 :version "21.1"
45 :group 'font-lock)
47 (defcustom jit-lock-chunk-size 500
48 "Jit-lock fontifies chunks of at most this many characters at a time.
50 This variable controls both display-time and stealth fontification."
51 :type 'integer
52 :group 'jit-lock)
55 (defcustom jit-lock-stealth-time nil
56 "Time in seconds to wait before beginning stealth fontification.
57 Stealth fontification occurs if there is no input within this time.
58 If nil, stealth fontification is never performed.
60 The value of this variable is used when JIT Lock mode is turned on."
61 :type '(choice (const :tag "never" nil)
62 (number :tag "seconds" :value 16))
63 :group 'jit-lock)
66 (defcustom jit-lock-stealth-nice 0.5
67 "Time in seconds to pause between chunks of stealth fontification.
68 Each iteration of stealth fontification is separated by this amount of time,
69 thus reducing the demand that stealth fontification makes on the system.
70 If nil, means stealth fontification is never paused.
71 To reduce machine load during stealth fontification, at the cost of stealth
72 taking longer to fontify, you could increase the value of this variable.
73 See also `jit-lock-stealth-load'."
74 :type '(choice (const :tag "never" nil)
75 (number :tag "seconds"))
76 :group 'jit-lock)
79 (defcustom jit-lock-stealth-load
80 (if (condition-case nil (load-average) (error)) 200)
81 "Load in percentage above which stealth fontification is suspended.
82 Stealth fontification pauses when the system short-term load average (as
83 returned by the function `load-average' if supported) goes above this level,
84 thus reducing the demand that stealth fontification makes on the system.
85 If nil, means stealth fontification is never suspended.
86 To reduce machine load during stealth fontification, at the cost of stealth
87 taking longer to fontify, you could reduce the value of this variable.
88 See also `jit-lock-stealth-nice'."
89 :type (if (condition-case nil (load-average) (error))
90 '(choice (const :tag "never" nil)
91 (integer :tag "load"))
92 '(const :format "%t: unsupported\n" nil))
93 :group 'jit-lock)
96 (defcustom jit-lock-stealth-verbose nil
97 "If non-nil, means stealth fontification should show status messages."
98 :type 'boolean
99 :group 'jit-lock)
102 (defvaralias 'jit-lock-defer-contextually 'jit-lock-contextually)
103 (defcustom jit-lock-contextually 'syntax-driven
104 "If non-nil, means fontification should be syntactically true.
105 If nil, means fontification occurs only on those lines modified. This
106 means where modification on a line causes syntactic change on subsequent lines,
107 those subsequent lines are not refontified to reflect their new context.
108 If t, means fontification occurs on those lines modified and all
109 subsequent lines. This means those subsequent lines are refontified to reflect
110 their new syntactic context, after `jit-lock-context-time' seconds.
111 If any other value, e.g., `syntax-driven', means syntactically true
112 fontification occurs only if syntactic fontification is performed using the
113 buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
115 The value of this variable is used when JIT Lock mode is turned on."
116 :type '(choice (const :tag "never" nil)
117 (const :tag "always" t)
118 (other :tag "syntax-driven" syntax-driven))
119 :group 'jit-lock)
121 (defcustom jit-lock-context-time 0.5
122 "Idle time after which text is contextually refontified, if applicable."
123 :type '(number :tag "seconds")
124 :group 'jit-lock)
126 (defcustom jit-lock-defer-time nil ;; 0.25
127 "Idle time after which deferred fontification should take place.
128 If nil, fontification is not deferred.
129 If 0, then fontification is only deferred while there is input pending."
130 :group 'jit-lock
131 :type '(choice (const :tag "never" nil)
132 (number :tag "seconds")))
134 ;;; Variables that are not customizable.
136 (defvar-local jit-lock-mode nil
137 "Non-nil means Just-in-time Lock mode is active.")
139 (defvar-local jit-lock-functions nil
140 "Functions to do the actual fontification.
141 They are called with two arguments: the START and END of the region to fontify.")
143 (defvar-local jit-lock-context-unfontify-pos nil
144 "Consider text after this position as contextually unfontified.
145 If nil, contextual fontification is disabled.")
147 (defvar jit-lock-stealth-timer nil
148 "Timer for stealth fontification in Just-in-time Lock mode.")
149 (defvar jit-lock-stealth-repeat-timer nil
150 "Timer for repeated stealth fontification in Just-in-time Lock mode.")
151 (defvar jit-lock-context-timer nil
152 "Timer for context fontification in Just-in-time Lock mode.")
153 (defvar jit-lock-defer-timer nil
154 "Timer for deferred fontification in Just-in-time Lock mode.")
156 (defvar jit-lock-defer-buffers nil
157 "List of buffers with pending deferred fontification.")
158 (defvar jit-lock-stealth-buffers nil
159 "List of buffers that are being fontified stealthily.")
161 ;;; JIT lock mode
163 (defun jit-lock-mode (arg)
164 "Toggle Just-in-time Lock mode.
165 Turn Just-in-time Lock mode on if and only if ARG is non-nil.
166 Enable it automatically by customizing group `font-lock'.
168 When Just-in-time Lock mode is enabled, fontification is different in the
169 following ways:
171 - Demand-driven buffer fontification triggered by Emacs C code.
172 This means initial fontification of the whole buffer does not occur.
173 Instead, fontification occurs when necessary, such as when scrolling
174 through the buffer would otherwise reveal unfontified areas. This is
175 useful if buffer fontification is too slow for large buffers.
177 - Stealthy buffer fontification if `jit-lock-stealth-time' is non-nil.
178 This means remaining unfontified areas of buffers are fontified if Emacs has
179 been idle for `jit-lock-stealth-time' seconds, while Emacs remains idle.
180 This is useful if any buffer has any deferred fontification.
182 - Deferred context fontification if `jit-lock-contextually' is
183 non-nil. This means fontification updates the buffer corresponding to
184 true syntactic context, after `jit-lock-context-time' seconds of Emacs
185 idle time, while Emacs remains idle. Otherwise, fontification occurs
186 on modified lines only, and subsequent lines can remain fontified
187 corresponding to previous syntactic contexts. This is useful where
188 strings or comments span lines.
190 Stealth fontification only occurs while the system remains unloaded.
191 If the system load rises above `jit-lock-stealth-load' percent, stealth
192 fontification is suspended. Stealth fontification intensity is controlled via
193 the variable `jit-lock-stealth-nice'.
195 If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
196 (setq jit-lock-mode arg)
197 (cond
198 ((and (buffer-base-buffer)
199 jit-lock-mode)
200 ;; We're in an indirect buffer, and we're turning the mode on.
201 ;; This doesn't work because jit-lock relies on the `fontified'
202 ;; text-property which is shared with the base buffer.
203 (setq jit-lock-mode nil)
204 (message "Not enabling jit-lock: it does not work in indirect buffer"))
206 (jit-lock-mode ;; Turn Just-in-time Lock mode on.
208 ;; Mark the buffer for refontification.
209 (jit-lock-refontify)
211 ;; Install an idle timer for stealth fontification.
212 (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
213 (setq jit-lock-stealth-timer
214 (run-with-idle-timer jit-lock-stealth-time t
215 'jit-lock-stealth-fontify)))
217 ;; Create, but do not activate, the idle timer for repeated
218 ;; stealth fontification.
219 (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
220 (setq jit-lock-stealth-repeat-timer (timer-create))
221 (timer-set-function jit-lock-stealth-repeat-timer
222 'jit-lock-stealth-fontify '(t)))
224 ;; Init deferred fontification timer.
225 (when (and jit-lock-defer-time (null jit-lock-defer-timer))
226 (setq jit-lock-defer-timer
227 (run-with-idle-timer jit-lock-defer-time t
228 'jit-lock-deferred-fontify)))
230 ;; Initialize contextual fontification if requested.
231 (when (eq jit-lock-contextually t)
232 (unless jit-lock-context-timer
233 (setq jit-lock-context-timer
234 (run-with-idle-timer jit-lock-context-time t
235 'jit-lock-context-fontify)))
236 (setq jit-lock-context-unfontify-pos
237 (or jit-lock-context-unfontify-pos (point-max))))
239 ;; Setup our hooks.
240 (add-hook 'after-change-functions 'jit-lock-after-change nil t)
241 (add-hook 'fontification-functions 'jit-lock-function))
243 ;; Turn Just-in-time Lock mode off.
245 ;; Cancel our idle timers.
246 (when (and (or jit-lock-stealth-timer jit-lock-defer-timer
247 jit-lock-context-timer)
248 ;; Only if there's no other buffer using them.
249 (not (catch 'found
250 (dolist (buf (buffer-list))
251 (with-current-buffer buf
252 (when jit-lock-mode (throw 'found t)))))))
253 (when jit-lock-stealth-timer
254 (cancel-timer jit-lock-stealth-timer)
255 (setq jit-lock-stealth-timer nil))
256 (when jit-lock-context-timer
257 (cancel-timer jit-lock-context-timer)
258 (setq jit-lock-context-timer nil))
259 (when jit-lock-defer-timer
260 (cancel-timer jit-lock-defer-timer)
261 (setq jit-lock-defer-timer nil)))
263 ;; Remove hooks.
264 (remove-hook 'after-change-functions 'jit-lock-after-change t)
265 (remove-hook 'fontification-functions 'jit-lock-function))))
267 (define-minor-mode jit-lock-debug-mode
268 "Minor mode to help debug code run from jit-lock.
269 When this minor mode is enabled, jit-lock runs as little code as possible
270 during redisplay and moves the rest to a timer, where things
271 like `debug-on-error' and Edebug can be used."
272 :global t :group 'jit-lock
273 (when jit-lock-defer-timer
274 (cancel-timer jit-lock-defer-timer)
275 (setq jit-lock-defer-timer nil))
276 (when jit-lock-debug-mode
277 (setq jit-lock-defer-timer
278 (run-with-idle-timer 0 t #'jit-lock--debug-fontify))))
280 (defvar jit-lock--debug-fontifying nil)
282 (defun jit-lock--debug-fontify ()
283 "Fontify what was deferred for debugging."
284 (when (and (not jit-lock--debug-fontifying)
285 jit-lock-defer-buffers (not memory-full))
286 (let ((jit-lock--debug-fontifying t)
287 (inhibit-debugger nil)) ;FIXME: Not sufficient!
288 ;; Mark the deferred regions back to `fontified = nil'
289 (dolist (buffer jit-lock-defer-buffers)
290 (when (buffer-live-p buffer)
291 (with-current-buffer buffer
292 ;; (message "Jit-Debug %s" (buffer-name))
293 (with-buffer-prepared-for-jit-lock
294 (let ((pos (point-min)))
295 (while
296 (progn
297 (when (eq (get-text-property pos 'fontified) 'defer)
298 (let ((beg pos)
299 (end (setq pos (next-single-property-change
300 pos 'fontified
301 nil (point-max)))))
302 (put-text-property beg end 'fontified nil)
303 (jit-lock-fontify-now beg end)))
304 (setq pos (next-single-property-change
305 pos 'fontified)))))))))
306 (setq jit-lock-defer-buffers nil))))
308 (defun jit-lock-register (fun &optional contextual)
309 "Register FUN as a fontification function to be called in this buffer.
310 FUN will be called with two arguments START and END indicating the region
311 that needs to be (re)fontified.
312 If non-nil, CONTEXTUAL means that a contextual fontification would be useful."
313 (add-hook 'jit-lock-functions fun nil t)
314 (when (and contextual jit-lock-contextually)
315 (setq-local jit-lock-contextually t))
316 (jit-lock-mode t))
318 (defun jit-lock-unregister (fun)
319 "Unregister FUN as a fontification function.
320 Only applies to the current buffer."
321 (remove-hook 'jit-lock-functions fun t)
322 (unless jit-lock-functions (jit-lock-mode nil)))
324 (defun jit-lock-refontify (&optional beg end)
325 "Force refontification of the region BEG..END (default whole buffer)."
326 (with-buffer-prepared-for-jit-lock
327 (save-restriction
328 (widen)
329 (put-text-property (or beg (point-min)) (or end (point-max))
330 'fontified nil))))
332 ;;; On demand fontification.
334 (defun jit-lock-function (start)
335 "Fontify current buffer starting at position START.
336 This function is added to `fontification-functions' when `jit-lock-mode'
337 is active."
338 (when (and jit-lock-mode (not memory-full))
339 (if (not (and jit-lock-defer-timer
340 (or (not (eq jit-lock-defer-time 0))
341 (input-pending-p))))
342 ;; No deferral.
343 (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
344 ;; Record the buffer for later fontification.
345 (unless (memq (current-buffer) jit-lock-defer-buffers)
346 (push (current-buffer) jit-lock-defer-buffers))
347 ;; Mark the area as defer-fontified so that the redisplay engine
348 ;; is happy and so that the idle timer can find the places to fontify.
349 (with-buffer-prepared-for-jit-lock
350 (put-text-property start
351 (next-single-property-change
352 start 'fontified nil
353 (min (point-max) (+ start jit-lock-chunk-size)))
354 'fontified 'defer)))))
356 (defun jit-lock--run-functions (beg end)
357 (let ((tight-beg nil) (tight-end nil)
358 (loose-beg beg) (loose-end end))
359 (run-hook-wrapped
360 'jit-lock-functions
361 (lambda (fun)
362 (pcase-let*
363 ((res (funcall fun beg end))
364 (`(,this-beg . ,this-end)
365 (if (eq (car-safe res) 'jit-lock-bounds)
366 (cdr res) (cons beg end))))
367 ;; If all functions don't fontify the same region, we currently
368 ;; just try to "still be correct". But we could go further and for
369 ;; the chunks of text that was fontified by some functions but not
370 ;; all, we could add text-properties indicating which functions were
371 ;; already run to avoid running them redundantly when we get to
372 ;; those chunks.
373 (setq tight-beg (max (or tight-beg (point-min)) this-beg))
374 (setq tight-end (min (or tight-end (point-max)) this-end))
375 (setq loose-beg (min loose-beg this-beg))
376 (setq loose-end (max loose-end this-end))
377 nil)))
378 `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
380 (defun jit-lock-fontify-now (&optional start end)
381 "Fontify current buffer from START to END.
382 Defaults to the whole buffer. END can be out of bounds."
383 (with-buffer-prepared-for-jit-lock
384 (save-excursion
385 (unless start (setq start (point-min)))
386 (setq end (if end (min end (point-max)) (point-max)))
387 (let ((orig-start start) next)
388 (save-match-data
389 ;; Fontify chunks beginning at START. The end of a
390 ;; chunk is either `end', or the start of a region
391 ;; before `end' that has already been fontified.
392 (while (and start (< start end))
393 ;; Determine the end of this chunk.
394 (setq next (or (text-property-any start end 'fontified t)
395 end))
397 ;; Avoid unnecessary work if the chunk is empty (bug#23278).
398 (when (> next start)
399 ;; Fontify the chunk, and mark it as fontified.
400 ;; We mark it first, to make sure that we don't indefinitely
401 ;; re-execute this fontification if an error occurs.
402 (put-text-property start next 'fontified t)
403 (pcase-let
404 ;; `tight' is the part we've fully refontified, and `loose'
405 ;; is the part we've partly refontified (some of the
406 ;; functions have refontified it but maybe not all).
407 ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end)
408 (condition-case err
409 (jit-lock--run-functions start next)
410 ;; If the user quits (which shouldn't happen in normal
411 ;; on-the-fly jit-locking), make sure the fontification
412 ;; will be performed before displaying the block again.
413 (quit (put-text-property start next 'fontified nil)
414 (signal (car err) (cdr err))))))
416 ;; In case we fontified more than requested, take advantage of the
417 ;; good news.
418 (when (or (< tight-beg start) (> tight-end next))
419 (put-text-property tight-beg tight-end 'fontified t))
421 ;; Make sure the contextual refontification doesn't re-refontify
422 ;; what's already been refontified.
423 (when (and jit-lock-context-unfontify-pos
424 (< jit-lock-context-unfontify-pos tight-end)
425 (>= jit-lock-context-unfontify-pos tight-beg)
426 ;; Don't move boundary forward if we have to
427 ;; refontify previous text. Otherwise, we risk moving
428 ;; it past the end of the multiline property and thus
429 ;; forget about this multiline region altogether.
430 (not (get-text-property tight-beg
431 'jit-lock-defer-multiline)))
432 (setq jit-lock-context-unfontify-pos tight-end))
434 ;; The redisplay engine has already rendered the buffer up-to
435 ;; `orig-start' and won't notice if the above jit-lock-functions
436 ;; changed the appearance of any part of the buffer prior
437 ;; to that. So if `loose-beg' is before `orig-start', we need to
438 ;; cause a new redisplay cycle after this one so that the changes
439 ;; are properly reflected on screen.
440 ;; To make such repeated redisplay happen less often, we can
441 ;; eagerly extend the refontified region with
442 ;; jit-lock-after-change-extend-region-functions.
443 (when (< loose-beg orig-start)
444 (run-with-timer 0 nil #'jit-lock-force-redisplay
445 (copy-marker loose-beg)
446 (copy-marker orig-start)))
448 ;; Skip to the end of the fully refontified part.
449 (setq start tight-end)))
450 ;; Find the start of the next chunk, if any.
451 (setq start
452 (text-property-any start end 'fontified nil))))))))
454 (defun jit-lock-force-redisplay (start end)
455 "Force the display engine to re-render START's buffer from START to END.
456 This applies to the buffer associated with marker START."
457 (when (marker-buffer start)
458 (with-current-buffer (marker-buffer start)
459 (with-buffer-prepared-for-jit-lock
460 (when (> end (point-max))
461 (setq end (point-max) start (min start end)))
462 (when (< start (point-min))
463 (setq start (point-min) end (max start end)))
464 ;; Don't cause refontification (it's already been done), but just do
465 ;; some random buffer change, so as to force redisplay.
466 (put-text-property start end 'fontified t)))))
468 ;;; Stealth fontification.
470 (defsubst jit-lock-stealth-chunk-start (around)
471 "Return the start of the next chunk to fontify around position AROUND.
472 Value is nil if there is nothing more to fontify."
473 (if (zerop (buffer-size))
475 (let* ((next (text-property-not-all around (point-max) 'fontified t))
476 (prev (previous-single-property-change around 'fontified))
477 (prop (get-text-property (max (point-min) (1- around))
478 'fontified))
479 (start (cond
480 ((null prev)
481 ;; There is no property change between AROUND
482 ;; and the start of the buffer. If PROP is
483 ;; non-nil, everything in front of AROUND is
484 ;; fontified, otherwise nothing is fontified.
485 (if (eq prop t)
487 (max (point-min)
488 (- around (/ jit-lock-chunk-size 2)))))
489 ((eq prop t)
490 ;; PREV is the start of a region of fontified
491 ;; text containing AROUND. Start fontifying a
492 ;; chunk size before the end of the unfontified
493 ;; region in front of that.
494 (max (or (previous-single-property-change prev 'fontified)
495 (point-min))
496 (- prev jit-lock-chunk-size)))
498 ;; PREV is the start of a region of unfontified
499 ;; text containing AROUND. Start at PREV or
500 ;; chunk size in front of AROUND, whichever is
501 ;; nearer.
502 (max prev (- around jit-lock-chunk-size)))))
503 (result (cond ((null start) next)
504 ((null next) start)
505 ((< (- around start) (- next around)) start)
506 (t next))))
507 result)))
509 (defun jit-lock-stealth-fontify (&optional repeat)
510 "Fontify buffers stealthily.
511 This function is called repeatedly after Emacs has become idle for
512 `jit-lock-stealth-time' seconds. Optional argument REPEAT is expected
513 non-nil in a repeated invocation of this function."
514 ;; Cancel timer for repeated invocations.
515 (unless repeat
516 (cancel-timer jit-lock-stealth-repeat-timer))
517 (unless (or executing-kbd-macro
518 memory-full
519 (window-minibuffer-p)
520 ;; For first invocation set up `jit-lock-stealth-buffers'.
521 ;; In repeated invocations it's already been set up.
522 (null (if repeat
523 jit-lock-stealth-buffers
524 (setq jit-lock-stealth-buffers (buffer-list)))))
525 (let ((buffer (car jit-lock-stealth-buffers))
526 (delay 0)
527 minibuffer-auto-raise
528 message-log-max
529 start)
530 (if (and jit-lock-stealth-load
531 ;; load-average can return nil. The w32 emulation does
532 ;; that during the first few dozens of seconds after
533 ;; startup.
534 (> (or (car (load-average)) 0) jit-lock-stealth-load))
535 ;; Wait a little if load is too high.
536 (setq delay jit-lock-stealth-time)
537 (if (buffer-live-p buffer)
538 (with-current-buffer buffer
539 (if (and jit-lock-mode
540 (setq start (jit-lock-stealth-chunk-start (point))))
541 ;; Fontify one block of at most `jit-lock-chunk-size'
542 ;; characters.
543 (with-temp-message (if jit-lock-stealth-verbose
544 (concat "JIT stealth lock "
545 (buffer-name)))
546 (jit-lock-fontify-now start
547 (+ start jit-lock-chunk-size))
548 ;; Run again after `jit-lock-stealth-nice' seconds.
549 (setq delay (or jit-lock-stealth-nice 0)))
550 ;; Nothing to fontify here. Remove this buffer from
551 ;; `jit-lock-stealth-buffers' and run again immediately.
552 (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers))))
553 ;; Buffer is no longer live. Remove it from
554 ;; `jit-lock-stealth-buffers' and run again immediately.
555 (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers))))
556 ;; Call us again.
557 (when jit-lock-stealth-buffers
558 (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time))
559 (timer-inc-time jit-lock-stealth-repeat-timer delay)
560 (timer-activate-when-idle jit-lock-stealth-repeat-timer t)))))
563 ;;; Deferred fontification.
565 (defun jit-lock-deferred-fontify ()
566 "Fontify what was deferred."
567 (when (and jit-lock-defer-buffers (not memory-full))
568 ;; Mark the deferred regions back to `fontified = nil'
569 (dolist (buffer jit-lock-defer-buffers)
570 (when (buffer-live-p buffer)
571 (with-current-buffer buffer
572 ;; (message "Jit-Defer %s" (buffer-name))
573 (with-buffer-prepared-for-jit-lock
574 (let ((pos (point-min)))
575 (while
576 (progn
577 (when (eq (get-text-property pos 'fontified) 'defer)
578 (put-text-property
579 pos (setq pos (next-single-property-change
580 pos 'fontified nil (point-max)))
581 'fontified nil))
582 (setq pos (next-single-property-change
583 pos 'fontified)))))))))
584 ;; Force fontification of the visible parts.
585 (let ((buffers jit-lock-defer-buffers)
586 (jit-lock-defer-timer nil))
587 (setq jit-lock-defer-buffers nil)
588 ;; (message "Jit-Defer Now")
589 (unless (redisplay) ;FIXME: Should we `force'?
590 (setq jit-lock-defer-buffers buffers))
591 ;; (message "Jit-Defer Done")
595 (defun jit-lock-context-fontify ()
596 "Refresh fontification to take new context into account."
597 (unless memory-full
598 (dolist (buffer (buffer-list))
599 (with-current-buffer buffer
600 (when jit-lock-context-unfontify-pos
601 ;; (message "Jit-Context %s" (buffer-name))
602 (save-restriction
603 ;; Don't be blindsided by narrowing that starts in the middle
604 ;; of a jit-lock-defer-multiline.
605 (widen)
606 (when (and (>= jit-lock-context-unfontify-pos (point-min))
607 (< jit-lock-context-unfontify-pos (point-max)))
608 ;; If we're in text that matches a complex multi-line
609 ;; font-lock pattern, make sure the whole text will be
610 ;; redisplayed eventually.
611 ;; Despite its name, we treat jit-lock-defer-multiline here
612 ;; rather than in jit-lock-defer since it has to do with multiple
613 ;; lines, i.e. with context.
614 (when (get-text-property jit-lock-context-unfontify-pos
615 'jit-lock-defer-multiline)
616 (setq jit-lock-context-unfontify-pos
617 (or (previous-single-property-change
618 jit-lock-context-unfontify-pos
619 'jit-lock-defer-multiline)
620 (point-min))))
621 (with-buffer-prepared-for-jit-lock
622 ;; Force contextual refontification.
623 (remove-text-properties
624 jit-lock-context-unfontify-pos (point-max)
625 '(fontified nil jit-lock-defer-multiline nil)))
626 (setq jit-lock-context-unfontify-pos (point-max)))))))))
628 (defvar jit-lock-start) (defvar jit-lock-end) ; Dynamically scoped variables.
629 (defvar jit-lock-after-change-extend-region-functions nil
630 "Hook that can extend the text to refontify after a change.
631 This is run after every buffer change. The functions are called with
632 the three arguments of `after-change-functions': START END OLD-LEN.
633 The extended region to refontify is returned indirectly by modifying
634 the variables `jit-lock-start' and `jit-lock-end'.
636 Note that extending the region this way is not strictly necessary, except
637 that the nature of the redisplay code tends to otherwise leave some of
638 the rehighlighted text displayed with the old highlight until the next
639 redisplay (see comment about repeated redisplay in `jit-lock-fontify-now').")
641 (defun jit-lock-after-change (start end old-len)
642 "Mark the rest of the buffer as not fontified after a change.
643 Installed on `after-change-functions'.
644 START and END are the start and end of the changed text. OLD-LEN
645 is the pre-change length.
646 This function ensures that lines following the change will be refontified
647 in case the syntax of those lines has changed. Refontification
648 will take place when text is fontified stealthily."
649 (when (and jit-lock-mode (not memory-full))
650 (let ((jit-lock-start start)
651 (jit-lock-end end))
652 (with-buffer-prepared-for-jit-lock
653 (run-hook-with-args 'jit-lock-after-change-extend-region-functions
654 start end old-len)
655 ;; Make sure we change at least one char (in case of deletions).
656 (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
657 ;; Request refontification.
658 (save-restriction
659 (widen)
660 (put-text-property jit-lock-start jit-lock-end 'fontified nil)))
661 ;; Mark the change for deferred contextual refontification.
662 (when jit-lock-context-unfontify-pos
663 (setq jit-lock-context-unfontify-pos
664 ;; Here we use `start' because nothing guarantees that the
665 ;; text between start and end will be otherwise refontified:
666 ;; usually it will be refontified by virtue of being
667 ;; displayed, but if it's outside of any displayed area in the
668 ;; buffer, only jit-lock-context-* will re-fontify it.
669 (min jit-lock-context-unfontify-pos jit-lock-start))))))
671 (provide 'jit-lock)
673 ;;; jit-lock.el ends here