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