ia.el 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501
  1. ;;; semantic/ia.el --- Interactive Analysis functions
  2. ;;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
  3. ;; Author: Eric M. Ludlam <zappo@gnu.org>
  4. ;; Keywords: syntax
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;;
  18. ;; Interactive access to `semantic-analyze'.
  19. ;;
  20. ;; These routines are fairly simple, and show how to use the Semantic
  21. ;; analyzer to provide things such as completion lists, summaries,
  22. ;; locations, or documentation.
  23. ;;
  24. ;;; TODO
  25. ;;
  26. ;; fast-jump. For a virtual method, offer some of the possible
  27. ;; implementations in various sub-classes.
  28. (require 'semantic/analyze)
  29. (require 'semantic/format)
  30. (require 'pulse)
  31. (require 'semantic/senator)
  32. (require 'semantic/analyze/refs)
  33. (eval-when-compile
  34. (require 'semantic/analyze)
  35. (require 'semantic/find))
  36. (declare-function imenu--mouse-menu "imenu")
  37. ;;; Code:
  38. ;;; COMPLETION
  39. ;;
  40. ;; This set of routines provides some simplisting completion
  41. ;; functions.
  42. (defcustom semantic-ia-completion-format-tag-function
  43. 'semantic-format-tag-prototype
  44. "Function used to convert a tag to a string during completion."
  45. :group 'semantic
  46. :type semantic-format-tag-custom-list)
  47. ;;; COMPLETION HELPER
  48. ;;
  49. ;; This overload function handles inserting a tag
  50. ;; into a buffer for these local completion routines.
  51. ;;
  52. ;; By creating the functions as overloadable, it can be
  53. ;; customized. For example, the default will put a paren "("
  54. ;; character after function names. For Lisp, it might check
  55. ;; to put a "(" in front of a function name.
  56. (define-overloadable-function semantic-ia-insert-tag (tag)
  57. "Insert TAG into the current buffer based on completion.")
  58. (defun semantic-ia-insert-tag-default (tag)
  59. "Insert TAG into the current buffer based on completion."
  60. (insert (semantic-tag-name tag))
  61. (let ((tt (semantic-tag-class tag)))
  62. (cond ((eq tt 'function)
  63. (insert "("))
  64. (t nil))))
  65. (defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated
  66. "`Semantic-ia-get-completions' is obsolete.
  67. Use `semantic-analyze-possible-completions' instead.")
  68. (defun semantic-ia-get-completions-deprecated (context point)
  69. "A function to help transition away from `semantic-ia-get-completions'.
  70. Return completions based on CONTEXT at POINT.
  71. You should not use this, nor the aliased version.
  72. Use `semantic-analyze-possible-completions' instead."
  73. (semantic-analyze-possible-completions context))
  74. ;;;###autoload
  75. (defun semantic-ia-complete-symbol (&optional pos)
  76. "Complete the current symbol at POS.
  77. If POS is nil, default to point.
  78. Completion options are calculated with `semantic-analyze-possible-completions'."
  79. (interactive "d")
  80. (when (semantic-active-p)
  81. (or pos (setq pos (point)))
  82. ;; Calculating completions is a two step process.
  83. ;;
  84. ;; The first analyzer the current context, which finds tags for
  85. ;; all the stuff that may be references by the code around POS.
  86. ;;
  87. ;; The second step derives completions from that context.
  88. (let* ((a (semantic-analyze-current-context pos))
  89. (syms (semantic-analyze-possible-completions a))
  90. (pre (car (reverse (oref a prefix)))))
  91. ;; If PRE was actually an already completed symbol, it doesn't
  92. ;; come in as a string, but as a tag instead.
  93. (if (semantic-tag-p pre)
  94. ;; We will try completions on it anyway.
  95. (setq pre (semantic-tag-name pre)))
  96. ;; Complete this symbol.
  97. (if (null syms)
  98. (if (semantic-analyze-context-p a)
  99. ;; This is a clever hack. If we were unable to find any
  100. ;; smart completions, let's divert to how senator derives
  101. ;; completions.
  102. ;;
  103. ;; This is a way of making this fcn more useful since
  104. ;; the smart completion engine sometimes fails.
  105. (semantic-complete-symbol))
  106. ;; Use try completion to seek a common substring.
  107. (let* ((completion-ignore-case (string= (downcase pre) pre))
  108. (tc (try-completion (or pre "") syms)))
  109. (if (and (stringp tc) (not (string= tc (or pre ""))))
  110. (let ((tok (semantic-find-first-tag-by-name
  111. tc syms)))
  112. ;; Delete what came before...
  113. (when (and (car (oref a bounds)) (cdr (oref a bounds)))
  114. (delete-region (car (oref a bounds))
  115. (cdr (oref a bounds)))
  116. (goto-char (car (oref a bounds))))
  117. ;; We have some new text. Stick it in.
  118. (if tok
  119. (semantic-ia-insert-tag tok)
  120. (insert tc)))
  121. ;; We don't have new text. Show all completions.
  122. (when (cdr (oref a bounds))
  123. (goto-char (cdr (oref a bounds))))
  124. (with-output-to-temp-buffer "*Completions*"
  125. (display-completion-list
  126. (mapcar semantic-ia-completion-format-tag-function syms)))))))))
  127. (defcustom semantic-ia-completion-menu-format-tag-function
  128. 'semantic-format-tag-uml-concise-prototype
  129. "Function used to convert a tag to a string during completion."
  130. :group 'semantic
  131. :type semantic-format-tag-custom-list)
  132. ;;;###autoload
  133. (defun semantic-ia-complete-symbol-menu (point)
  134. "Complete the current symbol via a menu based at POINT.
  135. Completion options are calculated with `semantic-analyze-possible-completions'."
  136. (interactive "d")
  137. (require 'imenu)
  138. (let* ((a (semantic-analyze-current-context point))
  139. (syms (semantic-analyze-possible-completions a))
  140. )
  141. ;; Complete this symbol.
  142. (if (not syms)
  143. (progn
  144. (message "No smart completions found.")
  145. ;; Disabled - see http://debbugs.gnu.org/14522
  146. ;; (message "No smart completions found. Trying Senator.")
  147. ;; (when (semantic-analyze-context-p a)
  148. ;; ;; This is a quick way of getting a nice completion list
  149. ;; ;; in the menu if the regular context mechanism fails.
  150. ;; (senator-completion-menu-popup))
  151. )
  152. (let* ((menu
  153. (mapcar
  154. (lambda (tag)
  155. (cons
  156. (funcall semantic-ia-completion-menu-format-tag-function tag)
  157. (vector tag)))
  158. syms))
  159. (ans
  160. (imenu--mouse-menu
  161. ;; XEmacs needs that the menu has at least 2 items. So,
  162. ;; include a nil item that will be ignored by imenu.
  163. (cons nil menu)
  164. `(down-mouse-1 ,(posn-at-point))
  165. "Completions")))
  166. (when ans
  167. (if (not (semantic-tag-p ans))
  168. (setq ans (aref (cdr ans) 0)))
  169. (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
  170. (semantic-ia-insert-tag ans))
  171. ))))
  172. ;;; Completions Tip
  173. ;;
  174. ;; This functions shows how to get the list of completions,
  175. ;; to place in a tooltip. It doesn't actually do any completion.
  176. ;;;###autoload
  177. (defun semantic-ia-complete-tip (point)
  178. "Pop up a tooltip for completion at POINT."
  179. (interactive "d")
  180. (let* ((a (semantic-analyze-current-context point))
  181. (syms (semantic-analyze-possible-completions a))
  182. (x (mod (- (current-column) (window-hscroll))
  183. (window-width)))
  184. (y (save-excursion
  185. (save-restriction
  186. (widen)
  187. (narrow-to-region (window-start) (point))
  188. (goto-char (point-min))
  189. (1+ (vertical-motion (buffer-size))))))
  190. (str (mapconcat #'semantic-tag-name
  191. syms
  192. "\n"))
  193. )
  194. (cond ((fboundp 'x-show-tip)
  195. (x-show-tip str
  196. (selected-frame)
  197. nil
  198. nil
  199. x y)
  200. )
  201. (t (message str))
  202. )))
  203. ;;; Summary
  204. ;;
  205. ;; Like idle-summary-mode, this shows how to get something to
  206. ;; show a summary on.
  207. ;;;###autoload
  208. (defun semantic-ia-show-summary (point)
  209. "Display a summary for the symbol under POINT."
  210. (interactive "P")
  211. (let* ((ctxt (semantic-analyze-current-context point))
  212. (pf (when ctxt
  213. ;; The CTXT is an EIEIO object. The below
  214. ;; method will attempt to pick the most interesting
  215. ;; tag associated with the current context.
  216. (semantic-analyze-interesting-tag ctxt)))
  217. )
  218. (if pf
  219. (message "%s" (semantic-format-tag-summarize pf nil t))
  220. (message "No summary info available"))))
  221. ;;; Variants
  222. ;;
  223. ;; Show all variants for the symbol under point.
  224. ;;;###autoload
  225. (defun semantic-ia-show-variants (point)
  226. "Display a list of all variants for the symbol under POINT."
  227. (interactive "P")
  228. (let* ((ctxt (semantic-analyze-current-context point))
  229. (comp nil))
  230. ;; We really want to look at the function if we are on an
  231. ;; argument. Are there some additional rules we care about for
  232. ;; changing the CTXT we look at?
  233. (when (semantic-analyze-context-functionarg-p ctxt)
  234. (goto-char (cdr (oref ctxt bounds)))
  235. (setq ctxt (semantic-analyze-current-context (point))))
  236. ;; Get the "completion list", but remove ALL filters to get the master list
  237. ;; of all the possible things.
  238. (setq comp (semantic-analyze-possible-completions ctxt 'no-unique 'no-tc))
  239. ;; Special case for a single type. List the constructors?
  240. (when (and (= (length comp) 1) (semantic-tag-of-class-p (car comp) 'type))
  241. (setq comp (semantic-find-tags-by-name (semantic-tag-name (car comp))
  242. (semantic-tag-type-members (car comp)))))
  243. ;; Display the results.
  244. (cond ((= (length comp) 0)
  245. (message "No Variants found."))
  246. ((= (length comp) 1)
  247. (message "%s" (semantic-format-tag-summarize (car comp) nil t)))
  248. (t
  249. (with-output-to-temp-buffer "*Symbol Variants*"
  250. (semantic-analyze-princ-sequence comp "" (current-buffer)))
  251. (shrink-window-if-larger-than-buffer
  252. (get-buffer-window "*Symbol Variants*")))
  253. )))
  254. ;;; FAST Jump
  255. ;;
  256. ;; Jump to a destination based on the local context.
  257. ;;
  258. ;; This shows how to use the analyzer context, and the
  259. ;; analyzer references objects to choose a good destination.
  260. (defun semantic-ia--fast-jump-helper (dest)
  261. "Jump to DEST, a Semantic tag.
  262. This helper manages the mark, buffer switching, and pulsing."
  263. ;; We have a tag, but in C++, we usually get a prototype instead
  264. ;; because of header files. Let's try to find the actual
  265. ;; implementation instead.
  266. (when (semantic-tag-prototype-p dest)
  267. (let* ((refs (semantic-analyze-tag-references dest))
  268. (impl (semantic-analyze-refs-impl refs t))
  269. )
  270. (when impl (setq dest (car impl)))))
  271. ;; Make sure we have a place to go...
  272. (if (not (and (or (semantic-tag-with-position-p dest)
  273. (semantic-tag-get-attribute dest :line))
  274. (semantic-tag-file-name dest)))
  275. (error "Tag %s has no buffer information"
  276. (semantic-format-tag-name dest)))
  277. ;; Once we have the tag, we can jump to it. Here
  278. ;; are the key bits to the jump:
  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. (declare-function semantic-decoration-include-visit "semantic/decorate/include")
  293. ;;;###autoload
  294. (defun semantic-ia-fast-jump (point)
  295. "Jump to the tag referred to by the code at POINT.
  296. Uses `semantic-analyze-current-context' output to identify an accurate
  297. origin of the code at point."
  298. (interactive "d")
  299. (let* ((ctxt (semantic-analyze-current-context point))
  300. (pf (and ctxt (reverse (oref ctxt prefix))))
  301. ;; In the analyzer context, the PREFIX is the list of items
  302. ;; that makes up the code context at point. Thus the c++ code
  303. ;; this.that().theothe
  304. ;; would make a list:
  305. ;; ( ("this" variable ..) ("that" function ...) "theothe")
  306. ;; Where the first two elements are the semantic tags of the prefix.
  307. ;;
  308. ;; PF is the reverse of this list. If the first item is a string,
  309. ;; then it is an incomplete symbol, thus we pick the second.
  310. ;; The second cannot be a string, as that would have been an error.
  311. (first (car pf))
  312. (second (nth 1 pf))
  313. )
  314. (cond
  315. ((semantic-tag-p first)
  316. ;; We have a match. Just go there.
  317. (semantic-ia--fast-jump-helper first))
  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-message
  328. "Could not find `%s'. Jump to %s? "
  329. first (semantic-tag-name secondclass))))
  330. (semantic-ia--fast-jump-helper secondclass)
  331. )
  332. ;; If we missed out on the class of the second item, then
  333. ;; just visit SECOND.
  334. ((and (semantic-tag-p second)
  335. (y-or-n-p (format-message
  336. "Could not find `%s'. Jump to %s? "
  337. first (semantic-tag-name second))))
  338. (semantic-ia--fast-jump-helper second)
  339. ))))
  340. ((semantic-tag-of-class-p (semantic-current-tag) 'include)
  341. ;; Just borrow this cool fcn.
  342. (require 'semantic/decorate/include)
  343. ;; Push the mark, so you can pop global mark back, or
  344. ;; use semantic-mru-bookmark mode to do so.
  345. (push-mark)
  346. (when (fboundp 'push-tag-mark)
  347. (push-tag-mark))
  348. (semantic-decoration-include-visit)
  349. )
  350. (t
  351. (error "Could not find suitable jump point for %s"
  352. first))
  353. )))
  354. ;;;###autoload
  355. (defun semantic-ia-fast-mouse-jump (evt)
  356. "Jump to the tag referred to by the point clicked on.
  357. See `semantic-ia-fast-jump' for details on how it works.
  358. This command is meant to be bound to a mouse event."
  359. (interactive "e")
  360. (semantic-ia-fast-jump
  361. (save-excursion
  362. (posn-set-point (event-end evt))
  363. (point))))
  364. ;;; DOC/DESCRIBE
  365. ;;
  366. ;; These routines show how to get additional information about a tag
  367. ;; for purposes of describing or showing documentation about them.
  368. ;;;###autoload
  369. (defun semantic-ia-show-doc (point)
  370. "Display the code-level documentation for the symbol at POINT."
  371. (interactive "d")
  372. (let* ((ctxt (semantic-analyze-current-context point))
  373. (pf (reverse (oref ctxt prefix)))
  374. )
  375. ;; If PF, the prefix is non-nil, then the last element is either
  376. ;; a string (incomplete type), or a semantic TAG. If it is a TAG
  377. ;; then we should be able to find DOC for it.
  378. (cond
  379. ((stringp (car pf))
  380. (message "Incomplete symbol name."))
  381. ((semantic-tag-p (car pf))
  382. ;; The `semantic-documentation-for-tag' fcn is language
  383. ;; specific. If it doesn't return what you expect, you may
  384. ;; need to implement something for your language.
  385. ;;
  386. ;; The default tries to find a comment in front of the tag
  387. ;; and then strings off comment prefixes.
  388. (let ((doc (semantic-documentation-for-tag (car pf))))
  389. (if (or (null doc) (string= doc ""))
  390. (message "Doc unavailable for: %s"
  391. (semantic-format-tag-prototype (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. ;;;###autoload
  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. ;; When looking for a tag of any name there are a couple ways to do
  415. ;; it. The simple `semanticdb-find-tag-by-...' are simple, and
  416. ;; you need to pass it the exact name you want.
  417. ;;
  418. ;; The analyzer function `semantic-analyze-tag-name' will take
  419. ;; more complex names, such as the cpp symbol foo::bar::baz,
  420. ;; and break it up, and dive through the namespaces.
  421. (let ((class (semantic-analyze-find-tag typename)))
  422. (when (not (semantic-tag-p class))
  423. (error "Cannot find class %s" class))
  424. (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
  425. ;; There are many semantic-format-tag-* fcns.
  426. ;; The summarize routine is a fairly generic one.
  427. (princ (semantic-format-tag-summarize class))
  428. (princ "\n")
  429. (princ " Type Members:\n")
  430. ;; The type tag contains all the parts of the type.
  431. ;; In complex languages with inheritance, not all the
  432. ;; parts are in the tag. This analyzer fcn will traverse
  433. ;; the inheritance tree, and find all the pieces that
  434. ;; are inherited.
  435. (let ((parts (semantic-analyze-scoped-type-parts class)))
  436. (while parts
  437. (princ " ")
  438. (princ (semantic-format-tag-summarize (car parts)))
  439. (princ "\n")
  440. (setq parts (cdr parts)))
  441. )
  442. )))
  443. (provide 'semantic/ia)
  444. ;; Local variables:
  445. ;; generated-autoload-file: "loaddefs.el"
  446. ;; generated-autoload-load-name: "semantic/ia"
  447. ;; End:
  448. ;;; semantic/ia.el ends here