Change implementation of IMAP URLs so that they are fully instantiated

at all times.  This greatly simplifies comparison and caching.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 96c07f6fedf6cc5a19046591878c0541b3b6cb15..644d4657c10b4b24e40e837049996cfb5feee581 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.38 2000/05/16 01:46:37 cph Exp $
+;;; $Id: imail-imap.scm,v 1.39 2000/05/16 02:16:42 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -24,9 +24,7 @@
 \f
 ;;;; URL
 
-(define-class (<imap-url>
-              (constructor %make-imap-url (user-id host port mailbox)))
-    (<url>)
+(define-class <imap-url> (<url>)
   ;; User name to connect as.
   (user-id define accessor)
   ;; Name or IP address of host to connect to.
@@ -51,6 +49,16 @@
                             (string->number port)))
                      (parser-token pv 'MAILBOX)))))
 
+(define %make-imap-url
+  (let ((constructor
+        (instance-constructor <imap-url> '(USER-ID HOST PORT MAILBOX))))
+    (lambda (user-id host port mailbox)
+      (let ((default (imail-default-imap-url)))
+       (constructor (or user-id (imap-url-user-id default))
+                    (or host (imap-url-host default))
+                    (or port (imap-url-port default))
+                    (or mailbox (imap-url-mailbox default)))))))
+
 (define imap:parse:imail-url
   (let ((//server
         (sequence-parser (noise-parser (string-matcher "//"))
@@ -64,26 +72,24 @@
      imap:parse:enc-mailbox)))
 
 (define-method url-body ((url <imap-url>))
-  (string-append
-   (let ((user-id (imap-url-user-id url))
-        (host (imap-url-host url))
-        (port (imap-url-port url)))
-     (if (or user-id host port)
-        (string-append
-         "//"
-         (if user-id
-             (string-append (url:encode-string user-id) "@")
-             "")
-         host
-         (if port
-             (string-append ":" (number->string port))
-             "")
-         "/")
-        ""))
-   (url:encode-string (imap-url-mailbox url))))
+  (string-append "//"
+                (url:encode-string (imap-url-user-id url))
+                "@"
+                (imap-url-host url)
+                ":"
+                (number->string (imap-url-port url))
+                "/"
+                (url:encode-string (imap-url-mailbox url))))
 
 (define-method url-presentation-name ((url <imap-url>))
   (imap-url-mailbox 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
 ;;;; Server connection
 

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 4cec9ac3fb131ae9aafede745d203f9248d11776..305121b253c07f9e29a5b832cf5819adc2f00929 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.44 2000/05/12 18:33:44 cph Exp $
+;;; $Id: imail-top.scm,v 1.45 2000/05/16 02:16:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -168,27 +168,11 @@ May be called with an IMAIL folder URL as argument;
        (imail-default-imap-url))))
 
 (define (imail-parse-partial-url string)
-  (let ((url
-        (->url
-         (let ((colon (string-find-next-char string #\:)))
-           (if colon
-               string
-               (string-append "imap:" string))))))
-    (if (and (imap-url? url)
-            (not (and (imap-url-user-id url)
-                      (imap-url-host url)
-                      (imap-url-port url)
-                      (imap-url-mailbox url))))
-       (let ((url* (imail-default-imap-url)))
-         (make-imap-url (or (imap-url-user-id url)
-                            (imap-url-user-id url*))
-                        (or (imap-url-host url)
-                            (imap-url-host url*))
-                        (or (imap-url-port url)
-                            (imap-url-port url*))
-                        (or (imap-url-mailbox url)
-                            (imap-url-mailbox url*))))
-       url)))
+  (->url
+   (let ((colon (string-find-next-char string #\:)))
+     (if colon
+        string
+        (string-append "imap:" string)))))
 
 (define (imail-default-imap-url)
   (call-with-values
@@ -199,7 +183,7 @@ May be called with an IMAIL folder URL as argument;
                (values (string-head server colon)
                        (or (string->number (string-tail server (+ colon 1)))
                            (error "Invalid port specification:" server)))
-               (values server #f)))))
+               (values server 143)))))
     (lambda (host port)
       (make-imap-url (or (ref-variable imail-default-user-id)
                         (current-user-name))