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