Canonicalize the case of IMAP URLs, where possible without knowing

details of the server.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index c33089308430b46a9d3b90a7d0c473c3f72af8d7..142d06c8dac326ee5efe802c2b96e5efee5d119c 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.67 2000/05/22 03:43:39 cph Exp $
+;;; $Id: imail-imap.scm,v 1.68 2000/05/22 13:30:18 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -40,24 +40,36 @@
   (let ((constructor
         (instance-constructor <imap-url> '(USER-ID HOST PORT MAILBOX))))
     (lambda (user-id host port mailbox)
-      (intern-url (constructor user-id host port mailbox)))))
-
-(define-method url-body ((url <imap-url>))
-  (make-imap-url-string (imap-url-user-id url)
-                       (imap-url-host url)
-                       (imap-url-port url)
-                       (imap-url-mailbox url)))
+      (intern-url (constructor user-id
+                              (string-downcase host)
+                              port
+                              (canonicalize-imap-mailbox mailbox))))))
 
 (define (make-imap-url-string user-id host port mailbox)
   (string-append "//"
                 (url:encode-string user-id)
                 "@"
-                host
+                (string-downcase host)
                 (if (= port 143)
                     ""
                     (string-append ":" (number->string port)))
                 "/"
-                (url:encode-string mailbox)))
+                (url:encode-string (canonicalize-imap-mailbox mailbox))))
+
+(define (canonicalize-imap-mailbox mailbox)
+  (cond ((string-ci=? mailbox "inbox") "inbox")
+       ((and (string-prefix-ci? "inbox." mailbox)
+             (not (string-prefix? "inbox." mailbox)))
+        (let ((mailbox (string-copy mailbox)))
+          (substring-downcase! mailbox 0 6)
+          mailbox))
+       (else mailbox)))
+
+(define-method url-body ((url <imap-url>))
+  (make-imap-url-string (imap-url-user-id url)
+                       (imap-url-host url)
+                       (imap-url-port url)
+                       (imap-url-mailbox url)))
 
 (define-method url-presentation-name ((url <imap-url>))
   (imap-url-mailbox url))
@@ -76,7 +88,7 @@
   ;; 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))
+       (string=? (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)