Change definition of URL-PASS-PHRASE-KEY to specify that it is also

part of the prompt to the user.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 054185a5d599b4247248ab6d3f387d60ccfb34ec..2a270039847f5cf5abc669cc8199052c40f9f5e2 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.86 2000/05/22 20:22:32 cph Exp $
+;;; $Id: imail-core.scm,v 1.87 2000/05/22 20:51:00 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -81,10 +81,10 @@
 ;; Return #T if URL represents an existing folder.
 (define-generic url-exists? (url))
 
-;; Return a string that can be used as a key to memoize a pass phrase
-;; for URL.  E.g. for IMAP this could be the URL string without the
-;; mailbox information, which would allow all URLs referring to the
-;; same user account on the same server to share a pass phrase.
+;; Return a string that uniquely identifies the server and account for
+;; URL.  E.g. for IMAP this could be the URL string without the
+;; mailbox information.  This string will be included in the
+;; pass-phrase prompt, and also used as a key for memoization.
 (define-generic url-pass-phrase-key (url))
 \f
 ;; Convert STRING to a URL.  GET-DEFAULT-URL is a procedure of one

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 2399fe65c612c913e46b068291ec62bb1917909a..dd0d3f0581452392c5174d702ee4c73e13843074 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.76 2000/05/22 20:28:03 cph Exp $
+;;; $Id: imail-imap.scm,v 1.77 2000/05/22 20:50:37 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -53,8 +53,11 @@
                 (if (= port 143)
                     ""
                     (string-append ":" (number->string port)))
-                "/"
-                (url:encode-string (canonicalize-imap-mailbox mailbox))))
+                (if mailbox
+                    (string-append
+                     "/"
+                     (url:encode-string (canonicalize-imap-mailbox mailbox)))
+                    "")))
 
 (define (canonicalize-imap-mailbox mailbox)
   (cond ((string-ci=? mailbox "inbox") "inbox")
@@ -92,10 +95,11 @@
        (= (imap-url-port url1) (imap-url-port url2))))
 
 (define-method url-pass-phrase-key ((url <imap-url>))
-  (make-imap-url-string (imap-url-user-id url)
-                       (imap-url-host url)
-                       (imap-url-port url)
-                       ""))
+  (make-url-string "imap"
+                  (make-imap-url-string (imap-url-user-id url)
+                                        (imap-url-host url)
+                                        (imap-url-port url)
+                                        #f)))
 \f
 (define-method parse-url-body (string default-url)
   (call-with-values (lambda () (parse-imap-url-body string default-url))

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 884b60bf2140fe366f02c9a05509584aa7881834..be09e5d4875fd8bbe7f23d7a3980f3e5d942fece 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.86 2000/05/22 20:22:46 cph Exp $
+;;; $Id: imail-top.scm,v 1.87 2000/05/22 20:51:04 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -105,8 +105,6 @@ May be called with an IMAIL folder URL as argument;
   (lambda ()
     (list (and (command-argument)
               (prompt-for-imail-url-string "Run IMAIL on folder"
-                                           (imail-default-url)
-                                           'DEFAULT-TYPE 'INSERTED-DEFAULT
                                            'HISTORY 'IMAIL))))
   (lambda (url-string)
     (let ((folder
@@ -128,10 +126,10 @@ May be called with an IMAIL folder URL as argument;
                         #t)
         buffer)))))
 
-(define (prompt-for-imail-url-string prompt default . options)
+(define (prompt-for-imail-url-string prompt . options)
   (apply prompt-for-completed-string
         prompt
-        (and default (url-container-string default))
+        #f ;(url-container-string (imail-default-url))
         (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))
@@ -142,6 +140,7 @@ May be called with an IMAIL folder URL as argument;
            (ignore-errors
             (lambda ()
               (parse-url-string string imail-get-default-url)))))
+        'DEFAULT-TYPE 'INSERTED-DEFAULT
         options))
 \f
 (define (imail-default-url)
@@ -218,7 +217,7 @@ May be called with an IMAIL folder URL as argument;
       (if obscured
          (call-with-unobscured-pass-phrase obscured receiver)
          (call-with-pass-phrase
-          (string-append "Pass phrase for " (url->string url))
+          (string-append "Pass phrase for " key)
           (lambda (pass-phrase)
             (hash-table/put! imail-memoized-pass-phrases key
                              (obscure-pass-phrase pass-phrase))
@@ -898,8 +897,7 @@ 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-default-url)
-                                      'DEFAULT-TYPE 'INSERTED-DEFAULT
+    (list (prompt-for-imail-url-string "Create folder"
                                       'HISTORY 'IMAIL-CREATE-FOLDER)))
   (lambda (url-string)
     (create-folder (imail-parse-partial-url url-string))))
@@ -907,8 +905,7 @@ An error if signalled if the folder already exists."
 (define-command imail-delete-folder
   "Delete a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Delete folder" (imail-default-url)
-                                      'DEFAULT-TYPE 'INSERTED-DEFAULT
+    (list (prompt-for-imail-url-string "Delete folder"
                                       'HISTORY 'IMAIL-DELETE-FOLDER)))
   (lambda (url-string)
     (delete-folder (imail-parse-partial-url url-string))))
@@ -916,8 +913,7 @@ An error if signalled if the folder already exists."
 (define-command imail-input
   "Append messages to this folder from a specified folder."
   (lambda ()
-    (list (prompt-for-imail-url-string "Input from folder" (imail-default-url)
-                                      'DEFAULT-TYPE 'INSERTED-DEFAULT
+    (list (prompt-for-imail-url-string "Input from folder"
                                       'HISTORY 'IMAIL-INPUT
                                       'HISTORY-INDEX 0)))
   (lambda (url-string)
@@ -935,8 +931,7 @@ 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-default-url)
-                                      'DEFAULT-TYPE 'INSERTED-DEFAULT
+    (list (prompt-for-imail-url-string "Output to folder"
                                       'HISTORY 'IMAIL-OUTPUT
                                       'HISTORY-INDEX 0)
          (command-argument)))
@@ -955,8 +950,7 @@ 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-default-url)
-                                      'DEFAULT-TYPE 'INSERTED-DEFAULT
+    (list (prompt-for-imail-url-string "Output to folder"
                                       'HISTORY 'IMAIL-OUTPUT
                                       'HISTORY-INDEX 0)))
   (lambda (url-string)