Mercurial > emacs
annotate lisp/cedet/semantic/analyze/refs.el @ 108712:056a00ed4b81
Use terminfo rather than termcap on recent NetBSD.
* configure.in: On NetBSD, if terminfo is found, use it in preference
to termcap. (Bug#6190)
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 19 May 2010 23:37:29 -0700 |
parents | 1d1d5d9bd884 |
children | a5ad4f188e19 |
rev | line source |
---|---|
104421 | 1 ;;; semantic/analyze/refs.el --- Analysis of the references between tags. |
2 | |
106815 | 3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
104421 | 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 | |
104456
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
37 (require 'semantic) |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
38 (require 'semantic/analyze) |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
39 (require 'semantic/db-find) |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
40 (eval-when-compile (require 'semantic/find)) |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
41 |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
42 (declare-function data-debug-new-buffer "data-debug") |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
43 (declare-function data-debug-insert-object-slots "eieio-datadebug") |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
44 (declare-function semantic-momentary-highlight-tag "semantic/decorate") |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
45 |
104421 | 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)) | |
107 (impl nil) | |
108 ) | |
109 (semanticdb-find-result-mapc | |
110 (lambda (T DB) | |
111 "Examine T in the database DB, and sont it." | |
112 (let* ((ans (semanticdb-normalize-one-tag DB T)) | |
113 (aT (cdr ans)) | |
114 (aDB (car ans)) | |
115 ) | |
116 (when (not (semantic-tag-prototype-p aT)) | |
117 (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) | |
118 (push aT impl)))) | |
119 allhits) | |
120 impl)) | |
121 | |
122 (defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer) | |
123 "Return the prototypes derived in the reference analyzer REFS. | |
124 Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." | |
125 (let ((allhits (oref refs rawsearchdata)) | |
126 (proto nil)) | |
127 (semanticdb-find-result-mapc | |
128 (lambda (T DB) | |
129 "Examine T in the database DB, and sort it." | |
130 (let* ((ans (semanticdb-normalize-one-tag DB T)) | |
131 (aT (cdr ans)) | |
132 (aDB (car ans)) | |
133 ) | |
134 (when (semantic-tag-prototype-p aT) | |
135 (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) | |
136 (push aT proto)))) | |
137 allhits) | |
138 proto)) | |
139 | |
140 ;;; LOOKUP | |
141 ;; | |
142 (defun semantic--analyze-refs-full-lookup (tag scope) | |
105340 | 143 "Perform a full lookup for all occurrences of TAG in the current project. |
104421 | 144 TAG should be the tag currently under point. |
145 PARENT is the list of tags that are parents to TAG by | |
146 containment, as opposed to reference." | |
147 (if (not (oref scope parents)) | |
148 ;; If this tag has some named parent, but is not | |
149 (semantic--analyze-refs-full-lookup-simple tag) | |
150 | |
151 ;; We have some sort of lineage we need to consider when we do | |
152 ;; our side lookup of tags. | |
153 (semantic--analyze-refs-full-lookup-with-parents tag scope) | |
154 )) | |
155 | |
156 (defun semantic--analyze-refs-find-child-in-find-results (find-results name class) | |
157 "Find in FIND-RESULT a tag NAME which is a child of a tag in FIND-RESULTS. | |
158 CLASS is the class of the tag that ought to be returned." | |
159 (let ((ans nil) | |
160 (subans nil)) | |
161 ;; Loop over each segment of the find results. | |
162 (dolist (FDB find-results) | |
163 (setq subans nil) | |
164 ;; Loop over each tag in the find results. | |
165 (dolist (T (cdr FDB)) | |
166 ;; For each tag, get the children. | |
167 (let* ((chil (semantic-tag-type-members T)) | |
168 (match (semantic-find-tags-by-name name chil))) | |
169 ;; Go over the matches, looking for matching tag class. | |
170 (dolist (M match) | |
171 (when (semantic-tag-of-class-p M class) | |
172 (push M subans))))) | |
173 ;; Store current matches into a new find results. | |
174 (when subans | |
175 (push (cons (car FDB) subans) ans)) | |
176 ) | |
177 ans)) | |
178 | |
179 (defun semantic--analyze-refs-find-tags-with-parent (find-results parents) | |
180 "Find in FIND-RESULTS all tags with PARNTS. | |
181 NAME is the name of the tag needing finding. | |
182 PARENTS is a list of names." | |
183 (let ((ans nil)) | |
184 (semanticdb-find-result-mapc | |
185 (lambda (tag db) | |
186 (let* ((p (semantic-tag-named-parent tag)) | |
187 (ps (when (stringp p) | |
188 (semantic-analyze-split-name p)))) | |
189 (when (stringp ps) (setq ps (list ps))) | |
190 (when (and ps (equal ps parents)) | |
191 ;; We could optimize this, but it seems unlikely. | |
192 (push (list db tag) ans)) | |
193 )) | |
194 find-results) | |
195 ans)) | |
196 | |
197 (defun semantic--analyze-refs-full-lookup-with-parents (tag scope) | |
105340 | 198 "Perform a lookup for all occurrences of TAG based on TAG's SCOPE. |
104421 | 199 TAG should be the tag currently under point." |
200 (let* ((classmatch (semantic-tag-class tag)) | |
201 (plist (mapcar (lambda (T) (semantic-tag-name T)) (oref scope parents))) | |
202 ;; The first item in the parent list | |
203 (name (car plist)) | |
204 ;; Stuff from the simple list. | |
205 (simple (semantic--analyze-refs-full-lookup-simple tag t)) | |
206 ;; Find all hits for the first parent name. | |
207 (brute (semanticdb-find-tags-collector | |
208 (lambda (table tags) | |
209 (semanticdb-find-tags-by-name-method table name tags) | |
210 ) | |
211 nil nil t)) | |
212 ;; Prime the answer. | |
213 (answer (semantic--analyze-refs-find-tags-with-parent simple plist)) | |
214 ) | |
215 ;; First parent is already search to initialize "brute". | |
216 (setq plist (cdr plist)) | |
217 ;; Go through the list of parents, and try to find matches. | |
218 ;; As we cycle through plist, for each level look for NAME, | |
219 ;; and compare the named-parent, and also dive into the next item of | |
220 ;; plist. | |
221 (while (and plist brute) | |
222 | |
223 ;; Find direct matches | |
224 (let* ((direct (semantic--analyze-refs-find-child-in-find-results | |
225 brute (semantic-tag-name tag) classmatch)) | |
226 (pdirect (semantic--analyze-refs-find-tags-with-parent | |
227 direct plist))) | |
228 (setq answer (append pdirect answer))) | |
229 | |
230 ;; The next set of search items. | |
231 (setq brute (semantic--analyze-refs-find-child-in-find-results | |
232 brute (car plist) 'type)) | |
233 | |
234 (setq plist (cdr plist))) | |
235 | |
236 ;; Brute now has the children from the very last match. | |
237 (let* ((direct (semantic--analyze-refs-find-child-in-find-results | |
238 brute (semantic-tag-name tag) classmatch)) | |
239 ) | |
240 (setq answer (append direct answer))) | |
241 | |
242 answer)) | |
243 | |
244 (defun semantic--analyze-refs-full-lookup-simple (tag &optional noerror) | |
105340 | 245 "Perform a simple lookup for occurrences of TAG in the current project. |
104421 | 246 TAG should be the tag currently under point. |
247 Optional NOERROR means don't throw errors on failure to find something. | |
248 This only compares the tag name, and does not infer any matches in namespaces, | |
249 or parts of some other data structure. | |
250 Only works for tags in the global namespace." | |
251 (let* ((name (semantic-tag-name tag)) | |
252 (brute (semanticdb-find-tags-collector | |
253 (lambda (table tags) | |
254 (semanticdb-find-tags-by-name-method table name tags) | |
255 ) | |
256 nil nil t)) | |
257 ) | |
258 | |
259 (when (and (not brute) (not noerror)) | |
260 ;; An error, because tag under point ought to be found. | |
261 (error "Cannot find any references to %s in wide search" name)) | |
262 | |
263 (let* ((classmatch (semantic-tag-class tag)) | |
264 (RES | |
265 (semanticdb-find-tags-collector | |
266 (lambda (table tags) | |
267 (semantic-find-tags-by-class classmatch tags) | |
268 ;; @todo - Add parent check also. | |
269 ) | |
270 brute nil))) | |
271 | |
272 (when (and (not RES) (not noerror)) | |
273 (error "Cannot find any definitions for %s in wide search" | |
274 (semantic-tag-name tag))) | |
275 | |
276 ;; Return the matching tags and databases. | |
277 RES))) | |
278 | |
279 | |
280 ;;; USER COMMANDS | |
281 ;; | |
104456
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
282 ;;;###autoload |
104421 | 283 (defun semantic-analyze-current-tag () |
284 "Analyze the tag under point." | |
285 (interactive) | |
286 (let* ((tag (semantic-current-tag)) | |
287 (start (current-time)) | |
288 (sac (semantic-analyze-tag-references tag)) | |
289 (end (current-time)) | |
290 ) | |
291 (message "Analysis took %.2f seconds." (semantic-elapsed-time start end)) | |
292 (if sac | |
293 (progn | |
104456
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
294 (require 'eieio-datadebug) |
104421 | 295 (data-debug-new-buffer "*Analyzer Reference ADEBUG*") |
296 (data-debug-insert-object-slots sac "]")) | |
297 (message "No Context to analyze here.")))) | |
298 | |
104456
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
299 ;;;###autoload |
104421 | 300 (defun semantic-analyze-proto-impl-toggle () |
301 "Toggle between the implementation, and a prototype of tag under point." | |
302 (interactive) | |
104456
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
303 (require 'semantic/decorate) |
104421 | 304 (semantic-fetch-tags) |
305 (let* ((tag (semantic-current-tag)) | |
306 (sar (if tag | |
307 (semantic-analyze-tag-references tag) | |
308 (error "Point must be in a declaration"))) | |
309 (target (if (semantic-tag-prototype-p tag) | |
310 (car (semantic-analyze-refs-impl sar t)) | |
311 (car (semantic-analyze-refs-proto sar t)))) | |
312 ) | |
313 | |
314 (when (not target) | |
315 (error "Could not find suitable %s" | |
316 (if (semantic-tag-prototype-p tag) "implementation" "prototype"))) | |
317 | |
318 (push-mark) | |
319 (semantic-go-to-tag target) | |
320 (switch-to-buffer (current-buffer)) | |
321 (semantic-momentary-highlight-tag target)) | |
322 ) | |
323 | |
324 (provide 'semantic/analyze/refs) | |
325 | |
104456
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
326 ;; Local variables: |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
327 ;; generated-autoload-file: "../loaddefs.el" |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
328 ;; generated-autoload-load-name: "semantic/analyze/refs" |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
329 ;; End: |
6065d66f0c99
lisp/cedet/semantic/db-ref.el: Require semantic/db.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
330 |
105377 | 331 ;; arch-tag: f8c59a91-1829-42b3-b083-437c6881841c |
104421 | 332 ;;; semantic/analyze/refs.el ends here |