;;; cc-engine.el --- core syntax guessing engine for CC mode ;; Copyright (C) 1985,1987,1992-2003, 2004, 2005, 2006 Free Software Foundation, ;; Inc. ;; Authors: 1998- Martin Stjernholm ;; 1992-1999 Barry A. Warsaw ;; 1987 Dave Detlefs and Stewart Clamen ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) ;; Version: See cc-mode.el ;; Keywords: c languages oop ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; The functions which have docstring documentation can be considered ;; part of an API which other packages can use in CC Mode buffers. ;; Otoh, undocumented functions and functions with the documentation ;; in comments are considered purely internal and can change semantics ;; or even disappear in the future. ;; ;; (This policy applies to CC Mode as a whole, not just this file. It ;; probably also applies to many other Emacs packages, but here it's ;; clearly spelled out.) ;; Hidden buffer changes ;; ;; Various functions in CC Mode use text properties for caching and ;; syntactic markup purposes, and those of them that might modify such ;; properties but still don't modify the buffer in a visible way are ;; said to do "hidden buffer changes". They should be used within ;; `c-save-buffer-state' or a similar function that saves and restores ;; buffer modifiedness, disables buffer change hooks, etc. ;; ;; Interactive functions are assumed to not do hidden buffer changes, ;; except in the specific parts of them that do real changes. ;; ;; Lineup functions are assumed to do hidden buffer changes. They ;; must not do real changes, though. ;; ;; All other functions that do hidden buffer changes have that noted ;; in their doc string or comment. ;; ;; The intention with this system is to avoid wrapping every leaf ;; function that do hidden buffer changes inside ;; `c-save-buffer-state'. It should be used as near the top of the ;; interactive functions as possible. ;; ;; Functions called during font locking are allowed to do hidden ;; buffer changes since the font-lock package run them in a context ;; similar to `c-save-buffer-state' (in fact, that function is heavily ;; inspired by `save-buffer-state' in the font-lock package). ;; Use of text properties ;; ;; CC Mode uses several text properties internally to mark up various ;; positions, e.g. to improve speed and to eliminate glitches in ;; interactive refontification. ;; ;; Note: This doc is for internal use only. Other packages should not ;; assume that these text properties are used as described here. ;; ;; 'syntax-table ;; Used to modify the syntax of some characters. Currently used to ;; mark the "<" and ">" of angle bracket parens with paren syntax. ;; ;; This property is used on single characters and is therefore ;; always treated as front and rear nonsticky (or start and end open ;; in XEmacs vocabulary). It's therefore installed on ;; `text-property-default-nonsticky' if that variable exists (Emacs ;; >= 21). ;; ;; 'c-is-sws and 'c-in-sws ;; Used by `c-forward-syntactic-ws' and `c-backward-syntactic-ws' to ;; speed them up. See the comment blurb before `c-put-is-sws' ;; below for further details. ;; ;; 'c-type ;; This property is used on single characters to mark positions with ;; special syntactic relevance of various sorts. Its primary use is ;; to avoid glitches when multiline constructs are refontified ;; interactively (on font lock decoration level 3). It's cleared in ;; a region before it's fontified and is then put on relevant chars ;; in that region as they are encountered during the fontification. ;; The value specifies the kind of position: ;; ;; 'c-decl-arg-start ;; Put on the last char of the token preceding each declaration ;; inside a declaration style arglist (typically in a function ;; prototype). ;; ;; 'c-decl-end ;; Put on the last char of the token preceding a declaration. ;; This is used in cases where declaration boundaries can't be ;; recognized simply by looking for a token like ";" or "}". ;; `c-type-decl-end-used' must be set if this is used (see also ;; `c-find-decl-spots'). ;; ;; 'c-<>-arg-sep ;; Put on the commas that separate arguments in angle bracket ;; arglists like C++ template arglists. ;; ;; 'c-decl-id-start and 'c-decl-type-start ;; Put on the last char of the token preceding each declarator ;; in the declarator list of a declaration. They are also used ;; between the identifiers cases like enum declarations. ;; 'c-decl-type-start is used when the declarators are types, ;; 'c-decl-id-start otherwise. ;; ;; 'c-awk-NL-prop ;; Used in AWK mode to mark the various kinds of newlines. See ;; cc-awk.el. ;;; Code: (eval-when-compile (let ((load-path (if (and (boundp 'byte-compile-dest-file) (stringp byte-compile-dest-file)) (cons (file-name-directory byte-compile-dest-file) load-path) load-path))) (load "cc-bytecomp" nil t))) (cc-require 'cc-defs) (cc-require-when-compile 'cc-langs) (cc-require 'cc-vars) ;; Silence the compiler. (cc-bytecomp-defun buffer-syntactic-context) ; XEmacs ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. (defmacro c-declare-lang-variables () `(progn ,@(mapcan (lambda (init) `(,(if (elt init 2) `(defvar ,(car init) nil ,(elt init 2)) `(defvar ,(car init) nil)) (make-variable-buffer-local ',(car init)))) (cdr c-lang-variable-inits)))) (c-declare-lang-variables) ;;; Internal state variables. ;; Internal state of hungry delete key feature (defvar c-hungry-delete-key nil) (make-variable-buffer-local 'c-hungry-delete-key) ;; The electric flag (toggled by `c-toggle-electric-state'). ;; If t, electric actions (like automatic reindentation, and (if ;; c-auto-newline is also set) auto newlining) will happen when an electric ;; key like `{' is pressed (or an electric keyword like `else'). (defvar c-electric-flag t) (make-variable-buffer-local 'c-electric-flag) ;; Internal state of auto newline feature. (defvar c-auto-newline nil) (make-variable-buffer-local 'c-auto-newline) ;; Included in the mode line to indicate the active submodes. ;; (defvar c-submode-indicators nil) ;; (make-variable-buffer-local 'c-submode-indicators) (defun c-calculate-state (arg prevstate) ;; Calculate the new state of PREVSTATE, t or nil, based on arg. If ;; arg is nil or zero, toggle the state. If arg is negative, turn ;; the state off, and if arg is positive, turn the state on (if (or (not arg) (zerop (setq arg (prefix-numeric-value arg)))) (not prevstate) (> arg 0))) ;; Dynamically bound cache for `c-in-literal'. (defvar c-in-literal-cache t) ;; Basic handling of preprocessor directives. ;; This is a dynamically bound cache used together with ;; `c-query-macro-start' and `c-query-and-set-macro-start'. It only ;; works as long as point doesn't cross a macro boundary. (defvar c-macro-start 'unknown) (defsubst c-query-and-set-macro-start () (if (symbolp c-macro-start) (setq c-macro-start (save-excursion (c-save-buffer-state () (and (c-beginning-of-macro) (point))))) c-macro-start)) (defsubst c-query-macro-start () (if (symbolp c-macro-start) (save-excursion (c-save-buffer-state () (and (c-beginning-of-macro) (point)))) c-macro-start)) (defun c-beginning-of-macro (&optional lim) "Go to the beginning of a preprocessor directive. Leave point at the beginning of the directive and return t if in one, otherwise return nil and leave point unchanged. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (when c-opt-cpp-prefix (let ((here (point))) (save-restriction (if lim (narrow-to-region lim (point-max))) (beginning-of-line) (while (eq (char-before (1- (point))) ?\\) (forward-line -1)) (back-to-indentation) (if (and (<= (point) here) (looking-at c-opt-cpp-start)) t (goto-char here) nil))))) (defun c-end-of-macro () "Go to the end of a preprocessor directive. More accurately, move the point to the end of the closest following line that doesn't end with a line continuation backslash - no check is done that the point is inside a cpp directive to begin with. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (while (progn (end-of-line) (when (and (eq (char-before) ?\\) (not (eobp))) (forward-char) t)))) (defun c-forward-to-cpp-define-body () ;; Assuming point is at the "#" that introduces a preprocessor ;; directive, it's moved forward to the start of the definition body ;; if it's a "#define" (or whatever c-opt-cpp-macro-define ;; specifies). Non-nil is returned in this case, in all other cases ;; nil is returned and point isn't moved. ;; ;; This function might do hidden buffer changes. (when (and c-opt-cpp-macro-define-start (looking-at c-opt-cpp-macro-define-start) (not (= (match-end 0) (c-point 'eol)))) (goto-char (match-end 0)))) ;;; Basic utility functions. (defun c-syntactic-content (from to paren-level) ;; Return the given region as a string where all syntactic ;; whitespace is removed or, where necessary, replaced with a single ;; space. If PAREN-LEVEL is given then all parens in the region are ;; collapsed to "()", "[]" etc. ;; ;; This function might do hidden buffer changes. (save-excursion (save-restriction (narrow-to-region from to) (goto-char from) (let* ((parts (list nil)) (tail parts) pos in-paren) (while (re-search-forward c-syntactic-ws-start to t) (goto-char (setq pos (match-beginning 0))) (c-forward-syntactic-ws) (if (= (point) pos) (forward-char) (when paren-level (save-excursion (setq in-paren (= (car (parse-partial-sexp from pos 1)) 1) pos (point)))) (if (and (> pos from) (< (point) to) (looking-at "\\w\\|\\s_") (save-excursion (goto-char (1- pos)) (looking-at "\\w\\|\\s_"))) (progn (setcdr tail (list (buffer-substring-no-properties from pos) " ")) (setq tail (cddr tail))) (setcdr tail (list (buffer-substring-no-properties from pos))) (setq tail (cdr tail))) (when in-paren (when (= (car (parse-partial-sexp pos to -1)) -1) (setcdr tail (list (buffer-substring-no-properties (1- (point)) (point)))) (setq tail (cdr tail)))) (setq from (point)))) (setcdr tail (list (buffer-substring-no-properties from to))) (apply 'concat (cdr parts)))))) (defun c-shift-line-indentation (shift-amt) ;; Shift the indentation of the current line with the specified ;; amount (positive inwards). The buffer is modified only if ;; SHIFT-AMT isn't equal to zero. (let ((pos (- (point-max) (point))) (c-macro-start c-macro-start) tmp-char-inserted) (if (zerop shift-amt) nil ;; If we're on an empty line inside a macro, we take the point ;; to be at the current indentation and shift it to the ;; appropriate column. This way we don't treat the extra ;; whitespace out to the line continuation as indentation. (when (and (c-query-and-set-macro-start) (looking-at "[ \t]*\\\\$") (save-excursion (skip-chars-backward " \t") (bolp))) (insert ?x) (backward-char) (setq tmp-char-inserted t)) (unwind-protect (let ((col (current-indentation))) (delete-region (c-point 'bol) (c-point 'boi)) (beginning-of-line) (indent-to (+ col shift-amt))) (when tmp-char-inserted (delete-char 1)))) ;; If initial point was within line's indentation and we're not on ;; a line with a line continuation in a macro, position after the ;; indentation. Else stay at same point in text. (if (and (< (point) (c-point 'boi)) (not tmp-char-inserted)) (back-to-indentation) (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))))) (defsubst c-keyword-sym (keyword) ;; Return non-nil if the string KEYWORD is a known keyword. More ;; precisely, the value is the symbol for the keyword in ;; `c-keywords-obarray'. (intern-soft keyword c-keywords-obarray)) (defsubst c-keyword-member (keyword-sym lang-constant) ;; Return non-nil if the symbol KEYWORD-SYM, as returned by ;; `c-keyword-sym', is a member of LANG-CONSTANT, which is the name ;; of a language constant that ends with "-kwds". If KEYWORD-SYM is ;; nil then the result is nil. (get keyword-sym lang-constant)) ;; String syntax chars, suitable for skip-syntax-(forward|backward). (defconst c-string-syntax (if (memq 'gen-string-delim c-emacs-features) "\"|" "\"")) ;; Regexp matching string limit syntax. (defconst c-string-limit-regexp (if (memq 'gen-string-delim c-emacs-features) "\\s\"\\|\\s|" "\\s\"")) ;; Regexp matching WS followed by string limit syntax. (defconst c-ws*-string-limit-regexp (concat "[ \t]*\\(" c-string-limit-regexp "\\)")) ;; Holds formatted error strings for the few cases where parse errors ;; are reported. (defvar c-parsing-error nil) (make-variable-buffer-local 'c-parsing-error) (defun c-echo-parsing-error (&optional quiet) (when (and c-report-syntactic-errors c-parsing-error (not quiet)) (c-benign-error "%s" c-parsing-error)) c-parsing-error) ;; Faces given to comments and string literals. This is used in some ;; situations to speed up recognition; it isn't mandatory that font ;; locking is in use. This variable is extended with the face in ;; `c-doc-face-name' when fontification is activated in cc-fonts.el. (defvar c-literal-faces (append '(font-lock-comment-face font-lock-string-face) (when (facep 'font-lock-comment-delimiter-face) ;; New in Emacs 22. '(font-lock-comment-delimiter-face)))) (defsubst c-put-c-type-property (pos value) ;; Put a c-type property with the given value at POS. (c-put-char-property pos 'c-type value)) (defun c-clear-c-type-property (from to value) ;; Remove all occurences of the c-type property that has the given ;; value in the region between FROM and TO. VALUE is assumed to not ;; be nil. ;; ;; Note: This assumes that c-type is put on single chars only; it's ;; very inefficient if matching properties cover large regions. (save-excursion (goto-char from) (while (progn (when (eq (get-text-property (point) 'c-type) value) (c-clear-char-property (point) 'c-type)) (goto-char (next-single-property-change (point) 'c-type nil to)) (< (point) to))))) ;; Some debug tools to visualize various special positions. This ;; debug code isn't as portable as the rest of CC Mode. (cc-bytecomp-defun overlays-in) (cc-bytecomp-defun overlay-get) (cc-bytecomp-defun overlay-start) (cc-bytecomp-defun overlay-end) (cc-bytecomp-defun delete-overlay) (cc-bytecomp-defun overlay-put) (cc-bytecomp-defun make-overlay) (defun c-debug-add-face (beg end face) (c-save-buffer-state ((overlays (overlays-in beg end)) overlay) (while overlays (setq overlay (car overlays) overlays (cdr overlays)) (when (eq (overlay-get overlay 'face) face) (setq beg (min beg (overlay-start overlay)) end (max end (overlay-end overlay))) (delete-overlay overlay))) (overlay-put (make-overlay beg end) 'face face))) (defun c-debug-remove-face (beg end face) (c-save-buffer-state ((overlays (overlays-in beg end)) overlay (ol-beg beg) (ol-end end)) (while overlays (setq overlay (car overlays) overlays (cdr overlays)) (when (eq (overlay-get overlay 'face) face) (setq ol-beg (min ol-beg (overlay-start overlay)) ol-end (max ol-end (overlay-end overlay))) (delete-overlay overlay))) (when (< ol-beg beg) (overlay-put (make-overlay ol-beg beg) 'face face)) (when (> ol-end end) (overlay-put (make-overlay end ol-end) 'face face)))) ;; `c-beginning-of-statement-1' and accompanying stuff. ;; KLUDGE ALERT: c-maybe-labelp is used to pass information between ;; c-crosses-statement-barrier-p and c-beginning-of-statement-1. A ;; better way should be implemented, but this will at least shut up ;; the byte compiler. (defvar c-maybe-labelp) ;; New awk-compatible version of c-beginning-of-statement-1, ACM 2002/6/22 ;; Macros used internally in c-beginning-of-statement-1 for the ;; automaton actions. (defmacro c-bos-push-state () '(setq stack (cons (cons state saved-pos) stack))) (defmacro c-bos-pop-state (&optional do-if-done) `(if (setq state (car (car stack)) saved-pos (cdr (car stack)) stack (cdr stack)) t ,do-if-done (throw 'loop nil))) (defmacro c-bos-pop-state-and-retry () '(throw 'loop (setq state (car (car stack)) saved-pos (cdr (car stack)) ;; Throw nil if stack is empty, else throw non-nil. stack (cdr stack)))) (defmacro c-bos-save-pos () '(setq saved-pos (vector pos tok ptok pptok))) (defmacro c-bos-restore-pos () '(unless (eq (elt saved-pos 0) start) (setq pos (elt saved-pos 0) tok (elt saved-pos 1) ptok (elt saved-pos 2) pptok (elt saved-pos 3)) (goto-char pos) (setq sym nil))) (defmacro c-bos-save-error-info (missing got) `(setq saved-pos (vector pos ,missing ,got))) (defmacro c-bos-report-error () '(unless noerror (setq c-parsing-error (format "No matching `%s' found for `%s' on line %d" (elt saved-pos 1) (elt saved-pos 2) (1+ (count-lines (point-min) (c-point 'bol (elt saved-pos 0)))))))) (defun c-beginning-of-statement-1 (&optional lim ignore-labels noerror comma-delim) "Move to the start of the current statement or declaration, or to the previous one if already at the beginning of one. Only statements/declarations on the same level are considered, i.e. don't move into or out of sexps (not even normal expression parentheses). Stop at statement continuation tokens like \"else\", \"catch\", \"finally\" and the \"while\" in \"do ... while\" if the start point is within the continuation. If starting at such a token, move to the corresponding statement start. If at the beginning of a statement, move to the closest containing statement if there is any. This might also stop at a continuation clause. Labels are treated as part of the following statements if IGNORE-LABELS is non-nil. (FIXME: Doesn't work if we stop at a known statement start keyword.) Otherwise, each label is treated as a separate statement. Macros are ignored \(i.e. skipped over) unless point is within one, in which case the content of the macro is treated as normal code. Aside from any normal statement starts found in it, stop at the first token of the content in the macro, i.e. the expression of an \"#if\" or the start of the definition in a \"#define\". Also stop at start of macros before leaving them. Return 'label if stopped at a label, 'same if stopped at the beginning of the current statement, 'up if stepped to a containing statement, 'previous if stepped to a preceding statement, 'beginning if stepped from a statement continuation clause to its start clause, or 'macro if stepped to a macro start. Note that 'same and not 'label is returned if stopped at the same label without crossing the colon character. LIM may be given to limit the search. If the search hits the limit, point will be left at the closest following token, or at the start position if that is less ('same is returned in this case). NOERROR turns off error logging to `c-parsing-error'. Normally only ';' and virtual semicolons are considered to delimit statements, but if COMMA-DELIM is non-nil then ',' is treated as a delimiter too. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." ;; The bulk of this function is a pushdown automaton that looks at statement ;; boundaries and the tokens (such as "while") in c-opt-block-stmt-key. Its ;; purpose is to keep track of nested statements, ensuring that such ;; statments are skipped over in their entirety (somewhat akin to what C-M-p ;; does with nested braces/brackets/parentheses). ;; ;; Note: The position of a boundary is the following token. ;; ;; Beginning with the current token (the one following point), move back one ;; sexp at a time (where a sexp is, more or less, either a token or the ;; entire contents of a brace/bracket/paren pair). Each time a statement ;; boundary is crossed or a "while"-like token is found, update the state of ;; the PDA. Stop at the beginning of a statement when the stack (holding ;; nested statement info) is empty and the position has been moved. ;; ;; The following variables constitute the PDA: ;; ;; sym: This is either the "while"-like token (e.g. 'for) we've just ;; scanned back over, 'boundary if we've just gone back over a ;; statement boundary, or nil otherwise. ;; state: takes one of the values (nil else else-boundary while ;; while-boundary catch catch-boundary). ;; nil means "no "while"-like token yet scanned". ;; 'else, for example, means "just gone back over an else". ;; 'else-boundary means "just gone back over a statement boundary ;; immediately after having gone back over an else". ;; saved-pos: A vector of either saved positions (tok ptok pptok, etc.) or ;; of error reporting information. ;; stack: The stack onto which the PDA pushes its state. Each entry ;; consists of a saved value of state and saved-pos. An entry is ;; pushed when we move back over a "continuation" token (e.g. else) ;; and popped when we encounter the corresponding opening token ;; (e.g. if). ;; ;; ;; The following diagram briefly outlines the PDA. ;; ;; Common state: ;; "else": Push state, goto state `else'. ;; "while": Push state, goto state `while'. ;; "catch" or "finally": Push state, goto state `catch'. ;; boundary: Pop state. ;; other: Do nothing special. ;; ;; State `else': ;; boundary: Goto state `else-boundary'. ;; other: Error, pop state, retry token. ;; ;; State `else-boundary': ;; "if": Pop state. ;; boundary: Error, pop state. ;; other: See common state. ;; ;; State `while': ;; boundary: Save position, goto state `while-boundary'. ;; other: Pop state, retry token. ;; ;; State `while-boundary': ;; "do": Pop state. ;; boundary: Restore position if it's not at start, pop state. [*see below] ;; other: See common state. ;; ;; State `catch': ;; boundary: Goto state `catch-boundary'. ;; other: Error, pop state, retry token. ;; ;; State `catch-boundary': ;; "try": Pop state. ;; "catch": Goto state `catch'. ;; boundary: Error, pop state. ;; other: See common state. ;; ;; [*] In the `while-boundary' state, we had pushed a 'while state, and were ;; searching for a "do" which would have opened a do-while. If we didn't ;; find it, we discard the analysis done since the "while", go back to this ;; token in the buffer and restart the scanning there, this time WITHOUT ;; pushing the 'while state onto the stack. ;; ;; In addition to the above there is some special handling of labels ;; and macros. (let ((case-fold-search nil) (start (point)) macro-start (delims (if comma-delim '(?\; ?,) '(?\;))) (c-stmt-delim-chars (if comma-delim c-stmt-delim-chars-with-comma c-stmt-delim-chars)) c-in-literal-cache c-maybe-labelp saved ;; Current position. pos ;; Position of last stmt boundary character (e.g. ;). boundary-pos ;; The position of the last sexp or bound that follows the ;; first found colon, i.e. the start of the nonlabel part of ;; the statement. It's `start' if a colon is found just after ;; the start. after-labels-pos ;; Like `after-labels-pos', but the first such position inside ;; a label, i.e. the start of the last label before the start ;; of the nonlabel part of the statement. last-label-pos ;; The last position where a label is possible provided the ;; statement started there. It's nil as long as no invalid ;; label content has been found (according to ;; `c-nonlabel-token-key'. It's `start' if no valid label ;; content was found in the label. Note that we might still ;; regard it a label if it starts with `c-label-kwds'. label-good-pos ;; Symbol just scanned back over (e.g. 'while or 'boundary). ;; See above. sym ;; Current state in the automaton. See above. state ;; Current saved positions. See above. saved-pos ;; Stack of conses (state . saved-pos). stack ;; Regexp which matches "for", "if", etc. (cond-key (or c-opt-block-stmt-key "\\<\\>")) ; Matches nothing. ;; Return value. (ret 'same) ;; Positions of the last three sexps or bounds we've stopped at. tok ptok pptok) (save-restriction (if lim (narrow-to-region lim (point-max))) (if (save-excursion (and (c-beginning-of-macro) (/= (point) start))) (setq macro-start (point))) ;; Try to skip back over unary operator characters, to register ;; that we've moved. (while (progn (setq pos (point)) (c-backward-syntactic-ws) ;; Protect post-++/-- operators just before a virtual semicolon. (and (not (c-at-vsemi-p)) (/= (skip-chars-backward "-+!*&~@`#") 0)))) ;; Skip back over any semicolon here. If it was a bare semicolon, we're ;; done. Later on we ignore the boundaries for statements that don't ;; contain any sexp. The only thing that is affected is that the error ;; checking is a little less strict, and we really don't bother. (if (and (memq (char-before) delims) (progn (forward-char -1) (setq saved (point)) (c-backward-syntactic-ws) (or (memq (char-before) delims) (memq (char-before) '(?: nil)) (eq (char-syntax (char-before)) ?\() (c-at-vsemi-p)))) (setq ret 'previous pos saved) ;; Begin at start and not pos to detect macros if we stand ;; directly after the #. (goto-char start) (if (looking-at "\\<\\|\\W") ;; Record this as the first token if not starting inside it. (setq tok start)) ;; The following while loop goes back one sexp (balanced parens, ;; etc. with contents, or symbol or suchlike) each iteration. This ;; movement is accomplished with a call to scan-sexps approx 130 lines ;; below. (while (catch 'loop ;; Throw nil to break, non-nil to continue. (cond ((save-excursion (and macro-start ; Always NIL for AWK. (progn (skip-chars-backward " \t") (eq (char-before) ?#)) (progn (setq saved (1- (point))) (beginning-of-line) (not (eq (char-before (1- (point))) ?\\))) (looking-at c-opt-cpp-start) (progn (skip-chars-forward " \t") (eq (point) saved)))) (goto-char saved) (if (and (c-forward-to-cpp-define-body) (progn (c-forward-syntactic-ws start) (< (point) start))) ;; Stop at the first token in the content of the macro. (setq pos (point) ignore-labels t) ; Avoid the label check on exit. (setq pos saved ret 'macro ignore-labels t)) (throw 'loop nil)) ;; Do a round through the automaton if we've just passed a ;; statement boundary or passed a "while"-like token. ((or sym (and (looking-at cond-key) (setq sym (intern (match-string 1))))) (when (and (< pos start) (null stack)) (throw 'loop nil)) ;; The PDA state handling. ;; ;; Refer to the description of the PDA in the opening ;; comments. In the following OR form, the first leaf ;; attempts to handles one of the specific actions detailed ;; (e.g., finding token "if" whilst in state `else-boundary'). ;; We drop through to the second leaf (which handles common ;; state) if no specific handler is found in the first cond. ;; If a parsing error is detected (e.g. an "else" with no ;; preceding "if"), we throw to the enclosing catch. ;; ;; Note that the (eq state 'else) means ;; "we've just passed an else", NOT "we're looking for an ;; else". (or (cond ((eq state 'else) (if (eq sym 'boundary) (setq state 'else-boundary) (c-bos-report-error) (c-bos-pop-state-and-retry))) ((eq state 'else-boundary) (cond ((eq sym 'if) (c-bos-pop-state (setq ret 'beginning))) ((eq sym 'boundary) (c-bos-report-error) (c-bos-pop-state)))) ((eq state 'while) (if (and (eq sym 'boundary) ;; Since this can cause backtracking we do a ;; little more careful analysis to avoid it: ;; If there's a label in front of the while ;; it can't be part of a do-while. (not after-labels-pos)) (progn (c-bos-save-pos) (setq state 'while-boundary)) (c-bos-pop-state-and-retry))) ; Can't be a do-while ((eq state 'while-boundary) (cond ((eq sym 'do) (c-bos-pop-state (setq ret 'beginning))) ((eq sym 'boundary) ; isn't a do-while (c-bos-restore-pos) ; the position of the while (c-bos-pop-state)))) ; no longer searching for do. ((eq state 'catch) (if (eq sym 'boundary) (setq state 'catch-boundary) (c-bos-report-error) (c-bos-pop-state-and-retry))) ((eq state 'catch-boundary) (cond ((eq sym 'try) (c-bos-pop-state (setq ret 'beginning))) ((eq sym 'catch) (setq state 'catch)) ((eq sym 'boundary) (c-bos-report-error) (c-bos-pop-state))))) ;; This is state common. We get here when the previous ;; cond statement found no particular state handler. (cond ((eq sym 'boundary) ;; If we have a boundary at the start ;; position we push a frame to go to the ;; previous statement. (if (>= pos start) (c-bos-push-state) (c-bos-pop-state))) ((eq sym 'else) (c-bos-push-state) (c-bos-save-error-info 'if 'else) (setq state 'else)) ((eq sym 'while) ;; Is this a real while, or a do-while? ;; The next `when' triggers unless we are SURE that ;; the `while' is not the tailend of a `do-while'. (when (or (not pptok) (memq (char-after pptok) delims) ;; The following kludge is to prevent ;; infinite recursion when called from ;; c-awk-after-if-for-while-condition-p, ;; or the like. (and (eq (point) start) (c-vsemi-status-unknown-p)) (c-at-vsemi-p pptok)) ;; Since this can cause backtracking we do a ;; little more careful analysis to avoid it: If ;; the while isn't followed by a (possibly ;; virtual) semicolon it can't be a do-while. (c-bos-push-state) (setq state 'while))) ((memq sym '(catch finally)) (c-bos-push-state) (c-bos-save-error-info 'try sym) (setq state 'catch)))) (when c-maybe-labelp ;; We're either past a statement boundary or at the ;; start of a statement, so throw away any label data ;; for the previous one. (setq after-labels-pos nil last-label-pos nil c-maybe-labelp nil)))) ;; Step to the previous sexp, but not if we crossed a ;; boundary, since that doesn't consume an sexp. (if (eq sym 'boundary) (setq ret 'previous) ;; HERE IS THE SINGLE PLACE INSIDE THE PDA LOOP WHERE WE MOVE ;; BACKWARDS THROUGH THE SOURCE. ;; This is typically fast with the caching done by ;; c-(backward|forward)-sws. (c-backward-syntactic-ws) (let ((before-sws-pos (point)) ;; Set as long as we have to continue jumping by sexps. ;; It's the position to use as end in the next round. sexp-loop-continue-pos ;; The end position of the area to search for statement ;; barriers in this round. (sexp-loop-end-pos pos)) ;; The following while goes back one sexp per iteration. (while (progn (unless (c-safe (c-backward-sexp) t) ;; Give up if we hit an unbalanced block. Since the ;; stack won't be empty the code below will report a ;; suitable error. (throw 'loop nil)) ;; Check if the sexp movement crossed a statement or ;; declaration boundary. But first modify the point ;; so that `c-crosses-statement-barrier-p' only looks ;; at the non-sexp chars following the sexp. (save-excursion (when (setq boundary-pos (cond ((if macro-start nil (save-excursion (when (c-beginning-of-macro) ;; Set continuation position in case ;; `c-crosses-statement-barrier-p' ;; doesn't detect anything below. (setq sexp-loop-continue-pos (point))))) ;; If the sexp movement took us into a ;; macro then there were only some non-sexp ;; chars after it. Skip out of the macro ;; to analyze them but not the non-sexp ;; chars that might be inside the macro. (c-end-of-macro) (c-crosses-statement-barrier-p (point) sexp-loop-end-pos)) ((and (eq (char-after) ?{) (not (c-looking-at-inexpr-block lim nil t))) ;; Passed a block sexp. That's a boundary ;; alright. (point)) ((looking-at "\\s\(") ;; Passed some other paren. Only analyze ;; the non-sexp chars after it. (goto-char (1+ (c-down-list-backward before-sws-pos))) ;; We're at a valid token start position ;; (outside the `save-excursion') if ;; `c-crosses-statement-barrier-p' failed. (c-crosses-statement-barrier-p (point) sexp-loop-end-pos)) (t ;; Passed a symbol sexp or line ;; continuation. It doesn't matter that ;; it's included in the analyzed region. (if (c-crosses-statement-barrier-p (point) sexp-loop-end-pos) t ;; If it was a line continuation then we ;; have to continue looping. (if (looking-at "\\\\$") (setq sexp-loop-continue-pos (point))) nil)))) (setq pptok ptok ptok tok tok boundary-pos sym 'boundary) ;; Like a C "continue". Analyze the next sexp. (throw 'loop t))) sexp-loop-continue-pos) ; End of "go back a sexp" loop. (goto-char sexp-loop-continue-pos) (setq sexp-loop-end-pos sexp-loop-continue-pos sexp-loop-continue-pos nil)))) ;; ObjC method def? (when (and c-opt-method-key (setq saved (c-in-method-def-p))) (setq pos saved ignore-labels t) ; Avoid the label check on exit. (throw 'loop nil)) ;; Handle labels. (unless (eq ignore-labels t) (when (numberp c-maybe-labelp) ;; `c-crosses-statement-barrier-p' has found a colon, so we ;; might be in a label now. Have we got a real label ;; (including a case label) or something like C++'s "public:"? (if (or (not (looking-at c-nonlabel-token-key)) ; proper label (save-excursion ; e.g. "case 'a':" ? (and (c-safe (c-backward-sexp) t) (looking-at "\\")))) ; FIXME!!! this is ; wrong for AWK. 2006/1/14. (progn (if after-labels-pos ; Have we already encountered a label? (if (not last-label-pos) (setq last-label-pos (or tok start))) (setq after-labels-pos (or tok start))) (setq c-maybe-labelp t label-good-pos nil)) (setq c-maybe-labelp nil))) ; bogus "label" (when (and (not label-good-pos) ; i.e. no invalid "label"'s yet ; been found. (looking-at c-nonlabel-token-key)) ; e.g. "while :" ;; We're in a potential label and it's the first ;; time we've found something that isn't allowed in ;; one. (setq label-good-pos (or tok start)))) ;; We've moved back by a sexp, so update the token positions. (setq sym nil pptok ptok ptok tok tok (point) pos tok))) ; Not nil (for the while loop). ;; If the stack isn't empty there might be errors to report. (while stack (if (and (vectorp saved-pos) (eq (length saved-pos) 3)) (c-bos-report-error)) (setq saved-pos (cdr (car stack)) stack (cdr stack))) (when (and (eq ret 'same) (not (memq sym '(boundary ignore nil)))) ;; Need to investigate closer whether we've crossed ;; between a substatement and its containing statement. (if (setq saved (if (looking-at c-block-stmt-1-key) ptok pptok)) (cond ((> start saved) (setq pos saved)) ((= start saved) (setq ret 'up))))) (when (and (not ignore-labels) (eq c-maybe-labelp t) (not (eq ret 'beginning)) after-labels-pos (or (not label-good-pos) (<= label-good-pos pos) (progn (goto-char (if (and last-label-pos (< last-label-pos start)) last-label-pos pos)) (looking-at c-label-kwds-regexp)))) ;; We're in a label. Maybe we should step to the statement ;; after it. (if (< after-labels-pos start) (setq pos after-labels-pos) (setq ret 'label) (if (and last-label-pos (< last-label-pos start)) ;; Might have jumped over several labels. Go to the last one. (setq pos last-label-pos))))) ;; Skip over the unary operators that can start the statement. (goto-char pos) (while (progn (c-backward-syntactic-ws) ;; protect AWK post-inc/decrement operators, etc. (and (not (c-at-vsemi-p (point))) (/= (skip-chars-backward "-+!*&~@`#") 0))) (setq pos (point))) (goto-char pos) ret))) (defun c-crosses-statement-barrier-p (from to) "Return non-nil if buffer positions FROM to TO cross one or more statement or declaration boundaries. The returned value is actually the position of the earliest boundary char. FROM must not be within a string or comment. The variable `c-maybe-labelp' is set to the position of the first `:' that might start a label (i.e. not part of `::' and not preceded by `?'). If a single `?' is found, then `c-maybe-labelp' is cleared. For AWK, a statement which is terminated by an EOL (not a \; or a }) is regarded as having a \"virtual semicolon\" immediately after the last token on the line. If this virtual semicolon is _at_ from, the function recognises it. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (let ((skip-chars c-stmt-delim-chars) lit-range) (save-excursion (catch 'done (goto-char from) (while (progn (skip-chars-forward skip-chars to) (< (point) to)) (cond ((setq lit-range (c-literal-limits from)) ; Have we landed in a string/comment? (goto-char (cdr lit-range))) ((eq (char-after) ?:) (forward-char) (if (and (eq (char-after) ?:) (< (point) to)) ;; Ignore scope operators. (forward-char) (setq c-maybe-labelp (1- (point))))) ((eq (char-after) ??) ;; A question mark. Can't be a label, so stop ;; looking for more : and ?. (setq c-maybe-labelp nil skip-chars (substring c-stmt-delim-chars 0 -2))) ((memq (char-after) '(?# ?\n ?\r)) ; A virtual semicolon? (if (and (eq (char-before) ?\\) (memq (char-after) '(?\n ?\r))) (backward-char)) (skip-chars-backward " \t" from) (if (c-at-vsemi-p) (throw 'done (point)) (forward-line))) (t (throw 'done (point))))) ;; In trailing space after an as yet undetected virtual semicolon? (c-backward-syntactic-ws from) (if (and (< (point) to) (c-at-vsemi-p)) (point) nil))))) (defun c-at-statement-start-p () "Return non-nil if the point is at the first token in a statement or somewhere in the syntactic whitespace before it. A \"statement\" here is not restricted to those inside code blocks. Any kind of declaration-like construct that occur outside function bodies is also considered a \"statement\". Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-excursion (let ((end (point)) c-maybe-labelp) (c-syntactic-skip-backward (substring c-stmt-delim-chars 1) nil t) (or (bobp) (eq (char-before) ?}) (and (eq (char-before) ?{) (not (and c-special-brace-lists (progn (backward-char) (c-looking-at-special-brace-list))))) (c-crosses-statement-barrier-p (point) end))))) (defun c-at-expression-start-p () "Return non-nil if the point is at the first token in an expression or statement, or somewhere in the syntactic whitespace before it. An \"expression\" here is a bit different from the normal language grammar sense: It's any sequence of expression tokens except commas, unless they are enclosed inside parentheses of some kind. Also, an expression never continues past an enclosing parenthesis, but it might contain parenthesis pairs of any sort except braces. Since expressions never cross statement boundaries, this function also recognizes statement beginnings, just like `c-at-statement-start-p'. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-excursion (let ((end (point)) (c-stmt-delim-chars c-stmt-delim-chars-with-comma) c-maybe-labelp) (c-syntactic-skip-backward (substring c-stmt-delim-chars 1) nil t) (or (bobp) (memq (char-before) '(?{ ?})) (save-excursion (backward-char) (looking-at "\\s(")) (c-crosses-statement-barrier-p (point) end))))) ;; A set of functions that covers various idiosyncrasies in ;; implementations of `forward-comment'. ;; Note: Some emacsen considers incorrectly that any line comment ;; ending with a backslash continues to the next line. I can't think ;; of any way to work around that in a reliable way without changing ;; the buffer, though. Suggestions welcome. ;) (No, temporarily ;; changing the syntax for backslash doesn't work since we must treat ;; escapes in string literals correctly.) (defun c-forward-single-comment () "Move forward past whitespace and the closest following comment, if any. Return t if a comment was found, nil otherwise. In either case, the point is moved past the following whitespace. Line continuations, i.e. a backslashes followed by line breaks, are treated as whitespace. The line breaks that end line comments are considered to be the comment enders, so the point will be put on the beginning of the next line if it moved past a line comment. This function does not do any hidden buffer changes." (let ((start (point))) (when (looking-at "\\([ \t\n\r\f\v]\\|\\\\[\n\r]\\)+") (goto-char (match-end 0))) (when (forward-comment 1) (if (eobp) ;; Some emacsen (e.g. XEmacs 21) return t when moving ;; forwards at eob. nil ;; Emacs includes the ending newline in a b-style (c++) ;; comment, but XEmacs doesn't. We depend on the Emacs ;; behavior (which also is symmetric). (if (and (eolp) (elt (parse-partial-sexp start (point)) 7)) (condition-case nil (forward-char 1))) t)))) (defsubst c-forward-comments () "Move forward past all following whitespace and comments. Line continuations, i.e. a backslashes followed by line breaks, are treated as whitespace. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (while (or ;; If forward-comment in at least XEmacs 21 is given a large ;; positive value, it'll loop all the way through if it hits ;; eob. (and (forward-comment 5) ;; Some emacsen (e.g. XEmacs 21) return t when moving ;; forwards at eob. (not (eobp))) (when (looking-at "\\\\[\n\r]") (forward-char 2) t)))) (defun c-backward-single-comment () "Move backward past whitespace and the closest preceding comment, if any. Return t if a comment was found, nil otherwise. In either case, the point is moved past the preceding whitespace. Line continuations, i.e. a backslashes followed by line breaks, are treated as whitespace. The line breaks that end line comments are considered to be the comment enders, so the point cannot be at the end of the same line to move over a line comment. This function does not do any hidden buffer changes." (let ((start (point))) ;; When we got newline terminated comments, forward-comment in all ;; supported emacsen so far will stop at eol of each line not ;; ending with a comment when moving backwards. This corrects for ;; that, and at the same time handles line continuations. (while (progn (skip-chars-backward " \t\n\r\f\v") (and (looking-at "[\n\r]") (eq (char-before) ?\\))) (backward-char)) (if (bobp) ;; Some emacsen (e.g. Emacs 19.34) return t when moving ;; backwards at bob. nil ;; Leave point after the closest following newline if we've ;; backed up over any above, since forward-comment won't move ;; backward over a line comment if point is at the end of the ;; same line. (re-search-forward "\\=\\s *[\n\r]" start t) (if (if (forward-comment -1) (if (eolp) ;; If forward-comment above succeeded and we're at eol ;; then the newline we moved over above didn't end a ;; line comment, so we give it another go. (forward-comment -1) t)) ;; Emacs <= 20 and XEmacs move back over the closer of a ;; block comment that lacks an opener. (if (looking-at "\\*/") (progn (forward-char 2) nil) t))))) (defsubst c-backward-comments () "Move backward past all preceding whitespace and comments. Line continuations, i.e. a backslashes followed by line breaks, are treated as whitespace. The line breaks that end line comments are considered to be the comment enders, so the point cannot be at the end of the same line to move over a line comment. Unlike c-backward-syntactic-ws, this function doesn't move back over preprocessor directives. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (let ((start (point))) (while (and ;; `forward-comment' in some emacsen (e.g. XEmacs 21.4) ;; return t when moving backwards at bob. (not (bobp)) (if (forward-comment -1) (if (looking-at "\\*/") ;; Emacs <= 20 and XEmacs move back over the ;; closer of a block comment that lacks an opener. (progn (forward-char 2) nil) t) ;; XEmacs treats line continuations as whitespace but ;; only in the backward direction, which seems a bit ;; odd. Anyway, this is necessary for Emacs. (when (and (looking-at "[\n\r]") (eq (char-before) ?\\) (< (point) start)) (backward-char) t)))))) ;; Tools for skipping over syntactic whitespace. ;; The following functions use text properties to cache searches over ;; large regions of syntactic whitespace. It works as follows: ;; ;; o If a syntactic whitespace region contains anything but simple ;; whitespace (i.e. space, tab and line breaks), the text property ;; `c-in-sws' is put over it. At places where we have stopped ;; within that region there's also a `c-is-sws' text property. ;; That since there typically are nested whitespace inside that ;; must be handled separately, e.g. whitespace inside a comment or ;; cpp directive. Thus, from one point with `c-is-sws' it's safe ;; to jump to another point with that property within the same ;; `c-in-sws' region. It can be likened to a ladder where ;; `c-in-sws' marks the bars and `c-is-sws' the rungs. ;; ;; o The `c-is-sws' property is put on the simple whitespace chars at ;; a "rung position" and also maybe on the first following char. ;; As many characters as can be conveniently found in this range ;; are marked, but no assumption can be made that the whole range ;; is marked (it could be clobbered by later changes, for ;; instance). ;; ;; Note that some part of the beginning of a sequence of simple ;; whitespace might be part of the end of a preceding line comment ;; or cpp directive and must not be considered part of the "rung". ;; Such whitespace is some amount of horizontal whitespace followed ;; by a newline. In the case of cpp directives it could also be ;; two newlines with horizontal whitespace between them. ;; ;; The reason to include the first following char is to cope with ;; "rung positions" that doesn't have any ordinary whitespace. If ;; `c-is-sws' is put on a token character it does not have ;; `c-in-sws' set simultaneously. That's the only case when that ;; can occur, and the reason for not extending the `c-in-sws' ;; region to cover it is that the `c-in-sws' region could then be ;; accidentally merged with a following one if the token is only ;; one character long. ;; ;; o On buffer changes the `c-in-sws' and `c-is-sws' properties are ;; removed in the changed region. If the change was inside ;; syntactic whitespace that means that the "ladder" is broken, but ;; a later call to `c-forward-sws' or `c-backward-sws' will use the ;; parts on either side and use an ordinary search only to "repair" ;; the gap. ;; ;; Special care needs to be taken if a region is removed: If there ;; are `c-in-sws' on both sides of it which do not connect inside ;; the region then they can't be joined. If e.g. a marked macro is ;; broken, syntactic whitespace inside the new text might be ;; marked. If those marks would become connected with the old ;; `c-in-sws' range around the macro then we could get a ladder ;; with one end outside the macro and the other at some whitespace ;; within it. ;; ;; The main motivation for this system is to increase the speed in ;; skipping over the large whitespace regions that can occur at the ;; top level in e.g. header files that contain a lot of comments and ;; cpp directives. For small comments inside code it's probably ;; slower than using `forward-comment' straightforwardly, but speed is ;; not a significant factor there anyway. ; (defface c-debug-is-sws-face ; '((t (:background "GreenYellow"))) ; "Debug face to mark the `c-is-sws' property.") ; (defface c-debug-in-sws-face ; '((t (:underline t))) ; "Debug face to mark the `c-in-sws' property.") ; (defun c-debug-put-sws-faces () ; ;; Put the sws debug faces on all the `c-is-sws' and `c-in-sws' ; ;; properties in the buffer. ; (interactive) ; (save-excursion ; (c-save-buffer-state (in-face) ; (goto-char (point-min)) ; (setq in-face (if (get-text-property (point) 'c-is-sws) ; (point))) ; (while (progn ; (goto-char (next-single-property-change ; (point) 'c-is-sws nil (point-max))) ; (if in-face ; (progn ; (c-debug-add-face in-face (point) 'c-debug-is-sws-face) ; (setq in-face nil)) ; (setq in-face (point))) ; (not (eobp)))) ; (goto-char (point-min)) ; (setq in-face (if (get-text-property (point) 'c-in-sws) ; (point))) ; (while (progn ; (goto-char (next-single-property-change ; (point) 'c-in-sws nil (point-max))) ; (if in-face ; (progn ; (c-debug-add-face in-face (point) 'c-debug-in-sws-face) ; (setq in-face nil)) ; (setq in-face (point))) ; (not (eobp))))))) (defmacro c-debug-sws-msg (&rest args) ;;`(message ,@args) ) (defmacro c-put-is-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (put-text-property beg end 'c-is-sws t) ,@(when (facep 'c-debug-is-sws-face) `((c-debug-add-face beg end 'c-debug-is-sws-face))))) (defmacro c-put-in-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (put-text-property beg end 'c-in-sws t) ,@(when (facep 'c-debug-is-sws-face) `((c-debug-add-face beg end 'c-debug-in-sws-face))))) (defmacro c-remove-is-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-is-sws nil)) ,@(when (facep 'c-debug-is-sws-face) `((c-debug-remove-face beg end 'c-debug-is-sws-face))))) (defmacro c-remove-in-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) `((c-debug-remove-face beg end 'c-debug-in-sws-face))))) (defmacro c-remove-is-and-in-sws (beg end) ;; This macro does a hidden buffer change. `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-is-sws nil c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) `((c-debug-remove-face beg end 'c-debug-is-sws-face) (c-debug-remove-face beg end 'c-debug-in-sws-face))))) (defsubst c-invalidate-sws-region-after (beg end) ;; Called from `after-change-functions'. Note that if ;; `c-forward-sws' or `c-backward-sws' are used outside ;; `c-save-buffer-state' or similar then this will remove the cache ;; properties right after they're added. ;; ;; This function does hidden buffer changes. (save-excursion ;; Adjust the end to remove the properties in any following simple ;; ws up to and including the next line break, if there is any ;; after the changed region. This is necessary e.g. when a rung ;; marked empty line is converted to a line comment by inserting ;; "//" before the line break. In that case the line break would ;; keep the rung mark which could make a later `c-backward-sws' ;; move into the line comment instead of over it. (goto-char end) (skip-chars-forward " \t\f\v") (when (and (eolp) (not (eobp))) (setq end (1+ (point))))) (when (and (= beg end) (get-text-property beg 'c-in-sws) (> beg (point-min)) (get-text-property (1- beg) 'c-in-sws)) ;; Ensure that an `c-in-sws' range gets broken. Note that it isn't ;; safe to keep a range that was continuous before the change. E.g: ;; ;; #define foo ;; \ ;; bar ;; ;; There can be a "ladder" between "#" and "b". Now, if the newline ;; after "foo" is removed then "bar" will become part of the cpp ;; directive instead of a syntactically relevant token. In that ;; case there's no longer syntactic ws from "#" to "b". (setq beg (1- beg))) (c-debug-sws-msg "c-invalidate-sws-region-after [%s..%s]" beg end) (c-remove-is-and-in-sws beg end)) (defun c-forward-sws () ;; Used by `c-forward-syntactic-ws' to implement the unbounded search. ;; ;; This function might do hidden buffer changes. (let (;; `rung-pos' is set to a position as early as possible in the ;; unmarked part of the simple ws region. (rung-pos (point)) next-rung-pos rung-end-pos last-put-in-sws-pos rung-is-marked next-rung-is-marked simple-ws-end ;; `safe-start' is set when it's safe to cache the start position. ;; It's not set if we've initially skipped over comments and line ;; continuations since we might have gone out through the end of a ;; macro then. This provision makes `c-forward-sws' not populate the ;; cache in the majority of cases, but otoh is `c-backward-sws' by far ;; more common. safe-start) ;; Skip simple ws and do a quick check on the following character to see ;; if it's anything that can't start syntactic ws, so we can bail out ;; early in the majority of cases when there just are a few ws chars. (skip-chars-forward " \t\n\r\f\v") (when (looking-at c-syntactic-ws-start) (setq rung-end-pos (min (1+ (point)) (point-max))) (if (setq rung-is-marked (text-property-any rung-pos rung-end-pos 'c-is-sws t)) ;; Find the last rung position to avoid setting properties in all ;; the cases when the marked rung is complete. ;; (`next-single-property-change' is certain to move at least one ;; step forward.) (setq rung-pos (1- (next-single-property-change rung-is-marked 'c-is-sws nil rung-end-pos))) ;; Got no marked rung here. Since the simple ws might have started ;; inside a line comment or cpp directive we must set `rung-pos' as ;; high as possible. (setq rung-pos (point))) (while (progn (while (when (and rung-is-marked (get-text-property (point) 'c-in-sws)) ;; The following search is the main reason that `c-in-sws' ;; and `c-is-sws' aren't combined to one property. (goto-char (next-single-property-change (point) 'c-in-sws nil (point-max))) (unless (get-text-property (point) 'c-is-sws) ;; If the `c-in-sws' region extended past the last ;; `c-is-sws' char we have to go back a bit. (or (get-text-property (1- (point)) 'c-is-sws) (goto-char (previous-single-property-change (point) 'c-is-sws))) (backward-char)) (c-debug-sws-msg "c-forward-sws cached move %s -> %s (max %s)" rung-pos (point) (point-max)) (setq rung-pos (point)) (and (> (skip-chars-forward " \t\n\r\f\v") 0) (not (eobp)))) ;; We'll loop here if there is simple ws after the last rung. ;; That means that there's been some change in it and it's ;; possible that we've stepped into another ladder, so extend ;; the previous one to join with it if there is one, and try to ;; use the cache again. (c-debug-sws-msg "c-forward-sws extending rung with [%s..%s] (max %s)" (1+ rung-pos) (1+ (point)) (point-max)) (unless (get-text-property (point) 'c-is-sws) ;; Remove any `c-in-sws' property from the last char of ;; the rung before we mark it with `c-is-sws', so that we ;; won't connect with the remains of a broken "ladder". (c-remove-in-sws (point) (1+ (point)))) (c-put-is-sws (1+ rung-pos) (1+ (point))) (c-put-in-sws rung-pos (setq rung-pos (point) last-put-in-sws-pos rung-pos))) (setq simple-ws-end (point)) (c-forward-comments) (cond ((/= (point) simple-ws-end) ;; Skipped over comments. Don't cache at eob in case the buffer ;; is narrowed. (not (eobp))) ((save-excursion (and c-opt-cpp-prefix (looking-at c-opt-cpp-start) (progn (skip-chars-backward " \t") (bolp)) (or (bobp) (progn (backward-char) (not (eq (char-before) ?\\)))))) ;; Skip a preprocessor directive. (end-of-line) (while (and (eq (char-before) ?\\) (= (forward-line 1) 0)) (end-of-line)) (forward-line 1) (setq safe-start t) ;; Don't cache at eob in case the buffer is narrowed. (not (eobp))))) ;; We've searched over a piece of non-white syntactic ws. See if this ;; can be cached. (setq next-rung-pos (point)) (skip-chars-forward " \t\n\r\f\v") (setq rung-end-pos (min (1+ (point)) (point-max))) (if (or ;; Cache if we haven't skipped comments only, and if we started ;; either from a marked rung or from a completely uncached ;; position. (and safe-start (or rung-is-marked (not (get-text-property simple-ws-end 'c-in-sws)))) ;; See if there's a marked rung in the encountered simple ws. If ;; so then we can cache, unless `safe-start' is nil. Even then ;; we need to do this to check if the cache can be used for the ;; next step. (and (setq next-rung-is-marked (text-property-any next-rung-pos rung-end-pos 'c-is-sws t)) safe-start)) (progn (c-debug-sws-msg "c-forward-sws caching [%s..%s] - [%s..%s] (max %s)" rung-pos (1+ simple-ws-end) next-rung-pos rung-end-pos (point-max)) ;; Remove the properties for any nested ws that might be cached. ;; Only necessary for `c-is-sws' since `c-in-sws' will be set ;; anyway. (c-remove-is-sws (1+ simple-ws-end) next-rung-pos) (unless (and rung-is-marked (= rung-pos simple-ws-end)) (c-put-is-sws rung-pos (1+ simple-ws-end)) (setq rung-is-marked t)) (c-put-in-sws rung-pos (setq rung-pos (point) last-put-in-sws-pos rung-pos)) (unless (get-text-property (1- rung-end-pos) 'c-is-sws) ;; Remove any `c-in-sws' property from the last char of ;; the rung before we mark it with `c-is-sws', so that we ;; won't connect with the remains of a broken "ladder". (c-remove-in-sws (1- rung-end-pos) rung-end-pos)) (c-put-is-sws next-rung-pos rung-end-pos)) (c-debug-sws-msg "c-forward-sws not caching [%s..%s] - [%s..%s] (max %s)" rung-pos (1+ simple-ws-end) next-rung-pos rung-end-pos (point-max)) ;; Set `rung-pos' for the next rung. It's the same thing here as ;; initially, except that the rung position is set as early as ;; possible since we can't be in the ending ws of a line comment or ;; cpp directive now. (if (setq rung-is-marked next-rung-is-marked) (setq rung-pos (1- (next-single-property-change rung-is-marked 'c-is-sws nil rung-end-pos))) (setq rung-pos next-rung-pos)) (setq safe-start t))) ;; Make sure that the newly marked `c-in-sws' region doesn't connect to ;; another one after the point (which might occur when editing inside a ;; comment or macro). (when (eq last-put-in-sws-pos (point)) (cond ((< last-put-in-sws-pos (point-max)) (c-debug-sws-msg "c-forward-sws clearing at %s for cache separation" last-put-in-sws-pos) (c-remove-in-sws last-put-in-sws-pos (1+ last-put-in-sws-pos))) (t ;; If at eob we have to clear the last character before the end ;; instead since the buffer might be narrowed and there might ;; be a `c-in-sws' after (point-max). In this case it's ;; necessary to clear both properties. (c-debug-sws-msg "c-forward-sws clearing thoroughly at %s for cache separation" (1- last-put-in-sws-pos)) (c-remove-is-and-in-sws (1- last-put-in-sws-pos) last-put-in-sws-pos)))) ))) (defun c-backward-sws () ;; Used by `c-backward-syntactic-ws' to implement the unbounded search. ;; ;; This function might do hidden buffer changes. (let (;; `rung-pos' is set to a position as late as possible in the unmarked ;; part of the simple ws region. (rung-pos (point)) next-rung-pos last-put-in-sws-pos rung-is-marked simple-ws-beg cmt-skip-pos) ;; Skip simple horizontal ws and do a quick check on the preceding ;; character to see if it's anying that can't end syntactic ws, so we can ;; bail out early in the majority of cases when there just are a few ws ;; chars. Newlines are complicated in the backward direction, so we can't ;; skip over them. (skip-chars-backward " \t\f") (when (and (not (bobp)) (save-excursion (backward-char) (looking-at c-syntactic-ws-end))) ;; Try to find a rung position in the simple ws preceding point, so that ;; we can get a cache hit even if the last bit of the simple ws has ;; changed recently. (setq simple-ws-beg (point)) (skip-chars-backward " \t\n\r\f\v") (if (setq rung-is-marked (text-property-any (point) (min (1+ rung-pos) (point-max)) 'c-is-sws t)) ;; `rung-pos' will be the earliest marked position, which means that ;; there might be later unmarked parts in the simple ws region. ;; It's not worth the effort to fix that; the last part of the ;; simple ws is also typically edited often, so it could be wasted. (goto-char (setq rung-pos rung-is-marked)) (goto-char simple-ws-beg)) (while (progn (while (when (and rung-is-marked (not (bobp)) (get-text-property (1- (point)) 'c-in-sws)) ;; The following search is the main reason that `c-in-sws' ;; and `c-is-sws' aren't combined to one property. (goto-char (previous-single-property-change (point) 'c-in-sws nil (point-min))) (unless (get-text-property (point) 'c-is-sws) ;; If the `c-in-sws' region extended past the first ;; `c-is-sws' char we have to go forward a bit. (goto-char (next-single-property-change (point) 'c-is-sws))) (c-debug-sws-msg "c-backward-sws cached move %s <- %s (min %s)" (point) rung-pos (point-min)) (setq rung-pos (point)) (if (and (< (min (skip-chars-backward " \t\f\v") (progn (setq simple-ws-beg (point)) (skip-chars-backward " \t\n\r\f\v"))) 0) (setq rung-is-marked (text-property-any (point) rung-pos 'c-is-sws t))) t (goto-char simple-ws-beg) nil)) ;; We'll loop here if there is simple ws before the first rung. ;; That means that there's been some change in it and it's ;; possible that we've stepped into another ladder, so extend ;; the previous one to join with it if there is one, and try to ;; use the cache again. (c-debug-sws-msg "c-backward-sws extending rung with [%s..%s] (min %s)" rung-is-marked rung-pos (point-min)) (unless (get-text-property (1- rung-pos) 'c-is-sws) ;; Remove any `c-in-sws' property from the last char of ;; the rung before we mark it with `c-is-sws', so that we ;; won't connect with the remains of a broken "ladder". (c-remove-in-sws (1- rung-pos) rung-pos)) (c-put-is-sws rung-is-marked rung-pos) (c-put-in-sws rung-is-marked (1- rung-pos)) (setq rung-pos rung-is-marked last-put-in-sws-pos rung-pos)) (c-backward-comments) (setq cmt-skip-pos (point)) (cond ((and c-opt-cpp-prefix (/= cmt-skip-pos simple-ws-beg) (c-beginning-of-macro)) ;; Inside a cpp directive. See if it should be skipped over. (let ((cpp-beg (point))) ;; Move back over all line continuations in the region skipped ;; over by `c-backward-comments'. If we go past it then we ;; started inside the cpp directive. (goto-char simple-ws-beg) (beginning-of-line) (while (and (> (point) cmt-skip-pos) (progn (backward-char) (eq (char-before) ?\\))) (beginning-of-line)) (if (< (point) cmt-skip-pos) ;; Don't move past the cpp directive if we began inside ;; it. Note that the position at the end of the last line ;; of the macro is also considered to be within it. (progn (goto-char cmt-skip-pos) nil) ;; It's worthwhile to spend a little bit of effort on finding ;; the end of the macro, to get a good `simple-ws-beg' ;; position for the cache. Note that `c-backward-comments' ;; could have stepped over some comments before going into ;; the macro, and then `simple-ws-beg' must be kept on the ;; same side of those comments. (goto-char simple-ws-beg) (skip-chars-backward " \t\n\r\f\v") (if (eq (char-before) ?\\) (forward-char)) (forward-line 1) (if (< (point) simple-ws-beg) ;; Might happen if comments after the macro were skipped ;; over. (setq simple-ws-beg (point))) (goto-char cpp-beg) t))) ((/= (save-excursion (skip-chars-forward " \t\n\r\f\v" simple-ws-beg) (setq next-rung-pos (point))) simple-ws-beg) ;; Skipped over comments. Must put point at the end of ;; the simple ws at point since we might be after a line ;; comment or cpp directive that's been partially ;; narrowed out, and we can't risk marking the simple ws ;; at the end of it. (goto-char next-rung-pos) t))) ;; We've searched over a piece of non-white syntactic ws. See if this ;; can be cached. (setq next-rung-pos (point)) (skip-chars-backward " \t\f\v") (if (or ;; Cache if we started either from a marked rung or from a ;; completely uncached position. rung-is-marked (not (get-text-property (1- simple-ws-beg) 'c-in-sws)) ;; Cache if there's a marked rung in the encountered simple ws. (save-excursion (skip-chars-backward " \t\n\r\f\v") (text-property-any (point) (min (1+ next-rung-pos) (point-max)) 'c-is-sws t))) (progn (c-debug-sws-msg "c-backward-sws caching [%s..%s] - [%s..%s] (min %s)" (point) (1+ next-rung-pos) simple-ws-beg (min (1+ rung-pos) (point-max)) (point-min)) ;; Remove the properties for any nested ws that might be cached. ;; Only necessary for `c-is-sws' since `c-in-sws' will be set ;; anyway. (c-remove-is-sws (1+ next-rung-pos) simple-ws-beg) (unless (and rung-is-marked (= simple-ws-beg rung-pos)) (let ((rung-end-pos (min (1+ rung-pos) (point-max)))) (unless (get-text-property (1- rung-end-pos) 'c-is-sws) ;; Remove any `c-in-sws' property from the last char of ;; the rung before we mark it with `c-is-sws', so that we ;; won't connect with the remains of a broken "ladder". (c-remove-in-sws (1- rung-end-pos) rung-end-pos)) (c-put-is-sws simple-ws-beg rung-end-pos) (setq rung-is-marked t))) (c-put-in-sws (setq simple-ws-beg (point) last-put-in-sws-pos simple-ws-beg) rung-pos) (c-put-is-sws (setq rung-pos simple-ws-beg) (1+ next-rung-pos))) (c-debug-sws-msg "c-backward-sws not caching [%s..%s] - [%s..%s] (min %s)" (point) (1+ next-rung-pos) simple-ws-beg (min (1+ rung-pos) (point-max)) (point-min)) (setq rung-pos next-rung-pos simple-ws-beg (point)) )) ;; Make sure that the newly marked `c-in-sws' region doesn't connect to ;; another one before the point (which might occur when editing inside a ;; comment or macro). (when (eq last-put-in-sws-pos (point)) (cond ((< (point-min) last-put-in-sws-pos) (c-debug-sws-msg "c-backward-sws clearing at %s for cache separation" (1- last-put-in-sws-pos)) (c-remove-in-sws (1- last-put-in-sws-pos) last-put-in-sws-pos)) ((> (point-min) 1) ;; If at bob and the buffer is narrowed, we have to clear the ;; character we're standing on instead since there might be a ;; `c-in-sws' before (point-min). In this case it's necessary ;; to clear both properties. (c-debug-sws-msg "c-backward-sws clearing thoroughly at %s for cache separation" last-put-in-sws-pos) (c-remove-is-and-in-sws last-put-in-sws-pos (1+ last-put-in-sws-pos))))) ))) ;; A system for finding noteworthy parens before the point. (defvar c-state-cache nil) (make-variable-buffer-local 'c-state-cache) ;; The state cache used by `c-parse-state' to cut down the amount of ;; searching. It's the result from some earlier `c-parse-state' call. ;; ;; The use of the cached info is more effective if the next ;; `c-parse-state' call is on a line close by the one the cached state ;; was made at; the cache can actually slow down a little if the ;; cached state was made very far back in the buffer. The cache is ;; most effective if `c-parse-state' is used on each line while moving ;; forward. (defvar c-state-cache-start 1) (make-variable-buffer-local 'c-state-cache-start) ;; This is (point-min) when `c-state-cache' was calculated, since a ;; change of narrowing is likely to affect the parens that are visible ;; before the point. (defvar c-state-cache-good-pos 1) (make-variable-buffer-local 'c-state-cache-good-pos) ;; This is a position where `c-state-cache' is known to be correct. ;; It's a position inside one of the recorded unclosed parens or the ;; top level, but not further nested inside any literal or 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 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 ;; with refontification of the current line. (defsubst c-invalidate-state-cache (pos) ;; Invalidate all info on `c-state-cache' that applies to the buffer ;; at POS or higher. 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 new open paren wouldn't have the ;; required preceding paren pair element. (while (and (or c-state-cache (when (< pos c-state-cache-good-pos) (setq c-state-cache-good-pos 1) nil)) (let ((elem (car c-state-cache))) (if (consp elem) (or (< pos (cdr elem)) (when (< pos c-state-cache-good-pos) (setq c-state-cache-good-pos (cdr elem)) nil)) (or (<= pos elem) (when (< pos c-state-cache-good-pos) (setq c-state-cache-good-pos (1+ elem)) nil))))) (setq c-state-cache (cdr c-state-cache)))) (defun c-get-fallback-start-pos (here) ;; Return the start position for building `c-state-cache' from ;; scratch. (save-excursion ;; Go back 2 bods, but ignore any bogus positions returned by ;; beginning-of-defun (i.e. open paren in column zero). (goto-char here) (let ((cnt 2)) (while (not (or (bobp) (zerop cnt))) (c-beginning-of-defun-1) (if (eq (char-after) ?\{) (setq cnt (1- cnt))))) (point))) (defun c-parse-state () ;; Find and record all noteworthy parens between some good point ;; earlier in the file and point. That good point is at least the ;; beginning of the top-level construct we are in, or the beginning ;; of the preceding top-level construct if we aren't in one. ;; ;; The returned value is a list of the noteworthy parens with the ;; last one first. If an element in the list is an integer, it's ;; the position of an open paren which has not been closed before ;; the point. If an element is a cons, it gives the position of a ;; closed brace paren pair; the car is the start paren position and ;; the cdr is the position following the closing paren. Only the ;; last closed brace paren pair before each open paren and before ;; the point is recorded, and thus the state never contains two cons ;; elements in succession. ;; ;; Currently no characters which are given paren syntax with the ;; syntax-table property are recorded, i.e. angle bracket arglist ;; parens are never present here. Note that this might change. ;; ;; BUG: This function doesn't cope entirely well with unbalanced ;; parens in macros. E.g. in the following case the brace before ;; the macro isn't balanced with the one after it: ;; ;; { ;; #define X { ;; } ;; ;; This function might do hidden buffer changes. (save-restriction (let* ((here (point)) (here-bol (c-point 'bol)) (c-macro-start (c-query-macro-start)) (in-macro-start (or c-macro-start (point))) old-state last-pos brace-pair-open brace-pair-close pos save-pos) (c-invalidate-state-cache here) ;; If the minimum position has changed due to narrowing then we ;; have to fix the tail of `c-state-cache' accordingly. (unless (= c-state-cache-start (point-min)) (if (> (point-min) c-state-cache-start) ;; If point-min has moved forward then we just need to cut ;; off a bit of the tail. (let ((ptr (cons nil c-state-cache)) elem) (while (and (setq elem (car-safe (cdr ptr))) (>= (if (consp elem) (car elem) elem) (point-min))) (setq ptr (cdr ptr))) (when (consp ptr) (if (eq (cdr ptr) c-state-cache) (setq c-state-cache nil c-state-cache-good-pos 1) (setcdr ptr nil)))) ;; If point-min has moved backward then we drop the state ;; completely. It's possible to do a better job here and ;; recalculate the top only. (setq c-state-cache nil c-state-cache-good-pos 1)) (setq c-state-cache-start (point-min))) ;; Get the latest position we know are directly inside the ;; closest containing paren of the cached state. (setq last-pos (and c-state-cache (if (consp (car c-state-cache)) (cdr (car c-state-cache)) (1+ (car c-state-cache))))) (if (or (not last-pos) (< last-pos c-state-cache-good-pos)) (setq last-pos c-state-cache-good-pos) ;; Take the opportunity to move the cached good position ;; further down. (if (< last-pos here-bol) (setq c-state-cache-good-pos last-pos))) ;; Check if `last-pos' is in a macro. If it is, and we're not ;; in the same macro, we must discard everything on ;; `c-state-cache' that is inside the macro before using it. (save-excursion (goto-char last-pos) (when (and (c-beginning-of-macro) (/= (point) in-macro-start)) (c-invalidate-state-cache (point)) ;; Set `last-pos' again just like above except that there's ;; no use looking at `c-state-cache-good-pos' here. (setq last-pos (if c-state-cache (if (consp (car c-state-cache)) (cdr (car c-state-cache)) (1+ (car c-state-cache))) 1)))) ;; If we've moved very far from the last cached position then ;; it's probably better to redo it from scratch, otherwise we ;; might spend a lot of time searching from `last-pos' down to ;; here. (when (< last-pos (- here 20000)) ;; First get the fallback start position. If it turns out ;; that it's so far back that the cached state is closer then ;; we'll keep it afterall. (setq pos (c-get-fallback-start-pos here)) (if (<= pos last-pos) (setq pos nil) (setq last-pos nil c-state-cache nil c-state-cache-good-pos 1))) ;; Find the start position for the forward search. (Can't ;; search in the backward direction since the point might be in ;; some kind of literal.) (unless pos (setq old-state c-state-cache) ;; There's a cached state with a containing paren. Pop off ;; the stale containing sexps from it by going forward out of ;; parens as far as possible. (narrow-to-region (point-min) here) (let (placeholder pair-beg) (while (and c-state-cache (setq placeholder (c-up-list-forward last-pos))) (setq last-pos placeholder) (if (consp (car c-state-cache)) (setq pair-beg (car-safe (cdr c-state-cache)) c-state-cache (cdr-safe (cdr c-state-cache))) (setq pair-beg (car c-state-cache) c-state-cache (cdr c-state-cache)))) (when (and pair-beg (eq (char-after pair-beg) ?{)) ;; The last paren pair we moved out from was a brace ;; pair. Modify the state to record this as a closed ;; pair now. (if (consp (car-safe c-state-cache)) (setq c-state-cache (cdr c-state-cache))) (setq c-state-cache (cons (cons pair-beg last-pos) c-state-cache)))) ;; Check if the preceding balanced paren is within a ;; macro; it should be ignored if we're outside the ;; macro. There's no need to check any further upwards; ;; if the macro contains an unbalanced opening paren then ;; we're smoked anyway. (when (and (<= (point) in-macro-start) (consp (car c-state-cache))) (save-excursion (goto-char (car (car c-state-cache))) (when (c-beginning-of-macro) (setq here (point) c-state-cache (cdr c-state-cache))))) (unless (eq c-state-cache old-state) ;; Have to adjust the cached good position if state has been ;; popped off. (setq c-state-cache-good-pos (if c-state-cache (if (consp (car c-state-cache)) (cdr (car c-state-cache)) (1+ (car c-state-cache))) 1) old-state c-state-cache)) (when c-state-cache (setq pos last-pos))) ;; Get the fallback start position. (unless pos (setq pos (c-get-fallback-start-pos here) c-state-cache nil c-state-cache-good-pos 1)) (narrow-to-region (point-min) here) (while pos (setq save-pos pos brace-pair-open nil) ;; Find the balanced brace pairs. This loop is hot, so it ;; does ugly tricks to go faster. (c-safe (let (set-good-pos set-brace-pair) (while t (setq last-pos nil last-pos (scan-lists pos 1 -1)) ; Might signal. (setq pos (scan-lists last-pos 1 1) ; Might signal. set-good-pos (< pos here-bol) set-brace-pair (eq (char-before last-pos) ?{)) ;; Update the cached good position and record the brace ;; pair, whichever is applicable for the paren we've ;; just jumped over. But first check that it isn't ;; inside a macro and the point isn't inside the same ;; one. (when (and (or set-good-pos set-brace-pair) (or (>= pos in-macro-start) (save-excursion (goto-char pos) (not (c-beginning-of-macro))))) (if set-good-pos (setq c-state-cache-good-pos pos)) (if set-brace-pair (setq brace-pair-open last-pos brace-pair-close pos)))))) ;; Record the last brace pair. (when brace-pair-open (let ((head (car-safe c-state-cache))) (if (consp head) (progn (setcar head (1- brace-pair-open)) (setcdr head brace-pair-close)) (setq c-state-cache (cons (cons (1- brace-pair-open) brace-pair-close) c-state-cache))))) (if last-pos ;; Prepare to loop, but record the open paren only if it's ;; outside a macro or within the same macro as point, and ;; if it is a legitimate open paren and not some character ;; that got an open paren syntax-table property. (progn (setq pos last-pos) (when (and (or (>= last-pos in-macro-start) (save-excursion (goto-char last-pos) (not (c-beginning-of-macro)))) ;; Check for known types of parens that we ;; want to record. The syntax table is not to ;; be trusted here since the caller might be ;; using e.g. `c++-template-syntax-table'. (memq (char-before last-pos) '(?{ ?\( ?\[))) (if (< last-pos here-bol) (setq c-state-cache-good-pos last-pos)) (setq c-state-cache (cons (1- last-pos) c-state-cache)))) (if (setq last-pos (c-up-list-forward pos)) ;; Found a close paren without a corresponding opening ;; one. Maybe we didn't go back far enough, so try to ;; scan backward for the start paren and then start over. (progn (setq pos (c-up-list-backward pos) c-state-cache nil c-state-cache-good-pos c-state-cache-start) (when (or (not pos) ;; Emacs (up to at least 21.2) can get confused by ;; open parens in column zero inside comments: The ;; sexp functions can then misbehave and bring us ;; back to the same point again. Check this so that ;; we don't get an infinite loop. (>= pos save-pos)) (setq pos last-pos c-parsing-error (format "Unbalanced close paren at line %d" (1+ (count-lines (point-min) (c-point 'bol last-pos))))))) (setq pos nil)))) ;;(message "c-parse-state: %S end: %S" c-state-cache c-state-cache-good-pos) c-state-cache))) ;; Debug tool to catch cache inconsistencies. (defvar c-debug-parse-state nil) (unless (fboundp 'c-real-parse-state) (fset 'c-real-parse-state (symbol-function 'c-parse-state))) (cc-bytecomp-defun c-real-parse-state) (defun c-debug-parse-state () (let ((res1 (c-real-parse-state)) res2) (let ((c-state-cache nil) (c-state-cache-start 1) (c-state-cache-good-pos 1)) (setq res2 (c-real-parse-state))) (unless (equal res1 res2) ;; The cache can actually go further back due to the ad-hoc way ;; the first paren is found, so try to whack off a bit of its ;; start before complaining. (save-excursion (goto-char (or (c-least-enclosing-brace res2) (point))) (c-beginning-of-defun-1) (while (not (or (bobp) (eq (char-after) ?{))) (c-beginning-of-defun-1)) (unless (equal (c-whack-state-before (point) res1) res2) (message (concat "c-parse-state inconsistency: " "using cache: %s, from scratch: %s") res1 res2)))) res1)) (defun c-toggle-parse-state-debug (&optional arg) (interactive "P") (setq c-debug-parse-state (c-calculate-state arg c-debug-parse-state)) (fset 'c-parse-state (symbol-function (if c-debug-parse-state 'c-debug-parse-state 'c-real-parse-state))) (c-keep-region-active)) (when c-debug-parse-state (c-toggle-parse-state-debug 1)) (defun c-whack-state-before (bufpos paren-state) ;; Whack off any state information from PAREN-STATE which lies ;; before BUFPOS. Not destructive on PAREN-STATE. (let* ((newstate (list nil)) (ptr newstate) car) (while paren-state (setq car (car paren-state) paren-state (cdr paren-state)) (if (< (if (consp car) (car car) car) bufpos) (setq paren-state nil) (setcdr ptr (list car)) (setq ptr (cdr ptr)))) (cdr newstate))) (defun c-whack-state-after (bufpos paren-state) ;; Whack off any state information from PAREN-STATE which lies at or ;; after BUFPOS. Not destructive on PAREN-STATE. (catch 'done (while paren-state (let ((car (car paren-state))) (if (consp car) ;; just check the car, because in a balanced brace ;; expression, it must be impossible for the corresponding ;; close brace to be before point, but the open brace to ;; be after. (if (<= bufpos (car car)) nil ; whack it off (if (< bufpos (cdr car)) ;; its possible that the open brace is before ;; bufpos, but the close brace is after. In that ;; case, convert this to a non-cons element. The ;; rest of the state is before bufpos, so we're ;; done. (throw 'done (cons (car car) (cdr paren-state))) ;; we know that both the open and close braces are ;; before bufpos, so we also know that everything else ;; on state is before bufpos. (throw 'done paren-state))) (if (<= bufpos car) nil ; whack it off ;; it's before bufpos, so everything else should too. (throw 'done paren-state))) (setq paren-state (cdr paren-state))) nil))) (defun c-most-enclosing-brace (paren-state &optional bufpos) ;; Return the bufpos of the innermost enclosing open paren before ;; bufpos, or nil if none was found. (let (enclosingp) (or bufpos (setq bufpos 134217727)) (while paren-state (setq enclosingp (car paren-state) paren-state (cdr paren-state)) (if (or (consp enclosingp) (>= enclosingp bufpos)) (setq enclosingp nil) (setq paren-state nil))) enclosingp)) (defun c-least-enclosing-brace (paren-state) ;; Return the bufpos of the outermost enclosing open paren, or nil ;; if none was found. (let (pos elem) (while paren-state (setq elem (car paren-state) paren-state (cdr paren-state)) (if (integerp elem) (setq pos elem))) pos)) (defun c-safe-position (bufpos paren-state) ;; Return the closest "safe" position recorded on PAREN-STATE that ;; is higher up than BUFPOS. Return nil if PAREN-STATE doesn't ;; contain any. Return nil if BUFPOS is nil, which is useful to ;; find the closest limit before a given limit that might be nil. ;; ;; A "safe" position is a position at or after a recorded open ;; paren, or after a recorded close paren. The returned position is ;; thus either the first position after a close brace, or the first ;; position after an enclosing paren, or at the enclosing paren in ;; case BUFPOS is immediately after it. (when bufpos (let (elem) (catch 'done (while paren-state (setq elem (car paren-state)) (if (consp elem) (cond ((< (cdr elem) bufpos) (throw 'done (cdr elem))) ((< (car elem) bufpos) ;; See below. (throw 'done (min (1+ (car elem)) bufpos)))) (if (< elem bufpos) ;; elem is the position at and not after the opening paren, so ;; we can go forward one more step unless it's equal to ;; bufpos. This is useful in some cases avoid an extra paren ;; level between the safe position and bufpos. (throw 'done (min (1+ elem) bufpos)))) (setq paren-state (cdr paren-state))))))) (defun c-beginning-of-syntax () ;; This is used for `font-lock-beginning-of-syntax-function'. It ;; goes to the closest previous point that is known to be outside ;; any string literal or comment. `c-state-cache' is used if it has ;; a position in the vicinity. (let* ((paren-state c-state-cache) elem (pos (catch 'done ;; Note: Similar code in `c-safe-position'. The ;; difference is that we accept a safe position at ;; the point and don't bother to go forward past open ;; parens. (while paren-state (setq elem (car paren-state)) (if (consp elem) (cond ((<= (cdr elem) (point)) (throw 'done (cdr elem))) ((<= (car elem) (point)) (throw 'done (car elem)))) (if (<= elem (point)) (throw 'done elem))) (setq paren-state (cdr paren-state))) (point-min)))) (if (> pos (- (point) 4000)) (goto-char pos) ;; The position is far back. Try `c-beginning-of-defun-1' ;; (although we can't be entirely sure it will go to a position ;; outside a comment or string in current emacsen). FIXME: ;; Consult `syntax-ppss' here. (c-beginning-of-defun-1) (if (< (point) pos) (goto-char pos))))) ;; Tools for scanning identifiers and other tokens. (defun c-on-identifier () "Return non-nil if the point is on or directly after an identifier. Keywords are recognized and not considered identifiers. If an identifier is detected, the returned value is its starting position. If an identifier ends at the point and another begins at it \(can only happen in Pike) then the point for the preceding one is returned. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." ;; FIXME: Shouldn't this function handle "operator" in C++? (save-excursion (skip-syntax-backward "w_") (or ;; Check for a normal (non-keyword) identifier. (and (looking-at c-symbol-start) (not (looking-at c-keywords-regexp)) (point)) (when (c-major-mode-is 'pike-mode) ;; Handle the ` syntax in Pike. (let ((pos (point))) (skip-chars-backward "-!%&*+/<=>^|~[]()") (and (if (< (skip-chars-backward "`") 0) t (goto-char pos) (eq (char-after) ?\`)) (looking-at c-symbol-key) (>= (match-end 0) pos) (point)))) ;; Handle the "operator +" syntax in C++. (when (and c-overloadable-operators-regexp (= (c-backward-token-2 0) 0)) (cond ((and (looking-at c-overloadable-operators-regexp) (or (not c-opt-op-identitier-prefix) (and (= (c-backward-token-2 1) 0) (looking-at c-opt-op-identitier-prefix)))) (point)) ((save-excursion (and c-opt-op-identitier-prefix (looking-at c-opt-op-identitier-prefix) (= (c-forward-token-2 1) 0) (looking-at c-overloadable-operators-regexp))) (point)))) ))) (defsubst c-simple-skip-symbol-backward () ;; If the point is at the end of a symbol then skip backward to the ;; beginning of it. Don't move otherwise. Return non-nil if point ;; moved. ;; ;; This function might do hidden buffer changes. (or (< (skip-syntax-backward "w_") 0) (and (c-major-mode-is 'pike-mode) ;; Handle the ` syntax in Pike. (let ((pos (point))) (if (and (< (skip-chars-backward "-!%&*+/<=>^|~[]()") 0) (< (skip-chars-backward "`") 0) (looking-at c-symbol-key) (>= (match-end 0) pos)) t (goto-char pos) nil))))) (defun c-beginning-of-current-token (&optional back-limit) ;; Move to the beginning of the current token. Do not move if not ;; in the middle of one. BACK-LIMIT may be used to bound the ;; backward search; if given it's assumed to be at the boundary ;; between two tokens. ;; ;; This function might do hidden buffer changes. (if (looking-at "\\w\\|\\s_") (skip-syntax-backward "w_" back-limit) (let ((start (point))) (when (< (skip-syntax-backward ".()" back-limit) 0) (while (let ((pos (or (and (looking-at c-nonsymbol-token-regexp) (match-end 0)) ;; `c-nonsymbol-token-regexp' should always match ;; since we've skipped backward over punctuator ;; or paren syntax, but consume one char in case ;; it doesn't so that we don't leave point before ;; some earlier incorrect token. (1+ (point))))) (if (<= pos start) (goto-char pos)) (< pos start))))))) (defun c-end-of-current-token (&optional back-limit) ;; Move to the end of the current token. Do not move if not in the ;; middle of one. BACK-LIMIT may be used to bound the backward ;; search; if given it's assumed to be at the boundary between two ;; tokens. Return non-nil if the point is moved, nil otherwise. ;; ;; This function might do hidden buffer changes. (let ((start (point))) (cond ((< (skip-syntax-backward "w_" (1- start)) 0) (skip-syntax-forward "w_")) ((< (skip-syntax-backward ".()" back-limit) 0) (while (progn (if (looking-at c-nonsymbol-token-regexp) (goto-char (match-end 0)) ;; `c-nonsymbol-token-regexp' should always match since ;; we've skipped backward over punctuator or paren ;; syntax, but move forward in case it doesn't so that ;; we don't leave point earlier than we started with. (forward-char)) (< (point) start))))) (> (point) start))) (defconst c-jump-syntax-balanced (if (memq 'gen-string-delim c-emacs-features) "\\w\\|\\s_\\|\\s\(\\|\\s\)\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\(\\|\\s\)\\|\\s\"")) (defconst c-jump-syntax-unbalanced (if (memq 'gen-string-delim c-emacs-features) "\\w\\|\\s_\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\"")) (defun c-forward-token-2 (&optional count balanced limit) "Move forward by tokens. A token is defined as all symbols and identifiers which aren't syntactic whitespace \(note that multicharacter tokens like \"==\" are treated properly). Point is always either left at the beginning of a token or not moved at all. COUNT specifies the number of tokens to move; a negative COUNT moves in the opposite direction. A COUNT of 0 moves to the next token beginning only if not already at one. If BALANCED is true, move over balanced parens, otherwise move into them. Also, if BALANCED is true, never move out of an enclosing paren. LIMIT sets the limit for the movement and defaults to the point limit. The case when LIMIT is set in the middle of a token, comment or macro is handled correctly, i.e. the point won't be left there. Return the number of tokens left to move \(positive or negative). If BALANCED is true, a move over a balanced paren counts as one. Note that if COUNT is 0 and no appropriate token beginning is found, 1 will be returned. Thus, a return value of 0 guarantees that point is at the requested position and a return value less \(without signs) than COUNT guarantees that point is at the beginning of some token. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (or count (setq count 1)) (if (< count 0) (- (c-backward-token-2 (- count) balanced limit)) (let ((jump-syntax (if balanced c-jump-syntax-balanced c-jump-syntax-unbalanced)) (last (point)) (prev (point))) (if (zerop count) ;; If count is zero we should jump if in the middle of a token. (c-end-of-current-token)) (save-restriction (if limit (narrow-to-region (point-min) limit)) (if (/= (point) (progn (c-forward-syntactic-ws) (point))) ;; Skip whitespace. Count this as a move if we did in ;; fact move. (setq count (max (1- count) 0))) (if (eobp) ;; Moved out of bounds. Make sure the returned count isn't zero. (progn (if (zerop count) (setq count 1)) (goto-char last)) ;; Use `condition-case' to avoid having the limit tests ;; inside the loop. (condition-case nil (while (and (> count 0) (progn (setq last (point)) (cond ((looking-at jump-syntax) (goto-char (scan-sexps (point) 1)) t) ((looking-at c-nonsymbol-token-regexp) (goto-char (match-end 0)) t) ;; `c-nonsymbol-token-regexp' above should always ;; match if there are correct tokens. Try to ;; widen to see if the limit was set in the ;; middle of one, else fall back to treating ;; the offending thing as a one character token. ((and limit (save-restriction (widen) (looking-at c-nonsymbol-token-regexp))) nil) (t (forward-char) t)))) (c-forward-syntactic-ws) (setq prev last count (1- count))) (error (goto-char last))) (when (eobp) (goto-char prev) (setq count (1+ count))))) count))) (defun c-backward-token-2 (&optional count balanced limit) "Move backward by tokens. See `c-forward-token-2' for details." (or count (setq count 1)) (if (< count 0) (- (c-forward-token-2 (- count) balanced limit)) (or limit (setq limit (point-min))) (let ((jump-syntax (if balanced c-jump-syntax-balanced c-jump-syntax-unbalanced)) (last (point))) (if (zerop count) ;; The count is zero so try to skip to the beginning of the ;; current token. (if (> (point) (progn (c-beginning-of-current-token) (point))) (if (< (point) limit) ;; The limit is inside the same token, so return 1. (setq count 1)) ;; We're not in the middle of a token. If there's ;; whitespace after the point then we must move backward, ;; so set count to 1 in that case. (and (looking-at c-syntactic-ws-start) ;; If we're looking at a '#' that might start a cpp ;; directive then we have to do a more elaborate check. (or (/= (char-after) ?#) (not c-opt-cpp-prefix) (save-excursion (and (= (point) (progn (beginning-of-line) (looking-at "[ \t]*") (match-end 0))) (or (bobp) (progn (backward-char) (not (eq (char-before) ?\\))))))) (setq count 1)))) ;; Use `condition-case' to avoid having to check for buffer ;; limits in `backward-char', `scan-sexps' and `goto-char' below. (condition-case nil (while (and (> count 0) (progn (c-backward-syntactic-ws) (backward-char) (if (looking-at jump-syntax) (goto-char (scan-sexps (1+ (point)) -1)) ;; This can be very inefficient if there's a long ;; sequence of operator tokens without any separation. ;; That doesn't happen in practice, anyway. (c-beginning-of-current-token)) (>= (point) limit))) (setq last (point) count (1- count))) (error (goto-char last))) (if (< (point) limit) (goto-char last)) count))) (defun c-forward-token-1 (&optional count balanced limit) "Like `c-forward-token-2' but doesn't treat multicharacter operator tokens like \"==\" as single tokens, i.e. all sequences of symbol characters are jumped over character by character. This function is for compatibility only; it's only a wrapper over `c-forward-token-2'." (let ((c-nonsymbol-token-regexp "\\s.\\|\\s\(\\|\\s\)")) (c-forward-token-2 count balanced limit))) (defun c-backward-token-1 (&optional count balanced limit) "Like `c-backward-token-2' but doesn't treat multicharacter operator tokens like \"==\" as single tokens, i.e. all sequences of symbol characters are jumped over character by character. This function is for compatibility only; it's only a wrapper over `c-backward-token-2'." (let ((c-nonsymbol-token-regexp "\\s.\\|\\s\(\\|\\s\)")) (c-backward-token-2 count balanced limit))) ;; Tools for doing searches restricted to syntactically relevant text. (defun c-syntactic-re-search-forward (regexp &optional bound noerror paren-level not-inside-token lookbehind-submatch) "Like `re-search-forward', but only report matches that are found in syntactically significant text. I.e. matches in comments, macros or string literals are ignored. The start point is assumed to be outside any comment, macro or string literal, or else the content of that region is taken as syntactically significant text. If PAREN-LEVEL is non-nil, an additional restriction is added to ignore matches in nested paren sexps. The search will also not go outside the current list sexp, which has the effect that if the point should be moved to BOUND when no match is found \(i.e. NOERROR is neither nil nor t), then it will be at the closing paren if the end of the current list sexp is encountered first. If NOT-INSIDE-TOKEN is non-nil, matches in the middle of tokens are ignored. Things like multicharacter operators and special symbols \(e.g. \"`()\" in Pike) are handled but currently not floating point constants. If LOOKBEHIND-SUBMATCH is non-nil, it's taken as a number of a subexpression in REGEXP. The end of that submatch is used as the position to check for syntactic significance. If LOOKBEHIND-SUBMATCH isn't used or if that subexpression didn't match then the start position of the whole match is used instead. The \"look behind\" subexpression is never tested before the starting position, so it might be a good idea to include \\=\\= as a match alternative in it. Optimization note: Matches might be missed if the \"look behind\" subexpression can match the end of nonwhite syntactic whitespace, i.e. the end of comments or cpp directives. This since the function skips over such things before resuming the search. It's on the other hand not safe to assume that the \"look behind\" subexpression never matches syntactic whitespace. Bug: Unbalanced parens inside cpp directives are currently not handled correctly \(i.e. they don't get ignored as they should) when PAREN-LEVEL is set. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (or bound (setq bound (point-max))) (if paren-level (setq paren-level -1)) ;;(message "c-syntactic-re-search-forward %s %s %S" (point) bound regexp) (let ((start (point)) tmp ;; Start position for the last search. search-pos ;; The `parse-partial-sexp' state between the start position ;; and the point. state ;; The current position after the last state update. The next ;; `parse-partial-sexp' continues from here. (state-pos (point)) ;; The position at which to check the state and the state ;; there. This is separate from `state-pos' since we might ;; need to back up before doing the next search round. check-pos check-state ;; Last position known to end a token. (last-token-end-pos (point-min)) ;; Set when a valid match is found. found) (condition-case err (while (and (progn (setq search-pos (point)) (re-search-forward regexp bound noerror)) (progn (setq state (parse-partial-sexp state-pos (match-beginning 0) paren-level nil state) state-pos (point)) (if (setq check-pos (and lookbehind-submatch (or (not paren-level) (>= (car state) 0)) (match-end lookbehind-submatch))) (setq check-state (parse-partial-sexp state-pos check-pos paren-level nil state)) (setq check-pos state-pos check-state state)) ;; NOTE: If we got a look behind subexpression and get ;; an insignificant match in something that isn't ;; syntactic whitespace (i.e. strings or in nested ;; parentheses), then we can never skip more than a ;; single character from the match start position ;; (i.e. `state-pos' here) before continuing the ;; search. That since the look behind subexpression ;; might match the end of the insignificant region in ;; the next search. (cond ((elt check-state 7) ;; Match inside a line comment. Skip to eol. Use ;; `re-search-forward' instead of `skip-chars-forward' to get ;; the right bound behavior. (re-search-forward "[\n\r]" bound noerror)) ((elt check-state 4) ;; Match inside a block comment. Skip to the '*/'. (search-forward "*/" bound noerror)) ((and (not (elt check-state 5)) (eq (char-before check-pos) ?/) (not (c-get-char-property (1- check-pos) 'syntax-table)) (memq (char-after check-pos) '(?/ ?*))) ;; Match in the middle of the opener of a block or line ;; comment. (if (= (char-after check-pos) ?/) (re-search-forward "[\n\r]" bound noerror) (search-forward "*/" bound noerror))) ;; The last `parse-partial-sexp' above might have ;; stopped short of the real check position if the end ;; of the current sexp was encountered in paren-level ;; mode. The checks above are always false in that ;; case, and since they can do better skipping in ;; lookbehind-submatch mode, we do them before ;; checking the paren level. ((and paren-level (/= (setq tmp (car check-state)) 0)) ;; Check the paren level first since we're short of the ;; syntactic checking position if the end of the ;; current sexp was encountered by `parse-partial-sexp'. (if (> tmp 0) ;; Inside a nested paren sexp. (if lookbehind-submatch ;; See the NOTE above. (progn (goto-char state-pos) t) ;; Skip out of the paren quickly. (setq state (parse-partial-sexp state-pos bound 0 nil state) state-pos (point))) ;; Have exited the current paren sexp. (if noerror (progn ;; The last `parse-partial-sexp' call above ;; has left us just after the closing paren ;; in this case, so we can modify the bound ;; to leave the point at the right position ;; upon return. (setq bound (1- (point))) nil) (signal 'search-failed (list regexp))))) ((setq tmp (elt check-state 3)) ;; Match inside a string. (if (or lookbehind-submatch (not (integerp tmp))) ;; See the NOTE above. (progn (goto-char state-pos) t) ;; Skip to the end of the string before continuing. (let ((ender (make-string 1 tmp)) (continue t)) (while (if (search-forward ender bound noerror) (progn (setq state (parse-partial-sexp state-pos (point) nil nil state) state-pos (point)) (elt state 3)) (setq continue nil))) continue))) ((save-excursion (save-match-data (c-beginning-of-macro start))) ;; Match inside a macro. Skip to the end of it. (c-end-of-macro) (cond ((<= (point) bound) t) (noerror nil) (t (signal 'search-failed (list regexp))))) ((and not-inside-token (or (< check-pos last-token-end-pos) (< check-pos (save-excursion (goto-char check-pos) (save-match-data (c-end-of-current-token last-token-end-pos)) (setq last-token-end-pos (point)))))) ;; Inside a token. (if lookbehind-submatch ;; See the NOTE above. (goto-char state-pos) (goto-char (min last-token-end-pos bound)))) (t ;; A real match. (setq found t) nil))) ;; Should loop to search again, but take care to avoid ;; looping on the same spot. (or (/= search-pos (point)) (if (= (point) bound) (if noerror nil (signal 'search-failed (list regexp))) (forward-char) t)))) (error (goto-char start) (signal (car err) (cdr err)))) ;;(message "c-syntactic-re-search-forward done %s" (or (match-end 0) (point))) (if found (progn (goto-char (match-end 0)) (match-end 0)) ;; Search failed. Set point as appropriate. (if (eq noerror t) (goto-char start) (goto-char bound)) nil))) (defun c-syntactic-skip-backward (skip-chars &optional limit paren-level) "Like `skip-chars-backward' but only look at syntactically relevant chars, i.e. don't stop at positions inside syntactic whitespace or string literals. Preprocessor directives are also ignored, with the exception of the one that the point starts within, if any. If LIMIT is given, it's assumed to be at a syntactically relevant position. If PAREN-LEVEL is non-nil, the function won't stop in nested paren sexps, and the search will also not go outside the current paren sexp. However, if LIMIT or the buffer limit is reached inside a nested paren then the point will be left at the limit. Non-nil is returned if the point moved, nil otherwise. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (let ((start (point)) state ;; A list of syntactically relevant positions in descending ;; order. It's used to avoid scanning repeatedly over ;; potentially large regions with `parse-partial-sexp' to verify ;; each position. safe-pos-list ;; The position at the beginning of `safe-pos-list'. safe-pos ;; The result from `c-beginning-of-macro' at the start position or the ;; start position itself if it isn't within a macro. Evaluated on ;; demand. start-macro-beg ;; The earliest position after the current one with the same paren ;; level. Used only when `paren-level' is set. (paren-level-pos (point))) (while (progn (while (and (< (skip-chars-backward skip-chars limit) 0) ;; Use `parse-partial-sexp' from a safe position down to ;; the point to check if it's outside comments and ;; strings. (let ((pos (point)) state-2 pps-end-pos) ;; Pick a safe position as close to the point as ;; possible. ;; ;; FIXME: Consult `syntax-ppss' here if our ;; cache doesn't give a good position. (while (and safe-pos-list (> (car safe-pos-list) (point))) (setq safe-pos-list (cdr safe-pos-list))) (unless (setq safe-pos (car-safe safe-pos-list)) (setq safe-pos (max (or (c-safe-position (point) (or c-state-cache (c-parse-state))) 0) (point-min)) safe-pos-list (list safe-pos))) ;; Cache positions along the way to use if we have to ;; back up more. We cache every closing paren on the ;; same level. If the paren cache is relevant in this ;; region then we're typically already on the same ;; level as the target position. Note that we might ;; cache positions after opening parens in case ;; safe-pos is in a nested list. That's both uncommon ;; and harmless. (while (progn (setq state (parse-partial-sexp safe-pos pos 0)) (< (point) pos)) (setq safe-pos (point) safe-pos-list (cons safe-pos safe-pos-list))) (cond ((or (elt state 3) (elt state 4)) ;; Inside string or comment. Continue search at the ;; beginning of it. (goto-char (elt state 8)) t) ((and paren-level (save-excursion (setq state-2 (parse-partial-sexp pos paren-level-pos -1) pps-end-pos (point)) (/= (car state-2) 0))) ;; Not at the right level. (if (and (< (car state-2) 0) ;; We stop above if we go out of a paren. ;; Now check whether it precedes or is ;; nested in the starting sexp. (save-excursion (setq state-2 (parse-partial-sexp pps-end-pos paren-level-pos nil nil state-2)) (< (car state-2) 0))) ;; We've stopped short of the starting position ;; so the hit was inside a nested list. Go up ;; until we are at the right level. (condition-case nil (progn (goto-char (scan-lists pos -1 (- (car state-2)))) (setq paren-level-pos (point)) (if (and limit (>= limit paren-level-pos)) (progn (goto-char limit) nil) t)) (error (goto-char (or limit (point-min))) nil)) ;; The hit was outside the list at the start ;; position. Go to the start of the list and exit. (goto-char (1+ (elt state-2 1))) nil)) ((c-beginning-of-macro limit) ;; Inside a macro. (if (< (point) (or start-macro-beg (setq start-macro-beg (save-excursion (goto-char start) (c-beginning-of-macro limit) (point))))) t ;; It's inside the same macro we started in so it's ;; a relevant match. (goto-char pos) nil))))) ;; If the state contains the start of the containing sexp we ;; cache that position too, so that parse-partial-sexp in the ;; next run has a bigger chance of starting at the same level ;; as the target position and thus will get more good safe ;; positions into the list. (if (elt state 1) (setq safe-pos (1+ (elt state 1)) safe-pos-list (cons safe-pos safe-pos-list)))) (> (point) (progn ;; Skip syntactic ws afterwards so that we don't stop at the ;; end of a comment if `skip-chars' is something like "^/". (c-backward-syntactic-ws) (point))))) ;; We might want to extend this with more useful return values in ;; the future. (/= (point) start))) ;; The following is an alternative implementation of ;; `c-syntactic-skip-backward' that uses backward movement to keep ;; track of the syntactic context. It turned out to be generally ;; slower than the one above which uses forward checks from earlier ;; safe positions. ;; ;;(defconst c-ssb-stop-re ;; ;; The regexp matching chars `c-syntactic-skip-backward' needs to ;; ;; stop at to avoid going into comments and literals. ;; (concat ;; ;; Match comment end syntax and string literal syntax. Also match ;; ;; '/' for block comment endings (not covered by comment end ;; ;; syntax). ;; "\\s>\\|/\\|\\s\"" ;; (if (memq 'gen-string-delim c-emacs-features) ;; "\\|\\s|" ;; "") ;; (if (memq 'gen-comment-delim c-emacs-features) ;; "\\|\\s!" ;; ""))) ;; ;;(defconst c-ssb-stop-paren-re ;; ;; Like `c-ssb-stop-re' but also stops at paren chars. ;; (concat c-ssb-stop-re "\\|\\s(\\|\\s)")) ;; ;;(defconst c-ssb-sexp-end-re ;; ;; Regexp matching the ending syntax of a complex sexp. ;; (concat c-string-limit-regexp "\\|\\s)")) ;; ;;(defun c-syntactic-skip-backward (skip-chars &optional limit paren-level) ;; "Like `skip-chars-backward' but only look at syntactically relevant chars, ;;i.e. don't stop at positions inside syntactic whitespace or string ;;literals. Preprocessor directives are also ignored. However, if the ;;point is within a comment, string literal or preprocessor directory to ;;begin with, its contents is treated as syntactically relevant chars. ;;If LIMIT is given, it limits the backward search and the point will be ;;left there if no earlier position is found. ;; ;;If PAREN-LEVEL is non-nil, the function won't stop in nested paren ;;sexps, and the search will also not go outside the current paren sexp. ;;However, if LIMIT or the buffer limit is reached inside a nested paren ;;then the point will be left at the limit. ;; ;;Non-nil is returned if the point moved, nil otherwise. ;; ;;Note that this function might do hidden buffer changes. See the ;;comment at the start of cc-engine.el for more info." ;; ;; (save-restriction ;; (when limit ;; (narrow-to-region limit (point-max))) ;; ;; (let ((start (point))) ;; (catch 'done ;; (while (let ((last-pos (point)) ;; (stop-pos (progn ;; (skip-chars-backward skip-chars) ;; (point)))) ;; ;; ;; Skip back over the same region as ;; ;; `skip-chars-backward' above, but keep to ;; ;; syntactically relevant positions. ;; (goto-char last-pos) ;; (while (and ;; ;; `re-search-backward' with a single char regexp ;; ;; should be fast. ;; (re-search-backward ;; (if paren-level c-ssb-stop-paren-re c-ssb-stop-re) ;; stop-pos 'move) ;; ;; (progn ;; (cond ;; ((looking-at "\\s(") ;; ;; `paren-level' is set and we've found the ;; ;; start of the containing paren. ;; (forward-char) ;; (throw 'done t)) ;; ;; ((looking-at c-ssb-sexp-end-re) ;; ;; We're at the end of a string literal or paren ;; ;; sexp (if `paren-level' is set). ;; (forward-char) ;; (condition-case nil ;; (c-backward-sexp) ;; (error ;; (goto-char limit) ;; (throw 'done t)))) ;; ;; (t ;; (forward-char) ;; ;; At the end of some syntactic ws or possibly ;; ;; after a plain '/' operator. ;; (let ((pos (point))) ;; (c-backward-syntactic-ws) ;; (if (= pos (point)) ;; ;; Was a plain '/' operator. Go past it. ;; (backward-char))))) ;; ;; (> (point) stop-pos)))) ;; ;; ;; Now the point is either at `stop-pos' or at some ;; ;; position further back if `stop-pos' was at a ;; ;; syntactically irrelevant place. ;; ;; ;; Skip additional syntactic ws so that we don't stop ;; ;; at the end of a comment if `skip-chars' is ;; ;; something like "^/". ;; (c-backward-syntactic-ws) ;; ;; (< (point) stop-pos)))) ;; ;; ;; We might want to extend this with more useful return values ;; ;; in the future. ;; (/= (point) start)))) ;; Tools for handling comments and string literals. (defun c-slow-in-literal (&optional lim detect-cpp) "Return the type of literal point is in, if any. The return value is `c' if in a C-style comment, `c++' if in a C++ style comment, `string' if in a string literal, `pound' if DETECT-CPP is non-nil and in a preprocessor line, or nil if somewhere else. Optional LIM is used as the backward limit of the search. If omitted, or nil, `c-beginning-of-defun' is used. The last point calculated is cached if the cache is enabled, i.e. if `c-in-literal-cache' is bound to a two element vector. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (if (and (vectorp c-in-literal-cache) (= (point) (aref c-in-literal-cache 0))) (aref c-in-literal-cache 1) (let ((rtn (save-excursion (let* ((pos (point)) (lim (or lim (progn (c-beginning-of-syntax) (point)))) (state (parse-partial-sexp lim pos))) (cond ((elt state 3) 'string) ((elt state 4) (if (elt state 7) 'c++ 'c)) ((and detect-cpp (c-beginning-of-macro lim)) 'pound) (t nil)))))) ;; cache this result if the cache is enabled (if (not c-in-literal-cache) (setq c-in-literal-cache (vector (point) rtn))) rtn))) ;; XEmacs has a built-in function that should make this much quicker. ;; I don't think we even need the cache, which makes our lives more ;; complicated anyway. In this case, lim is only used to detect ;; cpp directives. ;; ;; Note that there is a bug in Xemacs's buffer-syntactic-context when used in ;; conjunction with syntax-table-properties. The bug is present in, e.g., ;; Xemacs 21.4.4. It manifested itself thus: ;; ;; Starting with an empty AWK Mode buffer, type ;; /regexp/ { ;; Point gets wrongly left at column 0, rather than being indented to tab-width. ;; ;; AWK Mode is designed such that when the first / is typed, it gets the ;; syntax-table property "string fence". When the second / is typed, BOTH /s ;; are given the s-t property "string". However, buffer-syntactic-context ;; fails to take account of the change of the s-t property on the opening / to ;; "string", and reports that the { is within a string started by the second /. ;; ;; The workaround for this is for the AWK Mode initialisation to switch the ;; defalias for c-in-literal to c-slow-in-literal. This will slow down other ;; cc-modes in Xemacs whenever an awk-buffer has been initialised. ;; ;; (Alan Mackenzie, 2003/4/30). (defun c-fast-in-literal (&optional lim detect-cpp) ;; This function might do hidden buffer changes. (let ((context (buffer-syntactic-context))) (cond ((eq context 'string) 'string) ((eq context 'comment) 'c++) ((eq context 'block-comment) 'c) ((and detect-cpp (save-excursion (c-beginning-of-macro lim))) 'pound)))) (defalias 'c-in-literal (if (fboundp 'buffer-syntactic-context) 'c-fast-in-literal ; XEmacs 'c-slow-in-literal)) ; GNU Emacs ;; The defalias above isn't enough to shut up the byte compiler. (cc-bytecomp-defun c-in-literal) (defun c-literal-limits (&optional lim near not-in-delimiter) "Return a cons of the beginning and end positions of the comment or string surrounding point (including both delimiters), or nil if point isn't in one. If LIM is non-nil, it's used as the \"safe\" position to start parsing from. If NEAR is non-nil, then the limits of any literal next to point is returned. \"Next to\" means there's only spaces and tabs between point and the literal. The search for such a literal is done first in forward direction. If NOT-IN-DELIMITER is non-nil, the case when point is inside a starting delimiter won't be recognized. This only has effect for comments, which have starting delimiters with more than one character. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-excursion (let* ((pos (point)) (lim (or lim (progn (c-beginning-of-syntax) (point)))) (state (parse-partial-sexp lim pos))) (cond ((elt state 3) ; String. (goto-char (elt state 8)) (cons (point) (or (c-safe (c-forward-sexp 1) (point)) (point-max)))) ((elt state 4) ; Comment. (goto-char (elt state 8)) (cons (point) (progn (c-forward-single-comment) (point)))) ((and (not not-in-delimiter) (not (elt state 5)) (eq (char-before) ?/) (looking-at "[/*]")) ;; We're standing in a comment starter. (backward-char 1) (cons (point) (progn (c-forward-single-comment) (point)))) (near (goto-char pos) ;; Search forward for a literal. (skip-chars-forward " \t") (cond ((looking-at c-string-limit-regexp) ; String. (cons (point) (or (c-safe (c-forward-sexp 1) (point)) (point-max)))) ((looking-at c-comment-start-regexp) ; Line or block comment. (cons (point) (progn (c-forward-single-comment) (point)))) (t ;; Search backward. (skip-chars-backward " \t") (let ((end (point)) beg) (cond ((save-excursion (< (skip-syntax-backward c-string-syntax) 0)) ; String. (setq beg (c-safe (c-backward-sexp 1) (point)))) ((and (c-safe (forward-char -2) t) (looking-at "*/")) ;; Block comment. Due to the nature of line ;; comments, they will always be covered by the ;; normal case above. (goto-char end) (c-backward-single-comment) ;; If LIM is bogus, beg will be bogus. (setq beg (point)))) (if beg (cons beg end)))))) )))) ;; In case external callers use this; it did have a docstring. (defalias 'c-literal-limits-fast 'c-literal-limits) (defun c-collect-line-comments (range) "If the argument is a cons of two buffer positions (such as returned by `c-literal-limits'), and that range contains a C++ style line comment, then an extended range is returned that contains all adjacent line comments (i.e. all comments that starts in the same column with no empty lines or non-whitespace characters between them). Otherwise the argument is returned. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-excursion (condition-case nil (if (and (consp range) (progn (goto-char (car range)) (looking-at c-line-comment-starter))) (let ((col (current-column)) (beg (point)) (bopl (c-point 'bopl)) (end (cdr range))) ;; Got to take care in the backward direction to handle ;; comments which are preceded by code. (while (and (c-backward-single-comment) (>= (point) bopl) (looking-at c-line-comment-starter) (= col (current-column))) (setq beg (point) bopl (c-point 'bopl))) (goto-char end) (while (and (progn (skip-chars-forward " \t") (looking-at c-line-comment-starter)) (= col (current-column)) (prog1 (zerop (forward-line 1)) (setq end (point))))) (cons beg end)) range) (error range)))) (defun c-literal-type (range) "Convenience function that given the result of `c-literal-limits', returns nil or the type of literal that the range surrounds. It's much faster than using `c-in-literal' and is intended to be used when you need both the type of a literal and its limits. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (if (consp range) (save-excursion (goto-char (car range)) (cond ((looking-at c-string-limit-regexp) 'string) ((or (looking-at "//") ; c++ line comment (and (looking-at "\\s<") ; comment starter (looking-at "#"))) ; awk comment. 'c++) (t 'c))) ; Assuming the range is valid. range)) ;; `c-find-decl-spots' and accompanying stuff. ;; Variables used in `c-find-decl-spots' to cache the search done for ;; the first declaration in the last call. When that function starts, ;; it needs to back up over syntactic whitespace to look at the last ;; token before the region being searched. That can sometimes cause ;; moves back and forth over a quite large region of comments and ;; macros, which would be repeated for each changed character when ;; we're called during fontification, since font-lock refontifies the ;; current line for each change. Thus it's worthwhile to cache the ;; first match. ;; ;; `c-find-decl-syntactic-pos' is a syntactically relevant position in ;; the syntactic whitespace less or equal to some start position. ;; There's no cached value if it's nil. ;; ;; `c-find-decl-match-pos' is the match position if ;; `c-find-decl-prefix-search' matched before the syntactic whitespace ;; at `c-find-decl-syntactic-pos', or nil if there's no such match. (defvar c-find-decl-syntactic-pos nil) (make-variable-buffer-local 'c-find-decl-syntactic-pos) (defvar c-find-decl-match-pos nil) (make-variable-buffer-local 'c-find-decl-match-pos) (defsubst c-invalidate-find-decl-cache (change-min-pos) (and c-find-decl-syntactic-pos (< change-min-pos c-find-decl-syntactic-pos) (setq c-find-decl-syntactic-pos nil))) ; (defface c-debug-decl-spot-face ; '((t (:background "Turquoise"))) ; "Debug face to mark the spots where `c-find-decl-spots' stopped.") ; (defface c-debug-decl-sws-face ; '((t (:background "Khaki"))) ; "Debug face to mark the syntactic whitespace between the declaration ; spots and the preceding token end.") (defmacro c-debug-put-decl-spot-faces (match-pos decl-pos) (when (facep 'c-debug-decl-spot-face) `(c-save-buffer-state ((match-pos ,match-pos) (decl-pos ,decl-pos)) (c-debug-add-face (max match-pos (point-min)) decl-pos 'c-debug-decl-sws-face) (c-debug-add-face decl-pos (min (1+ decl-pos) (point-max)) 'c-debug-decl-spot-face)))) (defmacro c-debug-remove-decl-spot-faces (beg end) (when (facep 'c-debug-decl-spot-face) `(c-save-buffer-state () (c-debug-remove-face ,beg ,end 'c-debug-decl-spot-face) (c-debug-remove-face ,beg ,end 'c-debug-decl-sws-face)))) (defmacro c-find-decl-prefix-search () ;; Macro used inside `c-find-decl-spots'. It ought to be a defun, ;; but it contains lots of free variables that refer to things ;; inside `c-find-decl-spots'. The point is left at `cfd-match-pos' ;; if there is a match, otherwise at `cfd-limit'. ;; ;; This macro might do hidden buffer changes. '(progn ;; Find the next property match position if we haven't got one already. (unless cfd-prop-match (save-excursion (while (progn (goto-char (next-single-property-change (point) 'c-type nil cfd-limit)) (and (< (point) cfd-limit) (not (eq (c-get-char-property (1- (point)) 'c-type) 'c-decl-end))))) (setq cfd-prop-match (point)))) ;; Find the next `c-decl-prefix-or-start-re' match if we haven't ;; got one already. (unless cfd-re-match (if (> cfd-re-match-end (point)) (goto-char cfd-re-match-end)) (while (if (setq cfd-re-match-end (re-search-forward c-decl-prefix-or-start-re cfd-limit 'move)) ;; Match. Check if it's inside a comment or string literal. (c-got-face-at (if (setq cfd-re-match (match-end 1)) ;; Matched the end of a token preceding a decl spot. (progn (goto-char cfd-re-match) (1- cfd-re-match)) ;; Matched a token that start a decl spot. (goto-char (match-beginning 0)) (point)) c-literal-faces) ;; No match. Finish up and exit the loop. (setq cfd-re-match cfd-limit) nil) ;; Skip out of comments and string literals. (while (progn (goto-char (next-single-property-change (point) 'face nil cfd-limit)) (and (< (point) cfd-limit) (c-got-face-at (point) c-literal-faces))))) ;; If we matched at the decl start, we have to back up over the ;; preceding syntactic ws to set `cfd-match-pos' and to catch ;; any decl