;;; semantic/analyze.el --- Analyze semantic tags against local context
-;; Copyright (C) 2000-2005, 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;;
;; context - A semantic datatype representing a point in a buffer.
;;
-;; constriant - If a context specifies a specific datatype is needed,
+;; constraint - If a context specifies a specific datatype is needed,
;; that is a constraint.
;; constants - Some datatypes define elements of themselves as a
;; constant. These need to be returned as there would be no
(prefixclass :initarg :prefixclass
:type list
:documentation "Tag classes expected at this context.
-These are clases for tags, such as 'function, or 'variable.")
+These are classes for tags, such as 'function, or 'variable.")
(prefixtypes :initarg :prefixtypes
:type list
:documentation "List of tags defining types for :prefix.
(defclass semantic-analyze-context-return (semantic-analyze-context)
() ; No extra data.
"Analysis class for return data.
-Return data methods identify the requred type by the return value
+Return data methods identify the required type by the return value
of the parent function.")
;;; METHODS
;; by an application that doesn't need to calculate the full
;; context.
-(define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional
- scope typereturn throwsym)
+(define-overloadable-function semantic-analyze-find-tag-sequence
+ (sequence &optional scope typereturn throwsym &rest flags)
"Attempt to find all tags in SEQUENCE.
Optional argument LOCALVAR is the list of local variables to use when
finding the details on the first element of SEQUENCE in case
which doesn't need to be dereferenced.
Optional argument TYPERETURN is a symbol in which the types of all found
will be stored. If nil, that data is thrown away.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.")
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.")
-(defun semantic-analyze-find-tag-sequence-default (sequence &optional
- scope typereturn
- throwsym)
+(defun semantic-analyze-find-tag-sequence-default
+ ;; Note: overloadable fcn uses &rest, but it is a list already, so we don't need
+ ;; to do that in the -default.
+ (sequence &optional scope typereturn throwsym flags)
"Attempt to find all tags in SEQUENCE.
SCOPE are extra tags which are in scope.
TYPERETURN is a symbol in which to place a list of tag classes that
are found in SEQUENCE.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error."
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.
+This function knows of flags:
+ 'mustbeclassvariable"
(let ((s sequence) ; copy of the sequence
(tmp nil) ; tmp find variable
(tag nil) ; tag return list
(tagtype nil) ; tag types return list
(fname nil)
(miniscope (when scope (clone scope)))
+ (tagclass (if (memq 'mustbeclassvariable flags)
+ 'variable nil))
)
- ;; First order check. Is this wholely contained in the typecache?
+ ;; First order check. Is this wholly contained in the typecache?
(setq tmp (semanticdb-typecache-find sequence))
-
- (if tmp
- (progn
+
+ (when tmp
+ (if (or (not tagclass) (semantic-tag-of-class-p tmp tagclass))
;; We are effectively done...
- (setq s nil)
- (setq tag (list tmp)))
-
- ;; For the first entry, it better be a variable, but it might
- ;; be in the local context too.
- ;; NOTE: Don't forget c++ namespace foo::bar.
- (setq tmp (or
- ;; Is this tag within our scope. Scopes can sometimes
- ;; shadow other things, so it goes first.
- (and scope (semantic-scope-find (car s) nil scope))
- ;; Find the tag out there... somewhere, but not in scope
- (semantic-analyze-find-tag (car s))
- ))
-
- (if (and (listp tmp) (semantic-tag-p (car tmp)))
- (setq tmp (semantic-analyze-select-best-tag tmp)))
- (if (not (semantic-tag-p tmp))
- (if throwsym
- (throw throwsym "Cannot find definition")
- (error "Cannot find definition for \"%s\"" (car s))))
- (setq s (cdr s))
- (setq tag (cons tmp tag)) ; tag is nil here...
- (setq fname (semantic-tag-file-name tmp))
- )
+ (setq s nil
+ tag (list tmp))
+ ;; tagclass doesn't match, so fail this.
+ (setq tmp nil)))
+
+ (unless tmp
+ ;; For tag class filtering, only apply the filter if the first entry
+ ;; is also the only entry.
+ (let ((lftagclass (if (= (length s) 1) tagclass)))
+
+ ;; For the first entry, it better be a variable, but it might
+ ;; be in the local context too.
+ ;; NOTE: Don't forget c++ namespace foo::bar.
+ (setq tmp (or
+ ;; Is this tag within our scope. Scopes can sometimes
+ ;; shadow other things, so it goes first.
+ (and scope (semantic-scope-find (car s) lftagclass scope))
+ ;; Find the tag out there... somewhere, but not in scope
+ (semantic-analyze-find-tag (car s) lftagclass)
+ ))
+
+ (if (and (listp tmp) (semantic-tag-p (car tmp)))
+ (setq tmp (semantic-analyze-select-best-tag tmp lftagclass)))
+ (if (not (semantic-tag-p tmp))
+ (if throwsym
+ (throw throwsym "Cannot find definition")
+ (error "Cannot find definition for \"%s\"" (car s))))
+ (setq s (cdr s))
+ (setq tag (cons tmp tag)) ; tag is nil here...
+ (setq fname (semantic-tag-file-name tmp))
+ ))
;; For the middle entries
(while s
- ;; Using the tag found in TMP, lets find the tag
+ ;; Using the tag found in TMP, let's find the tag
;; representing the full typeographic information of its
;; type, and use that to determine the search context for
;; (car s)
;; 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 analayze 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)))
(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)))
;; Search in the typecache. First entries in a sequence are
;; often there.
(setq retlist (semanticdb-typecache-find name))
- (if retlist
+ (if (and retlist (or (not tagclass)
+ (semantic-tag-of-class-p retlist 'tagclass)))
retlist
(semantic-analyze-select-best-tag
(semanticdb-strip-find-results
in a separate buffer.
Returns an object based on symbol `semantic-analyze-context'.
-This function can be overriden with the symbol `analyze-context'.
+This function can be overridden with the symbol `analyze-context'.
When overriding this function, your override will be called while
cursor is at POSITION. In addition, your function will not be called
if a cached copy of the return object is found."
(function nil)
(fntag nil)
arg fntagend argtag
- assign asstag
+ assign asstag newseq
)
;; Pattern for Analysis:
(if debug-on-error
(catch 'unfindable
- ;; If debug on error is on, allow debugging in this fcn.
(setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes 'unfindable)))
+ prefix scope 'prefixtypes 'unfindable))
+ ;; If there's an alias, dereference it and analyze
+ ;; sequence again.
+ (when (setq newseq
+ (semantic-analyze-dereference-alias prefix))
+ (setq prefix (semantic-analyze-find-tag-sequence
+ newseq scope 'prefixtypes 'unfindable))))
;; Debug on error is off. Capture errors and move on
(condition-case err
;; NOTE: This line is duplicated in
;; semantic-analyzer-debug-global-symbol
;; You will need to update both places.
- (setq prefix (semantic-analyze-find-tag-sequence
- prefix scope 'prefixtypes))
+ (progn
+ (setq prefix (semantic-analyze-find-tag-sequence
+ prefix scope 'prefixtypes))
+ (when (setq newseq
+ (semantic-analyze-dereference-alias prefix))
+ (setq prefix (semantic-analyze-find-tag-sequence
+ newseq scope 'prefixtypes))))
(error (semantic-analyze-push-error err))))
)
;; We have some sort of an assignment
(condition-case err
(setq asstag (semantic-analyze-find-tag-sequence
- assign scope))
+ assign scope nil nil 'mustbeclassvariable))
(error (semantic-analyze-push-error err)
nil)))
;; Return our context.
context-return))
+(defun semantic-analyze-dereference-alias (taglist)
+ "Dereference first tag in TAGLIST if it is an alias.
+Returns a sequence of names which can then be fed again into
+`semantic-analyze-find-tag-sequence'.
+Returns nil if no alias was found."
+ (when (eq (semantic-tag-get-attribute (car taglist) :kind) 'alias)
+ (let ((tagname
+ (semantic-analyze-split-name
+ (semantic-tag-name
+ (car (semantic-tag-get-attribute (car taglist) :members))))))
+ (append (if (listp tagname)
+ tagname
+ (list tagname))
+ (cdr taglist)))))
\f
(defun semantic-adebug-analyze (&optional ctxt)
"Perform `semantic-analyze-current-context'.
"Send the tag SEQUENCE to standard out.
Use PREFIX as a label.
Use BUFF as a source of override methods."
+ ;; If there is no sequence, at least show the field as being empty.
+ (unless sequence (princ prefix) (princ "<none>\n"))
+
+ ;; Display the sequence column aligned.
(while sequence
- (princ prefix)
- (cond
- ((semantic-tag-p (car sequence))
- (princ (funcall semantic-analyze-summary-function
- (car sequence))))
- ((stringp (car sequence))
- (princ "\"")
- (princ (semantic--format-colorize-text (car sequence) 'variable))
- (princ "\""))
- (t
- (princ (format "'%S" (car sequence)))))
- (princ "\n")
- (setq sequence (cdr sequence))
- (setq prefix (make-string (length prefix) ? ))
- ))
+ (princ prefix)
+ (cond
+ ((semantic-tag-p (car sequence))
+ (princ (funcall semantic-analyze-summary-function
+ (car sequence))))
+ ((stringp (car sequence))
+ (princ "\"")
+ (princ (semantic--format-colorize-text (car sequence) 'variable))
+ (princ "\""))
+ (t
+ (princ (format "'%S" (car sequence)))))
+ (princ "\n")
+ (setq sequence (cdr sequence))
+ (setq prefix (make-string (length prefix) ? ))
+ ))
(defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-pulse context)
(with-output-to-temp-buffer "*Semantic Context Analysis*"
(princ "Context Type: ")
- (princ (object-name context))
+ (princ (eieio-object-name context))
(princ "\n")
(princ "Bounds: ")
(princ (oref context bounds))