lisp/cedet/semantic/tag-file.el

   1 ;;; tag-file.el --- Routines that find files based on tags.
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
   4 ;;; 2008, 2009 Free Software Foundation, Inc.
   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
  31 ;;; Code:
  32
  33 ;;; Location a TAG came from.
  34 ;;
  35 (define-overloadable-function semantic-go-to-tag (tag &optional parent)
  36   "Go to the location of TAG.
  37 TAG may be a stripped element, in which case PARENT specifies a
  38 parent tag that has position information.
  39 PARENT can also be a `semanticdb-table' object."
  40   (:override
  41    (cond ((semantic-tag-in-buffer-p tag)
  42           ;; We have a linked tag, go to that buffer.
  43           (set-buffer (semantic-tag-buffer tag)))
  44          ((semantic-tag-file-name tag)
  45           ;; If it didn't have a buffer, but does have a file
  46           ;; name, then we need to get to that file so the tag
  47           ;; location is made accurate.
  48           (set-buffer (find-file-noselect (semantic-tag-file-name tag))))
  49          ((and parent (semantic-tag-p parent) (semantic-tag-in-buffer-p parent))
  50           ;; The tag had nothing useful, but we have a parent with
  51           ;; a buffer, then go there.
  52           (set-buffer (semantic-tag-buffer parent)))
  53          ((and parent (semantic-tag-p parent) (semantic-tag-file-name parent))
  54           ;; Tag had nothing, and the parent only has a file-name, then
  55           ;; find that file, and switch to that buffer.
  56           (set-buffer (find-file-noselect (semantic-tag-file-name parent))))
  57          ((and parent (semanticdb-table-child-p parent))
  58           (set-buffer (semanticdb-get-buffer parent)))
  59          (t
  60           ;; Well, just assume things are in the current buffer.
  61           nil
  62           ))
  63    ;; We should be in the correct buffer now, try and figure out
  64    ;; where the tag is.
  65    (cond ((semantic-tag-with-position-p tag)
  66           ;; If it's a number, go there
  67           (goto-char (semantic-tag-start tag)))
  68          ((semantic-tag-with-position-p parent)
  69           ;; Otherwise, it's a trimmed vector, such as a parameter,
  70           ;; or a structure part.  If there is a parent, we can use it
  71           ;; as a bounds for searching.
  72           (goto-char (semantic-tag-start parent))
  73           ;; Here we make an assumption that the text returned by
  74           ;; the parser and concocted by us actually exists
  75           ;; in the buffer.
  76           (re-search-forward (semantic-tag-name tag)
  77                              (semantic-tag-end parent)
  78                              t))
  79          ((semantic-tag-get-attribute tag :line)
  80           ;; The tag has a line number in it.  Go there.
  81           (goto-line (semantic-tag-get-attribute tag :line)))
  82          ((and (semantic-tag-p parent) (semantic-tag-get-attribute parent :line))
  83           ;; The tag has a line number in it.  Go there.
  84           (goto-line (semantic-tag-get-attribute parent :line))
  85           (re-search-forward (semantic-tag-name tag) nil t)
  86           )
  87          (t
  88           ;; Take a guess that the tag has a unique name, and just
  89           ;; search for it from the beginning of the buffer.
  90           (goto-char (point-min))
  91           (re-search-forward (semantic-tag-name tag) nil t)))
  92    )
  93   )
  94
  95 (make-obsolete-overload 'semantic-find-nonterminal
  96                         'semantic-go-to-tag)
  97
  98 ;;; Dependencies
  99 ;;
 100 ;; A tag which is of type 'include specifies a dependency.
 101 ;; Dependencies usually represent a file of some sort.
 102 ;; Find the file described by a dependency.
 103
 104 (define-overloadable-function semantic-dependency-tag-file (&optional tag)
 105   "Find the filename represented from TAG.
 106 Depends on `semantic-dependency-include-path' for searching.  Always searches
 107 `.' first, then searches additional paths."
 108   (or tag (setq tag (car (semantic-find-tag-by-overlay nil))))
 109   (unless (semantic-tag-of-class-p tag 'include)
 110     (signal 'wrong-type-argument (list tag 'include)))
 111   (save-excursion
 112     (let ((result nil)
 113           (default-directory default-directory)
 114           (edefind nil)
 115           (tag-fname nil))
 116       (cond ((semantic-tag-in-buffer-p tag)
 117              ;; If the tag has an overlay and buffer associated with it,
 118              ;; switch to that buffer so that we get the right override metohds.
 119              (set-buffer (semantic-tag-buffer tag)))
 120             ((semantic-tag-file-name tag)
 121              ;; If it didn't have a buffer, but does have a file
 122              ;; name, then we need to get to that file so the tag
 123              ;; location is made accurate.
 124              ;;(set-buffer (find-file-noselect (semantic-tag-file-name tag)))
 125              ;;
 126              ;; 2/3/08
 127              ;; The above causes unnecessary buffer loads all over the place. Ick!
 128              ;; All we really need is for 'default-directory' to be set correctly.
 129              (setq default-directory (file-name-directory (semantic-tag-file-name tag)))
 130              ))
 131       ;; Setup the filename represented by this include
 132       (setq tag-fname (semantic-tag-include-filename tag))
 133
 134       ;; First, see if this file exists in the current EDE project
 135       (if (and (fboundp 'ede-expand-filename) ede-minor-mode
 136                (setq edefind
 137                      (condition-case nil
 138                          (let ((proj  (ede-toplevel)))
 139                            (when proj
 140                              (ede-expand-filename proj tag-fname)))
 141                        (error nil))))
 142           (setq result edefind))
 143       (if (not result)
 144           (setq result
 145                 ;; I don't have a plan for refreshing tags with a dependency
 146                 ;; stuck on them somehow.  I'm thinking that putting a cache
 147                 ;; onto the dependancy finding with a hash table might be best.
 148                 ;;(if (semantic--tag-get-property tag 'dependency-file)
 149                 ;;  (semantic--tag-get-property tag 'dependency-file)
 150                 (:override
 151                  (save-excursion
 152                    (semantic-dependency-find-file-on-path
 153                     tag-fname (semantic-tag-include-system-p tag))))
 154                 ;; )
 155                 ))
 156       (if (stringp result)
 157           (progn
 158             (semantic--tag-put-property tag 'dependency-file result)
 159             result)
 160         ;; @todo: Do something to make this get flushed w/
 161         ;;        when the path is changed.
 162         ;; @undo: Just eliminate
 163         ;; (semantic--tag-put-property tag 'dependency-file 'none)
 164         nil)
 165       )))
 166
 167 (make-obsolete-overload 'semantic-find-dependency
 168                         'semantic-dependency-tag-file)
 169
 170 ;;; PROTOTYPE FILE
 171 ;;
 172 ;; In C, a function in the .c file often has a representation in a
 173 ;; corresponding .h file.  This routine attempts to find the
 174 ;; prototype file a given source file would be associated with.
 175 ;; This can be used by prototype manager programs.
 176 (define-overloadable-function semantic-prototype-file (buffer)
 177   "Return a file in which prototypes belonging to BUFFER should be placed.
 178 Default behavior (if not overridden) looks for a token specifying the
 179 prototype file, or the existence of an EDE variable indicating which
 180 file prototypes belong in."
 181   (:override
 182    ;; Perform some default behaviors
 183    (if (and (fboundp 'ede-header-file) ede-minor-mode)
 184        (save-excursion
 185          (set-buffer buffer)
 186          (ede-header-file))
 187      ;; No EDE options for a quick answer.  Search.
 188      (save-excursion
 189        (set-buffer buffer)
 190        (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t)
 191            (match-string 1))))))
 192
 193 (semantic-alias-obsolete 'semantic-find-nonterminal
 194                          'semantic-go-to-tag)
 195
 196 (semantic-alias-obsolete 'semantic-find-dependency
 197                          'semantic-dependency-tag-file)
 198
 199
 200 (provide 'semantic/tag-file)
 201
 202 ;;; semantic-tag-file.el ends here