;;; cc-defs.el --- compile time definitions for CC Mode
-;; Copyright (C) 1985,1987,1992-2001 Free Software Foundation, Inc.
+;; Copyright (C) 1985,1987,1992-2003 Free Software Foundation, Inc.
-;; Authors: 2000- Martin Stjernholm
-;; 1998-1999 Barry A. Warsaw and Martin Stjernholm
-;; 1992-1997 Barry A. Warsaw
+;; 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
;;; Commentary:
+;; This file contains macros, defsubsts, and various other things that
+;; must be loaded early both during compilation and at runtime.
+
;;; Code:
(eval-when-compile
(stringp byte-compile-dest-file))
(cons (file-name-directory byte-compile-dest-file) load-path)
load-path)))
- (require 'cc-bytecomp)))
+ (load "cc-bytecomp" nil t)))
+
+;; `require' in XEmacs doesn't have the third NOERROR argument.
+(condition-case nil (require 'regexp-opt) (file-error nil))
-;; cc-mode-19.el contains compatibility macros that should be used if
+;; Silence the compiler.
+(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
+(cc-bytecomp-defvar c-emacs-features) ; In cc-vars.el
+(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
+(cc-bytecomp-defun region-active-p) ; XEmacs
+(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs
+(cc-bytecomp-defvar zmacs-regions) ; XEmacs
+(cc-bytecomp-defvar mark-active) ; Emacs
+(cc-bytecomp-defvar deactivate-mark) ; Emacs
+(cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs
+(cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs 20+
+(cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21
+(cc-bytecomp-defvar lookup-syntax-properties) ; XEmacs 21
+(cc-bytecomp-defun string-to-syntax) ; Emacs 21
+(cc-bytecomp-defun regexp-opt-depth) ; (X)Emacs 20+
+
+\f
+;; cc-fix.el contains compatibility macros that should be used if
;; needed.
(eval-and-compile
(if (or (not (fboundp 'functionp))
(progn (eval '(char-after)) t)
(error nil)))
(not (fboundp 'when))
- (not (fboundp 'unless)))
- (cc-load "cc-mode-19")))
+ (not (fboundp 'unless))
+ (not (fboundp 'regexp-opt))
+ (not (cc-bytecomp-fboundp 'regexp-opt-depth))
+ (/= (regexp-opt-depth "\\(\\(\\)\\)") 2))
+ (cc-load "cc-fix")
+ (defalias 'c-regexp-opt 'regexp-opt)
+ (defalias 'c-regexp-opt-depth 'regexp-opt-depth)))
-;; Silence the compiler.
-(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
-(cc-bytecomp-defvar c-buffer-is-cc-mode) ; In cc-vars.el
-(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
-(cc-bytecomp-defun region-active-p) ; XEmacs
-(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs
-(cc-bytecomp-defvar zmacs-regions) ; XEmacs
-(cc-bytecomp-defvar mark-active) ; Emacs
-(cc-bytecomp-defun scan-lists) ; 5 args in XEmacs, 3 in Emacs
-(require 'derived) ; Only necessary in Emacs
+(eval-after-load "font-lock"
+ '(if (and (not (featurep 'cc-fix)) ; only load the file once.
+ (let (font-lock-keywords)
+ (font-lock-compile-keywords '("\\<\\>"))
+ font-lock-keywords)) ; did the previous call foul this up?
+ (load "cc-fix")))
+
+;; The above takes care of the delayed loading, but this is necessary
+;; to ensure correct byte compilation.
+(eval-when-compile
+ (if (and (not (featurep 'cc-fix))
+ (progn
+ (require 'font-lock)
+ (let (font-lock-keywords)
+ (font-lock-compile-keywords '("\\<\\>"))
+ font-lock-keywords)))
+ (cc-load "cc-fix")))
+
+(cc-external-require 'cl)
\f
-;;; Macros.
+;;; Variables also used at compile time.
+
+(defconst c-version "5.30.1"
+ "CC Mode version number.")
+
+(defconst c-version-sym (intern c-version))
+;; A little more compact and faster in comparisons.
+
+(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', and any other non-CC Mode mode that calls
+`c-initialize-cc-mode' (e.g. `awk-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)
+
+;; Have to make `c-buffer-is-cc-mode' permanently local so that it
+;; survives the initialization of the derived mode.
+(put 'c-buffer-is-cc-mode 'permanent-local t)
+
+\f
+;; The following is used below during compilation.
+(eval-and-compile
+ (defvar c-inside-eval-when-compile nil)
-;;; Helpers for building regexps.
-(defmacro c-paren-re (re)
- `(concat "\\(" ,re "\\)"))
-(defmacro c-identifier-re (re)
- `(concat "\\<\\(" ,re "\\)\\>[^_]"))
+ (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
+ ;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it
+ ;; evaluates its body at macro expansion time if it's nested
+ ;; inside another `eval-when-compile'. So we use a dynamically
+ ;; bound variable to avoid nesting them.
+ `(progn ,@body)
+
+ `(eval-when-compile
+ ;; In all (X)Emacsen so far, `eval-when-compile' byte compiles
+ ;; its contents before evaluating it. That can cause forms to
+ ;; be compiled in situations they aren't intended to be
+ ;; compiled.
+ ;;
+ ;; Example: It's not possible to defsubst a primitive, e.g. the
+ ;; following will produce an error (in any emacs flavor), since
+ ;; `nthcdr' is a primitive function that's handled specially by
+ ;; the byte compiler and thus can't be redefined:
+ ;;
+ ;; (defsubst nthcdr (val) val)
+ ;;
+ ;; `defsubst', like `defmacro', needs to be evaluated at
+ ;; compile time, so this will produce an error during byte
+ ;; compilation.
+ ;;
+ ;; CC Mode occasionally needs to do things like this for
+ ;; cross-emacs compatibility. It therefore uses the following
+ ;; to conditionally do a `defsubst':
+ ;;
+ ;; (eval-when-compile
+ ;; (if (not (fboundp 'foo))
+ ;; (defsubst foo ...)))
+ ;;
+ ;; But `eval-when-compile' byte compiles its contents and
+ ;; _then_ evaluates it (in all current emacs versions, up to
+ ;; and including Emacs 20.6 and XEmacs 21.1 as of this
+ ;; writing). So this will still produce an error, since the
+ ;; byte compiler will get to the defsubst anyway. That's
+ ;; arguably a bug because the point with `eval-when-compile' is
+ ;; that it should evaluate rather than compile its contents.
+ ;;
+ ;; We get around it by expanding the body to a quoted
+ ;; constant that we eval. That otoh introduce a problem in
+ ;; that a returned lambda expression doesn't get byte
+ ;; compiled (even if `function' is used).
+ (eval '(let ((c-inside-eval-when-compile t)) ,@body)))))
+
+ (put 'cc-eval-when-compile 'lisp-indent-hook 0))
+
+\f
+;;; Macros.
(defmacro c-point (position &optional point)
- ;; Returns 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
- ;;
- ;; If the referenced position doesn't exist, the closest accessible
- ;; point to it is returned. This function does not modify point or
- ;; mark.
- `(save-excursion
- ,(if point `(goto-char ,point))
- ,(if (and (eq (car-safe position) 'quote)
- (symbolp (eval position)))
- (let ((position (eval 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 'bonl) `(forward-line 1))
- ((eq position 'bopl) `(forward-line -1))
- ((eq position 'eod) `(c-end-of-defun-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)))
- (t (error "unknown buffer position requested: %s" position))))
- ;;(message "c-point long expansion")
- `(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 'bonl) (forward-line 1))
- ((eq position 'bopl) (forward-line -1))
- ((eq position 'eod) (c-end-of-defun-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)))
- (t (error "unknown buffer position requested: %s" position)))))
- (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
+
+If the referenced position doesn't exist, the closest accessible point
+to it is returned. This function does not modify point or mark.
+
+This function does not do any hidden buffer changes."
+
+ (if (eq (car-safe position) 'quote)
+ (let ((position (eval position)))
+ (cond
+
+ ((eq position 'bol)
+ (if (and (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 (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 (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 (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 (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 (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)))
+
+ (t (error "Unknown buffer position requested: %s" position))))
+
+ ;;(message "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)))
+ (t (error "Unknown buffer position requested: %s" position))))
+ (point))))
(defmacro c-safe (&rest body)
;; safely execute BODY, return nil if an error occurred
+ ;;
+ ;; This function does not do any hidden buffer changes.
`(condition-case nil
(progn ,@body)
(error nil)))
(put 'c-safe 'lisp-indent-function 0)
-(defmacro c-forward-sexp (&optional arg)
- ;; like forward-sexp except
- ;; 1. this is much stripped down from the XEmacs version
- ;; 2. this cannot be used as a command, so we're insulated from
- ;; XEmacs' losing efforts to make forward-sexp more user
- ;; friendly
- ;; 3. Preserves the semantics most of CC Mode is based on
- (or arg (setq arg 1))
- `(goto-char (or (scan-sexps (point) ,arg)
- ,(if (numberp arg)
- (if (> arg 0) `(point-max) `(point-min))
- `(if (> ,arg 0) (point-max) (point-min))))))
-
-(defmacro c-backward-sexp (&optional arg)
- ;; See c-forward-sexp and reverse directions
- (or arg (setq arg 1))
- `(c-forward-sexp ,(if (numberp arg) (- arg) `(- ,arg))))
+;; The following is essentially `save-buffer-state' from lazy-lock.el.
+;; It ought to be a standard macro.
+(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. 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.
+
+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)
+ (prog1 (progn ,@body)
+ (and (not modified)
+ (buffer-modified-p)
+ (set-buffer-modified-p nil)))))
+(put 'c-save-buffer-state 'lisp-indent-function 1)
+(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.
+
+This function does not do any hidden buffer changes."
+ (or count (setq count 1))
+ `(goto-char (or (scan-sexps (point) ,count)
+ ,(if (numberp count)
+ (if (> count 0) `(point-max) `(point-min))
+ `(if (> ,count 0) (point-max) (point-min))))))
+
+(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)
+ "Like `scan-lists' but returns nil instead of signalling errors.
+
+This function does not do any hidden buffer changes."
+ (if (featurep 'xemacs)
+ `(scan-lists ,from ,count ,depth nil t)
+ `(c-safe (scan-lists ,from ,count ,depth))))
+
+\f
;; Wrappers for common scan-lists cases, mainly because it's almost
;; impossible to get a feel for how that function works.
-(defmacro c-up-list-forward (pos)
- `(c-safe (scan-lists ,pos 1 1)))
-(defmacro c-up-list-backward (pos)
- `(c-safe (scan-lists ,pos -1 1)))
-(defmacro c-down-list-forward (pos)
- `(c-safe (scan-lists ,pos 1 -1)))
-(defmacro c-down-list-backward (pos)
- `(c-safe (scan-lists ,pos -1 -1)))
-
-(defmacro c-add-syntax (symbol &optional relpos)
- ;; a simple macro to append the syntax in symbol to the syntax list.
- ;; try to increase performance by using this macro
- `(let ((relpos-tmp ,relpos))
- (if relpos-tmp (setq syntactic-relpos relpos-tmp))
- (setq syntax (cons (cons ,symbol relpos-tmp) syntax))))
+
+(defmacro c-up-list-forward (&optional pos)
+ "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.
+
+This function does not do any hidden buffer changes."
+ `(c-safe-scan-lists ,(or pos `(point)) 1 1))
+
+(defmacro c-up-list-backward (&optional pos)
+ "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.
+
+This function does not do any hidden buffer changes."
+ `(c-safe-scan-lists ,(or pos `(point)) -1 1))
+
+(defmacro c-down-list-forward (&optional pos)
+ "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.
+
+This function does not do any hidden buffer changes."
+ `(c-safe-scan-lists ,(or pos `(point)) 1 -1))
+
+(defmacro c-down-list-backward (&optional pos)
+ "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.
+
+This function does not do any hidden buffer changes."
+ `(c-safe-scan-lists ,(or pos `(point)) -1 -1))
+
+(defmacro c-go-up-list-forward (&optional pos)
+ "Move the point to the first position after the list sexp containing POS,
+or the point if POS is left out. Return t if such a position exists,
+otherwise nil is returned and the point isn't moved.
+
+This function does not do any hidden buffer changes."
+ `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 1)) t))
+
+(defmacro c-go-up-list-backward (&optional pos)
+ "Move the point to the position of the start of the list sexp containing POS,
+or the point if POS is left out. Return t if such a position exists,
+otherwise nil is returned and the point isn't moved.
+
+This function does not do any hidden buffer changes."
+ `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 1)) t))
+
+(defmacro c-go-down-list-forward (&optional pos)
+ "Move the point to the first position inside the first list sexp after POS,
+or the point if POS is left out. Return t if such a position exists,
+otherwise nil is returned and the point isn't moved.
+
+This function does not do any hidden buffer changes."
+ `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 -1)) t))
+
+(defmacro c-go-down-list-backward (&optional pos)
+ "Move the point to the last position inside the last list sexp before POS,
+or the point if POS is left out. Return t if such a position exists,
+otherwise nil is returned and the point isn't moved.
+
+This function does not do any hidden buffer changes."
+ `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 -1)) t))
+
+\f
+(defmacro c-beginning-of-defun-1 ()
+ ;; Wrapper around beginning-of-defun.
+ ;;
+ ;; NOTE: This function should contain the only explicit use of
+ ;; beginning-of-defun in CC Mode. Eventually something better than
+ ;; b-o-d will be available and this should be the only place the
+ ;; code needs to change. Everything else should use
+ ;; (c-beginning-of-defun-1)
+ ;;
+ ;; This is really a bit too large to be a macro but that isn't a
+ ;; problem as long as it only is used in one place in
+ ;; `c-parse-state'.
+ ;;
+ ;; This function does not do any hidden buffer changes.
+
+ `(progn
+ (if (and ,(cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
+ c-enable-xemacs-performance-kludge-p)
+ ,(when (cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
+ ;; XEmacs only. This can improve the performance of
+ ;; c-parse-state to between 3 and 60 times faster when
+ ;; braces are hung. It can also degrade performance by
+ ;; about as much when braces are not hung.
+ '(let (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 "^{")))
+ ;; unbalanced parenthesis, while illegal C code,
+ ;; shouldn't cause an infloop! See unbal.c
+ (when (zerop distance)
+ ;; Punt!
+ (beginning-of-defun)
+ (setq pos (point)))))
+ ((= pos 0))
+ ((not (eq (char-after pos) ?{))
+ (goto-char pos)
+ (setq pos nil))
+ ))
+ (goto-char pos)))
+ ;; Emacs, which doesn't have buffer-syntactic-context-depth
+ (beginning-of-defun))
+ ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at the
+ ;; open brace.
+ (and defun-prompt-regexp
+ (looking-at defun-prompt-regexp)
+ (goto-char (match-end 0)))))
(defmacro c-benign-error (format &rest args)
;; Formats an error message for the echo area and dings, i.e. like
;; `error' but doesn't abort.
+ ;;
+ ;; This function does not do any hidden buffer changes.
`(progn
(message ,format ,@args)
(ding)))
(defmacro c-update-modeline ()
;; set the c-auto-hungry-string for the correct designation on the modeline
+ ;;
+ ;; This function does not do any hidden buffer changes.
`(progn
(setq c-auto-hungry-string
(if c-auto-newline
(defmacro c-with-syntax-table (table &rest code)
;; Temporarily switches to the specified syntax table in a failsafe
;; way to execute code.
+ ;;
+ ;; This function does not do any hidden buffer changes.
`(let ((c-with-syntax-table-orig-table (syntax-table)))
(unwind-protect
(progn
(defmacro c-skip-ws-forward (&optional limit)
"Skip over any whitespace following point.
This function skips over horizontal and vertical whitespace and line
-continuations."
+continuations.
+
+This function does not do any hidden buffer changes."
(if limit
- `(let ((-limit- (or ,limit (point-max))))
+ `(let ((limit (or ,limit (point-max))))
(while (progn
;; skip-syntax-* doesn't count \n as whitespace..
- (skip-chars-forward " \t\n\r\f" -limit-)
+ (skip-chars-forward " \t\n\r\f\v" limit)
(when (and (eq (char-after) ?\\)
- (< (point) -limit-))
+ (< (point) limit))
(forward-char)
(or (eolp)
(progn (backward-char) nil))))))
'(while (progn
- (skip-chars-forward " \t\n\r\f")
+ (skip-chars-forward " \t\n\r\f\v")
(when (eq (char-after) ?\\)
(forward-char)
(or (eolp)
(defmacro c-skip-ws-backward (&optional limit)
"Skip over any whitespace preceding point.
This function skips over horizontal and vertical whitespace and line
-continuations."
+continuations.
+
+This function does not do any hidden buffer changes."
(if limit
- `(let ((-limit- (or ,limit (point-min))))
+ `(let ((limit (or ,limit (point-min))))
(while (progn
;; skip-syntax-* doesn't count \n as whitespace..
- (skip-chars-backward " \t\n\r\f" -limit-)
+ (skip-chars-backward " \t\n\r\f\v" limit)
(and (eolp)
(eq (char-before) ?\\)
- (> (point) -limit-)))
+ (> (point) limit)))
(backward-char)))
'(while (progn
- (skip-chars-backward " \t\n\r\f")
+ (skip-chars-backward " \t\n\r\f\v")
(and (eolp)
(eq (char-before) ?\\)))
(backward-char))))
+(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.
+
+This function does not do any hidden buffer changes."
+ (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)))))
+
+(defmacro c-parse-sexp-lookup-properties ()
+ ;; Return the value of the variable that says whether the
+ ;; syntax-table property affects the sexp routines. Always return
+ ;; nil in (X)Emacsen without support for that.
+ ;;
+ ;; This function does not do any hidden buffer changes.
+ (cond ((cc-bytecomp-boundp 'parse-sexp-lookup-properties)
+ `parse-sexp-lookup-properties)
+ ((cc-bytecomp-boundp 'lookup-syntax-properties)
+ `lookup-syntax-properties)
+ (t nil)))
+
+\f
+;; Macros/functions to handle so-called "char properties", which are
+;; properties set on a single character and that never spreads to any
+;; other characters.
+
+(eval-and-compile
+ ;; Constant used at compile time to decide whether or not to use
+ ;; XEmacs extents. Check all the extent functions we'll use since
+ ;; some packages might add compatibility aliases for some of them in
+ ;; Emacs.
+ (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))))
+
+;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to
+;; make it a function.
+(defalias 'c-put-char-property-fun
+ (cc-eval-when-compile
+ (cond (c-use-extents
+ ;; XEmacs.
+ (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))
+ ;; In Emacs < 21 we have to mess with the `rear-nonsticky' property.
+ (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) ; Make it known below.
+
+(defmacro c-put-char-property (pos property value)
+ ;; Put the given property with the given value on the character at
+ ;; POS and make it front and rear nonsticky, or start and end open
+ ;; in XEmacs vocabulary. If the character already has the given
+ ;; property then the value is replaced, and the behavior is
+ ;; undefined if that property has been put by some other function.
+ ;; PROPERTY is assumed to be constant.
+ ;;
+ ;; If there's a `text-property-default-nonsticky' variable (Emacs
+ ;; 21) then it's assumed that the property is present on it.
+ (setq property (eval property))
+ (if (or c-use-extents
+ (not (cc-bytecomp-boundp 'text-property-default-nonsticky)))
+ ;; XEmacs and Emacs < 21.
+ `(c-put-char-property-fun ,pos ',property ,value)
+ ;; In Emacs 21 we got the `rear-nonsticky' property covered
+ ;; by `text-property-default-nonsticky'.
+ `(let ((-pos- ,pos))
+ (put-text-property -pos- (1+ -pos-) ',property ,value))))
+
+(defmacro c-get-char-property (pos property)
+ ;; Get the value of the given property on the character at POS if
+ ;; it's been put there by `c-put-char-property'. PROPERTY is
+ ;; assumed to be constant.
+ (setq property (eval property))
+ (if c-use-extents
+ ;; XEmacs.
+ `(let ((ext (extent-at ,pos nil ',property)))
+ (if ext (extent-property ext ',property)))
+ ;; Emacs.
+ `(get-text-property ,pos ',property)))
+
+;; `c-clear-char-property' is complex enough in Emacs < 21 to make it
+;; a function, since we have to mess with the `rear-nonsticky' 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) ; Make it known below.
+
+(defmacro c-clear-char-property (pos property)
+ ;; Remove the given property on the character at POS if it's been put
+ ;; there by `c-put-char-property'. PROPERTY is assumed to be
+ ;; constant.
+ (setq property (eval property))
+ (cond (c-use-extents
+ ;; XEmacs.
+ `(let ((ext (extent-at ,pos nil ',property)))
+ (if ext (delete-extent ext))))
+ ((cc-bytecomp-boundp 'text-property-default-nonsticky)
+ ;; In Emacs 21 we got the `rear-nonsticky' property covered
+ ;; by `text-property-default-nonsticky'.
+ `(let ((pos ,pos))
+ (remove-text-properties pos (1+ pos)
+ '(,property nil))))
+ (t
+ ;; Emacs < 21.
+ `(c-clear-char-property-fun ,pos ',property))))
+
+(defmacro c-clear-char-properties (from to property)
+ ;; Remove all the occurences of the given property in the given
+ ;; region that has been put with `c-put-char-property'. PROPERTY is
+ ;; assumed to be constant.
+ ;;
+ ;; Note that this function does not clean up the property from the
+ ;; lists of the `rear-nonsticky' properties in the region, if such
+ ;; are used. Thus it should not be used for common properties like
+ ;; `syntax-table'.
+ (setq property (eval property))
+ (if c-use-extents
+ ;; XEmacs.
+ `(map-extents (lambda (ext ignored)
+ (delete-extent ext))
+ nil ,from ,to nil nil ',property)
+ ;; Emacs.
+ `(remove-text-properties ,from ,to '(,property nil))))
+
+\f
;; Make edebug understand the macros.
(eval-after-load "edebug"
'(progn
- (def-edebug-spec c-paren-re t)
- (def-edebug-spec c-identifier-re t)
- (def-edebug-spec c-point ([&or symbolp form] &optional form))
+ (def-edebug-spec c-point t)
(def-edebug-spec c-safe t)
- (def-edebug-spec c-forward-sexp (&optional [&or numberp form]))
- (def-edebug-spec c-backward-sexp (&optional [&or numberp form]))
+ (def-edebug-spec c-save-buffer-state let*)
+ (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-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-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 cc-eval-when-compile t)))
-;;; Inline functions.
+\f
+;;; Functions.
;; Note: All these after the macros, to be on safe side in avoiding
;; bugs where macros are defined too late. These bugs often only show
;; when the files are compiled in a certain order within the same
;; session.
-(defsubst c-beginning-of-defun-1 ()
- ;; Wrapper around beginning-of-defun.
- ;;
- ;; NOTE: This function should contain the only explicit use of
- ;; beginning-of-defun in CC Mode. Eventually something better than
- ;; b-o-d will be available and this should be the only place the
- ;; code needs to change. Everything else should use
- ;; (c-beginning-of-defun-1)
- (if (and (fboundp 'buffer-syntactic-context-depth)
- c-enable-xemacs-performance-kludge-p)
- ;; XEmacs only. This can improve the performance of
- ;; c-parse-state to between 3 and 60 times faster when
- ;; braces are hung. It can also degrade performance by
- ;; about as much when braces are not hung.
- (let (pos)
- (while (not pos)
- (save-restriction
- (widen)
- (setq pos (scan-lists (point) -1
- (buffer-syntactic-context-depth)
- nil t)))
- (cond
- ((bobp) (setq pos (point-min)))
- ((not pos)
- (let ((distance (skip-chars-backward "^{")))
- ;; unbalanced parenthesis, while illegal C code,
- ;; shouldn't cause an infloop! See unbal.c
- (when (zerop distance)
- ;; Punt!
- (beginning-of-defun)
- (setq pos (point)))))
- ((= pos 0))
- ((not (eq (char-after pos) ?{))
- (goto-char pos)
- (setq pos nil))
- ))
- (goto-char pos))
- ;; Emacs, which doesn't have buffer-syntactic-context-depth
- (beginning-of-defun))
- ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at the
- ;; open brace.
- (and defun-prompt-regexp
- (looking-at defun-prompt-regexp)
- (goto-char (match-end 0))))
-
(defsubst c-end-of-defun-1 ()
;; Replacement for end-of-defun that use c-beginning-of-defun-1.
(let ((start (point)))
(if (< (point) start)
(goto-char (point-max)))))
+(defconst c-<-as-paren-syntax '(4 . ?>))
+
+(defsubst c-mark-<-as-paren (pos)
+ ;; Mark the "<" character at POS as an sexp list opener using the
+ ;; syntax-table property. Note that Emacs 19 and XEmacs <= 20
+ ;; doesn't support syntax properties, so this function might not
+ ;; have any effect.
+ (c-put-char-property pos 'syntax-table c-<-as-paren-syntax))
+
+(defconst c->-as-paren-syntax '(5 . ?<))
+
+(defsubst c-mark->-as-paren (pos)
+ ;; Mark the ">" character at POS as an sexp list closer using the
+ ;; syntax-table property. Note that Emacs 19 and XEmacs <= 20
+ ;; doesn't support syntax properties, so this function might not
+ ;; have any effect.
+ (c-put-char-property pos 'syntax-table c->-as-paren-syntax))
+
(defsubst c-intersect-lists (list alist)
;; return the element of ALIST that matches the first element found
;; in LIST. Uses assq.
+ ;;
+ ;; This function does not do any hidden buffer changes.
(let (match)
(while (and list
(not (setq match (assq (car list) alist))))
(defsubst c-lookup-lists (list alist1 alist2)
;; first, find the first entry from LIST that is present in ALIST1,
;; then find the entry in ALIST2 for that entry.
+ ;;
+ ;; This function does not do any hidden buffer changes.
(assq (car (c-intersect-lists list alist1)) alist2))
(defsubst c-langelem-col (langelem &optional preserve-point)
- ;; convenience routine to return the column of langelem's relpos.
- ;; Leaves point at the relpos unless preserve-point is non-nil.
+ "Convenience routine to return the column of LANGELEM's relpos.
+Leaves point at the relpos unless PRESERVE-POINT is non-nil.
+
+This function does not do any hidden buffer changes."
(if (cdr langelem)
(let ((here (point)))
(goto-char (cdr langelem))
(defsubst c-keep-region-active ()
;; Do whatever is necessary to keep the region active in XEmacs.
;; This is not needed for Emacs.
+ ;;
+ ;; This function does not do any hidden buffer changes.
(and (boundp 'zmacs-region-stays)
(setq zmacs-region-stays t)))
(defsubst c-region-is-active-p ()
;; Return t when the region is active. The determination of region
;; activeness is different in both Emacs and XEmacs.
+ ;;
+ ;; This function does not do any hidden buffer changes.
(cond
;; XEmacs
((and (fboundp 'region-active-p)
;; fallback; shouldn't get here
(t (mark t))))
-(defsubst c-major-mode-is (mode)
- (eq c-buffer-is-cc-mode mode))
+(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.
+
+This function does not do any hidden buffer changes."
+ (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.
+
+This function does not do any hidden buffer changes."
+ (symbol-value (c-mode-symbol suffix)))
+
+(defsubst c-mode-is-new-awk-p ()
+ ;; Is the current mode the "new" awk mode? It is important for
+ ;; (e.g.) the cc-engine functions do distinguish between the old and
+ ;; new awk-modes.
+ (and (c-major-mode-is 'awk-mode)
+ (memq 'syntax-properties c-emacs-features)))
+
+(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.
+
+This function does not do any hidden buffer changes."
+ (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)
+ ;; Return t if FACENAME is the name of a face. This method is
+ ;; necessary since facep in XEmacs only returns t for the actual
+ ;; face objects (while it's only their names that are used just
+ ;; about anywhere else) without providing a predicate that tests
+ ;; face names.
+ ;;
+ ;; This function does not do any hidden buffer changes.
+ (memq facename (face-list)))
+
+(defun c-make-keywords-re (adorn list &optional mode)
+ "Make a regexp that matches all the strings the list.
+Duplicates in the list are removed. The regexp may contain zero or
+more submatch expressions.
+
+If ADORN is non-nil there will be at least one submatch and the first
+matches the whole keyword, 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. The
+optional MODE specifies the language to get it in. The default is the
+current language (taken from `c-buffer-is-cc-mode')."
+ (setq list (delete-duplicates list :test 'string-equal))
+ (if list
+ (let ((re (c-regexp-opt list)))
+ ;; Add our own grouping parenthesis around re instead of
+ ;; passing adorn to `regexp-opt', since in XEmacs it makes the
+ ;; top level grouping "shy".
+ (if adorn
+ (concat "\\(" re "\\)"
+ "\\("
+ (c-get-lang-constant 'c-nonsymbol-key nil mode)
+ "\\|$\\)")
+ re))
+ ;; Produce a regexp that matches nothing.
+ (if adorn
+ "\\(\\<\\>\\)"
+ "\\<\\>")))
+(put 'c-make-keywords-re 'lisp-indent-function 1)
+
+\f
+;;; Some helper constants.
+
+;; If the regexp engine supports POSIX char classes (e.g. Emacs 21)
+;; then we can use them to handle extended charsets correctly.
+(if (string-match "[[:alpha:]]" "a") ; Can't use c-emacs-features here.
+ (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"))
+
+\f
+;;; System for handling language dependent constants.
+
+;; This is used to set various language dependent data in a flexible
+;; way: Language constants can be built from the values of other
+;; language constants, also those for other languages. They can also
+;; process the values of other language constants uniformly across all
+;; the languages. E.g. one language constant can list all the type
+;; keywords in each language, and another can build a regexp for each
+;; language from those lists without code duplication.
+;;
+;; Language constants are defined with `c-lang-defconst', and their
+;; value forms (referred to as source definitions) are evaluated only
+;; on demand when requested for a particular language with
+;; `c-lang-const'. It's therefore possible to refer to the values of
+;; constants defined later in the file, or in another file, just as
+;; long as all the relevant `c-lang-defconst' have been loaded when
+;; `c-lang-const' is actually evaluated from somewhere else.
+;;
+;; `c-lang-const' forms are also evaluated at compile time and
+;; replaced with the values they produce. Thus there's no overhead
+;; for this system when compiled code is used - only the values
+;; actually used in the code are present, and the file(s) containing
+;; the `c-lang-defconst' forms don't need to be loaded at all then.
+;; There are however safeguards to make sure that they can be loaded
+;; to get the source definitions for the values if there's a mismatch
+;; in compiled versions, or if `c-lang-const' is used uncompiled.
+;;
+;; Note that the source definitions in a `c-lang-defconst' form are
+;; compiled into the .elc file where it stands; there's no need to
+;; load the source file to get it.
+;;
+;; See cc-langs.el for more details about how this system is deployed
+;; in CC Mode, and how the associated language variable system
+;; (`c-lang-defvar') works. That file also contains a lot of
+;; examples.
+
+(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))
+;; This obarray is a cache to keep track of the language constants
+;; defined by `c-lang-defconst' and the evaluated values returned by
+;; `c-lang-const'. It's mostly used at compile time but it's not
+;; stored in compiled files.
+;;
+;; The obarray contains all the language constants as symbols. The
+;; value cells hold the evaluated values as alists where each car is
+;; the mode name symbol and the corresponding cdr is the evaluated
+;; value in that mode. The property lists hold the source definitions
+;; and other miscellaneous data. The obarray might also contain
+;; various other symbols, but those don't have any variable bindings.
+
+(defvar c-lang-const-expansion nil)
+(defvar c-langs-are-parametric nil)
+
+(defsubst c-get-current-file ()
+ ;; Return the base name of the current file.
+ (let ((file (cond
+ (load-in-progress
+ ;; Being loaded.
+ load-file-name)
+ ((and (boundp 'byte-compile-dest-file)
+ (stringp byte-compile-dest-file))
+ ;; Being compiled.
+ byte-compile-dest-file)
+ (t
+ ;; Being evaluated interactively.
+ (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."
+ ;; Evaluate at macro expansion time, i.e. in the
+ ;; `cl-macroexpand-all' inside `c-lang-defconst'.
+ (eval form))
+
+(defmacro c-lang-defconst (name &rest args)
+ "Set the language specific values of the language constant NAME.
+The second argument can be an optional 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.
+
+This macro does not do any hidden buffer changes."
+
+ (let* ((sym (intern (symbol-name name) c-lang-constants))
+ ;; Make `c-lang-const' expand to a straightforward call to
+ ;; `c-get-lang-constant' in `cl-macroexpand-all' below.
+ ;;
+ ;; (The default behavior, i.e. to expand to a call inside
+ ;; `eval-when-compile' should be equivalent, since that macro
+ ;; should only expand to its content if it's used inside a
+ ;; form that's already evaluated at compile time. It's
+ ;; however necessary to use our cover macro
+ ;; `cc-eval-when-compile' due to bugs in `eval-when-compile',
+ ;; and it expands to a bulkier form that in this case only is
+ ;; unnecessary garbage that we don't want to store in the
+ ;; language constant source definitions.)
+ (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))
+ ;; The docstring is hardly used anywhere since there's no normal
+ ;; symbol to attach it to. It's primarily for getting the right
+ ;; format in the source.
+ (put sym 'variable-documentation (car args))
+ (setq args (cdr args)))
+
+ (or args
+ (error "No assignments in `c-lang-defconst' for %s" name))
+
+ ;; Rework ARGS to an association list to make it easier to handle.
+ ;; It's reversed at the same time to make it easier to implement
+ ;; the demand-driven (i.e. reversed) evaluation in `c-lang-const'.
+ (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))
+
+ ;; Emacs has a weird bug where it seems to fail to read
+ ;; backquote lists from byte compiled files correctly (,@
+ ;; forms, to be specific), so make sure the bindings in the
+ ;; expansion below doesn't contain any backquote stuff.
+ ;; (XEmacs handles it correctly and doesn't need this for that
+ ;; reason, but we also use this expansion handle
+ ;; `c-lang-defconst-eval-immediately' and to register
+ ;; dependencies on the `c-lang-const's in VAL.)
+ (setq val (cl-macroexpand-all val))
+
+ (setq bindings (cons (cons assigned-mode val) bindings)
+ args (cdr args))))
+
+ ;; Compile in the other files that have provided source
+ ;; definitions for this symbol, to make sure the order in the
+ ;; `source' property is correct even when files are loaded out of
+ ;; order.
+ (setq pre-files (nreverse
+ ;; Reverse to get the right load order.
+ (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)
+(eval-after-load "edebug"
+ '(def-edebug-spec c-lang-defconst
+ (&define name [&optional stringp] [&rest sexp def-form])))
+
+(defun c-define-lang-constant (name bindings &optional pre-files)
+ ;; Used by `c-lang-defconst'. This function does not do any hidden
+ ;; buffer changes.
+
+ (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)))
+
+ ;;(when (cdr-safe elem)
+ ;; (message "Language constant %s redefined in %S" name file))
+
+ ;; Note that the order in the source alist is relevant. Like how
+ ;; `c-lang-defconst' reverses the bindings, this reverses the
+ ;; order between files so that the last to evaluate comes first.
+ (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)
+
+ ;; Bind the symbol as a variable, or clear any earlier evaluated
+ ;; value it has.
+ (set sym nil)
+
+ ;; Clear the evaluated values that depend on this source.
+ (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.
+
+This macro does not do any hidden buffer changes."
+
+ (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)
+
+ (if lang
+ (progn
+ (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 c-buffer-is-cc-mode
+ (setq lang c-buffer-is-cc-mode)
+ (or c-langs-are-parametric
+ (error
+ "`c-lang-const' requires a literal language in this context"))))
+
+ (if (eq c-lang-const-expansion 'immediate)
+ ;; No need to find out the source file(s) when we evaluate
+ ;; immediately since all the info is already there in the
+ ;; `source' property.
+ `',(c-get-lang-constant name nil mode)
+
+ (let ((file (c-get-current-file)))
+ (if file (setq file (intern file)))
+ ;; Get the source file(s) that must be loaded to get the value
+ ;; of the constant. If the symbol isn't defined yet we assume
+ ;; that its definition will come later in this file, and thus
+ ;; are no file dependencies needed.
+ (setq source-files (nreverse
+ ;; Reverse to get the right load order.
+ (mapcan (lambda (elem)
+ (if (eq file (car elem))
+ nil ; Exclude our own file.
+ (list (car elem))))
+ (get sym 'source)))))
+
+ ;; Spend some effort to make a compact call to
+ ;; `c-get-lang-constant' since it will be compiled in.
+ (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)
+ load-in-progress
+ (not (boundp 'byte-compile-dest-file))
+ (not (stringp byte-compile-dest-file)))
+ ;; Either a straight call is requested in the context, or
+ ;; we're not being byte compiled so the compile time stuff
+ ;; below is unnecessary.
+ `(c-get-lang-constant ',name ,@args)
+
+ ;; Being compiled. If the loading and compiling version is
+ ;; the same we use a value that is evaluated at compile time,
+ ;; otherwise it's evaluated at runtime.
+ `(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)
+ ;; Used by `c-lang-const'. This function does not do any hidden
+ ;; buffer changes.
+
+ (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))))
+
+ ;; Record the dependencies between this symbol and the one we're
+ ;; being evaluated in.
+ (when eval-in-sym
+ (or (memq eval-in-sym (get sym 'dependents))
+ (put sym 'dependents (cons eval-in-sym (get sym 'dependents)))))
+
+ ;; Make sure the source files have entries on the `source'
+ ;; property so that loading will take place when necessary.
+ (while source-files
+ (unless (assq (car source-files) source)
+ (put sym 'source
+ (setq source (cons (list (car source-files)) source)))
+ ;; Might pull in more definitions which affect the value. The
+ ;; clearing of dependent values etc is done when the
+ ;; definition is encountered during the load; this is just to
+ ;; jump past the check for a cached value below.
+ (set sym nil))
+ (setq source-files (cdr source-files)))
+
+ (if (and (boundp sym)
+ (setq elem (assq mode (symbol-value sym))))
+ (cdr elem)
+
+ ;; Check if an evaluation of this symbol is already underway.
+ ;; In that case we just continue with the "assignment" before
+ ;; the one currently being evaluated, thereby creating the
+ ;; illusion if a `setq'-like sequence of assignments.
+ (let* ((c-buffer-is-cc-mode mode)
+ (source-pos
+ (or (assq sym c-lang-constants-under-evaluation)
+ (cons sym (vector source nil))))
+ ;; Append `c-lang-constants-under-evaluation' even if an
+ ;; earlier entry is found. It's only necessary to get
+ ;; the recording of dependencies above correct.
+ (c-lang-constants-under-evaluation
+ (cons source-pos c-lang-constants-under-evaluation))
+ (fallback (get mode 'c-fallback-mode))
+ value
+ ;; Make sure the recursion limits aren't very low
+ ;; since the `c-lang-const' dependencies can go deep.
+ (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
+ ;; First try the original mode but don't accept an
+ ;; entry matching all languages since the fallback
+ ;; mode might have an explicit entry before that.
+ (eq (setq value (c-find-assignment-for-mode
+ (cdr source-pos) mode nil name))
+ c-lang-constants)
+ ;; Try again with the fallback mode from the
+ ;; original position. Note that
+ ;; `c-buffer-is-cc-mode' still is the real mode if
+ ;; language parameterization takes place.
+ (eq (setq value (c-find-assignment-for-mode
+ (setcdr source-pos backup-source-pos)
+ fallback t name))
+ c-lang-constants)))
+ ;; A simple lookup with no fallback mode.
+ (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
+ ;; Print a message to aid in locating the error. We don't
+ ;; print the error itself since that will be done later by
+ ;; some caller higher up.
+ (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)
+ ;; Find the first assignment entry that applies to MODE at or after
+ ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with `t' as
+ ;; the language list are considered to match, otherwise they don't.
+ ;; On return SOURCE-POS is updated to point to the next assignment
+ ;; after the returned one. If no assignment is found,
+ ;; `c-lang-constants' is returned as a magic value.
+ ;;
+ ;; SOURCE-POS is a vector that points out a specific assignment in
+ ;; the double alist that's used in the `source' property. The first
+ ;; element is the position in the top alist which is indexed with
+ ;; the source files, and the second element is the position in the
+ ;; nested bindings alist.
+ ;;
+ ;; NAME is only used for error messages.
+
+ (catch 'found
+ (let ((file-entry (elt source-pos 0))
+ (assignment-entry (elt source-pos 1))
+ assignment)
+
+ (while (if assignment-entry
+ t
+ ;; Handled the last assignment from one file, begin on the
+ ;; next. Due to the check in `c-lang-defconst', we know
+ ;; there's at least one.
+ (when file-entry
+
+ (unless (aset source-pos 1
+ (setq assignment-entry (cdar file-entry)))
+ ;; The file containing the source definitions has not
+ ;; been loaded.
+ (let ((file (symbol-name (caar file-entry)))
+ (c-lang-constants-under-evaluation nil))
+ ;;(message (concat "Loading %s to get the source "
+ ;; "value for language constant %s")
+ ;; file name)
+ (load file))
+
+ (unless (setq assignment-entry (cdar file-entry))
+ ;; The load didn't fill in the source for the
+ ;; constant as expected. The situation is
+ ;; probably that a derived mode was written for
+ ;; and compiled with another version of CC Mode,
+ ;; and the requested constant isn't in the
+ ;; currently loaded one. Put in a dummy
+ ;; assignment that matches no language.
+ (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)))
\f
(cc-provide 'cc-defs)
HCoop / bpt / emacs.git / blobdiff