1 ;;; tag.el --- tag creation and access
3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
4 ;;; 2008, 2009 Free Software Foundation, Inc.
6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; I. The core production of semantic is the list of tags produced by the
26 ;; different parsers. This file provides 3 APIs related to tag access:
28 ;; 1) Primitive Tag Access
29 ;; There is a set of common features to all tags. These access
30 ;; functions can get these values.
31 ;; 2) Standard Tag Access
32 ;; A Standard Tag should be produced by most traditional languages
33 ;; with standard styles common to typed object oriented languages.
34 ;; These functions can access these data elements from a tag.
35 ;; 3) Generic Tag Access
36 ;; Access to tag structure in a more direct way.
37 ;; ** May not be forward compatible.
39 ;; II. There is also an API for tag creation. Use `semantic-tag' to create
42 ;; III. Tag Comparison. Allows explicit or comparitive tests to see
43 ;; if two tags are the same.
51 ;; Keep this only so long as we have obsolete fcns.
52 (require 'semantic
/fw
)
53 (require 'semantic
/lex
)
55 (declare-function semantic-current-tag
"semantic/find")
56 (declare-function semantic-find-first-tag-by-name
"semantic/find")
57 (declare-function semantic-ctxt-current-mode
"semantic/ctxt")
58 (declare-function semantic-analyze-split-name
"semantic/analyze/fcn")
59 (declare-function semantic-fetch-tags
"semantic")
60 (declare-function semantic-clear-toplevel-cache
"semantic")
61 (declare-function semantic-documentation-for-tag
"semantic/doc")
62 (declare-function semantic-format-tag-prototype
"semantic/format")
63 (declare-function semantic-format-tag-summarize
"semantic/format")
64 (declare-function semantic-format-tag-name
"semantic/format")
66 (defconst semantic-tag-version
"2.0pre7"
67 "Version string of semantic tags made with this code.")
69 (defconst semantic-tag-incompatible-version
"1.0"
70 "Version string of semantic tags which are not currently compatible.
71 These old style tags may be loaded from a file with semantic db.
72 In this case, we must flush the old tags and start over.")
74 ;;; Primitive Tag access system:
76 ;; Raw tags in semantic are lists of 5 elements:
78 ;; (NAME CLASS ATTRIBUTES PROPERTIES OVERLAY)
82 ;; - NAME is a string that represents the tag name.
84 ;; - CLASS is a symbol that represent the class of the tag (for
85 ;; example, usual classes are `type', `function', `variable',
86 ;; `include', `package', `code').
88 ;; - ATTRIBUTES is a public list of attributes that describes
89 ;; language data represented by the tag (for example, a variable
90 ;; can have a `:constant-flag' attribute, a function an `:arguments'
93 ;; - PROPERTIES is a private list of properties used internally.
95 ;; - OVERLAY represent the location of data described by the tag.
98 (defsubst semantic-tag-name
(tag)
99 "Return the name of TAG.
100 For functions, variables, classes, typedefs, etc., this is the identifier
101 that is being defined. For tags without an obvious associated name, this
102 may be the statement type, e.g., this may return @code{print} for python's
106 (defsubst semantic-tag-class
(tag)
107 "Return the class of TAG.
108 That is, the symbol 'variable, 'function, 'type, or other.
109 There is no limit to the symbols that may represent the class of a tag.
110 Each parser generates tags with classes defined by it.
112 For functional languages, typical tag classes are:
116 Data types, named map for a memory block.
118 A function or method, or named execution location.
120 A variable, or named storage for data.
122 Statement that represents a file from which more tags can be found.
124 Statement that declairs this file's package name.
126 Code that has not name or binding to any other symbol, such as in a script.
131 (defsubst semantic-tag-attributes
(tag)
132 "Return the list of public attributes of TAG.
133 That is a property list: (ATTRIBUTE-1 VALUE-1 ATTRIBUTE-2 VALUE-2...)."
136 (defsubst semantic-tag-properties
(tag)
137 "Return the list of private properties of TAG.
138 That is a property list: (PROPERTY-1 VALUE-1 PROPERTY-2 VALUE-2...)."
141 (defsubst semantic-tag-overlay
(tag)
142 "Return the OVERLAY part of TAG.
143 That is, an overlay or an unloaded buffer representation.
144 This function can also return an array of the form [ START END ].
145 This occurs for tags that are not currently linked into a buffer."
148 (defsubst semantic--tag-overlay-cdr
(tag)
149 "Return the cons cell whose car is the OVERLAY part of TAG.
150 That function is for internal use only."
153 (defsubst semantic--tag-set-overlay
(tag overlay
)
154 "Set the overlay part of TAG with OVERLAY.
155 That function is for internal use only."
156 (setcar (semantic--tag-overlay-cdr tag
) overlay
))
158 (defsubst semantic-tag-start
(tag)
159 "Return the start location of TAG."
160 (let ((o (semantic-tag-overlay tag
)))
161 (if (semantic-overlay-p o
)
162 (semantic-overlay-start o
)
165 (defsubst semantic-tag-end
(tag)
166 "Return the end location of TAG."
167 (let ((o (semantic-tag-overlay tag
)))
168 (if (semantic-overlay-p o
)
169 (semantic-overlay-end o
)
172 (defsubst semantic-tag-bounds
(tag)
173 "Return the location (START END) of data TAG describes."
174 (list (semantic-tag-start tag
)
175 (semantic-tag-end tag
)))
177 (defun semantic-tag-set-bounds (tag start end
)
178 "In TAG, set the START and END location of data it describes."
179 (let ((o (semantic-tag-overlay tag
)))
180 (if (semantic-overlay-p o
)
181 (semantic-overlay-move o start end
)
182 (semantic--tag-set-overlay tag
(vector start end
)))))
184 (defun semantic-tag-in-buffer-p (tag)
185 "Return the buffer TAG resides in IFF tag is already in a buffer.
186 If a tag is not in a buffer, return nil."
187 (let ((o (semantic-tag-overlay tag
)))
188 ;; TAG is currently linked to a buffer, return it.
189 (when (and (semantic-overlay-p o
)
190 (semantic-overlay-live-p o
))
191 (semantic-overlay-buffer o
))))
193 (defsubst semantic--tag-get-property
(tag property
)
194 "From TAG, extract the value of PROPERTY.
195 Return the value found, or nil if PROPERTY is not one of the
197 That function is for internal use only."
198 (plist-get (semantic-tag-properties tag
) property
))
200 (defun semantic-tag-buffer (tag)
201 "Return the buffer TAG resides in.
202 If TAG has an originating file, read that file into a (maybe new)
203 buffer, and return it.
204 Return nil if there is no buffer for this tag."
205 (let ((buff (semantic-tag-in-buffer-p tag
)))
208 ;; TAG has an originating file, read that file into a buffer, and
210 (if (semantic--tag-get-property tag
:filename
)
211 (find-file-noselect (semantic--tag-get-property tag
:filename
))
212 ;; TAG is not in Emacs right now, no buffer is available.
215 (defun semantic-tag-mode (&optional tag
)
216 "Return the major mode active for TAG.
217 TAG defaults to the tag at point in current buffer.
218 If TAG has a :mode property return it.
219 If point is inside TAG bounds, return the major mode active at point.
220 Return the major mode active at beginning of TAG otherwise.
221 See also the function `semantic-ctxt-current-mode'."
222 (require 'semantic
/find
)
223 (or tag
(setq tag
(semantic-current-tag)))
224 (or (semantic--tag-get-property tag
:mode
)
225 (let ((buffer (semantic-tag-buffer tag
))
226 (start (semantic-tag-start tag
))
227 (end (semantic-tag-end tag
)))
229 (and buffer
(set-buffer buffer
))
230 ;; Unless point is inside TAG bounds, move it to the
232 (or (and (>= (point) start
) (< (point) end
))
234 (require 'semantic
/ctxt
)
235 (semantic-ctxt-current-mode)))))
237 (defsubst semantic--tag-attributes-cdr
(tag)
238 "Return the cons cell whose car is the ATTRIBUTES part of TAG.
239 That function is for internal use only."
242 (defsubst semantic-tag-put-attribute
(tag attribute value
)
243 "Change value in TAG of ATTRIBUTE to VALUE.
244 If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
245 new ATTRIBUTE VALUE pair is added.
247 Use this function in a parser when not all attributes are known at the
249 (let* ((plist-cdr (semantic--tag-attributes-cdr tag
)))
250 (when (consp plist-cdr
)
252 (semantic-tag-make-plist
253 (plist-put (car plist-cdr
) attribute value
))))
256 (defun semantic-tag-put-attribute-no-side-effect (tag attribute value
)
257 "Change value in TAG of ATTRIBUTE to VALUE without side effects.
258 All cons cells in the attribute list are replicated so that there
259 are no side effects if TAG is in shared lists.
260 If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
261 new ATTRIBUTE VALUE pair is added.
263 (let* ((plist-cdr (semantic--tag-attributes-cdr tag
)))
264 (when (consp plist-cdr
)
266 (semantic-tag-make-plist
267 (plist-put (copy-sequence (car plist-cdr
))
271 (defsubst semantic-tag-get-attribute
(tag attribute
)
272 "From TAG, return the value of ATTRIBUTE.
273 ATTRIBUTE is a symbol whose specification value to get.
274 Return the value found, or nil if ATTRIBUTE is not one of the
276 (plist-get (semantic-tag-attributes tag
) attribute
))
278 ;; These functions are for internal use only!
279 (defsubst semantic--tag-properties-cdr
(tag)
280 "Return the cons cell whose car is the PROPERTIES part of TAG.
281 That function is for internal use only."
284 (defun semantic--tag-put-property (tag property value
)
285 "Change value in TAG of PROPERTY to VALUE.
286 If PROPERTY already exists, its value is set to VALUE, otherwise the
287 new PROPERTY VALUE pair is added.
289 That function is for internal use only."
290 (let* ((plist-cdr (semantic--tag-properties-cdr tag
)))
291 (when (consp plist-cdr
)
293 (semantic-tag-make-plist
294 (plist-put (car plist-cdr
) property value
))))
297 (defun semantic--tag-put-property-no-side-effect (tag property value
)
298 "Change value in TAG of PROPERTY to VALUE without side effects.
299 All cons cells in the property list are replicated so that there
300 are no side effects if TAG is in shared lists.
301 If PROPERTY already exists, its value is set to VALUE, otherwise the
302 new PROPERTY VALUE pair is added.
304 That function is for internal use only."
305 (let* ((plist-cdr (semantic--tag-properties-cdr tag
)))
306 (when (consp plist-cdr
)
308 (semantic-tag-make-plist
309 (plist-put (copy-sequence (car plist-cdr
))
313 (defun semantic-tag-file-name (tag)
314 "Return the name of the file from which TAG originated.
315 Return nil if that information can't be obtained.
316 If TAG is from a loaded buffer, then that buffer's filename is used.
317 If TAG is unlinked, but has a :filename property, then that is used."
318 (let ((buffer (semantic-tag-in-buffer-p tag
)))
320 (buffer-file-name buffer
)
321 (semantic--tag-get-property tag
:filename
))))
323 ;;; Tag tests and comparisons.
324 (defsubst semantic-tag-p
(tag)
325 "Return non-nil if TAG is most likely a semantic tag."
328 (stringp (car tag
)) ; NAME
329 (symbolp (nth 1 tag
)) (nth 1 tag
) ; TAG-CLASS
330 (listp (nth 2 tag
)) ; ATTRIBUTES
331 (listp (nth 3 tag
)) ; PROPERTIES
333 ;; If an error occurs, then it most certainly is not a tag.
336 (defsubst semantic-tag-of-class-p
(tag class
)
337 "Return non-nil if class of TAG is CLASS."
338 (eq (semantic-tag-class tag
) class
))
340 (defsubst semantic-tag-type-members
(tag)
341 "Return the members of the type that TAG describes.
342 That is the value of the `:members' attribute."
343 (semantic-tag-get-attribute tag
:members
))
345 (defun semantic-tag-with-position-p (tag)
346 "Return non-nil if TAG has positional information."
347 (and (semantic-tag-p tag
)
348 (let ((o (semantic-tag-overlay tag
)))
349 (or (and (semantic-overlay-p o
)
350 (semantic-overlay-live-p o
))
353 (defun semantic-equivalent-tag-p (tag1 tag2
)
354 "Compare TAG1 and TAG2 and return non-nil if they are equivalent.
355 Use `equal' on elements the name, class, and position.
356 Use this function if tags are being copied and regrouped to test
357 for if two tags represent the same thing, but may be constructed
358 of different cons cells."
359 (and (equal (semantic-tag-name tag1
) (semantic-tag-name tag2
))
360 (semantic-tag-of-class-p tag1
(semantic-tag-class tag2
))
361 (or (and (not (semantic-tag-overlay tag1
))
362 (not (semantic-tag-overlay tag2
)))
363 (and (semantic-tag-overlay tag1
)
364 (semantic-tag-overlay tag2
)
365 (equal (semantic-tag-bounds tag1
)
366 (semantic-tag-bounds tag2
))))))
368 (defsubst semantic-tag-type
(tag)
369 "Return the value of the `:type' attribute of TAG.
370 For a function it would be the data type of the return value.
371 For a variable, it is the storage type of that variable.
372 For a data type, the type is the style of datatype, such as
374 (semantic-tag-get-attribute tag
:type
))
376 (defun semantic-tag-similar-p (tag1 tag2
&rest ignorable-attributes
)
377 "Test to see if TAG1 and TAG2 are similar.
378 Two tags are similar if their name, datatype, and various attributes
381 Similar tags that have sub-tags such as arg lists or type members,
382 are similar w/out checking the sub-list of tags.
383 Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity."
384 (let* ((A1 (and (equal (semantic-tag-name tag1
) (semantic-tag-name tag2
))
385 (semantic-tag-of-class-p tag1
(semantic-tag-class tag2
))
386 (semantic-tag-of-type-p tag1
(semantic-tag-type tag2
))))
387 (attr1 (semantic-tag-attributes tag1
))
388 (A2 (= (length attr1
) (length (semantic-tag-attributes tag2
))))
391 (when (and (not A2
) ignorable-attributes
)
393 (while (and A2 attr1 A3
)
394 (let ((a (car attr1
))
395 (v (car (cdr attr1
))))
397 (cond ((or (eq a
:type
) ;; already tested above.
398 (memq a ignorable-attributes
)) ;; Ignore them...
401 ;; Don't test sublists of tags
402 ((and (listp v
) (semantic-tag-p (car v
)))
405 ;; The attributes are not the same?
406 ((not (equal v
(semantic-tag-get-attribute tag2 a
)))
411 (setq attr1
(cdr (cdr attr1
))))
416 (defun semantic-tag-similar-with-subtags-p (tag1 tag2
&rest ignorable-attributes
)
417 "Test to see if TAG1 and TAG2 are similar.
418 Uses `semantic-tag-similar-p' but also recurses through sub-tags, such
419 as argument lists and type members.
420 Optional argument IGNORABLE-ATTRIBUTES is passed down to
421 `semantic-tag-similar-p'."
422 (let ((C1 (semantic-tag-components tag1
))
423 (C2 (semantic-tag-components tag2
))
425 (if (or (/= (length C1
) (length C2
))
426 (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes
))
430 ;; Else, check component lists.
431 (catch 'component-dissimilar
434 (if (not (semantic-tag-similar-with-subtags-p
435 (car C1
) (car C2
) ignorable-attributes
))
436 (throw 'component-dissimilar nil
))
441 ;; If we made it this far, we are ok.
445 (defun semantic-tag-of-type-p (tag type
)
446 "Compare TAG's type against TYPE. Non nil if equivalent.
447 TYPE can be a string, or a tag of class 'type.
448 This can be complex since some tags might have a :type that is a tag,
449 while other tags might just have a string. This function will also be
450 return true of TAG's type is compared directly to the declaration of a
452 (let* ((tagtype (semantic-tag-type tag
))
453 (tagtypestring (cond ((stringp tagtype
)
455 ((and (semantic-tag-p tagtype
)
456 (semantic-tag-of-class-p tagtype
'type
))
457 (semantic-tag-name tagtype
))
459 (typestring (cond ((stringp type
)
461 ((and (semantic-tag-p type
)
462 (semantic-tag-of-class-p type
'type
))
463 (semantic-tag-name type
))
469 ;; Matching strings (input type is string)
471 (string= tagtypestring type
))
472 ;; Matching strings (tag type is string)
473 (and (stringp tagtype
)
474 (string= tagtype typestring
))
475 ;; Matching tokens, and the type of the type is the same.
476 (and (string= tagtypestring typestring
)
477 (if (and (semantic-tag-type tagtype
) (semantic-tag-type type
))
478 (equal (semantic-tag-type tagtype
) (semantic-tag-type type
))
483 (defun semantic-tag-type-compound-p (tag)
484 "Return non-nil the type of TAG is compound.
485 Compound implies a structure or similar data type.
486 Returns the list of tag members if it is compound."
487 (let* ((tagtype (semantic-tag-type tag
))
489 (when (and (semantic-tag-p tagtype
)
490 (semantic-tag-of-class-p tagtype
'type
))
491 ;; We have the potential of this being a nifty compound type.
492 (semantic-tag-type-members tagtype
)
495 (defun semantic-tag-faux-p (tag)
496 "Return non-nil if TAG is a FAUX tag.
497 FAUX tags are created to represent a construct that is
498 not known to exist in the code.
500 Example: When the class browser sees methods to a class, but
501 cannot find the class, it will create a faux tag to represent the
502 class to store those methods."
503 (semantic--tag-get-property tag
:faux-flag
))
508 ;; Is this function still necessary?
509 (defun semantic-tag-make-plist (args)
510 "Create a property list with ARGS.
511 Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN).
512 Where KEY is a symbol, and VALUE is the value for that symbol.
513 The return value will be a new property list, with these KEY/VALUE
516 - KEY associated to nil VALUE.
517 - KEY associated to an empty string VALUE.
518 - KEY associated to a zero VALUE."
523 args
(nthcdr 2 args
))
524 (or (member val
'("" nil
))
525 (and (numberp val
) (zerop val
))
526 (setq plist
(cons key
(cons val plist
)))))
527 ;; It is not useful to reverse the new plist.
530 (defsubst semantic-tag
(name class
&rest attributes
)
531 "Create a generic semantic tag.
532 NAME is a string representing the name of this tag.
533 CLASS is the symbol that represents the class of tag this is,
534 such as 'variable, or 'function.
535 ATTRIBUTES is a list of additional attributes belonging to this tag."
536 (list name class
(semantic-tag-make-plist attributes
) nil nil
))
538 (defsubst semantic-tag-new-variable
(name type
&optional default-value
&rest attributes
)
539 "Create a semantic tag of class 'variable.
540 NAME is the name of this variable.
541 TYPE is a string or semantic tag representing the type of this variable.
542 Optional DEFAULT-VALUE is a string representing the default value of this variable.
543 ATTRIBUTES is a list of additional attributes belonging to this tag."
544 (apply 'semantic-tag name
'variable
546 :default-value default-value
549 (defsubst semantic-tag-new-function
(name type arg-list
&rest attributes
)
550 "Create a semantic tag of class 'function.
551 NAME is the name of this function.
552 TYPE is a string or semantic tag representing the type of this function.
553 ARG-LIST is a list of strings or semantic tags representing the
554 arguments of this function.
555 ATTRIBUTES is a list of additional attributes belonging to this tag."
556 (apply 'semantic-tag name
'function
561 (defsubst semantic-tag-new-type
(name type members parents
&rest attributes
)
562 "Create a semantic tag of class 'type.
563 NAME is the name of this type.
564 TYPE is a string or semantic tag representing the type of this type.
565 MEMBERS is a list of strings or semantic tags representing the
566 elements that make up this type if it is a composite type.
567 PARENTS is a cons cell. (EXPLICIT-PARENTS . INTERFACE-PARENTS)
568 EXPLICIT-PARENTS can be a single string (Just one parent) or a
569 list of parents (in a multiple inheritance situation). It can also
571 INTERFACE-PARENTS is a list of strings representing the names of
572 all INTERFACES, or abstract classes inherited from. It can also be
574 This slot can be interesting because the form:
576 is a valid parent where there is no explicit parent, and only an
578 ATTRIBUTES is a list of additional attributes belonging to this tag."
579 (apply 'semantic-tag name
'type
582 :superclasses
(car parents
)
583 :interfaces
(cdr parents
)
586 (defsubst semantic-tag-new-include
(name system-flag
&rest attributes
)
587 "Create a semantic tag of class 'include.
588 NAME is the name of this include.
589 SYSTEM-FLAG represents that we were able to identify this include as belonging
590 to the system, as opposed to belonging to the local project.
591 ATTRIBUTES is a list of additional attributes belonging to this tag."
592 (apply 'semantic-tag name
'include
593 :system-flag system-flag
596 (defsubst semantic-tag-new-package
(name detail
&rest attributes
)
597 "Create a semantic tag of class 'package.
598 NAME is the name of this package.
599 DETAIL is extra information about this package, such as a location where
601 ATTRIBUTES is a list of additional attributes belonging to this tag."
602 (apply 'semantic-tag name
'package
606 (defsubst semantic-tag-new-code
(name detail
&rest attributes
)
607 "Create a semantic tag of class 'code.
608 NAME is a name for this code.
609 DETAIL is extra information about the code.
610 ATTRIBUTES is a list of additional attributes belonging to this tag."
611 (apply 'semantic-tag name
'code
615 (defsubst semantic-tag-set-faux
(tag)
616 "Set TAG to be a new FAUX tag.
617 FAUX tags represent constructs not found in the source code.
618 You can identify a faux tag with `semantic-tag-faux-p'"
619 (semantic--tag-put-property tag
:faux-flag t
))
621 (defsubst semantic-tag-set-name
(tag name
)
622 "Set TAG name to NAME."
625 ;;; Copying and cloning tags.
627 (defsubst semantic-tag-clone
(tag &optional name
)
628 "Clone TAG, creating a new TAG.
629 If optional argument NAME is not nil it specifies a new name for the
631 ;; Right now, TAG is a list.
632 (list (or name
(semantic-tag-name tag
))
633 (semantic-tag-class tag
)
634 (copy-sequence (semantic-tag-attributes tag
))
635 (copy-sequence (semantic-tag-properties tag
))
636 (semantic-tag-overlay tag
)))
638 (defun semantic-tag-copy (tag &optional name keep-file
)
639 "Return a copy of TAG unlinked from the originating buffer.
640 If optional argument NAME is non-nil it specifies a new name for the
642 If optional argument KEEP-FILE is non-nil, and TAG was linked to a
643 buffer, the originating buffer file name is kept in the `:filename'
644 property of the copied tag.
645 If KEEP-FILE is a string, and the orginating buffer is NOT available,
646 then KEEP-FILE is stored on the `:filename' property.
647 This runs the tag hook `unlink-copy-hook`."
648 ;; Right now, TAG is a list.
649 (let ((copy (semantic-tag-clone tag name
)))
651 ;; Keep the filename if needed.
653 (semantic--tag-put-property
654 copy
:filename
(or (semantic-tag-file-name copy
)
655 (and (stringp keep-file
)
659 (when (semantic-tag-with-position-p tag
)
660 ;; Convert the overlay to a vector, effectively 'unlinking' the tag.
661 (semantic--tag-set-overlay
662 copy
(vector (semantic-tag-start copy
) (semantic-tag-end copy
)))
664 ;; Force the children to be copied also.
665 ;;(let ((chil (semantic--tag-copy-list
666 ;; (semantic-tag-components-with-overlays tag)
668 ;;;; Put the list into TAG.
671 ;; Call the unlink-copy hook. This should tell tools that
672 ;; this tag is not part of any buffer.
673 (when (semantic-overlay-p (semantic-tag-overlay tag
))
674 (semantic--tag-run-hooks copy
'unlink-copy-hook
))
678 ;;(defun semantic--tag-copy-list (tags &optional keep-file)
679 ;; "Make copies of TAGS and return the list of TAGS."
681 ;; (dolist (tag tags out)
682 ;; (setq out (cons (semantic-tag-copy tag nil keep-file)
686 (defun semantic--tag-copy-properties (tag1 tag2
)
687 "Copy private properties from TAG1 to TAG2.
689 This function is for internal use only."
690 (let ((plist (semantic-tag-properties tag1
)))
692 (semantic--tag-put-property tag2
(car plist
) (nth 1 plist
))
693 (setq plist
(nthcdr 2 plist
)))
698 (defun semantic-tag-deep-copy-one-tag (tag &optional filter
)
699 "Make a deep copy of TAG, applying FILTER to each child-tag.
700 Properties and overlay info are not copied.
701 FILTER takes TAG as an argument, and should returns a semantic-tag.
702 It is safe for FILTER to modify the input tag and return it."
703 (when (not filter
) (setq filter
'identity
))
704 (when (not (semantic-tag-p tag
))
705 (signal 'wrong-type-argument
(list tag
'semantic-tag-p
)))
706 (funcall filter
(list (semantic-tag-name tag
)
707 (semantic-tag-class tag
)
708 (semantic--tag-deep-copy-attributes
709 (semantic-tag-attributes tag
) filter
)
713 (defun semantic--tag-deep-copy-attributes (attrs &optional filter
)
714 "Make a deep copy of ATTRS, applying FILTER to each child-tag.
716 It is safe to modify ATTR, and return a permutaion of that list.
718 FILTER takes TAG as an argument, and should returns a semantic-tag.
719 It is safe for FILTER to modify the input tag and return it."
721 (when (not (symbolp (car attrs
))) (error "Bad Attribute List in tag"))
723 (cons (semantic--tag-deep-copy-value (nth 1 attrs
) filter
)
724 (semantic--tag-deep-copy-attributes (nthcdr 2 attrs
) filter
)))))
726 (defun semantic--tag-deep-copy-value (value &optional filter
)
727 "Make a deep copy of VALUE, applying FILTER to each child-tag.
729 It is safe to modify VALUE, and return a permutaion of that list.
731 FILTER takes TAG as an argument, and should returns a semantic-tag.
732 It is safe for FILTER to modify the input tag and return it."
735 ((semantic-tag-p value
)
736 (semantic-tag-deep-copy-one-tag value filter
))
738 ;; A list of more tags
739 ((and (listp value
) (semantic-tag-p (car value
)))
740 (semantic--tag-deep-copy-tag-list value filter
))
742 ;; Some arbitrary data.
745 (defun semantic--tag-deep-copy-tag-list (tags &optional filter
)
746 "Make a deep copy of TAGS, applying FILTER to each child-tag.
748 It is safe to modify the TAGS list, and return a permutaion of that list.
750 FILTER takes TAG as an argument, and should returns a semantic-tag.
751 It is safe for FILTER to modify the input tag and return it."
753 (if (semantic-tag-p (car tags
))
754 (cons (semantic-tag-deep-copy-one-tag (car tags
) filter
)
755 (semantic--tag-deep-copy-tag-list (cdr tags
) filter
))
756 (cons (car tags
) (semantic--tag-deep-copy-tag-list (cdr tags
) filter
)))))
759 ;;; Standard Tag Access
765 (defsubst semantic-tag-modifiers
(tag)
766 "Return the value of the `:typemodifiers' attribute of TAG."
767 (semantic-tag-get-attribute tag
:typemodifiers
))
769 (defun semantic-tag-docstring (tag &optional buffer
)
770 "Return the documentation of TAG.
771 That is the value defined by the `:documentation' attribute.
772 Optional argument BUFFER indicates where to get the text from.
773 If not provided, then only the POSITION can be provided.
775 If you want to get documentation for languages that do not store
776 the documentation string in the tag itself, use
777 `semantic-documentation-for-tag' instead."
778 (let ((p (semantic-tag-get-attribute tag
:documentation
)))
780 ((stringp p
) p
) ;; it is the doc string.
782 ((semantic-lex-token-with-text-p p
)
783 (semantic-lex-token-text p
))
785 ((and (semantic-lex-token-without-text-p p
)
787 (with-current-buffer buffer
788 (semantic-lex-token-text (car (semantic-lex p
(1+ p
))))))
792 ;;; Generic attributes for tags of any class.
794 (defsubst semantic-tag-named-parent
(tag)
795 "Return the parent of TAG.
796 That is the value of the `:parent' attribute.
797 If a definition can occur outside an actual parent structure, but
798 refers to that parent by name, then the :parent attribute should be used."
799 (semantic-tag-get-attribute tag
:parent
))
801 ;;; Tags of class `type'
803 (defun semantic-tag-type-superclasses (tag)
804 "Return the list of superclass names of the type that TAG describes."
805 (let ((supers (semantic-tag-get-attribute tag
:superclasses
)))
806 (cond ((stringp supers
)
807 ;; If we have a string, make it a list.
809 ((semantic-tag-p supers
)
810 ;; If we have one tag, return just the name.
811 (list (semantic-tag-name supers
)))
812 ((and (consp supers
) (semantic-tag-p (car supers
)))
813 ;; If we have a tag list, then return the names.
814 (mapcar (lambda (s) (semantic-tag-name s
))
817 ;; A list of something, return it.
820 (defun semantic--tag-find-parent-by-name (name supers
)
821 "Find the superclass NAME in the list of SUPERS.
822 If a simple search doesn't do it, try splitting up the names
824 (require 'semantic
/find
)
826 (setq stag
(semantic-find-first-tag-by-name name supers
))
829 (require 'semantic
/analyze
/fcn
)
831 (let* ((sname (semantic-tag-name S
))
832 (splitparts (semantic-analyze-split-name sname
))
833 (parts (if (stringp splitparts
)
835 (nreverse splitparts
))))
836 (when (string= name
(car parts
))
842 (defun semantic-tag-type-superclass-protection (tag parentstring
)
843 "Return the inheritance protection in TAG from PARENTSTRING.
844 PARENTSTRING is the name of the parent being inherited.
845 The return protection is a symbol, 'public, 'protection, and 'private."
846 (let ((supers (semantic-tag-get-attribute tag
:superclasses
)))
847 (cond ((stringp supers
)
849 ((semantic-tag-p supers
)
850 (let ((prot (semantic-tag-get-attribute supers
:protection
)))
851 (or (cdr (assoc prot
'(("public" . public
)
852 ("protected" . protected
)
853 ("private" . private
))))
855 ((and (consp supers
) (stringp (car supers
)))
857 ((and (consp supers
) (semantic-tag-p (car supers
)))
858 (let* ((stag (semantic--tag-find-parent-by-name parentstring supers
))
860 (semantic-tag-get-attribute stag
:protection
))))
861 (or (cdr (assoc prot
'(("public" . public
)
862 ("protected" . protected
)
863 ("private" . private
))))
864 (when (equal prot
"unspecified")
865 (if (semantic-tag-of-type-p tag
"class")
871 (defsubst semantic-tag-type-interfaces
(tag)
872 "Return the list of interfaces of the type that TAG describes."
873 ;; @todo - make this as robust as the above.
874 (semantic-tag-get-attribute tag
:interfaces
))
876 ;;; Tags of class `function'
878 (defsubst semantic-tag-function-arguments
(tag)
879 "Return the arguments of the function that TAG describes.
880 That is the value of the `:arguments' attribute."
881 (semantic-tag-get-attribute tag
:arguments
))
883 (defsubst semantic-tag-function-throws
(tag)
884 "Return the exceptions the function that TAG describes can throw.
885 That is the value of the `:throws' attribute."
886 (semantic-tag-get-attribute tag
:throws
))
888 (defsubst semantic-tag-function-parent
(tag)
889 "Return the parent of the function that TAG describes.
890 That is the value of the `:parent' attribute.
891 A function has a parent if it is a method of a class, and if the
892 function does not appear in body of it's parent class."
893 (semantic-tag-named-parent tag
))
895 (defsubst semantic-tag-function-destructor-p
(tag)
896 "Return non-nil if TAG describes a destructor function.
897 That is the value of the `:destructor-flag' attribute."
898 (semantic-tag-get-attribute tag
:destructor-flag
))
900 (defsubst semantic-tag-function-constructor-p
(tag)
901 "Return non-nil if TAG describes a constructor function.
902 That is the value of the `:constructor-flag' attribute."
903 (semantic-tag-get-attribute tag
:constructor-flag
))
905 ;;; Tags of class `variable'
907 (defsubst semantic-tag-variable-default
(tag)
908 "Return the default value of the variable that TAG describes.
909 That is the value of the attribute `:default-value'."
910 (semantic-tag-get-attribute tag
:default-value
))
912 (defsubst semantic-tag-variable-constant-p
(tag)
913 "Return non-nil if the variable that TAG describes is a constant.
914 That is the value of the attribute `:constant-flag'."
915 (semantic-tag-get-attribute tag
:constant-flag
))
917 ;;; Tags of class `include'
919 (defsubst semantic-tag-include-system-p
(tag)
920 "Return non-nil if the include that TAG describes is a system include.
921 That is the value of the attribute `:system-flag'."
922 (semantic-tag-get-attribute tag
:system-flag
))
924 (define-overloadable-function semantic-tag-include-filename
(tag)
925 "Return a filename representation of TAG.
926 The default action is to return the `semantic-tag-name'.
927 Some languages do not use full filenames in their include statements.
928 Override this method to translate the code represenation
929 into a filename. (A relative filename if necessary.)
931 See `semantic-dependency-tag-file' to expand an include
932 tag to a full file name.")
934 (defun semantic-tag-include-filename-default (tag)
935 "Return a filename representation of TAG.
936 Returns `semantic-tag-name'."
937 (semantic-tag-name tag
))
939 ;;; Tags of class `code'
941 (defsubst semantic-tag-code-detail
(tag)
942 "Return detail information from code that TAG describes.
943 That is the value of the attribute `:detail'."
944 (semantic-tag-get-attribute tag
:detail
))
946 ;;; Tags of class `alias'
948 (defsubst semantic-tag-new-alias
(name meta-tag-class value
&rest attributes
)
949 "Create a semantic tag of class alias.
950 NAME is a name for this alias.
951 META-TAG-CLASS is the class of the tag this tag is an alias.
952 VALUE is the aliased definition.
953 ATTRIBUTES is a list of additional attributes belonging to this tag."
954 (apply 'semantic-tag name
'alias
955 :aliasclass meta-tag-class
959 (defsubst semantic-tag-alias-class
(tag)
960 "Return the class of tag TAG is an alias."
961 (semantic-tag-get-attribute tag
:aliasclass
))
963 (define-overloadable-function semantic-tag-alias-definition
(tag)
964 "Return the definition TAG is an alias.
965 The returned value is a tag of the class that
966 `semantic-tag-alias-class' returns for TAG.
967 The default is to return the value of the :definition attribute.
968 Return nil if TAG is not of class 'alias."
969 (when (semantic-tag-of-class-p tag
'alias
)
971 (semantic-tag-get-attribute tag
:definition
))))
973 ;;; Language Specific Tag access via overload
975 (define-overloadable-function semantic-tag-components
(tag)
976 "Return a list of components for TAG.
977 A Component is a part of TAG which itself may be a TAG.
978 Examples include the elements of a structure in a
979 tag of class `type, or the list of arguments to a
980 tag of class 'function."
983 (defun semantic-tag-components-default (tag)
984 "Return a list of components for TAG.
985 Perform the described task in `semantic-tag-components'."
986 (cond ((semantic-tag-of-class-p tag
'type
)
987 (semantic-tag-type-members tag
))
988 ((semantic-tag-of-class-p tag
'function
)
989 (semantic-tag-function-arguments tag
))
992 (define-overloadable-function semantic-tag-components-with-overlays
(tag)
993 "Return the list of top level components belonging to TAG.
994 Children are any sub-tags which contain overlays.
996 Default behavior is to get `semantic-tag-components' in addition
997 to the components of an anonymous types (if applicable.)
999 Note for language authors:
1000 If a mode defines a language tag that has tags in it with overlays
1001 you should still return them with this function.
1002 Ignoring this step will prevent several features from working correctly."
1005 (defun semantic-tag-components-with-overlays-default (tag)
1006 "Return the list of top level components belonging to TAG.
1007 Children are any sub-tags which contain overlays.
1008 The default action collects regular components of TAG, in addition
1009 to any components beloning to an anonymous type."
1010 (let ((explicit-children (semantic-tag-components tag
))
1011 (type (semantic-tag-type tag
))
1012 (anon-type-children nil
)
1014 ;; Identify if this tag has an anonymous structure as
1015 ;; its type. This implies it may have children with overlays.
1016 (when (and type
(semantic-tag-p type
))
1017 (setq anon-type-children
(semantic-tag-components type
))
1018 ;; Add anonymous children
1019 (while anon-type-children
1020 (when (semantic-tag-with-position-p (car anon-type-children
))
1021 (setq all-children
(cons (car anon-type-children
) all-children
)))
1022 (setq anon-type-children
(cdr anon-type-children
))))
1023 ;; Add explicit children
1024 (while explicit-children
1025 (when (semantic-tag-with-position-p (car explicit-children
))
1026 (setq all-children
(cons (car explicit-children
) all-children
)))
1027 (setq explicit-children
(cdr explicit-children
)))
1029 (nreverse all-children
)))
1031 (defun semantic-tag-children-compatibility (tag &optional positiononly
)
1032 "Return children of TAG.
1033 If POSITIONONLY is nil, use `semantic-tag-components'.
1034 If POSITIONONLY is non-nil, use `semantic-tag-components-with-overlays'.
1035 DO NOT use this fcn in new code. Use one of the above instead."
1037 (semantic-tag-components-with-overlays tag
)
1038 (semantic-tag-components tag
)))
1042 ;; A Tag represents a region in a buffer. You can narrow to that tag.
1044 (defun semantic-narrow-to-tag (&optional tag
)
1045 "Narrow to the region specified by the bounds of TAG.
1046 See `semantic-tag-bounds'."
1048 (if (not tag
) (setq tag
(semantic-current-tag)))
1049 (narrow-to-region (semantic-tag-start tag
)
1050 (semantic-tag-end tag
)))
1052 (defmacro semantic-with-buffer-narrowed-to-current-tag
(&rest body
)
1053 "Execute BODY with the buffer narrowed to the current tag."
1055 (semantic-narrow-to-tag (semantic-current-tag))
1057 (put 'semantic-with-buffer-narrowed-to-current-tag
'lisp-indent-function
0)
1058 (add-hook 'edebug-setup-hook
1060 (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
1063 (defmacro semantic-with-buffer-narrowed-to-tag
(tag &rest body
)
1064 "Narrow to TAG, and execute BODY."
1066 (semantic-narrow-to-tag ,tag
)
1068 (put 'semantic-with-buffer-narrowed-to-tag
'lisp-indent-function
1)
1069 (add-hook 'edebug-setup-hook
1071 (def-edebug-spec semantic-with-buffer-narrowed-to-tag
1076 ;; Semantic may want to provide special hooks when specific operations
1077 ;; are about to happen on a given tag. These routines allow for hook
1078 ;; maintenance on a tag.
1080 ;; Internal global variable used to manage tag hooks. For example,
1081 ;; some implementation of `remove-hook' checks that the hook variable
1082 ;; is `default-boundp'.
1083 (defvar semantic--tag-hook-value
)
1085 (defun semantic-tag-add-hook (tag hook function
&optional append
)
1086 "Onto TAG, add to the value of HOOK the function FUNCTION.
1087 FUNCTION is added (if necessary) at the beginning of the hook list
1088 unless the optional argument APPEND is non-nil, in which case
1089 FUNCTION is added at the end.
1090 HOOK should be a symbol, and FUNCTION may be any valid function.
1091 See also the function `add-hook'."
1092 (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook
)))
1093 (add-hook 'semantic--tag-hook-value function append
)
1094 (semantic--tag-put-property tag hook semantic--tag-hook-value
)
1095 semantic--tag-hook-value
))
1097 (defun semantic-tag-remove-hook (tag hook function
)
1098 "Onto TAG, remove from the value of HOOK the function FUNCTION.
1099 HOOK should be a symbol, and FUNCTION may be any valid function. If
1100 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in
1101 the list of hooks to run in HOOK, then nothing is done.
1102 See also the function `remove-hook'."
1103 (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook
)))
1104 (remove-hook 'semantic--tag-hook-value function
)
1105 (semantic--tag-put-property tag hook semantic--tag-hook-value
)
1106 semantic--tag-hook-value
))
1108 (defun semantic--tag-run-hooks (tag hook
&rest args
)
1109 "Run for TAG all expressions saved on the property HOOK.
1110 Each hook expression must take at least one argument, the TAG.
1111 For any given situation, additional ARGS may be passed."
1112 (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook
))
1113 (arglist (cons tag args
)))
1115 ;; If a hook bombs, ignore it! Usually this is tied into
1116 ;; some sort of critical system.
1117 (apply 'run-hook-with-args
'semantic--tag-hook-value arglist
)
1118 (error (message "Error: %S" err
)))))
1120 ;;; Tags and Overlays
1122 ;; Overlays are used so that we can quickly identify tags from
1123 ;; buffer positions and regions using built in Emacs commands.
1126 (defsubst semantic--tag-unlink-list-from-buffer
(tags)
1127 "Convert TAGS from using an overlay to using an overlay proxy.
1128 This function is for internal use only."
1129 (mapcar 'semantic--tag-unlink-from-buffer tags
))
1131 (defun semantic--tag-unlink-from-buffer (tag)
1132 "Convert TAG from using an overlay to using an overlay proxy.
1133 This function is for internal use only."
1134 (when (semantic-tag-p tag
)
1135 (let ((o (semantic-tag-overlay tag
)))
1136 (when (semantic-overlay-p o
)
1137 (semantic--tag-set-overlay
1138 tag
(vector (semantic-overlay-start o
)
1139 (semantic-overlay-end o
)))
1140 (semantic-overlay-delete o
))
1141 ;; Look for a link hook on TAG.
1142 (semantic--tag-run-hooks tag
'unlink-hook
)
1143 ;; Fix the sub-tags which contain overlays.
1144 (semantic--tag-unlink-list-from-buffer
1145 (semantic-tag-components-with-overlays tag
)))))
1147 (defsubst semantic--tag-link-list-to-buffer
(tags)
1148 "Convert TAGS from using an overlay proxy to using an overlay.
1149 This function is for internal use only."
1150 (mapcar 'semantic--tag-link-to-buffer tags
))
1152 (defun semantic--tag-link-to-buffer (tag)
1153 "Convert TAG from using an overlay proxy to using an overlay.
1154 This function is for internal use only."
1155 (when (semantic-tag-p tag
)
1156 (let ((o (semantic-tag-overlay tag
)))
1157 (when (and (vectorp o
) (= (length o
) 2))
1158 (setq o
(semantic-make-overlay (aref o
0) (aref o
1)
1160 (semantic--tag-set-overlay tag o
)
1161 (semantic-overlay-put o
'semantic tag
)
1162 ;; Clear the :filename property
1163 (semantic--tag-put-property tag
:filename nil
))
1164 ;; Look for a link hook on TAG.
1165 (semantic--tag-run-hooks tag
'link-hook
)
1166 ;; Fix the sub-tags which contain overlays.
1167 (semantic--tag-link-list-to-buffer
1168 (semantic-tag-components-with-overlays tag
)))))
1170 (defun semantic--tag-unlink-cache-from-buffer ()
1171 "Convert all tags in the current cache to use overlay proxys.
1172 This function is for internal use only."
1174 (semantic--tag-unlink-list-from-buffer
1175 ;; @todo- use fetch-tags-fast?
1176 (semantic-fetch-tags)))
1178 (defvar semantic--buffer-cache
)
1180 (defun semantic--tag-link-cache-to-buffer ()
1181 "Convert all tags in the current cache to use overlays.
1182 This function is for internal use only."
1185 ;; In this unique case, we cannot call the usual toplevel fn.
1186 ;; because we don't want a reparse, we want the old overlays.
1187 (semantic--tag-link-list-to-buffer
1188 semantic--buffer-cache
)
1189 ;; Recover when there is an error restoring the cache.
1190 (error (message "Error recovering tag list")
1191 (semantic-clear-toplevel-cache)
1196 ;; Raw tags from a parser follow a different positional format than
1197 ;; those used in the buffer cache. Raw tags need to be cooked into
1198 ;; semantic cache friendly tags for use by the masses.
1200 (defsubst semantic--tag-expanded-p
(tag)
1201 "Return non-nil if TAG is expanded.
1202 This function is for internal use only.
1203 See also the function `semantic--expand-tag'."
1204 ;; In fact a cooked tag is actually a list of cooked tags
1205 ;; because a raw tag can be expanded in several cooked ones!
1207 (while (and (semantic-tag-p (car tag
))
1208 (vectorp (semantic-tag-overlay (car tag
))))
1209 (setq tag
(cdr tag
)))
1212 (defvar semantic-tag-expand-function nil
1213 "Function used to expand a tag.
1214 It is passed each tag production, and must return a list of tags
1215 derived from it, or nil if it does not need to be expanded.
1217 Languages with compound definitions should use this function to expand
1218 from one compound symbol into several. For example, in C or Java the
1219 following definition is easily parsed into one tag:
1223 This function should take this compound tag and turn it into two tags,
1224 one for A, and the other for B.")
1225 (make-variable-buffer-local 'semantic-tag-expand-function
)
1227 (defun semantic--tag-expand (tag)
1228 "Convert TAG from a raw state to a cooked state, and expand it.
1229 Returns a list of cooked tags.
1231 The parser returns raw tags with positional data START END at the
1232 end of the tag data structure (a list for now). We convert it from
1233 that to a cooked state that uses an overlay proxy, that is, a vector
1236 The raw tag is changed with side effects and maybe expanded in
1237 several derived tags when the variable `semantic-tag-expand-function'
1240 This function is for internal use only."
1241 (if (semantic--tag-expanded-p tag
)
1242 ;; Just return TAG if it is already expanded (by a grammar
1243 ;; semantic action), or if it isn't recognized as a valid
1247 ;; Try to cook the tag. This code will be removed when tag will
1248 ;; be directly created with the right format.
1250 (let ((ocdr (semantic--tag-overlay-cdr tag
)))
1251 ;; OCDR contains the sub-list of TAG whose car is the
1252 ;; OVERLAY part of TAG. That is, a list (OVERLAY START END).
1253 ;; Convert it into an overlay proxy ([START END]).
1254 (semantic--tag-set-overlay
1255 tag
(vector (nth 1 ocdr
) (nth 2 ocdr
)))
1256 ;; Remove START END positions at end of tag.
1258 ;; At this point (length TAG) must be 5!
1259 ;;(unless (= (length tag) 5)
1260 ;; (error "Tag expansion failed"))
1263 (message "A Rule must return a single tag-line list!")
1267 ;; @todo - I think we've waited long enough. Lets find out.
1269 ;; ;; Compatibility code to be removed in future versions.
1270 ;; (unless semantic-tag-expand-function
1271 ;; ;; This line throws a byte compiler warning.
1272 ;; (setq semantic-tag-expand-function semantic-expand-nonterminal)
1275 ;; Expand based on local configuration
1276 (if semantic-tag-expand-function
1277 (or (funcall semantic-tag-expand-function tag
)
1283 (defmacro semantic-foreign-tag-invalid
(tag)
1284 "Signal that TAG is an invalid foreign tag."
1285 `(signal 'wrong-type-argument
'(semantic-foreign-tag-p ,tag
)))
1287 (defsubst semantic-foreign-tag-p
(tag)
1288 "Return non-nil if TAG is a foreign tag.
1289 That is, a tag unlinked from the originating buffer, which carries the
1290 originating buffer file name, and major mode."
1291 (and (semantic-tag-p tag
)
1292 (semantic--tag-get-property tag
:foreign-flag
)))
1294 (defsubst semantic-foreign-tag-check
(tag)
1295 "Check that TAG is a valid foreign tag.
1296 Signal an error if not."
1297 (or (semantic-foreign-tag-p tag
)
1298 (semantic-foreign-tag-invalid tag
)))
1300 (defun semantic-foreign-tag (&optional tag
)
1301 "Return a copy of TAG as a foreign tag, or nil if it can't be done.
1302 TAG defaults to the tag at point in current buffer.
1303 See also `semantic-foreign-tag-p'."
1304 (require 'semantic
/doc
)
1305 (or tag
(setq tag
(semantic-current-tag)))
1306 (when (semantic-tag-p tag
)
1307 (let ((ftag (semantic-tag-copy tag nil t
))
1308 ;; Do extra work for the doc strings, since this is a
1310 (doc (condition-case nil
1311 (semantic-documentation-for-tag tag
)
1313 ;; A foreign tag must carry its originating buffer file name!
1314 (when (semantic--tag-get-property ftag
:filename
)
1315 (semantic--tag-put-property ftag
:mode
(semantic-tag-mode tag
))
1316 (semantic--tag-put-property ftag
:documentation doc
)
1317 (semantic--tag-put-property ftag
:foreign-flag t
)
1320 ;; High level obtain/insert foreign tag overloads
1321 (define-overloadable-function semantic-obtain-foreign-tag
(&optional tag
)
1322 "Obtain a foreign tag from TAG.
1323 TAG defaults to the tag at point in current buffer.
1324 Return the obtained foreign tag or nil if failed."
1325 (semantic-foreign-tag tag
))
1327 (defun semantic-insert-foreign-tag-default (foreign-tag)
1328 "Insert FOREIGN-TAG into the current buffer.
1329 The default behavior assumes the current buffer is a language file,
1330 and attempts to insert a prototype/function call."
1331 ;; Long term goal: Have a mechanism for a tempo-like template insert
1332 ;; for the given tag.
1333 (require 'semantic
/format
)
1334 (insert (semantic-format-tag-prototype foreign-tag
)))
1336 (define-overloadable-function semantic-insert-foreign-tag
(foreign-tag)
1337 "Insert FOREIGN-TAG into the current buffer.
1338 Signal an error if FOREIGN-TAG is not a valid foreign tag.
1339 This function is overridable with the symbol `insert-foreign-tag'."
1340 (require 'semantic
/format
)
1341 (semantic-foreign-tag-check foreign-tag
)
1343 (message (semantic-format-tag-summarize foreign-tag
)))
1345 ;;; Support log modes here
1346 (define-mode-local-override semantic-insert-foreign-tag
1347 log-edit-mode
(foreign-tag)
1348 "Insert foreign tags into log-edit mode."
1349 (require 'semantic
/format
)
1350 (insert (concat "(" (semantic-format-tag-name foreign-tag
) "): ")))
1352 (define-mode-local-override semantic-insert-foreign-tag
1353 change-log-mode
(foreign-tag)
1354 "Insert foreign tags into log-edit mode."
1355 (require 'semantic
/format
)
1356 (insert (concat "(" (semantic-format-tag-name foreign-tag
) "): ")))
1359 ;;; EDEBUG display support
1361 (eval-after-load "cedet-edebug"
1363 (cedet-edebug-add-print-override
1364 '(semantic-tag-p object
)
1365 '(concat "#<TAG " (semantic-format-tag-name object
) ">"))
1366 (cedet-edebug-add-print-override
1367 '(and (listp object
) (semantic-tag-p (car object
)))
1368 '(cedet-edebug-prin1-recurse object
))
1373 (defconst semantic-token-version
1374 semantic-tag-version
)
1375 (defconst semantic-token-incompatible-version
1376 semantic-tag-incompatible-version
)
1378 (semantic-alias-obsolete 'semantic-token-name
1381 (semantic-alias-obsolete 'semantic-token-token
1382 'semantic-tag-class
)
1384 (semantic-alias-obsolete 'semantic-token-extra-specs
1385 'semantic-tag-attributes
)
1387 (semantic-alias-obsolete 'semantic-token-properties
1388 'semantic-tag-properties
)
1390 (semantic-alias-obsolete 'semantic-token-properties-cdr
1391 'semantic--tag-properties-cdr
)
1393 (semantic-alias-obsolete 'semantic-token-overlay
1394 'semantic-tag-overlay
)
1396 (semantic-alias-obsolete 'semantic-token-overlay-cdr
1397 'semantic--tag-overlay-cdr
)
1399 (semantic-alias-obsolete 'semantic-token-start
1400 'semantic-tag-start
)
1402 (semantic-alias-obsolete 'semantic-token-end
1405 (semantic-alias-obsolete 'semantic-token-extent
1406 'semantic-tag-bounds
)
1408 (semantic-alias-obsolete 'semantic-token-buffer
1409 'semantic-tag-buffer
)
1411 (semantic-alias-obsolete 'semantic-token-put
1412 'semantic--tag-put-property
)
1414 (semantic-alias-obsolete 'semantic-token-put-no-side-effect
1415 'semantic--tag-put-property-no-side-effect
)
1417 (semantic-alias-obsolete 'semantic-token-get
1418 'semantic--tag-get-property
)
1420 (semantic-alias-obsolete 'semantic-token-add-extra-spec
1421 'semantic-tag-put-attribute
)
1423 (semantic-alias-obsolete 'semantic-token-extra-spec
1424 'semantic-tag-get-attribute
)
1426 (semantic-alias-obsolete 'semantic-token-type
1429 (semantic-alias-obsolete 'semantic-token-modifiers
1430 'semantic-tag-modifiers
)
1432 (semantic-alias-obsolete 'semantic-token-docstring
1433 'semantic-tag-docstring
)
1435 (semantic-alias-obsolete 'semantic-token-type-parts
1436 'semantic-tag-type-members
)
1438 (defsubst semantic-token-type-parent
(tag)
1439 "Return the parent of the type that TAG describes.
1440 The return value is a list. A value of nil means no parents.
1441 The `car' of the list is either the parent class, or a list
1442 of parent classes. The `cdr' of the list is the list of
1443 interfaces, or abstract classes which are parents of TAG."
1444 (cons (semantic-tag-get-attribute tag
:superclasses
)
1445 (semantic-tag-type-interfaces tag
)))
1446 (make-obsolete 'semantic-token-type-parent
1448 use `semantic-tag-type-superclass' \
1449 and `semantic-tag-type-interfaces' instead")
1451 (semantic-alias-obsolete 'semantic-token-type-parent-superclass
1452 'semantic-tag-type-superclasses
)
1454 (semantic-alias-obsolete 'semantic-token-type-parent-implement
1455 'semantic-tag-type-interfaces
)
1457 (semantic-alias-obsolete 'semantic-token-type-extra-specs
1458 'semantic-tag-attributes
)
1460 (semantic-alias-obsolete 'semantic-token-type-extra-spec
1461 'semantic-tag-get-attribute
)
1463 (semantic-alias-obsolete 'semantic-token-type-modifiers
1464 'semantic-tag-modifiers
)
1466 (semantic-alias-obsolete 'semantic-token-function-args
1467 'semantic-tag-function-arguments
)
1469 (semantic-alias-obsolete 'semantic-token-function-extra-specs
1470 'semantic-tag-attributes
)
1472 (semantic-alias-obsolete 'semantic-token-function-extra-spec
1473 'semantic-tag-get-attribute
)
1475 (semantic-alias-obsolete 'semantic-token-function-modifiers
1476 'semantic-tag-modifiers
)
1478 (semantic-alias-obsolete 'semantic-token-function-throws
1479 'semantic-tag-function-throws
)
1481 (semantic-alias-obsolete 'semantic-token-function-parent
1482 'semantic-tag-function-parent
)
1484 (semantic-alias-obsolete 'semantic-token-function-destructor
1485 'semantic-tag-function-destructor-p
)
1487 (semantic-alias-obsolete 'semantic-token-variable-default
1488 'semantic-tag-variable-default
)
1490 (semantic-alias-obsolete 'semantic-token-variable-extra-specs
1491 'semantic-tag-attributes
)
1493 (semantic-alias-obsolete 'semantic-token-variable-extra-spec
1494 'semantic-tag-get-attribute
)
1496 (semantic-alias-obsolete 'semantic-token-variable-modifiers
1497 'semantic-tag-modifiers
)
1499 (semantic-alias-obsolete 'semantic-token-variable-const
1500 'semantic-tag-variable-constant-p
)
1502 (semantic-alias-obsolete 'semantic-token-variable-optsuffix
1503 'semantic-tag-variable-optsuffix
)
1505 (semantic-alias-obsolete 'semantic-token-include-system
1506 'semantic-tag-include-system-p
)
1508 (semantic-alias-obsolete 'semantic-token-p
1511 (semantic-alias-obsolete 'semantic-token-with-position-p
1512 'semantic-tag-with-position-p
)
1514 (semantic-alias-obsolete 'semantic-tag-make-assoc-list
1515 'semantic-tag-make-plist
)
1517 (semantic-alias-obsolete 'semantic-nonterminal-children
1518 'semantic-tag-children-compatibility
)
1520 (semantic-alias-obsolete 'semantic-narrow-to-token
1521 'semantic-narrow-to-tag
)
1523 (semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token
1524 'semantic-with-buffer-narrowed-to-current-tag
)
1526 (semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token
1527 'semantic-with-buffer-narrowed-to-tag
)
1529 (semantic-alias-obsolete 'semantic-deoverlay-token
1530 'semantic--tag-unlink-from-buffer
)
1532 (semantic-alias-obsolete 'semantic-overlay-token
1533 'semantic--tag-link-to-buffer
)
1535 (semantic-alias-obsolete 'semantic-deoverlay-list
1536 'semantic--tag-unlink-list-from-buffer
)
1538 (semantic-alias-obsolete 'semantic-overlay-list
1539 'semantic--tag-link-list-to-buffer
)
1541 (semantic-alias-obsolete 'semantic-deoverlay-cache
1542 'semantic--tag-unlink-cache-from-buffer
)
1544 (semantic-alias-obsolete 'semantic-overlay-cache
1545 'semantic--tag-link-cache-to-buffer
)
1547 (semantic-alias-obsolete 'semantic-cooked-token-p
1548 'semantic--tag-expanded-p
)
1550 (semantic-varalias-obsolete 'semantic-expand-nonterminal
1551 'semantic-tag-expand-function
)
1553 (semantic-alias-obsolete 'semantic-raw-to-cooked-token
1554 'semantic--tag-expand
)
1556 ;; Lets test this out during this short transition.
1557 (semantic-alias-obsolete 'semantic-clone-tag
1558 'semantic-tag-clone
)
1560 (semantic-alias-obsolete 'semantic-token
1563 (semantic-alias-obsolete 'semantic-token-new-variable
1564 'semantic-tag-new-variable
)
1566 (semantic-alias-obsolete 'semantic-token-new-function
1567 'semantic-tag-new-function
)
1569 (semantic-alias-obsolete 'semantic-token-new-type
1570 'semantic-tag-new-type
)
1572 (semantic-alias-obsolete 'semantic-token-new-include
1573 'semantic-tag-new-include
)
1575 (semantic-alias-obsolete 'semantic-token-new-package
1576 'semantic-tag-new-package
)
1578 (semantic-alias-obsolete 'semantic-equivalent-tokens-p
1579 'semantic-equivalent-tag-p
)
1581 (provide 'semantic
/tag
)
1583 ;;; semantic-tag.el ends here