diff options
Diffstat (limited to 'lisp/progmodes/cc-defs.el')
| -rw-r--r-- | lisp/progmodes/cc-defs.el | 1510 |
1 files changed, 1319 insertions, 191 deletions
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 25f31a0ec8c..2a0e5d23291 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1,10 +1,9 @@ ;;; 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 @@ -31,6 +30,9 @@ ;;; 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 @@ -39,9 +41,29 @@ (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+ + + +;; cc-fix.el contains compatibility macros that should be used if ;; needed. (eval-and-compile (if (or (not (fboundp 'functionp)) @@ -52,152 +74,488 @@ (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) -;;; 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) + + +;; 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)) + + +;;; 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)))) + + ;; 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)) + + +(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 @@ -208,6 +566,8 @@ (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 @@ -219,19 +579,21 @@ (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) @@ -240,31 +602,194 @@ continuations." (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))) + + +;; 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)))) + + ;; 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) @@ -274,60 +799,22 @@ continuations." (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. + +;;; 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))) @@ -341,9 +828,29 @@ continuations." (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)))) @@ -353,11 +860,15 @@ continuations." (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)) @@ -370,12 +881,16 @@ continuations." (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) @@ -387,8 +902,621 @@ continuations." ;; 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) + + +;;; 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")) + + +;;; 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))) (cc-provide 'cc-defs) |