Implement IMAIL-COPY-FOLDER, a tool to copy folders to and from an

IMAIL server.

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index ade8c0d27728cb55fb74cb92cd54a9456893bcd0..c7fe9d273ff1808e1e730bc62c667f1fbf9d63b8 100644 (file)
--- 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.82 2000/05/22 04:01:06 cph Exp $
+;;; $Id: imail-top.scm,v 1.83 2000/05/22 13:36:20 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -864,17 +864,24 @@ With prefix argument N, removes FLAG from next N messages,
                                       'HISTORY-INDEX 0)))
   (lambda (url-string)
     (let ((folder (selected-folder)))
-      (let ((folder* (open-folder (imail-parse-partial-url url-string)))
-           (url (folder-url folder)))
-       (let ((n (folder-length folder*)))
-         (do ((index 0 (+ index 1)))
-             ((= index n))
-           (append-message (get-message folder* index) url)))
-       (close-folder folder*))
+      (%imail-copy-folder (imail-parse-partial-url url-string)
+                         (folder-url folder))
       (select-message folder
                      (or (selected-message #f)
                          (navigator/first-unseen-message folder))))))
 
+(define (imail-copy-folder from to)
+  (%imail-copy-folder (imail-parse-partial-url from)
+                     (imail-parse-partial-url to)))
+
+(define (%imail-copy-folder from to)
+  (let ((folder (open-folder from)))
+    (let ((n (folder-length folder)))
+      (do ((i 0 (+ i 1)))
+         ((= i n))
+       (append-message (get-message folder i) to)))
+    (close-folder folder)))
+
 (define-command imail-output
   "Append this message to a specified folder."
   (lambda ()

diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm
index 38f2f8fbc713c8d0450ee169c9e4a68f691a6a10..ec0d1a5882a4b3fc13ba285d60a952a27bf869f8 100644 (file)
--- a/v7/src/imail/load.scm
+++ b/v7/src/imail/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.6 2000/05/22 13:25:38 cph Exp $
+;;; $Id: load.scm,v 1.7 2000/05/22 13:36:29 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -91,4 +91,5 @@
            edwin-variable$imail-summary-mode-hook
            edwin-variable$imail-summary-pop-up-message
            edwin-variable$imail-summary-show-date
-           edwin-variable$imail-summary-subject-width))
\ No newline at end of file
+           edwin-variable$imail-summary-subject-width
+           imail-copy-folder))
\ No newline at end of file