lisp/minibuf.el

   1 ;;; minibuf.el --- Minibuffer functions for XEmacs
   2
   3 ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1995 Tinker Systems.
   5 ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
   6
   7 ;; Author: Richard Mlynarik
   8 ;; Created: 2-Oct-92
   9 ;; Maintainer: XEmacs Development Team
  10 ;; Keywords: internal, dumped
  11
  12 ;; This file is part of XEmacs.
  13
  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)
  17 ;; any later version.
  18
  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.
  23
  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.
  28
  29 ;;; Synched up with: all the minibuffer history stuff is synched with
  30 ;;; 19.30.  Not sure about the rest.
  31
  32 ;;; Commentary:
  33
  34 ;; This file is dumped with XEmacs.
  35
  36 ;; Written by Richard Mlynarik 2-Oct-92
  37
  38 ;; 06/11/1997 -  Use char-(after|before) instead of
  39 ;;  (following|preceding)-char. -slb
  40
  41 ;;; Code:
  42
  43 (defgroup minibuffer nil
  44   "Controling the behavior of the minibuffer."
  45   :group 'environment)
  46
  47
  48 (defcustom insert-default-directory t
  49  "*Non-nil means when reading a filename start with default dir in minibuffer."
  50  :type 'boolean
  51  :group 'minibuffer)
  52
  53 (defcustom minibuffer-history-uniquify t
  54   "*Non-nil means when adding an item to a minibuffer history, remove
  55 previous occurrences of the same item from the history list first,
  56 rather than just consing the new element onto the front of the list."
  57   :type 'boolean
  58   :group 'minibuffer)
  59
  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'.
  63
  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.")
  73
  74 (defvar minibuffer-completion-predicate nil
  75   "Within call to `completing-read', this holds the PREDICATE argument.")
  76
  77 (defvar minibuffer-completion-confirm nil
  78   "Non-nil => demand confirmation of completion before exiting minibuffer.")
  79
  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."
  84   :type 'boolean
  85   :group 'minibuffer)
  86
  87 (defcustom completion-auto-help t
  88   "*Non-nil means automatically provide help for invalid completion input."
  89   :type 'boolean
  90   :group 'minibuffer)
  91
  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."
  97   :type 'boolean
  98   :group 'minibuffer)
  99
 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))
 107   :group 'minibuffer)
 108
 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.")
 113
 114 ;; see comment at list-mode-hook.
 115 (put 'minibuffer-setup-hook 'permanent-local t)
 116
 117 (defvar minibuffer-exit-hook nil
 118   "Normal hook run just after exit from minibuffer.")
 119 (put 'minibuffer-exit-hook 'permanent-local t)
 120
 121 (defvar minibuffer-help-form nil
 122   "Value that `help-form' takes on inside the minibuffer.")
 123
 124 (defvar minibuffer-default nil
 125   "Default value for minibuffer input.")
 126
 127 (defvar minibuffer-local-map
 128   (let ((map (make-sparse-keymap 'minibuffer-local-map)))
 129     map)
 130   "Default keymap to use when reading from the minibuffer.")
 131
 132 (defvar minibuffer-local-completion-map
 133   (let ((map (make-sparse-keymap 'minibuffer-local-completion-map)))
 134     (set-keymap-parents map (list minibuffer-local-map))
 135     map)
 136   "Local keymap for minibuffer input with completion.")
 137
 138 (defvar minibuffer-local-must-match-map
 139   (let ((map (make-sparse-keymap 'minibuffer-must-match-map)))
 140     (set-keymap-parents map (list minibuffer-local-completion-map))
 141     map)
 142   "Local keymap for minibuffer input with completion, for exact match.")
 143
 144 ;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit)
 145 (define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el
 146 (define-key minibuffer-local-map "\r" 'exit-minibuffer)
 147 (define-key minibuffer-local-map "\n" 'exit-minibuffer)
 148
 149 ;; Historical crock.  Unused by anything but user code, if even that
 150 ;(defvar minibuffer-local-ns-map
 151 ;  (let ((map (make-sparse-keymap 'minibuffer-local-ns-map)))
 152 ;    (set-keymap-parents map (list minibuffer-local-map))
 153 ;    map)
 154 ;  "Local keymap for the minibuffer when spaces are not allowed.")
 155 ;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer)
 156 ;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer)
 157 ;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit)
 158
 159 (define-key minibuffer-local-completion-map "\t" 'minibuffer-complete)
 160 (define-key minibuffer-local-completion-map " " 'minibuffer-complete-word)
 161 (define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help)
 162 (define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit)
 163 (define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit)
 164
 165 (define-key minibuffer-local-map "\M-n" 'next-history-element)
 166 (define-key minibuffer-local-map "\M-p" 'previous-history-element)
 167 (define-key minibuffer-local-map '[next]  "\M-n")
 168 (define-key minibuffer-local-map '[prior] "\M-p")
 169 (define-key minibuffer-local-map "\M-r" 'previous-matching-history-element)
 170 (define-key minibuffer-local-map "\M-s" 'next-matching-history-element)
 171 (define-key minibuffer-local-must-match-map [next]
 172   'next-complete-history-element)
 173 (define-key minibuffer-local-must-match-map [prior]
 174   'previous-complete-history-element)
 175
 176 ;; This is an experiment--make up and down arrows do history.
 177 (define-key minibuffer-local-map [up] 'previous-history-element)
 178 (define-key minibuffer-local-map [down] 'next-history-element)
 179 (define-key minibuffer-local-completion-map [up] 'previous-history-element)
 180 (define-key minibuffer-local-completion-map [down] 'next-history-element)
 181 (define-key minibuffer-local-must-match-map [up] 'previous-history-element)
 182 (define-key minibuffer-local-must-match-map [down] 'next-history-element)
 183
 184 (defvar read-expression-map (let ((map (make-sparse-keymap
 185                                         'read-expression-map)))
 186                               (set-keymap-parents map
 187                                                   (list minibuffer-local-map))
 188                               (define-key map "\M-\t" 'lisp-complete-symbol)
 189                               map)
 190   "Minibuffer keymap used for reading Lisp expressions.")
 191
 192 (defvar read-shell-command-map
 193   (let ((map (make-sparse-keymap 'read-shell-command-map)))
 194     (set-keymap-parents map (list minibuffer-local-map))
 195     (define-key map "\t" 'comint-dynamic-complete)
 196     (define-key map "\M-\t" 'comint-dynamic-complete)
 197     (define-key map "\M-?" 'comint-dynamic-list-completions)
 198     map)
 199   "Minibuffer keymap used by `shell-command' and related commands.")
 200
 201 (defcustom use-dialog-box t
 202   "*Variable controlling usage of the dialog box.
 203 If nil, the dialog box will never be used, even in response to mouse events."
 204   :type 'boolean
 205   :group 'minibuffer)
 206 \f
 207 (defcustom minibuffer-electric-file-name-behavior t
 208   "*If non-nil, slash and tilde in certain places cause immediate deletion.
 209 These are the same places where this behavior would occur later on anyway,
 210 in `substitute-in-file-name'."
 211   :type 'boolean
 212   :group 'minibuffer)
 213
 214 ;; originally by Stig@hackvan.com
 215 (defun minibuffer-electric-separator ()
 216   (interactive)
 217   (let ((c last-command-char))
 218     (and minibuffer-electric-file-name-behavior
 219          (eq c directory-sep-char)
 220          (eq c (char-before (point)))
 221          (not (save-excursion
 222               (goto-char (point-min))
 223               (and (looking-at "/.+:~?[^/]*/.+")
 224                    (re-search-forward "^/.+:~?[^/]*" nil t)
 225                    (progn
 226                      (delete-region (point) (point-max))
 227                      t))))
 228          (not (save-excursion
 229                 (goto-char (point-min))
 230                 (and (looking-at ".+://[^/]*/.+")
 231                      (re-search-forward "^.+:/" nil t)
 232                      (progn
 233                        (delete-region (point) (point-max))
 234                        t))))
 235          ;; permit `//hostname/path/to/file'
 236          (not (eq (point) (1+ (point-min))))
 237          ;; permit `http://url/goes/here'
 238          (or (not (eq ?: (char-after (- (point) 2))))
 239              (eq ?/ (char-after (point-min))))
 240        (delete-region (point-min) (point)))
 241     (insert c)))
 242
 243 (defun minibuffer-electric-tilde ()
 244   (interactive)
 245   (and minibuffer-electric-file-name-behavior
 246        (eq directory-sep-char (char-before (point)))
 247        ;; permit URL's with //, for e.g. http://hostname/~user
 248        (not (save-excursion (search-backward "//" nil t)))
 249        (delete-region (point-min) (point)))
 250   (insert ?~))
 251
 252
 253 (defvar read-file-name-map
 254   (let ((map (make-sparse-keymap 'read-file-name-map)))
 255     (set-keymap-parents map (list minibuffer-local-completion-map))
 256     (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
 257     (define-key map "~" 'minibuffer-electric-tilde)
 258     map
 259     ))
 260
 261 (defvar read-file-name-must-match-map
 262   (let ((map (make-sparse-keymap 'read-file-name-map)))
 263     (set-keymap-parents map (list minibuffer-local-must-match-map))
 264     (define-key map (vector directory-sep-char) 'minibuffer-electric-separator)
 265     (define-key map "~" 'minibuffer-electric-tilde)
 266     map
 267     ))
 268 \f
 269 (defun minibuffer-keyboard-quit ()
 270   "Abort recursive edit.
 271 If `zmacs-regions' is true, and the zmacs region is active in this buffer,
 272 then this key deactivates the region without beeping."
 273   (interactive)
 274   (if (region-active-p)
 275       ;; pseudo-zmacs compatibility: don't beep if this ^G is simply
 276       ;; deactivating the region.  If it is inactive, beep.
 277       nil
 278     (abort-recursive-edit)))
 279 \f
 280 ;;;; Guts of minibuffer invocation
 281
 282 ;;#### The only things remaining in C are
 283 ;; "Vminibuf_prompt" and the display junk
 284 ;;  "minibuf_prompt_width" and "minibuf_prompt_pix_width"
 285 ;; Also "active_frame", though I suspect I could already
 286 ;;   hack that in Lisp if I could make any sense of the
 287 ;;   complete mess of frame/frame code in XEmacs.
 288 ;; Vminibuf_prompt could easily be made Lisp-bindable.
 289 ;;  I suspect that minibuf_prompt*_width are actually recomputed
 290 ;;  by redisplay as needed -- or could be arranged to be so --
 291 ;;  and that there could be need for read-minibuffer-internal to
 292 ;;  save and restore them.
 293 ;;#### The only other thing which read-from-minibuffer-internal does
 294 ;;  which we can't presently do in Lisp is move the frame cursor
 295 ;;  to the start of the minibuffer line as it returns.  This is
 296 ;;  a rather nice touch and should be preserved -- probably by
 297 ;;  providing some Lisp-level mechanism (extension to cursor-in-echo-area ?)
 298 ;;  to effect it.
 299
 300
 301 ;; Like reset_buffer in FSF's buffer.c
 302 ;;  (Except that kill-all-local-variables doesn't nuke 'permanent-local
 303 ;;   variables -- we preserve them, reset_buffer doesn't.)
 304 (defun reset-buffer (buffer)
 305   (with-current-buffer buffer
 306     ;(if (fboundp 'unlock-buffer) (unlock-buffer))
 307     (kill-all-local-variables)
 308     (setq buffer-read-only nil)
 309     ;; don't let read only text yanked into the minibuffer
 310     ;; permanently wedge it.
 311     (make-local-variable 'inhibit-read-only)
 312     (setq inhibit-read-only t)
 313     (erase-buffer)
 314     ;(setq default-directory nil)
 315     (setq buffer-file-name nil)
 316     (setq buffer-file-truename nil)
 317     (set-buffer-modified-p nil)
 318     (setq buffer-backed-up nil)
 319     (setq buffer-auto-save-file-name nil)
 320     (set-buffer-dedicated-frame buffer nil)
 321     buffer))
 322
 323 (defvar minibuffer-history-variable 'minibuffer-history
 324   "History list symbol to add minibuffer values to.
 325 Each minibuffer output is added with
 326   (set minibuffer-history-variable
 327        (cons STRING (symbol-value minibuffer-history-variable)))")
 328 (defvar minibuffer-history-position)
 329
 330 ;; Added by hniksic:
 331 (defvar initial-minibuffer-history-position)
 332 (defvar current-minibuffer-contents)
 333 (defvar current-minibuffer-point)
 334
 335 (defcustom minibuffer-history-minimum-string-length nil
 336   "*If this variable is non-nil, a string will not be added to the
 337 minibuffer history if its length is less than that value."
 338   :type '(choice (const :tag "Any" nil)
 339                  integer)
 340   :group 'minibuffer)
 341
 342 (define-error 'input-error "Keyboard input error")
 343
 344 (put 'input-error 'display-error
 345      #'(lambda (error-object stream)
 346          (princ (cadr error-object) stream)))
 347
 348 (defun read-from-minibuffer (prompt &optional initial-contents
 349                                     keymap
 350                                     readp
 351                                     history
 352                                     abbrev-table
 353                                     default)
 354   "Read a string from the minibuffer, prompting with string PROMPT.
 355 If optional second arg INITIAL-CONTENTS is non-nil, it is a string
 356   to be inserted into the minibuffer before reading input.
 357   If INITIAL-CONTENTS is (STRING . POSITION), the initial input
 358   is STRING, but point is placed POSITION characters into the string.
 359 Third arg KEYMAP is a keymap to use while reading;
 360   if omitted or nil, the default is `minibuffer-local-map'.
 361 If fourth arg READ is non-nil, then interpret the result as a lisp object
 362   and return that object:
 363   in other words, do `(car (read-from-string INPUT-STRING))'
 364 Fifth arg HISTORY, if non-nil, specifies a history list
 365   and optionally the initial position in the list.
 366   It can be a symbol, which is the history list variable to use,
 367   or it can be a cons cell (HISTVAR . HISTPOS).
 368   In that case, HISTVAR is the history list variable to use,
 369   and HISTPOS is the initial position (the position in the list
 370   which INITIAL-CONTENTS corresponds to).
 371   If HISTORY is `t', no history will be recorded.
 372   Positions are counted starting from 1 at the beginning of the list.
 373 Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table'
 374   in the minibuffer.
 375 Seventh arg DEFAULT, if non-nil, will be returned when user enters
 376   an empty string.
 377
 378 See also the variable `completion-highlight-first-word-only' for
 379   control over completion display."
 380   (if (and (not enable-recursive-minibuffers)
 381            (> (minibuffer-depth) 0)
 382            (eq (selected-window) (minibuffer-window)))
 383       (error "Command attempted to use minibuffer while in minibuffer"))
 384
 385   (if (and minibuffer-max-depth
 386            (> minibuffer-max-depth 0)
 387            (>= (minibuffer-depth) minibuffer-max-depth))
 388       (minibuffer-max-depth-exceeded))
 389
 390   ;; catch this error before the poor user has typed something...
 391   (if history
 392       (if (symbolp history)
 393           (or (boundp history)
 394               (error "History list %S is unbound" history))
 395         (or (boundp (car history))
 396             (error "History list %S is unbound" (car history)))))
 397
 398   (if (noninteractive)
 399       (progn
 400         ;; XEmacs in -batch mode calls minibuffer: print the prompt.
 401         (message "%s" (gettext prompt))
 402         ;;#### force-output
 403
 404         ;;#### Should this even be falling though to the code below?
 405         ;;#### How does this stuff work now, anyway?
 406         ))
 407   (let* ((dir default-directory)
 408          (owindow (selected-window))
 409          (oframe (selected-frame))
 410          (window (minibuffer-window))
 411          (buffer (if (eq (minibuffer-depth) 0)
 412                      (window-buffer window)
 413                    (get-buffer-create (format " *Minibuf-%d"
 414                                               (minibuffer-depth)))))
 415          (frame (window-frame window))
 416          (mconfig (if (eq frame (selected-frame))
 417                       nil (current-window-configuration frame)))
 418          (oconfig (current-window-configuration))
 419          ;; dynamic scope sucks sucks sucks sucks sucks sucks.
 420          ;; `M-x doctor' makes history a local variable, and thus
 421          ;; our binding above is buffer-local and doesn't apply
 422          ;; once we switch buffers!!!!  We demand better scope!
 423          (_history_ history)
 424          (minibuffer-default default))
 425     (unwind-protect
 426          (progn
 427            (set-buffer (reset-buffer buffer))
 428            (setq default-directory dir)
 429            (make-local-variable 'print-escape-newlines)
 430            (setq print-escape-newlines t)
 431            (make-local-variable 'current-minibuffer-contents)
 432            (make-local-variable 'current-minibuffer-point)
 433            (make-local-variable 'initial-minibuffer-history-position)
 434            (setq current-minibuffer-contents ""
 435                  current-minibuffer-point 1)
 436            (if (not minibuffer-smart-completion-tracking-behavior)
 437                nil
 438              (make-local-variable 'mode-motion-hook)
 439              (or mode-motion-hook
 440                  ;;####disgusting
 441                  (setq mode-motion-hook 'minibuffer-smart-mouse-tracker))
 442              (make-local-variable 'mouse-track-click-hook)
 443              (add-hook 'mouse-track-click-hook
 444                        'minibuffer-smart-maybe-select-highlighted-completion))
 445            (set-window-buffer window buffer)
 446            (select-window window)
 447            (set-window-hscroll window 0)
 448            (buffer-enable-undo buffer)
 449            (message nil)
 450            (if initial-contents
 451                (if (consp initial-contents)
 452                    (progn
 453                      (insert (car initial-contents))
 454                      (goto-char (1+ (cdr initial-contents)))
 455                      (setq current-minibuffer-contents (car initial-contents)
 456                            current-minibuffer-point (cdr initial-contents)))
 457                  (insert initial-contents)
 458                  (setq current-minibuffer-contents initial-contents
 459                        current-minibuffer-point (point))))
 460            (use-local-map (help-keymap-with-help-key
 461                            (or keymap minibuffer-local-map)
 462                            minibuffer-help-form))
 463            (let ((mouse-grabbed-buffer
 464                   (and minibuffer-smart-completion-tracking-behavior
 465                        (current-buffer)))
 466                  (current-prefix-arg current-prefix-arg)
 467 ;;                 (help-form minibuffer-help-form)
 468                  (minibuffer-history-variable (cond ((not _history_)
 469                                                      'minibuffer-history)
 470                                                     ((consp _history_)
 471                                                      (car _history_))
 472                                                     (t
 473                                                      _history_)))
 474                  (minibuffer-history-position (cond ((consp _history_)
 475                                                      (cdr _history_))
 476                                                     (t
 477                                                      0)))
 478                  (minibuffer-scroll-window owindow))
 479              (setq initial-minibuffer-history-position
 480                    minibuffer-history-position)
 481              (if abbrev-table
 482                  (setq local-abbrev-table abbrev-table
 483                        abbrev-mode t))
 484              ;; This is now run from read-minibuffer-internal
 485              ;(if minibuffer-setup-hook
 486              ;    (run-hooks 'minibuffer-setup-hook))
 487              ;(message nil)
 488              (if (eq 't
 489                      (catch 'exit
 490                        (if (> (recursion-depth) (minibuffer-depth))
 491                            (let ((standard-output t)
 492                                  (standard-input t))
 493                              (read-minibuffer-internal prompt))
 494                            (read-minibuffer-internal prompt))))
 495                  ;; Translate an "abort" (throw 'exit 't)
 496                  ;;  into a real quit
 497                  (signal 'quit '())
 498                ;; return value
 499                (let* ((val (progn (set-buffer buffer)
 500                                   (if minibuffer-exit-hook
 501                                       (run-hooks 'minibuffer-exit-hook))
 502                                   (if (and (eq (char-after (point-min)) nil)
 503                                            default)
 504                                       default
 505                                     (buffer-string))))
 506                       (histval (if (and default (string= val ""))
 507                                    default
 508                                  val))
 509                       (err nil))
 510                  (if readp
 511                      (condition-case e
 512                          (let ((v (read-from-string val)))
 513                            (if (< (cdr v) (length val))
 514                                (save-match-data
 515                                  (or (string-match "[ \t\n]*\\'" val (cdr v))
 516                                      (error "Trailing garbage following expression"))))
 517                            (setq v (car v))
 518                            ;; total total kludge
 519                            (if (stringp v) (setq v (list 'quote v)))
 520                            (setq val v))
 521                        (end-of-file
 522                         (setq err
 523                               '(input-error "End of input before end of expression")))
 524                        (error (setq err e))))
 525                  ;; Add the value to the appropriate history list unless
 526                  ;; it's already the most recent element, or it's only
 527                  ;; two characters long.
 528                  (if (and (symbolp minibuffer-history-variable)
 529                           (boundp minibuffer-history-variable))
 530                      (let ((list (symbol-value minibuffer-history-variable)))
 531                        (or (eq list t)
 532                            (null val)
 533                            (and list (equal histval (car list)))
 534                            (and (stringp val)
 535                                 minibuffer-history-minimum-string-length
 536                                 (< (length val)
 537                                    minibuffer-history-minimum-string-length))
 538                            (set minibuffer-history-variable
 539                                 (if minibuffer-history-uniquify
 540                                     (cons histval (remove histval list))
 541                                   (cons histval list))))))
 542                  (if err (signal (car err) (cdr err)))
 543                  val))))
 544       ;; stupid display code requires this for some reason
 545       (set-buffer buffer)
 546       (buffer-disable-undo buffer)
 547       (setq buffer-read-only nil)
 548       (erase-buffer)
 549
 550       ;; restore frame configurations
 551       (if (and mconfig (frame-live-p oframe)
 552                (eq frame (selected-frame)))
 553           ;; if we changed frames (due to surrogate minibuffer),
 554           ;; and we're still on the new frame, go back to the old one.
 555           (select-frame oframe))
 556       (if mconfig (set-window-configuration mconfig))
 557       (set-window-configuration oconfig))))
 558
 559
 560 (defun minibuffer-max-depth-exceeded ()
 561   ;;
 562   ;; This signals an error if an Nth minibuffer is invoked while N-1 are
 563   ;; already active, whether the minibuffer window is selected or not.
 564   ;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x,
 565   ;; getting distracted, and clicking elsewhere) many many novice users have
 566   ;; had the problem of having multiple minibuffers build up, even to the
 567   ;; point of exceeding max-lisp-eval-depth.  Since the variable
 568   ;; enable-recursive-minibuffers historically/crockishly is only consulted
 569   ;; when the minibuffer is currently active (like typing M-x M-x) it doesn't
 570   ;; help in this situation.
 571   ;;
 572   ;; This routine also offers to edit .emacs for you to get rid of this
 573   ;; complaint, like `disabled' commands do, since it's likely that non-novice
 574   ;; users will be annoyed by this change, so we give them an easy way to get
 575   ;; rid of it forever.
 576   ;;
 577   (beep t 'minibuffer-limit-exceeded)
 578   (message
 579    "Minibuffer already active: abort it with `^]', enable new one with `n': ")
 580   (let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work??
 581                 (read-char))))
 582     (cond
 583      ((eq char ?n)
 584       (cond
 585        ((y-or-n-p "Enable recursive minibuffers for other sessions too? ")
 586         ;; This is completely disgusting, but it's basically what novice.el
 587         ;; does.  This kind of thing should be generalized.
 588         (setq minibuffer-max-depth nil)
 589         (save-excursion
 590           (set-buffer
 591            (find-file-noselect
 592             (substitute-in-file-name custom-file)))
 593           (goto-char (point-min))
 594           (if (re-search-forward
 595                "^(setq minibuffer-max-depth \\([0-9]+\\|'?nil\\|'?()\\))\n"
 596                nil t)
 597               (delete-region (match-beginning 0 ) (match-end 0))
 598             ;; Must have been disabled by default.
 599             (goto-char (point-max)))
 600           (insert"\n(setq minibuffer-max-depth nil)\n")
 601           (save-buffer))
 602         (message "Multiple minibuffers enabled")
 603         (sit-for 1))))
 604      ((eq char ?\1d)
 605       (abort-recursive-edit))
 606      (t
 607       (error "Minibuffer already active")))))
 608
 609 \f
 610 ;;;; Guts of minibuffer completion
 611
 612
 613 ;; Used by minibuffer-do-completion
 614 (defvar last-exact-completion nil)
 615
 616 (defun temp-minibuffer-message (m)
 617   (let ((savemax (point-max)))
 618     (save-excursion
 619       (goto-char (point-max))
 620       (message nil)
 621       (insert m))
 622     (let ((inhibit-quit t))
 623       (sit-for 2)
 624       (delete-region savemax (point-max))
 625       ;;  If the user types a ^G while we're in sit-for, then quit-flag
 626       ;;  gets set. In this case, we want that ^G to be interpreted
 627       ;;  as a normal character, and act just like typeahead.
 628       (if (and quit-flag (not unread-command-event))
 629           (setq unread-command-event (character-to-event (quit-char))
 630                 quit-flag nil)))))
 631
 632
 633 ;; Determines whether buffer-string is an exact completion
 634 (defun exact-minibuffer-completion-p (buffer-string)
 635   (cond ((not minibuffer-completion-table)
 636          ;; Empty alist
 637          nil)
 638         ((vectorp minibuffer-completion-table)
 639          (let ((tem (intern-soft buffer-string
 640                                  minibuffer-completion-table)))
 641            (if (or tem
 642                    (and (string-equal buffer-string "nil")
 643                         ;; intern-soft loses for 'nil
 644                         (catch 'found
 645                           (mapatoms #'(lambda (s)
 646                                         (if (string-equal
 647                                              (symbol-name s)
 648                                              buffer-string)
 649                                             (throw 'found t)))
 650                                     minibuffer-completion-table)
 651                           nil)))
 652                (if minibuffer-completion-predicate
 653                    (funcall minibuffer-completion-predicate
 654                             tem)
 655                    t)
 656                nil)))
 657         ((and (consp minibuffer-completion-table)
 658               ;;#### Emacs-Lisp truly sucks!
 659               ;; lambda, autoload, etc
 660               (not (symbolp (car minibuffer-completion-table))))
 661          (if (not completion-ignore-case)
 662              (assoc buffer-string minibuffer-completion-table)
 663              (let ((s (upcase buffer-string))
 664                    (tail minibuffer-completion-table)
 665                    tem)
 666                (while tail
 667                  (setq tem (car (car tail)))
 668                  (if (or (equal tem buffer-string)
 669                          (equal tem s)
 670                         (if tem (equal (upcase tem) s)))
 671                      (setq s 'win
 672                            tail nil)    ;exit
 673                      (setq tail (cdr tail))))
 674                (eq s 'win))))
 675         (t
 676          (funcall minibuffer-completion-table
 677                   buffer-string
 678                   minibuffer-completion-predicate
 679                   'lambda)))
 680   )
 681
 682 ;; 0 'none                 no possible completion
 683 ;; 1 'unique               was already an exact and unique completion
 684 ;; 3 'exact                was already an exact (but nonunique) completion
 685 ;; NOT USED 'completed-exact-unique completed to an exact and completion
 686 ;; 4 'completed-exact      completed to an exact (but nonunique) completion
 687 ;; 5 'completed            some completion happened
 688 ;; 6 'uncompleted          no completion happened
 689 (defun minibuffer-do-completion-1 (buffer-string completion)
 690   (cond ((not completion)
 691          'none)
 692         ((eq completion t)
 693          ;; exact and unique match
 694          'unique)
 695         (t
 696          ;; It did find a match.  Do we match some possibility exactly now?
 697          (let ((completedp (not (string-equal completion buffer-string))))
 698            (if completedp
 699                (progn
 700                  ;; Some completion happened
 701                  (erase-buffer)
 702                  (insert completion)
 703                  (setq buffer-string completion)))
 704            (if (exact-minibuffer-completion-p buffer-string)
 705                ;; An exact completion was possible
 706                (if completedp
 707 ;; Since no callers need to know the difference, don't bother
 708 ;;  with this (potentially expensive) discrimination.
 709 ;;                 (if (eq (try-completion completion
 710 ;;                                         minibuffer-completion-table
 711 ;;                                         minibuffer-completion-predicate)
 712 ;;                         't)
 713 ;;                     'completed-exact-unique
 714                        'completed-exact
 715 ;;                     )
 716                    'exact)
 717                ;; Not an exact match
 718                (if completedp
 719                    'completed
 720                    'uncompleted))))))
 721
 722
 723 (defun minibuffer-do-completion (buffer-string)
 724   (let* ((completion (try-completion buffer-string
 725                                      minibuffer-completion-table
 726                                      minibuffer-completion-predicate))
 727          (status (minibuffer-do-completion-1 buffer-string completion))
 728          (last last-exact-completion))
 729     (setq last-exact-completion nil)
 730     (cond ((eq status 'none)
 731            ;; No completions
 732            (ding nil 'no-completion)
 733            (temp-minibuffer-message " [No match]"))
 734           ((eq status 'unique)
 735            )
 736           (t
 737            ;; It did find a match.  Do we match some possibility exactly now?
 738            (if (not (string-equal completion buffer-string))
 739                (progn
 740                  ;; Some completion happened
 741                  (erase-buffer)
 742                  (insert completion)
 743                  (setq buffer-string completion)))
 744            (cond ((eq status 'exact)
 745                   ;; If the last exact completion and this one were
 746                   ;;  the same, it means we've already given a
 747                   ;;  "Complete but not unique" message and that the
 748                   ;;  user's hit TAB again, so now we give help.
 749                   (setq last-exact-completion completion)
 750                   (if (equal buffer-string last)
 751                       (minibuffer-completion-help)))
 752                  ((eq status 'uncompleted)
 753                   (if completion-auto-help
 754                       (minibuffer-completion-help)
 755                       (temp-minibuffer-message " [Next char not unique]")))
 756                  (t
 757                   nil))))
 758     status))
 759
 760 \f
 761 ;;;; completing-read
 762
 763 (defun completing-read (prompt table
 764                         &optional predicate require-match
 765                                   initial-contents history default)
 766   "Read a string in the minibuffer, with completion.
 767
 768 PROMPT is a string to prompt with; normally it ends in a colon and a space.
 769 TABLE is an alist whose elements' cars are strings, or an obarray.
 770 TABLE can also be a function which does the completion itself.
 771 PREDICATE limits completion to a subset of TABLE.
 772 See `try-completion' and `all-completions' for more details
 773   on completion, TABLE, and PREDICATE.
 774
 775 If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
 776   the input is (or completes to) an element of TABLE or is null.
 777   If it is also not t, Return does not exit if it does non-null completion.
 778 If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially.
 779   If it is (STRING . POSITION), the initial input
 780   is STRING, but point is placed POSITION characters into the string.
 781
 782 HISTORY, if non-nil, specifies a history list
 783   and optionally the initial position in the list.
 784   It can be a symbol, which is the history list variable to use,
 785   or it can be a cons cell (HISTVAR . HISTPOS).
 786   In that case, HISTVAR is the history list variable to use,
 787   and HISTPOS is the initial position (the position in the list
 788   which INITIAL-CONTENTS corresponds to).
 789   If HISTORY is `t', no history will be recorded.
 790   Positions are counted starting from 1 at the beginning of the list.
 791 DEFAULT, if non-nil, will be returned when the user enters an empty
 792   string.
 793
 794 Completion ignores case if the ambient value of
 795   `completion-ignore-case' is non-nil."
 796   (let ((minibuffer-completion-table table)
 797         (minibuffer-completion-predicate predicate)
 798         (minibuffer-completion-confirm (if (eq require-match 't) nil t))
 799         (last-exact-completion nil)
 800         ret)
 801     (setq ret (read-from-minibuffer prompt
 802                                     initial-contents
 803                                     (if (not require-match)
 804                                         minibuffer-local-completion-map
 805                                       minibuffer-local-must-match-map)
 806                                     nil
 807                                     history
 808                                     nil
 809                                     default))
 810     (if (and (string= ret "")
 811              default)
 812         default
 813       ret)))
 814
 815 \f
 816 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 817 ;;;;                   Minibuffer completion commands                   ;;;;
 818 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 819
 820
 821 (defun minibuffer-complete ()
 822   "Complete the minibuffer contents as far as possible.
 823 Return nil if there is no valid completion, else t.
 824 If no characters can be completed, display a list of possible completions.
 825 If you repeat this command after it displayed such a list,
 826 scroll the window of possible completions."
 827   (interactive)
 828   ;; If the previous command was not this, then mark the completion
 829   ;;  buffer obsolete.
 830   (or (eq last-command this-command)
 831       (setq minibuffer-scroll-window nil))
 832   (let ((window minibuffer-scroll-window))
 833     (if (and window (windowp window) (window-buffer window)
 834              (buffer-name (window-buffer window)))
 835         ;; If there's a fresh completion window with a live buffer
 836         ;;  and this command is repeated, scroll that window.
 837         (let ((obuf (current-buffer)))
 838           (unwind-protect
 839               (progn
 840                 (set-buffer (window-buffer window))
 841                 (if (pos-visible-in-window-p (point-max) window)
 842                     ;; If end is in view, scroll up to the beginning.
 843                     (set-window-start window (point-min))
 844                   ;; Else scroll down one frame.
 845                   (scroll-other-window)))
 846             (set-buffer obuf))
 847           nil)
 848       (let ((status (minibuffer-do-completion (buffer-string))))
 849         (if (eq status 'none)
 850             nil
 851           (progn
 852             (cond ((eq status 'unique)
 853                    (temp-minibuffer-message
 854                     " [Sole completion]"))
 855                   ((eq status 'exact)
 856                    (temp-minibuffer-message
 857                     " [Complete, but not unique]")))
 858             t))))))
 859
 860
 861 (defun minibuffer-complete-and-exit ()
 862   "Complete the minibuffer contents, and maybe exit.
 863 Exit if the name is valid with no completion needed.
 864 If name was completed to a valid match,
 865 a repetition of this command will exit."
 866   (interactive)
 867   (if (= (point-min) (point-max))
 868       ;; Crockishly allow user to specify null string
 869       (throw 'exit nil))
 870   (let ((buffer-string (buffer-string)))
 871     ;; Short-cut -- don't call minibuffer-do-completion if we already
 872     ;;  have an (possibly nonunique) exact completion.
 873     (if (exact-minibuffer-completion-p buffer-string)
 874         (throw 'exit nil))
 875     (let ((status (minibuffer-do-completion buffer-string)))
 876       (if (or (eq status 'unique)
 877               (eq status 'exact)
 878               (if (or (eq status 'completed-exact)
 879                       (eq status 'completed-exact-unique))
 880                   (if minibuffer-completion-confirm
 881                       (progn (temp-minibuffer-message " [Confirm]")
 882                              nil)
 883                       t)))
 884           (throw 'exit nil)))))
 885
 886
 887 (defun self-insert-and-exit ()
 888   "Terminate minibuffer input."
 889   (interactive)
 890   (self-insert-command 1)
 891   (throw 'exit nil))
 892
 893 (defun exit-minibuffer ()
 894   "Terminate this minibuffer argument.
 895 If minibuffer-confirm-incomplete is true, and we are in a completing-read
 896 of some kind, and the contents of the minibuffer is not an existing
 897 completion, requires an additional RET before the minibuffer will be exited
 898 \(assuming that RET was the character that invoked this command:
 899 the character in question must be typed again)."
 900   (interactive)
 901   (if (not minibuffer-confirm-incomplete)
 902       (throw 'exit nil))
 903   (let ((buffer-string (buffer-string)))
 904     (if (exact-minibuffer-completion-p buffer-string)
 905         (throw 'exit nil))
 906     (let ((completion (if (not minibuffer-completion-table)
 907                           t
 908                           (try-completion buffer-string
 909                                           minibuffer-completion-table
 910                                           minibuffer-completion-predicate))))
 911       (if (or (eq completion 't)
 912               ;; Crockishly allow user to specify null string
 913               (string-equal buffer-string ""))
 914           (throw 'exit nil))
 915       (if completion ;; rewritten for I18N3 snarfing
 916           (temp-minibuffer-message " [incomplete; confirm]")
 917         (temp-minibuffer-message " [no completions; confirm]"))
 918       (let ((event (let ((inhibit-quit t))
 919                      (prog1
 920                          (next-command-event)
 921                        (setq quit-flag nil)))))
 922         (cond ((equal event last-command-event)
 923                (throw 'exit nil))
 924               ((equal (quit-char) (event-to-character event))
 925                ;; Minibuffer abort.
 926                (throw 'exit t)))
 927         (dispatch-event event)))))
 928 \f
 929 ;;;; minibuffer-complete-word
 930
 931
 932 ;;;#### I think I have done this correctly; it certainly is simpler
 933 ;;;#### than what the C code seemed to be trying to do.
 934 (defun minibuffer-complete-word ()
 935   "Complete the minibuffer contents at most a single word.
 936 After one word is completed as much as possible, a space or hyphen
 937 is added, provided that matches some possible completion.
 938 Return nil if there is no valid completion, else t."
 939   (interactive)
 940   (let* ((buffer-string (buffer-string))
 941          (completion (try-completion buffer-string
 942                                      minibuffer-completion-table
 943                                      minibuffer-completion-predicate))
 944          (status (minibuffer-do-completion-1 buffer-string completion)))
 945     (cond ((eq status 'none)
 946            (ding nil 'no-completion)
 947            (temp-minibuffer-message " [No match]")
 948            nil)
 949           ((eq status 'unique)
 950            ;; New message, only in this new Lisp code
 951            (temp-minibuffer-message " [Sole completion]")
 952            t)
 953           (t
 954            (cond ((or (eq status 'uncompleted)
 955                       (eq status 'exact))
 956                   (let ((foo #'(lambda (s)
 957                                  (condition-case nil
 958                                      (if (try-completion
 959                                           (concat buffer-string s)
 960                                           minibuffer-completion-table
 961                                           minibuffer-completion-predicate)
 962                                          (progn
 963                                            (goto-char (point-max))
 964                                            (insert s)
 965                                            t)
 966                                        nil)
 967                                    (error nil))))
 968                         (char last-command-char))
 969                     ;; Try to complete by adding a word-delimiter
 970                     (or (and (characterp char) (> char 0)
 971                              (funcall foo (char-to-string char)))
 972                         (and (not (eq char ?\ ))
 973                              (funcall foo " "))
 974                         (and (not (eq char ?\-))
 975                              (funcall foo "-"))
 976                         (progn
 977                           (if completion-auto-help
 978                               (minibuffer-completion-help)
 979                               ;; New message, only in this new Lisp code
 980                             ;; rewritten for I18N3 snarfing
 981                             (if (eq status 'exact)
 982                                 (temp-minibuffer-message
 983                                  " [Complete, but not unique]")
 984                               (temp-minibuffer-message " [Ambiguous]")))
 985                           nil))))
 986                  (t
 987                   (erase-buffer)
 988                   (insert completion)
 989                   ;; First word-break in stuff found by completion
 990                   (goto-char (point-min))
 991                   (let ((len (length buffer-string))
 992                         n)
 993                     (if (and (< len (length completion))
 994                              (catch 'match
 995                                (setq n 0)
 996                                (while (< n len)
 997                                  (if (char-equal
 998                                        (upcase (aref buffer-string n))
 999                                        (upcase (aref completion n)))
1000                                      (setq n (1+ n))
1001                                      (throw 'match nil)))
1002                                t)
1003                              (progn
1004                                (goto-char (point-min))
1005                                (forward-char len)
1006                                (re-search-forward "\\W" nil t)))
1007                         (delete-region (point) (point-max))
1008                         (goto-char (point-max))))
1009                   t))))))
1010 \f
1011 \f
1012 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1013 ;;;;                      "Smart minibuffer" hackery                    ;;;;
1014 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1015
1016 ;;; ("Kludgy minibuffer hackery" is perhaps a better name)
1017
1018 ;; This works by setting `mouse-grabbed-buffer' to the minibuffer,
1019 ;; defining button2 in the minibuffer keymap to
1020 ;; `minibuffer-smart-select-highlighted-completion', and setting the
1021 ;; mode-motion-hook of the minibuffer to `minibuffer-mouse-tracker'.
1022 ;; By setting `mouse-grabbed-buffer', the minibuffer's keymap and
1023 ;; mode-motion-hook apply (for mouse motion and presses) no matter
1024 ;; what buffer the mouse is over.  Then, `minibuffer-mouse-tracker'
1025 ;; examines the text under the mouse looking for something that looks
1026 ;; like a completion, and causes it to be highlighted, and
1027 ;; `minibuffer-smart-select-highlighted-completion' looks for a
1028 ;; flagged completion under the mouse and inserts it.  This has the
1029 ;; following advantages:
1030 ;;
1031 ;; -- filenames and such in any buffer can be inserted by clicking,
1032 ;;    not just completions
1033 ;;
1034 ;; but the following disadvantages:
1035 ;;
1036 ;; -- unless you're aware of the "filename in any buffer" feature,
1037 ;;    the fact that strings in arbitrary buffers get highlighted appears
1038 ;;    as a bug
1039 ;; -- mouse motion can cause ange-ftp actions -- bad bad bad.
1040 ;;
1041 ;; There's some hackery in minibuffer-mouse-tracker to try to avoid the
1042 ;; ange-ftp stuff, but it doesn't work.
1043 ;;
1044
1045 (defcustom minibuffer-smart-completion-tracking-behavior nil
1046   "*If non-nil, look for completions under mouse in all buffers.
1047 This allows you to click on something that looks like a completion
1048 and have it selected, regardless of what buffer it is in.
1049
1050 This is not enabled by default because
1051
1052 -- The \"mysterious\" highlighting in normal buffers is confusing to
1053    people not expecting it, and looks like a bug
1054 -- If ange-ftp is enabled, this tracking sometimes causes ange-ftp
1055    action as a result of mouse motion, which is *bad bad bad*.
1056    Hopefully this bug will be fixed at some point."
1057   :type 'boolean
1058   :group 'minibuffer)
1059
1060 (defun minibuffer-smart-mouse-tracker (event)
1061   ;; Used as the mode-motion-hook of the minibuffer window, which is the
1062   ;; value of `mouse-grabbed-buffer' while the minibuffer is active.  If
1063   ;; the word under the mouse is a valid minibuffer completion, then it
1064   ;; is highlighted.
1065   ;;
1066   ;; We do some special voodoo when we're reading a pathname, because
1067   ;; the way filename completion works is funny.  Possibly there's some
1068   ;; more general way this could be dealt with...
1069   ;;
1070   ;; We do some further voodoo when reading a pathname that is an
1071   ;; ange-ftp or efs path, because causing FTP activity as a result of
1072   ;; mouse motion is a really bad time.
1073   ;;
1074   (and minibuffer-smart-completion-tracking-behavior
1075        (event-point event)
1076        ;; avoid conflict with display-completion-list extents
1077        (not (extent-at (event-point event)
1078                        (event-buffer event)
1079                        'list-mode-item))
1080        (let ((filename-kludge-p (eq minibuffer-completion-table
1081                                     'read-file-name-internal)))
1082          (mode-motion-highlight-internal
1083           event
1084           #'(lambda () (default-mouse-track-beginning-of-word
1085                          (if filename-kludge-p 'nonwhite t)))
1086           #'(lambda ()
1087               (let ((p (point))
1088                     (string ""))
1089                 (default-mouse-track-end-of-word
1090                   (if filename-kludge-p 'nonwhite t))
1091                 (if (and (/= p (point)) minibuffer-completion-table)
1092                     (setq string (buffer-substring p (point))))
1093                 (if (string-match "\\`[ \t\n]*\\'" string)
1094                     (goto-char p)
1095                   (if filename-kludge-p
1096                       (setq string (minibuffer-smart-select-kludge-filename
1097                                     string)))
1098                   ;; try-completion bogusly returns a string even when
1099                   ;; that string is complete if that string is also a
1100                   ;; prefix for other completions.  This means that we
1101                   ;; can't just do the obvious thing, (eq t
1102                   ;; (try-completion ...)).
1103                   (let (comp)
1104                     (if (and filename-kludge-p
1105                              ;; #### evil evil evil evil
1106                              (or (and (fboundp 'ange-ftp-ftp-path)
1107                                       (ange-ftp-ftp-path string))
1108                                  (and (fboundp 'efs-ftp-path)
1109                                       (efs-ftp-path string))))
1110                         (setq comp t)
1111                       (setq comp
1112                             (try-completion string
1113                                             minibuffer-completion-table
1114                                             minibuffer-completion-predicate)))
1115                     (or (eq comp t)
1116                         (and (equal comp string)
1117                              (or (null minibuffer-completion-predicate)
1118                                  (stringp
1119                                   minibuffer-completion-predicate) ; ???
1120                                  (funcall minibuffer-completion-predicate
1121                                           (if (vectorp
1122                                                minibuffer-completion-table)
1123                                               (intern-soft
1124                                                string
1125                                                minibuffer-completion-table)
1126                                             string))))
1127                         (goto-char p))))))))))
1128
1129 (defun minibuffer-smart-select-kludge-filename (string)
1130   (save-excursion
1131     (set-buffer mouse-grabbed-buffer) ; the minibuf
1132     (let ((kludge-string (concat (buffer-string) string)))
1133       (if (or (and (fboundp 'ange-ftp-ftp-path)
1134                    (ange-ftp-ftp-path kludge-string))
1135                (and (fboundp 'efs-ftp-path) (efs-ftp-path kludge-string)))
1136            ;; #### evil evil evil, but more so.
1137            string
1138          (append-expand-filename (buffer-string) string)))))
1139
1140 (defun minibuffer-smart-select-highlighted-completion (event)
1141   "Select the highlighted text under the mouse as a minibuffer response.
1142 When the minibuffer is being used to prompt the user for a completion,
1143 any valid completions which are visible on the frame will highlight
1144 when the mouse moves over them.  Clicking \\<minibuffer-local-map>\
1145 \\[minibuffer-smart-select-highlighted-completion] will select the
1146 highlighted completion under the mouse.
1147
1148 If the mouse is clicked while not over a highlighted completion,
1149 then the global binding of \\[minibuffer-smart-select-highlighted-completion] \
1150 will be executed instead.  In this\nway you can get at the normal global \
1151 behavior of \\[minibuffer-smart-select-highlighted-completion] as well as
1152 the special minibuffer behavior."
1153   (interactive "e")
1154   (if minibuffer-smart-completion-tracking-behavior
1155       (minibuffer-smart-select-highlighted-completion-1 event t)
1156     (let ((command (lookup-key global-map
1157                                (vector current-mouse-event))))
1158       (if command (call-interactively command)))))
1159
1160 (defun minibuffer-smart-select-highlighted-completion-1 (event global-p)
1161   (let* ((filename-kludge-p (eq minibuffer-completion-table
1162                                 'read-file-name-internal))
1163          completion
1164          command-p
1165          (evpoint (event-point event))
1166          (evextent (and evpoint (extent-at evpoint (event-buffer event)
1167                                            'list-mode-item))))
1168     (if evextent
1169         ;; avoid conflict with display-completion-list extents.
1170         ;; if we find one, do that behavior instead.
1171         (list-mode-item-selected-1 evextent event)
1172       (save-excursion
1173         (let* ((buffer (window-buffer (event-window event)))
1174                (p (event-point event))
1175                (extent (and p (extent-at p buffer 'mouse-face))))
1176           (set-buffer buffer)
1177           (if (not (and (extent-live-p extent)
1178                         (eq (extent-object extent) (current-buffer))
1179                         (not (extent-detached-p extent))))
1180               (setq command-p t)
1181             ;; ...else user has selected a highlighted completion.
1182             (setq completion
1183                   (buffer-substring (extent-start-position extent)
1184                                     (extent-end-position extent)))
1185             (if filename-kludge-p
1186                 (setq completion (minibuffer-smart-select-kludge-filename
1187                                   completion)))
1188             ;; remove the extent so that it's not hanging around in
1189             ;; *Completions*
1190             (detach-extent extent)
1191             (set-buffer mouse-grabbed-buffer)
1192             (erase-buffer)
1193             (insert completion))))
1194       ;; we need to execute the command or do the throw outside of the
1195       ;; save-excursion.
1196       (cond ((and command-p global-p)
1197              (let ((command (lookup-key global-map
1198                                         (vector current-mouse-event))))
1199                (if command
1200                    (call-interactively command)
1201                  (if minibuffer-completion-table
1202                      (error
1203                       "Highlighted words are valid completions.  You may select one.")
1204                    (error "no completions")))))
1205             ((not command-p)
1206              ;; things get confused if the minibuffer is terminated while
1207              ;; not selected.
1208              (select-window (minibuffer-window))
1209              (if (and filename-kludge-p (file-directory-p completion))
1210                  ;; if the user clicked middle on a directory name, display the
1211                  ;; files in that directory.
1212                  (progn
1213                    (goto-char (point-max))
1214                    (minibuffer-completion-help))
1215                ;; otherwise, terminate input
1216                (throw 'exit nil)))))))
1217
1218 (defun minibuffer-smart-maybe-select-highlighted-completion
1219   (event &optional click-count)
1220   "Like `minibuffer-smart-select-highlighted-completion' but does nothing if
1221 there is no completion (as opposed to executing the global binding).  Useful
1222 as the value of `mouse-track-click-hook'."
1223   (interactive "e")
1224   (minibuffer-smart-select-highlighted-completion-1 event nil))
1225
1226 (define-key minibuffer-local-map 'button2
1227   'minibuffer-smart-select-highlighted-completion)
1228
1229 \f
1230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1231 ;;;;                         Minibuffer History                         ;;;;
1232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1233
1234 (defvar minibuffer-history '()
1235   "Default minibuffer history list.
1236 This is used for all minibuffer input except when an alternate history
1237 list is specified.")
1238
1239 ;; Some other history lists:
1240 ;;
1241 (defvar minibuffer-history-search-history '())
1242 (defvar function-history '())
1243 (defvar variable-history '())
1244 (defvar buffer-history '())
1245 (defvar shell-command-history '())
1246 (defvar file-name-history '())
1247
1248 (defvar read-expression-history nil)
1249
1250 (defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge
1251   "Non-nil when doing history operations on `command-history'.
1252 More generally, indicates that the history list being acted on
1253 contains expressions rather than strings.")
1254
1255 (defun previous-matching-history-element (regexp n)
1256   "Find the previous history element that matches REGEXP.
1257 \(Previous history elements refer to earlier actions.)
1258 With prefix argument N, search for Nth previous match.
1259 If N is negative, find the next or Nth next match."
1260   (interactive
1261    (let ((enable-recursive-minibuffers t)
1262          (minibuffer-history-sexp-flag nil)
1263          (minibuffer-max-depth (and minibuffer-max-depth
1264                                     (1+ minibuffer-max-depth))))
1265      (if (eq 't (symbol-value minibuffer-history-variable))
1266          (error "History is not being recorded in this context"))
1267      (list (read-from-minibuffer "Previous element matching (regexp): "
1268                                  (car minibuffer-history-search-history)
1269                                  minibuffer-local-map
1270                                  nil
1271                                  'minibuffer-history-search-history)
1272            (prefix-numeric-value current-prefix-arg))))
1273   (let ((history (symbol-value minibuffer-history-variable))
1274         prevpos
1275         (pos minibuffer-history-position))
1276     (if (eq history t)
1277         (error "History is not being recorded in this context"))
1278     (while (/= n 0)
1279       (setq prevpos pos)
1280       (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
1281       (if (= pos prevpos)
1282           (if (= pos 1) ;; rewritten for I18N3 snarfing
1283               (error "No later matching history item")
1284             (error "No earlier matching history item")))
1285       (if (string-match regexp
1286                         (if minibuffer-history-sexp-flag
1287                             (let ((print-level nil))
1288                               (prin1-to-string (nth (1- pos) history)))
1289                             (nth (1- pos) history)))
1290           (setq n (+ n (if (< n 0) 1 -1)))))
1291     (setq minibuffer-history-position pos)
1292     (setq current-minibuffer-contents (buffer-string)
1293           current-minibuffer-point (point))
1294     (erase-buffer)
1295     (let ((elt (nth (1- pos) history)))
1296       (insert (if minibuffer-history-sexp-flag
1297                   (let ((print-level nil))
1298                     (prin1-to-string elt))
1299                   elt)))
1300       (goto-char (point-min)))
1301   (if (or (eq (car (car command-history)) 'previous-matching-history-element)
1302           (eq (car (car command-history)) 'next-matching-history-element))
1303       (setq command-history (cdr command-history))))
1304
1305 (defun next-matching-history-element (regexp n)
1306   "Find the next history element that matches REGEXP.
1307 \(The next history element refers to a more recent action.)
1308 With prefix argument N, search for Nth next match.
1309 If N is negative, find the previous or Nth previous match."
1310   (interactive
1311    (let ((enable-recursive-minibuffers t)
1312          (minibuffer-history-sexp-flag nil)
1313          (minibuffer-max-depth (and minibuffer-max-depth
1314                                     (1+ minibuffer-max-depth))))
1315      (if (eq t (symbol-value minibuffer-history-variable))
1316          (error "History is not being recorded in this context"))
1317      (list (read-from-minibuffer "Next element matching (regexp): "
1318                                  (car minibuffer-history-search-history)
1319                                  minibuffer-local-map
1320                                  nil
1321                                  'minibuffer-history-search-history)
1322            (prefix-numeric-value current-prefix-arg))))
1323   (previous-matching-history-element regexp (- n)))
1324
1325 (defun next-history-element (n)
1326   "Insert the next element of the minibuffer history into the minibuffer."
1327   (interactive "p")
1328   (if (eq 't (symbol-value minibuffer-history-variable))
1329       (error "History is not being recorded in this context"))
1330   (unless (zerop n)
1331     (when (eq minibuffer-history-position
1332               initial-minibuffer-history-position)
1333       (setq current-minibuffer-contents (buffer-string)
1334             current-minibuffer-point (point)))
1335     (let ((narg (- minibuffer-history-position n))
1336           (minimum (if minibuffer-default -1 0)))
1337       ;; a weird special case here; when in repeat-complex-command, we're
1338       ;; trying to edit the top command, and minibuffer-history-position
1339       ;; points to 1, the next-to-top command.  in this case, the top
1340       ;; command in the history is suppressed in favor of the one being
1341       ;; edited, and there is no more command below it, except maybe the
1342       ;; default.
1343       (if (and (zerop narg) (eq minibuffer-history-position
1344                                 initial-minibuffer-history-position))
1345           (setq minimum (1+ minimum)))
1346       (cond ((< narg minimum)
1347              (error (if minibuffer-default
1348                         "No following item in %s"
1349                       "No following item in %s; no default available")
1350                     minibuffer-history-variable))
1351             ((> narg (length (symbol-value minibuffer-history-variable)))
1352              (error "No preceding item in %s" minibuffer-history-variable)))
1353       (erase-buffer)
1354       (setq minibuffer-history-position narg)
1355       (if (eq narg initial-minibuffer-history-position)
1356           (progn
1357             (insert current-minibuffer-contents)
1358             (goto-char current-minibuffer-point))
1359         (let ((elt (if (> narg 0)
1360                        (nth (1- minibuffer-history-position)
1361                             (symbol-value minibuffer-history-variable))
1362                      minibuffer-default)))
1363           (insert
1364            (if (not (stringp elt))
1365                (let ((print-level nil))
1366                  (condition-case nil
1367                      (let ((print-readably t)
1368                            (print-escape-newlines t))
1369                        (prin1-to-string elt))
1370                    (error (prin1-to-string elt))))
1371              elt)))
1372         ;; FSF has point-min here.
1373         (goto-char (point-max))))))
1374
1375 (defun previous-history-element (n)
1376   "Insert the previous element of the minibuffer history into the minibuffer."
1377   (interactive "p")
1378   (next-history-element (- n)))
1379
1380 (defun next-complete-history-element (n)
1381   "Get next element of history which is a completion of minibuffer contents."
1382   (interactive "p")
1383   (let ((point-at-start (point)))
1384     (next-matching-history-element
1385      (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
1386     ;; next-matching-history-element always puts us at (point-min).
1387     ;; Move to the position we were at before changing the buffer contents.
1388     ;; This is still sensical, because the text before point has not changed.
1389     (goto-char point-at-start)))
1390
1391 (defun previous-complete-history-element (n)
1392   "Get previous element of history which is a completion of minibuffer contents."
1393   (interactive "p")
1394   (next-complete-history-element (- n)))
1395
1396 \f
1397 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1398 ;;;;                reading various things from a minibuffer            ;;;;
1399 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1400
1401 (defun read-expression (prompt &optional initial-contents history default-value)
1402   "Return a Lisp object read using the minibuffer, prompting with PROMPT.
1403 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
1404  in the minibuffer before reading.
1405 Third arg HISTORY, if non-nil, specifies a history list.
1406 Fourth arg DEFAULT-VALUE is the default value.  If non-nil, it is used
1407  for history command, and as the value to return if the user enters the
1408  empty string."
1409   (let ((minibuffer-history-sexp-flag t)
1410         ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
1411         (minibuffer-completion-table nil))
1412     (read-from-minibuffer prompt
1413                           initial-contents
1414                           read-expression-map
1415                           t
1416                           (or history 'read-expression-history)
1417                           lisp-mode-abbrev-table
1418                           default-value)))
1419
1420 (defun read-string (prompt &optional initial-contents history default-value)
1421   "Return a string from the minibuffer, prompting with string PROMPT.
1422 If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
1423  in the minibuffer before reading.
1424 Third arg HISTORY, if non-nil, specifies a history list.
1425 Fourth arg DEFAULT-VALUE is the default value.  If non-nil, it is used
1426  for history command, and as the value to return if the user enters the
1427  empty string."
1428   (let ((minibuffer-completion-table nil))
1429     (read-from-minibuffer prompt
1430                           initial-contents
1431                           minibuffer-local-map
1432                           nil history nil default-value)))
1433
1434 (defun eval-minibuffer (prompt &optional initial-contents history default-value)
1435   "Return value of Lisp expression read using the minibuffer.
1436 Prompt with PROMPT.  If non-nil, optional second arg INITIAL-CONTENTS
1437 is a string to insert in the minibuffer before reading.
1438 Third arg HISTORY, if non-nil, specifies a history list.
1439 Fourth arg DEFAULT-VALUE is the default value.  If non-nil, it is used
1440  for history command, and as the value to return if the user enters the
1441  empty string."
1442   (eval (read-expression prompt initial-contents history default-value)))
1443
1444 ;; The name `command-history' is already taken
1445 (defvar read-command-history '())
1446
1447 (defun read-command (prompt &optional default-value)
1448   "Read the name of a command and return as a symbol.
1449 Prompts with PROMPT.  By default, return DEFAULT-VALUE."
1450   (intern (completing-read prompt obarray 'commandp t nil
1451                            ;; 'command-history is not right here: that's a
1452                            ;; list of evalable forms, not a history list.
1453                            'read-command-history
1454                            default-value)))
1455
1456 (defun read-function (prompt &optional default-value)
1457   "Read the name of a function and return as a symbol.
1458 Prompts with PROMPT.  By default, return DEFAULT-VALUE."
1459   (intern (completing-read prompt obarray 'fboundp t nil
1460                            'function-history default-value)))
1461
1462 (defun read-variable (prompt &optional default-value)
1463   "Read the name of a user variable and return it as a symbol.
1464 Prompts with PROMPT.  By default, return DEFAULT-VALUE.
1465 A user variable is one whose documentation starts with a `*' character."
1466   (intern (completing-read prompt obarray 'user-variable-p t nil
1467                            'variable-history
1468                            (if (symbolp default-value)
1469                                (symbol-name default-value)
1470                              default-value))))
1471
1472 (defun read-buffer (prompt &optional default require-match)
1473   "Read the name of a buffer and return as a string.
1474 Prompts with PROMPT.  Optional second arg DEFAULT is value to return if user
1475 enters an empty line.  If optional third arg REQUIRE-MATCH is non-nil,
1476 only existing buffer names are allowed."
1477   (let ((prompt (if default
1478                     (format "%s(default %s) "
1479                             (gettext prompt) (if (bufferp default)
1480                                                  (buffer-name default)
1481                                                default))
1482                     prompt))
1483         (alist (mapcar #'(lambda (b) (cons (buffer-name b) b))
1484                        (buffer-list)))
1485         result)
1486     (while (progn
1487              (setq result (completing-read prompt alist nil require-match
1488                                            nil 'buffer-history
1489                                            (if (bufferp default)
1490                                                (buffer-name default)
1491                                              default)))
1492              (cond ((not (equal result ""))
1493                     nil)
1494                    ((not require-match)
1495                     (setq result default)
1496                     nil)
1497                    ((not default)
1498                     t)
1499                    ((not (get-buffer default))
1500                     t)
1501                    (t
1502                     (setq result default)
1503                     nil))))
1504     (if (bufferp result)
1505         (buffer-name result)
1506       result)))
1507
1508 (defun read-number (prompt &optional integers-only default-value)
1509   "Read a number from the minibuffer, prompting with PROMPT.
1510 If optional second argument INTEGERS-ONLY is non-nil, accept
1511  only integer input.
1512 If DEFAULT-VALUE is non-nil, return that if user enters an empty
1513  line."
1514   (let ((pred (if integers-only 'integerp 'numberp))
1515         num)
1516     (while (not (funcall pred num))
1517       (setq num (condition-case ()
1518                     (let ((minibuffer-completion-table nil))
1519                       (read-from-minibuffer
1520                        prompt (if num (prin1-to-string num)) nil t
1521                        nil nil default-value))
1522                   (input-error nil)
1523                   (invalid-read-syntax nil)
1524                   (end-of-file nil)))
1525       (or (funcall pred num) (beep)))
1526     num))
1527
1528 (defun read-shell-command (prompt &optional initial-input history default-value)
1529   "Just like read-string, but uses read-shell-command-map:
1530 \\{read-shell-command-map}"
1531   (let ((minibuffer-completion-table nil))
1532     (read-from-minibuffer prompt initial-input read-shell-command-map
1533                           nil (or history 'shell-command-history)
1534                           nil default-value)))
1535
1536 \f
1537 ;;; This read-file-name stuff probably belongs in files.el
1538
1539 ;; Quote "$" as "$$" to get it past substitute-in-file-name
1540 (defun un-substitute-in-file-name (string)
1541   (let ((regexp "\\$")
1542         (olen (length string))
1543         new
1544         n o ch)
1545     (if (not (string-match regexp string))
1546         string
1547       (setq n 1)
1548       (while (string-match regexp string (match-end 0))
1549         (setq n (1+ n)))
1550       (setq new (make-string (+ olen n) ?$))
1551       (setq n 0 o 0)
1552       (while (< o olen)
1553         (setq ch (aref string o))
1554         (aset new n ch)
1555         (setq o (1+ o) n (1+ n))
1556         (if (eq ch ?$)
1557             ;; already aset by make-string initial-value
1558             (setq n (1+ n))))
1559       new)))
1560
1561
1562 ;; Wrapper for `directory-files' for use in generating completion lists.
1563 ;; Generates output in the same format as `file-name-all-completions'.
1564 ;;
1565 ;; The EFS replacement for `directory-files' doesn't support the FILES-ONLY
1566 ;; option, so it has to be faked.  The listing cache will hopefully
1567 ;; improve the performance of this operation.
1568 (defun minibuf-directory-files (dir &optional match-regexp files-only)
1569   (let ((want-file (or (eq files-only nil) (eq files-only t)))
1570         (want-dirs (or (eq files-only nil) (not (eq files-only t)))))
1571     (delete nil
1572             (mapcar (function (lambda (f)
1573                                 (if (file-directory-p (expand-file-name f dir))
1574                                     (and want-dirs (file-name-as-directory f))
1575                                   (and want-file f))))
1576                     (delete "." (directory-files dir nil match-regexp))))))
1577
1578
1579 (defun read-file-name-2 (history prompt dir default
1580                                  must-match initial-contents
1581                                  completer)
1582   (if (not dir)
1583       (setq dir default-directory))
1584   (setq dir (abbreviate-file-name dir t))
1585   (let* ((insert (cond ((and (not insert-default-directory)
1586                              (not initial-contents))
1587                         "")
1588                        (initial-contents
1589                         (cons (un-substitute-in-file-name
1590                                (concat dir initial-contents))
1591                               (length dir)))
1592                        (t
1593                         (un-substitute-in-file-name dir))))
1594          (val
1595                 ;;  Hateful, broken, case-sensitive un*x
1596 ;;;                 (completing-read prompt
1597 ;;;                                  completer
1598 ;;;                                  dir
1599 ;;;                                  must-match
1600 ;;;                                  insert
1601 ;;;                                  history)
1602           ;; #### - this is essentially the guts of completing read.
1603           ;; There should be an elegant way to pass a pair of keymaps to
1604           ;; completing read, but this will do for now.  All sins are
1605           ;; relative.  --Stig
1606           (let ((minibuffer-completion-table completer)
1607                 (minibuffer-completion-predicate dir)
1608                 (minibuffer-completion-confirm (if (eq must-match 't)
1609                                                    nil t))
1610                 (last-exact-completion nil))
1611             (read-from-minibuffer prompt
1612                                   insert
1613                                   (if (not must-match)
1614                                       read-file-name-map
1615                                     read-file-name-must-match-map)
1616                                   nil
1617                                   history
1618                                   nil
1619                                   default))))
1620 ;;;     ;; Kludge!  Put "/foo/bar" on history rather than "/default//foo/bar"
1621 ;;;     (let ((hist (cond ((not history) 'minibuffer-history)
1622 ;;;                       ((consp history) (car history))
1623 ;;;                       (t history))))
1624 ;;;       (if (and val
1625 ;;;                hist
1626 ;;;                (not (eq hist 't))
1627 ;;;                (boundp hist)
1628 ;;;                (equal (car-safe (symbol-value hist)) val))
1629 ;;;           (let ((e (condition-case nil
1630 ;;;                        (expand-file-name val)
1631 ;;;                      (error nil))))
1632 ;;;             (if (and e (not (equal e val)))
1633 ;;;                 (set hist (cons e (cdr (symbol-value hist))))))))
1634
1635     (cond ((not val)
1636            (error "No file name specified"))
1637           ((and default
1638                 (equal val (if (consp insert) (car insert) insert)))
1639            default)
1640           (t
1641            (substitute-in-file-name val)))))
1642
1643 ;; #### this function should use minibuffer-completion-table
1644 ;; or something.  But that is sloooooow.
1645 ;; #### all this shit needs better documentation!!!!!!!!
1646 (defun read-file-name-activate-callback (event extent dir-p)
1647   ;; used as the activate-callback of the filename list items
1648   ;; in the completion buffer, in place of default-choose-completion.
1649   ;; if a regular file was selected, we call default-choose-completion
1650   ;; (which just inserts the string in the minibuffer and calls
1651   ;; exit-minibuffer).  If a directory was selected, we display
1652   ;; the contents of the directory.
1653   (let* ((file (extent-string extent))
1654          (completion-buf (extent-object extent))
1655          (minibuf (symbol-value-in-buffer 'completion-reference-buffer
1656                                           completion-buf))
1657          (in-dir (file-name-directory (buffer-substring nil nil minibuf)))
1658          (full (expand-file-name file in-dir)))
1659     (if (not (file-directory-p full))
1660         (default-choose-completion event extent minibuf)
1661       (erase-buffer minibuf)
1662       (insert-string (file-name-as-directory
1663                       (abbreviate-file-name full t)) minibuf)
1664       (reset-buffer completion-buf)
1665       (let ((standard-output completion-buf))
1666         (display-completion-list
1667          (minibuf-directory-files full nil (if dir-p 'directory))
1668          :user-data dir-p
1669          :reference-buffer minibuf
1670          :activate-callback 'read-file-name-activate-callback)
1671         (goto-char (point-min) completion-buf)))))
1672
1673 (defun read-file-name-1 (type history prompt dir default
1674                               must-match initial-contents
1675                               completer)
1676   (if (should-use-dialog-box-p)
1677       (condition-case nil
1678           (let ((file
1679                  (apply #'make-dialog-box
1680                         type `(:title ,(capitalize-string-as-title
1681                                         ;; Kludge: Delete ": " off the end.
1682                                         (replace-in-string prompt ": $" ""))
1683                                       ,@(and dir (list :initial-directory
1684                                                        dir))
1685                                       :file-must-exist ,must-match
1686                                       ,@(and initial-contents
1687                                              (list :initial-filename
1688                                                    initial-contents))))))
1689             ;; hack -- until we implement reading a directory properly,
1690             ;; allow a file as indicating the directory it's in
1691             (if (and (eq completer 'read-directory-name-internal)
1692                      (not (file-directory-p file)))
1693                 (file-name-directory file)
1694               file))
1695         (unimplemented
1696          ;; this calls read-file-name-2
1697          (mouse-read-file-name-1 history prompt dir default must-match
1698                                  initial-contents completer)
1699          ))
1700     (add-one-shot-hook
1701      'minibuffer-setup-hook
1702      (lambda ()
1703        ;; #### SCREAM!  Create a `file-system-ignore-case'
1704        ;; function, so this kind of stuff is generalized!
1705        (and (eq system-type 'windows-nt)
1706             (set (make-local-variable 'completion-ignore-case) t))
1707        (set
1708         (make-local-variable
1709          'completion-display-completion-list-function)
1710         #'(lambda (completions)
1711             (display-completion-list
1712              completions
1713              :user-data (not (eq completer 'read-file-name-internal))
1714              :activate-callback
1715              'read-file-name-activate-callback)))))
1716     (read-file-name-2 history prompt dir default must-match
1717                       initial-contents completer)))
1718
1719 (defun read-file-name (prompt
1720                        &optional dir default must-match initial-contents
1721                        history)
1722   "Read file name, prompting with PROMPT and completing in directory DIR.
1723 This will prompt with a dialog box if appropriate, according to
1724  `should-use-dialog-box-p'.
1725 Value is not expanded---you must call `expand-file-name' yourself.
1726 Value is subject to interpretation by `substitute-in-file-name' however.
1727 Default name to DEFAULT if user enters a null string.
1728  (If DEFAULT is omitted, the visited file name is used,
1729   except that if INITIAL-CONTENTS is specified, that combined with DIR is
1730   used.)
1731 Fourth arg MUST-MATCH non-nil means require existing file's name.
1732  Non-nil and non-t means also require confirmation after completion.
1733 Fifth arg INITIAL-CONTENTS specifies text to start with.  If this is not
1734  specified, and `insert-default-directory' is non-nil, DIR or the current
1735  directory will be used.
1736 Sixth arg HISTORY specifies the history list to use.  Default is
1737  `file-name-history'.
1738 DIR defaults to current buffer's directory default."
1739   (read-file-name-1
1740    'file (or history 'file-name-history)
1741    prompt dir (or default
1742                   (and initial-contents
1743                        (abbreviate-file-name (expand-file-name
1744                                               initial-contents dir) t))
1745                   (and buffer-file-truename
1746                        (abbreviate-file-name buffer-file-name t)))
1747    must-match initial-contents
1748    ;; A separate function (not an anonymous lambda-expression)
1749    ;; and passed as a symbol because of disgusting kludges in various
1750    ;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...)
1751    'read-file-name-internal))
1752
1753 (defun read-directory-name (prompt
1754                             &optional dir default must-match initial-contents
1755                             history)
1756   "Read directory name, prompting with PROMPT and completing in directory DIR.
1757 This will prompt with a dialog box if appropriate, according to
1758  `should-use-dialog-box-p'.
1759 Value is not expanded---you must call `expand-file-name' yourself.
1760 Value is subject to interpreted by substitute-in-file-name however.
1761 Default name to DEFAULT if user enters a null string.
1762  (If DEFAULT is omitted, the current buffer's default directory is used.)
1763 Fourth arg MUST-MATCH non-nil means require existing directory's name.
1764  Non-nil and non-t means also require confirmation after completion.
1765 Fifth arg INITIAL-CONTENTS specifies text to start with.
1766 Sixth arg HISTORY specifies the history list to use.  Default is
1767  `file-name-history'.
1768 DIR defaults to current buffer's directory default."
1769   (read-file-name-1
1770    'directory (or history 'file-name-history)
1771    prompt dir (or default default-directory) must-match initial-contents
1772    'read-directory-name-internal))
1773
1774
1775 ;; Environment-variable and ~username completion hack
1776 (defun read-file-name-internal-1 (string dir action completer)
1777   (if (not (string-match
1778             "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'"
1779             string))
1780       ;; Not doing environment-variable completion hack
1781       (let* ((orig (if (equal string "") nil string))
1782              (sstring (if orig (substitute-in-file-name string) string))
1783              (specdir (if orig (file-name-directory sstring) nil))
1784              (name    (if orig (file-name-nondirectory sstring) string))
1785              (direct  (if specdir (expand-file-name specdir dir) dir)))
1786         ;; ~username completion
1787         (if (and (fboundp 'user-name-completion-1)
1788                  (string-match "^[~]" name))
1789             (let ((user (substring name 1)))
1790               (cond ((eq action 'lambda)
1791                      (file-directory-p name))
1792                     ((eq action 't)
1793                      ;; all completions
1794                      (mapcar #'(lambda (p) (concat "~" p))
1795                              (user-name-all-completions user)))
1796                     (t;; 'nil
1797                      ;; complete
1798                      (let* ((val+uniq (user-name-completion-1 user))
1799                             (val  (car val+uniq))
1800                             (uniq (cdr val+uniq)))
1801                        (cond ((stringp val)
1802                               (if uniq
1803                                   (file-name-as-directory (concat "~" val))
1804                                 (concat "~" val)))
1805                              ((eq val t)
1806                               (file-name-as-directory name))
1807                              (t nil))))))
1808           (funcall completer
1809                    action
1810                    orig
1811                    sstring
1812                    specdir
1813                    direct
1814                    name)))
1815       ;; An odd number of trailing $'s
1816       (let* ((start (match-beginning 3))
1817              (env (substring string
1818                              (cond ((= start (length string))
1819                                     ;; "...$"
1820                                     start)
1821                                    ((= (aref string start) ?{)
1822                                     ;; "...${..."
1823                                     (1+ start))
1824                                    (t
1825                                     start))))
1826              (head (substring string 0 (1- start)))
1827              (alist #'(lambda ()
1828                         (mapcar #'(lambda (x)
1829                                     (cons (substring x 0 (string-match "=" x))
1830                                           nil))
1831                                 process-environment))))
1832
1833         (cond ((eq action 'lambda)
1834                nil)
1835               ((eq action 't)
1836                ;; all completions
1837                (mapcar #'(lambda (p)
1838                            (if (and (> (length p) 0)
1839                                     ;;#### Unix-specific
1840                                     ;;####  -- need absolute-pathname-p
1841                                     (/= (aref p 0) ?/))
1842                                (concat "$" p)
1843                              (concat head "$" p)))
1844                        (all-completions env (funcall alist))))
1845               (t ;; nil
1846                ;; complete
1847                (let* ((e (funcall alist))
1848                       (val (try-completion env e)))
1849                  (cond ((stringp val)
1850                         (if (string-match "[^A-Za-z0-9_]" val)
1851                             (concat head
1852                                     "${" val
1853                                     ;; completed uniquely?
1854                                     (if (eq (try-completion val e) 't)
1855                                         "}" ""))
1856                             (concat head "$" val)))
1857                        ((eql val 't)
1858                         (concat head
1859                                 (un-substitute-in-file-name (getenv env))))
1860                        (t nil))))))))
1861
1862
1863 (defun read-file-name-internal (string dir action)
1864   (read-file-name-internal-1
1865    string dir action
1866    #'(lambda (action orig string specdir dir name)
1867       (cond ((eq action 'lambda)
1868              (if (not orig)
1869                  nil
1870                (let ((sstring (condition-case nil
1871                                   (expand-file-name string)
1872                                 (error nil))))
1873                  (if (not sstring)
1874                      ;; Some pathname syntax error in string
1875                      nil
1876                      (file-exists-p sstring)))))
1877             ((eq action 't)
1878              ;; all completions
1879              (mapcar #'un-substitute-in-file-name
1880                      (if (string= name "")
1881                          (delete "./" (file-name-all-completions "" dir))
1882                        (file-name-all-completions name dir))))
1883             (t;; nil
1884              ;; complete
1885              (let* ((d (or dir default-directory))
1886                     (val (file-name-completion name d)))
1887                (if (and (eq val 't)
1888                         (not (null completion-ignored-extensions)))
1889                    ;;#### (file-name-completion "foo") returns 't
1890                    ;;   when both "foo" and "foo~" exist and the latter
1891                    ;;   is "pruned" by completion-ignored-extensions.
1892                    ;; I think this is a bug in file-name-completion.
1893                    (setq val (let ((completion-ignored-extensions '()))
1894                                (file-name-completion name d))))
1895                (if (stringp val)
1896                    (un-substitute-in-file-name (if specdir
1897                                                    (concat specdir val)
1898                                                    val))
1899                    (let ((tem (un-substitute-in-file-name string)))
1900                      (if (not (equal tem orig))
1901                          ;; substitute-in-file-name did something
1902                          tem
1903                          val)))))))))
1904
1905 (defun read-directory-name-internal (string dir action)
1906   (read-file-name-internal-1
1907    string dir action
1908    #'(lambda (action orig string specdir dir name)
1909       (let* ((dirs #'(lambda (fn)
1910                        (let ((l (if (equal name "")
1911                                     (minibuf-directory-files
1912                                      dir
1913                                      ""
1914                                      'directories)
1915                                   (minibuf-directory-files
1916                                    dir
1917                                    (concat "\\`" (regexp-quote name))
1918                                    'directories))))
1919                          (mapcar fn
1920                                  ;; Wretched unix
1921                                  (delete "." l))))))
1922         (cond ((eq action 'lambda)
1923                ;; complete?
1924                (if (not orig)
1925                    nil
1926                  (file-directory-p string)))
1927               ((eq action 't)
1928                ;; all completions
1929                (funcall dirs #'(lambda (n)
1930                                  (un-substitute-in-file-name
1931                                   (file-name-as-directory n)))))
1932               (t
1933                ;; complete
1934                (let ((val (try-completion
1935                            name
1936                            (funcall dirs
1937                                     #'(lambda (n)
1938                                         (list (file-name-as-directory
1939                                                n)))))))
1940                  (if (stringp val)
1941                      (un-substitute-in-file-name (if specdir
1942                                                      (concat specdir val)
1943                                                    val))
1944                    (let ((tem (un-substitute-in-file-name string)))
1945                      (if (not (equal tem orig))
1946                          ;; substitute-in-file-name did something
1947                          tem
1948                        val))))))))))
1949
1950 (defun append-expand-filename (file-string string)
1951   "Append STRING to FILE-STRING differently depending on whether STRING
1952 is a username (~string), an environment variable ($string),
1953 or a filename (/string).  The resultant string is returned with the
1954 environment variable or username expanded and resolved to indicate
1955 whether it is a file(/result) or a directory (/result/)."
1956   (let ((file
1957          (cond ((string-match "\\([~$]\\)\\([^~$/]*\\)$" file-string)
1958                 (cond ((string= (substring file-string
1959                                            (match-beginning 1)
1960                                            (match-end 1)) "~")
1961                        (concat (substring file-string 0 (match-end 1))
1962                                string))
1963                       (t (substitute-in-file-name
1964                           (concat (substring file-string 0 (match-end 1))
1965                                   string)))))
1966                (t (concat (file-name-directory
1967                            (substitute-in-file-name file-string)) string))))
1968         result)
1969
1970     (cond ((stringp (setq result (and (file-exists-p (expand-file-name file))
1971                                       (read-file-name-internal
1972                                        (condition-case nil
1973                                            (expand-file-name file)
1974                                          (error file))
1975                                        "" nil))))
1976            result)
1977           (t file))))
1978
1979 (defun mouse-rfn-setup-vars (prompt)
1980   ;; a specifier would be nice.
1981   (set (make-local-variable 'frame-title-format)
1982        (capitalize-string-as-title
1983         ;; Kludge: Delete ": " off the end.
1984         (replace-in-string prompt ": $" "")))
1985   ;; ensure that killing the frame works right,
1986   ;; instead of leaving us in the minibuffer.
1987   (add-local-hook 'delete-frame-hook
1988                   #'(lambda (frame)
1989                       (abort-recursive-edit))))
1990
1991 (defun mouse-file-display-completion-list (window dir minibuf user-data)
1992   (let ((standard-output (window-buffer window)))
1993     (condition-case nil
1994         (display-completion-list
1995          (minibuf-directory-files dir nil t)
1996          :window-width (window-width window)
1997          :window-height (window-text-area-height window)
1998          :completion-string ""
1999          :activate-callback
2000          'mouse-read-file-name-activate-callback
2001          :user-data user-data
2002          :reference-buffer minibuf
2003          :help-string "")
2004       (t nil))
2005     ))
2006
2007 (defun mouse-directory-display-completion-list (window dir minibuf user-data)
2008   (let ((standard-output (window-buffer window)))
2009     (condition-case nil
2010         (display-completion-list
2011          (minibuf-directory-files dir nil 1)
2012          :window-width (window-width window)
2013          :window-height (window-text-area-height window)
2014          :completion-string ""
2015          :activate-callback
2016          'mouse-read-file-name-activate-callback
2017          :user-data user-data
2018          :reference-buffer minibuf
2019          :help-string "")
2020       (t nil))
2021     ))
2022
2023 (defun mouse-read-file-name-activate-callback (event extent user-data)
2024   (let* ((file (extent-string extent))
2025          (minibuf (symbol-value-in-buffer 'completion-reference-buffer
2026                                           (extent-object extent)))
2027          (ministring (buffer-substring nil nil minibuf))
2028          (in-dir (file-name-directory ministring))
2029          (full (expand-file-name file in-dir))
2030          (filebuf (nth 0 user-data))
2031          (dirbuf (nth 1 user-data))
2032          (filewin (nth 2 user-data))
2033          (dirwin (nth 3 user-data)))
2034     (if (file-regular-p full)
2035         (default-choose-completion event extent minibuf)
2036       (erase-buffer minibuf)
2037       (insert-string (file-name-as-directory
2038                       (abbreviate-file-name full t)) minibuf)
2039       (reset-buffer filebuf)
2040       (if (not dirbuf)
2041           (mouse-directory-display-completion-list filewin full minibuf
2042                                                    user-data)
2043         (mouse-file-display-completion-list filewin full minibuf user-data)
2044         (reset-buffer dirbuf)
2045         (mouse-directory-display-completion-list dirwin full minibuf
2046                                                  user-data)))))
2047
2048 ;; our cheesy but god-awful time consuming file dialog box implementation.
2049 ;; this will be replaced with use of the native file dialog box (when
2050 ;; available).
2051 (defun mouse-read-file-name-1 (history prompt dir default
2052                                        must-match initial-contents
2053                                        completer)
2054   ;; file-p is t if we're reading files, nil if directories.
2055   (let* ((file-p (eq 'read-file-name-internal completer))
2056          (filebuf (get-buffer-create "*Completions*"))
2057          (dirbuf (and file-p (generate-new-buffer " *mouse-read-file*")))
2058          (butbuf (generate-new-buffer " *mouse-read-file*"))
2059          (frame (make-dialog-frame))
2060          filewin dirwin
2061          user-data)
2062     (unwind-protect
2063         (progn
2064           (reset-buffer filebuf)
2065
2066           ;; set up the frame.
2067           (focus-frame frame)
2068           (let ((window-min-height 1))
2069             ;; #### should be 2 not 3, but that causes
2070             ;; "window too small to split" errors for some
2071             ;; people (but not for me ...) There's a more
2072             ;; fundamental bug somewhere.
2073             (split-window nil (- (frame-height frame) 3)))
2074           (if file-p
2075               (progn
2076                 (split-window-horizontally 16)
2077                 (setq filewin (frame-rightmost-window frame)
2078                       dirwin (frame-leftmost-window frame))
2079                 (set-window-buffer filewin filebuf)
2080                 (set-window-buffer dirwin dirbuf))
2081             (setq filewin (frame-highest-window frame))
2082             (set-window-buffer filewin filebuf))
2083           (setq user-data (list filebuf dirbuf filewin dirwin))
2084           (set-window-buffer (frame-lowest-window frame) butbuf)
2085
2086           ;; set up completion buffers.
2087           (let ((rfcshookfun
2088                  ;; kludge!
2089                  ;; #### I really need to flesh out the object
2090                  ;; hierarchy better to avoid these kludges.
2091                  ;; (?? I wrote this comment above some time ago,
2092                  ;; and I don't understand what I'm referring to
2093                  ;; any more. --ben
2094                  (lambda ()
2095                    (mouse-rfn-setup-vars prompt)
2096                    (when (featurep 'scrollbar)
2097                      (set-specifier scrollbar-width 0 (current-buffer)))
2098                    (setq truncate-lines t))))
2099
2100             (set-buffer filebuf)
2101             (add-local-hook 'completion-setup-hook rfcshookfun)
2102             (when file-p
2103               (set-buffer dirbuf)
2104               (add-local-hook 'completion-setup-hook rfcshookfun)))
2105
2106           ;; set up minibuffer.
2107           (add-one-shot-hook
2108            'minibuffer-setup-hook
2109            (lambda ()
2110              (if (not file-p)
2111                  (mouse-directory-display-completion-list
2112                   filewin dir (current-buffer) user-data)
2113                (mouse-file-display-completion-list
2114                 filewin dir (current-buffer) user-data)
2115                (mouse-directory-display-completion-list
2116                 dirwin dir (current-buffer) user-data))
2117              (set
2118               (make-local-variable
2119                'completion-display-completion-list-function)
2120               (lambda (completions)
2121                 (display-completion-list
2122                  completions
2123                  :help-string ""
2124                  :window-width (window-width filewin)
2125                  :window-height (window-text-area-height filewin)
2126                  :completion-string ""
2127                  :activate-callback
2128                  'mouse-read-file-name-activate-callback
2129                  :user-data user-data)))
2130              (mouse-rfn-setup-vars prompt)
2131              (save-selected-window
2132                ;; kludge to ensure the frame title is correct.
2133                ;; the minibuffer leaves the frame title the way
2134                ;; it was before (i.e. of the selected window before
2135                ;; the dialog box was opened), so to get it correct
2136                ;; we have to be tricky.
2137                (select-window filewin)
2138                (redisplay-frame nil t)
2139                ;; #### another kludge.  sometimes the focus ends up
2140                ;; back in the main window, not the dialog box.  it
2141                ;; occurs randomly and it's not possible to reliably
2142                ;; reproduce.  We try to fix it by draining non-user
2143                ;; events and then setting the focus back on the frame.
2144                (sit-for 0 t)
2145                (focus-frame frame))))
2146
2147           ;; set up button buffer.
2148           (set-buffer butbuf)
2149           (mouse-rfn-setup-vars prompt)
2150           (when dir
2151             (setq default-directory dir))
2152           (when (featurep 'scrollbar)
2153             (set-specifier scrollbar-width 0 butbuf))
2154           (insert "                 ")
2155           (insert-gui-button (make-gui-button "OK"
2156                                               (lambda (foo)
2157                                                 (exit-minibuffer))))
2158           (insert "                 ")
2159           (insert-gui-button (make-gui-button "Cancel"
2160                                               (lambda (foo)
2161                                                 (abort-recursive-edit))))
2162
2163           ;; now start reading filename.
2164           (read-file-name-2 history prompt dir default
2165                             must-match initial-contents
2166                             completer))
2167
2168       ;; always clean up.
2169       ;; get rid of our hook that calls abort-recursive-edit -- not a good
2170       ;; idea here.
2171       (kill-local-variable 'delete-frame-hook)
2172       (delete-frame frame)
2173       (kill-buffer filebuf)
2174       (kill-buffer butbuf)
2175       (and dirbuf (kill-buffer dirbuf)))))
2176
2177 (defun read-face (prompt &optional must-match)
2178   "Read the name of a face from the minibuffer and return it as a symbol."
2179   (intern (completing-read prompt obarray 'find-face must-match)))
2180
2181 ;; #### - wrong place for this variable?  Exactly.  We probably want
2182 ;; `color-list' to be a console method, so `tty-color-list' becomes
2183 ;; obsolete, and `read-color-completion-table' conses (mapcar #'list
2184 ;; (color-list)), optionally caching the results.
2185
2186 ;; Ben wanted all of the possibilities from the `configure' script used
2187 ;; here, but I think this is way too many.  I already trimmed the R4 variants
2188 ;; and a few obvious losers from the list.  --Stig
2189 (defvar x-library-search-path '("/usr/X11R6/lib/X11/"
2190                                 "/usr/X11R5/lib/X11/"
2191                                 "/usr/lib/X11R6/X11/"
2192                                 "/usr/lib/X11R5/X11/"
2193                                 "/usr/local/X11R6/lib/X11/"
2194                                 "/usr/local/X11R5/lib/X11/"
2195                                 "/usr/local/lib/X11R6/X11/"
2196                                 "/usr/local/lib/X11R5/X11/"
2197                                 "/usr/X11/lib/X11/"
2198                                 "/usr/lib/X11/"
2199                                 "/usr/share/X11/"
2200                                 "/usr/local/lib/X11/"
2201                                 "/usr/local/share/X11/"
2202                                 "/usr/X386/lib/X11/"
2203                                 "/usr/x386/lib/X11/"
2204                                 "/usr/XFree86/lib/X11/"
2205                                 "/usr/unsupported/lib/X11/"
2206                                 "/usr/athena/lib/X11/"
2207                                 "/usr/local/x11r5/lib/X11/"
2208                                 "/usr/lpp/Xamples/lib/X11/"
2209                                 "/usr/openwin/lib/X11/"
2210                                 "/usr/openwin/share/lib/X11/")
2211   "Search path used by `read-color' to find rgb.txt.")
2212
2213 (defvar x-read-color-completion-table)
2214
2215 (defun read-color-completion-table ()
2216   (case (device-type)
2217     ;; #### Evil device-type dependency
2218     ((x gtk)
2219      (if (boundp 'x-read-color-completion-table)
2220          x-read-color-completion-table
2221        (let ((rgb-file (locate-file "rgb.txt" x-library-search-path))
2222              clist color p)
2223          (if (not rgb-file)
2224              ;; prevents multiple searches for rgb.txt if we can't find it
2225              (setq x-read-color-completion-table nil)
2226            (with-current-buffer (get-buffer-create " *colors*")
2227              (reset-buffer (current-buffer))
2228              (insert-file-contents rgb-file)
2229              (while (not (eobp))
2230                ;; skip over comments
2231                (while (looking-at "^!")
2232                  (end-of-line)
2233                  (forward-char 1))
2234                (skip-chars-forward "0-9 \t")
2235                (setq p (point))
2236                (end-of-line)
2237                (setq color (buffer-substring p (point))
2238                      clist (cons (list color) clist))
2239                ;; Ugh.  If we want to be able to complete the lowercase form
2240                ;; of the color name, we need to add it twice!  Yuck.
2241                (let ((dcase (downcase color)))
2242                  (or (string= dcase color)
2243                      (push (list dcase) clist)))
2244                (forward-char 1))
2245              (kill-buffer (current-buffer))))
2246          (setq x-read-color-completion-table clist)
2247          x-read-color-completion-table)))
2248     (mswindows
2249      (mapcar #'list (mswindows-color-list)))
2250     (tty
2251      (mapcar #'list (tty-color-list)))))
2252
2253 (defun read-color (prompt &optional must-match initial-contents)
2254   "Read the name of a color from the minibuffer.
2255 On X devices, this uses `x-library-search-path' to find rgb.txt in order
2256  to build a completion table.
2257 On TTY devices, this uses `tty-color-list'.
2258 On mswindows devices, this uses `mswindows-color-list'."
2259   (let ((table (read-color-completion-table)))
2260     (completing-read prompt table nil (and table must-match)
2261                      initial-contents)))
2262
2263 \f
2264 ;; #### The doc string for read-non-nil-coding system gets lost if we
2265 ;; only include these if the mule feature is present.  Strangely,
2266 ;; read-coding-system doesn't.
2267
2268 ;;(if (featurep 'mule)
2269
2270 (defun read-coding-system (prompt &optional default-coding-system)
2271   "Read a coding-system (or nil) from the minibuffer.
2272 Prompting with string PROMPT.
2273 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM.
2274 DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object."
2275   (intern (completing-read prompt obarray 'find-coding-system t nil nil
2276                            (cond ((symbolp default-coding-system)
2277                                   (symbol-name default-coding-system))
2278                                  ((coding-system-p default-coding-system)
2279                                   (symbol-name (coding-system-name default-coding-system)))
2280                                  (t
2281                                   default-coding-system)))))
2282
2283 (defun read-non-nil-coding-system (prompt)
2284   "Read a non-nil coding-system from the minibuffer.
2285 Prompt with string PROMPT."
2286   (let ((retval (intern "")))
2287     (while (= 0 (length (symbol-name retval)))
2288       (setq retval (intern (completing-read prompt obarray
2289                                             'find-coding-system
2290                                             t))))
2291     retval))
2292
2293 ;;) ;; end of (featurep 'mule)
2294
2295 \f
2296
2297 (defcustom force-dialog-box-use nil
2298   "*If non-nil, always use a dialog box for asking questions, if possible.
2299 You should *bind* this, not set it.  This is useful if you're doing
2300 something mousy but which wasn't actually invoked using the mouse."
2301   :type 'boolean
2302   :group 'minibuffer)
2303
2304 ;; We include this here rather than dialog.el so it is defined
2305 ;; even when dialog boxes are not present.
2306 (defun should-use-dialog-box-p ()
2307   "If non-nil, questions should be asked with a dialog box instead of the
2308 minibuffer.  This looks at `last-command-event' to see if it was a mouse
2309 event, and checks whether dialog-support exists and the current device
2310 supports dialog boxes.
2311
2312 The dialog box is totally disabled if the variable `use-dialog-box'
2313 is set to nil."
2314   (and (featurep 'dialog)
2315        (device-on-window-system-p)
2316        use-dialog-box
2317        (or force-dialog-box-use
2318            (button-press-event-p last-command-event)
2319            (button-release-event-p last-command-event)
2320            (misc-user-event-p last-command-event))))
2321
2322 ;;; minibuf.el ends here