Package: emacs;
Reported by: Devon Sean McCullough <Emacs-hacker2018 <at> jovi.net>
Date: Fri, 15 Jan 2021 18:14:01 UTC
Severity: normal
Found in version 27.1
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Eli Zaretskii <eliz <at> gnu.org> Cc: gerd.moellmann <at> gmail.com, psainty <at> orcon.net.nz, larsi <at> gnus.org, Emacs-hacker2018 <at> jovi.net, 45898 <at> debbugs.gnu.org Subject: bug#45898: 27.1; wedged in redisplay again Date: Wed, 29 Jun 2022 17:07:45 -0400
>> How 'bout the patch below?
> Thanks.
Doesn't work: the looping around font-lock-extend-region-functions ends
up calling `font-lock-extend-region-wholelines` repeatedly as long as
the bounds a grown and so the bounds keep growing until we're back at
square one.
The patch below addresses this problem by truncating in a more careful
way, so `font-lock-extend-region-wholelines` is idempotent
(i.e. repeated calls don't keep growing the bounds). It's also careful
to use that same "chunking" in syntax.el and in the antiblink code of
jit-lock. Tracing `syntax-ppss` and `syntax-propertize-wholelines`
suggests that this patch is sufficient to keep most of the work "local"
rather than applying to the whole line/file all the time.
>> It doesn't seem to make much difference on the `medium_line.json`
>> example from Phil, tho :-(
> In what case does it make much difference?
None that I can see :-(
> And how did you test whether it makes a difference?
I just did
src/emacs -Q ~/tmp/medium_line.json
and then tried to move around in the buffer, search with Isearch, and
insert a few chars.
I don't notice any difference with or without the patch :-(
Stefan
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 @@ syntax-propertize-extend-region-functions
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 @@ font-lock-extend-region-multiline
(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 @@ font-lock-apply-syntactic-highlight
(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 @@ font-lock-fontify-syntactic-anchored-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 @@ font-lock-fontify-syntactic-anchored-keywords
(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 @@ font-lock-apply-highlight
;; 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 @@ font-lock-fontify-anchored-keywords
(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 @@ font-lock-fontify-anchored-keywords
(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 @@ font-lock-compile-keyword
(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 @@ font-lock-eval-keywords
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 @@ jit-lock-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 @@ jit-lock-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 @@ jit-lock-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 @@ jit-lock-after-change
(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))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.