[bpt/emacs.git] / lisp / cedet / semantic / tag-file.el

;;; semantic/tag-file.el --- Routines that find files based on tags.

;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
;;   2009  Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax

;; 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:
;;
;; A tag, by itself, can have representations in several files.
;; These routines will find those files.

(require 'semantic/tag)

(defvar ede-minor-mode)
(declare-function semanticdb-table-child-p "semantic/db" t t)
(declare-function semanticdb-get-buffer "semantic/db")
(declare-function semantic-dependency-find-file-on-path "semantic/dep")
(declare-function ede-toplevel "ede/files")

;;; Code:

;;; Location a TAG came from.
;;
;;;###autoload
(define-overloadable-function semantic-go-to-tag (tag &optional parent)
  "Go to the location of TAG.
TAG may be a stripped element, in which case PARENT specifies a
parent tag that has position information.
PARENT can also be a `semanticdb-table' object."
  (:override
   (save-match-data
     (cond ((semantic-tag-in-buffer-p tag)
	    ;; We have a linked tag, go to that buffer.
	    (set-buffer (semantic-tag-buffer tag)))
	   ((semantic-tag-file-name tag)
	    ;; If it didn't have a buffer, but does have a file
	    ;; name, then we need to get to that file so the tag
	    ;; location is made accurate.
	    (set-buffer (find-file-noselect (semantic-tag-file-name tag))))
	   ((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p parent))
	    ;; The tag had nothing useful, but we have a parent with
	    ;; a buffer, then go there.
	    (set-buffer (semantic-tag-buffer parent)))
	   ((and parent (semantic-tag-p parent) (semantic-tag-file-name parent))
	    ;; Tag had nothing, and the parent only has a file-name, then
	    ;; find that file, and switch to that buffer.
	    (set-buffer (find-file-noselect (semantic-tag-file-name parent))))
	   ((and parent (featurep 'semantic/db)
		 (semanticdb-table-child-p parent))
	    (set-buffer (semanticdb-get-buffer parent)))
	   (t
	    ;; Well, just assume things are in the current buffer.
	    nil
	    )))
   ;; We should be in the correct buffer now, try and figure out
   ;; where the tag is.
   (cond ((semantic-tag-with-position-p tag)
	  ;; If it's a number, go there
	  (goto-char (semantic-tag-start tag)))
	 ((semantic-tag-with-position-p parent)
	  ;; Otherwise, it's a trimmed vector, such as a parameter,
	  ;; or a structure part.  If there is a parent, we can use it
	  ;; as a bounds for searching.
	  (goto-char (semantic-tag-start parent))
	  ;; Here we make an assumption that the text returned by
	  ;; the parser and concocted by us actually exists
	  ;; in the buffer.
	  (re-search-forward (semantic-tag-name tag)
			     (semantic-tag-end parent)
			     t))
	 ((semantic-tag-get-attribute tag :line)
	  ;; The tag has a line number in it.  Go there.
	  (goto-char (point-min))
	  (forward-line (1- (semantic-tag-get-attribute tag :line))))
	 ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line))
	  ;; The tag has a line number in it.  Go there.
	  (goto-char (point-min))
	  (forward-line (1- (semantic-tag-get-attribute parent :line)))
	  (re-search-forward (semantic-tag-name tag) nil t))
	 (t
	  ;; Take a guess that the tag has a unique name, and just
	  ;; search for it from the beginning of the buffer.
	  (goto-char (point-min))
	  (re-search-forward (semantic-tag-name tag) nil t)))
   )
  )

(make-obsolete-overload 'semantic-find-nonterminal
                        'semantic-go-to-tag)

;;; Dependencies
;;
;; A tag which is of type 'include specifies a dependency.
;; Dependencies usually represent a file of some sort.
;; Find the file described by a dependency.

;;;###autoload
(define-overloadable-function semantic-dependency-tag-file (&optional tag)
  "Find the filename represented from TAG.
Depends on `semantic-dependency-include-path' for searching.  Always searches
`.' first, then searches additional paths."
  (or tag (setq tag (car (semantic-find-tag-by-overlay nil))))
  (unless (semantic-tag-of-class-p tag 'include)
    (signal 'wrong-type-argument (list tag 'include)))
  (save-excursion
    (let ((result nil)
	  (default-directory default-directory)
	  (edefind nil)
	  (tag-fname nil))
      (cond ((semantic-tag-in-buffer-p tag)
	     ;; If the tag has an overlay and buffer associated with it,
	     ;; switch to that buffer so that we get the right override metohds.
	     (set-buffer (semantic-tag-buffer tag)))
	    ((semantic-tag-file-name tag)
	     ;; If it didn't have a buffer, but does have a file
	     ;; name, then we need to get to that file so the tag
	     ;; location is made accurate.
	     ;;(set-buffer (find-file-noselect (semantic-tag-file-name tag)))
	     ;;
	     ;; 2/3/08
	     ;; The above causes unnecessary buffer loads all over the place. Ick!
	     ;; All we really need is for 'default-directory' to be set correctly.
	     (setq default-directory (file-name-directory (semantic-tag-file-name tag)))
	     ))
      ;; Setup the filename represented by this include
      (setq tag-fname (semantic-tag-include-filename tag))

      ;; First, see if this file exists in the current EDE project
      (if (and (fboundp 'ede-expand-filename) ede-minor-mode
	       (setq edefind
		     (condition-case nil
			 (let ((proj  (ede-toplevel)))
			   (when proj
			     (ede-expand-filename proj tag-fname)))
		       (error nil))))
	  (setq result edefind))
      (if (not result)
	  (setq result
		;; I don't have a plan for refreshing tags with a dependency
		;; stuck on them somehow.  I'm thinking that putting a cache
		;; onto the dependancy finding with a hash table might be best.
		;;(if (semantic--tag-get-property tag 'dependency-file)
		;;  (semantic--tag-get-property tag 'dependency-file)
		(:override
		 (save-excursion
		   (require 'semantic/dep)
		   (semantic-dependency-find-file-on-path
		    tag-fname (semantic-tag-include-system-p tag))))
		;; )
		))
      (if (stringp result)
	  (progn
	    (semantic--tag-put-property tag 'dependency-file result)
	    result)
	;; @todo: Do something to make this get flushed w/
	;;        when the path is changed.
	;; @undo: Just eliminate
	;; (semantic--tag-put-property tag 'dependency-file 'none)
	nil)
      )))

(make-obsolete-overload 'semantic-find-dependency
                        'semantic-dependency-tag-file)

;;; PROTOTYPE FILE
;;
;; In C, a function in the .c file often has a representation in a
;; corresponding .h file.  This routine attempts to find the
;; prototype file a given source file would be associated with.
;; This can be used by prototype manager programs.
(define-overloadable-function semantic-prototype-file (buffer)
  "Return a file in which prototypes belonging to BUFFER should be placed.
Default behavior (if not overridden) looks for a token specifying the
prototype file, or the existence of an EDE variable indicating which
file prototypes belong in."
  (:override
   ;; Perform some default behaviors
   (if (and (fboundp 'ede-header-file) ede-minor-mode)
       (save-excursion
         (set-buffer buffer)
         (ede-header-file))
     ;; No EDE options for a quick answer.  Search.
     (save-excursion
       (set-buffer buffer)
       (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
           (match-string 1))))))

(semantic-alias-obsolete 'semantic-find-nonterminal
                         'semantic-go-to-tag)

(semantic-alias-obsolete 'semantic-find-dependency
                         'semantic-dependency-tag-file)


(provide 'semantic/tag-file)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-feature: semantic/loaddefs
;; generated-autoload-load-name: "semantic/tag-file"
;; End:

;;; semantic/tag-file.el ends here
Commit	Line	Data
55b522b2	1	;;; semantic/tag-file.el --- Routines that find files based on tags.
f273dfc6	2
84c23041 GM	3	;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008,
84c23041 GM	4	;; 2009 Free Software Foundation, Inc.
f273dfc6 CY	5
	6	;; Author: Eric M. Ludlam <zappo@gnu.org>
	7	;; Keywords: syntax
	8
	9	;; This file is part of GNU Emacs.
	10
	11	;; GNU Emacs is free software: you can redistribute it and/or modify
	12	;; it under the terms of the GNU General Public License as published by
	13	;; the Free Software Foundation, either version 3 of the License, or
	14	;; (at your option) any later version.
	15
	16	;; GNU Emacs is distributed in the hope that it will be useful,
	17	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	18	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	19	;; GNU General Public License for more details.
	20
	21	;; You should have received a copy of the GNU General Public License
	22	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
	23
	24	;;; Commentary:
	25	;;
	26	;; A tag, by itself, can have representations in several files.
	27	;; These routines will find those files.
	28
	29	(require 'semantic/tag)
	30
a4556861	31	(defvar ede-minor-mode)
84c23041	32	(declare-function semanticdb-table-child-p "semantic/db" t t)
55b522b2 CY	33	(declare-function semanticdb-get-buffer "semantic/db")
55b522b2 CY	34	(declare-function semantic-dependency-find-file-on-path "semantic/dep")
a4556861	35	(declare-function ede-toplevel "ede/files")
55b522b2	36
f273dfc6 CY	37	;;; Code:
	38
	39	;;; Location a TAG came from.
	40	;;
3d9d8486	41	;;;###autoload
f273dfc6 CY	42	(define-overloadable-function semantic-go-to-tag (tag &optional parent)
	43	"Go to the location of TAG.
	44	TAG may be a stripped element, in which case PARENT specifies a
	45	parent tag that has position information.
	46	PARENT can also be a `semanticdb-table' object."
	47	(:override
1eac105a CY	48	(save-match-data
	49	(cond ((semantic-tag-in-buffer-p tag)
	50	;; We have a linked tag, go to that buffer.
	51	(set-buffer (semantic-tag-buffer tag)))
	52	((semantic-tag-file-name tag)
	53	;; If it didn't have a buffer, but does have a file
	54	;; name, then we need to get to that file so the tag
	55	;; location is made accurate.
	56	(set-buffer (find-file-noselect (semantic-tag-file-name tag))))
	57	((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p parent))
	58	;; The tag had nothing useful, but we have a parent with
	59	;; a buffer, then go there.
	60	(set-buffer (semantic-tag-buffer parent)))
	61	((and parent (semantic-tag-p parent) (semantic-tag-file-name parent))
	62	;; Tag had nothing, and the parent only has a file-name, then
	63	;; find that file, and switch to that buffer.
	64	(set-buffer (find-file-noselect (semantic-tag-file-name parent))))
	65	((and parent (featurep 'semantic/db)
	66	(semanticdb-table-child-p parent))
	67	(set-buffer (semanticdb-get-buffer parent)))
	68	(t
	69	;; Well, just assume things are in the current buffer.
	70	nil
	71	)))
f273dfc6 CY	72	;; We should be in the correct buffer now, try and figure out
	73	;; where the tag is.
	74	(cond ((semantic-tag-with-position-p tag)
	75	;; If it's a number, go there
	76	(goto-char (semantic-tag-start tag)))
	77	((semantic-tag-with-position-p parent)
	78	;; Otherwise, it's a trimmed vector, such as a parameter,
	79	;; or a structure part. If there is a parent, we can use it
	80	;; as a bounds for searching.
	81	(goto-char (semantic-tag-start parent))
	82	;; Here we make an assumption that the text returned by
	83	;; the parser and concocted by us actually exists
	84	;; in the buffer.
	85	(re-search-forward (semantic-tag-name tag)
	86	(semantic-tag-end parent)
	87	t))
	88	((semantic-tag-get-attribute tag :line)
	89	;; The tag has a line number in it. Go there.
b90caf50 CY	90	(goto-char (point-min))
b90caf50 CY	91	(forward-line (1- (semantic-tag-get-attribute tag :line))))
f273dfc6 CY	92	((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line))
f273dfc6 CY	93	;; The tag has a line number in it. Go there.
b90caf50 CY	94	(goto-char (point-min))
	95	(forward-line (1- (semantic-tag-get-attribute parent :line)))
	96	(re-search-forward (semantic-tag-name tag) nil t))
f273dfc6 CY	97	(t
	98	;; Take a guess that the tag has a unique name, and just
	99	;; search for it from the beginning of the buffer.
	100	(goto-char (point-min))
	101	(re-search-forward (semantic-tag-name tag) nil t)))
	102	)
	103	)
	104
	105	(make-obsolete-overload 'semantic-find-nonterminal
	106	'semantic-go-to-tag)
	107
	108	;;; Dependencies
	109	;;
	110	;; A tag which is of type 'include specifies a dependency.
	111	;; Dependencies usually represent a file of some sort.
	112	;; Find the file described by a dependency.
	113
3d9d8486	114	;;;###autoload
f273dfc6 CY	115	(define-overloadable-function semantic-dependency-tag-file (&optional tag)
	116	"Find the filename represented from TAG.
	117	Depends on `semantic-dependency-include-path' for searching. Always searches
	118	`.' first, then searches additional paths."
	119	(or tag (setq tag (car (semantic-find-tag-by-overlay nil))))
	120	(unless (semantic-tag-of-class-p tag 'include)
	121	(signal 'wrong-type-argument (list tag 'include)))
	122	(save-excursion
	123	(let ((result nil)
	124	(default-directory default-directory)
	125	(edefind nil)
	126	(tag-fname nil))
	127	(cond ((semantic-tag-in-buffer-p tag)
	128	;; If the tag has an overlay and buffer associated with it,
	129	;; switch to that buffer so that we get the right override metohds.
	130	(set-buffer (semantic-tag-buffer tag)))
	131	((semantic-tag-file-name tag)
	132	;; If it didn't have a buffer, but does have a file
	133	;; name, then we need to get to that file so the tag
	134	;; location is made accurate.
	135	;;(set-buffer (find-file-noselect (semantic-tag-file-name tag)))
	136	;;
	137	;; 2/3/08
	138	;; The above causes unnecessary buffer loads all over the place. Ick!
	139	;; All we really need is for 'default-directory' to be set correctly.
	140	(setq default-directory (file-name-directory (semantic-tag-file-name tag)))
	141	))
	142	;; Setup the filename represented by this include
	143	(setq tag-fname (semantic-tag-include-filename tag))
	144
	145	;; First, see if this file exists in the current EDE project
	146	(if (and (fboundp 'ede-expand-filename) ede-minor-mode
	147	(setq edefind
	148	(condition-case nil
	149	(let ((proj (ede-toplevel)))
	150	(when proj
	151	(ede-expand-filename proj tag-fname)))
	152	(error nil))))
	153	(setq result edefind))
	154	(if (not result)
	155	(setq result
	156	;; I don't have a plan for refreshing tags with a dependency
	157	;; stuck on them somehow. I'm thinking that putting a cache
	158	;; onto the dependancy finding with a hash table might be best.
	159	;;(if (semantic--tag-get-property tag 'dependency-file)
	160	;; (semantic--tag-get-property tag 'dependency-file)
	161	(:override
	162	(save-excursion
55b522b2	163	(require 'semantic/dep)
f273dfc6 CY	164	(semantic-dependency-find-file-on-path
	165	tag-fname (semantic-tag-include-system-p tag))))
	166	;; )
	167	))
	168	(if (stringp result)
	169	(progn
	170	(semantic--tag-put-property tag 'dependency-file result)
	171	result)
	172	;; @todo: Do something to make this get flushed w/
	173	;; when the path is changed.
	174	;; @undo: Just eliminate
	175	;; (semantic--tag-put-property tag 'dependency-file 'none)
	176	nil)
	177	)))
	178
	179	(make-obsolete-overload 'semantic-find-dependency
	180	'semantic-dependency-tag-file)
	181
	182	;;; PROTOTYPE FILE
	183	;;
	184	;; In C, a function in the .c file often has a representation in a
	185	;; corresponding .h file. This routine attempts to find the
	186	;; prototype file a given source file would be associated with.
	187	;; This can be used by prototype manager programs.
	188	(define-overloadable-function semantic-prototype-file (buffer)
	189	"Return a file in which prototypes belonging to BUFFER should be placed.
	190	Default behavior (if not overridden) looks for a token specifying the
	191	prototype file, or the existence of an EDE variable indicating which
	192	file prototypes belong in."
	193	(:override
	194	;; Perform some default behaviors
	195	(if (and (fboundp 'ede-header-file) ede-minor-mode)
	196	(save-excursion
	197	(set-buffer buffer)
	198	(ede-header-file))
	199	;; No EDE options for a quick answer. Search.
	200	(save-excursion
	201	(set-buffer buffer)
	202	(if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
	203	(match-string 1))))))
	204
	205	(semantic-alias-obsolete 'semantic-find-nonterminal
	206	'semantic-go-to-tag)
	207
	208	(semantic-alias-obsolete 'semantic-find-dependency
	209	'semantic-dependency-tag-file)
	210
	211
	212	(provide 'semantic/tag-file)
	213
3d9d8486 CY	214	;; Local variables:
	215	;; generated-autoload-file: "loaddefs.el"
	216	;; generated-autoload-feature: semantic/loaddefs
996bc9bf	217	;; generated-autoload-load-name: "semantic/tag-file"
3d9d8486 CY	218	;; End:
3d9d8486 CY	219
55b522b2	220	;;; semantic/tag-file.el ends here