--- a/lisp/minibuf.el	Mon Aug 13 11:33:40 2007 +0200
+++ b/lisp/minibuf.el	Mon Aug 13 11:35:02 2007 +0200
@@ -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)
@@ -111,8 +111,12 @@
 ;(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.")
@@ -608,7 +612,7 @@
 
 
 ;; Used by minibuffer-do-completion
-(defvar last-exact-completion)
+(defvar last-exact-completion nil)
 
 (defun temp-minibuffer-message (m)
   (let ((savemax (point-max)))
@@ -1325,6 +1329,15 @@
 	    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 (if minibuffer-default
 			"No following item in %s"
@@ -1338,7 +1351,7 @@
 	  (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)))
@@ -1446,7 +1459,10 @@
 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 default-value)))
+			   '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.
@@ -1537,6 +1553,24 @@
 	    (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)
@@ -1625,7 +1659,7 @@
       (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)
@@ -1635,33 +1669,47 @@
 				 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
@@ -1824,7 +1872,9 @@
             ((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))
@@ -1853,17 +1903,13 @@
    #'(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
@@ -1925,40 +1971,59 @@
 	   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)
@@ -1967,29 +2032,34 @@
       (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
@@ -2002,16 +2072,80 @@
 		(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)
@@ -2020,51 +2154,20 @@
 	  (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."