In APPEND-MESSAGE, create mailbox if append/copy causes error

containing TRYCREATE.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 142d06c8dac326ee5efe802c2b96e5efee5d119c..da6572d7a5fa67d0496aba587413b134a4f44eaf 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.68 2000/05/22 13:30:18 cph Exp $
+;;; $Id: imail-imap.scm,v 1.69 2000/05/22 13:52:07 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -732,20 +732,37 @@
             url new-url)))
 
 (define-method %append-message ((message <message>) (url <imap-url>))
-  (let ((folder (message-folder message)))
+  (let ((folder (message-folder message))
+       (maybe-create
+        (lambda (connection thunk)
+          (let ((response (thunk)))
+            (if (imap:response:no? response)
+                (if (imap:response-code:trycreate?
+                     (imap:response:response-text-code response))
+                    (begin
+                      (imap:command:create connection (imap-url-mailbox url))
+                      (let ((response (thunk)))
+                        (if (imap:response:no? response)
+                            (imap:server-error response))))
+                    (imap:server-error response)))))))
     (if (let ((url* (folder-url folder)))
          (and (imap-url? url*)
               (compatible-imap-urls? url url*)))
-       (imap:command:copy (imap-folder-connection folder)
-                          (message-index message)
-                          (imap-url-mailbox url))
+       (let ((connection (imap-folder-connection folder)))
+         (maybe-create connection
+           (lambda ()
+             (imap:command:uid-copy connection
+                                    (imap-message-uid message)
+                                    (imap-url-mailbox url)))))
        (with-open-imap-connection url
          (lambda (connection)
-           (imap:command:append connection
-                                (imap-url-mailbox url)
-                                (message-flags message)
-                                (message-internal-time message)
-                                (message->string message)))))))
+           (maybe-create connection
+             (lambda ()
+               (imap:command:append connection
+                                    (imap-url-mailbox url)
+                                    (message-flags message)
+                                    (message-internal-time message)
+                                    (message->string message)))))))))
 
 (define-method available-folder-names ((url <imap-url>))
   url
@@ -880,14 +897,14 @@
 (define (imap:command:rename connection from to)
   (imap:command:no-response connection 'RENAME from to))
 
-(define (imap:command:copy connection index mailbox)
-  (imap:command:no-response connection 'COPY (+ index 1) mailbox))
+(define (imap:command:uid-copy connection uid mailbox)
+  (imap:command:no-response-1 connection 'UID 'COPY uid mailbox))
 
 (define (imap:command:append connection mailbox flags time text)
-  (imap:command:no-response connection 'APPEND mailbox
-                           (and (pair? flags) flags)
-                           (imap:universal-time->date-time time)
-                           (cons 'LITERAL text)))
+  (imap:command:no-response-1 connection 'APPEND mailbox
+                             (and (pair? flags) flags)
+                             (imap:universal-time->date-time time)
+                             (cons 'LITERAL text)))
 
 (define (imap:command:search connection . key-plist)
   (apply imap:command:single-response imap:response:search? connection

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 93c000f37cadf952b27cf6de06e02a90aea1efd7..18f98c29b65292e0959cd6b9aa0cadf787f6d0ff 100644 (file)
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.39 2000/05/22 13:25:33 cph Exp $
+;;; $Id: imail.pkg,v 1.40 2000/05/22 13:52:25 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -162,6 +162,7 @@
          imap:response-code:permanentflags?
          imap:response-code:read-only?
          imap:response-code:read-write?
+         imap:response-code:trycreate?
          imap:response-code:uidnext
          imap:response-code:uidnext?
          imap:response-code:uidvalidity

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 995b7e0ec2cf65185119d2c151e59fca28046fe7..e3c8fcfe1d7c410de4696e8d9bd96f9620bdb3b7 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.33 2000/05/22 04:01:58 cph Exp $
+$Id: todo.txt,v 1.34 2000/05/22 13:52:41 cph Exp $
 
 Bug fixes
 ---------
@@ -51,10 +51,6 @@ New features
 
 * Add configurable confirmation for performing EXPUNGE.
 
-* M-x imail-output should create the folder if necessary.  This means
-  that %APPEND-MESSAGE method must check for [TRYCREATE] and do the
-  create if it is present.
-
 * Add command to rename folders.  Add command to append all of the
   messages from one folder to another.