xemacs-beta: lisp/minibuf.el comparison

comparison lisp/minibuf.el @ 428:3ecd8885ac67 r21-2-22

Import from CVS: tag r21-2-22

author	cvs
date	Mon, 13 Aug 2007 11:28:15 +0200
parents
children	a5df635868b2

comparison

equal deleted inserted replaced

-:0a0253eac470
+:3ecd8885ac67
+;;; minibuf.el --- Minibuffer functions for XEmacs
+;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Tinker Systems
+;; Copyright (C) 1995, 1996 Ben Wing
+;; Author: Richard Mlynarik
+;; Created: 2-Oct-92
+;; Maintainer: XEmacs Development Team
+;; Keywords: internal, dumped
+;; This file is part of XEmacs.
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;; Synched up with: all the minibuffer history stuff is synched with
+;;; 19.30.  Not sure about the rest.
+;;; Commentary:
+;; This file is dumped with XEmacs.
+;; Written by Richard Mlynarik 2-Oct-92
+;; 06/11/1997 -  Use char-(after|before) instead of
+;;  (following|preceding)-char. -slb
+;;; Code:
+(defgroup minibuffer nil
+"Controling the behavior of the minibuffer."
+:group 'environment)
+(defcustom insert-default-directory t
+"*Non-nil means when reading a filename start with default dir in minibuffer."
+:type 'boolean
+:group 'minibuffer)
+(defcustom minibuffer-history-uniquify t
+"*Non-nil means when adding an item to a minibuffer history, remove
+previous occurances of the same item from the history list first,
+rather than just consing the new element onto the front of the list."
+:type 'boolean
+:group 'minibuffer)
+(defvar minibuffer-completion-table nil
+"Alist or obarray used for completion in the minibuffer.
+This becomes the ALIST argument to `try-completion' and `all-completions'.
+The value may alternatively be a function, which is given three arguments:
+STRING, the current buffer contents;
+PREDICATE, the predicate for filtering possible matches;
+CODE, which says what kind of things to do.
+CODE can be nil, t or `lambda'.
+nil means to return the best completion of STRING, nil if there is none,
+or t if it is already a unique completion.
+t means to return a list of all possible completions of STRING.
+`lambda' means to return t if STRING is a valid completion as it stands.")
+(defvar minibuffer-completion-predicate nil
+"Within call to `completing-read', this holds the PREDICATE argument.")
+(defvar minibuffer-completion-confirm nil
+"Non-nil => demand confirmation of completion before exiting minibuffer.")
+(defvar minibuffer-confirm-incomplete nil
+"If true, then in contexts where completing-read allows answers which
+are not valid completions, an extra RET must be typed to confirm the
+response.  This is helpful for catching typos, etc.")
+(defcustom completion-auto-help t
+"*Non-nil means automatically provide help for invalid completion input."
+:type 'boolean
+:group 'minibuffer)
+(defcustom enable-recursive-minibuffers nil
+"*Non-nil means to allow minibuffer commands while in the minibuffer.
+More precisely, this variable makes a difference when the minibuffer window
+is the selected window.  If you are in some other window, minibuffer commands
+are allowed even if a minibuffer is active."
+:type 'boolean
+:group 'minibuffer)
+(defcustom minibuffer-max-depth 1
+;; See comment in #'minibuffer-max-depth-exceeded
+"*Global maximum number of minibuffers allowed;
+compare to enable-recursive-minibuffers, which is only consulted when the
+minibuffer is reinvoked while it is the selected window."
+:type '(choice integer
+		 (const :tag "Indefinite" nil))
+:group 'minibuffer)
+;; Moved to C.  The minibuffer prompt must be setup before this is run
+;; and that can only be done from the C side.
+;(defvar minibuffer-setup-hook nil
+;  "Normal hook run just after entry to minibuffer.")
+(defvar minibuffer-exit-hook nil
+"Normal hook run just after exit from minibuffer.")
+(defvar minibuffer-help-form nil
+"Value that `help-form' takes on inside the minibuffer.")
+(defvar minibuffer-default nil
+"Default value for minibuffer input.")
+(defvar minibuffer-local-map
+(let ((map (make-sparse-keymap 'minibuffer-local-map)))
+map)
+"Default keymap to use when reading from the minibuffer.")
+(defvar minibuffer-local-completion-map
+(let ((map (make-sparse-keymap 'minibuffer-local-completion-map)))
+(set-keymap-parents map (list minibuffer-local-map))
+map)
+"Local keymap for minibuffer input with completion.")
+(defvar minibuffer-local-must-match-map
+(let ((map (make-sparse-keymap 'minibuffer-must-match-map)))
+(set-keymap-parents map (list minibuffer-local-completion-map))
+map)
+"Local keymap for minibuffer input with completion, for exact match.")
+;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
+(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el
+(define-key minibuffer-local-map "\r" 'exit-minibuffer)
+(define-key minibuffer-local-map "\n" 'exit-minibuffer)
+;; Historical crock.  Unused by anything but user code, if even that
+;(defvar minibuffer-local-ns-map
+;  (let ((map (make-sparse-keymap 'minibuffer-local-ns-map)))
+;    (set-keymap-parents map (list minibuffer-local-map))
+;    map)
+;  "Local keymap for the minibuffer when spaces are not allowed.")
+;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer)
+;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer)
+;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit)
+(define-key minibuffer-local-completion-map "\t" 'minibuffer-complete)
+(define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
+(define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help)
+(define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit)
+(define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit)
+(define-key minibuffer-local-map "\M-n" 'next-history-element)
+(define-key minibuffer-local-map "\M-p" 'previous-history-element)
+(define-key minibuffer-local-map '[next]  "\M-n")
+(define-key minibuffer-local-map '[prior] "\M-p")
+(define-key minibuffer-local-map "\M-r" 'previous-matching-history-element)
+(define-key minibuffer-local-map "\M-s" 'next-matching-history-element)
+(define-key minibuffer-local-must-match-map [next]
+'next-complete-history-element)
+(define-key minibuffer-local-must-match-map [prior]
+'previous-complete-history-element)
+;; This is an experiment--make up and down arrows do history.
+(define-key minibuffer-local-map [up] 'previous-history-element)
+(define-key minibuffer-local-map [down] 'next-history-element)
+(define-key minibuffer-local-completion-map [up] 'previous-history-element)
+(define-key minibuffer-local-completion-map [down] 'next-history-element)
+(define-key minibuffer-local-must-match-map [up] 'previous-history-element)
+(define-key minibuffer-local-must-match-map [down] 'next-history-element)
+(defvar read-expression-map (let ((map (make-sparse-keymap
+					'read-expression-map)))
+(set-keymap-parents map
+						  (list minibuffer-local-map))
+(define-key map "\M-\t" 'lisp-complete-symbol)
+map)
+"Minibuffer keymap used for reading Lisp expressions.")
+(defvar read-shell-command-map
+(let ((map (make-sparse-keymap 'read-shell-command-map)))
+(set-keymap-parents map (list minibuffer-local-map))
+(define-key map "\t" 'comint-dynamic-complete)
+(define-key map "\M-\t" 'comint-dynamic-complete)
+(define-key map "\M-?" 'comint-dynamic-list-completions)
+map)
+"Minibuffer keymap used by shell-command and related commands.")
+(defcustom use-dialog-box t
+"*Variable controlling usage of the dialog box.
+If nil, the dialog box will never be used, even in response to mouse events."
+:type 'boolean
+:group 'minibuffer)
+(defcustom minibuffer-electric-file-name-behavior t
+"*If non-nil, slash and tilde in certain places cause immediate deletion.
+These are the same places where this behavior would occur later on anyway,
+in `substitute-in-file-name'."
+:type 'boolean
+:group 'minibuffer)
+;; originally by Stig@hackvan.com
+(defun minibuffer-electric-separator ()
+(interactive)
+(let ((c last-command-char))
+(and minibuffer-electric-file-name-behavior
+	 (eq c directory-sep-char)
+	 (eq c (char-before (point)))
+	 (not (save-excursion
+	      (goto-char (point-min))
+	      (and (looking-at "/.+:~?[^/]*/.+")
+		   (re-search-forward "^/.+:~?[^/]*" nil t)
+		   (progn
+		     (delete-region (point) (point-max))
+		     t))))
+	 (not (save-excursion
+		(goto-char (point-min))
+		(and (looking-at ".+://[^/]*/.+")
+		     (re-search-forward "^.+:/" nil t)
+		     (progn
+		       (delete-region (point) (point-max))
+		       t))))
+	 ;; permit `//hostname/path/to/file'
+	 (not (eq (point) (1+ (point-min))))
+	 ;; permit `http://url/goes/here'
+	 (or (not (eq ?: (char-after (- (point) 2))))
+	     (eq ?/ (char-after (point-min))))
+(delete-region (point-min) (point)))
+(insert c)))
+(defun minibuffer-electric-tilde ()
+(interactive)
+(and minibuffer-electric-file-name-behavior
+(eq directory-sep-char (char-before (point)))
+;; permit URL's with //, for e.g. http://hostname/~user
+(not (save-excursion (search-backward "//" nil t)))
+(delete-region (point-min) (point)))
+(insert ?~))
+(defvar read-file-name-map
+(let ((map (make-sparse-keymap 'read-file-name-map)))
+(set-keymap-parents map (list minibuffer-local-completion-map))
+(define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
+(define-key map "~" 'minibuffer-electric-tilde)
+map
+))
+(defvar read-file-name-must-match-map
+(let ((map (make-sparse-keymap 'read-file-name-map)))
+(set-keymap-parents map (list minibuffer-local-must-match-map))
+(define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
+(define-key map "~" 'minibuffer-electric-tilde)
+map
+))
+(defun minibuffer-keyboard-quit ()
+"Abort recursive edit.
+If `zmacs-regions' is true, and the zmacs region is active in this buffer,
+then this key deactivates the region without beeping."
+(interactive)
+(if (and (region-active-p)
+	   (eq (current-buffer) (zmacs-region-buffer)))
+;; pseudo-zmacs compatibility: don't beep if this ^G is simply
+;; deactivating the region.  If it is inactive, beep.
+nil
+(abort-recursive-edit)))
+;;;; Guts of minibuffer invocation
+;;#### The only things remaining in C are
+;; "Vminibuf_prompt" and the display junk
+;;  "minibuf_prompt_width" and "minibuf_prompt_pix_width"
+;; Also "active_frame", though I suspect I could already
+;;   hack that in Lisp if I could make any sense of the
+;;   complete mess of frame/frame code in XEmacs.
+;; Vminibuf_prompt could easily be made Lisp-bindable.
+;;  I suspect that minibuf_prompt*_width are actually recomputed
+;;  by redisplay as needed -- or could be arranged to be so --
+;;  and that there could be need for read-minibuffer-internal to
+;;  save and restore them.
+;;#### The only other thing which read-from-minibuffer-internal does
+;;  which we can't presently do in Lisp is move the frame cursor
+;;  to the start of the minibuffer line as it returns.  This is
+;;  a rather nice touch and should be preserved -- probably by
+;;  providing some Lisp-level mechanism (extension to cursor-in-echo-area ?)
+;;  to effect it.
+;; Like reset_buffer in FSF's buffer.c
+;;  (Except that kill-all-local-variables doesn't nuke 'permanent-local
+;;   variables -- we preserve them, reset_buffer doesn't.)
+(defun reset-buffer (buffer)
+(with-current-buffer buffer
+;(if (fboundp 'unlock-buffer) (unlock-buffer))
+(kill-all-local-variables)
+(setq buffer-read-only nil)
+;; don't let read only text yanked into the minibuffer
+;; permanently wedge it.
+(make-local-variable 'inhibit-read-only)
+(setq inhibit-read-only t)
+(erase-buffer)
+;(setq default-directory nil)
+(setq buffer-file-name nil)
+(setq buffer-file-truename nil)
+(set-buffer-modified-p nil)
+(setq buffer-backed-up nil)
+(setq buffer-auto-save-file-name nil)
+(set-buffer-dedicated-frame buffer nil)
+buffer))
+(defvar minibuffer-history-variable 'minibuffer-history
+"History list symbol to add minibuffer values to.
+Each minibuffer output is added with
+(set minibuffer-history-variable
+(cons STRING (symbol-value minibuffer-history-variable)))")
+(defvar minibuffer-history-position)
+;; Added by hniksic:
+(defvar initial-minibuffer-history-position)
+(defvar current-minibuffer-contents)
+(defvar current-minibuffer-point)
+(defcustom minibuffer-history-minimum-string-length nil
+"*If this variable is non-nil, a string will not be added to the
+minibuffer history if its length is less than that value."
+:type '(choice (const :tag "Any" nil)
+		 integer)
+:group 'minibuffer)
+(define-error 'input-error "Keyboard input error")
+(put 'input-error 'display-error
+#'(lambda (error-object stream)
+	 (princ (cadr error-object) stream)))
+(defun read-from-minibuffer (prompt &optional initial-contents
+keymap
+readp
+history
+				    abbrev-table)
+"Read a string from the minibuffer, prompting with string PROMPT.
+If optional second arg INITIAL-CONTENTS is non-nil, it is a string
+to be inserted into the minibuffer before reading input.
+If INITIAL-CONTENTS is (STRING . POSITION), the initial input
+is STRING, but point is placed POSITION characters into the string.
+Third arg KEYMAP is a keymap to use while reading;
+if omitted or nil, the default is `minibuffer-local-map'.
+If fourth arg READ is non-nil, then interpret the result as a lisp object
+and return that object:
+in other words, do `(car (read-from-string INPUT-STRING))'
+Fifth arg HISTORY, if non-nil, specifies a history list
+and optionally the initial position in the list.
+It can be a symbol, which is the history list variable to use,
+or it can be a cons cell (HISTVAR . HISTPOS).
+In that case, HISTVAR is the history list variable to use,
+and HISTPOS is the initial position (the position in the list
+which INITIAL-CONTENTS corresponds to).
+If HISTORY is `t', no history will be recorded.
+Positions are counted starting from 1 at the beginning of the list.
+Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table'
+in the minibuffer.
+See also the variable completion-highlight-first-word-only for control over
+completion display."
+(if (and (not enable-recursive-minibuffers)
+(> (minibuffer-depth) 0)
+(eq (selected-window) (minibuffer-window)))
+(error "Command attempted to use minibuffer while in minibuffer"))
+(if (and minibuffer-max-depth
+	   (> minibuffer-max-depth 0)
+(>= (minibuffer-depth) minibuffer-max-depth))
+(minibuffer-max-depth-exceeded))
+;; catch this error before the poor user has typed something...
+(if history
+(if (symbolp history)
+	  (or (boundp history)
+	      (error "History list %S is unbound" history))
+	(or (boundp (car history))
+	    (error "History list %S is unbound" (car history)))))
+(if (noninteractive)
+(progn
+;; XEmacs in -batch mode calls minibuffer: print the prompt.
+(message "%s" (gettext prompt))
+;;#### force-output
+;;#### Should this even be falling though to the code below?
+;;#### How does this stuff work now, anyway?
+))
+(let* ((dir default-directory)
+(owindow (selected-window))
+	 (oframe (selected-frame))
+(window (minibuffer-window))
+(buffer (if (eq (minibuffer-depth) 0)
+(window-buffer window)
+		   (get-buffer-create (format " *Minibuf-%d"
+					      (minibuffer-depth)))))
+(frame (window-frame window))
+(mconfig (if (eq frame (selected-frame))
+nil (current-window-configuration frame)))
+(oconfig (current-window-configuration))
+	 ;; dynamic scope sucks sucks sucks sucks sucks sucks.
+	 ;; `M-x doctor' makes history a local variable, and thus
+	 ;; our binding above is buffer-local and doesn't apply
+	 ;; once we switch buffers!!!!  We demand better scope!
+	 (_history_ history))
+(unwind-protect
+(progn
+(set-buffer (reset-buffer buffer))
+(setq default-directory dir)
+(make-local-variable 'print-escape-newlines)
+(setq print-escape-newlines t)
+	   (make-local-variable 'current-minibuffer-contents)
+	   (make-local-variable 'current-minibuffer-point)
+	   (make-local-variable 'initial-minibuffer-history-position)
+	   (setq current-minibuffer-contents ""
+		 current-minibuffer-point 1)
+	   (if (not minibuffer-smart-completion-tracking-behavior)
+	       nil
+	     (make-local-variable 'mode-motion-hook)
+	     (or mode-motion-hook
+		 ;;####disgusting
+		 (setq mode-motion-hook 'minibuffer-smart-mouse-tracker))
+	     (make-local-variable 'mouse-track-click-hook)
+	     (add-hook 'mouse-track-click-hook
+		       'minibuffer-smart-maybe-select-highlighted-completion))
+(set-window-buffer window buffer)
+(select-window window)
+(set-window-hscroll window 0)
+(buffer-enable-undo buffer)
+(message nil)
+(if initial-contents
+(if (consp initial-contents)
+(progn
+(insert (car initial-contents))
+(goto-char (1+ (cdr initial-contents)))
+		     (setq current-minibuffer-contents (car initial-contents)
+			   current-minibuffer-point (cdr initial-contents)))
+		 (insert initial-contents)
+		 (setq current-minibuffer-contents initial-contents
+		       current-minibuffer-point (point))))
+(use-local-map (help-keymap-with-help-key
+			   (or keymap minibuffer-local-map)
+			   minibuffer-help-form))
+(let ((mouse-grabbed-buffer
+		  (and minibuffer-smart-completion-tracking-behavior
+		       (current-buffer)))
+(current-prefix-arg current-prefix-arg)
+;;                 (help-form minibuffer-help-form)
+(minibuffer-history-variable (cond ((not _history_)
+'minibuffer-history)
+((consp _history_)
+(car _history_))
+(t
+_history_)))
+(minibuffer-history-position (cond ((consp _history_)
+(cdr _history_))
+(t
+0)))
+(minibuffer-scroll-window owindow))
+	     (setq initial-minibuffer-history-position
+		   minibuffer-history-position)
+	     (if abbrev-table
+		 (setq local-abbrev-table abbrev-table
+		       abbrev-mode t))
+	     ;; This is now run from read-minibuffer-internal
+;(if minibuffer-setup-hook
+;    (run-hooks 'minibuffer-setup-hook))
+;(message nil)
+(if (eq 't
+(catch 'exit
+(if (> (recursion-depth) (minibuffer-depth))
+(let ((standard-output t)
+(standard-input t))
+(read-minibuffer-internal prompt))
+(read-minibuffer-internal prompt))))
+;; Translate an "abort" (throw 'exit 't)
+;;  into a real quit
+(signal 'quit '())
+;; return value
+(let* ((val (progn (set-buffer buffer)
+(if minibuffer-exit-hook
+(run-hooks 'minibuffer-exit-hook))
+(buffer-string)))
+(histval val)
+(err nil))
+(if readp
+(condition-case e
+(let ((v (read-from-string val)))
+(if (< (cdr v) (length val))
+(save-match-data
+(or (string-match "[ \t\n]*\\'" val (cdr v))
+(error "Trailing garbage following expression"))))
+(setq v (car v))
+;; total total kludge
+(if (stringp v) (setq v (list 'quote v)))
+(setq val v))
+(end-of-file
+			(setq err
+			      '(input-error "End of input before end of expression")))
+		       (error (setq err e))))
+;; Add the value to the appropriate history list unless
+;; it's already the most recent element, or it's only
+;; two characters long.
+(if (and (symbolp minibuffer-history-variable)
+(boundp minibuffer-history-variable))
+		     (let ((list (symbol-value minibuffer-history-variable)))
+		       (or (eq list t)
+			   (null val)
+			   (and list (equal histval (car list)))
+			   (and (stringp val)
+				minibuffer-history-minimum-string-length
+				(< (length val)
+				   minibuffer-history-minimum-string-length))
+			   (set minibuffer-history-variable
+				(if minibuffer-history-uniquify
+				    (cons histval (remove histval list))
+				  (cons histval list))))))
+(if err (signal (car err) (cdr err)))
+val))))
+;; stupid display code requires this for some reason
+(set-buffer buffer)
+(buffer-disable-undo buffer)
+(setq buffer-read-only nil)
+(erase-buffer)
+;; restore frame configurations
+(if (and mconfig (frame-live-p oframe)
+	       (eq frame (selected-frame)))
+	  ;; if we changed frames (due to surrogate minibuffer),
+	  ;; and we're still on the new frame, go back to the old one.
+	  (select-frame oframe))
+(if mconfig (set-window-configuration mconfig))
+(set-window-configuration oconfig))))
+(defun minibuffer-max-depth-exceeded ()
+;;
+;; This signals an error if an Nth minibuffer is invoked while N-1 are
+;; already active, whether the minibuffer window is selected or not.
+;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x,
+;; getting distracted, and clicking elsewhere) many many novice users have
+;; had the problem of having multiple minibuffers build up, even to the
+;; point of exceeding max-lisp-eval-depth.  Since the variable
+;; enable-recursive-minibuffers historically/crockishly is only consulted
+;; when the minibuffer is currently active (like typing M-x M-x) it doesn't
+;; help in this situation.
+;;
+;; This routine also offers to edit .emacs for you to get rid of this
+;; complaint, like `disabled' commands do, since it's likely that non-novice
+;; users will be annoyed by this change, so we give them an easy way to get
+;; rid of it forever.
+;;
+(beep t 'minibuffer-limit-exceeded)
+(message
+"Minibuffer already active: abort it with `^]', enable new one with `n': ")
+(let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work??
+		(read-char))))
+(cond
+((eq char ?n)
+(cond
+((y-or-n-p "Enable recursive minibuffers for other sessions too? ")
+	;; This is completely disgusting, but it's basically what novice.el
+	;; does.  This kind of thing should be generalized.
+	(setq minibuffer-max-depth nil)
+	(save-excursion
+	  (set-buffer
+	   (find-file-noselect
+	    (substitute-in-file-name custom-file)))
+	  (goto-char (point-min))
+	  (if (re-search-forward
+	       "^(setq minibuffer-max-depth \\([0-9]+\\|'?nil\\|'?()\\))\n"
+	       nil t)
+	      (delete-region (match-beginning 0 ) (match-end 0))
+	    ;; Must have been disabled by default.
+	    (goto-char (point-max)))
+	  (insert"\n(setq minibuffer-max-depth nil)\n")
+	  (save-buffer))
+	(message "Multiple minibuffers enabled")
+	(sit-for 1))))
+((eq char ?)
+(abort-recursive-edit))
+(t
+(error "Minibuffer already active")))))
+;;;; Guts of minibuffer completion
+;; Used by minibuffer-do-completion
+(defvar last-exact-completion)
+(defun temp-minibuffer-message (m)
+(let ((savemax (point-max)))
+(save-excursion
+(goto-char (point-max))
+(message nil)
+(insert m))
+(let ((inhibit-quit t))
+(sit-for 2)
+(delete-region savemax (point-max))
+;;  If the user types a ^G while we're in sit-for, then quit-flag
+;;  gets set. In this case, we want that ^G to be interpreted
+;;  as a normal character, and act just like typeahead.
+(if (and quit-flag (not unread-command-event))
+(setq unread-command-event (character-to-event (quit-char))
+quit-flag nil)))))
+;; Determines whether buffer-string is an exact completion
+(defun exact-minibuffer-completion-p (buffer-string)
+(cond ((not minibuffer-completion-table)
+;; Empty alist
+nil)
+((vectorp minibuffer-completion-table)
+(let ((tem (intern-soft buffer-string
+minibuffer-completion-table)))
+(if (or tem
+(and (string-equal buffer-string "nil")
+;; intern-soft loses for 'nil
+(catch 'found
+(mapatoms #'(lambda (s)
+					(if (string-equal
+					     (symbol-name s)
+					     buffer-string)
+					    (throw 'found t)))
+				    minibuffer-completion-table)
+nil)))
+(if minibuffer-completion-predicate
+(funcall minibuffer-completion-predicate
+tem)
+t)
+nil)))
+((and (consp minibuffer-completion-table)
+;;#### Emacs-Lisp truly sucks!
+;; lambda, autoload, etc
+(not (symbolp (car minibuffer-completion-table))))
+(if (not completion-ignore-case)
+(assoc buffer-string minibuffer-completion-table)
+(let ((s (upcase buffer-string))
+(tail minibuffer-completion-table)
+tem)
+(while tail
+(setq tem (car (car tail)))
+(if (or (equal tem buffer-string)
+(equal tem s)
+(if tem (equal (upcase tem) s)))
+(setq s 'win
+tail nil)    ;exit
+(setq tail (cdr tail))))
+(eq s 'win))))
+(t
+(funcall minibuffer-completion-table
+buffer-string
+minibuffer-completion-predicate
+'lambda)))
+)
+;; 0 'none                 no possible completion
+;; 1 'unique               was already an exact and unique completion
+;; 3 'exact                was already an exact (but nonunique) completion
+;; NOT USED 'completed-exact-unique completed to an exact and completion
+;; 4 'completed-exact      completed to an exact (but nonunique) completion
+;; 5 'completed            some completion happened
+;; 6 'uncompleted          no completion happened
+(defun minibuffer-do-completion-1 (buffer-string completion)
+(cond ((not completion)
+'none)
+((eq completion t)
+;; exact and unique match
+'unique)
+(t
+;; It did find a match.  Do we match some possibility exactly now?
+(let ((completedp (not (string-equal completion buffer-string))))
+(if completedp
+(progn
+;; Some completion happened
+(erase-buffer)
+(insert completion)
+(setq buffer-string completion)))
+(if (exact-minibuffer-completion-p buffer-string)
+;; An exact completion was possible
+(if completedp
+;; Since no callers need to know the difference, don't bother
+;;  with this (potentially expensive) discrimination.
+;;                 (if (eq (try-completion completion
+;;                                         minibuffer-completion-table
+;;                                         minibuffer-completion-predicate)
+;;                         't)
+;;                     'completed-exact-unique
+'completed-exact
+;;                     )
+'exact)
+;; Not an exact match
+(if completedp
+'completed
+'uncompleted))))))
+(defun minibuffer-do-completion (buffer-string)
+(let* ((completion (try-completion buffer-string
+minibuffer-completion-table
+minibuffer-completion-predicate))
+(status (minibuffer-do-completion-1 buffer-string completion))
+(last last-exact-completion))
+(setq last-exact-completion nil)
+(cond ((eq status 'none)
+;; No completions
+(ding nil 'no-completion)
+(temp-minibuffer-message " [No match]"))
+((eq status 'unique)
+)
+(t
+;; It did find a match.  Do we match some possibility exactly now?
+(if (not (string-equal completion buffer-string))
+(progn
+;; Some completion happened
+(erase-buffer)
+(insert completion)
+(setq buffer-string completion)))
+(cond ((eq status 'exact)
+;; If the last exact completion and this one were
+;;  the same, it means we've already given a
+;;  "Complete but not unique" message and that the
+;;  user's hit TAB again, so now we give help.
+(setq last-exact-completion completion)
+(if (equal buffer-string last)
+(minibuffer-completion-help)))
+((eq status 'uncompleted)
+(if completion-auto-help
+(minibuffer-completion-help)
+(temp-minibuffer-message " [Next char not unique]")))
+(t
+nil))))
+status))
+;;;; completing-read
+(defun completing-read (prompt table
+&optional predicate require-match
+initial-contents history default)
+"Read a string in the minibuffer, with completion.
+Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY.
+PROMPT is a string to prompt with; normally it ends in a colon and a space.
+TABLE is an alist whose elements' cars are strings, or an obarray.
+PREDICATE limits completion to a subset of TABLE.
+See `try-completion' for more details on completion, TABLE, and PREDICATE.
+If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
+the input is (or completes to) an element of TABLE or is null.
+If it is also not t, Return does not exit if it does non-null completion.
+If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
+If it is (STRING . POSITION), the initial input
+is STRING, but point is placed POSITION characters into the string.
+HISTORY, if non-nil, specifies a history list
+and optionally the initial position in the list.
+It can be a symbol, which is the history list variable to use,
+or it can be a cons cell (HISTVAR . HISTPOS).
+In that case, HISTVAR is the history list variable to use,
+and HISTPOS is the initial position (the position in the list
+which INITIAL-CONTENTS corresponds to).
+If HISTORY is `t', no history will be recorded.
+Positions are counted starting from 1 at the beginning of the list.
+DEFAULT, if non-nil, is the default value.
+Completion ignores case if the ambient value of
+`completion-ignore-case' is non-nil."
+(let ((minibuffer-completion-table table)
+(minibuffer-completion-predicate predicate)
+(minibuffer-completion-confirm (if (eq require-match 't) nil t))
+(last-exact-completion nil)
+	ret)
+(setq ret (read-from-minibuffer prompt
+				    initial-contents
+				    (if (not require-match)
+					minibuffer-local-completion-map
+				      minibuffer-local-must-match-map)
+				    nil
+				    history))
+(if (and (string= ret "")
+	     default)
+	default
+ret)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;                   Minibuffer completion commands                   ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun minibuffer-complete ()
+"Complete the minibuffer contents as far as possible.
+Return nil if there is no valid completion, else t.
+If no characters can be completed, display a list of possible completions.
+If you repeat this command after it displayed such a list,
+scroll the window of possible completions."
+(interactive)
+;; If the previous command was not this, then mark the completion
+;;  buffer obsolete.
+(or (eq last-command this-command)
+(setq minibuffer-scroll-window nil))
+(let ((window minibuffer-scroll-window))
+(if (and window (windowp window) (window-buffer window)
+(buffer-name (window-buffer window)))
+	;; If there's a fresh completion window with a live buffer
+	;;  and this command is repeated, scroll that window.
+	(let ((obuf (current-buffer)))
+(unwind-protect
+	      (progn
+		(set-buffer (window-buffer window))
+		(if (pos-visible-in-window-p (point-max) window)
+		    ;; If end is in view, scroll up to the beginning.
+		    (set-window-start window (point-min))
+		  ;; Else scroll down one frame.
+		  (scroll-other-window)))
+	    (set-buffer obuf))
+nil)
+(let ((status (minibuffer-do-completion (buffer-string))))
+	(if (eq status 'none)
+	    nil
+	  (progn
+	    (cond ((eq status 'unique)
+		   (temp-minibuffer-message
+		    " [Sole completion]"))
+		  ((eq status 'exact)
+		   (temp-minibuffer-message
+		    " [Complete, but not unique]")))
+	    t))))))
+(defun minibuffer-complete-and-exit ()
+"Complete the minibuffer contents, and maybe exit.
+Exit if the name is valid with no completion needed.
+If name was completed to a valid match,
+a repetition of this command will exit."
+(interactive)
+(if (= (point-min) (point-max))
+;; Crockishly allow user to specify null string
+(throw 'exit nil))
+(let ((buffer-string (buffer-string)))
+;; Short-cut -- don't call minibuffer-do-completion if we already
+;;  have an (possibly nonunique) exact completion.
+(if (exact-minibuffer-completion-p buffer-string)
+(throw 'exit nil))
+(let ((status (minibuffer-do-completion buffer-string)))
+(if (or (eq status 'unique)
+(eq status 'exact)
+(if (or (eq status 'completed-exact)
+(eq status 'completed-exact-unique))
+(if minibuffer-completion-confirm
+(progn (temp-minibuffer-message " [Confirm]")
+nil)
+t)))
+(throw 'exit nil)))))
+(defun self-insert-and-exit ()
+"Terminate minibuffer input."
+(interactive)
+(self-insert-command 1)
+(throw 'exit nil))
+(defun exit-minibuffer ()
+"Terminate this minibuffer argument.
+If minibuffer-confirm-incomplete is true, and we are in a completing-read
+of some kind, and the contents of the minibuffer is not an existing
+completion, requires an additional RET before the minibuffer will be exited
+\(assuming that RET was the character that invoked this command:
+the character in question must be typed again)."
+(interactive)
+(if (not minibuffer-confirm-incomplete)
+(throw 'exit nil))
+(let ((buffer-string (buffer-string)))
+(if (exact-minibuffer-completion-p buffer-string)
+(throw 'exit nil))
+(let ((completion (if (not minibuffer-completion-table)
+t
+(try-completion buffer-string
+minibuffer-completion-table
+minibuffer-completion-predicate))))
+(if (or (eq completion 't)
+;; Crockishly allow user to specify null string
+(string-equal buffer-string ""))
+(throw 'exit nil))
+(if completion ;; rewritten for I18N3 snarfing
+	  (temp-minibuffer-message " [incomplete; confirm]")
+	(temp-minibuffer-message " [no completions; confirm]"))
+(let ((event (let ((inhibit-quit t))
+		     (prog1
+			 (next-command-event)
+		       (setq quit-flag nil)))))
+(cond ((equal event last-command-event)
+(throw 'exit nil))
+((equal (quit-char) (event-to-character event))
+;; Minibuffer abort.
+(throw 'exit t)))
+(dispatch-event event)))))
+;;;; minibuffer-complete-word
+;;;#### I think I have done this correctly; it certainly is simpler
+;;;#### than what the C code seemed to be trying to do.
+(defun minibuffer-complete-word ()
+"Complete the minibuffer contents at most a single word.
+After one word is completed as much as possible, a space or hyphen
+is added, provided that matches some possible completion.
+Return nil if there is no valid completion, else t."
+(interactive)
+(let* ((buffer-string (buffer-string))
+(completion (try-completion buffer-string
+minibuffer-completion-table
+minibuffer-completion-predicate))
+(status (minibuffer-do-completion-1 buffer-string completion)))
+(cond ((eq status 'none)
+(ding nil 'no-completion)
+(temp-minibuffer-message " [No match]")
+nil)
+((eq status 'unique)
+;; New message, only in this new Lisp code
+(temp-minibuffer-message " [Sole completion]")
+t)
+(t
+(cond ((or (eq status 'uncompleted)
+(eq status 'exact))
+(let ((foo #'(lambda (s)
+				 (condition-case nil
+				     (if (try-completion
+					  (concat buffer-string s)
+					  minibuffer-completion-table
+					  minibuffer-completion-predicate)
+					 (progn
+					   (goto-char (point-max))
+					   (insert s)
+					   t)
+nil)
+(error nil))))
+(char last-command-char))
+;; Try to complete by adding a word-delimiter
+(or (and (characterp char) (> char 0)
+(funcall foo (char-to-string char)))
+(and (not (eq char ?\ ))
+(funcall foo " "))
+(and (not (eq char ?\-))
+(funcall foo "-"))
+(progn
+(if completion-auto-help
+(minibuffer-completion-help)
+;; New message, only in this new Lisp code
+			    ;; rewritten for I18N3 snarfing
+			    (if (eq status 'exact)
+				(temp-minibuffer-message
+				 " [Complete, but not unique]")
+			      (temp-minibuffer-message " [Ambiguous]")))
+nil))))
+(t
+(erase-buffer)
+(insert completion)
+;; First word-break in stuff found by completion
+(goto-char (point-min))
+(let ((len (length buffer-string))
+n)
+(if (and (< len (length completion))
+(catch 'match
+(setq n 0)
+(while (< n len)
+(if (char-equal
+(upcase (aref buffer-string n))
+(upcase (aref completion n)))
+(setq n (1+ n))
+(throw 'match nil)))
+t)
+(progn
+(goto-char (point-min))
+(forward-char len)
+(re-search-forward "\\W" nil t)))
+(delete-region (point) (point-max))
+(goto-char (point-max))))
+t))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;                      "Smart minibuffer" hackery                    ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ("Kludgy minibuffer hackery" is perhaps a better name)
+;; This works by setting `mouse-grabbed-buffer' to the minibuffer,
+;; defining button2 in the minibuffer keymap to
+;; `minibuffer-smart-select-highlighted-completion', and setting the
+;; mode-motion-hook of the minibuffer to `minibuffer-mouse-tracker'.
+;; By setting `mouse-grabbed-buffer', the minibuffer's keymap and
+;; mode-motion-hook apply (for mouse motion and presses) no matter
+;; what buffer the mouse is over.  Then, `minibuffer-mouse-tracker'
+;; examines the text under the mouse looking for something that looks
+;; like a completion, and causes it to be highlighted, and
+;; `minibuffer-smart-select-highlighted-completion' looks for a
+;; flagged completion under the mouse and inserts it.  This has the
+;; following advantages:
+;;
+;; -- filenames and such in any buffer can be inserted by clicking,
+;;    not just completions
+;;
+;; but the following disadvantages:
+;;
+;; -- unless you're aware of the "filename in any buffer" feature,
+;;    the fact that strings in arbitrary buffers get highlighted appears
+;;    as a bug
+;; -- mouse motion can cause ange-ftp actions -- bad bad bad.
+;;
+;; There's some hackery in minibuffer-mouse-tracker to try to avoid the
+;; ange-ftp stuff, but it doesn't work.
+;;
+(defcustom minibuffer-smart-completion-tracking-behavior nil
+"*If non-nil, look for completions under mouse in all buffers.
+This allows you to click on something that looks like a completion
+and have it selected, regardless of what buffer it is in.
+This is not enabled by default because
+-- The \"mysterious\" highlighting in normal buffers is confusing to
+people not expecting it, and looks like a bug
+-- If ange-ftp is enabled, this tracking sometimes causes ange-ftp
+action as a result of mouse motion, which is *bad bad bad*.
+Hopefully this bug will be fixed at some point."
+:type 'boolean
+:group 'minibuffer)
+(defun minibuffer-smart-mouse-tracker (event)
+;; Used as the mode-motion-hook of the minibuffer window, which is the
+;; value of `mouse-grabbed-buffer' while the minibuffer is active.  If
+;; the word under the mouse is a valid minibuffer completion, then it
+;; is highlighted.
+;;
+;; We do some special voodoo when we're reading a pathname, because
+;; the way filename completion works is funny.  Possibly there's some
+;; more general way this could be dealt with...
+;;
+;; We do some further voodoo when reading a pathname that is an
+;; ange-ftp or efs path, because causing FTP activity as a result of
+;; mouse motion is a really bad time.
+;;
+(and minibuffer-smart-completion-tracking-behavior
+(event-point event)
+;; avoid conflict with display-completion-list extents
+(not (extent-at (event-point event)
+		       (event-buffer event)
+		       'list-mode-item))
+(let ((filename-kludge-p (eq minibuffer-completion-table
+				    'read-file-name-internal)))
+	 (mode-motion-highlight-internal
+	  event
+	  #'(lambda () (default-mouse-track-beginning-of-word
+			 (if filename-kludge-p 'nonwhite t)))
+	  #'(lambda ()
+	      (let ((p (point))
+		    (string ""))
+		(default-mouse-track-end-of-word
+		  (if filename-kludge-p 'nonwhite t))
+		(if (and (/= p (point)) minibuffer-completion-table)
+		    (setq string (buffer-substring p (point))))
+		(if (string-match "\\`[ \t\n]*\\'" string)
+		    (goto-char p)
+		  (if filename-kludge-p
+		      (setq string (minibuffer-smart-select-kludge-filename
+				    string)))
+		  ;; try-completion bogusly returns a string even when
+		  ;; that string is complete if that string is also a
+		  ;; prefix for other completions.  This means that we
+		  ;; can't just do the obvious thing, (eq t
+		  ;; (try-completion ...)).
+		  (let (comp)
+		    (if (and filename-kludge-p
+			     ;; #### evil evil evil evil
+			     (or (and (fboundp 'ange-ftp-ftp-path)
+				      (ange-ftp-ftp-path string))
+				 (and (fboundp 'efs-ftp-path)
+				      (efs-ftp-path string))))
+			(setq comp t)
+		      (setq comp
+			    (try-completion string
+					    minibuffer-completion-table
+					    minibuffer-completion-predicate)))
+		    (or (eq comp t)
+			(and (equal comp string)
+			     (or (null minibuffer-completion-predicate)
+				 (stringp
+				  minibuffer-completion-predicate) ; ???
+				 (funcall minibuffer-completion-predicate
+					  (if (vectorp
+					       minibuffer-completion-table)
+					      (intern-soft
+					       string
+					       minibuffer-completion-table)
+					    string))))
+			(goto-char p))))))))))
+(defun minibuffer-smart-select-kludge-filename (string)
+(save-excursion
+(set-buffer mouse-grabbed-buffer) ; the minibuf
+(let ((kludge-string (concat (buffer-string) string)))
+(if (or (and (fboundp 'ange-ftp-ftp-path)
+		   (ange-ftp-ftp-path kludge-string))
+	       (and (fboundp 'efs-ftp-path) (efs-ftp-path kludge-string)))
+	   ;; #### evil evil evil, but more so.
+	   string
+	 (append-expand-filename (buffer-string) string)))))
+(defun minibuffer-smart-select-highlighted-completion (event)
+"Select the highlighted text under the mouse as a minibuffer response.
+When the minibuffer is being used to prompt the user for a completion,
+any valid completions which are visible on the frame will highlight
+when the mouse moves over them.  Clicking \\<minibuffer-local-map>\
+\\[minibuffer-smart-select-highlighted-completion] will select the
+highlighted completion under the mouse.
+If the mouse is clicked while not over a highlighted completion,
+then the global binding of \\[minibuffer-smart-select-highlighted-completion] \
+will be executed instead.  In this\nway you can get at the normal global \
+behavior of \\[minibuffer-smart-select-highlighted-completion] as well as
+the special minibuffer behavior."
+(interactive "e")
+(if minibuffer-smart-completion-tracking-behavior
+(minibuffer-smart-select-highlighted-completion-1 event t)
+(let ((command (lookup-key global-map
+			       (vector current-mouse-event))))
+(if command (call-interactively command)))))
+(defun minibuffer-smart-select-highlighted-completion-1 (event global-p)
+(let* ((filename-kludge-p (eq minibuffer-completion-table
+				'read-file-name-internal))
+	 completion
+	 command-p
+	 (evpoint (event-point event))
+	 (evextent (and evpoint (extent-at evpoint (event-buffer event)
+					   'list-mode-item))))
+(if evextent
+	;; avoid conflict with display-completion-list extents.
+	;; if we find one, do that behavior instead.
+	(list-mode-item-selected-1 evextent event)
+(save-excursion
+	(let* ((buffer (window-buffer (event-window event)))
+	       (p (event-point event))
+	       (extent (and p (extent-at p buffer 'mouse-face))))
+	  (set-buffer buffer)
+	  (if (not (and (extent-live-p extent)
+			(eq (extent-object extent) (current-buffer))
+			(not (extent-detached-p extent))))
+	      (setq command-p t)
+	    ;; ...else user has selected a highlighted completion.
+	    (setq completion
+		  (buffer-substring (extent-start-position extent)
+				    (extent-end-position extent)))
+	    (if filename-kludge-p
+		(setq completion (minibuffer-smart-select-kludge-filename
+				  completion)))
+	    ;; remove the extent so that it's not hanging around in
+	    ;; *Completions*
+	    (detach-extent extent)
+	    (set-buffer mouse-grabbed-buffer)
+	    (erase-buffer)
+	    (insert completion))))
+;; we need to execute the command or do the throw outside of the
+;; save-excursion.
+(cond ((and command-p global-p)
+	     (let ((command (lookup-key global-map
+					(vector current-mouse-event))))
+	       (if command
+		   (call-interactively command)
+		 (if minibuffer-completion-table
+		     (error
+		      "Highlighted words are valid completions.  You may select one.")
+		   (error "no completions")))))
+	    ((not command-p)
+	     ;; things get confused if the minibuffer is terminated while
+	     ;; not selected.
+	     (select-window (minibuffer-window))
+	     (if (and filename-kludge-p (file-directory-p completion))
+		 ;; if the user clicked middle on a directory name, display the
+		 ;; files in that directory.
+		 (progn
+		   (goto-char (point-max))
+		   (minibuffer-completion-help))
+	       ;; otherwise, terminate input
+	       (throw 'exit nil)))))))
+(defun minibuffer-smart-maybe-select-highlighted-completion
+(event &optional click-count)
+"Like minibuffer-smart-select-highlighted-completion but does nothing if
+there is no completion (as opposed to executing the global binding).  Useful
+as the value of `mouse-track-click-hook'."
+(interactive "e")
+(minibuffer-smart-select-highlighted-completion-1 event nil))
+(define-key minibuffer-local-map 'button2
+'minibuffer-smart-select-highlighted-completion)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;                         Minibuffer History                         ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar minibuffer-history '()
+"Default minibuffer history list.
+This is used for all minibuffer input except when an alternate history
+list is specified.")
+;; Some other history lists:
+;;
+(defvar minibuffer-history-search-history '())
+(defvar function-history '())
+(defvar variable-history '())
+(defvar buffer-history '())
+(defvar shell-command-history '())
+(defvar file-name-history '())
+(defvar read-expression-history nil)
+(defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge
+"Non-nil when doing history operations on `command-history'.
+More generally, indicates that the history list being acted on
+contains expressions rather than strings.")
+(defun previous-matching-history-element (regexp n)
+"Find the previous history element that matches REGEXP.
+\(Previous history elements refer to earlier actions.)
+With prefix argument N, search for Nth previous match.
+If N is negative, find the next or Nth next match."
+(interactive
+(let ((enable-recursive-minibuffers t)
+	 (minibuffer-history-sexp-flag nil))
+(if (eq 't (symbol-value minibuffer-history-variable))
+	 (error "History is not being recorded in this context"))
+(list (read-from-minibuffer "Previous element matching (regexp): "
+				 (car minibuffer-history-search-history)
+				 minibuffer-local-map
+				 nil
+				 'minibuffer-history-search-history)
+	   (prefix-numeric-value current-prefix-arg))))
+(let ((history (symbol-value minibuffer-history-variable))
+	prevpos
+	(pos minibuffer-history-position))
+(if (eq history t)
+	(error "History is not being recorded in this context"))
+(while (/= n 0)
+(setq prevpos pos)
+(setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
+(if (= pos prevpos)
+	  (if (= pos 1) ;; rewritten for I18N3 snarfing
+	      (error "No later matching history item")
+	    (error "No earlier matching history item")))
+(if (string-match regexp
+			(if minibuffer-history-sexp-flag
+			    (let ((print-level nil))
+			      (prin1-to-string (nth (1- pos) history)))
+(nth (1- pos) history)))
+	  (setq n (+ n (if (< n 0) 1 -1)))))
+(setq minibuffer-history-position pos)
+(setq current-minibuffer-contents (buffer-string)
+	  current-minibuffer-point (point))
+(erase-buffer)
+(let ((elt (nth (1- pos) history)))
+(insert (if minibuffer-history-sexp-flag
+		  (let ((print-level nil))
+		    (prin1-to-string elt))
+elt)))
+(goto-char (point-min)))
+(if (or (eq (car (car command-history)) 'previous-matching-history-element)
+	  (eq (car (car command-history)) 'next-matching-history-element))
+(setq command-history (cdr command-history))))
+(defun next-matching-history-element (regexp n)
+"Find the next history element that matches REGEXP.
+\(The next history element refers to a more recent action.)
+With prefix argument N, search for Nth next match.
+If N is negative, find the previous or Nth previous match."
+(interactive
+(let ((enable-recursive-minibuffers t)
+	 (minibuffer-history-sexp-flag nil))
+(if (eq t (symbol-value minibuffer-history-variable))
+	 (error "History is not being recorded in this context"))
+(list (read-from-minibuffer "Next element matching (regexp): "
+				 (car minibuffer-history-search-history)
+				 minibuffer-local-map
+				 nil
+				 'minibuffer-history-search-history)
+	   (prefix-numeric-value current-prefix-arg))))
+(previous-matching-history-element regexp (- n)))
+(defun next-history-element (n)
+"Insert the next element of the minibuffer history into the minibuffer."
+(interactive "p")
+(if (eq 't (symbol-value minibuffer-history-variable))
+(error "History is not being recorded in this context"))
+(unless (zerop n)
+(when (eq minibuffer-history-position
+	      initial-minibuffer-history-position)
+(setq current-minibuffer-contents (buffer-string)
+	    current-minibuffer-point (point)))
+(let ((narg (- minibuffer-history-position n))
+	  (minimum (if minibuffer-default -1 0)))
+(cond ((< narg minimum)
+	     (error "No following item in %s" minibuffer-history-variable))
+	    ((> narg (length (symbol-value minibuffer-history-variable)))
+	     (error "No preceding item in %s" minibuffer-history-variable)))
+(erase-buffer)
+(setq minibuffer-history-position narg)
+(if (eq narg initial-minibuffer-history-position)
+	  (progn
+	    (insert current-minibuffer-contents)
+	    (goto-char current-minibuffer-point))
+	(let ((elt (if (>= narg 0)
+		       (nth (1- minibuffer-history-position)
+			    (symbol-value minibuffer-history-variable))
+		     minibuffer-default)))
+	  (insert
+	   (if (not (stringp elt))
+	       (let ((print-level nil))
+		 (condition-case nil
+		     (let ((print-readably t)
+			   (print-escape-newlines t))
+		       (prin1-to-string elt))
+		   (error (prin1-to-string elt))))
+	     elt)))
+	;; FSF has point-min here.
+	(goto-char (point-max))))))
+(defun previous-history-element (n)
+"Insert the previous element of the minibuffer history into the minibuffer."
+(interactive "p")
+(next-history-element (- n)))
+(defun next-complete-history-element (n)
+"Get next element of history which is a completion of minibuffer contents."
+(interactive "p")
+(let ((point-at-start (point)))
+(next-matching-history-element
+(concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
+;; next-matching-history-element always puts us at (point-min).
+;; Move to the position we were at before changing the buffer contents.
+;; This is still sensical, because the text before point has not changed.
+(goto-char point-at-start)))
+(defun previous-complete-history-element (n)
+"Get previous element of history which is a completion of minibuffer contents."
+(interactive "p")
+(next-complete-history-element (- n)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;                reading various things from a minibuffer            ;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun read-expression (prompt &optional initial-contents history)
+"Return a Lisp object read using the minibuffer.
+Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
+is a string to insert in the minibuffer before reading.
+Third arg HISTORY, if non-nil, specifies a history list."
+(let ((minibuffer-history-sexp-flag t)
+	;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
+	(minibuffer-completion-table nil))
+(read-from-minibuffer prompt
+			  initial-contents
+			  read-expression-map
+			  t
+			  (or history 'read-expression-history)
+			  lisp-mode-abbrev-table)))
+(defun read-string (prompt &optional initial-contents history)
+"Return a string from the minibuffer, prompting with string PROMPT.
+If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
+in the minibuffer before reading.
+Third arg HISTORY, if non-nil, specifies a history list."
+(let ((minibuffer-completion-table nil))
+(read-from-minibuffer prompt
+			  initial-contents
+			  minibuffer-local-map
+			  nil history)))
+(defun eval-minibuffer (prompt &optional initial-contents history)
+"Return value of Lisp expression read using the minibuffer.
+Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
+is a string to insert in the minibuffer before reading.
+Third arg HISTORY, if non-nil, specifies a history list."
+(eval (read-expression prompt initial-contents history)))
+;; The name `command-history' is already taken
+(defvar read-command-history '())
+(defun read-command (prompt)
+"Read the name of a command and return as a symbol.
+Prompts with PROMPT."
+(intern (completing-read prompt obarray 'commandp t nil
+			   ;; 'command-history is not right here: that's a
+			   ;; list of evalable forms, not a history list.
+			   'read-command-history
+			   )))
+(defun read-function (prompt)
+"Read the name of a function and return as a symbol.
+Prompts with PROMPT."
+(intern (completing-read prompt obarray 'fboundp t nil
+			   'function-history)))
+(defun read-variable (prompt)
+"Read the name of a user variable and return it as a symbol.
+Prompts with PROMPT.
+A user variable is one whose documentation starts with a `*' character."
+(intern (completing-read prompt obarray 'user-variable-p t nil
+			   'variable-history)))
+(defun read-buffer (prompt &optional default require-match)
+"Read the name of a buffer and return as a string.
+Prompts with PROMPT.  Optional second arg DEFAULT is value to return if user
+enters an empty line.  If optional third arg REQUIRE-MATCH is non-nil,
+only existing buffer names are allowed."
+(let ((prompt (if default
+(format "%s(default %s) "
+(gettext prompt) (if (bufferp default)
+						 (buffer-name default)
+					       default))
+prompt))
+(alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
+(buffer-list)))
+result)
+(while (progn
+(setq result (completing-read prompt alist nil require-match
+					   nil 'buffer-history))
+(cond ((not (equal result ""))
+nil)
+((not require-match)
+(setq result default)
+nil)
+((not default)
+t)
+((not (get-buffer default))
+t)
+(t
+(setq result default)
+nil))))
+(if (bufferp result)
+(buffer-name result)
+result)))
+(defun read-number (prompt &optional integers-only)
+"Read a number from the minibuffer."
+(let ((pred (if integers-only 'integerp 'numberp))
+	num)
+(while (not (funcall pred num))
+(setq num (condition-case ()
+		    (let ((minibuffer-completion-table nil))
+		      (read-from-minibuffer
+		       prompt (if num (prin1-to-string num)) nil t
+		       t)) ;no history
+		  (input-error nil)
+		  (invalid-read-syntax nil)
+		  (end-of-file nil)))
+(or (funcall pred num) (beep)))
+num))
+(defun read-shell-command (prompt &optional initial-input history)
+"Just like read-string, but uses read-shell-command-map:
+\\{read-shell-command-map}"
+(let ((minibuffer-completion-table nil))
+(read-from-minibuffer prompt initial-input read-shell-command-map
+			  nil (or history 'shell-command-history))))
+;;; This read-file-name stuff probably belongs in files.el
+;; Quote "$" as "$$" to get it past substitute-in-file-name
+(defun un-substitute-in-file-name (string)
+(let ((regexp "\\$")
+(olen (length string))
+new
+n o ch)
+(if (not (string-match regexp string))
+	string
+(setq n 1)
+(while (string-match regexp string (match-end 0))
+	(setq n (1+ n)))
+(setq new (make-string (+ olen n) ?$))
+(setq n 0 o 0)
+(while (< o olen)
+	(setq ch (aref string o))
+	(aset new n ch)
+	(setq o (1+ o) n (1+ n))
+	(if (eq ch ?$)
+	    ;; already aset by make-string initial-value
+	    (setq n (1+ n))))
+new)))
+(defun read-file-name-2 (history prompt dir default
+				 must-match initial-contents
+				 completer)
+(if (not dir)
+(setq dir default-directory))
+(setq dir (abbreviate-file-name dir t))
+(let* ((insert (cond ((and (not insert-default-directory)
+			     (not initial-contents))
+"")
+(initial-contents
+(cons (un-substitute-in-file-name
+			       (concat dir initial-contents))
+(length dir)))
+(t
+(un-substitute-in-file-name dir))))
+(val
+;;  Hateful, broken, case-sensitive un*x
+;;;                 (completing-read prompt
+;;;                                  completer
+;;;                                  dir
+;;;                                  must-match
+;;;                                  insert
+;;;                                  history)
+	  ;; #### - this is essentially the guts of completing read.
+	  ;; There should be an elegant way to pass a pair of keymaps to
+	  ;; completing read, but this will do for now.  All sins are
+	  ;; relative.  --Stig
+	  (let ((minibuffer-completion-table completer)
+		(minibuffer-completion-predicate dir)
+		(minibuffer-completion-confirm (if (eq must-match 't)
+						   nil t))
+		(last-exact-completion nil))
+	    (read-from-minibuffer prompt
+				  insert
+				  (if (not must-match)
+				      read-file-name-map
+				    read-file-name-must-match-map)
+				  nil
+				  history))
+	      ))
+;;;     ;; Kludge!  Put "/foo/bar" on history rather than "/default//foo/bar"
+;;;     (let ((hist (cond ((not history) 'minibuffer-history)
+;;;                       ((consp history) (car history))
+;;;                       (t history))))
+;;;       (if (and val
+;;;                hist
+;;;                (not (eq hist 't))
+;;;                (boundp hist)
+;;;                (equal (car-safe (symbol-value hist)) val))
+;;;           (let ((e (condition-case nil
+;;;                        (expand-file-name val)
+;;;                      (error nil))))
+;;;             (if (and e (not (equal e val)))
+;;;                 (set hist (cons e (cdr (symbol-value hist))))))))
+(cond ((not val)
+(error "No file name specified"))
+((and default
+(equal val (if (consp insert) (car insert) insert)))
+default)
+(t
+(substitute-in-file-name val)))))
+;; #### this function should use minibuffer-completion-table
+;; or something.  But that is sloooooow.
+;; #### all this shit needs better documentation!!!!!!!!
+(defun read-file-name-activate-callback (event extent dir-p)
+;; used as the activate-callback of the filename list items
+;; in the completion buffer, in place of default-choose-completion.
+;; if a regular file was selected, we call default-choose-completion
+;; (which just inserts the string in the minibuffer and calls
+;; exit-minibuffer).  If a directory was selected, we display
+;; the contents of the directory.
+(let* ((file (extent-string extent))
+	 (completion-buf (extent-object extent))
+	 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
+					  completion-buf))
+	 (in-dir (file-name-directory (buffer-substring nil nil minibuf)))
+	 (full (expand-file-name file in-dir)))
+(if (not (file-directory-p full))
+	(default-choose-completion event extent minibuf)
+(erase-buffer minibuf)
+(insert-string (file-name-as-directory
+		      (abbreviate-file-name full t)) minibuf)
+(reset-buffer completion-buf)
+(let ((standard-output completion-buf))
+	(display-completion-list
+	 (delete "." (directory-files full nil nil nil (if dir-p 'directory)))
+	 :user-data dir-p
+	 :reference-buffer minibuf
+	 :activate-callback 'read-file-name-activate-callback)
+	(goto-char (point-min) completion-buf)))))
+(defun read-file-name-1 (history prompt dir default
+				 must-match initial-contents
+				 completer)
+(if (should-use-dialog-box-p)
+;; this calls read-file-name-2
+(mouse-read-file-name-1 history prompt dir default must-match
+			      initial-contents completer)
+(let ((rfhookfun
+	   (lambda ()
+	     ;; #### SCREAM!  Create a `file-system-ignore-case'
+	     ;; function, so this kind of stuff is generalized!
+	     (and (eq system-type 'windows-nt)
+		  (set (make-local-variable 'completion-ignore-case) t))
+	     (set
+	      (make-local-variable
+	       'completion-display-completion-list-function)
+	      #'(lambda (completions)
+		  (display-completion-list
+		   completions
+		   :user-data (not (eq completer 'read-file-name-internal))
+		   :activate-callback
+		   'read-file-name-activate-callback)))
+	     ;; kludge!
+	     (remove-hook 'minibuffer-setup-hook rfhookfun)
+	     )))
+(unwind-protect
+	  (progn
+	    (add-hook 'minibuffer-setup-hook rfhookfun)
+	    (read-file-name-2 history prompt dir default must-match
+			      initial-contents completer))
+	(remove-hook 'minibuffer-setup-hook rfhookfun)))))
+(defun read-file-name (prompt
+&optional dir default must-match initial-contents
+		       history)
+"Read file name, prompting with PROMPT and completing in directory DIR.
+This will prompt with a dialog box if appropriate, according to
+`should-use-dialog-box-p'.
+Value is not expanded---you must call `expand-file-name' yourself.
+Value is subject to interpreted by substitute-in-file-name however.
+Default name to DEFAULT if user enters a null string.
+(If DEFAULT is omitted, the visited file name is used,
+except that if INITIAL-CONTENTS is specified, that combined with DIR is
+used.)
+Fourth arg MUST-MATCH non-nil means require existing file's name.
+Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL-CONTENTS specifies text to start with.
+Sixth arg HISTORY specifies the history list to use.  Default is
+`file-name-history'.
+DIR defaults to current buffer's directory default."
+(read-file-name-1
+(or history 'file-name-history)
+prompt dir (or default
+		  (if initial-contents (expand-file-name initial-contents dir)
+		    buffer-file-name))
+must-match initial-contents
+;; A separate function (not an anonymous lambda-expression)
+;; and passed as a symbol because of disgusting kludges in various
+;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...)
+'read-file-name-internal))
+(defun read-directory-name (prompt
+&optional dir default must-match initial-contents
+			    history)
+"Read directory name, prompting with PROMPT and completing in directory DIR.
+This will prompt with a dialog box if appropriate, according to
+`should-use-dialog-box-p'.
+Value is not expanded---you must call `expand-file-name' yourself.
+Value is subject to interpreted by substitute-in-file-name however.
+Default name to DEFAULT if user enters a null string.
+(If DEFAULT is omitted, the current buffer's default directory is used.)
+Fourth arg MUST-MATCH non-nil means require existing directory's name.
+Non-nil and non-t means also require confirmation after completion.
+Fifth arg INITIAL-CONTENTS specifies text to start with.
+Sixth arg HISTORY specifies the history list to use.  Default is
+`file-name-history'.
+DIR defaults to current buffer's directory default."
+(read-file-name-1
+(or history 'file-name-history)
+prompt dir (or default default-directory) must-match initial-contents
+'read-directory-name-internal))
+;; Environment-variable and ~username completion hack
+(defun read-file-name-internal-1 (string dir action completer)
+(if (not (string-match
+	    "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
+	    string))
+;; Not doing environment-variable completion hack
+(let* ((orig (if (equal string "") nil string))
+(sstring (if orig (substitute-in-file-name string) string))
+(specdir (if orig (file-name-directory sstring) nil))
+(name    (if orig (file-name-nondirectory sstring) string))
+(direct  (if specdir (expand-file-name specdir dir) dir)))
+;; ~username completion
+(if (and (fboundp 'user-name-completion-1)
+(string-match "^[~]" name))
+(let ((user (substring name 1)))
+(cond ((eq action 'lambda)
+(file-directory-p name))
+((eq action 't)
+;; all completions
+(mapcar #'(lambda (p) (concat "~" p))
+(user-name-all-completions user)))
+(t;; 'nil
+;; complete
+(let* ((val+uniq (user-name-completion-1 user))
+(val  (car val+uniq))
+(uniq (cdr val+uniq)))
+(cond ((stringp val)
+(if uniq
+(file-name-as-directory (concat "~" val))
+(concat "~" val)))
+((eq val t)
+(file-name-as-directory name))
+(t nil))))))
+(funcall completer
+action
+orig
+sstring
+specdir
+direct
+name)))
+;; An odd number of trailing $'s
+(let* ((start (match-beginning 3))
+(env (substring string
+(cond ((= start (length string))
+;; "...$"
+start)
+((= (aref string start) ?{)
+;; "...${..."
+(1+ start))
+(t
+start))))
+(head (substring string 0 (1- start)))
+(alist #'(lambda ()
+(mapcar #'(lambda (x)
+(cons (substring x 0 (string-match "=" x))
+nil))
+process-environment))))
+	(cond ((eq action 'lambda)
+nil)
+((eq action 't)
+;; all completions
+(mapcar #'(lambda (p)
+			   (if (and (> (length p) 0)
+				    ;;#### Unix-specific
+				    ;;####  -- need absolute-pathname-p
+				    (/= (aref p 0) ?/))
+			       (concat "$" p)
+(concat head "$" p)))
+(all-completions env (funcall alist))))
+(t ;; nil
+;; complete
+(let* ((e (funcall alist))
+(val (try-completion env e)))
+(cond ((stringp val)
+(if (string-match "[^A-Za-z0-9_]" val)
+(concat head
+"${" val
+;; completed uniquely?
+(if (eq (try-completion val e) 't)
+"}" ""))
+(concat head "$" val)))
+((eql val 't)
+(concat head
+(un-substitute-in-file-name (getenv env))))
+(t nil))))))))
+(defun read-file-name-internal (string dir action)
+(read-file-name-internal-1
+string dir action
+#'(lambda (action orig string specdir dir name)
+(cond ((eq action 'lambda)
+(if (not orig)
+nil
+(let ((sstring (condition-case nil
+(expand-file-name string)
+(error nil))))
+(if (not sstring)
+;; Some pathname syntax error in string
+nil
+(file-exists-p sstring)))))
+((eq action 't)
+;; all completions
+(mapcar #'un-substitute-in-file-name
+(file-name-all-completions name dir)))
+(t;; nil
+;; complete
+(let* ((d (or dir default-directory))
+		    (val (file-name-completion name d)))
+(if (and (eq val 't)
+(not (null completion-ignored-extensions)))
+;;#### (file-name-completion "foo") returns 't
+;;   when both "foo" and "foo~" exist and the latter
+;;   is "pruned" by completion-ignored-extensions.
+;; I think this is a bug in file-name-completion.
+(setq val (let ((completion-ignored-extensions '()))
+(file-name-completion name d))))
+(if (stringp val)
+(un-substitute-in-file-name (if specdir
+(concat specdir val)
+val))
+(let ((tem (un-substitute-in-file-name string)))
+(if (not (equal tem orig))
+;; substitute-in-file-name did something
+tem
+val)))))))))
+(defun read-directory-name-internal (string dir action)
+(read-file-name-internal-1
+string dir action
+#'(lambda (action orig string specdir dir name)
+(let* ((dirs #'(lambda (fn)
+		       (let ((l (if (equal name "")
+				    (directory-files
+				     dir
+				     nil
+				     ""
+				     nil
+				     'directories)
+				  (directory-files
+				   dir
+				   nil
+				   (concat "\\`" (regexp-quote name))
+				   nil
+				   'directories))))
+			 (mapcar fn
+				 ;; Wretched unix
+				 (delete "." l))))))
+(cond ((eq action 'lambda)
+;; complete?
+(if (not orig)
+nil
+		 (file-directory-p string)))
+((eq action 't)
+;; all completions
+(funcall dirs #'(lambda (n)
+				 (un-substitute-in-file-name
+				  (file-name-as-directory n)))))
+(t
+;; complete
+(let ((val (try-completion
+name
+(funcall dirs
+#'(lambda (n)
+					(list (file-name-as-directory
+					       n)))))))
+(if (stringp val)
+(un-substitute-in-file-name (if specdir
+(concat specdir val)
+						   val))
+		   (let ((tem (un-substitute-in-file-name string)))
+		     (if (not (equal tem orig))
+			 ;; substitute-in-file-name did something
+			 tem
+		       val))))))))))
+(defun append-expand-filename (file-string string)
+"Append STRING to FILE-STRING differently depending on whether STRING
+is a username (~string), an environment variable ($string),
+or a filename (/string).  The resultant string is returned with the
+environment variable or username expanded and resolved to indicate
+whether it is a file(/result) or a directory (/result/)."
+(let ((file
+	 (cond ((string-match "\\([~$]\\)\\([^~$/]*\\)$" file-string)
+		(cond ((string= (substring file-string
+					   (match-beginning 1)
+					   (match-end 1)) "~")
+		       (concat (substring file-string 0 (match-end 1))
+			       string))
+		      (t (substitute-in-file-name
+			  (concat (substring file-string 0 (match-end 1))
+				  string)))))
+	       (t (concat (file-name-directory
+			   (substitute-in-file-name file-string)) string))))
+	result)
+(cond ((stringp (setq result (and (file-exists-p (expand-file-name file))
+				      (read-file-name-internal
+				       (condition-case nil
+					   (expand-file-name file)
+					 (error file))
+				       "" nil))))
+	   result)
+	  (t file))))
+(defun mouse-file-display-completion-list (window dir minibuf user-data)
+(let ((standard-output (window-buffer window)))
+(condition-case nil
+	(display-completion-list
+	 (directory-files dir nil nil nil t)
+	 :window-width (* 2 (window-width window))
+	 :activate-callback
+	 'mouse-read-file-name-activate-callback
+	 :user-data user-data
+	 :reference-buffer minibuf
+	 :help-string "")
+(t nil))))
+(defun mouse-directory-display-completion-list (window dir minibuf user-data)
+(let ((standard-output (window-buffer window)))
+(condition-case nil
+	(display-completion-list
+	 (delete "." (directory-files dir nil nil nil 1))
+	 :window-width (window-width window)
+	 :activate-callback
+	 'mouse-read-file-name-activate-callback
+	 :user-data user-data
+	 :reference-buffer minibuf
+	 :help-string "")
+(t nil))))
+(defun mouse-read-file-name-activate-callback (event extent user-data)
+(let* ((file (extent-string extent))
+	 (minibuf (symbol-value-in-buffer 'completion-reference-buffer
+					  (extent-object extent)))
+	 (in-dir (buffer-substring nil nil minibuf))
+	 (full (expand-file-name file in-dir))
+	 (filebuf (nth 0 user-data))
+	 (dirbuff (nth 1 user-data))
+	 (filewin (nth 2 user-data))
+	 (dirwin (nth 3 user-data)))
+(if (file-regular-p full)
+	(default-choose-completion event extent minibuf)
+(erase-buffer minibuf)
+(insert-string (file-name-as-directory
+		      (abbreviate-file-name full t)) minibuf)
+(reset-buffer filebuf)
+(if (not dirbuff)
+	  (mouse-directory-display-completion-list filewin full minibuf
+						   user-data)
+	(mouse-file-display-completion-list filewin full minibuf user-data)
+	(reset-buffer dirbuff)
+	(mouse-directory-display-completion-list dirwin full minibuf
+						 user-data)))))
+;; this is rather cheesified but gets the job done.
+(defun mouse-read-file-name-1 (history prompt dir default
+				 must-match initial-contents
+				 completer)
+(let* ((file-p (eq 'read-file-name-internal completer))
+	 (filebuf (get-buffer-create "*Completions*"))
+	 (dirbuff (and file-p (generate-new-buffer " *mouse-read-file*")))
+	 (butbuff (generate-new-buffer " *mouse-read-file*"))
+	 (frame (make-dialog-frame))
+	 filewin dirwin
+	 user-data)
+(unwind-protect
+	(progn
+	  (reset-buffer filebuf)
+	  (select-frame frame)
+	  (let ((window-min-height 1))
+	    ;; #### should be 2 not 3, but that causes
+	    ;; "window too small to split" errors for some
+	    ;; people (but not for me ...) There's a more
+	    ;; fundamental bug somewhere.
+	    (split-window nil (- (frame-height frame) 3)))
+	  (if file-p
+	      (progn
+		(split-window-horizontally 16)
+		(setq filewin (frame-rightmost-window frame)
+		      dirwin (frame-leftmost-window frame))
+		(set-window-buffer filewin filebuf)
+		(set-window-buffer dirwin dirbuff))
+	    (setq filewin (frame-highest-window frame))
+	    (set-window-buffer filewin filebuf))
+	  (setq user-data (list filebuf dirbuff filewin dirwin))
+	  (set-window-buffer (frame-lowest-window frame) butbuff)
+	  (set-buffer butbuff)
+	  (when dir
+	    (setq default-directory dir))
+	  (when (featurep 'scrollbar)
+	    (set-specifier scrollbar-width 0 butbuff))
+	  (insert "                 ")
+	  (insert-gui-button (make-gui-button "OK"
+					      (lambda (foo)
+						(exit-minibuffer))))
+	  (insert "                 ")
+	  (insert-gui-button (make-gui-button "Cancel"
+					      (lambda (foo)
+						(abort-recursive-edit))))
+	  (let ((rfhookfun
+		 (lambda ()
+		   (if (not file-p)
+		       (mouse-directory-display-completion-list
+			filewin dir (current-buffer) user-data)
+		     (mouse-file-display-completion-list filewin dir
+							 (current-buffer)
+							 user-data)
+		     (mouse-directory-display-completion-list dirwin dir
+							      (current-buffer)
+							      user-data))
+		   (set
+		    (make-local-variable
+		     'completion-display-completion-list-function)
+		    #'(lambda (completions)
+			(display-completion-list
+			 completions
+			 :help-string ""
+			 :activate-callback
+			 'mouse-read-file-name-activate-callback
+			 :user-data user-data)))
+		   ;; kludge!
+		   (remove-hook 'minibuffer-setup-hook rfhookfun)
+		   ))
+		(rfcshookfun
+		 ;; kludge!
+		 ;; #### I really need to flesh out the object
+		 ;; hierarchy better to avoid these kludges.
+		 (lambda ()
+		   (save-excursion
+		     (set-buffer standard-output)
+		     (setq truncate-lines t)))))
+	    (unwind-protect
+		(progn
+		  (add-hook 'minibuffer-setup-hook rfhookfun)
+		  (add-hook 'completion-setup-hook rfcshookfun)
+		  (read-file-name-2 history prompt dir default
+				    must-match initial-contents
+				    completer))
+	      (remove-hook 'minibuffer-setup-hook rfhookfun)
+	      (remove-hook 'completion-setup-hook rfcshookfun))))
+(delete-frame frame)
+(kill-buffer filebuf)
+(kill-buffer butbuff)
+(and dirbuff (kill-buffer dirbuff)))))
+(defun read-face (prompt &optional must-match)
+"Read the name of a face from the minibuffer and return it as a symbol."
+(intern (completing-read prompt obarray 'find-face must-match)))
+;; #### - wrong place for this variable?  Exactly.  We probably want
+;; `color-list' to be a console method, so `tty-color-list' becomes
+;; obsolete, and `read-color-completion-table' conses (mapcar #'list
+;; (color-list)), optionally caching the results.
+;; Ben wanted all of the possibilities from the `configure' script used
+;; here, but I think this is way too many.  I already trimmed the R4 variants
+;; and a few obvious losers from the list.  --Stig
+(defvar x-library-search-path '("/usr/X11R6/lib/X11/"
+				"/usr/X11R5/lib/X11/"
+				"/usr/lib/X11R6/X11/"
+				"/usr/lib/X11R5/X11/"
+				"/usr/local/X11R6/lib/X11/"
+				"/usr/local/X11R5/lib/X11/"
+				"/usr/local/lib/X11R6/X11/"
+				"/usr/local/lib/X11R5/X11/"
+				"/usr/X11/lib/X11/"
+				"/usr/lib/X11/"
+				"/usr/local/lib/X11/"
+				"/usr/X386/lib/X11/"
+				"/usr/x386/lib/X11/"
+				"/usr/XFree86/lib/X11/"
+				"/usr/unsupported/lib/X11/"
+				"/usr/athena/lib/X11/"
+				"/usr/local/x11r5/lib/X11/"
+				"/usr/lpp/Xamples/lib/X11/"
+				"/usr/openwin/lib/X11/"
+				"/usr/openwin/share/lib/X11/")
+"Search path used by `read-color' to find rgb.txt.")
+(defvar x-read-color-completion-table)
+(defun read-color-completion-table ()
+(case (device-type)
+;; #### Evil device-type dependency
+(x
+(if (boundp 'x-read-color-completion-table)
+	 x-read-color-completion-table
+(let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
+	     clist color p)
+	 (if (not rgb-file)
+	     ;; prevents multiple searches for rgb.txt if we can't find it
+	     (setq x-read-color-completion-table nil)
+	   (with-current-buffer (get-buffer-create " *colors*")
+	     (reset-buffer (current-buffer))
+	     (insert-file-contents rgb-file)
+	     (while (not (eobp))
+	       ;; skip over comments
+	       (while (looking-at "^!")
+		 (end-of-line)
+		 (forward-char 1))
+	       (skip-chars-forward "0-9 \t")
+	       (setq p (point))
+	       (end-of-line)
+	       (setq color (buffer-substring p (point))
+		     clist (cons (list color) clist))
+	       ;; Ugh.  If we want to be able to complete the lowercase form
+	       ;; of the color name, we need to add it twice!  Yuck.
+	       (let ((dcase (downcase color)))
+		 (or (string= dcase color)
+		     (push (list dcase) clist)))
+	       (forward-char 1))
+	     (kill-buffer (current-buffer))))
+	 (setq x-read-color-completion-table clist)
+	 x-read-color-completion-table)))
+(mswindows
+(mapcar #'list (mswindows-color-list)))
+(tty
+(mapcar #'list (tty-color-list)))))
+(defun read-color (prompt &optional must-match initial-contents)
+"Read the name of a color from the minibuffer.
+On X devices, this uses `x-library-search-path' to find rgb.txt in order
+to build a completion table.
+On TTY devices, this uses `tty-color-list'.
+On mswindows devices, this uses `mswindows-color-list'."
+(let ((table (read-color-completion-table)))
+(completing-read prompt table nil (and table must-match)
+		     initial-contents)))
+;; #### The doc string for read-non-nil-coding system gets lost if we
+;; only include these if the mule feature is present.  Strangely,
+;; read-coding-system doesn't.
+;;(if (featurep 'mule)
+(defun read-coding-system (prompt &optional default-coding-system)
+"Read a coding-system (or nil) from the minibuffer.
+Prompting with string PROMPT.
+If the user enters null input, return second argument DEFAULT-CODING-SYSTEM.
+DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object."
+(intern (completing-read prompt obarray 'find-coding-system t nil nil
+			   (cond ((symbolp default-coding-system)
+				  (symbol-name default-coding-system))
+				 ((coding-system-p default-coding-system)
+				  (symbol-name (coding-system-name default-coding-system)))
+				 (t
+				  default-coding-system)))))
+(defun read-non-nil-coding-system (prompt)
+"Read a non-nil coding-system from the minibuffer.
+Prompt with string PROMPT."
+(let ((retval (intern "")))
+(while (= 0 (length (symbol-name retval)))
+(setq retval (intern (completing-read prompt obarray
+					    'find-coding-system
+					    t))))
+retval))
+;;) ;; end of (featurep 'mule)
+(defcustom force-dialog-box-use nil
+"*If non-nil, always use a dialog box for asking questions, if possible.
+You should *bind* this, not set it.  This is useful if you're doing
+something mousy but which wasn't actually invoked using the mouse."
+:type 'boolean
+:group 'minibuffer)
+;; We include this here rather than dialog.el so it is defined
+;; even when dialog boxes are not present.
+(defun should-use-dialog-box-p ()
+"If non-nil, questions should be asked with a dialog box instead of the
+minibuffer.  This looks at `last-command-event' to see if it was a mouse
+event, and checks whether dialog-support exists and the current device
+supports dialog boxes.
+The dialog box is totally disabled if the variable `use-dialog-box'
+is set to nil."
+(and (featurep 'dialog)
+(device-on-window-system-p)
+use-dialog-box
+(or force-dialog-box-use
+	   (button-press-event-p last-command-event)
+	   (button-release-event-p last-command-event)
+	   (misc-user-event-p last-command-event))))
+;;; minibuf.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/minibuf.el @ 428:3ecd8885ac67 r21-2-22