cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semantic-ia.el

   1 ;;; semantic-ia.el --- Interactive Analysis functions
   2
   3 ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: syntax
   7 ;; X-RCS: $Id: semantic-ia.el,v 1.14 2007/02/22 03:32:03 zappo Exp $
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; Semantic 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 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This software 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Interactive access to `semantic-analyze'.
  29 ;;
  30
  31 (require 'senator)
  32 (require 'semantic-analyze)
  33
  34 ;;; Code:
  35 (defcustom semantic-ia-completion-format-tag-function
  36   'semantic-prototype-nonterminal
  37   "*Function used to convert a tag to a string during completion."
  38   :group 'semantic
  39   :type semantic-format-tag-custom-list)
  40
  41 (defvar semantic-ia-cache nil
  42   "Cache of the last completion request.
  43 Of the form ( POINT . COMPLETIONS ) where POINT is a location in the
  44 buffer where the completion was requested.  COMPLETONS is the list
  45 of semantic tag names that provide logical completions from that
  46 location.")
  47 (make-variable-buffer-local 'semantic-ia-cache)
  48
  49 (defun semantic-ia-get-completions (context point)
  50   "Fetch the completion of CONTEXT at POINT.
  51 Supports caching."
  52   (let ((symbols
  53          (if (and semantic-ia-cache
  54                   (= point (car semantic-ia-cache)))
  55              (cdr semantic-ia-cache)
  56            (semantic-analyze-possible-completions context))))
  57     ;; Set the cache
  58     (setq semantic-ia-cache (cons point symbols))
  59     symbols))
  60
  61 ;;;###autoload
  62 (defun semantic-ia-complete-symbol (point)
  63   "Complete the current symbol at POINT.
  64 Completion options are calculated with `semantic-analyze-possible-completions'."
  65   (interactive "d")
  66   (let* ((a (semantic-analyze-current-context point))
  67          (syms (semantic-ia-get-completions a point))
  68          (pre (car (reverse (oref a prefix))))
  69          )
  70     ;; If PRE was actually an already completed symbol, it doesn't
  71     ;; come in as a string, but as a tag instead.
  72     (if (semantic-tag-p pre)
  73         ;; We will try completions on it anyway.
  74         (setq pre (semantic-tag-name pre)))
  75     ;; Complete this symbol.
  76     (if (null syms)
  77         (progn
  78           (message "No smart completions found.  Trying senator-complete-symbol.")
  79           (if (semantic-analyze-context-p a)
  80               (senator-complete-symbol)
  81               ))
  82       ;; Use try completion to seek a common substring.
  83       (let ((tc (try-completion pre syms)))
  84         (if (and (stringp tc) (not (string= tc pre)))
  85             (let ((tok (semantic-find-first-tag-by-name
  86                         tc syms)))
  87               ;; We have some new text.  Stick it in.
  88               (delete-region (car (oref a bounds))
  89                              (cdr (oref a bounds)))
  90               (goto-char (car (oref a bounds)))
  91               (if tok
  92                   (semantic-ia-insert-tag tok)
  93                 (insert tc)))
  94           ;; We don't have new text.  Show all completions.
  95           (goto-char (cdr (oref a bounds)))
  96           (with-output-to-temp-buffer "*Completions*"
  97             (display-completion-list
  98              (mapcar semantic-ia-completion-format-tag-function syms))
  99             ))))))
 100
 101 (defcustom semantic-ia-completion-menu-format-tag-function
 102   'semantic-uml-concise-prototype-nonterminal
 103   "*Function used to convert a tag to a string during completion."
 104   :group 'semantic
 105   :type semantic-format-tag-custom-list)
 106
 107 ;;;###autoload
 108 (defun semantic-ia-complete-symbol-menu (point)
 109   "Complete the current symbol via a menu based at POINT.
 110 Completion options are calculated with `semantic-analyze-possible-completions'."
 111   (interactive "d")
 112   (let* ((a (semantic-analyze-current-context point))
 113          (syms (semantic-ia-get-completions a point))
 114          (pre (car (reverse (oref a prefix))))
 115          )
 116     ;; Complete this symbol.
 117     (if (not syms)
 118         (progn
 119           (message "No smart completions found.  Trying Senator.")
 120           (if (semantic-analyze-context-p a)
 121               (senator-completion-menu-popup)))
 122       (let* ((menu
 123               (mapcar
 124                (lambda (tag)
 125                  (cons
 126                   (funcall semantic-ia-completion-menu-format-tag-function tag)
 127                   (vector tag)))
 128                syms))
 129              (ans
 130               (imenu--mouse-menu
 131                ;; XEmacs needs that the menu has at least 2 items.  So,
 132                ;; include a nil item that will be ignored by imenu.
 133                (cons nil menu)
 134                (senator-completion-menu-point-as-event)
 135                "Completions")))
 136         (when ans
 137           (if (not (semantic-tag-p ans))
 138               (setq ans (aref (cdr ans) 0)))
 139           (delete-region (car (oref a bounds)) (cdr (oref a bounds)))
 140           (semantic-ia-insert-tag ans))
 141         ))))
 142
 143 (defun semantic-ia-insert-tag (tag)
 144   "Insert TAG into the current buffer based on completion."
 145   ;; I need to convert this into an override method!
 146   (insert (semantic-tag-name tag))
 147   (let ((tt (semantic-tag-class tag)))
 148     (cond ((eq tt 'function)
 149            (insert "("))
 150           (t nil))))
 151
 152 ;;;###autoload
 153 (defun semantic-ia-complete-tip (point)
 154   "Pop up a tooltip for completion at POINT."
 155   (interactive "d")
 156   (let* ((a (semantic-analyze-current-context point))
 157          (syms (semantic-ia-get-completions a point))
 158          (w (get-buffer-window (current-buffer)))
 159          (x (mod (- (current-column) (window-hscroll))
 160                  (window-width)))
 161          (y (save-excursion
 162               (save-restriction
 163                 (widen)
 164                 (narrow-to-region (window-start) (point))
 165                 (goto-char (point-min))
 166                 (1+ (vertical-motion (buffer-size))))))
 167          (str (mapconcat #'semantic-tag-name
 168                          syms
 169                          "\n"))
 170          )
 171     (cond ((fboundp 'x-show-tip)
 172            (x-show-tip str
 173                        (selected-frame)
 174                        nil
 175                        nil
 176                        x y)
 177            )
 178           (t (message str))
 179           )))
 180
 181 ;;;###autoload
 182 (defun semantic-ia-show-summary (point)
 183   "Display a summary for the symbol under POINT."
 184   (interactive "P")
 185   (let* ((ctxt (semantic-analyze-current-context point))
 186          (pf (reverse (oref ctxt prefix)))
 187          (sum nil)
 188         )
 189     (while (and pf (not sum))
 190       (if (semantic-tag-p (car pf))
 191           (setq sum (semantic-format-tag-summarize (car pf) nil t)))
 192       (setq pf (cdr pf)))
 193     (message "%s" sum)
 194     ))
 195
 196 ;;;###autoload
 197 (defun semantic-ia-show-doc (point)
 198   "Display the code-level documentation for the symbol at POINT."
 199   (interactive "P")
 200   (let* ((ctxt (semantic-analyze-current-context point))
 201          (pf (reverse (oref ctxt prefix))))
 202     ;; If PF, the prefix is non-nil, then the last element is either
 203     ;; a string (incomplete type), or a semantic TAG.  If it is a TAG
 204     ;; then we should be able to find DOC for it.
 205     (cond ((stringp (car pf))
 206            (message "Incomplete symbol name."))
 207           ((semantic-tag-p (car pf))
 208            (let ((doc (semantic-documentation-for-tag (car pf))))
 209              (with-output-to-temp-buffer "*TAG DOCUMENTATION*"
 210                (princ "Tag: ")
 211                (princ (semantic-format-tag-prototype (car pf)))
 212                (princ "\n")
 213                (princ "\n")
 214                (princ "Snarfed Documentation: ")
 215                (princ "\n")
 216                (princ "\n")
 217                (if doc
 218                    (princ doc)
 219                  (princ "  Documentation unavailable."))
 220                )))
 221           (t
 222            (message "Unknown tag.")))
 223     ))
 224
 225 (provide 'semantic-ia)
 226
 227 ;;; semantic-ia.el ends here