changeset 41511:19496cafe865

2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu> * mail/rmail.el (rmail-enable-mime-composing): New. A lightweight version of rmail-enable-mime. (rmail-forward): Use it. * message.el (message-forward-rmail-make-body): save-window-excursion. (message-encode-message-body): no error. (message-setup-1): compose-mail send-actions are different from message-send-actions. * message.el (message-forward-subject-author-subject): Don't use message-news-p, which widens the buffer. (message-forward-make-body): New function. (message-forward): Use it. (message-insinuate-rmail): New. (message-forward-rmail-make-body): New.
author ShengHuo ZHU <zsh@cs.rochester.edu>
date Sun, 25 Nov 2001 20:45:37 +0000
parents 69925dd4cdc7
children 4f4835967793
files lisp/ChangeLog lisp/gnus/ChangeLog lisp/gnus/message.el lisp/mail/rmail.el
diffstat 4 files changed, 112 insertions(+), 66 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Nov 25 19:35:29 2001 +0000
+++ b/lisp/ChangeLog	Sun Nov 25 20:45:37 2001 +0000
@@ -1,3 +1,9 @@
+2001-11-25  ShengHuo ZHU  <zsh@cs.rochester.edu>
+
+	* mail/rmail.el (rmail-enable-mime-composing): New. A lightweight
+	version of rmail-enable-mime.
+	(rmail-forward): Use it.
+
 2001-11-25  Richard M. Stallman  <rms@gnu.org>
 
 	* emacs-lisp/lisp-mode.el (lisp-indent-function): Add doc string.
--- a/lisp/gnus/ChangeLog	Sun Nov 25 19:35:29 2001 +0000
+++ b/lisp/gnus/ChangeLog	Sun Nov 25 20:45:37 2001 +0000
@@ -1,5 +1,18 @@
 2001-11-25  ShengHuo ZHU  <zsh@cs.rochester.edu>
 
+	* message.el (message-forward-rmail-make-body):
+	save-window-excursion.
+	(message-encode-message-body): no error.
+	(message-setup-1): compose-mail send-actions are different from
+	message-send-actions.
+
+	* message.el (message-forward-subject-author-subject): Don't use
+	message-news-p, which widens the buffer.
+	(message-forward-make-body): New function.
+	(message-forward): Use it.
+	(message-insinuate-rmail): New.
+	(message-forward-rmail-make-body): New.
+
 	* gnus-util.el (gnus-directory-sep-char-regexp): New.
 	* gnus-score.el (gnus-score-find-bnews): Sync with Gnus CVS.
 	* mm-util.el: Sync.
--- a/lisp/gnus/message.el	Sun Nov 25 19:35:29 2001 +0000
+++ b/lisp/gnus/message.el	Sun Nov 25 20:45:37 2001 +0000
@@ -3635,8 +3635,10 @@
     (push '(message-mode (encrypt . mc-encrypt-message)
 			 (sign . mc-sign-message))
 	  mc-modes-alist))
-  (when actions
-    (setq message-send-actions actions))
+  (dolist (action actions)
+    (condition-case nil
+	(add-to-list 'message-send-actions
+		     `(apply ',(car action) ',(cdr action)))))
   (setq message-reply-buffer replybuffer)
   (goto-char (point-min))
   ;; Insert all the headers.
@@ -4155,8 +4157,8 @@
 the list of newsgroups is was posted to."
   (concat "["
 	   (let ((prefix 
-		  (or (message-fetch-field
-		       (if (message-news-p) "newsgroups" "from"))
+		  (or (message-fetch-field "newsgroups")
+		      (message-fetch-field "from")
 		      "(nowhere)")))
 	     (if message-forward-decoded-p
 		 prefix
@@ -4199,6 +4201,7 @@
 (eval-when-compile
   (defvar gnus-article-decoded-p))
 
+
 ;;;###autoload
 (defun message-forward (&optional news digest)
   "Forward the current message via mail.
@@ -4206,39 +4209,42 @@
 Optional DIGEST will use digest to forward."
   (interactive "P")
   (let* ((cur (current-buffer))
-	 (message-forward-decoded-p 
+	 (message-forward-decoded-p
 	  (if (local-variable-p 'gnus-article-decoded-p (current-buffer))
-	      gnus-article-decoded-p  ;; In an article buffer.
+	      gnus-article-decoded-p ;; In an article buffer.
 	    message-forward-decoded-p))
-	 (subject (message-make-forward-subject))
-	 art-beg)
+	 (subject (message-make-forward-subject)))
     (if news
 	(message-news nil subject)
       (message-mail nil subject))
-    ;; Put point where we want it before inserting the forwarded
-    ;; message.
-    (if message-forward-before-signature
-        (message-goto-body)
-      (goto-char (point-max)))
-    (if message-forward-as-mime
-	(if digest
-	    (insert "\n<#multipart type=digest>\n")
-	  (if message-forward-show-mml
-	      (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
-	    (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
-      (insert "\n-------------------- Start of forwarded message --------------------\n"))
-    (let ((b (point)) e)
+    (message-forward-make-body cur digest)))
+
+;;;###autoload
+(defun message-forward-make-body (forward-buffer &optional digest)
+  ;; Put point where we want it before inserting the forwarded
+  ;; message.
+  (if message-forward-before-signature
+      (message-goto-body)
+    (goto-char (point-max)))
+  (if message-forward-as-mime
       (if digest
-	  (if message-forward-as-mime
-	      (insert-buffer-substring cur)
-	    (mml-insert-buffer cur))
-	(if (and message-forward-show-mml
-		 (not message-forward-decoded-p))
-	    (insert
-	     (with-temp-buffer
-	       (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
+	  (insert "\n<#multipart type=digest>\n")
+	(if message-forward-show-mml
+	    (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+	  (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))
+    (insert "\n-------------------- Start of forwarded message --------------------\n"))
+  (let ((b (point)) e)
+    (if digest
+	(if message-forward-as-mime
+	    (insert-buffer-substring forward-buffer)
+	  (mml-insert-buffer forward-buffer))
+      (if (and message-forward-show-mml
+	       (not message-forward-decoded-p))
+	  (insert
+	   (with-temp-buffer
+	     (mm-disable-multibyte-mule4) ;; Must copy buffer in unibyte mode
 	       (insert
-		(with-current-buffer cur
+		(with-current-buffer forward-buffer
 		  (mm-string-as-unibyte (buffer-string))))
 	       (mm-enable-multibyte-mule4)
 	       (mime-to-mml)
@@ -4246,37 +4252,53 @@
 	       (when (looking-at "From ")
 		 (replace-match "X-From-Line: "))
 	       (buffer-string)))
-	  (save-restriction
-	    (narrow-to-region (point) (point))
-	    (mml-insert-buffer cur)
-	    (goto-char (point-min))
-	    (when (looking-at "From ")
-	      (replace-match "X-From-Line: "))
-	    (goto-char (point-max)))))
-      (setq e (point))
-      (if message-forward-as-mime
-	  (if digest
-	      (insert "<#/multipart>\n")
-	    (if message-forward-show-mml
-		(insert "<#/mml>\n")
-	      (insert "<#/part>\n")))
-	(insert "\n-------------------- End of forwarded message --------------------\n"))
-      (if (and digest message-forward-as-mime)
-	  (save-restriction
-	    (narrow-to-region b e)
-	    (goto-char b)
-	    (narrow-to-region (point)
-			      (or (search-forward "\n\n" nil t) (point)))
-	    (delete-region (point-min) (point-max)))
-	(when (and (not current-prefix-arg)
-		   message-forward-ignored-headers)
-	  (save-restriction
-	    (narrow-to-region b e)
-	    (goto-char b)
-	    (narrow-to-region (point)
-			      (or (search-forward "\n\n" nil t) (point)))
-	    (message-remove-header message-forward-ignored-headers t)))))
-    (message-position-point)))
+	(save-restriction
+	  (narrow-to-region (point) (point))
+	  (mml-insert-buffer forward-buffer)
+	  (goto-char (point-min))
+	  (when (looking-at "From ")
+	    (replace-match "X-From-Line: "))
+	  (goto-char (point-max)))))
+    (setq e (point))
+    (if message-forward-as-mime
+	(if digest
+	    (insert "<#/multipart>\n")
+	  (if message-forward-show-mml
+	      (insert "<#/mml>\n")
+	    (insert "<#/part>\n")))
+      (insert "\n-------------------- End of forwarded message --------------------\n"))
+    (if (and digest message-forward-as-mime)
+	(save-restriction
+	  (narrow-to-region b e)
+	  (goto-char b)
+	  (narrow-to-region (point)
+			    (or (search-forward "\n\n" nil t) (point)))
+	  (delete-region (point-min) (point-max)))
+      (when (and (not current-prefix-arg)
+		 message-forward-ignored-headers)
+	(save-restriction
+	  (narrow-to-region b e)
+	  (goto-char b)
+	  (narrow-to-region (point)
+			    (or (search-forward "\n\n" nil t) (point)))
+	  (message-remove-header message-forward-ignored-headers t)))))
+  (message-position-point))
+
+;;;###autoload
+(defun message-forward-rmail-make-body (forward-buffer)
+  (save-window-excursion
+    (set-buffer forward-buffer)
+    (let (rmail-enable-mime)
+      (rmail-toggle-header 0)))
+  (message-forward-make-body forward-buffer))
+
+;;;###autoload
+(defun message-insinuate-rmail ()
+  "Let RMAIL uses message to forward."
+  (interactive)
+  (setq rmail-enable-mime-composing t)
+  (setq rmail-insert-mime-forwarded-message-function 
+	'message-forward-rmail-make-body))
 
 ;;;###autoload
 (defun message-resend (address)
@@ -4648,9 +4670,10 @@
       ;; /usr/bin/mail.
       (unless content-type-p
 	(goto-char (point-min))
-	(re-search-forward "^MIME-Version:")
-	(forward-line 1)
-	(insert "Content-Type: text/plain; charset=us-ascii\n")))))
+	;; For unknown reason, MIME-Version doesn't exist.
+	(when (re-search-forward "^MIME-Version:" nil t)
+	  (forward-line 1)
+	  (insert "Content-Type: text/plain; charset=us-ascii\n"))))))
 
 (defun message-read-from-minibuffer (prompt)
   "Read from the minibuffer while providing abbrev expansion."
--- a/lisp/mail/rmail.el	Sun Nov 25 19:35:29 2001 +0000
+++ b/lisp/mail/rmail.el	Sun Nov 25 20:45:37 2001 +0000
@@ -420,6 +420,9 @@
 		 (other :tag "when asked" ask))
   :group 'rmail)
 
+(defvar rmail-enable-mime-composing nil
+  "*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.")
+
 ;;;###autoload
 (defvar rmail-show-mime-function nil
   "Function to show MIME decoded message of RMAIL file.
@@ -429,7 +432,8 @@
 ;;;###autoload
 (defvar rmail-insert-mime-forwarded-message-function nil
   "Function to insert a message in MIME format so it can be forwarded.
-This function is called if `rmail-enable-mime' is non-nil.
+This function is called if `rmail-enable-mime' or 
+`rmail-enable-mime-composing' is non-nil.
 It is called with one argument FORWARD-BUFFER, which is a
 buffer containing the message to forward.  The current buffer
 is the outgoing mail buffer.")
@@ -3253,7 +3257,7 @@
 	  (save-excursion
 	    ;; Insert after header separator--before signature if any.
 	    (goto-char (mail-text-start))
-	    (if rmail-enable-mime
+	    (if (or rmail-enable-mime rmail-enable-mime-composing)
 		(funcall rmail-insert-mime-forwarded-message-function
 			 forward-buffer)
 	      (insert "------- Start of forwarded message -------\n")