Change IMAP-URL-SERVER-MAILBOX to accept container URLs and strip the
authorChris Hanson <org/chris-hanson/cph>
Fri, 18 May 2001 20:03:09 +0000 (20:03 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 18 May 2001 20:03:09 +0000 (20:03 +0000)
trailing delimiter off of them.

v7/src/imail/imail-imap.scm

index 5b16ab4d11d94cf0b529c8c0a9bb04d1e445a83c..dbde01befd6c203ef8344400e6b2457dacdd17b6 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.153 2001/05/17 04:37:39 cph Exp $
+;;; $Id: imail-imap.scm,v 1.154 2001/05/18 20:03:09 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
 ;;;; URL->server delimiter conversion
 
 (define (imap-url-server-mailbox url)
-  (imap-mailbox/url->server url (imap-url-mailbox url)))
+  (imap-mailbox/url->server
+   url
+   (let ((mailbox (imap-url-mailbox url)))
+     (if (string-suffix? "/" mailbox)
+        (string-head mailbox (fix:- (string-length mailbox) 1))
+        mailbox))))
 
 (define (imap-mailbox/url->server url mailbox)
   (let ((delimiter (imap-mailbox-delimiter url mailbox)))
       (error "Unable to perform rename between different IMAP accounts:"
             url new-url)))
 
-(define-method %append-message ((message <message>) (url <imap-url>))
+(define-method %append-message ((message <message>) (url <imap-folder-url>))
   (let ((folder (message-folder message))
        (maybe-create
         (lambda (connection thunk)