From 760a41dbe96e2a552ee6bcc015e4ac88317f8686 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 22 May 2000 13:36:29 +0000
Subject: [PATCH] Implement IMAIL-COPY-FOLDER, a tool to copy folders to and
 from an IMAIL server.

---
 v7/src/imail/imail-top.scm | 23 +++++++++++++++--------
 v7/src/imail/load.scm      |  5 +++--
 2 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index ade8c0d27..c7fe9d273 100644
--- 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 38f2f8fbc..ec0d1a588 100644
--- 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
-- 
2.25.1