From e151ee110a07e7c539d4a1e64e9456ca7fc9c399 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 16 May 2000 02:16:49 +0000
Subject: [PATCH] Change implementation of IMAP URLs so that they are fully
 instantiated at all times.  This greatly simplifies comparison and caching.

---
 v7/src/imail/imail-imap.scm | 48 +++++++++++++++++++++----------------
 v7/src/imail/imail-top.scm  | 30 ++++++-----------------
 2 files changed, 34 insertions(+), 44 deletions(-)

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 96c07f6fe..644d4657c 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.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 @@
 
 ;;;; 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))))
 
 ;;;; Server connection
 
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 4cec9ac3f..305121b25 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.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))
-- 
2.25.1