lisp/obsolete/sym-comp.el

   1 ;;; sym-comp.el --- mode-dependent symbol completion
   2
   3 ;; Copyright (C) 2004, 2008, 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Dave Love <fx@gnu.org>
   6 ;; Keywords: extensions
   7 ;; URL: http://www.loveshack.ukfsn.org/emacs
   8 ;; Obsolete-since: 23.2
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This defines `symbol-complete', which is a generalization of the
  28 ;; old `lisp-complete-symbol'.  It provides the following hooks to
  29 ;; allow major modes to set up completion appropriate for the mode:
  30 ;; `symbol-completion-symbol-function',
  31 ;; `symbol-completion-completions-function',
  32 ;; `symbol-completion-predicate-function',
  33 ;; `symbol-completion-transform-function'.  Typically it is only
  34 ;; necessary for a mode to set
  35 ;; `symbol-completion-completions-function' locally and to bind
  36 ;; `symbol-complete' appropriately.
  37
  38 ;; It's unfortunate that there doesn't seem to be a good way of
  39 ;; combining this with `complete-symbol'.
  40
  41 ;; There is also `symbol-completion-try-complete', for use with
  42 ;; Hippie-exp.
  43
  44 ;;; Code:
  45
  46 ;;;; Mode-dependent symbol completion.
  47
  48 (defun symbol-completion-symbol ()
  49   "Default `symbol-completion-symbol-function'.
  50 Uses `current-word' with the buffer narrowed to the part before
  51 point."
  52   (save-restriction
  53     ;; Narrow in case point is in the middle of a symbol -- we want
  54     ;; just the preceeding part.
  55     (narrow-to-region (point-min) (point))
  56     (current-word)))
  57
  58 (defvar symbol-completion-symbol-function 'symbol-completion-symbol
  59   "Function to return a partial symbol before point for completion.
  60 The value it returns should be a string (or nil).
  61 Major modes may set this locally if the default isn't appropriate.
  62
  63 Beware: the length of the string STR returned need to be equal to the length
  64 of text before point that's subject to completion.  Typically, this amounts
  65 to saying that STR is equal to
  66 \(buffer-substring (- (point) (length STR)) (point)).")
  67
  68 (defvar symbol-completion-completions-function nil
  69   "Function to return possible symbol completions.
  70 It takes an argument which is the string to be completed and
  71 returns a value suitable for the second argument of
  72 `try-completion'.  This value need not use the argument, i.e. it
  73 may be all possible completions, such as `obarray' in the case of
  74 Emacs Lisp.
  75
  76 Major modes may set this locally to allow them to support
  77 `symbol-complete'.  See also `symbol-completion-symbol-function',
  78 `symbol-completion-predicate-function' and
  79 `symbol-completion-transform-function'.")
  80
  81 (defvar symbol-completion-predicate-function nil
  82   "If non-nil, function to return a predicate for selecting symbol completions.
  83 The function gets two args, the positions of the beginning and
  84 end of the symbol to be completed.
  85
  86 Major modes may set this locally if the default isn't
  87 appropriate.  This is a function returning a predicate so that
  88 the predicate can be context-dependent, e.g. to select only
  89 function names if point is at a function call position.  The
  90 function's args may be useful for determining the context.")
  91
  92 (defvar symbol-completion-transform-function nil
  93   "If non-nil, function to transform symbols in the symbol-completion buffer.
  94 E.g., for Lisp, it may annotate the symbol as being a function,
  95 not a variable.
  96
  97 The function takes the symbol name as argument.  If it needs to
  98 annotate this, it should return a value suitable as an element of
  99 the list passed to `display-completion-list'.
 100
 101 The predicate being used for selecting completions (from
 102 `symbol-completion-predicate-function') is available
 103 dynamically-bound as `symbol-completion-predicate' in case the
 104 transform needs it.")
 105
 106 (defvar symbol-completion-predicate)
 107
 108 ;;;###autoload
 109 (defun symbol-complete (&optional predicate)
 110   "Perform completion of the symbol preceding point.
 111 This is done in a way appropriate to the current major mode,
 112 perhaps by interrogating an inferior interpreter.  Compare
 113 `complete-symbol'.
 114 If no characters can be completed, display a list of possible completions.
 115 Repeating the command at that point scrolls the list.
 116
 117 When called from a program, optional arg PREDICATE is a predicate
 118 determining which symbols are considered.
 119
 120 This function requires `symbol-completion-completions-function'
 121 to be set buffer-locally.  Variables `symbol-completion-symbol-function',
 122 `symbol-completion-predicate-function' and
 123 `symbol-completion-transform-function' are also consulted."
 124   (interactive)
 125   ;; Fixme: Punt to `complete-symbol' in this case?
 126   (unless (functionp symbol-completion-completions-function)
 127     (error "symbol-completion-completions-function not defined"))
 128   (let* ((pattern (or (funcall symbol-completion-symbol-function)
 129                       (error "No preceding symbol to complete")))
 130          ;; FIXME: We assume below that `pattern' holds the text just
 131          ;; before point.  This is a problem in the way
 132          ;; symbol-completion-symbol-function was defined.
 133          (predicate (or predicate
 134                         (if symbol-completion-predicate-function
 135                             (funcall symbol-completion-predicate-function
 136                                      (- (point) (length pattern))
 137                                      (point)))))
 138          (completions (funcall symbol-completion-completions-function
 139                                pattern))
 140          ;; In case the transform needs to access it.
 141          (symbol-completion-predicate predicate)
 142          (completion-annotate-function
 143           (if (functionp symbol-completion-transform-function)
 144               (lambda (str)
 145                 (car-safe (cdr-safe
 146                            (funcall symbol-completion-transform-function
 147                                     str)))))))
 148     (completion-in-region (- (point) (length pattern)) (point)
 149                           completions predicate)))
 150 \f
 151 (eval-when-compile (require 'hippie-exp))
 152
 153 ;;;###autoload
 154 (defun symbol-completion-try-complete (old)
 155   "Completion function for use with `hippie-expand'.
 156 Uses `symbol-completion-symbol-function' and
 157 `symbol-completion-completions-function'.  It is intended to be
 158 used something like this in a major mode which provides symbol
 159 completion:
 160
 161   (if (featurep 'hippie-exp)
 162       (set (make-local-variable 'hippie-expand-try-functions-list)
 163            (cons 'symbol-completion-try-complete
 164                  hippie-expand-try-functions-list)))"
 165   (when (and symbol-completion-symbol-function
 166              symbol-completion-completions-function)
 167     (unless old
 168       (let ((symbol (funcall symbol-completion-symbol-function)))
 169         (he-init-string (- (point) (length symbol)) (point))
 170         (if (not (he-string-member he-search-string he-tried-table))
 171             (push he-search-string he-tried-table))
 172         (setq he-expand-list
 173               (and symbol
 174                    (funcall symbol-completion-completions-function symbol)))))
 175     (while (and he-expand-list
 176                 (he-string-member (car he-expand-list) he-tried-table))
 177       (pop he-expand-list))
 178     (if he-expand-list
 179         (progn
 180           (he-substitute-string (pop he-expand-list))
 181           t)
 182       (if old (he-reset-string))
 183       nil)))
 184 \f
 185 ;;; Emacs Lisp symbol completion.
 186
 187 (defun lisp-completion-symbol ()
 188   "`symbol-completion-symbol-function' for Lisp."
 189   (let ((end (point))
 190         (beg (with-syntax-table emacs-lisp-mode-syntax-table
 191                (save-excursion
 192                  (backward-sexp 1)
 193                  (while (= (char-syntax (following-char)) ?\')
 194                    (forward-char 1))
 195                  (point)))))
 196     (buffer-substring-no-properties beg end)))
 197
 198 (defun lisp-completion-predicate (beg end)
 199   "`symbol-completion-predicate-function' for Lisp."
 200   (save-excursion
 201     (goto-char beg)
 202     (if (not (eq (char-before) ?\())
 203         (lambda (sym)                   ;why not just nil ?   -sm
 204                                         ;To avoid interned symbols with
 205                                         ;no slots.  -- fx
 206           (or (boundp sym) (fboundp sym)
 207               (symbol-plist sym)))
 208       ;; Looks like a funcall position.  Let's double check.
 209       (if (condition-case nil
 210               (progn (up-list -2) (forward-char 1)
 211                      (eq (char-after) ?\())
 212             (error nil))
 213           ;; If the first element of the parent list is an open
 214           ;; parenthesis we are probably not in a funcall position.
 215           ;; Maybe a `let' varlist or something.
 216           nil
 217         ;; Else, we assume that a function name is expected.
 218         'fboundp))))
 219
 220 (defun lisp-symbol-completion-transform ()
 221   "`symbol-completion-transform-function' for Lisp."
 222   (lambda (elt)
 223     (if (and (not (eq 'fboundp symbol-completion-predicate))
 224              (fboundp (intern elt)))
 225         (list elt " <f>")
 226       elt)))
 227
 228 (provide 'sym-comp)
 229
 230 ;; arch-tag: 6fcce616-f3c4-4751-94b4-710e83144124
 231 ;;; sym-comp.el ends here