summaryrefslogtreecommitdiff
path: root/lisp/cedet/semantic
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/cedet/semantic')
-rw-r--r--lisp/cedet/semantic/analyze.el15
-rw-r--r--lisp/cedet/semantic/analyze/refs.el6
-rw-r--r--lisp/cedet/semantic/bovine/c.el230
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el3
-rw-r--r--lisp/cedet/semantic/ctxt.el3
-rw-r--r--lisp/cedet/semantic/db-mode.el4
-rw-r--r--lisp/cedet/semantic/db.el5
-rw-r--r--lisp/cedet/semantic/decorate/include.el7
-rw-r--r--lisp/cedet/semantic/decorate/mode.el8
-rw-r--r--lisp/cedet/semantic/format.el10
-rw-r--r--lisp/cedet/semantic/lex-spp.el154
-rw-r--r--lisp/cedet/semantic/scope.el50
12 files changed, 361 insertions, 134 deletions
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index 000193d4a55..07bf1c7f621 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -295,18 +295,10 @@ Optional argument THROWSYM specifies a symbol the throw on non-recoverable error
;; In some cases the found TMP is a type,
;; and we can use it directly.
(cond ((semantic-tag-of-class-p tmp 'type)
- ;; update the miniscope when we need to analyze types directly.
- (when miniscope
- (let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
- tagtype))))
- (oset miniscope fullscope rawscope)))
- ;; Now analyze the type to remove metatypes.
(or (semantic-analyze-type tmp miniscope)
tmp))
(t
- (semantic-analyze-tag-type tmp scope))))
+ (semantic-analyze-tag-type tmp miniscope))))
(typefile
(when tmptype
(semantic-tag-file-name tmptype)))
@@ -336,6 +328,11 @@ Optional argument THROWSYM specifies a symbol the throw on non-recoverable error
(semantic--tag-put-property tmp :filename fname))
(setq tag (cons tmp tag))
(setq tagtype (cons tmptype tagtype))
+ (when miniscope
+ (let ((rawscope
+ (apply 'append
+ (mapcar 'semantic-tag-type-members tagtype))))
+ (oset miniscope fullscope rawscope)))
)
(setq s (cdr s)))
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index 93dd710a67d..b06a8a2c5aa 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -118,7 +118,8 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(semantic-tag-similar-p tag aT
:prototype-flag
:parent
- :typemodifiers))
+ :typemodifiers
+ :default-value))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT impl))))
allhits)
@@ -141,7 +142,8 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(semantic-tag-similar-p tag aT
:prototype-flag
:parent
- :typemodifiers))
+ :typemodifiers
+ :default-value))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT proto))))
allhits)
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 3c991ea8555..f7c6a43b37e 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -27,6 +27,7 @@
(require 'semantic)
(require 'semantic/analyze)
+(require 'semantic/analyze/refs)
(require 'semantic/bovine)
(require 'semantic/bovine/gcc)
(require 'semantic/idle)
@@ -812,7 +813,7 @@ Use semantic-cpp-lexer for parsing text inside a CPP macro."
;; semantic-lex-spp-replace-or-symbol-or-keyword
semantic-lex-symbol-or-keyword
semantic-lex-charquote
- semantic-lex-paren-or-list
+ semantic-lex-spp-paren-or-list
semantic-lex-close-paren
semantic-lex-ignore-comments
semantic-lex-punctuation
@@ -1118,7 +1119,8 @@ is its own toplevel tag. This function will return (cons A B)."
(semantic-tag-new-variable
(car cur) ;name
ty ;type
- (if default
+ (if (and default
+ (listp (cdr default)))
(buffer-substring-no-properties
(car default) (car (cdr default))))
:constant-flag (semantic-tag-variable-constant-p tag)
@@ -1173,11 +1175,7 @@ is its own toplevel tag. This function will return (cons A B)."
(nth 1 (car names)) ; name
"typedef"
(semantic-tag-type-members tag)
- ;; parent is just the name of what
- ;; is passed down as a tag.
- (list
- (semantic-tag-name
- (semantic-tag-type-superclasses tag)))
+ nil
:pointer
(let ((stars (car (car (car names)))))
(if (= stars 0) nil stars))
@@ -1227,6 +1225,45 @@ or \"struct\".")
name
(delete "" ans))))
+(define-mode-local-override semantic-analyze-tag-references c-mode (tag &optional db)
+ "Analyze the references for TAG.
+Returns a class with information about TAG.
+
+Optional argument DB is a database. It will be used to help
+locate TAG.
+
+Use `semantic-analyze-current-tag' to debug this fcn."
+ (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list 'semantic-tag-p tag)))
+ (let ((allhits nil)
+ (scope nil)
+ (refs nil))
+ (save-excursion
+ (semantic-go-to-tag tag db)
+ (setq scope (semantic-calculate-scope))
+
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t))
+
+ (when (or (zerop (semanticdb-find-result-length allhits))
+ (and (= (semanticdb-find-result-length allhits) 1)
+ (eq (car (semanticdb-find-result-nth allhits 0)) tag)))
+ ;; It found nothing or only itself - not good enough. As a
+ ;; last resort, let's remove all namespaces from the scope and
+ ;; search again.
+ (oset scope parents
+ (let ((parents (oref scope parents))
+ newparents)
+ (dolist (cur parents)
+ (unless (string= (semantic-tag-type cur) "namespace")
+ (push cur newparents)))
+ (reverse newparents)))
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t)))
+
+ (setq refs (semantic-analyze-references (semantic-tag-name tag)
+ :tag tag
+ :tagdb db
+ :scope scope
+ :rawsearchdata allhits)))))
+
(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
"Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
This is so we don't have to match the same starting text several times.
@@ -1258,7 +1295,8 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
(nth 10 tokenpart) ; initializers
)
(not (car (nth 3 tokenpart)))))
- (fcnpointer (string-match "^\\*" (car tokenpart)))
+ (fcnpointer (and (> (length (car tokenpart)) 0)
+ (= (aref (car tokenpart) 0) ?*)))
(fnname (if fcnpointer
(substring (car tokenpart) 1)
(car tokenpart)))
@@ -1266,70 +1304,80 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
nil
t))
)
- (if fcnpointer
- ;; Function pointers are really variables.
- (semantic-tag-new-variable
- fnname
- typedecl
- nil
- ;; It is a function pointer
- :functionpointer-flag t
- )
- ;; The function
- (semantic-tag-new-function
- fnname
- (or typedecl ;type
- (cond ((car (nth 3 tokenpart) )
- "void") ; Destructors have no return?
- (constructor
- ;; Constructors return an object.
- (semantic-tag-new-type
- ;; name
- (or (car semantic-c-classname)
- (let ((split (semantic-analyze-split-name-c-mode
- (car (nth 2 tokenpart)))))
- (if (stringp split) split
- (car (last split)))))
- ;; type
- (or (cdr semantic-c-classname)
- "class")
- ;; members
- nil
- ;; parents
- nil
- ))
- (t "int")))
- (nth 4 tokenpart) ;arglist
- :constant-flag (if (member "const" declmods) t nil)
- :typemodifiers (delete "const" declmods)
- :parent (car (nth 2 tokenpart))
- :destructor-flag (if (car (nth 3 tokenpart) ) t)
- :constructor-flag (if constructor t)
- :pointer (nth 7 tokenpart)
- :operator-flag operator
- ;; Even though it is "throw" in C++, we use
- ;; `throws' as a common name for things that toss
- ;; exceptions about.
- :throws (nth 5 tokenpart)
- ;; Reentrant is a C++ thingy. Add it here
- :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
- ;; A function post-const is funky. Try stuff
- :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
- ;; prototypes are functions w/ no body
- :prototype-flag (if (nth 8 tokenpart) t)
- ;; Pure virtual
- :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
- ;; Template specifier.
- :template-specifier (nth 9 tokenpart)
- )))
- )
- ))
+ ;; The function
+ (semantic-tag-new-function
+ fnname
+ (or typedecl ;type
+ (cond ((car (nth 3 tokenpart) )
+ "void") ; Destructors have no return?
+ (constructor
+ ;; Constructors return an object.
+ (semantic-tag-new-type
+ ;; name
+ (or (car semantic-c-classname)
+ (let ((split (semantic-analyze-split-name-c-mode
+ (car (nth 2 tokenpart)))))
+ (if (stringp split) split
+ (car (last split)))))
+ ;; type
+ (or (cdr semantic-c-classname)
+ "class")
+ ;; members
+ nil
+ ;; parents
+ nil
+ ))
+ (t "int")))
+ ;; Argument list can contain things like function pointers
+ (semantic-c-reconstitute-function-arglist (nth 4 tokenpart))
+ :constant-flag (if (member "const" declmods) t nil)
+ :typemodifiers (delete "const" declmods)
+ :parent (car (nth 2 tokenpart))
+ :destructor-flag (if (car (nth 3 tokenpart) ) t)
+ :constructor-flag (if constructor t)
+ :function-pointer fcnpointer
+ :pointer (nth 7 tokenpart)
+ :operator-flag operator
+ ;; Even though it is "throw" in C++, we use
+ ;; `throws' as a common name for things that toss
+ ;; exceptions about.
+ :throws (nth 5 tokenpart)
+ ;; Reentrant is a C++ thingy. Add it here
+ :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
+ ;; A function post-const is funky. Try stuff
+ :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
+ ;; prototypes are functions w/ no body
+ :prototype-flag (if (nth 8 tokenpart) t)
+ ;; Pure virtual
+ :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
+ ;; Template specifier.
+ :template-specifier (nth 9 tokenpart))))))
(defun semantic-c-reconstitute-template (tag specifier)
"Reconstitute the token TAG with the template SPECIFIER."
(semantic-tag-put-attribute tag :template (or specifier ""))
tag)
+(defun semantic-c-reconstitute-function-arglist (arglist)
+ "Reconstitute the argument list of a function.
+This currently only checks if the function expects a function
+pointer as argument."
+ (let (result)
+ (dolist (arg arglist)
+ ;; Names starting with a '*' denote a function pointer
+ (if (and (> (length (semantic-tag-name arg)) 0)
+ (= (aref (semantic-tag-name arg) 0) ?*))
+ (setq result
+ (append result
+ (list
+ (semantic-tag-new-function
+ (substring (semantic-tag-name arg) 1)
+ (semantic-tag-type arg)
+ (cadr (semantic-tag-attributes arg))
+ :function-pointer t))))
+ (setq result (append result (list arg)))))
+ result))
+
;;; Override methods & Variables
;;
@@ -1338,7 +1386,7 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
"Convert TAG to a string that is the print name for TAG.
Optional PARENT and COLOR are ignored."
(let ((name (semantic-format-tag-name-default tag parent color))
- (fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
+ (fnptr (semantic-tag-get-attribute tag :function-pointer))
)
(if (not fnptr)
name
@@ -1823,31 +1871,31 @@ DO NOT return the list of tags encompassing point."
(let ((idx 0)
(len (semanticdb-find-result-length tmp)))
(while (< idx len)
- (setq tagreturn (cons (semantic-tag-type (car (semanticdb-find-result-nth tmp idx))) tagreturn))
- (setq idx (1+ idx)))
- )
- ;; Use the encompassed types around point to also look for using statements.
- ;;(setq tagreturn (cons "bread_name" tagreturn))
- (while (cdr tagsaroundpoint) ; don't search the last one
- (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
- (dolist (T tmp)
- (setq tagreturn (cons (semantic-tag-type T) tagreturn))
- )
- (setq tagsaroundpoint (cdr tagsaroundpoint))
- )
- ;; If in a function...
- (when (and (semantic-tag-of-class-p (car tagsaroundpoint) 'function)
- ;; ...search for using statements in the local scope...
- (setq tmp (semantic-find-tags-by-class
- 'using
- (semantic-get-local-variables))))
- ;; ... and add them.
- (setq tagreturn
- (append tagreturn
- (mapcar 'semantic-tag-type tmp))))
+ (setq tagreturn
+ (append tagreturn (list (semantic-tag-type
+ (car (semanticdb-find-result-nth tmp idx))))))
+ (setq idx (1+ idx))))
+ ;; Use the encompassed types around point to also look for using
+ ;; statements. If we deal with types, search inside members; for
+ ;; functions, we have to call `semantic-get-local-variables' to
+ ;; parse inside the function's body.
+ (dolist (cur tagsaroundpoint)
+ (cond
+ ((and (eq (semantic-tag-class cur) 'type)
+ (setq tmp (semantic-find-tags-by-class
+ 'using
+ (semantic-tag-components (car tagsaroundpoint)))))
+ (dolist (T tmp)
+ (setq tagreturn (cons (semantic-tag-type T) tagreturn))))
+ ((and (semantic-tag-of-class-p (car (last tagsaroundpoint)) 'function)
+ (setq tmp (semantic-find-tags-by-class
+ 'using
+ (semantic-get-local-variables))))
+ (setq tagreturn
+ (append tagreturn
+ (mapcar 'semantic-tag-type tmp))))))
;; Return the stuff
- tagreturn
- ))
+ tagreturn))
(define-mode-local-override semantic-ctxt-imported-packages c++-mode (&optional point)
"Return the list of using tag types in scope of POINT."
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index 7beb8ff3203..e3c07ca96f4 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -210,7 +210,8 @@ It should also include other symbols GCC was compiled with.")
(semantic-add-system-include D 'c-mode))
(dolist (D (semantic-gcc-get-include-paths "c++"))
(semantic-add-system-include D 'c++-mode)
- (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h"))))
+ (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h")
+ (concat D "/features.h"))))
(dolist (cur cppconfig)
;; Presumably there will be only one of these files in the try-paths list...
(when (file-readable-p cur)
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index b010a30da7f..f421e725ad9 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -168,8 +168,7 @@ Uses the bovinator with the special top-symbol `bovine-inner-scope'
to collect tags, such as local variables or prototypes."
;; This assumes a bovine parser. Make sure we don't do
;; anything in that case.
- (when (and semantic--parse-table (not (eq semantic--parse-table t))
- (not (semantic-parse-tree-unparseable-p)))
+ (when (and semantic--parse-table (not (eq semantic--parse-table t)))
(let ((vars (semantic-get-cache-data 'get-local-variables)))
(if vars
(progn
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index e0cb3708454..27daa9c2279 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -105,7 +105,8 @@ Sets up the semanticdb environment."
(oset ctbl major-mode major-mode)
;; Local state
(setq semanticdb-current-table ctbl)
- ;; Try to swap in saved tags
+ (oset ctbl buffer (current-buffer))
+ ;; Try to swap in saved tags
(if (or (not (slot-boundp ctbl 'tags)) (not (oref ctbl tags))
(/= (or (oref ctbl pointmax) 0) (point-max))
)
@@ -133,7 +134,6 @@ Sets up the semanticdb environment."
(semantic--set-buffer-cache (oref ctbl tags))
;; Don't need it to be dirty. Set dirty due to hooks from above.
(oset ctbl dirty nil) ;; Special case here.
- (oset ctbl buffer (current-buffer))
;; Bind into the buffer.
(semantic--tag-link-cache-to-buffer)
)
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 614ce706b0c..bb7836e5c98 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -560,8 +560,9 @@ This will call `semantic-fetch-tags' if that file is in memory."
;;
;; Already in a buffer, just do it.
((semanticdb-in-buffer-p obj)
- (semanticdb-set-buffer obj)
- (semantic-fetch-tags))
+ (save-excursion
+ (semanticdb-set-buffer obj)
+ (semantic-fetch-tags)))
;;
;; Not in a buffer. Forcing a load.
(force
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index 0451ad44fe8..aa488373f0d 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -335,6 +335,9 @@ This mode provides a nice context menu on the include statements."
(defun semantic-decoration-on-includes-highlight-default (tag)
"Highlight the include TAG to show that semantic can't find it."
(let* ((file (semantic-dependency-tag-file tag))
+ ;; Don't actually load includes
+ (semanticdb-find-default-throttle
+ (remq 'unloaded semanticdb-find-default-throttle))
(table (semanticdb-find-table-for-include tag (current-buffer)))
(face nil)
(map nil)
@@ -365,8 +368,8 @@ This mode provides a nice context menu on the include statements."
(semanticdb-cache-get
table 'semantic-decoration-unparsed-include-cache)
;; Add a dependency.
- (let ((table semanticdb-current-table))
- (semanticdb-add-reference table tag))
+ (let ((currenttable semanticdb-current-table))
+ (semanticdb-add-reference currenttable tag))
)
))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index cc5e9d9bec2..d959d3ab9c7 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -275,7 +275,13 @@ minor mode is enabled."
'semantic-decorate-tags-after-full-reparse nil t)
;; Add decorations to available tags. The above hooks ensure
;; that new tags will be decorated when they become available.
- (semantic-decorate-add-decorations (semantic-fetch-available-tags)))
+ ;; However, don't do this immediately, because EDE will be
+ ;; activated later by find-file-hook, and includes might not
+ ;; be found yet.
+ (run-with-idle-timer
+ 0.1 nil
+ (lambda ()
+ (semantic-decorate-add-decorations (semantic-fetch-available-tags)))))
;; Remove decorations from available tags.
(semantic-decorate-clear-decorations (semantic-fetch-available-tags))
;; Cleanup any leftover crap too.
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index c6fbbed2424..16ff6eb768e 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -499,7 +499,12 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(setq r (concat r "[]")
deref (1- deref)))
r)))
- )
+ (default (when (eq class 'variable)
+ (let ((defval
+ (semantic-tag-get-attribute tag :default-value)))
+ (when (and defval (stringp defval))
+ (concat "[=" defval "]")))))
+ )
(if args
(setq args
(concat " "
@@ -512,7 +517,8 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(if type (concat type " "))
name
(or args "")
- (or array ""))))
+ (or array "")
+ (or default ""))))
;;;###autoload
(define-overloadable-function semantic-format-tag-concise-prototype (tag &optional parent color)
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 462e520654a..a77ebf98684 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -70,6 +70,8 @@
(require 'semantic)
(require 'semantic/lex)
+(declare-function semantic-c-end-of-macro "semantic/bovine/c")
+
;;; Code:
(defvar semantic-lex-spp-macro-symbol-obarray nil
"Table of macro keywords used by the Semantic Preprocessor.
@@ -527,16 +529,54 @@ and what valid VAL values are."
;;
;; Nested token FOO shows up in the table of macros, and gets replace
;; inline. This is the same as case 2.
+ ;;
+ ;; CASE 5: Macros which open a scope without closing it
+ ;;
+ ;; #define __NAMESPACE_STD namespace std {
+ ;; #define __NAMESPACE_END }
+ ;; ==>
+ ;; ((NAMESPACE "namespace" 140 . 149)
+ ;; (symbol "std" 150 . 153)
+ ;; (open-paren "{" 154 . 155))
+ ;;
+ ;; Note that we get a single 'open-paren' instead of a
+ ;; 'semantic-list', which is because we use
+ ;; 'semantic-lex-spp-paren-or-list' instead of
+ ;; 'semantic-lex-paren-or-list' in our spp-lexer. To keep things
+ ;; reasonably simple, we assume that such an open scope will always
+ ;; be closed by another macro (see
+ ;; `semantic-lex-spp-find-closing-macro'). We generate a
+ ;; 'semantic-list' to this closing macro, and we leave an overlay
+ ;; which contains information how far we got into the macro's
+ ;; stream (since it might open several scopes).
+
+ (let* ((arglist (semantic-lex-spp-macro-with-args val))
+ (argalist nil)
+ (val-tmp nil)
+ (v nil)
+ (sppov (semantic-lex-spp-get-overlay beg))
+ (sppinfo (when sppov (overlay-get sppov 'semantic-spp))))
+
+ ;; First, check if we were already here and left information
+ (when sppinfo
+ ;; Advance in the tokens as far as we got last time
+ (when (numberp (car sppinfo))
+ (while (and val
+ (>= (car sppinfo) (car (last (car val)))))
+ (setq val (cdr val))))
+ ;; And push an open paren
+ (semantic-lex-push-token
+ (semantic-lex-token 'open-paren beg (1+ beg) "{"))
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (unless val
+ ;; We reached the end of this macro, so delete overlay
+ (delete-overlay sppov)))
- (let ((arglist (semantic-lex-spp-macro-with-args val))
- (argalist nil)
- (val-tmp nil)
- (v nil)
- )
;; CASE 2: Dealing with the arg list.
- (when arglist
+ (when (and val arglist)
;; Skip the arg list.
- (setq val (cdr val))
+ (when (eq (caar val) 'spp-arg-list)
+ (setq val (cdr val)))
;; Push args into the replacement list.
(let ((AV argvalues))
@@ -616,7 +656,32 @@ and what valid VAL values are."
(semantic-lex-push-token
(semantic-lex-token (semantic-lex-token-class v) beg end txt))
)
-
+ ;; CASE 5: Macro which opens a scope
+ ((eq (semantic-lex-token-class v) 'open-paren)
+ ;; We assume that the scope will be closed by another macro.
+ ;; (Everything else would be a terrible idea anyway.)
+ (let* ((endpoint (semantic-lex-spp-find-closing-macro))
+ (ov (when endpoint
+ (or sppov
+ (make-overlay beg end)))))
+ (when ov
+ ;; Generate a semantic-list which spans to the end of
+ ;; the closing macro
+ (semantic-lex-push-token
+ (semantic-lex-token 'semantic-list beg endpoint))
+ ;; The rest of the current macro's stream will be parsed
+ ;; next time.
+ (setq val-tmp nil)
+ ;; Store our current state were we are in the macro and
+ ;; the endpoint.
+ (overlay-put ov 'semantic-spp
+ (cons (car (last v)) endpoint)))))
+ ((eq (semantic-lex-token-class v) 'close-paren)
+ ;; Macro which closes a scope
+ ;; Just push the close paren, but also decrease depth
+ (semantic-lex-push-token
+ (semantic-lex-token 'close-paren beg end txt))
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth)))
;; CASE 1: Just another token in the stream.
(t
;; Nothing new.
@@ -652,6 +717,37 @@ will return empty string instead.")
txt
""))
+(defun semantic-lex-spp-find-closing-macro ()
+ "Find next macro which closes a scope through a close-paren.
+Returns position with the end of that macro."
+ (let ((macros (semantic-lex-spp-macros))
+ (cmacro-regexp "\\(")
+ (case-fold-search nil))
+ ;; Build a regexp which search for all macros with a closing
+ ;; paren, and search for it.
+ (dolist (cur macros)
+ (let ((stream (symbol-value cur)))
+ (when (and (listp stream) (listp (car stream)))
+ (while stream
+ (if (and (eq (caar stream) 'close-paren)
+ (string= (nth 1 (car stream)) "}"))
+ (setq cmacro-regexp (concat cmacro-regexp (symbol-name cur) "\\|")
+ stream nil)
+ (setq stream (cdr-safe stream)))))))
+ (when cmacro-regexp
+ (save-excursion
+ (when (re-search-forward
+ (concat (substring cmacro-regexp 0 -2) "\\)[^0-9a-zA-Z_]") nil t)
+ (point))))))
+
+(defun semantic-lex-spp-get-overlay (&optional point)
+ "Return first overlay which has a 'semantic-spp property."
+ (let ((overlays (overlays-at (or point (point)))))
+ (while (and overlays
+ (null (overlay-get (car overlays) 'semantic-spp)))
+ (setq overlays (cdr overlays)))
+ (car-safe overlays)))
+
;;; Macro Merging
;;
;; Used when token streams from different macros include each other.
@@ -824,8 +920,46 @@ STR occurs in the current buffer between BEG and END."
"\\(\\sw\\|\\s_\\)+"
(let ((str (match-string 0))
(beg (match-beginning 0))
- (end (match-end 0)))
- (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)))
+ (end (match-end 0))
+ sppov)
+ (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)
+ (when (setq sppov (semantic-lex-spp-get-overlay beg))
+ (setq semantic-lex-end-point (cdr (overlay-get sppov 'semantic-spp))))))
+
+(define-lex-regex-analyzer semantic-lex-spp-paren-or-list
+ "Detect open parenthesis.
+Contrary to `semantic-lex-paren-or-list', this will push a single
+open-paren onto the stream if no closing paren can be found.
+This is important for macros which open a scope which is closed
+by another macro."
+ "\\s("
+ (if (or (not semantic-lex-maximum-depth)
+ (< semantic-lex-current-depth semantic-lex-maximum-depth))
+ (progn
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'open-paren (match-beginning 0) (match-end 0))))
+ (save-excursion
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (peom (save-excursion (semantic-c-end-of-macro) (point))))
+ (condition-case nil
+ (progn
+ ;; This will throw an error if no closing paren can be found.
+ (forward-list 1)
+ (when (> (point) peom)
+ ;; If we have left the macro, this is the wrong closing
+ ;; paren, so error out as well.
+ (error ""))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'semantic-list start (point))))
+ (error
+ ;; Only push a single open-paren.
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'open-paren start end))))))))
;;; ANALYZERS FOR NEW MACROS
;;
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 13e858ca000..653f02d8e41 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -195,12 +195,18 @@ Use `semantic-ctxt-scoped-types' to find types."
;; Get this thing as a tag
(let ((tmp (cond
((stringp (car sp))
- (semanticdb-typecache-find (car sp)))
- ;(semantic-analyze-find-tag (car sp) 'type))
+ (or (semanticdb-typecache-find (car sp))
+ ;; If we did not find it in the typecache,
+ ;; look in the tags we found so far
+ (car (semantic-deep-find-tags-by-name
+ (car sp)
+ code-scoped-types))))
((semantic-tag-p (car sp))
(if (semantic-tag-prototype-p (car sp))
- (semanticdb-typecache-find (semantic-tag-name (car sp)))
- ;;(semantic-analyze-find-tag (semantic-tag-name (car sp)) 'type)
+ (or (semanticdb-typecache-find (semantic-tag-name (car sp)))
+ (car (semantic-deep-find-tags-by-name
+ (semantic-tag-name (car sp))
+ code-scoped-types)))
(car sp)))
(t nil))))
(when tmp
@@ -506,10 +512,33 @@ tag is not something you can complete from within TYPE."
(leftover nil)
)
(dolist (S allslots)
- (when (or (not (semantic-tag-of-class-p S 'function))
- (not (semantic-tag-function-parent S)))
- (setq leftover (cons S leftover)))
- )
+ ;; We have to specially deal with 'using' tags here, since those
+ ;; pull in namespaces or classes into the current scope.
+ ;; (Should this go into c.el? If so, into which override?)
+ (if (semantic-tag-of-class-p S 'using)
+ (let* ((fullname (semantic-analyze-unsplit-name
+ (list (semantic-tag-name type)
+ (semantic-tag-name S))))
+ ;; Search the typecache, first for the unqualified name
+ (usingtype (or
+ (semanticdb-typecache-find (semantic-tag-name S))
+ ;; If that didn't return anything, use
+ ;; fully qualified name
+ (semanticdb-typecache-find fullname)))
+ (filename (when usingtype (semantic-tag-file-name usingtype))))
+ (when usingtype
+ ;; Use recursion to examine that namespace or class
+ (let ((tags (semantic-completable-tags-from-type usingtype)))
+ (if filename
+ ;; If we have a filename, copy the tags with it
+ (dolist (cur tags)
+ (setq leftover (cons (semantic-tag-copy cur nil filename)
+ leftover)))
+ ;; Otherwise just run with it
+ (setq leftover (append tags leftover))))))
+ (when (or (not (semantic-tag-of-class-p S 'function))
+ (not (semantic-tag-function-parent S)))
+ (setq leftover (cons S leftover)))))
(nreverse leftover)))
(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
@@ -734,8 +763,9 @@ The class returned from the scope calculation is variable
(when (called-interactively-p 'any)
(require 'eieio-datadebug)
(data-debug-show scopecache))
- ;; Return ourselves
- scopecache))))
+ ;; Return ourselves, but make a clone first so that the caller
+ ;; can reset the scope cache without affecting others.
+ (clone scopecache)))))
(defun semantic-scope-find (name &optional class scope-in)
"Find the tag with NAME, and optional CLASS in the current SCOPE-IN.
View Lorry Controller Status