;;; semantic/tag.el --- tag creation and access
-;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
-;;; 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; II. There is also an API for tag creation. Use `semantic-tag' to create
;; a new tag.
;;
-;; III. Tag Comparison. Allows explicit or comparitive tests to see
+;; III. Tag Comparison. Allows explicit or comparative tests to see
;; if two tags are the same.
-;;; History:
-;;
-
;;; Code:
;;
(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.0pre7"
+(defconst semantic-tag-version "2.0"
"Version string of semantic tags made with this code.")
(defconst semantic-tag-incompatible-version "1.0"
@item include
Statement that represents a file from which more tags can be found.
@item package
-Statement that declairs this file's package name.
+Statement that declares this file's package name.
@item code
Code that has not name or binding to any other symbol, such as in a script.
@end table
(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.
;; TAG has an originating file, read that file into a buffer, and
;; return it.
(if (semantic--tag-get-property tag :filename)
- (find-file-noselect (semantic--tag-get-property tag :filename))
+ (save-match-data
+ (find-file-noselect (semantic--tag-get-property tag :filename)))
;; TAG is not in Emacs right now, no buffer is available.
))))
;; beginning of TAG.
(or (and (>= (point) start) (< (point) end))
(goto-char start))
+ (require 'semantic/ctxt)
(semantic-ctxt-current-mode)))))
(defsubst semantic--tag-attributes-cdr (tag)
That is the value of the `:members' attribute."
(semantic-tag-get-attribute tag :members))
+(defsubst semantic-tag-type (tag)
+ "Return the value of the `:type' attribute of TAG.
+For a function it would be the data type of the return value.
+For a variable, it is the storage type of that variable.
+For a data type, the type is the style of datatype, such as
+struct or union."
+ (semantic-tag-get-attribute tag :type))
+
(defun semantic-tag-with-position-p (tag)
"Return non-nil if TAG has positional information."
(and (semantic-tag-p tag)
(equal (semantic-tag-bounds tag1)
(semantic-tag-bounds tag2))))))
-(defsubst semantic-tag-type (tag)
- "Return the value of the `:type' attribute of TAG.
-For a function it would be the data type of the return value.
-For a variable, it is the storage type of that variable.
-For a data type, the type is the style of datatype, such as
-struct or union."
- (semantic-tag-get-attribute tag :type))
-
-(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.
"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 variable.
-ATTRIBUTES is a list of additional attributes belonging to this tag."
+Optional DEFAULT-VALUE is a string representing the default value of this
+variable. ATTRIBUTES is a list of additional attributes belonging to this
+tag."
(apply 'semantic-tag name 'variable
:type type
:default-value default-value
"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)
If optional argument KEEP-FILE is non-nil, and TAG was linked to a
buffer, the originating buffer file name is kept in the `:filename'
property of the copied tag.
-If KEEP-FILE is a string, and the orginating buffer is NOT available,
+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`."
;; Right now, TAG is a list.
;;
(defun semantic-tag-deep-copy-one-tag (tag &optional filter)
"Make a deep copy of TAG, applying FILTER to each child-tag.
-Properties and overlay info are not copied.
-FILTER takes TAG as an argument, and should returns a semantic-tag.
+No properties are copied except for :filename.
+Overlay will be a vector.
+FILTER takes TAG as an argument, and should return a `semantic-tag'.
It is safe for FILTER to modify the input tag and return it."
(when (not filter) (setq filter 'identity))
(when (not (semantic-tag-p tag))
(signal 'wrong-type-argument (list tag 'semantic-tag-p)))
- (funcall filter (list (semantic-tag-name tag)
- (semantic-tag-class tag)
- (semantic--tag-deep-copy-attributes
- (semantic-tag-attributes tag) filter)
- nil
- nil)))
+ (let ((ol (semantic-tag-overlay tag))
+ (fn (semantic-tag-file-name tag)))
+ (funcall filter (list (semantic-tag-name tag)
+ (semantic-tag-class tag)
+ (semantic--tag-deep-copy-attributes
+ (semantic-tag-attributes tag) filter)
+ ;; Only copy the filename property
+ (when fn (list :filename fn))
+ ;; Only setup a vector if we had an overlay.
+ (when ol (vector (semantic-tag-start tag)
+ (semantic-tag-end tag)))))))
(defun semantic--tag-deep-copy-attributes (attrs &optional filter)
"Make a deep copy of ATTRS, applying FILTER to each child-tag.
-It is safe to modify ATTR, and return a permutaion of that list.
+It is safe to modify ATTR, and return a permutation of that list.
FILTER takes TAG as an argument, and should returns a semantic-tag.
It is safe for FILTER to modify the input tag and return it."
(defun semantic--tag-deep-copy-value (value &optional filter)
"Make a deep copy of VALUE, applying FILTER to each child-tag.
-It is safe to modify VALUE, and return a permutaion of that list.
+It is safe to modify VALUE, and return a permutation of that list.
FILTER takes TAG as an argument, and should returns a semantic-tag.
It is safe for FILTER to modify the input tag and return it."
(defun semantic--tag-deep-copy-tag-list (tags &optional filter)
"Make a deep copy of TAGS, applying FILTER to each child-tag.
-It is safe to modify the TAGS list, and return a permutaion of that list.
+It is safe to modify the TAGS list, and return a permutation of that list.
FILTER takes TAG as an argument, and should returns a semantic-tag.
It is safe for FILTER to modify the input tag and return it."
;;; Common
;;
-
(defsubst semantic-tag-modifiers (tag)
"Return the value of the `:typemodifiers' attribute of TAG."
(semantic-tag-get-attribute tag :typemodifiers))
in SUPERS."
(let ((stag nil))
(setq stag (semantic-find-first-tag-by-name name supers))
+
(when (not stag)
(require 'semantic/analyze/fcn)
(dolist (S supers)
"Return the parent of the function that TAG describes.
That is the value of the `:parent' attribute.
A function has a parent if it is a method of a class, and if the
-function does not appear in body of it's parent class."
+function does not appear in body of its parent class."
(semantic-tag-named-parent tag))
(defsubst semantic-tag-function-destructor-p (tag)
"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
"Return the list of top level components belonging to TAG.
Children are any sub-tags which contain overlays.
The default action collects regular components of TAG, in addition
-to any components beloning to an anonymous type."
+to any components belonging to an anonymous type."
(let ((explicit-children (semantic-tag-components tag))
(type (semantic-tag-type tag))
(anon-type-children nil)
;; Overlays are used so that we can quickly identify tags from
;; buffer positions and regions using built in Emacs commands.
;;
-
(defsubst semantic--tag-unlink-list-from-buffer (tags)
"Convert TAGS from using an overlay to using an overlay proxy.
This function is for internal use only."
(defsubst semantic--tag-link-list-to-buffer (tags)
"Convert TAGS from using an overlay proxy to using an overlay.
This function is for internal use only."
- (mapcar 'semantic--tag-link-to-buffer tags))
+ (mapc 'semantic--tag-link-to-buffer tags))
(defun semantic--tag-link-to-buffer (tag)
"Convert TAG from using an overlay proxy to using an overlay.
(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
(message "A Rule must return a single tag-line list!")
(debug tag)
nil))
-
-;; @todo - I think we've waited long enough. Lets find out.
-;;
-;; ;; Compatibility code to be removed in future versions.
-;; (unless semantic-tag-expand-function
-;; ;; This line throws a byte compiler warning.
-;; (setq semantic-tag-expand-function semantic-expand-nonterminal)
-;; )
-
;; Expand based on local configuration
(if semantic-tag-expand-function
(or (funcall semantic-tag-expand-function tag)
change-log-mode (foreign-tag)
"Insert foreign tags into log-edit mode."
(insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
-
-\f
-;;; EDEBUG display support
-;;
-(eval-after-load "cedet-edebug"
- '(progn
- (cedet-edebug-add-print-override
- '(semantic-tag-p object)
- '(concat "#<TAG " (semantic-format-tag-name object) ">"))
- (cedet-edebug-add-print-override
- '(and (listp object) (semantic-tag-p (car object)))
- '(cedet-edebug-prin1-recurse object))
- ))
\f
;;; Compatibility
;;
(defconst semantic-token-incompatible-version
semantic-tag-incompatible-version)
-(semantic-alias-obsolete 'semantic-token-name
- 'semantic-tag-name)
-
-(semantic-alias-obsolete 'semantic-token-token
- 'semantic-tag-class)
-
-(semantic-alias-obsolete 'semantic-token-extra-specs
- 'semantic-tag-attributes)
-
-(semantic-alias-obsolete 'semantic-token-properties
- 'semantic-tag-properties)
-
-(semantic-alias-obsolete 'semantic-token-properties-cdr
- 'semantic--tag-properties-cdr)
-
-(semantic-alias-obsolete 'semantic-token-overlay
- 'semantic-tag-overlay)
-
-(semantic-alias-obsolete 'semantic-token-overlay-cdr
- 'semantic--tag-overlay-cdr)
-
-(semantic-alias-obsolete 'semantic-token-start
- 'semantic-tag-start)
-
-(semantic-alias-obsolete 'semantic-token-end
- 'semantic-tag-end)
-
-(semantic-alias-obsolete 'semantic-token-extent
- 'semantic-tag-bounds)
-
-(semantic-alias-obsolete 'semantic-token-buffer
- 'semantic-tag-buffer)
-
-(semantic-alias-obsolete 'semantic-token-put
- 'semantic--tag-put-property)
-
-(semantic-alias-obsolete 'semantic-token-put-no-side-effect
- 'semantic--tag-put-property-no-side-effect)
-
-(semantic-alias-obsolete 'semantic-token-get
- 'semantic--tag-get-property)
-
-(semantic-alias-obsolete 'semantic-token-add-extra-spec
- 'semantic-tag-put-attribute)
-
-(semantic-alias-obsolete 'semantic-token-extra-spec
- 'semantic-tag-get-attribute)
-
-(semantic-alias-obsolete 'semantic-token-type
- 'semantic-tag-type)
-
-(semantic-alias-obsolete 'semantic-token-modifiers
- 'semantic-tag-modifiers)
-
-(semantic-alias-obsolete 'semantic-token-docstring
- 'semantic-tag-docstring)
-
-(semantic-alias-obsolete 'semantic-token-type-parts
- 'semantic-tag-type-members)
-
(defsubst semantic-token-type-parent (tag)
"Return the parent of the type that TAG describes.
The return value is a list. A value of nil means no parents.
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' \
-and `semantic-tag-type-interfaces' instead")
-
-(semantic-alias-obsolete 'semantic-token-type-parent-superclass
- 'semantic-tag-type-superclasses)
-
-(semantic-alias-obsolete 'semantic-token-type-parent-implement
- 'semantic-tag-type-interfaces)
-
-(semantic-alias-obsolete 'semantic-token-type-extra-specs
- 'semantic-tag-attributes)
-
-(semantic-alias-obsolete 'semantic-token-type-extra-spec
- 'semantic-tag-get-attribute)
-
-(semantic-alias-obsolete 'semantic-token-type-modifiers
- 'semantic-tag-modifiers)
-
-(semantic-alias-obsolete 'semantic-token-function-args
- 'semantic-tag-function-arguments)
-
-(semantic-alias-obsolete 'semantic-token-function-extra-specs
- 'semantic-tag-attributes)
-
-(semantic-alias-obsolete 'semantic-token-function-extra-spec
- 'semantic-tag-get-attribute)
-
-(semantic-alias-obsolete 'semantic-token-function-modifiers
- 'semantic-tag-modifiers)
-
-(semantic-alias-obsolete 'semantic-token-function-throws
- 'semantic-tag-function-throws)
-
-(semantic-alias-obsolete 'semantic-token-function-parent
- 'semantic-tag-function-parent)
-
-(semantic-alias-obsolete 'semantic-token-function-destructor
- 'semantic-tag-function-destructor-p)
-
-(semantic-alias-obsolete 'semantic-token-variable-default
- 'semantic-tag-variable-default)
-
-(semantic-alias-obsolete 'semantic-token-variable-extra-specs
- 'semantic-tag-attributes)
-
-(semantic-alias-obsolete 'semantic-token-variable-extra-spec
- 'semantic-tag-get-attribute)
-
-(semantic-alias-obsolete 'semantic-token-variable-modifiers
- 'semantic-tag-modifiers)
-
-(semantic-alias-obsolete 'semantic-token-variable-const
- 'semantic-tag-variable-constant-p)
-
-(semantic-alias-obsolete 'semantic-token-variable-optsuffix
- 'semantic-tag-variable-optsuffix)
-
-(semantic-alias-obsolete 'semantic-token-include-system
- 'semantic-tag-include-system-p)
-
-(semantic-alias-obsolete 'semantic-token-p
- 'semantic-tag-p)
-
-(semantic-alias-obsolete 'semantic-token-with-position-p
- 'semantic-tag-with-position-p)
+and `semantic-tag-type-interfaces' instead" "23.2")
(semantic-alias-obsolete 'semantic-tag-make-assoc-list
- 'semantic-tag-make-plist)
-
-(semantic-alias-obsolete 'semantic-nonterminal-children
- 'semantic-tag-children-compatibility)
-
-(semantic-alias-obsolete 'semantic-narrow-to-token
- 'semantic-narrow-to-tag)
-
-(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token
- 'semantic-with-buffer-narrowed-to-current-tag)
-
-(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token
- 'semantic-with-buffer-narrowed-to-tag)
-
-(semantic-alias-obsolete 'semantic-deoverlay-token
- 'semantic--tag-unlink-from-buffer)
-
-(semantic-alias-obsolete 'semantic-overlay-token
- 'semantic--tag-link-to-buffer)
-
-(semantic-alias-obsolete 'semantic-deoverlay-list
- 'semantic--tag-unlink-list-from-buffer)
-
-(semantic-alias-obsolete 'semantic-overlay-list
- 'semantic--tag-link-list-to-buffer)
-
-(semantic-alias-obsolete 'semantic-deoverlay-cache
- 'semantic--tag-unlink-cache-from-buffer)
-
-(semantic-alias-obsolete 'semantic-overlay-cache
- 'semantic--tag-link-cache-to-buffer)
-
-(semantic-alias-obsolete 'semantic-cooked-token-p
- 'semantic--tag-expanded-p)
+ 'semantic-tag-make-plist "23.2")
(semantic-varalias-obsolete 'semantic-expand-nonterminal
- 'semantic-tag-expand-function)
-
-(semantic-alias-obsolete 'semantic-raw-to-cooked-token
- 'semantic--tag-expand)
-
-;; Lets test this out during this short transition.
-(semantic-alias-obsolete 'semantic-clone-tag
- 'semantic-tag-clone)
-
-(semantic-alias-obsolete 'semantic-token
- 'semantic-tag)
-
-(semantic-alias-obsolete 'semantic-token-new-variable
- 'semantic-tag-new-variable)
-
-(semantic-alias-obsolete 'semantic-token-new-function
- 'semantic-tag-new-function)
-
-(semantic-alias-obsolete 'semantic-token-new-type
- 'semantic-tag-new-type)
-
-(semantic-alias-obsolete 'semantic-token-new-include
- 'semantic-tag-new-include)
-
-(semantic-alias-obsolete 'semantic-token-new-package
- 'semantic-tag-new-package)
-
-(semantic-alias-obsolete 'semantic-equivalent-tokens-p
- 'semantic-equivalent-tag-p)
+ 'semantic-tag-expand-function "23.2")
(provide 'semantic/tag)
;; Local variables:
;; generated-autoload-file: "loaddefs.el"
-;; generated-autoload-feature: semantic/loaddefs
;; generated-autoload-load-name: "semantic/tag"
;; End: