25003
|
1 ;;; jit-lock.el --- just-in-time fontification.
|
|
2
|
|
3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Gerd Moellmann <gerd@gnu.org>
|
|
6 ;; Keywords: faces files
|
|
7 ;; Version: 1.0
|
|
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 2, or (at your option)
|
|
14 ;; 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; see the file COPYING. If not, write to the
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;; Just-in-time fontification, triggered by C redisplay code.
|
|
29
|
|
30 ;;; Code:
|
|
31
|
|
32
|
|
33 (require 'font-lock)
|
|
34
|
|
35 (eval-when-compile
|
|
36 (defmacro with-buffer-prepared-for-font-lock (&rest body)
|
|
37 "Execute BODY in current buffer, overriding several variables.
|
|
38 Preserves the `buffer-modified-p' state of the current buffer."
|
|
39 `(let ((modified (buffer-modified-p))
|
|
40 (buffer-undo-list t)
|
|
41 (inhibit-read-only t)
|
|
42 (inhibit-point-motion-hooks t)
|
|
43 before-change-functions
|
|
44 after-change-functions
|
|
45 deactivate-mark
|
|
46 buffer-file-name
|
|
47 buffer-file-truename)
|
|
48 ,@body
|
|
49 (set-buffer-modified-p modified))))
|
|
50
|
|
51
|
|
52
|
|
53 ;;; Customization.
|
|
54
|
|
55 (defcustom jit-lock-chunk-size 500
|
|
56 "*Font-lock chunks of this many characters, or smaller."
|
|
57 :type 'integer
|
|
58 :group 'jit-lock)
|
|
59
|
|
60
|
|
61 (defcustom jit-lock-stealth-time 3
|
|
62 "*Time in seconds to wait before beginning stealth fontification.
|
|
63 Stealth fontification occurs if there is no input within this time.
|
|
64 If nil, means stealth fontification is never performed.
|
|
65
|
|
66 The value of this variable is used when JIT Lock mode is turned on."
|
|
67 :type '(choice (const :tag "never" nil)
|
|
68 (number :tag "seconds"))
|
|
69 :group 'jit-lock)
|
|
70
|
|
71
|
|
72 (defcustom jit-lock-stealth-nice 0.125
|
|
73 "*Time in seconds to pause between chunks of stealth fontification.
|
|
74 Each iteration of stealth fontification is separated by this amount of time,
|
|
75 thus reducing the demand that stealth fontification makes on the system.
|
|
76 If nil, means stealth fontification is never paused.
|
|
77 To reduce machine load during stealth fontification, at the cost of stealth
|
|
78 taking longer to fontify, you could increase the value of this variable.
|
|
79 See also `jit-lock-stealth-load'."
|
|
80 :type '(choice (const :tag "never" nil)
|
|
81 (number :tag "seconds"))
|
|
82 :group 'jit-lock)
|
|
83
|
|
84
|
|
85 (defcustom jit-lock-stealth-load
|
|
86 (if (condition-case nil (load-average) (error)) 200)
|
|
87 "*Load in percentage above which stealth fontification is suspended.
|
|
88 Stealth fontification pauses when the system short-term load average (as
|
|
89 returned by the function `load-average' if supported) goes above this level,
|
|
90 thus reducing the demand that stealth fontification makes on the system.
|
|
91 If nil, means stealth fontification is never suspended.
|
|
92 To reduce machine load during stealth fontification, at the cost of stealth
|
|
93 taking longer to fontify, you could reduce the value of this variable.
|
|
94 See also `jit-lock-stealth-nice'."
|
|
95 :type (if (condition-case nil (load-average) (error))
|
|
96 '(choice (const :tag "never" nil)
|
|
97 (integer :tag "load"))
|
|
98 '(const :format "%t: unsupported\n" nil))
|
|
99 :group 'jit-lock)
|
|
100
|
|
101
|
|
102 (defcustom jit-lock-stealth-verbose nil
|
|
103 "*If non-nil, means stealth fontification should show status messages."
|
|
104 :type 'boolean
|
|
105 :group 'jit-lock)
|
|
106
|
|
107
|
|
108 (defcustom jit-lock-defer-contextually 'syntax-driven
|
|
109 "*If non-nil, means deferred fontification should be syntactically true.
|
|
110 If nil, means deferred fontification occurs only on those lines modified. This
|
|
111 means where modification on a line causes syntactic change on subsequent lines,
|
|
112 those subsequent lines are not refontified to reflect their new context.
|
|
113 If t, means deferred fontification occurs on those lines modified and all
|
|
114 subsequent lines. This means those subsequent lines are refontified to reflect
|
|
115 their new syntactic context, either immediately or when scrolling into them.
|
|
116 If any other value, e.g., `syntax-driven', means deferred syntactically true
|
|
117 fontification occurs only if syntactic fontification is performed using the
|
|
118 buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
|
|
119
|
|
120 The value of this variable is used when JIT Lock mode is turned on."
|
|
121 :type '(choice (const :tag "never" nil)
|
|
122 (const :tag "always" t)
|
|
123 (other :tag "syntax-driven" syntax-driven))
|
|
124 :group 'jit-lock)
|
|
125
|
|
126
|
|
127
|
|
128 ;;; Variables that are not customizable.
|
|
129
|
|
130 (defvar jit-lock-mode nil
|
|
131 "Non-nil means Just-in-time Lock mode is active.")
|
|
132 (make-variable-buffer-local 'jit-lock-mode)
|
|
133
|
|
134
|
|
135 (defvar jit-lock-first-unfontify-pos nil
|
|
136 "Consider text after this position as unfontified.")
|
|
137 (make-variable-buffer-local 'jit-lock-first-unfontify-pos)
|
|
138
|
|
139
|
|
140 (defvar jit-lock-stealth-timer nil
|
|
141 "Timer for stealth fontification in Just-in-time Lock mode.")
|
|
142
|
|
143
|
|
144
|
|
145 ;;; JIT lock mode
|
|
146
|
|
147 ;;;###autoload
|
|
148 (defun jit-lock-mode (arg)
|
|
149 "Toggle Just-in-time Lock mode.
|
|
150 With arg, turn Just-in-time Lock mode on if and only if arg is positive.
|
|
151 Enable it automatically by customizing group `font-lock'.
|
|
152
|
|
153 When Just-in-time Lock mode is enabled, fontification is different in the
|
|
154 following ways:
|
|
155
|
|
156 - Demand-driven buffer fontification triggered by Emacs C code.
|
|
157 This means initial fontification of the whole buffer does not occur.
|
|
158 Instead, fontification occurs when necessary, such as when scrolling
|
|
159 through the buffer would otherwise reveal unfontified areas. This is
|
|
160 useful if buffer fontification is too slow for large buffers.
|
|
161
|
|
162 - Stealthy buffer fontification if `jit-lock-stealth-time' is non-nil.
|
|
163 This means remaining unfontified areas of buffers are fontified if Emacs has
|
|
164 been idle for `jit-lock-stealth-time' seconds, while Emacs remains idle.
|
|
165 This is useful if any buffer has any deferred fontification.
|
|
166
|
|
167 - Deferred context fontification if `jit-lock-defer-contextually' is
|
|
168 non-nil. This means fontification updates the buffer corresponding to
|
|
169 true syntactic context, after `jit-lock-stealth-time' seconds of Emacs
|
|
170 idle time, while Emacs remains idle. Otherwise, fontification occurs
|
|
171 on modified lines only, and subsequent lines can remain fontified
|
|
172 corresponding to previous syntactic contexts. This is useful where
|
|
173 strings or comments span lines.
|
|
174
|
|
175 Stealth fontification only occurs while the system remains unloaded.
|
|
176 If the system load rises above `jit-lock-stealth-load' percent, stealth
|
|
177 fontification is suspended. Stealth fontification intensity is controlled via
|
|
178 the variable `jit-lock-stealth-nice' and `jit-lock-stealth-lines'."
|
|
179 (interactive "P")
|
|
180 (setq jit-lock-mode (if arg
|
|
181 (> (prefix-numeric-value arg) 0)
|
|
182 (not jit-lock-mode)))
|
|
183 (cond ((and jit-lock-mode
|
|
184 (or (not (boundp 'font-lock-mode))
|
|
185 (not font-lock-mode)))
|
|
186 ;; If font-lock is not on, turn it on, with Just-in-time
|
|
187 ;; Lock mode as support mode; font-lock will call us again.
|
|
188 (let ((font-lock-support-mode 'jit-lock-mode))
|
|
189 (font-lock-mode t)))
|
|
190
|
|
191 ;; Turn Just-in-time Lock mode on.
|
|
192 (jit-lock-mode
|
|
193 ;; Setting `font-lock-fontified' makes font-lock believe the
|
|
194 ;; buffer is already fontified, so that it won't highlight
|
|
195 ;; the whole buffer.
|
|
196 (make-local-variable 'font-lock-fontified)
|
|
197 (setq font-lock-fontified t)
|
|
198
|
|
199 (setq jit-lock-first-unfontify-pos nil)
|
|
200
|
|
201 ;; Install an idle timer for stealth fontification.
|
|
202 (when (and jit-lock-stealth-time
|
|
203 (null jit-lock-stealth-timer))
|
|
204 (setq jit-lock-stealth-timer
|
|
205 (run-with-idle-timer jit-lock-stealth-time
|
|
206 jit-lock-stealth-time
|
|
207 'jit-lock-stealth-fontify)))
|
|
208
|
|
209 ;; Add a hook for deferred contectual fontification.
|
|
210 (when (or (eq jit-lock-defer-contextually 'always)
|
|
211 (and (not (eq jit-lock-defer-contextually 'never))
|
|
212 (null font-lock-keywords-only)))
|
|
213 (add-hook 'after-change-functions 'jit-lock-after-change))
|
|
214
|
|
215 ;; Install the fontification hook.
|
|
216 (add-hook 'fontification-functions 'jit-lock-function))
|
|
217
|
|
218 ;; Turn Just-in-time Lock mode off.
|
|
219 (t
|
|
220 ;; Cancel our idle timer.
|
|
221 (when jit-lock-stealth-timer
|
|
222 (cancel-timer jit-lock-stealth-timer)
|
|
223 (setq jit-lock-stealth-timer nil))
|
|
224
|
|
225 ;; Remove hooks.
|
|
226 (remove-hook 'after-change-functions 'jit-lock-after-change)
|
|
227 (remove-hook 'fontification-functions 'jit-lock-function))))
|
|
228
|
|
229
|
|
230 ;;;###autoload
|
|
231 (defun turn-on-jit-lock ()
|
|
232 "Unconditionally turn on Just-in-time Lock mode."
|
|
233 (jit-lock-mode 1))
|
|
234
|
|
235
|
|
236
|
|
237 ;;; On demand fontification.
|
|
238
|
|
239 (defun jit-lock-function (start)
|
|
240 "Fontify current buffer starting at position START.
|
|
241 This function is added to `fontification-functions' when `jit-lock-mode'
|
|
242 is active."
|
|
243 (when jit-lock-mode
|
|
244 (with-buffer-prepared-for-font-lock
|
|
245 (let ((end (min (point-max) (+ start jit-lock-chunk-size)))
|
|
246 (parse-sexp-lookup-properties font-lock-syntactic-keywords)
|
|
247 (old-syntax-table (syntax-table))
|
|
248 (font-lock-beginning-of-syntax-function nil)
|
25395
|
249 next font-lock-start font-lock-end)
|
25003
|
250 (when font-lock-syntax-table
|
|
251 (set-syntax-table font-lock-syntax-table))
|
|
252 (save-excursion
|
|
253 (save-restriction
|
|
254 (widen)
|
|
255 (save-match-data
|
|
256 (condition-case error
|
|
257 ;; Fontify chunks beginning at START. The end of a
|
|
258 ;; chunk is either `end', or the start of a region
|
|
259 ;; before `end' that has already been fontified.
|
|
260 (while start
|
|
261 ;; Determine the end of this chunk.
|
|
262 (setq next (or (text-property-any start end 'fontified t)
|
|
263 end))
|
25395
|
264
|
|
265 ;; Decide which range of text should be fontified.
|
|
266 ;; The problem is that START and NEXT may be in the
|
|
267 ;; middle of something matched by a font-lock regexp.
|
|
268 ;; Until someone has a better idea, let's start
|
|
269 ;; at the start of the line containing START and
|
|
270 ;; stop at the start of the line following NEXT.
|
|
271 (goto-char next)
|
|
272 (setq font-lock-end (line-beginning-position 2))
|
25003
|
273 (goto-char start)
|
25395
|
274 (setq font-lock-start (line-beginning-position))
|
25003
|
275
|
|
276 ;; Fontify the chunk, and mark it as fontified.
|
25395
|
277 (font-lock-fontify-region font-lock-start font-lock-end nil)
|
25003
|
278 (add-text-properties start next '(fontified t))
|
|
279
|
|
280 ;; Find the start of the next chunk, if any.
|
|
281 (setq start (text-property-any next end 'fontified nil)))
|
|
282
|
|
283 ((error quit)
|
|
284 (message "Fontifying region...%s" error))))))
|
|
285
|
|
286 ;; Restore previous buffer settings.
|
|
287 (set-syntax-table old-syntax-table)))))
|
|
288
|
|
289
|
|
290 (defun jit-lock-after-fontify-buffer ()
|
|
291 "Mark the current buffer as fontified.
|
|
292 Called from `font-lock-after-fontify-buffer."
|
|
293 (with-buffer-prepared-for-font-lock
|
|
294 (add-text-properties (point-min) (point-max) '(fontified t))))
|
|
295
|
|
296
|
|
297 (defun jit-lock-after-unfontify-buffer ()
|
|
298 "Mark the current buffer as unfontified.
|
|
299 Called from `font-lock-after-fontify-buffer."
|
|
300 (with-buffer-prepared-for-font-lock
|
|
301 (remove-text-properties (point-min) (point-max) '(fontified nil))))
|
|
302
|
|
303
|
|
304
|
|
305 ;;; Stealth fontification.
|
|
306
|
|
307 (defsubst jit-lock-stealth-chunk-start (around)
|
|
308 "Return the start of the next chunk to fontify around position AROUND..
|
|
309 Value is nil if there is nothing more to fontify."
|
|
310 (save-restriction
|
|
311 (widen)
|
|
312 (let ((prev (previous-single-property-change around 'fontified))
|
|
313 (next (text-property-any around (point-max) 'fontified nil))
|
|
314 (prop (get-text-property around 'fontified)))
|
|
315 (cond ((and (null prop)
|
|
316 (< around (point-max)))
|
|
317 ;; Text at position AROUND is not fontified. The value of
|
|
318 ;; prev, if non-nil, is the start of the region of
|
|
319 ;; unfontified text. As a special case, prop will always
|
|
320 ;; be nil at point-max. So don't handle that case here.
|
|
321 (max (or prev (point-min))
|
|
322 (- around jit-lock-chunk-size)))
|
|
323
|
|
324 ((null prev)
|
|
325 ;; Text at AROUND is fontified, and everything up to
|
|
326 ;; point-min is. Return the value of next. If that is
|
|
327 ;; nil, there is nothing left to fontify.
|
|
328 next)
|
|
329
|
|
330 ((or (null next)
|
|
331 (< (- around prev) (- next around)))
|
|
332 ;; We either have no unfontified text following AROUND, or
|
|
333 ;; the unfontified text in front of AROUND is nearer. The
|
|
334 ;; value of prev is the end of the region of unfontified
|
|
335 ;; text in front of AROUND.
|
|
336 (let ((start (previous-single-property-change prev 'fontified)))
|
|
337 (max (or start (point-min))
|
|
338 (- prev jit-lock-chunk-size))))
|
|
339
|
|
340 (t
|
|
341 next)))))
|
|
342
|
|
343
|
|
344 (defun jit-lock-stealth-fontify ()
|
|
345 "Fontify buffers stealthily.
|
|
346 This functions is called after Emacs has been idle for
|
|
347 `jit-lock-stealth-time' seconds."
|
|
348 (unless (or executing-kbd-macro
|
|
349 (window-minibuffer-p (selected-window)))
|
|
350 (let ((buffers (buffer-list))
|
|
351 minibuffer-auto-raise
|
|
352 message-log-max)
|
|
353 (while (and buffers
|
|
354 (not (input-pending-p)))
|
|
355 (let ((buffer (car buffers)))
|
|
356 (setq buffers (cdr buffers))
|
|
357 (with-current-buffer buffer
|
|
358 (when jit-lock-mode
|
|
359 ;; This is funny. Calling sit-for with 3rd arg non-nil
|
|
360 ;; so that it doesn't redisplay, internally calls
|
|
361 ;; wait_reading_process_input also with a parameter
|
|
362 ;; saying "don't redisplay." Since this function here
|
|
363 ;; is called periodically, this effectively leads to
|
|
364 ;; process output not being redisplayed at all because
|
|
365 ;; redisplay_internal is never called. (That didn't
|
|
366 ;; work in the old redisplay either.) So, we learn that
|
|
367 ;; we mustn't call sit-for that way here. But then, we
|
|
368 ;; have to be cautious not to call sit-for in a widened
|
|
369 ;; buffer, since this could display hidden parts of that
|
|
370 ;; buffer. This explains the seemingly weird use of
|
|
371 ;; save-restriction/widen here.
|
|
372
|
|
373 (with-temp-message (if jit-lock-stealth-verbose
|
|
374 (concat "JIT stealth lock "
|
|
375 (buffer-name)))
|
|
376
|
|
377 ;; Perform deferred unfontification, if any.
|
|
378 (when jit-lock-first-unfontify-pos
|
|
379 (save-restriction
|
|
380 (widen)
|
|
381 (when (and (>= jit-lock-first-unfontify-pos (point-min))
|
|
382 (< jit-lock-first-unfontify-pos (point-max)))
|
|
383 (with-buffer-prepared-for-font-lock
|
|
384 (put-text-property jit-lock-first-unfontify-pos
|
|
385 (point-max) 'fontified nil))
|
|
386 (setq jit-lock-first-unfontify-pos nil))))
|
|
387
|
|
388 (let (start
|
|
389 (nice (or jit-lock-stealth-nice 0))
|
|
390 (point (point)))
|
|
391 (while (and (setq start
|
|
392 (jit-lock-stealth-chunk-start point))
|
|
393 (sit-for nice))
|
|
394
|
|
395 ;; Wait a little if load is too high.
|
|
396 (when (and jit-lock-stealth-load
|
|
397 (> (car (load-average)) jit-lock-stealth-load))
|
|
398 (sit-for (or jit-lock-stealth-time 30)))
|
|
399
|
|
400 ;; Unless there's input pending now, fontify.
|
|
401 (unless (input-pending-p)
|
|
402 (jit-lock-function start))))))))))))
|
|
403
|
|
404
|
|
405
|
|
406 ;;; Deferred fontification.
|
|
407
|
|
408 (defun jit-lock-after-change (start end old-len)
|
|
409 "Mark the rest of the buffer as not fontified after a change.
|
|
410 Installed on `after-change-functions'.
|
|
411 START and END are the start and end of the changed text. OLD-LEN
|
|
412 is the pre-change length.
|
|
413 This function ensures that lines following the change will be refontified
|
|
414 in case the syntax of those lines has changed. Refontification
|
|
415 will take place when text is fontified stealthily."
|
|
416 ;; Don't do much here---removing text properties is too slow for
|
|
417 ;; fast typers, giving them the impression of Emacs not being
|
|
418 ;; very responsive.
|
|
419 (when jit-lock-mode
|
|
420 (setq jit-lock-first-unfontify-pos
|
|
421 (if jit-lock-first-unfontify-pos
|
|
422 (min jit-lock-first-unfontify-pos start)
|
|
423 start))))
|
|
424
|
|
425
|
|
426 (provide 'jit-lock)
|
|
427
|
|
428 ;; jit-lock.el ends here
|