lisp/cedet/semantic/ia.el

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