From: Alan Mackenzie Date: Tue, 15 Oct 2024 21:08:41 +0000 (+0000) Subject: CC Mode: Rationalize and optimize cache invalidation (2). X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=31c5a8a244f27eeaaaab16e20d281a79a8df67d8;p=emacs.git CC Mode: Rationalize and optimize cache invalidation (2). Replace separate syntax-table text property changes and cache invalidation with macros which do both together. Correct a bug in the invocation of XEmacs's map-extents. * lisp/progmodes/cc-defs.el (c-put-syntax-table-trim-caches) (c-clear-syntax-table-trim-caches) (c-clear-syntax-table-properties-trim-caches) (c-clear-syntax-table-with-value-trim-caches) (c-clear-syntax-table-with-value-on-char-trim-caches) (c-put-syntax-table-properties-on-char-trim-caches): New macros. (c-clear-char-properties, c-clear-char-property-with-value) (c-clear-char-property-with-value-on-char): Correct the invocation of XEmacs's map-extents by returning nil from the mapping function to prevent premature exit from map-extents. (c-clear-char-property-with-value-function) (c-clear-char-property-with-value) (c-clear-char-property-with-value-on-char-function) (c-clear-char-property-with-value-on-char) (c-put-char-properties-on-char): Enhance to return the position of the first changed char property (or nil). * lisp/progmodes/cc-awk.el (c-awk-set-string-regexp-syntax-table-properties) (c-awk-set-syntax-table-properties) * lisp/progmodes/cc-engine.el (c-depropertize-ml-string-delims) (c-after-change-unmark-ml-strings, c-propertize-ml-string-id) (c-propertize-ml-string-opener, c-depropertize-ml-string) (c-depropertize-ml-strings-in-region) * lisp/progmodes/cc-mode.el (c-depropertize-CPP) (c-neutralize-CPP-line, c-put-syn-tab, c-clear-syn-tab) (c-parse-quotes-before-change, c-parse-quotes-after-change) (c-before-change-fix-comment-escapes) (c-after-change-fix-comment-escapes): Use the new macros from cc-defs.el. * lisp/progmodes/cc-mode.el (c-trim-cache-first-punctuation-prop): Remove. (c-depropertize-CPP): Remove calls to the above function. (cherry picked from commit fdac10b216f7b47e2eea129d2a96807a0c2055f3) --- diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index e377c4831fc..b71442c4751 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -761,14 +761,14 @@ (c-put-string-fence end)) ((eq (char-after beg) ?/) ; Properly bracketed regexp (c-put-char-property beg 'syntax-table '(7)) ; (7) = "string" - (c-put-char-property end 'syntax-table '(7))) - (t)) ; Properly bracketed string: Nothing to do. + (c-put-syntax-table-trim-caches end '(7))) + (t)) ; Properly bracketed string: Nothing to do. ;; Now change the properties of any escaped "s in the string to punctuation. (save-excursion (goto-char (1+ beg)) (or (eobp) - (while (search-forward "\"" end t) - (c-put-char-property (1- (point)) 'syntax-table '(1)))))) + (while (search-forward "\"" end t) + (c-put-syntax-table-trim-caches (1- (point)) '(1)))))) (defun c-awk-syntax-tablify-string () ;; Point is at the opening " or _" of a string. Set the syntax-table @@ -861,7 +861,7 @@ (let (anchor (anchor-state-/div nil)) ; t means a following / would be a div sign. (c-awk-beginning-of-logical-line) ; ACM 2002/7/21. This is probably redundant. - (c-clear-char-properties (point) lim 'syntax-table) + (c-clear-syntax-table-properties-trim-caches (point) lim) ;; Once round the next loop for each string, regexp, or div sign (while (progn ;; Skip any "harmless" lines before the next tricky one. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e3eb1c96009..23dea22d138 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1248,6 +1248,14 @@ MODE is either a mode symbol or a list of mode symbols." `((setq c-syntax-table-hwm (min c-syntax-table-hwm -pos-)))) (put-text-property -pos- (1+ -pos-) ',property ,value)))) +(defmacro c-put-syntax-table-trim-caches (pos value) + ;; Put a 'syntax-table property with VALUE at POS. Also invalidate four + ;; caches from the position POS. + (declare (debug t)) + `(let ((-pos- ,pos)) + (c-put-char-property -pos- 'syntax-table ,value) + (c-truncate-lit-pos/state-cache -pos-))) + (defmacro c-put-string-fence (pos) ;; Put the string-fence syntax-table text property at POS. ;; Since the character there cannot then count as syntactic whitespace, @@ -1333,6 +1341,14 @@ MODE is either a mode symbol or a list of mode symbols." ;; Emacs < 21. `(c-clear-char-property-fun ,pos ',property)))) +(defmacro c-clear-syntax-table-trim-caches (pos) + ;; Remove the 'syntax-table property at POS and invalidate the four caches + ;; from that position. + (declare (debug t)) + `(let ((-pos- ,pos)) + (c-clear-char-property -pos- 'syntax-table) + (c-truncate-lit-pos/state-cache -pos-))) + (defmacro c-min-property-position (from to property) ;; Return the first position in the range [FROM to) where the text property ;; PROPERTY is set, or `most-positive-fixnum' if there is no such position. @@ -1387,7 +1403,8 @@ MODE is either a mode symbol or a list of mode symbols." (c-use-extents ;; XEmacs `(map-extents (lambda (ext ignored) - (delete-extent ext)) + (delete-extent ext) + nil) ; To prevent exit from `map-extents'. nil ret -to- nil nil ',property)) ((and (fboundp 'syntax-ppss) (eq property 'syntax-table)) @@ -1402,6 +1419,15 @@ MODE is either a mode symbol or a list of mode symbols." ret) nil))) +(defmacro c-clear-syntax-table-properties-trim-caches (from to) + ;; Remove all occurrences of the 'syntax-table property in (FROM TO) and + ;; invalidate the four caches from the first position from which the + ;; property was removed, if any. + (declare (debug t)) + `(let ((first (c-clear-char-properties ,from ,to 'syntax-table))) + (when first + (c-truncate-lit-pos/state-cache first)))) + (defmacro c-clear-syn-tab-properties (from to) ;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text ;; properties between FROM and TO. @@ -1492,8 +1518,10 @@ point is then left undefined." "Remove all text-properties PROPERTY from the region (FROM, TO) which have the value VALUE, as tested by `equal'. These properties are assumed to be over individual characters, having -been put there by `c-put-char-property'. POINT remains unchanged." - (let ((place from) end-place) +been put there by `c-put-char-property'. POINT remains unchanged. +Return the position of the first removed property, if any, or nil." + (let ((place from) end-place + first) (while ; loop round occurrences of (PROPERTY VALUE) (progn (while ; loop round changes in PROPERTY till we find VALUE @@ -1506,25 +1534,51 @@ been put there by `c-put-char-property'. POINT remains unchanged." (setq c-syntax-table-hwm (min c-syntax-table-hwm place))) (setq end-place (c-next-single-property-change place property nil to)) (remove-text-properties place end-place (list property nil)) + (unless first (setq first place)) ;; Do we have to do anything with stickiness here? - (setq place end-place)))) + (setq place end-place)) + first)) (defmacro c-clear-char-property-with-value (from to property value) "Remove all text-properties PROPERTY from the region [FROM, TO) which have the value VALUE, as tested by `equal'. These properties are assumed to be over individual characters, having -been put there by `c-put-char-property'. POINT remains unchanged." +been put there by `c-put-char-property'. POINT remains unchanged. +Return the position of the first removed property, or nil." (declare (debug t)) (if c-use-extents ;; XEmacs - `(let ((-property- ,property)) + `(let ((-property- ,property) + (first (1+ (point-max)))) (map-extents (lambda (ext val) - (if (equal (extent-property ext -property-) val) - (delete-extent ext))) - nil ,from ,to ,value nil -property-)) - ;; GNU Emacs + ;; In the following, the test on the extent's property + ;; is probably redundant. See documentation of + ;; `map-extents'. NO it's NOT! This automatic check + ;; would require another argument to `map-extents', + ;; but the test would use `eq', not `equal', so it's + ;; no good. :-( + (when (equal (extent-property ext -property-) val) + (setq first (min first + (extent-start-position ext))) + (delete-extent ext)) + nil) + nil ,from ,to ,value nil -property-) + (and (<= first (point-max)) first)) + ;; Gnu Emacs `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) +(defmacro c-clear-syntax-table-with-value-trim-caches (from to value) + "Remove all `syntax-table' text-properties with value VALUE from [FROM, TO) +and invalidate the four caches from the first postion, if any, where a +property was removed. Return the position of the first property removed, +if any, else nil. POINT and the match data remain unchanged." + (declare (debug t)) + `(let ((first + (c-clear-char-property-with-value ,from ,to 'syntax-table ,value))) + (when first + (c-truncate-lit-pos/state-cache first)) + first)) + (defmacro c-search-forward-char-property-with-value-on-char (property value char &optional limit) "Search forward for a text-property PROPERTY having value VALUE on a @@ -1623,7 +1677,8 @@ property, or nil." (or first (progn (setq first place) (when (eq property 'syntax-table) - (setq c-syntax-table-hwm (min c-syntax-table-hwm place)))))) + (setq c-syntax-table-hwm + (min c-syntax-table-hwm place)))))) ;; Do we have to do anything with stickiness here? (setq place (1+ place))) first)) @@ -1642,26 +1697,46 @@ property, or nil." (-char- ,char) (first (1+ (point-max)))) (map-extents (lambda (ext val) - (when (and (equal (extent-property ext -property-) val) + ;; In the following, the test on the extent's property + ;; is probably redundant. See documentation of + ;; map-extents. NO! See + ;; `c-clear-char-property-with-value'. + (when (and (equal (extent-property ext -property-) + val) (eq (char-after (extent-start-position ext)) -char-)) (setq first (min first (extent-start-position ext))) - (delete-extent ext))) + (delete-extent ext)) + nil) nil ,from ,to ,value nil -property-) (and (<= first (point-max)) first)) - ;; GNU Emacs + ;; Gnu Emacs `(c-clear-char-property-with-value-on-char-function ,from ,to ,property ,value ,char))) +(defmacro c-clear-syntax-table-with-value-on-char-trim-caches + (from to value char) + "Remove all `syntax-table' properties with VALUE on CHAR in [FROM, TO), +as tested by `equal', and invalidate the four caches from the first position, +if any, where a property was removed. POINT and the match data remain +unchanged." + (declare (debug t)) + `(let ((first (c-clear-char-property-with-value-on-char + ,from ,to 'syntax-table ,value ,char))) + (when first + (c-truncate-lit-pos/state-cache first)))) + (defmacro c-put-char-properties-on-char (from to property value char) ;; This needs to be a macro because `property' passed to ;; `c-put-char-property' must be a constant. "Put the text property PROPERTY with value VALUE on characters -with value CHAR in the region [FROM to)." +with value CHAR in the region [FROM to). Return the position of the +first char changed, if any, else nil." (declare (debug t)) `(let ((skip-string (concat "^" (list ,char))) - (-to- ,to)) + (-to- ,to) + first) (save-excursion (goto-char ,from) (while (progn (skip-chars-forward skip-string -to-) @@ -1670,8 +1745,20 @@ with value CHAR in the region [FROM to)." (eq (eval property) 'syntax-table)) `((setq c-syntax-table-hwm (min c-syntax-table-hwm (point))))) (c-put-char-property (point) ,property ,value) - (forward-char))))) - + (when (not first) (setq first (point))) + (forward-char))) + first)) + +(defmacro c-put-syntax-table-properties-on-char-trim-caches + (from to value char) + "Put a `syntax-table' text property with value VALUE on all characters +with value CHAR in the region [FROM to), and invalidate the four caches +from the first position, if any, where a property was put." + (declare (debug t)) + `(let ((first (c-put-char-properties-on-char + ,from ,to 'syntax-table ,value ,char))) + (when first + (c-truncate-lit-pos/state-cache first)))) ;; Miscellaneous macro(s) (defvar c-string-fences-set-flag nil) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 8c62ec8448d..174989543b9 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -164,6 +164,7 @@ (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) +(defvar c-state-cache-invalid-pos) (defvar c-doc-line-join-re) (defvar c-doc-bright-comment-start-re) (defvar c-doc-line-join-end-ch) @@ -3210,6 +3211,7 @@ comment at the start of cc-engine.el for more info." (c-full-put-near-cache-entry here s nil)) (list s)))))))) + (defsubst c-truncate-lit-pos-cache (pos) ;; Truncate the upper bound of each of the three caches to POS, if it is ;; higher than that position. @@ -3217,6 +3219,12 @@ comment at the start of cc-engine.el for more info." c-semi-near-cache-limit (min c-semi-near-cache-limit pos) c-full-near-cache-limit (min c-full-near-cache-limit pos))) +(defsubst c-truncate-lit-pos/state-cache (pos) + ;; Truncate the upper bound of each of the four caches to POS, if it is + ;; higher than that position. + (c-truncate-lit-pos-cache pos) + (setq c-state-cache-invalid-pos (min c-state-cache-invalid-pos pos))) + (defun c-foreign-truncate-lit-pos-cache (beg _end) "Truncate CC Mode's literal cache. @@ -3266,7 +3274,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and ;; subparen that is closed before the last recorded position. ;; ;; The exact position is chosen to try to be close to yet earlier than -;; the position where `c-state-cache' will be called next. Right now +;; the position where `c-parse-state' will be called next. Right now ;; the heuristic is to set it to the position after the last found ;; closing paren (of any type) before the line on which ;; `c-parse-state' was called. That is chosen primarily to work well @@ -3282,6 +3290,19 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and ;; the middle of the desert, as long as it is not within a brace pair ;; recorded in `c-state-cache' or a paren/bracket pair. +(defvar c-state-cache-invalid-pos 1) +(make-variable-buffer-local 'c-state-cache-invalid-pos) +;; This variable is always a number, and is typically eq to +;; `c-state-cache-good-pos'. +;; +;; Its purpose is to record the position that `c-invalidate-state-cache' needs +;; to trim `c-state-cache' to. +;; +;; When a `syntax-table' text property has been +;; modified at a position before `c-state-cache-good-pos', it gets set to +;; the lowest such position. When that variable is nil, +;; `c-state-cache-invalid-pos' is set to `c-state-point-min-literal'. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; We maintain a simple cache of positions which aren't in a literal, so as to ;; speed up testing for non-literality. @@ -3746,6 +3767,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (c-state-mark-point-min-literal) (setq c-state-cache nil c-state-cache-good-pos c-state-min-scan-pos + c-state-cache-invalid-pos c-state-cache-good-pos c-state-brace-pair-desert nil)) ;; point-min has MOVED FORWARD. @@ -3769,7 +3791,8 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and ; inside a recorded ; brace pair. (setq c-state-cache nil - c-state-cache-good-pos c-state-min-scan-pos) + c-state-cache-good-pos c-state-min-scan-pos + c-state-cache-invalid-pos c-state-cache-good-pos) ;; Do not alter the original `c-state-cache' structure, since there ;; may be a loop suspended which is looping through that structure. ;; This may have been the cause of bug #37910. @@ -3777,7 +3800,8 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (setcdr ptr nil) (setq c-state-cache (copy-sequence c-state-cache)) (setcdr ptr cdr-ptr)) - (setq c-state-cache-good-pos (1+ (c-state-cache-top-lparen)))) + (setq c-state-cache-good-pos (1+ (c-state-cache-top-lparen)) + c-state-cache-invalid-pos c-state-cache-good-pos)) ))) (setq c-state-point-min (point-min))) @@ -4301,6 +4325,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (defun c-state-cache-init () (setq c-state-cache nil c-state-cache-good-pos 1 + c-state-cache-invalid-pos 1 c-state-nonlit-pos-cache nil c-state-nonlit-pos-cache-limit 1 c-state-brace-pair-desert nil @@ -4337,8 +4362,9 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (defun c-invalidate-state-cache-1 (here) ;; Invalidate all info on `c-state-cache' that applies to the buffer at HERE - ;; or higher and set `c-state-cache-good-pos' accordingly. The cache is - ;; left in a consistent state. + ;; or higher and set `c-state-cache-good-pos' and + ;; `c-state-cache-invalid-pos' accordingly. The cache is left in a + ;; consistent state. ;; ;; This is much like `c-whack-state-after', but it never changes a paren ;; pair element into an open paren element. Doing that would mean that the @@ -4352,7 +4378,6 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and ;; HERE. (if (<= here c-state-nonlit-pos-cache-limit) (setq c-state-nonlit-pos-cache-limit (1- here))) - (c-truncate-lit-pos-cache here) (cond ;; `c-state-cache': @@ -4362,6 +4387,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (< here (c-state-get-min-scan-pos))) (setq c-state-cache nil c-state-cache-good-pos nil + c-state-cache-invalid-pos (c-state-get-min-scan-pos) c-state-min-scan-pos nil)) ;; Case 2: `here' is below `c-state-cache-good-pos', so we need to amend @@ -4376,7 +4402,9 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (setq c-state-cache-good-pos (if scan-forward-p (c-append-to-state-cache good-pos here) - good-pos))))) + good-pos) + c-state-cache-invalid-pos + (or c-state-cache-good-pos (c-state-get-min-scan-pos)))))) ;; The brace-pair desert marker: (when (car c-state-brace-pair-desert) @@ -4473,7 +4501,8 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (if (and bopl-state (< good-pos (- here c-state-cache-too-far))) (c-state-cache-lower-good-pos here here-bopl bopl-state) - good-pos))) + good-pos) + c-state-cache-invalid-pos c-state-cache-good-pos)) ((eq strategy 'backward) (setq res (c-remove-stale-state-cache-backwards here) @@ -4485,7 +4514,8 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (setq c-state-cache-good-pos (if scan-forward-p (c-append-to-state-cache good-pos here) - good-pos))) + good-pos) + c-state-cache-invalid-pos c-state-cache-good-pos)) (t ; (eq strategy 'IN-LIT) (setq c-state-cache nil @@ -4493,7 +4523,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and c-state-cache) -(defun c-invalidate-state-cache (here) +(defun c-invalidate-state-cache () ;; This is a wrapper over `c-invalidate-state-cache-1'. ;; ;; It suppresses the syntactic effect of the < and > (template) brackets and @@ -4503,9 +4533,9 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (if (eval-when-compile (memq 'category-properties c-emacs-features)) ;; Emacs (c-with-<->-as-parens-suppressed - (c-invalidate-state-cache-1 here)) + (c-invalidate-state-cache-1 c-state-cache-invalid-pos)) ;; XEmacs - (c-invalidate-state-cache-1 here))) + (c-invalidate-state-cache-1 c-state-cache-invalid-pos))) (defmacro c-state-maybe-marker (place marker) ;; If PLACE is non-nil, return a marker marking it, otherwise nil. @@ -4538,8 +4568,14 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (if (eval-when-compile (memq 'category-properties c-emacs-features)) ;; Emacs (c-with-<->-as-parens-suppressed + (when (< c-state-cache-invalid-pos + (or c-state-cache-good-pos (c-state-get-min-scan-pos))) + (c-invalidate-state-cache-1 c-state-cache-invalid-pos)) (c-parse-state-1)) ;; XEmacs + (when (< c-state-cache-invalid-pos + (or c-state-cache-good-pos (c-state-get-min-scan-pos))) + (c-invalidate-state-cache-1 c-state-cache-invalid-pos)) (c-parse-state-1)) (setq c-state-old-cpp-beg (c-state-maybe-marker here-cpp-beg c-state-old-cpp-beg-marker) @@ -4571,6 +4607,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (t val))))) '(c-state-cache c-state-cache-good-pos + c-state-cache-invalid-pos c-state-nonlit-pos-cache c-state-nonlit-pos-cache-limit c-state-brace-pair-desert @@ -4608,6 +4645,7 @@ initializing CC Mode. Currently (2020-06) these are `js-mode' and (let ((here (point)) (min-point (point-min)) (res1 (c-real-parse-state)) res2) (let ((c-state-cache nil) (c-state-cache-good-pos 1) + (c-state-cache-invalid-pos 1) (c-state-nonlit-pos-cache nil) (c-state-nonlit-pos-cache-limit 1) (c-state-brace-pair-desert nil) @@ -6988,9 +7026,9 @@ comment at the start of cc-engine.el for more info." (when (equal (c-get-char-property (1- (point)) 'syntax-table) c->-as-paren-syntax) ; should always be true. (c-unmark-<->-as-paren (1- (point))) - (c-truncate-lit-pos-cache (1- (point)))) + (c-truncate-lit-pos/state-cache (1- (point)))) (c-unmark-<->-as-paren pos) - (c-truncate-lit-pos-cache pos)))) + (c-truncate-lit-pos/state-cache pos)))) (defun c-clear->-pair-props (&optional pos) ;; POS (default point) is at a > character. If it is marked with @@ -7007,9 +7045,9 @@ comment at the start of cc-engine.el for more info." (when (equal (c-get-char-property (point) 'syntax-table) c-<-as-paren-syntax) ; should always be true. (c-unmark-<->-as-paren (point)) - (c-truncate-lit-pos-cache (point))) + (c-truncate-lit-pos/state-cache (point))) (c-unmark-<->-as-paren pos) - (c-truncate-lit-pos-cache pos)))) + (c-truncate-lit-pos/state-cache pos)))) (defun c-clear-<>-pair-props (&optional pos) ;; POS (default point) is at a < or > character. If it has an @@ -7043,7 +7081,7 @@ comment at the start of cc-engine.el for more info." c->-as-paren-syntax)) ; should always be true. (c-unmark-<->-as-paren (1- (point))) (c-unmark-<->-as-paren pos) - (c-truncate-lit-pos-cache pos) + (c-truncate-lit-pos/state-cache pos) (point))))) (defun c-clear->-pair-props-if-match-before (lim &optional pos) @@ -7064,7 +7102,7 @@ comment at the start of cc-engine.el for more info." (equal (c-get-char-property (point) 'syntax-table) c-<-as-paren-syntax)) ; should always be true. (c-unmark-<->-as-paren (point)) - (c-truncate-lit-pos-cache (point)) + (c-truncate-lit-pos/state-cache (point)) (c-unmark-<->-as-paren pos) (point))))) @@ -7183,7 +7221,8 @@ comment at the start of cc-engine.el for more info." (not (eq beg-literal-end end-literal-end)) (skip-chars-forward "\\\\") (eq (char-after) ?\n) - (not (zerop (skip-chars-backward "\\\\")))) + (not (zerop (skip-chars-backward "\\\\"))) + (< (point) end)) (setq swap-open-string-ends t) (if (c-get-char-property (1- beg-literal-end) 'syntax-table) @@ -7489,16 +7528,11 @@ multi-line strings (but not C++, for example)." ;; Remove any syntax-table text properties from the multi-line string ;; delimiters specified by STRING-DELIMS, the output of ;; `c-ml-string-delims-around-point'. - (let (found) - (if (setq found (c-clear-char-properties (caar string-delims) - (cadar string-delims) - 'syntax-table)) - (c-truncate-lit-pos-cache found)) + (c-clear-syntax-table-properties-trim-caches (caar string-delims) + (cadar string-delims)) (when (cdr string-delims) - (if (setq found (c-clear-char-properties (cadr string-delims) - (caddr string-delims) - 'syntax-table)) - (c-truncate-lit-pos-cache found))))) + (c-clear-syntax-table-properties-trim-caches (cadr string-delims) + (caddr string-delims)))) (defun c-get-ml-closer (open-delim) ;; Return the closer, a three element dotted list of the closer's start, its @@ -7932,7 +7966,7 @@ multi-line strings (but not C++, for example)." ((eq (nth 3 (car state)) t) (insert ?\") (c-put-string-fence end))) - (c-truncate-lit-pos-cache end) + (c-truncate-lit-pos/state-cache end) ;; ....ensure c-new-END extends right to the end of the about ;; to be un-stringed raw string.... (save-excursion @@ -7952,7 +7986,7 @@ multi-line strings (but not C++, for example)." ;; Remove the temporary string delimiter. (goto-char end) (delete-char 1) - (c-truncate-lit-pos-cache end)))) + (c-truncate-lit-pos/state-cache end)))) ;; Have we just created a new starting id? (goto-char beg) @@ -8002,7 +8036,7 @@ multi-line strings (but not C++, for example)." (> (point) beg))) (goto-char (caar c-old-1-beg-ml)) (setq c-new-BEG (min c-new-BEG (point))) - (c-truncate-lit-pos-cache (point)))) + (c-truncate-lit-pos/state-cache (point)))) (when (looking-at c-ml-string-opener-re) (goto-char (match-end 1)) @@ -8015,11 +8049,8 @@ multi-line strings (but not C++, for example)." (when (c-get-char-property (match-beginning 2) 'c-fl-syn-tab) (c-remove-string-fences (match-beginning 2))) (setq c-new-END (point-max)) - (c-clear-char-properties (caar (or c-old-beg-ml c-old-1-beg-ml)) - c-new-END - 'syntax-table) - (c-truncate-lit-pos-cache - (caar (or c-old-beg-ml c-old-1-beg-ml)))))) + (c-clear-syntax-table-properties-trim-caches + (caar (or c-old-beg-ml c-old-1-beg-ml)) c-new-END)))) ;; Have we disturbed the innards of an ml string, possibly by deleting "s? (when (and @@ -8045,10 +8076,9 @@ multi-line strings (but not C++, for example)." bound 'bound) (< (match-end 1) new-END-end-ml-string)) (setq c-new-END (max new-END-end-ml-string c-new-END)) - (c-clear-char-properties (caar c-old-beg-ml) c-new-END - 'syntax-table) - (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG)) - (c-truncate-lit-pos-cache (caar c-old-beg-ml))))) + (c-clear-syntax-table-properties-trim-caches + (caar c-old-beg-ml) c-new-END) + (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG))))) ;; Have we terminated an existing raw string by inserting or removing ;; text? @@ -8082,7 +8112,7 @@ multi-line strings (but not C++, for example)." (setq c-new-BEG (min (point) c-new-BEG) c-new-END (point-max)) (c-clear-syn-tab-properties (point) c-new-END) - (c-truncate-lit-pos-cache (point))))) + (c-truncate-lit-pos/state-cache (point))))) ;; Are there any raw strings in a newly created macro? (goto-char (c-point 'bol beg)) @@ -8136,8 +8166,7 @@ multi-line strings (but not C++, for example)." (cadr delim)) (< (point) (cadr delim))) (when (not (eq (point) (cddr delim))) - (c-put-char-property (point) 'syntax-table '(1)) - (c-truncate-lit-pos-cache (point))) + (c-put-syntax-table-trim-caches (point) '(1))) (forward-char)))) (defun c-propertize-ml-string-opener (delim bound) @@ -8170,14 +8199,12 @@ multi-line strings (but not C++, for example)." (while (progn (skip-syntax-forward c-ml-string-non-punc-skip-chars (car end-delim)) (< (point) (car end-delim))) - (c-put-char-property (point) 'syntax-table '(1)) ; punctuation - (c-truncate-lit-pos-cache (point)) + (c-put-syntax-table-trim-caches (point) '(1)) ; punctuation (forward-char)) (goto-char (cadr end-delim)) t) - (c-put-char-property (cddr delim) 'syntax-table '(1)) + (c-put-syntax-table-trim-caches (cddr delim) '(1)) (c-put-string-fence (1- (cadr delim))) - (c-truncate-lit-pos-cache (1- (cddr delim))) (when bound ;; In a CPP construct, we try to apply a generic-string ;; `syntax-table' text property to the last possible character in @@ -8207,10 +8234,9 @@ multi-line strings (but not C++, for example)." (if (match-beginning 10) (progn (c-put-string-fence (match-beginning 10)) - (c-truncate-lit-pos-cache (match-beginning 10))) - (c-put-char-property (match-beginning 5) 'syntax-table '(1)) - (c-put-string-fence (1+ (match-beginning 5))) - (c-truncate-lit-pos-cache (match-beginning 5)))) + (c-truncate-lit-pos/state-cache (match-beginning 10))) + (c-put-syntax-table-trim-caches (match-beginning 5) '(1)) + (c-put-string-fence (1+ (match-beginning 5))))) (goto-char bound)) nil)) @@ -8250,20 +8276,18 @@ multi-line strings (but not C++, for example)." '(15))) (goto-char (cdddr string-delims)) (when (c-safe (c-forward-sexp)) ; To '(15) at EOL. - (c-clear-char-property (1- (point)) 'syntax-table) - (c-truncate-lit-pos-cache (1- (point))))) + (c-clear-syntax-table-trim-caches (1- (point))))) ;; The '(15) in the closing delimiter will be cleared by the following. (c-depropertize-ml-string-delims string-delims) (let ((bound1 (if (cdr string-delims) (caddr string-delims) ; end of closing delimiter. bound)) - first s) - (if (and - bound1 - (setq first (c-clear-char-properties (cadar string-delims) bound1 - 'syntax-table))) - (c-truncate-lit-pos-cache first)) + s) + (if bound1 + (c-clear-syntax-table-properties-trim-caches + (cadar string-delims) bound1)) + (setq s (parse-partial-sexp (or c-neutralize-pos (caar string-delims)) (or bound1 (point-max)))) (cond @@ -8272,15 +8296,13 @@ multi-line strings (but not C++, for example)." (setq c-neutralize-pos (nth 8 s)) (setq c-neutralized-prop (c-get-char-property c-neutralize-pos 'syntax-table)) - (c-put-char-property c-neutralize-pos 'syntax-table '(1)) - (c-truncate-lit-pos-cache c-neutralize-pos)) + (c-put-syntax-table-trim-caches c-neutralize-pos '(1))) ((eq (nth 3 s) (char-after c-neutralize-pos)) ;; New unbalanced quote balances old one. (if c-neutralized-prop - (c-put-char-property c-neutralize-pos 'syntax-table - c-neutralized-prop) - (c-clear-char-property c-neutralize-pos 'syntax-table)) - (c-truncate-lit-pos-cache c-neutralize-pos) + (c-put-syntax-table-trim-caches c-neutralize-pos + c-neutralized-prop) + (c-clear-syntax-table-trim-caches c-neutralize-pos)) (setq c-neutralize-pos nil)) ;; New unbalanced quote doesn't balance old one. Nothing to do. ))) @@ -8339,10 +8361,8 @@ multi-line strings (but not C++, for example)." eom))))))) ; bound. (when c-neutralize-pos (if c-neutralized-prop - (c-put-char-property c-neutralize-pos 'syntax-table - c-neutralized-prop) - (c-clear-char-property c-neutralize-pos 'syntax-table)) - (c-truncate-lit-pos-cache c-neutralize-pos))) + (c-put-syntax-table-trim-caches c-neutralize-pos c-neutralized-prop) + (c-clear-syntax-table-trim-caches c-neutralize-pos)))) (defun c-before-after-change-check-c++-modules (beg end &optional _old_len) @@ -8782,7 +8802,7 @@ multi-line strings (but not C++, for example)." (when c-parse-and-markup-<>-arglists (c-mark-<-as-paren (point)) (c-mark->-as-paren (match-beginning 1)) - (c-truncate-lit-pos-cache (point))) + (c-truncate-lit-pos/state-cache (point))) (goto-char (match-end 1)) t) nil)) @@ -8916,11 +8936,11 @@ multi-line strings (but not C++, for example)." (save-excursion (and (c-go-list-backward) (eq (char-after) ?<) - (c-truncate-lit-pos-cache (point)) + (c-truncate-lit-pos/state-cache (point)) (c-unmark-<->-as-paren (point))))) (c-mark-<-as-paren start) (c-mark->-as-paren (1- (point))) - (c-truncate-lit-pos-cache start)) + (c-truncate-lit-pos/state-cache start)) (setq res t) nil)) ; Exit the loop. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 2fd1fb68fc0..dbf5b796c35 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -658,7 +658,7 @@ that requires a literal mode spec at compile time." ;; Initialize the cache for `c-looking-at-or-maybe-in-bracelist'. (setq c-laomib-cache nil) ;; Initialize the three literal sub-caches. - (c-truncate-lit-pos-cache 1) + (c-truncate-lit-pos/state-cache 1) ;; Initialize the cache of brace pairs, and opening braces/brackets/parens. (c-state-cache-init) ;; Initialize the "brace stack" cache. @@ -1010,8 +1010,8 @@ Note that the style variables are always made local to the buffer." (setq m-beg (point)) (c-end-of-macro) (when c-ml-string-opener-re - (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))) - (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) + (save-excursion (c-depropertize-ml-strings-in-region m-beg (point))) + (c-clear-syntax-table-with-value-trim-caches m-beg (point) '(1)))) (while (and (< (point) end) (setq ss-found @@ -1022,17 +1022,17 @@ Note that the style variables are always made local to the buffer." (when (and ss-found (> (point) end)) (when c-ml-string-opener-re (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))) - (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) + (c-clear-syntax-table-with-value-trim-caches m-beg (point) '(1))) (while (and (< (point) c-new-END) - (search-forward-regexp c-anchored-cpp-prefix c-new-END 'bound)) + (search-forward-regexp c-anchored-cpp-prefix + c-new-END 'bound)) (goto-char (match-beginning 1)) (setq m-beg (point)) (c-end-of-macro) (when c-ml-string-opener-re (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))) - (c-clear-char-property-with-value - m-beg (point) 'syntax-table '(1))))) + (c-clear-syntax-table-with-value-trim-caches m-beg (point) '(1))))) (defun c-extend-region-for-CPP (_beg _end) ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of @@ -1113,7 +1113,7 @@ Note that the style variables are always made local to the buffer." (setq s (parse-partial-sexp beg end -1)) (cond ((< (nth 0 s) 0) ; found an unmated ),},] - (c-put-char-property (1- (point)) 'syntax-table '(1)) + (c-put-syntax-table-trim-caches (1- (point)) '(1)) t) ;; Unbalanced strings are now handled by ;; `c-before-change-check-unbalanced-strings', etc. @@ -1121,7 +1121,7 @@ Note that the style variables are always made local to the buffer." ;; (c-put-char-property (nth 8 s) 'syntax-table '(1)) ;; t) ((> (nth 0 s) 0) ; In a (,{,[ - (c-put-char-property (nth 1 s) 'syntax-table '(1)) + (c-put-syntax-table-trim-caches (nth 1 s) '(1)) t) (t nil))))))) @@ -1271,7 +1271,7 @@ Note that the style variables are always made local to the buffer." ;; (-value- ,value)) (if (equal value '(15)) (c-put-string-fence pos) - (c-put-char-property pos 'syntax-table value)) + (c-put-syntax-table-trim-caches pos value)) (c-put-char-property pos 'c-fl-syn-tab value) (cond ((null c-min-syn-tab-mkr) @@ -1282,12 +1282,11 @@ Note that the style variables are always made local to the buffer." ((null c-max-syn-tab-mkr) (setq c-max-syn-tab-mkr (copy-marker (1+ pos) nil))) ((>= pos c-max-syn-tab-mkr) - (move-marker c-max-syn-tab-mkr (1+ pos)))) - (c-truncate-lit-pos-cache pos)) + (move-marker c-max-syn-tab-mkr (1+ pos))))) (defun c-clear-syn-tab (pos) ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS. - (c-clear-char-property pos 'syntax-table) + (c-clear-syntax-table-trim-caches pos) (c-clear-char-property pos 'c-fl-syn-tab) (when c-min-syn-tab-mkr (if (and (eq pos (marker-position c-min-syn-tab-mkr)) @@ -1308,12 +1307,15 @@ Note that the style variables are always made local to the buffer." pos (c-previous-single-property-change pos 'c-fl-syn-tab nil (1+ c-min-syn-tab-mkr))))))) - (c-truncate-lit-pos-cache pos)) + (c-truncate-lit-pos/state-cache pos)) (defun c-clear-string-fences () ;; Clear syntax-table text properties which are "mirrored" by c-fl-syn-tab ;; text properties. However, any such " character which ends up not being ;; balanced by another " is left with a '(1) syntax-table property. + ;; Note we don't truncate the caches in this function, since it is only + ;; called before leaving CC Mode, and the text properties will be restored + ;; by `c-restore-string-fences' before we continue in CC Mode. (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr) (c-save-buffer-state (s pos) ; Prevent text property stuff causing change @@ -1378,6 +1380,7 @@ Note that the style variables are always made local to the buffer." (defun c-restore-string-fences () ;; Restore any syntax-table text properties which are "mirrored" by ;; c-fl-syn-tab text properties. + ;; We don't truncate the caches here. See `c-clear-string-fences'. (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr) (c-save-buffer-state ; Prevent text property stuff causing change function ; invocation. @@ -1934,12 +1937,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (goto-char c-new-BEG) (when (c-search-forward-char-property-with-value-on-char 'syntax-table '(1) ?\' c-new-END) - (c-invalidate-state-cache (1- (point))) - (c-truncate-lit-pos-cache (1- (point))) - (c-clear-char-property-with-value-on-char - (1- (point)) c-new-END - 'syntax-table '(1) - ?') + (c-clear-syntax-table-with-value-on-char-trim-caches + (1- (point)) c-new-END '(1) ?') ;; Remove the c-digit-separator text property from the same "'"s. (when c-has-quoted-numbers (c-clear-char-property-with-value-on-char @@ -1966,10 +1965,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ((c-quoted-number-straddling-point) (setq num-beg (match-beginning 0) num-end (match-end 0)) - (c-invalidate-state-cache num-beg) - (c-truncate-lit-pos-cache num-beg) - (c-put-char-properties-on-char num-beg num-end - 'syntax-table '(1) ?') + (c-put-syntax-table-properties-on-char-trim-caches + num-beg num-end '(1) ?') (c-put-char-properties-on-char num-beg num-end 'c-digit-separator t ?') (goto-char num-end)) @@ -1978,15 +1975,11 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") \\)'") ; balanced quoted expression. (goto-char (match-end 0))) ((looking-at "\\\\'") ; Anomalous construct. - (c-invalidate-state-cache (1- (point))) - (c-truncate-lit-pos-cache (1- (point))) - (c-put-char-properties-on-char (1- (point)) (+ (point) 2) - 'syntax-table '(1) ?') - (goto-char (match-end 0))) + (c-truncate-lit-pos/state-cache (1- (point))) + (c-put-syntax-table-properties-on-char-trim-caches + (1- (point)) (+ (point) 2) '(1) ?')) (t - (c-invalidate-state-cache (1- (point))) - (c-truncate-lit-pos-cache (1- (point))) - (c-put-char-property (1- (point)) 'syntax-table '(1)))) + (c-put-syntax-table-trim-caches (1- (point)) '(1)))) ;; Prevent the next `c-quoted-number-straddling-point' getting ;; confused by already processed single quotes. (narrow-to-region (point) (point-max)))))) @@ -2023,12 +2016,10 @@ with // and /*, not more generic line and block comments." (if (eq (cadr end-state) 'c) (when (search-forward "\\*/" (or (cdr (caddr end-state)) (point-max)) t) - (c-clear-char-property (match-beginning 0) 'syntax-table) - (c-truncate-lit-pos-cache (match-beginning 0))) + (c-clear-syntax-table-trim-caches (match-beginning 0))) (while (search-forward "\\\\\n" (or (cdr (caddr end-state)) (point-max)) t) - (c-clear-char-property (match-beginning 0) 'syntax-table) - (c-truncate-lit-pos-cache (match-beginning 0))))))) + (c-clear-syntax-table-trim-caches (match-beginning 0))))))) (defun c-after-change-fix-comment-escapes (beg end _old-len) "Apply punctuation syntax-table text properties to C/C++ comment markers. @@ -2060,8 +2051,7 @@ with // and /*, not more generic line and block comments." (match-beginning 3)) ((eq (cadr state) 'c++) (match-beginning 2))) - (c-put-char-property (match-beginning 0) 'syntax-table '(1)) - (c-truncate-lit-pos-cache (match-beginning 0)))) + (c-put-syntax-table-trim-caches (match-beginning 0) '(1)))) (goto-char end) (setq state (c-semi-pp-to-literal (point))) @@ -2069,8 +2059,7 @@ with // and /*, not more generic line and block comments." ((eq (cadr state) 'c) (when (search-forward "*/" nil t) (when (eq (char-before (match-beginning 0)) ?\\) - (c-put-char-property (1- (match-beginning 0)) 'syntax-table '(1)) - (c-truncate-lit-pos-cache (1- (match-beginning 0)))))) + (c-put-syntax-table-trim-caches (1- (match-beginning 0)) '(1))))) ((eq (cadr state) 'c++) (while (progn @@ -2078,8 +2067,7 @@ with // and /*, not more generic line and block comments." (and (eq (char-before) ?\\) (progn (when (eq (char-before (1- (point))) ?\\) - (c-put-char-property (- (point) 2) 'syntax-table '(1)) - (c-truncate-lit-pos-cache (1- (point)))) + (c-put-syntax-table-trim-caches (- (point) 2) '(1))) t) (not (eobp)))) (forward-char)))))) @@ -2265,11 +2253,11 @@ with // and /*, not more generic line and block comments." c-get-state-before-change-functions)) (c-laomib-invalidate-cache beg end)))) - (c-truncate-lit-pos-cache beg) + (c-truncate-lit-pos/state-cache beg) ;; The following must be done here rather than in `c-after-change' ;; because newly inserted parens would foul up the invalidation ;; algorithm. - (c-invalidate-state-cache beg) + (c-invalidate-state-cache) ;; The following must happen after the previous, which likely alters ;; the macro cache. (when c-opt-cpp-symbol