;; Emacs and earlier XEmacs
`(next-single-property-change ,position ,prop ,object ,limit)))
+(defmacro c-previous-single-property-change (position prop &optional object limit)
+ ;; See the doc string for either of the defuns expanded to.
+ (if (and c-use-extents
+ (fboundp 'previous-single-char-property-change))
+ ;; XEmacs >= 2005-01-25
+ `(previous-single-char-property-change ,position ,prop ,object ,limit)
+ ;; Emacs and earlier XEmacs
+ `(previous-single-property-change ,position ,prop ,object ,limit)))
+
(defmacro c-region-is-active-p ()
;; Return t when the region is active. The determination of region
;; activeness is different in both Emacs and XEmacs.
;; properties set on a single character and that never spread to any
;; other characters.
-(defmacro c-put-syn-tab (pos value)
- ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
- ;; VALUE (which should not be nil).
- `(let ((-pos- ,pos)
- (-value- ,value))
- (c-put-char-property -pos- 'syntax-table -value-)
- (c-put-char-property -pos- 'c-fl-syn-tab -value-)
- (c-truncate-lit-pos-cache -pos-)))
-
(eval-and-compile
;; Constant used at compile time to decide whether or not to use
;; XEmacs extents. Check all the extent functions we'll use since
;; Emacs < 21.
`(c-clear-char-property-fun ,pos ',property))))
-(defmacro c-clear-syn-tab (pos)
- ;; Remove both the 'syntax-table and `c-fl-syn-tab properties at POS.
- `(let ((-pos- ,pos))
- (c-clear-char-property -pos- 'syntax-table)
- (c-clear-char-property -pos- 'c-fl-syn-tab)
- (c-truncate-lit-pos-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.
;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text
;; properties between FROM and TO.
`(let ((-from- ,from) (-to- ,to))
- (c-clear-char-properties -from- -to- 'syntax-table)
- (c-clear-char-properties -from- -to- 'c-fl-syn-tab)))
+ (when (and
+ c-min-syn-tab-mkr c-max-syn-tab-mkr
+ (< -from- c-max-syn-tab-mkr)
+ (> -to- c-min-syn-tab-mkr))
+ (let ((pos -from-))
+ (while (and
+ (< pos -to-)
+ (setq pos (c-min-property-position pos -to- 'c-fl-syn-tab))
+ (< pos -to-))
+ (c-clear-syn-tab pos)
+ (setq pos (1+ pos)))))
+ (c-clear-char-properties -from- -to- 'syntax-table)))
(defmacro c-search-forward-char-property (property value &optional limit)
"Search forward for a text-property PROPERTY having value VALUE.
(c-put-char-property (point) ,property ,value)
(forward-char)))))
-(defmacro c-with-extended-string-fences (beg end &rest body)
- ;; If needed, extend the region with "mirrored" c-fl-syn-tab properties to
- ;; contain the region (BEG END), then evaluate BODY. If this mirrored
- ;; region was initially empty, restore it afterwards.
- `(let ((-beg- ,beg)
- (-end- ,end)
- )
- (cond
- ((null c-fl-syn-tab-region)
- (unwind-protect
- (progn
- (c-restore-string-fences -beg- -end-)
- ,@body)
- (c-clear-string-fences)))
- ((and (>= -beg- (car c-fl-syn-tab-region))
- (<= -end- (cdr c-fl-syn-tab-region)))
- ,@body)
- (t ; Crudely extend the mirrored region.
- (setq -beg- (min -beg- (car c-fl-syn-tab-region))
- -end- (max -end- (cdr c-fl-syn-tab-region)))
- (c-restore-string-fences -beg- -end-)
- ,@body))))
\f
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
;; For our purposes, these are characterized by being possible to
(defvar c-doc-line-join-re)
(defvar c-doc-bright-comment-start-re)
(defvar c-doc-line-join-end-ch)
-(defvar c-fl-syn-tab-region)
+(cc-bytecomp-defvar c-min-syn-tab-mkr)
+(cc-bytecomp-defvar c-max-syn-tab-mkr)
+(cc-bytecomp-defun c-clear-syn-tab)
(cc-bytecomp-defun c-clear-string-fences)
(cc-bytecomp-defun c-restore-string-fences)
(defun c-enclosing-c++-attribute ()
;; If we're in C++ Mode, and point is within a correctly balanced [[ ... ]]
;; attribute structure, return a cons of its starting and ending positions.
- ;; Otherwise, return nil. We use the c-{in,is}-sws-face text properties for
- ;; this determination, this macro being intended only for use in the *-sws-*
- ;; functions and macros. The match data are NOT preserved over this macro.
- (let (attr-end pos-is-sws)
- (and
- (c-major-mode-is 'c++-mode)
- (> (point) (point-min))
- (setq pos-is-sws
- (if (get-text-property (1- (point)) 'c-is-sws)
- (1- (point))
- (1- (previous-single-property-change
- (point) 'c-is-sws nil (point-min)))))
- (save-excursion
- (goto-char pos-is-sws)
- (setq attr-end (c-looking-at-c++-attribute)))
- (> attr-end (point))
- (cons pos-is-sws attr-end))))
-
-(defun c-slow-enclosing-c++-attribute ()
- ;; Like `c-enclosing-c++-attribute', but does not depend on the c-i[ns]-sws
- ;; properties being set.
+ ;; Otherwise, return nil.
(and
(c-major-mode-is 'c++-mode)
(save-excursion
- (let ((paren-state (c-parse-state))
+ (let ((lim (max (- (point) 200) (point-min)))
cand)
(while
- (progn
- (setq cand
- (catch 'found-cand
- (while (cdr paren-state)
- (when (and (numberp (car paren-state))
- (numberp (cadr paren-state))
- (eq (car paren-state)
- (1+ (cadr paren-state)))
- (eq (char-after (car paren-state)) ?\[)
- (eq (char-after (cadr paren-state)) ?\[))
- (throw 'found-cand (cadr paren-state)))
- (setq paren-state (cdr paren-state)))))
- (and cand
- (not
- (and (c-go-list-forward cand)
- (eq (char-before) ?\])
- (eq (char-before (1- (point))) ?\])))))
- (setq paren-state (cdr paren-state)))
- (and cand (cons cand (point)))))))
+ (and
+ (progn
+ (skip-chars-backward "^[;{}" lim)
+ (eq (char-before) ?\[))
+ (not (eq (char-before (1- (point))) ?\[))
+ (> (point) lim))
+ (backward-char))
+ (and (eq (char-before) ?\[)
+ (eq (char-before (1- (point))) ?\[)
+ (progn (backward-char 2) t)
+ (setq cand (point))
+ (c-go-list-forward nil (min (+ (point) 200) (point-max)))
+ (eq (char-before) ?\])
+ (eq (char-before (1- (point))) ?\])
+ (not (c-literal-limits))
+ (cons cand (point)))))))
(defun c-invalidate-sws-region-before (beg end)
;; Called from c-before-change. BEG and END are the bounds of the change
c-block-comment-awkward-chars)))
(and (nth 4 s) (nth 7 s) ; Line comment
(not (memq (char-before here) '(?\\ ?\n)))))))
- (c-with-extended-string-fences
- pos here
- (setq s (parse-partial-sexp pos here nil nil s))))
+ (setq s (parse-partial-sexp pos here nil nil s)))
(when (not (eq near-pos here))
(c-semi-put-near-cache-entry here s))
(cond
;; and `after-change-functions'. Note that this variable is not set when
;; `c-before-change' is invoked by a change to text properties.
+(defvar c-min-syn-tab-mkr nil)
+;; The minimum buffer position where there's a `c-fl-syn-tab' text property,
+;; or nil if there aren't any. This is a marker, or nil if there's currently
+;; no such text property.
+(make-variable-buffer-local 'c-min-syn-tab-mkr)
+
+(defvar c-max-syn-tab-mkr nil)
+;; The maximum buffer position plus 1 where there's a `c-fl-syn-tab' text
+;; property, or nil if there aren't any. This is a marker, or nil if there's
+;; currently no such text property.
+(make-variable-buffer-local 'c-max-syn-tab-mkr)
+
(defun c-basic-common-init (mode default-style)
"Do the necessary initialization for the syntax handling routines
and the line breaking/filling code. Intended to be used by other
;; Initialize the "brace stack" cache.
(c-init-bs-cache)
+ ;; Keep track of where `c-fl-syn-tab' text properties are set.
+ (setq c-min-syn-tab-mkr nil)
+ (setq c-max-syn-tab-mkr nil)
+
(when (or c-recognize-<>-arglists
(c-major-mode-is 'awk-mode)
(c-major-mode-is '(java-mode c-mode c++-mode objc-mode pike-mode)))
(c-put-char-property (1- (point)) 'syntax-table '(15)))
(t nil)))))
-(defvar c-fl-syn-tab-region nil)
- ;; Non-nil when a `c-restore-string-fences' is "in force". It's value is a
- ;; cons of the BEG and END of the region currently "mirroring" the
- ;; c-fl-syn-tab properties as syntax-table properties.
+(defun c-put-syn-tab (pos value)
+ ;; Set both the syntax-table and the c-fl-syn-tab text properties at POS to
+ ;; VALUE (which should not be nil).
+ ;; `(let ((-pos- ,pos)
+ ;; (-value- ,value))
+ (c-put-char-property pos 'syntax-table value)
+ (c-put-char-property pos 'c-fl-syn-tab value)
+ (cond
+ ((null c-min-syn-tab-mkr)
+ (setq c-min-syn-tab-mkr (copy-marker pos t)))
+ ((< pos c-min-syn-tab-mkr)
+ (move-marker c-min-syn-tab-mkr pos)))
+ (cond
+ ((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))
+
+(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-char-property pos 'c-fl-syn-tab)
+ (when c-min-syn-tab-mkr
+ (if (and (eq pos (marker-position c-min-syn-tab-mkr))
+ (eq (1+ pos) (marker-position c-max-syn-tab-mkr)))
+ (progn
+ (move-marker c-min-syn-tab-mkr nil)
+ (move-marker c-max-syn-tab-mkr nil)
+ (setq c-min-syn-tab-mkr nil c-max-syn-tab-mkr nil))
+ (when (eq pos (marker-position c-min-syn-tab-mkr))
+ (move-marker c-min-syn-tab-mkr
+ (if (c-get-char-property (1+ pos) 'c-fl-syn-tab)
+ (1+ pos)
+ (c-next-single-property-change
+ (1+ pos) 'c-fl-syn-tab nil c-max-syn-tab-mkr))))
+ (when (eq (1+ pos) (marker-position c-max-syn-tab-mkr))
+ (move-marker c-max-syn-tab-mkr
+ (if (c-get-char-property (1- pos) 'c-fl-syn-tab)
+ pos
+ (c-previous-single-property-change
+ pos 'c-fl-syn-tab nil (1+ c-min-syn-tab-mkr)))))))
+ (c-truncate-lit-pos-cache pos))
(defun c-clear-string-fences ()
- ;; Clear syntax-table text properties in the region defined by
- ;; `c-cl-syn-tab-region' which are "mirrored" by c-fl-syn-tab text
- ;; properties. However, any such " character which ends up not being
+ ;; 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.
- (when c-fl-syn-tab-region
- (let ((beg (car c-fl-syn-tab-region))
- (end (cdr c-fl-syn-tab-region))
- s pos)
- (setq pos beg)
+ (when
+ (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
+ (let (s pos)
+ (setq pos c-min-syn-tab-mkr)
(while
(and
- (< pos end)
- (setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (< pos end))
+ (< pos c-max-syn-tab-mkr)
+ (setq pos (c-min-property-position pos
+ c-max-syn-tab-mkr
+ 'c-fl-syn-tab))
+ (< pos c-max-syn-tab-mkr))
(c-clear-char-property pos 'syntax-table)
(setq pos (1+ pos)))
;; Check we haven't left any unbalanced "s.
(save-excursion
- (setq pos beg)
+ (setq pos c-min-syn-tab-mkr)
;; Is there already an unbalanced " before BEG?
- (setq pos (c-min-property-position pos end 'c-fl-syn-tab))
- (when (< pos end) (goto-char pos))
+ (setq pos (c-min-property-position pos c-max-syn-tab-mkr
+ 'c-fl-syn-tab))
+ (when (< pos c-max-syn-tab-mkr)
+ (goto-char pos))
(when (and (save-match-data
(c-search-backward-char-property-with-value-on-char
'c-fl-syn-tab '(15) ?\"
(max (- (point) 500) (point-min))))
(not (equal (c-get-char-property (point) 'syntax-table) '(1))))
(setq pos (1+ pos)))
- (while (< pos end)
+ (while (< pos c-max-syn-tab-mkr)
(setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (when (< pos end)
+ (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
+ (when (< pos c-max-syn-tab-mkr)
(if (memq (char-after pos) c-string-delims)
(progn
;; Step over the ".
- (setq s (parse-partial-sexp pos end nil nil nil
+ (setq s (parse-partial-sexp pos c-max-syn-tab-mkr
+ nil nil nil
'syntax-table))
;; Seek a (bogus) matching ".
- (setq s (parse-partial-sexp (point) end nil nil s
+ (setq s (parse-partial-sexp (point) c-max-syn-tab-mkr
+ nil nil s
'syntax-table))
;; When a bogus matching " is found, do nothing.
;; Otherwise mark the " with 'syntax-table '(1).
(c-get-char-property (1- (point)) 'c-fl-syn-tab))
(c-put-char-property pos 'syntax-table '(1)))
(setq pos (point)))
- (setq pos (1+ pos))))))
- (setq c-fl-syn-tab-region nil))))
-
-(defun c-restore-string-fences (beg end)
- ;; Restore any syntax-table text properties in the region (BEG END) which
- ;; are "mirrored" by c-fl-syn-tab text properties.
- (let ((pos beg))
- (while
- (and
- (< pos end)
- (setq pos
- (c-min-property-position pos end 'c-fl-syn-tab))
- (< pos end))
- (c-put-char-property pos 'syntax-table
- (c-get-char-property pos 'c-fl-syn-tab))
- (setq pos (1+ pos)))
- (setq c-fl-syn-tab-region (cons beg end))))
+ (setq pos (1+ pos)))))))))
+
+(defun c-restore-string-fences ()
+ ;; Restore any syntax-table text properties which are "mirrored" by
+ ;; c-fl-syn-tab text properties.
+ (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr)
+ (let ((pos c-min-syn-tab-mkr))
+ (while
+ (and
+ (< pos c-max-syn-tab-mkr)
+ (setq pos
+ (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab))
+ (< pos c-max-syn-tab-mkr))
+ (c-put-char-property pos 'syntax-table
+ (c-get-char-property pos 'c-fl-syn-tab))
+ (setq pos (1+ pos))))))
(defvar c-bc-changed-stringiness nil)
;; Non-nil when, in a before-change function, the deletion of a range of text
(widen)
(unwind-protect
(progn
- (c-restore-string-fences (point-min) (point-max))
+ (c-restore-string-fences)
(save-excursion
;; Are we inserting/deleting stuff in the middle of an
;; identifier?
(widen)
(unwind-protect
(progn
- (c-restore-string-fences (point-min) (point-max))
+ (c-restore-string-fences)
(when (> end (point-max))
;; Some emacsen might return positions past the end. This
;; has been observed in Emacs 20.7 when rereading a buffer
enclosing-attribute pos1)
(unless lit-start
(c-backward-syntactic-ws)
- (when (setq enclosing-attribute (c-slow-enclosing-c++-attribute))
+ (when (setq enclosing-attribute (c-enclosing-c++-attribute))
(goto-char (car enclosing-attribute))) ; Only happens in C++ Mode.
(when (setq pos1 (c-on-identifier))
(goto-char pos1)
(t beg)))
(c-save-buffer-state nil
;; Temporarily reapply the string fence syntax-table properties.
- (c-with-extended-string-fences
- string-fence-beg (if c-in-after-change-fontification
- (max end c-new-END)
- end)
-
- (if (and c-in-after-change-fontification
- (< beg c-new-END) (> end c-new-BEG))
- ;; Region and the latest after-change fontification region overlap.
- ;; Determine the upper and lower bounds of our adjusted region
- ;; separately.
- (progn
- (if (<= beg c-new-BEG)
- (setq c-in-after-change-fontification nil))
- (setq new-beg
- (if (and (>= beg (c-point 'bol c-new-BEG))
- (<= beg c-new-BEG))
- ;; Either jit-lock has accepted `c-new-BEG', or has
- ;; (probably) extended the change region spuriously
- ;; to BOL, which position likely has a
- ;; syntactically different position. To ensure
- ;; correct fontification, we start at `c-new-BEG',
- ;; assuming any characters to the left of
- ;; `c-new-BEG' on the line do not require
- ;; fontification.
- c-new-BEG
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-end (cdr new-region))
- (car new-region)))
- (setq new-end
- (if (and (>= end (c-point 'bol c-new-END))
- (<= end c-new-END))
- c-new-END
- (or new-end
- (cdr (c-before-context-fl-expand-region beg end))))))
- ;; Context (etc.) fontification.
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-beg (car new-region) new-end (cdr new-region)))
- ;; Finally invoke font lock's functionality.
- (funcall (default-value 'font-lock-fontify-region-function)
- new-beg new-end verbose)))))))
+ (unwind-protect
+ (progn
+ (c-restore-string-fences)
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or has
+ ;; (probably) extended the change region spuriously
+ ;; to BOL, which position likely has a
+ ;; syntactically different position. To ensure
+ ;; correct fontification, we start at `c-new-BEG',
+ ;; assuming any characters to the left of
+ ;; `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
+ ;; Finally invoke font lock's functionality.
+ (funcall (default-value 'font-lock-fontify-region-function)
+ new-beg new-end verbose))
+ (c-clear-string-fences)))))))
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
projects / emacs.git / commitdiff