lisp/cedet/semantic/tag-file.el

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