bug#56682: Fix the long lines font locking related slowdowns

[Gregory Heytings]

> > > Feel free to suggest better ways of handling these issues, or even 
> > > ways to solve this entirely inside font-lock.  If and when such 
> > > suggestions materialize, I'm sure we will be glad to use them instead 
> > > of less elegant/more direct solutions.
> >
> > I'd suggest to keep things mostly as they are but move the decision to 
> > ELisp: i.e. pass the beg..end limits to jit-lock and let jit-lock do 
> > the narrowing.  This way it's easy to later refine the mechanism.
>
> That's already happening: code called via fontification-functions can 
> access the restriction via point-min and point-max.  If you or someone 
> else can come up with efficient methods of using that information so as 
> not to go too far forward and back, we could consider removing the lock 
> from the narrowing.  But we'd need to see the code first and assess the 
> resulting performance with long lines.

IIUC, what Stefan suggests is the following, which seems (almost) fine to 
me.  The only problem I see is that jit-lock-function is not the only user 
of fontication-functions.  It has at least two other users: in ELPA 
multi-mode.el sets fontification-functions to multi-fontify, and in MELPA 
poly-lock.el sets fontification-functions to poly-lock-function.

diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index be26ca55f0..aa26b990bc 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -370,27 +370,36 @@ jit-lock-refontify

 ;;; On demand fontification.

+(defun jit-lock-function--internal (start)
+  "Internal function called by `jit-lock-function'."
+  (if (not (and jit-lock-defer-timer
+                (or (not (eq jit-lock-defer-time 0))
+                    (input-pending-p))))
+      ;; No deferral.
+      (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
+    ;; Record the buffer for later fontification.
+    (unless (memq (current-buffer) jit-lock-defer-buffers)
+      (push (current-buffer) jit-lock-defer-buffers))
+    ;; Mark the area as defer-fontified so that the redisplay engine
+    ;; is happy and so that the idle timer can find the places to fontify.
+    (with-buffer-prepared-for-jit-lock
+     (put-text-property start
+                       (next-single-property-change
+                        start 'fontified nil
+                        (min (point-max) (+ start jit-lock-chunk-size)))
+                       'fontified 'defer))))
+
 (defun jit-lock-function (start)
   "Fontify current buffer starting at position START.
 This function is added to `fontification-functions' when `jit-lock-mode'
 is active."
   (when (and jit-lock-mode (not memory-full))
-    (if (not (and jit-lock-defer-timer
-                  (or (not (eq jit-lock-defer-time 0))
-                      (input-pending-p))))
-       ;; No deferral.
-       (jit-lock-fontify-now start (+ start jit-lock-chunk-size))
-      ;; Record the buffer for later fontification.
-      (unless (memq (current-buffer) jit-lock-defer-buffers)
-       (push (current-buffer) jit-lock-defer-buffers))
-      ;; Mark the area as defer-fontified so that the redisplay engine
-      ;; is happy and so that the idle timer can find the places to fontify.
-      (with-buffer-prepared-for-jit-lock
-       (put-text-property start
-                         (next-single-property-change
-                          start 'fontified nil
-                          (min (point-max) (+ start jit-lock-chunk-size)))
-                         'fontified 'defer)))))
+    (if (not fontification-functions-restriction)
+        (jit-lock-function--internal start)
+      (narrow-to-region (car fontification-functions-restriction)
+                        (cdr fontification-functions-restriction)
+                        t)
+      (jit-lock-function--internal start))))

 (defun jit-lock--run-functions (beg end)
   (let ((tight-beg nil) (tight-end nil)
diff --git a/src/xdisp.c b/src/xdisp.c
index 0fdb1922e5..726e77b8eb 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4412,9 +4412,9 @@ handle_fontified_prop (struct it *it)
          ptrdiff_t begv = it->narrowed_begv ? it->narrowed_begv : BEGV;
          ptrdiff_t zv = it->narrowed_zv;
          ptrdiff_t charpos = IT_CHARPOS (*it);
          if (begv <= charpos && charpos <= zv)
-           Fnarrow_to_region (make_fixnum (begv), make_fixnum (zv), Qt);
+           specbind (Qfontification_functions_restriction,
+                     Fcons (make_fixnum (begv), make_fixnum (zv)));
        }

       /* Don't allow Lisp that runs from 'fontification-functions'
@@ -36673,6 +36673,13 @@ syms_of_xdisp (void)
   Vfontification_functions = Qnil;
   Fmake_variable_buffer_local (Qfontification_functions);

+  DEFSYM (Qfontification_functions_restriction,
+         "fontification-functions-restriction");
+  DEFVAR_LISP ("fontification-functions-restriction",
+              Vfontification_functions_restriction,
+              doc: /* TODO  */);
+  Vfontification_functions_restriction = Qnil;
+
   DEFVAR_BOOL ("unibyte-display-via-language-environment",
                unibyte_display_via_language_environment,
     doc: /* Non-nil means display unibyte text according to language 
environment.

By the way, while trying the above, it became clear that I forgot to 
properly handle the new optional argument to narrow-to-region in 
byte-compiled code.  But I don't know how to do that:

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b4954eee9f..1ecd77f751 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -767,7 +767,7 @@ 121
 (byte-defop 122  0 byte-char-syntax)
 (byte-defop 123 -1 byte-buffer-substring)
 (byte-defop 124 -1 byte-delete-region)
-(byte-defop 125 -1 byte-narrow-to-region)
+(byte-defop 125 -2 byte-narrow-to-region)
 (byte-defop 126  1 byte-widen)
 (byte-defop 127  0 byte-end-of-line)

@@ -3833,7 +3833,7 @@ setcar
 (byte-defop-compiler setcdr            2)
 (byte-defop-compiler buffer-substring  2)
 (byte-defop-compiler delete-region     2)
-(byte-defop-compiler narrow-to-region  2)
+(byte-defop-compiler narrow-to-region  2-3)
 (byte-defop-compiler (% byte-rem)      2)
 (byte-defop-compiler aset              3)

is apparently not enough, because "2-3" seems to install an 
integer-or-marker-p check on the third argument, which raises a 
(wrong-type-argument integer-or-marker-p nil) or (wrong-type-argument 
integer-or-marker-p t) error when narrow-to-region is called from 
byte-compiled code.