scratch/font_lock_large_files fe0e53d963: New option: font-lock-large-files

[Dmitry Gutov]

branch: scratch/font_lock_large_files
commit fe0e53d963899a16e0dd1bbc1ba10a6b59f7989e
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>

    New option: font-lock-large-files
    
    * lisp/font-lock.el (font-lock-fontify-region): Use it.
    (font-lock-large-files): New option (bug#56682).
    
    * src/xdisp.c (handle_fontified_prop): Don't apply narrowing here.
---
 lisp/font-lock.el | 30 +++++++++++++++++++++++++++++-
 src/xdisp.c       | 14 --------------
 2 files changed, 29 insertions(+), 15 deletions(-)

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 7eb5a414fe..88bd6cbc5b 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -254,6 +254,23 @@ decoration for buffers in C++ mode, and level 1 decoration 
otherwise."
                                      (integer :tag "level" 1)))))
   :group 'font-lock)
 
+(defcustom font-lock-large-files t
+  "How to fontify large files.
+When t, apply highlighting without restriction.
+
+When its a cons with car equal to `head', fontify the first (cdr
+value) number of characters only.
+
+When its a cons with car equal to `narrow', narrow the buffer
+to (cdr value) characters around point. That speeds up
+fontification at the expense of possible misdetection of syntax
+context."
+  :type '(choice (const :tag "full" t)
+                 (cons :tag "head"
+                       (const head) (integer :tag "length" 1000000))
+                 (cons :tag "narrow"
+                       (const narrow) (integer :tag "width" 15000))))
+
 (defcustom font-lock-ignore nil
   "Rules to selectively disable fontifications due to `font-lock-keywords'.
 If non-nil, the value should be a list of condition sets of the form
@@ -996,7 +1013,18 @@ If LOUDLY is non-nil, print status messages while 
fontifying.
 This works by calling `font-lock-fontify-region-function'."
   (font-lock-set-defaults)
   (save-restriction
-    (unless font-lock-dont-widen (widen))
+    (pcase-exhaustive font-lock-large-files
+      (`t nil)
+      (`(head . ,length)
+       (setq beg (min length beg)
+             end (min length end)))
+      (`(narrow . ,width)
+       (narrow-to-region (max (point-min) (* (1- (/ beg width)) width))
+                         (min (point-max) (* (1+ (/ beg width)) width)))
+       (setq end (min end (point-max)))))
+    (unless (or font-lock-dont-widen
+                (eq (car-safe font-lock-large-files) 'narrow))
+      (widen))
     (funcall font-lock-fontify-region-function beg end loudly)))
 
 (defun font-lock-unfontify-region (beg end)
diff --git a/src/xdisp.c b/src/xdisp.c
index 855f48f2bd..1fcff2c2e3 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4392,20 +4392,6 @@ handle_fontified_prop (struct it *it)
 
       eassert (it->end_charpos == ZV);
 
-      if (current_buffer->long_line_optimizations_p)
-       {
-         ptrdiff_t begv = it->narrowed_begv;
-         ptrdiff_t zv = it->narrowed_zv;
-         ptrdiff_t charpos = IT_CHARPOS (*it);
-         if (charpos < begv || charpos > zv)
-           {
-             begv = get_narrowed_begv (it->w, charpos);
-             zv = get_narrowed_zv (it->w, charpos);
-           }
-         narrow_to_region_internal (make_fixnum (begv), make_fixnum (zv), 
true);
-         specbind (Qrestrictions_locked, Qt);
-       }
-
       /* Don't allow Lisp that runs from 'fontification-functions'
         clear our face and image caches behind our back.  */
       it->f->inhibit_clear_image_cache = true;