;;; minibuf.el --- Minibuffer functions for XEmacs
;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems
-;; Copyright (C) 1995, 1996 Ben Wing
+;; Copyright (C) 1995 Tinker Systems.
+;; Copyright (C) 1995, 1996, 2000 Ben Wing.
;; Author: Richard Mlynarik
;; Created: 2-Oct-92
(defcustom minibuffer-history-uniquify t
"*Non-nil means when adding an item to a minibuffer history, remove
-previous occurances of the same item from the history list first,
+previous occurrences of the same item from the history list first,
rather than just consing the new element onto the front of the list."
:type 'boolean
:group 'minibuffer)
;(defvar minibuffer-setup-hook nil
; "Normal hook run just after entry to minibuffer.")
+;; see comment at list-mode-hook.
+(put 'minibuffer-setup-hook 'permanent-local t)
+
(defvar minibuffer-exit-hook nil
"Normal hook run just after exit from minibuffer.")
+(put 'minibuffer-exit-hook 'permanent-local t)
(defvar minibuffer-help-form nil
"Value that `help-form' takes on inside the minibuffer.")
(define-key map "\M-\t" 'comint-dynamic-complete)
(define-key map "\M-?" 'comint-dynamic-list-completions)
map)
- "Minibuffer keymap used by shell-command and related commands.")
+ "Minibuffer keymap used by `shell-command' and related commands.")
(defcustom use-dialog-box t
"*Variable controlling usage of the dialog box.
Seventh arg DEFAULT, if non-nil, will be returned when user enters
an empty string.
-See also the variable completion-highlight-first-word-only for control over
- completion display."
+See also the variable `completion-highlight-first-word-only' for
+ control over completion display."
(if (and (not enable-recursive-minibuffers)
(> (minibuffer-depth) 0)
(eq (selected-window) (minibuffer-window)))
;; Used by minibuffer-do-completion
-(defvar last-exact-completion)
+(defvar last-exact-completion nil)
(defun temp-minibuffer-message (m)
(let ((savemax (point-max)))
(defun minibuffer-smart-maybe-select-highlighted-completion
(event &optional click-count)
- "Like minibuffer-smart-select-highlighted-completion but does nothing if
+ "Like `minibuffer-smart-select-highlighted-completion' but does nothing if
there is no completion (as opposed to executing the global binding). Useful
as the value of `mouse-track-click-hook'."
(interactive "e")
current-minibuffer-point (point)))
(let ((narg (- minibuffer-history-position n))
(minimum (if minibuffer-default -1 0)))
+ ;; a weird special case here; when in repeat-complex-command, we're
+ ;; trying to edit the top command, and minibuffer-history-position
+ ;; points to 1, the next-to-top command. in this case, the top
+ ;; command in the history is suppressed in favor of the one being
+ ;; edited, and there is no more command below it, except maybe the
+ ;; default.
+ (if (and (zerop narg) (eq minibuffer-history-position
+ initial-minibuffer-history-position))
+ (setq minimum (1+ minimum)))
(cond ((< narg minimum)
- (error "No following item in %s" minibuffer-history-variable))
+ (error (if minibuffer-default
+ "No following item in %s"
+ "No following item in %s; no default available")
+ minibuffer-history-variable))
((> narg (length (symbol-value minibuffer-history-variable)))
(error "No preceding item in %s" minibuffer-history-variable)))
(erase-buffer)
(progn
(insert current-minibuffer-contents)
(goto-char current-minibuffer-point))
- (let ((elt (if (>= narg 0)
+ (let ((elt (if (> narg 0)
(nth (1- minibuffer-history-position)
(symbol-value minibuffer-history-variable))
minibuffer-default)))
;;;; reading various things from a minibuffer ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun read-expression (prompt &optional initial-contents history)
- "Return a Lisp object read using the minibuffer.
-Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
-is a string to insert in the minibuffer before reading.
-Third arg HISTORY, if non-nil, specifies a history list."
+(defun read-expression (prompt &optional initial-contents history default-value)
+ "Return a Lisp object read using the minibuffer, prompting with PROMPT.
+If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
+ in the minibuffer before reading.
+Third arg HISTORY, if non-nil, specifies a history list.
+Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
+ for history command, and as the value to return if the user enters the
+ empty string."
(let ((minibuffer-history-sexp-flag t)
;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion.
(minibuffer-completion-table nil))
read-expression-map
t
(or history 'read-expression-history)
- lisp-mode-abbrev-table)))
+ lisp-mode-abbrev-table
+ default-value)))
-(defun read-string (prompt &optional initial-contents history)
+(defun read-string (prompt &optional initial-contents history default-value)
"Return a string from the minibuffer, prompting with string PROMPT.
If non-nil, optional second arg INITIAL-CONTENTS is a string to insert
-in the minibuffer before reading.
-Third arg HISTORY, if non-nil, specifies a history list."
+ in the minibuffer before reading.
+Third arg HISTORY, if non-nil, specifies a history list.
+Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
+ for history command, and as the value to return if the user enters the
+ empty string."
(let ((minibuffer-completion-table nil))
(read-from-minibuffer prompt
initial-contents
minibuffer-local-map
- nil history)))
+ nil history nil default-value)))
-(defun eval-minibuffer (prompt &optional initial-contents history)
+(defun eval-minibuffer (prompt &optional initial-contents history default-value)
"Return value of Lisp expression read using the minibuffer.
Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS
is a string to insert in the minibuffer before reading.
-Third arg HISTORY, if non-nil, specifies a history list."
- (eval (read-expression prompt initial-contents history)))
+Third arg HISTORY, if non-nil, specifies a history list.
+Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
+ for history command, and as the value to return if the user enters the
+ empty string."
+ (eval (read-expression prompt initial-contents history default-value)))
;; The name `command-history' is already taken
(defvar read-command-history '())
-(defun read-command (prompt)
+(defun read-command (prompt &optional default-value)
"Read the name of a command and return as a symbol.
-Prompts with PROMPT."
+Prompts with PROMPT. By default, return DEFAULT-VALUE."
(intern (completing-read prompt obarray 'commandp t nil
;; 'command-history is not right here: that's a
;; list of evalable forms, not a history list.
'read-command-history
- )))
+ default-value)))
-(defun read-function (prompt)
+(defun read-function (prompt &optional default-value)
"Read the name of a function and return as a symbol.
-Prompts with PROMPT."
+Prompts with PROMPT. By default, return DEFAULT-VALUE."
(intern (completing-read prompt obarray 'fboundp t nil
- 'function-history)))
+ 'function-history default-value)))
-(defun read-variable (prompt)
+(defun read-variable (prompt &optional default-value)
"Read the name of a user variable and return it as a symbol.
-Prompts with PROMPT.
+Prompts with PROMPT. By default, return DEFAULT-VALUE.
A user variable is one whose documentation starts with a `*' character."
(intern (completing-read prompt obarray 'user-variable-p t nil
- 'variable-history)))
+ 'variable-history
+ (if (symbolp default-value)
+ (symbol-name default-value)
+ default-value))))
(defun read-buffer (prompt &optional default require-match)
"Read the name of a buffer and return as a string.
(buffer-name result)
result)))
-(defun read-number (prompt &optional integers-only)
- "Read a number from the minibuffer."
+(defun read-number (prompt &optional integers-only default-value)
+ "Read a number from the minibuffer, prompting with PROMPT.
+If optional second argument INTEGERS-ONLY is non-nil, accept
+ only integer input.
+If DEFAULT-VALUE is non-nil, return that if user enters an empty
+ line."
(let ((pred (if integers-only 'integerp 'numberp))
num)
(while (not (funcall pred num))
(let ((minibuffer-completion-table nil))
(read-from-minibuffer
prompt (if num (prin1-to-string num)) nil t
- t)) ;no history
+ nil nil default-value))
(input-error nil)
(invalid-read-syntax nil)
(end-of-file nil)))
(or (funcall pred num) (beep)))
num))
-(defun read-shell-command (prompt &optional initial-input history)
+(defun read-shell-command (prompt &optional initial-input history default-value)
"Just like read-string, but uses read-shell-command-map:
\\{read-shell-command-map}"
(let ((minibuffer-completion-table nil))
(read-from-minibuffer prompt initial-input read-shell-command-map
- nil (or history 'shell-command-history))))
+ nil (or history 'shell-command-history)
+ nil default-value)))
\f
;;; This read-file-name stuff probably belongs in files.el
(setq n (1+ n))))
new)))
+
+;; Wrapper for `directory-files' for use in generating completion lists.
+;; Generates output in the same format as `file-name-all-completions'.
+;;
+;; The EFS replacement for `directory-files' doesn't support the FILES-ONLY
+;; option, so it has to be faked. The listing cache will hopefully
+;; improve the performance of this operation.
+(defun minibuf-directory-files (dir &optional match-regexp files-only)
+ (let ((want-file (or (eq files-only nil) (eq files-only t)))
+ (want-dirs (or (eq files-only nil) (not (eq files-only t)))))
+ (delete nil
+ (mapcar (function (lambda (f)
+ (if (file-directory-p (expand-file-name f dir))
+ (and want-dirs (file-name-as-directory f))
+ (and want-file f))))
+ (delete "." (directory-files dir nil match-regexp))))))
+
+
(defun read-file-name-2 (history prompt dir default
must-match initial-contents
completer)
(reset-buffer completion-buf)
(let ((standard-output completion-buf))
(display-completion-list
- (delete "." (directory-files full nil nil nil (if dir-p 'directory)))
+ (minibuf-directory-files full nil (if dir-p 'directory))
:user-data dir-p
:reference-buffer minibuf
:activate-callback 'read-file-name-activate-callback)
must-match initial-contents
completer)
(if (should-use-dialog-box-p)
- ;; this calls read-file-name-2
- (mouse-read-file-name-1 history prompt dir default must-match
- initial-contents completer)
- (let ((rfhookfun
- (lambda ()
- ;; #### SCREAM! Create a `file-system-ignore-case'
- ;; function, so this kind of stuff is generalized!
- (and (eq system-type 'windows-nt)
- (set (make-local-variable 'completion-ignore-case) t))
- (set
- (make-local-variable
- 'completion-display-completion-list-function)
- #'(lambda (completions)
- (display-completion-list
- completions
- :user-data (not (eq completer 'read-file-name-internal))
- :activate-callback
- 'read-file-name-activate-callback)))
- ;; kludge!
- (remove-hook 'minibuffer-setup-hook rfhookfun)
- )))
- (unwind-protect
- (progn
- (add-hook 'minibuffer-setup-hook rfhookfun)
- (read-file-name-2 history prompt dir default must-match
- initial-contents completer))
- (remove-hook 'minibuffer-setup-hook rfhookfun)))))
+ (condition-case nil
+ (let ((file
+ (apply #'make-dialog-box
+ 'file `(:title ,(capitalize-string-as-title
+ ;; Kludge: Delete ": " off the end.
+ (replace-in-string prompt ": $" ""))
+ ,@(and dir (list :initial-directory
+ dir))
+ :file-must-exist ,must-match
+ ,@(and initial-contents
+ (list :initial-filename
+ initial-contents))))))
+ ;; hack -- until we implement reading a directory properly,
+ ;; allow a file as indicating the directory it's in
+ (if (and (eq completer 'read-directory-name-internal)
+ (not (file-directory-p file)))
+ (file-name-directory file)
+ file))
+ (unimplemented
+ ;; this calls read-file-name-2
+ (mouse-read-file-name-1 history prompt dir default must-match
+ initial-contents completer)
+ ))
+ (add-one-shot-hook
+ 'minibuffer-setup-hook
+ (lambda ()
+ ;; #### SCREAM! Create a `file-system-ignore-case'
+ ;; function, so this kind of stuff is generalized!
+ (and (eq system-type 'windows-nt)
+ (set (make-local-variable 'completion-ignore-case) t))
+ (set
+ (make-local-variable
+ 'completion-display-completion-list-function)
+ #'(lambda (completions)
+ (display-completion-list
+ completions
+ :user-data (not (eq completer 'read-file-name-internal))
+ :activate-callback
+ 'read-file-name-activate-callback)))))
+ (read-file-name-2 history prompt dir default must-match
+ initial-contents completer)))
(defun read-file-name (prompt
&optional dir default must-match initial-contents
used.)
Fourth arg MUST-MATCH non-nil means require existing file's name.
Non-nil and non-t means also require confirmation after completion.
-Fifth arg INITIAL-CONTENTS specifies text to start with.
+Fifth arg INITIAL-CONTENTS specifies text to start with. If this is not
+ specified, and `insert-default-directory' is non-nil, DIR or the current
+ directory will be used.
Sixth arg HISTORY specifies the history list to use. Default is
`file-name-history'.
DIR defaults to current buffer's directory default."
(read-file-name-1
(or history 'file-name-history)
prompt dir (or default
- (if initial-contents (expand-file-name initial-contents dir)
- buffer-file-name))
+ (and initial-contents
+ (abbreviate-file-name (expand-file-name
+ initial-contents dir) t))
+ (and buffer-file-truename
+ (abbreviate-file-name buffer-file-name t)))
must-match initial-contents
;; A separate function (not an anonymous lambda-expression)
;; and passed as a symbol because of disgusting kludges in various
((eq action 't)
;; all completions
(mapcar #'un-substitute-in-file-name
- (file-name-all-completions name dir)))
+ (if (string= name "")
+ (delete "./" (file-name-all-completions "" dir))
+ (file-name-all-completions name dir))))
(t;; nil
;; complete
(let* ((d (or dir default-directory))
#'(lambda (action orig string specdir dir name)
(let* ((dirs #'(lambda (fn)
(let ((l (if (equal name "")
- (directory-files
+ (minibuf-directory-files
dir
- nil
""
- nil
'directories)
- (directory-files
+ (minibuf-directory-files
dir
- nil
(concat "\\`" (regexp-quote name))
- nil
'directories))))
(mapcar fn
;; Wretched unix
result)
(t file))))
+(defun mouse-rfn-setup-vars (prompt)
+ ;; a specifier would be nice.
+ (set (make-local-variable 'frame-title-format)
+ (capitalize-string-as-title
+ ;; Kludge: Delete ": " off the end.
+ (replace-in-string prompt ": $" "")))
+ ;; ensure that killing the frame works right,
+ ;; instead of leaving us in the minibuffer.
+ (add-local-hook 'delete-frame-hook
+ #'(lambda (frame)
+ (abort-recursive-edit))))
+
(defun mouse-file-display-completion-list (window dir minibuf user-data)
(let ((standard-output (window-buffer window)))
(condition-case nil
(display-completion-list
- (directory-files dir nil nil nil t)
- :window-width (* 2 (window-width window))
+ (minibuf-directory-files dir nil t)
+ :window-width (window-width window)
+ :window-height (window-text-area-height window)
+ :completion-string ""
:activate-callback
'mouse-read-file-name-activate-callback
:user-data user-data
:reference-buffer minibuf
:help-string "")
- (t nil))))
+ (t nil))
+ ))
(defun mouse-directory-display-completion-list (window dir minibuf user-data)
(let ((standard-output (window-buffer window)))
(condition-case nil
(display-completion-list
- (delete "." (directory-files dir nil nil nil 1))
+ (minibuf-directory-files dir nil 1)
:window-width (window-width window)
+ :window-height (window-text-area-height window)
+ :completion-string ""
:activate-callback
'mouse-read-file-name-activate-callback
:user-data user-data
:reference-buffer minibuf
:help-string "")
- (t nil))))
+ (t nil))
+ ))
(defun mouse-read-file-name-activate-callback (event extent user-data)
(let* ((file (extent-string extent))
(minibuf (symbol-value-in-buffer 'completion-reference-buffer
(extent-object extent)))
- (in-dir (buffer-substring nil nil minibuf))
+ (ministring (buffer-substring nil nil minibuf))
+ (in-dir (file-name-directory ministring))
(full (expand-file-name file in-dir))
(filebuf (nth 0 user-data))
- (dirbuff (nth 1 user-data))
+ (dirbuf (nth 1 user-data))
(filewin (nth 2 user-data))
(dirwin (nth 3 user-data)))
(if (file-regular-p full)
(insert-string (file-name-as-directory
(abbreviate-file-name full t)) minibuf)
(reset-buffer filebuf)
- (if (not dirbuff)
+ (if (not dirbuf)
(mouse-directory-display-completion-list filewin full minibuf
user-data)
(mouse-file-display-completion-list filewin full minibuf user-data)
- (reset-buffer dirbuff)
+ (reset-buffer dirbuf)
(mouse-directory-display-completion-list dirwin full minibuf
user-data)))))
-;; this is rather cheesified but gets the job done.
+;; our cheesy but god-awful time consuming file dialog box implementation.
+;; this will be replaced with use of the native file dialog box (when
+;; available).
(defun mouse-read-file-name-1 (history prompt dir default
- must-match initial-contents
- completer)
+ must-match initial-contents
+ completer)
+ ;; file-p is t if we're reading files, nil if directories.
(let* ((file-p (eq 'read-file-name-internal completer))
(filebuf (get-buffer-create "*Completions*"))
- (dirbuff (and file-p (generate-new-buffer " *mouse-read-file*")))
- (butbuff (generate-new-buffer " *mouse-read-file*"))
+ (dirbuf (and file-p (generate-new-buffer " *mouse-read-file*")))
+ (butbuf (generate-new-buffer " *mouse-read-file*"))
(frame (make-dialog-frame))
filewin dirwin
user-data)
(unwind-protect
(progn
(reset-buffer filebuf)
- (select-frame frame)
+
+ ;; set up the frame.
+ (focus-frame frame)
(let ((window-min-height 1))
;; #### should be 2 not 3, but that causes
;; "window too small to split" errors for some
(setq filewin (frame-rightmost-window frame)
dirwin (frame-leftmost-window frame))
(set-window-buffer filewin filebuf)
- (set-window-buffer dirwin dirbuff))
+ (set-window-buffer dirwin dirbuf))
(setq filewin (frame-highest-window frame))
(set-window-buffer filewin filebuf))
- (setq user-data (list filebuf dirbuff filewin dirwin))
- (set-window-buffer (frame-lowest-window frame) butbuff)
- (set-buffer butbuff)
+ (setq user-data (list filebuf dirbuf filewin dirwin))
+ (set-window-buffer (frame-lowest-window frame) butbuf)
+
+ ;; set up completion buffers.
+ (let ((rfcshookfun
+ ;; kludge!
+ ;; #### I really need to flesh out the object
+ ;; hierarchy better to avoid these kludges.
+ ;; (?? I wrote this comment above some time ago,
+ ;; and I don't understand what I'm referring to
+ ;; any more. --ben
+ (lambda ()
+ (mouse-rfn-setup-vars prompt)
+ (when (featurep 'scrollbar)
+ (set-specifier scrollbar-width 0 (current-buffer)))
+ (setq truncate-lines t))))
+
+ (set-buffer filebuf)
+ (add-local-hook 'completion-setup-hook rfcshookfun)
+ (when file-p
+ (set-buffer dirbuf)
+ (add-local-hook 'completion-setup-hook rfcshookfun)))
+
+ ;; set up minibuffer.
+ (add-one-shot-hook
+ 'minibuffer-setup-hook
+ (lambda ()
+ (if (not file-p)
+ (mouse-directory-display-completion-list
+ filewin dir (current-buffer) user-data)
+ (mouse-file-display-completion-list
+ filewin dir (current-buffer) user-data)
+ (mouse-directory-display-completion-list
+ dirwin dir (current-buffer) user-data))
+ (set
+ (make-local-variable
+ 'completion-display-completion-list-function)
+ (lambda (completions)
+ (display-completion-list
+ completions
+ :help-string ""
+ :window-width (window-width filewin)
+ :window-height (window-text-area-height filewin)
+ :completion-string ""
+ :activate-callback
+ 'mouse-read-file-name-activate-callback
+ :user-data user-data)))
+ (mouse-rfn-setup-vars prompt)
+ (save-selected-window
+ ;; kludge to ensure the frame title is correct.
+ ;; the minibuffer leaves the frame title the way
+ ;; it was before (i.e. of the selected window before
+ ;; the dialog box was opened), so to get it correct
+ ;; we have to be tricky.
+ (select-window filewin)
+ (redisplay-frame nil t)
+ ;; #### another kludge. sometimes the focus ends up
+ ;; back in the main window, not the dialog box. it
+ ;; occurs randomly and it's not possible to reliably
+ ;; reproduce. We try to fix it by draining non-user
+ ;; events and then setting the focus back on the frame.
+ (sit-for 0 t)
+ (focus-frame frame))))
+
+ ;; set up button buffer.
+ (set-buffer butbuf)
+ (mouse-rfn-setup-vars prompt)
(when dir
(setq default-directory dir))
(when (featurep 'scrollbar)
- (set-specifier scrollbar-width 0 butbuff))
+ (set-specifier scrollbar-width 0 butbuf))
(insert " ")
(insert-gui-button (make-gui-button "OK"
(lambda (foo)
(insert-gui-button (make-gui-button "Cancel"
(lambda (foo)
(abort-recursive-edit))))
- (let ((rfhookfun
- (lambda ()
- (if (not file-p)
- (mouse-directory-display-completion-list
- filewin dir (current-buffer) user-data)
- (mouse-file-display-completion-list filewin dir
- (current-buffer)
- user-data)
- (mouse-directory-display-completion-list dirwin dir
- (current-buffer)
- user-data))
- (set
- (make-local-variable
- 'completion-display-completion-list-function)
- #'(lambda (completions)
- (display-completion-list
- completions
- :help-string ""
- :activate-callback
- 'mouse-read-file-name-activate-callback
- :user-data user-data)))
- ;; kludge!
- (remove-hook 'minibuffer-setup-hook rfhookfun)
- ))
- (rfcshookfun
- ;; kludge!
- ;; #### I really need to flesh out the object
- ;; hierarchy better to avoid these kludges.
- (lambda ()
- (save-excursion
- (set-buffer standard-output)
- (setq truncate-lines t)))))
- (unwind-protect
- (progn
- (add-hook 'minibuffer-setup-hook rfhookfun)
- (add-hook 'completion-setup-hook rfcshookfun)
- (read-file-name-2 history prompt dir default
- must-match initial-contents
- completer))
- (remove-hook 'minibuffer-setup-hook rfhookfun)
- (remove-hook 'completion-setup-hook rfcshookfun))))
+
+ ;; now start reading filename.
+ (read-file-name-2 history prompt dir default
+ must-match initial-contents
+ completer))
+
+ ;; always clean up.
+ ;; get rid of our hook that calls abort-recursive-edit -- not a good
+ ;; idea here.
+ (kill-local-variable 'delete-frame-hook)
(delete-frame frame)
(kill-buffer filebuf)
- (kill-buffer butbuff)
- (and dirbuff (kill-buffer dirbuff)))))
+ (kill-buffer butbuf)
+ (and dirbuf (kill-buffer dirbuf)))))
(defun read-face (prompt &optional must-match)
"Read the name of a face from the minibuffer and return it as a symbol."
projects / chise / xemacs-chise.git.1 / blobdiff