\f
* 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
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."
(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.
(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
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)
(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.
;; 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)))
(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))
(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.
(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))
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.
(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)
(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
(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.
(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))
projects / emacs.git / commitdiff