Mercurial > emacs
changeset 104412:05443eb58935
cedet/semantic.el: Change requires to use semantic/FOO format.
cedet/semantic/fw.el: New file.
cedet/semantic/tag.el: New file.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Fri, 28 Aug 2009 15:01:48 +0000 |
| parents | 11f4ef827ca4 |
| children | 6524f06f3a75 |
| files | lisp/cedet/semantic.el lisp/cedet/semantic/fw.el lisp/cedet/semantic/tag.el |
| diffstat | 3 files changed, 2101 insertions(+), 4 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/cedet/semantic.el Fri Aug 28 14:51:35 2009 +0000 +++ b/lisp/cedet/semantic.el Fri Aug 28 15:01:48 2009 +0000 @@ -36,8 +36,8 @@ ;; (require 'working) (require 'assoc) -(require 'semantic-tag) -(require 'semantic-lex) +(require 'semantic/tag) +(require 'semantic/lex) (declare-function inversion-test "inversion") @@ -66,7 +66,7 @@ "Faces used for Semantic enabled tools." :group 'semantic) -(require 'semantic-fw) +(require 'semantic/fw) ;;; Code: ;; @@ -842,4 +842,4 @@ ;; Semantic-util is a part of the semantic API. Include it last ;; because it depends on semantic. -(require 'semantic-util) +(require 'semantic/util)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/fw.el Fri Aug 28 15:01:48 2009 +0000 @@ -0,0 +1,528 @@ +;;; semantic-fw.el --- Framework for Semantic + +;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;;; 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Semantic has several core features shared across it's lex/parse/util +;; stages. This used to clutter semantic.el some. These routines are all +;; simple things that are not parser specific, but aid in making +;; semantic flexible and compatible amongst different Emacs platforms. + +;;; Code: +;; +(require 'mode-local) +(require 'eieio) + +;;; Compatibility +;; +(if (featurep 'xemacs) + (progn + (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer) + (defalias 'semantic-overlay-live-p + (lambda (o) + (and (extent-live-p o) + (not (extent-detached-p o)) + (bufferp (extent-buffer o))))) + (defalias 'semantic-make-overlay + (lambda (beg end &optional buffer &rest rest) + "Xemacs `make-extent', supporting the front/rear advance options." + (let ((ol (make-extent beg end buffer))) + (when rest + (set-extent-property ol 'start-open (car rest)) + (setq rest (cdr rest))) + (when rest + (set-extent-property ol 'end-open (car rest))) + ol))) + (defalias 'semantic-overlay-put 'set-extent-property) + (defalias 'semantic-overlay-get 'extent-property) + (defalias 'semantic-overlay-properties 'extent-properties) + (defalias 'semantic-overlay-move 'set-extent-endpoints) + (defalias 'semantic-overlay-delete 'delete-extent) + (defalias 'semantic-overlays-at + (lambda (pos) + (condition-case nil + (extent-list nil pos pos) + (error nil)) + )) + (defalias 'semantic-overlays-in + (lambda (beg end) (extent-list nil beg end))) + (defalias 'semantic-overlay-buffer 'extent-buffer) + (defalias 'semantic-overlay-start 'extent-start-position) + (defalias 'semantic-overlay-end 'extent-end-position) + (defalias 'semantic-overlay-size 'extent-length) + (defalias 'semantic-overlay-next-change 'next-extent-change) + (defalias 'semantic-overlay-previous-change 'previous-extent-change) + (defalias 'semantic-overlay-lists + (lambda () (list (extent-list)))) + (defalias 'semantic-overlay-p 'extentp) + (defalias 'semantic-event-window 'event-window) + (defun semantic-read-event () + (let ((event (next-command-event))) + (if (key-press-event-p event) + (let ((c (event-to-character event))) + (if (char-equal c (quit-char)) + (keyboard-quit) + c))) + event)) + (defun semantic-popup-menu (menu) + "Blockinig version of `popup-menu'" + (popup-menu menu) + ;; Wait... + (while (popup-up-p) (dispatch-event (next-event)))) + ) + ;; Emacs Bindings + (defalias 'semantic-buffer-local-value 'buffer-local-value) + (defalias 'semantic-overlay-live-p 'overlay-buffer) + (defalias 'semantic-make-overlay 'make-overlay) + (defalias 'semantic-overlay-put 'overlay-put) + (defalias 'semantic-overlay-get 'overlay-get) + (defalias 'semantic-overlay-properties 'overlay-properties) + (defalias 'semantic-overlay-move 'move-overlay) + (defalias 'semantic-overlay-delete 'delete-overlay) + (defalias 'semantic-overlays-at 'overlays-at) + (defalias 'semantic-overlays-in 'overlays-in) + (defalias 'semantic-overlay-buffer 'overlay-buffer) + (defalias 'semantic-overlay-start 'overlay-start) + (defalias 'semantic-overlay-end 'overlay-end) + (defalias 'semantic-overlay-size 'overlay-size) + (defalias 'semantic-overlay-next-change 'next-overlay-change) + (defalias 'semantic-overlay-previous-change 'previous-overlay-change) + (defalias 'semantic-overlay-lists 'overlay-lists) + (defalias 'semantic-overlay-p 'overlayp) + (defalias 'semantic-read-event 'read-event) + (defalias 'semantic-popup-menu 'popup-menu) + (defun semantic-event-window (event) + "Extract the window from EVENT." + (car (car (cdr event)))) + ) + +(if (and (not (featurep 'xemacs)) + (>= emacs-major-version 21)) + (defalias 'semantic-make-local-hook 'identity) + (defalias 'semantic-make-local-hook 'make-local-hook) + ) + +(if (featurep 'xemacs) + (defalias 'semantic-mode-line-update 'redraw-modeline) + (defalias 'semantic-mode-line-update 'force-mode-line-update)) + +;; Since Emacs 22 major mode functions should use `run-mode-hooks' to +;; run major mode hooks. +(defalias 'semantic-run-mode-hooks + (if (fboundp 'run-mode-hooks) + 'run-mode-hooks + 'run-hooks)) + +;; Fancy compat useage now handled in cedet-compat +(defalias 'semantic-subst-char-in-string 'subst-char-in-string) + + +(defun semantic-delete-overlay-maybe (overlay) + "Delete OVERLAY if it is a semantic token overlay." + (if (semantic-overlay-get overlay 'semantic) + (semantic-overlay-delete overlay))) + +(defalias 'semantic-compile-warn + (eval-when-compile + (if (fboundp 'byte-compile-warn) + 'byte-compile-warn + 'message))) + +(if (not (fboundp 'string-to-number)) + (defalias 'string-to-number 'string-to-int)) + +;;; Menu Item compatibility +;; +(defun semantic-menu-item (item) + "Build an XEmacs compatible menu item from vector ITEM. +That is remove the unsupported :help stuff." + (if (featurep 'xemacs) + (let ((n (length item)) + (i 0) + slot l) + (while (< i n) + (setq slot (aref item i)) + (if (and (keywordp slot) + (eq slot :help)) + (setq i (1+ i)) + (setq l (cons slot l))) + (setq i (1+ i))) + (apply #'vector (nreverse l))) + item)) + +;;; Positional Data Cache +;; +(defvar semantic-cache-data-overlays nil + "List of all overlays waiting to be flushed.") + +(defun semantic-cache-data-to-buffer (buffer start end value name &optional lifespan) + "In BUFFER over the region START END, remember VALUE. +NAME specifies a special name that can be searched for later to +recover the cached data with `semantic-get-cache-data'. +LIFESPAN indicates how long the data cache will be remembered. +The default LIFESPAN is 'end-of-command. +Possible Lifespans are: + 'end-of-command - Remove the cache at the end of the currently + executing command. + 'exit-cache-zone - Remove when point leaves the overlay at the + end of the currently executing command." + ;; Check if LIFESPAN is valid before to create any overlay + (or lifespan (setq lifespan 'end-of-command)) + (or (memq lifespan '(end-of-command exit-cache-zone)) + (error "semantic-cache-data-to-buffer: Unknown LIFESPAN: %s" + lifespan)) + (let ((o (semantic-make-overlay start end buffer))) + (semantic-overlay-put o 'cache-name name) + (semantic-overlay-put o 'cached-value value) + (semantic-overlay-put o 'lifespan lifespan) + (setq semantic-cache-data-overlays + (cons o semantic-cache-data-overlays)) + ;;(message "Adding to cache: %s" o) + (add-hook 'post-command-hook 'semantic-cache-data-post-command-hook) + )) + +(defun semantic-cache-data-post-command-hook () + "Flush `semantic-cache-data-overlays' based 'lifespan property. +Remove self from `post-command-hook' if it is empty." + (let ((newcache nil) + (oldcache semantic-cache-data-overlays)) + (while oldcache + (let* ((o (car oldcache)) + (life (semantic-overlay-get o 'lifespan)) + ) + (if (or (eq life 'end-of-command) + (and (eq life 'exit-cache-zone) + (not (member o (semantic-overlays-at (point)))))) + (progn + ;;(message "Removing from cache: %s" o) + (semantic-overlay-delete o) + ) + (setq newcache (cons o newcache)))) + (setq oldcache (cdr oldcache))) + (setq semantic-cache-data-overlays (nreverse newcache))) + + ;; Remove ourselves if we have removed all overlays. + (unless semantic-cache-data-overlays + (remove-hook 'post-command-hook + 'semantic-cache-data-post-command-hook))) + +(defun semantic-get-cache-data (name &optional point) + "Get cached data with NAME from optional POINT." + (save-excursion + (if point (goto-char point)) + (let ((o (semantic-overlays-at (point))) + (ans nil)) + (while (and (not ans) o) + (if (equal (semantic-overlay-get (car o) 'cache-name) name) + (setq ans (car o)) + (setq o (cdr o)))) + (when ans + (semantic-overlay-get ans 'cached-value))))) + +(defun semantic-test-data-cache () + "Test the data cache." + (interactive) + (let ((data '(a b c))) + (save-excursion + (set-buffer (get-buffer-create " *semantic-test-data-cache*")) + (erase-buffer) + (insert "The Moose is Loose") + (goto-char (point-min)) + (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5) + data 'moose 'exit-cache-zone) + (if (equal (semantic-get-cache-data 'moose) data) + (message "Successfully retrieved cached data.") + (error "Failed to retrieve cached data")) + ))) + +;;; Obsoleting various functions & variables +;; +(defun semantic-overload-symbol-from-function (name) + "Return the symbol for overload used by NAME, the defined symbol." + (let ((sym-name (symbol-name name))) + (if (string-match "^semantic-" sym-name) + (intern (substring sym-name (match-end 0))) + name))) + +(defun semantic-alias-obsolete (oldfnalias newfn) + "Make OLDFNALIAS an alias for NEWFN. +Mark OLDFNALIAS as obsolete, such that the byte compiler +will throw a warning when it encounters this symbol." + (defalias oldfnalias newfn) + (make-obsolete oldfnalias newfn) + (when (and (function-overload-p newfn) + (not (overload-obsoleted-by newfn)) + ;; Only throw this warning when byte compiling things. + (boundp 'byte-compile-current-file) + byte-compile-current-file + (not (string-match "cedet" byte-compile-current-file)) + ) + (make-obsolete-overload oldfnalias newfn) + (semantic-compile-warn + "%s: `%s' obsoletes overload `%s'" + byte-compile-current-file + newfn + (semantic-overload-symbol-from-function oldfnalias)) + )) + +(defun semantic-varalias-obsolete (oldvaralias newvar) + "Make OLDVARALIAS an alias for variable NEWVAR. +Mark OLDVARALIAS as obsolete, such that the byte compiler +will throw a warning when it encounters this symbol." + (make-obsolete-variable oldvaralias newvar) + (condition-case nil + (defvaralias oldvaralias newvar) + (error + ;; Only throw this warning when byte compiling things. + (when (and (boundp 'byte-compile-current-file) + byte-compile-current-file) + (semantic-compile-warn + "variable `%s' obsoletes, but isn't alias of `%s'" + newvar oldvaralias) + )))) + +;;; Help debugging +;; +(defmacro semantic-safe (format &rest body) + "Turn into a FORMAT message any error caught during eval of BODY. +Return the value of last BODY form or nil if an error occurred. +FORMAT can have a %s escape which will be replaced with the actual +error message. +If `debug-on-error' is set, errors are not caught, so that you can +debug them. +Avoid using a large BODY since it is duplicated." + ;;(declare (debug t) (indent 1)) + `(if debug-on-error + ;;(let ((inhibit-quit nil)) ,@body) + ;; Note to self: Doing the above screws up the wisent parser. + (progn ,@body) + (condition-case err + (progn ,@body) + (error + (message ,format (format "%S - %s" (current-buffer) + (error-message-string err))) + nil)))) +(put 'semantic-safe 'lisp-indent-function 1) + +;;; Misc utilities +;; +(defsubst semantic-map-buffers (function) + "Run FUNCTION for each Semantic enabled buffer found. +FUNCTION does not have arguments. When FUNCTION is entered +`current-buffer' is a selected Semantic enabled buffer." + (mode-local-map-file-buffers function #'semantic-active-p)) + +(defalias 'semantic-map-mode-buffers + 'mode-local-map-mode-buffers) + +(semantic-alias-obsolete 'semantic-fetch-overload + 'fetch-overload) + +(semantic-alias-obsolete 'define-mode-overload-implementation + 'define-mode-local-override) + +(semantic-alias-obsolete 'semantic-with-mode-bindings + 'with-mode-local) + +(semantic-alias-obsolete 'define-semantic-child-mode + 'define-child-mode) + +(defun semantic-install-function-overrides (overrides &optional transient mode) + "Install the function OVERRIDES in the specified environment. +OVERRIDES must be an alist ((OVERLOAD . FUNCTION) ...) where OVERLOAD +is a symbol identifying an overloadable entry, and FUNCTION is the +function to override it with. +If optional argument TRANSIENT is non-nil, installed overrides can in +turn be overridden by next installation. +If optional argument MODE is non-nil, it must be a major mode symbol. +OVERRIDES will be installed globally for this major mode. If MODE is +nil, OVERRIDES will be installed locally in the current buffer. This +later installation should be done in MODE hook." + (mode-local-bind + ;; Add the semantic- prefix to OVERLOAD short names. + (mapcar + #'(lambda (e) + (let ((name (symbol-name (car e)))) + (if (string-match "^semantic-" name) + e + (cons (intern (format "semantic-%s" name)) (cdr e))))) + overrides) + (list 'constant-flag (not transient) + 'override-flag t) + mode)) + +;;; User Interrupt handling +;; +(defvar semantic-current-input-throw-symbol nil + "The current throw symbol for `semantic-exit-on-input'.") + +(defmacro semantic-exit-on-input (symbol &rest forms) + "Using SYMBOL as an argument to `throw', execute FORMS. +If FORMS includes a call to `semantic-thow-on-input', then +if a user presses any key during execution, this form macro +will exit with the value passed to `semantic-throw-on-input'. +If FORMS completes, then the return value is the same as `progn'." + `(let ((semantic-current-input-throw-symbol ,symbol)) + (catch ,symbol + ,@forms))) +(put 'semantic-exit-on-input 'lisp-indent-function 1) + +(defmacro semantic-throw-on-input (from) + "Exit with `throw' when in `semantic-exit-on-input' on user input. +FROM is an indication of where this function is called from as a value +to pass to `throw'. It is recommended to use the name of the function +calling this one." + `(when (and semantic-current-input-throw-symbol + (or (input-pending-p) (accept-process-output))) + (throw semantic-current-input-throw-symbol ,from))) + +(defun semantic-test-throw-on-input () + "Test that throw on input will work." + (interactive) + (semantic-throw-on-input 'done-die) + (message "Exit Code: %s" + (semantic-exit-on-input 'testing + (let ((inhibit-quit nil) + (message-log-max nil)) + (while t + (message "Looping ... press a key to test") + (semantic-throw-on-input 'test-inner-loop)) + 'exit))) + (when (input-pending-p) + (if (fboundp 'read-event) + (read-event) + (read-char))) + ) + +;;; Special versions of Find File +;; +(defun semantic-find-file-noselect (file &optional nowarn rawfile wildcards) + "Call `find-file-noselect' with various features turned off. +Use this when referencing a file that will be soon deleted. +FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'" + (let* ((recentf-exclude '( (lambda (f) t) )) + ;; This is a brave statement. Don't waste time loading in + ;; lots of modes. Especially decoration mode can waste a lot + ;; of time for a buffer we intend to kill. + (semantic-init-hooks nil) + ;; This disables the part of EDE that asks questions + (ede-auto-add-method 'never) + ;; Ask font-lock to not colorize these buffers, nor to + ;; whine about it either. + (font-lock-maximum-size 0) + (font-lock-verbose nil) + ;; Disable revision control + (vc-handled-backends nil) + ;; Don't prompt to insert a template if we visit an empty file + (auto-insert nil) + ;; We don't want emacs to query about unsafe local variables + (enable-local-variables + (if (featurep 'xemacs) + ;; XEmacs only has nil as an option? + nil + ;; Emacs 23 has the spiffy :safe option, nil otherwise. + (if (>= emacs-major-version 22) + nil + :safe))) + ;; ... or eval variables + (enable-local-eval nil) + ) + (if (featurep 'xemacs) + (find-file-noselect file nowarn rawfile) + (find-file-noselect file nowarn rawfile wildcards)) + )) + + +;;; Editor goodies ;-) +;; +(defconst semantic-fw-font-lock-keywords + (eval-when-compile + (let* ( + ;; Variable declarations + (vl nil) + (kv (if vl (regexp-opt vl t) "")) + ;; Function declarations + (vf '( + "define-lex" + "define-lex-analyzer" + "define-lex-block-analyzer" + "define-lex-regex-analyzer" + "define-lex-spp-macro-declaration-analyzer" + "define-lex-spp-macro-undeclaration-analyzer" + "define-lex-spp-include-analyzer" + "define-lex-simple-regex-analyzer" + "define-lex-keyword-type-analyzer" + "define-lex-sexp-type-analyzer" + "define-lex-regex-type-analyzer" + "define-lex-string-type-analyzer" + "define-lex-block-type-analyzer" + ;;"define-mode-overload-implementation" + ;;"define-semantic-child-mode" + "define-semantic-idle-service" + "define-semantic-decoration-style" + "define-wisent-lexer" + "semantic-alias-obsolete" + "semantic-varalias-obsolete" + "semantic-make-obsolete-overload" + "defcustom-mode-local-semantic-dependency-system-include-path" + )) + (kf (if vf (regexp-opt vf t) "")) + ;; Regexp depths + (kv-depth (if kv (regexp-opt-depth kv) nil)) + (kf-depth (if kf (regexp-opt-depth kf) nil)) + ) + `((,(concat + ;; Declarative things + "(\\(" kv "\\|" kf "\\)" + ;; Whitespaces & names + "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?" + ) + (1 font-lock-keyword-face) + (,(+ 1 kv-depth kf-depth 1) + (cond ((match-beginning 2) + font-lock-type-face) + ((match-beginning ,(+ 1 kv-depth 1)) + font-lock-function-name-face) + ) + nil t) + (,(+ 1 kv-depth kf-depth 1 1) + (cond ((match-beginning 2) + font-lock-variable-name-face) + ) + nil t))) + )) + "Highlighted Semantic keywords.") + +;; (when (fboundp 'font-lock-add-keywords) +;; (font-lock-add-keywords 'emacs-lisp-mode +;; semantic-fw-font-lock-keywords)) + +;;; Interfacing with edebug +;; +(defun semantic-fw-add-edebug-spec () + (def-edebug-spec semantic-exit-on-input 'def-body)) + +(add-hook 'edebug-setup-hook 'semantic-fw-add-edebug-spec) + +(provide 'semantic/fw) + +;;; semantic-fw.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/tag.el Fri Aug 28 15:01:48 2009 +0000 @@ -0,0 +1,1569 @@ +;;; semantic-tag.el --- tag creation and access + +;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, +;;; 2008, 2009 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; I. The core production of semantic is the list of tags produced by the +;; different parsers. This file provides 3 APIs related to tag access: +;; +;; 1) Primitive Tag Access +;; There is a set of common features to all tags. These access +;; functions can get these values. +;; 2) Standard Tag Access +;; A Standard Tag should be produced by most traditional languages +;; with standard styles common to typed object oriented languages. +;; These functions can access these data elements from a tag. +;; 3) Generic Tag Access +;; Access to tag structure in a more direct way. +;; ** May not be forward compatible. +;; +;; II. There is also an API for tag creation. Use `semantic-tag' to create +;; a new tag. +;; +;; III. Tag Comparison. Allows explicit or comparitive tests to see +;; if two tags are the same. + +;;; History: +;; + +;;; Code: +;; + +;; Keep this only so long as we have obsolete fcns. +(require 'semantic/fw) + +(defconst semantic-tag-version semantic-version + "Version string of semantic tags made with this code.") + +(defconst semantic-tag-incompatible-version "1.0" + "Version string of semantic tags which are not currently compatible. +These old style tags may be loaded from a file with semantic db. +In this case, we must flush the old tags and start over.") + +;;; Primitive Tag access system: +;; +;; Raw tags in semantic are lists of 5 elements: +;; +;; (NAME CLASS ATTRIBUTES PROPERTIES OVERLAY) +;; +;; Where: +;; +;; - NAME is a string that represents the tag name. +;; +;; - CLASS is a symbol that represent the class of the tag (for +;; example, usual classes are `type', `function', `variable', +;; `include', `package', `code'). +;; +;; - ATTRIBUTES is a public list of attributes that describes +;; language data represented by the tag (for example, a variable +;; can have a `:constant-flag' attribute, a function an `:arguments' +;; attribute, etc.). +;; +;; - PROPERTIES is a private list of properties used internally. +;; +;; - OVERLAY represent the location of data described by the tag. +;; + +(defsubst semantic-tag-name (tag) + "Return the name of TAG. +For functions, variables, classes, typedefs, etc., this is the identifier +that is being defined. For tags without an obvious associated name, this +may be the statement type, e.g., this may return @code{print} for python's +print statement." + (car tag)) + +(defsubst semantic-tag-class (tag) + "Return the class of TAG. +That is, the symbol 'variable, 'function, 'type, or other. +There is no limit to the symbols that may represent the class of a tag. +Each parser generates tags with classes defined by it. + +For functional languages, typical tag classes are: + +@table @code +@item type +Data types, named map for a memory block. +@item function +A function or method, or named execution location. +@item variable +A variable, or named storage for data. +@item include +Statement that represents a file from which more tags can be found. +@item package +Statement that declairs this file's package name. +@item code +Code that has not name or binding to any other symbol, such as in a script. +@end table +" + (nth 1 tag)) + +(defsubst semantic-tag-attributes (tag) + "Return the list of public attributes of TAG. +That is a property list: (ATTRIBUTE-1 VALUE-1 ATTRIBUTE-2 VALUE-2...)." + (nth 2 tag)) + +(defsubst semantic-tag-properties (tag) + "Return the list of private properties of TAG. +That is a property list: (PROPERTY-1 VALUE-1 PROPERTY-2 VALUE-2...)." + (nth 3 tag)) + +(defsubst semantic-tag-overlay (tag) + "Return the OVERLAY part of TAG. +That is, an overlay or an unloaded buffer representation. +This function can also return an array of the form [ START END ]. +This occurs for tags that are not currently linked into a buffer." + (nth 4 tag)) + +(defsubst semantic--tag-overlay-cdr (tag) + "Return the cons cell whose car is the OVERLAY part of TAG. +That function is for internal use only." + (nthcdr 4 tag)) + +(defsubst semantic--tag-set-overlay (tag overlay) + "Set the overlay part of TAG with OVERLAY. +That function is for internal use only." + (setcar (semantic--tag-overlay-cdr tag) overlay)) + +(defsubst semantic-tag-start (tag) + "Return the start location of TAG." + (let ((o (semantic-tag-overlay tag))) + (if (semantic-overlay-p o) + (semantic-overlay-start o) + (aref o 0)))) + +(defsubst semantic-tag-end (tag) + "Return the end location of TAG." + (let ((o (semantic-tag-overlay tag))) + (if (semantic-overlay-p o) + (semantic-overlay-end o) + (aref o 1)))) + +(defsubst semantic-tag-bounds (tag) + "Return the location (START END) of data TAG describes." + (list (semantic-tag-start tag) + (semantic-tag-end tag))) + +(defun semantic-tag-set-bounds (tag start end) + "In TAG, set the START and END location of data it describes." + (let ((o (semantic-tag-overlay tag))) + (if (semantic-overlay-p o) + (semantic-overlay-move o start end) + (semantic--tag-set-overlay tag (vector start end))))) + +(defun semantic-tag-in-buffer-p (tag) + "Return the buffer TAG resides in IFF tag is already in a buffer. +If a tag is not in a buffer, return nil." + (let ((o (semantic-tag-overlay tag))) + ;; TAG is currently linked to a buffer, return it. + (when (and (semantic-overlay-p o) + (semantic-overlay-live-p o)) + (semantic-overlay-buffer o)))) + +(defsubst semantic--tag-get-property (tag property) + "From TAG, extract the value of PROPERTY. +Return the value found, or nil if PROPERTY is not one of the +properties of TAG. +That function is for internal use only." + (plist-get (semantic-tag-properties tag) property)) + +(defun semantic-tag-buffer (tag) + "Return the buffer TAG resides in. +If TAG has an originating file, read that file into a (maybe new) +buffer, and return it. +Return nil if there is no buffer for this tag." + (let ((buff (semantic-tag-in-buffer-p tag))) + (if buff + buff + ;; TAG has an originating file, read that file into a buffer, and + ;; return it. + (if (semantic--tag-get-property tag :filename) + (find-file-noselect (semantic--tag-get-property tag :filename)) + ;; TAG is not in Emacs right now, no buffer is available. + )))) + +(defun semantic-tag-mode (&optional tag) + "Return the major mode active for TAG. +TAG defaults to the tag at point in current buffer. +If TAG has a :mode property return it. +If point is inside TAG bounds, return the major mode active at point. +Return the major mode active at beginning of TAG otherwise. +See also the function `semantic-ctxt-current-mode'." + (or tag (setq tag (semantic-current-tag))) + (or (semantic--tag-get-property tag :mode) + (let ((buffer (semantic-tag-buffer tag)) + (start (semantic-tag-start tag)) + (end (semantic-tag-end tag))) + (save-excursion + (and buffer (set-buffer buffer)) + ;; Unless point is inside TAG bounds, move it to the + ;; beginning of TAG. + (or (and (>= (point) start) (< (point) end)) + (goto-char start)) + (require 'semantic/ctxt) + (semantic-ctxt-current-mode))))) + +(defsubst semantic--tag-attributes-cdr (tag) + "Return the cons cell whose car is the ATTRIBUTES part of TAG. +That function is for internal use only." + (nthcdr 2 tag)) + +(defsubst semantic-tag-put-attribute (tag attribute value) + "Change value in TAG of ATTRIBUTE to VALUE. +If ATTRIBUTE already exists, its value is set to VALUE, otherwise the +new ATTRIBUTE VALUE pair is added. +Return TAG. +Use this function in a parser when not all attributes are known at the +same time." + (let* ((plist-cdr (semantic--tag-attributes-cdr tag))) + (when (consp plist-cdr) + (setcar plist-cdr + (semantic-tag-make-plist + (plist-put (car plist-cdr) attribute value)))) + tag)) + +(defun semantic-tag-put-attribute-no-side-effect (tag attribute value) + "Change value in TAG of ATTRIBUTE to VALUE without side effects. +All cons cells in the attribute list are replicated so that there +are no side effects if TAG is in shared lists. +If ATTRIBUTE already exists, its value is set to VALUE, otherwise the +new ATTRIBUTE VALUE pair is added. +Return TAG." + (let* ((plist-cdr (semantic--tag-attributes-cdr tag))) + (when (consp plist-cdr) + (setcar plist-cdr + (semantic-tag-make-plist + (plist-put (copy-sequence (car plist-cdr)) + attribute value)))) + tag)) + +(defsubst semantic-tag-get-attribute (tag attribute) + "From TAG, return the value of ATTRIBUTE. +ATTRIBUTE is a symbol whose specification value to get. +Return the value found, or nil if ATTRIBUTE is not one of the +attributes of TAG." + (plist-get (semantic-tag-attributes tag) attribute)) + +;; These functions are for internal use only! +(defsubst semantic--tag-properties-cdr (tag) + "Return the cons cell whose car is the PROPERTIES part of TAG. +That function is for internal use only." + (nthcdr 3 tag)) + +(defun semantic--tag-put-property (tag property value) + "Change value in TAG of PROPERTY to VALUE. +If PROPERTY already exists, its value is set to VALUE, otherwise the +new PROPERTY VALUE pair is added. +Return TAG. +That function is for internal use only." + (let* ((plist-cdr (semantic--tag-properties-cdr tag))) + (when (consp plist-cdr) + (setcar plist-cdr + (semantic-tag-make-plist + (plist-put (car plist-cdr) property value)))) + tag)) + +(defun semantic--tag-put-property-no-side-effect (tag property value) + "Change value in TAG of PROPERTY to VALUE without side effects. +All cons cells in the property list are replicated so that there +are no side effects if TAG is in shared lists. +If PROPERTY already exists, its value is set to VALUE, otherwise the +new PROPERTY VALUE pair is added. +Return TAG. +That function is for internal use only." + (let* ((plist-cdr (semantic--tag-properties-cdr tag))) + (when (consp plist-cdr) + (setcar plist-cdr + (semantic-tag-make-plist + (plist-put (copy-sequence (car plist-cdr)) + property value)))) + tag)) + +(defun semantic-tag-file-name (tag) + "Return the name of the file from which TAG originated. +Return nil if that information can't be obtained. +If TAG is from a loaded buffer, then that buffer's filename is used. +If TAG is unlinked, but has a :filename property, then that is used." + (let ((buffer (semantic-tag-in-buffer-p tag))) + (if buffer + (buffer-file-name buffer) + (semantic--tag-get-property tag :filename)))) + +;;; Tag tests and comparisons. +;; +;;;###autoload +(defsubst semantic-tag-p (tag) + "Return non-nil if TAG is most likely a semantic tag." + (condition-case nil + (and (consp tag) + (stringp (car tag)) ; NAME + (symbolp (nth 1 tag)) (nth 1 tag) ; TAG-CLASS + (listp (nth 2 tag)) ; ATTRIBUTES + (listp (nth 3 tag)) ; PROPERTIES + ) + ;; If an error occurs, then it most certainly is not a tag. + (error nil))) + +(defsubst semantic-tag-of-class-p (tag class) + "Return non-nil if class of TAG is CLASS." + (eq (semantic-tag-class tag) class)) + +(defsubst semantic-tag-type-members (tag) + "Return the members of the type that TAG describes. +That is the value of the `:members' attribute." + (semantic-tag-get-attribute tag :members)) + +(defun semantic-tag-with-position-p (tag) + "Return non-nil if TAG has positional information." + (and (semantic-tag-p tag) + (let ((o (semantic-tag-overlay tag))) + (or (and (semantic-overlay-p o) + (semantic-overlay-live-p o)) + (arrayp o))))) + +(defun semantic-equivalent-tag-p (tag1 tag2) + "Compare TAG1 and TAG2 and return non-nil if they are equivalent. +Use `equal' on elements the name, class, and position. +Use this function if tags are being copied and regrouped to test +for if two tags represent the same thing, but may be constructed +of different cons cells." + (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2)) + (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)) + (or (and (not (semantic-tag-overlay tag1)) + (not (semantic-tag-overlay tag2))) + (and (semantic-tag-overlay tag1) + (semantic-tag-overlay tag2) + (equal (semantic-tag-bounds tag1) + (semantic-tag-bounds tag2)))))) + +(defsubst semantic-tag-type (tag) + "Return the value of the `:type' attribute of TAG. +For a function it would be the data type of the return value. +For a variable, it is the storage type of that variable. +For a data type, the type is the style of datatype, such as +struct or union." + (semantic-tag-get-attribute tag :type)) + +(defun semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes) + "Test to see if TAG1 and TAG2 are similar. +Two tags are similar if their name, datatype, and various attributes +are the same. + +Similar tags that have sub-tags such as arg lists or type members, +are similar w/out checking the sub-list of tags. +Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity." + (let* ((A1 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2)) + (semantic-tag-of-class-p tag1 (semantic-tag-class tag2)) + (semantic-tag-of-type-p tag1 (semantic-tag-type tag2)))) + (attr1 (semantic-tag-attributes tag1)) + (A2 (= (length attr1) (length (semantic-tag-attributes tag2)))) + (A3 t) + ) + (when (and (not A2) ignorable-attributes) + (setq A2 t)) + (while (and A2 attr1 A3) + (let ((a (car attr1)) + (v (car (cdr attr1)))) + + (cond ((or (eq a :type) ;; already tested above. + (memq a ignorable-attributes)) ;; Ignore them... + nil) + + ;; Don't test sublists of tags + ((and (listp v) (semantic-tag-p (car v))) + nil) + + ;; The attributes are not the same? + ((not (equal v (semantic-tag-get-attribute tag2 a))) + (setq A3 nil)) + (t + nil)) + ) + (setq attr1 (cdr (cdr attr1)))) + + (and A1 A2 A3) + )) + +(defun semantic-tag-similar-with-subtags-p (tag1 tag2 &rest ignorable-attributes) + "Test to see if TAG1 and TAG2 are similar. +Uses `semantic-tag-similar-p' but also recurses through sub-tags, such +as argument lists and type members. +Optional argument IGNORABLE-ATTRIBUTES is passed down to +`semantic-tag-similar-p'." + (let ((C1 (semantic-tag-components tag1)) + (C2 (semantic-tag-components tag2)) + ) + (if (or (/= (length C1) (length C2)) + (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes)) + ) + ;; Basic test fails. + nil + ;; Else, check component lists. + (catch 'component-dissimilar + (while C1 + + (if (not (semantic-tag-similar-with-subtags-p + (car C1) (car C2) ignorable-attributes)) + (throw 'component-dissimilar nil)) + + (setq C1 (cdr C1)) + (setq C2 (cdr C2)) + ) + ;; If we made it this far, we are ok. + t) ))) + + +(defun semantic-tag-of-type-p (tag type) + "Compare TAG's type against TYPE. Non nil if equivalent. +TYPE can be a string, or a tag of class 'type. +This can be complex since some tags might have a :type that is a tag, +while other tags might just have a string. This function will also be +return true of TAG's type is compared directly to the declaration of a +data type." + (let* ((tagtype (semantic-tag-type tag)) + (tagtypestring (cond ((stringp tagtype) + tagtype) + ((and (semantic-tag-p tagtype) + (semantic-tag-of-class-p tagtype 'type)) + (semantic-tag-name tagtype)) + (t ""))) + (typestring (cond ((stringp type) + type) + ((and (semantic-tag-p type) + (semantic-tag-of-class-p type 'type)) + (semantic-tag-name type)) + (t ""))) + ) + (and + tagtypestring + (or + ;; Matching strings (input type is string) + (and (stringp type) + (string= tagtypestring type)) + ;; Matching strings (tag type is string) + (and (stringp tagtype) + (string= tagtype typestring)) + ;; Matching tokens, and the type of the type is the same. + (and (string= tagtypestring typestring) + (if (and (semantic-tag-type tagtype) (semantic-tag-type type)) + (equal (semantic-tag-type tagtype) (semantic-tag-type type)) + t)) + )) + )) + +(defun semantic-tag-type-compound-p (tag) + "Return non-nil the type of TAG is compound. +Compound implies a structure or similar data type. +Returns the list of tag members if it is compound." + (let* ((tagtype (semantic-tag-type tag)) + ) + (when (and (semantic-tag-p tagtype) + (semantic-tag-of-class-p tagtype 'type)) + ;; We have the potential of this being a nifty compound type. + (semantic-tag-type-members tagtype) + ))) + +(defun semantic-tag-faux-p (tag) + "Return non-nil if TAG is a FAUX tag. +FAUX tags are created to represent a construct that is +not known to exist in the code. + +Example: When the class browser sees methods to a class, but +cannot find the class, it will create a faux tag to represent the +class to store those methods." + (semantic--tag-get-property tag :faux-flag)) + +;;; Tag creation +;; + +;; Is this function still necessary? +(defun semantic-tag-make-plist (args) + "Create a property list with ARGS. +Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN). +Where KEY is a symbol, and VALUE is the value for that symbol. +The return value will be a new property list, with these KEY/VALUE +pairs eliminated: + + - KEY associated to nil VALUE. + - KEY associated to an empty string VALUE. + - KEY associated to a zero VALUE." + (let (plist key val) + (while args + (setq key (car args) + val (nth 1 args) + args (nthcdr 2 args)) + (or (member val '("" nil)) + (and (numberp val) (zerop val)) + (setq plist (cons key (cons val plist))))) + ;; It is not useful to reverse the new plist. + plist)) + +(defsubst semantic-tag (name class &rest attributes) + "Create a generic semantic tag. +NAME is a string representing the name of this tag. +CLASS is the symbol that represents the class of tag this is, +such as 'variable, or 'function. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (list name class (semantic-tag-make-plist attributes) nil nil)) + +(defsubst semantic-tag-new-variable (name type &optional default-value &rest attributes) + "Create a semantic tag of class 'variable. +NAME is the name of this variable. +TYPE is a string or semantic tag representing the type of this variable. +Optional DEFAULT-VALUE is a string representing the default value of this variable. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'variable + :type type + :default-value default-value + attributes)) + +(defsubst semantic-tag-new-function (name type arg-list &rest attributes) + "Create a semantic tag of class 'function. +NAME is the name of this function. +TYPE is a string or semantic tag representing the type of this function. +ARG-LIST is a list of strings or semantic tags representing the +arguments of this function. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'function + :type type + :arguments arg-list + attributes)) + +(defsubst semantic-tag-new-type (name type members parents &rest attributes) + "Create a semantic tag of class 'type. +NAME is the name of this type. +TYPE is a string or semantic tag representing the type of this type. +MEMBERS is a list of strings or semantic tags representing the +elements that make up this type if it is a composite type. +PARENTS is a cons cell. (EXPLICIT-PARENTS . INTERFACE-PARENTS) +EXPLICIT-PARENTS can be a single string (Just one parent) or a +list of parents (in a multiple inheritance situation). It can also +be nil. +INTERFACE-PARENTS is a list of strings representing the names of +all INTERFACES, or abstract classes inherited from. It can also be +nil. +This slot can be interesting because the form: + ( nil \"string\") +is a valid parent where there is no explicit parent, and only an +interface. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'type + :type type + :members members + :superclasses (car parents) + :interfaces (cdr parents) + attributes)) + +(defsubst semantic-tag-new-include (name system-flag &rest attributes) + "Create a semantic tag of class 'include. +NAME is the name of this include. +SYSTEM-FLAG represents that we were able to identify this include as belonging +to the system, as opposed to belonging to the local project. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'include + :system-flag system-flag + attributes)) + +(defsubst semantic-tag-new-package (name detail &rest attributes) + "Create a semantic tag of class 'package. +NAME is the name of this package. +DETAIL is extra information about this package, such as a location where +it can be found. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'package + :detail detail + attributes)) + +(defsubst semantic-tag-new-code (name detail &rest attributes) + "Create a semantic tag of class 'code. +NAME is a name for this code. +DETAIL is extra information about the code. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'code + :detail detail + attributes)) + +(defsubst semantic-tag-set-faux (tag) + "Set TAG to be a new FAUX tag. +FAUX tags represent constructs not found in the source code. +You can identify a faux tag with `semantic-tag-faux-p'" + (semantic--tag-put-property tag :faux-flag t)) + +(defsubst semantic-tag-set-name (tag name) + "Set TAG name to NAME." + (setcar tag name)) + +;;; Copying and cloning tags. +;; +(defsubst semantic-tag-clone (tag &optional name) + "Clone TAG, creating a new TAG. +If optional argument NAME is not nil it specifies a new name for the +cloned tag." + ;; Right now, TAG is a list. + (list (or name (semantic-tag-name tag)) + (semantic-tag-class tag) + (copy-sequence (semantic-tag-attributes tag)) + (copy-sequence (semantic-tag-properties tag)) + (semantic-tag-overlay tag))) + +(defun semantic-tag-copy (tag &optional name keep-file) + "Return a copy of TAG unlinked from the originating buffer. +If optional argument NAME is non-nil it specifies a new name for the +copied tag. +If optional argument KEEP-FILE is non-nil, and TAG was linked to a +buffer, the originating buffer file name is kept in the `:filename' +property of the copied tag. +If KEEP-FILE is a string, and the orginating buffer is NOT available, +then KEEP-FILE is stored on the `:filename' property. +This runs the tag hook `unlink-copy-hook`." + ;; Right now, TAG is a list. + (let ((copy (semantic-tag-clone tag name))) + + ;; Keep the filename if needed. + (when keep-file + (semantic--tag-put-property + copy :filename (or (semantic-tag-file-name copy) + (and (stringp keep-file) + keep-file) + ))) + + (when (semantic-tag-with-position-p tag) + ;; Convert the overlay to a vector, effectively 'unlinking' the tag. + (semantic--tag-set-overlay + copy (vector (semantic-tag-start copy) (semantic-tag-end copy))) + + ;; Force the children to be copied also. + ;;(let ((chil (semantic--tag-copy-list + ;; (semantic-tag-components-with-overlays tag) + ;; keep-file))) + ;;;; Put the list into TAG. + ;;) + + ;; Call the unlink-copy hook. This should tell tools that + ;; this tag is not part of any buffer. + (when (semantic-overlay-p (semantic-tag-overlay tag)) + (semantic--tag-run-hooks copy 'unlink-copy-hook)) + ) + copy)) + +;;(defun semantic--tag-copy-list (tags &optional keep-file) +;; "Make copies of TAGS and return the list of TAGS." +;; (let ((out nil)) +;; (dolist (tag tags out) +;; (setq out (cons (semantic-tag-copy tag nil keep-file) +;; out)) +;; ))) + +(defun semantic--tag-copy-properties (tag1 tag2) + "Copy private properties from TAG1 to TAG2. +Return TAG2. +This function is for internal use only." + (let ((plist (semantic-tag-properties tag1))) + (while plist + (semantic--tag-put-property tag2 (car plist) (nth 1 plist)) + (setq plist (nthcdr 2 plist))) + tag2)) + +;;; DEEP COPIES +;; +(defun semantic-tag-deep-copy-one-tag (tag &optional filter) + "Make a deep copy of TAG, applying FILTER to each child-tag. +Properties and overlay info are not copied. +FILTER takes TAG as an argument, and should returns a semantic-tag. +It is safe for FILTER to modify the input tag and return it." + (when (not filter) (setq filter 'identity)) + (when (not (semantic-tag-p tag)) + (signal 'wrong-type-argument (list tag 'semantic-tag-p))) + (funcall filter (list (semantic-tag-name tag) + (semantic-tag-class tag) + (semantic--tag-deep-copy-attributes + (semantic-tag-attributes tag) filter) + nil + nil))) + +(defun semantic--tag-deep-copy-attributes (attrs &optional filter) + "Make a deep copy of ATTRS, applying FILTER to each child-tag. + +It is safe to modify ATTR, and return a permutaion of that list. + +FILTER takes TAG as an argument, and should returns a semantic-tag. +It is safe for FILTER to modify the input tag and return it." + (when (car attrs) + (when (not (symbolp (car attrs))) (error "Bad Attribute List in tag")) + (cons (car attrs) + (cons (semantic--tag-deep-copy-value (nth 1 attrs) filter) + (semantic--tag-deep-copy-attributes (nthcdr 2 attrs) filter))))) + +(defun semantic--tag-deep-copy-value (value &optional filter) + "Make a deep copy of VALUE, applying FILTER to each child-tag. + +It is safe to modify VALUE, and return a permutaion of that list. + +FILTER takes TAG as an argument, and should returns a semantic-tag. +It is safe for FILTER to modify the input tag and return it." + (cond + ;; Another tag. + ((semantic-tag-p value) + (semantic-tag-deep-copy-one-tag value filter)) + + ;; A list of more tags + ((and (listp value) (semantic-tag-p (car value))) + (semantic--tag-deep-copy-tag-list value filter)) + + ;; Some arbitrary data. + (t value))) + +(defun semantic--tag-deep-copy-tag-list (tags &optional filter) + "Make a deep copy of TAGS, applying FILTER to each child-tag. + +It is safe to modify the TAGS list, and return a permutaion of that list. + +FILTER takes TAG as an argument, and should returns a semantic-tag. +It is safe for FILTER to modify the input tag and return it." + (when (car tags) + (if (semantic-tag-p (car tags)) + (cons (semantic-tag-deep-copy-one-tag (car tags) filter) + (semantic--tag-deep-copy-tag-list (cdr tags) filter)) + (cons (car tags) (semantic--tag-deep-copy-tag-list (cdr tags) filter))))) + + +;;; Standard Tag Access +;; + +;;; Common +;; + +(defsubst semantic-tag-modifiers (tag) + "Return the value of the `:typemodifiers' attribute of TAG." + (semantic-tag-get-attribute tag :typemodifiers)) + +(defun semantic-tag-docstring (tag &optional buffer) + "Return the documentation of TAG. +That is the value defined by the `:documentation' attribute. +Optional argument BUFFER indicates where to get the text from. +If not provided, then only the POSITION can be provided. + +If you want to get documentation for languages that do not store +the documentation string in the tag itself, use +`semantic-documentation-for-tag' instead." + (let ((p (semantic-tag-get-attribute tag :documentation))) + (cond + ((stringp p) p) ;; it is the doc string. + + ((semantic-lex-token-with-text-p p) + (semantic-lex-token-text p)) + + ((and (semantic-lex-token-without-text-p p) + buffer) + (with-current-buffer buffer + (semantic-lex-token-text (car (semantic-lex p (1+ p)))))) + + (t nil)))) + +;;; Generic attributes for tags of any class. +;; +(defsubst semantic-tag-named-parent (tag) + "Return the parent of TAG. +That is the value of the `:parent' attribute. +If a definition can occur outside an actual parent structure, but +refers to that parent by name, then the :parent attribute should be used." + (semantic-tag-get-attribute tag :parent)) + +;;; Tags of class `type' + +(defun semantic-tag-type-superclasses (tag) + "Return the list of superclass names of the type that TAG describes." + (let ((supers (semantic-tag-get-attribute tag :superclasses))) + (cond ((stringp supers) + ;; If we have a string, make it a list. + (list supers)) + ((semantic-tag-p supers) + ;; If we have one tag, return just the name. + (list (semantic-tag-name supers))) + ((and (consp supers) (semantic-tag-p (car supers))) + ;; If we have a tag list, then return the names. + (mapcar (lambda (s) (semantic-tag-name s)) + supers)) + ((consp supers) + ;; A list of something, return it. + supers)))) + +(defun semantic--tag-find-parent-by-name (name supers) + "Find the superclass NAME in the list of SUPERS. +If a simple search doesn't do it, try splitting up the names +in SUPERS." + (let ((stag nil)) + (setq stag (semantic-find-first-tag-by-name name supers)) + + (when (not stag) + (dolist (S supers) + (let* ((sname (semantic-tag-name S)) + (splitparts (semantic-analyze-split-name sname)) + (parts (if (stringp splitparts) + (list splitparts) + (nreverse splitparts)))) + (when (string= name (car parts)) + (setq stag S)) + ))) + + stag)) + +(defun semantic-tag-type-superclass-protection (tag parentstring) + "Return the inheritance protection in TAG from PARENTSTRING. +PARENTSTRING is the name of the parent being inherited. +The return protection is a symbol, 'public, 'protection, and 'private." + (let ((supers (semantic-tag-get-attribute tag :superclasses))) + (cond ((stringp supers) + 'public) + ((semantic-tag-p supers) + (let ((prot (semantic-tag-get-attribute supers :protection))) + (or (cdr (assoc prot '(("public" . public) + ("protected" . protected) + ("private" . private)))) + 'public))) + ((and (consp supers) (stringp (car supers))) + 'public) + ((and (consp supers) (semantic-tag-p (car supers))) + (let* ((stag (semantic--tag-find-parent-by-name parentstring supers)) + (prot (when stag + (semantic-tag-get-attribute stag :protection)))) + (or (cdr (assoc prot '(("public" . public) + ("protected" . protected) + ("private" . private)))) + (when (equal prot "unspecified") + (if (semantic-tag-of-type-p tag "class") + 'private + 'public)) + 'public)))) + )) + +(defsubst semantic-tag-type-interfaces (tag) + "Return the list of interfaces of the type that TAG describes." + ;; @todo - make this as robust as the above. + (semantic-tag-get-attribute tag :interfaces)) + +;;; Tags of class `function' +;; +(defsubst semantic-tag-function-arguments (tag) + "Return the arguments of the function that TAG describes. +That is the value of the `:arguments' attribute." + (semantic-tag-get-attribute tag :arguments)) + +(defsubst semantic-tag-function-throws (tag) + "Return the exceptions the function that TAG describes can throw. +That is the value of the `:throws' attribute." + (semantic-tag-get-attribute tag :throws)) + +(defsubst semantic-tag-function-parent (tag) + "Return the parent of the function that TAG describes. +That is the value of the `:parent' attribute. +A function has a parent if it is a method of a class, and if the +function does not appear in body of it's parent class." + (semantic-tag-named-parent tag)) + +(defsubst semantic-tag-function-destructor-p (tag) + "Return non-nil if TAG describes a destructor function. +That is the value of the `:destructor-flag' attribute." + (semantic-tag-get-attribute tag :destructor-flag)) + +(defsubst semantic-tag-function-constructor-p (tag) + "Return non-nil if TAG describes a constructor function. +That is the value of the `:constructor-flag' attribute." + (semantic-tag-get-attribute tag :constructor-flag)) + +;;; Tags of class `variable' +;; +(defsubst semantic-tag-variable-default (tag) + "Return the default value of the variable that TAG describes. +That is the value of the attribute `:default-value'." + (semantic-tag-get-attribute tag :default-value)) + +(defsubst semantic-tag-variable-constant-p (tag) + "Return non-nil if the variable that TAG describes is a constant. +That is the value of the attribute `:constant-flag'." + (semantic-tag-get-attribute tag :constant-flag)) + +;;; Tags of class `include' +;; +(defsubst semantic-tag-include-system-p (tag) + "Return non-nil if the include that TAG describes is a system include. +That is the value of the attribute `:system-flag'." + (semantic-tag-get-attribute tag :system-flag)) + +(define-overloadable-function semantic-tag-include-filename (tag) + "Return a filename representation of TAG. +The default action is to return the `semantic-tag-name'. +Some languages do not use full filenames in their include statements. +Override this method to translate the code represenation +into a filename. (A relative filename if necessary.) + +See `semantic-dependency-tag-file' to expand an include +tag to a full file name.") + +(defun semantic-tag-include-filename-default (tag) + "Return a filename representation of TAG. +Returns `semantic-tag-name'." + (semantic-tag-name tag)) + +;;; Tags of class `code' +;; +(defsubst semantic-tag-code-detail (tag) + "Return detail information from code that TAG describes. +That is the value of the attribute `:detail'." + (semantic-tag-get-attribute tag :detail)) + +;;; Tags of class `alias' +;; +(defsubst semantic-tag-new-alias (name meta-tag-class value &rest attributes) + "Create a semantic tag of class alias. +NAME is a name for this alias. +META-TAG-CLASS is the class of the tag this tag is an alias. +VALUE is the aliased definition. +ATTRIBUTES is a list of additional attributes belonging to this tag." + (apply 'semantic-tag name 'alias + :aliasclass meta-tag-class + :definition value + attributes)) + +(defsubst semantic-tag-alias-class (tag) + "Return the class of tag TAG is an alias." + (semantic-tag-get-attribute tag :aliasclass)) + +;;;###autoload +(define-overloadable-function semantic-tag-alias-definition (tag) + "Return the definition TAG is an alias. +The returned value is a tag of the class that +`semantic-tag-alias-class' returns for TAG. +The default is to return the value of the :definition attribute. +Return nil if TAG is not of class 'alias." + (when (semantic-tag-of-class-p tag 'alias) + (:override + (semantic-tag-get-attribute tag :definition)))) + +;;; Language Specific Tag access via overload +;; +;;;###autoload +(define-overloadable-function semantic-tag-components (tag) + "Return a list of components for TAG. +A Component is a part of TAG which itself may be a TAG. +Examples include the elements of a structure in a +tag of class `type, or the list of arguments to a +tag of class 'function." + ) + +(defun semantic-tag-components-default (tag) + "Return a list of components for TAG. +Perform the described task in `semantic-tag-components'." + (cond ((semantic-tag-of-class-p tag 'type) + (semantic-tag-type-members tag)) + ((semantic-tag-of-class-p tag 'function) + (semantic-tag-function-arguments tag)) + (t nil))) + +;;;###autoload +(define-overloadable-function semantic-tag-components-with-overlays (tag) + "Return the list of top level components belonging to TAG. +Children are any sub-tags which contain overlays. + +Default behavior is to get `semantic-tag-components' in addition +to the components of an anonymous types (if applicable.) + +Note for language authors: + If a mode defines a language tag that has tags in it with overlays +you should still return them with this function. +Ignoring this step will prevent several features from working correctly." + ) + +(defun semantic-tag-components-with-overlays-default (tag) + "Return the list of top level components belonging to TAG. +Children are any sub-tags which contain overlays. +The default action collects regular components of TAG, in addition +to any components beloning to an anonymous type." + (let ((explicit-children (semantic-tag-components tag)) + (type (semantic-tag-type tag)) + (anon-type-children nil) + (all-children nil)) + ;; Identify if this tag has an anonymous structure as + ;; its type. This implies it may have children with overlays. + (when (and type (semantic-tag-p type)) + (setq anon-type-children (semantic-tag-components type)) + ;; Add anonymous children + (while anon-type-children + (when (semantic-tag-with-position-p (car anon-type-children)) + (setq all-children (cons (car anon-type-children) all-children))) + (setq anon-type-children (cdr anon-type-children)))) + ;; Add explicit children + (while explicit-children + (when (semantic-tag-with-position-p (car explicit-children)) + (setq all-children (cons (car explicit-children) all-children))) + (setq explicit-children (cdr explicit-children))) + ;; Return + (nreverse all-children))) + +(defun semantic-tag-children-compatibility (tag &optional positiononly) + "Return children of TAG. +If POSITIONONLY is nil, use `semantic-tag-components'. +If POSITIONONLY is non-nil, use `semantic-tag-components-with-overlays'. +DO NOT use this fcn in new code. Use one of the above instead." + (if positiononly + (semantic-tag-components-with-overlays tag) + (semantic-tag-components tag))) + +;;; Tag Region +;; +;; A Tag represents a region in a buffer. You can narrow to that tag. +;; +(defun semantic-narrow-to-tag (&optional tag) + "Narrow to the region specified by the bounds of TAG. +See `semantic-tag-bounds'." + (interactive) + (if (not tag) (setq tag (semantic-current-tag))) + (narrow-to-region (semantic-tag-start tag) + (semantic-tag-end tag))) + +(defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body) + "Execute BODY with the buffer narrowed to the current tag." + `(save-restriction + (semantic-narrow-to-tag (semantic-current-tag)) + ,@body)) +(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0) +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag + (def-body)))) + +(defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body) + "Narrow to TAG, and execute BODY." + `(save-restriction + (semantic-narrow-to-tag ,tag) + ,@body)) +(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1) +(add-hook 'edebug-setup-hook + (lambda () + (def-edebug-spec semantic-with-buffer-narrowed-to-tag + (def-body)))) + +;;; Tag Hooks +;; +;; Semantic may want to provide special hooks when specific operations +;; are about to happen on a given tag. These routines allow for hook +;; maintenance on a tag. + +;; Internal global variable used to manage tag hooks. For example, +;; some implementation of `remove-hook' checks that the hook variable +;; is `default-boundp'. +(defvar semantic--tag-hook-value) + +(defun semantic-tag-add-hook (tag hook function &optional append) + "Onto TAG, add to the value of HOOK the function FUNCTION. +FUNCTION is added (if necessary) at the beginning of the hook list +unless the optional argument APPEND is non-nil, in which case +FUNCTION is added at the end. +HOOK should be a symbol, and FUNCTION may be any valid function. +See also the function `add-hook'." + (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook))) + (add-hook 'semantic--tag-hook-value function append) + (semantic--tag-put-property tag hook semantic--tag-hook-value) + semantic--tag-hook-value)) + +(defun semantic-tag-remove-hook (tag hook function) + "Onto TAG, remove from the value of HOOK the function FUNCTION. +HOOK should be a symbol, and FUNCTION may be any valid function. If +FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in +the list of hooks to run in HOOK, then nothing is done. +See also the function `remove-hook'." + (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook))) + (remove-hook 'semantic--tag-hook-value function) + (semantic--tag-put-property tag hook semantic--tag-hook-value) + semantic--tag-hook-value)) + +(defun semantic--tag-run-hooks (tag hook &rest args) + "Run for TAG all expressions saved on the property HOOK. +Each hook expression must take at least one argument, the TAG. +For any given situation, additional ARGS may be passed." + (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)) + (arglist (cons tag args))) + (condition-case err + ;; If a hook bombs, ignore it! Usually this is tied into + ;; some sort of critical system. + (apply 'run-hook-with-args 'semantic--tag-hook-value arglist) + (error (message "Error: %S" err))))) + +;;; Tags and Overlays +;; +;; Overlays are used so that we can quickly identify tags from +;; buffer positions and regions using built in Emacs commands. +;; + +(defsubst semantic--tag-unlink-list-from-buffer (tags) + "Convert TAGS from using an overlay to using an overlay proxy. +This function is for internal use only." + (mapcar 'semantic--tag-unlink-from-buffer tags)) + +(defun semantic--tag-unlink-from-buffer (tag) + "Convert TAG from using an overlay to using an overlay proxy. +This function is for internal use only." + (when (semantic-tag-p tag) + (let ((o (semantic-tag-overlay tag))) + (when (semantic-overlay-p o) + (semantic--tag-set-overlay + tag (vector (semantic-overlay-start o) + (semantic-overlay-end o))) + (semantic-overlay-delete o)) + ;; Look for a link hook on TAG. + (semantic--tag-run-hooks tag 'unlink-hook) + ;; Fix the sub-tags which contain overlays. + (semantic--tag-unlink-list-from-buffer + (semantic-tag-components-with-overlays tag))))) + +(defsubst semantic--tag-link-list-to-buffer (tags) + "Convert TAGS from using an overlay proxy to using an overlay. +This function is for internal use only." + (mapcar 'semantic--tag-link-to-buffer tags)) + +(defun semantic--tag-link-to-buffer (tag) + "Convert TAG from using an overlay proxy to using an overlay. +This function is for internal use only." + (when (semantic-tag-p tag) + (let ((o (semantic-tag-overlay tag))) + (when (and (vectorp o) (= (length o) 2)) + (setq o (semantic-make-overlay (aref o 0) (aref o 1) + (current-buffer))) + (semantic--tag-set-overlay tag o) + (semantic-overlay-put o 'semantic tag) + ;; Clear the :filename property + (semantic--tag-put-property tag :filename nil)) + ;; Look for a link hook on TAG. + (semantic--tag-run-hooks tag 'link-hook) + ;; Fix the sub-tags which contain overlays. + (semantic--tag-link-list-to-buffer + (semantic-tag-components-with-overlays tag))))) + +(defun semantic--tag-unlink-cache-from-buffer () + "Convert all tags in the current cache to use overlay proxys. +This function is for internal use only." + (semantic--tag-unlink-list-from-buffer + ;; @todo- use fetch-tags-fast? + (semantic-fetch-tags))) + +(defvar semantic--buffer-cache) + +(defun semantic--tag-link-cache-to-buffer () + "Convert all tags in the current cache to use overlays. +This function is for internal use only." + (condition-case nil + ;; In this unique case, we cannot call the usual toplevel fn. + ;; because we don't want a reparse, we want the old overlays. + (semantic--tag-link-list-to-buffer + semantic--buffer-cache) + ;; Recover when there is an error restoring the cache. + (error (message "Error recovering tag list") + (semantic-clear-toplevel-cache) + nil))) + +;;; Tag Cooking +;; +;; Raw tags from a parser follow a different positional format than +;; those used in the buffer cache. Raw tags need to be cooked into +;; semantic cache friendly tags for use by the masses. +;; +(defsubst semantic--tag-expanded-p (tag) + "Return non-nil if TAG is expanded. +This function is for internal use only. +See also the function `semantic--expand-tag'." + ;; In fact a cooked tag is actually a list of cooked tags + ;; because a raw tag can be expanded in several cooked ones! + (when (consp tag) + (while (and (semantic-tag-p (car tag)) + (vectorp (semantic-tag-overlay (car tag)))) + (setq tag (cdr tag))) + (null tag))) + +(defvar semantic-tag-expand-function nil + "Function used to expand a tag. +It is passed each tag production, and must return a list of tags +derived from it, or nil if it does not need to be expanded. + +Languages with compound definitions should use this function to expand +from one compound symbol into several. For example, in C or Java the +following definition is easily parsed into one tag: + + int a, b; + +This function should take this compound tag and turn it into two tags, +one for A, and the other for B.") +(make-variable-buffer-local 'semantic-tag-expand-function) + +(defun semantic--tag-expand (tag) + "Convert TAG from a raw state to a cooked state, and expand it. +Returns a list of cooked tags. + + The parser returns raw tags with positional data START END at the +end of the tag data structure (a list for now). We convert it from +that to a cooked state that uses an overlay proxy, that is, a vector +\[START END]. + + The raw tag is changed with side effects and maybe expanded in +several derived tags when the variable `semantic-tag-expand-function' +is set. + +This function is for internal use only." + (if (semantic--tag-expanded-p tag) + ;; Just return TAG if it is already expanded (by a grammar + ;; semantic action), or if it isn't recognized as a valid + ;; semantic tag. + tag + + ;; Try to cook the tag. This code will be removed when tag will + ;; be directly created with the right format. + (condition-case nil + (let ((ocdr (semantic--tag-overlay-cdr tag))) + ;; OCDR contains the sub-list of TAG whose car is the + ;; OVERLAY part of TAG. That is, a list (OVERLAY START END). + ;; Convert it into an overlay proxy ([START END]). + (semantic--tag-set-overlay + tag (vector (nth 1 ocdr) (nth 2 ocdr))) + ;; Remove START END positions at end of tag. + (setcdr ocdr nil) + ;; At this point (length TAG) must be 5! + ;;(unless (= (length tag) 5) + ;; (error "Tag expansion failed")) + ) + (error + (message "A Rule must return a single tag-line list!") + (debug tag) + nil)) + +;; @todo - I think we've waited long enough. Lets find out. +;; +;; ;; Compatibility code to be removed in future versions. +;; (unless semantic-tag-expand-function +;; ;; This line throws a byte compiler warning. +;; (setq semantic-tag-expand-function semantic-expand-nonterminal) +;; ) + + ;; Expand based on local configuration + (if semantic-tag-expand-function + (or (funcall semantic-tag-expand-function tag) + (list tag)) + (list tag)))) + +;; Foreign tags +;; +(defmacro semantic-foreign-tag-invalid (tag) + "Signal that TAG is an invalid foreign tag." + `(signal 'wrong-type-argument '(semantic-foreign-tag-p ,tag))) + +(defsubst semantic-foreign-tag-p (tag) + "Return non-nil if TAG is a foreign tag. +That is, a tag unlinked from the originating buffer, which carries the +originating buffer file name, and major mode." + (and (semantic-tag-p tag) + (semantic--tag-get-property tag :foreign-flag))) + +(defsubst semantic-foreign-tag-check (tag) + "Check that TAG is a valid foreign tag. +Signal an error if not." + (or (semantic-foreign-tag-p tag) + (semantic-foreign-tag-invalid tag))) + +(defun semantic-foreign-tag (&optional tag) + "Return a copy of TAG as a foreign tag, or nil if it can't be done. +TAG defaults to the tag at point in current buffer. +See also `semantic-foreign-tag-p'." + (or tag (setq tag (semantic-current-tag))) + (when (semantic-tag-p tag) + (let ((ftag (semantic-tag-copy tag nil t)) + ;; Do extra work for the doc strings, since this is a + ;; common use case. + (doc (condition-case nil + (semantic-documentation-for-tag tag) + (error nil)))) + ;; A foreign tag must carry its originating buffer file name! + (when (semantic--tag-get-property ftag :filename) + (semantic--tag-put-property ftag :mode (semantic-tag-mode tag)) + (semantic--tag-put-property ftag :documentation doc) + (semantic--tag-put-property ftag :foreign-flag t) + ftag)))) + +;; High level obtain/insert foreign tag overloads +;; +;;;###autoload +(define-overloadable-function semantic-obtain-foreign-tag (&optional tag) + "Obtain a foreign tag from TAG. +TAG defaults to the tag at point in current buffer. +Return the obtained foreign tag or nil if failed." + (semantic-foreign-tag tag)) + +(defun semantic-insert-foreign-tag-default (foreign-tag) + "Insert FOREIGN-TAG into the current buffer. +The default behavior assumes the current buffer is a language file, +and attempts to insert a prototype/function call." + ;; Long term goal: Have a mechanism for a tempo-like template insert + ;; for the given tag. + (insert (semantic-format-tag-prototype foreign-tag))) + +;;;###autoload +(define-overloadable-function semantic-insert-foreign-tag (foreign-tag) + "Insert FOREIGN-TAG into the current buffer. +Signal an error if FOREIGN-TAG is not a valid foreign tag. +This function is overridable with the symbol `insert-foreign-tag'." + (semantic-foreign-tag-check foreign-tag) + (:override) + (message (semantic-format-tag-summarize foreign-tag))) + +;;; Support log modes here +(define-mode-local-override semantic-insert-foreign-tag + log-edit-mode (foreign-tag) + "Insert foreign tags into log-edit mode." + (insert (concat "(" (semantic-format-tag-name foreign-tag) "): "))) + +(define-mode-local-override semantic-insert-foreign-tag + change-log-mode (foreign-tag) + "Insert foreign tags into log-edit mode." + (insert (concat "(" (semantic-format-tag-name foreign-tag) "): "))) + + +;;; EDEBUG display support +;; +(eval-after-load "cedet-edebug" + '(progn + (cedet-edebug-add-print-override + '(semantic-tag-p object) + '(concat "#<TAG " (semantic-format-tag-name object) ">")) + (cedet-edebug-add-print-override + '(and (listp object) (semantic-tag-p (car object))) + '(cedet-edebug-prin1-recurse object)) + )) + +;;; Compatibility +;; +(defconst semantic-token-version + semantic-tag-version) +(defconst semantic-token-incompatible-version + semantic-tag-incompatible-version) + +(semantic-alias-obsolete 'semantic-token-name + 'semantic-tag-name) + +(semantic-alias-obsolete 'semantic-token-token + 'semantic-tag-class) + +(semantic-alias-obsolete 'semantic-token-extra-specs + 'semantic-tag-attributes) + +(semantic-alias-obsolete 'semantic-token-properties + 'semantic-tag-properties) + +(semantic-alias-obsolete 'semantic-token-properties-cdr + 'semantic--tag-properties-cdr) + +(semantic-alias-obsolete 'semantic-token-overlay + 'semantic-tag-overlay) + +(semantic-alias-obsolete 'semantic-token-overlay-cdr + 'semantic--tag-overlay-cdr) + +(semantic-alias-obsolete 'semantic-token-start + 'semantic-tag-start) + +(semantic-alias-obsolete 'semantic-token-end + 'semantic-tag-end) + +(semantic-alias-obsolete 'semantic-token-extent + 'semantic-tag-bounds) + +(semantic-alias-obsolete 'semantic-token-buffer + 'semantic-tag-buffer) + +(semantic-alias-obsolete 'semantic-token-put + 'semantic--tag-put-property) + +(semantic-alias-obsolete 'semantic-token-put-no-side-effect + 'semantic--tag-put-property-no-side-effect) + +(semantic-alias-obsolete 'semantic-token-get + 'semantic--tag-get-property) + +(semantic-alias-obsolete 'semantic-token-add-extra-spec + 'semantic-tag-put-attribute) + +(semantic-alias-obsolete 'semantic-token-extra-spec + 'semantic-tag-get-attribute) + +(semantic-alias-obsolete 'semantic-token-type + 'semantic-tag-type) + +(semantic-alias-obsolete 'semantic-token-modifiers + 'semantic-tag-modifiers) + +(semantic-alias-obsolete 'semantic-token-docstring + 'semantic-tag-docstring) + +(semantic-alias-obsolete 'semantic-token-type-parts + 'semantic-tag-type-members) + +(defsubst semantic-token-type-parent (tag) + "Return the parent of the type that TAG describes. +The return value is a list. A value of nil means no parents. +The `car' of the list is either the parent class, or a list +of parent classes. The `cdr' of the list is the list of +interfaces, or abstract classes which are parents of TAG." + (cons (semantic-tag-get-attribute tag :superclasses) + (semantic-tag-type-interfaces tag))) +(make-obsolete 'semantic-token-type-parent + "\ +use `semantic-tag-type-superclass' \ +and `semantic-tag-type-interfaces' instead") + +(semantic-alias-obsolete 'semantic-token-type-parent-superclass + 'semantic-tag-type-superclasses) + +(semantic-alias-obsolete 'semantic-token-type-parent-implement + 'semantic-tag-type-interfaces) + +(semantic-alias-obsolete 'semantic-token-type-extra-specs + 'semantic-tag-attributes) + +(semantic-alias-obsolete 'semantic-token-type-extra-spec + 'semantic-tag-get-attribute) + +(semantic-alias-obsolete 'semantic-token-type-modifiers + 'semantic-tag-modifiers) + +(semantic-alias-obsolete 'semantic-token-function-args + 'semantic-tag-function-arguments) + +(semantic-alias-obsolete 'semantic-token-function-extra-specs + 'semantic-tag-attributes) + +(semantic-alias-obsolete 'semantic-token-function-extra-spec + 'semantic-tag-get-attribute) + +(semantic-alias-obsolete 'semantic-token-function-modifiers + 'semantic-tag-modifiers) + +(semantic-alias-obsolete 'semantic-token-function-throws + 'semantic-tag-function-throws) + +(semantic-alias-obsolete 'semantic-token-function-parent + 'semantic-tag-function-parent) + +(semantic-alias-obsolete 'semantic-token-function-destructor + 'semantic-tag-function-destructor-p) + +(semantic-alias-obsolete 'semantic-token-variable-default + 'semantic-tag-variable-default) + +(semantic-alias-obsolete 'semantic-token-variable-extra-specs + 'semantic-tag-attributes) + +(semantic-alias-obsolete 'semantic-token-variable-extra-spec + 'semantic-tag-get-attribute) + +(semantic-alias-obsolete 'semantic-token-variable-modifiers + 'semantic-tag-modifiers) + +(semantic-alias-obsolete 'semantic-token-variable-const + 'semantic-tag-variable-constant-p) + +(semantic-alias-obsolete 'semantic-token-variable-optsuffix + 'semantic-tag-variable-optsuffix) + +(semantic-alias-obsolete 'semantic-token-include-system + 'semantic-tag-include-system-p) + +(semantic-alias-obsolete 'semantic-token-p + 'semantic-tag-p) + +(semantic-alias-obsolete 'semantic-token-with-position-p + 'semantic-tag-with-position-p) + +(semantic-alias-obsolete 'semantic-tag-make-assoc-list + 'semantic-tag-make-plist) + +(semantic-alias-obsolete 'semantic-nonterminal-children + 'semantic-tag-children-compatibility) + +(semantic-alias-obsolete 'semantic-narrow-to-token + 'semantic-narrow-to-tag) + +(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token + 'semantic-with-buffer-narrowed-to-current-tag) + +(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token + 'semantic-with-buffer-narrowed-to-tag) + +(semantic-alias-obsolete 'semantic-deoverlay-token + 'semantic--tag-unlink-from-buffer) + +(semantic-alias-obsolete 'semantic-overlay-token + 'semantic--tag-link-to-buffer) + +(semantic-alias-obsolete 'semantic-deoverlay-list + 'semantic--tag-unlink-list-from-buffer) + +(semantic-alias-obsolete 'semantic-overlay-list + 'semantic--tag-link-list-to-buffer) + +(semantic-alias-obsolete 'semantic-deoverlay-cache + 'semantic--tag-unlink-cache-from-buffer) + +(semantic-alias-obsolete 'semantic-overlay-cache + 'semantic--tag-link-cache-to-buffer) + +(semantic-alias-obsolete 'semantic-cooked-token-p + 'semantic--tag-expanded-p) + +(semantic-varalias-obsolete 'semantic-expand-nonterminal + 'semantic-tag-expand-function) + +(semantic-alias-obsolete 'semantic-raw-to-cooked-token + 'semantic--tag-expand) + +;; Lets test this out during this short transition. +(semantic-alias-obsolete 'semantic-clone-tag + 'semantic-tag-clone) + +(semantic-alias-obsolete 'semantic-token + 'semantic-tag) + +(semantic-alias-obsolete 'semantic-token-new-variable + 'semantic-tag-new-variable) + +(semantic-alias-obsolete 'semantic-token-new-function + 'semantic-tag-new-function) + +(semantic-alias-obsolete 'semantic-token-new-type + 'semantic-tag-new-type) + +(semantic-alias-obsolete 'semantic-token-new-include + 'semantic-tag-new-include) + +(semantic-alias-obsolete 'semantic-token-new-package + 'semantic-tag-new-package) + +(semantic-alias-obsolete 'semantic-equivalent-tokens-p + 'semantic-equivalent-tag-p) + +(provide 'semantic/tag) + +;;; semantic-tag.el ends here