-;;; tag.el --- tag creation and access
+;;; 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, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
+;; 2009, 2010, 2011 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:
;;
(require 'semantic/fw)
(require 'semantic/lex)
-(declare-function semantic-current-tag "semantic/find")
-(declare-function semantic-find-first-tag-by-name "semantic/find")
-(declare-function semantic-ctxt-current-mode "semantic/ctxt")
(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-documentation-for-tag "semantic/doc")
-(declare-function semantic-format-tag-prototype "semantic/format")
-(declare-function semantic-format-tag-summarize "semantic/format")
-(declare-function semantic-format-tag-name "semantic/format")
-(defconst semantic-tag-version semantic-version
+(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
;; 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.
))))
If point is inside TAG bounds, return the major mode active at point.
Return the major mode active at beginning of TAG otherwise.
See also the function `semantic-ctxt-current-mode'."
- (require 'semantic/find)
(or tag (setq tag (semantic-current-tag)))
(or (semantic--tag-get-property tag :mode)
(let ((buffer (semantic-tag-buffer 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
"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
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))
"Find the superclass NAME in the list of SUPERS.
If a simple search doesn't do it, try splitting up the names
in SUPERS."
- (require 'semantic/find)
(let ((stag nil))
(setq stag (semantic-find-first-tag-by-name name 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)
;;; Language Specific Tag access via overload
;;
+;;;###autoload
(define-overloadable-function semantic-tag-components (tag)
"Return a list of components for TAG.
A Component is a part of TAG which itself may be a TAG.
"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.
(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)
"Return a copy of TAG as a foreign tag, or nil if it can't be done.
TAG defaults to the tag at point in current buffer.
See also `semantic-foreign-tag-p'."
- (require 'semantic/doc)
(or tag (setq tag (semantic-current-tag)))
(when (semantic-tag-p tag)
(let ((ftag (semantic-tag-copy tag nil t))
and attempts to insert a prototype/function call."
;; Long term goal: Have a mechanism for a tempo-like template insert
;; for the given tag.
- (require 'semantic/format)
(insert (semantic-format-tag-prototype foreign-tag)))
(define-overloadable-function semantic-insert-foreign-tag (foreign-tag)
"Insert FOREIGN-TAG into the current buffer.
Signal an error if FOREIGN-TAG is not a valid foreign tag.
This function is overridable with the symbol `insert-foreign-tag'."
- (require 'semantic/format)
(semantic-foreign-tag-check foreign-tag)
(:override)
(message (semantic-format-tag-summarize foreign-tag)))
(define-mode-local-override semantic-insert-foreign-tag
log-edit-mode (foreign-tag)
"Insert foreign tags into log-edit mode."
- (require 'semantic/format)
(insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
(define-mode-local-override semantic-insert-foreign-tag
change-log-mode (foreign-tag)
"Insert foreign tags into log-edit mode."
- (require 'semantic/format)
(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.
(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)
-;;; semantic-tag.el ends here
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "semantic/tag"
+;; End:
+
+;;; semantic/tag.el ends here