Commit | Line | Data |
---|---|---|
a6de3d1a CY |
1 | ;;; semantic/analyze/refs.el --- Analysis of the references between tags. |
2 | ||
5df4f04c | 3 | ;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc. |
a6de3d1a CY |
4 | |
5 | ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Analyze the references between tags. | |
25 | ;; | |
26 | ;; The original purpose of these analysis is to provide a way to jump | |
27 | ;; between a prototype and implementation. | |
28 | ;; | |
29 | ;; Finding all prototype/impl matches is hard because you have to search | |
30 | ;; through the entire set of allowed databases to capture all possible | |
31 | ;; refs. The core analysis class stores basic starting point, and then | |
32 | ;; entire raw search data, which is expensive to calculate. | |
33 | ;; | |
34 | ;; Once the raw data is available, queries for impl, prototype, or | |
35 | ;; perhaps other things become cheap. | |
36 | ||
1fe1547a CY |
37 | (require 'semantic) |
38 | (require 'semantic/analyze) | |
39 | (require 'semantic/db-find) | |
40 | (eval-when-compile (require 'semantic/find)) | |
41 | ||
42 | (declare-function data-debug-new-buffer "data-debug") | |
43 | (declare-function data-debug-insert-object-slots "eieio-datadebug") | |
44 | (declare-function semantic-momentary-highlight-tag "semantic/decorate") | |
45 | ||
a6de3d1a CY |
46 | ;;; Code: |
47 | (defclass semantic-analyze-references () | |
48 | ((tag :initarg :tag | |
49 | :type semantic-tag | |
50 | :documentation | |
51 | "The starting TAG we are providing references analysis for.") | |
52 | (tagdb :initarg :tagdb | |
53 | :documentation | |
54 | "The database that tag can be found in.") | |
55 | (scope :initarg :scope | |
56 | :documentation "A Scope object.") | |
57 | (rawsearchdata :initarg :rawsearchdata | |
58 | :documentation | |
59 | "The raw search data for TAG's name across all databases.") | |
60 | ;; Note: Should I cache queried data here? I expect that searching | |
61 | ;; through rawsearchdata will be super-fast, so why bother? | |
62 | ) | |
63 | "Class containing data from a semantic analysis.") | |
64 | ||
65 | (define-overloadable-function semantic-analyze-tag-references (tag &optional db) | |
66 | "Analyze the references for TAG. | |
67 | Returns a class with information about TAG. | |
68 | ||
69 | Optional argument DB is a database. It will be used to help | |
70 | locate TAG. | |
71 | ||
72 | Use `semantic-analyze-current-tag' to debug this fcn.") | |
73 | ||
74 | (defun semantic-analyze-tag-references-default (tag &optional db) | |
75 | "Analyze the references for TAG. | |
76 | Returns a class with information about TAG. | |
77 | ||
78 | Optional argument DB is a database. It will be used to help | |
79 | locate TAG. | |
80 | ||
81 | Use `semantic-analyze-current-tag' to debug this fcn." | |
82 | (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list 'semantic-tag-p tag))) | |
83 | (let ((allhits nil) | |
84 | (scope nil) | |
85 | ) | |
86 | (save-excursion | |
87 | (semantic-go-to-tag tag db) | |
88 | (setq scope (semantic-calculate-scope)) | |
89 | ||
90 | (setq allhits (semantic--analyze-refs-full-lookup tag scope)) | |
91 | ||
92 | (semantic-analyze-references (semantic-tag-name tag) | |
93 | :tag tag | |
94 | :tagdb db | |
95 | :scope scope | |
96 | :rawsearchdata allhits) | |
97 | ))) | |
98 | ||
99 | ;;; METHODS | |
100 | ;; | |
101 | ;; These accessor methods will calculate the useful bits from the context, and cache values | |
102 | ;; into the context. | |
103 | (defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer) | |
104 | "Return the implementations derived in the reference analyzer REFS. | |
105 | Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." | |
106 | (let ((allhits (oref refs rawsearchdata)) | |
dd9af436 | 107 | (tag (oref refs :tag)) |
a6de3d1a CY |
108 | (impl nil) |
109 | ) | |
110 | (semanticdb-find-result-mapc | |
111 | (lambda (T DB) | |
112 | "Examine T in the database DB, and sont it." | |
113 | (let* ((ans (semanticdb-normalize-one-tag DB T)) | |
114 | (aT (cdr ans)) | |
115 | (aDB (car ans)) | |
116 | ) | |
dd9af436 CY |
117 | (when (and (not (semantic-tag-prototype-p aT)) |
118 | (semantic-tag-similar-p tag aT :prototype-flag :parent)) | |
a6de3d1a CY |
119 | (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) |
120 | (push aT impl)))) | |
121 | allhits) | |
122 | impl)) | |
123 | ||
124 | (defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer) | |
125 | "Return the prototypes derived in the reference analyzer REFS. | |
126 | Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." | |
127 | (let ((allhits (oref refs rawsearchdata)) | |
dd9af436 | 128 | (tag (oref refs :tag)) |
a6de3d1a CY |
129 | (proto nil)) |
130 | (semanticdb-find-result-mapc | |
131 | (lambda (T DB) | |
132 | "Examine T in the database DB, and sort it." | |
133 | (let* ((ans (semanticdb-normalize-one-tag DB T)) | |
134 | (aT (cdr ans)) | |
135 | (aDB (car ans)) | |
136 | ) | |
dd9af436 CY |
137 | (when (and (semantic-tag-prototype-p aT) |
138 | (semantic-tag-similar-p tag aT :prototype-flag :parent)) | |
a6de3d1a CY |
139 | (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) |
140 | (push aT proto)))) | |
141 | allhits) | |
142 | proto)) | |
143 | ||
144 | ;;; LOOKUP | |
145 | ;; | |
146 | (defun semantic--analyze-refs-full-lookup (tag scope) | |
9bf6c65c | 147 | "Perform a full lookup for all occurrences of TAG in the current project. |
a6de3d1a | 148 | TAG should be the tag currently under point. |
dd9af436 CY |
149 | SCOPE is the scope the cursor is in. From this a list of parents is |
150 | derived. If SCOPE does not have parents, then only a simple lookup is done." | |
a6de3d1a CY |
151 | (if (not (oref scope parents)) |
152 | ;; If this tag has some named parent, but is not | |
153 | (semantic--analyze-refs-full-lookup-simple tag) | |
154 | ||
155 | ;; We have some sort of lineage we need to consider when we do | |
156 | ;; our side lookup of tags. | |
157 | (semantic--analyze-refs-full-lookup-with-parents tag scope) | |
158 | )) | |
159 | ||
160 | (defun semantic--analyze-refs-find-child-in-find-results (find-results name class) | |
161 | "Find in FIND-RESULT a tag NAME which is a child of a tag in FIND-RESULTS. | |
162 | CLASS is the class of the tag that ought to be returned." | |
163 | (let ((ans nil) | |
164 | (subans nil)) | |
165 | ;; Loop over each segment of the find results. | |
166 | (dolist (FDB find-results) | |
167 | (setq subans nil) | |
168 | ;; Loop over each tag in the find results. | |
169 | (dolist (T (cdr FDB)) | |
170 | ;; For each tag, get the children. | |
171 | (let* ((chil (semantic-tag-type-members T)) | |
172 | (match (semantic-find-tags-by-name name chil))) | |
173 | ;; Go over the matches, looking for matching tag class. | |
174 | (dolist (M match) | |
175 | (when (semantic-tag-of-class-p M class) | |
176 | (push M subans))))) | |
177 | ;; Store current matches into a new find results. | |
178 | (when subans | |
179 | (push (cons (car FDB) subans) ans)) | |
180 | ) | |
181 | ans)) | |
182 | ||
183 | (defun semantic--analyze-refs-find-tags-with-parent (find-results parents) | |
dd9af436 | 184 | "Find in FIND-RESULTS all tags with PARENTS. |
a6de3d1a CY |
185 | NAME is the name of the tag needing finding. |
186 | PARENTS is a list of names." | |
dd9af436 CY |
187 | (let ((ans nil) (usingnames nil)) |
188 | ;; Loop over the find-results passed in. | |
a6de3d1a CY |
189 | (semanticdb-find-result-mapc |
190 | (lambda (tag db) | |
191 | (let* ((p (semantic-tag-named-parent tag)) | |
dd9af436 | 192 | (ps (when (stringp p) (semantic-analyze-split-name p)))) |
a6de3d1a | 193 | (when (stringp ps) (setq ps (list ps))) |
dd9af436 CY |
194 | (when ps |
195 | ;; If there is a perfect match, then use it. | |
196 | (if (equal ps parents) | |
197 | (push (list db tag) ans)) | |
198 | ;; No match, find something from our list of using names. | |
199 | ;; Do we need to split UN? | |
200 | (save-excursion | |
201 | (semantic-go-to-tag tag db) | |
202 | (setq usingnames nil) | |
203 | (let ((imports (semantic-ctxt-imported-packages))) | |
204 | ;; Derive the names from all the using statements. | |
205 | (mapc (lambda (T) | |
206 | (setq usingnames | |
207 | (cons (semantic-format-tag-name-from-anything T) usingnames))) | |
208 | imports)) | |
209 | (dolist (UN usingnames) | |
210 | (when (equal (cons UN ps) parents) | |
211 | (push (list db tag) ans) | |
212 | (setq usingnames (cdr usingnames)))) | |
213 | )))) | |
a6de3d1a CY |
214 | find-results) |
215 | ans)) | |
216 | ||
217 | (defun semantic--analyze-refs-full-lookup-with-parents (tag scope) | |
9bf6c65c | 218 | "Perform a lookup for all occurrences of TAG based on TAG's SCOPE. |
a6de3d1a CY |
219 | TAG should be the tag currently under point." |
220 | (let* ((classmatch (semantic-tag-class tag)) | |
221 | (plist (mapcar (lambda (T) (semantic-tag-name T)) (oref scope parents))) | |
222 | ;; The first item in the parent list | |
223 | (name (car plist)) | |
224 | ;; Stuff from the simple list. | |
225 | (simple (semantic--analyze-refs-full-lookup-simple tag t)) | |
226 | ;; Find all hits for the first parent name. | |
227 | (brute (semanticdb-find-tags-collector | |
228 | (lambda (table tags) | |
dd9af436 | 229 | (semanticdb-deep-find-tags-by-name-method table name tags) |
a6de3d1a CY |
230 | ) |
231 | nil nil t)) | |
232 | ;; Prime the answer. | |
233 | (answer (semantic--analyze-refs-find-tags-with-parent simple plist)) | |
234 | ) | |
235 | ;; First parent is already search to initialize "brute". | |
236 | (setq plist (cdr plist)) | |
dd9af436 | 237 | |
a6de3d1a CY |
238 | ;; Go through the list of parents, and try to find matches. |
239 | ;; As we cycle through plist, for each level look for NAME, | |
240 | ;; and compare the named-parent, and also dive into the next item of | |
241 | ;; plist. | |
242 | (while (and plist brute) | |
243 | ||
244 | ;; Find direct matches | |
245 | (let* ((direct (semantic--analyze-refs-find-child-in-find-results | |
246 | brute (semantic-tag-name tag) classmatch)) | |
247 | (pdirect (semantic--analyze-refs-find-tags-with-parent | |
248 | direct plist))) | |
249 | (setq answer (append pdirect answer))) | |
250 | ||
251 | ;; The next set of search items. | |
252 | (setq brute (semantic--analyze-refs-find-child-in-find-results | |
253 | brute (car plist) 'type)) | |
254 | ||
255 | (setq plist (cdr plist))) | |
256 | ||
257 | ;; Brute now has the children from the very last match. | |
258 | (let* ((direct (semantic--analyze-refs-find-child-in-find-results | |
259 | brute (semantic-tag-name tag) classmatch)) | |
260 | ) | |
261 | (setq answer (append direct answer))) | |
262 | ||
263 | answer)) | |
264 | ||
265 | (defun semantic--analyze-refs-full-lookup-simple (tag &optional noerror) | |
9bf6c65c | 266 | "Perform a simple lookup for occurrences of TAG in the current project. |
a6de3d1a CY |
267 | TAG should be the tag currently under point. |
268 | Optional NOERROR means don't throw errors on failure to find something. | |
269 | This only compares the tag name, and does not infer any matches in namespaces, | |
270 | or parts of some other data structure. | |
271 | Only works for tags in the global namespace." | |
272 | (let* ((name (semantic-tag-name tag)) | |
273 | (brute (semanticdb-find-tags-collector | |
274 | (lambda (table tags) | |
275 | (semanticdb-find-tags-by-name-method table name tags) | |
276 | ) | |
dd9af436 CY |
277 | nil ;; This may need to be the entire project?? |
278 | nil t)) | |
a6de3d1a CY |
279 | ) |
280 | ||
281 | (when (and (not brute) (not noerror)) | |
282 | ;; An error, because tag under point ought to be found. | |
283 | (error "Cannot find any references to %s in wide search" name)) | |
284 | ||
285 | (let* ((classmatch (semantic-tag-class tag)) | |
286 | (RES | |
287 | (semanticdb-find-tags-collector | |
288 | (lambda (table tags) | |
289 | (semantic-find-tags-by-class classmatch tags) | |
290 | ;; @todo - Add parent check also. | |
291 | ) | |
292 | brute nil))) | |
293 | ||
294 | (when (and (not RES) (not noerror)) | |
295 | (error "Cannot find any definitions for %s in wide search" | |
296 | (semantic-tag-name tag))) | |
297 | ||
298 | ;; Return the matching tags and databases. | |
299 | RES))) | |
300 | ||
301 | ||
302 | ;;; USER COMMANDS | |
303 | ;; | |
1fe1547a | 304 | ;;;###autoload |
a6de3d1a CY |
305 | (defun semantic-analyze-current-tag () |
306 | "Analyze the tag under point." | |
307 | (interactive) | |
308 | (let* ((tag (semantic-current-tag)) | |
309 | (start (current-time)) | |
310 | (sac (semantic-analyze-tag-references tag)) | |
311 | (end (current-time)) | |
312 | ) | |
313 | (message "Analysis took %.2f seconds." (semantic-elapsed-time start end)) | |
314 | (if sac | |
315 | (progn | |
1fe1547a | 316 | (require 'eieio-datadebug) |
a6de3d1a CY |
317 | (data-debug-new-buffer "*Analyzer Reference ADEBUG*") |
318 | (data-debug-insert-object-slots sac "]")) | |
319 | (message "No Context to analyze here.")))) | |
320 | ||
1fe1547a | 321 | ;;;###autoload |
a6de3d1a CY |
322 | (defun semantic-analyze-proto-impl-toggle () |
323 | "Toggle between the implementation, and a prototype of tag under point." | |
324 | (interactive) | |
1fe1547a | 325 | (require 'semantic/decorate) |
a6de3d1a CY |
326 | (semantic-fetch-tags) |
327 | (let* ((tag (semantic-current-tag)) | |
328 | (sar (if tag | |
329 | (semantic-analyze-tag-references tag) | |
330 | (error "Point must be in a declaration"))) | |
331 | (target (if (semantic-tag-prototype-p tag) | |
332 | (car (semantic-analyze-refs-impl sar t)) | |
333 | (car (semantic-analyze-refs-proto sar t)))) | |
334 | ) | |
335 | ||
336 | (when (not target) | |
337 | (error "Could not find suitable %s" | |
338 | (if (semantic-tag-prototype-p tag) "implementation" "prototype"))) | |
339 | ||
340 | (push-mark) | |
341 | (semantic-go-to-tag target) | |
342 | (switch-to-buffer (current-buffer)) | |
343 | (semantic-momentary-highlight-tag target)) | |
344 | ) | |
345 | ||
a6de3d1a CY |
346 | (provide 'semantic/analyze/refs) |
347 | ||
1fe1547a CY |
348 | ;; Local variables: |
349 | ;; generated-autoload-file: "../loaddefs.el" | |
1fe1547a CY |
350 | ;; generated-autoload-load-name: "semantic/analyze/refs" |
351 | ;; End: | |
352 | ||
3999968a | 353 | ;; arch-tag: f8c59a91-1829-42b3-b083-437c6881841c |
a6de3d1a | 354 | ;;; semantic/analyze/refs.el ends here |