Mercurial > emacs
comparison lisp/minibuffer.el @ 93885:6c6216b3b878
* lisp/minibuffer.el: New file.
* src/minibuf.c (last_exact_completion): Remove variable.
(Fdelete_minibuffer_contents, do_completion, Fminibuffer_complete)
(complete_and_exit_1, complete_and_exit_2)
(Fminibuffer_complete_and_exit, Fminibuffer_complete_word)
(Fdisplay_completion_list, display_completion_list_1)
(Fminibuffer_completion_help, Fself_insert_and_exit)
(Fexit_minibuffer, Fminibuffer_message): Move functions to minibuffer.el.
(syms_of_minibuf): Remove corresponding initializations.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 09 Apr 2008 03:34:19 +0000 |
parents | |
children | dfe13eac745b |
comparison
equal
deleted
inserted
replaced
93884:b4877813e2df | 93885:6c6216b3b878 |
---|---|
1 ;;; minibuffer.el --- Minibuffer completion functions | |
2 | |
3 ;; Copyright (C) 2008 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
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. | |
13 | |
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. | |
18 | |
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/>. | |
21 | |
22 ;;; Commentary: | |
23 | |
24 ;; TODO: | |
25 ;; - merge do-completion and complete-word | |
26 ;; - move all I/O out of do-completion | |
27 | |
28 ;;; Code: | |
29 | |
30 (eval-when-compile (require 'cl)) | |
31 | |
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. | |
39 (message nil) | |
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))) | |
44 (unwind-protect | |
45 (progn | |
46 (overlay-put ol 'after-string message) | |
47 (sit-for (or minibuffer-message-timeout 1000000))) | |
48 (delete-overlay ol)))) | |
49 | |
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))) | |
54 | |
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." | |
58 (delete-field)) | |
59 | |
60 (defun minibuffer--maybe-completion-help () | |
61 (if completion-auto-help | |
62 (minibuffer-completion-help) | |
63 (minibuffer-message "Next char not unique"))) | |
64 | |
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. | |
70 | |
71 CEM | |
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) | |
83 (cond | |
84 ((null completion) | |
85 (ding) (minibuffer-message "No match") 0) | |
86 ((eq t completion) 1) ;Exact and unique match. | |
87 (t | |
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 | |
92 string nil nil t)))) | |
93 (unchanged (eq t (compare-strings completion nil nil | |
94 string nil nil nil)))) | |
95 (unless unchanged | |
96 (let ((beg (field-beginning)) | |
97 (end (point))) | |
98 (insert completion) | |
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) | |
106 | |
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))) | |
111 (cond | |
112 ((not exact) | |
113 (if completed 5 | |
114 (minibuffer--maybe-completion-help) | |
115 6)) | |
116 (completed 4) | |
117 (t | |
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)) | |
123 3))))))))) | |
124 | |
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." | |
131 (interactive) | |
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)) | |
136 | |
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)) | |
147 nil) | |
148 | |
149 (let ((i (minibuffer-do-completion))) | |
150 (case i | |
151 (0 nil) | |
152 (1 (goto-char (field-end)) | |
153 (minibuffer-message "Sole completion") | |
154 t) | |
155 (3 (goto-char (field-end)) | |
156 (minibuffer-message "Complete, but not unique") | |
157 t) | |
158 (t t)))))) | |
159 | |
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." | |
164 (interactive) | |
165 (cond | |
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)) | |
182 (end (field-end))) | |
183 (goto-char end) | |
184 (insert compl) | |
185 (delete-region beg end))))) | |
186 (exit-minibuffer)) | |
187 | |
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) | |
192 (exit-minibuffer) | |
193 (minibuffer-message "Confirm") | |
194 nil)) | |
195 | |
196 (t | |
197 ;; Call do-completion, but ignore errors. | |
198 (let ((i (condition-case nil | |
199 (minibuffer-do-completion) | |
200 (error 1)))) | |
201 (case i | |
202 ((1 3) (exit-minibuffer)) | |
203 (4 (if (not minibuffer-completion-confirm) | |
204 (exit-minibuffer) | |
205 (minibuffer-message "Confirm") | |
206 nil)) | |
207 (t nil)))))) | |
208 | |
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." | |
214 (interactive) | |
215 (let* ((beg (field-beginning)) | |
216 (string (buffer-substring beg (point))) | |
217 (completion (try-completion string | |
218 minibuffer-completion-table | |
219 minibuffer-completion-predicate))) | |
220 (cond | |
221 ((null completion) | |
222 (ding) (minibuffer-message "No match") nil) | |
223 ((eq t completion) nil) ;Exact and unique match. | |
224 (t | |
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. | |
232 | |
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) | |
240 (error string)))) | |
241 (unless (eq string substituted) | |
242 (setq string substituted) | |
243 (let ((end (point))) | |
244 (insert substituted) | |
245 (delete-region beg end))))) | |
246 | |
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 | |
253 completion 0 length | |
254 completion-ignore-case)))) | |
255 (setq startpos (1+ startpos)) | |
256 (setq length (1- length))) | |
257 | |
258 (setq string (substring string startpos)) | |
259 (delete-region beg (+ beg startpos))) | |
260 | |
261 ;; Now `string' is a prefix of `completion'. | |
262 | |
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 '(" " "-")) | |
267 tem) | |
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)))) | |
273 | |
274 (if (= (length string) (length completion)) | |
275 ;; If got no characters, print help for user. | |
276 (progn | |
277 (if completion-auto-help (minibuffer-completion-help)) | |
278 nil) | |
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)))) | |
284 | |
285 (if (and (eq ?/ (aref completion (1- (length completion)))) | |
286 (eq ?/ (char-after))) | |
287 (setq completion (substring completion 0 (1- (length completion))))) | |
288 | |
289 (let ((pos (point))) | |
290 (insert completion) | |
291 (delete-region beg pos) | |
292 t)))))) | |
293 | |
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 | |
300 (mapcar (lambda (s) | |
301 (if (consp s) | |
302 (+ (length (car s)) (length (cadr s))) | |
303 (length s))) | |
304 strings))) | |
305 (window (get-buffer-window (current-buffer) 0)) | |
306 (wwidth (if window (1- (window-width window)) 79)) | |
307 (columns (min | |
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)) | |
314 (column 0) | |
315 (laststring nil)) | |
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) | |
321 (unless (bolp) | |
322 (insert " \t") | |
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 | |
333 (if (consp str) | |
334 (+ (length (car str)) (length (cadr str))) | |
335 (length str))) | |
336 column)) | |
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))))))) | |
345 | |
346 (defvar completion-common-substring) | |
347 | |
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. | |
369 (with-temp-buffer | |
370 (let ((standard-output (current-buffer)) | |
371 (completion-setup-hook nil)) | |
372 (display-completion-list completions)) | |
373 (princ (buffer-string))) | |
374 | |
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.") | |
379 | |
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)) | |
384 nil) | |
385 | |
386 (defun minibuffer-completion-help () | |
387 "Display a list of possible completions of the current minibuffer contents." | |
388 (interactive) | |
389 (message "Making completion list...") | |
390 (let* ((string (field-string)) | |
391 (completions (all-completions | |
392 string | |
393 minibuffer-completion-table | |
394 minibuffer-completion-predicate | |
395 t))) | |
396 (message nil) | |
397 (if (and completions | |
398 (or (cdr completions) (not (equal (car completions) string)))) | |
399 (with-output-to-temp-buffer "*Completions*" | |
400 (display-completion-list (sort completions 'string-lessp))) | |
401 | |
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)) | |
407 (condition-case () | |
408 (delete-window window) | |
409 (error (iconify-frame (window-frame window)))))) | |
410 (ding) | |
411 (minibuffer-message | |
412 (if completions "Sole completion" "No completions"))) | |
413 nil)) | |
414 | |
415 (defun exit-minibuffer () | |
416 "Terminate this minibuffer argument." | |
417 (interactive) | |
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 | |
420 ;; buffer. | |
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) | |
425 (throw 'exit nil)) | |
426 | |
427 (defun self-insert-and-exit () | |
428 "Terminate minibuffer input." | |
429 (interactive) | |
430 (if (characterp last-command-char) | |
431 (call-interactively 'self-insert-command) | |
432 (ding)) | |
433 (exit-minibuffer)) | |
434 | |
435 (provide 'minibuffer) | |
436 ;;; minibuffer.el ends here |