From: Brian A. LaMacchia <edu/mit/csail/zurich/bal>
Date: Wed, 29 Apr 1992 22:29:26 +0000 (+0000)
Subject: Added rmail-edit-current-message.
X-Git-Tag: 20090517-FFI~9453
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=babb9b34dc5f1678824c2ef34482e90ca1fa5838;p=mit-scheme.git

Added rmail-edit-current-message.
---

diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm
index e03df982f..afe96b4a8 100644
--- a/v7/src/edwin/rmail.scm
+++ b/v7/src/edwin/rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmail.scm,v 1.16 1992/02/12 06:40:08 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmail.scm,v 1.17 1992/04/29 22:29:26 bal Exp $
 ;;;
 ;;;	Copyright (c) 1991-92 Massachusetts Institute of Technology
 ;;;
@@ -1373,6 +1373,50 @@ buffer visiting that file."
 	 (and (not (null? addresses))
 	      (car addresses)))))
 
+;;;; Editing 
+(define-command rmail-edit-current-message
+  "Edit the current RMAIL message."
+  '()
+  (lambda ()
+    (let* ((memo (current-msg-memo))
+	   (original-message #f)
+	   (return-value 'ABORT)
+	   (msg-num (msg-memo/number memo)))
+      (dynamic-wind
+       (lambda ()
+	 (with-buffer-open
+	  (current-buffer)
+	  (lambda ()
+	    (set! original-message
+		  (extract-string
+		   (msg-memo/start-body memo)
+		   (msg-memo/end-body memo)))))
+	 (set-buffer-writeable! (current-buffer))
+	 (set-current-major-mode! (ref-mode-object rmail-edit)))
+       (lambda ()
+	 (set! return-value (enter-recursive-edit))
+	 (message return-value)
+	 return-value)
+       (lambda ()
+	 (if (eq? return-value 'ABORT)
+	     (begin
+	       (with-buffer-open
+		(current-buffer)
+		(lambda ()
+		  (kill-string
+		   (msg-memo/start-body memo)
+		   (msg-memo/end-body memo))
+		  (insert-string original-message
+				 (msg-memo/start-body memo))))))
+	 (set-current-major-mode! (ref-mode-object rmail))
+	 (let ((buf (current-buffer)))
+	   (with-buffer-open
+	       buf
+	     (lambda ()
+	       (memoize-buffer buf)
+	       (update-mode-line! buf)))
+	   (show-message buf msg-num)))))))
+
 ;;;; Undigestifier
 
 (define-command undigestify-rmail-message