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