1 ;;; minibuf.el --- Minibuffer functions for XEmacs
3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems
5 ;; Copyright (C) 1995, 1996 Ben Wing
7 ;; Author: Richard Mlynarik
9 ;; Maintainer: XEmacs Development Team
10 ;; Keywords: internal, dumped
12 ;; This file is part of XEmacs.
14 ;; XEmacs is free software; you can redistribute it and/or modify it
15 ;; under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; XEmacs is distributed in the hope that it will be useful, but
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 ;; General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with XEmacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
29 ;;; Synched up with: all the minibuffer history stuff is synched with
30 ;;; 19.30. Not sure about the rest.
34 ;; This file is dumped with XEmacs.
36 ;; Written by Richard Mlynarik 2-Oct-92
38 ;; 06/11/1997 - Use char-(after|before) instead of
39 ;; (following|preceding)-char. -slb
43 (defgroup minibuffer nil
44 "Controling the behavior of the minibuffer."
48 (defcustom insert-default-directory t
49 "*Non-nil means when reading a filename start with default dir in minibuffer."
53 (defcustom minibuffer-history-uniquify t
54 "*Non-nil means when adding an item to a minibuffer history, remove
55 previous occurances of the same item from the history list first,
56 rather than just consing the new element onto the front of the list."
60 (defvar minibuffer-completion-table nil
61 "Alist or obarray used for completion in the minibuffer.
62 This becomes the ALIST argument to `try-completion' and `all-completions'.
64 The value may alternatively be a function, which is given three arguments:
65 STRING, the current buffer contents;
66 PREDICATE, the predicate for filtering possible matches;
67 CODE, which says what kind of things to do.
68 CODE can be nil, t or `lambda'.
69 nil means to return the best completion of STRING, nil if there is none,
70 or t if it is already a unique completion.
71 t means to return a list of all possible completions of STRING.
72 `lambda' means to return t if STRING is a valid completion as it stands.")
74 (defvar minibuffer-completion-predicate nil
75 "Within call to `completing-read', this holds the PREDICATE argument.")
77 (defvar minibuffer-completion-confirm nil
78 "Non-nil => demand confirmation of completion before exiting minibuffer.")
80 (defcustom minibuffer-confirm-incomplete nil
81 "If true, then in contexts where completing-read allows answers which
82 are not valid completions, an extra RET must be typed to confirm the
83 response. This is helpful for catching typos, etc."
87 (defcustom completion-auto-help t
88 "*Non-nil means automatically provide help for invalid completion input."
92 (defcustom enable-recursive-minibuffers nil
93 "*Non-nil means to allow minibuffer commands while in the minibuffer.
94 More precisely, this variable makes a difference when the minibuffer window
95 is the selected window. If you are in some other window, minibuffer commands
96 are allowed even if a minibuffer is active."
100 (defcustom minibuffer-max-depth 1
101 ;; See comment in #'minibuffer-max-depth-exceeded
102 "*Global maximum number of minibuffers allowed;
103 compare to enable-recursive-minibuffers, which is only consulted when the
104 minibuffer is reinvoked while it is the selected window."
105 :type '(choice integer
106 (const :tag "Indefinite" nil))
109 ;; Moved to C. The minibuffer prompt must be setup before this is run
110 ;; and that can only be done from the C side.
111 ;(defvar minibuffer-setup-hook nil
112 ; "Normal hook run just after entry to minibuffer.")
114 (defvar minibuffer-exit-hook nil
115 "Normal hook run just after exit from minibuffer.")
117 (defvar minibuffer-help-form nil
118 "Value that `help-form' takes on inside the minibuffer.")
120 (defvar minibuffer-default nil
121 "Default value for minibuffer input.")
123 (defvar minibuffer-local-map
124 (let ((map (make-sparse-keymap 'minibuffer-local-map)))
126 "Default keymap to use when reading from the minibuffer.")
128 (defvar minibuffer-local-completion-map
129 (let ((map (make-sparse-keymap 'minibuffer-local-completion-map)))
130 (set-keymap-parents map (list minibuffer-local-map))
132 "Local keymap for minibuffer input with completion.")
134 (defvar minibuffer-local-must-match-map
135 (let ((map (make-sparse-keymap 'minibuffer-must-match-map)))
136 (set-keymap-parents map (list minibuffer-local-completion-map))
138 "Local keymap for minibuffer input with completion, for exact match.")
140 ;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
141 (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el
142 (define-key minibuffer-local-map "\r" 'exit-minibuffer)
143 (define-key minibuffer-local-map "\n" 'exit-minibuffer)
145 ;; Historical crock. Unused by anything but user code, if even that
146 ;(defvar minibuffer-local-ns-map
147 ; (let ((map (make-sparse-keymap 'minibuffer-local-ns-map)))
148 ; (set-keymap-parents map (list minibuffer-local-map))
150 ; "Local keymap for the minibuffer when spaces are not allowed.")
151 ;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer)
152 ;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer)
153 ;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit)
155 (define-key minibuffer-local-completion-map "\t" 'minibuffer-complete)
156 (define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
157 (define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help)
158 (define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit)
159 (define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit)
161 (define-key minibuffer-local-map "\M-n" 'next-history-element)
162 (define-key minibuffer-local-map "\M-p" 'previous-history-element)
163 (define-key minibuffer-local-map '[next] "\M-n")
164 (define-key minibuffer-local-map '[prior] "\M-p")
165 (define-key minibuffer-local-map "\M-r" 'previous-matching-history-element)
166 (define-key minibuffer-local-map "\M-s" 'next-matching-history-element)
167 (define-key minibuffer-local-must-match-map [next]
168 'next-complete-history-element)
169 (define-key minibuffer-local-must-match-map [prior]
170 'previous-complete-history-element)
172 ;; This is an experiment--make up and down arrows do history.
173 (define-key minibuffer-local-map [up] 'previous-history-element)
174 (define-key minibuffer-local-map [down] 'next-history-element)
175 (define-key minibuffer-local-completion-map [up] 'previous-history-element)
176 (define-key minibuffer-local-completion-map [down] 'next-history-element)
177 (define-key minibuffer-local-must-match-map [up] 'previous-history-element)
178 (define-key minibuffer-local-must-match-map [down] 'next-history-element)
180 (defvar read-expression-map (let ((map (make-sparse-keymap
181 'read-expression-map)))
182 (set-keymap-parents map
183 (list minibuffer-local-map))
184 (define-key map "\M-\t" 'lisp-complete-symbol)
186 "Minibuffer keymap used for reading Lisp expressions.")
188 (defvar read-shell-command-map
189 (let ((map (make-sparse-keymap 'read-shell-command-map)))
190 (set-keymap-parents map (list minibuffer-local-map))
191 (define-key map "\t" 'comint-dynamic-complete)
192 (define-key map "\M-\t" 'comint-dynamic-complete)
193 (define-key map "\M-?" 'comint-dynamic-list-completions)
195 "Minibuffer keymap used by shell-command and related commands.")
197 (defcustom use-dialog-box t
198 "*Variable controlling usage of the dialog box.
199 If nil, the dialog box will never be used, even in response to mouse events."
203 (defcustom minibuffer-electric-file-name-behavior t
204 "*If non-nil, slash and tilde in certain places cause immediate deletion.
205 These are the same places where this behavior would occur later on anyway,
206 in `substitute-in-file-name'."
210 ;; originally by Stig@hackvan.com
211 (defun minibuffer-electric-separator ()
213 (let ((c last-command-char))
214 (and minibuffer-electric-file-name-behavior
215 (eq c directory-sep-char)
216 (eq c (char-before (point)))
218 (goto-char (point-min))
219 (and (looking-at "/.+:~?[^/]*/.+")
220 (re-search-forward "^/.+:~?[^/]*" nil t)
222 (delete-region (point) (point-max))
225 (goto-char (point-min))
226 (and (looking-at ".+://[^/]*/.+")
227 (re-search-forward "^.+:/" nil t)
229 (delete-region (point) (point-max))
231 ;; permit `//hostname/path/to/file'
232 (not (eq (point) (1+ (point-min))))
233 ;; permit `http://url/goes/here'
234 (or (not (eq ?: (char-after (- (point) 2))))
235 (eq ?/ (char-after (point-min))))
236 (delete-region (point-min) (point)))
239 (defun minibuffer-electric-tilde ()
241 (and minibuffer-electric-file-name-behavior
242 (eq directory-sep-char (char-before (point)))
243 ;; permit URL's with //, for e.g. http://hostname/~user
244 (not (save-excursion (search-backward "//" nil t)))
245 (delete-region (point-min) (point)))
249 (defvar read-file-name-map
250 (let ((map (make-sparse-keymap 'read-file-name-map)))
251 (set-keymap-parents map (list minibuffer-local-completion-map))
252 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
253 (define-key map "~" 'minibuffer-electric-tilde)
257 (defvar read-file-name-must-match-map
258 (let ((map (make-sparse-keymap 'read-file-name-map)))
259 (set-keymap-parents map (list minibuffer-local-must-match-map))
260 (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
261 (define-key map "~" 'minibuffer-electric-tilde)
265 (defun minibuffer-keyboard-quit ()
266 "Abort recursive edit.
267 If `zmacs-regions' is true, and the zmacs region is active in this buffer,
268 then this key deactivates the region without beeping."
270 (if (and (region-active-p)
271 (eq (current-buffer) (zmacs-region-buffer)))
272 ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
273 ;; deactivating the region. If it is inactive, beep.
275 (abort-recursive-edit)))
277 ;;;; Guts of minibuffer invocation
279 ;;#### The only things remaining in C are
280 ;; "Vminibuf_prompt" and the display junk
281 ;; "minibuf_prompt_width" and "minibuf_prompt_pix_width"
282 ;; Also "active_frame", though I suspect I could already
283 ;; hack that in Lisp if I could make any sense of the
284 ;; complete mess of frame/frame code in XEmacs.
285 ;; Vminibuf_prompt could easily be made Lisp-bindable.
286 ;; I suspect that minibuf_prompt*_width are actually recomputed
287 ;; by redisplay as needed -- or could be arranged to be so --
288 ;; and that there could be need for read-minibuffer-internal to
289 ;; save and restore them.
290 ;;#### The only other thing which read-from-minibuffer-internal does
291 ;; which we can't presently do in Lisp is move the frame cursor
292 ;; to the start of the minibuffer line as it returns. This is
293 ;; a rather nice touch and should be preserved -- probably by
294 ;; providing some Lisp-level mechanism (extension to cursor-in-echo-area ?)
298 ;; Like reset_buffer in FSF's buffer.c
299 ;; (Except that kill-all-local-variables doesn't nuke 'permanent-local
300 ;; variables -- we preserve them, reset_buffer doesn't.)
301 (defun reset-buffer (buffer)
302 (with-current-buffer buffer
303 ;(if (fboundp 'unlock-buffer) (unlock-buffer))
304 (kill-all-local-variables)
305 (setq buffer-read-only nil)
306 ;; don't let read only text yanked into the minibuffer
307 ;; permanently wedge it.
308 (make-local-variable 'inhibit-read-only)
309 (setq inhibit-read-only t)
311 ;(setq default-directory nil)
312 (setq buffer-file-name nil)
313 (setq buffer-file-truename nil)
314 (set-buffer-modified-p nil)
315 (setq buffer-backed-up nil)
316 (setq buffer-auto-save-file-name nil)
317 (set-buffer-dedicated-frame buffer nil)
320 (defvar minibuffer-history-variable 'minibuffer-history
321 "History list symbol to add minibuffer values to.
322 Each minibuffer output is added with
323 (set minibuffer-history-variable
324 (cons STRING (symbol-value minibuffer-history-variable)))")
325 (defvar minibuffer-history-position)
328 (defvar initial-minibuffer-history-position)
329 (defvar current-minibuffer-contents)
330 (defvar current-minibuffer-point)
332 (defcustom minibuffer-history-minimum-string-length nil
333 "*If this variable is non-nil, a string will not be added to the
334 minibuffer history if its length is less than that value."
335 :type '(choice (const :tag "Any" nil)
339 (define-error 'input-error "Keyboard input error")
341 (put 'input-error 'display-error
342 #'(lambda (error-object stream)
343 (princ (cadr error-object) stream)))
345 (defun read-from-minibuffer (prompt &optional initial-contents
351 "Read a string from the minibuffer, prompting with string PROMPT.
352 If optional second arg INITIAL-CONTENTS is non-nil, it is a string
353 to be inserted into the minibuffer before reading input.
354 If INITIAL-CONTENTS is (STRING . POSITION), the initial input
355 is STRING, but point is placed POSITION characters into the string.
356 Third arg KEYMAP is a keymap to use while reading;
357 if omitted or nil, the default is `minibuffer-local-map'.
358 If fourth arg READ is non-nil, then interpret the result as a lisp object
359 and return that object:
360 in other words, do `(car (read-from-string INPUT-STRING))'
361 Fifth arg HISTORY, if non-nil, specifies a history list
362 and optionally the initial position in the list.
363 It can be a symbol, which is the history list variable to use,
364 or it can be a cons cell (HISTVAR . HISTPOS).
365 In that case, HISTVAR is the history list variable to use,
366 and HISTPOS is the initial position (the position in the list
367 which INITIAL-CONTENTS corresponds to).
368 If HISTORY is `t', no history will be recorded.
369 Positions are counted starting from 1 at the beginning of the list.
370 Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table'
372 Seventh arg DEFAULT, if non-nil, will be returned when user enters
375 See also the variable completion-highlight-first-word-only for control over
377 (if (and (not enable-recursive-minibuffers)
378 (> (minibuffer-depth) 0)
379 (eq (selected-window) (minibuffer-window)))
380 (error "Command attempted to use minibuffer while in minibuffer"))
382 (if (and minibuffer-max-depth
383 (> minibuffer-max-depth 0)
384 (>= (minibuffer-depth) minibuffer-max-depth))
385 (minibuffer-max-depth-exceeded))
387 ;; catch this error before the poor user has typed something...
389 (if (symbolp history)
391 (error "History list %S is unbound" history))
392 (or (boundp (car history))
393 (error "History list %S is unbound" (car history)))))
397 ;; XEmacs in -batch mode calls minibuffer: print the prompt.
398 (message "%s" (gettext prompt))
401 ;;#### Should this even be falling though to the code below?
402 ;;#### How does this stuff work now, anyway?
404 (let* ((dir default-directory)
405 (owindow (selected-window))
406 (oframe (selected-frame))
407 (window (minibuffer-window))
408 (buffer (if (eq (minibuffer-depth) 0)
409 (window-buffer window)
410 (get-buffer-create (format " *Minibuf-%d"
411 (minibuffer-depth)))))
412 (frame (window-frame window))
413 (mconfig (if (eq frame (selected-frame))
414 nil (current-window-configuration frame)))
415 (oconfig (current-window-configuration))
416 ;; dynamic scope sucks sucks sucks sucks sucks sucks.
417 ;; `M-x doctor' makes history a local variable, and thus
418 ;; our binding above is buffer-local and doesn't apply
419 ;; once we switch buffers!!!! We demand better scope!
421 (minibuffer-default default))
424 (set-buffer (reset-buffer buffer))
425 (setq default-directory dir)
426 (make-local-variable 'print-escape-newlines)
427 (setq print-escape-newlines t)
428 (make-local-variable 'current-minibuffer-contents)
429 (make-local-variable 'current-minibuffer-point)
430 (make-local-variable 'initial-minibuffer-history-position)
431 (setq current-minibuffer-contents ""
432 current-minibuffer-point 1)
433 (if (not minibuffer-smart-completion-tracking-behavior)
435 (make-local-variable 'mode-motion-hook)
438 (setq mode-motion-hook 'minibuffer-smart-mouse-tracker))
439 (make-local-variable 'mouse-track-click-hook)
440 (add-hook 'mouse-track-click-hook
441 'minibuffer-smart-maybe-select-highlighted-completion))
442 (set-window-buffer window buffer)
443 (select-window window)
444 (set-window-hscroll window 0)
445 (buffer-enable-undo buffer)
448 (if (consp initial-contents)
450 (insert (car initial-contents))
451 (goto-char (1+ (cdr initial-contents)))
452 (setq current-minibuffer-contents (car initial-contents)
453 current-minibuffer-point (cdr initial-contents)))
454 (insert initial-contents)
455 (setq current-minibuffer-contents initial-contents
456 current-minibuffer-point (point))))
457 (use-local-map (help-keymap-with-help-key
458 (or keymap minibuffer-local-map)
459 minibuffer-help-form))
460 (let ((mouse-grabbed-buffer
461 (and minibuffer-smart-completion-tracking-behavior
463 (current-prefix-arg current-prefix-arg)
464 ;; (help-form minibuffer-help-form)
465 (minibuffer-history-variable (cond ((not _history_)
471 (minibuffer-history-position (cond ((consp _history_)
475 (minibuffer-scroll-window owindow))
476 (setq initial-minibuffer-history-position
477 minibuffer-history-position)
479 (setq local-abbrev-table abbrev-table
481 ;; This is now run from read-minibuffer-internal
482 ;(if minibuffer-setup-hook
483 ; (run-hooks 'minibuffer-setup-hook))
487 (if (> (recursion-depth) (minibuffer-depth))
488 (let ((standard-output t)
490 (read-minibuffer-internal prompt))
491 (read-minibuffer-internal prompt))))
492 ;; Translate an "abort" (throw 'exit 't)
496 (let* ((val (progn (set-buffer buffer)
497 (if minibuffer-exit-hook
498 (run-hooks 'minibuffer-exit-hook))
499 (if (and (eq (char-after (point-min)) nil)
503 (histval (if (and default (string= val ""))
509 (let ((v (read-from-string val)))
510 (if (< (cdr v) (length val))
512 (or (string-match "[ \t\n]*\\'" val (cdr v))
513 (error "Trailing garbage following expression"))))
515 ;; total total kludge
516 (if (stringp v) (setq v (list 'quote v)))
520 '(input-error "End of input before end of expression")))
521 (error (setq err e))))
522 ;; Add the value to the appropriate history list unless
523 ;; it's already the most recent element, or it's only
524 ;; two characters long.
525 (if (and (symbolp minibuffer-history-variable)
526 (boundp minibuffer-history-variable))
527 (let ((list (symbol-value minibuffer-history-variable)))
530 (and list (equal histval (car list)))
532 minibuffer-history-minimum-string-length
534 minibuffer-history-minimum-string-length))
535 (set minibuffer-history-variable
536 (if minibuffer-history-uniquify
537 (cons histval (remove histval list))
538 (cons histval list))))))
539 (if err (signal (car err) (cdr err)))
541 ;; stupid display code requires this for some reason
543 (buffer-disable-undo buffer)
544 (setq buffer-read-only nil)
547 ;; restore frame configurations
548 (if (and mconfig (frame-live-p oframe)
549 (eq frame (selected-frame)))
550 ;; if we changed frames (due to surrogate minibuffer),
551 ;; and we're still on the new frame, go back to the old one.
552 (select-frame oframe))
553 (if mconfig (set-window-configuration mconfig))
554 (set-window-configuration oconfig))))
557 (defun minibuffer-max-depth-exceeded ()
559 ;; This signals an error if an Nth minibuffer is invoked while N-1 are
560 ;; already active, whether the minibuffer window is selected or not.
561 ;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x,
562 ;; getting distracted, and clicking elsewhere) many many novice users have
563 ;; had the problem of having multiple minibuffers build up, even to the
564 ;; point of exceeding max-lisp-eval-depth. Since the variable
565 ;; enable-recursive-minibuffers historically/crockishly is only consulted
566 ;; when the minibuffer is currently active (like typing M-x M-x) it doesn't
567 ;; help in this situation.
569 ;; This routine also offers to edit .emacs for you to get rid of this
570 ;; complaint, like `disabled' commands do, since it's likely that non-novice
571 ;; users will be annoyed by this change, so we give them an easy way to get
572 ;; rid of it forever.
574 (beep t 'minibuffer-limit-exceeded)
576 "Minibuffer already active: abort it with `^]', enable new one with `n': ")
577 (let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work??
582 ((y-or-n-p "Enable recursive minibuffers for other sessions too? ")
583 ;; This is completely disgusting, but it's basically what novice.el
584 ;; does. This kind of thing should be generalized.
585 (setq minibuffer-max-depth nil)
589 (substitute-in-file-name custom-file)))
590 (goto-char (point-min))
591 (if (re-search-forward
592 "^(setq minibuffer-max-depth \\([0-9]+\\|'?nil\\|'?()\\))\n"
594 (delete-region (match-beginning 0 ) (match-end 0))
595 ;; Must have been disabled by default.
596 (goto-char (point-max)))
597 (insert"\n(setq minibuffer-max-depth nil)\n")
599 (message "Multiple minibuffers enabled")
602 (abort-recursive-edit))
604 (error "Minibuffer already active")))))
607 ;;;; Guts of minibuffer completion
610 ;; Used by minibuffer-do-completion
611 (defvar last-exact-completion)
613 (defun temp-minibuffer-message (m)
614 (let ((savemax (point-max)))
616 (goto-char (point-max))
619 (let ((inhibit-quit t))
621 (delete-region savemax (point-max))
622 ;; If the user types a ^G while we're in sit-for, then quit-flag
623 ;; gets set. In this case, we want that ^G to be interpreted
624 ;; as a normal character, and act just like typeahead.
625 (if (and quit-flag (not unread-command-event))
626 (setq unread-command-event (character-to-event (quit-char))
630 ;; Determines whether buffer-string is an exact completion
631 (defun exact-minibuffer-completion-p (buffer-string)
632 (cond ((not minibuffer-completion-table)
635 ((vectorp minibuffer-completion-table)
636 (let ((tem (intern-soft buffer-string
637 minibuffer-completion-table)))
639 (and (string-equal buffer-string "nil")
640 ;; intern-soft loses for 'nil
642 (mapatoms #'(lambda (s)
647 minibuffer-completion-table)
649 (if minibuffer-completion-predicate
650 (funcall minibuffer-completion-predicate
654 ((and (consp minibuffer-completion-table)
655 ;;#### Emacs-Lisp truly sucks!
656 ;; lambda, autoload, etc
657 (not (symbolp (car minibuffer-completion-table))))
658 (if (not completion-ignore-case)
659 (assoc buffer-string minibuffer-completion-table)
660 (let ((s (upcase buffer-string))
661 (tail minibuffer-completion-table)
664 (setq tem (car (car tail)))
665 (if (or (equal tem buffer-string)
667 (if tem (equal (upcase tem) s)))
670 (setq tail (cdr tail))))
673 (funcall minibuffer-completion-table
675 minibuffer-completion-predicate
679 ;; 0 'none no possible completion
680 ;; 1 'unique was already an exact and unique completion
681 ;; 3 'exact was already an exact (but nonunique) completion
682 ;; NOT USED 'completed-exact-unique completed to an exact and completion
683 ;; 4 'completed-exact completed to an exact (but nonunique) completion
684 ;; 5 'completed some completion happened
685 ;; 6 'uncompleted no completion happened
686 (defun minibuffer-do-completion-1 (buffer-string completion)
687 (cond ((not completion)
690 ;; exact and unique match
693 ;; It did find a match. Do we match some possibility exactly now?
694 (let ((completedp (not (string-equal completion buffer-string))))
697 ;; Some completion happened
700 (setq buffer-string completion)))
701 (if (exact-minibuffer-completion-p buffer-string)
702 ;; An exact completion was possible
704 ;; Since no callers need to know the difference, don't bother
705 ;; with this (potentially expensive) discrimination.
706 ;; (if (eq (try-completion completion
707 ;; minibuffer-completion-table
708 ;; minibuffer-completion-predicate)
710 ;; 'completed-exact-unique
714 ;; Not an exact match
720 (defun minibuffer-do-completion (buffer-string)
721 (let* ((completion (try-completion buffer-string
722 minibuffer-completion-table
723 minibuffer-completion-predicate))
724 (status (minibuffer-do-completion-1 buffer-string completion))
725 (last last-exact-completion))
726 (setq last-exact-completion nil)
727 (cond ((eq status 'none)
729 (ding nil 'no-completion)
730 (temp-minibuffer-message " [No match]"))
734 ;; It did find a match. Do we match some possibility exactly now?
735 (if (not (string-equal completion buffer-string))
737 ;; Some completion happened
740 (setq buffer-string completion)))
741 (cond ((eq status 'exact)
742 ;; If the last exact completion and this one were
743 ;; the same, it means we've already given a
744 ;; "Complete but not unique" message and that the
745 ;; user's hit TAB again, so now we give help.
746 (setq last-exact-completion completion)
747 (if (equal buffer-string last)
748 (minibuffer-completion-help)))
749 ((eq status 'uncompleted)
750 (if completion-auto-help
751 (minibuffer-completion-help)
752 (temp-minibuffer-message " [Next char not unique]")))
760 (defun completing-read (prompt table
761 &optional predicate require-match
762 initial-contents history default)
763 "Read a string in the minibuffer, with completion.
764 Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY.
765 PROMPT is a string to prompt with; normally it ends in a colon and a space.
766 TABLE is an alist whose elements' cars are strings, or an obarray.
767 PREDICATE limits completion to a subset of TABLE.
768 See `try-completion' for more details on completion, TABLE, and PREDICATE.
769 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
770 the input is (or completes to) an element of TABLE or is null.
771 If it is also not t, Return does not exit if it does non-null completion.
772 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
773 If it is (STRING . POSITION), the initial input
774 is STRING, but point is placed POSITION characters into the string.
775 HISTORY, if non-nil, specifies a history list
776 and optionally the initial position in the list.
777 It can be a symbol, which is the history list variable to use,
778 or it can be a cons cell (HISTVAR . HISTPOS).
779 In that case, HISTVAR is the history list variable to use,
780 and HISTPOS is the initial position (the position in the list
781 which INITIAL-CONTENTS corresponds to).
782 If HISTORY is `t', no history will be recorded.
783 Positions are counted starting from 1 at the beginning of the list.
784 DEFAULT, if non-nil, is the default value.
785 Completion ignores case if the ambient value of
786 `completion-ignore-case' is non-nil."
787 (let ((minibuffer-completion-table table)
788 (minibuffer-completion-predicate predicate)
789 (minibuffer-completion-confirm (if (eq require-match 't) nil t))
790 (last-exact-completion nil)
792 (setq ret (read-from-minibuffer prompt
794 (if (not require-match)
795 minibuffer-local-completion-map
796 minibuffer-local-must-match-map)
801 (if (and (string= ret "")
807 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
808 ;;;; Minibuffer completion commands ;;;;
809 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
812 (defun minibuffer-complete ()
813 "Complete the minibuffer contents as far as possible.
814 Return nil if there is no valid completion, else t.
815 If no characters can be completed, display a list of possible completions.
816 If you repeat this command after it displayed such a list,
817 scroll the window of possible completions."
819 ;; If the previous command was not this, then mark the completion
821 (or (eq last-command this-command)
822 (setq minibuffer-scroll-window nil))
823 (let ((window minibuffer-scroll-window))
824 (if (and window (windowp window) (window-buffer window)
825 (buffer-name (window-buffer window)))
826 ;; If there's a fresh completion window with a live buffer
827 ;; and this command is repeated, scroll that window.
828 (let ((obuf (current-buffer)))
831 (set-buffer (window-buffer window))
832 (if (pos-visible-in-window-p (point-max) window)
833 ;; If end is in view, scroll up to the beginning.
834 (set-window-start window (point-min))
835 ;; Else scroll down one frame.
836 (scroll-other-window)))
839 (let ((status (minibuffer-do-completion (buffer-string))))
840 (if (eq status 'none)
843 (cond ((eq status 'unique)
844 (temp-minibuffer-message
845 " [Sole completion]"))
847 (temp-minibuffer-message
848 " [Complete, but not unique]")))
852 (defun minibuffer-complete-and-exit ()
853 "Complete the minibuffer contents, and maybe exit.
854 Exit if the name is valid with no completion needed.
855 If name was completed to a valid match,
856 a repetition of this command will exit."
858 (if (= (point-min) (point-max))
859 ;; Crockishly allow user to specify null string
861 (let ((buffer-string (buffer-string)))
862 ;; Short-cut -- don't call minibuffer-do-completion if we already
863 ;; have an (possibly nonunique) exact completion.
864 (if (exact-minibuffer-completion-p buffer-string)
866 (let ((status (minibuffer-do-completion buffer-string)))
867 (if (or (eq status 'unique)
869 (if (or (eq status 'completed-exact)
870 (eq status 'completed-exact-unique))
871 (if minibuffer-completion-confirm
872 (progn (temp-minibuffer-message " [Confirm]")
875 (throw 'exit nil)))))
878 (defun self-insert-and-exit ()
879 "Terminate minibuffer input."
881 (self-insert-command 1)
884 (defun exit-minibuffer ()
885 "Terminate this minibuffer argument.
886 If minibuffer-confirm-incomplete is true, and we are in a completing-read
887 of some kind, and the contents of the minibuffer is not an existing
888 completion, requires an additional RET before the minibuffer will be exited
889 \(assuming that RET was the character that invoked this command:
890 the character in question must be typed again)."
892 (if (not minibuffer-confirm-incomplete)
894 (let ((buffer-string (buffer-string)))
895 (if (exact-minibuffer-completion-p buffer-string)
897 (let ((completion (if (not minibuffer-completion-table)
899 (try-completion buffer-string
900 minibuffer-completion-table
901 minibuffer-completion-predicate))))
902 (if (or (eq completion 't)
903 ;; Crockishly allow user to specify null string
904 (string-equal buffer-string ""))
906 (if completion ;; rewritten for I18N3 snarfing
907 (temp-minibuffer-message " [incomplete; confirm]")
908 (temp-minibuffer-message " [no completions; confirm]"))
909 (let ((event (let ((inhibit-quit t))
912 (setq quit-flag nil)))))
913 (cond ((equal event last-command-event)
915 ((equal (quit-char) (event-to-character event))
918 (dispatch-event event)))))
920 ;;;; minibuffer-complete-word
923 ;;;#### I think I have done this correctly; it certainly is simpler
924 ;;;#### than what the C code seemed to be trying to do.
925 (defun minibuffer-complete-word ()
926 "Complete the minibuffer contents at most a single word.
927 After one word is completed as much as possible, a space or hyphen
928 is added, provided that matches some possible completion.
929 Return nil if there is no valid completion, else t."
931 (let* ((buffer-string (buffer-string))
932 (completion (try-completion buffer-string
933 minibuffer-completion-table
934 minibuffer-completion-predicate))
935 (status (minibuffer-do-completion-1 buffer-string completion)))
936 (cond ((eq status 'none)
937 (ding nil 'no-completion)
938 (temp-minibuffer-message " [No match]")
941 ;; New message, only in this new Lisp code
942 (temp-minibuffer-message " [Sole completion]")
945 (cond ((or (eq status 'uncompleted)
947 (let ((foo #'(lambda (s)
950 (concat buffer-string s)
951 minibuffer-completion-table
952 minibuffer-completion-predicate)
954 (goto-char (point-max))
959 (char last-command-char))
960 ;; Try to complete by adding a word-delimiter
961 (or (and (characterp char) (> char 0)
962 (funcall foo (char-to-string char)))
963 (and (not (eq char ?\ ))
965 (and (not (eq char ?\-))
968 (if completion-auto-help
969 (minibuffer-completion-help)
970 ;; New message, only in this new Lisp code
971 ;; rewritten for I18N3 snarfing
972 (if (eq status 'exact)
973 (temp-minibuffer-message
974 " [Complete, but not unique]")
975 (temp-minibuffer-message " [Ambiguous]")))
980 ;; First word-break in stuff found by completion
981 (goto-char (point-min))
982 (let ((len (length buffer-string))
984 (if (and (< len (length completion))
989 (upcase (aref buffer-string n))
990 (upcase (aref completion n)))
995 (goto-char (point-min))
997 (re-search-forward "\\W" nil t)))
998 (delete-region (point) (point-max))
999 (goto-char (point-max))))
1003 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1004 ;;;; "Smart minibuffer" hackery ;;;;
1005 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1007 ;;; ("Kludgy minibuffer hackery" is perhaps a better name)
1009 ;; This works by setting `mouse-grabbed-buffer' to the minibuffer,
1010 ;; defining button2 in the minibuffer keymap to
1011 ;; `minibuffer-smart-select-highlighted-completion', and setting the
1012 ;; mode-motion-hook of the minibuffer to `minibuffer-mouse-tracker'.
1013 ;; By setting `mouse-grabbed-buffer', the minibuffer's keymap and
1014 ;; mode-motion-hook apply (for mouse motion and presses) no matter
1015 ;; what buffer the mouse is over. Then, `minibuffer-mouse-tracker'
1016 ;; examines the text under the mouse looking for something that looks
1017 ;; like a completion, and causes it to be highlighted, and
1018 ;; `minibuffer-smart-select-highlighted-completion' looks for a
1019 ;; flagged completion under the mouse and inserts it. This has the
1020 ;; following advantages:
1022 ;; -- filenames and such in any buffer can be inserted by clicking,
1023 ;; not just completions
1025 ;; but the following disadvantages:
1027 ;; -- unless you're aware of the "filename in any buffer" feature,
1028 ;; the fact that strings in arbitrary buffers get highlighted appears
1030 ;; -- mouse motion can cause ange-ftp actions -- bad bad bad.
1032 ;; There's some hackery in minibuffer-mouse-tracker to try to avoid the
1033 ;; ange-ftp stuff, but it doesn't work.
1036 (defcustom minibuffer-smart-completion-tracking-behavior nil
1037 "*If non-nil, look for completions under mouse in all buffers.
1038 This allows you to click on something that looks like a completion
1039 and have it selected, regardless of what buffer it is in.
1041 This is not enabled by default because
1043 -- The \"mysterious\" highlighting in normal buffers is confusing to
1044 people not expecting it, and looks like a bug
1045 -- If ange-ftp is enabled, this tracking sometimes causes ange-ftp
1046 action as a result of mouse motion, which is *bad bad bad*.
1047 Hopefully this bug will be fixed at some point."
1051 (defun minibuffer-smart-mouse-tracker (event)
1052 ;; Used as the mode-motion-hook of the minibuffer window, which is the
1053 ;; value of `mouse-grabbed-buffer' while the minibuffer is active. If
1054 ;; the word under the mouse is a valid minibuffer completion, then it
1057 ;; We do some special voodoo when we're reading a pathname, because
1058 ;; the way filename completion works is funny. Possibly there's some
1059 ;; more general way this could be dealt with...
1061 ;; We do some further voodoo when reading a pathname that is an
1062 ;; ange-ftp or efs path, because causing FTP activity as a result of
1063 ;; mouse motion is a really bad time.
1065 (and minibuffer-smart-completion-tracking-behavior
1067 ;; avoid conflict with display-completion-list extents
1068 (not (extent-at (event-point event)
1069 (event-buffer event)
1071 (let ((filename-kludge-p (eq minibuffer-completion-table
1072 'read-file-name-internal)))
1073 (mode-motion-highlight-internal
1075 #'(lambda () (default-mouse-track-beginning-of-word
1076 (if filename-kludge-p 'nonwhite t)))
1080 (default-mouse-track-end-of-word
1081 (if filename-kludge-p 'nonwhite t))
1082 (if (and (/= p (point)) minibuffer-completion-table)
1083 (setq string (buffer-substring p (point))))
1084 (if (string-match "\\`[ \t\n]*\\'" string)
1086 (if filename-kludge-p
1087 (setq string (minibuffer-smart-select-kludge-filename
1089 ;; try-completion bogusly returns a string even when
1090 ;; that string is complete if that string is also a
1091 ;; prefix for other completions. This means that we
1092 ;; can't just do the obvious thing, (eq t
1093 ;; (try-completion ...)).
1095 (if (and filename-kludge-p
1096 ;; #### evil evil evil evil
1097 (or (and (fboundp 'ange-ftp-ftp-path)
1098 (ange-ftp-ftp-path string))
1099 (and (fboundp 'efs-ftp-path)
1100 (efs-ftp-path string))))
1103 (try-completion string
1104 minibuffer-completion-table
1105 minibuffer-completion-predicate)))
1107 (and (equal comp string)
1108 (or (null minibuffer-completion-predicate)
1110 minibuffer-completion-predicate) ; ???
1111 (funcall minibuffer-completion-predicate
1113 minibuffer-completion-table)
1116 minibuffer-completion-table)
1118 (goto-char p))))))))))
1120 (defun minibuffer-smart-select-kludge-filename (string)
1122 (set-buffer mouse-grabbed-buffer) ; the minibuf
1123 (let ((kludge-string (concat (buffer-string) string)))
1124 (if (or (and (fboundp 'ange-ftp-ftp-path)
1125 (ange-ftp-ftp-path kludge-string))
1126 (and (fboundp 'efs-ftp-path) (efs-ftp-path kludge-string)))
1127 ;; #### evil evil evil, but more so.
1129 (append-expand-filename (buffer-string) string)))))
1131 (defun minibuffer-smart-select-highlighted-completion (event)
1132 "Select the highlighted text under the mouse as a minibuffer response.
1133 When the minibuffer is being used to prompt the user for a completion,
1134 any valid completions which are visible on the frame will highlight
1135 when the mouse moves over them. Clicking \\<minibuffer-local-map>\
1136 \\[minibuffer-smart-select-highlighted-completion] will select the
1137 highlighted completion under the mouse.
1139 If the mouse is clicked while not over a highlighted completion,
1140 then the global binding of \\[minibuffer-smart-select-highlighted-completion] \
1141 will be executed instead. In this\nway you can get at the normal global \
1142 behavior of \\[minibuffer-smart-select-highlighted-completion] as well as
1143 the special minibuffer behavior."
1145 (if minibuffer-smart-completion-tracking-behavior
1146 (minibuffer-smart-select-highlighted-completion-1 event t)
1147 (let ((command (lookup-key global-map
1148 (vector current-mouse-event))))
1149 (if command (call-interactively command)))))
1151 (defun minibuffer-smart-select-highlighted-completion-1 (event global-p)
1152 (let* ((filename-kludge-p (eq minibuffer-completion-table
1153 'read-file-name-internal))
1156 (evpoint (event-point event))
1157 (evextent (and evpoint (extent-at evpoint (event-buffer event)
1160 ;; avoid conflict with display-completion-list extents.
1161 ;; if we find one, do that behavior instead.
1162 (list-mode-item-selected-1 evextent event)
1164 (let* ((buffer (window-buffer (event-window event)))
1165 (p (event-point event))
1166 (extent (and p (extent-at p buffer 'mouse-face))))
1168 (if (not (and (extent-live-p extent)
1169 (eq (extent-object extent) (current-buffer))
1170 (not (extent-detached-p extent))))
1172 ;; ...else user has selected a highlighted completion.
1174 (buffer-substring (extent-start-position extent)
1175 (extent-end-position extent)))
1176 (if filename-kludge-p
1177 (setq completion (minibuffer-smart-select-kludge-filename
1179 ;; remove the extent so that it's not hanging around in
1181 (detach-extent extent)
1182 (set-buffer mouse-grabbed-buffer)
1184 (insert completion))))
1185 ;; we need to execute the command or do the throw outside of the
1187 (cond ((and command-p global-p)
1188 (let ((command (lookup-key global-map
1189 (vector current-mouse-event))))
1191 (call-interactively command)
1192 (if minibuffer-completion-table
1194 "Highlighted words are valid completions. You may select one.")
1195 (error "no completions")))))
1197 ;; things get confused if the minibuffer is terminated while
1199 (select-window (minibuffer-window))
1200 (if (and filename-kludge-p (file-directory-p completion))
1201 ;; if the user clicked middle on a directory name, display the
1202 ;; files in that directory.
1204 (goto-char (point-max))
1205 (minibuffer-completion-help))
1206 ;; otherwise, terminate input
1207 (throw 'exit nil)))))))
1209 (defun minibuffer-smart-maybe-select-highlighted-completion
1210 (event &optional click-count)
1211 "Like minibuffer-smart-select-highlighted-completion but does nothing if
1212 there is no completion (as opposed to executing the global binding). Useful
1213 as the value of `mouse-track-click-hook'."
1215 (minibuffer-smart-select-highlighted-completion-1 event nil))
1217 (define-key minibuffer-local-map 'button2
1218 'minibuffer-smart-select-highlighted-completion)
1221 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1222 ;;;; Minibuffer History ;;;;
1223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1225 (defvar minibuffer-history '()
1226 "Default minibuffer history list.
1227 This is used for all minibuffer input except when an alternate history
1228 list is specified.")
1230 ;; Some other history lists:
1232 (defvar minibuffer-history-search-history '())
1233 (defvar function-history '())
1234 (defvar variable-history '())
1235 (defvar buffer-history '())
1236 (defvar shell-command-history '())
1237 (defvar file-name-history '())
1239 (defvar read-expression-history nil)
1241 (defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge
1242 "Non-nil when doing history operations on `command-history'.
1243 More generally, indicates that the history list being acted on
1244 contains expressions rather than strings.")
1246 (defun previous-matching-history-element (regexp n)
1247 "Find the previous history element that matches REGEXP.
1248 \(Previous history elements refer to earlier actions.)
1249 With prefix argument N, search for Nth previous match.
1250 If N is negative, find the next or Nth next match."
1252 (let ((enable-recursive-minibuffers t)
1253 (minibuffer-history-sexp-flag nil)
1254 (minibuffer-max-depth (and minibuffer-max-depth
1255 (1+ minibuffer-max-depth))))
1256 (if (eq 't (symbol-value minibuffer-history-variable))
1257 (error "History is not being recorded in this context"))
1258 (list (read-from-minibuffer "Previous element matching (regexp): "
1259 (car minibuffer-history-search-history)
1260 minibuffer-local-map
1262 'minibuffer-history-search-history)
1263 (prefix-numeric-value current-prefix-arg))))
1264 (let ((history (symbol-value minibuffer-history-variable))
1266 (pos minibuffer-history-position))
1268 (error "History is not being recorded in this context"))
1271 (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
1273 (if (= pos 1) ;; rewritten for I18N3 snarfing
1274 (error "No later matching history item")
1275 (error "No earlier matching history item")))
1276 (if (string-match regexp
1277 (if minibuffer-history-sexp-flag
1278 (let ((print-level nil))
1279 (prin1-to-string (nth (1- pos) history)))
1280 (nth (1- pos) history)))
1281 (setq n (+ n (if (< n 0) 1 -1)))))
1282 (setq minibuffer-history-position pos)
1283 (setq current-minibuffer-contents (buffer-string)
1284 current-minibuffer-point (point))
1286 (let ((elt (nth (1- pos) history)))
1287 (insert (if minibuffer-history-sexp-flag
1288 (let ((print-level nil))
1289 (prin1-to-string elt))
1291 (goto-char (point-min)))
1292 (if (or (eq (car (car command-history)) 'previous-matching-history-element)
1293 (eq (car (car command-history)) 'next-matching-history-element))
1294 (setq command-history (cdr command-history))))
1296 (defun next-matching-history-element (regexp n)
1297 "Find the next history element that matches REGEXP.
1298 \(The next history element refers to a more recent action.)
1299 With prefix argument N, search for Nth next match.
1300 If N is negative, find the previous or Nth previous match."
1302 (let ((enable-recursive-minibuffers t)
1303 (minibuffer-history-sexp-flag nil)
1304 (minibuffer-max-depth (and minibuffer-max-depth
1305 (1+ minibuffer-max-depth))))
1306 (if (eq t (symbol-value minibuffer-history-variable))
1307 (error "History is not being recorded in this context"))
1308 (list (read-from-minibuffer "Next element matching (regexp): "
1309 (car minibuffer-history-search-history)
1310 minibuffer-local-map
1312 'minibuffer-history-search-history)
1313 (prefix-numeric-value current-prefix-arg))))
1314 (previous-matching-history-element regexp (- n)))
1316 (defun next-history-element (n)
1317 "Insert the next element of the minibuffer history into the minibuffer."
1319 (if (eq 't (symbol-value minibuffer-history-variable))
1320 (error "History is not being recorded in this context"))
1322 (when (eq minibuffer-history-position
1323 initial-minibuffer-history-position)
1324 (setq current-minibuffer-contents (buffer-string)
1325 current-minibuffer-point (point)))
1326 (let ((narg (- minibuffer-history-position n))
1327 (minimum (if minibuffer-default -1 0)))
1328 (cond ((< narg minimum)
1329 (error "No following item in %s" minibuffer-history-variable))
1330 ((> narg (length (symbol-value minibuffer-history-variable)))
1331 (error "No preceding item in %s" minibuffer-history-variable)))
1333 (setq minibuffer-history-position narg)
1334 (if (eq narg initial-minibuffer-history-position)
1336 (insert current-minibuffer-contents)
1337 (goto-char current-minibuffer-point))
1338 (let ((elt (if (>= narg 0)
1339 (nth (1- minibuffer-history-position)
1340 (symbol-value minibuffer-history-variable))
1341 minibuffer-default)))
1343 (if (not (stringp elt))
1344 (let ((print-level nil))
1346 (let ((print-readably t)
1347 (print-escape-newlines t))
1348 (prin1-to-string elt))
1349 (error (prin1-to-string elt))))
1351 ;; FSF has point-min here.
1352 (goto-char (point-max))))))
1354 (defun previous-history-element (n)
1355 "Insert the previous element of the minibuffer history into the minibuffer."
1357 (next-history-element (- n)))
1359 (defun next-complete-history-element (n)
1360 "Get next element of history which is a completion of minibuffer contents."
1362 (let ((point-at-start (point)))
1363 (next-matching-history-element
1364 (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
1365 ;; next-matching-history-element always puts us at (point-min).
1366 ;; Move to the position we were at before changing the buffer contents.
1367 ;; This is still sensical, because the text before point has not changed.
1368 (goto-char point-at-start)))
1370 (defun previous-complete-history-element (n)
1371 "Get previous element of history which is a completion of minibuffer contents."
1373 (next-complete-history-element (- n)))
1376 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1377 ;;;; reading various things from a minibuffer ;;;;
1378 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1380 (defun read-expression (prompt &optional initial-contents history)
1381 "Return a Lisp object read using the minibuffer.
1382 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1383 is a string to insert in the minibuffer before reading.
1384 Third arg HISTORY, if non-nil, specifies a history list."
1385 (let ((minibuffer-history-sexp-flag t)
1386 ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
1387 (minibuffer-completion-table nil))
1388 (read-from-minibuffer prompt
1392 (or history 'read-expression-history)
1393 lisp-mode-abbrev-table)))
1395 (defun read-string (prompt &optional initial-contents history)
1396 "Return a string from the minibuffer, prompting with string PROMPT.
1397 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
1398 in the minibuffer before reading.
1399 Third arg HISTORY, if non-nil, specifies a history list."
1400 (let ((minibuffer-completion-table nil))
1401 (read-from-minibuffer prompt
1403 minibuffer-local-map
1406 (defun eval-minibuffer (prompt &optional initial-contents history)
1407 "Return value of Lisp expression read using the minibuffer.
1408 Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
1409 is a string to insert in the minibuffer before reading.
1410 Third arg HISTORY, if non-nil, specifies a history list."
1411 (eval (read-expression prompt initial-contents history)))
1413 ;; The name `command-history' is already taken
1414 (defvar read-command-history '())
1416 (defun read-command (prompt)
1417 "Read the name of a command and return as a symbol.
1418 Prompts with PROMPT."
1419 (intern (completing-read prompt obarray 'commandp t nil
1420 ;; 'command-history is not right here: that's a
1421 ;; list of evalable forms, not a history list.
1422 'read-command-history
1425 (defun read-function (prompt)
1426 "Read the name of a function and return as a symbol.
1427 Prompts with PROMPT."
1428 (intern (completing-read prompt obarray 'fboundp t nil
1429 'function-history)))
1431 (defun read-variable (prompt)
1432 "Read the name of a user variable and return it as a symbol.
1433 Prompts with PROMPT.
1434 A user variable is one whose documentation starts with a `*' character."
1435 (intern (completing-read prompt obarray 'user-variable-p t nil
1436 'variable-history)))
1438 (defun read-buffer (prompt &optional default require-match)
1439 "Read the name of a buffer and return as a string.
1440 Prompts with PROMPT. Optional second arg DEFAULT is value to return if user
1441 enters an empty line. If optional third arg REQUIRE-MATCH is non-nil,
1442 only existing buffer names are allowed."
1443 (let ((prompt (if default
1444 (format "%s(default %s) "
1445 (gettext prompt) (if (bufferp default)
1446 (buffer-name default)
1449 (alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
1453 (setq result (completing-read prompt alist nil require-match
1455 (if (bufferp default)
1456 (buffer-name default)
1458 (cond ((not (equal result ""))
1460 ((not require-match)
1461 (setq result default)
1465 ((not (get-buffer default))
1468 (setq result default)
1470 (if (bufferp result)
1471 (buffer-name result)
1474 (defun read-number (prompt &optional integers-only)
1475 "Read a number from the minibuffer."
1476 (let ((pred (if integers-only 'integerp 'numberp))
1478 (while (not (funcall pred num))
1479 (setq num (condition-case ()
1480 (let ((minibuffer-completion-table nil))
1481 (read-from-minibuffer
1482 prompt (if num (prin1-to-string num)) nil t
1485 (invalid-read-syntax nil)
1487 (or (funcall pred num) (beep)))
1490 (defun read-shell-command (prompt &optional initial-input history)
1491 "Just like read-string, but uses read-shell-command-map:
1492 \\{read-shell-command-map}"
1493 (let ((minibuffer-completion-table nil))
1494 (read-from-minibuffer prompt initial-input read-shell-command-map
1495 nil (or history 'shell-command-history))))
1498 ;;; This read-file-name stuff probably belongs in files.el
1500 ;; Quote "$" as "$$" to get it past substitute-in-file-name
1501 (defun un-substitute-in-file-name (string)
1502 (let ((regexp "\\$")
1503 (olen (length string))
1506 (if (not (string-match regexp string))
1509 (while (string-match regexp string (match-end 0))
1511 (setq new (make-string (+ olen n) ?$))
1514 (setq ch (aref string o))
1516 (setq o (1+ o) n (1+ n))
1518 ;; already aset by make-string initial-value
1522 (defun read-file-name-2 (history prompt dir default
1523 must-match initial-contents
1526 (setq dir default-directory))
1527 (setq dir (abbreviate-file-name dir t))
1528 (let* ((insert (cond ((and (not insert-default-directory)
1529 (not initial-contents))
1532 (cons (un-substitute-in-file-name
1533 (concat dir initial-contents))
1536 (un-substitute-in-file-name dir))))
1538 ;; Hateful, broken, case-sensitive un*x
1539 ;;; (completing-read prompt
1545 ;; #### - this is essentially the guts of completing read.
1546 ;; There should be an elegant way to pass a pair of keymaps to
1547 ;; completing read, but this will do for now. All sins are
1549 (let ((minibuffer-completion-table completer)
1550 (minibuffer-completion-predicate dir)
1551 (minibuffer-completion-confirm (if (eq must-match 't)
1553 (last-exact-completion nil))
1554 (read-from-minibuffer prompt
1556 (if (not must-match)
1558 read-file-name-must-match-map)
1563 ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar"
1564 ;;; (let ((hist (cond ((not history) 'minibuffer-history)
1565 ;;; ((consp history) (car history))
1569 ;;; (not (eq hist 't))
1571 ;;; (equal (car-safe (symbol-value hist)) val))
1572 ;;; (let ((e (condition-case nil
1573 ;;; (expand-file-name val)
1575 ;;; (if (and e (not (equal e val)))
1576 ;;; (set hist (cons e (cdr (symbol-value hist))))))))
1579 (error "No file name specified"))
1581 (equal val (if (consp insert) (car insert) insert)))
1584 (substitute-in-file-name val)))))
1586 ;; #### this function should use minibuffer-completion-table
1587 ;; or something. But that is sloooooow.
1588 ;; #### all this shit needs better documentation!!!!!!!!
1589 (defun read-file-name-activate-callback (event extent dir-p)
1590 ;; used as the activate-callback of the filename list items
1591 ;; in the completion buffer, in place of default-choose-completion.
1592 ;; if a regular file was selected, we call default-choose-completion
1593 ;; (which just inserts the string in the minibuffer and calls
1594 ;; exit-minibuffer). If a directory was selected, we display
1595 ;; the contents of the directory.
1596 (let* ((file (extent-string extent))
1597 (completion-buf (extent-object extent))
1598 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
1600 (in-dir (file-name-directory (buffer-substring nil nil minibuf)))
1601 (full (expand-file-name file in-dir)))
1602 (if (not (file-directory-p full))
1603 (default-choose-completion event extent minibuf)
1604 (erase-buffer minibuf)
1605 (insert-string (file-name-as-directory
1606 (abbreviate-file-name full t)) minibuf)
1607 (reset-buffer completion-buf)
1608 (let ((standard-output completion-buf))
1609 (display-completion-list
1610 (delete "." (directory-files full nil nil nil (if dir-p 'directory)))
1612 :reference-buffer minibuf
1613 :activate-callback 'read-file-name-activate-callback)
1614 (goto-char (point-min) completion-buf)))))
1616 (defun read-file-name-1 (history prompt dir default
1617 must-match initial-contents
1619 (if (should-use-dialog-box-p)
1620 ;; this calls read-file-name-2
1621 (mouse-read-file-name-1 history prompt dir default must-match
1622 initial-contents completer)
1625 ;; #### SCREAM! Create a `file-system-ignore-case'
1626 ;; function, so this kind of stuff is generalized!
1627 (and (eq system-type 'windows-nt)
1628 (set (make-local-variable 'completion-ignore-case) t))
1630 (make-local-variable
1631 'completion-display-completion-list-function)
1632 #'(lambda (completions)
1633 (display-completion-list
1635 :user-data (not (eq completer 'read-file-name-internal))
1637 'read-file-name-activate-callback)))
1639 (remove-hook 'minibuffer-setup-hook rfhookfun)
1643 (add-hook 'minibuffer-setup-hook rfhookfun)
1644 (read-file-name-2 history prompt dir default must-match
1645 initial-contents completer))
1646 (remove-hook 'minibuffer-setup-hook rfhookfun)))))
1648 (defun read-file-name (prompt
1649 &optional dir default must-match initial-contents
1651 "Read file name, prompting with PROMPT and completing in directory DIR.
1652 This will prompt with a dialog box if appropriate, according to
1653 `should-use-dialog-box-p'.
1654 Value is not expanded---you must call `expand-file-name' yourself.
1655 Value is subject to interpretation by `substitute-in-file-name' however.
1656 Default name to DEFAULT if user enters a null string.
1657 (If DEFAULT is omitted, the visited file name is used,
1658 except that if INITIAL-CONTENTS is specified, that combined with DIR is
1660 Fourth arg MUST-MATCH non-nil means require existing file's name.
1661 Non-nil and non-t means also require confirmation after completion.
1662 Fifth arg INITIAL-CONTENTS specifies text to start with.
1663 Sixth arg HISTORY specifies the history list to use. Default is
1664 `file-name-history'.
1665 DIR defaults to current buffer's directory default."
1667 (or history 'file-name-history)
1668 prompt dir (or default
1669 (if initial-contents (expand-file-name initial-contents dir)
1671 must-match initial-contents
1672 ;; A separate function (not an anonymous lambda-expression)
1673 ;; and passed as a symbol because of disgusting kludges in various
1674 ;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...)
1675 'read-file-name-internal))
1677 (defun read-directory-name (prompt
1678 &optional dir default must-match initial-contents
1680 "Read directory name, prompting with PROMPT and completing in directory DIR.
1681 This will prompt with a dialog box if appropriate, according to
1682 `should-use-dialog-box-p'.
1683 Value is not expanded---you must call `expand-file-name' yourself.
1684 Value is subject to interpreted by substitute-in-file-name however.
1685 Default name to DEFAULT if user enters a null string.
1686 (If DEFAULT is omitted, the current buffer's default directory is used.)
1687 Fourth arg MUST-MATCH non-nil means require existing directory's name.
1688 Non-nil and non-t means also require confirmation after completion.
1689 Fifth arg INITIAL-CONTENTS specifies text to start with.
1690 Sixth arg HISTORY specifies the history list to use. Default is
1691 `file-name-history'.
1692 DIR defaults to current buffer's directory default."
1694 (or history 'file-name-history)
1695 prompt dir (or default default-directory) must-match initial-contents
1696 'read-directory-name-internal))
1699 ;; Environment-variable and ~username completion hack
1700 (defun read-file-name-internal-1 (string dir action completer)
1701 (if (not (string-match
1702 "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
1704 ;; Not doing environment-variable completion hack
1705 (let* ((orig (if (equal string "") nil string))
1706 (sstring (if orig (substitute-in-file-name string) string))
1707 (specdir (if orig (file-name-directory sstring) nil))
1708 (name (if orig (file-name-nondirectory sstring) string))
1709 (direct (if specdir (expand-file-name specdir dir) dir)))
1710 ;; ~username completion
1711 (if (and (fboundp 'user-name-completion-1)
1712 (string-match "^[~]" name))
1713 (let ((user (substring name 1)))
1714 (cond ((eq action 'lambda)
1715 (file-directory-p name))
1718 (mapcar #'(lambda (p) (concat "~" p))
1719 (user-name-all-completions user)))
1722 (let* ((val+uniq (user-name-completion-1 user))
1723 (val (car val+uniq))
1724 (uniq (cdr val+uniq)))
1725 (cond ((stringp val)
1727 (file-name-as-directory (concat "~" val))
1730 (file-name-as-directory name))
1739 ;; An odd number of trailing $'s
1740 (let* ((start (match-beginning 3))
1741 (env (substring string
1742 (cond ((= start (length string))
1745 ((= (aref string start) ?{)
1750 (head (substring string 0 (1- start)))
1752 (mapcar #'(lambda (x)
1753 (cons (substring x 0 (string-match "=" x))
1755 process-environment))))
1757 (cond ((eq action 'lambda)
1761 (mapcar #'(lambda (p)
1762 (if (and (> (length p) 0)
1763 ;;#### Unix-specific
1764 ;;#### -- need absolute-pathname-p
1767 (concat head "$" p)))
1768 (all-completions env (funcall alist))))
1771 (let* ((e (funcall alist))
1772 (val (try-completion env e)))
1773 (cond ((stringp val)
1774 (if (string-match "[^A-Za-z0-9_]" val)
1777 ;; completed uniquely?
1778 (if (eq (try-completion val e) 't)
1780 (concat head "$" val)))
1783 (un-substitute-in-file-name (getenv env))))
1787 (defun read-file-name-internal (string dir action)
1788 (read-file-name-internal-1
1790 #'(lambda (action orig string specdir dir name)
1791 (cond ((eq action 'lambda)
1794 (let ((sstring (condition-case nil
1795 (expand-file-name string)
1798 ;; Some pathname syntax error in string
1800 (file-exists-p sstring)))))
1803 (mapcar #'un-substitute-in-file-name
1804 (file-name-all-completions name dir)))
1807 (let* ((d (or dir default-directory))
1808 (val (file-name-completion name d)))
1809 (if (and (eq val 't)
1810 (not (null completion-ignored-extensions)))
1811 ;;#### (file-name-completion "foo") returns 't
1812 ;; when both "foo" and "foo~" exist and the latter
1813 ;; is "pruned" by completion-ignored-extensions.
1814 ;; I think this is a bug in file-name-completion.
1815 (setq val (let ((completion-ignored-extensions '()))
1816 (file-name-completion name d))))
1818 (un-substitute-in-file-name (if specdir
1819 (concat specdir val)
1821 (let ((tem (un-substitute-in-file-name string)))
1822 (if (not (equal tem orig))
1823 ;; substitute-in-file-name did something
1827 (defun read-directory-name-internal (string dir action)
1828 (read-file-name-internal-1
1830 #'(lambda (action orig string specdir dir name)
1831 (let* ((dirs #'(lambda (fn)
1832 (let ((l (if (equal name "")
1842 (concat "\\`" (regexp-quote name))
1848 (cond ((eq action 'lambda)
1852 (file-directory-p string)))
1855 (funcall dirs #'(lambda (n)
1856 (un-substitute-in-file-name
1857 (file-name-as-directory n)))))
1860 (let ((val (try-completion
1864 (list (file-name-as-directory
1867 (un-substitute-in-file-name (if specdir
1868 (concat specdir val)
1870 (let ((tem (un-substitute-in-file-name string)))
1871 (if (not (equal tem orig))
1872 ;; substitute-in-file-name did something
1876 (defun append-expand-filename (file-string string)
1877 "Append STRING to FILE-STRING differently depending on whether STRING
1878 is a username (~string), an environment variable ($string),
1879 or a filename (/string). The resultant string is returned with the
1880 environment variable or username expanded and resolved to indicate
1881 whether it is a file(/result) or a directory (/result/)."
1883 (cond ((string-match "\\([~$]\\)\\([^~$/]*\\)$" file-string)
1884 (cond ((string= (substring file-string
1887 (concat (substring file-string 0 (match-end 1))
1889 (t (substitute-in-file-name
1890 (concat (substring file-string 0 (match-end 1))
1892 (t (concat (file-name-directory
1893 (substitute-in-file-name file-string)) string))))
1896 (cond ((stringp (setq result (and (file-exists-p (expand-file-name file))
1897 (read-file-name-internal
1899 (expand-file-name file)
1905 (defun mouse-file-display-completion-list (window dir minibuf user-data)
1906 (let ((standard-output (window-buffer window)))
1908 (display-completion-list
1909 (directory-files dir nil nil nil t)
1910 :window-width (* 2 (window-width window))
1912 'mouse-read-file-name-activate-callback
1913 :user-data user-data
1914 :reference-buffer minibuf
1918 (defun mouse-directory-display-completion-list (window dir minibuf user-data)
1919 (let ((standard-output (window-buffer window)))
1921 (display-completion-list
1922 (delete "." (directory-files dir nil nil nil 1))
1923 :window-width (window-width window)
1925 'mouse-read-file-name-activate-callback
1926 :user-data user-data
1927 :reference-buffer minibuf
1931 (defun mouse-read-file-name-activate-callback (event extent user-data)
1932 (let* ((file (extent-string extent))
1933 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
1934 (extent-object extent)))
1935 (in-dir (buffer-substring nil nil minibuf))
1936 (full (expand-file-name file in-dir))
1937 (filebuf (nth 0 user-data))
1938 (dirbuff (nth 1 user-data))
1939 (filewin (nth 2 user-data))
1940 (dirwin (nth 3 user-data)))
1941 (if (file-regular-p full)
1942 (default-choose-completion event extent minibuf)
1943 (erase-buffer minibuf)
1944 (insert-string (file-name-as-directory
1945 (abbreviate-file-name full t)) minibuf)
1946 (reset-buffer filebuf)
1948 (mouse-directory-display-completion-list filewin full minibuf
1950 (mouse-file-display-completion-list filewin full minibuf user-data)
1951 (reset-buffer dirbuff)
1952 (mouse-directory-display-completion-list dirwin full minibuf
1955 ;; this is rather cheesified but gets the job done.
1956 (defun mouse-read-file-name-1 (history prompt dir default
1957 must-match initial-contents
1959 (let* ((file-p (eq 'read-file-name-internal completer))
1960 (filebuf (get-buffer-create "*Completions*"))
1961 (dirbuff (and file-p (generate-new-buffer " *mouse-read-file*")))
1962 (butbuff (generate-new-buffer " *mouse-read-file*"))
1963 (frame (make-dialog-frame))
1968 (reset-buffer filebuf)
1969 (select-frame frame)
1970 (let ((window-min-height 1))
1971 ;; #### should be 2 not 3, but that causes
1972 ;; "window too small to split" errors for some
1973 ;; people (but not for me ...) There's a more
1974 ;; fundamental bug somewhere.
1975 (split-window nil (- (frame-height frame) 3)))
1978 (split-window-horizontally 16)
1979 (setq filewin (frame-rightmost-window frame)
1980 dirwin (frame-leftmost-window frame))
1981 (set-window-buffer filewin filebuf)
1982 (set-window-buffer dirwin dirbuff))
1983 (setq filewin (frame-highest-window frame))
1984 (set-window-buffer filewin filebuf))
1985 (setq user-data (list filebuf dirbuff filewin dirwin))
1986 (set-window-buffer (frame-lowest-window frame) butbuff)
1987 (set-buffer butbuff)
1989 (setq default-directory dir))
1990 (when (featurep 'scrollbar)
1991 (set-specifier scrollbar-width 0 butbuff))
1993 (insert-gui-button (make-gui-button "OK"
1995 (exit-minibuffer))))
1997 (insert-gui-button (make-gui-button "Cancel"
1999 (abort-recursive-edit))))
2003 (mouse-directory-display-completion-list
2004 filewin dir (current-buffer) user-data)
2005 (mouse-file-display-completion-list filewin dir
2008 (mouse-directory-display-completion-list dirwin dir
2012 (make-local-variable
2013 'completion-display-completion-list-function)
2014 #'(lambda (completions)
2015 (display-completion-list
2019 'mouse-read-file-name-activate-callback
2020 :user-data user-data)))
2022 (remove-hook 'minibuffer-setup-hook rfhookfun)
2026 ;; #### I really need to flesh out the object
2027 ;; hierarchy better to avoid these kludges.
2030 (set-buffer standard-output)
2031 (setq truncate-lines t)))))
2034 (add-hook 'minibuffer-setup-hook rfhookfun)
2035 (add-hook 'completion-setup-hook rfcshookfun)
2036 (read-file-name-2 history prompt dir default
2037 must-match initial-contents
2039 (remove-hook 'minibuffer-setup-hook rfhookfun)
2040 (remove-hook 'completion-setup-hook rfcshookfun))))
2041 (delete-frame frame)
2042 (kill-buffer filebuf)
2043 (kill-buffer butbuff)
2044 (and dirbuff (kill-buffer dirbuff)))))
2046 (defun read-face (prompt &optional must-match)
2047 "Read the name of a face from the minibuffer and return it as a symbol."
2048 (intern (completing-read prompt obarray 'find-face must-match)))
2050 ;; #### - wrong place for this variable? Exactly. We probably want
2051 ;; `color-list' to be a console method, so `tty-color-list' becomes
2052 ;; obsolete, and `read-color-completion-table' conses (mapcar #'list
2053 ;; (color-list)), optionally caching the results.
2055 ;; Ben wanted all of the possibilities from the `configure' script used
2056 ;; here, but I think this is way too many. I already trimmed the R4 variants
2057 ;; and a few obvious losers from the list. --Stig
2058 (defvar x-library-search-path '("/usr/X11R6/lib/X11/"
2059 "/usr/X11R5/lib/X11/"
2060 "/usr/lib/X11R6/X11/"
2061 "/usr/lib/X11R5/X11/"
2062 "/usr/local/X11R6/lib/X11/"
2063 "/usr/local/X11R5/lib/X11/"
2064 "/usr/local/lib/X11R6/X11/"
2065 "/usr/local/lib/X11R5/X11/"
2068 "/usr/local/lib/X11/"
2069 "/usr/X386/lib/X11/"
2070 "/usr/x386/lib/X11/"
2071 "/usr/XFree86/lib/X11/"
2072 "/usr/unsupported/lib/X11/"
2073 "/usr/athena/lib/X11/"
2074 "/usr/local/x11r5/lib/X11/"
2075 "/usr/lpp/Xamples/lib/X11/"
2076 "/usr/openwin/lib/X11/"
2077 "/usr/openwin/share/lib/X11/")
2078 "Search path used by `read-color' to find rgb.txt.")
2080 (defvar x-read-color-completion-table)
2082 (defun read-color-completion-table ()
2084 ;; #### Evil device-type dependency
2086 (if (boundp 'x-read-color-completion-table)
2087 x-read-color-completion-table
2088 (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
2091 ;; prevents multiple searches for rgb.txt if we can't find it
2092 (setq x-read-color-completion-table nil)
2093 (with-current-buffer (get-buffer-create " *colors*")
2094 (reset-buffer (current-buffer))
2095 (insert-file-contents rgb-file)
2097 ;; skip over comments
2098 (while (looking-at "^!")
2101 (skip-chars-forward "0-9 \t")
2104 (setq color (buffer-substring p (point))
2105 clist (cons (list color) clist))
2106 ;; Ugh. If we want to be able to complete the lowercase form
2107 ;; of the color name, we need to add it twice! Yuck.
2108 (let ((dcase (downcase color)))
2109 (or (string= dcase color)
2110 (push (list dcase) clist)))
2112 (kill-buffer (current-buffer))))
2113 (setq x-read-color-completion-table clist)
2114 x-read-color-completion-table)))
2116 (mapcar #'list (mswindows-color-list)))
2118 (mapcar #'list (tty-color-list)))))
2120 (defun read-color (prompt &optional must-match initial-contents)
2121 "Read the name of a color from the minibuffer.
2122 On X devices, this uses `x-library-search-path' to find rgb.txt in order
2123 to build a completion table.
2124 On TTY devices, this uses `tty-color-list'.
2125 On mswindows devices, this uses `mswindows-color-list'."
2126 (let ((table (read-color-completion-table)))
2127 (completing-read prompt table nil (and table must-match)
2131 ;; #### The doc string for read-non-nil-coding system gets lost if we
2132 ;; only include these if the mule feature is present. Strangely,
2133 ;; read-coding-system doesn't.
2135 ;;(if (featurep 'mule)
2137 (defun read-coding-system (prompt &optional default-coding-system)
2138 "Read a coding-system (or nil) from the minibuffer.
2139 Prompting with string PROMPT.
2140 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM.
2141 DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object."
2142 (intern (completing-read prompt obarray 'find-coding-system t nil nil
2143 (cond ((symbolp default-coding-system)
2144 (symbol-name default-coding-system))
2145 ((coding-system-p default-coding-system)
2146 (symbol-name (coding-system-name default-coding-system)))
2148 default-coding-system)))))
2150 (defun read-non-nil-coding-system (prompt)
2151 "Read a non-nil coding-system from the minibuffer.
2152 Prompt with string PROMPT."
2153 (let ((retval (intern "")))
2154 (while (= 0 (length (symbol-name retval)))
2155 (setq retval (intern (completing-read prompt obarray
2160 ;;) ;; end of (featurep 'mule)
2164 (defcustom force-dialog-box-use nil
2165 "*If non-nil, always use a dialog box for asking questions, if possible.
2166 You should *bind* this, not set it. This is useful if you're doing
2167 something mousy but which wasn't actually invoked using the mouse."
2171 ;; We include this here rather than dialog.el so it is defined
2172 ;; even when dialog boxes are not present.
2173 (defun should-use-dialog-box-p ()
2174 "If non-nil, questions should be asked with a dialog box instead of the
2175 minibuffer. This looks at `last-command-event' to see if it was a mouse
2176 event, and checks whether dialog-support exists and the current device
2177 supports dialog boxes.
2179 The dialog box is totally disabled if the variable `use-dialog-box'
2181 (and (featurep 'dialog)
2182 (device-on-window-system-p)
2184 (or force-dialog-box-use
2185 (button-press-event-p last-command-event)
2186 (button-release-event-p last-command-event)
2187 (misc-user-event-p last-command-event))))
2189 ;;; minibuf.el ends here