lisp/cedet/semantic/db-global.el

   1 ;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
   2
   3 ;; Copyright (C) 2002-2006, 2008-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: tags
   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 ;; Use GNU Global for by-name database searches.
  26 ;;
  27 ;; This will work as an "omniscient" database for a given project.
  28 ;;
  29
  30 (require 'cedet-global)
  31 (require 'semantic/db-find)
  32 (require 'semantic/symref/global)
  33
  34 (eval-when-compile
  35   ;; For generic function searching.
  36   (require 'eieio)
  37   (require 'eieio-opt)
  38   )
  39
  40 ;;; Code:
  41
  42 ;;;###autoload
  43 (defun semanticdb-enable-gnu-global-databases (mode &optional noerror)
  44   "Enable the use of the GNU Global SemanticDB back end for all files of MODE.
  45 This will add an instance of a GNU Global database to each buffer
  46 in a GNU Global supported hierarchy.
  47
  48 Two sanity checks are performed to assure (a) that GNU global program exists
  49 and (b) that the GNU global program version is compatibility with the database
  50 version.  If optional NOERROR is nil, then an error may be signalled on version
  51 mismatch.  If NOERROR is not nil, then no error will be signaled.  Instead
  52 return value will indicate success or failure with non-nil or nil respective
  53 values."
  54   (interactive
  55    (list (completing-read
  56           "Enable in Mode: " obarray
  57           #'(lambda (s) (get s 'mode-local-symbol-table))
  58           t (symbol-name major-mode))))
  59
  60   ;; First, make sure the version is ok.
  61   (if (not (cedet-gnu-global-version-check noerror))
  62       nil
  63     ;; Make sure mode is a symbol.
  64     (when (stringp mode)
  65       (setq mode (intern mode)))
  66
  67     (let ((ih (mode-local-value mode 'semantic-init-mode-hook)))
  68       (eval `(setq-mode-local
  69               ,mode semantic-init-mode-hook
  70               (cons 'semanticdb-enable-gnu-global-hook ih))))
  71     t
  72     )
  73   )
  74
  75 (defun semanticdb-enable-gnu-global-hook ()
  76   "Add support for GNU Global in the current buffer via `semantic-init-hook'.
  77 MODE is the major mode to support."
  78   (semanticdb-enable-gnu-global-in-buffer t))
  79
  80 (defclass semanticdb-project-database-global
  81   ;; @todo - convert to one DB per directory.
  82   (semanticdb-project-database eieio-instance-tracker)
  83
  84   ;; @todo - use instance tracker symbol.
  85   ()
  86   "Database representing a GNU Global tags file.")
  87
  88 (defun semanticdb-enable-gnu-global-in-buffer (&optional dont-err-if-not-available)
  89   "Enable a GNU Global database in the current buffer.
  90 When GNU Global is not available for this directory, display a message
  91 if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
  92   (interactive "P")
  93   (if (cedet-gnu-global-root)
  94       (setq
  95        ;; Add to the system database list.
  96        semanticdb-project-system-databases
  97        (cons (semanticdb-project-database-global "global")
  98              semanticdb-project-system-databases)
  99        ;; Apply the throttle.
 100        semanticdb-find-default-throttle
 101        (append semanticdb-find-default-throttle
 102                '(omniscience))
 103        )
 104     (if dont-err-if-not-available
 105         nil; (message "No Global support in %s" default-directory)
 106       (error "No Global support in %s" default-directory))
 107     ))
 108
 109 ;;; Classes:
 110 (defclass semanticdb-table-global (semanticdb-search-results-table)
 111   ((major-mode :initform nil)
 112    )
 113   "A table for returning search results from GNU Global.")
 114
 115 (defmethod object-print ((obj semanticdb-table-global) &rest strings)
 116   "Pretty printer extension for `semanticdb-table-global'.
 117 Adds the number of tags in this file to the object print name."
 118   (apply 'call-next-method obj (cons " (proxy)" strings)))
 119
 120 (defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
 121   "Return t, pretend that this table's mode is equivalent to BUFFER.
 122 Equivalent modes are specified by the `semantic-equivalent-major-modes'
 123 local variable."
 124   ;; @todo - hack alert!
 125   t)
 126
 127 ;;; Filename based methods
 128 ;;
 129 (defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
 130   "For a global database, there are no explicit tables.
 131 For each file hit, get the traditional semantic table from that file."
 132   ;; We need to return something since there is always the "master table"
 133   ;; The table can then answer file name type questions.
 134   (when (not (slot-boundp obj 'tables))
 135     (let ((newtable (semanticdb-table-global "GNU Global Search Table")))
 136       (oset obj tables (list newtable))
 137       (oset newtable parent-db obj)
 138       (oset newtable tags nil)
 139       ))
 140
 141   (call-next-method))
 142
 143 (defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
 144   "From OBJ, return FILENAME's associated table object."
 145   ;; We pass in "don't load".  I wonder if we need to avoid that or not?
 146   (car (semanticdb-get-database-tables obj))
 147   )
 148
 149 ;;; Search Overrides
 150 ;;
 151 ;; Only NAME based searches work with GLOBAL as that is all it tracks.
 152 ;;
 153 (defmethod semanticdb-find-tags-by-name-method
 154   ((table semanticdb-table-global) name &optional tags)
 155   "Find all tags named NAME in TABLE.
 156 Return a list of tags."
 157   (if tags
 158       ;; If TAGS are passed in, then we don't need to do work here.
 159       (call-next-method)
 160     ;; Call out to GNU Global for some results.
 161     (let* ((semantic-symref-tool 'global)
 162            (result (semantic-symref-find-tags-by-name name 'project))
 163            )
 164       (when result
 165         ;; We could ask to keep the buffer open, but that annoys
 166         ;; people.
 167         (semantic-symref-result-get-tags result))
 168       )))
 169
 170 (defmethod semanticdb-find-tags-by-name-regexp-method
 171   ((table semanticdb-table-global) regex &optional tags)
 172   "Find all tags with name matching REGEX in TABLE.
 173 Optional argument TAGS is a list of tags to search.
 174 Return a list of tags."
 175   (if tags (call-next-method)
 176     (let* ((semantic-symref-tool 'global)
 177            (result (semantic-symref-find-tags-by-regexp regex 'project))
 178            )
 179       (when result
 180         (semantic-symref-result-get-tags result))
 181       )))
 182
 183 (defmethod semanticdb-find-tags-for-completion-method
 184   ((table semanticdb-table-global) prefix &optional tags)
 185   "In TABLE, find all occurrences of tags matching PREFIX.
 186 Optional argument TAGS is a list of tags to search.
 187 Returns a table of all matching tags."
 188   (if tags (call-next-method)
 189     (let* ((semantic-symref-tool 'global)
 190            (result (semantic-symref-find-tags-by-completion prefix 'project))
 191            (faketags nil)
 192            )
 193       (when result
 194         (dolist (T (oref result :hit-text))
 195           ;; We should look up each tag one at a time, but I'm lazy!
 196           ;; Doing this may be good enough.
 197           (setq faketags (cons
 198                           (semantic-tag T 'function :faux t)
 199                           faketags))
 200           )
 201         faketags))))
 202
 203 ;;; Deep Searches
 204 ;;
 205 ;; If your language does not have a `deep' concept, these can be left
 206 ;; alone, otherwise replace with implementations similar to those
 207 ;; above.
 208 ;;
 209 (defmethod semanticdb-deep-find-tags-by-name-method
 210   ((table semanticdb-table-global) name &optional tags)
 211   "Find all tags name NAME in TABLE.
 212 Optional argument TAGS is a list of tags to search.
 213 Like `semanticdb-find-tags-by-name-method' for global."
 214   (semanticdb-find-tags-by-name-method table name tags))
 215
 216 (defmethod semanticdb-deep-find-tags-by-name-regexp-method
 217   ((table semanticdb-table-global) regex &optional tags)
 218   "Find all tags with name matching REGEX in TABLE.
 219 Optional argument TAGS is a list of tags to search.
 220 Like `semanticdb-find-tags-by-name-method' for global."
 221   (semanticdb-find-tags-by-name-regexp-method table regex tags))
 222
 223 (defmethod semanticdb-deep-find-tags-for-completion-method
 224   ((table semanticdb-table-global) prefix &optional tags)
 225   "In TABLE, find all occurrences of tags matching PREFIX.
 226 Optional argument TAGS is a list of tags to search.
 227 Like `semanticdb-find-tags-for-completion-method' for global."
 228   (semanticdb-find-tags-for-completion-method table prefix tags))
 229
 230 (provide 'semantic/db-global)
 231
 232 ;; Local variables:
 233 ;; generated-autoload-file: "loaddefs.el"
 234 ;; generated-autoload-load-name: "semantic/db-global"
 235 ;; End:
 236
 237 ;;; semantic/db-global.el ends here