Re: jit-lock refontifies too much

[martin rudalics]

With contextual fontification turned on jit-lock exposes yet another
inefficiency.  When changing text you trigger eventual execution of
`jit-lock-context-fontify' which removes the `fontified' text property
from the current and all subsequent lines in the buffer.  This has two
unpleasant consequences:

- After jit-lock-context-time seconds of Emacs idle time, redisplay will
  refontify all lines below the current one in any window showing the
  current buffer.

- After jit-lock-stealth-time seconds of Emacs idle time stealth
  fontification refontifies all subsequent lines in the current buffer.

I suppose that the latter was the main cause for complaints about
"stealth fontification GCing a lot" some months ago.  The ensuing
discussion lead to changing the default value of jit-lock-stealth-time
to 16 seconds.

Contextual fontification is useful since it reminds me whenever I forget
to close a string or comment.  But the context of subsequent lines
changes at most every 100th character I type.  Hence in at least 99 out
of 100 cases contextual fontification just slows down editing and wastes
processor cycles.

The problem could be resolved by using the following reasoning (please
correct me if I'm wrong):

- Syntactic context is correctly established via the face property
  assigned to a character by font-lock.  As an example, font-lock
  assigns a character the font-lock-string-face property iff that
  character is within a string - according to the best knowledge of
  syntax-ppss.

- The syntactic context of a character may change iff preceding text is
  modified (I ignore syntax table switching here).

- When text is modified, the syntactical context of subsequent
  characters may change iff the context of the first character
  following the modified text changes.

Hence, it seems sufficient to have jit-lock-fontify-now compare the face
property of the first character following modified text before and after
refontification.  If the property did not change, the modification could
not possibly change the syntactic context of subsequent text.

There is one complication: When text has not been fontified yet, the
comparison described above would always indicate a context change.  This
would be inefficient in some cases, for example, when scrolling backward
into unfontified text.  The patch of jit-lock below tries to avoid this
by using an additional text property called "jit-lock-context".


--- jit-lock.el 2005-08-18 09:58:40.000000000 +0200
+++ jit-lock.el 2005-09-21 10:34:32.000000000 +0200
@@ -159,10 +159,14 @@
 They are called with two arguments: the START and END of the region to 
fontify.")
 (make-variable-buffer-local 'jit-lock-functions)

-(defvar jit-lock-context-unfontify-pos nil
-  "Consider text after this position as contextually unfontified.
+(defvar jit-lock-context-min-pos nil
+  "Minimum buffer position to consider for contextual fontification.
 If nil, contextual fontification is disabled.")
-(make-variable-buffer-local 'jit-lock-context-unfontify-pos)
+(make-variable-buffer-local 'jit-lock-context-min-pos)
+
+(defvar jit-lock-context-max-pos nil
+  "Maximum buffer position to consider for contextual fontification.")
+(make-variable-buffer-local 'jit-lock-context-max-pos)


 (defvar jit-lock-stealth-timer nil
@@ -233,12 +237,15 @@
             (setq jit-lock-context-timer
                   (run-with-idle-timer jit-lock-context-time t
                                        'jit-lock-context-fontify)))
-          (setq jit-lock-context-unfontify-pos
-                (or jit-lock-context-unfontify-pos (point-max))))
+          (unless jit-lock-context-min-pos
+            (setq jit-lock-context-min-pos (point-max)))
+          (unless jit-lock-context-max-pos
+            (setq jit-lock-context-max-pos 1)))

         ;; Setup our hooks.
         (add-hook 'after-change-functions 'jit-lock-after-change nil t)
-        (add-hook 'fontification-functions 'jit-lock-function))
+        (add-hook 'fontification-functions 'jit-lock-function)
+        (add-hook 'after-revert-hook 'jit-lock-after-revert nil t))

        ;; Turn Just-in-time Lock mode off.
        (t
@@ -262,7 +269,8 @@

         ;; Remove hooks.
         (remove-hook 'after-change-functions 'jit-lock-after-change t)
-        (remove-hook 'fontification-functions 'jit-lock-function))))
+        (remove-hook 'fontification-functions 'jit-lock-function)
+        (remove-hook 'after-revert-hook 'jit-lock-after-revert t))))

 ;;;###autoload
 (defun jit-lock-register (fun &optional contextual)
@@ -330,7 +338,7 @@
      ;; from the end of a buffer to its start, can do repeated
      ;; `parse-partial-sexp' starting from `point-min', which can
      ;; take a long time in a large buffer.
-     (let (next)
+     (let (next prop prop-at from to)
        (save-match-data
         ;; Fontify chunks beginning at START.  The end of a
         ;; chunk is either `end', or the start of a region
@@ -349,6 +357,22 @@
           (goto-char next)  (setq next (line-beginning-position 2))
           (goto-char start) (setq start (line-beginning-position))

+          ;; Examine `jit-lock-context' text property within chunk.
+          (when (and jit-lock-context-min-pos
+                     (< jit-lock-context-min-pos next)
+                     (text-property-any
+                      (setq from (max start jit-lock-context-min-pos))
+                      (setq to (min next jit-lock-context-max-pos))
+                      'jit-lock-context t))
+            ;; Syntactic context may change after current chunk.  Have `prop'
+            ;; record the face property of the last character to be fontified.
+            ;; Usually that will be a newline character.  If text was inserted
+            ;; and/or deleted at eob that may be any character but then there
+            ;; is no following text anyway.  In any case let `prop-at' denote
+            ;; the position before that character.
+            (setq prop-at (1- next))
+            (setq prop (get-text-property prop-at 'face)))
+
           ;; Fontify the chunk, and mark it as fontified.
           ;; We mark it first, to make sure that we don't indefinitely
           ;; re-execute this fontification if an error occurs.
@@ -359,8 +383,28 @@
             ;; jit-locking), make sure the fontification will be performed
             ;; before displaying the block again.
             (quit (put-text-property start next 'fontified nil)
+                  (setq prop-at nil) ; reset prop-at
                   (funcall 'signal (car err) (cdr err))))

+          ;; Examine face property of last character fontified.
+          (when prop-at
+            (if (equal (get-text-property prop-at 'face) prop)
+                ;; Syntactic context on subsequent lines should not be affected
+                ;; by change within fontified chunk, remove `jit-lock-context'
+                ;; property from fontified chunk.
+                (remove-text-properties from to '(jit-lock-context nil))
+              ;; Syntactic context on subsequent lines might be affected by
+              ;; change within fontified chunk.  Assign `jit-lock-context' text
+              ;; property to character following chunk and correspondingly
+              ;; update `jit-lock-context-max-pos'.
+              (save-restriction
+                (widen) ; we need access to the character following next
+                (when (< next (point-max))
+                  (setq jit-lock-context-max-pos
+                        (max (1+ next) jit-lock-context-max-pos))
+                  (put-text-property next (1+ next) 'jit-lock-context t))))
+            (setq prop-at nil))
+
           ;; Find the start of the next chunk, if any.
           (setq start (text-property-any next end 'fontified nil))))))))

@@ -507,40 +551,44 @@
   "Refresh fontification to take new context into account."
   (dolist (buffer (buffer-list))
     (with-current-buffer buffer
-      (when jit-lock-context-unfontify-pos
+      (when (and jit-lock-context-min-pos
+                (< jit-lock-context-min-pos jit-lock-context-max-pos))
        ;; (message "Jit-Context %s" (buffer-name))
        (save-restriction
          (widen)
-         (when (and (>= jit-lock-context-unfontify-pos (point-min))
-                    (< jit-lock-context-unfontify-pos (point-max)))
+         (when (setq jit-lock-context-min-pos
+                     (text-property-any
+                      (min jit-lock-context-min-pos (point-max))
+                      (min jit-lock-context-max-pos (point-max))
+                      'jit-lock-context t))
            ;; If we're in text that matches a complex multi-line
            ;; font-lock pattern, make sure the whole text will be
            ;; redisplayed eventually.
            ;; Despite its name, we treat jit-lock-defer-multiline here
            ;; rather than in jit-lock-defer since it has to do with multiple
            ;; lines, i.e. with context.
-           (when (get-text-property jit-lock-context-unfontify-pos
-                                    'jit-lock-defer-multiline)
-             (setq jit-lock-context-unfontify-pos
+           (when (get-text-property
+                  jit-lock-context-min-pos 'jit-lock-defer-multiline)
+             (setq jit-lock-context-min-pos
                    (or (previous-single-property-change
-                        jit-lock-context-unfontify-pos
-                        'jit-lock-defer-multiline)
+                        jit-lock-context-min-pos 'jit-lock-defer-multiline)
                        (point-min))))
            (with-buffer-prepared-for-jit-lock
             ;; Force contextual refontification.
             (remove-text-properties
-             jit-lock-context-unfontify-pos (point-max)
-             '(fontified nil jit-lock-defer-multiline nil)))
-           (setq jit-lock-context-unfontify-pos (point-max))))))))
+             jit-lock-context-min-pos (point-max)
+             '(fontified nil jit-lock-defer-multiline nil jit-lock-context 
nil))))
+         (setq jit-lock-context-min-pos (point-max))
+         (setq jit-lock-context-max-pos 1))))))

 (defun jit-lock-after-change (start end old-len)
-  "Mark the rest of the buffer as not fontified after a change.
-Installed on `after-change-functions'.
-START and END are the start and end of the changed text.  OLD-LEN
-is the pre-change length.
-This function ensures that lines following the change will be refontified
-in case the syntax of those lines has changed.  Refontification
-will take place when text is fontified stealthily."
+  "Reset `fontified' text property after a change.
+Installed on `after-change-functions'. START and END are the start and
+end of the changed text.  OLD-LEN is the pre-change length.  This
+function ensures that lines following the change will be refontified
+provided `jit-lock-contextually' is non-nil and the syntactic context
+may change.  Refontification will take place during redisplay or when
+text is fontified stealthily."
   (when jit-lock-mode
     (save-excursion
       (with-buffer-prepared-for-jit-lock
@@ -561,12 +609,37 @@

        ;; Make sure we change at least one char (in case of deletions).
        (setq end (min (max end (1+ start)) (point-max)))
-       ;; Request refontification.
-       (put-text-property start end 'fontified nil))
-      ;; Mark the change for deferred contextual refontification.
-      (when jit-lock-context-unfontify-pos
-       (setq jit-lock-context-unfontify-pos
-             (min jit-lock-context-unfontify-pos start))))))
+       (if jit-lock-context-min-pos
+          ;; Install jit-lock-context text property on modified text and set
+          ;; `jit-lock-context-min-pos' and `jit-lock-context-max-pos'
+          ;; accordingly.
+          (progn
+            (add-text-properties
+             start end '(fontified nil jit-lock-context t))
+            (setq jit-lock-context-min-pos
+                  (min start jit-lock-context-min-pos))
+            (setq jit-lock-context-max-pos
+                  (max (+ jit-lock-context-max-pos (- end start)) end)))
+        (put-text-property start end 'fontified nil))))))
+
+(defun jit-lock-after-revert ()
+  "Reset `jit-lock' related properties after reverting a buffer.
+Installed on `after-revert-hook'.  In order to preserve markers and
+other things `revert-buffer' attempts to reuse text at the beginning and
+end of the buffer.  This may leave spurious remnants of text with the
+`jit-lock-context' text property in the reverted buffer.  For sanity
+reasons we remove such properties from the entire buffer, reset
+`jit-lock-context-min-pos' and `jit-lock-context-max-pos', and also
+remove the `fontified' and `jit-lock-defer-multiline' properties."
+  (when jit-lock-context-min-pos
+    (with-buffer-prepared-for-jit-lock
+     (save-restriction
+       (widen)
+       (remove-text-properties
+       (point-min) (point-max)
+       '(fontified nil jit-lock-defer-multiline nil jit-lock-context nil))
+       (setq jit-lock-context-min-pos (point-max))
+       (setq jit-lock-context-max-pos 1)))))

 (provide 'jit-lock)