(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)))
(eval-when-compile (require 'cl)) (cc-external-require 'regexp-opt)
(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) (cc-bytecomp-defun buffer-syntactic-context-depth) (cc-bytecomp-defun region-active-p) (cc-bytecomp-defvar zmacs-region-stays) (cc-bytecomp-defvar zmacs-regions) (cc-bytecomp-defvar mark-active) (cc-bytecomp-defvar deactivate-mark) (cc-bytecomp-defvar inhibit-point-motion-hooks) (cc-bytecomp-defvar parse-sexp-lookup-properties) (cc-bytecomp-defvar text-property-default-nonsticky) (cc-bytecomp-defvar lookup-syntax-properties) (cc-bytecomp-defun string-to-syntax)
(eval-and-compile
(if (or (/= (regexp-opt-depth "\\(\\(\\)\\)") 2)
(not (fboundp 'push)))
(cc-load "cc-fix")))
(if (and (not (featurep 'cc-fix)) (featurep 'xemacs) (let (font-lock-keywords)
(font-lock-compile-keywords '("\\<\\>"))
font-lock-keywords)) (load "cc-fix"))
(eval-when-compile
(if (and (not (featurep 'cc-fix))
(featurep 'xemacs)
(progn
(require 'font-lock)
(let (font-lock-keywords)
(font-lock-compile-keywords '("\\<\\>"))
font-lock-keywords)))
(cc-load "cc-fix")))
(defconst c-version "5.31.4"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
(defvar c-buffer-is-cc-mode nil
"Non-nil for all buffers with a major mode derived from CC Mode.
Otherwise, this variable is nil. I.e. this variable is non-nil for
`c-mode', `c++-mode', `objc-mode', `java-mode', `idl-mode',
`pike-mode', `awk-mode', and any other non-CC Mode mode that calls
`c-initialize-cc-mode'. The value is the mode symbol itself
\(i.e. `c-mode' etc) of the original CC Mode mode, or just t if it's
not known.")
(make-variable-buffer-local 'c-buffer-is-cc-mode)
(put 'c-buffer-is-cc-mode 'permanent-local t)
(eval-and-compile
(defvar c-inside-eval-when-compile nil)
(defmacro cc-eval-when-compile (&rest body)
"Like `progn', but evaluates the body at compile time.
The result of the body appears to the compiler as a quoted constant.
This variant works around bugs in `eval-when-compile' in various
\(X)Emacs versions. See cc-defs.el for details."
(if c-inside-eval-when-compile
`(progn ,@body)
`(eval-when-compile
(eval '(let ((c-inside-eval-when-compile t)) ,@body)))))
(put 'cc-eval-when-compile 'lisp-indent-hook 0))
(defmacro c-point (position &optional point)
"Return the value of certain commonly referenced POSITIONs relative to POINT.
The current point is used if POINT isn't specified. POSITION can be
one of the following symbols:
`bol' -- beginning of line
`eol' -- end of line
`bod' -- beginning of defun
`eod' -- end of defun
`boi' -- beginning of indentation
`ionl' -- indentation of next line
`iopl' -- indentation of previous line
`bonl' -- beginning of next line
`eonl' -- end of next line
`bopl' -- beginning of previous line
`eopl' -- end of previous line
`bosws' -- beginning of syntactic whitespace
`eosws' -- end of syntactic whitespace
If the referenced position doesn't exist, the closest accessible point
to it is returned. This function does not modify the point or the mark."
(if (eq (car-safe position) 'quote)
(let ((position (eval position)))
(cond
((eq position 'bol)
(if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point))
`(line-beginning-position)
`(save-excursion
,@(if point `((goto-char ,point)))
(beginning-of-line)
(point))))
((eq position 'eol)
(if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
`(line-end-position)
`(save-excursion
,@(if point `((goto-char ,point)))
(end-of-line)
(point))))
((eq position 'boi)
`(save-excursion
,@(if point `((goto-char ,point)))
(back-to-indentation)
(point)))
((eq position 'bod)
`(save-excursion
,@(if point `((goto-char ,point)))
(c-beginning-of-defun-1)
(point)))
((eq position 'eod)
`(save-excursion
,@(if point `((goto-char ,point)))
(c-end-of-defun-1)
(point)))
((eq position 'bopl)
(if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point))
`(line-beginning-position 0)
`(save-excursion
,@(if point `((goto-char ,point)))
(forward-line -1)
(point))))
((eq position 'bonl)
(if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point))
`(line-beginning-position 2)
`(save-excursion
,@(if point `((goto-char ,point)))
(forward-line 1)
(point))))
((eq position 'eopl)
(if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
`(line-end-position 0)
`(save-excursion
,@(if point `((goto-char ,point)))
(beginning-of-line)
(or (bobp) (backward-char))
(point))))
((eq position 'eonl)
(if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
`(line-end-position 2)
`(save-excursion
,@(if point `((goto-char ,point)))
(forward-line 1)
(end-of-line)
(point))))
((eq position 'iopl)
`(save-excursion
,@(if point `((goto-char ,point)))
(forward-line -1)
(back-to-indentation)
(point)))
((eq position 'ionl)
`(save-excursion
,@(if point `((goto-char ,point)))
(forward-line 1)
(back-to-indentation)
(point)))
((eq position 'bosws)
`(save-excursion
,@(if point `((goto-char ,point)))
(c-backward-syntactic-ws)
(point)))
((eq position 'eosws)
`(save-excursion
,@(if point `((goto-char ,point)))
(c-forward-syntactic-ws)
(point)))
(t (error "Unknown buffer position requested: %s" position))))
(message "Warning: c-point long expansion")
`(save-excursion
,@(if point `((goto-char ,point)))
(let ((position ,position))
(cond
((eq position 'bol) (beginning-of-line))
((eq position 'eol) (end-of-line))
((eq position 'boi) (back-to-indentation))
((eq position 'bod) (c-beginning-of-defun-1))
((eq position 'eod) (c-end-of-defun-1))
((eq position 'bopl) (forward-line -1))
((eq position 'bonl) (forward-line 1))
((eq position 'eopl) (progn
(beginning-of-line)
(or (bobp) (backward-char))))
((eq position 'eonl) (progn
(forward-line 1)
(end-of-line)))
((eq position 'iopl) (progn
(forward-line -1)
(back-to-indentation)))
((eq position 'ionl) (progn
(forward-line 1)
(back-to-indentation)))
((eq position 'bosws) (c-backward-syntactic-ws))
((eq position 'eosws) (c-forward-syntactic-ws))
(t (error "Unknown buffer position requested: %s" position))))
(point))))
(defmacro c-region-is-active-p ()
(if (cc-bytecomp-fboundp 'region-active-p)
'(region-active-p)
'mark-active))
(defmacro c-set-region-active (activate)
(if (cc-bytecomp-fboundp 'zmacs-activate-region)
`(if ,activate
(zmacs-activate-region)
(zmacs-deactivate-region))
`(setq mark-active ,activate)))
(defmacro c-delete-and-extract-region (start end)
"Delete the text between START and END and return it."
(if (cc-bytecomp-fboundp 'delete-and-extract-region)
`(delete-and-extract-region ,start ,end)
`(prog1
(buffer-substring ,start ,end)
(delete-region ,start ,end))))
(defmacro c-safe (&rest body)
`(condition-case nil
(progn ,@body)
(error nil)))
(put 'c-safe 'lisp-indent-function 0)
(defmacro c-int-to-char (integer)
(if (fboundp 'int-to-char)
`(int-to-char ,integer)
integer))
(defmacro c-sentence-end ()
(if (cc-bytecomp-fboundp 'sentence-end)
`(sentence-end)
`sentence-end))
(defmacro c-default-value-sentence-end ()
(if (cc-bytecomp-fboundp 'sentence-end)
`(let (sentence-end) (sentence-end))
`(default-value 'sentence-end)))
(defmacro c-save-buffer-state (varlist &rest body)
"Bind variables according to VARLIST (in `let*' style) and eval BODY,
then restore the buffer state under the assumption that no significant
modification has been made in BODY. A change is considered
significant if it affects the buffer text in any way that isn't
completely restored again. Changes in text properties like `face' or
`syntax-table' are considered insignificant. This macro allows text
properties to be changed, even in a read-only buffer.
This macro should be placed around all calculations which set
\"insignificant\" text properties in a buffer, even when the buffer is
known to be writeable. That way, these text properties remain set
even if the user undoes the command which set them.
This macro should ALWAYS be placed around \"temporary\" internal buffer
changes \(like adding a newline to calculate a text-property then
deleting it again\), so that the user never sees them on his
`buffer-undo-list'. See also `c-tentative-buffer-changes'.
However, any user-visible changes to the buffer \(like auto-newlines\)
must not be within a `c-save-buffer-state', since the user then
wouldn't be able to undo them.
The return value is the value of the last form in BODY."
`(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
before-change-functions after-change-functions
deactivate-mark
,@varlist)
(unwind-protect
(progn ,@body)
(and (not modified)
(buffer-modified-p)
(set-buffer-modified-p nil)))))
(put 'c-save-buffer-state 'lisp-indent-function 1)
(defmacro c-tentative-buffer-changes (&rest body)
"Eval BODY and optionally restore the buffer contents to the state it
was in before BODY. Any changes are kept if the last form in BODY
returns non-nil. Otherwise it's undone using the undo facility, and
various other buffer state that might be affected by the changes is
restored. That includes the current buffer, point, mark, mark
activation \(similar to `save-excursion'), and the modified state.
The state is also restored if BODY exits nonlocally.
If BODY makes a change that unconditionally is undone then wrap this
macro inside `c-save-buffer-state'. That way the change can be done
even when the buffer is read-only, and without interference from
various buffer change hooks."
`(let (-tnt-chng-keep
-tnt-chng-state)
(unwind-protect
(setq buffer-undo-list (cons nil buffer-undo-list)
-tnt-chng-state (c-tnt-chng-record-state)
-tnt-chng-keep (progn ,@body))
(c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state))))
(put 'c-tentative-buffer-changes 'lisp-indent-function 0)
(defun c-tnt-chng-record-state ()
(vector buffer-undo-list (current-buffer) (point) (mark t) (c-region-is-active-p) (buffer-modified-p)))
(defun c-tnt-chng-cleanup (keep saved-state)
(let ((saved-undo-list (elt saved-state 0)))
(if (eq buffer-undo-list saved-undo-list)
(setq buffer-undo-list (cdr saved-undo-list))
(if keep
(let ((p buffer-undo-list))
(while (not (eq (cdr p) saved-undo-list))
(setq p (cdr p)))
(setcdr p (cdr saved-undo-list)))
(setq saved-undo-list (cdr saved-undo-list))
(let ((undo-in-progress t))
(while (not (eq (setq buffer-undo-list
(primitive-undo 1 buffer-undo-list))
saved-undo-list))))
(when (buffer-live-p (elt saved-state 1))
(set-buffer (elt saved-state 1))
(goto-char (elt saved-state 2))
(set-mark (elt saved-state 3))
(c-set-region-active (elt saved-state 4))
(and (not (elt saved-state 5))
(buffer-modified-p)
(set-buffer-modified-p nil)))))))
(defmacro c-forward-syntactic-ws (&optional limit)
"Forward skip over syntactic whitespace.
Syntactic whitespace is defined as whitespace characters, comments,
and preprocessor directives. However if point starts inside a comment
or preprocessor directive, the content of it is not treated as
whitespace.
LIMIT sets an upper limit of the forward movement, if specified. If
LIMIT or the end of the buffer is reached inside a comment or
preprocessor directive, the point will be left there.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(if limit
`(save-restriction
(narrow-to-region (point-min) (or ,limit (point-max)))
(c-forward-sws))
'(c-forward-sws)))
(defmacro c-backward-syntactic-ws (&optional limit)
"Backward skip over syntactic whitespace.
Syntactic whitespace is defined as whitespace characters, comments,
and preprocessor directives. However if point starts inside a comment
or preprocessor directive, the content of it is not treated as
whitespace.
LIMIT sets a lower limit of the backward movement, if specified. If
LIMIT is reached inside a line comment or preprocessor directive then
the point is moved into it past the whitespace at the end.
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(if limit
`(save-restriction
(narrow-to-region (or ,limit (point-min)) (point-max))
(c-backward-sws))
'(c-backward-sws)))
(defmacro c-forward-sexp (&optional count)
"Move forward across COUNT balanced expressions.
A negative COUNT means move backward. Signal an error if the move
fails for any reason.
This is like `forward-sexp' except that it isn't interactive and does
not do any user friendly adjustments of the point and that it isn't
susceptible to user configurations such as disabling of signals in
certain situations."
(or count (setq count 1))
`(goto-char (scan-sexps (point) ,count)))
(defmacro c-backward-sexp (&optional count)
"See `c-forward-sexp' and reverse directions."
(or count (setq count 1))
`(c-forward-sexp ,(if (numberp count) (- count) `(- ,count))))
(defmacro c-safe-scan-lists (from count depth &optional limit)
"Like `scan-lists' but returns nil instead of signalling errors
for unbalanced parens.
A limit for the search may be given. FROM is assumed to be on the
right side of it."
(let ((res (if (featurep 'xemacs)
`(scan-lists ,from ,count ,depth nil t)
`(c-safe (scan-lists ,from ,count ,depth)))))
(if limit
`(save-restriction
,(if (numberp count)
(if (< count 0)
`(narrow-to-region ,limit (point-max))
`(narrow-to-region (point-min) ,limit))
`(if (< ,count 0)
(narrow-to-region ,limit (point-max))
(narrow-to-region (point-min) ,limit)))
,res)
res)))
(defmacro c-go-list-forward ()
"Move backward across one balanced group of parentheses.
Return POINT when we succeed, NIL when we fail. In the latter case, leave
point unmoved."
`(c-safe (let ((endpos (scan-lists (point) 1 0)))
(goto-char endpos)
endpos)))
(defmacro c-go-list-backward ()
"Move backward across one balanced group of parentheses.
Return POINT when we succeed, NIL when we fail. In the latter case, leave
point unmoved."
`(c-safe (let ((endpos (scan-lists (point) -1 0)))
(goto-char endpos)
endpos)))
(defmacro c-up-list-forward (&optional pos limit)
"Return the first position after the list sexp containing POS,
or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be before it."
`(c-safe-scan-lists ,(or pos `(point)) 1 1 ,limit))
(defmacro c-up-list-backward (&optional pos limit)
"Return the position of the start of the list sexp containing POS,
or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be after it."
`(c-safe-scan-lists ,(or pos `(point)) -1 1 ,limit))
(defmacro c-down-list-forward (&optional pos limit)
"Return the first position inside the first list sexp after POS,
or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be before it."
`(c-safe-scan-lists ,(or pos `(point)) 1 -1 ,limit))
(defmacro c-down-list-backward (&optional pos limit)
"Return the last position inside the last list sexp before POS,
or nil if no such position exists. The point is used if POS is left out.
A limit for the search may be given. The start position is assumed to
be after it."
`(c-safe-scan-lists ,(or pos `(point)) -1 -1 ,limit))
(defmacro c-go-up-list-forward (&optional pos limit)
"Move the point to the first position after the list sexp containing POS,
or containing the point if POS is left out. Return t if such a
position exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be before it."
(let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 1)) t)))
(if limit
`(save-restriction
(narrow-to-region (point-min) ,limit)
,res)
res)))
(defmacro c-go-up-list-backward (&optional pos limit)
"Move the point to the position of the start of the list sexp containing POS,
or containing the point if POS is left out. Return t if such a
position exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be after it."
(let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 1)) t)))
(if limit
`(save-restriction
(narrow-to-region ,limit (point-max))
,res)
res)))
(defmacro c-go-down-list-forward (&optional pos limit)
"Move the point to the first position inside the first list sexp after POS,
or before the point if POS is left out. Return t if such a position
exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be before it."
(let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 -1)) t)))
(if limit
`(save-restriction
(narrow-to-region (point-min) ,limit)
,res)
res)))
(defmacro c-go-down-list-backward (&optional pos limit)
"Move the point to the last position inside the last list sexp before POS,
or before the point if POS is left out. Return t if such a position
exists, otherwise nil is returned and the point isn't moved.
A limit for the search may be given. The start position is assumed to
be after it."
(let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 -1)) t)))
(if limit
`(save-restriction
(narrow-to-region ,limit (point-max))
,res)
res)))
(defmacro c-beginning-of-defun-1 ()
`(progn
(if (and ,(cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
c-enable-xemacs-performance-kludge-p)
,(when (cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
'(let (beginning-of-defun-function end-of-defun-function
pos)
(while (not pos)
(save-restriction
(widen)
(setq pos (c-safe-scan-lists
(point) -1 (buffer-syntactic-context-depth))))
(cond
((bobp) (setq pos (point-min)))
((not pos)
(let ((distance (skip-chars-backward "^{")))
(when (zerop distance)
(beginning-of-defun)
(setq pos (point)))))
((= pos 0))
((not (eq (char-after pos) ?{))
(goto-char pos)
(setq pos nil))
))
(goto-char pos)))
(let (beginning-of-defun-function end-of-defun-function)
(beginning-of-defun)))
(and defun-prompt-regexp
(looking-at defun-prompt-regexp)
(goto-char (match-end 0)))))
(defmacro c-at-vsemi-p (&optional pos)
`(if c-at-vsemi-p-fn
(funcall c-at-vsemi-p-fn ,@(if pos `(,pos)))))
(defmacro c-vsemi-status-unknown-p ()
`(if c-vsemi-status-unknown-p-fn (funcall c-vsemi-status-unknown-p-fn)))
(defmacro c-benign-error (format &rest args)
`(progn
(message ,format ,@args)
(ding)))
(defmacro c-with-syntax-table (table &rest code)
`(let ((c-with-syntax-table-orig-table (syntax-table)))
(unwind-protect
(progn
(set-syntax-table ,table)
,@code)
(set-syntax-table c-with-syntax-table-orig-table))))
(put 'c-with-syntax-table 'lisp-indent-function 1)
(defmacro c-skip-ws-forward (&optional limit)
"Skip over any whitespace following point.
This function skips over horizontal and vertical whitespace and line
continuations."
(if limit
`(let ((limit (or ,limit (point-max))))
(while (progn
(skip-chars-forward " \t\n\r\f\v" limit)
(when (and (eq (char-after) ?\\)
(< (point) limit))
(forward-char)
(or (eolp)
(progn (backward-char) nil))))))
'(while (progn
(skip-chars-forward " \t\n\r\f\v")
(when (eq (char-after) ?\\)
(forward-char)
(or (eolp)
(progn (backward-char) nil)))))))
(defmacro c-skip-ws-backward (&optional limit)
"Skip over any whitespace preceding point.
This function skips over horizontal and vertical whitespace and line
continuations."
(if limit
`(let ((limit (or ,limit (point-min))))
(while (progn
(skip-chars-backward " \t\n\r\f\v" limit)
(and (eolp)
(eq (char-before) ?\\)
(> (point) limit)))
(backward-char)))
'(while (progn
(skip-chars-backward " \t\n\r\f\v")
(and (eolp)
(eq (char-before) ?\\)))
(backward-char))))
(eval-and-compile
(defvar c-langs-are-parametric nil))
(defmacro c-major-mode-is (mode)
"Return non-nil if the current CC Mode major mode is MODE.
MODE is either a mode symbol or a list of mode symbols."
(if c-langs-are-parametric
`(c-lang-major-mode-is ,mode)
(if (eq (car-safe mode) 'quote)
(let ((mode (eval mode)))
(if (listp mode)
`(memq c-buffer-is-cc-mode ',mode)
`(eq c-buffer-is-cc-mode ',mode)))
`(let ((mode ,mode))
(if (listp mode)
(memq c-buffer-is-cc-mode mode)
(eq c-buffer-is-cc-mode mode))))))
(eval-and-compile
(defconst c-use-extents (and (cc-bytecomp-fboundp 'extent-at)
(cc-bytecomp-fboundp 'set-extent-property)
(cc-bytecomp-fboundp 'set-extent-properties)
(cc-bytecomp-fboundp 'make-extent)
(cc-bytecomp-fboundp 'extent-property)
(cc-bytecomp-fboundp 'delete-extent)
(cc-bytecomp-fboundp 'map-extents))))
(defalias 'c-put-char-property-fun
(cc-eval-when-compile
(cond (c-use-extents
(byte-compile
(lambda (pos property value)
(let ((ext (extent-at pos nil property)))
(if ext
(set-extent-property ext property value)
(set-extent-properties (make-extent pos (1+ pos))
(cons property
(cons value
'(start-open t
end-open t)))))))))
((not (cc-bytecomp-boundp 'text-property-default-nonsticky))
(byte-compile
(lambda (pos property value)
(put-text-property pos (1+ pos) property value)
(let ((prop (get-text-property pos 'rear-nonsticky)))
(or (memq property prop)
(put-text-property pos (1+ pos)
'rear-nonsticky
(cons property prop))))))))))
(cc-bytecomp-defun c-put-char-property-fun)
(defmacro c-put-char-property (pos property value)
(setq property (eval property))
(if (or c-use-extents
(not (cc-bytecomp-boundp 'text-property-default-nonsticky)))
`(c-put-char-property-fun ,pos ',property ,value)
`(let ((-pos- ,pos))
(put-text-property -pos- (1+ -pos-) ',property ,value))))
(defmacro c-get-char-property (pos property)
(setq property (eval property))
(if c-use-extents
`(let ((ext (extent-at ,pos nil ',property)))
(if ext (extent-property ext ',property)))
`(get-text-property ,pos ',property)))
(defalias 'c-clear-char-property-fun
(cc-eval-when-compile
(unless (or c-use-extents
(cc-bytecomp-boundp 'text-property-default-nonsticky))
(byte-compile
(lambda (pos property)
(when (get-text-property pos property)
(remove-text-properties pos (1+ pos) (list property nil))
(put-text-property pos (1+ pos)
'rear-nonsticky
(delq property (get-text-property
pos 'rear-nonsticky)))))))))
(cc-bytecomp-defun c-clear-char-property-fun)
(defmacro c-clear-char-property (pos property)
(setq property (eval property))
(cond (c-use-extents
`(let ((ext (extent-at ,pos nil ',property)))
(if ext (delete-extent ext))))
((cc-bytecomp-boundp 'text-property-default-nonsticky)
`(let ((pos ,pos))
(remove-text-properties pos (1+ pos)
'(,property nil))))
(t
`(c-clear-char-property-fun ,pos ',property))))
(defmacro c-clear-char-properties (from to property)
(setq property (eval property))
(if c-use-extents
`(map-extents (lambda (ext ignored)
(delete-extent ext))
nil ,from ,to nil nil ',property)
`(remove-text-properties ,from ,to '(,property nil))))
(defmacro c-put-overlay (from to property value)
(if (cc-bytecomp-fboundp 'make-overlay)
`(let ((ol (make-overlay ,from ,to)))
(overlay-put ol ,property ,value)
ol)
`(let ((ext (make-extent ,from ,to)))
(set-extent-property ext ,property ,value)
ext)))
(defmacro c-delete-overlay (overlay)
(if (cc-bytecomp-fboundp 'make-overlay)
`(delete-overlay ,overlay)
`(delete-extent ,overlay)))
(def-edebug-spec cc-eval-when-compile t)
(def-edebug-spec c-point t)
(def-edebug-spec c-set-region-active t)
(def-edebug-spec c-safe t)
(def-edebug-spec c-save-buffer-state let*)
(def-edebug-spec c-tentative-buffer-changes t)
(def-edebug-spec c-forward-syntactic-ws t)
(def-edebug-spec c-backward-syntactic-ws t)
(def-edebug-spec c-forward-sexp t)
(def-edebug-spec c-backward-sexp t)
(def-edebug-spec c-up-list-forward t)
(def-edebug-spec c-up-list-backward t)
(def-edebug-spec c-down-list-forward t)
(def-edebug-spec c-down-list-backward t)
(def-edebug-spec c-add-syntax t)
(def-edebug-spec c-add-class-syntax t)
(def-edebug-spec c-benign-error t)
(def-edebug-spec c-with-syntax-table t)
(def-edebug-spec c-skip-ws-forward t)
(def-edebug-spec c-skip-ws-backward t)
(def-edebug-spec c-major-mode-is t)
(def-edebug-spec c-put-char-property t)
(def-edebug-spec c-get-char-property t)
(def-edebug-spec c-clear-char-property t)
(def-edebug-spec c-clear-char-properties t)
(def-edebug-spec c-put-overlay t)
(def-edebug-spec c-delete-overlay t)
(defsubst c-end-of-defun-1 ()
(let ((start (point)))
(skip-chars-forward "^}")
(c-beginning-of-defun-1)
(if (eq (char-after) ?{)
(c-forward-sexp))
(if (< (point) start)
(goto-char (point-max)))))
(defconst c-<-as-paren-syntax '(4 . ?>))
(defsubst c-mark-<-as-paren (pos)
(c-put-char-property pos 'syntax-table c-<-as-paren-syntax))
(defconst c->-as-paren-syntax '(5 . ?<))
(defsubst c-mark->-as-paren (pos)
(c-put-char-property pos 'syntax-table c->-as-paren-syntax))
(defsubst c-intersect-lists (list alist)
(let (match)
(while (and list
(not (setq match (assq (car list) alist))))
(setq list (cdr list)))
match))
(defsubst c-lookup-lists (list alist1 alist2)
(assq (car (c-intersect-lists list alist1)) alist2))
(defsubst c-langelem-sym (langelem)
"Return the syntactic symbol in LANGELEM.
LANGELEM is either a cons cell on the \"old\" form given as the first
argument to lineup functions or a syntactic element on the \"new\"
form as used in `c-syntactic-element'."
(car langelem))
(defsubst c-langelem-pos (langelem)
"Return the anchor position in LANGELEM, or nil if there is none.
LANGELEM is either a cons cell on the \"old\" form given as the first
argument to lineup functions or a syntactic element on the \"new\"
form as used in `c-syntactic-element'."
(if (consp (cdr langelem))
(car-safe (cdr langelem))
(cdr langelem)))
(defun c-langelem-col (langelem &optional preserve-point)
"Return the column of the anchor position in LANGELEM.
Also move the point to that position unless PRESERVE-POINT is non-nil.
LANGELEM is either a cons cell on the \"old\" form given as the first
argument to lineup functions or a syntactic element on the \"new\"
form as used in `c-syntactic-element'."
(let ((pos (c-langelem-pos langelem))
(here (point)))
(if pos
(progn
(goto-char pos)
(prog1 (current-column)
(if preserve-point
(goto-char here))))
0)))
(defsubst c-langelem-2nd-pos (langelem)
"Return the secondary position in LANGELEM, or nil if there is none.
LANGELEM is typically a syntactic element on the \"new\" form as used
in `c-syntactic-element'. It may also be a cons cell as passed in the
first argument to lineup functions, but then the returned value always
will be nil."
(car-safe (cdr-safe (cdr-safe langelem))))
(defsubst c-keep-region-active ()
(and (boundp 'zmacs-region-stays)
(setq zmacs-region-stays t)))
(put 'c-mode 'c-mode-prefix "c-")
(put 'c++-mode 'c-mode-prefix "c++-")
(put 'objc-mode 'c-mode-prefix "objc-")
(put 'java-mode 'c-mode-prefix "java-")
(put 'idl-mode 'c-mode-prefix "idl-")
(put 'pike-mode 'c-mode-prefix "pike-")
(put 'awk-mode 'c-mode-prefix "awk-")
(defsubst c-mode-symbol (suffix)
"Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
the corresponding symbol."
(or c-buffer-is-cc-mode
(error "Not inside a CC Mode based mode"))
(let ((mode-prefix (get c-buffer-is-cc-mode 'c-mode-prefix)))
(or mode-prefix
(error "%S has no mode prefix known to `c-mode-symbol'"
c-buffer-is-cc-mode))
(intern (concat mode-prefix suffix))))
(defsubst c-mode-var (suffix)
"Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
the value of the variable with that name."
(symbol-value (c-mode-symbol suffix)))
(defsubst c-got-face-at (pos faces)
"Return non-nil if position POS in the current buffer has any of the
faces in the list FACES."
(let ((pos-faces (get-text-property pos 'face)))
(if (consp pos-faces)
(progn
(while (and pos-faces
(not (memq (car pos-faces) faces)))
(setq pos-faces (cdr pos-faces)))
pos-faces)
(memq pos-faces faces))))
(defsubst c-face-name-p (facename)
(memq facename (face-list)))
(defun c-concat-separated (list separator)
"Like `concat' on LIST, but separate each element with SEPARATOR.
Notably, null elements in LIST are ignored."
(mapconcat 'identity (delete nil (append list nil)) separator))
(defun c-make-keywords-re (adorn list &optional mode)
"Make a regexp that matches all the strings the list.
Duplicates and nil elements in the list are removed. The resulting
regexp may contain zero or more submatch expressions.
If ADORN is t there will be at least one submatch and the first
surrounds the matched alternative, and the regexp will also not match
a prefix of any identifier. Adorned regexps cannot be appended. The
language variable `c-nonsymbol-key' is used to make the adornment.
A value 'appendable for ADORN is like above, but all alternatives in
the list that end with a word constituent char will have \\> appended
instead, so that the regexp remains appendable. Note that this
variant doesn't always guarantee that an identifier prefix isn't
matched since the symbol constituent '_' is normally considered a
nonword token by \\>.
The optional MODE specifies the language to get `c-nonsymbol-key' from
when it's needed. The default is the current language taken from
`c-buffer-is-cc-mode'."
(let (unique)
(dolist (elt list)
(unless (member elt unique)
(push elt unique)))
(setq list (delete nil unique)))
(if list
(let (re)
(if (eq adorn 'appendable)
(let ((unique "") pos)
(while (let (found)
(setq unique (concat unique "@")
pos list)
(while (and pos
(if (string-match unique (car pos))
(progn (setq found t)
nil)
t))
(setq pos (cdr pos)))
found))
(setq pos list)
(while pos
(if (string-match "\\w\\'" (car pos))
(setcar pos (concat (car pos) unique)))
(setq pos (cdr pos)))
(setq re (regexp-opt list))
(setq pos 0)
(while (string-match unique re pos)
(setq pos (+ (match-beginning 0) 2)
re (replace-match "\\>" t t re))))
(setq re (regexp-opt list)))
(let (fail-list)
(while list
(and (string-match "\n" (car list)) (not (string-match (concat "\\`\\(" re "\\)\\'")
(car list)))
(setq fail-list (cons (car list) fail-list)))
(setq list (cdr list)))
(when fail-list
(setq re (concat re
"\\|"
(mapconcat
(if (eq adorn 'appendable)
(lambda (str)
(if (string-match "\\w\\'" str)
(concat (regexp-quote str)
"\\>")
(regexp-quote str)))
'regexp-quote)
(sort fail-list
(lambda (a b)
(> (length a) (length b))))
"\\|")))))
(cond ((eq adorn 'appendable)
(concat "\\(" re "\\)"))
(adorn
(concat "\\(" re "\\)"
"\\("
(c-get-lang-constant 'c-nonsymbol-key nil mode)
"\\|$\\)"))
(t
re)))
(if adorn
"\\(\\<\\>\\)"
"\\<\\>")))
(put 'c-make-keywords-re 'lisp-indent-function 1)
(defun c-make-bare-char-alt (chars &optional inverted)
"Make a character alternative string from the list of characters CHARS.
The returned string is of the type that can be used with
`skip-chars-forward' and `skip-chars-backward'. If INVERTED is
non-nil, a caret is prepended to invert the set."
(let ((str (if inverted "^" "")) char char2)
(setq chars (sort (append chars nil) `<))
(while chars
(setq char (pop chars))
(if (memq char '(?\\ ?^ ?-))
(setq str (format "%s\\%c" str char))
(setq str (format "%s%c" str char)))
(setq char2 char)
(while (and chars (>= (1+ char2) (car chars)))
(setq char2 (pop chars)))
(unless (= char char2)
(if (< (1+ char) char2)
(setq str (format "%s-%c" str char2))
(push char2 chars))))
str))
(defalias 'c-regexp-opt 'regexp-opt)
(defalias 'c-regexp-opt-depth 'regexp-opt-depth)
(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
(defconst c-emacs-features
(let (list)
(if (boundp 'infodock-version)
(setq list (cons 'infodock list)))
(let ((table (copy-syntax-table))
entry)
(modify-syntax-entry ?a ". 12345678" table)
(cond
((arrayp table)
(setq entry (aref table ?a))
(if (consp entry) (setq entry (car entry))))
((fboundp 'get-char-table)
(setq entry (get-char-table ?a table)))
(t (error "CC Mode is incompatible with this version of Emacs")))
(setq list (cons (if (= (logand (lsh entry -16) 255) 255)
'8-bit
'1-bit)
list)))
(let ((buf (generate-new-buffer " test"))
parse-sexp-lookup-properties
parse-sexp-ignore-comments
lookup-syntax-properties)
(save-excursion
(set-buffer buf)
(set-syntax-table (make-syntax-table))
(setq parse-sexp-lookup-properties t
parse-sexp-ignore-comments t
lookup-syntax-properties t)
(modify-syntax-entry ?< ".")
(modify-syntax-entry ?> ".")
(insert "<()>")
(c-mark-<-as-paren (point-min))
(c-mark->-as-paren (+ 3 (point-min)))
(goto-char (point-min))
(c-forward-sexp)
(if (= (point) (+ 4 (point-min)))
(setq list (cons 'syntax-properties list))
(error (concat
"CC Mode is incompatible with this version of Emacs - "
"support for the `syntax-table' text property "
"is required.")))
(c-safe
(modify-syntax-entry ?x "!")
(if (string-match "\\s!" "x")
(setq list (cons 'gen-comment-delim list))))
(c-safe
(modify-syntax-entry ?x "|")
(if (string-match "\\s|" "x")
(setq list (cons 'gen-string-delim list))))
(when (and (string-match "[[:alpha:]]" "a")
(progn
(delete-region (point-min) (point-max))
(insert "foo123")
(skip-chars-backward "[:alnum:]")
(bobp))
(= (skip-chars-forward "[:alpha:]") 3))
(setq list (cons 'posix-char-classes list)))
(when (boundp 'open-paren-in-column-0-is-defun-start)
(let ((open-paren-in-column-0-is-defun-start nil)
(parse-sexp-ignore-comments t))
(delete-region (point-min) (point-max))
(set-syntax-table (make-syntax-table))
(modify-syntax-entry ?\' "\"")
(cond
((memq '8-bit list)
(modify-syntax-entry ?/ ". 1456")
(modify-syntax-entry ?* ". 23"))
((memq '1-bit list)
(modify-syntax-entry ?/ ". 124b")
(modify-syntax-entry ?* ". 23")))
(modify-syntax-entry ?\n "> b")
(insert "/* '\n () */")
(backward-sexp)
(if (bobp)
(setq list (cons 'col-0-paren list)))))
(set-buffer-modified-p nil))
(kill-buffer buf))
(if (c-safe (>= (length (save-excursion (parse-partial-sexp (point) (point))))
10))
(setq list (cons 'pps-extended-state list))
(error (concat
"CC Mode is incompatible with this version of Emacs - "
"`parse-partial-sexp' has to return at least 10 elements.")))
list)
"A list of certain features in the (X)Emacs you are using.
There are many flavors of Emacs out there, each with different
features supporting those needed by CC Mode. The following values
might be present:
'8-bit 8 bit syntax entry flags (XEmacs style).
'1-bit 1 bit syntax entry flags (Emacs style).
'syntax-properties It works to override the syntax for specific characters
in the buffer with the 'syntax-table property. It's
always set - CC Mode no longer works in emacsen without
this feature.
'gen-comment-delim Generic comment delimiters work
(i.e. the syntax class `!').
'gen-string-delim Generic string delimiters work
(i.e. the syntax class `|').
'pps-extended-state `parse-partial-sexp' returns a list with at least 10
elements, i.e. it contains the position of the start of
the last comment or string. It's always set - CC Mode
no longer works in emacsen without this feature.
'posix-char-classes The regexp engine understands POSIX character classes.
'col-0-paren It's possible to turn off the ad-hoc rule that a paren
in column zero is the start of a defun.
'infodock This is Infodock (based on XEmacs).
'8-bit and '1-bit are mutually exclusive.")
(if (memq 'posix-char-classes c-emacs-features)
(progn
(defconst c-alpha "[:alpha:]")
(defconst c-alnum "[:alnum:]")
(defconst c-digit "[:digit:]")
(defconst c-upper "[:upper:]")
(defconst c-lower "[:lower:]"))
(defconst c-alpha "a-zA-Z")
(defconst c-alnum "a-zA-Z0-9")
(defconst c-digit "0-9")
(defconst c-upper "A-Z")
(defconst c-lower "a-z"))
(defun c-add-language (mode base-mode)
"Declare a new language in the language dependent variable system.
This is intended to be used by modes that inherit CC Mode to add new
languages. It should be used at the top level before any calls to
`c-lang-defconst'. MODE is the mode name symbol for the new language,
and BASE-MODE is the mode name symbol for the language in CC Mode that
is to be the template for the new mode.
The exact effect of BASE-MODE is to make all language constants that
haven't got a setting in the new language fall back to their values in
BASE-MODE. It does not have any effect outside the language constant
system."
(unless (string-match "\\`\\(.*-\\)mode\\'" (symbol-name mode))
(error "The mode name symbol `%s' must end with \"-mode\"" mode))
(put mode 'c-mode-prefix (match-string 1 (symbol-name mode)))
(unless (get base-mode 'c-mode-prefix)
(error "Unknown base mode `%s'" base-mode))
(put mode 'c-fallback-mode base-mode))
(defvar c-lang-constants (make-vector 151 0))
(defvar c-lang-const-expansion nil)
(defsubst c-get-current-file ()
(let ((file (cond
(load-in-progress
load-file-name)
((and (boundp 'byte-compile-dest-file)
(stringp byte-compile-dest-file))
byte-compile-dest-file)
(t
(buffer-file-name)))))
(and file
(file-name-sans-extension
(file-name-nondirectory file)))))
(defmacro c-lang-defconst-eval-immediately (form)
"Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
immediately, i.e. at the same time as the `c-lang-defconst' form
itself is evaluated."
(eval form))
(defmacro c-lang-defconst (name &rest args)
"Set the language specific values of the language constant NAME.
The second argument can optionally be a docstring. The rest of the
arguments are one or more repetitions of LANG VAL where LANG specifies
the language(s) that VAL applies to. LANG is the name of the
language, i.e. the mode name without the \"-mode\" suffix, or a list
of such language names, or `t' for all languages. VAL is a form to
evaluate to get the value.
If LANG isn't `t' or one of the core languages in CC Mode, it must
have been declared with `c-add-language'.
Neither NAME, LANG nor VAL are evaluated directly - they should not be
quoted. `c-lang-defconst-eval-immediately' can however be used inside
VAL to evaluate parts of it directly.
When VAL is evaluated for some language, that language is temporarily
made current so that `c-lang-const' without an explicit language can
be used inside VAL to refer to the value of a language constant in the
same language. That is particularly useful if LANG is `t'.
VAL is not evaluated right away but rather when the value is requested
with `c-lang-const'. Thus it's possible to use `c-lang-const' inside
VAL to refer to language constants that haven't been defined yet.
However, if the definition of a language constant is in another file
then that file must be loaded \(at compile time) before it's safe to
reference the constant.
The assignments in ARGS are processed in sequence like `setq', so
\(c-lang-const NAME) may be used inside a VAL to refer to the last
assigned value to this language constant, or a value that it has
gotten in another earlier loaded file.
To work well with repeated loads and interactive reevaluation, only
one `c-lang-defconst' for each NAME is permitted per file. If there
already is one it will be completely replaced; the value in the
earlier definition will not affect `c-lang-const' on the same
constant. A file is identified by its base name."
(let* ((sym (intern (symbol-name name) c-lang-constants))
(c-lang-const-expansion 'call)
(c-langs-are-parametric t)
bindings
pre-files)
(or (symbolp name)
(error "Not a symbol: %s" name))
(when (stringp (car-safe args))
(put sym 'variable-documentation (car args))
(setq args (cdr args)))
(or args
(error "No assignments in `c-lang-defconst' for %s" name))
(while args
(let ((assigned-mode
(cond ((eq (car args) t) t)
((symbolp (car args))
(list (intern (concat (symbol-name (car args))
"-mode"))))
((listp (car args))
(mapcar (lambda (lang)
(or (symbolp lang)
(error "Not a list of symbols: %s"
(car args)))
(intern (concat (symbol-name lang)
"-mode")))
(car args)))
(t (error "Not a symbol or a list of symbols: %s"
(car args)))))
val)
(or (cdr args)
(error "No value for %s" (car args)))
(setq args (cdr args)
val (car args))
(setq val (cl-macroexpand-all val))
(setq bindings (cons (cons assigned-mode val) bindings)
args (cdr args))))
(setq pre-files (nreverse
(mapcar 'car (get sym 'source))))
`(eval-and-compile
(c-define-lang-constant ',name ',bindings
,@(and pre-files `(',pre-files))))))
(put 'c-lang-defconst 'lisp-indent-function 1)
(def-edebug-spec c-lang-defconst
(&define name [&optional stringp] [&rest sexp def-form]))
(defun c-define-lang-constant (name bindings &optional pre-files)
(let* ((sym (intern (symbol-name name) c-lang-constants))
(source (get sym 'source))
(file (intern
(or (c-get-current-file)
(error "`c-lang-defconst' must be used in a file"))))
(elem (assq file source)))
(unless elem
(while pre-files
(unless (assq (car pre-files) source)
(setq source (cons (list (car pre-files)) source)))
(setq pre-files (cdr pre-files)))
(put sym 'source (cons (setq elem (list file)) source)))
(setcdr elem bindings)
(set sym nil)
(let ((agenda (get sym 'dependents))
(visited (make-vector 101 0))
ptr)
(while agenda
(setq sym (car agenda)
agenda (cdr agenda))
(intern (symbol-name sym) visited)
(set sym nil)
(setq ptr (get sym 'dependents))
(while ptr
(setq sym (car ptr)
ptr (cdr ptr))
(unless (intern-soft (symbol-name sym) visited)
(setq agenda (cons sym agenda))))))
name))
(defmacro c-lang-const (name &optional lang)
"Get the mode specific value of the language constant NAME in language LANG.
LANG is the name of the language, i.e. the mode name without the
\"-mode\" suffix. If used inside `c-lang-defconst' or
`c-lang-defvar', LANG may be left out to refer to the current
language. NAME and LANG are not evaluated so they should not be
quoted."
(or (symbolp name)
(error "Not a symbol: %s" name))
(or (symbolp lang)
(error "Not a symbol: %s" lang))
(let ((sym (intern (symbol-name name) c-lang-constants))
mode source-files args)
(when lang
(setq mode (intern (concat (symbol-name lang) "-mode")))
(unless (get mode 'c-mode-prefix)
(error
"Unknown language %S since it got no `c-mode-prefix' property"
(symbol-name lang))))
(if (eq c-lang-const-expansion 'immediate)
`',(c-get-lang-constant name nil mode)
(let ((file (c-get-current-file)))
(if file (setq file (intern file)))
(setq source-files (nreverse
(apply 'nconc
(mapcar (lambda (elem)
(if (eq file (car elem))
nil (list (car elem))))
(get sym 'source))))))
(setq args (and mode `(',mode)))
(if (or source-files args)
(setq args (cons (and source-files `',source-files)
args)))
(if (or (eq c-lang-const-expansion 'call)
(and (not c-lang-const-expansion)
(not mode))
load-in-progress
(not (boundp 'byte-compile-dest-file))
(not (stringp byte-compile-dest-file)))
`(c-get-lang-constant ',name ,@args)
`(if (eq c-version-sym ',c-version-sym)
(cc-eval-when-compile
(c-get-lang-constant ',name ,@args))
(c-get-lang-constant ',name ,@args))))))
(defvar c-lang-constants-under-evaluation nil)
(defun c-get-lang-constant (name &optional source-files mode)
(or mode
(setq mode c-buffer-is-cc-mode)
(error "No current language"))
(let* ((sym (intern (symbol-name name) c-lang-constants))
(source (get sym 'source))
elem
(eval-in-sym (and c-lang-constants-under-evaluation
(caar c-lang-constants-under-evaluation))))
(when eval-in-sym
(or (memq eval-in-sym (get sym 'dependents))
(put sym 'dependents (cons eval-in-sym (get sym 'dependents)))))
(while source-files
(unless (assq (car source-files) source)
(put sym 'source
(setq source (cons (list (car source-files)) source)))
(set sym nil))
(setq source-files (cdr source-files)))
(if (and (boundp sym)
(setq elem (assq mode (symbol-value sym))))
(cdr elem)
(let* ((c-buffer-is-cc-mode mode)
(source-pos
(or (assq sym c-lang-constants-under-evaluation)
(cons sym (vector source nil))))
(c-lang-constants-under-evaluation
(cons source-pos c-lang-constants-under-evaluation))
(fallback (get mode 'c-fallback-mode))
value
(max-specpdl-size (max max-specpdl-size 3000))
(max-lisp-eval-depth (max max-lisp-eval-depth 1000)))
(if (if fallback
(let ((backup-source-pos (copy-sequence (cdr source-pos))))
(and
(eq (setq value (c-find-assignment-for-mode
(cdr source-pos) mode nil name))
c-lang-constants)
(eq (setq value (c-find-assignment-for-mode
(setcdr source-pos backup-source-pos)
fallback t name))
c-lang-constants)))
(eq (setq value (c-find-assignment-for-mode
(cdr source-pos) mode t name))
c-lang-constants))
(error
"`%s' got no (prior) value in %s (might be a cyclic reference)"
name mode))
(condition-case err
(setq value (eval value))
(error
(message "Eval error in the `c-lang-defconst' for `%s' in %s:"
sym mode)
(makunbound sym)
(signal (car err) (cdr err))))
(set sym (cons (cons mode value) (symbol-value sym)))
value))))
(defun c-find-assignment-for-mode (source-pos mode match-any-lang name)
(catch 'found
(let ((file-entry (elt source-pos 0))
(assignment-entry (elt source-pos 1))
assignment)
(while (if assignment-entry
t
(when file-entry
(unless (aset source-pos 1
(setq assignment-entry (cdar file-entry)))
(let ((file (symbol-name (caar file-entry)))
(c-lang-constants-under-evaluation nil))
(load file))
(unless (setq assignment-entry (cdar file-entry))
(setcdr (car file-entry)
(setq assignment-entry (list (list nil))))))
(aset source-pos 0 (setq file-entry (cdr file-entry)))
t))
(setq assignment (car assignment-entry))
(aset source-pos 1
(setq assignment-entry (cdr assignment-entry)))
(when (if (listp (car assignment))
(memq mode (car assignment))
match-any-lang)
(throw 'found (cdr assignment))))
c-lang-constants)))
(defun c-lang-major-mode-is (mode)
(unless (listp mode)
(setq mode (list mode)))
(let (match (buf-mode c-buffer-is-cc-mode))
(while (if (memq buf-mode mode)
(progn
(setq match t)
nil)
(setq buf-mode (get buf-mode 'c-fallback-mode))))
match))
(cc-provide 'cc-defs)