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