127 |
(other :tag "syntax-driven" syntax-driven)) |
(other :tag "syntax-driven" syntax-driven)) |
128 |
:group 'jit-lock) |
:group 'jit-lock) |
129 |
|
|
130 |
|
(defcustom jit-lock-defer-time nil ;; 0.5 |
131 |
|
"Idle time after which deferred fontification should take place. |
132 |
|
If nil, fontification is not deferred." |
133 |
|
:group 'jit-lock |
134 |
|
:type '(choice (const :tag "never" nil) |
135 |
|
(number :tag "seconds"))) |
136 |
|
|
137 |
;;; Variables that are not customizable. |
;;; Variables that are not customizable. |
138 |
|
|
153 |
|
|
154 |
(defvar jit-lock-stealth-timer nil |
(defvar jit-lock-stealth-timer nil |
155 |
"Timer for stealth fontification in Just-in-time Lock mode.") |
"Timer for stealth fontification in Just-in-time Lock mode.") |
156 |
|
|
157 |
|
(defvar jit-lock-defer-timer nil |
158 |
|
"Timer for deferred fontification in Just-in-time Lock mode.") |
159 |
|
|
160 |
|
(defvar jit-lock-buffers nil |
161 |
|
"List of buffers with pending deferred fontification.") |
162 |
|
|
163 |
;;; JIT lock mode |
;;; JIT lock mode |
164 |
|
|
197 |
(cond (;; Turn Just-in-time Lock mode on. |
(cond (;; Turn Just-in-time Lock mode on. |
198 |
jit-lock-mode |
jit-lock-mode |
199 |
|
|
200 |
;; Mark the buffer for refontification |
;; Mark the buffer for refontification. |
201 |
(jit-lock-refontify) |
(jit-lock-refontify) |
202 |
|
|
203 |
;; Install an idle timer for stealth fontification. |
;; Install an idle timer for stealth fontification. |
204 |
(when (and jit-lock-stealth-time (null jit-lock-stealth-timer)) |
(when (and jit-lock-stealth-time (null jit-lock-stealth-timer)) |
205 |
(setq jit-lock-stealth-timer |
(setq jit-lock-stealth-timer |
206 |
(run-with-idle-timer jit-lock-stealth-time |
(run-with-idle-timer jit-lock-stealth-time t |
|
jit-lock-stealth-time |
|
207 |
'jit-lock-stealth-fontify))) |
'jit-lock-stealth-fontify))) |
208 |
|
|
209 |
|
;; Init deferred fontification timer. |
210 |
|
(when (and jit-lock-defer-time (null jit-lock-defer-timer)) |
211 |
|
(setq jit-lock-defer-timer |
212 |
|
(run-with-idle-timer jit-lock-defer-time t |
213 |
|
'jit-lock-deferred-fontify))) |
214 |
|
|
215 |
;; Initialize deferred contextual fontification if requested. |
;; Initialize deferred contextual fontification if requested. |
216 |
(when (eq jit-lock-defer-contextually t) |
(when (eq jit-lock-defer-contextually t) |
217 |
(setq jit-lock-first-unfontify-pos |
(setq jit-lock-first-unfontify-pos |
223 |
|
|
224 |
;; Turn Just-in-time Lock mode off. |
;; Turn Just-in-time Lock mode off. |
225 |
(t |
(t |
226 |
;; Cancel our idle timer. |
;; Cancel our idle timers. |
227 |
(when jit-lock-stealth-timer |
(when (and (or jit-lock-stealth-timer jit-lock-defer-timer) |
228 |
(cancel-timer jit-lock-stealth-timer) |
;; Only if there's no other buffer using them. |
229 |
(setq jit-lock-stealth-timer nil)) |
(not (catch 'found |
230 |
|
(dolist (buf (buffer-list)) |
231 |
|
(with-current-buffer buf |
232 |
|
(when jit-lock-mode (throw 'found t))))))) |
233 |
|
(when jit-lock-stealth-timer |
234 |
|
(cancel-timer jit-lock-stealth-timer) |
235 |
|
(setq jit-lock-stealth-timer nil)) |
236 |
|
(when jit-lock-defer-timer |
237 |
|
(cancel-timer jit-lock-defer-timer) |
238 |
|
(setq jit-lock-defer-timer nil))) |
239 |
|
|
240 |
;; Remove hooks. |
;; Remove hooks. |
241 |
(remove-hook 'after-change-functions 'jit-lock-after-change t) |
(remove-hook 'after-change-functions 'jit-lock-after-change t) |
267 |
(with-buffer-prepared-for-jit-lock |
(with-buffer-prepared-for-jit-lock |
268 |
(save-restriction |
(save-restriction |
269 |
(widen) |
(widen) |
270 |
(add-text-properties (or beg (point-min)) (or end (point-max)) |
(put-text-property (or beg (point-min)) (or end (point-max)) |
271 |
'(fontified nil))))) |
'fontified nil)))) |
272 |
|
|
273 |
;;; On demand fontification. |
;;; On demand fontification. |
274 |
|
|
277 |
This function is added to `fontification-functions' when `jit-lock-mode' |
This function is added to `fontification-functions' when `jit-lock-mode' |
278 |
is active." |
is active." |
279 |
(when jit-lock-mode |
(when jit-lock-mode |
280 |
(jit-lock-fontify-now start (+ start jit-lock-chunk-size)))) |
(if (null jit-lock-defer-time) |
281 |
|
;; No deferral. |
282 |
|
(jit-lock-fontify-now start (+ start jit-lock-chunk-size)) |
283 |
|
;; Record the buffer for later fontification. |
284 |
|
(unless (memq (current-buffer) jit-lock-buffers) |
285 |
|
(push (current-buffer) jit-lock-buffers)) |
286 |
|
;; Mark the area as defer-fontified so that the redisplay engine |
287 |
|
;; is happy and so that the idle timer can find the places to fontify. |
288 |
|
(with-buffer-prepared-for-jit-lock |
289 |
|
(put-text-property start |
290 |
|
(next-single-property-change |
291 |
|
start 'fontified nil |
292 |
|
(min (point-max) (+ start jit-lock-chunk-size))) |
293 |
|
'fontified 'defer))))) |
294 |
|
|
295 |
(defun jit-lock-fontify-now (&optional start end) |
(defun jit-lock-fontify-now (&optional start end) |
296 |
"Fontify current buffer from START to END. |
"Fontify current buffer from START to END. |
331 |
;; Fontify the chunk, and mark it as fontified. |
;; Fontify the chunk, and mark it as fontified. |
332 |
;; We mark it first, to make sure that we don't indefinitely |
;; We mark it first, to make sure that we don't indefinitely |
333 |
;; re-execute this fontification if an error occurs. |
;; re-execute this fontification if an error occurs. |
334 |
(add-text-properties start next '(fontified t)) |
(put-text-property start next 'fontified t) |
335 |
(run-hook-with-args 'jit-lock-functions start next) |
(run-hook-with-args 'jit-lock-functions start next) |
336 |
|
|
337 |
;; Find the start of the next chunk, if any. |
;; Find the start of the next chunk, if any. |
338 |
(setq start (text-property-any next end 'fontified nil))))))))) |
(setq start (text-property-any next end 'fontified nil))))))))) |
339 |
|
|
347 |
nil |
nil |
348 |
(save-restriction |
(save-restriction |
349 |
(widen) |
(widen) |
350 |
(let* ((next (text-property-any around (point-max) 'fontified nil)) |
(let* ((next (text-property-not-all around (point-max) 'fontified t)) |
351 |
(prev (previous-single-property-change around 'fontified)) |
(prev (previous-single-property-change around 'fontified)) |
352 |
(prop (get-text-property (max (point-min) (1- around)) |
(prop (get-text-property (max (point-min) (1- around)) |
353 |
'fontified)) |
'fontified)) |
357 |
;; and the start of the buffer. If PROP is |
;; and the start of the buffer. If PROP is |
358 |
;; non-nil, everything in front of AROUND is |
;; non-nil, everything in front of AROUND is |
359 |
;; fontified, otherwise nothing is fontified. |
;; fontified, otherwise nothing is fontified. |
360 |
(if prop |
(if (eq prop t) |
361 |
nil |
nil |
362 |
(max (point-min) |
(max (point-min) |
363 |
(- around (/ jit-lock-chunk-size 2))))) |
(- around (/ jit-lock-chunk-size 2))))) |
364 |
(prop |
((eq prop t) |
365 |
;; PREV is the start of a region of fontified |
;; PREV is the start of a region of fontified |
366 |
;; text containing AROUND. Start fontifying a |
;; text containing AROUND. Start fontifying a |
367 |
;; chunk size before the end of the unfontified |
;; chunk size before the end of the unfontified |
386 |
"Fontify buffers stealthily. |
"Fontify buffers stealthily. |
387 |
This functions is called after Emacs has been idle for |
This functions is called after Emacs has been idle for |
388 |
`jit-lock-stealth-time' seconds." |
`jit-lock-stealth-time' seconds." |
389 |
|
;; I used to check `inhibit-read-only' here, but I can't remember why. -stef |
390 |
(unless (or executing-kbd-macro |
(unless (or executing-kbd-macro |
391 |
(window-minibuffer-p (selected-window))) |
(window-minibuffer-p (selected-window))) |
392 |
(let ((buffers (buffer-list)) |
(let ((buffers (buffer-list)) |
422 |
(widen) |
(widen) |
423 |
(when (and (>= jit-lock-first-unfontify-pos (point-min)) |
(when (and (>= jit-lock-first-unfontify-pos (point-min)) |
424 |
(< jit-lock-first-unfontify-pos (point-max))) |
(< jit-lock-first-unfontify-pos (point-max))) |
425 |
|
;; If we're in text that matches a complex multi-line |
426 |
|
;; font-lock pattern, make sure the whole text will be |
427 |
|
;; redisplayed eventually. |
428 |
|
(when (get-text-property jit-lock-first-unfontify-pos |
429 |
|
'jit-lock-defer-multiline) |
430 |
|
(setq jit-lock-first-unfontify-pos |
431 |
|
(or (previous-single-property-change |
432 |
|
jit-lock-first-unfontify-pos |
433 |
|
'jit-lock-defer-multiline) |
434 |
|
(point-min)))) |
435 |
(with-buffer-prepared-for-jit-lock |
(with-buffer-prepared-for-jit-lock |
436 |
(put-text-property jit-lock-first-unfontify-pos |
(remove-text-properties |
437 |
(point-max) 'fontified nil)) |
jit-lock-first-unfontify-pos (point-max) |
438 |
|
'(fontified nil jit-lock-defer-multiline nil))) |
439 |
(setq jit-lock-first-unfontify-pos (point-max))))) |
(setq jit-lock-first-unfontify-pos (point-max))))) |
440 |
|
|
441 |
;; In the following code, the `sit-for' calls cause a |
;; In the following code, the `sit-for' calls cause a |
445 |
;; an unmodified buffer would show a `*'. |
;; an unmodified buffer would show a `*'. |
446 |
(let (start |
(let (start |
447 |
(nice (or jit-lock-stealth-nice 0)) |
(nice (or jit-lock-stealth-nice 0)) |
448 |
(point (point))) |
(point (point-min))) |
449 |
(while (and (setq start |
(while (and (setq start |
450 |
(jit-lock-stealth-chunk-start point)) |
(jit-lock-stealth-chunk-start point)) |
451 |
(sit-for nice)) |
(sit-for nice)) |
452 |
|
|
453 |
|
;; fontify a block. |
454 |
|
(jit-lock-fontify-now start (+ start jit-lock-chunk-size)) |
455 |
|
;; If stealth jit-locking is done backwards, this leads to |
456 |
|
;; excessive O(n^2) refontification. -stef |
457 |
|
;; (when (>= jit-lock-first-unfontify-pos start) |
458 |
|
;; (setq jit-lock-first-unfontify-pos end)) |
459 |
|
|
460 |
;; Wait a little if load is too high. |
;; Wait a little if load is too high. |
461 |
(when (and jit-lock-stealth-load |
(when (and jit-lock-stealth-load |
462 |
(> (car (load-average)) jit-lock-stealth-load)) |
(> (car (load-average)) jit-lock-stealth-load)) |
463 |
(sit-for (or jit-lock-stealth-time 30))) |
(sit-for (or jit-lock-stealth-time 30))))))))))))) |
|
|
|
|
;; Unless there's input pending now, fontify. |
|
|
(unless (input-pending-p) |
|
|
(jit-lock-fontify-now |
|
|
start (+ start jit-lock-chunk-size))))))))))))) |
|
464 |
|
|
465 |
|
|
466 |
|
|
467 |
;;; Deferred fontification. |
;;; Deferred fontification. |
468 |
|
|
469 |
|
(defun jit-lock-deferred-fontify () |
470 |
|
"Fontify what was deferred." |
471 |
|
(when jit-lock-buffers |
472 |
|
;; Mark the deferred regions back to `fontified = nil' |
473 |
|
(dolist (buffer jit-lock-buffers) |
474 |
|
(when (buffer-live-p buffer) |
475 |
|
(with-current-buffer buffer |
476 |
|
;; (message "Jit-Defer %s" (buffer-name)) |
477 |
|
(with-buffer-prepared-for-jit-lock |
478 |
|
(let ((pos (point-min))) |
479 |
|
(while |
480 |
|
(progn |
481 |
|
(when (eq (get-text-property pos 'fontified) 'defer) |
482 |
|
(put-text-property |
483 |
|
pos (setq pos (next-single-property-change |
484 |
|
pos 'fontified nil (point-max))) |
485 |
|
'fontified nil)) |
486 |
|
(setq pos (next-single-property-change pos 'fontified))))))))) |
487 |
|
(setq jit-lock-buffers nil) |
488 |
|
;; Force fontification of the visible parts. |
489 |
|
(let ((jit-lock-defer-time nil)) |
490 |
|
;; (message "Jit-Defer Now") |
491 |
|
(sit-for 0) |
492 |
|
;; (message "Jit-Defer Done") |
493 |
|
))) |
494 |
|
|
495 |
|
|
496 |
(defun jit-lock-after-change (start end old-len) |
(defun jit-lock-after-change (start end old-len) |
497 |
"Mark the rest of the buffer as not fontified after a change. |
"Mark the rest of the buffer as not fontified after a change. |
498 |
Installed on `after-change-functions'. |
Installed on `after-change-functions'. |
513 |
|
|
514 |
;; If we're in text that matches a multi-line font-lock pattern, |
;; If we're in text that matches a multi-line font-lock pattern, |
515 |
;; make sure the whole text will be redisplayed. |
;; make sure the whole text will be redisplayed. |
516 |
|
;; I'm not sure this is ever necessary and/or sufficient. -stef |
517 |
(when (get-text-property start 'font-lock-multiline) |
(when (get-text-property start 'font-lock-multiline) |
518 |
(setq start (or (previous-single-property-change |
(setq start (or (previous-single-property-change |
519 |
start 'font-lock-multiline) |
start 'font-lock-multiline) |