cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semantic-tag.el

   1 ;;; semantic-tag.el --- tag creation and access
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
   4
   5 ;; X-CVS: $Id: semantic-tag.el,v 1.1 2007-11-26 15:10:43 michaels Exp $
   6
   7 ;; This file is not part of GNU Emacs.
   8
   9 ;; Semantic is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; This software is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25 ;;
  26 ;; I.  The core production of semantic is the list of tags produced by the
  27 ;;    different parsers.  This file provides 3 APIs related to tag access:
  28 ;;
  29 ;;    1) Primitive Tag Access
  30 ;;       There is a set of common features to all tags.  These access
  31 ;;       functions can get these values.
  32 ;;    2) Standard Tag Access
  33 ;;       A Standard Tag should be produced by most traditional languages
  34 ;;       with standard styles common to typed object oriented languages.
  35 ;;       These functions can access these data elements from a tag.
  36 ;;    3) Generic Tag Access
  37 ;;       Access to tag structure in a more direct way.
  38 ;;         ** May not be forward compatible.
  39 ;;
  40 ;; II.  There is also an API for tag creation.  Use `semantic-tag' to create
  41 ;;     a new tag.
  42 ;;
  43 ;; III.  Tag Comparison.  Allows explicit or comparitive tests to see
  44 ;;      if two tags are the same.
  45
  46 ;;; History:
  47 ;;
  48
  49 ;;; Code:
  50 ;;
  51
  52 ;; Keep this only so long as we have obsolete fcns.
  53 (require 'semantic-fw)
  54
  55 (defconst semantic-tag-version semantic-version
  56   "Version string of semantic tags made with this code.")
  57
  58 (defconst semantic-tag-incompatible-version "1.0"
  59   "Version string of semantic tags which are not currently compatible.
  60 These old style tags may be loaded from a file with semantic db.
  61 In this case, we must flush the old tags and start over.")
  62 \f
  63 ;;; Primitive Tag access system:
  64 ;;
  65 ;; Raw tags in semantic are lists of 5 elements:
  66 ;;
  67 ;;   (NAME CLASS ATTRIBUTES PROPERTIES OVERLAY)
  68 ;;
  69 ;; Where:
  70 ;;
  71 ;;   - NAME is a string that represents the tag name.
  72 ;;
  73 ;;   - CLASS is a symbol that represent the class of the tag (for
  74 ;;     example, usual classes are `type', `function', `variable',
  75 ;;     `include', `package', `code').
  76 ;;
  77 ;;   - ATTRIBUTES is a public list of attributes that describes
  78 ;;     language data represented by the tag (for example, a variable
  79 ;;     can have a `:constant-flag' attribute, a function an `:arguments'
  80 ;;     attribute, etc.).
  81 ;;
  82 ;;   - PROPERTIES is a private list of properties used internally.
  83 ;;
  84 ;;   - OVERLAY represent the location of data described by the tag.
  85 ;;
  86
  87 (defsubst semantic-tag-name (tag)
  88   "Return the name of TAG.
  89 For functions, variables, classes, typedefs, etc., this is the identifier
  90 that is being defined.  For tags without an obvious associated name, this
  91 may be the statement type, e.g., this may return @code{print} for python's
  92 print statement."
  93   (car tag))
  94
  95 (defsubst semantic-tag-class (tag)
  96   "Return the class of TAG.
  97 That is, the symbol 'variable, 'function, 'type, or other.
  98 There is no limit to the symbols that may represent the class of a tag.
  99 Each parser generates tags with classes defined by it.
 100
 101 For functional languages, typical tag classes are:
 102
 103 @table @code
 104 @item type
 105 Data types, named map for a memory block.
 106 @item function
 107 A function or method, or named execution location.
 108 @item variable
 109 A variable, or named storage for data.
 110 @item include
 111 Statement that represents a file from which more tags can be found.
 112 @item package
 113 Statement that declairs this file's package name.
 114 @item code
 115 Code that has not name or binding to any other symbol, such as in a script.
 116 @end table
 117 "
 118   (nth 1 tag))
 119
 120 (defsubst semantic-tag-attributes (tag)
 121   "Return the list of public attributes of TAG.
 122 That is a property list: (ATTRIBUTE-1 VALUE-1 ATTRIBUTE-2 VALUE-2...)."
 123   (nth 2 tag))
 124
 125 (defsubst semantic-tag-properties (tag)
 126   "Return the list of private properties of TAG.
 127 That is a property list: (PROPERTY-1 VALUE-1 PROPERTY-2 VALUE-2...)."
 128   (nth 3 tag))
 129
 130 (defsubst semantic-tag-overlay (tag)
 131   "Return the OVERLAY part of TAG.
 132 That is, an overlay or an unloaded buffer representation.
 133 This function can also return an array of the form [ START END ].
 134 This occurs for tags that are not currently linked into a buffer."
 135   (nth 4 tag))
 136
 137 (defsubst semantic--tag-overlay-cdr (tag)
 138   "Return the cons cell whose car is the OVERLAY part of TAG.
 139 That function is for internal use only."
 140   (nthcdr 4 tag))
 141
 142 (defsubst semantic--tag-set-overlay (tag overlay)
 143   "Set the overlay part of TAG with OVERLAY.
 144 That function is for internal use only."
 145   (setcar (semantic--tag-overlay-cdr tag) overlay))
 146
 147 (defsubst semantic-tag-start (tag)
 148   "Return the start location of TAG."
 149   (let ((o (semantic-tag-overlay tag)))
 150     (if (semantic-overlay-p o)
 151         (semantic-overlay-start o)
 152       (aref o 0))))
 153
 154 (defsubst semantic-tag-end (tag)
 155   "Return the end location of TAG."
 156   (let ((o (semantic-tag-overlay tag)))
 157     (if (semantic-overlay-p o)
 158         (semantic-overlay-end o)
 159       (aref o 1))))
 160
 161 (defsubst semantic-tag-bounds (tag)
 162   "Return the location (START END) of data TAG describes."
 163   (list (semantic-tag-start tag)
 164         (semantic-tag-end tag)))
 165
 166 (defun semantic-tag-set-bounds (tag start end)
 167   "In TAG, set the START and END location of data it describes."
 168   (let ((o (semantic-tag-overlay tag)))
 169     (if (semantic-overlay-p o)
 170         (semantic-overlay-move o start end)
 171       (semantic--tag-set-overlay tag (vector start end)))))
 172
 173 (defun semantic-tag-buffer (tag)
 174   "Return the buffer TAG resides in.
 175 If TAG has an originating file, read that file into a (maybe new)
 176 buffer, and return it.
 177 Return nil if there is no buffer for this tag."
 178   (let ((o (semantic-tag-overlay tag)))
 179     (cond
 180      ;; TAG is currently linked to a buffer, return it.
 181      ((and (semantic-overlay-p o)
 182            (semantic-overlay-live-p o))
 183       (semantic-overlay-buffer o))
 184      ;; TAG has an originating file, read that file into a buffer, and
 185      ;; return it.
 186      ((semantic--tag-get-property tag :filename)
 187       (find-file-noselect (semantic--tag-get-property tag :filename)))
 188      ;; TAG is not in Emacs right now, no buffer is available.
 189      )))
 190
 191 (defun semantic-tag-mode (&optional tag)
 192   "Return the major mode active for TAG.
 193 TAG defaults to the tag at point in current buffer.
 194 If TAG has a :mode property return it.
 195 If point is inside TAG bounds, return the major mode active at point.
 196 Return the major mode active at beginning of TAG otherwise.
 197 See also the function `semantic-ctxt-current-mode'."
 198   (or tag (setq tag (semantic-current-tag)))
 199   (or (semantic--tag-get-property tag :mode)
 200       (let ((buffer (semantic-tag-buffer tag))
 201             (start (semantic-tag-start tag))
 202             (end   (semantic-tag-end tag)))
 203         (save-excursion
 204           (and buffer (set-buffer buffer))
 205           ;; Unless point is inside TAG bounds, move it to the
 206           ;; beginning of TAG.
 207           (or (and (>= (point) start) (< (point) end))
 208               (goto-char start))
 209           (require 'semantic-ctxt)
 210           (semantic-ctxt-current-mode)))))
 211
 212 (defsubst semantic--tag-attributes-cdr (tag)
 213   "Return the cons cell whose car is the ATTRIBUTES part of TAG.
 214 That function is for internal use only."
 215   (nthcdr 2 tag))
 216
 217 (defsubst semantic-tag-put-attribute (tag attribute value)
 218   "Change value in TAG of ATTRIBUTE to VALUE.
 219 If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
 220 new ATTRIBUTE VALUE pair is added.
 221 Return TAG.
 222 Use this function in a parser when not all attributes are known at the
 223 same time."
 224   (let* ((plist-cdr (semantic--tag-attributes-cdr tag)))
 225     (when (consp plist-cdr)
 226       (setcar plist-cdr
 227               (semantic-tag-make-plist
 228                (plist-put (car plist-cdr) attribute value))))
 229     tag))
 230
 231 (defun semantic-tag-put-attribute-no-side-effect (tag attribute value)
 232   "Change value in TAG of ATTRIBUTE to VALUE without side effects.
 233 All cons cells in the attribute list are replicated so that there
 234 are no side effects if TAG is in shared lists.
 235 If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
 236 new ATTRIBUTE VALUE pair is added.
 237 Return TAG."
 238   (let* ((plist-cdr (semantic--tag-attributes-cdr tag)))
 239     (when (consp plist-cdr)
 240       (setcar plist-cdr
 241               (semantic-tag-make-plist
 242                (plist-put (copy-sequence (car plist-cdr))
 243                           attribute value))))
 244     tag))
 245
 246 (defsubst semantic-tag-get-attribute (tag attribute)
 247   "From TAG, return the value of ATTRIBUTE.
 248 ATTRIBUTE is a symbol whose specification value to get.
 249 Return the value found, or nil if ATTRIBUTE is not one of the
 250 attributes of TAG."
 251   (plist-get (semantic-tag-attributes tag) attribute))
 252
 253 ;; These functions are for internal use only!
 254 (defsubst semantic--tag-properties-cdr (tag)
 255   "Return the cons cell whose car is the PROPERTIES part of TAG.
 256 That function is for internal use only."
 257   (nthcdr 3 tag))
 258
 259 (defun semantic--tag-put-property (tag property value)
 260   "Change value in TAG of PROPERTY to VALUE.
 261 If PROPERTY already exists, its value is set to VALUE, otherwise the
 262 new PROPERTY VALUE pair is added.
 263 Return TAG.
 264 That function is for internal use only."
 265   (let* ((plist-cdr (semantic--tag-properties-cdr tag)))
 266     (when (consp plist-cdr)
 267       (setcar plist-cdr
 268               (semantic-tag-make-plist
 269                (plist-put (car plist-cdr) property value))))
 270     tag))
 271
 272 (defun semantic--tag-put-property-no-side-effect (tag property value)
 273   "Change value in TAG of PROPERTY to VALUE without side effects.
 274 All cons cells in the property list are replicated so that there
 275 are no side effects if TAG is in shared lists.
 276 If PROPERTY already exists, its value is set to VALUE, otherwise the
 277 new PROPERTY VALUE pair is added.
 278 Return TAG.
 279 That function is for internal use only."
 280   (let* ((plist-cdr (semantic--tag-properties-cdr tag)))
 281     (when (consp plist-cdr)
 282       (setcar plist-cdr
 283               (semantic-tag-make-plist
 284                (plist-put (copy-sequence (car plist-cdr))
 285                           property value))))
 286     tag))
 287
 288 (defsubst semantic--tag-get-property (tag property)
 289   "From TAG, extract the value of PROPERTY.
 290 Return the value found, or nil if PROPERTY is not one of the
 291 properties of TAG.
 292 That function is for internal use only."
 293   (plist-get (semantic-tag-properties tag) property))
 294
 295 (defun semantic-tag-file-name (tag)
 296   "Return the name of the file from which TAG originated.
 297 Return nil if that information can't be obtained.
 298 If TAG is from a loaded buffer, then that buffer's filename is used.
 299 If TAG is unlinked, but has a :filename property, then that is used."
 300   (let ((buffer (semantic-tag-buffer tag)))
 301     (if buffer
 302         (buffer-file-name buffer)
 303       (semantic--tag-get-property tag :filename))))
 304 \f
 305 ;;; Tag tests and comparisons.
 306 ;;
 307 (defsubst semantic-tag-p (tag)
 308   "Return non-nil if TAG is most likely a semantic tag."
 309   (condition-case nil
 310       (and (consp tag)
 311            (stringp (car tag))                ; NAME
 312            (symbolp (nth 1 tag)) (nth 1 tag)  ; TAG-CLASS
 313            (listp (nth 2 tag))                ; ATTRIBUTES
 314            (listp (nth 3 tag))                ; PROPERTIES
 315            )
 316     ;; If an error occurs, then it most certainly is not a tag.
 317     (error nil)))
 318
 319 (defsubst semantic-tag-of-class-p (tag class)
 320   "Return non-nil if class of TAG is CLASS."
 321   (eq (semantic-tag-class tag) class))
 322
 323 (defun semantic-tag-with-position-p (tag)
 324   "Return non-nil if TAG has positional information."
 325   (and (semantic-tag-p tag)
 326        (let ((o (semantic-tag-overlay tag)))
 327          (or (and (semantic-overlay-p o)
 328                   (semantic-overlay-live-p o))
 329              (arrayp o)))))
 330
 331 (defun semantic-equivalent-tag-p (tag1 tag2)
 332   "Compare TAG1 and TAG2 and return non-nil if they are equivalent.
 333 Use `eq' to test if two tags are the same.  Use this function if tags
 334 are being copied and regrouped to test for if two tags represent the
 335 same thing, but may be constructed of different cons cells."
 336   (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
 337        (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
 338        (or (and (not (semantic-tag-overlay tag1))
 339                 (not (semantic-tag-overlay tag2)))
 340            (and (semantic-tag-overlay tag1)
 341                 (semantic-tag-overlay tag2)
 342                 (equal (semantic-tag-bounds tag1)
 343                        (semantic-tag-bounds tag2))))))
 344
 345 (defun semantic-tag-of-type-p (tag type)
 346   "Compare TAG's type against TYPE.  Non nil if equivalent.
 347 TYPE can be a string, or a tag of class 'type."
 348   (let* ((tagtype (semantic-tag-type tag))
 349          (tagtypestring (cond ((stringp tagtype)
 350                                tagtype)
 351                               ((and (semantic-tag-p tagtype)
 352                                     (semantic-tag-of-class-p tagtype 'type))
 353                                (semantic-tag-name tagtype))
 354                               (t nil)))
 355          (typestring (cond ((stringp type)
 356                             type)
 357                            ((and (semantic-tag-p type)
 358                                  (semantic-tag-of-class-p type 'type))
 359                             (semantic-tag-name type))
 360                            (t (error "Type's type is unknown"))))
 361          )
 362     (and
 363      tagtypestring
 364      (or
 365       ;; Matching strings (input type is string)
 366       (and (stringp type)
 367            (string= tagtypestring type))
 368       ;; Matching strings (tag type is string)
 369       (and (stringp tagtype)
 370            (string= tagtype typestring))
 371       ;; Matching tokens, and the type of the type is the same.
 372       (and (string= tagtypestring typestring)
 373            (if (and (semantic-tag-type tag) (semantic-tag-type type))
 374                (equal (semantic-tag-type tag) (semantic-tag-type type))
 375              t))
 376       ))
 377     ))
 378
 379 (defun semantic-tag-type-compound-p (tag)
 380   "Return non-nil the type of TAG is compound.
 381 Compound implies a structure or similar data type.
 382 Returns the list of tag members if it is compound."
 383   (let* ((tagtype (semantic-tag-type tag))
 384          )
 385     (when (and (semantic-tag-p tagtype)
 386                (semantic-tag-of-class-p tagtype 'type))
 387       ;; We have the potential of this being a nifty compound type.
 388       (semantic-tag-type-members tagtype)
 389       )))
 390
 391 (defun semantic-tag-faux-p (tag)
 392   "Return non-nil if TAG is a FAUX tag.
 393 FAUX tags are created to represent a construct that is
 394 not known to exist in the code."
 395   (semantic--tag-get-property tag :faux-flag))
 396 \f
 397 ;;; Tag creation
 398 ;;
 399
 400 ;; Is this function still necessary?
 401 (defun semantic-tag-make-plist (args)
 402   "Create a property list with ARGS.
 403 Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN).
 404 Where KEY is a symbol, and VALUE is the value for that symbol.
 405 The return value will be a new property list, with these KEY/VALUE
 406 pairs eliminated:
 407
 408   - KEY associated to nil VALUE.
 409   - KEY associated to an empty string VALUE.
 410   - KEY associated to a zero VALUE."
 411   (let (plist key val)
 412     (while args
 413       (setq key  (car args)
 414             val  (nth 1 args)
 415             args (nthcdr 2 args))
 416       (or (member val '("" nil))
 417           (and (numberp val) (zerop val))
 418           (setq plist (cons key (cons val plist)))))
 419     ;; It is not useful to reverse the new plist.
 420     plist))
 421
 422 (defsubst semantic-tag (name class &rest attributes)
 423   "Create a generic semantic tag.
 424 NAME is a string representing the name of this tag.
 425 CLASS is the symbol that represents the class of tag this is,
 426 such as 'variable, or 'function.
 427 ATTRIBUTES is a list of additional attributes belonging to this tag."
 428   (list name class (semantic-tag-make-plist attributes) nil nil))
 429
 430 (defsubst semantic-tag-new-variable (name type default-value &rest attributes)
 431   "Create a semantic tag of class 'variable.
 432 NAME is the name of this variable.
 433 TYPE is a string or semantic tag representing the type of this variable.
 434 DEFAULT-VALUE is a string representing the default value of this variable.
 435 ATTRIBUTES is a list of additional attributes belonging to this tag."
 436   (apply 'semantic-tag name 'variable
 437          :type type
 438          :default-value default-value
 439          attributes))
 440
 441 (defsubst semantic-tag-new-function (name type arg-list &rest attributes)
 442   "Create a semantic tag of class 'function.
 443 NAME is the name of this function.
 444 TYPE is a string or semantic tag representing the type of this function.
 445 ARG-LIST is a list of strings or semantic tags representing the
 446 arguments of this function.
 447 ATTRIBUTES is a list of additional attributes belonging to this tag."
 448   (apply 'semantic-tag name 'function
 449          :type type
 450          :arguments arg-list
 451          attributes))
 452
 453 (defsubst semantic-tag-new-type (name type members parents &rest attributes)
 454   "Create a semantic tag of class 'type.
 455 NAME is the name of this type.
 456 TYPE is a string or semantic tag representing the type of this type.
 457 MEMBERS is a list of strings or semantic tags representing the
 458 elements that make up this type if it is a composite type.
 459 PARENTS is a cons cell.  (EXPLICIT-PARENTS . INTERFACE-PARENTS)
 460 EXPLICIT-PARENTS can be a single string (Just one parent) or a
 461 list of parents (in a multiple inheritance situation).  It can also
 462 be nil.
 463 INTERFACE-PARENTS is a list of strings representing the names of
 464 all INTERFACES, or abstract classes inherited from.  It can also be
 465 nil.
 466 This slot can be interesting because the form:
 467      ( nil \"string\")
 468 is a valid parent where there is no explicit parent, and only an
 469 interface.
 470 ATTRIBUTES is a list of additional attributes belonging to this tag."
 471   (apply 'semantic-tag name 'type
 472          :type type
 473          :members members
 474          :superclasses (car parents)
 475          :interfaces (cdr parents)
 476          attributes))
 477
 478 (defsubst semantic-tag-new-include (name system-flag &rest attributes)
 479   "Create a semantic tag of class 'include.
 480 NAME is the name of this include.
 481 SYSTEM-FLAG represents that we were able to identify this include as belonging
 482 to the system, as opposed to belonging to the local project.
 483 ATTRIBUTES is a list of additional attributes belonging to this tag."
 484   (apply 'semantic-tag name 'include
 485          :system-flag system-flag
 486          attributes))
 487
 488 (defsubst semantic-tag-new-package (name detail &rest attributes)
 489   "Create a semantic tag of class 'package.
 490 NAME is the name of this package.
 491 DETAIL is extra information about this package, such as a location where
 492 it can be found.
 493 ATTRIBUTES is a list of additional attributes belonging to this tag."
 494   (apply 'semantic-tag name 'package
 495          :detail detail
 496          attributes))
 497
 498 (defsubst semantic-tag-new-code (name detail &rest attributes)
 499   "Create a semantic tag of class 'code.
 500 NAME is a name for this code.
 501 DETAIL is extra information about the code.
 502 ATTRIBUTES is a list of additional attributes belonging to this tag."
 503   (apply 'semantic-tag name 'code
 504          :detail detail
 505          attributes))
 506
 507 (defsubst semantic-tag-set-faux (tag)
 508   "Set TAG to be a new FAUX tag.
 509 FAUX tags represent constructs not found in the source code.
 510 You can identify a faux tag with `semantic-tag-faux-p'"
 511   (semantic--tag-put-property tag :faux-flag t))
 512
 513 ;;; Copying and cloning tags.
 514 ;;
 515 (defsubst semantic-tag-clone (tag &optional name)
 516   "Clone TAG, creating a new TAG.
 517 If optional argument NAME is not nil it specifies a new name for the
 518 cloned tag."
 519   ;; Right now, TAG is a list.
 520   (list (or name (semantic-tag-name tag))
 521         (semantic-tag-class tag)
 522         (copy-sequence (semantic-tag-attributes tag))
 523         (copy-sequence (semantic-tag-properties tag))
 524         (semantic-tag-overlay tag)))
 525
 526 (defun semantic-tag-copy (tag &optional name keep-file)
 527   "Return a copy of TAG unlinked from the originating buffer.
 528 If optional argument NAME is non-nil it specifies a new name for the
 529 copied tag.
 530 If optional argument KEEP-FILE is non-nil, and TAG was linked to a
 531 buffer, the originating buffer file name is kept in the `:filename'
 532 property of the copied tag.
 533 This runs the tag hook `unlink-copy-hook`."
 534   ;; Right now, TAG is a list.
 535   (let ((copy (semantic-tag-clone tag name)))
 536     (when (semantic-tag-with-position-p tag)
 537       ;; Keep the filename if needed.
 538       (when keep-file
 539         (semantic--tag-put-property
 540          copy :filename (semantic-tag-file-name copy)))
 541       ;; Convert the overlay to a vector, effectively 'unlinking' the tag.
 542       (semantic--tag-set-overlay
 543        copy (vector (semantic-tag-start copy) (semantic-tag-end copy)))
 544
 545       ;; Force the children to be copied also.
 546       ;;et ((chil (semantic--tag-copy-list
 547       ;;           (semantic-tag-components-with-overlays tag)
 548       ;;           keep-file)))
 549       ;;;; Put the list into TAG.
 550       ;;)
 551
 552       ;; Call the unlink-copy hook.  This should tell tools that
 553       ;; this tag is not part of any buffer.
 554       (semantic--tag-run-hooks copy 'unlink-copy-hook)
 555       )
 556     copy))
 557
 558 ;;(defun semantic--tag-copy-list (tags &optional keep-file)
 559 ;;  "Make copies of TAGS and return the list of TAGS."
 560 ;;  (let ((out nil))
 561 ;;    (dolist (tag tags out)
 562 ;;      (setq out (cons (semantic-tag-copy tag nil keep-file)
 563 ;;                    out))
 564 ;;      )))
 565
 566 (defun semantic--tag-copy-properties (tag1 tag2)
 567   "Copy private properties from TAG1 to TAG2.
 568 Return TAG2.
 569 This function is for internal use only."
 570   (let ((plist (semantic-tag-properties tag1)))
 571     (while plist
 572       (semantic--tag-put-property tag2 (car plist) (nth 1 plist))
 573       (setq plist (nthcdr 2 plist)))
 574     tag2))
 575 \f
 576 ;;; Standard Tag Access
 577 ;;
 578
 579 ;;; Common
 580 ;;
 581 (defsubst semantic-tag-type (tag)
 582   "Return the value of the `:type' attribute of TAG."
 583   (semantic-tag-get-attribute tag :type))
 584
 585 (defsubst semantic-tag-modifiers (tag)
 586   "Return the value of the `:typemodifiers' attribute of TAG."
 587   (semantic-tag-get-attribute tag :typemodifiers))
 588
 589 (defun semantic-tag-docstring (tag &optional buffer)
 590   "Return the documentation of TAG.
 591 That is the value defined by the `:documentation' attribute.
 592 Optional argument BUFFER indicates where to get the text from.
 593 If not provided, then only the POSITION can be provided."
 594   (let ((p (semantic-tag-get-attribute tag :documentation)))
 595     (if (and p buffer)
 596         (with-current-buffer buffer
 597           (semantic-lex-token-text (car (semantic-lex p (1+ p)))))
 598       p)))
 599
 600 ;;; Generic attributes for tags of any class.
 601 ;;
 602 (defsubst semantic-tag-named-parent (tag)
 603   "Return the parent of TAG.
 604 That is the value of the `:parent' attribute.
 605 If a definition can occur outside an actual parent structure, but
 606 refers to that parent by name, then the :parent attribute should be used."
 607   (semantic-tag-get-attribute tag :parent))
 608
 609 ;;; Tags of class `type'
 610 ;;
 611 (defsubst semantic-tag-type-members (tag)
 612   "Return the members of the type that TAG describes.
 613 That is the value of the `:members' attribute."
 614   (semantic-tag-get-attribute tag :members))
 615
 616 (defun semantic-tag-type-superclasses (tag)
 617   "Return the list of superclasses of the type that TAG describes."
 618   (let ((supers (semantic-tag-get-attribute tag :superclasses)))
 619     (cond ((stringp supers)
 620            (list supers))
 621           ((listp supers)
 622            supers))))
 623
 624 (defsubst semantic-tag-type-interfaces (tag)
 625   "Return the list of interfaces of the type that TAG describes."
 626   (semantic-tag-get-attribute tag :interfaces))
 627
 628 ;;; Tags of class `function'
 629 ;;
 630 (defsubst semantic-tag-function-arguments (tag)
 631   "Return the arguments of the function that TAG describes.
 632 That is the value of the `:arguments' attribute."
 633   (semantic-tag-get-attribute tag :arguments))
 634
 635 (defsubst semantic-tag-function-throws (tag)
 636   "Return the exceptions the function that TAG describes can throw.
 637 That is the value of the `:throws' attribute."
 638   (semantic-tag-get-attribute tag :throws))
 639
 640 (defsubst semantic-tag-function-parent (tag)
 641   "Return the parent of the function that TAG describes.
 642 That is the value of the `:parent' attribute.
 643 A function has a parent if it is a method of a class, and if the
 644 function does not appear in body of it's parent class."
 645   (semantic-tag-named-parent tag))
 646
 647 (defsubst semantic-tag-function-destructor-p (tag)
 648   "Return non-nil if TAG describes a destructor function.
 649 That is the value of the `:destructor-flag' attribute."
 650   (semantic-tag-get-attribute tag :destructor-flag))
 651
 652 (defsubst semantic-tag-function-constructor-p (tag)
 653   "Return non-nil if TAG describes a constructor function.
 654 That is the value of the `:constructor-flag' attribute."
 655   (semantic-tag-get-attribute tag :constructor-flag))
 656
 657 ;;; Tags of class `variable'
 658 ;;
 659 (defsubst semantic-tag-variable-default (tag)
 660   "Return the default value of the variable that TAG describes.
 661 That is the value of the attribute `:default-value'."
 662   (semantic-tag-get-attribute tag :default-value))
 663
 664 (defsubst semantic-tag-variable-constant-p (tag)
 665   "Return non-nil if the variable that TAG describes is a constant.
 666 That is the value of the attribute `:constant-flag'."
 667   (semantic-tag-get-attribute tag :constant-flag))
 668
 669 ;;; Tags of class `include'
 670 ;;
 671 (defsubst semantic-tag-include-system-p (tag)
 672   "Return non-nil if the include that TAG describes is a system include.
 673 That is the value of the attribute `:system-flag'."
 674   (semantic-tag-get-attribute tag :system-flag))
 675
 676 (define-overload semantic-tag-include-filename (tag)
 677   "Return a filename representation of TAG.
 678 The default action is to return the `semantic-tag-name'.
 679 Some languages do not use full filenames in their include statements.
 680 Override this method to translate the code represenation
 681 into a filename.  (A relative filename if necessary.)
 682
 683 See `semantic-dependency-tag-file' to expand an include
 684 tag to a full file name.")
 685
 686 (defun semantic-tag-include-filename-default (tag)
 687   "Return a filename representation of TAG.
 688 Returns `semantic-tag-name'."
 689   (semantic-tag-name tag))
 690
 691 ;;; Tags of class `code'
 692 ;;
 693 (defsubst semantic-tag-code-detail (tag)
 694   "Return detail information from code that TAG describes.
 695 That is the value of the attribute `:detail'."
 696   (semantic-tag-get-attribute tag :detail))
 697
 698 ;;; Tags of class `alias'
 699 ;;
 700 (defsubst semantic-tag-new-alias (name meta-tag-class value &rest attributes)
 701   "Create a semantic tag of class alias.
 702 NAME is a name for this alias.
 703 META-TAG-CLASS is the class of the tag this tag is an alias.
 704 VALUE is the aliased definition.
 705 ATTRIBUTES is a list of additional attributes belonging to this tag."
 706   (apply 'semantic-tag name 'alias
 707          :aliasclass meta-tag-class
 708          :definition value
 709          attributes))
 710
 711 (defsubst semantic-tag-alias-class (tag)
 712   "Return the class of tag TAG is an alias."
 713   (semantic-tag-get-attribute tag :aliasclass))
 714
 715 ;;;###autoload
 716 (define-overload semantic-tag-alias-definition (tag)
 717   "Return the definition TAG is an alias.
 718 The returned value is a tag of the class that
 719 `semantic-tag-alias-class' returns for TAG.
 720 The default is to return the value of the :definition attribute.
 721 Return nil if TAG is not of class 'alias."
 722   (when (semantic-tag-of-class-p tag 'alias)
 723     (:override
 724      (semantic-tag-get-attribute tag :definition))))
 725
 726 ;;; Language Specific Tag access via overload
 727 ;;
 728 ;;;###autoload
 729 (define-overload semantic-tag-components (tag)
 730   "Return a list of components for TAG.
 731 A Component is a part of TAG which itself may be a TAG.
 732 Examples include the elements of a structure in a
 733 tag of class `type, or the list of arguments to a
 734 tag of class 'function."
 735   )
 736
 737 (defun semantic-tag-components-default (tag)
 738   "Return a list of components for TAG.
 739 Perform the described task in `semantic-tag-components'."
 740   (cond ((semantic-tag-of-class-p tag 'type)
 741          (semantic-tag-type-members tag))
 742         ((semantic-tag-of-class-p tag 'function)
 743          (semantic-tag-function-arguments tag))
 744         (t nil)))
 745
 746 ;;;###autoload
 747 (define-overload semantic-tag-components-with-overlays (tag)
 748   "Return the list of top level components belonging to TAG.
 749 Children are any sub-tags which contain overlays.
 750
 751 Default behavior is to get `semantic-tag-components' in addition
 752 to the components of an anonymous types (if applicable.)
 753
 754 Note for language authors:
 755   If a mode defines a language tag that has tags in it with overlays
 756 you should still return them with this function.
 757 Ignoring this step will prevent several features from working correctly."
 758   )
 759
 760 (defun semantic-tag-components-with-overlays-default (tag)
 761   "Return the list of top level components belonging to TAG.
 762 Children are any sub-tags which contain overlays.
 763 The default action collects regular components of TAG, in addition
 764 to any components beloning to an anonymous type."
 765   (let ((class (semantic-tag-class tag))
 766         (explicit-children (semantic-tag-components tag))
 767         (type (semantic-tag-type tag))
 768         (anon-type-children nil)
 769         (all-children nil))
 770     ;; Identify if this tag has an anonymous structure as
 771     ;; its type.  This implies it may have children with overlays.
 772     (when (and type (semantic-tag-p type))
 773       (setq anon-type-children (semantic-tag-components type))
 774       ;; Add anonymous children
 775       (while anon-type-children
 776         (when (semantic-tag-with-position-p (car anon-type-children))
 777           (setq all-children (cons (car anon-type-children) all-children)))
 778         (setq anon-type-children (cdr anon-type-children))))
 779     ;; Add explicit children
 780     (while explicit-children
 781       (when (semantic-tag-with-position-p (car explicit-children))
 782         (setq all-children (cons (car explicit-children) all-children)))
 783       (setq explicit-children (cdr explicit-children)))
 784     ;; Return
 785     (nreverse all-children)))
 786
 787 (defun semantic-tag-children-compatibility (tag &optional positiononly)
 788   "Return children of TAG.
 789 If POSITIONONLY is nil, use `semantic-tag-components'.
 790 If POSITIONONLY is non-nil, use `semantic-tag-components-with-overlays'.
 791 DO NOT use this fcn in new code.  Use one of the above instead."
 792   (if positiononly
 793       (semantic-tag-components-with-overlays tag)
 794     (semantic-tag-components tag)))
 795 \f
 796 ;;; Tag Region
 797 ;;
 798 ;; A Tag represents a region in a buffer.  You can narrow to that tag.
 799 ;;
 800 (defun semantic-narrow-to-tag (&optional tag)
 801   "Narrow to the region specified by the bounds of TAG.
 802 See `semantic-tag-bounds'."
 803   (interactive)
 804   (if (not tag) (setq tag (semantic-current-tag)))
 805   (narrow-to-region (semantic-tag-start tag)
 806                     (semantic-tag-end tag)))
 807
 808 (defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body)
 809   "Execute BODY with the buffer narrowed to the current tag."
 810   `(save-restriction
 811      (semantic-narrow-to-tag (semantic-current-tag))
 812      ,@body))
 813 (put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0)
 814 (add-hook 'edebug-setup-hook
 815           (lambda ()
 816             (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
 817               (def-body))))
 818
 819 (defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body)
 820   "Narrow to TAG, and execute BODY."
 821   `(save-restriction
 822      (semantic-narrow-to-tag ,tag)
 823      ,@body))
 824 (put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1)
 825 (add-hook 'edebug-setup-hook
 826           (lambda ()
 827             (def-edebug-spec semantic-with-buffer-narrowed-to-tag
 828               (def-body))))
 829 \f
 830 ;;; Tag Hooks
 831 ;;
 832 ;; Semantic may want to provide special hooks when specific operations
 833 ;; are about to happen on a given tag.  These routines allow for hook
 834 ;; maintenance on a tag.
 835
 836 ;; Internal global variable used to manage tag hooks.  For example,
 837 ;; some implementation of `remove-hook' checks that the hook variable
 838 ;; is `default-boundp'.
 839 (defvar semantic--tag-hook-value)
 840
 841 (defun semantic-tag-add-hook (tag hook function &optional append)
 842   "Onto TAG, add to the value of HOOK the function FUNCTION.
 843 FUNCTION is added (if necessary) at the beginning of the hook list
 844 unless the optional argument APPEND is non-nil, in which case
 845 FUNCTION is added at the end.
 846 HOOK should be a symbol, and FUNCTION may be any valid function.
 847 See also the function `add-hook'."
 848   (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)))
 849     (add-hook 'semantic--tag-hook-value function append)
 850     (semantic--tag-put-property tag hook semantic--tag-hook-value)
 851     semantic--tag-hook-value))
 852
 853 (defun semantic-tag-remove-hook (tag hook function)
 854   "Onto TAG, remove from the value of HOOK the function FUNCTION.
 855 HOOK should be a symbol, and FUNCTION may be any valid function.  If
 856 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in
 857 the list of hooks to run in HOOK, then nothing is done.
 858 See also the function `remove-hook'."
 859   (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)))
 860     (remove-hook 'semantic--tag-hook-value function)
 861     (semantic--tag-put-property tag hook semantic--tag-hook-value)
 862     semantic--tag-hook-value))
 863
 864 (defun semantic--tag-run-hooks (tag hook &rest args)
 865   "Run for TAG all expressions saved on the property HOOK.
 866 Each hook expression must take at least one argument, the TAG.
 867 For any given situation, additional ARGS may be passed."
 868   (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook))
 869         (arglist (cons tag args)))
 870     (condition-case err
 871         ;; If a hook bombs, ignore it!  Usually this is tied into
 872         ;; some sort of critical system.
 873         (apply 'run-hook-with-args 'semantic--tag-hook-value arglist)
 874       (error (message "Error: %S" err)))))
 875 \f
 876 ;;; Tags and Overlays
 877 ;;
 878 ;; Overlays are used so that we can quickly identify tags from
 879 ;; buffer positions and regions using built in Emacs commands.
 880 ;;
 881 (defun semantic--tag-unlink-from-buffer (tag)
 882   "Convert TAG from using an overlay to using an overlay proxy.
 883 This function is for internal use only."
 884   (when (semantic-tag-p tag)
 885     (let ((o (semantic-tag-overlay tag)))
 886       (when (semantic-overlay-p o)
 887         (semantic--tag-set-overlay
 888          tag (vector (semantic-overlay-start o)
 889                      (semantic-overlay-end o)))
 890         (semantic-overlay-delete o))
 891       ;; Look for a link hook on TAG.
 892       (semantic--tag-run-hooks tag 'unlink-hook)
 893       ;; Fix the sub-tags which contain overlays.
 894       (semantic--tag-unlink-list-from-buffer
 895        (semantic-tag-components-with-overlays tag)))))
 896
 897 (defun semantic--tag-link-to-buffer (tag)
 898   "Convert TAG from using an overlay proxy to using an overlay.
 899 This function is for internal use only."
 900   (when (semantic-tag-p tag)
 901     (let ((o (semantic-tag-overlay tag)))
 902       (when (and (vectorp o) (= (length o) 2))
 903         (setq o (semantic-make-overlay (aref o 0) (aref o 1)
 904                                        (current-buffer)))
 905         (semantic--tag-set-overlay tag o)
 906         (semantic-overlay-put o 'semantic tag)
 907         ;; Clear the :filename property
 908         (semantic--tag-put-property tag :filename nil))
 909       ;; Look for a link hook on TAG.
 910       (semantic--tag-run-hooks tag 'link-hook)
 911       ;; Fix the sub-tags which contain overlays.
 912       (semantic--tag-link-list-to-buffer
 913        (semantic-tag-components-with-overlays tag)))))
 914
 915 (defsubst semantic--tag-unlink-list-from-buffer (tags)
 916   "Convert TAGS from using an overlay to using an overlay proxy.
 917 This function is for internal use only."
 918   (mapcar 'semantic--tag-unlink-from-buffer tags))
 919
 920 (defsubst semantic--tag-link-list-to-buffer (tags)
 921   "Convert TAGS from using an overlay proxy to using an overlay.
 922 This function is for internal use only."
 923   (mapcar 'semantic--tag-link-to-buffer tags))
 924
 925 (defun semantic--tag-unlink-cache-from-buffer ()
 926   "Convert all tags in the current cache to use overlay proxys.
 927 This function is for internal use only."
 928   (semantic--tag-unlink-list-from-buffer
 929    (semantic-fetch-tags)))
 930
 931 (defun semantic--tag-link-cache-to-buffer ()
 932   "Convert all tags in the current cache to use overlays.
 933 This function is for internal use only."
 934   (condition-case nil
 935       ;; In this unique case, we cannot call the usual toplevel fn.
 936       ;; because we don't want a reparse, we want the old overlays.
 937       (semantic--tag-link-list-to-buffer
 938        semantic--buffer-cache)
 939     ;; Recover when there is an error restoring the cache.
 940     (error (message "Error recovering tag list")
 941            (semantic-clear-toplevel-cache)
 942            nil)))
 943 \f
 944 ;;; Tag Cooking
 945 ;;
 946 ;; Raw tags from a parser follow a different positional format than
 947 ;; those used in the buffer cache.  Raw tags need to be cooked into
 948 ;; semantic cache friendly tags for use by the masses.
 949 ;;
 950 (defsubst semantic--tag-expanded-p (tag)
 951   "Return non-nil if TAG is expanded.
 952 This function is for internal use only.
 953 See also the function `semantic--expand-tag'."
 954   ;; In fact a cooked tag is actually a list of cooked tags
 955   ;; because a raw tag can be expanded in several cooked ones!
 956   (when (consp tag)
 957     (while (and (semantic-tag-p (car tag))
 958                 (vectorp (semantic-tag-overlay (car tag))))
 959       (setq tag (cdr tag)))
 960     (null tag)))
 961
 962 (defvar semantic-tag-expand-function nil
 963   "Function used to expand a tag.
 964 It is passed each tag production, and must return a list of tags
 965 derived from it, or nil if it does not need to be expanded.
 966
 967 Languages with compound definitions should use this function to expand
 968 from one compound symbol into several.  For example, in C or Java the
 969 following definition is easily parsed into one tag:
 970
 971   int a, b;
 972
 973 This function should take this compound tag and turn it into two tags,
 974 one for A, and the other for B.")
 975 (make-variable-buffer-local 'semantic-tag-expand-function)
 976
 977 (defun semantic--tag-expand (tag)
 978   "Convert TAG from a raw state to a cooked state, and expand it.
 979 Returns a list of cooked tags.
 980
 981   The parser returns raw tags with positional data START END at the
 982 end of the tag data structure (a list for now).  We convert it from
 983 that to a cooked state that uses an overlay proxy, that is, a vector
 984 \[START END].
 985
 986   The raw tag is changed with side effects and maybe expanded in
 987 several derived tags when the variable `semantic-tag-expand-function'
 988 is set.
 989
 990 This function is for internal use only."
 991   (if (semantic--tag-expanded-p tag)
 992       ;; Just return TAG if it is already expanded (by a grammar
 993       ;; semantic action), or if it isn't recognized as a valid
 994       ;; semantic tag.
 995       tag
 996
 997     ;; Try to cook the tag.  This code will be removed when tag will
 998     ;; be directly created with the right format.
 999     (condition-case nil
1000         (let ((ocdr (semantic--tag-overlay-cdr tag)))
1001           ;; OCDR contains the sub-list of TAG whose car is the
1002           ;; OVERLAY part of TAG. That is, a list (OVERLAY START END).
1003           ;; Convert it into an overlay proxy ([START END]).
1004           (semantic--tag-set-overlay
1005            tag (vector (nth 1 ocdr) (nth 2 ocdr)))
1006           ;; Remove START END positions at end of tag.
1007           (setcdr ocdr nil)
1008           ;; At this point (length TAG) must be 5!
1009           ;;(unless (= (length tag) 5)
1010           ;;  (error "Tag expansion failed"))
1011           )
1012       (error
1013        (message "A Rule must return a single tag-line list!")
1014        (debug tag)
1015        nil))
1016
1017     ;; Compatibility code to be removed in future versions.
1018     (unless semantic-tag-expand-function
1019       ;; This line throws a byte compiler warning.
1020       (setq semantic-tag-expand-function semantic-expand-nonterminal)
1021       )
1022
1023     ;; Expand based on local configuration
1024     (if semantic-tag-expand-function
1025         (or (funcall semantic-tag-expand-function tag)
1026             (list tag))
1027       (list tag))))
1028 \f
1029 ;; Foreign tags
1030 ;;
1031 (defmacro semantic-foreign-tag-invalid (tag)
1032   "Signal that TAG is an invalid foreign tag."
1033   `(signal 'wrong-type-argument '(semantic-foreign-tag-p ,tag)))
1034
1035 (defsubst semantic-foreign-tag-p (tag)
1036   "Return non-nil if TAG is a foreign tag.
1037 That is, a tag unlinked from the originating buffer, which carries the
1038 originating buffer file name, and major mode."
1039   (and (semantic-tag-p tag)
1040        (semantic--tag-get-property tag :foreign-flag)))
1041
1042 (defsubst semantic-foreign-tag-check (tag)
1043   "Check that TAG is a valid foreign tag.
1044 Signal an error if not."
1045   (or (semantic-foreign-tag-p tag)
1046       (semantic-foreign-tag-invalid tag)))
1047
1048 (defun semantic-foreign-tag (&optional tag)
1049   "Return a copy of TAG as a foreign tag, or nil if it can't be done.
1050 TAG defaults to the tag at point in current buffer.
1051 See also `semantic-foreign-tag-p'."
1052   (or tag (setq tag (semantic-current-tag)))
1053   (when (semantic-tag-p tag)
1054     (let ((ftag (semantic-tag-copy tag nil t)))
1055       ;; A foreign tag must carry its originating buffer file name!
1056       (when (semantic--tag-get-property ftag :filename)
1057         (semantic--tag-put-property
1058          ftag :mode (semantic-tag-mode tag))
1059         (semantic--tag-put-property ftag :foreign-flag t)
1060         ftag))))
1061
1062 ;; High level obtain/insert foreign tag overloads
1063 ;;
1064 ;;;###autoload
1065 (define-overload semantic-obtain-foreign-tag (&optional tag)
1066   "Obtain a foreign tag from TAG.
1067 TAG defaults to the tag at point in current buffer.
1068 Return the obtained foreign tag or nil if failed."
1069   (semantic-foreign-tag tag))
1070
1071 (defun semantic-insert-foreign-tag-default (foreign-tag)
1072   "Insert FOREIGN-TAG into the current buffer.
1073 The default behavior assumes the current buffer is a language file,
1074 and attempts to insert a prototype/function call."
1075   ;; Long term goal: Have a mechanism for a tempo-like template insert
1076   ;; for the given tag.
1077   (insert (semantic-format-tag-prototype foreign-tag)))
1078
1079 ;;;###autoload
1080 (define-overload semantic-insert-foreign-tag (foreign-tag)
1081   "Insert FOREIGN-TAG into the current buffer.
1082 Signal an error if FOREIGN-TAG is not a valid foreign tag.
1083 This function is overridable with the symbol `insert-foreign-tag'."
1084   (semantic-foreign-tag-check foreign-tag)
1085   (:override)
1086   (message (semantic-format-tag-summarize foreign-tag)))
1087 \f
1088 ;;; EDEBUG display support
1089 ;;
1090 (eval-after-load "cedet-edebug"
1091   '(progn
1092      (cedet-edebug-add-print-override
1093       '(semantic-tag-p object)
1094       '(concat "#<TAG " (semantic-format-tag-name object) ">"))
1095      (cedet-edebug-add-print-override
1096       '(and (listp object) (semantic-tag-p (car object)))
1097       '(cedet-edebug-prin1-recurse object))
1098      ))
1099 \f
1100 ;;; Compatibility
1101 ;;
1102 (defconst semantic-token-version
1103   semantic-tag-version)
1104 (defconst semantic-token-incompatible-version
1105   semantic-tag-incompatible-version)
1106
1107 (semantic-alias-obsolete 'semantic-token-name
1108                          'semantic-tag-name)
1109
1110 (semantic-alias-obsolete 'semantic-token-token
1111                          'semantic-tag-class)
1112
1113 (semantic-alias-obsolete 'semantic-token-extra-specs
1114                          'semantic-tag-attributes)
1115
1116 (semantic-alias-obsolete 'semantic-token-properties
1117                          'semantic-tag-properties)
1118
1119 (semantic-alias-obsolete 'semantic-token-properties-cdr
1120                          'semantic--tag-properties-cdr)
1121
1122 (semantic-alias-obsolete 'semantic-token-overlay
1123                          'semantic-tag-overlay)
1124
1125 (semantic-alias-obsolete 'semantic-token-overlay-cdr
1126                          'semantic--tag-overlay-cdr)
1127
1128 (semantic-alias-obsolete 'semantic-token-start
1129                          'semantic-tag-start)
1130
1131 (semantic-alias-obsolete 'semantic-token-end
1132                          'semantic-tag-end)
1133
1134 (semantic-alias-obsolete 'semantic-token-extent
1135                          'semantic-tag-bounds)
1136
1137 (semantic-alias-obsolete 'semantic-token-buffer
1138                          'semantic-tag-buffer)
1139
1140 (semantic-alias-obsolete 'semantic-token-put
1141                          'semantic--tag-put-property)
1142
1143 (semantic-alias-obsolete 'semantic-token-put-no-side-effect
1144                          'semantic--tag-put-property-no-side-effect)
1145
1146 (semantic-alias-obsolete 'semantic-token-get
1147                          'semantic--tag-get-property)
1148
1149 (semantic-alias-obsolete 'semantic-token-add-extra-spec
1150                          'semantic-tag-put-attribute)
1151
1152 (semantic-alias-obsolete 'semantic-token-extra-spec
1153                          'semantic-tag-get-attribute)
1154
1155 (semantic-alias-obsolete 'semantic-token-type
1156                          'semantic-tag-type)
1157
1158 (semantic-alias-obsolete 'semantic-token-modifiers
1159                          'semantic-tag-modifiers)
1160
1161 (semantic-alias-obsolete 'semantic-token-docstring
1162                          'semantic-tag-docstring)
1163
1164 (semantic-alias-obsolete 'semantic-token-type-parts
1165                          'semantic-tag-type-members)
1166
1167 (defsubst semantic-token-type-parent (tag)
1168   "Return the parent of the type that TAG describes.
1169 The return value is a list.  A value of nil means no parents.
1170 The `car' of the list is either the parent class, or a list
1171 of parent classes.  The `cdr' of the list is the list of
1172 interfaces, or abstract classes which are parents of TAG."
1173   (cons (semantic-tag-get-attribute tag :superclasses)
1174         (semantic-tag-type-interfaces tag)))
1175 (make-obsolete 'semantic-token-type-parent
1176                "\
1177 use `semantic-tag-type-superclass' \
1178 and `semantic-tag-type-interfaces' instead")
1179
1180 (semantic-alias-obsolete 'semantic-token-type-parent-superclass
1181                          'semantic-tag-type-superclasses)
1182
1183 (semantic-alias-obsolete 'semantic-token-type-parent-implement
1184                          'semantic-tag-type-interfaces)
1185
1186 (semantic-alias-obsolete 'semantic-token-type-extra-specs
1187                          'semantic-tag-attributes)
1188
1189 (semantic-alias-obsolete 'semantic-token-type-extra-spec
1190                          'semantic-tag-get-attribute)
1191
1192 (semantic-alias-obsolete 'semantic-token-type-modifiers
1193                          'semantic-tag-modifiers)
1194
1195 (semantic-alias-obsolete 'semantic-token-function-args
1196                          'semantic-tag-function-arguments)
1197
1198 (semantic-alias-obsolete 'semantic-token-function-extra-specs
1199                          'semantic-tag-attributes)
1200
1201 (semantic-alias-obsolete 'semantic-token-function-extra-spec
1202                          'semantic-tag-get-attribute)
1203
1204 (semantic-alias-obsolete 'semantic-token-function-modifiers
1205                          'semantic-tag-modifiers)
1206
1207 (semantic-alias-obsolete 'semantic-token-function-throws
1208                          'semantic-tag-function-throws)
1209
1210 (semantic-alias-obsolete 'semantic-token-function-parent
1211                          'semantic-tag-function-parent)
1212
1213 (semantic-alias-obsolete 'semantic-token-function-destructor
1214                          'semantic-tag-function-destructor-p)
1215
1216 (semantic-alias-obsolete 'semantic-token-variable-default
1217                          'semantic-tag-variable-default)
1218
1219 (semantic-alias-obsolete 'semantic-token-variable-extra-specs
1220                          'semantic-tag-attributes)
1221
1222 (semantic-alias-obsolete 'semantic-token-variable-extra-spec
1223                          'semantic-tag-get-attribute)
1224
1225 (semantic-alias-obsolete 'semantic-token-variable-modifiers
1226                          'semantic-tag-modifiers)
1227
1228 (semantic-alias-obsolete 'semantic-token-variable-const
1229                          'semantic-tag-variable-constant-p)
1230
1231 (semantic-alias-obsolete 'semantic-token-variable-optsuffix
1232                          'semantic-tag-variable-optsuffix)
1233
1234 (semantic-alias-obsolete 'semantic-token-include-system
1235                          'semantic-tag-include-system-p)
1236
1237 (semantic-alias-obsolete 'semantic-token-p
1238                          'semantic-tag-p)
1239
1240 (semantic-alias-obsolete 'semantic-token-with-position-p
1241                          'semantic-tag-with-position-p)
1242
1243 (semantic-alias-obsolete 'semantic-tag-make-assoc-list
1244                          'semantic-tag-make-plist)
1245
1246 (semantic-alias-obsolete 'semantic-nonterminal-children
1247                          'semantic-tag-children-compatibility)
1248
1249 (semantic-alias-obsolete 'semantic-narrow-to-token
1250                          'semantic-narrow-to-tag)
1251
1252 (semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token
1253                          'semantic-with-buffer-narrowed-to-current-tag)
1254
1255 (semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token
1256                          'semantic-with-buffer-narrowed-to-tag)
1257
1258 (semantic-alias-obsolete 'semantic-deoverlay-token
1259                          'semantic--tag-unlink-from-buffer)
1260
1261 (semantic-alias-obsolete 'semantic-overlay-token
1262                          'semantic--tag-link-to-buffer)
1263
1264 (semantic-alias-obsolete 'semantic-deoverlay-list
1265                          'semantic--tag-unlink-list-from-buffer)
1266
1267 (semantic-alias-obsolete 'semantic-overlay-list
1268                          'semantic--tag-link-list-to-buffer)
1269
1270 (semantic-alias-obsolete 'semantic-deoverlay-cache
1271                          'semantic--tag-unlink-cache-from-buffer)
1272
1273 (semantic-alias-obsolete 'semantic-overlay-cache
1274                          'semantic--tag-link-cache-to-buffer)
1275
1276 (semantic-alias-obsolete 'semantic-cooked-token-p
1277                          'semantic--tag-expanded-p)
1278
1279 (semantic-varalias-obsolete 'semantic-expand-nonterminal
1280                             'semantic-tag-expand-function)
1281
1282 (semantic-alias-obsolete 'semantic-raw-to-cooked-token
1283                          'semantic--tag-expand)
1284
1285 ;; Lets test this out during this short transition.
1286 (semantic-alias-obsolete 'semantic-clone-tag
1287                          'semantic-tag-clone)
1288
1289 (semantic-alias-obsolete 'semantic-token
1290                          'semantic-tag)
1291
1292 (semantic-alias-obsolete 'semantic-token-new-variable
1293                          'semantic-tag-new-variable)
1294
1295 (semantic-alias-obsolete 'semantic-token-new-function
1296                          'semantic-tag-new-function)
1297
1298 (semantic-alias-obsolete 'semantic-token-new-type
1299                          'semantic-tag-new-type)
1300
1301 (semantic-alias-obsolete 'semantic-token-new-include
1302                          'semantic-tag-new-include)
1303
1304 (semantic-alias-obsolete 'semantic-token-new-package
1305                          'semantic-tag-new-package)
1306
1307 (semantic-alias-obsolete 'semantic-equivalent-tokens-p
1308                          'semantic-equivalent-tag-p)
1309
1310 (provide 'semantic-tag)
1311
1312 ;;; semantic-tag.el ends here