Mercurial > emacs
comparison lisp/cedet/semantic/ia.el @ 104420:2e15afd37998
cedet/semantic/adebug.el, cedet/semantic/chart.el,
cedet/semantic/db-debug.el, cedet/semantic/db-ebrowse.el,
cedet/semantic/db-el.el, cedet/semantic/db-file.el,
cedet/semantic/db-javascript.el, cedet/semantic/db-search.el,
cedet/semantic/db-typecache.el, cedet/semantic/dep.el,
cedet/semantic/ia.el, cedet/semantic/tag-file.el,
cedet/semantic/tag-ls.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 29 Aug 2009 19:32:33 +0000 |
parents | |
children | 3783a1145a65 |
comparison
equal
deleted
inserted
replaced
104419:b1ac14799f78 | 104420:2e15afd37998 |
---|---|
1 ;;; ia.el --- Interactive Analysis functions | |
2 | |
3 ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, | |
4 ;;; 2008, 2009 Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Keywords: syntax | |
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 ;; Interactive access to `semantic-analyze'. | |
27 ;; | |
28 ;; These routines are fairly simple, and show how to use the Semantic | |
29 ;; analyzer to provide things such as completion lists, summaries, | |
30 ;; locations, or documentation. | |
31 ;; | |
32 | |
33 ;;; TODO | |
34 ;; | |
35 ;; fast-jump. For a virtual method, offer some of the possible | |
36 ;; implementations in various sub-classes. | |
37 | |
38 (require 'senator) | |
39 (require 'semantic/analyze) | |
40 (require 'pulse) | |
41 (eval-when-compile | |
42 (require 'semantic/analyze) | |
43 (require 'semantic/analyze/refs)) | |
44 | |
45 ;;; Code: | |
46 | |
47 ;;; COMPLETION | |
48 ;; | |
49 ;; This set of routines provides some simplisting completion | |
50 ;; functions. | |
51 | |
52 (defcustom semantic-ia-completion-format-tag-function | |
53 'semantic-prototype-nonterminal | |
54 "*Function used to convert a tag to a string during completion." | |
55 :group 'semantic | |
56 :type semantic-format-tag-custom-list) | |
57 | |
58 (defvar semantic-ia-cache nil | |
59 "Cache of the last completion request. | |
60 Of the form ( POINT . COMPLETIONS ) where POINT is a location in the | |
61 buffer where the completion was requested. COMPLETONS is the list | |
62 of semantic tag names that provide logical completions from that | |
63 location.") | |
64 (make-variable-buffer-local 'semantic-ia-cache) | |
65 | |
66 (defun semantic-ia-get-completions (context point) | |
67 "Fetch the completion of CONTEXT at POINT. | |
68 Supports caching." | |
69 ;; Cache the current set of symbols so that we can get at | |
70 ;; them quickly the second time someone presses the | |
71 ;; complete button. | |
72 (let ((symbols | |
73 (if (and semantic-ia-cache | |
74 (= point (car semantic-ia-cache))) | |
75 (cdr semantic-ia-cache) | |
76 (semantic-analyze-possible-completions context)))) | |
77 ;; Set the cache | |
78 (setq semantic-ia-cache (cons point symbols)) | |
79 symbols)) | |
80 | |
81 (defun semantic-ia-complete-symbol (point) | |
82 "Complete the current symbol at POINT. | |
83 Completion options are calculated with `semantic-analyze-possible-completions'." | |
84 (interactive "d") | |
85 ;; Calculating completions is a two step process. | |
86 ;; | |
87 ;; The first analyzer the current context, which finds tags | |
88 ;; for all the stuff that may be references by the code around | |
89 ;; POINT. | |
90 ;; | |
91 ;; The second step derives completions from that context. | |
92 (let* ((a (semantic-analyze-current-context point)) | |
93 (syms (semantic-ia-get-completions a point)) | |
94 (pre (car (reverse (oref a prefix)))) | |
95 ) | |
96 ;; If PRE was actually an already completed symbol, it doesn't | |
97 ;; come in as a string, but as a tag instead. | |
98 (if (semantic-tag-p pre) | |
99 ;; We will try completions on it anyway. | |
100 (setq pre (semantic-tag-name pre))) | |
101 ;; Complete this symbol. | |
102 (if (null syms) | |
103 (progn | |
104 ;(message "No smart completions found. Trying senator-complete-symbol.") | |
105 (if (semantic-analyze-context-p a) | |
106 ;; This is a clever hack. If we were unable to find any | |
107 ;; smart completions, lets divert to how senator derives | |
108 ;; completions. | |
109 ;; | |
110 ;; This is a way of making this fcn more useful since the | |
111 ;; smart completion engine sometimes failes. | |
112 (senator-complete-symbol) | |
113 )) | |
114 ;; Use try completion to seek a common substring. | |
115 (let ((tc (try-completion (or pre "") syms))) | |
116 (if (and (stringp tc) (not (string= tc (or pre "")))) | |
117 (let ((tok (semantic-find-first-tag-by-name | |
118 tc syms))) | |
119 ;; Delete what came before... | |
120 (when (and (car (oref a bounds)) (cdr (oref a bounds))) | |
121 (delete-region (car (oref a bounds)) | |
122 (cdr (oref a bounds))) | |
123 (goto-char (car (oref a bounds)))) | |
124 ;; We have some new text. Stick it in. | |
125 (if tok | |
126 (semantic-ia-insert-tag tok) | |
127 (insert tc))) | |
128 ;; We don't have new text. Show all completions. | |
129 (when (cdr (oref a bounds)) | |
130 (goto-char (cdr (oref a bounds)))) | |
131 (with-output-to-temp-buffer "*Completions*" | |
132 (display-completion-list | |
133 (mapcar semantic-ia-completion-format-tag-function syms)) | |
134 )))))) | |
135 | |
136 (defcustom semantic-ia-completion-menu-format-tag-function | |
137 'semantic-uml-concise-prototype-nonterminal | |
138 "*Function used to convert a tag to a string during completion." | |
139 :group 'semantic | |
140 :type semantic-format-tag-custom-list) | |
141 | |
142 (defun semantic-ia-complete-symbol-menu (point) | |
143 "Complete the current symbol via a menu based at POINT. | |
144 Completion options are calculated with `semantic-analyze-possible-completions'." | |
145 (interactive "d") | |
146 (let* ((a (semantic-analyze-current-context point)) | |
147 (syms (semantic-ia-get-completions a point)) | |
148 ) | |
149 ;; Complete this symbol. | |
150 (if (not syms) | |
151 (progn | |
152 (message "No smart completions found. Trying Senator.") | |
153 (when (semantic-analyze-context-p a) | |
154 ;; This is a quick way of getting a nice completion list | |
155 ;; in the menu if the regular context mechanism fails. | |
156 (senator-completion-menu-popup))) | |
157 | |
158 (let* ((menu | |
159 (mapcar | |
160 (lambda (tag) | |
161 (cons | |
162 (funcall semantic-ia-completion-menu-format-tag-function tag) | |
163 (vector tag))) | |
164 syms)) | |
165 (ans | |
166 (imenu--mouse-menu | |
167 ;; XEmacs needs that the menu has at least 2 items. So, | |
168 ;; include a nil item that will be ignored by imenu. | |
169 (cons nil menu) | |
170 (senator-completion-menu-point-as-event) | |
171 "Completions"))) | |
172 (when ans | |
173 (if (not (semantic-tag-p ans)) | |
174 (setq ans (aref (cdr ans) 0))) | |
175 (delete-region (car (oref a bounds)) (cdr (oref a bounds))) | |
176 (semantic-ia-insert-tag ans)) | |
177 )))) | |
178 | |
179 ;;; COMPLETION HELPER | |
180 ;; | |
181 ;; This overload function handles inserting a tag | |
182 ;; into a buffer for these local completion routines. | |
183 ;; | |
184 ;; By creating the functions as overloadable, it can be | |
185 ;; customized. For example, the default will put a paren "(" | |
186 ;; character after function names. For Lisp, it might check | |
187 ;; to put a "(" in front of a function name. | |
188 | |
189 (define-overloadable-function semantic-ia-insert-tag (tag) | |
190 "Insert TAG into the current buffer based on completion.") | |
191 | |
192 (defun semantic-ia-insert-tag-default (tag) | |
193 "Insert TAG into the current buffer based on completion." | |
194 (insert (semantic-tag-name tag)) | |
195 (let ((tt (semantic-tag-class tag))) | |
196 (cond ((eq tt 'function) | |
197 (insert "(")) | |
198 (t nil)))) | |
199 | |
200 ;;; Completions Tip | |
201 ;; | |
202 ;; This functions shows how to get the list of completions, | |
203 ;; to place in a tooltip. It doesn't actually do any completion. | |
204 | |
205 (defun semantic-ia-complete-tip (point) | |
206 "Pop up a tooltip for completion at POINT." | |
207 (interactive "d") | |
208 (let* ((a (semantic-analyze-current-context point)) | |
209 (syms (semantic-ia-get-completions a point)) | |
210 (x (mod (- (current-column) (window-hscroll)) | |
211 (window-width))) | |
212 (y (save-excursion | |
213 (save-restriction | |
214 (widen) | |
215 (narrow-to-region (window-start) (point)) | |
216 (goto-char (point-min)) | |
217 (1+ (vertical-motion (buffer-size)))))) | |
218 (str (mapconcat #'semantic-tag-name | |
219 syms | |
220 "\n")) | |
221 ) | |
222 (cond ((fboundp 'x-show-tip) | |
223 (x-show-tip str | |
224 (selected-frame) | |
225 nil | |
226 nil | |
227 x y) | |
228 ) | |
229 (t (message str)) | |
230 ))) | |
231 | |
232 ;;; Summary | |
233 ;; | |
234 ;; Like idle-summary-mode, this shows how to get something to | |
235 ;; show a summary on. | |
236 | |
237 (defun semantic-ia-show-summary (point) | |
238 "Display a summary for the symbol under POINT." | |
239 (interactive "P") | |
240 (let* ((ctxt (semantic-analyze-current-context point)) | |
241 (pf (when ctxt | |
242 ;; The CTXT is an EIEIO object. The below | |
243 ;; method will attempt to pick the most interesting | |
244 ;; tag associated with the current context. | |
245 (semantic-analyze-interesting-tag ctxt))) | |
246 ) | |
247 (when pf | |
248 (message "%s" (semantic-format-tag-summarize pf nil t))))) | |
249 | |
250 ;;; FAST Jump | |
251 ;; | |
252 ;; Jump to a destination based on the local context. | |
253 ;; | |
254 ;; This shows how to use the analyzer context, and the | |
255 ;; analyer references objects to choose a good destination. | |
256 | |
257 (defun semantic-ia--fast-jump-helper (dest) | |
258 "Jump to DEST, a Semantic tag. | |
259 This helper manages the mark, buffer switching, and pulsing." | |
260 ;; We have a tag, but in C++, we usually get a prototype instead | |
261 ;; because of header files. Lets try to find the actual | |
262 ;; implementaion instead. | |
263 (when (semantic-tag-prototype-p dest) | |
264 (let* ((refs (semantic-analyze-tag-references dest)) | |
265 (impl (semantic-analyze-refs-impl refs t)) | |
266 ) | |
267 (when impl (setq dest (car impl))))) | |
268 | |
269 ;; Make sure we have a place to go... | |
270 (if (not (and (or (semantic-tag-with-position-p dest) | |
271 (semantic-tag-get-attribute dest :line)) | |
272 (semantic-tag-file-name dest))) | |
273 (error "Tag %s has no buffer information" | |
274 (semantic-format-tag-name dest))) | |
275 | |
276 ;; Once we have the tag, we can jump to it. Here | |
277 ;; are the key bits to the jump: | |
278 | |
279 ;; 1) Push the mark, so you can pop global mark back, or | |
280 ;; use semantic-mru-bookmark mode to do so. | |
281 (push-mark) | |
282 (when (fboundp 'push-tag-mark) | |
283 (push-tag-mark)) | |
284 ;; 2) Visits the tag. | |
285 (semantic-go-to-tag dest) | |
286 ;; 3) go-to-tag doesn't switch the buffer in the current window, | |
287 ;; so it is like find-file-noselect. Bring it forward. | |
288 (switch-to-buffer (current-buffer)) | |
289 ;; 4) Fancy pulsing. | |
290 (pulse-momentary-highlight-one-line (point)) | |
291 ) | |
292 | |
293 (defun semantic-ia-fast-jump (point) | |
294 "Jump to the tag referred to by the code at POINT. | |
295 Uses `semantic-analyze-current-context' output to identify an accurate | |
296 origin of the code at point." | |
297 (interactive "d") | |
298 (let* ((ctxt (semantic-analyze-current-context point)) | |
299 (pf (and ctxt (reverse (oref ctxt prefix)))) | |
300 ;; In the analyzer context, the PREFIX is the list of items | |
301 ;; that makes up the code context at point. Thus the c++ code | |
302 ;; this.that().theothe | |
303 ;; would make a list: | |
304 ;; ( ("this" variable ..) ("that" function ...) "theothe") | |
305 ;; Where the first two elements are the semantic tags of the prefix. | |
306 ;; | |
307 ;; PF is the reverse of this list. If the first item is a string, | |
308 ;; then it is an incomplete symbol, thus we pick the second. | |
309 ;; The second cannot be a string, as that would have been an error. | |
310 (first (car pf)) | |
311 (second (nth 1 pf)) | |
312 ) | |
313 (cond | |
314 ((semantic-tag-p first) | |
315 ;; We have a match. Just go there. | |
316 (semantic-ia--fast-jump-helper first)) | |
317 | |
318 ((semantic-tag-p second) | |
319 ;; Because FIRST failed, we should visit our second tag. | |
320 ;; HOWEVER, the tag we actually want that was only an unfound | |
321 ;; string may be related to some take in the datatype that belongs | |
322 ;; to SECOND. Thus, instead of visiting second directly, we | |
323 ;; can offer to find the type of SECOND, and go there. | |
324 (let ((secondclass (car (reverse (oref ctxt prefixtypes))))) | |
325 (cond | |
326 ((and (semantic-tag-with-position-p secondclass) | |
327 (y-or-n-p (format "Could not find `%s'. Jump to %s? " | |
328 first (semantic-tag-name secondclass)))) | |
329 (semantic-ia--fast-jump-helper secondclass) | |
330 ) | |
331 ;; If we missed out on the class of the second item, then | |
332 ;; just visit SECOND. | |
333 ((and (semantic-tag-p second) | |
334 (y-or-n-p (format "Could not find `%s'. Jump to %s? " | |
335 first (semantic-tag-name second)))) | |
336 (semantic-ia--fast-jump-helper second) | |
337 )))) | |
338 | |
339 ((semantic-tag-of-class-p (semantic-current-tag) 'include) | |
340 ;; Just borrow this cool fcn. | |
341 (semantic-decoration-include-visit) | |
342 ) | |
343 | |
344 (t | |
345 (error "Could not find suitable jump point for %s" | |
346 first)) | |
347 ))) | |
348 | |
349 (defun semantic-ia-fast-mouse-jump (evt) | |
350 "Jump to the tag referred to by the point clicked on. | |
351 See `semantic-ia-fast-jump' for details on how it works. | |
352 This command is meant to be bound to a mouse event." | |
353 (interactive "e") | |
354 (semantic-ia-fast-jump | |
355 (save-excursion | |
356 (posn-set-point (event-end evt)) | |
357 (point)))) | |
358 | |
359 ;;; DOC/DESCRIBE | |
360 ;; | |
361 ;; These routines show how to get additional information about a tag | |
362 ;; for purposes of describing or showing documentation about them. | |
363 (defun semantic-ia-show-doc (point) | |
364 "Display the code-level documentation for the symbol at POINT." | |
365 (interactive "d") | |
366 (let* ((ctxt (semantic-analyze-current-context point)) | |
367 (pf (reverse (oref ctxt prefix))) | |
368 ) | |
369 ;; If PF, the prefix is non-nil, then the last element is either | |
370 ;; a string (incomplete type), or a semantic TAG. If it is a TAG | |
371 ;; then we should be able to find DOC for it. | |
372 (cond | |
373 ((stringp (car pf)) | |
374 (message "Incomplete symbol name.")) | |
375 ((semantic-tag-p (car pf)) | |
376 ;; The `semantic-documentation-for-tag' fcn is language | |
377 ;; specific. If it doesn't return what you expect, you may | |
378 ;; need to implement something for your language. | |
379 ;; | |
380 ;; The default tries to find a comment in front of the tag | |
381 ;; and then strings off comment prefixes. | |
382 (let ((doc (semantic-documentation-for-tag (car pf)))) | |
383 (with-output-to-temp-buffer "*TAG DOCUMENTATION*" | |
384 (princ "Tag: ") | |
385 (princ (semantic-format-tag-prototype (car pf))) | |
386 (princ "\n") | |
387 (princ "\n") | |
388 (princ "Snarfed Documentation: ") | |
389 (princ "\n") | |
390 (princ "\n") | |
391 (if doc | |
392 (princ doc) | |
393 (princ " Documentation unavailable.")) | |
394 ))) | |
395 (t | |
396 (message "Unknown tag."))) | |
397 )) | |
398 | |
399 (defun semantic-ia-describe-class (typename) | |
400 "Display all known parts for the datatype TYPENAME. | |
401 If the type in question is a class, all methods and other accessible | |
402 parts of the parent classes are displayed." | |
403 ;; @todo - use a fancy completing reader. | |
404 (interactive "sType Name: ") | |
405 | |
406 ;; When looking for a tag of any name there are a couple ways to do | |
407 ;; it. The simple `semanticdb-find-tag-by-...' are simple, and | |
408 ;; you need to pass it the exact name you want. | |
409 ;; | |
410 ;; The analyzer function `semantic-analyze-tag-name' will take | |
411 ;; more complex names, such as the cpp symbol foo::bar::baz, | |
412 ;; and break it up, and dive through the namespaces. | |
413 (let ((class (semantic-analyze-find-tag typename))) | |
414 | |
415 (when (not (semantic-tag-p class)) | |
416 (error "Cannot find class %s" class)) | |
417 (with-output-to-temp-buffer "*TAG DOCUMENTATION*" | |
418 ;; There are many semantic-format-tag-* fcns. | |
419 ;; The summarize routine is a fairly generic one. | |
420 (princ (semantic-format-tag-summarize class)) | |
421 (princ "\n") | |
422 (princ " Type Members:\n") | |
423 ;; The type tag contains all the parts of the type. | |
424 ;; In complex languages with inheritance, not all the | |
425 ;; parts are in the tag. This analyzer fcn will traverse | |
426 ;; the inheritance tree, and find all the pieces that | |
427 ;; are inherited. | |
428 (let ((parts (semantic-analyze-scoped-type-parts class))) | |
429 (while parts | |
430 (princ " ") | |
431 (princ (semantic-format-tag-summarize (car parts))) | |
432 (princ "\n") | |
433 (setq parts (cdr parts))) | |
434 ) | |
435 ))) | |
436 | |
437 (provide 'semantic/ia) | |
438 | |
439 ;;; semantic-ia.el ends here |