From: Dmitry Gutov <dgutov@yandex.ru>
Date: Fri, 12 Aug 2022 10:46:04 +0000 (+0300)
Subject: New option: font-lock-large-files
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fe0e53d963899a16e0dd1bbc1ba10a6b59f7989e;p=emacs.git

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.
---

diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 7eb5a414fe3..88bd6cbc5b6 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 855f48f2bde..1fcff2c2e3b 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;