LCOV - code coverage report
Current view: top level - lisp - jit-lock.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 249 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 16 0.0 %

          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

Generated by: LCOV version 1.12