]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/cc-defs.el
Merge from emacs-24; up to 2014-07-20T16:14:58Z!dmantipov@yandex.ru
[gnu-emacs] / lisp / progmodes / cc-defs.el
index 48236c2dca2e8a90069324f501d6859b8b7dcfcc..dc31fde131dce09288cddaabac41d200aece6c2d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cc-defs.el --- compile time definitions for CC Mode
 
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc.
 
 ;; Authors:    2003- Alan Mackenzie
 ;;             1998- Martin Stjernholm
 
 ;; Silence the compiler.
 (cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el
-(cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs
 (cc-bytecomp-defun region-active-p)    ; XEmacs
-(cc-bytecomp-defvar zmacs-region-stays)        ; XEmacs
-(cc-bytecomp-defvar zmacs-regions)     ; XEmacs
 (cc-bytecomp-defvar mark-active)       ; Emacs
 (cc-bytecomp-defvar deactivate-mark)   ; Emacs
 (cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs
 (cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs
 (cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21
-(cc-bytecomp-defvar lookup-syntax-properties) ; XEmacs
 (cc-bytecomp-defun string-to-syntax)   ; Emacs 21
 
 \f
               font-lock-keywords)))
       (cc-load "cc-fix")))
 
+;; XEmacs 21.4 doesn't have `delete-dups'.
+(eval-and-compile
+  (if (and (not (fboundp 'delete-dups))
+          (not (featurep 'cc-fix)))
+      (cc-load "cc-fix")))
 \f
 ;;; Variables also used at compile time.
 
-(defconst c-version "5.32.4"
+(defconst c-version "5.32.5"
   "CC Mode version number.")
 
 (defconst c-version-sym (intern c-version))
@@ -334,6 +335,8 @@ to it is returned.  This function does not modify the point or the mark."
 (defmacro c-region-is-active-p ()
   ;; Return t when the region is active.  The determination of region
   ;; activeness is different in both Emacs and XEmacs.
+  ;; FIXME? Emacs has region-active-p since 23.1, so maybe this test
+  ;; should be updated.
   (if (cc-bytecomp-boundp 'mark-active)
       ;; Emacs.
       'mark-active
@@ -343,7 +346,7 @@ to it is returned.  This function does not modify the point or the mark."
 (defmacro c-set-region-active (activate)
   ;; Activate the region if ACTIVE is non-nil, deactivate it
   ;; otherwise.  Covers the differences between Emacs and XEmacs.
-  (if (cc-bytecomp-fboundp 'zmacs-activate-region)
+  (if (fboundp 'zmacs-activate-region)
       ;; XEmacs.
       `(if ,activate
           (zmacs-activate-region)
@@ -707,9 +710,9 @@ be after it."
   ;; `c-parse-state'.
 
   `(progn
-     (if (and ,(cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
+     (if (and ,(fboundp 'buffer-syntactic-context-depth)
              c-enable-xemacs-performance-kludge-p)
-        ,(when (cc-bytecomp-fboundp 'buffer-syntactic-context-depth)
+        ,(when (fboundp 'buffer-syntactic-context-depth)
            ;; XEmacs only.  This can improve the performance of
            ;; c-parse-state to between 3 and 60 times faster when
            ;; braces are hung.  It can also degrade performance by
@@ -825,6 +828,8 @@ be after it."
 (defmacro c-with-syntax-table (table &rest code)
   ;; Temporarily switches to the specified syntax table in a failsafe
   ;; way to execute code.
+  ;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call
+  ;; any forms inside this that call `c-parse-state'.  !!!!
   `(let ((c-with-syntax-table-orig-table (syntax-table)))
      (unwind-protect
         (progn
@@ -913,6 +918,12 @@ MODE is either a mode symbol or a list of mode symbols."
                               (cc-bytecomp-fboundp 'delete-extent)
                               (cc-bytecomp-fboundp 'map-extents))))
 
+(defconst c-<-as-paren-syntax '(4 . ?>))
+(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax)
+
+(defconst c->-as-paren-syntax '(5 . ?<))
+(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax)
+
 ;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to
 ;; make it a function.
 (defalias 'c-put-char-property-fun
@@ -1139,7 +1150,7 @@ been put there by c-put-char-property.  POINT remains unchanged."
 ;; Make edebug understand the macros.
 ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
 ;  '(progn
-(def-edebug-spec cc-eval-when-compile t)
+(def-edebug-spec cc-eval-when-compile (&rest def-form))
 (def-edebug-spec c-point t)
 (def-edebug-spec c-set-region-active t)
 (def-edebug-spec c-safe t)
@@ -1188,9 +1199,6 @@ been put there by c-put-char-property.  POINT remains unchanged."
     (if (< (point) start)
        (goto-char (point-max)))))
 
-(defconst c-<-as-paren-syntax '(4 . ?>))
-(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax)
-
 (defsubst c-mark-<-as-paren (pos)
   ;; Mark the "<" character at POS as a template opener using the
   ;; `syntax-table' property via the `category' property.
@@ -1201,9 +1209,6 @@ been put there by c-put-char-property.  POINT remains unchanged."
   ;; cheaply.  We use this, for instance, in `c-parse-state'.
   (c-put-char-property pos 'category 'c-<-as-paren-syntax))
 
-(defconst c->-as-paren-syntax '(5 . ?<))
-(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax)
-
 (defsubst c-mark->-as-paren (pos)
   ;; Mark the ">" character at POS as an sexp list closer using the
   ;; syntax-table property.
@@ -1295,10 +1300,14 @@ been put there by c-put-char-property.  POINT remains unchanged."
   ;; suppressed.
   `(unwind-protect
        (c-save-buffer-state ()
-        (c-clear-cpp-delimiters ,beg ,end)
+        (save-restriction
+          (widen)
+          (c-clear-cpp-delimiters ,beg ,end))
         ,`(c-with-cpps-commented-out ,@forms))
      (c-save-buffer-state ()
-       (c-set-cpp-delimiters ,beg ,end))))
+       (save-restriction
+        (widen)
+        (c-set-cpp-delimiters ,beg ,end)))))
 \f
 (defsubst c-intersect-lists (list alist)
   ;; return the element of ALIST that matches the first element found
@@ -1415,8 +1424,8 @@ Notably, null elements in LIST are ignored."
 
 (defun c-make-keywords-re (adorn list &optional mode)
   "Make a regexp that matches all the strings the list.
-Duplicates and nil elements in the list are removed.  The resulting
-regexp may contain zero or more submatch expressions.
+Duplicates and nil elements in the list are removed.  The
+resulting regexp may contain zero or more submatch expressions.
 
 If ADORN is t there will be at least one submatch and the first
 surrounds the matched alternative, and the regexp will also not match
@@ -1434,11 +1443,7 @@ The optional MODE specifies the language to get `c-nonsymbol-key' from
 when it's needed.  The default is the current language taken from
 `c-buffer-is-cc-mode'."
 
-  (let (unique)
-    (dolist (elt list)
-      (unless (member elt unique)
-       (push elt unique)))
-    (setq list (delete nil unique)))
+  (setq list (delete nil (delete-dups list)))
   (if list
       (let (re)
 
@@ -1552,6 +1557,8 @@ non-nil, a caret is prepended to invert the set."
 
 (cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
 
+(defvar lookup-syntax-properties)       ;XEmacs.
+
 (defconst c-emacs-features
   (let (list)
 
@@ -1606,7 +1613,7 @@ non-nil, a caret is prepended to invert the set."
     (let ((buf (generate-new-buffer " test"))
          parse-sexp-lookup-properties
          parse-sexp-ignore-comments
-         lookup-syntax-properties)
+         lookup-syntax-properties)     ; XEmacs
       (with-current-buffer buf
        (set-syntax-table (make-syntax-table))
 
@@ -1632,13 +1639,13 @@ non-nil, a caret is prepended to invert the set."
                  "support for the `syntax-table' text property "
                  "is required.")))
 
-       ;; Find out if generic comment delimiters work.
+       ;; Find out if "\\s!" (generic comment delimiters) work.
        (c-safe
          (modify-syntax-entry ?x "!")
          (if (string-match "\\s!" "x")
              (setq list (cons 'gen-comment-delim list))))
 
-       ;; Find out if generic string delimiters work.
+       ;; Find out if "\\s|" (generic string delimiters) work.
        (c-safe
          (modify-syntax-entry ?x "|")
          (if (string-match "\\s|" "x")
@@ -1685,7 +1692,8 @@ non-nil, a caret is prepended to invert the set."
       (kill-buffer buf))
 
     ;; See if `parse-partial-sexp' returns the eighth element.
-    (if (c-safe (>= (length (save-excursion (parse-partial-sexp (point) (point))))
+    (if (c-safe (>= (length (save-excursion
+                             (parse-partial-sexp (point) (point))))
                    10))
        (setq list (cons 'pps-extended-state list))
       (error (concat
@@ -1701,9 +1709,8 @@ might be present:
 
 '8-bit              8 bit syntax entry flags (XEmacs style).
 '1-bit              1 bit syntax entry flags (Emacs style).
-'argumentative-bod-function         beginning-of-defun passes ARG through
-                    to a non-null beginning-of-defun-function.  It is assumed
-                   the end-of-defun does the same thing.
+'argumentative-bod-function        beginning-of-defun and end-of-defun pass
+                   ARG through to beginning/end-of-defun-function.
 'syntax-properties  It works to override the syntax for specific characters
                    in the buffer with the 'syntax-table property.  It's
                    always set - CC Mode no longer works in emacsen without
@@ -1798,11 +1805,11 @@ system."
   (put mode 'c-fallback-mode base-mode))
 
 (defvar c-lang-constants (make-vector 151 0))
-;; This obarray is a cache to keep track of the language constants
-;; defined by `c-lang-defconst' and the evaluated values returned by
-;; `c-lang-const'.  It's mostly used at compile time but it's not
+;;   Obarray used as a cache to keep track of the language constants.
+;; The constants stored are those defined by `c-lang-defconst' and the values
+;; computed by `c-lang-const'.  It's mostly used at compile time but it's not
 ;; stored in compiled files.
-;;
+
 ;; The obarray contains all the language constants as symbols.  The
 ;; value cells hold the evaluated values as alists where each car is
 ;; the mode name symbol and the corresponding cdr is the evaluated
@@ -1825,19 +1832,18 @@ system."
               (t
                ;; Being evaluated interactively.
                (buffer-file-name)))))
-    (and file (file-name-base file))))
+    (and file
+        (file-name-sans-extension
+         (file-name-nondirectory file)))))
 
 (defmacro c-lang-defconst-eval-immediately (form)
   "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
 immediately, i.e. at the same time as the `c-lang-defconst' form
 itself is evaluated."
   ;; Evaluate at macro expansion time, i.e. in the
-  ;; `cl-macroexpand-all' inside `c-lang-defconst'.
+  ;; `macroexpand-all' inside `c-lang-defconst'.
   (eval form))
 
-;; Only used at compile time - suppress "might not be defined at runtime".
-(declare-function cl-macroexpand-all "cl" (form &optional env))
-
 (defmacro c-lang-defconst (name &rest args)
   "Set the language specific values of the language constant NAME.
 The second argument can optionally be a docstring.  The rest of the
@@ -1879,7 +1885,7 @@ constant.  A file is identified by its base name."
 
   (let* ((sym (intern (symbol-name name) c-lang-constants))
         ;; Make `c-lang-const' expand to a straightforward call to
-        ;; `c-get-lang-constant' in `cl-macroexpand-all' below.
+        ;; `c-get-lang-constant' in `macroexpand-all' below.
         ;;
         ;; (The default behavior, i.e. to expand to a call inside
         ;; `eval-when-compile' should be equivalent, since that macro
@@ -1896,7 +1902,7 @@ constant.  A file is identified by its base name."
         pre-files)
 
     (or (symbolp name)
-       (error "Not a symbol: %s" name))
+       (error "Not a symbol: %S" name))
 
     (when (stringp (car-safe args))
       ;; The docstring is hardly used anywhere since there's no normal
@@ -1906,7 +1912,7 @@ constant.  A file is identified by its base name."
       (setq args (cdr args)))
 
     (or args
-       (error "No assignments in `c-lang-defconst' for %s" name))
+       (error "No assignments in `c-lang-defconst' for %S" name))
 
     ;; Rework ARGS to an association list to make it easier to handle.
     ;; It's reversed at the same time to make it easier to implement
@@ -1920,17 +1926,17 @@ constant.  A file is identified by its base name."
                   ((listp (car args))
                    (mapcar (lambda (lang)
                              (or (symbolp lang)
-                                 (error "Not a list of symbols: %s"
+                                 (error "Not a list of symbols: %S"
                                         (car args)))
                              (intern (concat (symbol-name lang)
                                              "-mode")))
                            (car args)))
-                  (t (error "Not a symbol or a list of symbols: %s"
+                  (t (error "Not a symbol or a list of symbols: %S"
                             (car args)))))
            val)
 
        (or (cdr args)
-           (error "No value for %s" (car args)))
+           (error "No value for %S" (car args)))
        (setq args (cdr args)
              val (car args))
 
@@ -1942,9 +1948,9 @@ constant.  A file is identified by its base name."
        ;; reason, but we also use this expansion handle
        ;; `c-lang-defconst-eval-immediately' and to register
        ;; dependencies on the `c-lang-const's in VAL.)
-       (setq val (cl-macroexpand-all val))
+       (setq val (macroexpand-all val))
 
-       (setq bindings (cons (cons assigned-mode val) bindings)
+       (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings)
              args (cdr args))))
 
     ;; Compile in the other files that have provided source
@@ -1956,7 +1962,7 @@ constant.  A file is identified by its base name."
                     (mapcar 'car (get sym 'source))))
 
     `(eval-and-compile
-       (c-define-lang-constant ',name ',bindings
+       (c-define-lang-constant ',name ,bindings
                               ,@(and pre-files `(',pre-files))))))
 
 (put 'c-lang-defconst 'lisp-indent-function 1)
@@ -2021,19 +2027,16 @@ language.  NAME and LANG are not evaluated so they should not be
 quoted."
 
   (or (symbolp name)
-      (error "Not a symbol: %s" name))
+      (error "Not a symbol: %S" name))
   (or (symbolp lang)
-      (error "Not a symbol: %s" lang))
+      (error "Not a symbol: %S" lang))
 
   (let ((sym (intern (symbol-name name) c-lang-constants))
-       mode source-files args)
+       (mode (when lang (intern (concat (symbol-name lang) "-mode")))))
 
-    (when lang
-      (setq mode (intern (concat (symbol-name lang) "-mode")))
-      (unless (get mode 'c-mode-prefix)
-       (error
-        "Unknown language %S since it got no `c-mode-prefix' property"
-        (symbol-name lang))))
+    (or (get mode 'c-mode-prefix) (null mode)
+        (error "Unknown language %S: no `c-mode-prefix' property"
+               lang))
 
     (if (eq c-lang-const-expansion 'immediate)
        ;; No need to find out the source file(s) when we evaluate
@@ -2041,49 +2044,56 @@ quoted."
        ;; `source' property.
        `',(c-get-lang-constant name nil mode)
 
-      (let ((file (c-get-current-file)))
-       (if file (setq file (intern file)))
-       ;; Get the source file(s) that must be loaded to get the value
-       ;; of the constant.  If the symbol isn't defined yet we assume
-       ;; that its definition will come later in this file, and thus
-       ;; are no file dependencies needed.
-       (setq source-files (nreverse
-                           ;; Reverse to get the right load order.
-                           (apply 'nconc
-                                  (mapcar (lambda (elem)
-                                            (if (eq file (car elem))
-                                                nil ; Exclude our own file.
-                                              (list (car elem))))
-                                          (get sym 'source))))))
-
-      ;; Make some effort to do a compact call to
-      ;; `c-get-lang-constant' since it will be compiled in.
-      (setq args (and mode `(',mode)))
-      (if (or source-files args)
-         (setq args (cons (and source-files `',source-files)
-                          args)))
-
-      (if (or (eq c-lang-const-expansion 'call)
-             (and (not c-lang-const-expansion)
-                  (not mode))
-             load-in-progress
-             (not (boundp 'byte-compile-dest-file))
-             (not (stringp byte-compile-dest-file)))
-         ;; Either a straight call is requested in the context, or
-         ;; we're in an "uncontrolled" context and got no language,
-         ;; or we're not being byte compiled so the compile time
-         ;; stuff below is unnecessary.
-         `(c-get-lang-constant ',name ,@args)
-
-       ;; Being compiled.  If the loading and compiling version is
-       ;; the same we use a value that is evaluated at compile time,
-       ;; otherwise it's evaluated at runtime.
-       `(if (eq c-version-sym ',c-version-sym)
-            (cc-eval-when-compile
-              (c-get-lang-constant ',name ,@args))
-          (c-get-lang-constant ',name ,@args))))))
-
-(defvar c-lang-constants-under-evaluation nil)
+      (let ((source-files
+             (let ((file (c-get-current-file)))
+               (if file (setq file (intern file)))
+               ;; Get the source file(s) that must be loaded to get the value
+               ;; of the constant.  If the symbol isn't defined yet we assume
+               ;; that its definition will come later in this file, and thus
+               ;; are no file dependencies needed.
+               (nreverse
+                ;; Reverse to get the right load order.
+                (apply 'nconc
+                       (mapcar (lambda (elem)
+                                 (if (eq file (car elem))
+                                     nil ; Exclude our own file.
+                                   (list (car elem))))
+                               (get sym 'source))))))
+            ;; Make some effort to do a compact call to
+            ;; `c-get-lang-constant' since it will be compiled in.
+            (args (and mode `(',mode))))
+
+        (if (or source-files args)
+            (push (and source-files `',source-files) args))
+
+        (if (or (eq c-lang-const-expansion 'call)
+                (and (not c-lang-const-expansion)
+                     (not mode))
+                load-in-progress
+                (not (boundp 'byte-compile-dest-file))
+                (not (stringp byte-compile-dest-file)))
+            ;; Either a straight call is requested in the context, or
+            ;; we're in an "uncontrolled" context and got no language,
+            ;; or we're not being byte compiled so the compile time
+            ;; stuff below is unnecessary.
+            `(c-get-lang-constant ',name ,@args)
+
+          ;; Being compiled.  If the loading and compiling version is
+          ;; the same we use a value that is evaluated at compile time,
+          ;; otherwise it's evaluated at runtime.
+          `(if (eq c-version-sym ',c-version-sym)
+               (cc-eval-when-compile
+                 (c-get-lang-constant ',name ,@args))
+             (c-get-lang-constant ',name ,@args)))))))
+
+(defvar c-lang-constants-under-evaluation nil
+  "Alist of constants in the process of being evaluated.
+The `cdr' of each entry indicates how far we've looked in the list
+of definitions, so that the def for var FOO in c-mode can be defined in
+terms of the def for that same var FOO (which will then rely on the
+fallback definition for all modes, to break the cycle).")
+
+(defconst c-lang--novalue "novalue")
 
 (defun c-get-lang-constant (name &optional source-files mode)
   ;; Used by `c-lang-const'.
@@ -2149,7 +2159,7 @@ quoted."
                   ;; mode might have an explicit entry before that.
                   (eq (setq value (c-find-assignment-for-mode
                                    (cdr source-pos) mode nil name))
-                      c-lang-constants)
+                      c-lang--novalue)
                   ;; Try again with the fallback mode from the
                   ;; original position.  Note that
                   ;; `c-buffer-is-cc-mode' still is the real mode if
@@ -2157,22 +2167,22 @@ quoted."
                   (eq (setq value (c-find-assignment-for-mode
                                    (setcdr source-pos backup-source-pos)
                                    fallback t name))
-                      c-lang-constants)))
+                      c-lang--novalue)))
              ;; A simple lookup with no fallback mode.
              (eq (setq value (c-find-assignment-for-mode
                               (cdr source-pos) mode t name))
-                 c-lang-constants))
+                 c-lang--novalue))
            (error
-            "`%s' got no (prior) value in %s (might be a cyclic reference)"
+            "`%s' got no (prior) value in %S (might be a cyclic reference)"
             name mode))
 
        (condition-case err
-           (setq value (eval value))
+           (setq value (funcall value))
          (error
           ;; Print a message to aid in locating the error.  We don't
           ;; print the error itself since that will be done later by
           ;; some caller higher up.
-          (message "Eval error in the `c-lang-defconst' for `%s' in %s:"
+          (message "Eval error in the `c-lang-defconst' for `%S' in %s:"
                    sym mode)
           (makunbound sym)
           (signal (car err) (cdr err))))
@@ -2180,13 +2190,13 @@ quoted."
        (set sym (cons (cons mode value) (symbol-value sym)))
        value))))
 
-(defun c-find-assignment-for-mode (source-pos mode match-any-lang name)
+(defun c-find-assignment-for-mode (source-pos mode match-any-lang _name)
   ;; Find the first assignment entry that applies to MODE at or after
   ;; SOURCE-POS.  If MATCH-ANY-LANG is non-nil, entries with `t' as
   ;; the language list are considered to match, otherwise they don't.
   ;; On return SOURCE-POS is updated to point to the next assignment
   ;; after the returned one.  If no assignment is found,
-  ;; `c-lang-constants' is returned as a magic value.
+  ;; `c-lang--novalue' is returned as a magic value.
   ;;
   ;; SOURCE-POS is a vector that points out a specific assignment in
   ;; the double alist that's used in the `source' property.  The first
@@ -2217,7 +2227,7 @@ quoted."
                     ;;(message (concat "Loading %s to get the source "
                     ;;                 "value for language constant %s")
                     ;;         file name)
-                    (load file))
+                    (load file nil t))
 
                   (unless (setq assignment-entry (cdar file-entry))
                     ;; The load didn't fill in the source for the
@@ -2242,7 +2252,7 @@ quoted."
                match-any-lang)
          (throw 'found (cdr assignment))))
 
-      c-lang-constants)))
+      c-lang--novalue)))
 
 (defun c-lang-major-mode-is (mode)
   ;; `c-major-mode-is' expands to a call to this function inside