From c80abf2a84c765269a14853857b63db000de8802 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 22 May 2000 20:51:04 +0000 Subject: [PATCH] Change definition of URL-PASS-PHRASE-KEY to specify that it is also part of the prompt to the user. --- v7/src/imail/imail-core.scm | 10 +++++----- v7/src/imail/imail-imap.scm | 18 +++++++++++------- v7/src/imail/imail-top.scm | 26 ++++++++++---------------- 3 files changed, 26 insertions(+), 28 deletions(-) diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm index 054185a5d..2a2700398 100644 --- 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)) ;; 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 2399fe65c..dd0d3f058 100644 --- 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 )) - (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))) (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 884b60bf2..be09e5d48 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.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)) (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) -- 2.25.1