]> code.delx.au - gnu-emacs/blob - lisp/progmodes/cc-defs.el
Further Unicode restrictive fixups
[gnu-emacs] / lisp / progmodes / cc-defs.el
1 ;;; cc-defs.el --- compile time definitions for CC Mode
2
3 ;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
4
5 ;; Authors: 2003- Alan Mackenzie
6 ;; 1998- Martin Stjernholm
7 ;; 1992-1999 Barry A. Warsaw
8 ;; 1987 Dave Detlefs
9 ;; 1987 Stewart Clamen
10 ;; 1985 Richard M. Stallman
11 ;; Maintainer: bug-cc-mode@gnu.org
12 ;; Created: 22-Apr-1997 (split from cc-mode.el)
13 ;; Keywords: c languages
14 ;; Package: cc-mode
15
16 ;; This file is part of GNU Emacs.
17
18 ;; GNU Emacs is free software: you can redistribute it and/or modify
19 ;; it under the terms of the GNU General Public License as published by
20 ;; the Free Software Foundation, either version 3 of the License, or
21 ;; (at your option) any later version.
22
23 ;; GNU Emacs is distributed in the hope that it will be useful,
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
26 ;; GNU General Public License for more details.
27
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
30
31 ;;; Commentary:
32
33 ;; This file contains macros, defsubsts, and various other things that
34 ;; must be loaded early both during compilation and at runtime.
35
36 ;;; Code:
37
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)))
45
46 (eval-and-compile
47 (defvar c--mapcan-status
48 (cond ((and (fboundp 'mapcan)
49 (subrp (symbol-function 'mapcan)))
50 ;; XEmacs
51 'mapcan)
52 ((locate-file "cl-lib.elc" load-path)
53 ;; Emacs >= 24.3
54 'cl-mapcan)
55 (t
56 ;; Emacs <= 24.2
57 nil))))
58
59 (cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
60 ; was (cc-external-require 'cl). ACM 2005/11/29.
61 ; Changed from (eval-when-compile (require 'cl)) back to
62 ; cc-external-require, 2015-08-12.
63 (cc-external-require 'regexp-opt)
64
65 ;; Silence the compiler.
66 (cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
67 (cc-bytecomp-defun region-active-p) ; XEmacs
68 (cc-bytecomp-defvar mark-active) ; Emacs
69 (cc-bytecomp-defvar deactivate-mark) ; Emacs
70 (cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs
71 (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs
72 (cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21
73 (cc-bytecomp-defun string-to-syntax) ; Emacs 21
74
75 \f
76 ;; cc-fix.el contains compatibility macros that should be used if
77 ;; needed.
78 (eval-and-compile
79 (if (or (/= (regexp-opt-depth "\\(\\(\\)\\)") 2)
80 (not (fboundp 'push)))
81 (cc-load "cc-fix")))
82
83 (when (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS
84 ; to make the call to f-l-c-k throw an error.
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 (featurep 'xemacs)
96 (not (featurep 'cc-fix))
97 (progn
98 (require 'font-lock)
99 (let (font-lock-keywords)
100 (font-lock-compile-keywords '("\\<\\>"))
101 font-lock-keywords)))
102 (cc-load "cc-fix")))
103
104 ;; XEmacs 21.4 doesn't have `delete-dups'.
105 (eval-and-compile
106 (if (and (not (fboundp 'delete-dups))
107 (not (featurep 'cc-fix)))
108 (cc-load "cc-fix")))
109 \f
110 ;;; Variables also used at compile time.
111
112 (defconst c-version "5.33"
113 "CC Mode version number.")
114
115 (defconst c-version-sym (intern c-version))
116 ;; A little more compact and faster in comparisons.
117
118 (defvar c-buffer-is-cc-mode nil
119 "Non-nil for all buffers with a major mode derived from CC Mode.
120 Otherwise, this variable is nil. I.e. this variable is non-nil for
121 `c-mode', `c++-mode', `objc-mode', `java-mode', `idl-mode',
122 `pike-mode', `awk-mode', and any other non-CC Mode mode that calls
123 `c-initialize-cc-mode'. The value is the mode symbol itself
124 \(i.e. `c-mode' etc) of the original CC Mode mode, or just t if it's
125 not known.")
126 (make-variable-buffer-local 'c-buffer-is-cc-mode)
127
128 ;; Have to make `c-buffer-is-cc-mode' permanently local so that it
129 ;; survives the initialization of the derived mode.
130 (put 'c-buffer-is-cc-mode 'permanent-local t)
131
132 \f
133 ;; The following is used below during compilation.
134 (eval-and-compile
135 (defvar c-inside-eval-when-compile nil)
136
137 (defmacro cc-eval-when-compile (&rest body)
138 "Like `progn', but evaluates the body at compile time.
139 The result of the body appears to the compiler as a quoted constant.
140
141 This variant works around bugs in `eval-when-compile' in various
142 \(X)Emacs versions. See cc-defs.el for details."
143
144 (if c-inside-eval-when-compile
145 ;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it
146 ;; evaluates its body at macro expansion time if it's nested
147 ;; inside another `eval-when-compile'. So we use a dynamically
148 ;; bound variable to avoid nesting them.
149 `(progn ,@body)
150
151 `(eval-when-compile
152 ;; In all (X)Emacsen so far, `eval-when-compile' byte compiles
153 ;; its contents before evaluating it. That can cause forms to
154 ;; be compiled in situations they aren't intended to be
155 ;; compiled.
156 ;;
157 ;; Example: It's not possible to defsubst a primitive, e.g. the
158 ;; following will produce an error (in any emacs flavor), since
159 ;; `nthcdr' is a primitive function that's handled specially by
160 ;; the byte compiler and thus can't be redefined:
161 ;;
162 ;; (defsubst nthcdr (val) val)
163 ;;
164 ;; `defsubst', like `defmacro', needs to be evaluated at
165 ;; compile time, so this will produce an error during byte
166 ;; compilation.
167 ;;
168 ;; CC Mode occasionally needs to do things like this for
169 ;; cross-emacs compatibility. It therefore uses the following
170 ;; to conditionally do a `defsubst':
171 ;;
172 ;; (eval-when-compile
173 ;; (if (not (fboundp 'foo))
174 ;; (defsubst foo ...)))
175 ;;
176 ;; But `eval-when-compile' byte compiles its contents and
177 ;; _then_ evaluates it (in all current emacs versions, up to
178 ;; and including Emacs 20.6 and XEmacs 21.1 as of this
179 ;; writing). So this will still produce an error, since the
180 ;; byte compiler will get to the defsubst anyway. That's
181 ;; arguably a bug because the point with `eval-when-compile' is
182 ;; that it should evaluate rather than compile its contents.
183 ;;
184 ;; We get around it by expanding the body to a quoted
185 ;; constant that we eval. That otoh introduce a problem in
186 ;; that a returned lambda expression doesn't get byte
187 ;; compiled (even if `function' is used).
188 (eval '(let ((c-inside-eval-when-compile t)) ,@body)))))
189
190 (put 'cc-eval-when-compile 'lisp-indent-hook 0))
191
192 \f
193 ;;; Macros.
194 (defmacro c--mapcan (fun liszt)
195 ;; CC Mode equivalent of `mapcan' which bridges the difference
196 ;; between the host [X]Emacsen."
197 ;; The motivation for this macro is to avoid the irritating message
198 ;; "function `mapcan' from cl package called at runtime" produced by Emacs.
199 (cond
200 ((eq c--mapcan-status 'mapcan)
201 `(mapcan ,fun ,liszt))
202 ((eq c--mapcan-status 'cl-mapcan)
203 `(cl-mapcan ,fun ,liszt))
204 (t
205 ;; Emacs <= 24.2. It would be nice to be able to distinguish between
206 ;; compile-time and run-time use here.
207 `(apply 'nconc (mapcar ,fun ,liszt)))))
208
209 (defmacro c--set-difference (liszt1 liszt2 &rest other-args)
210 ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3.
211 (if (eq c--mapcan-status 'cl-mapcan)
212 `(cl-set-difference ,liszt1 ,liszt2 ,@other-args)
213 `(set-difference ,liszt1 ,liszt2 ,@other-args)))
214
215 (defmacro c--intersection (liszt1 liszt2 &rest other-args)
216 ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3.
217 (if (eq c--mapcan-status 'cl-mapcan)
218 `(cl-intersection ,liszt1 ,liszt2 ,@other-args)
219 `(intersection ,liszt1 ,liszt2 ,@other-args)))
220
221 (eval-and-compile
222 (defmacro c--macroexpand-all (form &optional environment)
223 ;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3.
224 (if (fboundp 'macroexpand-all)
225 `(macroexpand-all ,form ,environment)
226 `(cl-macroexpand-all ,form ,environment)))
227
228 (defmacro c--delete-duplicates (cl-seq &rest cl-keys)
229 ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3.
230 (if (eq c--mapcan-status 'cl-mapcan)
231 `(cl-delete-duplicates ,cl-seq ,@cl-keys)
232 `(delete-duplicates ,cl-seq ,@cl-keys))))
233
234 (defmacro c-point (position &optional point)
235 "Return the value of certain commonly referenced POSITIONs relative to POINT.
236 The current point is used if POINT isn't specified. POSITION can be
237 one of the following symbols:
238
239 `bol' -- beginning of line
240 `eol' -- end of line
241 `bod' -- beginning of defun
242 `eod' -- end of defun
243 `boi' -- beginning of indentation
244 `ionl' -- indentation of next line
245 `iopl' -- indentation of previous line
246 `bonl' -- beginning of next line
247 `eonl' -- end of next line
248 `bopl' -- beginning of previous line
249 `eopl' -- end of previous line
250 `bosws' -- beginning of syntactic whitespace
251 `eosws' -- end of syntactic whitespace
252
253 If the referenced position doesn't exist, the closest accessible point
254 to it is returned. This function does not modify the point or the mark."
255
256 (if (eq (car-safe position) 'quote)
257 (let ((position (eval position)))
258 (cond
259
260 ((eq position 'bol)
261 (if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point))
262 `(line-beginning-position)
263 `(save-excursion
264 ,@(if point `((goto-char ,point)))
265 (beginning-of-line)
266 (point))))
267
268 ((eq position 'eol)
269 (if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
270 `(line-end-position)
271 `(save-excursion
272 ,@(if point `((goto-char ,point)))
273 (end-of-line)
274 (point))))
275
276 ((eq position 'boi)
277 `(save-excursion
278 ,@(if point `((goto-char ,point)))
279 (back-to-indentation)
280 (point)))
281
282 ((eq position 'bod)
283 `(save-excursion
284 ,@(if point `((goto-char ,point)))
285 (c-beginning-of-defun-1)
286 (point)))
287
288 ((eq position 'eod)
289 `(save-excursion
290 ,@(if point `((goto-char ,point)))
291 (c-end-of-defun-1)
292 (point)))
293
294 ((eq position 'bopl)
295 (if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point))
296 `(line-beginning-position 0)
297 `(save-excursion
298 ,@(if point `((goto-char ,point)))
299 (forward-line -1)
300 (point))))
301
302 ((eq position 'bonl)
303 (if (and (cc-bytecomp-fboundp 'line-beginning-position) (not point))
304 `(line-beginning-position 2)
305 `(save-excursion
306 ,@(if point `((goto-char ,point)))
307 (forward-line 1)
308 (point))))
309
310 ((eq position 'eopl)
311 (if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
312 `(line-end-position 0)
313 `(save-excursion
314 ,@(if point `((goto-char ,point)))
315 (beginning-of-line)
316 (or (bobp) (backward-char))
317 (point))))
318
319 ((eq position 'eonl)
320 (if (and (cc-bytecomp-fboundp 'line-end-position) (not point))
321 `(line-end-position 2)
322 `(save-excursion
323 ,@(if point `((goto-char ,point)))
324 (forward-line 1)
325 (end-of-line)
326 (point))))
327
328 ((eq position 'iopl)
329 `(save-excursion
330 ,@(if point `((goto-char ,point)))
331 (forward-line -1)
332 (back-to-indentation)
333 (point)))
334
335 ((eq position 'ionl)
336 `(save-excursion
337 ,@(if point `((goto-char ,point)))
338 (forward-line 1)
339 (back-to-indentation)
340 (point)))
341
342 ((eq position 'bosws)
343 `(save-excursion
344 ,@(if point `((goto-char ,point)))
345 (c-backward-syntactic-ws)
346 (point)))
347
348 ((eq position 'eosws)
349 `(save-excursion
350 ,@(if point `((goto-char ,point)))
351 (c-forward-syntactic-ws)
352 (point)))
353
354 (t (error "Unknown buffer position requested: %s" position))))
355
356 ;; The bulk of this should perhaps be in a function to avoid large
357 ;; expansions, but this case is not used anywhere in CC Mode (and
358 ;; probably not anywhere else either) so we only have it to be on
359 ;; the safe side.
360 (message "Warning: c-point long expansion")
361 `(save-excursion
362 ,@(if point `((goto-char ,point)))
363 (let ((position ,position))
364 (cond
365 ((eq position 'bol) (beginning-of-line))
366 ((eq position 'eol) (end-of-line))
367 ((eq position 'boi) (back-to-indentation))
368 ((eq position 'bod) (c-beginning-of-defun-1))
369 ((eq position 'eod) (c-end-of-defun-1))
370 ((eq position 'bopl) (forward-line -1))
371 ((eq position 'bonl) (forward-line 1))
372 ((eq position 'eopl) (progn
373 (beginning-of-line)
374 (or (bobp) (backward-char))))
375 ((eq position 'eonl) (progn
376 (forward-line 1)
377 (end-of-line)))
378 ((eq position 'iopl) (progn
379 (forward-line -1)
380 (back-to-indentation)))
381 ((eq position 'ionl) (progn
382 (forward-line 1)
383 (back-to-indentation)))
384 ((eq position 'bosws) (c-backward-syntactic-ws))
385 ((eq position 'eosws) (c-forward-syntactic-ws))
386 (t (error "Unknown buffer position requested: %s" position))))
387 (point))))
388
389 (eval-and-compile
390 ;; Constant to decide at compilation time whether to use category
391 ;; properties. Currently (2010-03) they're available only on GNU Emacs.
392 (defconst c-use-category
393 (with-temp-buffer
394 (let ((parse-sexp-lookup-properties t)
395 (lookup-syntax-properties t))
396 (set-syntax-table (make-syntax-table))
397 (insert "<()>")
398 (put-text-property (point-min) (1+ (point-min))
399 'category 'c-<-as-paren-syntax)
400 (put-text-property (+ 3 (point-min)) (+ 4 (point-min))
401 'category 'c->-as-paren-syntax)
402 (goto-char (point-min))
403 (forward-sexp)
404 (= (point) (+ 4 (point-min)))))))
405
406 (defvar c-use-extents)
407
408 (defmacro c-next-single-property-change (position prop &optional object limit)
409 ;; See the doc string for either of the defuns expanded to.
410 (if (and c-use-extents
411 (fboundp 'next-single-char-property-change))
412 ;; XEmacs >= 2005-01-25
413 `(next-single-char-property-change ,position ,prop ,object ,limit)
414 ;; Emacs and earlier XEmacs
415 `(next-single-property-change ,position ,prop ,object ,limit)))
416
417 (defmacro c-region-is-active-p ()
418 ;; Return t when the region is active. The determination of region
419 ;; activeness is different in both Emacs and XEmacs.
420 (if (cc-bytecomp-fboundp 'region-active-p)
421 ;; XEmacs.
422 '(region-active-p)
423 ;; Old Emacs.
424 'mark-active))
425
426 (defmacro c-set-region-active (activate)
427 ;; Activate the region if ACTIVE is non-nil, deactivate it
428 ;; otherwise. Covers the differences between Emacs and XEmacs.
429 (if (fboundp 'zmacs-activate-region)
430 ;; XEmacs.
431 `(if ,activate
432 (zmacs-activate-region)
433 (zmacs-deactivate-region))
434 ;; Emacs.
435 `(setq mark-active ,activate)))
436
437 (defmacro c-delete-and-extract-region (start end)
438 "Delete the text between START and END and return it."
439 (if (cc-bytecomp-fboundp 'delete-and-extract-region)
440 ;; Emacs 21.1 and later
441 `(delete-and-extract-region ,start ,end)
442 ;; XEmacs and Emacs 20.x
443 `(prog1
444 (buffer-substring ,start ,end)
445 (delete-region ,start ,end))))
446
447 (defmacro c-safe (&rest body)
448 ;; safely execute BODY, return nil if an error occurred
449 `(condition-case nil
450 (progn ,@body)
451 (error nil)))
452 (put 'c-safe 'lisp-indent-function 0)
453
454 (defmacro c-int-to-char (integer)
455 ;; In Emacs, a character is an integer. In XEmacs, a character is a
456 ;; type distinct from an integer. Sometimes we need to convert integers to
457 ;; characters. `c-int-to-char' makes this conversion, if necessary.
458 (if (fboundp 'int-to-char)
459 `(int-to-char ,integer)
460 integer))
461
462 (defmacro c-last-command-char ()
463 ;; The last character just typed. Note that `last-command-event' exists in
464 ;; both Emacs and XEmacs, but with confusingly different meanings.
465 (if (featurep 'xemacs)
466 'last-command-char
467 'last-command-event))
468
469 (defmacro c-sentence-end ()
470 ;; Get the regular expression `sentence-end'.
471 (if (cc-bytecomp-fboundp 'sentence-end)
472 ;; Emacs 22:
473 `(sentence-end)
474 ;; Emacs <22 + XEmacs
475 `sentence-end))
476
477 (defmacro c-default-value-sentence-end ()
478 ;; Get the default value of the variable sentence end.
479 (if (cc-bytecomp-fboundp 'sentence-end)
480 ;; Emacs 22:
481 `(let (sentence-end) (sentence-end))
482 ;; Emacs <22 + XEmacs
483 `(default-value 'sentence-end)))
484
485 ;; The following is essentially `save-buffer-state' from lazy-lock.el.
486 ;; It ought to be a standard macro.
487 (defmacro c-save-buffer-state (varlist &rest body)
488 "Bind variables according to VARLIST (in `let*' style) and eval BODY,
489 then restore the buffer state under the assumption that no significant
490 modification has been made in BODY. A change is considered
491 significant if it affects the buffer text in any way that isn't
492 completely restored again. Changes in text properties like `face' or
493 `syntax-table' are considered insignificant. This macro allows text
494 properties to be changed, even in a read-only buffer.
495
496 This macro should be placed around all calculations which set
497 \"insignificant\" text properties in a buffer, even when the buffer is
498 known to be writable. That way, these text properties remain set
499 even if the user undoes the command which set them.
500
501 This macro should ALWAYS be placed around \"temporary\" internal buffer
502 changes \(like adding a newline to calculate a text-property then
503 deleting it again), so that the user never sees them on his
504 `buffer-undo-list'. See also `c-tentative-buffer-changes'.
505
506 However, any user-visible changes to the buffer \(like auto-newlines)
507 must not be within a `c-save-buffer-state', since the user then
508 wouldn't be able to undo them.
509
510 The return value is the value of the last form in BODY."
511 (declare (debug t) (indent 1))
512 (if (fboundp 'with-silent-modifications)
513 `(with-silent-modifications (let* ,varlist ,@body))
514 `(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
515 (inhibit-read-only t) (inhibit-point-motion-hooks t)
516 before-change-functions after-change-functions
517 deactivate-mark
518 buffer-file-name buffer-file-truename ; Prevent primitives checking
519 ; for file modification
520 ,@varlist)
521 (unwind-protect
522 (progn ,@body)
523 (and (not modified)
524 (buffer-modified-p)
525 (set-buffer-modified-p nil))))))
526
527 (defmacro c-tentative-buffer-changes (&rest body)
528 "Eval BODY and optionally restore the buffer contents to the state it
529 was in before BODY. Any changes are kept if the last form in BODY
530 returns non-nil. Otherwise it's undone using the undo facility, and
531 various other buffer state that might be affected by the changes is
532 restored. That includes the current buffer, point, mark, mark
533 activation \(similar to `save-excursion'), and the modified state.
534 The state is also restored if BODY exits nonlocally.
535
536 If BODY makes a change that unconditionally is undone then wrap this
537 macro inside `c-save-buffer-state'. That way the change can be done
538 even when the buffer is read-only, and without interference from
539 various buffer change hooks."
540 `(let (-tnt-chng-keep
541 -tnt-chng-state)
542 (unwind-protect
543 ;; Insert an undo boundary for use with `undo-more'. We
544 ;; don't use `undo-boundary' since it doesn't insert one
545 ;; unconditionally.
546 (setq buffer-undo-list (cons nil buffer-undo-list)
547 -tnt-chng-state (c-tnt-chng-record-state)
548 -tnt-chng-keep (progn ,@body))
549 (c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state))))
550 (put 'c-tentative-buffer-changes 'lisp-indent-function 0)
551
552 (defun c-tnt-chng-record-state ()
553 ;; Used internally in `c-tentative-buffer-changes'.
554 (vector buffer-undo-list ; 0
555 (current-buffer) ; 1
556 ;; No need to use markers for the point and mark; if the
557 ;; undo got out of synch we're hosed anyway.
558 (point) ; 2
559 (mark t) ; 3
560 (c-region-is-active-p) ; 4
561 (buffer-modified-p))) ; 5
562
563 (defun c-tnt-chng-cleanup (keep saved-state)
564 ;; Used internally in `c-tentative-buffer-changes'.
565
566 (let ((saved-undo-list (elt saved-state 0)))
567 (if (eq buffer-undo-list saved-undo-list)
568 ;; No change was done after all.
569 (setq buffer-undo-list (cdr saved-undo-list))
570
571 (if keep
572 ;; Find and remove the undo boundary.
573 (let ((p buffer-undo-list))
574 (while (not (eq (cdr p) saved-undo-list))
575 (setq p (cdr p)))
576 (setcdr p (cdr saved-undo-list)))
577
578 ;; `primitive-undo' will remove the boundary.
579 (setq saved-undo-list (cdr saved-undo-list))
580 (let ((undo-in-progress t))
581 (while (not (eq (setq buffer-undo-list
582 (primitive-undo 1 buffer-undo-list))
583 saved-undo-list))))
584
585 (when (buffer-live-p (elt saved-state 1))
586 (set-buffer (elt saved-state 1))
587 (goto-char (elt saved-state 2))
588 (set-mark (elt saved-state 3))
589 (c-set-region-active (elt saved-state 4))
590 (and (not (elt saved-state 5))
591 (buffer-modified-p)
592 (set-buffer-modified-p nil)))))))
593
594 (defmacro c-forward-syntactic-ws (&optional limit)
595 "Forward skip over syntactic whitespace.
596 Syntactic whitespace is defined as whitespace characters, comments,
597 and preprocessor directives. However if point starts inside a comment
598 or preprocessor directive, the content of it is not treated as
599 whitespace.
600
601 LIMIT sets an upper limit of the forward movement, if specified. If
602 LIMIT or the end of the buffer is reached inside a comment or
603 preprocessor directive, the point will be left there.
604
605 Note that this function might do hidden buffer changes. See the
606 comment at the start of cc-engine.el for more info."
607 (if limit
608 `(save-restriction
609 (narrow-to-region (point-min) (or ,limit (point-max)))
610 (c-forward-sws))
611 '(c-forward-sws)))
612
613 (defmacro c-backward-syntactic-ws (&optional limit)
614 "Backward skip over syntactic whitespace.
615 Syntactic whitespace is defined as whitespace characters, comments,
616 and preprocessor directives. However if point starts inside a comment
617 or preprocessor directive, the content of it is not treated as
618 whitespace.
619
620 LIMIT sets a lower limit of the backward movement, if specified. If
621 LIMIT is reached inside a line comment or preprocessor directive then
622 the point is moved into it past the whitespace at the end.
623
624 Note that this function might do hidden buffer changes. See the
625 comment at the start of cc-engine.el for more info."
626 (if limit
627 `(save-restriction
628 (narrow-to-region (or ,limit (point-min)) (point-max))
629 (c-backward-sws))
630 '(c-backward-sws)))
631
632 (defmacro c-forward-sexp (&optional count)
633 "Move forward across COUNT balanced expressions.
634 A negative COUNT means move backward. Signal an error if the move
635 fails for any reason.
636
637 This is like `forward-sexp' except that it isn't interactive and does
638 not do any user friendly adjustments of the point and that it isn't
639 susceptible to user configurations such as disabling of signals in
640 certain situations."
641 (or count (setq count 1))
642 `(goto-char (scan-sexps (point) ,count)))
643
644 (defmacro c-backward-sexp (&optional count)
645 "See `c-forward-sexp' and reverse directions."
646 (or count (setq count 1))
647 `(c-forward-sexp ,(if (numberp count) (- count) `(- ,count))))
648
649 (defmacro c-safe-scan-lists (from count depth &optional limit)
650 "Like `scan-lists' but returns nil instead of signaling errors
651 for unbalanced parens.
652
653 A limit for the search may be given. FROM is assumed to be on the
654 right side of it."
655 (let ((res (if (featurep 'xemacs)
656 `(scan-lists ,from ,count ,depth nil t)
657 `(c-safe (scan-lists ,from ,count ,depth)))))
658 (if limit
659 `(save-restriction
660 ,(if (numberp count)
661 (if (< count 0)
662 `(narrow-to-region ,limit (point-max))
663 `(narrow-to-region (point-min) ,limit))
664 `(if (< ,count 0)
665 (narrow-to-region ,limit (point-max))
666 (narrow-to-region (point-min) ,limit)))
667 ,res)
668 res)))
669
670 \f
671 ;; Wrappers for common scan-lists cases, mainly because it's almost
672 ;; impossible to get a feel for how that function works.
673
674 (defmacro c-go-list-forward ()
675 "Move backward across one balanced group of parentheses.
676
677 Return POINT when we succeed, NIL when we fail. In the latter case, leave
678 point unmoved."
679 `(c-safe (let ((endpos (scan-lists (point) 1 0)))
680 (goto-char endpos)
681 endpos)))
682
683 (defmacro c-go-list-backward ()
684 "Move backward across one balanced group of parentheses.
685
686 Return POINT when we succeed, NIL when we fail. In the latter case, leave
687 point unmoved."
688 `(c-safe (let ((endpos (scan-lists (point) -1 0)))
689 (goto-char endpos)
690 endpos)))
691
692 (defmacro c-up-list-forward (&optional pos limit)
693 "Return the first position after the list sexp containing POS,
694 or nil if no such position exists. The point is used if POS is left out.
695
696 A limit for the search may be given. The start position is assumed to
697 be before it."
698 `(c-safe-scan-lists ,(or pos `(point)) 1 1 ,limit))
699
700 (defmacro c-up-list-backward (&optional pos limit)
701 "Return the position of the start of the list sexp containing POS,
702 or nil if no such position exists. The point is used if POS is left out.
703
704 A limit for the search may be given. The start position is assumed to
705 be after it."
706 `(c-safe-scan-lists ,(or pos `(point)) -1 1 ,limit))
707
708 (defmacro c-down-list-forward (&optional pos limit)
709 "Return the first position inside the first list sexp after POS,
710 or nil if no such position exists. The point is used if POS is left out.
711
712 A limit for the search may be given. The start position is assumed to
713 be before it."
714 `(c-safe-scan-lists ,(or pos `(point)) 1 -1 ,limit))
715
716 (defmacro c-down-list-backward (&optional pos limit)
717 "Return the last position inside the last list sexp before POS,
718 or nil if no such position exists. The point is used if POS is left out.
719
720 A limit for the search may be given. The start position is assumed to
721 be after it."
722 `(c-safe-scan-lists ,(or pos `(point)) -1 -1 ,limit))
723
724 (defmacro c-go-up-list-forward (&optional pos limit)
725 "Move the point to the first position after the list sexp containing POS,
726 or containing the point if POS is left out. Return t if such a
727 position exists, otherwise nil is returned and the point isn't moved.
728
729 A limit for the search may be given. The start position is assumed to
730 be before it."
731 (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 1)) t)))
732 (if limit
733 `(save-restriction
734 (narrow-to-region (point-min) ,limit)
735 ,res)
736 res)))
737
738 (defmacro c-go-up-list-backward (&optional pos limit)
739 "Move the point to the position of the start of the list sexp containing POS,
740 or containing the point if POS is left out. Return t if such a
741 position exists, otherwise nil is returned and the point isn't moved.
742
743 A limit for the search may be given. The start position is assumed to
744 be after it."
745 (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 1)) t)))
746 (if limit
747 `(save-restriction
748 (narrow-to-region ,limit (point-max))
749 ,res)
750 res)))
751
752 (defmacro c-go-down-list-forward (&optional pos limit)
753 "Move the point to the first position inside the first list sexp after POS,
754 or before the point if POS is left out. Return t if such a position
755 exists, otherwise nil is returned and the point isn't moved.
756
757 A limit for the search may be given. The start position is assumed to
758 be before it."
759 (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) 1 -1)) t)))
760 (if limit
761 `(save-restriction
762 (narrow-to-region (point-min) ,limit)
763 ,res)
764 res)))
765
766 (defmacro c-go-down-list-backward (&optional pos limit)
767 "Move the point to the last position inside the last list sexp before POS,
768 or before the point if POS is left out. Return t if such a position
769 exists, otherwise nil is returned and the point isn't moved.
770
771 A limit for the search may be given. The start position is assumed to
772 be after it."
773 (let ((res `(c-safe (goto-char (scan-lists ,(or pos `(point)) -1 -1)) t)))
774 (if limit
775 `(save-restriction
776 (narrow-to-region ,limit (point-max))
777 ,res)
778 res)))
779
780 \f
781 (defmacro c-beginning-of-defun-1 ()
782 ;; Wrapper around beginning-of-defun.
783 ;;
784 ;; NOTE: This function should contain the only explicit use of
785 ;; beginning-of-defun in CC Mode. Eventually something better than
786 ;; b-o-d will be available and this should be the only place the
787 ;; code needs to change. Everything else should use
788 ;; (c-beginning-of-defun-1)
789 ;;
790 ;; This is really a bit too large to be a macro but that isn't a
791 ;; problem as long as it only is used in one place in
792 ;; `c-parse-state'.
793
794 `(progn
795 (if (and ,(fboundp 'buffer-syntactic-context-depth)
796 c-enable-xemacs-performance-kludge-p)
797 ,(when (fboundp 'buffer-syntactic-context-depth)
798 ;; XEmacs only. This can improve the performance of
799 ;; c-parse-state to between 3 and 60 times faster when
800 ;; braces are hung. It can also degrade performance by
801 ;; about as much when braces are not hung.
802 '(let (beginning-of-defun-function end-of-defun-function
803 pos)
804 (while (not pos)
805 (save-restriction
806 (widen)
807 (setq pos (c-safe-scan-lists
808 (point) -1 (buffer-syntactic-context-depth))))
809 (cond
810 ((bobp) (setq pos (point-min)))
811 ((not pos)
812 (let ((distance (skip-chars-backward "^{")))
813 ;; unbalanced parenthesis, while invalid C code,
814 ;; shouldn't cause an infloop! See unbal.c
815 (when (zerop distance)
816 ;; Punt!
817 (beginning-of-defun)
818 (setq pos (point)))))
819 ((= pos 0))
820 ((not (eq (char-after pos) ?{))
821 (goto-char pos)
822 (setq pos nil))
823 ))
824 (goto-char pos)))
825 ;; Emacs, which doesn't have buffer-syntactic-context-depth
826 (let (beginning-of-defun-function end-of-defun-function)
827 (beginning-of-defun)))
828 ;; if defun-prompt-regexp is non-nil, b-o-d won't leave us at the
829 ;; open brace.
830 (and defun-prompt-regexp
831 (looking-at defun-prompt-regexp)
832 (goto-char (match-end 0)))))
833
834 \f
835 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
836 ;; V i r t u a l S e m i c o l o n s
837 ;;
838 ;; In most CC Mode languages, statements are terminated explicitly by
839 ;; semicolons or closing braces. In some of the CC modes (currently AWK Mode
840 ;; and certain user-specified #define macros in C, C++, etc. (November 2008)),
841 ;; statements are (or can be) terminated by EOLs. Such a statement is said to
842 ;; be terminated by a "virtual semicolon" (VS). A statement terminated by an
843 ;; actual semicolon or brace is never considered to have a VS.
844 ;;
845 ;; The indentation engine (or whatever) tests for a VS at a specific position
846 ;; by invoking the macro `c-at-vsemi-p', which in its turn calls the mode
847 ;; specific function (if any) which is the value of the language variable
848 ;; `c-at-vsemi-p-fn'. This function should only use "low-level" features of
849 ;; CC Mode, i.e. features which won't trigger infinite recursion. ;-) The
850 ;; actual details of what constitutes a VS in a language are thus encapsulated
851 ;; in code specific to that language (e.g. cc-awk.el). `c-at-vsemi-p' returns
852 ;; non-nil if point (or the optional parameter POS) is at a VS, nil otherwise.
853 ;;
854 ;; The language specific function might well do extensive analysis of the
855 ;; source text, and may use a caching scheme to speed up repeated calls.
856 ;;
857 ;; The "virtual semicolon" lies just after the last non-ws token on the line.
858 ;; Like POINT, it is considered to lie between two characters. For example,
859 ;; at the place shown in the following AWK source line:
860 ;;
861 ;; kbyte = 1024 # 1000 if you're not picky
862 ;; ^
863 ;; |
864 ;; Virtual Semicolon
865 ;;
866 ;; In addition to `c-at-vsemi-p-fn', a mode may need to supply a function for
867 ;; `c-vsemi-status-unknown-p-fn'. The macro `c-vsemi-status-unknown-p' is a
868 ;; rather recondite kludge. It exists because the function
869 ;; `c-beginning-of-statement-1' sometimes tests for VSs as an optimization,
870 ;; but `c-at-vsemi-p' might well need to call `c-beginning-of-statement-1' in
871 ;; its calculations, thus potentially leading to infinite recursion.
872 ;;
873 ;; The macro `c-vsemi-status-unknown-p' resolves this problem; it may return
874 ;; non-nil at any time; returning nil is a guarantee that an immediate
875 ;; invocation of `c-at-vsemi-p' at point will NOT call
876 ;; `c-beginning-of-statement-1'. `c-vsemi-status-unknown-p' may not itself
877 ;; call `c-beginning-of-statement-1'.
878 ;;
879 ;; The macro `c-vsemi-status-unknown-p' will typically check the caching
880 ;; scheme used by the `c-at-vsemi-p-fn', hence the name - the status is
881 ;; "unknown" if there is no cache entry current for the line.
882 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
883
884 (defmacro c-at-vsemi-p (&optional pos)
885 ;; Is there a virtual semicolon (not a real one or a }) at POS (defaults to
886 ;; point)? Always returns nil for languages which don't have Virtual
887 ;; semicolons.
888 ;; This macro might do hidden buffer changes.
889 `(if c-at-vsemi-p-fn
890 (funcall c-at-vsemi-p-fn ,@(if pos `(,pos)))))
891
892 (defmacro c-vsemi-status-unknown-p ()
893 ;; Return NIL only if it can be guaranteed that an immediate
894 ;; (c-at-vsemi-p) will NOT call c-beginning-of-statement-1. Otherwise,
895 ;; return non-nil. (See comments above). The function invoked by this
896 ;; macro MUST NOT UNDER ANY CIRCUMSTANCES itself call
897 ;; c-beginning-of-statement-1.
898 ;; Languages which don't have EOL terminated statements always return NIL
899 ;; (they _know_ there's no vsemi ;-).
900 `(if c-vsemi-status-unknown-p-fn (funcall c-vsemi-status-unknown-p-fn)))
901
902 \f
903 (defmacro c-benign-error (format &rest args)
904 ;; Formats an error message for the echo area and dings, i.e. like
905 ;; `error' but doesn't abort.
906 `(progn
907 (message ,format ,@args)
908 (ding)))
909
910 (defmacro c-with-syntax-table (table &rest code)
911 ;; Temporarily switches to the specified syntax table in a failsafe
912 ;; way to execute code.
913 ;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call
914 ;; any forms inside this that call `c-parse-state'. !!!!
915 `(let ((c-with-syntax-table-orig-table (syntax-table)))
916 (unwind-protect
917 (progn
918 (set-syntax-table ,table)
919 ,@code)
920 (set-syntax-table c-with-syntax-table-orig-table))))
921 (put 'c-with-syntax-table 'lisp-indent-function 1)
922
923 (defmacro c-skip-ws-forward (&optional limit)
924 "Skip over any whitespace following point.
925 This function skips over horizontal and vertical whitespace and line
926 continuations."
927 (if limit
928 `(let ((limit (or ,limit (point-max))))
929 (while (progn
930 ;; skip-syntax-* doesn't count \n as whitespace..
931 (skip-chars-forward " \t\n\r\f\v" limit)
932 (when (and (eq (char-after) ?\\)
933 (< (point) limit))
934 (forward-char)
935 (or (eolp)
936 (progn (backward-char) nil))))))
937 '(while (progn
938 (skip-chars-forward " \t\n\r\f\v")
939 (when (eq (char-after) ?\\)
940 (forward-char)
941 (or (eolp)
942 (progn (backward-char) nil)))))))
943
944 (defmacro c-skip-ws-backward (&optional limit)
945 "Skip over any whitespace preceding point.
946 This function skips over horizontal and vertical whitespace and line
947 continuations."
948 (if limit
949 `(let ((limit (or ,limit (point-min))))
950 (while (progn
951 ;; skip-syntax-* doesn't count \n as whitespace..
952 (skip-chars-backward " \t\n\r\f\v" limit)
953 (and (eolp)
954 (eq (char-before) ?\\)
955 (> (point) limit)))
956 (backward-char)))
957 '(while (progn
958 (skip-chars-backward " \t\n\r\f\v")
959 (and (eolp)
960 (eq (char-before) ?\\)))
961 (backward-char))))
962
963 (eval-and-compile
964 (defvar c-langs-are-parametric nil))
965
966 (defmacro c-major-mode-is (mode)
967 "Return non-nil if the current CC Mode major mode is MODE.
968 MODE is either a mode symbol or a list of mode symbols."
969
970 (if c-langs-are-parametric
971 ;; Inside a `c-lang-defconst'.
972 `(c-lang-major-mode-is ,mode)
973
974 (if (eq (car-safe mode) 'quote)
975 (let ((mode (eval mode)))
976 (if (listp mode)
977 `(memq c-buffer-is-cc-mode ',mode)
978 `(eq c-buffer-is-cc-mode ',mode)))
979
980 `(let ((mode ,mode))
981 (if (listp mode)
982 (memq c-buffer-is-cc-mode mode)
983 (eq c-buffer-is-cc-mode mode))))))
984
985 \f
986 ;; Macros/functions to handle so-called "char properties", which are
987 ;; properties set on a single character and that never spread to any
988 ;; other characters.
989
990 (eval-and-compile
991 ;; Constant used at compile time to decide whether or not to use
992 ;; XEmacs extents. Check all the extent functions we'll use since
993 ;; some packages might add compatibility aliases for some of them in
994 ;; Emacs.
995 (defconst c-use-extents (and (cc-bytecomp-fboundp 'extent-at)
996 (cc-bytecomp-fboundp 'set-extent-property)
997 (cc-bytecomp-fboundp 'set-extent-properties)
998 (cc-bytecomp-fboundp 'make-extent)
999 (cc-bytecomp-fboundp 'extent-property)
1000 (cc-bytecomp-fboundp 'delete-extent)
1001 (cc-bytecomp-fboundp 'map-extents))))
1002
1003 (defconst c-<-as-paren-syntax '(4 . ?>))
1004 (put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax)
1005
1006 (defconst c->-as-paren-syntax '(5 . ?<))
1007 (put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax)
1008
1009 ;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to
1010 ;; make it a function.
1011 (defalias 'c-put-char-property-fun
1012 (cc-eval-when-compile
1013 (cond (c-use-extents
1014 ;; XEmacs.
1015 (byte-compile
1016 (lambda (pos property value)
1017 (let ((ext (extent-at pos nil property)))
1018 (if ext
1019 (set-extent-property ext property value)
1020 (set-extent-properties (make-extent pos (1+ pos))
1021 (cons property
1022 (cons value
1023 '(start-open t
1024 end-open t)))))))))
1025
1026 ((not (cc-bytecomp-boundp 'text-property-default-nonsticky))
1027 ;; In Emacs < 21 we have to mess with the `rear-nonsticky' property.
1028 (byte-compile
1029 (lambda (pos property value)
1030 (put-text-property pos (1+ pos) property value)
1031 (let ((prop (get-text-property pos 'rear-nonsticky)))
1032 (or (memq property prop)
1033 (put-text-property pos (1+ pos)
1034 'rear-nonsticky
1035 (cons property prop)))))))
1036 ;; This won't be used for anything.
1037 (t 'ignore))))
1038 (cc-bytecomp-defun c-put-char-property-fun) ; Make it known below.
1039
1040 (defmacro c-put-char-property (pos property value)
1041 ;; Put the given property with the given value on the character at
1042 ;; POS and make it front and rear nonsticky, or start and end open
1043 ;; in XEmacs vocabulary. If the character already has the given
1044 ;; property then the value is replaced, and the behavior is
1045 ;; undefined if that property has been put by some other function.
1046 ;; PROPERTY is assumed to be constant.
1047 ;;
1048 ;; If there's a `text-property-default-nonsticky' variable (Emacs
1049 ;; 21) then it's assumed that the property is present on it.
1050 ;;
1051 ;; This macro does a hidden buffer change.
1052 (setq property (eval property))
1053 (if (or c-use-extents
1054 (not (cc-bytecomp-boundp 'text-property-default-nonsticky)))
1055 ;; XEmacs and Emacs < 21.
1056 `(c-put-char-property-fun ,pos ',property ,value)
1057 ;; In Emacs 21 we got the `rear-nonsticky' property covered
1058 ;; by `text-property-default-nonsticky'.
1059 `(let ((-pos- ,pos))
1060 (put-text-property -pos- (1+ -pos-) ',property ,value))))
1061
1062 (defmacro c-get-char-property (pos property)
1063 ;; Get the value of the given property on the character at POS if
1064 ;; it's been put there by `c-put-char-property'. PROPERTY is
1065 ;; assumed to be constant.
1066 (setq property (eval property))
1067 (if c-use-extents
1068 ;; XEmacs.
1069 `(let ((ext (extent-at ,pos nil ',property)))
1070 (if ext (extent-property ext ',property)))
1071 ;; Emacs.
1072 `(get-text-property ,pos ',property)))
1073
1074 ;; `c-clear-char-property' is complex enough in Emacs < 21 to make it
1075 ;; a function, since we have to mess with the `rear-nonsticky' property.
1076 (defalias 'c-clear-char-property-fun
1077 (cc-eval-when-compile
1078 (unless (or c-use-extents
1079 (cc-bytecomp-boundp 'text-property-default-nonsticky))
1080 (byte-compile
1081 (lambda (pos property)
1082 (when (get-text-property pos property)
1083 (remove-text-properties pos (1+ pos) (list property nil))
1084 (put-text-property pos (1+ pos)
1085 'rear-nonsticky
1086 (delq property (get-text-property
1087 pos 'rear-nonsticky)))))))))
1088 (cc-bytecomp-defun c-clear-char-property-fun) ; Make it known below.
1089
1090 (defmacro c-clear-char-property (pos property)
1091 ;; Remove the given property on the character at POS if it's been put
1092 ;; there by `c-put-char-property'. PROPERTY is assumed to be
1093 ;; constant.
1094 ;;
1095 ;; This macro does a hidden buffer change.
1096 (setq property (eval property))
1097 (cond (c-use-extents
1098 ;; XEmacs.
1099 `(let ((ext (extent-at ,pos nil ',property)))
1100 (if ext (delete-extent ext))))
1101 ((cc-bytecomp-boundp 'text-property-default-nonsticky)
1102 ;; In Emacs 21 we got the `rear-nonsticky' property covered
1103 ;; by `text-property-default-nonsticky'.
1104 `(let ((pos ,pos))
1105 (remove-text-properties pos (1+ pos)
1106 '(,property nil))))
1107 (t
1108 ;; Emacs < 21.
1109 `(c-clear-char-property-fun ,pos ',property))))
1110
1111 (defmacro c-clear-char-properties (from to property)
1112 ;; Remove all the occurrences of the given property in the given
1113 ;; region that has been put with `c-put-char-property'. PROPERTY is
1114 ;; assumed to be constant.
1115 ;;
1116 ;; Note that this function does not clean up the property from the
1117 ;; lists of the `rear-nonsticky' properties in the region, if such
1118 ;; are used. Thus it should not be used for common properties like
1119 ;; `syntax-table'.
1120 ;;
1121 ;; This macro does hidden buffer changes.
1122 (setq property (eval property))
1123 (if c-use-extents
1124 ;; XEmacs.
1125 `(map-extents (lambda (ext ignored)
1126 (delete-extent ext))
1127 nil ,from ,to nil nil ',property)
1128 ;; Emacs.
1129 `(remove-text-properties ,from ,to '(,property nil))))
1130
1131 (defmacro c-search-forward-char-property (property value &optional limit)
1132 "Search forward for a text-property PROPERTY having value VALUE.
1133 LIMIT bounds the search. The comparison is done with `equal'.
1134
1135 Leave point just after the character, and set the match data on
1136 this character, and return point. If VALUE isn't found, Return
1137 nil; point is then left undefined."
1138 `(let ((place (point)))
1139 (while
1140 (and
1141 (< place ,(or limit '(point-max)))
1142 (not (equal (c-get-char-property place ,property) ,value)))
1143 (setq place (c-next-single-property-change
1144 place ,property nil ,(or limit '(point-max)))))
1145 (when (< place ,(or limit '(point-max)))
1146 (goto-char place)
1147 (search-forward-regexp ".") ; to set the match-data.
1148 (point))))
1149
1150 (defmacro c-search-backward-char-property (property value &optional limit)
1151 "Search backward for a text-property PROPERTY having value VALUE.
1152 LIMIT bounds the search. The comparison is done with `equal'.
1153
1154 Leave point just before the character, set the match data on this
1155 character, and return point. If VALUE isn't found, Return nil;
1156 point is then left undefined."
1157 `(let ((place (point)))
1158 (while
1159 (and
1160 (> place ,(or limit '(point-min)))
1161 (not (equal (c-get-char-property (1- place) ,property) ,value)))
1162 (setq place (,(if (and c-use-extents
1163 (fboundp 'previous-single-char-property-change))
1164 ;; XEmacs > 2005-01-25.
1165 'previous-single-char-property-change
1166 ;; Emacs and earlier XEmacs.
1167 'previous-single-property-change)
1168 place ,property nil ,(or limit '(point-min)))))
1169 (when (> place ,(or limit '(point-min)))
1170 (goto-char place)
1171 (search-backward-regexp ".") ; to set the match-data.
1172 (point))))
1173
1174 (defun c-clear-char-property-with-value-function (from to property value)
1175 "Remove all text-properties PROPERTY from the region (FROM, TO)
1176 which have the value VALUE, as tested by `equal'. These
1177 properties are assumed to be over individual characters, having
1178 been put there by c-put-char-property. POINT remains unchanged."
1179 (let ((place from) end-place)
1180 (while ; loop round occurrences of (PROPERTY VALUE)
1181 (progn
1182 (while ; loop round changes in PROPERTY till we find VALUE
1183 (and
1184 (< place to)
1185 (not (equal (get-text-property place property) value)))
1186 (setq place (c-next-single-property-change place property nil to)))
1187 (< place to))
1188 (setq end-place (c-next-single-property-change place property nil to))
1189 (remove-text-properties place end-place (cons property nil))
1190 ;; Do we have to do anything with stickiness here?
1191 (setq place end-place))))
1192
1193 (defmacro c-clear-char-property-with-value (from to property value)
1194 "Remove all text-properties PROPERTY from the region [FROM, TO)
1195 which have the value VALUE, as tested by `equal'. These
1196 properties are assumed to be over individual characters, having
1197 been put there by c-put-char-property. POINT remains unchanged."
1198 (if c-use-extents
1199 ;; XEmacs
1200 `(let ((-property- ,property))
1201 (map-extents (lambda (ext val)
1202 (if (equal (extent-property ext -property-) val)
1203 (delete-extent ext)))
1204 nil ,from ,to ,value nil -property-))
1205 ;; GNU Emacs
1206 `(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
1207 \f
1208 ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
1209 ;; For our purposes, these are characterized by being possible to
1210 ;; remove again without affecting the other text properties in the
1211 ;; buffer that got overridden when they were put.
1212
1213 (defmacro c-put-overlay (from to property value)
1214 ;; Put an overlay/extent covering the given range in the current
1215 ;; buffer. It's currently undefined whether it's front/end sticky
1216 ;; or not. The overlay/extent object is returned.
1217 (if (cc-bytecomp-fboundp 'make-overlay)
1218 ;; Emacs.
1219 `(let ((ol (make-overlay ,from ,to)))
1220 (overlay-put ol ,property ,value)
1221 ol)
1222 ;; XEmacs.
1223 `(let ((ext (make-extent ,from ,to)))
1224 (set-extent-property ext ,property ,value)
1225 ext)))
1226
1227 (defmacro c-delete-overlay (overlay)
1228 ;; Deletes an overlay/extent object previously retrieved using
1229 ;; `c-put-overlay'.
1230 (if (cc-bytecomp-fboundp 'make-overlay)
1231 ;; Emacs.
1232 `(delete-overlay ,overlay)
1233 ;; XEmacs.
1234 `(delete-extent ,overlay)))
1235
1236 \f
1237 ;; Make edebug understand the macros.
1238 ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
1239 ; '(progn
1240 (def-edebug-spec cc-eval-when-compile (&rest def-form))
1241 (def-edebug-spec c-point t)
1242 (def-edebug-spec c-set-region-active t)
1243 (def-edebug-spec c-safe t)
1244 (def-edebug-spec c-save-buffer-state let*)
1245 (def-edebug-spec c-tentative-buffer-changes t)
1246 (def-edebug-spec c-forward-syntactic-ws t)
1247 (def-edebug-spec c-backward-syntactic-ws t)
1248 (def-edebug-spec c-forward-sexp t)
1249 (def-edebug-spec c-backward-sexp t)
1250 (def-edebug-spec c-up-list-forward t)
1251 (def-edebug-spec c-up-list-backward t)
1252 (def-edebug-spec c-down-list-forward t)
1253 (def-edebug-spec c-down-list-backward t)
1254 (def-edebug-spec c-add-syntax t)
1255 (def-edebug-spec c-add-class-syntax t)
1256 (def-edebug-spec c-benign-error t)
1257 (def-edebug-spec c-with-syntax-table t)
1258 (def-edebug-spec c-skip-ws-forward t)
1259 (def-edebug-spec c-skip-ws-backward t)
1260 (def-edebug-spec c-major-mode-is t)
1261 (def-edebug-spec c-put-char-property t)
1262 (def-edebug-spec c-get-char-property t)
1263 (def-edebug-spec c-clear-char-property t)
1264 (def-edebug-spec c-clear-char-properties t)
1265 (def-edebug-spec c-put-overlay t)
1266 (def-edebug-spec c-delete-overlay t) ;))
1267
1268 \f
1269 ;;; Functions.
1270
1271 ;; Note: All these after the macros, to be on safe side in avoiding
1272 ;; bugs where macros are defined too late. These bugs often only show
1273 ;; when the files are compiled in a certain order within the same
1274 ;; session.
1275
1276 (defsubst c-end-of-defun-1 ()
1277 ;; Replacement for end-of-defun that use c-beginning-of-defun-1.
1278 (let ((start (point)))
1279 ;; Skip forward into the next defun block. Don't bother to avoid
1280 ;; comments, literals etc, since beginning-of-defun doesn't do that
1281 ;; anyway.
1282 (skip-chars-forward "^}")
1283 (c-beginning-of-defun-1)
1284 (if (eq (char-after) ?{)
1285 (c-forward-sexp))
1286 (if (< (point) start)
1287 (goto-char (point-max)))))
1288
1289 (defmacro c-mark-<-as-paren (pos)
1290 ;; Mark the "<" character at POS as a template opener using the
1291 ;; `syntax-table' property either directly (XEmacs) or via a `category'
1292 ;; property (GNU Emacs).
1293 ;;
1294 ;; This function does a hidden buffer change. Note that we use
1295 ;; indirection through the `category' text property. This allows us to
1296 ;; toggle the property in all template brackets simultaneously and
1297 ;; cheaply. We use this, for instance, in `c-parse-state'.
1298 (if c-use-category
1299 `(c-put-char-property ,pos 'category 'c-<-as-paren-syntax)
1300 `(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax)))
1301
1302
1303 (defmacro c-mark->-as-paren (pos)
1304 ;; Mark the ">" character at POS as an sexp list closer using the
1305 ;; `syntax-table' property either directly (XEmacs) or via a `category'
1306 ;; property (GNU Emacs).
1307 ;;
1308 ;; This function does a hidden buffer change. Note that we use
1309 ;; indirection through the `category' text property. This allows us to
1310 ;; toggle the property in all template brackets simultaneously and
1311 ;; cheaply. We use this, for instance, in `c-parse-state'.
1312 (if c-use-category
1313 `(c-put-char-property ,pos 'category 'c->-as-paren-syntax)
1314 `(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax)))
1315
1316 (defmacro c-unmark-<->-as-paren (pos)
1317 ;; Unmark the "<" or "<" character at POS as an sexp list opener using the
1318 ;; `syntax-table' property either directly or indirectly through a
1319 ;; `category' text property.
1320 ;;
1321 ;; This function does a hidden buffer change. Note that we try to use
1322 ;; indirection through the `category' text property. This allows us to
1323 ;; toggle the property in all template brackets simultaneously and
1324 ;; cheaply. We use this, for instance, in `c-parse-state'.
1325 `(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table)))
1326
1327 (defsubst c-suppress-<->-as-parens ()
1328 ;; Suppress the syntactic effect of all marked < and > as parens. Note
1329 ;; that this effect is NOT buffer local. You should probably not use
1330 ;; this directly, but only through the macro
1331 ;; `c-with-<->-as-parens-suppressed'
1332 (put 'c-<-as-paren-syntax 'syntax-table nil)
1333 (put 'c->-as-paren-syntax 'syntax-table nil))
1334
1335 (defsubst c-restore-<->-as-parens ()
1336 ;; Restore the syntactic effect of all marked <s and >s as parens. This
1337 ;; has no effect on unmarked <s and >s
1338 (put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax)
1339 (put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax))
1340
1341 (defmacro c-with-<->-as-parens-suppressed (&rest forms)
1342 ;; Like progn, except that the paren property is suppressed on all
1343 ;; template brackets whilst they are running. This macro does a hidden
1344 ;; buffer change.
1345 `(unwind-protect
1346 (progn
1347 (c-suppress-<->-as-parens)
1348 ,@forms)
1349 (c-restore-<->-as-parens)))
1350
1351 ;;;;;;;;;;;;;;;
1352
1353 (defconst c-cpp-delimiter '(14)) ; generic comment syntax
1354 ;; This is the value of the `category' text property placed on every #
1355 ;; which introduces a CPP construct and every EOL (or EOB, or character
1356 ;; preceding //, etc.) which terminates it. We can instantly "comment
1357 ;; out" all CPP constructs by giving `c-cpp-delimiter' a syntax-table
1358 ;; property '(14) (generic comment delimiter).
1359 (defmacro c-set-cpp-delimiters (beg end)
1360 ;; This macro does a hidden buffer change.
1361 `(progn
1362 (c-put-char-property ,beg 'category 'c-cpp-delimiter)
1363 (if (< ,end (point-max))
1364 (c-put-char-property ,end 'category 'c-cpp-delimiter))))
1365 (defmacro c-clear-cpp-delimiters (beg end)
1366 ;; This macro does a hidden buffer change.
1367 `(progn
1368 (c-clear-char-property ,beg 'category)
1369 (if (< ,end (point-max))
1370 (c-clear-char-property ,end 'category))))
1371
1372 (defsubst c-comment-out-cpps ()
1373 ;; Render all preprocessor constructs syntactically commented out.
1374 (put 'c-cpp-delimiter 'syntax-table c-cpp-delimiter))
1375 (defsubst c-uncomment-out-cpps ()
1376 ;; Restore the syntactic visibility of preprocessor constructs.
1377 (put 'c-cpp-delimiter 'syntax-table nil))
1378
1379 (defmacro c-with-cpps-commented-out (&rest forms)
1380 ;; Execute FORMS... whilst the syntactic effect of all characters in
1381 ;; all CPP regions is suppressed. In particular, this is to suppress
1382 ;; the syntactic significance of parens/braces/brackets to functions
1383 ;; such as `scan-lists' and `parse-partial-sexp'.
1384 `(unwind-protect
1385 (c-save-buffer-state ()
1386 (c-comment-out-cpps)
1387 ,@forms)
1388 (c-save-buffer-state ()
1389 (c-uncomment-out-cpps))))
1390
1391 (defmacro c-with-all-but-one-cpps-commented-out (beg end &rest forms)
1392 ;; Execute FORMS... whilst the syntactic effect of all characters in
1393 ;; every CPP region APART FROM THE ONE BETWEEN BEG and END is
1394 ;; suppressed.
1395 `(unwind-protect
1396 (c-save-buffer-state ()
1397 (save-restriction
1398 (widen)
1399 (c-clear-cpp-delimiters ,beg ,end))
1400 ,`(c-with-cpps-commented-out ,@forms))
1401 (c-save-buffer-state ()
1402 (save-restriction
1403 (widen)
1404 (c-set-cpp-delimiters ,beg ,end)))))
1405 \f
1406 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1407 ;; The following macros are to be used only in `c-parse-state' and its
1408 ;; subroutines. Their main purpose is to simplify the handling of C++/Java
1409 ;; template delimiters and CPP macros. In GNU Emacs, this is done slickly by
1410 ;; the judicious use of 'category properties. These don't exist in XEmacs.
1411 ;;
1412 ;; Note: in the following macros, there is no special handling for parentheses
1413 ;; inside CPP constructs. That is because CPPs are always syntactically
1414 ;; balanced, thanks to `c-neutralize-CPP-line' in cc-mode.el.
1415 (defmacro c-sc-scan-lists-no-category+1+1 (from)
1416 ;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is
1417 ;; determined by and angle bracket; or (ii) is inside a macro whose start
1418 ;; isn't POINT-MACRO-START doesn't count as a finishing position.
1419 `(let ((here (point))
1420 (pos (scan-lists ,from 1 1)))
1421 (while (eq (char-before pos) ?>)
1422 (setq pos (scan-lists pos 1 1)))
1423 pos))
1424
1425 (defmacro c-sc-scan-lists-no-category+1-1 (from)
1426 ;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is
1427 ;; determined by an angle bracket; or (ii) is inside a macro whose start
1428 ;; isn't POINT-MACRO-START doesn't count as a finishing position.
1429 `(let ((here (point))
1430 (pos (scan-lists ,from 1 -1)))
1431 (while (eq (char-before pos) ?<)
1432 (setq pos (scan-lists pos 1 1))
1433 (setq pos (scan-lists pos 1 -1)))
1434 pos))
1435
1436 (defmacro c-sc-scan-lists-no-category-1+1 (from)
1437 ;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is
1438 ;; determined by and angle bracket; or (ii) is inside a macro whose start
1439 ;; isn't POINT-MACRO-START doesn't count as a finishing position.
1440 `(let ((here (point))
1441 (pos (scan-lists ,from -1 1)))
1442 (while (eq (char-after pos) ?<)
1443 (setq pos (scan-lists pos -1 1)))
1444 pos))
1445
1446 (defmacro c-sc-scan-lists-no-category-1-1 (from)
1447 ;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is
1448 ;; determined by and angle bracket; or (ii) is inside a macro whose start
1449 ;; isn't POINT-MACRO-START doesn't count as a finishing position.
1450 `(let ((here (point))
1451 (pos (scan-lists ,from -1 -1)))
1452 (while (eq (char-after pos) ?>)
1453 (setq pos (scan-lists pos -1 1))
1454 (setq pos (scan-lists pos -1 -1)))
1455 pos))
1456
1457 (defmacro c-sc-scan-lists (from count depth)
1458 (if c-use-category
1459 `(scan-lists ,from ,count ,depth)
1460 (cond
1461 ((and (eq count 1) (eq depth 1))
1462 `(c-sc-scan-lists-no-category+1+1 ,from))
1463 ((and (eq count 1) (eq depth -1))
1464 `(c-sc-scan-lists-no-category+1-1 ,from))
1465 ((and (eq count -1) (eq depth 1))
1466 `(c-sc-scan-lists-no-category-1+1 ,from))
1467 ((and (eq count -1) (eq depth -1))
1468 `(c-sc-scan-lists-no-category-1-1 ,from))
1469 (t (error "Invalid parameter(s) to c-sc-scan-lists")))))
1470
1471
1472 (defun c-sc-parse-partial-sexp-no-category (from to targetdepth stopbefore
1473 oldstate)
1474 ;; Do a parse-partial-sexp using the supplied arguments, disregarding
1475 ;; template/generic delimiters < > and disregarding macros other than the
1476 ;; one at POINT-MACRO-START.
1477 ;;
1478 ;; NOTE that STOPBEFORE must be nil. TARGETDEPTH should be one less than
1479 ;; the depth in OLDSTATE. This function is thus a SPECIAL PURPOSE variation
1480 ;; on parse-partial-sexp, designed for calling from
1481 ;; `c-remove-stale-state-cache'.
1482 ;;
1483 ;; Any finishing position which is determined by an angle bracket delimiter
1484 ;; doesn't count as a finishing position.
1485 ;;
1486 ;; Note there is no special handling of CPP constructs here, since these are
1487 ;; always syntactically balanced (thanks to `c-neutralize-CPP-line').
1488 (let ((state
1489 (parse-partial-sexp from to targetdepth stopbefore oldstate)))
1490 (while
1491 (and (< (point) to)
1492 ;; We must have hit targetdepth.
1493 (or (eq (char-before) ?<)
1494 (eq (char-before) ?>)))
1495 (setcar state
1496 (if (memq (char-before) '(?> ?\) ?\} ?\]))
1497 (1+ (car state))
1498 (1- (car state))))
1499 (setq state
1500 (parse-partial-sexp (point) to targetdepth stopbefore oldstate)))
1501 state))
1502
1503 (defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore
1504 oldstate)
1505 (if c-use-category
1506 `(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate)
1507 `(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore
1508 ,oldstate)))
1509
1510 \f
1511 (defvar c-emacs-features)
1512
1513 (defmacro c-looking-at-non-alphnumspace ()
1514 "Are we looking at a character which isn't alphanumeric or space?"
1515 (if (memq 'gen-comment-delim c-emacs-features)
1516 `(looking-at
1517 "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)")
1518 `(or (looking-at
1519 "\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)"
1520 (let ((prop (c-get-char-property (point) 'syntax-table)))
1521 (eq prop '(14))))))) ; '(14) is generic comment delimiter.
1522
1523 \f
1524 (defsubst c-intersect-lists (list alist)
1525 ;; return the element of ALIST that matches the first element found
1526 ;; in LIST. Uses assq.
1527 (let (match)
1528 (while (and list
1529 (not (setq match (assq (car list) alist))))
1530 (setq list (cdr list)))
1531 match))
1532
1533 (defsubst c-lookup-lists (list alist1 alist2)
1534 ;; first, find the first entry from LIST that is present in ALIST1,
1535 ;; then find the entry in ALIST2 for that entry.
1536 (assq (car (c-intersect-lists list alist1)) alist2))
1537
1538 (defsubst c-langelem-sym (langelem)
1539 "Return the syntactic symbol in LANGELEM.
1540
1541 LANGELEM is either a cons cell on the \"old\" form given as the first
1542 argument to lineup functions or a syntactic element on the \"new\"
1543 form as used in `c-syntactic-element'."
1544 (car langelem))
1545
1546 (defsubst c-langelem-pos (langelem)
1547 "Return the anchor position in LANGELEM, or nil if there is none.
1548
1549 LANGELEM is either a cons cell on the \"old\" form given as the first
1550 argument to lineup functions or a syntactic element on the \"new\"
1551 form as used in `c-syntactic-element'."
1552 (if (consp (cdr langelem))
1553 (car-safe (cdr langelem))
1554 (cdr langelem)))
1555
1556 (defun c-langelem-col (langelem &optional preserve-point)
1557 "Return the column of the anchor position in LANGELEM.
1558 Also move the point to that position unless PRESERVE-POINT is non-nil.
1559
1560 LANGELEM is either a cons cell on the \"old\" form given as the first
1561 argument to lineup functions or a syntactic element on the \"new\"
1562 form as used in `c-syntactic-element'."
1563 (let ((pos (c-langelem-pos langelem))
1564 (here (point)))
1565 (if pos
1566 (progn
1567 (goto-char pos)
1568 (prog1 (current-column)
1569 (if preserve-point
1570 (goto-char here))))
1571 0)))
1572
1573 (defsubst c-langelem-2nd-pos (langelem)
1574 "Return the secondary position in LANGELEM, or nil if there is none.
1575
1576 LANGELEM is typically a syntactic element on the \"new\" form as used
1577 in `c-syntactic-element'. It may also be a cons cell as passed in the
1578 first argument to lineup functions, but then the returned value always
1579 will be nil."
1580 (car-safe (cdr-safe (cdr-safe langelem))))
1581
1582 (defsubst c-keep-region-active ()
1583 ;; Do whatever is necessary to keep the region active in XEmacs.
1584 ;; This is not needed for Emacs.
1585 (and (boundp 'zmacs-region-stays)
1586 (setq zmacs-region-stays t)))
1587
1588 (put 'c-mode 'c-mode-prefix "c-")
1589 (put 'c++-mode 'c-mode-prefix "c++-")
1590 (put 'objc-mode 'c-mode-prefix "objc-")
1591 (put 'java-mode 'c-mode-prefix "java-")
1592 (put 'idl-mode 'c-mode-prefix "idl-")
1593 (put 'pike-mode 'c-mode-prefix "pike-")
1594 (put 'awk-mode 'c-mode-prefix "awk-")
1595
1596 (defsubst c-mode-symbol (suffix)
1597 "Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
1598 the corresponding symbol."
1599 (or c-buffer-is-cc-mode
1600 (error "Not inside a CC Mode based mode"))
1601 (let ((mode-prefix (get c-buffer-is-cc-mode 'c-mode-prefix)))
1602 (or mode-prefix
1603 (error "%S has no mode prefix known to `c-mode-symbol'"
1604 c-buffer-is-cc-mode))
1605 (intern (concat mode-prefix suffix))))
1606
1607 (defsubst c-mode-var (suffix)
1608 "Prefix the current mode prefix (e.g. \"c-\") to SUFFIX and return
1609 the value of the variable with that name."
1610 (symbol-value (c-mode-symbol suffix)))
1611
1612 (defsubst c-got-face-at (pos faces)
1613 "Return non-nil if position POS in the current buffer has any of the
1614 faces in the list FACES."
1615 (let ((pos-faces (get-text-property pos 'face)))
1616 (if (consp pos-faces)
1617 (progn
1618 (while (and pos-faces
1619 (not (memq (car pos-faces) faces)))
1620 (setq pos-faces (cdr pos-faces)))
1621 pos-faces)
1622 (memq pos-faces faces))))
1623
1624 (defsubst c-face-name-p (facename)
1625 ;; Return t if FACENAME is the name of a face. This method is
1626 ;; necessary since facep in XEmacs only returns t for the actual
1627 ;; face objects (while it's only their names that are used just
1628 ;; about anywhere else) without providing a predicate that tests
1629 ;; face names.
1630 (memq facename (face-list)))
1631
1632 (defun c-concat-separated (list separator)
1633 "Like `concat' on LIST, but separate each element with SEPARATOR.
1634 Notably, null elements in LIST are ignored."
1635 (mapconcat 'identity (delete nil (append list nil)) separator))
1636
1637 (defun c-make-keywords-re (adorn list &optional mode)
1638 "Make a regexp that matches all the strings the list.
1639 Duplicates and nil elements in the list are removed. The
1640 resulting regexp may contain zero or more submatch expressions.
1641
1642 If ADORN is t there will be at least one submatch and the first
1643 surrounds the matched alternative, and the regexp will also not match
1644 a prefix of any identifier. Adorned regexps cannot be appended. The
1645 language variable `c-nonsymbol-key' is used to make the adornment.
1646
1647 A value `appendable' for ADORN is like above, but all alternatives in
1648 the list that end with a word constituent char will have \\> appended
1649 instead, so that the regexp remains appendable. Note that this
1650 variant doesn't always guarantee that an identifier prefix isn't
1651 matched since the symbol constituent `_' is normally considered a
1652 nonword token by \\>.
1653
1654 The optional MODE specifies the language to get `c-nonsymbol-key' from
1655 when it's needed. The default is the current language taken from
1656 `c-buffer-is-cc-mode'."
1657
1658 (setq list (delete nil (delete-dups list)))
1659 (if list
1660 (let (re)
1661
1662 (if (eq adorn 'appendable)
1663 ;; This is kludgy but it works: Search for a string that
1664 ;; doesn't occur in any word in LIST. Append it to all
1665 ;; the alternatives where we want to add \>. Run through
1666 ;; `regexp-opt' and then replace it with \>.
1667 (let ((unique "") pos)
1668 (while (let (found)
1669 (setq unique (concat unique "@")
1670 pos list)
1671 (while (and pos
1672 (if (string-match unique (car pos))
1673 (progn (setq found t)
1674 nil)
1675 t))
1676 (setq pos (cdr pos)))
1677 found))
1678 (setq pos list)
1679 (while pos
1680 (if (string-match "\\w\\'" (car pos))
1681 (setcar pos (concat (car pos) unique)))
1682 (setq pos (cdr pos)))
1683 (setq re (regexp-opt list))
1684 (setq pos 0)
1685 (while (string-match unique re pos)
1686 (setq pos (+ (match-beginning 0) 2)
1687 re (replace-match "\\>" t t re))))
1688
1689 (setq re (regexp-opt list)))
1690
1691 ;; Emacs 20 and XEmacs (all versions so far) has a buggy
1692 ;; regexp-opt that doesn't always cope with strings containing
1693 ;; newlines. This kludge doesn't handle shy parens correctly
1694 ;; so we can't advice regexp-opt directly with it.
1695 (let (fail-list)
1696 (while list
1697 (and (string-match "\n" (car list)) ; To speed it up a little.
1698 (not (string-match (concat "\\`\\(" re "\\)\\'")
1699 (car list)))
1700 (setq fail-list (cons (car list) fail-list)))
1701 (setq list (cdr list)))
1702 (when fail-list
1703 (setq re (concat re
1704 "\\|"
1705 (mapconcat
1706 (if (eq adorn 'appendable)
1707 (lambda (str)
1708 (if (string-match "\\w\\'" str)
1709 (concat (regexp-quote str)
1710 "\\>")
1711 (regexp-quote str)))
1712 'regexp-quote)
1713 (sort fail-list
1714 (lambda (a b)
1715 (> (length a) (length b))))
1716 "\\|")))))
1717
1718 ;; Add our own grouping parenthesis around re instead of
1719 ;; passing adorn to `regexp-opt', since in XEmacs it makes the
1720 ;; top level grouping "shy".
1721 (cond ((eq adorn 'appendable)
1722 (concat "\\(" re "\\)"))
1723 (adorn
1724 (concat "\\(" re "\\)"
1725 "\\("
1726 (c-get-lang-constant 'c-nonsymbol-key nil mode)
1727 "\\|$\\)"))
1728 (t
1729 re)))
1730
1731 ;; Produce a regexp that matches nothing.
1732 (if adorn
1733 "\\(\\<\\>\\)"
1734 "\\<\\>")))
1735
1736 (put 'c-make-keywords-re 'lisp-indent-function 1)
1737
1738 (defun c-make-bare-char-alt (chars &optional inverted)
1739 "Make a character alternative string from the list of characters CHARS.
1740 The returned string is of the type that can be used with
1741 `skip-chars-forward' and `skip-chars-backward'. If INVERTED is
1742 non-nil, a caret is prepended to invert the set."
1743 ;; This function ought to be in the elisp core somewhere.
1744 (let ((str (if inverted "^" "")) char char2)
1745 (setq chars (sort (append chars nil) `<))
1746 (while chars
1747 (setq char (pop chars))
1748 (if (memq char '(?\\ ?^ ?-))
1749 ;; Quoting necessary (this method only works in the skip
1750 ;; functions).
1751 (setq str (format "%s\\%c" str char))
1752 (setq str (format "%s%c" str char)))
1753 ;; Check for range.
1754 (setq char2 char)
1755 (while (and chars (>= (1+ char2) (car chars)))
1756 (setq char2 (pop chars)))
1757 (unless (= char char2)
1758 (if (< (1+ char) char2)
1759 (setq str (format "%s-%c" str char2))
1760 (push char2 chars))))
1761 str))
1762
1763 ;; Leftovers from (X)Emacs 19 compatibility.
1764 (defalias 'c-regexp-opt 'regexp-opt)
1765 (defalias 'c-regexp-opt-depth 'regexp-opt-depth)
1766
1767 \f
1768 ;; Figure out what features this Emacs has
1769
1770 (cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
1771
1772 (defvar lookup-syntax-properties) ;XEmacs.
1773
1774 (defconst c-emacs-features
1775 (let (list)
1776
1777 (if (boundp 'infodock-version)
1778 ;; I've no idea what this actually is, but it's legacy. /mast
1779 (setq list (cons 'infodock list)))
1780
1781 ;; XEmacs uses 8-bit modify-syntax-entry flags.
1782 ;; Emacs uses a 1-bit flag. We will have to set up our
1783 ;; syntax tables differently to handle this.
1784 (let ((table (copy-syntax-table))
1785 entry)
1786 (modify-syntax-entry ?a ". 12345678" table)
1787 (cond
1788 ;; Emacs
1789 ((arrayp table)
1790 (setq entry (aref table ?a))
1791 ;; In Emacs, table entries are cons cells
1792 (if (consp entry) (setq entry (car entry))))
1793 ;; XEmacs
1794 ((fboundp 'get-char-table)
1795 (setq entry (get-char-table ?a table)))
1796 ;; incompatible
1797 (t (error "CC Mode is incompatible with this version of Emacs")))
1798 (setq list (cons (if (= (logand (lsh entry -16) 255) 255)
1799 '8-bit
1800 '1-bit)
1801 list)))
1802
1803 ;; Check whether beginning/end-of-defun call
1804 ;; beginning/end-of-defun-function nicely, passing through the
1805 ;; argument and respecting the return code.
1806 (let* (mark-ring
1807 (bod-param 'foo) (eod-param 'foo)
1808 (beginning-of-defun-function
1809 (lambda (&optional arg)
1810 (or (eq bod-param 'foo) (setq bod-param 'bar))
1811 (and (eq bod-param 'foo)
1812 (setq bod-param arg)
1813 (eq arg 3))))
1814 (end-of-defun-function
1815 (lambda (&optional arg)
1816 (and (eq eod-param 'foo)
1817 (setq eod-param arg)
1818 (eq arg 3)))))
1819 (if (save-excursion (and (beginning-of-defun 3) (eq bod-param 3)
1820 (not (beginning-of-defun))
1821 (end-of-defun 3) (eq eod-param 3)
1822 (not (end-of-defun))))
1823 (setq list (cons 'argumentative-bod-function list))))
1824
1825 ;; Record whether the `category' text property works.
1826 (if c-use-category (setq list (cons 'category-properties list)))
1827
1828 (let ((buf (generate-new-buffer " test"))
1829 parse-sexp-lookup-properties
1830 parse-sexp-ignore-comments
1831 lookup-syntax-properties) ; XEmacs
1832 (with-current-buffer buf
1833 (set-syntax-table (make-syntax-table))
1834
1835 ;; For some reason we have to set some of these after the
1836 ;; buffer has been made current. (Specifically,
1837 ;; `parse-sexp-ignore-comments' in Emacs 21.)
1838 (setq parse-sexp-lookup-properties t
1839 parse-sexp-ignore-comments t
1840 lookup-syntax-properties t)
1841
1842 ;; Find out if the `syntax-table' text property works.
1843 (modify-syntax-entry ?< ".")
1844 (modify-syntax-entry ?> ".")
1845 (insert "<()>")
1846 (c-mark-<-as-paren (point-min))
1847 (c-mark->-as-paren (+ 3 (point-min)))
1848 (goto-char (point-min))
1849 (c-forward-sexp)
1850 (if (= (point) (+ 4 (point-min)))
1851 (setq list (cons 'syntax-properties list))
1852 (error (concat
1853 "CC Mode is incompatible with this version of Emacs - "
1854 "support for the `syntax-table' text property "
1855 "is required.")))
1856
1857 ;; Find out if "\\s!" (generic comment delimiters) work.
1858 (c-safe
1859 (modify-syntax-entry ?x "!")
1860 (if (string-match "\\s!" "x")
1861 (setq list (cons 'gen-comment-delim list))))
1862
1863 ;; Find out if "\\s|" (generic string delimiters) work.
1864 (c-safe
1865 (modify-syntax-entry ?x "|")
1866 (if (string-match "\\s|" "x")
1867 (setq list (cons 'gen-string-delim list))))
1868
1869 ;; See if POSIX char classes work.
1870 (when (and (string-match "[[:alpha:]]" "a")
1871 ;; All versions of Emacs 21 so far haven't fixed
1872 ;; char classes in `skip-chars-forward' and
1873 ;; `skip-chars-backward'.
1874 (progn
1875 (delete-region (point-min) (point-max))
1876 (insert "foo123")
1877 (skip-chars-backward "[:alnum:]")
1878 (bobp))
1879 (= (skip-chars-forward "[:alpha:]") 3))
1880 (setq list (cons 'posix-char-classes list)))
1881
1882 ;; See if `open-paren-in-column-0-is-defun-start' exists and
1883 ;; isn't buggy (Emacs >= 21.4).
1884 (when (boundp 'open-paren-in-column-0-is-defun-start)
1885 (let ((open-paren-in-column-0-is-defun-start nil)
1886 (parse-sexp-ignore-comments t))
1887 (delete-region (point-min) (point-max))
1888 (set-syntax-table (make-syntax-table))
1889 (modify-syntax-entry ?\' "\"")
1890 (cond
1891 ;; XEmacs. Afaik this is currently an Emacs-only
1892 ;; feature, but it's good to be prepared.
1893 ((memq '8-bit list)
1894 (modify-syntax-entry ?/ ". 1456")
1895 (modify-syntax-entry ?* ". 23"))
1896 ;; Emacs
1897 ((memq '1-bit list)
1898 (modify-syntax-entry ?/ ". 124b")
1899 (modify-syntax-entry ?* ". 23")))
1900 (modify-syntax-entry ?\n "> b")
1901 (insert "/* '\n () */")
1902 (backward-sexp)
1903 (if (bobp)
1904 (setq list (cons 'col-0-paren list)))))
1905
1906 (set-buffer-modified-p nil))
1907 (kill-buffer buf))
1908
1909 ;; See if `parse-partial-sexp' returns the eighth element.
1910 (if (c-safe (>= (length (save-excursion
1911 (parse-partial-sexp (point) (point))))
1912 10))
1913 (setq list (cons 'pps-extended-state list))
1914 (error (concat
1915 "CC Mode is incompatible with this version of Emacs - "
1916 "`parse-partial-sexp' has to return at least 10 elements.")))
1917
1918 ;;(message "c-emacs-features: %S" list)
1919 list)
1920 "A list of certain features in the (X)Emacs you are using.
1921 There are many flavors of Emacs out there, each with different
1922 features supporting those needed by CC Mode. The following values
1923 might be present:
1924
1925 `8-bit' 8 bit syntax entry flags (XEmacs style).
1926 `1-bit' 1 bit syntax entry flags (Emacs style).
1927 `argumentative-bod-function' beginning-of-defun and end-of-defun pass
1928 ARG through to beginning/end-of-defun-function.
1929 `syntax-properties' It works to override the syntax for specific characters
1930 in the buffer with the `syntax-table' property. It's
1931 always set - CC Mode no longer works in emacsen without
1932 this feature.
1933 `category-properties' Syntax routines can add a level of indirection to text
1934 properties using the `category' property.
1935 `gen-comment-delim' Generic comment delimiters work
1936 (i.e. the syntax class `!').
1937 `gen-string-delim' Generic string delimiters work
1938 (i.e. the syntax class `|').
1939 `pps-extended-state' `parse-partial-sexp' returns a list with at least 10
1940 elements, i.e. it contains the position of the start of
1941 the last comment or string. It's always set - CC Mode
1942 no longer works in emacsen without this feature.
1943 `posix-char-classes' The regexp engine understands POSIX character classes.
1944 `col-0-paren' It's possible to turn off the ad-hoc rule that a paren
1945 in column zero is the start of a defun.
1946 `infodock' This is Infodock (based on XEmacs).
1947
1948 `8-bit' and `1-bit' are mutually exclusive.")
1949
1950 \f
1951 ;;; Some helper constants.
1952
1953 ;; If the regexp engine supports POSIX char classes then we can use
1954 ;; them to handle extended charsets correctly.
1955 (if (memq 'posix-char-classes c-emacs-features)
1956 (progn
1957 (defconst c-alpha "[:alpha:]")
1958 (defconst c-alnum "[:alnum:]")
1959 (defconst c-digit "[:digit:]")
1960 (defconst c-upper "[:upper:]")
1961 (defconst c-lower "[:lower:]"))
1962 (defconst c-alpha "a-zA-Z")
1963 (defconst c-alnum "a-zA-Z0-9")
1964 (defconst c-digit "0-9")
1965 (defconst c-upper "A-Z")
1966 (defconst c-lower "a-z"))
1967
1968 \f
1969 ;;; System for handling language dependent constants.
1970
1971 ;; This is used to set various language dependent data in a flexible
1972 ;; way: Language constants can be built from the values of other
1973 ;; language constants, also those for other languages. They can also
1974 ;; process the values of other language constants uniformly across all
1975 ;; the languages. E.g. one language constant can list all the type
1976 ;; keywords in each language, and another can build a regexp for each
1977 ;; language from those lists without code duplication.
1978 ;;
1979 ;; Language constants are defined with `c-lang-defconst', and their
1980 ;; value forms (referred to as source definitions) are evaluated only
1981 ;; on demand when requested for a particular language with
1982 ;; `c-lang-const'. It's therefore possible to refer to the values of
1983 ;; constants defined later in the file, or in another file, just as
1984 ;; long as all the relevant `c-lang-defconst' have been loaded when
1985 ;; `c-lang-const' is actually evaluated from somewhere else.
1986 ;;
1987 ;; `c-lang-const' forms are also evaluated at compile time and
1988 ;; replaced with the values they produce. Thus there's no overhead
1989 ;; for this system when compiled code is used - only the values
1990 ;; actually used in the code are present, and the file(s) containing
1991 ;; the `c-lang-defconst' forms don't need to be loaded at all then.
1992 ;; There are however safeguards to make sure that they can be loaded
1993 ;; to get the source definitions for the values if there's a mismatch
1994 ;; in compiled versions, or if `c-lang-const' is used uncompiled.
1995 ;;
1996 ;; Note that the source definitions in a `c-lang-defconst' form are
1997 ;; compiled into the .elc file where it stands; there's no need to
1998 ;; load the source file to get it.
1999 ;;
2000 ;; See cc-langs.el for more details about how this system is deployed
2001 ;; in CC Mode, and how the associated language variable system
2002 ;; (`c-lang-defvar') works. That file also contains a lot of
2003 ;; examples.
2004
2005 (defun c-add-language (mode base-mode)
2006 "Declare a new language in the language dependent variable system.
2007 This is intended to be used by modes that inherit CC Mode to add new
2008 languages. It should be used at the top level before any calls to
2009 `c-lang-defconst'. MODE is the mode name symbol for the new language,
2010 and BASE-MODE is the mode name symbol for the language in CC Mode that
2011 is to be the template for the new mode.
2012
2013 The exact effect of BASE-MODE is to make all language constants that
2014 haven't got a setting in the new language fall back to their values in
2015 BASE-MODE. It does not have any effect outside the language constant
2016 system."
2017 (unless (string-match "\\`\\(.*-\\)mode\\'" (symbol-name mode))
2018 (error "The mode name symbol `%s' must end with \"-mode\"" mode))
2019 (put mode 'c-mode-prefix (match-string 1 (symbol-name mode)))
2020 (unless (get base-mode 'c-mode-prefix)
2021 (error "Unknown base mode `%s'" base-mode))
2022 (put mode 'c-fallback-mode base-mode))
2023
2024 (defvar c-lang-constants (make-vector 151 0))
2025 ;; Obarray used as a cache to keep track of the language constants.
2026 ;; The constants stored are those defined by `c-lang-defconst' and the values
2027 ;; computed by `c-lang-const'. It's mostly used at compile time but it's not
2028 ;; stored in compiled files.
2029
2030 ;; The obarray contains all the language constants as symbols. The
2031 ;; value cells hold the evaluated values as alists where each car is
2032 ;; the mode name symbol and the corresponding cdr is the evaluated
2033 ;; value in that mode. The property lists hold the source definitions
2034 ;; and other miscellaneous data. The obarray might also contain
2035 ;; various other symbols, but those don't have any variable bindings.
2036
2037 (defvar c-lang-const-expansion nil)
2038
2039 ;; Ugly hack to pull in the definition of `cc-bytecomp-compiling-or-loading'
2040 ;; from cc-bytecomp to make it available at loadtime. This is the same
2041 ;; mechanism used in cc-mode.el for `c-populate-syntax-table'.
2042 (defalias 'cc-bytecomp-compiling-or-loading
2043 (cc-eval-when-compile
2044 (let ((f (symbol-function 'cc-bytecomp-compiling-or-loading)))
2045 (if (byte-code-function-p f) f (byte-compile f)))))
2046
2047 (defsubst c-get-current-file ()
2048 ;; Return the base name of the current file.
2049 (let* ((c-or-l (cc-bytecomp-compiling-or-loading))
2050 (file
2051 (cond
2052 ((eq c-or-l 'loading) load-file-name)
2053 ((eq c-or-l 'compiling) byte-compile-dest-file)
2054 ((null c-or-l) (buffer-file-name)))))
2055 (and file
2056 (file-name-sans-extension
2057 (file-name-nondirectory file)))))
2058
2059 (defmacro c-lang-defconst-eval-immediately (form)
2060 "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
2061 immediately, i.e. at the same time as the `c-lang-defconst' form
2062 itself is evaluated."
2063 ;; Evaluate at macro expansion time, i.e. in the
2064 ;; `c--macroexpand-all' inside `c-lang-defconst'.
2065 (eval form))
2066
2067 (defmacro c-lang-defconst (name &rest args)
2068 "Set the language specific values of the language constant NAME.
2069 The second argument can optionally be a docstring. The rest of the
2070 arguments are one or more repetitions of LANG VAL where LANG specifies
2071 the language(s) that VAL applies to. LANG is the name of the
2072 language, i.e. the mode name without the \"-mode\" suffix, or a list
2073 of such language names, or t for all languages. VAL is a form to
2074 evaluate to get the value.
2075
2076 If LANG isn't t or one of the core languages in CC Mode, it must
2077 have been declared with `c-add-language'.
2078
2079 Neither NAME, LANG nor VAL are evaluated directly - they should not be
2080 quoted. `c-lang-defconst-eval-immediately' can however be used inside
2081 VAL to evaluate parts of it directly.
2082
2083 When VAL is evaluated for some language, that language is temporarily
2084 made current so that `c-lang-const' without an explicit language can
2085 be used inside VAL to refer to the value of a language constant in the
2086 same language. That is particularly useful if LANG is t.
2087
2088 VAL is not evaluated right away but rather when the value is requested
2089 with `c-lang-const'. Thus it's possible to use `c-lang-const' inside
2090 VAL to refer to language constants that haven't been defined yet.
2091 However, if the definition of a language constant is in another file
2092 then that file must be loaded \(at compile time) before it's safe to
2093 reference the constant.
2094
2095 The assignments in ARGS are processed in sequence like `setq', so
2096 \(c-lang-const NAME) may be used inside a VAL to refer to the last
2097 assigned value to this language constant, or a value that it has
2098 gotten in another earlier loaded file.
2099
2100 To work well with repeated loads and interactive reevaluation, only
2101 one `c-lang-defconst' for each NAME is permitted per file. If there
2102 already is one it will be completely replaced; the value in the
2103 earlier definition will not affect `c-lang-const' on the same
2104 constant. A file is identified by its base name."
2105
2106 (let* ((sym (intern (symbol-name name) c-lang-constants))
2107 ;; Make `c-lang-const' expand to a straightforward call to
2108 ;; `c-get-lang-constant' in `c--macroexpand-all' below.
2109 ;;
2110 ;; (The default behavior, i.e. to expand to a call inside
2111 ;; `eval-when-compile' should be equivalent, since that macro
2112 ;; should only expand to its content if it's used inside a
2113 ;; form that's already evaluated at compile time. It's
2114 ;; however necessary to use our cover macro
2115 ;; `cc-eval-when-compile' due to bugs in `eval-when-compile',
2116 ;; and it expands to a bulkier form that in this case only is
2117 ;; unnecessary garbage that we don't want to store in the
2118 ;; language constant source definitions.)
2119 (c-lang-const-expansion 'call)
2120 (c-langs-are-parametric t)
2121 (file (intern
2122 (or (c-get-current-file)
2123 (error "`c-lang-defconst' can only be used in a file"))))
2124 bindings
2125 pre-files)
2126
2127 (or (symbolp name)
2128 (error "Not a symbol: %S" name))
2129
2130 (when (stringp (car-safe args))
2131 ;; The docstring is hardly used anywhere since there's no normal
2132 ;; symbol to attach it to. It's primarily for getting the right
2133 ;; format in the source.
2134 (put sym 'variable-documentation (car args))
2135 (setq args (cdr args)))
2136
2137 (or args
2138 (error "No assignments in `c-lang-defconst' for %S" name))
2139
2140 ;; Rework ARGS to an association list to make it easier to handle.
2141 ;; It's reversed at the same time to make it easier to implement
2142 ;; the demand-driven (i.e. reversed) evaluation in `c-lang-const'.
2143 (while args
2144 (let ((assigned-mode
2145 (cond ((eq (car args) t) t)
2146 ((symbolp (car args))
2147 (list (intern (concat (symbol-name (car args))
2148 "-mode"))))
2149 ((listp (car args))
2150 (mapcar (lambda (lang)
2151 (or (symbolp lang)
2152 (error "Not a list of symbols: %S"
2153 (car args)))
2154 (intern (concat (symbol-name lang)
2155 "-mode")))
2156 (car args)))
2157 (t (error "Not a symbol or a list of symbols: %S"
2158 (car args)))))
2159 val)
2160
2161 (or (cdr args)
2162 (error "No value for %S" (car args)))
2163 (setq args (cdr args)
2164 val (car args))
2165
2166 ;; Emacs has a weird bug where it seems to fail to read
2167 ;; backquote lists from byte compiled files correctly (,@
2168 ;; forms, to be specific), so make sure the bindings in the
2169 ;; expansion below don't contain any backquote stuff.
2170 ;; (XEmacs handles it correctly and doesn't need this for that
2171 ;; reason, but we also use this expansion handle
2172 ;; `c-lang-defconst-eval-immediately' and to register
2173 ;; dependencies on the `c-lang-const's in VAL.)
2174 (setq val (c--macroexpand-all val))
2175
2176 (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings)
2177 args (cdr args))))
2178
2179 ;; Compile in the other files that have provided source
2180 ;; definitions for this symbol, to make sure the order in the
2181 ;; `source' property is correct even when files are loaded out of
2182 ;; order.
2183 (setq pre-files (mapcar 'car (get sym 'source)))
2184 (if (memq file pre-files)
2185 ;; This can happen when the source file (e.g. cc-langs.el) is first
2186 ;; loaded as source, setting a 'source property entry, and then itself
2187 ;; being compiled.
2188 (setq pre-files (cdr (memq file pre-files))))
2189 ;; Reverse to get the right load order.
2190 (setq pre-files (nreverse pre-files))
2191
2192 `(eval-and-compile
2193 (c-define-lang-constant ',name ,bindings
2194 ,@(and pre-files `(',pre-files))))))
2195
2196 (put 'c-lang-defconst 'lisp-indent-function 1)
2197 ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
2198 ; '
2199 (def-edebug-spec c-lang-defconst
2200 (&define name [&optional stringp] [&rest sexp def-form]))
2201
2202 (defun c-define-lang-constant (name bindings &optional pre-files)
2203 ;; Used by `c-lang-defconst'.
2204
2205 (let* ((sym (intern (symbol-name name) c-lang-constants))
2206 (source (get sym 'source))
2207 (file (intern
2208 (or (c-get-current-file)
2209 (error "`c-lang-defconst' must be used in a file"))))
2210 (elem (assq file source)))
2211
2212 ;;(when (cdr-safe elem)
2213 ;; (message "Language constant %s redefined in %S" name file))
2214
2215 ;; Note that the order in the source alist is relevant. Like how
2216 ;; `c-lang-defconst' reverses the bindings, this reverses the
2217 ;; order between files so that the last to evaluate comes first.
2218 (unless elem
2219 (while pre-files
2220 (unless (assq (car pre-files) source)
2221 (setq source (cons (list (car pre-files)) source)))
2222 (setq pre-files (cdr pre-files)))
2223 (put sym 'source (cons (setq elem (list file)) source)))
2224
2225 (setcdr elem bindings)
2226
2227 ;; Bind the symbol as a variable, or clear any earlier evaluated
2228 ;; value it has.
2229 (set sym nil)
2230
2231 ;; Clear the evaluated values that depend on this source.
2232 (let ((agenda (get sym 'dependents))
2233 (visited (make-vector 101 0))
2234 ptr)
2235 (while agenda
2236 (setq sym (car agenda)
2237 agenda (cdr agenda))
2238 (intern (symbol-name sym) visited)
2239 (set sym nil)
2240 (setq ptr (get sym 'dependents))
2241 (while ptr
2242 (setq sym (car ptr)
2243 ptr (cdr ptr))
2244 (unless (intern-soft (symbol-name sym) visited)
2245 (setq agenda (cons sym agenda))))))
2246
2247 name))
2248
2249 (defmacro c-lang-const (name &optional lang)
2250 "Get the mode specific value of the language constant NAME in language LANG.
2251 LANG is the name of the language, i.e. the mode name without the
2252 \"-mode\" suffix. If used inside `c-lang-defconst' or
2253 `c-lang-defvar', LANG may be left out to refer to the current
2254 language. NAME and LANG are not evaluated so they should not be
2255 quoted."
2256
2257 (or (symbolp name)
2258 (error "Not a symbol: %S" name))
2259 (or (symbolp lang)
2260 (error "Not a symbol: %S" lang))
2261
2262 (let ((sym (intern (symbol-name name) c-lang-constants))
2263 (mode (when lang (intern (concat (symbol-name lang) "-mode")))))
2264
2265 (or (get mode 'c-mode-prefix) (null mode)
2266 (error "Unknown language %S: no `c-mode-prefix' property"
2267 lang))
2268
2269 (if (eq c-lang-const-expansion 'immediate)
2270 ;; No need to find out the source file(s) when we evaluate
2271 ;; immediately since all the info is already there in the
2272 ;; `source' property.
2273 `',(c-get-lang-constant name nil mode)
2274
2275 (let ((source-files
2276 (let ((file (c-get-current-file)))
2277 (if file (setq file (intern file)))
2278 ;; Get the source file(s) that must be loaded to get the value
2279 ;; of the constant. If the symbol isn't defined yet we assume
2280 ;; that its definition will come later in this file, and thus
2281 ;; are no file dependencies needed.
2282 (nreverse
2283 ;; Reverse to get the right load order.
2284 (c--mapcan (lambda (elem)
2285 (if (eq file (car elem))
2286 nil ; Exclude our own file.
2287 (list (car elem))))
2288 (get sym 'source)))))
2289
2290 ;; Make some effort to do a compact call to
2291 ;; `c-get-lang-constant' since it will be compiled in.
2292 (args (and mode `(',mode))))
2293
2294 (if (or source-files args)
2295 (push (and source-files `',source-files) args))
2296
2297 (if (or (eq c-lang-const-expansion 'call)
2298 (and (not c-lang-const-expansion)
2299 (not mode))
2300 (not (cc-bytecomp-is-compiling)))
2301 ;; Either a straight call is requested in the context, or
2302 ;; we're in an "uncontrolled" context and got no language,
2303 ;; or we're not being byte compiled so the compile time
2304 ;; stuff below is unnecessary.
2305 `(c-get-lang-constant ',name ,@args)
2306
2307 ;; Being compiled. If the loading and compiling version is
2308 ;; the same we use a value that is evaluated at compile time,
2309 ;; otherwise it's evaluated at runtime.
2310 `(if (eq c-version-sym ',c-version-sym)
2311 (cc-eval-when-compile
2312 (c-get-lang-constant ',name ,@args))
2313 (c-get-lang-constant ',name ,@args)))))))
2314
2315 (defvar c-lang-constants-under-evaluation nil
2316 "Alist of constants in the process of being evaluated.
2317 The `cdr' of each entry indicates how far we've looked in the list
2318 of definitions, so that the def for var FOO in c-mode can be defined in
2319 terms of the def for that same var FOO (which will then rely on the
2320 fallback definition for all modes, to break the cycle).")
2321
2322 (defconst c-lang--novalue "novalue")
2323
2324 (defun c-get-lang-constant (name &optional source-files mode)
2325 ;; Used by `c-lang-const'.
2326
2327 (or mode
2328 (setq mode c-buffer-is-cc-mode)
2329 (error "No current language"))
2330
2331 (let* ((sym (intern (symbol-name name) c-lang-constants))
2332 (source (get sym 'source))
2333 elem
2334 (eval-in-sym (and c-lang-constants-under-evaluation
2335 (caar c-lang-constants-under-evaluation))))
2336
2337 ;; Record the dependencies between this symbol and the one we're
2338 ;; being evaluated in.
2339 (when eval-in-sym
2340 (or (memq eval-in-sym (get sym 'dependents))
2341 (put sym 'dependents (cons eval-in-sym (get sym 'dependents)))))
2342
2343 ;; Make sure the source files have entries on the `source'
2344 ;; property so that loading will take place when necessary.
2345 (while source-files
2346 (unless (assq (car source-files) source)
2347 (put sym 'source
2348 (setq source (cons (list (car source-files)) source)))
2349 ;; Might pull in more definitions which affect the value. The
2350 ;; clearing of dependent values etc is done when the
2351 ;; definition is encountered during the load; this is just to
2352 ;; jump past the check for a cached value below.
2353 (set sym nil))
2354 (setq source-files (cdr source-files)))
2355
2356 (if (and (boundp sym)
2357 (setq elem (assq mode (symbol-value sym))))
2358 (cdr elem)
2359
2360 ;; Check if an evaluation of this symbol is already underway.
2361 ;; In that case we just continue with the "assignment" before
2362 ;; the one currently being evaluated, thereby creating the
2363 ;; illusion if a `setq'-like sequence of assignments.
2364 (let* ((c-buffer-is-cc-mode mode)
2365 (source-pos
2366 (or (assq sym c-lang-constants-under-evaluation)
2367 (cons sym (vector source nil))))
2368 ;; Append `c-lang-constants-under-evaluation' even if an
2369 ;; earlier entry is found. It's only necessary to get
2370 ;; the recording of dependencies above correct.
2371 (c-lang-constants-under-evaluation
2372 (cons source-pos c-lang-constants-under-evaluation))
2373 (fallback (get mode 'c-fallback-mode))
2374 value
2375 ;; Make sure the recursion limits aren't very low
2376 ;; since the `c-lang-const' dependencies can go deep.
2377 (max-specpdl-size (max max-specpdl-size 3000))
2378 (max-lisp-eval-depth (max max-lisp-eval-depth 1000)))
2379
2380 (if (if fallback
2381 (let ((backup-source-pos (copy-sequence (cdr source-pos))))
2382 (and
2383 ;; First try the original mode but don't accept an
2384 ;; entry matching all languages since the fallback
2385 ;; mode might have an explicit entry before that.
2386 (eq (setq value (c-find-assignment-for-mode
2387 (cdr source-pos) mode nil name))
2388 c-lang--novalue)
2389 ;; Try again with the fallback mode from the
2390 ;; original position. Note that
2391 ;; `c-buffer-is-cc-mode' still is the real mode if
2392 ;; language parameterization takes place.
2393 (eq (setq value (c-find-assignment-for-mode
2394 (setcdr source-pos backup-source-pos)
2395 fallback t name))
2396 c-lang--novalue)))
2397 ;; A simple lookup with no fallback mode.
2398 (eq (setq value (c-find-assignment-for-mode
2399 (cdr source-pos) mode t name))
2400 c-lang--novalue))
2401 (error
2402 "`%s' got no (prior) value in %S (might be a cyclic reference)"
2403 name mode))
2404
2405 (condition-case err
2406 (setq value (funcall value))
2407 (error
2408 ;; Print a message to aid in locating the error. We don't
2409 ;; print the error itself since that will be done later by
2410 ;; some caller higher up.
2411 (message "Eval error in the `c-lang-defconst' for `%S' in %s:"
2412 sym mode)
2413 (makunbound sym)
2414 (signal (car err) (cdr err))))
2415
2416 (set sym (cons (cons mode value) (symbol-value sym)))
2417 value))))
2418
2419 (defun c-find-assignment-for-mode (source-pos mode match-any-lang _name)
2420 ;; Find the first assignment entry that applies to MODE at or after
2421 ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with t as
2422 ;; the language list are considered to match, otherwise they don't.
2423 ;; On return SOURCE-POS is updated to point to the next assignment
2424 ;; after the returned one. If no assignment is found,
2425 ;; `c-lang--novalue' is returned as a magic value.
2426 ;;
2427 ;; SOURCE-POS is a vector that points out a specific assignment in
2428 ;; the double alist that's used in the `source' property. The first
2429 ;; element is the position in the top alist which is indexed with
2430 ;; the source files, and the second element is the position in the
2431 ;; nested bindings alist.
2432 ;;
2433 ;; NAME is only used for error messages.
2434
2435 (catch 'found
2436 (let ((file-entry (elt source-pos 0))
2437 (assignment-entry (elt source-pos 1))
2438 assignment)
2439
2440 (while (if assignment-entry
2441 t
2442 ;; Handled the last assignment from one file, begin on the
2443 ;; next. Due to the check in `c-lang-defconst', we know
2444 ;; there's at least one.
2445 (when file-entry
2446
2447 (unless (aset source-pos 1
2448 (setq assignment-entry (cdar file-entry)))
2449 ;; The file containing the source definitions has not
2450 ;; been loaded.
2451 (let ((file (symbol-name (caar file-entry)))
2452 (c-lang-constants-under-evaluation nil))
2453 ;;(message (concat "Loading %s to get the source "
2454 ;; "value for language constant %s")
2455 ;; file name)
2456 (load file nil t))
2457
2458 (unless (setq assignment-entry (cdar file-entry))
2459 ;; The load didn't fill in the source for the
2460 ;; constant as expected. The situation is
2461 ;; probably that a derived mode was written for
2462 ;; and compiled with another version of CC Mode,
2463 ;; and the requested constant isn't in the
2464 ;; currently loaded one. Put in a dummy
2465 ;; assignment that matches no language.
2466 (setcdr (car file-entry)
2467 (setq assignment-entry (list (list nil))))))
2468
2469 (aset source-pos 0 (setq file-entry (cdr file-entry)))
2470 t))
2471
2472 (setq assignment (car assignment-entry))
2473 (aset source-pos 1
2474 (setq assignment-entry (cdr assignment-entry)))
2475
2476 (when (if (listp (car assignment))
2477 (memq mode (car assignment))
2478 match-any-lang)
2479 (throw 'found (cdr assignment))))
2480
2481 c-lang--novalue)))
2482
2483 (defun c-lang-major-mode-is (mode)
2484 ;; `c-major-mode-is' expands to a call to this function inside
2485 ;; `c-lang-defconst'. Here we also match the mode(s) against any
2486 ;; fallback modes for the one in `c-buffer-is-cc-mode', so that
2487 ;; e.g. (c-major-mode-is 'c++-mode) is true in a derived language
2488 ;; that has c++-mode as base mode.
2489 (unless (listp mode)
2490 (setq mode (list mode)))
2491 (let (match (buf-mode c-buffer-is-cc-mode))
2492 (while (if (memq buf-mode mode)
2493 (progn
2494 (setq match t)
2495 nil)
2496 (setq buf-mode (get buf-mode 'c-fallback-mode))))
2497 match))
2498
2499 \f
2500 (cc-provide 'cc-defs)
2501
2502 ;; Local Variables:
2503 ;; indent-tabs-mode: t
2504 ;; tab-width: 8
2505 ;; End:
2506 ;;; cc-defs.el ends here