Fix bug: the container URL "imap://localhost/" had an associated

"folder" URL with the same string representation.  This confused the
URL interning mechanism, which uses the string rep as the key.
Consequently only one of the URLs existed.  Now, the "folder" is
represented by "imap://localhost".

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 23723eea6f5fca72f1647c5a69df7a6f3176209e..a850234bc1a5ba55cb6dc9e8936db6928f56b3ec 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.178 2001/06/03 01:42:40 cph Exp $
+;;; $Id: imail-imap.scm,v 1.179 2001/06/03 06:00:18 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -65,9 +65,9 @@
 (define-method imap-url-mailbox ((url <container-url>))
   (let ((mailbox
         (imap-url-mailbox (imap-container-url-corresponding-folder url))))
-    (if (string-null? mailbox)
-       mailbox
-       (string-append mailbox "/"))))
+    (if mailbox
+       (string-append mailbox "/")
+       "")))
 
 (define make-imap-url
   (let ((make-folder
@@ -178,7 +178,7 @@
 (define imap-list-info-duration 60)
 \f
 (define-method url-base-name ((url <imap-folder-url>))
-  (let ((mailbox (imap-url-mailbox url)))
+  (let ((mailbox (or (imap-url-mailbox url) "")))
     (let ((index (imap-mailbox-container-slash mailbox)))
       (if index
          (string-tail mailbox (fix:+ index 1))
@@ -234,7 +234,7 @@
                            "")))
 
 (define-method url-content-name ((url <imap-url>))
-  (let* ((mailbox (imap-url-mailbox url))
+  (let* ((mailbox (or (imap-url-mailbox url) ""))
         (index (imap-mailbox-container-slash mailbox)))
     (if index
        (string-tail mailbox (fix:+ index 1))
@@ -244,10 +244,11 @@
   (imap-url-new-mailbox url (string-append (imap-url-mailbox url) name)))
 
 (define (imap-url-container-mailbox url)
-  (let* ((mailbox (imap-url-mailbox url))
-        (index (imap-mailbox-container-slash mailbox)))
-    (and index
-        (string-head mailbox (fix:+ index 1)))))
+  (let ((mailbox (imap-url-mailbox url)))
+    (and mailbox
+        (let ((index (imap-mailbox-container-slash mailbox)))
+          (and index
+               (string-head mailbox (fix:+ index 1)))))))
 
 (define (imap-mailbox-container-slash mailbox)
   (substring-find-previous-char mailbox
@@ -385,9 +386,10 @@
   (imap-mailbox/url->server
    url
    (let ((mailbox (imap-url-mailbox url)))
-     (if (string-suffix? "/" mailbox)
-        (string-head mailbox (fix:- (string-length mailbox) 1))
-        mailbox))))
+     (cond ((not mailbox) "")
+          ((string-suffix? "/" mailbox)
+           (string-head mailbox (fix:- (string-length mailbox) 1)))
+          (else mailbox)))))
 
 (define (imap-mailbox/url->server url mailbox)
   (let ((delimiter (imap-mailbox-delimiter url mailbox)))