From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 22 May 2000 14:50:30 +0000 (+0000)
Subject: Write M-x imail-copy-messages.
X-Git-Tag: 20090517-FFI~3750
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5286b58bb43f64ca9b7cb86167c91442415d4134;p=mit-scheme.git

Write M-x imail-copy-messages.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index c7fe9d273..34f59ee38 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.83 2000/05/22 13:36:20 cph Exp $
+;;; $Id: imail-top.scm,v 1.84 2000/05/22 14:50:30 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -855,6 +855,25 @@ With prefix argument N, removes FLAG from next N messages,
 
 ;;;; Message I/O
 
+(define-command imail-create-folder
+  "Create a new folder with the specified name.
+An error if signalled if the folder already exists."
+  (lambda ()
+    (list (prompt-for-imail-url-string "Create folder" (imail-default-url)
+				       'DEFAULT-TYPE 'INSERTED-DEFAULT
+				       'HISTORY 'IMAIL-CREATE-FOLDER)))
+  (lambda (url-string)
+    (create-folder (imail-parse-partial-url url-string))))
+
+(define-command imail-delete-folder
+  "Delete a specified folder."
+  (lambda ()
+    (list (prompt-for-imail-url-string "Delete folder" (imail-default-url)
+				       'DEFAULT-TYPE 'INSERTED-DEFAULT
+				       'HISTORY 'IMAIL-DELETE-FOLDER)))
+  (lambda (url-string)
+    (delete-folder (imail-parse-partial-url url-string))))
+
 (define-command imail-input
   "Append messages to this folder from a specified folder."
   (lambda ()
@@ -864,24 +883,16 @@ With prefix argument N, removes FLAG from next N messages,
 				       'HISTORY-INDEX 0)))
   (lambda (url-string)
     (let ((folder (selected-folder)))
-      (%imail-copy-folder (imail-parse-partial-url url-string)
-			  (folder-url folder))
+      (let ((folder (open-folder (imail-parse-partial-url url-string)))
+	    (to (folder-url folder)))
+	(let ((n (folder-length folder)))
+	  (do ((i 0 (+ i 1)))
+	      ((= i n))
+	    (append-message (get-message folder i) to))))
       (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 ()
@@ -898,24 +909,24 @@ With prefix argument N, removes FLAG from next N messages,
 	  (message-filed message)
 	  (if delete? (delete-message message)))))))
 
-(define-command imail-create-folder
-  "Create a new folder with the specified name.
-An error if signalled if the folder already exists."
-  (lambda ()
-    (list (prompt-for-imail-url-string "Create folder" (imail-default-url)
-				       'DEFAULT-TYPE 'INSERTED-DEFAULT
-				       'HISTORY 'IMAIL-CREATE-FOLDER)))
-  (lambda (url-string)
-    (create-folder (imail-parse-partial-url url-string))))
-
-(define-command imail-delete-folder
-  "Delete a specified folder."
+(define-command imail-copy-messages
+  "Append all messages from this folder to a specified folder.
+The messages are NOT marked as filed.
+The messages are NOT deleted even if imail-delete-after-output is true.
+This command is meant to be used to move the contents of a folder
+ either to or from an IMAP server."
   (lambda ()
-    (list (prompt-for-imail-url-string "Delete folder" (imail-default-url)
+    (list (prompt-for-imail-url-string "Output to folder" (imail-default-url)
 				       'DEFAULT-TYPE 'INSERTED-DEFAULT
-				       'HISTORY 'IMAIL-DELETE-FOLDER)))
+				       'HISTORY 'IMAIL-OUTPUT
+				       'HISTORY-INDEX 0)))
   (lambda (url-string)
-    (delete-folder (imail-parse-partial-url url-string))))
+    (let ((folder (selected-folder))
+	  (to (imail-parse-partial-url url-string)))
+      (let ((n (folder-length folder)))
+	(do ((i 0 (+ i 1)))
+	    ((= i n))
+	  (append-message (get-message folder i) to))))))
 
 ;;;; Sending mail