1 ;;; semantic/ia.el --- Interactive Analysis functions
3 ;;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
8 ;; This file is part of GNU Emacs.
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.
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.
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/>.
25 ;; Interactive access to `semantic-analyze'.
27 ;; These routines are fairly simple, and show how to use the Semantic
28 ;; analyzer to provide things such as completion lists, summaries,
29 ;; locations, or documentation.
34 ;; fast-jump. For a virtual method, offer some of the possible
35 ;; implementations in various sub-classes.
37 (require 'semantic
/analyze
)
38 (require 'semantic
/format
)
40 (require 'semantic
/senator
)
41 (require 'semantic
/analyze
/refs
)
43 (require 'semantic
/analyze
)
44 (require 'semantic
/find
))
46 (declare-function imenu--mouse-menu
"imenu")
52 ;; This set of routines provides some simplisting completion
55 (defcustom semantic-ia-completion-format-tag-function
56 'semantic-format-tag-prototype
57 "Function used to convert a tag to a string during completion."
59 :type semantic-format-tag-custom-list
)
63 ;; This overload function handles inserting a tag
64 ;; into a buffer for these local completion routines.
66 ;; By creating the functions as overloadable, it can be
67 ;; customized. For example, the default will put a paren "("
68 ;; character after function names. For Lisp, it might check
69 ;; to put a "(" in front of a function name.
71 (define-overloadable-function semantic-ia-insert-tag
(tag)
72 "Insert TAG into the current buffer based on completion.")
74 (defun semantic-ia-insert-tag-default (tag)
75 "Insert TAG into the current buffer based on completion."
76 (insert (semantic-tag-name tag
))
77 (let ((tt (semantic-tag-class tag
)))
78 (cond ((eq tt
'function
)
82 (defalias 'semantic-ia-get-completions
'semantic-ia-get-completions-deprecated
83 "`Semantic-ia-get-completions' is obsolete.
84 Use `semantic-analyze-possible-completions' instead.")
86 (defun semantic-ia-get-completions-deprecated (context point
)
87 "A function to help transition away from `semantic-ia-get-completions'.
88 Return completions based on CONTEXT at POINT.
89 You should not use this, nor the aliased version.
90 Use `semantic-analyze-possible-completions' instead."
91 (semantic-analyze-possible-completions context
))
94 (defun semantic-ia-complete-symbol (&optional pos
)
95 "Complete the current symbol at POS.
96 If POS is nil, default to point.
97 Completion options are calculated with `semantic-analyze-possible-completions'."
99 (when (semantic-active-p)
100 (or pos
(setq pos
(point)))
101 ;; Calculating completions is a two step process.
103 ;; The first analyzer the current context, which finds tags for
104 ;; all the stuff that may be references by the code around POS.
106 ;; The second step derives completions from that context.
107 (let* ((a (semantic-analyze-current-context pos
))
108 (syms (semantic-analyze-possible-completions a
))
109 (pre (car (reverse (oref a prefix
)))))
110 ;; If PRE was actually an already completed symbol, it doesn't
111 ;; come in as a string, but as a tag instead.
112 (if (semantic-tag-p pre
)
113 ;; We will try completions on it anyway.
114 (setq pre
(semantic-tag-name pre
)))
115 ;; Complete this symbol.
117 (if (semantic-analyze-context-p a
)
118 ;; This is a clever hack. If we were unable to find any
119 ;; smart completions, let's divert to how senator derives
122 ;; This is a way of making this fcn more useful since
123 ;; the smart completion engine sometimes fails.
124 (semantic-complete-symbol))
125 ;; Use try completion to seek a common substring.
126 (let* ((completion-ignore-case (string= (downcase pre
) pre
))
127 (tc (try-completion (or pre
"") syms
)))
128 (if (and (stringp tc
) (not (string= tc
(or pre
""))))
129 (let ((tok (semantic-find-first-tag-by-name
131 ;; Delete what came before...
132 (when (and (car (oref a bounds
)) (cdr (oref a bounds
)))
133 (delete-region (car (oref a bounds
))
134 (cdr (oref a bounds
)))
135 (goto-char (car (oref a bounds
))))
136 ;; We have some new text. Stick it in.
138 (semantic-ia-insert-tag tok
)
140 ;; We don't have new text. Show all completions.
141 (when (cdr (oref a bounds
))
142 (goto-char (cdr (oref a bounds
))))
143 (with-output-to-temp-buffer "*Completions*"
144 (display-completion-list
145 (mapcar semantic-ia-completion-format-tag-function syms
)))))))))
147 (defcustom semantic-ia-completion-menu-format-tag-function
148 'semantic-format-tag-uml-concise-prototype
149 "*Function used to convert a tag to a string during completion."
151 :type semantic-format-tag-custom-list
)
154 (defun semantic-ia-complete-symbol-menu (point)
155 "Complete the current symbol via a menu based at POINT.
156 Completion options are calculated with `semantic-analyze-possible-completions'."
159 (let* ((a (semantic-analyze-current-context point
))
160 (syms (semantic-analyze-possible-completions a
))
162 ;; Complete this symbol.
165 (message "No smart completions found.")
166 ;; Disabled - see http://debbugs.gnu.org/14522
167 ;; (message "No smart completions found. Trying Senator.")
168 ;; (when (semantic-analyze-context-p a)
169 ;; ;; This is a quick way of getting a nice completion list
170 ;; ;; in the menu if the regular context mechanism fails.
171 ;; (senator-completion-menu-popup))
178 (funcall semantic-ia-completion-menu-format-tag-function tag
)
183 ;; XEmacs needs that the menu has at least 2 items. So,
184 ;; include a nil item that will be ignored by imenu.
186 `(down-mouse-1 ,(posn-at-point))
189 (if (not (semantic-tag-p ans
))
190 (setq ans
(aref (cdr ans
) 0)))
191 (delete-region (car (oref a bounds
)) (cdr (oref a bounds
)))
192 (semantic-ia-insert-tag ans
))
197 ;; This functions shows how to get the list of completions,
198 ;; to place in a tooltip. It doesn't actually do any completion.
201 (defun semantic-ia-complete-tip (point)
202 "Pop up a tooltip for completion at POINT."
204 (let* ((a (semantic-analyze-current-context point
))
205 (syms (semantic-analyze-possible-completions a
))
206 (x (mod (- (current-column) (window-hscroll))
211 (narrow-to-region (window-start) (point))
212 (goto-char (point-min))
213 (1+ (vertical-motion (buffer-size))))))
214 (str (mapconcat #'semantic-tag-name
218 (cond ((fboundp 'x-show-tip
)
230 ;; Like idle-summary-mode, this shows how to get something to
231 ;; show a summary on.
234 (defun semantic-ia-show-summary (point)
235 "Display a summary for the symbol under POINT."
237 (let* ((ctxt (semantic-analyze-current-context point
))
239 ;; The CTXT is an EIEIO object. The below
240 ;; method will attempt to pick the most interesting
241 ;; tag associated with the current context.
242 (semantic-analyze-interesting-tag ctxt
)))
245 (message "%s" (semantic-format-tag-summarize pf nil t
))
246 (message "No summary info available"))))
250 ;; Show all variants for the symbol under point.
253 (defun semantic-ia-show-variants (point)
254 "Display a list of all variants for the symbol under POINT."
256 (let* ((ctxt (semantic-analyze-current-context point
))
259 ;; We really want to look at the function if we are on an
260 ;; argument. Are there some additional rules we care about for
261 ;; changing the CTXT we look at?
262 (when (semantic-analyze-context-functionarg-p ctxt
)
263 (goto-char (cdr (oref ctxt bounds
)))
264 (setq ctxt
(semantic-analyze-current-context (point))))
266 ;; Get the "completion list", but remove ALL filters to get the master list
267 ;; of all the possible things.
268 (setq comp
(semantic-analyze-possible-completions ctxt
'no-unique
'no-tc
))
270 ;; Special case for a single type. List the constructors?
271 (when (and (= (length comp
) 1) (semantic-tag-of-class-p (car comp
) 'type
))
272 (setq comp
(semantic-find-tags-by-name (semantic-tag-name (car comp
))
273 (semantic-tag-type-members (car comp
)))))
275 ;; Display the results.
276 (cond ((= (length comp
) 0)
277 (message "No Variants found."))
279 (message "%s" (semantic-format-tag-summarize (car comp
) nil t
)))
281 (with-output-to-temp-buffer "*Symbol Variants*"
282 (semantic-analyze-princ-sequence comp
"" (current-buffer)))
283 (shrink-window-if-larger-than-buffer
284 (get-buffer-window "*Symbol Variants*")))
289 ;; Jump to a destination based on the local context.
291 ;; This shows how to use the analyzer context, and the
292 ;; analyzer references objects to choose a good destination.
294 (defun semantic-ia--fast-jump-helper (dest)
295 "Jump to DEST, a Semantic tag.
296 This helper manages the mark, buffer switching, and pulsing."
297 ;; We have a tag, but in C++, we usually get a prototype instead
298 ;; because of header files. Let's try to find the actual
299 ;; implementation instead.
300 (when (semantic-tag-prototype-p dest
)
301 (let* ((refs (semantic-analyze-tag-references dest
))
302 (impl (semantic-analyze-refs-impl refs t
))
304 (when impl
(setq dest
(car impl
)))))
306 ;; Make sure we have a place to go...
307 (if (not (and (or (semantic-tag-with-position-p dest
)
308 (semantic-tag-get-attribute dest
:line
))
309 (semantic-tag-file-name dest
)))
310 (error "Tag %s has no buffer information"
311 (semantic-format-tag-name dest
)))
313 ;; Once we have the tag, we can jump to it. Here
314 ;; are the key bits to the jump:
316 ;; 1) Push the mark, so you can pop global mark back, or
317 ;; use semantic-mru-bookmark mode to do so.
319 (when (fboundp 'push-tag-mark
)
321 ;; 2) Visits the tag.
322 (semantic-go-to-tag dest
)
323 ;; 3) go-to-tag doesn't switch the buffer in the current window,
324 ;; so it is like find-file-noselect. Bring it forward.
325 (switch-to-buffer (current-buffer))
327 (pulse-momentary-highlight-one-line (point))
330 (declare-function semantic-decoration-include-visit
"semantic/decorate/include")
333 (defun semantic-ia-fast-jump (point)
334 "Jump to the tag referred to by the code at POINT.
335 Uses `semantic-analyze-current-context' output to identify an accurate
336 origin of the code at point."
338 (let* ((ctxt (semantic-analyze-current-context point
))
339 (pf (and ctxt
(reverse (oref ctxt prefix
))))
340 ;; In the analyzer context, the PREFIX is the list of items
341 ;; that makes up the code context at point. Thus the c++ code
342 ;; this.that().theothe
343 ;; would make a list:
344 ;; ( ("this" variable ..) ("that" function ...) "theothe")
345 ;; Where the first two elements are the semantic tags of the prefix.
347 ;; PF is the reverse of this list. If the first item is a string,
348 ;; then it is an incomplete symbol, thus we pick the second.
349 ;; The second cannot be a string, as that would have been an error.
354 ((semantic-tag-p first
)
355 ;; We have a match. Just go there.
356 (semantic-ia--fast-jump-helper first
))
358 ((semantic-tag-p second
)
359 ;; Because FIRST failed, we should visit our second tag.
360 ;; HOWEVER, the tag we actually want that was only an unfound
361 ;; string may be related to some take in the datatype that belongs
362 ;; to SECOND. Thus, instead of visiting second directly, we
363 ;; can offer to find the type of SECOND, and go there.
364 (let ((secondclass (car (reverse (oref ctxt prefixtypes
)))))
366 ((and (semantic-tag-with-position-p secondclass
)
367 (y-or-n-p (format "Could not find `%s'. Jump to %s? "
368 first
(semantic-tag-name secondclass
))))
369 (semantic-ia--fast-jump-helper secondclass
)
371 ;; If we missed out on the class of the second item, then
372 ;; just visit SECOND.
373 ((and (semantic-tag-p second
)
374 (y-or-n-p (format "Could not find `%s'. Jump to %s? "
375 first
(semantic-tag-name second
))))
376 (semantic-ia--fast-jump-helper second
)
379 ((semantic-tag-of-class-p (semantic-current-tag) 'include
)
380 ;; Just borrow this cool fcn.
381 (require 'semantic
/decorate
/include
)
383 ;; Push the mark, so you can pop global mark back, or
384 ;; use semantic-mru-bookmark mode to do so.
386 (when (fboundp 'push-tag-mark
)
389 (semantic-decoration-include-visit)
393 (error "Could not find suitable jump point for %s"
398 (defun semantic-ia-fast-mouse-jump (evt)
399 "Jump to the tag referred to by the point clicked on.
400 See `semantic-ia-fast-jump' for details on how it works.
401 This command is meant to be bound to a mouse event."
403 (semantic-ia-fast-jump
405 (posn-set-point (event-end evt
))
410 ;; These routines show how to get additional information about a tag
411 ;; for purposes of describing or showing documentation about them.
413 (defun semantic-ia-show-doc (point)
414 "Display the code-level documentation for the symbol at POINT."
416 (let* ((ctxt (semantic-analyze-current-context point
))
417 (pf (reverse (oref ctxt prefix
)))
419 ;; If PF, the prefix is non-nil, then the last element is either
420 ;; a string (incomplete type), or a semantic TAG. If it is a TAG
421 ;; then we should be able to find DOC for it.
424 (message "Incomplete symbol name."))
425 ((semantic-tag-p (car pf
))
426 ;; The `semantic-documentation-for-tag' fcn is language
427 ;; specific. If it doesn't return what you expect, you may
428 ;; need to implement something for your language.
430 ;; The default tries to find a comment in front of the tag
431 ;; and then strings off comment prefixes.
432 (let ((doc (semantic-documentation-for-tag (car pf
))))
433 (if (or (null doc
) (string= doc
""))
434 (message "Doc unavailable for: %s"
435 (semantic-format-tag-prototype (car pf
)))
436 (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
438 (princ (semantic-format-tag-prototype (car pf
)))
441 (princ "Snarfed Documentation: ")
446 (princ " Documentation unavailable."))
449 (message "Unknown tag.")))
453 (defun semantic-ia-describe-class (typename)
454 "Display all known parts for the datatype TYPENAME.
455 If the type in question is a class, all methods and other accessible
456 parts of the parent classes are displayed."
457 ;; @todo - use a fancy completing reader.
458 (interactive "sType Name: ")
460 ;; When looking for a tag of any name there are a couple ways to do
461 ;; it. The simple `semanticdb-find-tag-by-...' are simple, and
462 ;; you need to pass it the exact name you want.
464 ;; The analyzer function `semantic-analyze-tag-name' will take
465 ;; more complex names, such as the cpp symbol foo::bar::baz,
466 ;; and break it up, and dive through the namespaces.
467 (let ((class (semantic-analyze-find-tag typename
)))
469 (when (not (semantic-tag-p class
))
470 (error "Cannot find class %s" class
))
471 (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
472 ;; There are many semantic-format-tag-* fcns.
473 ;; The summarize routine is a fairly generic one.
474 (princ (semantic-format-tag-summarize class
))
476 (princ " Type Members:\n")
477 ;; The type tag contains all the parts of the type.
478 ;; In complex languages with inheritance, not all the
479 ;; parts are in the tag. This analyzer fcn will traverse
480 ;; the inheritance tree, and find all the pieces that
482 (let ((parts (semantic-analyze-scoped-type-parts class
)))
485 (princ (semantic-format-tag-summarize (car parts
)))
487 (setq parts
(cdr parts
)))
491 (provide 'semantic
/ia
)
494 ;; generated-autoload-file: "loaddefs.el"
495 ;; generated-autoload-load-name: "semantic/ia"
498 ;;; semantic/ia.el ends here