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