lisp/jit-lock.el

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