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