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