| 1 | ;;; jit-lock.el --- just-in-time fontification |
| 2 | |
| 3 | ;; Copyright (C) 1998, 2000-2013 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 | \f |
| 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 | :group 'jit-lock |
| 130 | :type '(choice (const :tag "never" nil) |
| 131 | (number :tag "seconds"))) |
| 132 | \f |
| 133 | ;;; Variables that are not customizable. |
| 134 | |
| 135 | (defvar jit-lock-mode nil |
| 136 | "Non-nil means Just-in-time Lock mode is active.") |
| 137 | (make-variable-buffer-local 'jit-lock-mode) |
| 138 | |
| 139 | (defvar 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 | (make-variable-buffer-local 'jit-lock-functions) |
| 143 | |
| 144 | (defvar jit-lock-context-unfontify-pos nil |
| 145 | "Consider text after this position as contextually unfontified. |
| 146 | If nil, contextual fontification is disabled.") |
| 147 | (make-variable-buffer-local 'jit-lock-context-unfontify-pos) |
| 148 | |
| 149 | |
| 150 | (defvar jit-lock-stealth-timer nil |
| 151 | "Timer for stealth fontification in Just-in-time Lock mode.") |
| 152 | (defvar jit-lock-stealth-repeat-timer nil |
| 153 | "Timer for repeated stealth fontification in Just-in-time Lock mode.") |
| 154 | (defvar jit-lock-context-timer nil |
| 155 | "Timer for context fontification in Just-in-time Lock mode.") |
| 156 | (defvar jit-lock-defer-timer nil |
| 157 | "Timer for deferred fontification in Just-in-time Lock mode.") |
| 158 | |
| 159 | (defvar jit-lock-defer-buffers nil |
| 160 | "List of buffers with pending deferred fontification.") |
| 161 | (defvar jit-lock-stealth-buffers nil |
| 162 | "List of buffers that are being fontified stealthily.") |
| 163 | \f |
| 164 | ;;; JIT lock mode |
| 165 | |
| 166 | (defun jit-lock-mode (arg) |
| 167 | "Toggle Just-in-time Lock mode. |
| 168 | Turn Just-in-time Lock mode on if and only if ARG is non-nil. |
| 169 | Enable it automatically by customizing group `font-lock'. |
| 170 | |
| 171 | When Just-in-time Lock mode is enabled, fontification is different in the |
| 172 | following ways: |
| 173 | |
| 174 | - Demand-driven buffer fontification triggered by Emacs C code. |
| 175 | This means initial fontification of the whole buffer does not occur. |
| 176 | Instead, fontification occurs when necessary, such as when scrolling |
| 177 | through the buffer would otherwise reveal unfontified areas. This is |
| 178 | useful if buffer fontification is too slow for large buffers. |
| 179 | |
| 180 | - Stealthy buffer fontification if `jit-lock-stealth-time' is non-nil. |
| 181 | This means remaining unfontified areas of buffers are fontified if Emacs has |
| 182 | been idle for `jit-lock-stealth-time' seconds, while Emacs remains idle. |
| 183 | This is useful if any buffer has any deferred fontification. |
| 184 | |
| 185 | - Deferred context fontification if `jit-lock-contextually' is |
| 186 | non-nil. This means fontification updates the buffer corresponding to |
| 187 | true syntactic context, after `jit-lock-context-time' seconds of Emacs |
| 188 | idle time, while Emacs remains idle. Otherwise, fontification occurs |
| 189 | on modified lines only, and subsequent lines can remain fontified |
| 190 | corresponding to previous syntactic contexts. This is useful where |
| 191 | strings or comments span lines. |
| 192 | |
| 193 | Stealth fontification only occurs while the system remains unloaded. |
| 194 | If the system load rises above `jit-lock-stealth-load' percent, stealth |
| 195 | fontification is suspended. Stealth fontification intensity is controlled via |
| 196 | the variable `jit-lock-stealth-nice'." |
| 197 | (setq jit-lock-mode arg) |
| 198 | (cond (;; Turn Just-in-time Lock mode on. |
| 199 | jit-lock-mode |
| 200 | |
| 201 | ;; Mark the buffer for refontification. |
| 202 | (jit-lock-refontify) |
| 203 | |
| 204 | ;; Install an idle timer for stealth fontification. |
| 205 | (when (and jit-lock-stealth-time (null jit-lock-stealth-timer)) |
| 206 | (setq jit-lock-stealth-timer |
| 207 | (run-with-idle-timer jit-lock-stealth-time t |
| 208 | 'jit-lock-stealth-fontify))) |
| 209 | |
| 210 | ;; Create, but do not activate, the idle timer for repeated |
| 211 | ;; stealth fontification. |
| 212 | (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer)) |
| 213 | (setq jit-lock-stealth-repeat-timer (timer-create)) |
| 214 | (timer-set-function jit-lock-stealth-repeat-timer |
| 215 | 'jit-lock-stealth-fontify '(t))) |
| 216 | |
| 217 | ;; Init deferred fontification timer. |
| 218 | (when (and jit-lock-defer-time (null jit-lock-defer-timer)) |
| 219 | (setq jit-lock-defer-timer |
| 220 | (run-with-idle-timer jit-lock-defer-time t |
| 221 | 'jit-lock-deferred-fontify))) |
| 222 | |
| 223 | ;; Initialize contextual fontification if requested. |
| 224 | (when (eq jit-lock-contextually t) |
| 225 | (unless jit-lock-context-timer |
| 226 | (setq jit-lock-context-timer |
| 227 | (run-with-idle-timer jit-lock-context-time t |
| 228 | 'jit-lock-context-fontify))) |
| 229 | (setq jit-lock-context-unfontify-pos |
| 230 | (or jit-lock-context-unfontify-pos (point-max)))) |
| 231 | |
| 232 | ;; Setup our hooks. |
| 233 | (add-hook 'after-change-functions 'jit-lock-after-change nil t) |
| 234 | (add-hook 'fontification-functions 'jit-lock-function)) |
| 235 | |
| 236 | ;; Turn Just-in-time Lock mode off. |
| 237 | (t |
| 238 | ;; Cancel our idle timers. |
| 239 | (when (and (or jit-lock-stealth-timer jit-lock-defer-timer |
| 240 | jit-lock-context-timer) |
| 241 | ;; Only if there's no other buffer using them. |
| 242 | (not (catch 'found |
| 243 | (dolist (buf (buffer-list)) |
| 244 | (with-current-buffer buf |
| 245 | (when jit-lock-mode (throw 'found t))))))) |
| 246 | (when jit-lock-stealth-timer |
| 247 | (cancel-timer jit-lock-stealth-timer) |
| 248 | (setq jit-lock-stealth-timer nil)) |
| 249 | (when jit-lock-context-timer |
| 250 | (cancel-timer jit-lock-context-timer) |
| 251 | (setq jit-lock-context-timer nil)) |
| 252 | (when jit-lock-defer-timer |
| 253 | (cancel-timer jit-lock-defer-timer) |
| 254 | (setq jit-lock-defer-timer nil))) |
| 255 | |
| 256 | ;; Remove hooks. |
| 257 | (remove-hook 'after-change-functions 'jit-lock-after-change t) |
| 258 | (remove-hook 'fontification-functions 'jit-lock-function)))) |
| 259 | |
| 260 | (defun jit-lock-register (fun &optional contextual) |
| 261 | "Register FUN as a fontification function to be called in this buffer. |
| 262 | FUN will be called with two arguments START and END indicating the region |
| 263 | that needs to be (re)fontified. |
| 264 | If non-nil, CONTEXTUAL means that a contextual fontification would be useful." |
| 265 | (add-hook 'jit-lock-functions fun nil t) |
| 266 | (when (and contextual jit-lock-contextually) |
| 267 | (set (make-local-variable 'jit-lock-contextually) t)) |
| 268 | (jit-lock-mode t)) |
| 269 | |
| 270 | (defun jit-lock-unregister (fun) |
| 271 | "Unregister FUN as a fontification function. |
| 272 | Only applies to the current buffer." |
| 273 | (remove-hook 'jit-lock-functions fun t) |
| 274 | (unless jit-lock-functions (jit-lock-mode nil))) |
| 275 | |
| 276 | ;; This function is used to prevent font-lock-fontify-buffer from |
| 277 | ;; fontifying eagerly the whole buffer. This is important for |
| 278 | ;; things like CWarn mode which adds/removes a few keywords and |
| 279 | ;; does a refontify (which takes ages on large files). |
| 280 | (defun jit-lock-refontify (&optional beg end) |
| 281 | "Force refontification of the region BEG..END (default whole buffer)." |
| 282 | (with-buffer-prepared-for-jit-lock |
| 283 | (save-restriction |
| 284 | (widen) |
| 285 | (put-text-property (or beg (point-min)) (or end (point-max)) |
| 286 | 'fontified nil)))) |
| 287 | \f |
| 288 | ;;; On demand fontification. |
| 289 | |
| 290 | (defun jit-lock-function (start) |
| 291 | "Fontify current buffer starting at position START. |
| 292 | This function is added to `fontification-functions' when `jit-lock-mode' |
| 293 | is active." |
| 294 | (when (and jit-lock-mode (not memory-full)) |
| 295 | (if (null jit-lock-defer-timer) |
| 296 | ;; No deferral. |
| 297 | (jit-lock-fontify-now start (+ start jit-lock-chunk-size)) |
| 298 | ;; Record the buffer for later fontification. |
| 299 | (unless (memq (current-buffer) jit-lock-defer-buffers) |
| 300 | (push (current-buffer) jit-lock-defer-buffers)) |
| 301 | ;; Mark the area as defer-fontified so that the redisplay engine |
| 302 | ;; is happy and so that the idle timer can find the places to fontify. |
| 303 | (with-buffer-prepared-for-jit-lock |
| 304 | (put-text-property start |
| 305 | (next-single-property-change |
| 306 | start 'fontified nil |
| 307 | (min (point-max) (+ start jit-lock-chunk-size))) |
| 308 | 'fontified 'defer))))) |
| 309 | |
| 310 | (defun jit-lock-fontify-now (&optional start end) |
| 311 | "Fontify current buffer from START to END. |
| 312 | Defaults to the whole buffer. END can be out of bounds." |
| 313 | (with-buffer-prepared-for-jit-lock |
| 314 | (save-excursion |
| 315 | (unless start (setq start (point-min))) |
| 316 | (setq end (if end (min end (point-max)) (point-max))) |
| 317 | ;; This did bind `font-lock-beginning-of-syntax-function' to |
| 318 | ;; nil at some point, for an unknown reason. Don't do this; it |
| 319 | ;; can make highlighting slow due to expensive calls to |
| 320 | ;; `parse-partial-sexp' in function |
| 321 | ;; `font-lock-fontify-syntactically-region'. Example: paging |
| 322 | ;; from the end of a buffer to its start, can do repeated |
| 323 | ;; `parse-partial-sexp' starting from `point-min', which can |
| 324 | ;; take a long time in a large buffer. |
| 325 | (let ((orig-start start) next) |
| 326 | (save-match-data |
| 327 | ;; Fontify chunks beginning at START. The end of a |
| 328 | ;; chunk is either `end', or the start of a region |
| 329 | ;; before `end' that has already been fontified. |
| 330 | (while (and start (< start end)) |
| 331 | ;; Determine the end of this chunk. |
| 332 | (setq next (or (text-property-any start end 'fontified t) |
| 333 | end)) |
| 334 | |
| 335 | ;; Decide which range of text should be fontified. |
| 336 | ;; The problem is that START and NEXT may be in the |
| 337 | ;; middle of something matched by a font-lock regexp. |
| 338 | ;; Until someone has a better idea, let's start |
| 339 | ;; at the start of the line containing START and |
| 340 | ;; stop at the start of the line following NEXT. |
| 341 | (goto-char next) (setq next (line-beginning-position 2)) |
| 342 | (goto-char start) (setq start (line-beginning-position)) |
| 343 | |
| 344 | ;; Make sure the contextual refontification doesn't re-refontify |
| 345 | ;; what's already been refontified. |
| 346 | (when (and jit-lock-context-unfontify-pos |
| 347 | (< jit-lock-context-unfontify-pos next) |
| 348 | (>= jit-lock-context-unfontify-pos start) |
| 349 | ;; Don't move boundary forward if we have to |
| 350 | ;; refontify previous text. Otherwise, we risk moving |
| 351 | ;; it past the end of the multiline property and thus |
| 352 | ;; forget about this multiline region altogether. |
| 353 | (not (get-text-property start 'jit-lock-defer-multiline))) |
| 354 | (setq jit-lock-context-unfontify-pos next)) |
| 355 | |
| 356 | ;; Fontify the chunk, and mark it as fontified. |
| 357 | ;; We mark it first, to make sure that we don't indefinitely |
| 358 | ;; re-execute this fontification if an error occurs. |
| 359 | (put-text-property start next 'fontified t) |
| 360 | (condition-case err |
| 361 | (run-hook-with-args 'jit-lock-functions start next) |
| 362 | ;; If the user quits (which shouldn't happen in normal on-the-fly |
| 363 | ;; jit-locking), make sure the fontification will be performed |
| 364 | ;; before displaying the block again. |
| 365 | (quit (put-text-property start next 'fontified nil) |
| 366 | (funcall 'signal (car err) (cdr err)))) |
| 367 | |
| 368 | ;; The redisplay engine has already rendered the buffer up-to |
| 369 | ;; `orig-start' and won't notice if the above jit-lock-functions |
| 370 | ;; changed the appearance of any part of the buffer prior |
| 371 | ;; to that. So if `start' is before `orig-start', we need to |
| 372 | ;; cause a new redisplay cycle after this one so that any changes |
| 373 | ;; are properly reflected on screen. |
| 374 | ;; To make such repeated redisplay happen less often, we can |
| 375 | ;; eagerly extend the refontified region with |
| 376 | ;; jit-lock-after-change-extend-region-functions. |
| 377 | (when (< start orig-start) |
| 378 | (run-with-timer 0 nil 'jit-lock-force-redisplay |
| 379 | (current-buffer) start orig-start)) |
| 380 | |
| 381 | ;; Find the start of the next chunk, if any. |
| 382 | (setq start (text-property-any next end 'fontified nil)))))))) |
| 383 | |
| 384 | (defun jit-lock-force-redisplay (buf start end) |
| 385 | "Force the display engine to re-render buffer BUF from START to END." |
| 386 | (with-current-buffer buf |
| 387 | (with-buffer-prepared-for-jit-lock |
| 388 | ;; Don't cause refontification (it's already been done), but just do |
| 389 | ;; some random buffer change, so as to force redisplay. |
| 390 | (put-text-property start end 'fontified t)))) |
| 391 | |
| 392 | |
| 393 | \f |
| 394 | ;;; Stealth fontification. |
| 395 | |
| 396 | (defsubst jit-lock-stealth-chunk-start (around) |
| 397 | "Return the start of the next chunk to fontify around position AROUND. |
| 398 | Value is nil if there is nothing more to fontify." |
| 399 | (if (zerop (buffer-size)) |
| 400 | nil |
| 401 | (save-restriction |
| 402 | (widen) |
| 403 | (let* ((next (text-property-not-all around (point-max) 'fontified t)) |
| 404 | (prev (previous-single-property-change around 'fontified)) |
| 405 | (prop (get-text-property (max (point-min) (1- around)) |
| 406 | 'fontified)) |
| 407 | (start (cond |
| 408 | ((null prev) |
| 409 | ;; There is no property change between AROUND |
| 410 | ;; and the start of the buffer. If PROP is |
| 411 | ;; non-nil, everything in front of AROUND is |
| 412 | ;; fontified, otherwise nothing is fontified. |
| 413 | (if (eq prop t) |
| 414 | nil |
| 415 | (max (point-min) |
| 416 | (- around (/ jit-lock-chunk-size 2))))) |
| 417 | ((eq prop t) |
| 418 | ;; PREV is the start of a region of fontified |
| 419 | ;; text containing AROUND. Start fontifying a |
| 420 | ;; chunk size before the end of the unfontified |
| 421 | ;; region in front of that. |
| 422 | (max (or (previous-single-property-change prev 'fontified) |
| 423 | (point-min)) |
| 424 | (- prev jit-lock-chunk-size))) |
| 425 | (t |
| 426 | ;; PREV is the start of a region of unfontified |
| 427 | ;; text containing AROUND. Start at PREV or |
| 428 | ;; chunk size in front of AROUND, whichever is |
| 429 | ;; nearer. |
| 430 | (max prev (- around jit-lock-chunk-size))))) |
| 431 | (result (cond ((null start) next) |
| 432 | ((null next) start) |
| 433 | ((< (- around start) (- next around)) start) |
| 434 | (t next)))) |
| 435 | result)))) |
| 436 | |
| 437 | (defun jit-lock-stealth-fontify (&optional repeat) |
| 438 | "Fontify buffers stealthily. |
| 439 | This function is called repeatedly after Emacs has become idle for |
| 440 | `jit-lock-stealth-time' seconds. Optional argument REPEAT is expected |
| 441 | non-nil in a repeated invocation of this function." |
| 442 | ;; Cancel timer for repeated invocations. |
| 443 | (unless repeat |
| 444 | (cancel-timer jit-lock-stealth-repeat-timer)) |
| 445 | (unless (or executing-kbd-macro |
| 446 | memory-full |
| 447 | (window-minibuffer-p (selected-window)) |
| 448 | ;; For first invocation set up `jit-lock-stealth-buffers'. |
| 449 | ;; In repeated invocations it's already been set up. |
| 450 | (null (if repeat |
| 451 | jit-lock-stealth-buffers |
| 452 | (setq jit-lock-stealth-buffers (buffer-list))))) |
| 453 | (let ((buffer (car jit-lock-stealth-buffers)) |
| 454 | (delay 0) |
| 455 | minibuffer-auto-raise |
| 456 | message-log-max |
| 457 | start) |
| 458 | (if (and jit-lock-stealth-load |
| 459 | (> (car (load-average)) jit-lock-stealth-load)) |
| 460 | ;; Wait a little if load is too high. |
| 461 | (setq delay jit-lock-stealth-time) |
| 462 | (if (buffer-live-p buffer) |
| 463 | (with-current-buffer buffer |
| 464 | (if (and jit-lock-mode |
| 465 | (setq start (jit-lock-stealth-chunk-start (point)))) |
| 466 | ;; Fontify one block of at most `jit-lock-chunk-size' |
| 467 | ;; characters. |
| 468 | (with-temp-message (if jit-lock-stealth-verbose |
| 469 | (concat "JIT stealth lock " |
| 470 | (buffer-name))) |
| 471 | (jit-lock-fontify-now start |
| 472 | (+ start jit-lock-chunk-size)) |
| 473 | ;; Run again after `jit-lock-stealth-nice' seconds. |
| 474 | (setq delay (or jit-lock-stealth-nice 0))) |
| 475 | ;; Nothing to fontify here. Remove this buffer from |
| 476 | ;; `jit-lock-stealth-buffers' and run again immediately. |
| 477 | (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers)))) |
| 478 | ;; Buffer is no longer live. Remove it from |
| 479 | ;; `jit-lock-stealth-buffers' and run again immediately. |
| 480 | (setq jit-lock-stealth-buffers (cdr jit-lock-stealth-buffers)))) |
| 481 | ;; Call us again. |
| 482 | (when jit-lock-stealth-buffers |
| 483 | (timer-set-idle-time jit-lock-stealth-repeat-timer (current-idle-time)) |
| 484 | (timer-inc-time jit-lock-stealth-repeat-timer delay) |
| 485 | (timer-activate-when-idle jit-lock-stealth-repeat-timer t))))) |
| 486 | |
| 487 | \f |
| 488 | ;;; Deferred fontification. |
| 489 | |
| 490 | (defun jit-lock-deferred-fontify () |
| 491 | "Fontify what was deferred." |
| 492 | (when (and jit-lock-defer-buffers (not memory-full)) |
| 493 | ;; Mark the deferred regions back to `fontified = nil' |
| 494 | (dolist (buffer jit-lock-defer-buffers) |
| 495 | (when (buffer-live-p buffer) |
| 496 | (with-current-buffer buffer |
| 497 | ;; (message "Jit-Defer %s" (buffer-name)) |
| 498 | (with-buffer-prepared-for-jit-lock |
| 499 | (let ((pos (point-min))) |
| 500 | (while |
| 501 | (progn |
| 502 | (when (eq (get-text-property pos 'fontified) 'defer) |
| 503 | (put-text-property |
| 504 | pos (setq pos (next-single-property-change |
| 505 | pos 'fontified nil (point-max))) |
| 506 | 'fontified nil)) |
| 507 | (setq pos (next-single-property-change pos 'fontified))))))))) |
| 508 | (setq jit-lock-defer-buffers nil) |
| 509 | ;; Force fontification of the visible parts. |
| 510 | (let ((jit-lock-defer-timer nil)) |
| 511 | ;; (message "Jit-Defer Now") |
| 512 | (sit-for 0) |
| 513 | ;; (message "Jit-Defer Done") |
| 514 | ))) |
| 515 | |
| 516 | |
| 517 | (defun jit-lock-context-fontify () |
| 518 | "Refresh fontification to take new context into account." |
| 519 | (unless memory-full |
| 520 | (dolist (buffer (buffer-list)) |
| 521 | (with-current-buffer buffer |
| 522 | (when jit-lock-context-unfontify-pos |
| 523 | ;; (message "Jit-Context %s" (buffer-name)) |
| 524 | (save-restriction |
| 525 | (widen) |
| 526 | (when (and (>= jit-lock-context-unfontify-pos (point-min)) |
| 527 | (< jit-lock-context-unfontify-pos (point-max))) |
| 528 | ;; If we're in text that matches a complex multi-line |
| 529 | ;; font-lock pattern, make sure the whole text will be |
| 530 | ;; redisplayed eventually. |
| 531 | ;; Despite its name, we treat jit-lock-defer-multiline here |
| 532 | ;; rather than in jit-lock-defer since it has to do with multiple |
| 533 | ;; lines, i.e. with context. |
| 534 | (when (get-text-property jit-lock-context-unfontify-pos |
| 535 | 'jit-lock-defer-multiline) |
| 536 | (setq jit-lock-context-unfontify-pos |
| 537 | (or (previous-single-property-change |
| 538 | jit-lock-context-unfontify-pos |
| 539 | 'jit-lock-defer-multiline) |
| 540 | (point-min)))) |
| 541 | (with-buffer-prepared-for-jit-lock |
| 542 | ;; Force contextual refontification. |
| 543 | (remove-text-properties |
| 544 | jit-lock-context-unfontify-pos (point-max) |
| 545 | '(fontified nil jit-lock-defer-multiline nil))) |
| 546 | (setq jit-lock-context-unfontify-pos (point-max))))))))) |
| 547 | |
| 548 | (defvar jit-lock-start) (defvar jit-lock-end) ; Dynamically scoped variables. |
| 549 | (defvar jit-lock-after-change-extend-region-functions nil |
| 550 | "Hook that can extend the text to refontify after a change. |
| 551 | This is run after every buffer change. The functions are called with |
| 552 | the three arguments of `after-change-functions': START END OLD-LEN. |
| 553 | The extended region to refontify is returned indirectly by modifying |
| 554 | the variables `jit-lock-start' and `jit-lock-end'. |
| 555 | |
| 556 | Note that extending the region this way is not strictly necessary, except |
| 557 | that the nature of the redisplay code tends to otherwise leave some of |
| 558 | the rehighlighted text displayed with the old highlight until the next |
| 559 | redisplay (see comment about repeated redisplay in `jit-lock-fontify-now').") |
| 560 | |
| 561 | (defun jit-lock-after-change (start end old-len) |
| 562 | "Mark the rest of the buffer as not fontified after a change. |
| 563 | Installed on `after-change-functions'. |
| 564 | START and END are the start and end of the changed text. OLD-LEN |
| 565 | is the pre-change length. |
| 566 | This function ensures that lines following the change will be refontified |
| 567 | in case the syntax of those lines has changed. Refontification |
| 568 | will take place when text is fontified stealthily." |
| 569 | (when (and jit-lock-mode (not memory-full)) |
| 570 | (let ((jit-lock-start start) |
| 571 | (jit-lock-end end)) |
| 572 | (with-buffer-prepared-for-jit-lock |
| 573 | (run-hook-with-args 'jit-lock-after-change-extend-region-functions |
| 574 | start end old-len) |
| 575 | ;; Make sure we change at least one char (in case of deletions). |
| 576 | (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max))) |
| 577 | ;; Request refontification. |
| 578 | (put-text-property jit-lock-start jit-lock-end 'fontified nil)) |
| 579 | ;; Mark the change for deferred contextual refontification. |
| 580 | (when jit-lock-context-unfontify-pos |
| 581 | (setq jit-lock-context-unfontify-pos |
| 582 | ;; Here we use `start' because nothing guarantees that the |
| 583 | ;; text between start and end will be otherwise refontified: |
| 584 | ;; usually it will be refontified by virtue of being |
| 585 | ;; displayed, but if it's outside of any displayed area in the |
| 586 | ;; buffer, only jit-lock-context-* will re-fontify it. |
| 587 | (min jit-lock-context-unfontify-pos jit-lock-start)))))) |
| 588 | |
| 589 | (provide 'jit-lock) |
| 590 | |
| 591 | ;;; jit-lock.el ends here |