Line data Source code
1 : ;;; jit-lock.el --- just-in-time fontification -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1998, 2000-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Gerd Moellmann <gerd@gnu.org>
6 : ;; Keywords: faces files
7 : ;; Package: emacs
8 :
9 : ;; This file is part of GNU Emacs.
10 :
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.
15 :
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.
20 :
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/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; Just-in-time fontification, triggered by C redisplay code.
27 :
28 : ;;; Code:
29 :
30 :
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))))
39 :
40 : ;;; Customization.
41 :
42 : (defgroup jit-lock nil
43 : "Font Lock support mode to fontify just-in-time."
44 : :version "21.1"
45 : :group 'font-lock)
46 :
47 : (defcustom jit-lock-chunk-size 500
48 : "Jit-lock fontifies chunks of at most this many characters at a time.
49 :
50 : This variable controls both display-time and stealth fontification."
51 : :type 'integer
52 : :group 'jit-lock)
53 :
54 :
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.
59 :
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)
64 :
65 :
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)
77 :
78 :
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)
94 :
95 :
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)
100 :
101 :
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.
114 :
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)
120 :
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)
125 :
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")))
133 :
134 : ;;; Variables that are not customizable.
135 :
136 : (defvar-local jit-lock-mode nil
137 : "Non-nil means Just-in-time Lock mode is active.")
138 :
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.")
142 :
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.")
146 :
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.")
155 :
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.")
160 :
161 : ;;; JIT lock mode
162 :
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'.
167 :
168 : When Just-in-time Lock mode is enabled, fontification is different in the
169 : following ways:
170 :
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.
176 :
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.
181 :
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.
189 :
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'.
194 :
195 : If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
196 0 : (setq jit-lock-mode arg)
197 0 : (cond
198 0 : ((and (buffer-base-buffer)
199 0 : 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 0 : (setq jit-lock-mode nil)
204 0 : (message "Not enabling jit-lock: it does not work in indirect buffer"))
205 :
206 0 : (jit-lock-mode ;; Turn Just-in-time Lock mode on.
207 :
208 : ;; Mark the buffer for refontification.
209 0 : (jit-lock-refontify)
210 :
211 : ;; Install an idle timer for stealth fontification.
212 0 : (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
213 0 : (setq jit-lock-stealth-timer
214 0 : (run-with-idle-timer jit-lock-stealth-time t
215 0 : 'jit-lock-stealth-fontify)))
216 :
217 : ;; Create, but do not activate, the idle timer for repeated
218 : ;; stealth fontification.
219 0 : (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
220 0 : (setq jit-lock-stealth-repeat-timer (timer-create))
221 0 : (timer-set-function jit-lock-stealth-repeat-timer
222 0 : 'jit-lock-stealth-fontify '(t)))
223 :
224 : ;; Init deferred fontification timer.
225 0 : (when (and jit-lock-defer-time (null jit-lock-defer-timer))
226 0 : (setq jit-lock-defer-timer
227 0 : (run-with-idle-timer jit-lock-defer-time t
228 0 : 'jit-lock-deferred-fontify)))
229 :
230 : ;; Initialize contextual fontification if requested.
231 0 : (when (eq jit-lock-contextually t)
232 0 : (unless jit-lock-context-timer
233 0 : (setq jit-lock-context-timer
234 0 : (run-with-idle-timer jit-lock-context-time t
235 0 : 'jit-lock-context-fontify)))
236 0 : (setq jit-lock-context-unfontify-pos
237 0 : (or jit-lock-context-unfontify-pos (point-max))))
238 :
239 : ;; Setup our hooks.
240 0 : (add-hook 'after-change-functions 'jit-lock-after-change nil t)
241 0 : (add-hook 'fontification-functions 'jit-lock-function))
242 :
243 : ;; Turn Just-in-time Lock mode off.
244 : (t
245 : ;; Cancel our idle timers.
246 0 : (when (and (or jit-lock-stealth-timer jit-lock-defer-timer
247 0 : jit-lock-context-timer)
248 : ;; Only if there's no other buffer using them.
249 0 : (not (catch 'found
250 0 : (dolist (buf (buffer-list))
251 0 : (with-current-buffer buf
252 0 : (when jit-lock-mode (throw 'found t)))))))
253 0 : (when jit-lock-stealth-timer
254 0 : (cancel-timer jit-lock-stealth-timer)
255 0 : (setq jit-lock-stealth-timer nil))
256 0 : (when jit-lock-context-timer
257 0 : (cancel-timer jit-lock-context-timer)
258 0 : (setq jit-lock-context-timer nil))
259 0 : (when jit-lock-defer-timer
260 0 : (cancel-timer jit-lock-defer-timer)
261 0 : (setq jit-lock-defer-timer nil)))
262 :
263 : ;; Remove hooks.
264 0 : (remove-hook 'after-change-functions 'jit-lock-after-change t)
265 0 : (remove-hook 'fontification-functions 'jit-lock-function))))
266 :
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 0 : (when jit-lock-defer-timer
274 0 : (cancel-timer jit-lock-defer-timer)
275 0 : (setq jit-lock-defer-timer nil))
276 0 : (when jit-lock-debug-mode
277 0 : (setq jit-lock-defer-timer
278 0 : (run-with-idle-timer 0 t #'jit-lock--debug-fontify))))
279 :
280 : (defvar jit-lock--debug-fontifying nil)
281 :
282 : (defun jit-lock--debug-fontify ()
283 : "Fontify what was deferred for debugging."
284 0 : (when (and (not jit-lock--debug-fontifying)
285 0 : jit-lock-defer-buffers (not memory-full))
286 0 : (let ((jit-lock--debug-fontifying t)
287 : (inhibit-debugger nil)) ;FIXME: Not sufficient!
288 : ;; Mark the deferred regions back to `fontified = nil'
289 0 : (dolist (buffer jit-lock-defer-buffers)
290 0 : (when (buffer-live-p buffer)
291 0 : (with-current-buffer buffer
292 : ;; (message "Jit-Debug %s" (buffer-name))
293 0 : (with-buffer-prepared-for-jit-lock
294 0 : (let ((pos (point-min)))
295 0 : (while
296 0 : (progn
297 0 : (when (eq (get-text-property pos 'fontified) 'defer)
298 0 : (let ((beg pos)
299 0 : (end (setq pos (next-single-property-change
300 0 : pos 'fontified
301 0 : nil (point-max)))))
302 0 : (put-text-property beg end 'fontified nil)
303 0 : (jit-lock-fontify-now beg end)))
304 0 : (setq pos (next-single-property-change
305 0 : pos 'fontified)))))))))
306 0 : (setq jit-lock-defer-buffers nil))))
307 :
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 0 : (add-hook 'jit-lock-functions fun nil t)
314 0 : (when (and contextual jit-lock-contextually)
315 0 : (setq-local jit-lock-contextually t))
316 0 : (jit-lock-mode t))
317 :
318 : (defun jit-lock-unregister (fun)
319 : "Unregister FUN as a fontification function.
320 : Only applies to the current buffer."
321 0 : (remove-hook 'jit-lock-functions fun t)
322 0 : (unless jit-lock-functions (jit-lock-mode nil)))
323 :
324 : (defun jit-lock-refontify (&optional beg end)
325 : "Force refontification of the region BEG..END (default whole buffer)."
326 0 : (with-buffer-prepared-for-jit-lock
327 0 : (save-restriction
328 0 : (widen)
329 0 : (put-text-property (or beg (point-min)) (or end (point-max))
330 0 : 'fontified nil))))
331 :
332 : ;;; On demand fontification.
333 :
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 0 : (when (and jit-lock-mode (not memory-full))
339 0 : (if (not (and jit-lock-defer-timer
340 0 : (or (not (eq jit-lock-defer-time 0))
341 0 : (input-pending-p))))
342 : ;; No deferral.
343 0 : (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
344 : ;; Record the buffer for later fontification.
345 0 : (unless (memq (current-buffer) jit-lock-defer-buffers)
346 0 : (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 0 : (with-buffer-prepared-for-jit-lock
350 0 : (put-text-property start
351 0 : (next-single-property-change
352 0 : start 'fontified nil
353 0 : (min (point-max) (+ start jit-lock-chunk-size)))
354 0 : 'fontified 'defer)))))
355 :
356 : (defun jit-lock--run-functions (beg end)
357 0 : (let ((tight-beg nil) (tight-end nil)
358 0 : (loose-beg beg) (loose-end end))
359 0 : (run-hook-wrapped
360 : 'jit-lock-functions
361 : (lambda (fun)
362 0 : (pcase-let*
363 0 : ((res (funcall fun beg end))
364 : (`(,this-beg . ,this-end)
365 0 : (if (eq (car-safe res) 'jit-lock-bounds)
366 0 : (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 0 : (setq tight-beg (max (or tight-beg (point-min)) this-beg))
374 0 : (setq tight-end (min (or tight-end (point-max)) this-end))
375 0 : (setq loose-beg (min loose-beg this-beg))
376 0 : (setq loose-end (max loose-end this-end))
377 0 : nil)))
378 0 : `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
379 :
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 0 : (with-buffer-prepared-for-jit-lock
384 0 : (save-excursion
385 0 : (unless start (setq start (point-min)))
386 0 : (setq end (if end (min end (point-max)) (point-max)))
387 0 : (let ((orig-start start) next)
388 0 : (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 0 : (while (and start (< start end))
393 : ;; Determine the end of this chunk.
394 0 : (setq next (or (text-property-any start end 'fontified t)
395 0 : end))
396 :
397 : ;; Avoid unnecessary work if the chunk is empty (bug#23278).
398 0 : (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 0 : (put-text-property start next 'fontified t)
403 0 : (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 0 : (condition-case err
409 0 : (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 0 : (quit (put-text-property start next 'fontified nil)
414 0 : (signal (car err) (cdr err))))))
415 :
416 : ;; In case we fontified more than requested, take advantage of the
417 : ;; good news.
418 0 : (when (or (< tight-beg start) (> tight-end next))
419 0 : (put-text-property tight-beg tight-end 'fontified t))
420 :
421 : ;; Make sure the contextual refontification doesn't re-refontify
422 : ;; what's already been refontified.
423 0 : (when (and jit-lock-context-unfontify-pos
424 0 : (< jit-lock-context-unfontify-pos tight-end)
425 0 : (>= 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 0 : (not (get-text-property tight-beg
431 0 : 'jit-lock-defer-multiline)))
432 0 : (setq jit-lock-context-unfontify-pos tight-end))
433 :
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 0 : (when (< loose-beg orig-start)
444 0 : (run-with-timer 0 nil #'jit-lock-force-redisplay
445 0 : (copy-marker loose-beg)
446 0 : (copy-marker orig-start)))
447 :
448 : ;; Skip to the end of the fully refontified part.
449 0 : (setq start tight-end)))
450 : ;; Find the start of the next chunk, if any.
451 0 : (setq start
452 0 : (text-property-any start end 'fontified nil))))))))
453 :
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 0 : (when (marker-buffer start)
458 0 : (with-current-buffer (marker-buffer start)
459 0 : (with-buffer-prepared-for-jit-lock
460 0 : (when (> end (point-max))
461 0 : (setq end (point-max) start (min start end)))
462 0 : (when (< start (point-min))
463 0 : (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 0 : (put-text-property start end 'fontified t)))))
467 :
468 : ;;; Stealth fontification.
469 :
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 0 : (if (zerop (buffer-size))
474 : nil
475 0 : (let* ((next (text-property-not-all around (point-max) 'fontified t))
476 0 : (prev (previous-single-property-change around 'fontified))
477 0 : (prop (get-text-property (max (point-min) (1- around))
478 0 : 'fontified))
479 0 : (start (cond
480 0 : ((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 0 : (if (eq prop t)
486 : nil
487 0 : (max (point-min)
488 0 : (- around (/ jit-lock-chunk-size 2)))))
489 0 : ((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 0 : (max (or (previous-single-property-change prev 'fontified)
495 0 : (point-min))
496 0 : (- prev jit-lock-chunk-size)))
497 : (t
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 0 : (max prev (- around jit-lock-chunk-size)))))
503 0 : (result (cond ((null start) next)
504 0 : ((null next) start)
505 0 : ((< (- around start) (- next around)) start)
506 0 : (t next))))
507 0 : result)))
508 :
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 0 : (unless repeat
516 0 : (cancel-timer jit-lock-stealth-repeat-timer))
517 0 : (unless (or executing-kbd-macro
518 0 : memory-full
519 0 : (window-minibuffer-p)
520 : ;; For first invocation set up `jit-lock-stealth-buffers'.
521 : ;; In repeated invocations it's already been set up.
522 0 : (null (if repeat
523 0 : jit-lock-stealth-buffers
524 0 : (setq jit-lock-stealth-buffers (buffer-list)))))
525 0 : (let ((buffer (car jit-lock-stealth-buffers))
526 : (delay 0)
527 : minibuffer-auto-raise
528 : message-log-max
529 : start)
530 0 : (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 0 : (> (or (car (load-average)) 0) jit-lock-stealth-load))
535 : ;; Wait a little if load is too high.
536 0 : (setq delay jit-lock-stealth-time)
537 0 : (if (buffer-live-p buffer)
538 0 : (with-current-buffer buffer
539 0 : (if (and jit-lock-mode
540 0 : (setq start (jit-lock-stealth-chunk-start (point))))
541 : ;; Fontify one block of at most `jit-lock-chunk-size'
542 : ;; characters.
543 0 : (with-temp-message (if jit-lock-stealth-verbose
544 0 : (concat "JIT stealth lock "
545 0 : (buffer-name)))
546 0 : (jit-lock-fontify-now start
547 0 : (+ start jit-lock-chunk-size))
548 : ;; Run again after `jit-lock-stealth-nice' seconds.
549 0 : (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 0 : (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 0 : (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers))))
556 : ;; Call us again.
557 0 : (when jit-lock-stealth-buffers
558 0 : (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time))
559 0 : (timer-inc-time jit-lock-stealth-repeat-timer delay)
560 0 : (timer-activate-when-idle jit-lock-stealth-repeat-timer t)))))
561 :
562 :
563 : ;;; Deferred fontification.
564 :
565 : (defun jit-lock-deferred-fontify ()
566 : "Fontify what was deferred."
567 0 : (when (and jit-lock-defer-buffers (not memory-full))
568 : ;; Mark the deferred regions back to `fontified = nil'
569 0 : (dolist (buffer jit-lock-defer-buffers)
570 0 : (when (buffer-live-p buffer)
571 0 : (with-current-buffer buffer
572 : ;; (message "Jit-Defer %s" (buffer-name))
573 0 : (with-buffer-prepared-for-jit-lock
574 0 : (let ((pos (point-min)))
575 0 : (while
576 0 : (progn
577 0 : (when (eq (get-text-property pos 'fontified) 'defer)
578 0 : (put-text-property
579 0 : pos (setq pos (next-single-property-change
580 0 : pos 'fontified nil (point-max)))
581 0 : 'fontified nil))
582 0 : (setq pos (next-single-property-change
583 0 : pos 'fontified)))))))))
584 : ;; Force fontification of the visible parts.
585 0 : (let ((buffers jit-lock-defer-buffers)
586 : (jit-lock-defer-timer nil))
587 0 : (setq jit-lock-defer-buffers nil)
588 : ;; (message "Jit-Defer Now")
589 0 : (unless (redisplay) ;FIXME: Should we `force'?
590 0 : (setq jit-lock-defer-buffers buffers))
591 : ;; (message "Jit-Defer Done")
592 0 : )))
593 :
594 :
595 : (defun jit-lock-context-fontify ()
596 : "Refresh fontification to take new context into account."
597 0 : (unless memory-full
598 0 : (dolist (buffer (buffer-list))
599 0 : (with-current-buffer buffer
600 0 : (when jit-lock-context-unfontify-pos
601 : ;; (message "Jit-Context %s" (buffer-name))
602 0 : (save-restriction
603 : ;; Don't be blindsided by narrowing that starts in the middle
604 : ;; of a jit-lock-defer-multiline.
605 0 : (widen)
606 0 : (when (and (>= jit-lock-context-unfontify-pos (point-min))
607 0 : (< 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 0 : (when (get-text-property jit-lock-context-unfontify-pos
615 0 : 'jit-lock-defer-multiline)
616 0 : (setq jit-lock-context-unfontify-pos
617 0 : (or (previous-single-property-change
618 0 : jit-lock-context-unfontify-pos
619 0 : 'jit-lock-defer-multiline)
620 0 : (point-min))))
621 0 : (with-buffer-prepared-for-jit-lock
622 : ;; Force contextual refontification.
623 0 : (remove-text-properties
624 0 : jit-lock-context-unfontify-pos (point-max)
625 0 : '(fontified nil jit-lock-defer-multiline nil)))
626 0 : (setq jit-lock-context-unfontify-pos (point-max)))))))))
627 :
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'.
635 :
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').")
640 :
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 0 : (when (and jit-lock-mode (not memory-full))
650 0 : (let ((jit-lock-start start)
651 0 : (jit-lock-end end))
652 0 : (with-buffer-prepared-for-jit-lock
653 0 : (run-hook-with-args 'jit-lock-after-change-extend-region-functions
654 0 : start end old-len)
655 : ;; Make sure we change at least one char (in case of deletions).
656 0 : (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
657 : ;; Request refontification.
658 0 : (save-restriction
659 0 : (widen)
660 0 : (put-text-property jit-lock-start jit-lock-end 'fontified nil)))
661 : ;; Mark the change for deferred contextual refontification.
662 0 : (when jit-lock-context-unfontify-pos
663 0 : (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 0 : (min jit-lock-context-unfontify-pos jit-lock-start))))))
670 :
671 : (provide 'jit-lock)
672 :
673 : ;;; jit-lock.el ends here
|