Make another stab at getting URL prompts right.

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index bd14be822cd430e20623312c1738c3a8fed451f0..64d8b54721ace399802735f67b7d6a0172dc4098 100644 (file)
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.89 2000/05/22 22:41:00 cph Exp $
+;;; $Id: imail-top.scm,v 1.90 2000/05/23 00:18:19 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -104,7 +104,8 @@ May be called with an IMAIL folder URL as argument;
  but does not copy any new mail into the folder."
   (lambda ()
     (list (and (command-argument)
-              (prompt-for-imail-url-string "Run IMAIL on folder" 'IMAIL))))
+              (prompt-for-imail-url-string "Run IMAIL on folder"
+                                           'HISTORY 'IMAIL))))
   (lambda (url-string)
     (let ((folder
           (open-folder
@@ -125,28 +126,34 @@ May be called with an IMAIL folder URL as argument;
                         #t)
         buffer)))))
 
-(define (prompt-for-imail-url-string prompt history . options)
-  (if (null? (prompt-history-strings history))
-      (set-prompt-history-strings!
-       history
-       (list (url-container-string (imail-default-url)))))
-  (apply prompt-for-completed-string
-        prompt
-        #f
-        (lambda (string if-unique if-not-unique if-not-found)
-          (url-complete-string string imail-get-default-url
-                               if-unique if-not-unique if-not-found))
-        (lambda (string)
-          (url-string-completions string imail-get-default-url))
-        (lambda (string)
-          (url?
-           (ignore-errors
-            (lambda ()
-              (parse-url-string string imail-get-default-url)))))
-        'DEFAULT-TYPE 'INSERTED-DEFAULT
-        'HISTORY history
-        'HISTORY-INDEX 0
-        options))
+(define (prompt-for-imail-url-string prompt . options)
+  (let ((get-option
+        (lambda (key)
+          (let loop ((options options))
+            (and (pair? options)
+                 (pair? (cdr options))
+                 (if (eq? (car options) key)
+                     (cadr options)
+                     (loop (cddr options)))))))
+       (default (url-container-string (imail-default-url))))
+    (let ((history (get-option 'HISTORY)))
+      (if (null? (prompt-history-strings history))
+         (set-prompt-history-strings! history (list default))))
+    (apply prompt-for-completed-string
+          prompt
+          (if (= (or (get-option 'HISTORY-INDEX) -1) -1) default #f)
+          (lambda (string if-unique if-not-unique if-not-found)
+            (url-complete-string string imail-get-default-url
+                                 if-unique if-not-unique if-not-found))
+          (lambda (string)
+            (url-string-completions string imail-get-default-url))
+          (lambda (string)
+            (url?
+             (ignore-errors
+              (lambda ()
+                (parse-url-string string imail-get-default-url)))))
+          'DEFAULT-TYPE 'INSERTED-DEFAULT
+          options)))
 \f
 (define (imail-default-url)
   (let ((primary-folder (ref-variable imail-primary-folder)))
@@ -902,21 +909,25 @@ With prefix argument N, removes FLAG from next N messages,
   "Create a new folder with the specified name.
 An error if signalled if the folder already exists."
   (lambda ()
-    (list (prompt-for-imail-url-string "Create folder" 'IMAIL-CREATE-FOLDER)))
+    (list (prompt-for-imail-url-string "Create folder"
+                                      'HISTORY 'IMAIL-CREATE-FOLDER)))
   (lambda (url-string)
     (create-folder (imail-parse-partial-url url-string))))
 
 (define-command imail-delete-folder
   "Delete a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Delete folder" 'IMAIL-DELETE-FOLDER)))
+    (list (prompt-for-imail-url-string "Delete folder"
+                                      'HISTORY 'IMAIL-DELETE-FOLDER)))
   (lambda (url-string)
     (delete-folder (imail-parse-partial-url url-string))))
 
 (define-command imail-input
   "Append messages to this folder from a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Input from folder" 'IMAIL-INPUT)))
+    (list (prompt-for-imail-url-string "Input from folder"
+                                      'HISTORY 'IMAIL-INPUT
+                                      'HISTORY-INDEX 0)))
   (lambda (url-string)
     (let ((folder (selected-folder)))
       (let ((folder (open-folder (imail-parse-partial-url url-string)))
@@ -932,7 +943,9 @@ An error if signalled if the folder already exists."
 (define-command imail-output
   "Append this message to a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Output to folder" 'IMAIL-OUTPUT)
+    (list (prompt-for-imail-url-string "Output to folder"
+                                      'HISTORY 'IMAIL-OUTPUT
+                                      'HISTORY-INDEX 0)
          (command-argument)))
   (lambda (url-string argument)
     (let ((delete? (ref-variable imail-delete-after-output)))
@@ -949,7 +962,9 @@ The messages are NOT deleted even if imail-delete-after-output is true.
 This command is meant to be used to move the contents of a folder
  either to or from an IMAP server."
   (lambda ()
-    (list (prompt-for-imail-url-string "Output to folder" 'IMAIL-OUTPUT)))
+    (list (prompt-for-imail-url-string "Output to folder"
+                                      'HISTORY 'IMAIL-OUTPUT
+                                      'HISTORY-INDEX 0)))
   (lambda (url-string)
     (let ((folder (selected-folder))
          (to (imail-parse-partial-url url-string)))