;;; semantic/tag.el --- tag creation and access
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
-;; 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2016 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
(declare-function semantic-analyze-split-name "semantic/analyze/fcn")
(declare-function semantic-fetch-tags "semantic")
(declare-function semantic-clear-toplevel-cache "semantic")
+(declare-function semantic-tag-similar-p "semantic/tag-ls")
(defconst semantic-tag-version "2.0"
"Version string of semantic tags made with this code.")
(defsubst semantic-tag-class (tag)
"Return the class of TAG.
-That is, the symbol 'variable, 'function, 'type, or other.
+This is a symbol like `variable', `function', or `type'.
There is no limit to the symbols that may represent the class of a tag.
Each parser generates tags with classes defined by it.
(semantic--tag-set-overlay tag (vector start end)))))
(defun semantic-tag-in-buffer-p (tag)
- "Return the buffer TAG resides in IFF tag is already in a buffer.
+ "Return the buffer TAG resides in, if tag is already in a buffer.
If a tag is not in a buffer, return nil."
(let ((o (semantic-tag-overlay tag)))
;; TAG is currently linked to a buffer, return it.
(equal (semantic-tag-bounds tag1)
(semantic-tag-bounds tag2))))))
-(defun semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes)
- "Test to see if TAG1 and TAG2 are similar.
-Two tags are similar if their name, datatype, and various attributes
-are the same.
-
-Similar tags that have sub-tags such as arg lists or type members,
-are similar w/out checking the sub-list of tags.
-Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity."
- (let* ((A1 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
- (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
- (semantic-tag-of-type-p tag1 (semantic-tag-type tag2))))
- (attr1 (semantic-tag-attributes tag1))
- (A2 (= (length attr1) (length (semantic-tag-attributes tag2))))
- (A3 t)
- )
- (when (and (not A2) ignorable-attributes)
- (setq A2 t))
- (while (and A2 attr1 A3)
- (let ((a (car attr1))
- (v (car (cdr attr1))))
-
- (cond ((or (eq a :type) ;; already tested above.
- (memq a ignorable-attributes)) ;; Ignore them...
- nil)
-
- ;; Don't test sublists of tags
- ((and (listp v) (semantic-tag-p (car v)))
- nil)
-
- ;; The attributes are not the same?
- ((not (equal v (semantic-tag-get-attribute tag2 a)))
- (setq A3 nil))
- (t
- nil))
- )
- (setq attr1 (cdr (cdr attr1))))
-
- (and A1 A2 A3)
- ))
(defun semantic-tag-similar-with-subtags-p (tag1 tag2 &rest ignorable-attributes)
"Test to see if TAG1 and TAG2 are similar.
as argument lists and type members.
Optional argument IGNORABLE-ATTRIBUTES is passed down to
`semantic-tag-similar-p'."
- (let ((C1 (semantic-tag-components tag1))
- (C2 (semantic-tag-components tag2))
- )
- (if (or (/= (length C1) (length C2))
- (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes))
- )
- ;; Basic test fails.
- nil
- ;; Else, check component lists.
- (catch 'component-dissimilar
- (while C1
-
- (if (not (semantic-tag-similar-with-subtags-p
- (car C1) (car C2) ignorable-attributes))
- (throw 'component-dissimilar nil))
-
- (setq C1 (cdr C1))
- (setq C2 (cdr C2))
- )
- ;; If we made it this far, we are ok.
- t) )))
-
+ ;; DEPRECATE THIS.
+ (semantic-tag-similar-p tag1 tag2 ignorable-attributes))
(defun semantic-tag-of-type-p (tag type)
"Compare TAG's type against TYPE. Non nil if equivalent.
-TYPE can be a string, or a tag of class 'type.
+TYPE can be a string, or a tag of class `type'.
This can be complex since some tags might have a :type that is a tag,
while other tags might just have a string. This function will also be
return true of TAG's type is compared directly to the declaration of a
"Create a generic semantic tag.
NAME is a string representing the name of this tag.
CLASS is the symbol that represents the class of tag this is,
-such as 'variable, or 'function.
+such as `variable', or `function'.
ATTRIBUTES is a list of additional attributes belonging to this tag."
(list name class (semantic-tag-make-plist attributes) nil nil))
(defsubst semantic-tag-new-variable (name type &optional default-value &rest attributes)
- "Create a semantic tag of class 'variable.
+ "Create a semantic tag of class `variable'.
NAME is the name of this variable.
TYPE is a string or semantic tag representing the type of this variable.
Optional DEFAULT-VALUE is a string representing the default value of this
attributes))
(defsubst semantic-tag-new-function (name type arg-list &rest attributes)
- "Create a semantic tag of class 'function.
+ "Create a semantic tag of class `function'.
NAME is the name of this function.
TYPE is a string or semantic tag representing the type of this function.
ARG-LIST is a list of strings or semantic tags representing the
attributes))
(defsubst semantic-tag-new-type (name type members parents &rest attributes)
- "Create a semantic tag of class 'type.
+ "Create a semantic tag of class `type'.
NAME is the name of this type.
TYPE is a string or semantic tag representing the type of this type.
MEMBERS is a list of strings or semantic tags representing the
attributes))
(defsubst semantic-tag-new-include (name system-flag &rest attributes)
- "Create a semantic tag of class 'include.
+ "Create a semantic tag of class `include'.
NAME is the name of this include.
SYSTEM-FLAG represents that we were able to identify this include as belonging
to the system, as opposed to belonging to the local project.
attributes))
(defsubst semantic-tag-new-package (name detail &rest attributes)
- "Create a semantic tag of class 'package.
+ "Create a semantic tag of class `package'.
NAME is the name of this package.
DETAIL is extra information about this package, such as a location where
it can be found.
attributes))
(defsubst semantic-tag-new-code (name detail &rest attributes)
- "Create a semantic tag of class 'code.
+ "Create a semantic tag of class `code'.
NAME is a name for this code.
DETAIL is extra information about the code.
ATTRIBUTES is a list of additional attributes belonging to this tag."
"Set TAG name to NAME."
(setcar tag name))
+;;; TAG Proxies
+;;
+;; A new kind of tag is a TAG PROXY. These are tags that have some
+;; minimal number of features set, such as name and class, but have a
+;; marker in them that indicates how to complete them.
+;;
+;; To make the tags easier to view, the proxy is stored as custom
+;; symbol that is not in the global obarray, but has properties set on
+;; it. This prevents saving of massive amounts of proxy data.
+(defun semantic-create-tag-proxy (function data)
+ "Create a tag proxy symbol.
+FUNCTION will be used to resolve the proxy. It should take 3
+two arguments, DATA and TAG. TAG is a proxy tag that needs
+to be resolved, and DATA is the DATA passed into this function.
+DATA is data to help resolve the proxy. DATA can be an EIEIO object,
+such that FUNCTION is a method.
+FUNCTION should return a list of tags, preferably one tag."
+ (let ((sym (make-symbol ":tag-proxy")))
+ (put sym 'proxy-function function)
+ (put sym 'proxy-data data)
+ sym))
+
+(defun semantic-tag-set-proxy (tag proxy &optional filename)
+ "Set TAG to be a proxy. The proxy can be resolved with PROXY.
+This function will also make TAG be a faux tag with
+`semantic-tag-set-faux', and possibly set the tag's
+:filename with FILENAME.
+To create a proxy, see `semantic-create-tag-proxy'."
+ (semantic-tag-set-faux tag)
+ (semantic--tag-put-property tag :proxy proxy)
+ (when filename
+ (semantic--tag-put-property tag :filename filename)))
+
+(defun semantic-tag-resolve-proxy (tag)
+ "Resolve the proxy in TAG.
+The return value is whatever format the proxy was setup as.
+It should be a list of complete tags.
+If TAG has no proxy, then just return tag."
+ (let* ((proxy (semantic--tag-get-property tag :proxy))
+ (function (get proxy 'proxy-function))
+ (data (get proxy 'proxy-data)))
+ (if proxy
+ (funcall function data tag)
+ tag)))
+
;;; Copying and cloning tags.
;;
(defsubst semantic-tag-clone (tag &optional name)
property of the copied tag.
If KEEP-FILE is a string, and the originating buffer is NOT available,
then KEEP-FILE is stored on the `:filename' property.
-This runs the tag hook `unlink-copy-hook`."
+This runs the tag hook `unlink-copy-hook'."
;; Right now, TAG is a list.
(let ((copy (semantic-tag-clone tag name)))
(defun semantic-tag-type-superclass-protection (tag parentstring)
"Return the inheritance protection in TAG from PARENTSTRING.
PARENTSTRING is the name of the parent being inherited.
-The return protection is a symbol, 'public, 'protection, and 'private."
+The return protection is a symbol, `public', `protection', and `private'."
(let ((supers (semantic-tag-get-attribute tag :superclasses)))
(cond ((stringp supers)
'public)
"Return a filename representation of TAG.
The default action is to return the `semantic-tag-name'.
Some languages do not use full filenames in their include statements.
-Override this method to translate the code represenation
+Override this method to translate the code representation
into a filename. (A relative filename if necessary.)
See `semantic-dependency-tag-file' to expand an include
The returned value is a tag of the class that
`semantic-tag-alias-class' returns for TAG.
The default is to return the value of the :definition attribute.
-Return nil if TAG is not of class 'alias."
+Return nil if TAG is not of class `alias'."
(when (semantic-tag-of-class-p tag 'alias)
(:override
(semantic-tag-get-attribute tag :definition))))
"Return a list of components for TAG.
A Component is a part of TAG which itself may be a TAG.
Examples include the elements of a structure in a
-tag of class `type, or the list of arguments to a
-tag of class 'function."
+tag of class `type', or the list of arguments to a
+tag of class `function'."
)
(defun semantic-tag-components-default (tag)
(semantic-tag-components-with-overlays tag)))))
(defun semantic--tag-unlink-cache-from-buffer ()
- "Convert all tags in the current cache to use overlay proxys.
+ "Convert all tags in the current cache to use overlay proxies.
This function is for internal use only."
(require 'semantic)
(semantic--tag-unlink-list-from-buffer
The parser returns raw tags with positional data START END at the
end of the tag data structure (a list for now). We convert it from
that to a cooked state that uses an overlay proxy, that is, a vector
-\[START END].
+[START END].
The raw tag is changed with side effects and maybe expanded in
several derived tags when the variable `semantic-tag-expand-function'
interfaces, or abstract classes which are parents of TAG."
(cons (semantic-tag-get-attribute tag :superclasses)
(semantic-tag-type-interfaces tag)))
+
(make-obsolete 'semantic-token-type-parent
"\
use `semantic-tag-type-superclass' \