From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 8 Jun 2000 03:14:00 +0000 (+0000)
Subject: Implement M-x imail-rename-folder.
X-Git-Tag: 20090517-FFI~3589
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e18af2d339c1d82d5e0a9184f976dfd4f5eecd59;p=mit-scheme.git

Implement M-x imail-rename-folder.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 821f1e205..be77886e8 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.135 2000/06/08 02:03:07 cph Exp $
+;;; $Id: imail-top.scm,v 1.136 2000/06/08 03:13:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -527,6 +527,7 @@ variable's documentation (using \\[describe-variable]) for details:
 (define-key 'imail #\c-o	'imail-save-attachment)
 (define-key 'imail #\+		'imail-create-folder)
 (define-key 'imail #\-		'imail-delete-folder)
+(define-key 'imail #\R		'imail-rename-folder)
 (define-key 'imail #\q		'imail-quit)
 (define-key 'imail #\?		'describe-mode)
 
@@ -1433,6 +1434,24 @@ An error if signalled if the folder already exists."
 	    (message "Deleted folder " (url->string url)))
 	  (message "Folder not deleted")))))
 
+(define-command imail-rename-folder
+  "Delete a specified folder and all its messages."
+  (lambda ()
+    (let ((from
+	   (prompt-for-imail-url-string "Rename folder"
+					'HISTORY 'IMAIL-RENAME-FOLDER-SOURCE
+					'HISTORY-INDEX 0
+					'REQUIRE-MATCH? #t)))
+      (list from
+	    (prompt-for-imail-url-string "Rename folder to"
+					 'HISTORY 'IMAIL-RENAME-FOLDER-TARGET
+					 'HISTORY-INDEX 0))))
+  (lambda (from to)
+    (let ((from (imail-parse-partial-url from))
+	  (to (imail-parse-partial-url to)))
+      (rename-folder from to)
+      (message "Folder renamed to " (url->string to)))))
+
 (define-command imail-input
   "Run IMAIL on a specified folder."
   (lambda ()
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 6a0d23e37..10080fca3 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.49 2000/06/08 02:03:28 cph Exp $
+;;; $Id: imail.pkg,v 1.50 2000/06/08 03:14:00 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -243,6 +243,7 @@
 	  edwin-command$imail-previous-message
 	  edwin-command$imail-previous-undeleted-message
 	  edwin-command$imail-quit
+	  edwin-command$imail-rename-folder
 	  edwin-command$imail-reply
 	  edwin-command$imail-resend
 	  edwin-command$imail-save-folder