lisp/cedet/semantic/ia-sb.el

   1 ;;; semantic/ia-sb.el --- Speedbar analysis display interactor
   2
   3 ;;; Copyright (C) 2002-2004, 2006, 2008-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: syntax
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; Speedbar node for displaying derived context information.
  26 ;;
  27
  28 (require 'semantic/analyze)
  29 (require 'speedbar)
  30
  31 ;;; Code:
  32 (defvar semantic-ia-sb-key-map nil
  33   "Keymap used when in semantic analysis display mode.")
  34
  35 (if semantic-ia-sb-key-map
  36     nil
  37   (setq semantic-ia-sb-key-map (speedbar-make-specialized-keymap))
  38
  39   ;; Basic features.
  40   (define-key semantic-ia-sb-key-map "\C-m" 'speedbar-edit-line)
  41   (define-key semantic-ia-sb-key-map "I" 'semantic-ia-sb-show-tag-info)
  42   )
  43
  44 (defvar semantic-ia-sb-easymenu-definition
  45   '( "---"
  46 ;     [ "Expand" speedbar-expand-line nil ]
  47 ;     [ "Contract" speedbar-contract-line nil ]
  48      [ "Tag Information" semantic-ia-sb-show-tag-info t ]
  49      [ "Jump to Tag" speedbar-edit-line t ]
  50      [ "Complete" speedbar-edit-line t ]
  51      )
  52   "Extra menu items Analysis mode.")
  53
  54 ;; Make sure our special speedbar major mode is loaded
  55 (speedbar-add-expansion-list '("Analyze"
  56                                semantic-ia-sb-easymenu-definition
  57                                semantic-ia-sb-key-map
  58                                semantic-ia-speedbar))
  59
  60 (speedbar-add-mode-functions-list
  61  (list "Analyze"
  62        ;;'(speedbar-item-info . eieio-speedbar-item-info)
  63        '(speedbar-line-directory . semantic-ia-sb-line-path)))
  64
  65 ;;;###autoload
  66 (defun semantic-speedbar-analysis ()
  67   "Start Speedbar in semantic analysis mode.
  68 The analyzer displays information about the current context, plus a smart
  69 list of possible completions."
  70   (interactive)
  71   ;; Make sure that speedbar is active
  72   (speedbar-frame-mode 1)
  73   ;; Now, throw us into Analyze  mode on speedbar.
  74   (speedbar-change-initial-expansion-list "Analyze")
  75   )
  76
  77 (defun semantic-ia-speedbar (directory zero)
  78   "Create buttons in speedbar which define the current analysis at POINT.
  79 DIRECTORY is the current directory, which is ignored, and ZERO is 0."
  80   (let ((analysis nil)
  81         (scope nil)
  82         (buffer nil)
  83         (completions nil)
  84         (cf (selected-frame))
  85         (cnt nil)
  86         (mode-local-active-mode nil)
  87         )
  88     ;; Try and get some sort of analysis
  89     (condition-case nil
  90         (progn
  91           (speedbar-select-attached-frame)
  92           (setq buffer (current-buffer))
  93           (setq mode-local-active-mode major-mode)
  94           (save-excursion
  95             ;; Get the current scope
  96             (setq scope (semantic-calculate-scope (point)))
  97             ;; Get the analysis
  98             (setq analysis (semantic-analyze-current-context (point)))
  99             (setq cnt (semantic-find-tag-by-overlay))
 100             (when analysis
 101               (setq completions (semantic-analyze-possible-completions analysis))
 102               )
 103             ))
 104       (error nil))
 105     (select-frame cf)
 106     (with-current-buffer speedbar-buffer
 107       ;; If we have something, do something spiff with it.
 108       (erase-buffer)
 109       (speedbar-insert-separator "Buffer/Function")
 110       ;; Note to self: Turn this into an expandable file name.
 111       (speedbar-make-tag-line 'bracket ?  nil nil
 112                               (buffer-name buffer)
 113                               nil nil 'speedbar-file-face 0)
 114
 115       (when cnt
 116         (semantic-ia-sb-string-list cnt
 117                                     'speedbar-tag-face
 118                                     'semantic-sb-token-jump))
 119       (when analysis
 120         ;; If this analyzer happens to point at a complete symbol, then
 121         ;; see if we can dig up some documentation for it.
 122         (semantic-ia-sb-show-doc analysis))
 123
 124       (when analysis
 125         ;; Let different classes draw more buttons.
 126         (semantic-ia-sb-more-buttons analysis)
 127         (when completions
 128           (speedbar-insert-separator "Completions")
 129           (semantic-ia-sb-completion-list completions
 130                                           'speedbar-tag-face
 131                                           'semantic-ia-sb-complete))
 132         )
 133
 134       ;; Show local variables
 135       (when scope
 136         (semantic-ia-sb-show-scope scope))
 137
 138       )))
 139
 140 (defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
 141   "Show documentation about CONTEXT iff CONTEXT points at a complete symbol."
 142   (let ((sym (car (reverse (oref context prefix))))
 143         (doc nil))
 144     (when (semantic-tag-p sym)
 145       (setq doc (semantic-documentation-for-tag sym))
 146       (when doc
 147         (speedbar-insert-separator "Documentation")
 148         (insert doc)
 149         (insert "\n")
 150         ))
 151     ))
 152
 153 (defun semantic-ia-sb-show-scope (scope)
 154   "Show SCOPE information."
 155   (let ((localvars (when scope
 156                      (oref scope localvar)))
 157         )
 158     (when localvars
 159       (speedbar-insert-separator "Local Variables")
 160       (semantic-ia-sb-string-list localvars
 161                                   'speedbar-tag-face
 162                                   ;; This is from semantic-sb
 163                                   'semantic-sb-token-jump))))
 164
 165 (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
 166   "Show a set of speedbar buttons specific to CONTEXT."
 167   (let ((prefix (oref context prefix)))
 168     (when prefix
 169       (speedbar-insert-separator "Prefix")
 170       (semantic-ia-sb-string-list prefix
 171                                   'speedbar-tag-face
 172                                   'semantic-sb-token-jump))
 173     ))
 174
 175 (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
 176   "Show a set of speedbar buttons specific to CONTEXT."
 177   (call-next-method)
 178   (let ((assignee (oref context assignee)))
 179     (when assignee
 180       (speedbar-insert-separator "Assignee")
 181       (semantic-ia-sb-string-list assignee
 182                                   'speedbar-tag-face
 183                                   'semantic-sb-token-jump))))
 184
 185 (defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
 186   "Show a set of speedbar buttons specific to CONTEXT."
 187   (call-next-method)
 188   (let ((func (oref context function)))
 189     (when func
 190       (speedbar-insert-separator "Function")
 191       (semantic-ia-sb-string-list func
 192                                   'speedbar-tag-face
 193                                   'semantic-sb-token-jump)
 194       ;; An index for the argument the prefix is in:
 195       (let ((arg (oref context argument))
 196             (args (semantic-tag-function-arguments (car func)))
 197             (idx 0)
 198             )
 199         (speedbar-insert-separator
 200          (format "Argument #%d" (oref context index)))
 201         (if args
 202             (semantic-ia-sb-string-list args
 203                                         'speedbar-tag-face
 204                                         'semantic-sb-token-jump
 205                                         (oref context index)
 206                                         'speedbar-selected-face)
 207           ;; Else, no args list, so use what the context had.
 208           (semantic-ia-sb-string-list arg
 209                                       'speedbar-tag-face
 210                                       'semantic-sb-token-jump))
 211         ))))
 212
 213 (defun semantic-ia-sb-string-list (list face function &optional idx idxface)
 214   "Create some speedbar buttons from LIST.
 215 Each button will use FACE, and be activated with FUNCTION.
 216 Optional IDX is an index into LIST to apply IDXFACE instead."
 217   (let ((count 1))
 218     (while list
 219       (let* ((usefn nil)
 220              (string (cond ((stringp (car list))
 221                             (car list))
 222                            ((semantic-tag-p (car list))
 223                             (setq usefn (semantic-tag-with-position-p (car list)))
 224                             (semantic-format-tag-uml-concise-prototype (car list)))
 225                            (t "<No Tag>")))
 226              (localface (if (or (not idx) (/= idx count))
 227                             face
 228                           idxface))
 229              )
 230         (if (semantic-tag-p (car list))
 231             (speedbar-make-tag-line 'angle ?i
 232                                     'semantic-ia-sb-tag-info (car list)
 233                                     string (if usefn function) (car list) localface
 234                                     0)
 235           (speedbar-make-tag-line 'statictag ??
 236                                   nil nil
 237                                   string (if usefn function) (car list) localface
 238                                   0))
 239         (setq list (cdr list)
 240               count (1+ count)))
 241       )))
 242
 243 (defun semantic-ia-sb-completion-list (list face function)
 244   "Create some speedbar buttons from LIST.
 245 Each button will use FACE, and be activated with FUNCTION."
 246   (while list
 247     (let* ((documentable nil)
 248            (string (cond ((stringp (car list))
 249                           (car list))
 250                          ((semantic-tag-p (car list))
 251                           (setq documentable t)
 252                           (semantic-format-tag-uml-concise-prototype (car list)))
 253                         (t "foo"))))
 254       (if documentable
 255           (speedbar-make-tag-line 'angle ?i
 256                                   'semantic-ia-sb-tag-info
 257                                   (car list)
 258                                   string function (car list) face
 259                                   0)
 260         (speedbar-make-tag-line 'statictag ?  nil nil
 261                                 string function (car list) face
 262                                 0))
 263       (setq list (cdr list)))))
 264
 265 (defun semantic-ia-sb-show-tag-info ()
 266   "Display information about the tag on the current line.
 267 Same as clicking on the <i> button.
 268 See `semantic-ia-sb-tag-info' for more."
 269   (interactive)
 270   (let ((tok nil))
 271     (save-excursion
 272       (end-of-line)
 273       (forward-char -1)
 274       (setq tok (get-text-property (point) 'speedbar-token)))
 275     (semantic-ia-sb-tag-info nil tok 0)))
 276
 277 (defun semantic-ia-sb-tag-info (text tag indent)
 278   "Display as much information as we can about tag.
 279 Show the information in a shrunk split-buffer and expand
 280 out as many details as possible.
 281 TEXT, TAG, and INDENT are speedbar function arguments."
 282   (when (semantic-tag-p tag)
 283     (unwind-protect
 284         (let ((ob nil))
 285           (speedbar-select-attached-frame)
 286           (setq ob (current-buffer))
 287           (with-output-to-temp-buffer "*Tag Information*"
 288             ;; Output something about this tag:
 289             (with-current-buffer "*Tag Information*"
 290               (goto-char (point-max))
 291               (insert
 292                (semantic-format-tag-prototype tag nil t)
 293                "\n")
 294               (let ((typetok
 295                      (condition-case nil
 296                          (with-current-buffer ob
 297                            ;; @todo - We need a context to derive a scope from.
 298                            (semantic-analyze-tag-type tag nil))
 299                        (error nil))))
 300                 (if typetok
 301                     (insert (semantic-format-tag-prototype
 302                              typetok nil t))
 303                   ;; No type found by the analyzer
 304                   ;; The below used to try and select the buffer from the last
 305                   ;; analysis, but since we are already in the correct buffer, I
 306                   ;; don't think that is needed.
 307                   (let ((type (semantic-tag-type tag)))
 308                     (cond ((semantic-tag-p type)
 309                            (setq type (semantic-tag-name type)))
 310                           ((listp type)
 311                            (setq type (car type))))
 312                     (if (semantic-lex-keyword-p type)
 313                         (setq typetok
 314                               (semantic-lex-keyword-get type 'summary))))
 315                   (if typetok
 316                       (insert typetok))
 317                   ))
 318               ))
 319           ;; Make it small
 320           (shrink-window-if-larger-than-buffer
 321            (get-buffer-window "*Tag Information*")))
 322       (select-frame speedbar-frame))))
 323
 324 (defun semantic-ia-sb-line-path (&optional depth)
 325   "Return the file name associated with DEPTH."
 326   (save-match-data
 327     (let* ((tok (speedbar-line-token))
 328            (buff (if (semantic-tag-buffer tok)
 329                      (semantic-tag-buffer tok)
 330                    (current-buffer))))
 331       (buffer-file-name buff))))
 332
 333 (defun semantic-ia-sb-complete (text tag indent)
 334   "At point in the attached buffer, complete the symbol clicked on.
 335 TEXT TAG and INDENT are the details."
 336   ;; Find the specified bounds from the current analysis.
 337   (speedbar-select-attached-frame)
 338   (unwind-protect
 339       (let* ((a (semantic-analyze-current-context (point)))
 340              (bounds (oref a bounds))
 341              (movepoint nil)
 342              )
 343         (save-excursion
 344           (if (and (<= (point) (cdr bounds)) (>= (point) (car bounds)))
 345               (setq movepoint t))
 346           (goto-char (car bounds))
 347           (delete-region (car bounds) (cdr bounds))
 348           (insert (semantic-tag-name tag))
 349           (if movepoint (setq movepoint (point)))
 350           ;; I'd like to use this to add fancy () or what not at the end
 351           ;; but we need the parent file which requires an upgrade to the
 352           ;; analysis tool.
 353           ;;(semantic-insert-foreign-tag tag ??))
 354           )
 355         (if movepoint
 356             (let ((cf (selected-frame)))
 357               (speedbar-select-attached-frame)
 358               (goto-char movepoint)
 359               (select-frame cf))))
 360     (select-frame speedbar-frame)))
 361
 362 (provide 'semantic/ia-sb)
 363
 364 ;; Local variables:
 365 ;; generated-autoload-file: "loaddefs.el"
 366 ;; generated-autoload-load-name: "semantic/ia-sb"
 367 ;; End:
 368
 369 ;;; semantic/ia-sb.el ends here