X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fminibuf.el;h=8177a3edc8c3beb9bab89f8f6c65234286a198ff;hp=0061576b82649c2d250738253a70bcce734085cd;hb=eeca41d3213b7a3b7efcf6508693e748c1590748;hpb=1e7fd761ecf5fd2208bde8e30fc6f7cbf789b7db diff --git a/lisp/minibuf.el b/lisp/minibuf.el index 0061576..8177a3e 100644 --- a/lisp/minibuf.el +++ b/lisp/minibuf.el @@ -1,8 +1,8 @@ ;;; 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 @@ -52,7 +52,7 @@ (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) @@ -77,10 +77,12 @@ t means to return a list of all possible completions of STRING. (defvar minibuffer-completion-confirm nil "Non-nil => demand confirmation of completion before exiting minibuffer.") -(defvar minibuffer-confirm-incomplete nil +(defcustom minibuffer-confirm-incomplete nil "If true, then in contexts where completing-read allows answers which are not valid completions, an extra RET must be typed to confirm the -response. This is helpful for catching typos, etc.") +response. This is helpful for catching typos, etc." + :type 'boolean + :group 'minibuffer) (defcustom completion-auto-help t "*Non-nil means automatically provide help for invalid completion input." @@ -109,8 +111,12 @@ minibuffer is reinvoked while it is the selected window." ;(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.") @@ -190,7 +196,7 @@ minibuffer is reinvoked while it is the selected window." (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. @@ -265,8 +271,7 @@ in `substitute-in-file-name'." If `zmacs-regions' is true, and the zmacs region is active in this buffer, then this key deactivates the region without beeping." (interactive) - (if (and (region-active-p) - (eq (current-buffer) (zmacs-region-buffer))) + (if (region-active-p) ;; pseudo-zmacs compatibility: don't beep if this ^G is simply ;; deactivating the region. If it is inactive, beep. nil @@ -344,7 +349,8 @@ minibuffer history if its length is less than that value." keymap readp history - abbrev-table) + abbrev-table + default) "Read a string from the minibuffer, prompting with string PROMPT. If optional second arg INITIAL-CONTENTS is non-nil, it is a string to be inserted into the minibuffer before reading input. @@ -366,9 +372,11 @@ Fifth arg HISTORY, if non-nil, specifies a history list Positions are counted starting from 1 at the beginning of the list. Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table' in the minibuffer. +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))) @@ -412,7 +420,8 @@ See also the variable completion-highlight-first-word-only for control over ;; `M-x doctor' makes history a local variable, and thus ;; our binding above is buffer-local and doesn't apply ;; once we switch buffers!!!! We demand better scope! - (_history_ history)) + (_history_ history) + (minibuffer-default default)) (unwind-protect (progn (set-buffer (reset-buffer buffer)) @@ -490,8 +499,13 @@ See also the variable completion-highlight-first-word-only for control over (let* ((val (progn (set-buffer buffer) (if minibuffer-exit-hook (run-hooks 'minibuffer-exit-hook)) - (buffer-string))) - (histval val) + (if (and (eq (char-after (point-min)) nil) + default) + default + (buffer-string)))) + (histval (if (and default (string= val "")) + default + val)) (err nil)) (if readp (condition-case e @@ -597,7 +611,7 @@ See also the variable completion-highlight-first-word-only for control over ;; Used by minibuffer-do-completion -(defvar last-exact-completion) +(defvar last-exact-completion nil) (defun temp-minibuffer-message (m) (let ((savemax (point-max))) @@ -750,17 +764,21 @@ See also the variable completion-highlight-first-word-only for control over &optional predicate require-match initial-contents history default) "Read a string in the minibuffer, with completion. -Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY. + PROMPT is a string to prompt with; normally it ends in a colon and a space. TABLE is an alist whose elements' cars are strings, or an obarray. +TABLE can also be a function which does the completion itself. PREDICATE limits completion to a subset of TABLE. -See `try-completion' for more details on completion, TABLE, and PREDICATE. +See `try-completion' and `all-completions' for more details + on completion, TABLE, and PREDICATE. + If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless - the input is (or completes to) an element of TABLE or is null. - If it is also not t, Return does not exit if it does non-null completion. + the input is (or completes to) an element of TABLE or is null. + If it is also not t, Return does not exit if it does non-null completion. If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. If it is (STRING . POSITION), the initial input is STRING, but point is placed POSITION characters into the string. + HISTORY, if non-nil, specifies a history list and optionally the initial position in the list. It can be a symbol, which is the history list variable to use, @@ -770,7 +788,9 @@ HISTORY, if non-nil, specifies a history list which INITIAL-CONTENTS corresponds to). If HISTORY is `t', no history will be recorded. Positions are counted starting from 1 at the beginning of the list. -DEFAULT, if non-nil, is the default value. +DEFAULT, if non-nil, will be returned when the user enters an empty + string. + Completion ignores case if the ambient value of `completion-ignore-case' is non-nil." (let ((minibuffer-completion-table table) @@ -784,7 +804,9 @@ Completion ignores case if the ambient value of minibuffer-local-completion-map minibuffer-local-must-match-map) nil - history)) + history + nil + default)) (if (and (string= ret "") default) default @@ -1195,7 +1217,7 @@ the special minibuffer behavior." (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") @@ -1237,7 +1259,9 @@ With prefix argument N, search for Nth previous match. If N is negative, find the next or Nth next match." (interactive (let ((enable-recursive-minibuffers t) - (minibuffer-history-sexp-flag nil)) + (minibuffer-history-sexp-flag nil) + (minibuffer-max-depth (and minibuffer-max-depth + (1+ minibuffer-max-depth)))) (if (eq 't (symbol-value minibuffer-history-variable)) (error "History is not being recorded in this context")) (list (read-from-minibuffer "Previous element matching (regexp): " @@ -1285,7 +1309,9 @@ With prefix argument N, search for Nth next match. If N is negative, find the previous or Nth previous match." (interactive (let ((enable-recursive-minibuffers t) - (minibuffer-history-sexp-flag nil)) + (minibuffer-history-sexp-flag nil) + (minibuffer-max-depth (and minibuffer-max-depth + (1+ minibuffer-max-depth)))) (if (eq t (symbol-value minibuffer-history-variable)) (error "History is not being recorded in this context")) (list (read-from-minibuffer "Next element matching (regexp): " @@ -1308,8 +1334,20 @@ If N is negative, find the previous or Nth previous match." 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) @@ -1318,7 +1356,7 @@ If N is negative, find the previous or Nth previous match." (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))) @@ -1360,11 +1398,14 @@ If N is negative, find the previous or Nth previous match." ;;;; 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)) @@ -1373,50 +1414,60 @@ Third arg HISTORY, if non-nil, specifies a history list." 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. @@ -1434,7 +1485,10 @@ only existing buffer names are allowed." result) (while (progn (setq result (completing-read prompt alist nil require-match - nil 'buffer-history)) + nil 'buffer-history + (if (bufferp default) + (buffer-name default) + default))) (cond ((not (equal result "")) nil) ((not require-match) @@ -1451,8 +1505,12 @@ only existing buffer names are allowed." (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)) @@ -1460,19 +1518,20 @@ only existing buffer names are allowed." (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))) ;;; This read-file-name stuff probably belongs in files.el @@ -1499,6 +1558,24 @@ only existing buffer names are allowed." (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) @@ -1537,8 +1614,9 @@ only existing buffer names are allowed." read-file-name-map read-file-name-must-match-map) nil - history)) - )) + history + nil + default)))) ;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar" ;;; (let ((hist (cond ((not history) 'minibuffer-history) ;;; ((consp history) (car history)) @@ -1586,43 +1664,57 @@ only existing buffer names are allowed." (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) (goto-char (point-min) completion-buf))))) -(defun read-file-name-1 (history prompt dir default - must-match initial-contents - completer) +(defun read-file-name-1 (type history prompt dir default + must-match initial-contents + completer) (if (should-use-dialog-box-p) - ;; this calls read-file-name-2 - (mouse-read-file-name-1 history prompt dir default must-match - initial-contents completer) - (let ((rfhookfun - (lambda () - ;; #### SCREAM! Create a `file-system-ignore-case' - ;; function, so this kind of stuff is generalized! - (and (eq system-type 'windows-nt) - (set (make-local-variable 'completion-ignore-case) t)) - (set - (make-local-variable - 'completion-display-completion-list-function) - #'(lambda (completions) - (display-completion-list - completions - :user-data (not (eq completer 'read-file-name-internal)) - :activate-callback - 'read-file-name-activate-callback))) - ;; kludge! - (remove-hook 'minibuffer-setup-hook rfhookfun) - ))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook rfhookfun) - (read-file-name-2 history prompt dir default must-match - initial-contents completer)) - (remove-hook 'minibuffer-setup-hook rfhookfun))))) + (condition-case nil + (let ((file + (apply #'make-dialog-box + type `(: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 @@ -1631,22 +1723,27 @@ only existing buffer names are allowed." This will prompt with a dialog box if appropriate, according to `should-use-dialog-box-p'. Value is not expanded---you must call `expand-file-name' yourself. -Value is subject to interpreted by substitute-in-file-name however. +Value is subject to interpretation by `substitute-in-file-name' however. Default name to DEFAULT if user enters a null string. (If DEFAULT is omitted, the visited file name is used, except that if INITIAL-CONTENTS is specified, that combined with DIR is used.) Fourth arg MUST-MATCH non-nil means require existing file's name. Non-nil and non-t means also require confirmation after completion. -Fifth arg INITIAL-CONTENTS specifies text to start with. +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) + (read-file-name-1 + 'file (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 @@ -1670,9 +1767,9 @@ Sixth arg HISTORY specifies the history list to use. Default is `file-name-history'. DIR defaults to current buffer's directory default." (read-file-name-1 - (or history 'file-name-history) - prompt dir (or default default-directory) must-match initial-contents - 'read-directory-name-internal)) + 'directory (or history 'file-name-history) + prompt dir (or default default-directory) must-match initial-contents + 'read-directory-name-internal)) ;; Environment-variable and ~username completion hack @@ -1780,7 +1877,9 @@ DIR defaults to current buffer's directory default." ((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)) @@ -1809,17 +1908,13 @@ DIR defaults to current buffer's directory default." #'(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 @@ -1881,40 +1976,59 @@ whether it is a file(/result) or a directory (/result/)." 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) @@ -1923,29 +2037,34 @@ whether it is a file(/result) or a directory (/result/)." (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 @@ -1958,16 +2077,80 @@ whether it is a file(/result) or a directory (/result/)." (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) @@ -1976,51 +2159,20 @@ whether it is a file(/result) or a directory (/result/)." (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." @@ -2044,7 +2196,9 @@ whether it is a file(/result) or a directory (/result/)." "/usr/local/lib/X11R5/X11/" "/usr/X11/lib/X11/" "/usr/lib/X11/" + "/usr/share/X11/" "/usr/local/lib/X11/" + "/usr/local/share/X11/" "/usr/X386/lib/X11/" "/usr/x386/lib/X11/" "/usr/XFree86/lib/X11/" @@ -2061,7 +2215,7 @@ whether it is a file(/result) or a directory (/result/)." (defun read-color-completion-table () (case (device-type) ;; #### Evil device-type dependency - (x + ((x gtk) (if (boundp 'x-read-color-completion-table) x-read-color-completion-table (let ((rgb-file (locate-file "rgb.txt" x-library-search-path)) @@ -2116,9 +2270,15 @@ On mswindows devices, this uses `mswindows-color-list'." (defun read-coding-system (prompt &optional default-coding-system) "Read a coding-system (or nil) from the minibuffer. Prompting with string PROMPT. -If the user enters null input, return second argument DEFAULT-CODING-SYSTEM." +If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. +DEFAULT-CODING-SYSTEM can be a string, symbol, or coding-system object." (intern (completing-read prompt obarray 'find-coding-system t nil nil - default-coding-system))) + (cond ((symbolp default-coding-system) + (symbol-name default-coding-system)) + ((coding-system-p default-coding-system) + (symbol-name (coding-system-name default-coding-system))) + (t + default-coding-system))))) (defun read-non-nil-coding-system (prompt) "Read a non-nil coding-system from the minibuffer.