1 ;;; minibuffer.el --- Minibuffer completion functions
3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
7 ;; This file is part of GNU Emacs.
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.
14 ;; This program 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.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;; - merge do-completion and complete-word
26 ;; - move all I/O out of do-completion
30 (eval-when-compile (require 'cl
))
32 (defun minibuffer-message (message &rest args
)
33 "Temporarily display MESSAGE at the end of the minibuffer.
34 The text is displayed for `minibuffer-message-timeout' seconds,
35 or until the next input event arrives, whichever comes first.
36 Enclose MESSAGE in [...] if this is not yet the case.
37 If ARGS are provided, then pass MESSAGE through `format'."
38 ;; Clear out any old echo-area message to make way for our new thing.
40 (unless (string-match "\\[.+\\]" message
)
41 (setq message
(concat " [" message
"]")))
42 (when args
(setq message
(apply 'format message args
)))
43 (let ((ol (make-overlay (point-max) (point-max) nil t t
)))
46 (overlay-put ol
'after-string message
)
47 (sit-for (or minibuffer-message-timeout
1000000)))
48 (delete-overlay ol
))))
50 (defun minibuffer-completion-contents ()
51 "Return the user input in a minibuffer before point as a string.
52 That is what completion commands operate on."
53 (buffer-substring (field-beginning) (point)))
55 (defun delete-minibuffer-contents ()
56 "Delete all user input in a minibuffer.
57 If the current buffer is not a minibuffer, erase its entire contents."
60 (defun minibuffer--maybe-completion-help ()
61 (if completion-auto-help
62 (minibuffer-completion-help)
63 (minibuffer-message "Next char not unique")))
65 (defun minibuffer-do-completion ()
66 "Do the completion and return a summary of what happened.
67 C = There were available completions.
68 E = After completion we now have an exact match.
69 M = Completion was performed, the text was Modified.
72 000 0 no possible completion
73 010 1 was already an exact and unique completion
74 110 3 was already an exact completion
75 111 4 completed to an exact completion
76 101 5 some completion happened
77 100 6 no completion happened"
78 (let* ((string (minibuffer-completion-contents))
79 (completion (try-completion (field-string)
80 minibuffer-completion-table
81 minibuffer-completion-predicate
)))
82 (setq last-exact-completion nil
)
85 (ding) (minibuffer-message "No match") 0)
86 ((eq t completion
) 1) ;Exact and unique match.
88 ;; `completed' should be t if some completion was done, which doesn't
89 ;; include simply changing the case of the entered string. However,
90 ;; for appearance, the string is rewritten if the case changes.
91 (let ((completed (not (eq t
(compare-strings completion nil nil
93 (unchanged (eq t
(compare-strings completion nil nil
94 string nil nil nil
))))
96 (let ((beg (field-beginning))
99 (delete-region beg end
)))
100 (if (not (or unchanged completed
))
101 ;; The case of the string changed, but that's all. We're not sure
102 ;; whether this is a unique completion or not, so try again using
103 ;; the real case (this shouldn't recurse again, because the next
104 ;; time try-completion will return either t or the exact string).
105 (minibuffer-do-completion)
107 ;; It did find a match. Do we match some possibility exactly now?
108 (let ((exact (test-completion (field-string)
109 minibuffer-completion-table
110 minibuffer-completion-predicate
)))
114 (minibuffer--maybe-completion-help)
118 ;; If the last exact completion and this one were the same,
119 ;; it means we've already given a "Complete but not unique"
120 ;; message and the user's hit TAB again, so now we give him help.
121 (if (eq this-command last-command
)
122 (minibuffer-completion-help))
125 (defun minibuffer-complete ()
126 "Complete the minibuffer contents as far as possible.
127 Return nil if there is no valid completion, else t.
128 If no characters can be completed, display a list of possible completions.
129 If you repeat this command after it displayed such a list,
130 scroll the window of possible completions."
132 ;; If the previous command was not this,
133 ;; mark the completion buffer obsolete.
134 (unless (eq this-command last-command
)
135 (setq minibuffer-scroll-window nil
))
137 (let ((window minibuffer-scroll-window
))
138 ;; If there's a fresh completion window with a live buffer,
139 ;; and this command is repeated, scroll that window.
140 (if (window-live-p window
)
141 (with-current-buffer (window-buffer window
)
142 (if (pos-visible-in-window-p (point-max) window
)
143 ;; If end is in view, scroll up to the beginning.
144 (set-window-start window
(point-min) nil
)
145 ;; Else scroll down one screen.
146 (scroll-other-window))
149 (let ((i (minibuffer-do-completion)))
152 (1 (goto-char (field-end))
153 (minibuffer-message "Sole completion")
155 (3 (goto-char (field-end))
156 (minibuffer-message "Complete, but not unique")
160 (defun minibuffer-complete-and-exit ()
161 "If the minibuffer contents is a valid completion then exit.
162 Otherwise try to complete it. If completion leads to a valid completion,
163 a repetition of this command will exit."
166 ;; Allow user to specify null string
167 ((= (field-beginning) (field-end)) (exit-minibuffer))
168 ((test-completion (field-string)
169 minibuffer-completion-table
170 minibuffer-completion-predicate
)
171 (when completion-ignore-case
172 ;; Fixup case of the field, if necessary.
173 (let* ((string (field-string))
174 (compl (try-completion string
175 minibuffer-completion-table
176 minibuffer-completion-predicate
)))
177 (when (and (stringp compl
)
178 ;; If it weren't for this piece of paranoia, I'd replace
179 ;; the whole thing with a call to complete-do-completion.
180 (= (length string
) (length compl
)))
181 (let ((beg (field-beginning))
185 (delete-region beg end
)))))
188 ((eq minibuffer-completion-confirm
'confirm-only
)
189 ;; The user is permitted to exit with an input that's rejected
190 ;; by test-completion, but at the condition to confirm her choice.
191 (if (eq last-command this-command
)
193 (minibuffer-message "Confirm")
197 ;; Call do-completion, but ignore errors.
198 (let ((i (condition-case nil
199 (minibuffer-do-completion)
202 ((1 3) (exit-minibuffer))
203 (4 (if (not minibuffer-completion-confirm
)
205 (minibuffer-message "Confirm")
209 (defun minibuffer-complete-word ()
210 "Complete the minibuffer contents at most a single word.
211 After one word is completed as much as possible, a space or hyphen
212 is added, provided that matches some possible completion.
213 Return nil if there is no valid completion, else t."
215 (let* ((beg (field-beginning))
216 (string (buffer-substring beg
(point)))
217 (completion (try-completion string
218 minibuffer-completion-table
219 minibuffer-completion-predicate
)))
222 (ding) (minibuffer-message "No match") nil
)
223 ((eq t completion
) nil
) ;Exact and unique match.
225 ;; Completing a single word is actually more difficult than completing
226 ;; as much as possible, because we first have to find the "current
227 ;; position" in `completion' in order to find the end of the word
228 ;; we're completing. Normally, `string' is a prefix of `completion',
229 ;; which makes it trivial to find the position, but with fancier
230 ;; completion (plus env-var expansion, ...) `completion' might not
231 ;; look anything like `string' at all.
233 (when minibuffer-completing-file-name
234 ;; In order to minimize the problem mentioned above, let's try to
235 ;; reduce the different between `string' and `completion' by
236 ;; mirroring some of the work done in read-file-name-internal.
237 (let ((substituted (condition-case nil
238 ;; Might fail when completing an env-var.
239 (substitute-in-file-name string
)
241 (unless (eq string substituted
)
242 (setq string substituted
)
245 (delete-region beg end
)))))
247 ;; Make buffer (before point) contain the longest match
248 ;; of `string's tail and `completion's head.
249 (let* ((startpos (max 0 (- (length string
) (length completion
))))
250 (length (- (length string
) startpos
)))
251 (while (and (> length
0)
252 (not (eq t
(compare-strings string startpos nil
254 completion-ignore-case
))))
255 (setq startpos
(1+ startpos
))
256 (setq length
(1- length
)))
258 (setq string
(substring string startpos
))
259 (delete-region beg
(+ beg startpos
)))
261 ;; Now `string' is a prefix of `completion'.
263 ;; If completion finds next char not unique,
264 ;; consider adding a space or a hyphen.
265 (when (= (length string
) (length completion
))
266 (let ((exts '(" " "-"))
268 (while (and exts
(not (stringp tem
)))
269 (setq tem
(try-completion (concat string
(pop exts
))
270 minibuffer-completion-table
271 minibuffer-completion-predicate
)))
272 (if (stringp tem
) (setq completion tem
))))
274 (if (= (length string
) (length completion
))
275 ;; If got no characters, print help for user.
277 (if completion-auto-help
(minibuffer-completion-help))
279 ;; Otherwise insert in minibuffer the chars we got.
280 (if (string-match "\\W" completion
(length string
))
281 ;; First find first word-break in the stuff found by completion.
282 ;; i gets index in string of where to stop completing.
283 (setq completion
(substring completion
0 (match-end 0))))
285 (if (and (eq ?
/ (aref completion
(1- (length completion
))))
286 (eq ?
/ (char-after)))
287 (setq completion
(substring completion
0 (1- (length completion
)))))
291 (delete-region beg pos
)
294 (defun minibuffer-complete-insert-strings (strings)
295 "Insert a list of STRINGS into the current buffer.
296 Uses columns to keep the listing readable but compact.
297 It also eliminates runs of equal strings."
298 (when (consp strings
)
299 (let* ((length (apply 'max
302 (+ (length (car s
)) (length (cadr s
)))
305 (window (get-buffer-window (current-buffer) 0))
306 (wwidth (if window
(1- (window-width window
)) 79))
308 ;; At least 2 columns; at least 2 spaces between columns.
309 (max 2 (/ wwidth
(+ 2 length
)))
310 ;; Don't allocate more columns than we can fill.
311 ;; Windows can't show less than 3 lines anyway.
312 (max 1 (/ (length strings
) 2))))
313 (colwidth (/ wwidth columns
))
316 ;; The insertion should be "sensible" no matter what choices were made
317 ;; for the parameters above.
318 (dolist (str strings
)
319 (unless (equal laststring str
) ; Remove (consecutive) duplicates.
320 (setq laststring str
)
323 (setq column
(+ column colwidth
))
324 ;; Leave the space unpropertized so that in the case we're
325 ;; already past the goal column, there is still
326 ;; a space displayed.
327 (set-text-properties (- (point) 1) (point)
328 ;; We can't just set tab-width, because
329 ;; completion-setup-function will kill all
330 ;; local variables :-(
331 `(display (space :align-to
,column
))))
332 (when (< wwidth
(+ (max colwidth
334 (+ (length (car str
)) (length (cadr str
)))
337 (delete-char -
2) (insert "\n") (setq column
0))
338 (if (not (consp str
))
339 (put-text-property (point) (progn (insert str
) (point))
340 'mouse-face
'highlight
)
341 (put-text-property (point) (progn (insert (car str
)) (point))
342 'mouse-face
'highlight
)
343 (put-text-property (point) (progn (insert (cadr str
)) (point))
344 'mouse-face nil
)))))))
346 (defvar completion-common-substring
)
348 (defun display-completion-list (completions &optional common-substring
)
349 "Display the list of completions, COMPLETIONS, using `standard-output'.
350 Each element may be just a symbol or string
351 or may be a list of two strings to be printed as if concatenated.
352 If it is a list of two strings, the first is the actual completion
353 alternative, the second serves as annotation.
354 `standard-output' must be a buffer.
355 The actual completion alternatives, as inserted, are given `mouse-face'
356 properties of `highlight'.
357 At the end, this runs the normal hook `completion-setup-hook'.
358 It can find the completion buffer in `standard-output'.
359 The optional second arg COMMON-SUBSTRING is a string.
360 It is used to put faces, `completions-first-difference' and
361 `completions-common-part' on the completion buffer. The
362 `completions-common-part' face is put on the common substring
363 specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil
364 and the current buffer is not the minibuffer, the faces are not put.
365 Internally, COMMON-SUBSTRING is bound to `completion-common-substring'
366 during running `completion-setup-hook'."
367 (if (not (bufferp standard-output
))
368 ;; This *never* (ever) happens, so there's no point trying to be clever.
370 (let ((standard-output (current-buffer))
371 (completion-setup-hook nil
))
372 (display-completion-list completions
))
373 (princ (buffer-string)))
375 (with-current-buffer standard-output
376 (goto-char (point-max))
377 (if (null completions
)
378 (insert "There are no possible completions of what you have typed.")
380 (insert "Possible completions are:\n")
381 (minibuffer-complete-insert-strings completions
))))
382 (let ((completion-common-substring common-substring
))
383 (run-hooks 'completion-setup-hook
))
386 (defun minibuffer-completion-help ()
387 "Display a list of possible completions of the current minibuffer contents."
389 (message "Making completion list...")
390 (let* ((string (field-string))
391 (completions (all-completions
393 minibuffer-completion-table
394 minibuffer-completion-predicate
398 (or (cdr completions
) (not (equal (car completions
) string
))))
399 (with-output-to-temp-buffer "*Completions*"
400 (display-completion-list (sort completions
'string-lessp
)))
402 ;; If there are no completions, or if the current input is already the
403 ;; only possible completion, then hide (previous&stale) completions.
404 (let ((window (and (get-buffer "*Completions*")
405 (get-buffer-window "*Completions*" 0))))
406 (when (and (window-live-p window
) (window-dedicated-p window
))
408 (delete-window window
)
409 (error (iconify-frame (window-frame window
))))))
412 (if completions
"Sole completion" "No completions")))
415 (defun exit-minibuffer ()
416 "Terminate this minibuffer argument."
418 ;; If the command that uses this has made modifications in the minibuffer,
419 ;; we don't want them to cause deactivation of the mark in the original
421 ;; A better solution would be to make deactivate-mark buffer-local
422 ;; (or to turn it into a list of buffers, ...), but in the mean time,
423 ;; this should do the trick in most cases.
424 (setq deactivate_mark nil
)
427 (defun self-insert-and-exit ()
428 "Terminate minibuffer input."
430 (if (characterp last-command-char
)
431 (call-interactively 'self-insert-command
)
435 (provide 'minibuffer
)
436 ;;; minibuffer.el ends here