Correct the fontification of quote marks after buffer changes in CC Mode.
* lisp/progmodes/cc-defs.el (c-search-forward-char-property-with-value-on-char): New macro. * lisp/progmodes/cc-mode.el (c-parse-quotes-before-change) (c-parse-quotes-after-change): Rewrite the functions, simplifying considerably, and removing unnecessary optimisations. Invalidate two caches after manipulating text properties.
This commit is contained in:
Alan Mackenzie
parent
b733a91009
commit
c8439abe22
2 changed files with 119 additions and 81 deletions
|
|
@ -1185,6 +1185,29 @@ been put there by c-put-char-property. POINT remains unchanged."
|
||||||
;; GNU Emacs
|
;; GNU Emacs
|
||||||
`(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
|
`(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
|
||||||
|
|
||||||
|
(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
|
||||||
|
character with value CHAR.
|
||||||
|
LIMIT bounds the search. The value comparison is done with `equal'.
|
||||||
|
PROPERTY must be a constant.
|
||||||
|
|
||||||
|
Leave point just after the character, and set the match data on
|
||||||
|
this character, and return point. If the search fails, return
|
||||||
|
nil; point is then left undefined."
|
||||||
|
`(let ((char-skip (concat "^" (char-to-string ,char)))
|
||||||
|
(-limit- ,limit)
|
||||||
|
(-value- ,value))
|
||||||
|
(while
|
||||||
|
(and
|
||||||
|
(progn (skip-chars-forward char-skip -limit-)
|
||||||
|
(< (point) -limit-))
|
||||||
|
(not (equal (c-get-char-property (point) ,property) -value-)))
|
||||||
|
(forward-char))
|
||||||
|
(when (< (point) -limit-)
|
||||||
|
(search-forward-regexp ".") ; to set the match-data.
|
||||||
|
(point))))
|
||||||
|
|
||||||
(defun c-clear-char-property-with-value-on-char-function (from to property
|
(defun c-clear-char-property-with-value-on-char-function (from to property
|
||||||
value char)
|
value char)
|
||||||
"Remove all text-properties PROPERTY with value VALUE on
|
"Remove all text-properties PROPERTY with value VALUE on
|
||||||
|
|
|
||||||
|
|
@ -1197,76 +1197,82 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
|
||||||
;;
|
;;
|
||||||
;; This function is called exclusively as a before-change function via the
|
;; This function is called exclusively as a before-change function via the
|
||||||
;; variable `c-get-state-before-change-functions'.
|
;; variable `c-get-state-before-change-functions'.
|
||||||
(c-save-buffer-state (p-limit found)
|
(c-save-buffer-state ()
|
||||||
;; Special consideration for deleting \ from '\''.
|
|
||||||
(if (and (> end beg)
|
|
||||||
(eq (char-before end) ?\\)
|
|
||||||
(<= c-new-END end))
|
|
||||||
(setq c-new-END (min (1+ end) (point-max))))
|
|
||||||
|
|
||||||
;; Do we have a ' (or something like ',',',',',') within range of
|
|
||||||
;; c-new-BEG?
|
|
||||||
(goto-char c-new-BEG)
|
(goto-char c-new-BEG)
|
||||||
(setq p-limit (max (- (point) 2) (point-min)))
|
;; We need to scan for 's from the BO (logical) line.
|
||||||
(while (and (skip-chars-backward "^\\\\'" p-limit)
|
|
||||||
(> (point) p-limit))
|
|
||||||
(when (eq (char-before) ?\\)
|
|
||||||
(setq p-limit (max (1- p-limit) (point-min))))
|
|
||||||
(backward-char)
|
|
||||||
(setq c-new-BEG (point)))
|
|
||||||
(beginning-of-line)
|
(beginning-of-line)
|
||||||
(while (and
|
(while (eq (char-before (1- (point))) ?\\)
|
||||||
(setq found (search-forward-regexp "\\('\\([^'\\]\\|\\\\.\\)\\)*'"
|
(beginning-of-line 0))
|
||||||
c-new-BEG 'limit))
|
(while (and (< (point) c-new-BEG)
|
||||||
(< (point) (1- c-new-BEG))))
|
(search-forward "'" c-new-BEG t))
|
||||||
(if found
|
(cond
|
||||||
(setq c-new-BEG
|
((c-quoted-number-straddling-point)
|
||||||
(if (and (eq (point) (1- c-new-BEG))
|
(goto-char (match-end 0))
|
||||||
(eq (char-after) ?')) ; "''" before c-new-BEG.
|
(if (> (match-end 0) c-new-BEG)
|
||||||
(1- c-new-BEG)
|
(setq c-new-BEG (match-beginning 0))))
|
||||||
(match-beginning 0))))
|
((c-quoted-number-head-before-point)
|
||||||
|
(if (>= (point) c-new-BEG)
|
||||||
|
(setq c-new-BEG (match-beginning 0))))
|
||||||
|
((looking-at "\\([^'\\]\\|\\\\.\\)'")
|
||||||
|
(goto-char (match-end 0))
|
||||||
|
(if (> (match-end 0) c-new-BEG)
|
||||||
|
(setq c-new-BEG (1- (match-beginning 0)))))
|
||||||
|
((or (>= (point) (1- c-new-BEG))
|
||||||
|
(and (eq (point) (- c-new-BEG 2))
|
||||||
|
(eq (char-after) ?\\)))
|
||||||
|
(setq c-new-BEG (1- (point))))
|
||||||
|
(t nil)))
|
||||||
|
|
||||||
;; Check for a number with quote separators straddling c-new-BEG
|
|
||||||
(when c-has-quoted-numbers
|
|
||||||
(goto-char c-new-BEG)
|
|
||||||
(when ;; (c-quoted-number-straddling-point)
|
|
||||||
(c-quoted-number-head-before-point)
|
|
||||||
(setq c-new-BEG (match-beginning 0))))
|
|
||||||
|
|
||||||
;; Do we have a ' (or something like ',',',',...,',') within range of
|
|
||||||
;; c-new-END?
|
|
||||||
(goto-char c-new-END)
|
(goto-char c-new-END)
|
||||||
(setq p-limit (min (+ (point) 2) (point-max)))
|
;; We will scan from the BO (logical) line.
|
||||||
(while (and (skip-chars-forward "^\\\\'" p-limit)
|
(beginning-of-line)
|
||||||
(< (point) p-limit))
|
(while (eq (char-before (1- (point))) ?\\)
|
||||||
(when (eq (char-after) ?\\)
|
(beginning-of-line 0))
|
||||||
(setq p-limit (min (1+ p-limit) (point-max))))
|
(while (and (< (point) c-new-END)
|
||||||
(forward-char)
|
(search-forward "'" c-new-END t))
|
||||||
(setq c-new-END (point)))
|
(cond
|
||||||
(if (looking-at "[^']?\\('\\([^'\\]\\|\\\\.\\)\\)*'")
|
((c-quoted-number-straddling-point)
|
||||||
(setq c-new-END (match-end 0)))
|
(goto-char (match-end 0))
|
||||||
|
(if (> (match-end 0) c-new-END)
|
||||||
|
(setq c-new-END (match-end 0))))
|
||||||
|
((c-quoted-number-tail-after-point)
|
||||||
|
(goto-char (match-end 0))
|
||||||
|
(if (> (match-end 0) c-new-END)
|
||||||
|
(setq c-new-END (match-end 0))))
|
||||||
|
((looking-at "\\([^'\\]\\|\\\\.\\)'")
|
||||||
|
(goto-char (match-end 0))
|
||||||
|
(if (> (match-end 0) c-new-END)
|
||||||
|
(setq c-new-END (match-end 0))))
|
||||||
|
(t nil)))
|
||||||
|
;; Having reached c-new-END, handle any 's after it whose context may be
|
||||||
|
;; changed by the current buffer change.
|
||||||
|
(goto-char c-new-END)
|
||||||
|
(cond
|
||||||
|
((c-quoted-number-tail-after-point)
|
||||||
|
(setq c-new-END (match-end 0)))
|
||||||
|
((looking-at
|
||||||
|
"\\(\\\\.\\|.\\)?\\('\\([^'\\]\\|\\\\.\\)\\)*'")
|
||||||
|
(setq c-new-END (match-end 0))))
|
||||||
|
|
||||||
;; Check for a number with quote separators straddling c-new-END.
|
;; Remove the '(1) syntax-table property from any "'"s within (c-new-BEG
|
||||||
(when c-has-quoted-numbers
|
|
||||||
(goto-char c-new-END)
|
|
||||||
(when ;; (c-quoted-number-straddling-point)
|
|
||||||
(c-quoted-number-tail-after-point)
|
|
||||||
(setq c-new-END (match-end 0))))
|
|
||||||
|
|
||||||
;; Remove the '(1) syntax-table property from all "'"s within (c-new-BEG
|
|
||||||
;; c-new-END).
|
;; c-new-END).
|
||||||
(c-clear-char-property-with-value-on-char
|
(goto-char c-new-BEG)
|
||||||
c-new-BEG c-new-END
|
(when (c-search-forward-char-property-with-value-on-char
|
||||||
'syntax-table '(1)
|
'syntax-table '(1) ?\' c-new-END)
|
||||||
?')
|
(c-invalidate-state-cache (1- (point)))
|
||||||
;; Remove the c-digit-separator text property from the same "'"s.
|
(c-truncate-semi-nonlit-pos-cache (1- (point)))
|
||||||
(when c-has-quoted-numbers
|
|
||||||
(c-clear-char-property-with-value-on-char
|
(c-clear-char-property-with-value-on-char
|
||||||
c-new-BEG c-new-END
|
(1- (point)) c-new-END
|
||||||
'c-digit-separator t
|
'syntax-table '(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
|
||||||
|
(1- (point)) c-new-END
|
||||||
|
'c-digit-separator t
|
||||||
|
?')))))
|
||||||
|
|
||||||
(defun c-parse-quotes-after-change (_beg _end _old-len)
|
(defun c-parse-quotes-after-change (beg end old-len)
|
||||||
;; This function applies syntax-table properties (value '(1)) and
|
;; This function applies syntax-table properties (value '(1)) and
|
||||||
;; c-digit-separator properties as needed to 's within the range (c-new-BEG
|
;; c-digit-separator properties as needed to 's within the range (c-new-BEG
|
||||||
;; c-new-END). This operation is performed even within strings and
|
;; c-new-END). This operation is performed even within strings and
|
||||||
|
|
@ -1277,25 +1283,34 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
|
||||||
(c-save-buffer-state (num-beg num-end)
|
(c-save-buffer-state (num-beg num-end)
|
||||||
;; Apply the needed syntax-table and c-digit-separator text properties to
|
;; Apply the needed syntax-table and c-digit-separator text properties to
|
||||||
;; quotes.
|
;; quotes.
|
||||||
(goto-char c-new-BEG)
|
(save-restriction
|
||||||
(while (and (< (point) c-new-END)
|
(goto-char c-new-BEG)
|
||||||
(search-forward "'" c-new-END 'limit))
|
(while (and (< (point) c-new-END)
|
||||||
(cond ((and (eq (char-before (1- (point))) ?\\)
|
(search-forward "'" c-new-END 'limit))
|
||||||
;; Check we've got an odd number of \s, here.
|
(cond ((and (eq (char-before (1- (point))) ?\\)
|
||||||
(save-excursion
|
;; Check we've got an odd number of \s, here.
|
||||||
(backward-char)
|
(save-excursion
|
||||||
(eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '.
|
(backward-char)
|
||||||
((c-quoted-number-straddling-point)
|
(eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '.
|
||||||
(setq num-beg (match-beginning 0)
|
((c-quoted-number-straddling-point)
|
||||||
num-end (match-end 0))
|
(setq num-beg (match-beginning 0)
|
||||||
(c-put-char-properties-on-char num-beg num-end
|
num-end (match-end 0))
|
||||||
'syntax-table '(1) ?')
|
(c-invalidate-state-cache num-beg)
|
||||||
(c-put-char-properties-on-char num-beg num-end
|
(c-truncate-semi-nonlit-pos-cache num-beg)
|
||||||
'c-digit-separator t ?')
|
(c-put-char-properties-on-char num-beg num-end
|
||||||
(goto-char num-end))
|
'syntax-table '(1) ?')
|
||||||
((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression.
|
(c-put-char-properties-on-char num-beg num-end
|
||||||
(goto-char (match-end 0)))
|
'c-digit-separator t ?')
|
||||||
(t (c-put-char-property (1- (point)) 'syntax-table '(1)))))))
|
(goto-char num-end))
|
||||||
|
((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression.
|
||||||
|
(goto-char (match-end 0)))
|
||||||
|
(t
|
||||||
|
(c-invalidate-state-cache (1- (point)))
|
||||||
|
(c-truncate-semi-nonlit-pos-cache (1- (point)))
|
||||||
|
(c-put-char-property (1- (point)) 'syntax-table '(1))))
|
||||||
|
;; Prevent the next `c-quoted-number-straddling-point' getting
|
||||||
|
;; confused by already processed single quotes.
|
||||||
|
(narrow-to-region (point) (point-max))))))
|
||||||
|
|
||||||
(defun c-before-change (beg end)
|
(defun c-before-change (beg end)
|
||||||
;; Function to be put on `before-change-functions'. Primarily, this calls
|
;; Function to be put on `before-change-functions'. Primarily, this calls
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue