From b1ed72fd707ddd81bf79b6937bf0a50ced4f025d Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 5 Jun 2022 22:37:32 +0200 Subject: Clarify syntax-ppss doc string * lisp/emacs-lisp/syntax.el (syntax-ppss): Clarify doc string. --- lisp/emacs-lisp/syntax.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/syntax.el') diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 7cc076cd806..a4d7beade13 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -545,10 +545,11 @@ These are valid when the buffer has no restriction.") (defun syntax-ppss (&optional pos) "Parse-Partial-Sexp State at POS, defaulting to point. +If POS is given, this function moves point to POS. + The returned value is the same as that of `parse-partial-sexp' run from `point-min' to POS except that values at positions 2 and 6 in the returned list (counting from 0) cannot be relied upon. -Point is at POS when this function returns. It is necessary to call `syntax-ppss-flush-cache' explicitly if this function is called while `before-change-functions' is -- cgit v1.2.3 From 6a96d1773469e671a3d5710bedf68c21929b5183 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 26 Jun 2022 08:59:38 -0400 Subject: * lisp/emacs-lisp/syntax.el: Rework the handling of nested calls. Nested calls to `syntax-ppss` and `syntax-propertize` can easily happen unexpectedly via ondemand propertizing or `forward-sexp`. Refine the handling of nested calls so we detect them more reliably (e.g. also within `syntax-propertize-extend-region-functions`) and so that the `syntax-ppss` cache is automatically flushed in case it might have been filled with data that's become obsolete since. (syntax-propertize--inhibit-flush): Delete var. (syntax-propertize--in-process-p): New function to replace it. (syntax-ppss-flush-cache): Use it. (syntax-ppss--updated-cache): New var. (syntax-propertize): Make `syntax-propertize--done` binding apply to `syntax-propertize-extend-region-functions` as well, as intended (fixes bug#46713). Use `syntax-ppss--updated-cache` to flush syntax-ppss cache at the end when needed. Don't bind `syntax-propertize--inhibit-flush` any more. (syntax-ppss): Set `syntax-ppss--updated-cache` when applicable. --- lisp/emacs-lisp/syntax.el | 69 +++++++++++++++++++++++++++++++---------------- 1 file changed, 46 insertions(+), 23 deletions(-) (limited to 'lisp/emacs-lisp/syntax.el') diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index a4d7beade13..36b0c56e953 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -345,10 +345,16 @@ END) suitable for `syntax-propertize-function'." (defvar-local syntax-ppss-table nil "Syntax-table to use during `syntax-ppss', if any.") -(defvar-local syntax-propertize--inhibit-flush nil - "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache. -Otherwise it flushes both the ppss cache and the properties -set by `syntax-propertize'") +(defun syntax-propertize--in-process-p () + "Non-nil if we're inside `syntax-propertize'. +This is used to avoid infinite recursion as well as to handle cases where +`syntax-ppss' is called when the final `syntax-table' properties have not +yet been setup, in which case we may end up putting invalid info into the cache. +It's also used so that `syntax-ppss-flush-cache' can be used from within +`syntax-propertize' without ruining the `syntax-table' already set." + (eq syntax-propertize--done most-positive-fixnum)) + +(defvar-local syntax-ppss--updated-cache nil) (defun syntax-propertize (pos) "Ensure that syntax-table properties are set until POS (a buffer point)." @@ -370,21 +376,24 @@ set by `syntax-propertize'") (with-silent-modifications (with-syntax-table (or syntax-ppss-table (syntax-table)) (make-local-variable 'syntax-propertize--done) ;Just in case! + ;; Make sure we let-bind it only buffer-locally. + (make-local-variable 'syntax-ppss--updated-cache) (let* ((start (max (min syntax-propertize--done (point-max)) (point-min))) (end (max pos (min (point-max) (+ start syntax-propertize-chunk-size)))) (first t) - (repeat t)) + (repeat t) + (syntax-ppss--updated-cache nil)) (while repeat (setq repeat nil) (run-hook-wrapped 'syntax-propertize-extend-region-functions (lambda (f) - (let ((new (funcall f start end)) - ;; Avoid recursion! - (syntax-propertize--done most-positive-fixnum)) + ;; Bind `syntax-propertize--done' to avoid recursion! + (let* ((syntax-propertize--done most-positive-fixnum) + (new (funcall f start end))) (if (or (null new) (and (>= (car new) start) (<= (cdr new) end))) nil @@ -399,20 +408,26 @@ set by `syntax-propertize'") ;; Flush ppss cache between the original value of `start' and that ;; set above by syntax-propertize-extend-region-functions. (syntax-ppss-flush-cache start) - ;; Move the limit before calling the function, so the function - ;; can use syntax-ppss. + ;; Move the limit before calling the function, so it's + ;; done in case of errors. (setq syntax-propertize--done end) ;; (message "syntax-propertizing from %s to %s" start end) (remove-text-properties start end '(syntax-table nil syntax-multiline nil)) - ;; Make sure we only let-bind it buffer-locally. - (make-local-variable 'syntax-propertize--inhibit-flush) - ;; Let-bind `syntax-propertize--done' to avoid infinite recursion! - (let ((syntax-propertize--done most-positive-fixnum) - ;; Let `syntax-propertize-function' call - ;; `syntax-ppss-flush-cache' without worries. - (syntax-propertize--inhibit-flush t)) - (funcall syntax-propertize-function start end))))))))) + ;; Bind `syntax-propertize--done' to avoid recursion! + (let ((syntax-propertize--done most-positive-fixnum)) + (funcall syntax-propertize-function start end) + (when syntax-ppss--updated-cache + ;; `syntax-ppss' was called and updated the cache while we + ;; were propertizing so we need to flush the part of the + ;; cache that may have been rendered out-of-date by the new + ;; properties. + ;; We used to require syntax-propertize-functions to do that + ;; manually when applicable, but nowadays the `syntax-ppss' + ;; cache can be updated by too many functions, so the author + ;; of the syntax-propertize-function may not be aware it + ;; can happen. + (syntax-ppss-flush-cache start)))))))))) ;;; Link syntax-propertize with syntax.c. @@ -487,10 +502,10 @@ These are valid when the buffer has no restriction.") (define-obsolete-function-alias 'syntax-ppss-after-change-function #'syntax-ppss-flush-cache "27.1") -(defun syntax-ppss-flush-cache (beg &rest ignored) +(defun syntax-ppss-flush-cache (beg &rest _ignored) "Flush the cache of `syntax-ppss' starting at position BEG." ;; Set syntax-propertize to refontify anything past beg. - (unless syntax-propertize--inhibit-flush + (unless (syntax-propertize--in-process-p) (setq syntax-propertize--done (min beg syntax-propertize--done))) ;; Flush invalid cache entries. (dolist (cell (list syntax-ppss-wide syntax-ppss-narrow)) @@ -517,10 +532,16 @@ These are valid when the buffer has no restriction.") (setcdr cell cache))) )) -;;; FIXME: Explain this variable. Currently only its last (5th) slot is used. -;;; Perhaps the other slots should be removed? +;; FIXME: Explain this variable. Currently only its last (5th) slot is used. +;; Perhaps the other slots should be removed? +;; This variable is only used when `syntax-begin-function' is used and +;; will hence be removed together with `syntax-begin-function'. (defvar syntax-ppss-stats - [(0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (2 . 2500)]) + [(0 . 0) (0 . 0) (0 . 0) (0 . 0) (0 . 0) (2 . 2500)] + "Statistics about which case is more/less frequent in `syntax-ppss'. +The 5th slot drives the heuristic to use `syntax-begin-function'. +The rest is only useful if you're interested in tweaking the algorithm.") + (defun syntax-ppss-stats () (mapcar (lambda (x) (condition-case nil @@ -658,6 +679,7 @@ running the hook." ;; populate the cache so we won't need to do it again soon. (t (syntax-ppss--update-stats 3 pt-min pos) + (setq syntax-ppss--updated-cache t) ;; If `pt-min' is too far, add a few intermediate entries. (while (> (- pos pt-min) (* 2 syntax-ppss-max-span)) @@ -692,6 +714,7 @@ running the hook." (push pair ppss-cache) (setcar ppss-cache pair))))))))) + (setq syntax-ppss--updated-cache t) (setq ppss-last (cons pos ppss)) (setcar cell ppss-last) (setcdr cell ppss-cache) -- cgit v1.2.3 From 15b2138719b34083967001c3903e7560d5e0947c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 30 Jun 2022 13:20:33 -0400 Subject: (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`. --- etc/NEWS | 11 +++++++++++ lisp/emacs-lisp/syntax.el | 46 ++++++++++++++++++++++++++++++++++++++++------ lisp/font-lock.el | 33 +++++++++++++-------------------- lisp/jit-lock.el | 21 +++++++++++---------- 4 files changed, 75 insertions(+), 36 deletions(-) (limited to 'lisp/emacs-lisp/syntax.el') 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)) -- cgit v1.2.3