Add arch taglines
[bpt/emacs.git] / lisp / progmodes / cc-defs.el
CommitLineData
3c3d11e7 1;;; cc-defs.el --- compile time definitions for CC Mode
785eecbb 2
d9e94c22 3;; Copyright (C) 1985,1987,1992-2003 Free Software Foundation, Inc.
785eecbb 4
d9e94c22
MS
5;; Authors: 1998- Martin Stjernholm
6;; 1992-1999 Barry A. Warsaw
785eecbb
RS
7;; 1987 Dave Detlefs and Stewart Clamen
8;; 1985 Richard M. Stallman
0ec8351b 9;; Maintainer: bug-cc-mode@gnu.org
785eecbb 10;; Created: 22-Apr-1997 (split from cc-mode.el)
81eb2ff9 11;; Version: See cc-mode.el
785eecbb
RS
12;; Keywords: c languages oop
13
14;; This file is part of GNU Emacs.
15
16;; GNU Emacs is free software; you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published by
18;; the Free Software Foundation; either version 2, or (at your option)
19;; any later version.
20
21;; GNU Emacs is distributed in the hope that it will be useful,
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
a66cd3ee 27;; along with GNU Emacs; see the file COPYING. If not, write to
130c507e 28;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
785eecbb
RS
29;; Boston, MA 02111-1307, USA.
30
3afbc435
PJ
31;;; Commentary:
32
d9e94c22
MS
33;; This file contains macros, defsubsts, and various other things that
34;; must be loaded early both during compilation and at runtime.
35
3afbc435
PJ
36;;; Code:
37
130c507e
GM
38(eval-when-compile
39 (let ((load-path
40 (if (and (boundp 'byte-compile-dest-file)
41 (stringp byte-compile-dest-file))
42 (cons (file-name-directory byte-compile-dest-file) load-path)
43 load-path)))
d9e94c22
MS
44 (load "cc-bytecomp" nil t)))
45
46;; `require' in XEmacs doesn't have the third NOERROR argument.
47(condition-case nil (require 'regexp-opt) (file-error nil))
0ec8351b 48
d9e94c22
MS
49;; Silence the compiler.
50(cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
51(cc-bytecomp-defvar c-emacs-features) ; In cc-vars.el
52(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
53(cc-bytecomp-defun region-active-p) ; XEmacs
54(cc-bytecomp-defvar zmacs-region-stays) ; XEmacs
55(cc-bytecomp-defvar zmacs-regions) ; XEmacs
56(cc-bytecomp-defvar mark-active) ; Emacs
57(cc-bytecomp-defvar deactivate-mark) ; Emacs
58(cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs
59(cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs 20+
60(cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21
61(cc-bytecomp-defvar lookup-syntax-properties) ; XEmacs 21
62(cc-bytecomp-defun string-to-syntax) ; Emacs 21
63(cc-bytecomp-defun regexp-opt-depth) ; (X)Emacs 20+
64
65\f
66;; cc-fix.el contains compatibility macros that should be used if
130c507e
GM
67;; needed.
68(eval-and-compile
69 (if (or (not (fboundp 'functionp))
70 (not (condition-case nil
71 (progn (eval '(char-before)) t)
72 (error nil)))
73 (not (condition-case nil
74 (progn (eval '(char-after)) t)
75 (error nil)))
76 (not (fboundp 'when))
d9e94c22
MS
77 (not (fboundp 'unless))
78 (not (fboundp 'regexp-opt))
79 (not (cc-bytecomp-fboundp 'regexp-opt-depth))
80 (/= (regexp-opt-depth "\\(\\(\\)\\)") 2))
81 (cc-load "cc-fix")
82 (defalias 'c-regexp-opt 'regexp-opt)
83 (defalias 'c-regexp-opt-depth 'regexp-opt-depth)))
130c507e 84
d9e94c22
MS
85(eval-after-load "font-lock"
86 '(if (and (not (featurep 'cc-fix)) ; only load the file once.
87 (let (font-lock-keywords)
88 (font-lock-compile-keywords '("\\<\\>"))
89 font-lock-keywords)) ; did the previous call foul this up?
90 (load "cc-fix")))
91
92;; The above takes care of the delayed loading, but this is necessary
93;; to ensure correct byte compilation.
94(eval-when-compile
95 (if (and (not (featurep 'cc-fix))
96 (progn
97 (require 'font-lock)
98 (let (font-lock-keywords)
99 (font-lock-compile-keywords '("\\<\\>"))
100 font-lock-keywords)))
101 (cc-load "cc-fix")))
102
103(cc-external-require 'cl)
0ec8351b
BW
104
105\f
d9e94c22
MS
106;;; Variables also used at compile time.
107
c577b222 108(defconst c-version "5.30.6"
d9e94c22
MS
109 "CC Mode version number.")
110
111(defconst c-version-sym (intern c-version))
112;; A little more compact and faster in comparisons.
113
114(defvar c-buffer-is-cc-mode nil
115 "Non-nil for all buffers with a major mode derived from CC Mode.
116Otherwise, this variable is nil. I.e. this variable is non-nil for
117`c-mode', `c++-mode', `objc-mode', `java-mode', `idl-mode',
118`pike-mode', and any other non-CC Mode mode that calls
119`c-initialize-cc-mode' (e.g. `awk-mode'). The value is the mode
120symbol itself (i.e. `c-mode' etc) of the original CC Mode mode, or
121just t if it's not known.")
122(make-variable-buffer-local 'c-buffer-is-cc-mode)
123
124;; Have to make `c-buffer-is-cc-mode' permanently local so that it
125;; survives the initialization of the derived mode.
126(put 'c-buffer-is-cc-mode 'permanent-local t)
127
128\f
129;; The following is used below during compilation.
130(eval-and-compile
131 (defvar c-inside-eval-when-compile nil)
130c507e 132
d9e94c22
MS
133 (defmacro cc-eval-when-compile (&rest body)
134 "Like `progn', but evaluates the body at compile time.
135The result of the body appears to the compiler as a quoted constant.
136
137This variant works around bugs in `eval-when-compile' in various
138\(X)Emacs versions. See cc-defs.el for details."
139
140 (if c-inside-eval-when-compile
141 ;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it
142 ;; evaluates its body at macro expansion time if it's nested
143 ;; inside another `eval-when-compile'. So we use a dynamically
144 ;; bound variable to avoid nesting them.
145 `(progn ,@body)
146
147 `(eval-when-compile
148 ;; In all (X)Emacsen so far, `eval-when-compile' byte compiles
149 ;; its contents before evaluating it. That can cause forms to
150 ;; be compiled in situations they aren't intended to be
151 ;; compiled.
152 ;;
153 ;; Example: It's not possible to defsubst a primitive, e.g. the
154 ;; following will produce an error (in any emacs flavor), since
155 ;; `nthcdr' is a primitive function that's handled specially by
156 ;; the byte compiler and thus can't be redefined:
157 ;;
158 ;; (defsubst nthcdr (val) val)
159 ;;
160 ;; `defsubst', like `defmacro', needs to be evaluated at
161 ;; compile time, so this will produce an error during byte
162 ;; compilation.
163 ;;
164 ;; CC Mode occasionally needs to do things like this for
165 ;; cross-emacs compatibility. It therefore uses the following
166 ;; to conditionally do a `defsubst':
167 ;;
168 ;; (eval-when-compile
169 ;; (if (not (fboundp 'foo))
170 ;; (defsubst foo ...)))
171 ;;
172 ;; But `eval-when-compile' byte compiles its contents and
173 ;; _then_ evaluates it (in all current emacs versions, up to
174 ;; and including Emacs 20.6 and XEmacs 21.1 as of this
175 ;; writing). So this will still produce an error, since the
176 ;; byte compiler will get to the defsubst anyway. That's
177 ;; arguably a bug because the point with `eval-when-compile' is
178 ;; that it should evaluate rather than compile its contents.
179 ;;
180 ;; We get around it by expanding the body to a quoted
181 ;; constant that we eval. That otoh introduce a problem in
182 ;; that a returned lambda expression doesn't get byte
183 ;; compiled (even if `function' is used).
184 (eval '(let ((c-inside-eval-when-compile t)) ,@body)))))
185
186 (put 'cc-eval-when-compile 'lisp-indent-hook 0))
187
188\f
189;;; Macros.
130c507e
GM
190
191(defmacro c-point (position &optional point)
d9e94c22
MS
192 "Return the value of certain commonly referenced POSITIONs relative to POINT.
193The current point is used if POINT isn't specified. POSITION can be
194one of the following symbols:
195
196`bol' -- beginning of line
197`eol' -- end of line
198`bod' -- beginning of defun
199`eod' -- end of defun
200`boi' -- beginning of indentation
201`ionl' -- indentation of next line
202`iopl' -- indentation of previous line
203`bonl' -- beginning of next line
204`eonl' -- end of next line
205`bopl' -- beginning of previous line
206`eopl' -- end of previous line
207
208If the referenced position doesn't exist, the closest accessible point
209to it is returned. This function does not modify point or mark.
210
211This function does not do any hidden buffer changes."
212
213 (if (eq (car-safe position) 'quote)
214 (let ((position (eval position)))
215 (cond
216
217 ((eq position 'bol)
218 (if (and (fboundp 'line-beginning-position) (not point))
219 `(line-beginning-position)
220 `(save-excursion
221 ,@(if point `((goto-char ,point)))
222 (beginning-of-line)
223 (point))))
224
225 ((eq position 'eol)
226 (if (and (fboundp 'line-end-position) (not point))
227 `(line-end-position)
228 `(save-excursion
229 ,@(if point `((goto-char ,point)))
230 (end-of-line)
231 (point))))
232
233 ((eq position 'boi)
234 `(save-excursion
235 ,@(if point `((goto-char ,point)))
236 (back-to-indentation)
237 (point)))
238
239 ((eq position 'bod)
240 `(save-excursion
241 ,@(if point `((goto-char ,point)))
242 (c-beginning-of-defun-1)
243 (point)))
244
245 ((eq position 'eod)
246 `(save-excursion
247 ,@(if point `((goto-char ,point)))
248 (c-end-of-defun-1)
249 (point)))
250
251 ((eq position 'bopl)
252 (if (and (fboundp 'line-beginning-position) (not point))
253 `(line-beginning-position 0)
254 `(save-excursion
255 ,@(if point `((goto-char ,point)))
256 (forward-line -1)
257 (point))))
258
259 ((eq position 'bonl)
260 (if (and (fboundp 'line-beginning-position) (not point))
261 `(line-beginning-position 2)
262 `(save-excursion
263 ,@(if point `((goto-char ,point)))
264 (forward-line 1)
265 (point))))
266
267 ((eq position 'eopl)
268 (if (and (fboundp 'line-end-position) (not point))
269 `(line-end-position 0)
270 `(save-excursion
271 ,@(if point `((goto-char ,point)))
272 (beginning-of-line)
273 (or (bobp) (backward-char))
274 (point))))
275
276 ((eq position 'eonl)
277 (if (and (fboundp 'line-end-position) (not point))
278 `(line-end-position 2)
279 `(save-excursion
280 ,@(if point `((goto-char ,point)))
281 (forward-line 1)
282 (end-of-line)
283 (point))))
284
285 ((eq position 'iopl)
286 `(save-excursion
287 ,@(if point `((goto-char ,point)))
288 (forward-line -1)
289 (back-to-indentation)
290 (point)))
291
292 ((eq position 'ionl)
293 `(save-excursion
294 ,@(if point `((goto-char ,point)))
295 (forward-line 1)
296 (back-to-indentation)
297 (point)))
298
299 (t (error "Unknown buffer position requested: %s" position))))
300
301 ;;(message "c-point long expansion")
302 `(save-excursion
303 ,@(if point `((goto-char ,point)))
304 (let ((position ,position))
305 (cond
306 ((eq position 'bol) (beginning-of-line))
307 ((eq position 'eol) (end-of-line))
308 ((eq position 'boi) (back-to-indentation))
309 ((eq position 'bod) (c-beginning-of-defun-1))
310 ((eq position 'eod) (c-end-of-defun-1))
311 ((eq position 'bopl) (forward-line -1))
312 ((eq position 'bonl) (forward-line 1))
313 ((eq position 'eopl) (progn
314 (beginning-of-line)
315 (or (bobp) (backward-char))))
316 ((eq position 'eonl) (progn
317 (forward-line 1)
318 (end-of-line)))
319 ((eq position 'iopl) (progn
320 (forward-line -1)
321 (back-to-indentation)))
322 ((eq position 'ionl) (progn
323 (forward-line 1)
324 (back-to-indentation)))
325 (t (error "Unknown buffer position requested: %s" position))))
326 (point))))
785eecbb
RS
327
328(defmacro c-safe (&rest body)
329 ;; safely execute BODY, return nil if an error occurred
d9e94c22
MS
330 ;;
331 ;; This function does not do any hidden buffer changes.
51f606de
GM
332 `(condition-case nil
333 (progn ,@body)
334 (error nil)))
a66cd3ee 335(put 'c-safe 'lisp-indent-function 0)
51f606de 336
d9e94c22
MS
337;; The following is essentially `save-buffer-state' from lazy-lock.el.
338;; It ought to be a standard macro.
339(defmacro c-save-buffer-state (varlist &rest body)
340 "Bind variables according to VARLIST (in `let*' style) and eval BODY,
341then restore the buffer state under the assumption that no significant
342modification has been made. A change is considered significant if it
343affects the buffer text in any way that isn't completely restored
344again. Changes in text properties like `face' or `syntax-table' are
345considered insignificant. This macro allows text properties to be
346changed, even in a read-only buffer.
347
348The return value is the value of the last form in BODY."
349 `(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
350 (inhibit-read-only t) (inhibit-point-motion-hooks t)
351 before-change-functions after-change-functions
352 deactivate-mark
353 ,@varlist)
354 (prog1 (progn ,@body)
355 (and (not modified)
356 (buffer-modified-p)
357 (set-buffer-modified-p nil)))))
358(put 'c-save-buffer-state 'lisp-indent-function 1)
130c507e 359
d9e94c22
MS
360(defmacro c-forward-syntactic-ws (&optional limit)
361 "Forward skip over syntactic whitespace.
362Syntactic whitespace is defined as whitespace characters, comments,
363and preprocessor directives. However if point starts inside a comment
364or preprocessor directive, the content of it is not treated as
365whitespace.
366
367LIMIT sets an upper limit of the forward movement, if specified. If
368LIMIT or the end of the buffer is reached inside a comment or
369preprocessor directive, the point will be left there.
370
371Note that this function might do hidden buffer changes. See the
372comment at the start of cc-engine.el for more info."
373 (if limit
374 `(save-restriction
375 (narrow-to-region (point-min) (or ,limit (point-max)))
376 (c-forward-sws))
377 '(c-forward-sws)))
378
379(defmacro c-backward-syntactic-ws (&optional limit)
380 "Backward skip over syntactic whitespace.
381Syntactic whitespace is defined as whitespace characters, comments,
382and preprocessor directives. However if point starts inside a comment
383or preprocessor directive, the content of it is not treated as
384whitespace.
385
386LIMIT sets a lower limit of the backward movement, if specified. If
387LIMIT is reached inside a line comment or preprocessor directive then
388the point is moved into it past the whitespace at the end.
389
390Note that this function might do hidden buffer changes. See the
391comment at the start of cc-engine.el for more info."
392 (if limit
393 `(save-restriction
394 (narrow-to-region (or ,limit (point-min)) (point-max))
395 (c-backward-sws))
396 '(c-backward-sws)))
397
398(defmacro c-forward-sexp (&optional count)
399 "Move forward across COUNT balanced expressions.
400A negative COUNT means move backward. Signal an error if the move
401fails for any reason.
402
403This is like `forward-sexp' except that it isn't interactive and does
404not do any user friendly adjustments of the point and that it isn't
405susceptible to user configurations such as disabling of signals in
406certain situations.
407
408This function does not do any hidden buffer changes."
409 (or count (setq count 1))
410 `(goto-char (or (scan-sexps (point) ,count)
411 ,(if (numberp count)
412 (if (> count 0) `(point-max) `(point-min))
413 `(if (> ,count 0) (point-max) (point-min))))))
414
415(defmacro c-backward-sexp (&optional count)
416 "See `c-forward-sexp' and reverse directions."
417 (or count (setq count 1))
418 `(c-forward-sexp ,(if (numberp count) (- count) `(- ,count))))
419
420(defmacro c-safe-scan-lists (from count depth)
421 "Like `scan-lists' but returns nil instead of signalling errors.
422
423This function does not do any hidden buffer changes."
424 (if (featurep 'xemacs)
425 `(scan-lists ,from ,count ,depth nil t)
426 `(c-safe (scan-lists ,from ,count ,depth))))
427
428\f
a66cd3ee
MS
429;; Wrappers for common scan-lists cases, mainly because it's almost
430;; impossible to get a feel for how that function works.
d9e94c22
MS
431
432(defmacro c-up-list-forward (&optional pos)
433 "Return the first position after the list sexp containing POS,
434or nil if no such position exists. The point is used if POS is left out.
435
436This function does not do any hidden buffer changes."
437 `(c-safe-scan-lists ,(or pos `(point)) 1 1))
438
439(defmacro c-up-list-backward (&optional pos)
440 "Return the position of the start of the list sexp containing POS,
441or nil if no such position exists. The point is used if POS is left out.
442
443This function does not do any hidden buffer changes."
444 `(c-safe-scan-lists ,(or pos `(point)) -1 1))
445
446(defmacro c-down-list-forward (&optional pos)
447 "Return the first position inside the first list sexp after POS,
448or nil if no such position exists. The point is used if POS is left out.
449
450This function does not do any hidden buffer changes."
451 `(c-safe-scan-lists ,(or pos `(point)) 1 -1))
452
453(defmacro c-down-list-backward (&optional pos)
454 "Return the last position inside the last list sexp before POS,
455or nil if no such position exists. The point is used if POS is left out.
456
457This function does not do any hidden buffer changes."
458 `(c-safe-scan-lists ,(or pos `(point)) -1 -1))
459
460(defmacro c-go-up-list-forward (&optional pos)
461 "Move the point to the first position after the list sexp containing POS,
462or the point if POS is left out. Return t if such a position exists,
463otherwise nil is returned and the point isn't moved.
464
465This function does not do any hidden buffer changes."
466 `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 1)) t))
467
468(defmacro c-go-up-list-backward (&optional pos)
469 "Move the point to the position of the start of the list sexp containing POS,
470or the point if POS is left out. Return t if such a position exists,
471otherwise nil is returned and the point isn't moved.
472
473This function does not do any hidden buffer changes."
474 `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 1)) t))
475
476(defmacro c-go-down-list-forward (&optional pos)
477 "Move the point to the first position inside the first list sexp after POS,
478or the point if POS is left out. Return t if such a position exists,
479otherwise nil is returned and the point isn't moved.
480
481This function does not do any hidden buffer changes."
482 `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 -1)) t))
483
484(defmacro c-go-down-list-backward (&optional pos)
485 "Move the point to the last position inside the last list sexp before POS,
486or the point if POS is left out. Return t if such a position exists,
487otherwise nil is returned and the point isn't moved.
488
489This function does not do any hidden buffer changes."
490 `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 -1)) t))
491
492\f
493(defmacro c-beginning-of-defun-1 ()
494 ;; Wrapper around beginning-of-defun.
495 ;;
496 ;; NOTE: This function should contain the only explicit use of
497 ;; beginning-of-defun in CC Mode. Eventually something better than
498 ;; b-o-d will be available and this should be the only place the
499 ;; code needs to change. Everything else should use
500 ;; (c-beginning-of-defun-1)
501 ;;
502 ;; This is really a bit too large to be a macro but that isn't a
503 ;; problem as long as it only is used in one place in
504 ;; `c-parse-state'.
505 ;;
506 ;; This function does not do any hidden buffer changes.
507
508 `(progn
509 (if (and ,(cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
510 c-enable-xemacs-performance-kludge-p)
511 ,(when (cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
512 ;; XEmacs only. This can improve the performance of
513 ;; c-parse-state to between 3 and 60 times faster when
514 ;; braces are hung. It can also degrade performance by
515 ;; about as much when braces are not hung.
516 '(let (pos)
517 (while (not pos)
518 (save-restriction
519 (widen)
520 (setq pos (c-safe-scan-lists
521 (point) -1 (buffer-syntactic-context-depth))))
522 (cond
523 ((bobp) (setq pos (point-min)))
524 ((not pos)
525 (let ((distance (skip-chars-backward "^{")))
526 ;; unbalanced parenthesis, while illegal C code,
527 ;; shouldn't cause an infloop! See unbal.c
528 (when (zerop distance)
529 ;; Punt!
530 (beginning-of-defun)
531 (setq pos (point)))))
532 ((= pos 0))
533 ((not (eq (char-after pos) ?{))
534 (goto-char pos)
535 (setq pos nil))
536 ))
537 (goto-char pos)))
538 ;; Emacs, which doesn't have buffer-syntactic-context-depth
539 (beginning-of-defun))
540 ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at the
541 ;; open brace.
542 (and defun-prompt-regexp
543 (looking-at defun-prompt-regexp)
544 (goto-char (match-end 0)))))
a66cd3ee
MS
545
546(defmacro c-benign-error (format &rest args)
547 ;; Formats an error message for the echo area and dings, i.e. like
548 ;; `error' but doesn't abort.
d9e94c22
MS
549 ;;
550 ;; This function does not do any hidden buffer changes.
a66cd3ee
MS
551 `(progn
552 (message ,format ,@args)
553 (ding)))
130c507e
GM
554
555(defmacro c-update-modeline ()
556 ;; set the c-auto-hungry-string for the correct designation on the modeline
d9e94c22
MS
557 ;;
558 ;; This function does not do any hidden buffer changes.
130c507e
GM
559 `(progn
560 (setq c-auto-hungry-string
561 (if c-auto-newline
562 (if c-hungry-delete-key "/ah" "/a")
563 (if c-hungry-delete-key "/h" nil)))
564 (force-mode-line-update)))
565
566(defmacro c-with-syntax-table (table &rest code)
567 ;; Temporarily switches to the specified syntax table in a failsafe
568 ;; way to execute code.
d9e94c22
MS
569 ;;
570 ;; This function does not do any hidden buffer changes.
130c507e
GM
571 `(let ((c-with-syntax-table-orig-table (syntax-table)))
572 (unwind-protect
573 (progn
574 (set-syntax-table ,table)
575 ,@code)
576 (set-syntax-table c-with-syntax-table-orig-table))))
577(put 'c-with-syntax-table 'lisp-indent-function 1)
578
a66cd3ee
MS
579(defmacro c-skip-ws-forward (&optional limit)
580 "Skip over any whitespace following point.
581This function skips over horizontal and vertical whitespace and line
d9e94c22
MS
582continuations.
583
584This function does not do any hidden buffer changes."
a66cd3ee 585 (if limit
d9e94c22 586 `(let ((limit (or ,limit (point-max))))
a66cd3ee
MS
587 (while (progn
588 ;; skip-syntax-* doesn't count \n as whitespace..
d9e94c22 589 (skip-chars-forward " \t\n\r\f\v" limit)
a66cd3ee 590 (when (and (eq (char-after) ?\\)
d9e94c22 591 (< (point) limit))
a66cd3ee
MS
592 (forward-char)
593 (or (eolp)
594 (progn (backward-char) nil))))))
595 '(while (progn
d9e94c22 596 (skip-chars-forward " \t\n\r\f\v")
a66cd3ee
MS
597 (when (eq (char-after) ?\\)
598 (forward-char)
599 (or (eolp)
600 (progn (backward-char) nil)))))))
601
602(defmacro c-skip-ws-backward (&optional limit)
603 "Skip over any whitespace preceding point.
604This function skips over horizontal and vertical whitespace and line
d9e94c22
MS
605continuations.
606
607This function does not do any hidden buffer changes."
a66cd3ee 608 (if limit
d9e94c22 609 `(let ((limit (or ,limit (point-min))))
a66cd3ee
MS
610 (while (progn
611 ;; skip-syntax-* doesn't count \n as whitespace..
d9e94c22 612 (skip-chars-backward " \t\n\r\f\v" limit)
a66cd3ee
MS
613 (and (eolp)
614 (eq (char-before) ?\\)
d9e94c22 615 (> (point) limit)))
a66cd3ee
MS
616 (backward-char)))
617 '(while (progn
d9e94c22 618 (skip-chars-backward " \t\n\r\f\v")
a66cd3ee
MS
619 (and (eolp)
620 (eq (char-before) ?\\)))
621 (backward-char))))
622
d9e94c22
MS
623(defmacro c-major-mode-is (mode)
624 "Return non-nil if the current CC Mode major mode is MODE.
625MODE is either a mode symbol or a list of mode symbols.
626
627This function does not do any hidden buffer changes."
628 (if (eq (car-safe mode) 'quote)
629 (let ((mode (eval mode)))
630 (if (listp mode)
631 `(memq c-buffer-is-cc-mode ',mode)
632 `(eq c-buffer-is-cc-mode ',mode)))
633 `(let ((mode ,mode))
634 (if (listp mode)
635 (memq c-buffer-is-cc-mode mode)
636 (eq c-buffer-is-cc-mode mode)))))
637
638(defmacro c-parse-sexp-lookup-properties ()
639 ;; Return the value of the variable that says whether the
640 ;; syntax-table property affects the sexp routines. Always return
641 ;; nil in (X)Emacsen without support for that.
642 ;;
643 ;; This function does not do any hidden buffer changes.
644 (cond ((cc-bytecomp-boundp 'parse-sexp-lookup-properties)
645 `parse-sexp-lookup-properties)
646 ((cc-bytecomp-boundp 'lookup-syntax-properties)
647 `lookup-syntax-properties)
648 (t nil)))
649
650\f
651;; Macros/functions to handle so-called "char properties", which are
652;; properties set on a single character and that never spreads to any
653;; other characters.
654
655(eval-and-compile
656 ;; Constant used at compile time to decide whether or not to use
657 ;; XEmacs extents. Check all the extent functions we'll use since
658 ;; some packages might add compatibility aliases for some of them in
659 ;; Emacs.
660 (defconst c-use-extents (and (cc-bytecomp-fboundp 'extent-at)
661 (cc-bytecomp-fboundp 'set-extent-property)
662 (cc-bytecomp-fboundp 'set-extent-properties)
663 (cc-bytecomp-fboundp 'make-extent)
664 (cc-bytecomp-fboundp 'extent-property)
665 (cc-bytecomp-fboundp 'delete-extent)
666 (cc-bytecomp-fboundp 'map-extents))))
667
668;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to
669;; make it a function.
670(defalias 'c-put-char-property-fun
671 (cc-eval-when-compile
672 (cond (c-use-extents
673 ;; XEmacs.
674 (byte-compile
675 (lambda (pos property value)
676 (let ((ext (extent-at pos nil property)))
677 (if ext
678 (set-extent-property ext property value)
679 (set-extent-properties (make-extent pos (1+ pos))
680 (cons property
681 (cons value
682 '(start-open t
683 end-open t)))))))))
684
685 ((not (cc-bytecomp-boundp 'text-property-default-nonsticky))
686 ;; In Emacs < 21 we have to mess with the `rear-nonsticky' property.
687 (byte-compile
688 (lambda (pos property value)
689 (put-text-property pos (1+ pos) property value)
690 (let ((prop (get-text-property pos 'rear-nonsticky)))
691 (or (memq property prop)
692 (put-text-property pos (1+ pos)
693 'rear-nonsticky
694 (cons property prop))))))))))
695(cc-bytecomp-defun c-put-char-property-fun) ; Make it known below.
696
697(defmacro c-put-char-property (pos property value)
698 ;; Put the given property with the given value on the character at
699 ;; POS and make it front and rear nonsticky, or start and end open
700 ;; in XEmacs vocabulary. If the character already has the given
701 ;; property then the value is replaced, and the behavior is
702 ;; undefined if that property has been put by some other function.
703 ;; PROPERTY is assumed to be constant.
704 ;;
705 ;; If there's a `text-property-default-nonsticky' variable (Emacs
706 ;; 21) then it's assumed that the property is present on it.
707 (setq property (eval property))
708 (if (or c-use-extents
709 (not (cc-bytecomp-boundp 'text-property-default-nonsticky)))
710 ;; XEmacs and Emacs < 21.
711 `(c-put-char-property-fun ,pos ',property ,value)
712 ;; In Emacs 21 we got the `rear-nonsticky' property covered
713 ;; by `text-property-default-nonsticky'.
714 `(let ((-pos- ,pos))
715 (put-text-property -pos- (1+ -pos-) ',property ,value))))
716
717(defmacro c-get-char-property (pos property)
718 ;; Get the value of the given property on the character at POS if
719 ;; it's been put there by `c-put-char-property'. PROPERTY is
720 ;; assumed to be constant.
721 (setq property (eval property))
722 (if c-use-extents
723 ;; XEmacs.
724 `(let ((ext (extent-at ,pos nil ',property)))
725 (if ext (extent-property ext ',property)))
726 ;; Emacs.
727 `(get-text-property ,pos ',property)))
728
729;; `c-clear-char-property' is complex enough in Emacs < 21 to make it
730;; a function, since we have to mess with the `rear-nonsticky' property.
731(defalias 'c-clear-char-property-fun
732 (cc-eval-when-compile
733 (unless (or c-use-extents
734 (cc-bytecomp-boundp 'text-property-default-nonsticky))
735 (byte-compile
736 (lambda (pos property)
737 (when (get-text-property pos property)
738 (remove-text-properties pos (1+ pos) (list property nil))
739 (put-text-property pos (1+ pos)
740 'rear-nonsticky
741 (delq property (get-text-property
742 pos 'rear-nonsticky)))))))))
743(cc-bytecomp-defun c-clear-char-property-fun) ; Make it known below.
744
745(defmacro c-clear-char-property (pos property)
746 ;; Remove the given property on the character at POS if it's been put
747 ;; there by `c-put-char-property'. PROPERTY is assumed to be
748 ;; constant.
749 (setq property (eval property))
750 (cond (c-use-extents
751 ;; XEmacs.
752 `(let ((ext (extent-at ,pos nil ',property)))
753 (if ext (delete-extent ext))))
754 ((cc-bytecomp-boundp 'text-property-default-nonsticky)
755 ;; In Emacs 21 we got the `rear-nonsticky' property covered
756 ;; by `text-property-default-nonsticky'.
757 `(let ((pos ,pos))
758 (remove-text-properties pos (1+ pos)
759 '(,property nil))))
760 (t
761 ;; Emacs < 21.
762 `(c-clear-char-property-fun ,pos ',property))))
763
764(defmacro c-clear-char-properties (from to property)
765 ;; Remove all the occurences of the given property in the given
766 ;; region that has been put with `c-put-char-property'. PROPERTY is
767 ;; assumed to be constant.
768 ;;
769 ;; Note that this function does not clean up the property from the
770 ;; lists of the `rear-nonsticky' properties in the region, if such
771 ;; are used. Thus it should not be used for common properties like
772 ;; `syntax-table'.
773 (setq property (eval property))
774 (if c-use-extents
775 ;; XEmacs.
776 `(map-extents (lambda (ext ignored)
777 (delete-extent ext))
778 nil ,from ,to nil nil ',property)
779 ;; Emacs.
780 `(remove-text-properties ,from ,to '(,property nil))))
781
782\f
a66cd3ee
MS
783;; Make edebug understand the macros.
784(eval-after-load "edebug"
785 '(progn
d9e94c22 786 (def-edebug-spec c-point t)
a66cd3ee 787 (def-edebug-spec c-safe t)
d9e94c22
MS
788 (def-edebug-spec c-save-buffer-state let*)
789 (def-edebug-spec c-forward-syntactic-ws t)
790 (def-edebug-spec c-backward-syntactic-ws t)
791 (def-edebug-spec c-forward-sexp t)
792 (def-edebug-spec c-backward-sexp t)
a66cd3ee
MS
793 (def-edebug-spec c-up-list-forward t)
794 (def-edebug-spec c-up-list-backward t)
795 (def-edebug-spec c-down-list-forward t)
796 (def-edebug-spec c-down-list-backward t)
797 (def-edebug-spec c-add-syntax t)
798 (def-edebug-spec c-add-class-syntax t)
799 (def-edebug-spec c-benign-error t)
800 (def-edebug-spec c-with-syntax-table t)
801 (def-edebug-spec c-skip-ws-forward t)
d9e94c22
MS
802 (def-edebug-spec c-skip-ws-backward t)
803 (def-edebug-spec c-major-mode-is t)
804 (def-edebug-spec c-put-char-property t)
805 (def-edebug-spec c-get-char-property t)
806 (def-edebug-spec c-clear-char-property t)
807 (def-edebug-spec c-clear-char-properties t)
808 (def-edebug-spec cc-eval-when-compile t)))
a66cd3ee 809
d9e94c22
MS
810\f
811;;; Functions.
130c507e
GM
812
813;; Note: All these after the macros, to be on safe side in avoiding
814;; bugs where macros are defined too late. These bugs often only show
815;; when the files are compiled in a certain order within the same
816;; session.
817
51f606de
GM
818(defsubst c-end-of-defun-1 ()
819 ;; Replacement for end-of-defun that use c-beginning-of-defun-1.
bbfbe5ec
GM
820 (let ((start (point)))
821 ;; Skip forward into the next defun block. Don't bother to avoid
822 ;; comments, literals etc, since beginning-of-defun doesn't do that
823 ;; anyway.
824 (skip-chars-forward "^}")
825 (c-beginning-of-defun-1)
826 (if (eq (char-after) ?{)
827 (c-forward-sexp))
828 (if (< (point) start)
829 (goto-char (point-max)))))
785eecbb 830
d9e94c22
MS
831(defconst c-<-as-paren-syntax '(4 . ?>))
832
833(defsubst c-mark-<-as-paren (pos)
834 ;; Mark the "<" character at POS as an sexp list opener using the
835 ;; syntax-table property. Note that Emacs 19 and XEmacs <= 20
836 ;; doesn't support syntax properties, so this function might not
837 ;; have any effect.
838 (c-put-char-property pos 'syntax-table c-<-as-paren-syntax))
839
840(defconst c->-as-paren-syntax '(5 . ?<))
841
842(defsubst c-mark->-as-paren (pos)
843 ;; Mark the ">" character at POS as an sexp list closer using the
844 ;; syntax-table property. Note that Emacs 19 and XEmacs <= 20
845 ;; doesn't support syntax properties, so this function might not
846 ;; have any effect.
847 (c-put-char-property pos 'syntax-table c->-as-paren-syntax))
848
785eecbb
RS
849(defsubst c-intersect-lists (list alist)
850 ;; return the element of ALIST that matches the first element found
851 ;; in LIST. Uses assq.
d9e94c22
MS
852 ;;
853 ;; This function does not do any hidden buffer changes.
785eecbb
RS
854 (let (match)
855 (while (and list
856 (not (setq match (assq (car list) alist))))
857 (setq list (cdr list)))
858 match))
859
860(defsubst c-lookup-lists (list alist1 alist2)
861 ;; first, find the first entry from LIST that is present in ALIST1,
862 ;; then find the entry in ALIST2 for that entry.
d9e94c22
MS
863 ;;
864 ;; This function does not do any hidden buffer changes.
785eecbb
RS
865 (assq (car (c-intersect-lists list alist1)) alist2))
866
117679f7
MS
867(defsubst c-langelem-sym (langelem)
868 "Return the syntactic symbol in LANGELEM.
869
870LANGELEM is a syntactic element, i.e. either a cons cell on the
871\"old\" form given as the first argument to lineup functions or a list
872on the \"new\" form as used in `c-syntactic-element'.
873
874This function does not do any hidden buffer changes."
875 (car langelem))
876
877(defsubst c-langelem-pos (langelem)
878 "Return the (primary) anchor position in LANGELEM, or nil if there is none.
879
880LANGELEM is a syntactic element, i.e. either a cons cell on the
881\"old\" form given as the first argument to lineup functions or a list
882on the \"new\" form as used in `c-syntactic-element'.
883
884This function does not do any hidden buffer changes."
885 (if (consp (cdr langelem))
886 (car-safe (cdr langelem))
887 (cdr langelem)))
888
889(defun c-langelem-col (langelem &optional preserve-point)
890 "Return the column of the (primary) anchor position in LANGELEM.
891Leave point at that position unless PRESERVE-POINT is non-nil.
892
893LANGELEM is a syntactic element, i.e. either a cons cell on the
894\"old\" form given as the first argument to lineup functions or a list
895on the \"new\" form as used in `c-syntactic-element'.
896
897This function does not do any hidden buffer changes."
898 (let ((pos (c-langelem-pos langelem))
899 (here (point)))
900 (if pos
901 (progn
902 (goto-char pos)
903 (prog1 (current-column)
904 (if preserve-point
905 (goto-char here))))
906 0)))
907
908(defsubst c-langelem-2nd-pos (langelem)
909 "Return the secondary position in LANGELEM, or nil if there is none.
910
911LANGELEM is a syntactic element, typically on the \"new\" form as used
912in `c-syntactic-element'. It may be on the \"old\" form that is used
913as the first argument to lineup functions, but then the returned value
914always will be nil.
d9e94c22
MS
915
916This function does not do any hidden buffer changes."
117679f7 917 (car-safe (cdr-safe (cdr-safe langelem))))
785eecbb 918
785eecbb
RS
919(defsubst c-keep-region-active ()
920 ;; Do whatever is necessary to keep the region active in XEmacs.
130c507e 921 ;; This is not needed for Emacs.
d9e94c22
MS
922 ;;
923 ;; This function does not do any hidden buffer changes.
785eecbb
RS
924 (and (boundp 'zmacs-region-stays)
925 (setq zmacs-region-stays t)))
926
0ec8351b
BW
927(defsubst c-region-is-active-p ()
928 ;; Return t when the region is active. The determination of region
929 ;; activeness is different in both Emacs and XEmacs.
d9e94c22
MS
930 ;;
931 ;; This function does not do any hidden buffer changes.
0ec8351b
BW
932 (cond
933 ;; XEmacs
934 ((and (fboundp 'region-active-p)
51f606de 935 (boundp 'zmacs-regions)
0ec8351b
BW
936 zmacs-regions)
937 (region-active-p))
938 ;; Emacs
939 ((boundp 'mark-active) mark-active)
940 ;; fallback; shouldn't get here
941 (t (mark t))))
942
d9e94c22
MS
943(put 'c-mode 'c-mode-prefix "c-")
944(put 'c++-mode 'c-mode-prefix "c++-")
945(put 'objc-mode 'c-mode-prefix "objc-")
946(put 'java-mode 'c-mode-prefix "java-")
947(put 'idl-mode 'c-mode-prefix "idl-")
948(put 'pike-mode 'c-mode-prefix "pike-")
949(put 'awk-mode 'c-mode-prefix "awk-")
950
951(defsubst c-mode-symbol (suffix)
952 "Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
953the corresponding symbol.
954
955This function does not do any hidden buffer changes."
956 (or c-buffer-is-cc-mode
957 (error "Not inside a CC Mode based mode"))
958 (let ((mode-prefix (get c-buffer-is-cc-mode 'c-mode-prefix)))
959 (or mode-prefix
960 (error "%S has no mode prefix known to `c-mode-symbol'"
961 c-buffer-is-cc-mode))
962 (intern (concat mode-prefix suffix))))
963
964(defsubst c-mode-var (suffix)
965 "Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
966the value of the variable with that name.
967
968This function does not do any hidden buffer changes."
969 (symbol-value (c-mode-symbol suffix)))
970
971(defsubst c-mode-is-new-awk-p ()
972 ;; Is the current mode the "new" awk mode? It is important for
973 ;; (e.g.) the cc-engine functions do distinguish between the old and
974 ;; new awk-modes.
975 (and (c-major-mode-is 'awk-mode)
976 (memq 'syntax-properties c-emacs-features)))
977
978(defsubst c-got-face-at (pos faces)
979 "Return non-nil if position POS in the current buffer has any of the
980faces in the list FACES.
981
982This function does not do any hidden buffer changes."
983 (let ((pos-faces (get-text-property pos 'face)))
984 (if (consp pos-faces)
985 (progn
986 (while (and pos-faces
987 (not (memq (car pos-faces) faces)))
988 (setq pos-faces (cdr pos-faces)))
989 pos-faces)
990 (memq pos-faces faces))))
991
992(defsubst c-face-name-p (facename)
993 ;; Return t if FACENAME is the name of a face. This method is
994 ;; necessary since facep in XEmacs only returns t for the actual
995 ;; face objects (while it's only their names that are used just
996 ;; about anywhere else) without providing a predicate that tests
997 ;; face names.
998 ;;
999 ;; This function does not do any hidden buffer changes.
1000 (memq facename (face-list)))
1001
1002(defun c-make-keywords-re (adorn list &optional mode)
1003 "Make a regexp that matches all the strings the list.
1004Duplicates in the list are removed. The regexp may contain zero or
1005more submatch expressions.
1006
1007If ADORN is non-nil there will be at least one submatch and the first
1008matches the whole keyword, and the regexp will also not match a prefix
1009of any identifier. Adorned regexps cannot be appended. The language
1010variable `c-nonsymbol-key' is used to make the adornment. The
1011optional MODE specifies the language to get it in. The default is the
1012current language (taken from `c-buffer-is-cc-mode')."
19c5fddb
RS
1013 (let (unique)
1014 (dolist (elt list)
1015 (unless (member elt unique)
1016 (push elt unique)))
1017 (setq list unique))
d9e94c22
MS
1018 (if list
1019 (let ((re (c-regexp-opt list)))
1020 ;; Add our own grouping parenthesis around re instead of
1021 ;; passing adorn to `regexp-opt', since in XEmacs it makes the
1022 ;; top level grouping "shy".
1023 (if adorn
1024 (concat "\\(" re "\\)"
1025 "\\("
1026 (c-get-lang-constant 'c-nonsymbol-key nil mode)
1027 "\\|$\\)")
1028 re))
1029 ;; Produce a regexp that matches nothing.
1030 (if adorn
1031 "\\(\\<\\>\\)"
1032 "\\<\\>")))
1033(put 'c-make-keywords-re 'lisp-indent-function 1)
1034
1035\f
1036;;; Some helper constants.
1037
1038;; If the regexp engine supports POSIX char classes (e.g. Emacs 21)
1039;; then we can use them to handle extended charsets correctly.
1040(if (string-match "[[:alpha:]]" "a") ; Can't use c-emacs-features here.
1041 (progn
1042 (defconst c-alpha "[:alpha:]")
1043 (defconst c-alnum "[:alnum:]")
1044 (defconst c-digit "[:digit:]")
1045 (defconst c-upper "[:upper:]")
1046 (defconst c-lower "[:lower:]"))
1047 (defconst c-alpha "a-zA-Z")
1048 (defconst c-alnum "a-zA-Z0-9")
1049 (defconst c-digit "0-9")
1050 (defconst c-upper "A-Z")
1051 (defconst c-lower "a-z"))
1052
1053\f
1054;;; System for handling language dependent constants.
1055
1056;; This is used to set various language dependent data in a flexible
1057;; way: Language constants can be built from the values of other
1058;; language constants, also those for other languages. They can also
1059;; process the values of other language constants uniformly across all
1060;; the languages. E.g. one language constant can list all the type
1061;; keywords in each language, and another can build a regexp for each
1062;; language from those lists without code duplication.
1063;;
1064;; Language constants are defined with `c-lang-defconst', and their
1065;; value forms (referred to as source definitions) are evaluated only
1066;; on demand when requested for a particular language with
1067;; `c-lang-const'. It's therefore possible to refer to the values of
1068;; constants defined later in the file, or in another file, just as
1069;; long as all the relevant `c-lang-defconst' have been loaded when
1070;; `c-lang-const' is actually evaluated from somewhere else.
1071;;
1072;; `c-lang-const' forms are also evaluated at compile time and
1073;; replaced with the values they produce. Thus there's no overhead
1074;; for this system when compiled code is used - only the values
1075;; actually used in the code are present, and the file(s) containing
1076;; the `c-lang-defconst' forms don't need to be loaded at all then.
1077;; There are however safeguards to make sure that they can be loaded
1078;; to get the source definitions for the values if there's a mismatch
1079;; in compiled versions, or if `c-lang-const' is used uncompiled.
1080;;
1081;; Note that the source definitions in a `c-lang-defconst' form are
1082;; compiled into the .elc file where it stands; there's no need to
1083;; load the source file to get it.
1084;;
1085;; See cc-langs.el for more details about how this system is deployed
1086;; in CC Mode, and how the associated language variable system
1087;; (`c-lang-defvar') works. That file also contains a lot of
1088;; examples.
1089
1090(defun c-add-language (mode base-mode)
1091 "Declare a new language in the language dependent variable system.
1092This is intended to be used by modes that inherit CC Mode to add new
1093languages. It should be used at the top level before any calls to
1094`c-lang-defconst'. MODE is the mode name symbol for the new language,
1095and BASE-MODE is the mode name symbol for the language in CC Mode that
1096is to be the template for the new mode.
1097
1098The exact effect of BASE-MODE is to make all language constants that
1099haven't got a setting in the new language fall back to their values in
1100BASE-MODE. It does not have any effect outside the language constant
1101system."
1102 (unless (string-match "\\`\\(.*-\\)mode\\'" (symbol-name mode))
1103 (error "The mode name symbol `%s' must end with \"-mode\"" mode))
1104 (put mode 'c-mode-prefix (match-string 1 (symbol-name mode)))
1105 (unless (get base-mode 'c-mode-prefix)
1106 (error "Unknown base mode `%s'" base-mode)
1107 (put mode 'c-fallback-mode base-mode)))
1108
1109(defvar c-lang-constants (make-vector 151 0))
1110;; This obarray is a cache to keep track of the language constants
1111;; defined by `c-lang-defconst' and the evaluated values returned by
1112;; `c-lang-const'. It's mostly used at compile time but it's not
1113;; stored in compiled files.
1114;;
1115;; The obarray contains all the language constants as symbols. The
1116;; value cells hold the evaluated values as alists where each car is
1117;; the mode name symbol and the corresponding cdr is the evaluated
1118;; value in that mode. The property lists hold the source definitions
1119;; and other miscellaneous data. The obarray might also contain
1120;; various other symbols, but those don't have any variable bindings.
1121
1122(defvar c-lang-const-expansion nil)
1123(defvar c-langs-are-parametric nil)
1124
1125(defsubst c-get-current-file ()
1126 ;; Return the base name of the current file.
1127 (let ((file (cond
1128 (load-in-progress
1129 ;; Being loaded.
1130 load-file-name)
1131 ((and (boundp 'byte-compile-dest-file)
1132 (stringp byte-compile-dest-file))
1133 ;; Being compiled.
1134 byte-compile-dest-file)
1135 (t
1136 ;; Being evaluated interactively.
1137 (buffer-file-name)))))
1138 (and file
1139 (file-name-sans-extension
1140 (file-name-nondirectory file)))))
1141
1142(defmacro c-lang-defconst-eval-immediately (form)
1143 "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
1144immediately, i.e. at the same time as the `c-lang-defconst' form
1145itself is evaluated."
1146 ;; Evaluate at macro expansion time, i.e. in the
1147 ;; `cl-macroexpand-all' inside `c-lang-defconst'.
1148 (eval form))
1149
1150(defmacro c-lang-defconst (name &rest args)
1151 "Set the language specific values of the language constant NAME.
1152The second argument can be an optional docstring. The rest of the
1153arguments are one or more repetitions of LANG VAL where LANG specifies
1154the language(s) that VAL applies to. LANG is the name of the
1155language, i.e. the mode name without the \"-mode\" suffix, or a list
1156of such language names, or `t' for all languages. VAL is a form to
1157evaluate to get the value.
1158
1159If LANG isn't `t' or one of the core languages in CC Mode, it must
1160have been declared with `c-add-language'.
1161
1162Neither NAME, LANG nor VAL are evaluated directly - they should not be
1163quoted. `c-lang-defconst-eval-immediately' can however be used inside
1164VAL to evaluate parts of it directly.
1165
1166When VAL is evaluated for some language, that language is temporarily
1167made current so that `c-lang-const' without an explicit language can
1168be used inside VAL to refer to the value of a language constant in the
1169same language. That is particularly useful if LANG is `t'.
1170
1171VAL is not evaluated right away but rather when the value is requested
1172with `c-lang-const'. Thus it's possible to use `c-lang-const' inside
1173VAL to refer to language constants that haven't been defined yet.
1174However, if the definition of a language constant is in another file
1175then that file must be loaded \(at compile time) before it's safe to
1176reference the constant.
1177
1178The assignments in ARGS are processed in sequence like `setq', so
1179\(c-lang-const NAME) may be used inside a VAL to refer to the last
1180assigned value to this language constant, or a value that it has
1181gotten in another earlier loaded file.
1182
1183To work well with repeated loads and interactive reevaluation, only
1184one `c-lang-defconst' for each NAME is permitted per file. If there
1185already is one it will be completely replaced; the value in the
1186earlier definition will not affect `c-lang-const' on the same
1187constant. A file is identified by its base name.
1188
1189This macro does not do any hidden buffer changes."
1190
1191 (let* ((sym (intern (symbol-name name) c-lang-constants))
1192 ;; Make `c-lang-const' expand to a straightforward call to
1193 ;; `c-get-lang-constant' in `cl-macroexpand-all' below.
1194 ;;
1195 ;; (The default behavior, i.e. to expand to a call inside
1196 ;; `eval-when-compile' should be equivalent, since that macro
1197 ;; should only expand to its content if it's used inside a
1198 ;; form that's already evaluated at compile time. It's
1199 ;; however necessary to use our cover macro
1200 ;; `cc-eval-when-compile' due to bugs in `eval-when-compile',
1201 ;; and it expands to a bulkier form that in this case only is
1202 ;; unnecessary garbage that we don't want to store in the
1203 ;; language constant source definitions.)
1204 (c-lang-const-expansion 'call)
1205 (c-langs-are-parametric t)
1206 bindings
1207 pre-files)
1208
1209 (or (symbolp name)
1210 (error "Not a symbol: %s" name))
1211
1212 (when (stringp (car-safe args))
1213 ;; The docstring is hardly used anywhere since there's no normal
1214 ;; symbol to attach it to. It's primarily for getting the right
1215 ;; format in the source.
1216 (put sym 'variable-documentation (car args))
1217 (setq args (cdr args)))
1218
1219 (or args
1220 (error "No assignments in `c-lang-defconst' for %s" name))
1221
1222 ;; Rework ARGS to an association list to make it easier to handle.
1223 ;; It's reversed at the same time to make it easier to implement
1224 ;; the demand-driven (i.e. reversed) evaluation in `c-lang-const'.
1225 (while args
1226 (let ((assigned-mode
1227 (cond ((eq (car args) t) t)
1228 ((symbolp (car args))
1229 (list (intern (concat (symbol-name (car args))
1230 "-mode"))))
1231 ((listp (car args))
1232 (mapcar (lambda (lang)
1233 (or (symbolp lang)
1234 (error "Not a list of symbols: %s"
1235 (car args)))
1236 (intern (concat (symbol-name lang)
1237 "-mode")))
1238 (car args)))
1239 (t (error "Not a symbol or a list of symbols: %s"
1240 (car args)))))
1241 val)
1242
1243 (or (cdr args)
1244 (error "No value for %s" (car args)))
1245 (setq args (cdr args)
1246 val (car args))
1247
1248 ;; Emacs has a weird bug where it seems to fail to read
1249 ;; backquote lists from byte compiled files correctly (,@
1250 ;; forms, to be specific), so make sure the bindings in the
1251 ;; expansion below doesn't contain any backquote stuff.
1252 ;; (XEmacs handles it correctly and doesn't need this for that
1253 ;; reason, but we also use this expansion handle
1254 ;; `c-lang-defconst-eval-immediately' and to register
1255 ;; dependencies on the `c-lang-const's in VAL.)
1256 (setq val (cl-macroexpand-all val))
1257
1258 (setq bindings (cons (cons assigned-mode val) bindings)
1259 args (cdr args))))
1260
1261 ;; Compile in the other files that have provided source
1262 ;; definitions for this symbol, to make sure the order in the
1263 ;; `source' property is correct even when files are loaded out of
1264 ;; order.
1265 (setq pre-files (nreverse
1266 ;; Reverse to get the right load order.
1267 (mapcar 'car (get sym 'source))))
1268
1269 `(eval-and-compile
1270 (c-define-lang-constant ',name ',bindings
1271 ,@(and pre-files `(',pre-files))))))
1272
1273(put 'c-lang-defconst 'lisp-indent-function 1)
1274(eval-after-load "edebug"
1275 '(def-edebug-spec c-lang-defconst
1276 (&define name [&optional stringp] [&rest sexp def-form])))
1277
1278(defun c-define-lang-constant (name bindings &optional pre-files)
1279 ;; Used by `c-lang-defconst'. This function does not do any hidden
1280 ;; buffer changes.
1281
1282 (let* ((sym (intern (symbol-name name) c-lang-constants))
1283 (source (get sym 'source))
1284 (file (intern
1285 (or (c-get-current-file)
1286 (error "`c-lang-defconst' must be used in a file"))))
1287 (elem (assq file source)))
1288
1289 ;;(when (cdr-safe elem)
1290 ;; (message "Language constant %s redefined in %S" name file))
1291
1292 ;; Note that the order in the source alist is relevant. Like how
1293 ;; `c-lang-defconst' reverses the bindings, this reverses the
1294 ;; order between files so that the last to evaluate comes first.
1295 (unless elem
1296 (while pre-files
1297 (unless (assq (car pre-files) source)
1298 (setq source (cons (list (car pre-files)) source)))
1299 (setq pre-files (cdr pre-files)))
1300 (put sym 'source (cons (setq elem (list file)) source)))
1301
1302 (setcdr elem bindings)
1303
1304 ;; Bind the symbol as a variable, or clear any earlier evaluated
1305 ;; value it has.
1306 (set sym nil)
1307
1308 ;; Clear the evaluated values that depend on this source.
1309 (let ((agenda (get sym 'dependents))
1310 (visited (make-vector 101 0))
1311 ptr)
1312 (while agenda
1313 (setq sym (car agenda)
1314 agenda (cdr agenda))
1315 (intern (symbol-name sym) visited)
1316 (set sym nil)
1317 (setq ptr (get sym 'dependents))
1318 (while ptr
1319 (setq sym (car ptr)
1320 ptr (cdr ptr))
1321 (unless (intern-soft (symbol-name sym) visited)
1322 (setq agenda (cons sym agenda))))))
1323
1324 name))
1325
1326(defmacro c-lang-const (name &optional lang)
1327 "Get the mode specific value of the language constant NAME in language LANG.
1328LANG is the name of the language, i.e. the mode name without the
1329\"-mode\" suffix. If used inside `c-lang-defconst' or
1330`c-lang-defvar', LANG may be left out to refer to the current
1331language. NAME and LANG are not evaluated so they should not be
1332quoted.
1333
1334This macro does not do any hidden buffer changes."
1335
1336 (or (symbolp name)
1337 (error "Not a symbol: %s" name))
1338 (or (symbolp lang)
1339 (error "Not a symbol: %s" lang))
1340
1341 (let ((sym (intern (symbol-name name) c-lang-constants))
1342 mode source-files args)
1343
1344 (if lang
1345 (progn
1346 (setq mode (intern (concat (symbol-name lang) "-mode")))
1347 (unless (get mode 'c-mode-prefix)
1348 (error
1349 "Unknown language %S since it got no `c-mode-prefix' property"
1350 (symbol-name lang))))
1351 (if c-buffer-is-cc-mode
1352 (setq lang c-buffer-is-cc-mode)
1353 (or c-langs-are-parametric
1354 (error
1355 "`c-lang-const' requires a literal language in this context"))))
1356
1357 (if (eq c-lang-const-expansion 'immediate)
1358 ;; No need to find out the source file(s) when we evaluate
1359 ;; immediately since all the info is already there in the
1360 ;; `source' property.
1361 `',(c-get-lang-constant name nil mode)
1362
1363 (let ((file (c-get-current-file)))
1364 (if file (setq file (intern file)))
1365 ;; Get the source file(s) that must be loaded to get the value
1366 ;; of the constant. If the symbol isn't defined yet we assume
1367 ;; that its definition will come later in this file, and thus
1368 ;; are no file dependencies needed.
1369 (setq source-files (nreverse
1370 ;; Reverse to get the right load order.
19c5fddb
RS
1371 (apply 'nconc
1372 (mapcar (lambda (elem)
1373 (if (eq file (car elem))
1374 nil ; Exclude our own file.
1375 (list (car elem))))
1376 (get sym 'source))))))
d9e94c22
MS
1377
1378 ;; Spend some effort to make a compact call to
1379 ;; `c-get-lang-constant' since it will be compiled in.
1380 (setq args (and mode `(',mode)))
1381 (if (or source-files args)
1382 (setq args (cons (and source-files `',source-files)
1383 args)))
1384
1385 (if (or (eq c-lang-const-expansion 'call)
1386 load-in-progress
1387 (not (boundp 'byte-compile-dest-file))
1388 (not (stringp byte-compile-dest-file)))
1389 ;; Either a straight call is requested in the context, or
1390 ;; we're not being byte compiled so the compile time stuff
1391 ;; below is unnecessary.
1392 `(c-get-lang-constant ',name ,@args)
1393
1394 ;; Being compiled. If the loading and compiling version is
1395 ;; the same we use a value that is evaluated at compile time,
1396 ;; otherwise it's evaluated at runtime.
1397 `(if (eq c-version-sym ',c-version-sym)
1398 (cc-eval-when-compile
1399 (c-get-lang-constant ',name ,@args))
1400 (c-get-lang-constant ',name ,@args))))))
1401
1402(defvar c-lang-constants-under-evaluation nil)
1403
1404(defun c-get-lang-constant (name &optional source-files mode)
1405 ;; Used by `c-lang-const'. This function does not do any hidden
1406 ;; buffer changes.
1407
1408 (or mode
1409 (setq mode c-buffer-is-cc-mode)
1410 (error "No current language"))
1411
1412 (let* ((sym (intern (symbol-name name) c-lang-constants))
1413 (source (get sym 'source))
1414 elem
1415 (eval-in-sym (and c-lang-constants-under-evaluation
1416 (caar c-lang-constants-under-evaluation))))
1417
1418 ;; Record the dependencies between this symbol and the one we're
1419 ;; being evaluated in.
1420 (when eval-in-sym
1421 (or (memq eval-in-sym (get sym 'dependents))
1422 (put sym 'dependents (cons eval-in-sym (get sym 'dependents)))))
1423
1424 ;; Make sure the source files have entries on the `source'
1425 ;; property so that loading will take place when necessary.
1426 (while source-files
1427 (unless (assq (car source-files) source)
1428 (put sym 'source
1429 (setq source (cons (list (car source-files)) source)))
1430 ;; Might pull in more definitions which affect the value. The
1431 ;; clearing of dependent values etc is done when the
1432 ;; definition is encountered during the load; this is just to
1433 ;; jump past the check for a cached value below.
1434 (set sym nil))
1435 (setq source-files (cdr source-files)))
1436
1437 (if (and (boundp sym)
1438 (setq elem (assq mode (symbol-value sym))))
1439 (cdr elem)
1440
1441 ;; Check if an evaluation of this symbol is already underway.
1442 ;; In that case we just continue with the "assignment" before
1443 ;; the one currently being evaluated, thereby creating the
1444 ;; illusion if a `setq'-like sequence of assignments.
1445 (let* ((c-buffer-is-cc-mode mode)
1446 (source-pos
1447 (or (assq sym c-lang-constants-under-evaluation)
1448 (cons sym (vector source nil))))
1449 ;; Append `c-lang-constants-under-evaluation' even if an
1450 ;; earlier entry is found. It's only necessary to get
1451 ;; the recording of dependencies above correct.
1452 (c-lang-constants-under-evaluation
1453 (cons source-pos c-lang-constants-under-evaluation))
1454 (fallback (get mode 'c-fallback-mode))
1455 value
1456 ;; Make sure the recursion limits aren't very low
1457 ;; since the `c-lang-const' dependencies can go deep.
1458 (max-specpdl-size (max max-specpdl-size 3000))
1459 (max-lisp-eval-depth (max max-lisp-eval-depth 1000)))
1460
1461 (if (if fallback
1462 (let ((backup-source-pos (copy-sequence (cdr source-pos))))
1463 (and
1464 ;; First try the original mode but don't accept an
1465 ;; entry matching all languages since the fallback
1466 ;; mode might have an explicit entry before that.
1467 (eq (setq value (c-find-assignment-for-mode
1468 (cdr source-pos) mode nil name))
1469 c-lang-constants)
1470 ;; Try again with the fallback mode from the
1471 ;; original position. Note that
1472 ;; `c-buffer-is-cc-mode' still is the real mode if
1473 ;; language parameterization takes place.
1474 (eq (setq value (c-find-assignment-for-mode
1475 (setcdr source-pos backup-source-pos)
1476 fallback t name))
1477 c-lang-constants)))
1478 ;; A simple lookup with no fallback mode.
1479 (eq (setq value (c-find-assignment-for-mode
1480 (cdr source-pos) mode t name))
1481 c-lang-constants))
1482 (error
1483 "`%s' got no (prior) value in %s (might be a cyclic reference)"
1484 name mode))
1485
1486 (condition-case err
1487 (setq value (eval value))
1488 (error
1489 ;; Print a message to aid in locating the error. We don't
1490 ;; print the error itself since that will be done later by
1491 ;; some caller higher up.
1492 (message "Eval error in the `c-lang-defconst' for `%s' in %s:"
1493 sym mode)
1494 (makunbound sym)
1495 (signal (car err) (cdr err))))
1496
1497 (set sym (cons (cons mode value) (symbol-value sym)))
1498 value))))
1499
1500(defun c-find-assignment-for-mode (source-pos mode match-any-lang name)
1501 ;; Find the first assignment entry that applies to MODE at or after
1502 ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with `t' as
1503 ;; the language list are considered to match, otherwise they don't.
1504 ;; On return SOURCE-POS is updated to point to the next assignment
1505 ;; after the returned one. If no assignment is found,
1506 ;; `c-lang-constants' is returned as a magic value.
1507 ;;
1508 ;; SOURCE-POS is a vector that points out a specific assignment in
1509 ;; the double alist that's used in the `source' property. The first
1510 ;; element is the position in the top alist which is indexed with
1511 ;; the source files, and the second element is the position in the
1512 ;; nested bindings alist.
1513 ;;
1514 ;; NAME is only used for error messages.
1515
1516 (catch 'found
1517 (let ((file-entry (elt source-pos 0))
1518 (assignment-entry (elt source-pos 1))
1519 assignment)
1520
1521 (while (if assignment-entry
1522 t
1523 ;; Handled the last assignment from one file, begin on the
1524 ;; next. Due to the check in `c-lang-defconst', we know
1525 ;; there's at least one.
1526 (when file-entry
1527
1528 (unless (aset source-pos 1
1529 (setq assignment-entry (cdar file-entry)))
1530 ;; The file containing the source definitions has not
1531 ;; been loaded.
1532 (let ((file (symbol-name (caar file-entry)))
1533 (c-lang-constants-under-evaluation nil))
1534 ;;(message (concat "Loading %s to get the source "
1535 ;; "value for language constant %s")
1536 ;; file name)
1537 (load file))
1538
1539 (unless (setq assignment-entry (cdar file-entry))
1540 ;; The load didn't fill in the source for the
1541 ;; constant as expected. The situation is
1542 ;; probably that a derived mode was written for
1543 ;; and compiled with another version of CC Mode,
1544 ;; and the requested constant isn't in the
1545 ;; currently loaded one. Put in a dummy
1546 ;; assignment that matches no language.
1547 (setcdr (car file-entry)
1548 (setq assignment-entry (list (list nil))))))
1549
1550 (aset source-pos 0 (setq file-entry (cdr file-entry)))
1551 t))
1552
1553 (setq assignment (car assignment-entry))
1554 (aset source-pos 1
1555 (setq assignment-entry (cdr assignment-entry)))
1556
1557 (when (if (listp (car assignment))
1558 (memq mode (car assignment))
1559 match-any-lang)
1560 (throw 'found (cdr assignment))))
1561
1562 c-lang-constants)))
0ec8351b 1563
785eecbb 1564\f
130c507e 1565(cc-provide 'cc-defs)
3afbc435 1566
ab5796a9 1567;;; arch-tag: 3bb2629d-dd84-4ff0-ad39-584be0fe3cda
785eecbb 1568;;; cc-defs.el ends here