]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/cc-defs.el
Support curved quotes in doc strings
[gnu-emacs] / lisp / progmodes / cc-defs.el
index 1d8b8abeb2fdb75f92bb2f598d7ad15390ed690d..fd4bfb3b921a81aa0bb38b58b87799238e9de431 100644 (file)
@@ -1,6 +1,6 @@
 ;;; cc-defs.el --- compile time definitions for CC Mode
 
-;; Copyright (C) 1985, 1987, 1992-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
 
 ;; Authors:    2003- Alan Mackenzie
 ;;             1998- Martin Stjernholm
          (not (fboundp 'push)))
       (cc-load "cc-fix")))
 
-; (eval-after-load "font-lock"  ; 2006-07-09.  font-lock is now preloaded
-;   '
-(if (and (featurep 'xemacs)    ; There is now (2005/12) code in GNU Emacs CVS
-                               ; to make the call to f-l-c-k throw an error.
-        (not (featurep 'cc-fix)) ; only load the file once.
-        (let (font-lock-keywords)
-          (font-lock-compile-keywords '("\\<\\>"))
-          font-lock-keywords))     ; did the previous call foul this up?
-    (load "cc-fix")) ;)
+(when (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS
+                        ; to make the call to f-l-c-k throw an error.
+  (eval-after-load "font-lock"
+    '(if (and (not (featurep 'cc-fix)) ; only load the file once.
+             (let (font-lock-keywords)
+               (font-lock-compile-keywords '("\\<\\>"))
+               font-lock-keywords)) ; did the previous call foul this up?
+         (load "cc-fix"))))
 
 ;; The above takes care of the delayed loading, but this is necessary
 ;; to ensure correct byte compilation.
@@ -94,7 +93,7 @@
 \f
 ;;; Variables also used at compile time.
 
-(defconst c-version "5.32.5"
+(defconst c-version "5.33"
   "CC Mode version number.")
 
 (defconst c-version-sym (intern c-version))
@@ -336,16 +335,42 @@ to it is returned.  This function does not modify the point or the mark."
          (t (error "Unknown buffer position requested: %s" position))))
        (point))))
 
+(eval-and-compile
+  ;; Constant to decide at compilation time whether to use category
+  ;; properties.  Currently (2010-03) they're available only on GNU Emacs.
+  (defconst c-use-category
+    (with-temp-buffer
+      (let ((parse-sexp-lookup-properties t)
+           (lookup-syntax-properties t))
+        (set-syntax-table (make-syntax-table))
+        (insert "<()>")
+        (put-text-property (point-min) (1+ (point-min))
+                          'category 'c-<-as-paren-syntax)
+        (put-text-property (+ 3 (point-min)) (+ 4 (point-min))
+                          'category 'c->-as-paren-syntax)
+        (goto-char (point-min))
+        (forward-sexp)
+        (= (point) (+ 4 (point-min)))))))
+
+(defvar c-use-extents)
+
+(defmacro c-next-single-property-change (position prop &optional object limit)
+  ;; See the doc string for either of the defuns expanded to.
+  (if (and c-use-extents
+          (fboundp 'next-single-char-property-change))
+      ;; XEmacs >= 2005-01-25
+      `(next-single-char-property-change ,position ,prop ,object ,limit)
+    ;; Emacs and earlier XEmacs
+    `(next-single-property-change ,position ,prop ,object ,limit)))
+
 (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
-    ;; XEmacs.
-    '(region-active-p)))
+  (if (cc-bytecomp-fboundp 'region-active-p)
+      ;; XEmacs.
+      '(region-active-p)
+    ;; Old Emacs.
+    'mark-active))
 
 (defmacro c-set-region-active (activate)
   ;; Activate the region if ACTIVE is non-nil, deactivate it
@@ -1061,8 +1086,8 @@ nil; point is then left undefined."
      (while
         (and
          (< place ,(or limit '(point-max)))
-         (not (equal (get-text-property place ,property) ,value)))
-       (setq place (next-single-property-change
+         (not (equal (c-get-char-property place ,property) ,value)))
+       (setq place (c-next-single-property-change
                    place ,property nil ,(or limit '(point-max)))))
      (when (< place ,(or limit '(point-max)))
        (goto-char place)
@@ -1080,10 +1105,15 @@ point is then left undefined."
      (while
         (and
          (> place ,(or limit '(point-min)))
-         (not (equal (get-text-property (1- place) ,property) ,value)))
-       (setq place (previous-single-property-change
+         (not (equal (c-get-char-property (1- place) ,property) ,value)))
+       (setq place (,(if (and c-use-extents
+                             (fboundp 'previous-single-char-property-change))
+                        ;; XEmacs > 2005-01-25.
+                        'previous-single-char-property-change
+                      ;; Emacs and earlier XEmacs.
+                      'previous-single-property-change)
                    place ,property nil ,(or limit '(point-min)))))
-     (when (> place ,(or limit '(point-max)))
+     (when (> place ,(or limit '(point-min)))
        (goto-char place)
        (search-backward-regexp ".")    ; to set the match-data.
        (point))))
@@ -1100,9 +1130,9 @@ been put there by c-put-char-property.  POINT remains unchanged."
              (and
               (< place to)
               (not (equal (get-text-property place property) value)))
-           (setq place (next-single-property-change place property nil to)))
+           (setq place (c-next-single-property-change place property nil to)))
          (< place to))
-      (setq end-place (next-single-property-change place property nil to))
+      (setq end-place (c-next-single-property-change place property nil to))
       (remove-text-properties place end-place (cons property nil))
       ;; Do we have to do anything with stickiness here?
       (setq place end-place))))
@@ -1119,7 +1149,7 @@ been put there by c-put-char-property.  POINT remains unchanged."
                        (if (equal (extent-property ext -property-) val)
                            (delete-extent ext)))
                      nil ,from ,to ,value nil -property-))
-  ;; Gnu Emacs
+    ;; GNU Emacs
     `(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
 \f
 ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
@@ -1203,36 +1233,43 @@ been put there by c-put-char-property.  POINT remains unchanged."
     (if (< (point) start)
        (goto-char (point-max)))))
 
-(defsubst c-mark-<-as-paren (pos)
+(defmacro c-mark-<-as-paren (pos)
   ;; Mark the "<" character at POS as a template opener using the
-  ;; `syntax-table' property via the `category' property.
+  ;; `syntax-table' property either directly (XEmacs) or via a `category'
+  ;; property (GNU Emacs).
   ;;
   ;; This function does a hidden buffer change.  Note that we use
   ;; indirection through the `category' text property.  This allows us to
   ;; toggle the property in all template brackets simultaneously and
   ;; cheaply.  We use this, for instance, in `c-parse-state'.
-  (c-put-char-property pos 'category 'c-<-as-paren-syntax))
+  (if c-use-category
+      `(c-put-char-property ,pos 'category 'c-<-as-paren-syntax)
+    `(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax)))
+
 
-(defsubst c-mark->-as-paren (pos)
+(defmacro c-mark->-as-paren (pos)
   ;; Mark the ">" character at POS as an sexp list closer using the
-  ;; syntax-table property.
+  ;; `syntax-table' property either directly (XEmacs) or via a `category'
+  ;; property (GNU Emacs).
   ;;
   ;; This function does a hidden buffer change.  Note that we use
   ;; indirection through the `category' text property.  This allows us to
   ;; toggle the property in all template brackets simultaneously and
   ;; cheaply.  We use this, for instance, in `c-parse-state'.
-  (c-put-char-property pos 'category 'c->-as-paren-syntax))
-
-(defsubst c-unmark-<->-as-paren (pos)
-  ;; Unmark the "<" or "<" character at POS as an sexp list opener using
-  ;; the syntax-table property indirectly through the `category' text
-  ;; property.
+  (if c-use-category
+      `(c-put-char-property ,pos 'category 'c->-as-paren-syntax)
+    `(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax)))
+
+(defmacro c-unmark-<->-as-paren (pos)
+  ;; Unmark the "<" or "<" character at POS as an sexp list opener using the
+  ;; `syntax-table' property either directly or indirectly through a
+  ;; `category' text property.
   ;;
-  ;; This function does a hidden buffer change.  Note that we use
+  ;; This function does a hidden buffer change.  Note that we try to use
   ;; indirection through the `category' text property.  This allows us to
   ;; toggle the property in all template brackets simultaneously and
   ;; cheaply.  We use this, for instance, in `c-parse-state'.
-  (c-clear-char-property pos 'category))
+  `(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table)))
 
 (defsubst c-suppress-<->-as-parens ()
   ;; Suppress the syntactic effect of all marked < and > as parens.  Note
@@ -1313,6 +1350,124 @@ been put there by c-put-char-property.  POINT remains unchanged."
         (widen)
         (c-set-cpp-delimiters ,beg ,end)))))
 \f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following macros are to be used only in `c-parse-state' and its
+;; subroutines.  Their main purpose is to simplify the handling of C++/Java
+;; template delimiters and CPP macros.  In GNU Emacs, this is done slickly by
+;; the judicious use of 'category properties.  These don't exist in XEmacs.
+;;
+;; Note: in the following macros, there is no special handling for parentheses
+;; inside CPP constructs.  That is because CPPs are always syntactically
+;; balanced, thanks to `c-neutralize-CPP-line' in cc-mode.el.
+(defmacro c-sc-scan-lists-no-category+1+1 (from)
+  ;; Do a (scan-lists FROM 1 1).  Any finishing position which either (i) is
+  ;; determined by and angle bracket; or (ii) is inside a macro whose start
+  ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+  `(let ((here (point))
+        (pos (scan-lists ,from 1 1)))
+     (while (eq (char-before pos) ?>)
+       (setq pos (scan-lists pos 1 1)))
+     pos))
+
+(defmacro c-sc-scan-lists-no-category+1-1 (from)
+  ;; Do a (scan-lists FROM 1 -1).  Any finishing position which either (i) is
+  ;; determined by an angle bracket; or (ii) is inside a macro whose start
+  ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+  `(let ((here (point))
+        (pos (scan-lists ,from 1 -1)))
+     (while (eq (char-before pos) ?<)
+       (setq pos (scan-lists pos 1 1))
+       (setq pos (scan-lists pos 1 -1)))
+     pos))
+
+(defmacro c-sc-scan-lists-no-category-1+1 (from)
+  ;; Do a (scan-lists FROM -1 1).  Any finishing position which either (i) is
+  ;; determined by and angle bracket; or (ii) is inside a macro whose start
+  ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+  `(let ((here (point))
+        (pos (scan-lists ,from -1 1)))
+     (while (eq (char-after pos) ?<)
+       (setq pos (scan-lists pos -1 1)))
+     pos))
+
+(defmacro c-sc-scan-lists-no-category-1-1 (from)
+  ;; Do a (scan-lists FROM -1 -1).  Any finishing position which either (i) is
+  ;; determined by and angle bracket; or (ii) is inside a macro whose start
+  ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+  `(let ((here (point))
+        (pos (scan-lists ,from -1 -1)))
+     (while (eq (char-after pos) ?>)
+       (setq pos (scan-lists pos -1 1))
+       (setq pos (scan-lists pos -1 -1)))
+     pos))
+
+(defmacro c-sc-scan-lists (from count depth)
+  (if c-use-category
+      `(scan-lists ,from ,count ,depth)
+    (cond
+     ((and (eq count 1) (eq depth 1))
+      `(c-sc-scan-lists-no-category+1+1 ,from))
+     ((and (eq count 1) (eq depth -1))
+      `(c-sc-scan-lists-no-category+1-1 ,from))
+     ((and (eq count -1) (eq depth 1))
+      `(c-sc-scan-lists-no-category-1+1 ,from))
+     ((and (eq count -1) (eq depth -1))
+      `(c-sc-scan-lists-no-category-1-1 ,from))
+     (t (error "Invalid parameter(s) to c-sc-scan-lists")))))
+
+
+(defun c-sc-parse-partial-sexp-no-category (from to targetdepth stopbefore
+                                                oldstate)
+  ;; Do a parse-partial-sexp using the supplied arguments, disregarding
+  ;; template/generic delimiters < > and disregarding macros other than the
+  ;; one at POINT-MACRO-START.
+  ;;
+  ;; NOTE that STOPBEFORE must be nil.  TARGETDEPTH should be one less than
+  ;; the depth in OLDSTATE.  This function is thus a SPECIAL PURPOSE variation
+  ;; on parse-partial-sexp, designed for calling from
+  ;; `c-remove-stale-state-cache'.
+  ;;
+  ;; Any finishing position which is determined by an angle bracket delimiter
+  ;; doesn't count as a finishing position.
+  ;;
+  ;; Note there is no special handling of CPP constructs here, since these are
+  ;; always syntactically balanced (thanks to `c-neutralize-CPP-line').
+  (let ((state
+        (parse-partial-sexp from to targetdepth stopbefore oldstate)))
+    (while
+       (and (< (point) to)
+            ;; We must have hit targetdepth.
+            (or (eq (char-before) ?<)
+                (eq (char-before) ?>)))
+      (setcar state
+             (if (memq (char-before) '(?> ?\) ?\} ?\]))
+                 (1+ (car state))
+               (1- (car state))))
+      (setq state
+           (parse-partial-sexp (point) to targetdepth stopbefore oldstate)))
+    state))
+
+(defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore
+                                       oldstate)
+  (if c-use-category
+      `(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate)
+    `(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore
+                                         ,oldstate)))
+
+\f
+(defvar c-emacs-features)
+
+(defmacro c-looking-at-non-alphnumspace ()
+  "Are we looking at a character which isn't alphanumeric or space?"
+  (if (memq 'gen-comment-delim c-emacs-features)
+      `(looking-at
+"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)")
+    `(or (looking-at
+"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)"
+        (let ((prop (c-get-char-property (point) 'syntax-table)))
+          (eq prop '(14)))))))         ; '(14) is generic comment delimiter.
+
+\f
 (defsubst c-intersect-lists (list alist)
   ;; return the element of ALIST that matches the first element found
   ;; in LIST.  Uses assq.
@@ -1614,6 +1769,9 @@ non-nil, a caret is prepended to invert the set."
                               (not (end-of-defun))))
          (setq list (cons 'argumentative-bod-function list))))
 
+    ;; Record whether the `category' text property works.
+    (if c-use-category (setq list (cons 'category-properties list)))
+
     (let ((buf (generate-new-buffer " test"))
          parse-sexp-lookup-properties
          parse-sexp-ignore-comments
@@ -1719,6 +1877,8 @@ might be present:
                    in the buffer with the 'syntax-table property.  It's
                    always set - CC Mode no longer works in emacsen without
                    this feature.
+'category-properties Syntax routines can add a level of indirection to text
+                   properties using the 'category property.
 'gen-comment-delim  Generic comment delimiters work
                    (i.e. the syntax class `!').
 'gen-string-delim   Generic string delimiters work
@@ -1823,19 +1983,22 @@ system."
 
 (defvar c-lang-const-expansion nil)
 
+;; Ugly hack to pull in the definition of `cc-bytecomp-compiling-or-loading'
+;; from cc-bytecomp to make it available at loadtime.  This is the same
+;; mechanism used in cc-mode.el for `c-populate-syntax-table'.
+(defalias 'cc-bytecomp-compiling-or-loading
+  (cc-eval-when-compile
+    (let ((f (symbol-function 'cc-bytecomp-compiling-or-loading)))
+      (if (byte-code-function-p f) f (byte-compile f)))))
+
 (defsubst c-get-current-file ()
   ;; Return the base name of the current file.
-  (let ((file (cond
-              (load-in-progress
-               ;; Being loaded.
-               load-file-name)
-              ((and (boundp 'byte-compile-dest-file)
-                    (stringp byte-compile-dest-file))
-               ;; Being compiled.
-               byte-compile-dest-file)
-              (t
-               ;; Being evaluated interactively.
-               (buffer-file-name)))))
+  (let* ((c-or-l (cc-bytecomp-compiling-or-loading))
+        (file
+         (cond
+          ((eq c-or-l 'loading) load-file-name)
+          ((eq c-or-l 'compiling) byte-compile-dest-file)
+          ((null c-or-l) (buffer-file-name)))))
     (and file
         (file-name-sans-extension
          (file-name-nondirectory file)))))
@@ -1854,10 +2017,10 @@ The second argument can optionally be a docstring.  The rest of the
 arguments are one or more repetitions of LANG VAL where LANG specifies
 the language(s) that VAL applies to.  LANG is the name of the
 language, i.e. the mode name without the \"-mode\" suffix, or a list
-of such language names, or `t' for all languages.  VAL is a form to
+of such language names, or t for all languages.  VAL is a form to
 evaluate to get the value.
 
-If LANG isn't `t' or one of the core languages in CC Mode, it must
+If LANG isn't t or one of the core languages in CC Mode, it must
 have been declared with `c-add-language'.
 
 Neither NAME, LANG nor VAL are evaluated directly - they should not be
@@ -1867,7 +2030,7 @@ VAL to evaluate parts of it directly.
 When VAL is evaluated for some language, that language is temporarily
 made current so that `c-lang-const' without an explicit language can
 be used inside VAL to refer to the value of a language constant in the
-same language.  That is particularly useful if LANG is `t'.
+same language.  That is particularly useful if LANG is t.
 
 VAL is not evaluated right away but rather when the value is requested
 with `c-lang-const'.  Thus it's possible to use `c-lang-const' inside
@@ -1902,6 +2065,9 @@ constant.  A file is identified by its base name."
         ;; language constant source definitions.)
         (c-lang-const-expansion 'call)
         (c-langs-are-parametric t)
+        (file (intern
+               (or (c-get-current-file)
+                   (error "`c-lang-defconst' can only be used in a file"))))
         bindings
         pre-files)
 
@@ -1961,9 +2127,14 @@ constant.  A file is identified by its base name."
     ;; definitions for this symbol, to make sure the order in the
     ;; `source' property is correct even when files are loaded out of
     ;; order.
-    (setq pre-files (nreverse
-                    ;; Reverse to get the right load order.
-                    (mapcar 'car (get sym 'source))))
+    (setq pre-files (mapcar 'car (get sym 'source)))
+    (if (memq file pre-files)
+       ;; This can happen when the source file (e.g. cc-langs.el) is first
+       ;; loaded as source, setting a 'source property entry, and then itself
+       ;; being compiled.
+       (setq pre-files (cdr (memq file pre-files))))
+    ;; Reverse to get the right load order.
+    (setq pre-files (nreverse pre-files))
 
     `(eval-and-compile
        (c-define-lang-constant ',name ,bindings
@@ -2073,9 +2244,7 @@ quoted."
         (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)))
+               (not (cc-bytecomp-is-compiling)))
             ;; 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
@@ -2196,7 +2365,7 @@ fallback definition for all modes, to break the cycle).")
 
 (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
+  ;; 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,
@@ -2277,4 +2446,8 @@ fallback definition for all modes, to break the cycle).")
 \f
 (cc-provide 'cc-defs)
 
+;;; Local Variables:
+;;; indent-tabs-mode: t
+;;; tab-width: 8
+;;; End:
 ;;; cc-defs.el ends here