summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2022-06-30 13:20:33 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2022-06-30 13:20:33 -0400
commit15b2138719b34083967001c3903e7560d5e0947c (patch)
treeb37d992e6f31140c051fc2b6bae6fb84f92addb6
parent77e99dcacb57cae558f833334a8367fbc9b4fd8a (diff)
downloademacs-15b2138719b34083967001c3903e7560d5e0947c.tar.gz
(syntax-wholeline-max): New var
Try and reduce the pain caused by font-lock and syntax-propertize's wholeline-based operation in buffers made up of a few very long lines (bug#45898). * lisp/emacs-lisp/syntax.el (syntax-wholeline-max): New var. (syntax--lbp): New function. (syntax-propertize-wholelines): Use it. * lisp/jit-lock.el (jit-lock--antiblink-post-command): Use `syntax--lbp`. * lisp/font-lock.el (font-lock-extend-region-wholelines): Rewrite, using `syntax-propertize-wholelines`.
-rw-r--r--etc/NEWS11
-rw-r--r--lisp/emacs-lisp/syntax.el46
-rw-r--r--lisp/font-lock.el33
-rw-r--r--lisp/jit-lock.el21
4 files changed, 75 insertions, 36 deletions
diff --git a/etc/NEWS b/etc/NEWS
index e757435ff91..d3dd8965267 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -317,6 +317,17 @@ startup. Previously, these functions ignored
* Changes in Emacs 29.1
+** New config variable 'syntax-wholeline-max' to reduce the cost of long lines.
+This variable is used by some operations (mostly syntax-propertization
+and font-locking) to treat lines longer than this variable as if they
+were made up of various smaller lines. This can help reduce the
+pathological slowdowns seen in buffers made of a single long line, but
+can also cause misbehavior in the presence of such long lines (tho
+most of that misbehavior should usually be limited to mis-highlighting).
+You can recover the previous behavior with:
+
+ (setq syntax-wholeline-max most-positive-fixnum)
+
---
** New bindings in 'find-function-setup-keys' for 'find-library'.
When 'find-function-setup-keys' is enabled, 'C-x L' is now bound to
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 36b0c56e953..e1be3015838 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -124,15 +124,49 @@ When the last position scanned holds the first character of a
otherwise nil. That construct can be a two character comment
delimiter or an Escaped or Char-quoted character."))
-(defun syntax-propertize-wholelines (start end)
- "Extend the region delimited by START and END to whole lines.
+(defvar syntax-wholeline-max 10000
+ "Maximum line length for syntax operations.
+If lines are longer than that, syntax operations will treat them as chunks
+of this size. Misfontification may then occur.
+This is a tradeoff between correctly applying the syntax rules,
+and avoiding major slowdown on pathologically long lines.")
+
+(defun syntax--lbp (&optional arg)
+ "Like `line-beginning-position' but obeying `syntax-wholeline-max'."
+ (let ((pos (point))
+ (res (line-beginning-position arg)))
+ (cond
+ ((< (abs (- pos res)) syntax-wholeline-max) res)
+ ;; For lines that are too long, round to the nearest multiple of
+ ;; `syntax-wholeline-max'. We use rounding rather than just
+ ;; (min res (+ pos syntax-wholeline-max)) so that repeated calls
+ ;; to `syntax-propertize-wholelines' don't keep growing the bounds,
+ ;; i.e. it really behaves like additional line-breaks.
+ ((< res pos)
+ (let ((max syntax-wholeline-max))
+ (max (point-min) (* max (truncate pos max)))))
+ (t
+ (let ((max syntax-wholeline-max))
+ (min (point-max) (* max (ceiling pos max))))))))
+
+(defun syntax-propertize-wholelines (beg end)
+ "Extend the region delimited by BEG and END to whole lines.
This function is useful for
`syntax-propertize-extend-region-functions';
see Info node `(elisp) Syntax Properties'."
- (goto-char start)
- (cons (line-beginning-position)
- (progn (goto-char end)
- (if (bolp) (point) (line-beginning-position 2)))))
+ ;; This let-binding was taken from
+ ;; `font-lock-extend-region-wholelines' where it was used to avoid
+ ;; inf-looping (Bug#21615) but for some reason it was not applied
+ ;; here in syntax.el and was used only for the "beg" side.
+ (let ((inhibit-field-text-motion t))
+ (let ((new-beg (progn (goto-char beg)
+ (if (bolp) beg
+ (syntax--lbp))))
+ (new-end (progn (goto-char end)
+ (if (bolp) end
+ (syntax--lbp 2)))))
+ (unless (and (eql beg new-beg) (eql end new-end))
+ (cons new-beg new-end)))))
(defun syntax-propertize-multiline (beg end)
"Let `syntax-propertize' pay attention to the syntax-multiline property."
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index df0a26f4d0f..7eeaf2f547f 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1260,18 +1260,11 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(defun font-lock-extend-region-wholelines ()
"Move fontification boundaries to beginning of lines."
- (let ((changed nil))
- (goto-char font-lock-beg)
- (unless (bolp)
- (setq changed t font-lock-beg
- (let ((inhibit-field-text-motion t))
- (line-beginning-position))))
- (goto-char font-lock-end)
- (unless (bolp)
- (unless (eq font-lock-end
- (setq font-lock-end (line-beginning-position 2)))
- (setq changed t)))
- changed))
+ (let ((new (syntax-propertize-wholelines font-lock-beg font-lock-end)))
+ (when new
+ (setq font-lock-beg (car new))
+ (setq font-lock-end (cdr new))
+ t)))
(defun font-lock-default-fontify-region (beg end loudly)
"Fontify the text between BEG and END.
@@ -1565,7 +1558,7 @@ see `font-lock-syntactic-keywords'."
(or (nth 3 highlight)
(error "No match %d in highlight %S" match highlight))
(when (and (consp value) (not (numberp (car value))))
- (setq value (eval value)))
+ (setq value (eval value t)))
(when (stringp value) (setq value (string-to-syntax value)))
;; Flush the syntax-cache. I believe this is not necessary for
;; font-lock's use of syntax-ppss, but I'm not 100% sure and it can
@@ -1589,7 +1582,7 @@ KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords',
LIMIT can be modified by the value of its PRE-MATCH-FORM."
(let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
;; Evaluate PRE-MATCH-FORM.
- (pre-match-value (eval (nth 1 keywords))))
+ (pre-match-value (eval (nth 1 keywords) t)))
;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
(if (and (numberp pre-match-value) (> pre-match-value (point)))
(setq limit pre-match-value)
@@ -1605,7 +1598,7 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(font-lock-apply-syntactic-highlight (car highlights))
(setq highlights (cdr highlights)))))
;; Evaluate POST-MATCH-FORM.
- (eval (nth 2 keywords))))
+ (eval (nth 2 keywords) t)))
(defun font-lock-fontify-syntactic-keywords-region (start end)
"Fontify according to `font-lock-syntactic-keywords' between START and END.
@@ -1718,7 +1711,7 @@ HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
;; No match but we might not signal an error.
(or (nth 3 highlight)
(error "No match %d in highlight %S" match highlight))
- (let ((val (eval (nth 1 highlight))))
+ (let ((val (eval (nth 1 highlight) t)))
(when (eq (car-safe val) 'face)
(add-text-properties start end (cddr val))
(setq val (cadr val)))
@@ -1753,7 +1746,7 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights
(lead-start (match-beginning 0))
;; Evaluate PRE-MATCH-FORM.
- (pre-match-value (eval (nth 1 keywords))))
+ (pre-match-value (eval (nth 1 keywords) t)))
;; Set LIMIT to value of PRE-MATCH-FORM or the end of line.
(if (not (and (numberp pre-match-value) (> pre-match-value (point))))
(setq limit (line-end-position))
@@ -1778,7 +1771,7 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(font-lock-apply-highlight (car highlights))
(setq highlights (cdr highlights)))))
;; Evaluate POST-MATCH-FORM.
- (eval (nth 2 keywords))))
+ (eval (nth 2 keywords) t)))
(defun font-lock-fontify-keywords-region (start end &optional loudly)
"Fontify according to `font-lock-keywords' between START and END.
@@ -1884,7 +1877,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
(cond ((or (functionp keyword) (nlistp keyword)) ; MATCHER
(list keyword '(0 font-lock-keyword-face)))
((eq (car keyword) 'eval) ; (eval . FORM)
- (font-lock-compile-keyword (eval (cdr keyword))))
+ (font-lock-compile-keyword (eval (cdr keyword) t)))
((eq (car-safe (cdr keyword)) 'quote) ; (MATCHER . 'FORM)
;; If FORM is a FACENAME then quote it. Otherwise ignore the quote.
(if (symbolp (nth 2 keyword))
@@ -1905,7 +1898,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
keywords
(font-lock-eval-keywords (if (fboundp keywords)
(funcall keywords)
- (eval keywords)))))
+ (eval keywords t)))))
(defun font-lock-value-in-major-mode (values)
"If VALUES is a list, use `major-mode' as a key and return the `assq' value.
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 17969d57620..a3ada443702 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -242,20 +242,20 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
(setq jit-lock-stealth-timer
(run-with-idle-timer jit-lock-stealth-time t
- 'jit-lock-stealth-fontify)))
+ #'jit-lock-stealth-fontify)))
;; Create, but do not activate, the idle timer for repeated
;; stealth fontification.
(when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
(setq jit-lock-stealth-repeat-timer (timer-create))
(timer-set-function jit-lock-stealth-repeat-timer
- 'jit-lock-stealth-fontify '(t)))
+ #'jit-lock-stealth-fontify '(t)))
;; Init deferred fontification timer.
(when (and jit-lock-defer-time (null jit-lock-defer-timer))
(setq jit-lock-defer-timer
(run-with-idle-timer jit-lock-defer-time t
- 'jit-lock-deferred-fontify)))
+ #'jit-lock-deferred-fontify)))
;; Initialize contextual fontification if requested.
(when (eq jit-lock-contextually t)
@@ -265,13 +265,13 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(lambda ()
(unless jit-lock--antiblink-grace-timer
(jit-lock-context-fontify))))))
- (add-hook 'post-command-hook 'jit-lock--antiblink-post-command nil t)
+ (add-hook 'post-command-hook #'jit-lock--antiblink-post-command nil t)
(setq jit-lock-context-unfontify-pos
(or jit-lock-context-unfontify-pos (point-max))))
;; Setup our hooks.
- (add-hook 'after-change-functions 'jit-lock-after-change nil t)
- (add-hook 'fontification-functions 'jit-lock-function nil t))
+ (add-hook 'after-change-functions #'jit-lock-after-change nil t)
+ (add-hook 'fontification-functions #'jit-lock-function nil t))
;; Turn Just-in-time Lock mode off.
(t
@@ -294,8 +294,9 @@ If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(setq jit-lock-defer-timer nil)))
;; Remove hooks.
- (remove-hook 'after-change-functions 'jit-lock-after-change t)
- (remove-hook 'fontification-functions 'jit-lock-function))))
+ (remove-hook 'post-command-hook #'jit-lock--antiblink-post-command t)
+ (remove-hook 'after-change-functions #'jit-lock-after-change t)
+ (remove-hook 'fontification-functions #'jit-lock-function))))
(define-minor-mode jit-lock-debug-mode
"Minor mode to help debug code run from jit-lock.
@@ -707,8 +708,8 @@ will take place when text is fontified stealthily."
(min jit-lock-context-unfontify-pos jit-lock-start))))))
(defun jit-lock--antiblink-post-command ()
- (let* ((new-l-b-p (copy-marker (line-beginning-position)))
- (l-b-p-2 (line-beginning-position 2))
+ (let* ((new-l-b-p (copy-marker (syntax--lbp)))
+ (l-b-p-2 (syntax--lbp 2))
(same-line
(and jit-lock-antiblink-grace
(not (= new-l-b-p l-b-p-2))