| 1 | ;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp |
| 2 | |
| 3 | ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 |
| 4 | ;;; Free Software Foundation, Inc. |
| 5 | |
| 6 | ;; Author: Eric M. Ludlam <zappo@gnu.org> |
| 7 | ;; Keywords: tags |
| 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 | ;; There are a lot of Emacs Lisp functions and variables available for |
| 27 | ;; the asking. This adds on to the semanticdb programming interface to |
| 28 | ;; allow all loaded Emacs Lisp functions to be queried via semanticdb. |
| 29 | ;; |
| 30 | ;; This allows you to use programs written for Semantic using the database |
| 31 | ;; to also work in Emacs Lisp with no compromises. |
| 32 | ;; |
| 33 | |
| 34 | (require 'semantic/db) |
| 35 | |
| 36 | (eval-when-compile |
| 37 | ;; For generic function searching. |
| 38 | (require 'eieio) |
| 39 | (require 'eieio-opt) |
| 40 | (require 'eieio-base)) |
| 41 | |
| 42 | (declare-function semantic-elisp-desymbolify "semantic/bovine/el") |
| 43 | |
| 44 | ;;; Code: |
| 45 | |
| 46 | ;;; Classes: |
| 47 | (defclass semanticdb-table-emacs-lisp (semanticdb-abstract-table) |
| 48 | ((major-mode :initform emacs-lisp-mode) |
| 49 | ) |
| 50 | "A table for returning search results from Emacs.") |
| 51 | |
| 52 | (defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force) |
| 53 | "Do not refresh Emacs Lisp table. |
| 54 | It does not need refreshing." |
| 55 | nil) |
| 56 | |
| 57 | (defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp)) |
| 58 | "Return nil, we never need a refresh." |
| 59 | nil) |
| 60 | |
| 61 | (defclass semanticdb-project-database-emacs-lisp |
| 62 | (semanticdb-project-database eieio-singleton) |
| 63 | ((new-table-class :initform semanticdb-table-emacs-lisp |
| 64 | :type class |
| 65 | :documentation |
| 66 | "New tables created for this database are of this class.") |
| 67 | ) |
| 68 | "Database representing Emacs core.") |
| 69 | |
| 70 | ;; Create the database, and add it to searchable databases for Emacs Lisp mode. |
| 71 | (defvar-mode-local emacs-lisp-mode semanticdb-project-system-databases |
| 72 | (list |
| 73 | (semanticdb-project-database-emacs-lisp "Emacs")) |
| 74 | "Search Emacs core for symbols.") |
| 75 | |
| 76 | (defvar-mode-local emacs-lisp-mode semanticdb-find-default-throttle |
| 77 | '(project omniscience) |
| 78 | "Search project files, then search this omniscience database. |
| 79 | It is not necessary to to system or recursive searching because of |
| 80 | the omniscience database.") |
| 81 | |
| 82 | ;;; Filename based methods |
| 83 | ;; |
| 84 | (defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp)) |
| 85 | "For an Emacs Lisp database, there are no explicit tables. |
| 86 | Create one of our special tables that can act as an intermediary." |
| 87 | ;; We need to return something since there is always the "master table" |
| 88 | ;; The table can then answer file name type questions. |
| 89 | (when (not (slot-boundp obj 'tables)) |
| 90 | (let ((newtable (semanticdb-table-emacs-lisp "Emacs System Table"))) |
| 91 | (oset obj tables (list newtable)) |
| 92 | (oset newtable parent-db obj) |
| 93 | (oset newtable tags nil) |
| 94 | )) |
| 95 | (call-next-method)) |
| 96 | |
| 97 | (defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename) |
| 98 | "From OBJ, return FILENAME's associated table object. |
| 99 | For Emacs Lisp, creates a specialized table." |
| 100 | (car (semanticdb-get-database-tables obj)) |
| 101 | ) |
| 102 | |
| 103 | (defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp )) |
| 104 | "Return the list of tags belonging to TABLE." |
| 105 | ;; specialty table ? Probably derive tags at request time. |
| 106 | nil) |
| 107 | |
| 108 | (defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer) |
| 109 | "Return non-nil if TABLE's mode is equivalent to BUFFER. |
| 110 | Equivalent modes are specified by by `semantic-equivalent-major-modes' |
| 111 | local variable." |
| 112 | (with-current-buffer buffer |
| 113 | (eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode))) |
| 114 | |
| 115 | (defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp)) |
| 116 | "Fetch the full filename that OBJ refers to. |
| 117 | For Emacs Lisp system DB, there isn't one." |
| 118 | nil) |
| 119 | |
| 120 | ;;; Conversion |
| 121 | ;; |
| 122 | (defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags) |
| 123 | "Convert tags, originating from Emacs OBJ, into standardized form." |
| 124 | (let ((newtags nil)) |
| 125 | (dolist (T tags) |
| 126 | (let* ((ot (semanticdb-normalize-one-tag obj T)) |
| 127 | (tag (cdr ot))) |
| 128 | (setq newtags (cons tag newtags)))) |
| 129 | ;; There is no promise to have files associated. |
| 130 | (nreverse newtags))) |
| 131 | |
| 132 | (defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag) |
| 133 | "Convert one TAG, originating from Emacs OBJ, into standardized form. |
| 134 | If Emacs cannot resolve this symbol to a particular file, then return nil." |
| 135 | ;; Here's the idea. For each tag, get the name, then use |
| 136 | ;; Emacs' `symbol-file' to get the source. Once we have that, |
| 137 | ;; we can use more typical semantic searching techniques to |
| 138 | ;; get a regularly parsed tag. |
| 139 | (let* ((type (cond ((semantic-tag-of-class-p tag 'function) |
| 140 | 'defun) |
| 141 | ((semantic-tag-of-class-p tag 'variable) |
| 142 | 'defvar) |
| 143 | )) |
| 144 | (sym (intern (semantic-tag-name tag))) |
| 145 | (file (condition-case err |
| 146 | (symbol-file sym type) |
| 147 | ;; Older [X]Emacs don't have a 2nd argument. |
| 148 | (error (symbol-file sym)))) |
| 149 | ) |
| 150 | (if (or (not file) (not (file-exists-p file))) |
| 151 | ;; The file didn't exist. Return nil. |
| 152 | ;; We can't normalize this tag. Fake it out. |
| 153 | (cons obj tag) |
| 154 | (when (string-match "\\.elc" file) |
| 155 | (setq file (concat (file-name-sans-extension file) |
| 156 | ".el")) |
| 157 | (when (and (not (file-exists-p file)) |
| 158 | (file-exists-p (concat file ".gz"))) |
| 159 | ;; Is it a .gz file? |
| 160 | (setq file (concat file ".gz")))) |
| 161 | |
| 162 | (let* ((tab (semanticdb-file-table-object file)) |
| 163 | (alltags (semanticdb-get-tags tab)) |
| 164 | (newtags (semanticdb-find-tags-by-name-method |
| 165 | tab (semantic-tag-name tag))) |
| 166 | (match nil)) |
| 167 | ;; Find the best match. |
| 168 | (dolist (T newtags) |
| 169 | (when (semantic-tag-similar-p T tag) |
| 170 | (setq match T))) |
| 171 | ;; Backup system. |
| 172 | (when (not match) |
| 173 | (setq match (car newtags))) |
| 174 | ;; Return it. |
| 175 | (cons tab match))))) |
| 176 | |
| 177 | (defun semanticdb-elisp-sym-function-arglist (sym) |
| 178 | "Get the argument list for SYM. |
| 179 | Deal with all different forms of function. |
| 180 | This was snarfed out of eldoc." |
| 181 | (let* ((prelim-def |
| 182 | (let ((sd (and (fboundp sym) |
| 183 | (symbol-function sym)))) |
| 184 | (and (symbolp sd) |
| 185 | (condition-case err |
| 186 | (setq sd (indirect-function sym)) |
| 187 | (error (setq sd nil)))) |
| 188 | sd)) |
| 189 | (def (if (eq (car-safe prelim-def) 'macro) |
| 190 | (cdr prelim-def) |
| 191 | prelim-def)) |
| 192 | (arglist (cond ((null def) nil) |
| 193 | ((byte-code-function-p def) |
| 194 | ;; This is an eieio compatibility function. |
| 195 | ;; We depend on EIEIO, so use this. |
| 196 | (eieio-compiled-function-arglist def)) |
| 197 | ((eq (car-safe def) 'lambda) |
| 198 | (nth 1 def)) |
| 199 | (t nil)))) |
| 200 | arglist)) |
| 201 | |
| 202 | (defun semanticdb-elisp-sym->tag (sym &optional toktype) |
| 203 | "Convert SYM into a semantic tag. |
| 204 | TOKTYPE is a hint to the type of tag desired." |
| 205 | (if (stringp sym) |
| 206 | (setq sym (intern-soft sym))) |
| 207 | (when sym |
| 208 | (cond ((and (eq toktype 'function) (fboundp sym)) |
| 209 | (require 'semantic/bovine/el) |
| 210 | (semantic-tag-new-function |
| 211 | (symbol-name sym) |
| 212 | nil ;; return type |
| 213 | (semantic-elisp-desymbolify |
| 214 | (semanticdb-elisp-sym-function-arglist sym)) ;; arg-list |
| 215 | :user-visible-flag (condition-case nil |
| 216 | (interactive-form sym) |
| 217 | (error nil)) |
| 218 | )) |
| 219 | ((and (eq toktype 'variable) (boundp sym)) |
| 220 | (semantic-tag-new-variable |
| 221 | (symbol-name sym) |
| 222 | nil ;; type |
| 223 | nil ;; value - ignore for now |
| 224 | )) |
| 225 | ((and (eq toktype 'type) (class-p sym)) |
| 226 | (semantic-tag-new-type |
| 227 | (symbol-name sym) |
| 228 | "class" |
| 229 | (semantic-elisp-desymbolify |
| 230 | (aref (class-v semanticdb-project-database) |
| 231 | class-public-a)) ;; slots |
| 232 | (semantic-elisp-desymbolify (class-parents sym)) ;; parents |
| 233 | )) |
| 234 | ((not toktype) |
| 235 | ;; Figure it out on our own. |
| 236 | (cond ((class-p sym) |
| 237 | (semanticdb-elisp-sym->tag sym 'type)) |
| 238 | ((fboundp sym) |
| 239 | (semanticdb-elisp-sym->tag sym 'function)) |
| 240 | ((boundp sym) |
| 241 | (semanticdb-elisp-sym->tag sym 'variable)) |
| 242 | (t nil)) |
| 243 | ) |
| 244 | (t nil)))) |
| 245 | |
| 246 | ;;; Search Overrides |
| 247 | ;; |
| 248 | (defvar semanticdb-elisp-mapatom-collector nil |
| 249 | "Variable used to collect mapatoms output.") |
| 250 | |
| 251 | (defmethod semanticdb-find-tags-by-name-method |
| 252 | ((table semanticdb-table-emacs-lisp) name &optional tags) |
| 253 | "Find all tags name NAME in TABLE. |
| 254 | Uses `inter-soft' to match NAME to emacs symbols. |
| 255 | Return a list of tags." |
| 256 | (if tags (call-next-method) |
| 257 | ;; No need to search. Use `intern-soft' which does the same thing for us. |
| 258 | (let* ((sym (intern-soft name)) |
| 259 | (fun (semanticdb-elisp-sym->tag sym 'function)) |
| 260 | (var (semanticdb-elisp-sym->tag sym 'variable)) |
| 261 | (typ (semanticdb-elisp-sym->tag sym 'type)) |
| 262 | (taglst nil) |
| 263 | ) |
| 264 | (when (or fun var typ) |
| 265 | ;; If the symbol is any of these things, build the search table. |
| 266 | (when var (setq taglst (cons var taglst))) |
| 267 | (when typ (setq taglst (cons typ taglst))) |
| 268 | (when fun (setq taglst (cons fun taglst))) |
| 269 | taglst |
| 270 | )))) |
| 271 | |
| 272 | (defmethod semanticdb-find-tags-by-name-regexp-method |
| 273 | ((table semanticdb-table-emacs-lisp) regex &optional tags) |
| 274 | "Find all tags with name matching REGEX in TABLE. |
| 275 | Optional argument TAGS is a list of tags to search. |
| 276 | Uses `apropos-internal' to find matches. |
| 277 | Return a list of tags." |
| 278 | (if tags (call-next-method) |
| 279 | (delq nil (mapcar 'semanticdb-elisp-sym->tag |
| 280 | (apropos-internal regex))))) |
| 281 | |
| 282 | (defmethod semanticdb-find-tags-for-completion-method |
| 283 | ((table semanticdb-table-emacs-lisp) prefix &optional tags) |
| 284 | "In TABLE, find all occurances of tags matching PREFIX. |
| 285 | Optional argument TAGS is a list of tags to search. |
| 286 | Returns a table of all matching tags." |
| 287 | (if tags (call-next-method) |
| 288 | (delq nil (mapcar 'semanticdb-elisp-sym->tag |
| 289 | (all-completions prefix obarray))))) |
| 290 | |
| 291 | (defmethod semanticdb-find-tags-by-class-method |
| 292 | ((table semanticdb-table-emacs-lisp) class &optional tags) |
| 293 | "In TABLE, find all occurances of tags of CLASS. |
| 294 | Optional argument TAGS is a list of tags to search. |
| 295 | Returns a table of all matching tags." |
| 296 | (if tags (call-next-method) |
| 297 | ;; We could implement this, but it could be messy. |
| 298 | nil)) |
| 299 | |
| 300 | ;;; Deep Searches |
| 301 | ;; |
| 302 | ;; For Emacs Lisp deep searches are like top level searches. |
| 303 | (defmethod semanticdb-deep-find-tags-by-name-method |
| 304 | ((table semanticdb-table-emacs-lisp) name &optional tags) |
| 305 | "Find all tags name NAME in TABLE. |
| 306 | Optional argument TAGS is a list of tags to search. |
| 307 | Like `semanticdb-find-tags-by-name-method' for Emacs Lisp." |
| 308 | (semanticdb-find-tags-by-name-method table name tags)) |
| 309 | |
| 310 | (defmethod semanticdb-deep-find-tags-by-name-regexp-method |
| 311 | ((table semanticdb-table-emacs-lisp) regex &optional tags) |
| 312 | "Find all tags with name matching REGEX in TABLE. |
| 313 | Optional argument TAGS is a list of tags to search. |
| 314 | Like `semanticdb-find-tags-by-name-method' for Emacs Lisp." |
| 315 | (semanticdb-find-tags-by-name-regexp-method table regex tags)) |
| 316 | |
| 317 | (defmethod semanticdb-deep-find-tags-for-completion-method |
| 318 | ((table semanticdb-table-emacs-lisp) prefix &optional tags) |
| 319 | "In TABLE, find all occurances of tags matching PREFIX. |
| 320 | Optional argument TAGS is a list of tags to search. |
| 321 | Like `semanticdb-find-tags-for-completion-method' for Emacs Lisp." |
| 322 | (semanticdb-find-tags-for-completion-method table prefix tags)) |
| 323 | |
| 324 | ;;; Advanced Searches |
| 325 | ;; |
| 326 | (defmethod semanticdb-find-tags-external-children-of-type-method |
| 327 | ((table semanticdb-table-emacs-lisp) type &optional tags) |
| 328 | "Find all nonterminals which are child elements of TYPE |
| 329 | Optional argument TAGS is a list of tags to search. |
| 330 | Return a list of tags." |
| 331 | (if tags (call-next-method) |
| 332 | ;; EIEIO is the only time this matters |
| 333 | (when (featurep 'eieio) |
| 334 | (let* ((class (intern-soft type)) |
| 335 | (taglst (when class |
| 336 | (delq nil |
| 337 | (mapcar 'semanticdb-elisp-sym->tag |
| 338 | ;; Fancy eieio function that knows all about |
| 339 | ;; built in methods belonging to CLASS. |
| 340 | (eieio-all-generic-functions class))))) |
| 341 | ) |
| 342 | taglst)))) |
| 343 | |
| 344 | (provide 'semantic/db-el) |
| 345 | |
| 346 | ;; arch-tag: e54f556e-fa3f-4bc5-9b15-744a659a6e65 |
| 347 | ;;; semantic/db-el.el ends here |