lisp/cedet/semantic/analyze/complete.el

   1 ;;; semantic/analyze/complete.el --- Smart Completions
   2
   3 ;;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; Caclulate smart completions.
  25 ;;
  26 ;; Uses the analyzer context routine to determine the best possible
  27 ;; list of completions.
  28 ;;
  29 ;;; History:
  30 ;;
  31 ;; Code was moved here from semantic-analyze.el
  32
  33 (require 'semantic/analyze)
  34
  35 ;;; Code:
  36
  37 ;;; Helper Fcns
  38 ;;
  39 ;;
  40 ;;;###autoload
  41 (define-overloadable-function semantic-analyze-type-constants (type)
  42   "For the tag TYPE, return any constant symbols of TYPE.
  43 Used as options when completing.")
  44
  45 (defun semantic-analyze-type-constants-default (type)
  46   "Do nothing with TYPE."
  47   nil)
  48
  49 ;; Old impl of the above.  I'm not sure what the issue is
  50 ;  (let ((ans
  51 ;         (:override-with-args
  52 ;             ((semantic-analyze-find-tag (semantic-tag-name type)))
  53 ;           ;; Be default, we don't know.
  54 ;           nil))
  55 ;        (out nil))
  56 ;    (dolist (elt ans)
  57 ;      (cond
  58 ;       ((stringp elt)
  59 ;        (push (semantic-tag-new-variable
  60 ;               elt (semantic-tag-name type) nil)
  61 ;              out))
  62 ;       ((semantic-tag-p elt)
  63 ;        (push elt out))
  64 ;       (t nil)))
  65 ;    (nreverse out)))
  66
  67 (defun semantic-analyze-tags-of-class-list (tags classlist)
  68   "Return the tags in TAGS that are of classes in CLASSLIST."
  69   (let ((origc tags))
  70     ;; Accept only tags that are of the datatype specified by
  71     ;; the desired classes.
  72     (setq tags (apply 'nconc ;; All input lists are permutable.
  73                       (mapcar (lambda (class)
  74                                 (semantic-find-tags-by-class class origc))
  75                               classlist)))
  76     tags))
  77
  78 ;;; MAIN completion calculator
  79 ;;
  80 ;;;###autoload
  81 (define-overloadable-function semantic-analyze-possible-completions (context)
  82   "Return a list of semantic tags which are possible completions.
  83 CONTEXT is either a position (such as point), or a precalculated
  84 context.  Passing in a context is useful if the caller also needs
  85 to access parts of the analysis.
  86 Completions run through the following filters:
  87   * Elements currently in scope
  88   * Constants currently in scope
  89   * Elements match the :prefix in the CONTEXT.
  90   * Type of the completion matches the type of the context.
  91 Context type matching can identify the following:
  92   * No specific type
  93   * Assignment into a variable of some type.
  94   * Argument to a function with type constraints.
  95 When called interactively, displays the list of possible completions
  96 in a buffer."
  97   (interactive "d")
  98   ;; In theory, we don't need the below since the context will
  99   ;; do it for us.
 100   ;;(semantic-refresh-tags-safe)
 101   (with-syntax-table semantic-lex-syntax-table
 102     (let* ((context (if (semantic-analyze-context-child-p context)
 103                         context
 104                       (semantic-analyze-current-context context)))
 105            (ans (if (not context)
 106                     (error "Nothing to Complete.")
 107                   (:override))))
 108       ;; If interactive, display them.
 109       (when (interactive-p)
 110         (with-output-to-temp-buffer "*Possible Completions*"
 111           (semantic-analyze-princ-sequence ans "" (current-buffer)))
 112         (shrink-window-if-larger-than-buffer
 113          (get-buffer-window "*Possible Completions*")))
 114       ans)))
 115
 116 (defun semantic-analyze-possible-completions-default (context)
 117   "Default method for producing smart completions.
 118 Argument CONTEXT is an object specifying the locally derived context."
 119   (let* ((a context)
 120          (desired-type (semantic-analyze-type-constraint a))
 121          (desired-class (oref a prefixclass))
 122          (prefix (oref a prefix))
 123          (prefixtypes (oref a prefixtypes))
 124          (completetext nil)
 125          (completetexttype nil)
 126          (scope (oref a scope))
 127          (localvar (oref scope localvar))
 128          (c nil))
 129
 130     ;; Calculate what our prefix string is so that we can
 131     ;; find all our matching text.
 132     (setq completetext (car (reverse prefix)))
 133     (if (semantic-tag-p completetext)
 134         (setq completetext (semantic-tag-name completetext)))
 135
 136     (if (and (not completetext) (not desired-type))
 137         (error "Nothing to complete"))
 138
 139     (if (not completetext) (setq completetext ""))
 140
 141     ;; This better be a reasonable type, or we should fry it.
 142     ;; The prefixtypes should always be at least 1 less than
 143     ;; the prefix since the type is never looked up for the last
 144     ;; item when calculating a sequence.
 145     (setq completetexttype (car (reverse prefixtypes)))
 146     (when (or (not completetexttype)
 147               (not (and (semantic-tag-p completetexttype)
 148                         (eq (semantic-tag-class completetexttype) 'type))))
 149       ;; What should I do here?  I think this is an error condition.
 150       (setq completetexttype nil)
 151       ;; If we had something that was a completetexttype but it wasn't
 152       ;; valid, then express our dismay!
 153       (when (> (length prefix) 1)
 154         (let* ((errprefix (car (cdr (reverse prefix)))))
 155           (error "Cannot find types for `%s'"
 156                  (cond ((semantic-tag-p errprefix)
 157                         (semantic-format-tag-prototype errprefix))
 158                        (t
 159                         (format "%S" errprefix)))))
 160         ))
 161
 162     ;; There are many places to get our completion stream for.
 163     ;; Here we go.
 164     (if completetexttype
 165
 166         (setq c (semantic-find-tags-for-completion
 167                  completetext
 168                  (semantic-analyze-scoped-type-parts completetexttype scope)
 169                  ))
 170
 171       ;; No type based on the completetext.  This is a free-range
 172       ;; var or function.  We need to expand our search beyond this
 173       ;; scope into semanticdb, etc.
 174       (setq c (nconc
 175                ;; Argument list and local variables
 176                (semantic-find-tags-for-completion completetext localvar)
 177                ;; The current scope
 178                (semantic-find-tags-for-completion completetext (oref scope fullscope))
 179                ;; The world
 180                (semantic-analyze-find-tags-by-prefix completetext))
 181             )
 182       )
 183
 184     (let ((origc c)
 185           (dtname (semantic-tag-name desired-type)))
 186
 187       ;; Reset c.
 188       (setq c nil)
 189
 190       ;; Loop over all the found matches, and catagorize them
 191       ;; as being possible features.
 192       (while origc
 193
 194         (cond
 195          ;; Strip operators
 196          ((semantic-tag-get-attribute (car origc) :operator-flag)
 197           nil
 198           )
 199
 200          ;; If we are completing from within some prefix,
 201          ;; then we want to exclude constructors and destructors
 202          ((and completetexttype
 203                (or (semantic-tag-get-attribute (car origc) :constructor-flag)
 204                    (semantic-tag-get-attribute (car origc) :destructor-flag)))
 205           nil
 206           )
 207
 208          ;; If there is a desired type, we need a pair of restrictions
 209          (desired-type
 210
 211           (cond
 212            ;; Ok, we now have a completion list based on the text we found
 213            ;; we want to complete on.  Now filter that stream against the
 214            ;; type we want to search for.
 215            ((string= dtname (semantic-analyze-type-to-name (semantic-tag-type (car origc))))
 216             (setq c (cons (car origc) c))
 217             )
 218
 219            ;; Now anything that is a compound type which could contain
 220            ;; additional things which are of the desired type
 221            ((semantic-tag-type (car origc))
 222             (let ((att (semantic-analyze-tag-type (car origc) scope))
 223                 )
 224               (if (and att (semantic-tag-type-members att))
 225                   (setq c (cons (car origc) c))))
 226             )
 227
 228            ) ; cond
 229           ); desired type
 230
 231          ;; No desired type, no other restrictions.  Just add.
 232          (t
 233           (setq c (cons (car origc) c)))
 234
 235          ); cond
 236
 237         (setq origc (cdr origc)))
 238
 239       (when desired-type
 240         ;; Some types, like the enum in C, have special constant values that
 241         ;; we could complete with.  Thus, if the target is an enum, we can
 242         ;; find possible symbol values to fill in that value.
 243         (let ((constants
 244                (semantic-analyze-type-constants desired-type)))
 245           (if constants
 246               (progn
 247                 ;; Filter
 248                 (setq constants
 249                       (semantic-find-tags-for-completion
 250                        completetext constants))
 251                 ;; Add to the list
 252                 (setq c (nconc c constants)))
 253             )))
 254       )
 255
 256     (when desired-class
 257       (setq c (semantic-analyze-tags-of-class-list c desired-class)))
 258
 259     ;; Pull out trash.
 260     ;; NOTE TO SELF: Is this too slow?
 261     ;; OTHER NOTE: Do we not want to strip duplicates by name and
 262     ;; only by position?  When are duplicate by name but not by tag
 263     ;; useful?
 264     (setq c (semantic-unique-tag-table-by-name c))
 265
 266     ;; All done!
 267
 268     c))
 269
 270 (provide 'semantic/analyze/complete)
 271
 272 ;; Local variables:
 273 ;; generated-autoload-file: "../loaddefs.el"
 274 ;; generated-autoload-feature: semantic/loaddefs
 275 ;; End:
 276
 277 ;;; semantic/analyze/complete.el ends here