lisp/cedet/semantic/ia.el

   1 ;;; 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 'senator)
  39 (require 'semantic/analyze)
  40 (require 'semantic/format)
  41 (require 'pulse)
  42 (eval-when-compile
  43   (require 'semantic/analyze)
  44   (require 'semantic/analyze/refs))
  45
  46 (declare-function imenu--mouse-menu "imenu")
  47
  48 ;;; Code:
  49
  50 ;;; COMPLETION
  51 ;;
  52 ;; This set of routines provides some simplisting completion
  53 ;; functions.
  54
  55 (defcustom semantic-ia-completion-format-tag-function
  56   'semantic-prototype-nonterminal
  57   "*Function used to convert a tag to a string during completion."
  58   :group 'semantic
  59   :type semantic-format-tag-custom-list)
  60
  61 (defvar semantic-ia-cache nil
  62   "Cache of the last completion request.
  63 Of the form ( POINT . COMPLETIONS ) where POINT is a location in the
  64 buffer where the completion was requested.  COMPLETONS is the list
  65 of semantic tag names that provide logical completions from that
  66 location.")
  67 (make-variable-buffer-local 'semantic-ia-cache)
  68
  69 ;;; COMPLETION HELPER
  70 ;;
  71 ;; This overload function handles inserting a tag
  72 ;; into a buffer for these local completion routines.
  73 ;;
  74 ;; By creating the functions as overloadable, it can be
  75 ;; customized.  For example, the default will put a paren "("
  76 ;; character after function names.  For Lisp, it might check
  77 ;; to put a "(" in front of a function name.
  78
  79 (define-overloadable-function semantic-ia-insert-tag (tag)
  80   "Insert TAG into the current buffer based on completion.")
  81
  82 (defun semantic-ia-insert-tag-default (tag)
  83   "Insert TAG into the current buffer based on completion."
  84   (insert (semantic-tag-name tag))
  85   (let ((tt (semantic-tag-class tag)))
  86     (cond ((eq tt 'function)
  87            (insert "("))
  88           (t nil))))
  89
  90 (declare-function semantic-analyze-possible-completions
  91                   "semantic/analyze/complete")
  92
  93 (defun semantic-ia-get-completions (context point)
  94   "Fetch the completion of CONTEXT at POINT.
  95 Supports caching."
  96   ;; Cache the current set of symbols so that we can get at
  97   ;; them quickly the second time someone presses the
  98   ;; complete button.
  99   (let ((symbols
 100          (if (and semantic-ia-cache
 101                   (= point (car semantic-ia-cache)))
 102              (cdr semantic-ia-cache)
 103            (semantic-analyze-possible-completions context))))
 104     ;; Set the cache
 105     (setq semantic-ia-cache (cons point symbols))
 106     symbols))
 107
 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               (senator-complete-symbol)
 140               ))
 141       ;; Use try completion to seek a common substring.
 142       (let ((tc (try-completion (or pre "")  syms)))
 143         (if (and (stringp tc) (not (string= tc (or pre ""))))
 144             (let ((tok (semantic-find-first-tag-by-name
 145                         tc syms)))
 146               ;; Delete what came before...
 147               (when (and (car (oref a bounds)) (cdr (oref a bounds)))
 148                 (delete-region (car (oref a bounds))
 149                                (cdr (oref a bounds)))
 150                 (goto-char (car (oref a bounds))))
 151               ;; We have some new text.  Stick it in.
 152               (if tok
 153                   (semantic-ia-insert-tag tok)
 154                 (insert tc)))
 155           ;; We don't have new text.  Show all completions.
 156           (when (cdr (oref a bounds))
 157             (goto-char (cdr (oref a bounds))))
 158           (with-output-to-temp-buffer "*Completions*"
 159             (display-completion-list
 160              (mapcar semantic-ia-completion-format-tag-function syms))
 161             ))))))
 162
 163 (defcustom semantic-ia-completion-menu-format-tag-function
 164   'semantic-uml-concise-prototype-nonterminal
 165   "*Function used to convert a tag to a string during completion."
 166   :group 'semantic
 167   :type semantic-format-tag-custom-list)
 168
 169 (defun semantic-ia-complete-symbol-menu (point)
 170   "Complete the current symbol via a menu based at POINT.
 171 Completion options are calculated with `semantic-analyze-possible-completions'."
 172   (interactive "d")
 173   (require 'imenu)
 174   (let* ((a (semantic-analyze-current-context point))
 175          (syms (semantic-ia-get-completions a point))
 176          )
 177     ;; Complete this symbol.
 178     (if (not syms)
 179         (progn
 180           (message "No smart completions found.  Trying Senator.")
 181           (when (semantic-analyze-context-p a)
 182             ;; This is a quick way of getting a nice completion list
 183             ;; in the menu if the regular context mechanism fails.
 184             (senator-completion-menu-popup)))
 185
 186       (let* ((menu
 187               (mapcar
 188                (lambda (tag)
 189                  (cons
 190                   (funcall semantic-ia-completion-menu-format-tag-function tag)
 191                   (vector tag)))
 192                syms))
 193              (ans
 194               (imenu--mouse-menu
 195                ;; XEmacs needs that the menu has at least 2 items.  So,
 196                ;; include a nil item that will be ignored by imenu.
 197                (cons nil menu)
 198                (senator-completion-menu-point-as-event)
 199                "Completions")))
 200         (when ans
 201           (if (not (semantic-tag-p ans))
 202               (setq ans (aref (cdr ans) 0)))
 203           (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
 204           (semantic-ia-insert-tag ans))
 205         ))))
 206
 207 ;;; Completions Tip
 208 ;;
 209 ;; This functions shows how to get the list of completions,
 210 ;; to place in a tooltip.  It doesn't actually do any completion.
 211
 212 (defun semantic-ia-complete-tip (point)
 213   "Pop up a tooltip for completion at POINT."
 214   (interactive "d")
 215   (let* ((a (semantic-analyze-current-context point))
 216          (syms (semantic-ia-get-completions a point))
 217          (x (mod (- (current-column) (window-hscroll))
 218                  (window-width)))
 219          (y (save-excursion
 220               (save-restriction
 221                 (widen)
 222                 (narrow-to-region (window-start) (point))
 223                 (goto-char (point-min))
 224                 (1+ (vertical-motion (buffer-size))))))
 225          (str (mapconcat #'semantic-tag-name
 226                          syms
 227                          "\n"))
 228          )
 229     (cond ((fboundp 'x-show-tip)
 230            (x-show-tip str
 231                        (selected-frame)
 232                        nil
 233                        nil
 234                        x y)
 235            )
 236           (t (message str))
 237           )))
 238
 239 ;;; Summary
 240 ;;
 241 ;; Like idle-summary-mode, this shows how to get something to
 242 ;; show a summary on.
 243
 244 (defun semantic-ia-show-summary (point)
 245   "Display a summary for the symbol under POINT."
 246   (interactive "P")
 247   (let* ((ctxt (semantic-analyze-current-context point))
 248          (pf (when ctxt
 249                ;; The CTXT is an EIEIO object.  The below
 250                ;; method will attempt to pick the most interesting
 251                ;; tag associated with the current context.
 252                (semantic-analyze-interesting-tag ctxt)))
 253         )
 254     (when pf
 255       (message "%s" (semantic-format-tag-summarize pf nil t)))))
 256
 257 ;;; FAST Jump
 258 ;;
 259 ;; Jump to a destination based on the local context.
 260 ;;
 261 ;; This shows how to use the analyzer context, and the
 262 ;; analyer references objects to choose a good destination.
 263
 264 (defun semantic-ia--fast-jump-helper (dest)
 265   "Jump to DEST, a Semantic tag.
 266 This helper manages the mark, buffer switching, and pulsing."
 267   ;; We have a tag, but in C++, we usually get a prototype instead
 268   ;; because of header files.  Lets try to find the actual
 269   ;; implementaion instead.
 270   (when (semantic-tag-prototype-p dest)
 271     (let* ((refs (semantic-analyze-tag-references dest))
 272            (impl (semantic-analyze-refs-impl refs t))
 273            )
 274       (when impl (setq dest (car impl)))))
 275
 276   ;; Make sure we have a place to go...
 277   (if (not (and (or (semantic-tag-with-position-p dest)
 278                     (semantic-tag-get-attribute dest :line))
 279                 (semantic-tag-file-name dest)))
 280       (error "Tag %s has no buffer information"
 281              (semantic-format-tag-name dest)))
 282
 283   ;; Once we have the tag, we can jump to it.  Here
 284   ;; are the key bits to the jump:
 285
 286   ;; 1) Push the mark, so you can pop global mark back, or
 287   ;;    use semantic-mru-bookmark mode to do so.
 288   (push-mark)
 289   (when (fboundp 'push-tag-mark)
 290     (push-tag-mark))
 291   ;; 2) Visits the tag.
 292   (semantic-go-to-tag dest)
 293   ;; 3) go-to-tag doesn't switch the buffer in the current window,
 294   ;;    so it is like find-file-noselect.  Bring it forward.
 295   (switch-to-buffer (current-buffer))
 296   ;; 4) Fancy pulsing.
 297   (pulse-momentary-highlight-one-line (point))
 298   )
 299
 300 (declare-function semantic-decoration-include-visit "semantic/decorate/include")
 301
 302 (defun semantic-ia-fast-jump (point)
 303   "Jump to the tag referred to by the code at POINT.
 304 Uses `semantic-analyze-current-context' output to identify an accurate
 305 origin of the code at point."
 306   (interactive "d")
 307   (let* ((ctxt (semantic-analyze-current-context point))
 308          (pf (and ctxt (reverse (oref ctxt prefix))))
 309          ;; In the analyzer context, the PREFIX is the list of items
 310          ;; that makes up the code context at point.  Thus the c++ code
 311          ;; this.that().theothe
 312          ;; would make a list:
 313          ;; ( ("this" variable ..) ("that" function ...) "theothe")
 314          ;; Where the first two elements are the semantic tags of the prefix.
 315          ;;
 316          ;; PF is the reverse of this list.  If the first item is a string,
 317          ;; then it is an incomplete symbol, thus we pick the second.
 318          ;; The second cannot be a string, as that would have been an error.
 319          (first (car pf))
 320          (second (nth 1 pf))
 321          )
 322     (cond
 323      ((semantic-tag-p first)
 324       ;; We have a match.  Just go there.
 325       (semantic-ia--fast-jump-helper first))
 326
 327      ((semantic-tag-p second)
 328       ;; Because FIRST failed, we should visit our second tag.
 329       ;; HOWEVER, the tag we actually want that was only an unfound
 330       ;; string may be related to some take in the datatype that belongs
 331       ;; to SECOND.  Thus, instead of visiting second directly, we
 332       ;; can offer to find the type of SECOND, and go there.
 333       (let ((secondclass (car (reverse (oref ctxt prefixtypes)))))
 334         (cond
 335          ((and (semantic-tag-with-position-p secondclass)
 336                (y-or-n-p (format "Could not find `%s'.  Jump to %s? "
 337                                  first (semantic-tag-name secondclass))))
 338           (semantic-ia--fast-jump-helper secondclass)
 339           )
 340          ;; If we missed out on the class of the second item, then
 341          ;; just visit SECOND.
 342          ((and (semantic-tag-p second)
 343                (y-or-n-p (format "Could not find `%s'.  Jump to %s? "
 344                                  first (semantic-tag-name second))))
 345           (semantic-ia--fast-jump-helper second)
 346           ))))
 347
 348      ((semantic-tag-of-class-p (semantic-current-tag) 'include)
 349       ;; Just borrow this cool fcn.
 350       (require 'semantic/decorate/include)
 351       (semantic-decoration-include-visit)
 352       )
 353
 354      (t
 355       (error "Could not find suitable jump point for %s"
 356              first))
 357      )))
 358
 359 (defun semantic-ia-fast-mouse-jump (evt)
 360   "Jump to the tag referred to by the point clicked on.
 361 See `semantic-ia-fast-jump' for details on how it works.
 362  This command is meant to be bound to a mouse event."
 363   (interactive "e")
 364   (semantic-ia-fast-jump
 365    (save-excursion
 366      (posn-set-point (event-end evt))
 367      (point))))
 368
 369 ;;; DOC/DESCRIBE
 370 ;;
 371 ;; These routines show how to get additional information about a tag
 372 ;; for purposes of describing or showing documentation about them.
 373 (defun semantic-ia-show-doc (point)
 374   "Display the code-level documentation for the symbol at POINT."
 375   (interactive "d")
 376   (let* ((ctxt (semantic-analyze-current-context point))
 377          (pf (reverse (oref ctxt prefix)))
 378          )
 379     ;; If PF, the prefix is non-nil, then the last element is either
 380     ;; a string (incomplete type), or a semantic TAG.  If it is a TAG
 381     ;; then we should be able to find DOC for it.
 382     (cond
 383      ((stringp (car pf))
 384       (message "Incomplete symbol name."))
 385      ((semantic-tag-p (car pf))
 386       ;; The `semantic-documentation-for-tag' fcn is language
 387       ;; specific.  If it doesn't return what you expect, you may
 388       ;; need to implement something for your language.
 389       ;;
 390       ;; The default tries to find a comment in front of the tag
 391       ;; and then strings off comment prefixes.
 392       (let ((doc (semantic-documentation-for-tag (car pf))))
 393         (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
 394           (princ "Tag: ")
 395           (princ (semantic-format-tag-prototype (car pf)))
 396           (princ "\n")
 397           (princ "\n")
 398           (princ "Snarfed Documentation: ")
 399           (princ "\n")
 400           (princ "\n")
 401           (if doc
 402               (princ doc)
 403             (princ "  Documentation unavailable."))
 404           )))
 405      (t
 406       (message "Unknown tag.")))
 407     ))
 408
 409 (defun semantic-ia-describe-class (typename)
 410   "Display all known parts for the datatype TYPENAME.
 411 If the type in question is a class, all methods and other accessible
 412 parts of the parent classes are displayed."
 413   ;; @todo - use a fancy completing reader.
 414   (interactive "sType Name: ")
 415
 416   ;; When looking for a tag of any name there are a couple ways to do
 417   ;; it.  The simple `semanticdb-find-tag-by-...' are simple, and
 418   ;; you need to pass it the exact name you want.
 419   ;;
 420   ;; The analyzer function `semantic-analyze-tag-name' will take
 421   ;; more complex names, such as the cpp symbol foo::bar::baz,
 422   ;; and break it up, and dive through the namespaces.
 423   (let ((class (semantic-analyze-find-tag typename)))
 424
 425     (when (not (semantic-tag-p class))
 426       (error "Cannot find class %s" class))
 427     (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
 428       ;; There are many semantic-format-tag-* fcns.
 429       ;; The summarize routine is a fairly generic one.
 430       (princ (semantic-format-tag-summarize class))
 431       (princ "\n")
 432       (princ "  Type Members:\n")
 433       ;; The type tag contains all the parts of the type.
 434       ;; In complex languages with inheritance, not all the
 435       ;; parts are in the tag.  This analyzer fcn will traverse
 436       ;; the inheritance tree, and find all the pieces that
 437       ;; are inherited.
 438       (let ((parts (semantic-analyze-scoped-type-parts class)))
 439         (while parts
 440           (princ "    ")
 441           (princ (semantic-format-tag-summarize (car parts)))
 442           (princ "\n")
 443           (setq parts (cdr parts)))
 444         )
 445       )))
 446
 447 (provide 'semantic/ia)
 448
 449 ;;; semantic-ia.el ends here