code.delx.au - gnu-emacs/blob - lisp/progmodes/sym-comp.el

   1 ;;; sym-comp.el --- mode-dependent symbol completion
   2
   3 ;; Copyright (C) 2004, 2008  Free Software Foundation, Inc.
   4
   5 ;; Author: Dave Love <fx@gnu.org>
   6 ;; Keywords: extensions
   7 ;; URL: http://www.loveshack.ukfsn.org/emacs
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs 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 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs 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 ;; This defines `symbol-complete', which is a generalization of the
  29 ;; old `lisp-complete-symbol'.  It provides the following hooks to
  30 ;; allow major modes to set up completion appropriate for the mode:
  31 ;; `symbol-completion-symbol-function',
  32 ;; `symbol-completion-completions-function',
  33 ;; `symbol-completion-predicate-function',
  34 ;; `symbol-completion-transform-function'.  Typically it is only
  35 ;; necessary for a mode to set
  36 ;; `symbol-completion-completions-function' locally and to bind
  37 ;; `symbol-complete' appropriately.
  38
  39 ;; It's unfortunate that there doesn't seem to be a good way of
  40 ;; combining this with `complete-symbol'.
  41
  42 ;; There is also `symbol-completion-try-complete', for use with
  43 ;; Hippie-exp.
  44
  45 ;;; Code:
  46
  47 ;;;; Mode-dependent symbol completion.
  48
  49 (defun symbol-completion-symbol ()
  50   "Default `symbol-completion-symbol-function'.
  51 Uses `current-word' with the buffer narrowed to the part before
  52 point."
  53   (save-restriction
  54     ;; Narrow in case point is in the middle of a symbol -- we want
  55     ;; just the preceeding part.
  56     (narrow-to-region (point-min) (point))
  57     (current-word)))
  58
  59 (defvar symbol-completion-symbol-function 'symbol-completion-symbol
  60   "Function to return a partial symbol before point for completion.
  61 The value it returns should be a string (or nil).
  62 Major modes may set this locally if the default isn't appropriate.")
  63
  64 (defvar symbol-completion-completions-function nil
  65   "Function to return possible symbol completions.
  66 It takes an argument which is the string to be completed and
  67 returns a value suitable for the second argument of
  68 `try-completion'.  This value need not use the argument, i.e. it
  69 may be all possible completions, such as `obarray' in the case of
  70 Emacs Lisp.
  71
  72 Major modes may set this locally to allow them to support
  73 `symbol-complete'.  See also `symbol-completion-symbol-function',
  74 `symbol-completion-predicate-function' and
  75 `symbol-completion-transform-function'.")
  76
  77 (defvar symbol-completion-predicate-function nil
  78   "If non-nil, function to return a predicate for selecting symbol completions.
  79 The function gets two args, the positions of the beginning and
  80 end of the symbol to be completed.
  81
  82 Major modes may set this locally if the default isn't
  83 appropriate.  This is a function returning a predicate so that
  84 the predicate can be context-dependent, e.g. to select only
  85 function names if point is at a function call position.  The
  86 function's args may be useful for determining the context.")
  87
  88 (defvar symbol-completion-transform-function nil
  89   "If non-nil, function to transform symbols in the symbol-completion buffer.
  90 E.g., for Lisp, it may annotate the symbol as being a function,
  91 not a variable.
  92
  93 The function takes the symbol name as argument.  If it needs to
  94 annotate this, it should return a value suitable as an element of
  95 the list passed to `display-completion-list'.
  96
  97 The predicate being used for selecting completions (from
  98 `symbol-completion-predicate-function') is available
  99 dynamically-bound as `symbol-completion-predicate' in case the
 100 transform needs it.")
 101
 102 (defvar displayed-completions)
 103
 104 ;;;###autoload
 105 (defun symbol-complete (&optional predicate)
 106   "Perform completion of the symbol preceding point.
 107 This is done in a way appropriate to the current major mode,
 108 perhaps by interrogating an inferior interpreter.  Compare
 109 `complete-symbol'.
 110 If no characters can be completed, display a list of possible completions.
 111 Repeating the command at that point scrolls the list.
 112
 113 When called from a program, optional arg PREDICATE is a predicate
 114 determining which symbols are considered.
 115
 116 This function requires `symbol-completion-completions-function'
 117 to be set buffer-locally.  Variables `symbol-completion-symbol-function',
 118 `symbol-completion-predicate-function' and
 119 `symbol-completion-transform-function' are also consulted."
 120   (interactive)
 121   ;; Fixme: Punt to `complete-symbol' in this case?
 122   (unless (functionp symbol-completion-completions-function)
 123     (error "symbol-completion-completions-function not defined"))
 124   (let ((window (get-buffer-window "*Completions*")))
 125     (let* ((pattern (or (funcall symbol-completion-symbol-function)
 126                         (error "No preceding symbol to complete")))
 127            (predicate (or predicate
 128                           (if symbol-completion-predicate-function
 129                               (funcall symbol-completion-predicate-function
 130                                        (- (point) (length pattern))
 131                                        (point)))))
 132            (completions (funcall symbol-completion-completions-function
 133                                  pattern))
 134            (completion (try-completion pattern completions predicate)))
 135       ;; If this command was repeated, and there's a fresh completion
 136       ;; window with a live buffer and a displayed completion list
 137       ;; matching the current completions, then scroll the window.
 138       (unless (and (eq last-command this-command)
 139                    window (window-live-p window) (window-buffer window)
 140                    (buffer-name (window-buffer window))
 141                    (with-current-buffer (window-buffer window)
 142                      (if (equal displayed-completions
 143                                 (all-completions pattern completions predicate))
 144                          (progn
 145                            (if (pos-visible-in-window-p (point-max) window)
 146                                (set-window-start window (point-min))
 147                              (save-selected-window
 148                                (select-window window)
 149                                (scroll-up)))
 150                            t))))
 151         ;; Otherwise, do completion.
 152         (cond ((eq completion t))
 153               ((null completion)
 154                (message "Can't find completion for \"%s\"" pattern)
 155                (ding))
 156               ((not (string= pattern completion))
 157                (delete-region (- (point) (length pattern)) (point))
 158                (insert completion))
 159               (t
 160                (message "Making completion list...")
 161                (let* ((list (all-completions pattern completions predicate))
 162                       ;; In case the transform needs to access it.
 163                       (symbol-completion-predicate predicate)
 164                       ;; Copy since list is side-effected by sorting.
 165                       (copy (copy-sequence list)))
 166                  (setq list (sort list 'string<))
 167                  (if (functionp symbol-completion-transform-function)
 168                      (setq list
 169                            (mapcar (funcall
 170                                     symbol-completion-transform-function)
 171                                    list)))
 172                  (with-output-to-temp-buffer "*Completions*"
 173                    (condition-case ()
 174                        (display-completion-list list pattern) ; Emacs 22
 175                      (error (display-completion-list list))))
 176                  ;; Record the list for determining whether to scroll
 177                  ;; (above).
 178                  (with-current-buffer "*Completions*"
 179                    (set (make-local-variable 'displayed-completions) copy)))
 180                (message "Making completion list...%s" "done")))))))
 181 \f
 182 (eval-when-compile (require 'hippie-exp))
 183
 184 ;;;###autoload
 185 (defun symbol-completion-try-complete (old)
 186   "Completion function for use with `hippie-expand'.
 187 Uses `symbol-completion-symbol-function' and
 188 `symbol-completion-completions-function'.  It is intended to be
 189 used something like this in a major mode which provides symbol
 190 completion:
 191
 192   (if (featurep 'hippie-exp)
 193       (set (make-local-variable 'hippie-expand-try-functions-list)
 194            (cons 'symbol-completion-try-complete
 195                  hippie-expand-try-functions-list)))"
 196   (when (and symbol-completion-symbol-function
 197              symbol-completion-completions-function)
 198     (unless old
 199       (let ((symbol (funcall symbol-completion-symbol-function)))
 200         (he-init-string (- (point) (length symbol)) (point))
 201         (if (not (he-string-member he-search-string he-tried-table))
 202             (push he-search-string he-tried-table))
 203         (setq he-expand-list
 204               (and symbol
 205                    (funcall symbol-completion-completions-function symbol)))))
 206     (while (and he-expand-list
 207                 (he-string-member (car he-expand-list) he-tried-table))
 208       (pop he-expand-list))
 209     (if he-expand-list
 210         (progn
 211           (he-substitute-string (pop he-expand-list))
 212           t)
 213       (if old (he-reset-string))
 214       nil)))
 215 \f
 216 ;;; Emacs Lisp symbol completion.
 217
 218 (defun lisp-completion-symbol ()
 219   "`symbol-completion-symbol-function' for Lisp."
 220   (let ((end (point))
 221         (beg (with-syntax-table emacs-lisp-mode-syntax-table
 222                (save-excursion
 223                  (backward-sexp 1)
 224                  (while (= (char-syntax (following-char)) ?\')
 225                    (forward-char 1))
 226                  (point)))))
 227     (buffer-substring-no-properties beg end)))
 228
 229 (defun lisp-completion-predicate (beg end)
 230   "`symbol-completion-predicate-function' for Lisp."
 231   (save-excursion
 232     (goto-char beg)
 233     (if (not (eq (char-before) ?\())
 234         (lambda (sym)                   ;why not just nil ?   -sm
 235                                         ;To avoid interned symbols with
 236                                         ;no slots.  -- fx
 237           (or (boundp sym) (fboundp sym)
 238               (symbol-plist sym)))
 239       ;; Looks like a funcall position.  Let's double check.
 240       (if (condition-case nil
 241               (progn (up-list -2) (forward-char 1)
 242                      (eq (char-after) ?\())
 243             (error nil))
 244           ;; If the first element of the parent list is an open
 245           ;; parenthesis we are probably not in a funcall position.
 246           ;; Maybe a `let' varlist or something.
 247           nil
 248         ;; Else, we assume that a function name is expected.
 249         'fboundp))))
 250
 251 (defvar symbol-completion-predicate)
 252
 253 (defun lisp-symbol-completion-transform ()
 254   "`symbol-completion-transform-function' for Lisp."
 255   (lambda (elt)
 256     (if (and (not (eq 'fboundp symbol-completion-predicate))
 257              (fboundp (intern elt)))
 258         (list elt " <f>")
 259       elt)))
 260
 261 (provide 'sym-comp)
 262
 263 ;; arch-tag: 6fcce616-f3c4-4751-94b4-710e83144124
 264 ;;; sym-comp.el ends here