From 0eedd406d18f86de47fd63d6cc4bc4b8bbac519f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 May 2000 21:13:25 +0000
Subject: [PATCH] Fix bug: retention time being interpreted in seconds rather
 than minutes.  Implement M-x imail-copy-folder.

---
 v7/src/imail/imail-top.scm | 60 +++++++++++++++++++++++++-------------
 v7/src/imail/todo.txt      |  5 ++--
 2 files changed, 42 insertions(+), 23 deletions(-)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 8ff46a583..8db29a903 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.103 2000/05/23 21:00:42 cph Exp $
+;;; $Id: imail-top.scm,v 1.104 2000/05/23 21:12:48 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -290,7 +290,7 @@ regardless of the folder type."
 (define (clean-imail-memoized-pass-phrases now retention-time)
   (if (> retention-time 0)
       (hash-table/for-each imail-memoized-pass-phrases
-	(let ((cutoff (- now retention-time)))
+	(let ((cutoff (- now (* retention-time 60))))
 	  (lambda (key datum)
 	    (if (<= (car datum) cutoff)
 		(hash-table/remove! imail-memoized-pass-phrases key)))))
@@ -362,6 +362,7 @@ Instead, these commands are available:
 \\[imail-input]	Append messages from a specified folder.
 \\[imail-output]       Output this message to a specified folder (append it).
 \\[imail-copy-messages]	Copy all messages in selected folder to another folder.
+\\[imail-copy-folder]	Copy all messages in specified folder to another folder.
 \\[imail-create-folder]	Create a new folder.  (Normally not needed
 	  as output commands create folders automatically.)
 \\[imail-delete-folder]	Delete an existing folder.
@@ -451,6 +452,7 @@ variable's documentation (using \\[describe-variable]) for details:
 (define-key 'imail #\i		'imail-input)
 (define-key 'imail #\o		'imail-output)
 (define-key 'imail #\m-o	'imail-copy-messages)
+(define-key 'imail #\m-c	'imail-copy-folder)
 (define-key 'imail #\+		'imail-create-folder)
 (define-key 'imail #\-		'imail-delete-folder)
 (define-key 'imail #\q		'imail-quit)
@@ -1139,24 +1141,42 @@ This command is meant to be used to move the contents of a folder
 				       'HISTORY 'IMAIL-OUTPUT
 				       'HISTORY-INDEX 0)))
   (lambda (url-string)
-    (let ((folder (selected-folder))
-	  (to (imail-parse-partial-url url-string)))
-      (with-open-connection to
-	(lambda ()
-	  (let ((n (folder-length folder)))
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      ((message-wrapper #f
-				"Copying message "
-				(number->string (+ i 1))
-				"/"
-				(number->string n))
-	       (lambda () (append-message (get-message folder i) to))))
-	    (message (number->string n)
-		     " message"
-		     (if (= n 1) "" "s")
-		     " copied to "
-		     (url->string to))))))))
+    (copy-folder (selected-folder) (imail-parse-partial-url url-string))))
+
+(define-command imail-copy-folder
+  "Copy all messages from a specified folder to another folder.
+If the target folder exists, the messages are appended to it.
+If it doesn't exist, it is created first."
+  (lambda ()
+    (let ((from
+	   (prompt-for-imail-url-string "Copy folder"
+					'HISTORY 'IMAIL-COPY-FOLDER-SOURCE
+					'HISTORY-INDEX 0)))
+      (list from
+	    (prompt-for-imail-url-string "Copy messages to folder"
+					 'HISTORY 'IMAIL-COPY-FOLDER-TARGET
+					 'HISTORY-INDEX 0))))
+  (lambda (from to)
+    (copy-folder (open-folder (imail-parse-partial-url from))
+		 (imail-parse-partial-url to))))
+
+(define (copy-folder folder to)
+  (with-open-connection to
+    (lambda ()
+      (let ((n (folder-length folder)))
+	(do ((i 0 (+ i 1)))
+	    ((= i n))
+	  ((message-wrapper #f
+			    "Copying message "
+			    (number->string (+ i 1))
+			    "/"
+			    (number->string n))
+	   (lambda () (append-message (get-message folder i) to))))
+	(message (number->string n)
+		 " message"
+		 (if (= n 1) "" "s")
+		 " copied to "
+		 (url->string to))))))
 
 ;;;; Sending mail
 
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 08e9eb26c..944be10fe 100644
--- 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.47 2000/05/23 21:00:52 cph Exp $
+$Id: todo.txt,v 1.48 2000/05/23 21:13:25 cph Exp $
 
 Bug fixes
 ---------
@@ -50,8 +50,7 @@ New features
 
 * Optionally wrap long lines for presentation.
 
-* Add command to rename folders.  Add command to append all of the
-  messages from one folder to another.
+* Add command to rename folders.
 
 * Add mail notification in mode line, active across the editor as long
   as there is an IMAP connection open in some buffer.
-- 
2.25.1