Provide inserted default strings to all URL prompts.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 10db2a748de68ca759eadfd1beddea4885fb577a..ef2bd89bd59fa4e33c30e43a5465eba96e4efa23 100644 (file)
--- a/v7/src/imail/imail-core.scm
+++ b/v7/src/imail/imail-core.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.80 2000/05/22 03:01:13 cph Exp $
+;;; $Id: imail-core.scm,v 1.81 2000/05/22 03:32:04 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -69,6 +69,15 @@
 ;; presentation layer.
 (define-generic url-presentation-name (url))
 
+;; Return a string that represents the object containing URL's folder.
+;; E.g. the container of "imap://localhost/inbox" is
+;; "imap://localhost/".
+(define (url-container-string url)
+  (make-url-string (url-protocol url)
+                  (url-body-container-string url)))
+
+(define-generic url-body-container-string (url))
+
 ;; Convert STRING to a URL.  GET-DEFAULT-URL is a procedure of one
 ;; argument that returns a URL that is used to fill in defaults if
 ;; STRING is a specification for a partial URL.  GET-DEFAULT-URL is

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index cc71678ed4e8d1ad8d1acf7894d1aa0c3d124623..601797f637291507230a3a2b1a2fe22f004e6596 100644 (file)
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.31 2000/05/22 02:17:39 cph Exp $
+;;; $Id: imail-file.scm,v 1.32 2000/05/22 03:32:09 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -33,6 +33,9 @@
 (define-method url-presentation-name ((url <file-url>))
   (file-namestring (file-url-pathname url)))
 
+(define-method url-body-container-string ((url <file-url>))
+  (directory-namestring (file-url-pathname url)))
+
 (define (define-file-url-completers class filter)
   (define-method %url-complete-string
       ((string <string>) (default-url class)

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index f97bc8b60d631d96856abee59593730818f47b59..3ef94f7100bff997dc16d8b44e5f55a1d793e573 100644 (file)
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.64 2000/05/22 03:01:18 cph Exp $
+;;; $Id: imail-imap.scm,v 1.65 2000/05/22 03:32:12 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -61,13 +61,19 @@
 (define-method url-presentation-name ((url <imap-url>))
   (imap-url-mailbox url))
 
+(define-method url-body-container-string ((url <imap-url>))
+  (make-imap-url-string (imap-url-user-id url)
+                       (imap-url-host url)
+                       (imap-url-port url)
+                       ""))
+
 (define (compatible-imap-urls? url1 url2)
   ;; Can URL1 and URL2 both be accessed from the same IMAP session?
   ;; E.g. can the IMAP COPY command work between them?
   (and (string=? (imap-url-user-id url1) (imap-url-user-id url2))
        (string-ci=? (imap-url-host url1) (imap-url-host url2))
        (= (imap-url-port url1) (imap-url-port url2))))
-
+\f
 (define-method parse-url-body (string default-url)
   (call-with-values (lambda () (parse-imap-url-body string default-url))
     (lambda (user-id host port mailbox)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 1467aac8c0f37f0f1fa6af6b59358b7ae7a4ba50..675ad22531827e648cd27527865aa72fc471f015 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.78 2000/05/22 02:17:50 cph Exp $
+;;; $Id: imail-top.scm,v 1.79 2000/05/22 03:32:17 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -104,10 +104,10 @@ 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" #f
-                                           'DEFAULT-TYPE 'VISIBLE-DEFAULT
-                                           'HISTORY 'IMAIL
-                                           'HISTORY-INDEX 0))))
+              (prompt-for-imail-url-string "Run IMAIL on folder"
+                                           (imail-default-url)
+                                           'DEFAULT-TYPE 'INSERTED-DEFAULT
+                                           'HISTORY 'IMAIL))))
   (lambda (url-string)
     (let ((folder
           (open-folder
@@ -138,20 +138,24 @@ May be called with an IMAIL folder URL as argument;
 (define (prompt-for-imail-url-string prompt default . options)
   (apply prompt-for-completed-string
         prompt
-        default
+        (and default (url-container-string default))
         (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) string #t)
+        (lambda (string)
+          (url?
+           (ignore-errors
+            (lambda ()
+              (parse-url-string string imail-get-default-url)))))
         options))
 \f
 (define (imail-default-url)
   (let ((primary-folder (ref-variable imail-primary-folder)))
     (if primary-folder
        (imail-parse-partial-url primary-folder)
-       (imail-get-default-url "imap"))))
+       (imail-get-default-url #f))))
 
 (define (imail-parse-partial-url string)
   (parse-url-string string imail-get-default-url))
@@ -848,7 +852,7 @@ With prefix argument N, removes FLAG from next N messages,
 (define-command imail-input
   "Append messages to this folder from a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Input from folder" #f
+    (list (prompt-for-imail-url-string "Input from folder" (imail-default-url)
                                       'DEFAULT-TYPE 'INSERTED-DEFAULT
                                       'HISTORY 'IMAIL-INPUT
                                       'HISTORY-INDEX 0)))
@@ -868,7 +872,7 @@ With prefix argument N, removes FLAG from next N messages,
 (define-command imail-output
   "Append this message to a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Output to folder" #f
+    (list (prompt-for-imail-url-string "Output to folder" (imail-default-url)
                                       'DEFAULT-TYPE 'INSERTED-DEFAULT
                                       'HISTORY 'IMAIL-OUTPUT
                                       'HISTORY-INDEX 0)
@@ -890,20 +894,18 @@ 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" #f
+    (list (prompt-for-imail-url-string "Create folder" (imail-default-url)
                                       'DEFAULT-TYPE 'INSERTED-DEFAULT
-                                      'HISTORY 'IMAIL-CREATE-FOLDER
-                                      'HISTORY-INDEX 0)))
+                                      '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" #f
+    (list (prompt-for-imail-url-string "Delete folder" (imail-default-url)
                                       'DEFAULT-TYPE 'INSERTED-DEFAULT
-                                      'HISTORY 'IMAIL-DELETE-FOLDER
-                                      'HISTORY-INDEX 0)))
+                                      'HISTORY 'IMAIL-DELETE-FOLDER)))
   (lambda (url-string)
     (delete-folder (imail-parse-partial-url url-string))))
 \f