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