diff lisp/gnus/message.el @ 34752:f04f551e94ce

* message.el (message-narrow-to-head-1): New function. (message-narrow-to-head): Use it. (message-reply): Ditto. (message-cancel-news): Ditto. (message-supersede): Ditto. (message-make-forward-subject): Ditto. (message-bounce): Ditto. * gnus-msg.el (gnus-summary-mail-forward): Use original buffer. * message.el (message-forward): Copy buffer in unibyte mode. (message-make-forward-subject): Don't widen. Decode. (message-forward): Don't decode subject. * mml.el (gnus-ems): Require it. * gnus-msg.el (gnus-summary-mail-forward): * message.el (message-forward): Move mime-to-mml here. * nnmbox.el (nnmbox-file-coding-system): Use binary. (nnmbox-active-file-coding-system): Ditto. * gnus-cus.el (gnus-group-parameters): Add posting-style. * mm-uu.el: Require binhex. * qp.el (quoted-printable-encode-region): Upcase QP.
author ShengHuo ZHU <zsh@cs.rochester.edu>
date Wed, 20 Dec 2000 20:20:51 +0000
parents 072ecdc5d391
children d8e4421fc16f
line wrap: on
line diff
--- a/lisp/gnus/message.el	Wed Dec 20 20:09:59 2000 +0000
+++ b/lisp/gnus/message.el	Wed Dec 20 20:20:51 2000 +0000
@@ -1242,10 +1242,8 @@
      (point-max)))
   (goto-char (point-min)))
 
-(defun message-narrow-to-head ()
-  "Narrow the buffer to the head of the message.
-Point is left at the beginning of the narrowed-to region."
-  (widen)
+(defun message-narrow-to-head-1 ()
+  "Like `message-narrow-to-head'. Don't widen."
   (narrow-to-region
    (goto-char (point-min))
    (if (search-forward "\n\n" nil 1)
@@ -1253,6 +1251,12 @@
      (point-max)))
   (goto-char (point-min)))
 
+(defun message-narrow-to-head ()
+  "Narrow the buffer to the head of the message.
+Point is left at the beginning of the narrowed-to region."
+  (widen)
+  (message-narrow-to-head-1))
+
 (defun message-narrow-to-headers-or-head ()
   "Narrow the buffer to the head of the message."
   (widen)
@@ -3758,7 +3762,7 @@
 	(message-this-is-mail t)
 	gnus-warning)
     (save-restriction
-      (message-narrow-to-head)
+      (message-narrow-to-head-1)
       ;; Allow customizations to have their say.
       (if (not wide)
 	  ;; This is a regular reply.
@@ -3932,7 +3936,7 @@
       (save-excursion
 	;; Get header info from original article.
 	(save-restriction
-	  (message-narrow-to-head)
+	  (message-narrow-to-head-1)
 	  (setq from (message-fetch-field "from")
 		sender (message-fetch-field "sender")
 		newsgroups (message-fetch-field "newsgroups")
@@ -3994,7 +3998,7 @@
     (message-pop-to-buffer (message-buffer-name "supersede"))
     (insert-buffer-substring cur)
     (mime-to-mml)
-    (message-narrow-to-head)
+    (message-narrow-to-head-1)
     ;; Remove unwanted headers.
     (when message-ignored-supersedes-headers
       (message-remove-header message-ignored-supersedes-headers t))
@@ -4082,13 +4086,15 @@
   "Return a Subject header suitable for the message in the current buffer."
   (save-excursion
     (save-restriction
-      (current-buffer)
-      (message-narrow-to-head)
+      (message-narrow-to-head-1)
       (let ((funcs message-make-forward-subject-function)
-	    (subject (if message-wash-forwarded-subjects
-			 (message-wash-subject
-			  (or (message-fetch-field "Subject") ""))
-		       (or (message-fetch-field "Subject") ""))))
+	    (subject (message-fetch-field "Subject")))
+	(setq subject
+	      (if subject
+		  (mail-decode-encoded-word-string subject)
+		""))
+	(if message-wash-forwarded-subjects
+	    (setq subject (message-wash-subject subject)))
 	;; Make sure funcs is a list.
 	(and funcs
 	     (not (listp funcs))
@@ -4108,10 +4114,7 @@
 Optional DIGEST will use digest to forward."
   (interactive "P")
   (let* ((cur (current-buffer))
-	 (subject (if message-forward-show-mml
-		      (message-make-forward-subject)
-		    (mail-decode-encoded-word-string
-		     (message-make-forward-subject))))
+	 (subject (message-make-forward-subject))
 	 art-beg)
     (if news
 	(message-news nil subject)
@@ -4134,8 +4137,29 @@
 	      (insert-buffer-substring cur)
 	    (mml-insert-buffer cur))
 	(if message-forward-show-mml
-	    (insert-buffer-substring cur)
-	  (mml-insert-buffer cur)))
+	    (let ((target (current-buffer)) tmp)
+	      (with-temp-buffer
+		(mm-disable-multibyte) ;; Must copy buffer in unibyte mode
+		(setq tmp (current-buffer))
+		(set-buffer cur)
+		(mm-with-unibyte-current-buffer
+		  (set-buffer tmp)
+		  (insert-buffer-substring cur))
+		(set-buffer tmp)
+		(mm-enable-multibyte)
+		(mime-to-mml)
+		(goto-char (point-min))
+		(when (looking-at "From ")
+		  (replace-match "X-From-Line: "))
+		(set-buffer target)
+		(insert-buffer-substring tmp)
+		(set-buffer tmp))
+	      (goto-char (point-max)))
+	  (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
@@ -4241,7 +4265,7 @@
     (mm-enable-multibyte)
     (mime-to-mml)
     (save-restriction
-      (message-narrow-to-head)
+      (message-narrow-to-head-1)
       (message-remove-header message-ignored-bounced-headers t)
       (goto-char (point-max))
       (insert mail-header-separator))