lisp/obsolete/sym-comp.el

   1 ;;; sym-comp.el --- mode-dependent symbol completion
   2
   3 ;; Copyright (C) 2004, 2008-2015 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 preceding 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-extra-properties
 143           (if (functionp symbol-completion-transform-function)
 144               '(:annotation-function
 145                 (lambda (str)
 146                   (car-safe (cdr-safe
 147                              (funcall symbol-completion-transform-function
 148                                       str))))))))
 149     (completion-in-region (- (point) (length pattern)) (point)
 150                           completions predicate)))
 151 \f
 152 (defvar he-search-string)
 153 (defvar he-tried-table)
 154 (defvar he-expand-list)
 155 (declare-function he-init-string "hippie-exp" (beg end))
 156 (declare-function he-string-member "hippie-exp" (str lst &optional trans-case))
 157 (declare-function he-substitute-string "hippie-exp" (str &optional trans-case))
 158 (declare-function he-reset-string "hippie-exp" ())
 159
 160 ;;;###autoload
 161 (defun symbol-completion-try-complete (old)
 162   "Completion function for use with `hippie-expand'.
 163 Uses `symbol-completion-symbol-function' and
 164 `symbol-completion-completions-function'.  It is intended to be
 165 used something like this in a major mode which provides symbol
 166 completion:
 167
 168   (if (featurep 'hippie-exp)
 169       (set (make-local-variable 'hippie-expand-try-functions-list)
 170            (cons 'symbol-completion-try-complete
 171                  hippie-expand-try-functions-list)))"
 172   (when (and symbol-completion-symbol-function
 173              symbol-completion-completions-function)
 174     (unless old
 175       (let ((symbol (funcall symbol-completion-symbol-function)))
 176         (he-init-string (- (point) (length symbol)) (point))
 177         (if (not (he-string-member he-search-string he-tried-table))
 178             (push he-search-string he-tried-table))
 179         (setq he-expand-list
 180               (and symbol
 181                    (funcall symbol-completion-completions-function symbol)))))
 182     (while (and he-expand-list
 183                 (he-string-member (car he-expand-list) he-tried-table))
 184       (pop he-expand-list))
 185     (if he-expand-list
 186         (progn
 187           (he-substitute-string (pop he-expand-list))
 188           t)
 189       (if old (he-reset-string))
 190       nil)))
 191 \f
 192 ;;; Emacs Lisp symbol completion.
 193
 194 (defun lisp-completion-symbol ()
 195   "`symbol-completion-symbol-function' for Lisp."
 196   (let ((end (point))
 197         (beg (with-syntax-table emacs-lisp-mode-syntax-table
 198                (save-excursion
 199                  (backward-sexp 1)
 200                  (while (= (char-syntax (following-char)) ?\')
 201                    (forward-char 1))
 202                  (point)))))
 203     (buffer-substring-no-properties beg end)))
 204
 205 (defun lisp-completion-predicate (beg end)
 206   "`symbol-completion-predicate-function' for Lisp."
 207   (save-excursion
 208     (goto-char beg)
 209     (if (not (eq (char-before) ?\())
 210         (lambda (sym)                   ;why not just nil ?   -sm
 211                                         ;To avoid interned symbols with
 212                                         ;no slots.  -- fx
 213           (or (boundp sym) (fboundp sym)
 214               (symbol-plist sym)))
 215       ;; Looks like a funcall position.  Let's double check.
 216       (if (condition-case nil
 217               (progn (up-list -2) (forward-char 1)
 218                      (eq (char-after) ?\())
 219             (error nil))
 220           ;; If the first element of the parent list is an open
 221           ;; parenthesis we are probably not in a funcall position.
 222           ;; Maybe a `let' varlist or something.
 223           nil
 224         ;; Else, we assume that a function name is expected.
 225         'fboundp))))
 226
 227 (defun lisp-symbol-completion-transform ()
 228   "`symbol-completion-transform-function' for Lisp."
 229   (lambda (elt)
 230     (if (and (not (eq 'fboundp symbol-completion-predicate))
 231              (fboundp (intern elt)))
 232         (list elt " <f>")
 233       elt)))
 234
 235 (provide 'sym-comp)
 236
 237 ;;; sym-comp.el ends here