1 ;;; minibuf.el --- Minibuffer functions for SXEmacs
3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems.
5 ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
7 ;; Author: Richard Mlynarik
9 ;; Maintainer: SXEmacs Development Team
10 ;; Keywords: internal, dumped
12 ;; This file is part of SXEmacs.
14 ;; SXEmacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; SXEmacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Synched up with: all the minibuffer history stuff is synched with
28 ;;; 19.30. Not sure about the rest.
32 ;; This file is dumped with SXEmacs.
34 ;; Written by Richard Mlynarik 2-Oct-92
36 ;; 06/11/1997 - Use char-(after|before) instead of
37 ;; (following|preceding)-char. -slb
41 (defgroup minibuffer nil
42 "Controling the behavior of the minibuffer."
46 (defcustom insert-default-directory t
47 "*Non-nil means when reading a filename start with default dir in minibuffer."
51 (defcustom minibuffer-history-uniquify t
52 "*Non-nil means when adding an item to a minibuffer history, remove
53 previous occurrences of the same item from the history list first,
54 rather than just consing the new element onto the front of the list."
58 (defvar minibuffer-completion-table nil
59 "Alist or obarray used for completion in the minibuffer.
60 This becomes the ALIST argument to `try-completion' and `all-completions'.
62 The value may alternatively be a function, which is given three arguments:
63 STRING, the current buffer contents;
64 PREDICATE, the predicate for filtering possible matches;
65 CODE, which says what kind of things to do.
66 CODE can be nil, t or `lambda'.
67 nil means to return the best completion of STRING, nil if there is none,
68 or t if it is already a unique completion.
69 t means to return a list of all possible completions of STRING.
70 `lambda' means to return t if STRING is a valid completion as it stands.")
72 (defvar minibuffer-completion-predicate nil
73 "Within call to `completing-read', this holds the PREDICATE argument.")
75 (defvar minibuffer-completion-confirm nil
76 "Non-nil => demand confirmation of completion before exiting minibuffer.")
78 (defcustom minibuffer-confirm-incomplete nil
79 "If true, then in contexts where completing-read allows answers which
80 are not valid completions, an extra RET must be typed to confirm the
81 response. This is helpful for catching typos, etc."
85 (defcustom completion-auto-help t
86 "*Non-nil means automatically provide help for invalid completion input."
90 (defcustom enable-recursive-minibuffers nil
91 "*Non-nil means to allow minibuffer commands while in the minibuffer.
92 More precisely, this variable makes a difference when the minibuffer window
93 is the selected window. If you are in some other window, minibuffer commands
94 are allowed even if a minibuffer is active."
98 (defcustom minibuffer-max-depth 1
99 ;; See comment in #'minibuffer-max-depth-exceeded
100 "*Global maximum number of minibuffers allowed;
101 compare to enable-recursive-minibuffers, which is only consulted when the
102 minibuffer is reinvoked while it is the selected window."
103 :type '(choice integer
104 (const :tag "Indefinite" nil))
107 ;; Moved to C. The minibuffer prompt must be setup before this is run
108 ;; and that can only be done from the C side.
109 ;(defvar minibuffer-setup-hook nil
110 ; "Normal hook run just after entry to minibuffer.")
112 ;; see comment at list-mode-hook.
113 (put 'minibuffer-setup-hook 'permanent-local t)
115 (defvar minibuffer-exit-hook nil
116 "Normal hook run just after exit from minibuffer.")
117 (put 'minibuffer-exit-hook 'permanent-local t)
119 (defvar minibuffer-help-form nil
120 "Value that `help-form' takes on inside the minibuffer.")
122 (defvar minibuffer-default nil
123 "Default value for minibuffer input.")
125 (defvar minibuffer-local-map
126 (let ((map (make-sparse-keymap 'minibuffer-local-map)))
128 "Default keymap to use when reading from the minibuffer.")
130 (defvar minibuffer-local-completion-map
131 (let ((map (make-sparse-keymap 'minibuffer-local-completion-map)))
132 (set-keymap-parents map (list minibuffer-local-map))
134 "Local keymap for minibuffer input with completion.")
136 (defvar minibuffer-local-must-match-map
137 (let ((map (make-sparse-keymap 'minibuffer-must-match-map)))
138 (set-keymap-parents map (list minibuffer-local-completion-map))
140 "Local keymap for minibuffer input with completion, for exact match.")
142 ;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
143 (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el
144 (define-key minibuffer-local-map "\r" 'exit-minibuffer)
145 (define-key minibuffer-local-map "\n" 'exit-minibuffer)
147 ;; Historical crock. Unused by anything but user code, if even that
148 ;(defvar minibuffer-local-ns-map
149 ; (let ((map (make-sparse-keymap 'minibuffer-local-ns-map)))
150 ; (set-keymap-parents map (list minibuffer-local-map))
152 ; "Local keymap for the minibuffer when spaces are not allowed.")
153 ;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer)
154 ;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer)
155 ;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit)
157 (define-key minibuffer-local-completion-map "\t" 'minibuffer-complete)
158 (define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
159 (define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help)
160 (define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit)
161 (define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit)
163 (define-key minibuffer-local-map "\M-n" 'next-history-element)
164 (define-key minibuffer-local-map "\M-p" 'previous-history-element)
165 (define-key minibuffer-local-map '[next] "\M-n")
166 (define-key minibuffer-local-map '[prior] "\M-p")
167 (define-key minibuffer-local-map "\M-r" 'previous-matching-history-element)
168 (define-key minibuffer-local-map "\M-s" 'next-matching-history-element)
169 (define-key minibuffer-local-must-match-map [next]
170 'next-complete-history-element)
171 (define-key minibuffer-local-must-match-map [prior]
172 'previous-complete-history-element)
174 ;; This is an experiment--make up and down arrows do history.
175 (define-key minibuffer-local-map [up] 'previous-history-element)
176 (define-key minibuffer-local-map [down] 'next-history-element)
177 (define-key minibuffer-local-completion-map [up] 'previous-history-element)
178 (define-key minibuffer-local-completion-map [down] 'next-history-element)
179 (define-key minibuffer-local-must-match-map [up] 'previous-history-element)
180 (define-key minibuffer-local-must-match-map [down] 'next-history-element)
182 (defvar read-expression-map (let ((map (make-sparse-keymap
183 'read-expression-map)))
184 (set-keymap-parents map
185 (list minibuffer-local-map))
186 (define-key map "\M-\t" 'lisp-complete-symbol)
188 "Minibuffer keymap used for reading Lisp expressions.")
190 (defvar read-shell-command-map
191 (let ((map (make-sparse-keymap 'read-shell-command-map)))
192 (set-keymap-parents map (list minibuffer-local-map))
193 (define-key map "\t" 'comint-dynamic-complete)
194 (define-key map "\M-\t" 'comint-dynamic-complete)
195 (define-key map "\M-?" 'comint-dynamic-list-completions)
197 "Minibuffer keymap used by `shell-command' and related commands.")
199 (defcustom use-dialog-box t
200 "*Variable controlling usage of the dialog box.
201 If nil, the dialog box will never be used, even in response to mouse events."
205 (defcustom minibuffer-electric-file-name-behavior t
206 "*If non-nil, slash and tilde in certain places cause immediate deletion.
207 These are the same places where this behavior would occur later on anyway,
208 in `substitute-in-file-name'."
212 ;; originally by Stig@hackvan.com
213 (defun minibuffer-electric-separator ()
215 (let ((c last-command-char))
216 (and minibuffer-electric-file-name-behavior
217 (eq c directory-sep-char)
218 (eq c (char-before (point)))
220 (goto-char (point-min))
221 (and (looking-at "/.+:~?[^/]*/.+")
222 (re-search-forward "^/.+:~?[^/]*" nil t)
224 (delete-region (point) (point-max))
227 (goto-char (point-min))
228 (and (looking-at ".+://[^/]*/.+")
229 (re-search-forward "^.+:/" nil t)
231 (delete-region (point) (point-max))
233 ;; permit `//hostname/path/to/file'
234 (not (eq (point) (1+ (point-min))))
235 ;; permit `http://url/goes/here'
236 (or (not (eq ?: (char-after (- (point) 2))))
237 (eq ?/ (char-after (point-min))))
238 (delete-region (point-min) (point)))
241 (defun minibuffer-electric-tilde ()
243 (and minibuffer-electric-file-name-behavior
244 (eq directory-sep-char (char-before (point)))
245 ;; permit URL's with //, for e.g. http://hostname/~user
246 (not (save-excursion (search-backward "//" nil t)))
247 (delete-region (point-min) (point)))
251 (defvar read-file-name-map
252 (let ((map (make-sparse-keymap 'read-file-name-map)))
253 (set-keymap-parents map (list minibuffer-local-completion-map))
254 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
255 (define-key map "~" 'minibuffer-electric-tilde)
259 (defvar read-file-name-must-match-map
260 (let ((map (make-sparse-keymap 'read-file-name-map)))
261 (set-keymap-parents map (list minibuffer-local-must-match-map))
262 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
263 (define-key map "~" 'minibuffer-electric-tilde)
267 (defun minibuffer-keyboard-quit ()
268 "Abort recursive edit.
269 If `zmacs-regions' is true, and the zmacs region is active in this buffer,
270 then this key deactivates the region without beeping."
272 (if (region-active-p)
273 ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
274 ;; deactivating the region. If it is inactive, beep.
276 (abort-recursive-edit)))
278 ;;;; Guts of minibuffer invocation
280 ;;#### The only things remaining in C are
281 ;; "Vminibuf_prompt" and the display junk
282 ;; "minibuf_prompt_width" and "minibuf_prompt_pix_width"
283 ;; Also "active_frame", though I suspect I could already
284 ;; hack that in Lisp if I could make any sense of the
285 ;; complete mess of frame/frame code in XEmacs.
286 ;; Vminibuf_prompt could easily be made Lisp-bindable.
287 ;; I suspect that minibuf_prompt*_width are actually recomputed
288 ;; by redisplay as needed -- or could be arranged to be so --
289 ;; and that there could be need for read-minibuffer-internal to
290 ;; save and restore them.
291 ;;#### The only other thing which read-from-minibuffer-internal does
292 ;; which we can't presently do in Lisp is move the frame cursor
293 ;; to the start of the minibuffer line as it returns. This is
294 ;; a rather nice touch and should be preserved -- probably by
295 ;; providing some Lisp-level mechanism (extension to cursor-in-echo-area ?)
299 ;; Like reset_buffer in FSF's buffer.c
300 ;; (Except that kill-all-local-variables doesn't nuke 'permanent-local
301 ;; variables -- we preserve them, reset_buffer doesn't.)
302 (defun reset-buffer (buffer)
303 (with-current-buffer buffer
304 ;(if (fboundp 'unlock-buffer) (unlock-buffer))
305 (kill-all-local-variables)
306 (setq buffer-read-only nil)
307 ;; don't let read only text yanked into the minibuffer
308 ;; permanently wedge it.
309 (make-local-variable 'inhibit-read-only)
310 (setq inhibit-read-only t)
312 ;(setq default-directory nil)
313 (setq buffer-file-name nil)
314 (setq buffer-file-truename nil)
315 (set-buffer-modified-p nil)
316 (setq buffer-backed-up nil)
317 (setq buffer-auto-save-file-name nil)
318 (set-buffer-dedicated-frame buffer nil)
321 (defvar minibuffer-history-variable 'minibuffer-history
322 "History list symbol to add minibuffer values to.
323 Each minibuffer output is added with
324 (set minibuffer-history-variable
325 (cons STRING (symbol-value minibuffer-history-variable)))")
326 (defvar minibuffer-history-position)
329 (defvar initial-minibuffer-history-position)
330 (defvar current-minibuffer-contents)
331 (defvar current-minibuffer-point)
334 (defvar minibuffer-prompt-stack nil)
336 (defcustom minibuffer-history-minimum-string-length nil
337 "*If this variable is non-nil, a string will not be added to the
338 minibuffer history if its length is less than that value."
339 :type '(choice (const :tag "Any" nil)
343 (define-error 'input-error "Keyboard input error")
345 (put 'input-error 'display-error
346 #'(lambda (error-object stream)
347 (princ (cadr error-object) stream)))
349 (defun read-from-minibuffer (prompt &optional initial-contents
355 "Read a string from the minibuffer, prompting with string PROMPT.
356 If optional second arg INITIAL-CONTENTS is non-nil, it is a string
357 to be inserted into the minibuffer before reading input.
358 If INITIAL-CONTENTS is (STRING . POSITION), the initial input
359 is STRING, but point is placed POSITION characters into the string.
360 Third arg KEYMAP is a keymap to use while reading;
361 if omitted or nil, the default is `minibuffer-local-map'.
362 If fourth arg READ is non-nil, then interpret the result as a lisp object
363 and return that object:
364 in other words, do `(car (read-from-string INPUT-STRING))'
365 Fifth arg HISTORY, if non-nil, specifies a history list
366 and optionally the initial position in the list.
367 It can be a symbol, which is the history list variable to use,
368 or it can be a cons cell (HISTVAR . HISTPOS).
369 In that case, HISTVAR is the history list variable to use,
370 and HISTPOS is the initial position (the position in the list
371 which INITIAL-CONTENTS corresponds to).
372 If HISTORY is `t', no history will be recorded.
373 Positions are counted starting from 1 at the beginning of the list.
374 Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table'
376 Seventh arg DEFAULT, if non-nil, will be returned when user enters
379 See also the variable `completion-highlight-first-word-only' for
380 control over completion display."
381 (if (and (not enable-recursive-minibuffers)
382 (> (minibuffer-depth) 0)
383 (eq (selected-window) (minibuffer-window)))
384 (error "Command attempted to use minibuffer while in minibuffer"))
386 (if (and minibuffer-max-depth
387 (> minibuffer-max-depth 0)
388 (>= (minibuffer-depth) minibuffer-max-depth))
389 (minibuffer-max-depth-exceeded))
391 ;; catch this error before the poor user has typed something...
393 (if (symbolp history)
395 (error "History list %S is unbound" history))
396 (or (boundp (car history))
397 (error "History list %S is unbound" (car history)))))
401 ;; XEmacs in -batch mode calls minibuffer: print the prompt.
402 (message "%s" (gettext prompt))
405 ;;#### Should this even be falling though to the code below?
406 ;;#### How does this stuff work now, anyway?
408 (let* ((dir default-directory)
409 (owindow (selected-window))
410 (oframe (selected-frame))
411 (window (minibuffer-window))
412 (buffer (if (eq (minibuffer-depth) 0)
413 (window-buffer window)
414 (get-buffer-create (format " *Minibuf-%d"
415 (minibuffer-depth)))))
416 (frame (window-frame window))
417 (mconfig (if (eq frame (selected-frame))
418 nil (current-window-configuration frame)))
419 (oconfig (current-window-configuration))
420 ;; dynamic scope sucks sucks sucks sucks sucks sucks.
421 ;; `M-x doctor' makes history a local variable, and thus
422 ;; our binding above is buffer-local and doesn't apply
423 ;; once we switch buffers!!!! We demand better scope!
425 (minibuffer-default default))
428 (set-buffer (reset-buffer buffer))
429 (setq default-directory dir)
430 (make-local-variable 'print-escape-newlines)
431 (setq print-escape-newlines t)
432 (make-local-variable 'current-minibuffer-contents)
433 (make-local-variable 'current-minibuffer-point)
434 (make-local-variable 'initial-minibuffer-history-position)
435 (setq current-minibuffer-contents ""
436 current-minibuffer-point 1)
437 (if (not minibuffer-smart-completion-tracking-behavior)
439 (make-local-variable 'mode-motion-hook)
442 (setq mode-motion-hook 'minibuffer-smart-mouse-tracker))
443 (make-local-variable 'mouse-track-click-hook)
444 (add-hook 'mouse-track-click-hook
445 'minibuffer-smart-maybe-select-highlighted-completion))
446 (set-window-buffer window buffer)
447 (select-window window)
448 (set-window-hscroll window 0)
449 (buffer-enable-undo buffer)
452 (if (consp initial-contents)
454 (insert (car initial-contents))
455 (goto-char (1+ (cdr initial-contents)))
456 (setq current-minibuffer-contents (car initial-contents)
457 current-minibuffer-point (cdr initial-contents)))
458 (insert initial-contents)
459 (setq current-minibuffer-contents initial-contents
460 current-minibuffer-point (point))))
461 (use-local-map (help-keymap-with-help-key
462 (or keymap minibuffer-local-map)
463 minibuffer-help-form))
464 (let ((mouse-grabbed-buffer
465 (and minibuffer-smart-completion-tracking-behavior
467 (current-prefix-arg current-prefix-arg)
468 ;; (help-form minibuffer-help-form)
469 (minibuffer-history-variable (cond ((not _history_)
475 (minibuffer-history-position (cond ((consp _history_)
479 (minibuffer-scroll-window owindow))
480 (setq initial-minibuffer-history-position
481 minibuffer-history-position)
483 (setq local-abbrev-table abbrev-table
485 ;; This is now run from read-minibuffer-internal
486 ;(if minibuffer-setup-hook
487 ; (run-hooks 'minibuffer-setup-hook))
491 (flet ((fmt-prompt-stack (p ps)
494 (fmt-prompt-stack (concat "[" (car ps) "]" p) (cdr ps)))))
495 (push prompt minibuffer-prompt-stack)
496 (setq prompt (fmt-prompt-stack prompt (cdr minibuffer-prompt-stack))))
501 (if (> (recursion-depth) (minibuffer-depth))
502 (let ((standard-output t)
504 (read-minibuffer-internal prompt))
505 (read-minibuffer-internal prompt))
506 (pop minibuffer-prompt-stack))))
508 ;; Translate an "abort" (throw 'exit 't)
512 (let* ((val (progn (set-buffer buffer)
513 (if minibuffer-exit-hook
514 (run-hooks 'minibuffer-exit-hook))
515 (if (and (eq (char-after (point-min)) nil)
519 (histval (if (and default (string= val ""))
525 (let ((v (read-from-string val)))
526 (if (< (cdr v) (length val))
528 (or (string-match "[ \t\n]*\\'" val (cdr v))
529 (error "Trailing garbage following expression"))))
531 ;; total total kludge
532 (if (stringp v) (setq v (list 'quote v)))
536 '(input-error "End of input before end of expression")))
537 (error (setq err e))))
538 ;; Add the value to the appropriate history list unless
539 ;; it's already the most recent element, or it's only
540 ;; two characters long.
541 (if (and (symbolp minibuffer-history-variable)
542 (boundp minibuffer-history-variable))
543 (let ((list (symbol-value minibuffer-history-variable)))
546 (and list (equal histval (car list)))
548 minibuffer-history-minimum-string-length
550 minibuffer-history-minimum-string-length))
551 (set minibuffer-history-variable
552 (if minibuffer-history-uniquify
553 (cons histval (remove histval list))
554 (cons histval list))))))
555 (if err (signal (car err) (cdr err)))
557 ;; stupid display code requires this for some reason
559 (buffer-disable-undo buffer)
560 (setq buffer-read-only nil)
563 ;; restore frame configurations
564 (if (and mconfig (frame-live-p oframe)
565 (eq frame (selected-frame)))
566 ;; if we changed frames (due to surrogate minibuffer),
567 ;; and we're still on the new frame, go back to the old one.
568 (select-frame oframe))
569 (if mconfig (set-window-configuration mconfig))
570 (set-window-configuration oconfig))))
573 (defun minibuffer-max-depth-exceeded ()
575 ;; This signals an error if an Nth minibuffer is invoked while N-1 are
576 ;; already active, whether the minibuffer window is selected or not.
577 ;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x,
578 ;; getting distracted, and clicking elsewhere) many many novice users have
579 ;; had the problem of having multiple minibuffers build up, even to the
580 ;; point of exceeding max-lisp-eval-depth. Since the variable
581 ;; enable-recursive-minibuffers historically/crockishly is only consulted
582 ;; when the minibuffer is currently active (like typing M-x M-x) it doesn't
583 ;; help in this situation.
585 ;; This routine also offers to edit .emacs for you to get rid of this
586 ;; complaint, like `disabled' commands do, since it's likely that non-novice
587 ;; users will be annoyed by this change, so we give them an easy way to get
588 ;; rid of it forever.
590 (beep t 'minibuffer-limit-exceeded)
592 "Minibuffer already active: abort it with `^]', enable new one with `n': ")
593 (let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work??
598 ((y-or-n-p "Enable recursive minibuffers for other sessions too? ")
599 ;; This is completely disgusting, but it's basically what novice.el
600 ;; does. This kind of thing should be generalized.
601 (setq minibuffer-max-depth nil)
605 (substitute-in-file-name custom-file)))
606 (goto-char (point-min))
607 (if (re-search-forward
608 (concat "^(setq minibuffer-max-depth "
609 #r"\([0-9]+\|'?nil\|'?()\))"
612 (delete-region (match-beginning 0 ) (match-end 0))
613 ;; Must have been disabled by default.
614 (goto-char (point-max)))
615 (insert"\n(setq minibuffer-max-depth nil)\n")
617 (message "Multiple minibuffers enabled")
620 (abort-recursive-edit))
622 (error "Minibuffer already active")))))
625 ;;;; Guts of minibuffer completion
628 ;; Used by minibuffer-do-completion
629 (defvar last-exact-completion nil)
631 (defun temp-minibuffer-message (m)
632 (let ((savemax (point-max)))
634 (goto-char (point-max))
637 (let ((inhibit-quit t))
639 (delete-region savemax (point-max))
640 ;; If the user types a ^G while we're in sit-for, then quit-flag
641 ;; gets set. In this case, we want that ^G to be interpreted
642 ;; as a normal character, and act just like typeahead.
643 (if (and quit-flag (not unread-command-event))
644 (setq unread-command-event (character-to-event (quit-char))
648 ;; Determines whether buffer-string is an exact completion
649 (defun exact-minibuffer-completion-p (buffer-string)
650 (cond ((not minibuffer-completion-table)
653 ((vectorp minibuffer-completion-table)
654 (let ((tem (intern-soft buffer-string
655 minibuffer-completion-table)))
657 (and (string-equal buffer-string "nil")
658 ;; intern-soft loses for 'nil
660 (mapatoms #'(lambda (s)
665 minibuffer-completion-table)
667 (if minibuffer-completion-predicate
668 (funcall minibuffer-completion-predicate
672 ((and (consp minibuffer-completion-table)
673 ;;#### Emacs-Lisp truly sucks!
674 ;; lambda, autoload, etc
675 (not (symbolp (car minibuffer-completion-table))))
676 (if (not completion-ignore-case)
677 (assoc buffer-string minibuffer-completion-table)
678 (let ((s (upcase buffer-string))
679 (tail minibuffer-completion-table)
682 (setq tem (car (car tail)))
683 (if (or (equal tem buffer-string)
685 (if tem (equal (upcase tem) s)))
688 (setq tail (cdr tail))))
691 (funcall minibuffer-completion-table
693 minibuffer-completion-predicate
697 ;; 0 'none no possible completion
698 ;; 1 'unique was already an exact and unique completion
699 ;; 3 'exact was already an exact (but nonunique) completion
700 ;; NOT USED 'completed-exact-unique completed to an exact and completion
701 ;; 4 'completed-exact completed to an exact (but nonunique) completion
702 ;; 5 'completed some completion happened
703 ;; 6 'uncompleted no completion happened
704 (defun minibuffer-do-completion-1 (buffer-string completion)
705 (cond ((not completion)
708 ;; exact and unique match
711 ;; It did find a match. Do we match some possibility exactly now?
712 (let ((completedp (not (string-equal completion buffer-string))))
715 ;; Some completion happened
718 (setq buffer-string completion)))
719 (if (exact-minibuffer-completion-p buffer-string)
720 ;; An exact completion was possible
722 ;; Since no callers need to know the difference, don't bother
723 ;; with this (potentially expensive) discrimination.
724 ;; (if (eq (try-completion completion
725 ;; minibuffer-completion-table
726 ;; minibuffer-completion-predicate)
728 ;; 'completed-exact-unique
732 ;; Not an exact match
738 (defun minibuffer-do-completion (buffer-string)
739 (let* ((completion (try-completion buffer-string
740 minibuffer-completion-table
741 minibuffer-completion-predicate))
742 (status (minibuffer-do-completion-1 buffer-string completion))
743 (last last-exact-completion))
744 (setq last-exact-completion nil)
745 (cond ((eq status 'none)
747 (ding nil 'no-completion)
748 (temp-minibuffer-message " [No match]"))
752 ;; It did find a match. Do we match some possibility exactly now?
753 (if (not (string-equal completion buffer-string))
755 ;; Some completion happened
758 (setq buffer-string completion)))
759 (cond ((eq status 'exact)
760 ;; If the last exact completion and this one were
761 ;; the same, it means we've already given a
762 ;; "Complete but not unique" message and that the
763 ;; user's hit TAB again, so now we give help.
764 (setq last-exact-completion completion)
765 (if (equal buffer-string last)
766 (minibuffer-completion-help)))
767 ((eq status 'uncompleted)
768 (if completion-auto-help
769 (minibuffer-completion-help)
770 (temp-minibuffer-message " [Next char not unique]")))
778 (defun completing-read (prompt table
779 &optional predicate require-match
780 initial-contents history default)
781 "Read a string in the minibuffer, with completion.
783 PROMPT is a string to prompt with; normally it ends in a colon and a space.
784 TABLE is an alist whose elements' cars are strings, or an obarray.
785 TABLE can also be a function which does the completion itself.
786 PREDICATE limits completion to a subset of TABLE.
787 See `try-completion' and `all-completions' for more details
788 on completion, TABLE, and PREDICATE.
790 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
791 the input is (or completes to) an element of TABLE or is null.
792 If it is also not t, Return does not exit if it does non-null completion.
793 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
794 If it is (STRING . POSITION), the initial input
795 is STRING, but point is placed POSITION characters into the string.
797 HISTORY, if non-nil, specifies a history list
798 and optionally the initial position in the list.
799 It can be a symbol, which is the history list variable to use,
800 or it can be a cons cell (HISTVAR . HISTPOS).
801 In that case, HISTVAR is the history list variable to use,
802 and HISTPOS is the initial position (the position in the list
803 which INITIAL-CONTENTS corresponds to).
804 If HISTORY is `t', no history will be recorded.
805 Positions are counted starting from 1 at the beginning of the list.
806 DEFAULT, if non-nil, will be returned when the user enters an empty
809 Completion ignores case if the ambient value of
810 `completion-ignore-case' is non-nil."
811 (let ((minibuffer-completion-table table)
812 (minibuffer-completion-predicate predicate)
813 (minibuffer-completion-confirm (if (eq require-match 't) nil t))
814 (last-exact-completion nil)
816 (setq ret (read-from-minibuffer prompt
818 (if (not require-match)
819 minibuffer-local-completion-map
820 minibuffer-local-must-match-map)
825 (if (and (string= ret "")
831 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
832 ;;;; Minibuffer completion commands ;;;;
833 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
836 (defun minibuffer-complete ()
837 "Complete the minibuffer contents as far as possible.
838 Return nil if there is no valid completion, else t.
839 If no characters can be completed, display a list of possible completions.
840 If you repeat this command after it displayed such a list,
841 scroll the window of possible completions."
843 ;; If the previous command was not this, then mark the completion
845 (or (eq last-command this-command)
846 (setq minibuffer-scroll-window nil))
847 (let ((window minibuffer-scroll-window))
848 (if (and window (windowp window) (window-buffer window)
849 (buffer-name (window-buffer window)))
850 ;; If there's a fresh completion window with a live buffer
851 ;; and this command is repeated, scroll that window.
852 (let ((obuf (current-buffer)))
855 (set-buffer (window-buffer window))
856 (if (pos-visible-in-window-p (point-max) window)
857 ;; If end is in view, scroll up to the beginning.
858 (set-window-start window (point-min))
859 ;; Else scroll down one frame.
860 (scroll-other-window)))
863 (let ((status (minibuffer-do-completion (buffer-string))))
864 (if (eq status 'none)
867 (cond ((eq status 'unique)
868 (temp-minibuffer-message
869 " [Sole completion]"))
871 (temp-minibuffer-message
872 " [Complete, but not unique]")))
876 (defun minibuffer-complete-and-exit ()
877 "Complete the minibuffer contents, and maybe exit.
878 Exit if the name is valid with no completion needed.
879 If name was completed to a valid match,
880 a repetition of this command will exit."
882 (if (= (point-min) (point-max))
883 ;; Crockishly allow user to specify null string
885 (let ((buffer-string (buffer-string)))
886 ;; Short-cut -- don't call minibuffer-do-completion if we already
887 ;; have an (possibly nonunique) exact completion.
888 (if (exact-minibuffer-completion-p buffer-string)
890 (let ((status (minibuffer-do-completion buffer-string)))
891 (if (or (eq status 'unique)
893 (if (or (eq status 'completed-exact)
894 (eq status 'completed-exact-unique))
895 (if minibuffer-completion-confirm
896 (progn (temp-minibuffer-message " [Confirm]")
899 (throw 'exit nil)))))
902 (defun self-insert-and-exit ()
903 "Terminate minibuffer input."
905 (self-insert-command 1)
908 (defun exit-minibuffer ()
909 "Terminate this minibuffer argument.
910 If minibuffer-confirm-incomplete is true, and we are in a completing-read
911 of some kind, and the contents of the minibuffer is not an existing
912 completion, requires an additional RET before the minibuffer will be exited
913 \(assuming that RET was the character that invoked this command:
914 the character in question must be typed again)."
916 (if (not minibuffer-confirm-incomplete)
918 (let ((buffer-string (buffer-string)))
919 (if (exact-minibuffer-completion-p buffer-string)
921 (let ((completion (if (not minibuffer-completion-table)
923 (try-completion buffer-string
924 minibuffer-completion-table
925 minibuffer-completion-predicate))))
926 (if (or (eq completion 't)
927 ;; Crockishly allow user to specify null string
928 (string-equal buffer-string ""))
930 (if completion ;; rewritten for I18N3 snarfing
931 (temp-minibuffer-message " [incomplete; confirm]")
932 (temp-minibuffer-message " [no completions; confirm]"))
933 (let ((event (let ((inhibit-quit t))
936 (setq quit-flag nil)))))
937 (cond ((equal event last-command-event)
939 ((equal (quit-char) (event-to-character event))
942 (dispatch-event event)))))
944 ;;;; minibuffer-complete-word
947 ;;;#### I think I have done this correctly; it certainly is simpler
948 ;;;#### than what the C code seemed to be trying to do.
949 (defun minibuffer-complete-word ()
950 "Complete the minibuffer contents at most a single word.
951 After one word is completed as much as possible, a space or hyphen
952 is added, provided that matches some possible completion.
953 Return nil if there is no valid completion, else t."
955 (let* ((buffer-string (buffer-string))
956 (completion (try-completion buffer-string
957 minibuffer-completion-table
958 minibuffer-completion-predicate))
959 (status (minibuffer-do-completion-1 buffer-string completion)))
960 (cond ((eq status 'none)
961 (ding nil 'no-completion)
962 (temp-minibuffer-message " [No match]")
965 ;; New message, only in this new Lisp code
966 (temp-minibuffer-message " [Sole completion]")
969 (cond ((or (eq status 'uncompleted)
971 (let ((foo #'(lambda (s)
974 (concat buffer-string s)
975 minibuffer-completion-table
976 minibuffer-completion-predicate)
978 (goto-char (point-max))
983 (char last-command-char))
984 ;; Try to complete by adding a word-delimiter
985 (or (and (characterp char) (> char 0)
986 (funcall foo (char-to-string char)))
987 (and (not (eq char ?\ ))
989 (and (not (eq char ?\-))
992 (if completion-auto-help
993 (minibuffer-completion-help)
994 ;; New message, only in this new Lisp code
995 ;; rewritten for I18N3 snarfing
996 (if (eq status 'exact)
997 (temp-minibuffer-message
998 " [Complete, but not unique]")
999 (temp-minibuffer-message " [Ambiguous]")))
1004 ;; First word-break in stuff found by completion
1005 (goto-char (point-min))
1006 (let ((len (length buffer-string))
1008 (if (and (< len (length completion))
1013 (upcase (aref buffer-string n))
1014 (upcase (aref completion n)))
1016 (throw 'match nil)))
1019 (goto-char (point-min))
1021 (re-search-forward "\\W" nil t)))
1022 (delete-region (point) (point-max))
1023 (goto-char (point-max))))
1027 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1028 ;;;; "Smart minibuffer" hackery ;;;;
1029 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1031 ;;; ("Kludgy minibuffer hackery" is perhaps a better name)
1033 ;; This works by setting `mouse-grabbed-buffer' to the minibuffer,
1034 ;; defining button2 in the minibuffer keymap to
1035 ;; `minibuffer-smart-select-highlighted-completion', and setting the
1036 ;; mode-motion-hook of the minibuffer to `minibuffer-mouse-tracker'.
1037 ;; By setting `mouse-grabbed-buffer', the minibuffer's keymap and
1038 ;; mode-motion-hook apply (for mouse motion and presses) no matter
1039 ;; what buffer the mouse is over. Then, `minibuffer-mouse-tracker'
1040 ;; examines the text under the mouse looking for something that looks
1041 ;; like a completion, and causes it to be highlighted, and
1042 ;; `minibuffer-smart-select-highlighted-completion' looks for a
1043 ;; flagged completion under the mouse and inserts it. This has the
1044 ;; following advantages:
1046 ;; -- filenames and such in any buffer can be inserted by clicking,
1047 ;; not just completions
1049 ;; but the following disadvantages:
1051 ;; -- unless you're aware of the "filename in any buffer" feature,
1052 ;; the fact that strings in arbitrary buffers get highlighted appears
1054 ;; -- mouse motion can cause ange-ftp actions -- bad bad bad.
1056 ;; There's some hackery in minibuffer-mouse-tracker to try to avoid the
1057 ;; ange-ftp stuff, but it doesn't work.
1060 (defcustom minibuffer-smart-completion-tracking-behavior nil
1061 "*If non-nil, look for completions under mouse in all buffers.
1062 This allows you to click on something that looks like a completion
1063 and have it selected, regardless of what buffer it is in.
1065 This is not enabled by default because
1067 -- The \"mysterious\" highlighting in normal buffers is confusing to
1068 people not expecting it, and looks like a bug
1069 -- If ange-ftp is enabled, this tracking sometimes causes ange-ftp
1070 action as a result of mouse motion, which is *bad bad bad*.
1071 Hopefully this bug will be fixed at some point."
1075 (defun minibuffer-smart-mouse-tracker (event)
1076 ;; Used as the mode-motion-hook of the minibuffer window, which is the
1077 ;; value of `mouse-grabbed-buffer' while the minibuffer is active. If
1078 ;; the word under the mouse is a valid minibuffer completion, then it
1081 ;; We do some special voodoo when we're reading a pathname, because
1082 ;; the way filename completion works is funny. Possibly there's some
1083 ;; more general way this could be dealt with...
1085 ;; We do some further voodoo when reading a pathname that is an
1086 ;; ange-ftp or efs path, because causing FTP activity as a result of
1087 ;; mouse motion is a really bad time.
1089 (and minibuffer-smart-completion-tracking-behavior
1091 ;; avoid conflict with display-completion-list extents
1092 (not (extent-at (event-point event)
1093 (event-buffer event)
1095 (let ((filename-kludge-p (eq minibuffer-completion-table
1096 'read-file-name-internal)))
1097 (mode-motion-highlight-internal
1099 #'(lambda () (default-mouse-track-beginning-of-word
1100 (if filename-kludge-p 'nonwhite t)))
1104 (default-mouse-track-end-of-word
1105 (if filename-kludge-p 'nonwhite t))
1106 (if (and (/= p (point)) minibuffer-completion-table)
1107 (setq string (buffer-substring p (point))))
1108 (if (string-match "\\`[ \t\n]*\\'" string)
1110 (if filename-kludge-p
1111 (setq string (minibuffer-smart-select-kludge-filename
1113 ;; try-completion bogusly returns a string even when
1114 ;; that string is complete if that string is also a
1115 ;; prefix for other completions. This means that we
1116 ;; can't just do the obvious thing, (eq t
1117 ;; (try-completion ...)).
1119 (if (and filename-kludge-p
1120 ;; #### evil evil evil evil
1121 (or (and (fboundp 'ange-ftp-ftp-path)
1122 (declare-fboundp (ange-ftp-ftp-path string)))
1123 (and (fboundp 'efs-ftp-path)
1124 (declare-fboundp (efs-ftp-path string)))))
1127 (try-completion string
1128 minibuffer-completion-table
1129 minibuffer-completion-predicate)))
1131 (and (equal comp string)
1132 (or (null minibuffer-completion-predicate)
1134 minibuffer-completion-predicate) ; ???
1135 (funcall minibuffer-completion-predicate
1137 minibuffer-completion-table)
1140 minibuffer-completion-table)
1142 (goto-char p))))))))))
1144 (defun minibuffer-smart-select-kludge-filename (string)
1146 (set-buffer mouse-grabbed-buffer) ; the minibuf
1147 (let ((kludge-string (concat (buffer-string) string)))
1148 (if (or (and (fboundp 'ange-ftp-ftp-path)
1149 (declare-fboundp (ange-ftp-ftp-path kludge-string)))
1150 (and (fboundp 'efs-ftp-path)
1151 (declare-fboundp (efs-ftp-path kludge-string))))
1152 ;; #### evil evil evil, but more so.
1154 (append-expand-filename (buffer-string) string)))))
1156 (defun minibuffer-smart-select-highlighted-completion (event)
1157 "Select the highlighted text under the mouse as a minibuffer response.
1158 When the minibuffer is being used to prompt the user for a completion,
1159 any valid completions which are visible on the frame will highlight
1160 when the mouse moves over them. Clicking \\<minibuffer-local-map>\
1161 \\[minibuffer-smart-select-highlighted-completion] will select the
1162 highlighted completion under the mouse.
1164 If the mouse is clicked while not over a highlighted completion,
1165 then the global binding of \\[minibuffer-smart-select-highlighted-completion] \
1166 will be executed instead. In this\nway you can get at the normal global \
1167 behavior of \\[minibuffer-smart-select-highlighted-completion] as well as
1168 the special minibuffer behavior."
1170 (if minibuffer-smart-completion-tracking-behavior
1171 (minibuffer-smart-select-highlighted-completion-1 event t)
1172 (let ((command (lookup-key global-map
1173 (vector current-mouse-event))))
1174 (if command (call-interactively command)))))
1176 (defun minibuffer-smart-select-highlighted-completion-1 (event global-p)
1177 (let* ((filename-kludge-p (eq minibuffer-completion-table
1178 'read-file-name-internal))
1181 (evpoint (event-point event))
1182 (evextent (and evpoint (extent-at evpoint (event-buffer event)
1185 ;; avoid conflict with display-completion-list extents.
1186 ;; if we find one, do that behavior instead.
1187 (list-mode-item-selected-1 evextent event)
1189 (let* ((buffer (window-buffer (event-window event)))
1190 (p (event-point event))
1191 (extent (and p (extent-at p buffer 'mouse-face))))
1193 (if (not (and (extent-live-p extent)
1194 (eq (extent-object extent) (current-buffer))
1195 (not (extent-detached-p extent))))
1197 ;; ...else user has selected a highlighted completion.
1199 (buffer-substring (extent-start-position extent)
1200 (extent-end-position extent)))
1201 (if filename-kludge-p
1202 (setq completion (minibuffer-smart-select-kludge-filename
1204 ;; remove the extent so that it's not hanging around in
1206 (detach-extent extent)
1207 (set-buffer mouse-grabbed-buffer)
1209 (insert completion))))
1210 ;; we need to execute the command or do the throw outside of the
1212 (cond ((and command-p global-p)
1213 (let ((command (lookup-key global-map
1214 (vector current-mouse-event))))
1216 (call-interactively command)
1217 (if minibuffer-completion-table
1219 "Highlighted words are valid completions. You may select one.")
1220 (error "no completions")))))
1222 ;; things get confused if the minibuffer is terminated while
1224 (select-window (minibuffer-window))
1225 (if (and filename-kludge-p (file-directory-p completion))
1226 ;; if the user clicked middle on a directory name, display the
1227 ;; files in that directory.
1229 (goto-char (point-max))
1230 (minibuffer-completion-help))
1231 ;; otherwise, terminate input
1232 (throw 'exit nil)))))))
1234 (defun minibuffer-smart-maybe-select-highlighted-completion
1235 (event &optional click-count)
1236 "Like `minibuffer-smart-select-highlighted-completion' but does nothing if
1237 there is no completion (as opposed to executing the global binding). Useful
1238 as the value of `mouse-track-click-hook'."
1240 (minibuffer-smart-select-highlighted-completion-1 event nil))
1242 (define-key minibuffer-local-map 'button2
1243 'minibuffer-smart-select-highlighted-completion)
1246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1247 ;;;; Minibuffer History ;;;;
1248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1250 (defvar minibuffer-history '()
1251 "Default minibuffer history list.
1252 This is used for all minibuffer input except when an alternate history
1253 list is specified.")
1255 ;; Some other history lists:
1257 (defvar minibuffer-history-search-history '())
1258 (defvar function-history '())
1259 (defvar variable-history '())
1260 (defvar buffer-history '())
1261 (defvar shell-command-history '())
1262 (defvar file-name-history '())
1264 (defvar read-expression-history nil)
1266 (defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge
1267 "Non-nil when doing history operations on `command-history'.
1268 More generally, indicates that the history list being acted on
1269 contains expressions rather than strings.")
1271 (defun previous-matching-history-element (regexp n)
1272 "Find the previous history element that matches REGEXP.
1273 \(Previous history elements refer to earlier actions.)
1274 With prefix argument N, search for Nth previous match.
1275 If N is negative, find the next or Nth next match."
1277 (let ((enable-recursive-minibuffers t)
1278 (minibuffer-history-sexp-flag nil)
1279 (minibuffer-max-depth (and minibuffer-max-depth
1280 (1+ minibuffer-max-depth))))
1281 (if (eq 't (symbol-value minibuffer-history-variable))
1282 (error "History is not being recorded in this context"))
1283 (list (read-from-minibuffer "Previous element matching (regexp): "
1284 (car minibuffer-history-search-history)
1285 minibuffer-local-map
1287 'minibuffer-history-search-history)
1288 (prefix-numeric-value current-prefix-arg))))
1289 (let ((history (symbol-value minibuffer-history-variable))
1291 (pos minibuffer-history-position))
1293 (error "History is not being recorded in this context"))
1296 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
1298 (if (= pos 1) ;; rewritten for I18N3 snarfing
1299 (error "No later matching history item")
1300 (error "No earlier matching history item")))
1301 (if (string-match regexp
1302 (if minibuffer-history-sexp-flag
1303 (let ((print-level nil))
1304 (prin1-to-string (nth (1- pos) history)))
1305 (nth (1- pos) history)))
1306 (setq n (+ n (if (< n 0) 1 -1)))))
1307 (setq minibuffer-history-position pos)
1308 (setq current-minibuffer-contents (buffer-string)
1309 current-minibuffer-point (point))
1311 (let ((elt (nth (1- pos) history)))
1312 (insert (if minibuffer-history-sexp-flag
1313 (let ((print-level nil))
1314 (prin1-to-string elt))
1316 (goto-char (point-min)))
1317 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
1318 (eq (car (car command-history)) 'next-matching-history-element))
1319 (setq command-history (cdr command-history))))
1321 (defun next-matching-history-element (regexp n)
1322 "Find the next history element that matches REGEXP.
1323 \(The next history element refers to a more recent action.)
1324 With prefix argument N, search for Nth next match.
1325 If N is negative, find the previous or Nth previous match."
1327 (let ((enable-recursive-minibuffers t)
1328 (minibuffer-history-sexp-flag nil)
1329 (minibuffer-max-depth (and minibuffer-max-depth
1330 (1+ minibuffer-max-depth))))
1331 (if (eq t (symbol-value minibuffer-history-variable))
1332 (error "History is not being recorded in this context"))
1333 (list (read-from-minibuffer "Next element matching (regexp): "
1334 (car minibuffer-history-search-history)
1335 minibuffer-local-map
1337 'minibuffer-history-search-history)
1338 (prefix-numeric-value current-prefix-arg))))
1339 (previous-matching-history-element regexp (- n)))
1341 (defun next-history-element (n)
1342 "Insert the next element of the minibuffer history into the minibuffer."
1344 (if (eq 't (symbol-value minibuffer-history-variable))
1345 (error "History is not being recorded in this context"))
1347 (when (eq minibuffer-history-position
1348 initial-minibuffer-history-position)
1349 (setq current-minibuffer-contents (buffer-string)
1350 current-minibuffer-point (point)))
1351 (let ((narg (- minibuffer-history-position n))
1352 (minimum (if minibuffer-default -1 0)))
1353 ;; a weird special case here; when in repeat-complex-command, we're
1354 ;; trying to edit the top command, and minibuffer-history-position
1355 ;; points to 1, the next-to-top command. in this case, the top
1356 ;; command in the history is suppressed in favor of the one being
1357 ;; edited, and there is no more command below it, except maybe the
1359 (if (and (zerop narg) (eq minibuffer-history-position
1360 initial-minibuffer-history-position))
1361 (setq minimum (1+ minimum)))
1362 (cond ((< narg minimum)
1363 (error (if minibuffer-default
1364 "No following item in %s"
1365 "No following item in %s; no default available")
1366 minibuffer-history-variable))
1367 ((> narg (length (symbol-value minibuffer-history-variable)))
1368 (error "No preceding item in %s" minibuffer-history-variable)))
1370 (setq minibuffer-history-position narg)
1371 (if (eq narg initial-minibuffer-history-position)
1373 (insert current-minibuffer-contents)
1374 (goto-char current-minibuffer-point))
1375 (let ((elt (if (> narg 0)
1376 (nth (1- minibuffer-history-position)
1377 (symbol-value minibuffer-history-variable))
1378 minibuffer-default)))
1380 (if (not (stringp elt))
1381 (let ((print-level nil))
1383 (let ((print-readably t)
1384 (print-escape-newlines t))
1385 (prin1-to-string elt))
1386 (error (prin1-to-string elt))))
1388 ;; FSF has point-min here.
1389 (goto-char (point-max))))))
1391 (defun previous-history-element (n)
1392 "Insert the previous element of the minibuffer history into the minibuffer."
1394 (next-history-element (- n)))
1396 (defun next-complete-history-element (n)
1397 "Get next element of history which is a completion of minibuffer contents."
1399 (let ((point-at-start (point)))
1400 (next-matching-history-element
1401 (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
1402 ;; next-matching-history-element always puts us at (point-min).
1403 ;; Move to the position we were at before changing the buffer contents.
1404 ;; This is still sensical, because the text before point has not changed.
1405 (goto-char point-at-start)))
1407 (defun previous-complete-history-element (n)
1408 "Get previous element of history which is a completion of minibuffer contents."
1410 (next-complete-history-element (- n)))
1413 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1414 ;;;; reading various things from a minibuffer ;;;;
1415 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1417 (defun read-expression (prompt &optional initial-contents history default-value)
1418 "Return a Lisp object read using the minibuffer, prompting with PROMPT.
1419 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
1420 in the minibuffer before reading.
1421 Third arg HISTORY, if non-nil, specifies a history list.
1422 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1423 for history command, and as the value to return if the user enters the
1425 (let ((minibuffer-history-sexp-flag t)
1426 ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
1427 (minibuffer-completion-table nil))
1428 (read-from-minibuffer prompt
1432 (or history 'read-expression-history)
1433 lisp-mode-abbrev-table
1436 (defun read-string (prompt &optional initial-contents history default-value)
1437 "Return a string from the minibuffer, prompting with string PROMPT.
1438 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
1439 in the minibuffer before reading.
1440 Third arg HISTORY, if non-nil, specifies a history list.
1441 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1442 for history command, and as the value to return if the user enters the
1444 (let ((minibuffer-completion-table nil))
1445 (read-from-minibuffer prompt
1447 minibuffer-local-map
1448 nil history nil default-value)))
1450 (defun eval-minibuffer (prompt &optional initial-contents history default-value)
1451 "Return value of Lisp expression read using the minibuffer.
1452 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1453 is a string to insert in the minibuffer before reading.
1454 Third arg HISTORY, if non-nil, specifies a history list.
1455 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1456 for history command, and as the value to return if the user enters the
1458 (eval (read-expression prompt initial-contents history default-value)))
1460 ;; The name `command-history' is already taken
1461 (defvar read-command-history '())
1463 (defun read-command (prompt &optional default-value)
1464 "Read the name of a command and return as a symbol.
1465 Prompts with PROMPT. By default, return DEFAULT-VALUE."
1466 (intern (completing-read prompt obarray 'commandp t nil
1467 ;; 'command-history is not right here: that's a
1468 ;; list of evalable forms, not a history list.
1469 'read-command-history
1472 (defun read-function (prompt &optional default-value)
1473 "Read the name of a function and return as a symbol.
1474 Prompts with PROMPT. By default, return DEFAULT-VALUE."
1475 (intern (completing-read prompt obarray 'fboundp t nil
1476 'function-history default-value)))
1478 (defun read-variable (prompt &optional default-value)
1479 "Read the name of a user variable and return it as a symbol.
1480 Prompts with PROMPT. By default, return DEFAULT-VALUE.
1481 A user variable is one whose documentation starts with a `*' character."
1482 (intern (completing-read prompt obarray 'user-variable-p t nil
1484 (if (symbolp default-value)
1485 (symbol-name default-value)
1488 (defun read-buffer (prompt &optional default require-match)
1489 "Read the name of a buffer and return as a string.
1490 Prompts with PROMPT. Optional second arg DEFAULT is value to return if user
1491 enters an empty line. If optional third arg REQUIRE-MATCH is non-nil,
1492 only existing buffer names are allowed."
1493 (let ((prompt (if default
1494 (format "%s(default %s) "
1495 (gettext prompt) (if (bufferp default)
1496 (buffer-name default)
1499 (alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
1503 (setq result (completing-read prompt alist nil require-match
1505 (if (bufferp default)
1506 (buffer-name default)
1508 (cond ((not (equal result ""))
1510 ((not require-match)
1511 (setq result default)
1515 ((not (get-buffer default))
1518 (setq result default)
1520 (if (bufferp result)
1521 (buffer-name result)
1524 (defun read-number (prompt &optional integers-only default-value)
1525 "Read a number from the minibuffer, prompting with PROMPT.
1526 If optional second argument INTEGERS-ONLY is non-nil, accept
1528 If DEFAULT-VALUE is non-nil, return that if user enters an empty
1530 (let ((pred (if integers-only 'integerp 'numberp))
1532 (while (not (funcall pred num))
1533 (setq num (condition-case ()
1534 (let ((minibuffer-completion-table nil))
1535 (read-from-minibuffer
1536 prompt (if num (prin1-to-string num)) nil t
1537 nil nil default-value))
1539 (invalid-read-syntax nil)
1541 (or (funcall pred num) (beep)))
1544 (defun read-shell-command (prompt &optional initial-input history default-value)
1545 "Just like read-string, but uses read-shell-command-map:
1546 \\{read-shell-command-map}"
1547 (let ((minibuffer-completion-table nil))
1548 (read-from-minibuffer prompt initial-input read-shell-command-map
1549 nil (or history 'shell-command-history)
1550 nil default-value)))
1553 ;;; This read-file-name stuff probably belongs in files.el
1555 ;; Quote "$" as "$$" to get it past substitute-in-file-name
1556 (defun un-substitute-in-file-name (string)
1557 (let ((regexp "\\$")
1558 (olen (length string))
1561 (if (not (string-match regexp string))
1564 (while (string-match regexp string (match-end 0))
1566 (setq new (make-string (+ olen n) ?$))
1569 (setq ch (aref string o))
1571 (setq o (1+ o) n (1+ n))
1573 ;; already aset by make-string initial-value
1578 ;; Wrapper for `directory-files' for use in generating completion lists.
1579 ;; Generates output in the same format as `file-name-all-completions'.
1581 ;; The EFS replacement for `directory-files' doesn't support the FILES-ONLY
1582 ;; option, so it has to be faked. The listing cache will hopefully
1583 ;; improve the performance of this operation.
1584 (defun minibuf-directory-files (dir &optional match-regexp files-only)
1585 (let ((want-file (or (eq files-only nil) (eq files-only t)))
1586 (want-dirs (or (eq files-only nil) (not (eq files-only t)))))
1588 (mapcar (function (lambda (f)
1589 (if (file-directory-p (expand-file-name f dir))
1590 (and want-dirs (file-name-as-directory f))
1591 (and want-file f))))
1592 (delete "." (directory-files dir nil match-regexp))))))
1595 (defun read-file-name-2 (history prompt dir default
1596 must-match initial-contents
1599 (setq dir default-directory))
1600 (setq dir (abbreviate-file-name dir t))
1601 (let* ((insert (cond ((and (not insert-default-directory)
1602 (not initial-contents))
1605 (cons (un-substitute-in-file-name
1606 (concat dir initial-contents))
1609 (un-substitute-in-file-name dir))))
1611 ;; Hateful, broken, case-sensitive un*x
1612 ;;; (completing-read prompt
1618 ;; #### - this is essentially the guts of completing read.
1619 ;; There should be an elegant way to pass a pair of keymaps to
1620 ;; completing read, but this will do for now. All sins are
1622 (let ((minibuffer-completion-table completer)
1623 (minibuffer-completion-predicate dir)
1624 (minibuffer-completion-confirm (if (eq must-match 't)
1626 (last-exact-completion nil))
1627 (read-from-minibuffer prompt
1629 (if (not must-match)
1631 read-file-name-must-match-map)
1636 ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar"
1637 ;;; (let ((hist (cond ((not history) 'minibuffer-history)
1638 ;;; ((consp history) (car history))
1642 ;;; (not (eq hist 't))
1644 ;;; (equal (car-safe (symbol-value hist)) val))
1645 ;;; (let ((e (condition-case nil
1646 ;;; (expand-file-name val)
1648 ;;; (if (and e (not (equal e val)))
1649 ;;; (set hist (cons e (cdr (symbol-value hist))))))))
1652 (error "No file name specified"))
1654 (equal val (if (consp insert) (car insert) insert)))
1657 (substitute-in-file-name val)))))
1659 ;; #### this function should use minibuffer-completion-table
1660 ;; or something. But that is sloooooow.
1661 ;; #### all this shit needs better documentation!!!!!!!!
1662 (defun read-file-name-activate-callback (event extent dir-p)
1663 ;; used as the activate-callback of the filename list items
1664 ;; in the completion buffer, in place of default-choose-completion.
1665 ;; if a regular file was selected, we call default-choose-completion
1666 ;; (which just inserts the string in the minibuffer and calls
1667 ;; exit-minibuffer). If a directory was selected, we display
1668 ;; the contents of the directory.
1669 (let* ((file (extent-string extent))
1670 (completion-buf (extent-object extent))
1671 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
1673 (in-dir (file-name-directory (buffer-substring nil nil minibuf)))
1674 (full (expand-file-name file in-dir)))
1675 (if (not (file-directory-p full))
1676 (default-choose-completion event extent minibuf)
1677 (erase-buffer minibuf)
1678 (insert-string (file-name-as-directory
1679 (abbreviate-file-name full t)) minibuf)
1680 (reset-buffer completion-buf)
1681 (let ((standard-output completion-buf))
1682 (display-completion-list
1683 (minibuf-directory-files full nil (if dir-p 'directory))
1685 :reference-buffer minibuf
1686 :activate-callback 'read-file-name-activate-callback)
1687 (goto-char (point-min) completion-buf)))))
1689 (defun read-file-name-1 (type history prompt dir default
1690 must-match initial-contents
1692 (if (should-use-dialog-box-p)
1695 (apply #'make-dialog-box
1696 type `(:title ,(capitalize-string-as-title
1697 ;; Kludge: Delete ": " off the end.
1698 (replace-in-string prompt ": $" ""))
1699 ,@(and dir (list :initial-directory
1701 :file-must-exist ,must-match
1702 ,@(and initial-contents
1703 (list :initial-filename
1704 initial-contents))))))
1705 ;; hack -- until we implement reading a directory properly,
1706 ;; allow a file as indicating the directory it's in
1707 (if (and (eq completer 'read-directory-name-internal)
1708 (not (file-directory-p file)))
1709 (file-name-directory file)
1712 ;; this calls read-file-name-2
1713 (mouse-read-file-name-1 history prompt dir default must-match
1714 initial-contents completer)
1717 'minibuffer-setup-hook
1719 ;; #### SCREAM! Create a `file-system-ignore-case'
1720 ;; function, so this kind of stuff is generalized!
1721 (and (eq system-type 'windows-nt)
1722 (set (make-local-variable 'completion-ignore-case) t))
1724 (make-local-variable
1725 'completion-display-completion-list-function)
1726 #'(lambda (completions)
1727 (display-completion-list
1729 :user-data (not (eq completer 'read-file-name-internal))
1731 'read-file-name-activate-callback)))))
1732 (read-file-name-2 history prompt dir default must-match
1733 initial-contents completer)))
1735 (defun read-file-name (prompt
1736 &optional dir default must-match initial-contents
1738 "Read file name, prompting with PROMPT and completing in directory DIR.
1739 This will prompt with a dialog box if appropriate, according to
1740 `should-use-dialog-box-p'.
1741 Value is not expanded---you must call `expand-file-name' yourself.
1742 Value is subject to interpretation by `substitute-in-file-name' however.
1743 Default name to DEFAULT if user enters a null string.
1744 (If DEFAULT is omitted, the visited file name is used,
1745 except that if INITIAL-CONTENTS is specified, that combined with DIR is
1747 Fourth arg MUST-MATCH non-nil means require existing file's name.
1748 Non-nil and non-t means also require confirmation after completion.
1749 Fifth arg INITIAL-CONTENTS specifies text to start with. If this is not
1750 specified, and `insert-default-directory' is non-nil, DIR or the current
1751 directory will be used.
1752 Sixth arg HISTORY specifies the history list to use. Default is
1753 `file-name-history'.
1754 DIR defaults to current buffer's directory default."
1756 'file (or history 'file-name-history)
1757 prompt dir (or default
1758 (and initial-contents
1759 (abbreviate-file-name (expand-file-name
1760 initial-contents dir) t))
1761 (and buffer-file-truename
1762 (abbreviate-file-name buffer-file-name t)))
1763 must-match initial-contents
1764 ;; A separate function (not an anonymous lambda-expression)
1765 ;; and passed as a symbol because of disgusting kludges in various
1766 ;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...)
1767 'read-file-name-internal))
1769 (defun read-directory-name (prompt
1770 &optional dir default must-match initial-contents
1772 "Read directory name, prompting with PROMPT and completing in directory DIR.
1773 This will prompt with a dialog box if appropriate, according to
1774 `should-use-dialog-box-p'.
1775 Value is not expanded---you must call `expand-file-name' yourself.
1776 Value is subject to interpreted by substitute-in-file-name however.
1777 Default name to DEFAULT if user enters a null string.
1778 (If DEFAULT is omitted, the current buffer's default directory is used.)
1779 Fourth arg MUST-MATCH non-nil means require existing directory's name.
1780 Non-nil and non-t means also require confirmation after completion.
1781 Fifth arg INITIAL-CONTENTS specifies text to start with.
1782 Sixth arg HISTORY specifies the history list to use. Default is
1783 `file-name-history'.
1784 DIR defaults to current buffer's directory default."
1786 'directory (or history 'file-name-history)
1787 prompt dir (or default default-directory) must-match initial-contents
1788 'read-directory-name-internal))
1791 ;; Environment-variable and ~username completion hack
1792 (defun read-file-name-internal-1 (string dir action completer)
1793 (if (not (string-match
1794 #r"\([^$]\|\`\)\(\$\$\)*\$\([A-Za-z0-9_]*\|{[^}]*\)\'"
1796 ;; Not doing environment-variable completion hack
1797 (let* ((orig (if (equal string "") nil string))
1798 (sstring (if orig (substitute-in-file-name string) string))
1799 (specdir (if orig (file-name-directory sstring) nil))
1800 (name (if orig (file-name-nondirectory sstring) string))
1801 (direct (if specdir (expand-file-name specdir dir) dir)))
1802 ;; ~username completion
1803 (if (and (fboundp 'user-name-completion-1)
1804 (string-match "^[~]" name))
1805 (let ((user (substring name 1)))
1806 (cond ((eq action 'lambda)
1807 (file-directory-p name))
1810 (mapcar #'(lambda (p) (concat "~" p))
1811 (user-name-all-completions user)))
1814 (let* ((val+uniq (user-name-completion-1 user))
1815 (val (car val+uniq))
1816 (uniq (cdr val+uniq)))
1817 (cond ((stringp val)
1819 (file-name-as-directory (concat "~" val))
1822 (file-name-as-directory name))
1831 ;; An odd number of trailing $'s
1832 (let* ((start (match-beginning 3))
1833 (env (substring string
1834 (cond ((= start (length string))
1837 ((= (aref string start) ?{)
1842 (head (substring string 0 (1- start)))
1844 (mapcar #'(lambda (x)
1845 (cons (substring x 0 (string-match "=" x))
1847 process-environment))))
1849 (cond ((eq action 'lambda)
1853 (mapcar #'(lambda (p)
1854 (if (and (> (length p) 0)
1855 ;;#### Unix-specific
1856 ;;#### -- need absolute-pathname-p
1859 (concat head "$" p)))
1860 (all-completions env (funcall alist))))
1863 (let* ((e (funcall alist))
1864 (val (try-completion env e)))
1865 (cond ((stringp val)
1866 (if (string-match "[^A-Za-z0-9_]" val)
1869 ;; completed uniquely?
1870 (if (eq (try-completion val e) 't)
1872 (concat head "$" val)))
1875 (un-substitute-in-file-name (getenv env))))
1879 (defun read-file-name-internal (string dir action)
1880 (read-file-name-internal-1
1882 #'(lambda (action orig string specdir dir name)
1883 (cond ((eq action 'lambda)
1886 (let ((sstring (condition-case nil
1887 (expand-file-name string)
1890 ;; Some pathname syntax error in string
1892 (file-exists-p sstring)))))
1895 (mapcar #'un-substitute-in-file-name
1896 (if (string= name "")
1897 (delete "./" (file-name-all-completions "" dir))
1898 (file-name-all-completions name dir))))
1901 (let* ((d (or dir default-directory))
1902 (val (file-name-completion name d)))
1903 (if (and (eq val 't)
1904 (not (null completion-ignored-extensions)))
1905 ;;#### (file-name-completion "foo") returns 't
1906 ;; when both "foo" and "foo~" exist and the latter
1907 ;; is "pruned" by completion-ignored-extensions.
1908 ;; I think this is a bug in file-name-completion.
1909 (setq val (let ((completion-ignored-extensions '()))
1910 (file-name-completion name d))))
1912 (un-substitute-in-file-name (if specdir
1913 (concat specdir val)
1915 (let ((tem (un-substitute-in-file-name string)))
1916 (if (not (equal tem orig))
1917 ;; substitute-in-file-name did something
1921 (defun read-directory-name-internal (string dir action)
1922 (read-file-name-internal-1
1924 #'(lambda (action orig string specdir dir name)
1925 (let* ((dirs #'(lambda (fn)
1926 (let ((l (if (equal name "")
1927 (minibuf-directory-files
1931 (minibuf-directory-files
1933 (concat "\\`" (regexp-quote name))
1938 (cond ((eq action 'lambda)
1942 (file-directory-p string)))
1945 (funcall dirs #'(lambda (n)
1946 (un-substitute-in-file-name
1947 (file-name-as-directory n)))))
1950 (let ((val (try-completion
1954 (list (file-name-as-directory
1957 (un-substitute-in-file-name (if specdir
1958 (concat specdir val)
1960 (let ((tem (un-substitute-in-file-name string)))
1961 (if (not (equal tem orig))
1962 ;; substitute-in-file-name did something
1966 (defun append-expand-filename (file-string string)
1967 "Append STRING to FILE-STRING differently depending on whether STRING
1968 is a username (~string), an environment variable ($string),
1969 or a filename (/string). The resultant string is returned with the
1970 environment variable or username expanded and resolved to indicate
1971 whether it is a file(/result) or a directory (/result/)."
1973 (cond ((string-match #r"\([~$]\)\([^~$/]*\)$" file-string)
1974 (cond ((string= (substring file-string
1977 (concat (substring file-string 0 (match-end 1))
1979 (t (substitute-in-file-name
1980 (concat (substring file-string 0 (match-end 1))
1982 (t (concat (file-name-directory
1983 (substitute-in-file-name file-string)) string))))
1986 (cond ((stringp (setq result (and (file-exists-p (expand-file-name file))
1987 (read-file-name-internal
1989 (expand-file-name file)
1995 (defun mouse-rfn-setup-vars (prompt)
1996 ;; a specifier would be nice.
1997 (set (make-local-variable 'frame-title-format)
1998 (capitalize-string-as-title
1999 ;; Kludge: Delete ": " off the end.
2000 (replace-in-string prompt ": $" "")))
2001 ;; ensure that killing the frame works right,
2002 ;; instead of leaving us in the minibuffer.
2003 (add-local-hook 'delete-frame-hook
2005 (abort-recursive-edit))))
2007 (defun mouse-file-display-completion-list (window dir minibuf user-data)
2008 (let ((standard-output (window-buffer window)))
2010 (display-completion-list
2011 (minibuf-directory-files dir nil t)
2012 :window-width (window-width window)
2013 :window-height (window-text-area-height window)
2014 :completion-string ""
2016 'mouse-read-file-name-activate-callback
2017 :user-data user-data
2018 :reference-buffer minibuf
2023 (defun mouse-directory-display-completion-list (window dir minibuf user-data)
2024 (let ((standard-output (window-buffer window)))
2026 (display-completion-list
2027 (minibuf-directory-files dir nil 1)
2028 :window-width (window-width window)
2029 :window-height (window-text-area-height window)
2030 :completion-string ""
2032 'mouse-read-file-name-activate-callback
2033 :user-data user-data
2034 :reference-buffer minibuf
2039 (defun mouse-read-file-name-activate-callback (event extent user-data)
2040 (let* ((file (extent-string extent))
2041 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
2042 (extent-object extent)))
2043 (ministring (buffer-substring nil nil minibuf))
2044 (in-dir (file-name-directory ministring))
2045 (full (expand-file-name file in-dir))
2046 (filebuf (nth 0 user-data))
2047 (dirbuf (nth 1 user-data))
2048 (filewin (nth 2 user-data))
2049 (dirwin (nth 3 user-data)))
2050 (if (file-regular-p full)
2051 (default-choose-completion event extent minibuf)
2052 (erase-buffer minibuf)
2053 (insert-string (file-name-as-directory
2054 (abbreviate-file-name full t)) minibuf)
2055 (reset-buffer filebuf)
2057 (mouse-directory-display-completion-list filewin full minibuf
2059 (mouse-file-display-completion-list filewin full minibuf user-data)
2060 (reset-buffer dirbuf)
2061 (mouse-directory-display-completion-list dirwin full minibuf
2064 ;; our cheesy but god-awful time consuming file dialog box implementation.
2065 ;; this will be replaced with use of the native file dialog box (when
2067 (defun mouse-read-file-name-1 (history prompt dir default
2068 must-match initial-contents
2070 ;; file-p is t if we're reading files, nil if directories.
2071 (let* ((file-p (eq 'read-file-name-internal completer))
2072 (filebuf (get-buffer-create "*Completions*"))
2073 (dirbuf (and file-p (generate-new-buffer " *mouse-read-file*")))
2074 (butbuf (generate-new-buffer " *mouse-read-file*"))
2075 (frame (make-dialog-frame))
2080 (reset-buffer filebuf)
2082 ;; set up the frame.
2084 (let ((window-min-height 1))
2085 ;; #### should be 2 not 3, but that causes
2086 ;; "window too small to split" errors for some
2087 ;; people (but not for me ...) There's a more
2088 ;; fundamental bug somewhere.
2089 (split-window nil (- (frame-height frame) 3)))
2092 (split-window-horizontally 16)
2093 (setq filewin (frame-rightmost-window frame)
2094 dirwin (frame-leftmost-window frame))
2095 (set-window-buffer filewin filebuf)
2096 (set-window-buffer dirwin dirbuf))
2097 (setq filewin (frame-highest-window frame))
2098 (set-window-buffer filewin filebuf))
2099 (setq user-data (list filebuf dirbuf filewin dirwin))
2100 (set-window-buffer (frame-lowest-window frame) butbuf)
2102 ;; set up completion buffers.
2105 ;; #### I really need to flesh out the object
2106 ;; hierarchy better to avoid these kludges.
2107 ;; (?? I wrote this comment above some time ago,
2108 ;; and I don't understand what I'm referring to
2111 (mouse-rfn-setup-vars prompt)
2112 (when (featurep 'scrollbar)
2113 (set-specifier scrollbar-width 0 (current-buffer)))
2114 (setq truncate-lines t))))
2116 (set-buffer filebuf)
2117 (add-local-hook 'completion-setup-hook rfcshookfun)
2120 (add-local-hook 'completion-setup-hook rfcshookfun)))
2122 ;; set up minibuffer.
2124 'minibuffer-setup-hook
2127 (mouse-directory-display-completion-list
2128 filewin dir (current-buffer) user-data)
2129 (mouse-file-display-completion-list
2130 filewin dir (current-buffer) user-data)
2131 (mouse-directory-display-completion-list
2132 dirwin dir (current-buffer) user-data))
2134 (make-local-variable
2135 'completion-display-completion-list-function)
2136 (lambda (completions)
2137 (display-completion-list
2140 :window-width (window-width filewin)
2141 :window-height (window-text-area-height filewin)
2142 :completion-string ""
2144 'mouse-read-file-name-activate-callback
2145 :user-data user-data)))
2146 (mouse-rfn-setup-vars prompt)
2147 (save-selected-window
2148 ;; kludge to ensure the frame title is correct.
2149 ;; the minibuffer leaves the frame title the way
2150 ;; it was before (i.e. of the selected window before
2151 ;; the dialog box was opened), so to get it correct
2152 ;; we have to be tricky.
2153 (select-window filewin)
2154 (redisplay-frame nil t)
2155 ;; #### another kludge. sometimes the focus ends up
2156 ;; back in the main window, not the dialog box. it
2157 ;; occurs randomly and it's not possible to reliably
2158 ;; reproduce. We try to fix it by draining non-user
2159 ;; events and then setting the focus back on the frame.
2161 (focus-frame frame))))
2163 ;; set up button buffer.
2165 (mouse-rfn-setup-vars prompt)
2167 (setq default-directory dir))
2168 (when (featurep 'scrollbar)
2169 (set-specifier scrollbar-width 0 butbuf))
2171 (insert-gui-button (make-gui-button "OK"
2173 (exit-minibuffer))))
2175 (insert-gui-button (make-gui-button "Cancel"
2177 (abort-recursive-edit))))
2179 ;; now start reading filename.
2180 (read-file-name-2 history prompt dir default
2181 must-match initial-contents
2185 ;; get rid of our hook that calls abort-recursive-edit -- not a good
2187 (kill-local-variable 'delete-frame-hook)
2188 (delete-frame frame)
2189 (kill-buffer filebuf)
2190 (kill-buffer butbuf)
2191 (and dirbuf (kill-buffer dirbuf)))))
2193 (defun read-face (prompt &optional must-match)
2194 "Read the name of a face from the minibuffer and return it as a symbol."
2195 (intern (completing-read prompt obarray 'find-face must-match)))
2198 (defvar x-read-color-completion-table))
2200 (defun read-color-completion-table ()
2202 ;; #### Evil device-type dependency
2204 (if-fboundp #'x-read-color-completion-table
2205 (x-read-color-completion-table)
2206 (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
2209 ;; prevents multiple searches for rgb.txt if we can't find it
2210 (setq x-read-color-completion-table nil)
2211 (with-current-buffer (get-buffer-create " *colors*")
2212 (reset-buffer (current-buffer))
2213 (insert-file-contents rgb-file)
2215 ;; skip over comments
2216 (while (looking-at "^!")
2219 (skip-chars-forward "0-9 \t")
2222 (setq color (buffer-substring p (point))
2223 clist (cons (list color) clist))
2224 ;; Ugh. If we want to be able to complete the lowercase form
2225 ;; of the color name, we need to add it twice! Yuck.
2226 (let ((dcase (downcase color)))
2227 (or (string= dcase color)
2228 (push (list dcase) clist)))
2230 (kill-buffer (current-buffer))))
2231 (setq x-read-color-completion-table clist)
2232 x-read-color-completion-table)))
2234 (mapcar #'list (tty-color-list)))))
2238 (defun read-color (prompt &optional must-match initial-contents)
2239 "Read the name of a color from the minibuffer."
2240 (let ((table (x-read-color-completion-table)))
2241 (completing-read prompt table nil (and table must-match)
2245 ;; #### The doc string for read-non-nil-coding system gets lost if we
2246 ;; only include these if the mule feature is present. Strangely,
2247 ;; read-coding-system doesn't.
2249 ;;(if (featurep 'mule)
2251 (defun read-coding-system (prompt &optional default-coding-system)
2252 "Read a coding-system (or nil) from the minibuffer.
2253 Prompting with string PROMPT.
2254 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM.
2255 DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object."
2256 (intern (completing-read prompt obarray 'find-coding-system t nil nil
2257 (cond ((symbolp default-coding-system)
2258 (symbol-name default-coding-system))
2259 ((coding-system-p default-coding-system)
2260 (symbol-name (coding-system-name default-coding-system)))
2262 default-coding-system)))))
2264 (defun read-non-nil-coding-system (prompt)
2265 "Read a non-nil coding-system from the minibuffer.
2266 Prompt with string PROMPT."
2267 (let ((retval (intern "")))
2268 (while (= 0 (length (symbol-name retval)))
2269 (setq retval (intern (completing-read prompt obarray
2274 ;;) ;; end of (featurep 'mule)
2278 (defcustom force-dialog-box-use nil
2279 "*If non-nil, always use a dialog box for asking questions, if possible.
2280 You should *bind* this, not set it. This is useful if you're doing
2281 something mousy but which wasn't actually invoked using the mouse."
2285 ;; We include this here rather than dialog.el so it is defined
2286 ;; even when dialog boxes are not present.
2287 (defun should-use-dialog-box-p ()
2288 "If non-nil, questions should be asked with a dialog box instead of the
2289 minibuffer. This looks at `last-command-event' to see if it was a mouse
2290 event, and checks whether dialog-support exists and the current device
2291 supports dialog boxes.
2293 The dialog box is totally disabled if the variable `use-dialog-box'
2295 (and (featurep 'dialog)
2296 (device-on-window-system-p)
2298 (or force-dialog-box-use
2299 (button-press-event-p last-command-event)
2300 (button-release-event-p last-command-event)
2301 (misc-user-event-p last-command-event))))
2303 ;;; minibuf.el ends here