Better module help
[geiser.git] / elisp / geiser-completion.el
blobb33c9761d683c0679ce724f0fdd8d450d0c35df8
1 ;;; geiser-completion.el -- tab completion
3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Mon Feb 09, 2009 22:21
14 (require 'geiser-impl)
15 (require 'geiser-eval)
16 (require 'geiser-log)
17 (require 'geiser-syntax)
18 (require 'geiser-base)
21 ;;; Completions window handling, heavily inspired in slime's:
23 (defvar geiser-completion--comp-buffer "*Geiser Completions*")
25 (make-variable-buffer-local
26 (defvar geiser-completion--window-cfg nil
27 "Window configuration before we show the *Completions* buffer.
28 This is buffer local in the buffer where the completion is
29 performed."))
31 (make-variable-buffer-local
32 (defvar geiser-completion--completions-window nil
33 "The window displaying *Completions* after saving window configuration.
34 If this window is no longer active or displaying the completions
35 buffer then we can ignore `geiser-completion--window-cfg'."))
37 (defun geiser-completion--save-window-cfg ()
38 "Maybe save the current window configuration.
39 Return true if the configuration was saved."
40 (unless (or geiser-completion--window-cfg
41 (get-buffer-window geiser-completion--comp-buffer))
42 (setq geiser-completion--window-cfg
43 (current-window-configuration))
44 t))
46 (defun geiser-completion--delay-restoration ()
47 (add-hook 'pre-command-hook
48 'geiser-completion--maybe-restore-window-cfg
49 nil t))
51 (defun geiser-completion--forget-window-cfg ()
52 (setq geiser-completion--window-cfg nil)
53 (setq geiser-completion--completions-window nil))
55 (defun geiser-completion--restore-window-cfg ()
56 "Restore the window config if available."
57 (remove-hook 'pre-command-hook
58 'geiser-completion--maybe-restore-window-cfg)
59 (when (and geiser-completion--window-cfg
60 (geiser-completion--window-active-p))
61 (save-excursion
62 (set-window-configuration geiser-completion--window-cfg))
63 (setq geiser-completion--window-cfg nil)
64 (when (buffer-live-p geiser-completion--comp-buffer)
65 (kill-buffer geiser-completion--comp-buffer))))
67 (defun geiser-completion--maybe-restore-window-cfg ()
68 "Restore the window configuration, if the following command
69 terminates a current completion."
70 (remove-hook 'pre-command-hook
71 'geiser-completion--maybe-restore-window-cfg)
72 (condition-case err
73 (cond ((memq last-command-event '(?( ?) ?\" ?' ?` ?, ?# ? ?\r ?\n ?:))
74 (geiser-completion--restore-window-cfg))
75 ((not (geiser-completion--window-active-p))
76 (geiser-completion--forget-window-cfg))
77 (t (geiser-completion--delay-restoration)))
78 (error
79 ;; Because this is called on the pre-command-hook, we mustn't let
80 ;; errors propagate.
81 (message "Error in geiser-completion--restore-window-cfg: %S" err))))
83 (defun geiser-completion--window-active-p ()
84 "Is the completion window currently active?"
85 (and (window-live-p geiser-completion--completions-window)
86 (equal (buffer-name
87 (window-buffer geiser-completion--completions-window))
88 geiser-completion--comp-buffer)))
90 (defun geiser-completion--display-comp-list (completions base)
91 (let ((savedp (geiser-completion--save-window-cfg)))
92 (with-output-to-temp-buffer geiser-completion--comp-buffer
93 (display-completion-list completions base)
94 (let ((offset (- (point) 1 (length base))))
95 (with-current-buffer standard-output
96 (setq completion-base-position (list offset nil))
97 (set-syntax-table scheme-mode-syntax-table))))
98 (when savedp
99 (setq geiser-completion--completions-window
100 (get-buffer-window geiser-completion--comp-buffer)))))
102 (defun geiser-completion--display-or-scroll (completions base)
103 (if (and (eq last-command this-command)
104 (geiser-completion--window-active-p))
105 (geiser-completion--scroll-completions)
106 (geiser-completion--display-comp-list completions base))
107 (geiser-completion--delay-restoration))
109 (defun geiser-completion--scroll-completions ()
110 (let ((window geiser-completion--completions-window))
111 (with-current-buffer (window-buffer window)
112 (if (pos-visible-in-window-p (point-max) window)
113 (set-window-start window (point-min))
114 (save-selected-window
115 (select-window window)
116 (scroll-up))))))
119 ;;; Minibuffer maps:
121 (defvar geiser-completion--minibuffer-map
122 (let ((map (make-keymap)))
123 (set-keymap-parent map minibuffer-local-completion-map)
124 (define-key map "?" 'self-insert-command)
125 map))
127 (defvar geiser-completion--module-minibuffer-map
128 (let ((map (make-keymap)))
129 (set-keymap-parent map minibuffer-local-completion-map)
130 (define-key map " " 'self-insert-command)
131 (define-key map "?" 'self-insert-command)
132 map))
135 ;;; Completion functionality:
137 (defvar geiser-completion--binding-forms nil)
138 (geiser-impl--register-local-variable
139 'geiser-completion--binding-forms 'binding-forms nil
140 "A list of forms introducing local bindings, a la let or lambda.")
142 (defvar geiser-completion--binding-forms* nil)
143 (geiser-impl--register-local-variable
144 'geiser-completion--binding-forms* 'binding-forms* nil
145 "A list of forms introducing nested local bindings, a la let*.")
147 (defsubst geiser-completion--locals ()
148 (mapcar (lambda (s) (and (symbolp s) (symbol-name s)))
149 (geiser-syntax--locals-around-point
150 geiser-completion--binding-forms
151 geiser-completion--binding-forms*)))
153 (defun geiser-completion--symbol-list (prefix)
154 (geiser--del-dups
155 (append (all-completions prefix (geiser-completion--locals))
156 (geiser-eval--send/result `(:eval (:ge completions ,prefix))))))
158 (defsubst geiser-completion--module-list (prefix)
159 (geiser-eval--send/result `(:eval (:ge module-completions ,prefix))))
161 (defvar geiser-completion--symbol-list-func
162 (completion-table-dynamic 'geiser-completion--symbol-list))
164 (defvar geiser-completion--module-list-func
165 (completion-table-dynamic 'geiser-completion--module-list))
167 (defun geiser-completion--complete (prefix modules)
168 (let* ((completions (if modules (geiser-completion--module-list prefix)
169 (geiser-completion--symbol-list prefix)))
170 (partial (try-completion prefix completions))
171 (partial (if (eq partial t) prefix partial)))
172 (cons completions partial)))
174 (defvar geiser-completion--symbol-history nil)
176 (defun geiser-completion--read-symbol (prompt &optional default history)
177 (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map))
178 (completing-read prompt
179 geiser-completion--symbol-list-func
180 nil nil nil
181 (or history geiser-completion--symbol-history)
182 (or default (symbol-at-point)))))
184 (defvar geiser-completion--module-history nil)
186 (defun geiser-completion--read-module (&optional prompt default history)
187 (let ((minibuffer-local-completion-map
188 geiser-completion--module-minibuffer-map))
189 (completing-read (or prompt "Module name: ")
190 geiser-completion--module-list-func
191 nil nil nil
192 (or history geiser-completion--module-history)
193 default)))
195 (defun geiser--respecting-message (format &rest format-args)
196 "Display TEXT as a message, without hiding any minibuffer contents."
197 (let ((text (format " [%s]" (apply #'format format format-args))))
198 (if (minibuffer-window-active-p (minibuffer-window))
199 (minibuffer-message text)
200 (message "%s" text))))
202 (defvar geiser-completion--symbol-begin-function nil)
204 (defsubst geiser-completion--def-symbol-begin (module)
205 (save-excursion (skip-syntax-backward "^-()>") (point)))
207 (geiser-impl--register-local-method
208 'geiser-completion--symbol-begin-function 'find-symbol-begin
209 'geiser-completion--def-symbol-begin
210 "An optional function finding the position of the beginning of
211 the identifier around point. Takes a boolean, indicating whether
212 we're looking for a module name.")
214 (defsubst geiser-completion--symbol-begin (module)
215 (funcall geiser-completion--symbol-begin-function module))
217 (defun geiser-completion--module-at-point ()
218 (save-excursion
219 (goto-char (geiser-completion--symbol-begin t))
220 (ignore-errors (thing-at-point 'sexp))))
222 (defsubst geiser-completion--prefix (module)
223 (buffer-substring-no-properties (geiser-completion--symbol-begin module)
224 (point)))
226 (defun geiser-completion--complete-symbol (&optional arg)
227 "Complete the symbol at point.
228 Perform completion similar to Emacs' complete-symbol.
229 With prefix, complete module name."
230 (interactive "P")
231 (unless (geiser-syntax--symbol-at-point)
232 (error "No symbol at point"))
233 (geiser--respecting-message "Retrieving completions...")
234 (let* ((prefix (geiser-completion--prefix arg))
235 (result (and prefix (geiser-completion--complete prefix arg)))
236 (completions (car result))
237 (partial (cdr result)))
238 (cond ((null completions)
239 (if (not arg)
240 (geiser-completion--complete-symbol t)
241 (geiser--respecting-message "Can't find completion for %S"
242 prefix)
243 (geiser-completion--restore-window-cfg)))
244 (t (insert-and-inherit (substring partial (length prefix)))
245 (cond ((= (length completions) 1)
246 (geiser--respecting-message "Sole completion")
247 (geiser-completion--restore-window-cfg))
248 (t (geiser--respecting-message "Complete but not unique")
249 (geiser-completion--display-or-scroll completions
250 partial)))))))
252 (defun geiser-completion--complete-module ()
253 (interactive)
254 (geiser-completion--complete-symbol t))
257 ;;; Smart tab mode:
259 (make-variable-buffer-local
260 (defvar geiser-smart-tab-mode-string " SmartTab"
261 "Modeline indicator for geiser-smart-tab-mode"))
263 (defun geiser-completion--maybe-complete ()
264 "Indent if at beginning of line or after a white space or
265 closing parenthesis, try completion otherwise."
266 (interactive)
267 (let ((indent (or (bolp) (memq (syntax-class (syntax-after (1- (point))))
268 '(0 5)))))
269 (if indent (indent-according-to-mode)
270 (geiser-completion--complete-symbol))))
272 (define-minor-mode geiser-smart-tab-mode
273 "Toggle smart tab mode.
274 With no argument, this command toggles the mode.
275 Non-null prefix argument turns on the mode.
276 Null prefix argument turns off the mode.
278 When this mode is enable, TAB will indent if at point is at
279 beginning of line or after a white space or closing parenthesis,
280 and will try completing symbol at point otherwise."
281 :init-value nil
282 :lighter geiser-smart-tab-mode-string
283 :group 'geiser-mode
284 :keymap `((,(kbd "TAB") . geiser-completion--maybe-complete)))
287 (provide 'geiser-completion)