Re: bug-reference-prog-mode slows down CC Mode's scrolling by ~7%

[Alan Mackenzie]

Hello, Stefan.

On Thu, Sep 02, 2021 at 19:24:51 +0000, Alan Mackenzie wrote:

[ .... ]

> In words (;-), only the first function on jit-lock-functions should be
> able to expand the region which gets `fontified' text properties.  This
> expanded region will then be supplied to the subsequent functions.

> Given how little used the `jit-lock-bounds' mechanism is (there is one
> function in Emacs, font-lock-default-fontify-region, which uses it, and
> a web search revealed only a single other instance, in lsp-mode on
> git-hub), this shouldn't cause problems.  In fact, I'm not sure the
> lsp-mode use of it is even correct.

OK, here's some code.  There's actually two versions of
jit-lock--run-functions here.  The second is a bit longer, but avoids
all the contrivances of using pcase-let*, and may be easier to read and
change.  They both fontify xdisp.c without the 7% penalty for the second
jit-lock-functions function, and are equally fast.



diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index a1287926eb..bc45eb4e73 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -377,6 +377,7 @@ jit-lock-function
                           (min (point-max) (+ start jit-lock-chunk-size)))
                          'fontified 'defer)))))
 
+;;;; NEW STOUGH, 2021-09-02
 (defun jit-lock--run-functions (beg end)
   (let ((tight-beg nil) (tight-end nil)
         (loose-beg beg) (loose-end end))
@@ -384,23 +385,54 @@ jit-lock--run-functions
      'jit-lock-functions
      (lambda (fun)
        (pcase-let*
-           ((res (funcall fun beg end))
+           ;; The first function in `jit-lock-functions' can expand
+           ;; the region in `tight-beg' and `tight-end'.  This
+           ;; expanded region is passed to the subsequent functions.
+           ;; The union of all the regions the functions mark for
+           ;; fontification is stored in `loose-beg' and `loose-end'.
+           ((res (funcall fun (or tight-beg beg) (or tight-end end)))
             (`(,this-beg . ,this-end)
              (if (eq (car-safe res) 'jit-lock-bounds)
                  (cdr res) (cons beg end))))
-         ;; If all functions don't fontify the same region, we currently
-         ;; just try to "still be correct".  But we could go further and for
-         ;; the chunks of text that was fontified by some functions but not
-         ;; all, we could add text-properties indicating which functions were
-         ;; already run to avoid running them redundantly when we get to
-         ;; those chunks.
-         (setq tight-beg (max (or tight-beg (point-min)) this-beg))
-         (setq tight-end (min (or tight-end (point-max)) this-end))
+         (setq tight-beg (or tight-beg (min this-beg beg)))
+         (setq tight-end (or tight-end (max this-end end)))
          (setq loose-beg (min loose-beg this-beg))
          (setq loose-end (max loose-end this-end))
          nil)))
     `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
 
+;;;; NEWER STOUGH, 2021-09-02
+(defun jit-lock--run-functions (beg end)
+  (let ((loose-beg beg) (loose-end end)
+        tight-beg tight-end res)
+    (run-hook-wrapped
+     'jit-lock-functions
+     (lambda (fun)
+       (if (null tight-beg)
+           ;; The first function in `jit-lock-functions' can expand
+           ;; the fontified region, storing this in `tight-beg' and
+           ;; `tight-end'.
+           (progn
+             (setq res (funcall fun beg end))
+             (if (eq (car-safe res) 'jit-lock-bounds)
+                 (setq tight-beg (cadr res)
+                       tight-end (cddr res))
+               (setq tight-beg beg
+                     tight-end end)))
+         ;; The subsequent functions in `jit-lock-functions' take the
+         ;; possibly expanded region as arguments.
+         (setq res (funcall fun tight-beg tight-end)))
+
+       ;; The union of all the regions the functions mark for
+       ;; fontification is stored in `loose-beg' and `loose-end'.
+       (if (eq (car-safe res) 'jit-lock-bounds)
+           (setq loose-beg (min loose-beg (cadr res))
+                 loose-end (max loose-end (cddr res))))
+       nil))              ; prevent termination of `run-hook-wrapped'.
+
+    (list (or tight-beg beg) (or tight-end end) loose-beg loose-end)))
+;;;; END OF NEWER STOUGH
+
 (defun jit-lock-fontify-now (&optional start end)
   "Fontify current buffer from START to END.
 Defaults to the whole buffer.  END can be out of bounds."


-- 
Alan Mackenzie (Nuremberg, Germany).