(elint-check-defcustom-form): Don't use `evenp' so we don't implicitly
[emacs.git] / lisp / progmodes / cc-defs.el
blobcef04a32a5d3bb37ee172af3405fb765698dca85
1 ;;; cc-defs.el --- compile time definitions for CC Mode
3 ;; Copyright (C) 1985,1987,1992-2003 Free Software Foundation, Inc.
5 ;; Authors: 1998- Martin Stjernholm
6 ;; 1992-1999 Barry A. Warsaw
7 ;; 1987 Dave Detlefs and Stewart Clamen
8 ;; 1985 Richard M. Stallman
9 ;; Maintainer: bug-cc-mode@gnu.org
10 ;; Created: 22-Apr-1997 (split from cc-mode.el)
11 ;; Version: See cc-mode.el
12 ;; Keywords: c languages oop
14 ;; This file is part of GNU Emacs.
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.
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.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs; see the file COPYING. If not, write to
28 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29 ;; Boston, MA 02111-1307, USA.
31 ;;; Commentary:
33 ;; This file contains macros, defsubsts, and various other things that
34 ;; must be loaded early both during compilation and at runtime.
36 ;;; Code:
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)))
44 (load "cc-bytecomp" nil t)))
46 ;; `require' in XEmacs doesn't have the third NOERROR argument.
47 (condition-case nil (require 'regexp-opt) (file-error nil))
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+
66 ;; cc-fix.el contains compatibility macros that should be used if
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))
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)))
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")))
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")))
103 (cc-external-require 'cl)
106 ;;; Variables also used at compile time.
108 (defconst c-version "5.30.7"
109 "CC Mode version number.")
111 (defconst c-version-sym (intern c-version))
112 ;; A little more compact and faster in comparisons.
114 (defvar c-buffer-is-cc-mode nil
115 "Non-nil for all buffers with a major mode derived from CC Mode.
116 Otherwise, 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', `awk-mode', and any other non-CC Mode mode that calls
119 `c-initialize-cc-mode'. The value is the mode symbol itself
120 \(i.e. `c-mode' etc) of the original CC Mode mode, or just t if it's
121 not known.")
122 (make-variable-buffer-local 'c-buffer-is-cc-mode)
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)
129 ;; The following is used below during compilation.
130 (eval-and-compile
131 (defvar c-inside-eval-when-compile nil)
133 (defmacro cc-eval-when-compile (&rest body)
134 "Like `progn', but evaluates the body at compile time.
135 The result of the body appears to the compiler as a quoted constant.
137 This variant works around bugs in `eval-when-compile' in various
138 \(X)Emacs versions. See cc-defs.el for details."
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)
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.
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:
158 ;; (defsubst nthcdr (val) val)
160 ;; `defsubst', like `defmacro', needs to be evaluated at
161 ;; compile time, so this will produce an error during byte
162 ;; compilation.
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':
168 ;; (eval-when-compile
169 ;; (if (not (fboundp 'foo))
170 ;; (defsubst foo ...)))
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.
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)))))
186 (put 'cc-eval-when-compile 'lisp-indent-hook 0))
189 ;;; Macros.
191 (defmacro c-point (position &optional point)
192 "Return the value of certain commonly referenced POSITIONs relative to POINT.
193 The current point is used if POINT isn't specified. POSITION can be
194 one of the following symbols:
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
208 If the referenced position doesn't exist, the closest accessible point
209 to it is returned. This function does not modify point or mark.
211 This function does not do any hidden buffer changes."
213 (if (eq (car-safe position) 'quote)
214 (let ((position (eval position)))
215 (cond
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))))
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))))
233 ((eq position 'boi)
234 `(save-excursion
235 ,@(if point `((goto-char ,point)))
236 (back-to-indentation)
237 (point)))
239 ((eq position 'bod)
240 `(save-excursion
241 ,@(if point `((goto-char ,point)))
242 (c-beginning-of-defun-1)
243 (point)))
245 ((eq position 'eod)
246 `(save-excursion
247 ,@(if point `((goto-char ,point)))
248 (c-end-of-defun-1)
249 (point)))
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))))
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))))
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))))
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))))
285 ((eq position 'iopl)
286 `(save-excursion
287 ,@(if point `((goto-char ,point)))
288 (forward-line -1)
289 (back-to-indentation)
290 (point)))
292 ((eq position 'ionl)
293 `(save-excursion
294 ,@(if point `((goto-char ,point)))
295 (forward-line 1)
296 (back-to-indentation)
297 (point)))
299 (t (error "Unknown buffer position requested: %s" position))))
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))))
328 (defmacro c-safe (&rest body)
329 ;; safely execute BODY, return nil if an error occurred
331 ;; This function does not do any hidden buffer changes.
332 `(condition-case nil
333 (progn ,@body)
334 (error nil)))
335 (put 'c-safe 'lisp-indent-function 0)
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,
341 then restore the buffer state under the assumption that no significant
342 modification has been made. A change is considered significant if it
343 affects the buffer text in any way that isn't completely restored
344 again. Changes in text properties like `face' or `syntax-table' are
345 considered insignificant. This macro allows text properties to be
346 changed, even in a read-only buffer.
348 The 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)
360 (defmacro c-forward-syntactic-ws (&optional limit)
361 "Forward skip over syntactic whitespace.
362 Syntactic whitespace is defined as whitespace characters, comments,
363 and preprocessor directives. However if point starts inside a comment
364 or preprocessor directive, the content of it is not treated as
365 whitespace.
367 LIMIT sets an upper limit of the forward movement, if specified. If
368 LIMIT or the end of the buffer is reached inside a comment or
369 preprocessor directive, the point will be left there.
371 Note that this function might do hidden buffer changes. See the
372 comment 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)))
379 (defmacro c-backward-syntactic-ws (&optional limit)
380 "Backward skip over syntactic whitespace.
381 Syntactic whitespace is defined as whitespace characters, comments,
382 and preprocessor directives. However if point starts inside a comment
383 or preprocessor directive, the content of it is not treated as
384 whitespace.
386 LIMIT sets a lower limit of the backward movement, if specified. If
387 LIMIT is reached inside a line comment or preprocessor directive then
388 the point is moved into it past the whitespace at the end.
390 Note that this function might do hidden buffer changes. See the
391 comment 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)))
398 (defmacro c-forward-sexp (&optional count)
399 "Move forward across COUNT balanced expressions.
400 A negative COUNT means move backward. Signal an error if the move
401 fails for any reason.
403 This is like `forward-sexp' except that it isn't interactive and does
404 not do any user friendly adjustments of the point and that it isn't
405 susceptible to user configurations such as disabling of signals in
406 certain situations.
408 This 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))))))
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))))
420 (defmacro c-safe-scan-lists (from count depth)
421 "Like `scan-lists' but returns nil instead of signalling errors.
423 This 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))))
429 ;; Wrappers for common scan-lists cases, mainly because it's almost
430 ;; impossible to get a feel for how that function works.
432 (defmacro c-up-list-forward (&optional pos)
433 "Return the first position after the list sexp containing POS,
434 or nil if no such position exists. The point is used if POS is left out.
436 This function does not do any hidden buffer changes."
437 `(c-safe-scan-lists ,(or pos `(point)) 1 1))
439 (defmacro c-up-list-backward (&optional pos)
440 "Return the position of the start of the list sexp containing POS,
441 or nil if no such position exists. The point is used if POS is left out.
443 This function does not do any hidden buffer changes."
444 `(c-safe-scan-lists ,(or pos `(point)) -1 1))
446 (defmacro c-down-list-forward (&optional pos)
447 "Return the first position inside the first list sexp after POS,
448 or nil if no such position exists. The point is used if POS is left out.
450 This function does not do any hidden buffer changes."
451 `(c-safe-scan-lists ,(or pos `(point)) 1 -1))
453 (defmacro c-down-list-backward (&optional pos)
454 "Return the last position inside the last list sexp before POS,
455 or nil if no such position exists. The point is used if POS is left out.
457 This function does not do any hidden buffer changes."
458 `(c-safe-scan-lists ,(or pos `(point)) -1 -1))
460 (defmacro c-go-up-list-forward (&optional pos)
461 "Move the point to the first position after the list sexp containing POS,
462 or the point if POS is left out. Return t if such a position exists,
463 otherwise nil is returned and the point isn't moved.
465 This function does not do any hidden buffer changes."
466 `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 1)) t))
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,
470 or the point if POS is left out. Return t if such a position exists,
471 otherwise nil is returned and the point isn't moved.
473 This function does not do any hidden buffer changes."
474 `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 1)) t))
476 (defmacro c-go-down-list-forward (&optional pos)
477 "Move the point to the first position inside the first list sexp after POS,
478 or the point if POS is left out. Return t if such a position exists,
479 otherwise nil is returned and the point isn't moved.
481 This function does not do any hidden buffer changes."
482 `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 -1)) t))
484 (defmacro c-go-down-list-backward (&optional pos)
485 "Move the point to the last position inside the last list sexp before POS,
486 or the point if POS is left out. Return t if such a position exists,
487 otherwise nil is returned and the point isn't moved.
489 This function does not do any hidden buffer changes."
490 `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 -1)) t))
493 (defmacro c-beginning-of-defun-1 ()
494 ;; Wrapper around beginning-of-defun.
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)
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'.
506 ;; This function does not do any hidden buffer changes.
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))
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)))))
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.
550 ;; This function does not do any hidden buffer changes.
551 `(progn
552 (message ,format ,@args)
553 (ding)))
555 (defmacro c-update-modeline ()
556 ;; set the c-auto-hungry-string for the correct designation on the modeline
558 ;; This function does not do any hidden buffer changes.
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)))
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.
570 ;; This function does not do any hidden buffer changes.
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)
579 (defmacro c-skip-ws-forward (&optional limit)
580 "Skip over any whitespace following point.
581 This function skips over horizontal and vertical whitespace and line
582 continuations.
584 This function does not do any hidden buffer changes."
585 (if limit
586 `(let ((limit (or ,limit (point-max))))
587 (while (progn
588 ;; skip-syntax-* doesn't count \n as whitespace..
589 (skip-chars-forward " \t\n\r\f\v" limit)
590 (when (and (eq (char-after) ?\\)
591 (< (point) limit))
592 (forward-char)
593 (or (eolp)
594 (progn (backward-char) nil))))))
595 '(while (progn
596 (skip-chars-forward " \t\n\r\f\v")
597 (when (eq (char-after) ?\\)
598 (forward-char)
599 (or (eolp)
600 (progn (backward-char) nil)))))))
602 (defmacro c-skip-ws-backward (&optional limit)
603 "Skip over any whitespace preceding point.
604 This function skips over horizontal and vertical whitespace and line
605 continuations.
607 This function does not do any hidden buffer changes."
608 (if limit
609 `(let ((limit (or ,limit (point-min))))
610 (while (progn
611 ;; skip-syntax-* doesn't count \n as whitespace..
612 (skip-chars-backward " \t\n\r\f\v" limit)
613 (and (eolp)
614 (eq (char-before) ?\\)
615 (> (point) limit)))
616 (backward-char)))
617 '(while (progn
618 (skip-chars-backward " \t\n\r\f\v")
619 (and (eolp)
620 (eq (char-before) ?\\)))
621 (backward-char))))
623 (defmacro c-major-mode-is (mode)
624 "Return non-nil if the current CC Mode major mode is MODE.
625 MODE is either a mode symbol or a list of mode symbols.
627 This 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)))))
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.
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)))
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.
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))))
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)))))))))
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.
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.
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))))
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)))
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.
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))))
761 ;; Emacs < 21.
762 `(c-clear-char-property-fun ,pos ',property))))
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.
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))))
783 ;; Make edebug understand the macros.
784 (eval-after-load "edebug"
785 '(progn
786 (def-edebug-spec c-point t)
787 (def-edebug-spec c-safe t)
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)
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)
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)))
811 ;;; Functions.
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.
818 (defsubst c-end-of-defun-1 ()
819 ;; Replacement for end-of-defun that use c-beginning-of-defun-1.
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)))))
831 (defconst c-<-as-paren-syntax '(4 . ?>))
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))
840 (defconst c->-as-paren-syntax '(5 . ?<))
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))
849 (defsubst c-intersect-lists (list alist)
850 ;; return the element of ALIST that matches the first element found
851 ;; in LIST. Uses assq.
853 ;; This function does not do any hidden buffer changes.
854 (let (match)
855 (while (and list
856 (not (setq match (assq (car list) alist))))
857 (setq list (cdr list)))
858 match))
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.
864 ;; This function does not do any hidden buffer changes.
865 (assq (car (c-intersect-lists list alist1)) alist2))
867 (defsubst c-langelem-sym (langelem)
868 "Return the syntactic symbol in LANGELEM.
870 LANGELEM 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
872 on the \"new\" form as used in `c-syntactic-element'.
874 This function does not do any hidden buffer changes."
875 (car langelem))
877 (defsubst c-langelem-pos (langelem)
878 "Return the (primary) anchor position in LANGELEM, or nil if there is none.
880 LANGELEM 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
882 on the \"new\" form as used in `c-syntactic-element'.
884 This function does not do any hidden buffer changes."
885 (if (consp (cdr langelem))
886 (car-safe (cdr langelem))
887 (cdr langelem)))
889 (defun c-langelem-col (langelem &optional preserve-point)
890 "Return the column of the (primary) anchor position in LANGELEM.
891 Leave point at that position unless PRESERVE-POINT is non-nil.
893 LANGELEM 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
895 on the \"new\" form as used in `c-syntactic-element'.
897 This 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)))
908 (defsubst c-langelem-2nd-pos (langelem)
909 "Return the secondary position in LANGELEM, or nil if there is none.
911 LANGELEM is a syntactic element, typically on the \"new\" form as used
912 in `c-syntactic-element'. It may be on the \"old\" form that is used
913 as the first argument to lineup functions, but then the returned value
914 always will be nil.
916 This function does not do any hidden buffer changes."
917 (car-safe (cdr-safe (cdr-safe langelem))))
919 (defsubst c-keep-region-active ()
920 ;; Do whatever is necessary to keep the region active in XEmacs.
921 ;; This is not needed for Emacs.
923 ;; This function does not do any hidden buffer changes.
924 (and (boundp 'zmacs-region-stays)
925 (setq zmacs-region-stays t)))
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.
931 ;; This function does not do any hidden buffer changes.
932 (cond
933 ;; XEmacs
934 ((and (fboundp 'region-active-p)
935 (boundp 'zmacs-regions)
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))))
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-")
951 (defsubst c-mode-symbol (suffix)
952 "Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
953 the corresponding symbol.
955 This 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))))
964 (defsubst c-mode-var (suffix)
965 "Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
966 the value of the variable with that name.
968 This function does not do any hidden buffer changes."
969 (symbol-value (c-mode-symbol suffix)))
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)))
978 (defsubst c-got-face-at (pos faces)
979 "Return non-nil if position POS in the current buffer has any of the
980 faces in the list FACES.
982 This 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))))
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.
999 ;; This function does not do any hidden buffer changes.
1000 (memq facename (face-list)))
1002 (defun c-make-keywords-re (adorn list &optional mode)
1003 "Make a regexp that matches all the strings the list.
1004 Duplicates in the list are removed. The regexp may contain zero or
1005 more submatch expressions.
1007 If ADORN is non-nil there will be at least one submatch and the first
1008 matches the whole keyword, and the regexp will also not match a prefix
1009 of any identifier. Adorned regexps cannot be appended. The language
1010 variable `c-nonsymbol-key' is used to make the adornment. The
1011 optional MODE specifies the language to get it in. The default is the
1012 current language (taken from `c-buffer-is-cc-mode')."
1013 (let (unique)
1014 (dolist (elt list)
1015 (unless (member elt unique)
1016 (push elt unique)))
1017 (setq list unique))
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)
1036 ;;; Some helper constants.
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"))
1054 ;;; System for handling language dependent constants.
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.
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.
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.
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.
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.
1090 (defun c-add-language (mode base-mode)
1091 "Declare a new language in the language dependent variable system.
1092 This is intended to be used by modes that inherit CC Mode to add new
1093 languages. 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,
1095 and BASE-MODE is the mode name symbol for the language in CC Mode that
1096 is to be the template for the new mode.
1098 The exact effect of BASE-MODE is to make all language constants that
1099 haven't got a setting in the new language fall back to their values in
1100 BASE-MODE. It does not have any effect outside the language constant
1101 system."
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)))
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.
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.
1122 (defvar c-lang-const-expansion nil)
1123 (defvar c-langs-are-parametric nil)
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)
1136 ;; Being evaluated interactively.
1137 (buffer-file-name)))))
1138 (and file
1139 (file-name-sans-extension
1140 (file-name-nondirectory file)))))
1142 (defmacro c-lang-defconst-eval-immediately (form)
1143 "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
1144 immediately, i.e. at the same time as the `c-lang-defconst' form
1145 itself is evaluated."
1146 ;; Evaluate at macro expansion time, i.e. in the
1147 ;; `cl-macroexpand-all' inside `c-lang-defconst'.
1148 (eval form))
1150 (defmacro c-lang-defconst (name &rest args)
1151 "Set the language specific values of the language constant NAME.
1152 The second argument can be an optional docstring. The rest of the
1153 arguments are one or more repetitions of LANG VAL where LANG specifies
1154 the language(s) that VAL applies to. LANG is the name of the
1155 language, i.e. the mode name without the \"-mode\" suffix, or a list
1156 of such language names, or `t' for all languages. VAL is a form to
1157 evaluate to get the value.
1159 If LANG isn't `t' or one of the core languages in CC Mode, it must
1160 have been declared with `c-add-language'.
1162 Neither NAME, LANG nor VAL are evaluated directly - they should not be
1163 quoted. `c-lang-defconst-eval-immediately' can however be used inside
1164 VAL to evaluate parts of it directly.
1166 When VAL is evaluated for some language, that language is temporarily
1167 made current so that `c-lang-const' without an explicit language can
1168 be used inside VAL to refer to the value of a language constant in the
1169 same language. That is particularly useful if LANG is `t'.
1171 VAL is not evaluated right away but rather when the value is requested
1172 with `c-lang-const'. Thus it's possible to use `c-lang-const' inside
1173 VAL to refer to language constants that haven't been defined yet.
1174 However, if the definition of a language constant is in another file
1175 then that file must be loaded \(at compile time) before it's safe to
1176 reference the constant.
1178 The 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
1180 assigned value to this language constant, or a value that it has
1181 gotten in another earlier loaded file.
1183 To work well with repeated loads and interactive reevaluation, only
1184 one `c-lang-defconst' for each NAME is permitted per file. If there
1185 already is one it will be completely replaced; the value in the
1186 earlier definition will not affect `c-lang-const' on the same
1187 constant. A file is identified by its base name.
1189 This macro does not do any hidden buffer changes."
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.
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)
1209 (or (symbolp name)
1210 (error "Not a symbol: %s" name))
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)))
1219 (or args
1220 (error "No assignments in `c-lang-defconst' for %s" name))
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)
1243 (or (cdr args)
1244 (error "No value for %s" (car args)))
1245 (setq args (cdr args)
1246 val (car args))
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))
1258 (setq bindings (cons (cons assigned-mode val) bindings)
1259 args (cdr args))))
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))))
1269 `(eval-and-compile
1270 (c-define-lang-constant ',name ',bindings
1271 ,@(and pre-files `(',pre-files))))))
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])))
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.
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)))
1289 ;;(when (cdr-safe elem)
1290 ;; (message "Language constant %s redefined in %S" name file))
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)))
1302 (setcdr elem bindings)
1304 ;; Bind the symbol as a variable, or clear any earlier evaluated
1305 ;; value it has.
1306 (set sym nil)
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))))))
1324 name))
1326 (defmacro c-lang-const (name &optional lang)
1327 "Get the mode specific value of the language constant NAME in language LANG.
1328 LANG 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
1331 language. NAME and LANG are not evaluated so they should not be
1332 quoted.
1334 This macro does not do any hidden buffer changes."
1336 (or (symbolp name)
1337 (error "Not a symbol: %s" name))
1338 (or (symbolp lang)
1339 (error "Not a symbol: %s" lang))
1341 (let ((sym (intern (symbol-name name) c-lang-constants))
1342 mode source-files args)
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"))))
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)
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.
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))))))
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)))
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)
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))))))
1402 (defvar c-lang-constants-under-evaluation nil)
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.
1408 (or mode
1409 (setq mode c-buffer-is-cc-mode)
1410 (error "No current language"))
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))))
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)))))
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)))
1437 (if (and (boundp sym)
1438 (setq elem (assq mode (symbol-value sym))))
1439 (cdr elem)
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)))
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))
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))))
1497 (set sym (cons (cons mode value) (symbol-value sym)))
1498 value))))
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.
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.
1514 ;; NAME is only used for error messages.
1516 (catch 'found
1517 (let ((file-entry (elt source-pos 0))
1518 (assignment-entry (elt source-pos 1))
1519 assignment)
1521 (while (if assignment-entry
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
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))
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))))))
1550 (aset source-pos 0 (setq file-entry (cdr file-entry)))
1553 (setq assignment (car assignment-entry))
1554 (aset source-pos 1
1555 (setq assignment-entry (cdr assignment-entry)))
1557 (when (if (listp (car assignment))
1558 (memq mode (car assignment))
1559 match-any-lang)
1560 (throw 'found (cdr assignment))))
1562 c-lang-constants)))
1565 (cc-provide 'cc-defs)
1567 ;;; arch-tag: 3bb2629d-dd84-4ff0-ad39-584be0fe3cda
1568 ;;; cc-defs.el ends here