From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 May 2000 00:18:19 +0000 (+0000)
Subject: Make another stab at getting URL prompts right.
X-Git-Tag: 20090517-FFI~3728
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8b03afb21829b7c2073183ec75dd2f406e50b91f;p=mit-scheme.git

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 bd14be822..64d8b5472 100644
--- 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)))
 
 (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)))