From: yamaoka <yamaoka>
Date: Thu, 12 Nov 1998 05:05:58 +0000 (+0000)
Subject: Support for `article editing' and `re-sending bounced mail' with MIME-Edit.
X-Git-Tag: gnus-6_8-199811302358~36
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=73458d495ce36d87485f173d156adc7ced744f48;p=elisp%2Fgnus.git-

Support for `article editing' and `re-sending bounced mail' with MIME-Edit.
See ChangeLog for more details.
---

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 7c455a2..247338f 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -3,6 +3,7 @@
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;	Katsumi Yamaoka  <yamaoka@jpl.org>
 ;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
@@ -1999,6 +2000,38 @@ commands:
     (mime-maybe-hide-echo-buffer))
   (gnus-run-hooks 'gnus-mime-article-prepare-hook))
 
+(defun gnus-article-make-full-mail-header (&optional number charset)
+  "Create a new mail header structure in a raw article buffer."
+  (unless (and number charset)
+    (save-current-buffer
+      (set-buffer gnus-summary-buffer)
+      (unless number
+	(setq number (or (cdr gnus-article-current) 0)))
+      (unless charset
+	(setq charset (or default-mime-charset 'x-ctext)))))
+  (goto-char (point-min))
+  (let ((header-end (if (search-forward "\n\n" nil t)
+			(1- (point))
+		      (goto-char (point-max))))
+	(chars (- (point-max) (point)))
+	(lines (count-lines (point) (point-max)))
+	(default-mime-charset charset)
+	xref)
+    (narrow-to-region (point-min) header-end)
+    (setq xref (std11-fetch-field "xref"))
+    (prog1
+	(make-full-mail-header
+	 number
+	 (std11-fetch-field "subject")
+	 (std11-fetch-field "from")
+	 (std11-fetch-field "date")
+	 (std11-fetch-field "message-id")
+	 (std11-fetch-field "references")
+	 chars
+	 lines
+	 (when xref (concat "Xref: " xref)))
+      (widen))))
+
 (defun gnus-article-prepare (article &optional all-headers header)
   "Prepare ARTICLE in article mode buffer.
 ARTICLE should either be an article number or a Message-ID.
@@ -2092,25 +2125,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 		      (or all-headers gnus-show-all-headers))))
 	    (when (or (numberp article)
 		      (stringp article))
-	      ;; Hooks for getting information from the article.
-	      ;; This hook must be called before being narrowed.
-	      (let ((method
-		     (if gnus-show-mime
-			 (progn
-			   (mime-parse-buffer)
-			   (if (or (not gnus-strict-mime)
-				   (mime-fetch-field "MIME-Version"))
-			       gnus-article-display-method-for-mime
-			     gnus-article-display-method-for-encoded-word))
-		       gnus-article-display-method-for-traditional)))
-		(gnus-run-hooks 'gnus-tmp-internal-hook)
-		(gnus-run-hooks 'gnus-article-prepare-hook)
-		;; Display message.
-		(funcall method)
-		;; Associate this article with the current summary buffer.
-		(setq gnus-article-current-summary summary-buffer)
-		;; Perform the article display hooks.
-		(gnus-run-hooks 'gnus-article-display-hook))
+	      (gnus-article-prepare-display)
 	      ;; Do page break.
 	      (goto-char (point-min))
 	      (setq gnus-page-broken
@@ -2124,6 +2139,26 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 	    (set-window-point (get-buffer-window (current-buffer)) (point))
 	    t))))))
 
+(defun gnus-article-prepare-display ()
+  "Make the current buffer look like a nice article."
+  (let ((method
+	 (if gnus-show-mime
+	     (progn
+	       (mime-parse-buffer)
+	       (if (or (not gnus-strict-mime)
+		       (mime-fetch-field "MIME-Version"))
+		   gnus-article-display-method-for-mime
+		 gnus-article-display-method-for-encoded-word))
+	   gnus-article-display-method-for-traditional)))
+    (gnus-run-hooks 'gnus-tmp-internal-hook)
+    (gnus-run-hooks 'gnus-article-prepare-hook)
+    ;; Display message.
+    (funcall method)
+    ;; Associate this article with the current summary buffer.
+    (setq gnus-article-current-summary (current-buffer))
+    ;; Perform the article display hooks.
+    (gnus-run-hooks 'gnus-article-display-hook)))
+
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."
   (save-excursion
@@ -2553,6 +2588,12 @@ If given a prefix, show the hidden text instead."
   :group 'gnus-article-various
   :type 'hook)
 
+(defcustom gnus-article-edit-article-setup-function
+  'gnus-article-mime-edit-article-setup
+  "Function called to setup an editing article buffer."
+  :group 'gnus-article-various
+  :type 'function)
+
 (defvar gnus-article-edit-done-function nil)
 
 (defvar gnus-article-edit-mode-map nil)
@@ -2610,6 +2651,8 @@ groups."
     (gnus-configure-windows 'edit-article)
     (setq gnus-article-edit-done-function exit-func)
     (setq gnus-prev-winconf winconf)
+    (when gnus-article-edit-article-setup-function
+      (funcall gnus-article-edit-article-setup-function))
     (gnus-message 6 "C-c C-c to end edits")))
 
 (defun gnus-article-edit-done (&optional arg)
@@ -2640,6 +2683,8 @@ groups."
   (let ((func gnus-article-edit-done-function)
 	(buf (current-buffer))
 	(start (window-start)))
+    (remove-hook 'gnus-article-mode-hook
+		 'gnus-article-mime-edit-article-unwind)
     (gnus-article-edit-exit)
     (save-excursion
       (set-buffer buf)
@@ -2691,6 +2736,86 @@ groups."
       (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
 
 ;;;
+;;; Article editing with MIME-Edit
+;;;
+
+(defcustom gnus-article-mime-edit-article-setup-hook nil
+  "Hook run after setting up a MIME editing article buffer."
+  :group 'gnus-article-various
+  :type 'hook)
+
+(defun gnus-article-mime-edit-article-unwind ()
+  "Unwind `gnus-article-buffer' if article editing was given up."
+  (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind)
+  (when mime-edit-mode-flag
+    (mime-edit-exit 'nomime 'no-error)
+    (message ""))
+  (when (featurep 'font-lock)
+    (setq font-lock-defaults nil)
+    (font-lock-mode 0)))
+
+(defun gnus-article-mime-edit-article-setup ()
+  "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode
+after replacing with the original article."
+  (setq gnus-show-mime t)
+  (setq gnus-article-edit-done-function
+	`(lambda (&rest args)
+	   (when mime-edit-mode-flag
+	     (mime-edit-exit)
+	     (message ""))
+	   (goto-char (point-min))
+	   (let (case-fold-search)
+	     (when (re-search-forward
+		    (format "^%s$" (regexp-quote mail-header-separator))
+		    nil t)
+	       (replace-match "")))
+	   (when (featurep 'font-lock)
+	     (setq font-lock-defaults nil)
+	     (font-lock-mode 0))
+	   (apply ,gnus-article-edit-done-function args)
+	   (set-buffer gnus-original-article-buffer)
+	   (erase-buffer)
+	   (insert-buffer gnus-article-buffer)
+	   (setq gnus-current-headers (gnus-article-make-full-mail-header))
+	   (gnus-article-prepare-display)))
+  (define-key (current-local-map) "\C-c\C-k" 'gnus-article-mime-edit-exit)
+  (erase-buffer)
+  (insert-buffer gnus-original-article-buffer)
+  (mime-edit-again)
+  (when (featurep 'font-lock)
+    (set (make-local-variable 'font-lock-defaults)
+	 '(message-font-lock-keywords t))
+    (font-lock-set-defaults)
+    (turn-on-font-lock))
+  (add-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind)
+  (gnus-run-hooks 'gnus-article-mime-edit-article-setup-hook))
+
+(defun gnus-article-mime-edit-exit ()
+  "Exit the article MIME editing without updating."
+  (interactive)
+  (let ((winconf gnus-prev-winconf)
+	buf)
+    (when mime-edit-mode-flag
+      (mime-edit-exit)
+      (message ""))
+    (goto-char (point-min))
+    (let (case-fold-search)
+      (when (re-search-forward
+	     (format "^%s$" (regexp-quote mail-header-separator)) nil t)
+	(replace-match "")))
+    (when (featurep 'font-lock)
+      (setq font-lock-defaults nil)
+      (font-lock-mode 0))
+    ;; We remove all text props from the article buffer.
+    (setq buf (format "%s" (buffer-string)))
+    (set-buffer (get-buffer-create gnus-original-article-buffer))
+    (erase-buffer)
+    (insert buf)
+    (setq gnus-current-headers (gnus-article-make-full-mail-header))
+    (gnus-article-prepare-display)
+    (set-window-configuration winconf)))
+
+;;;
 ;;; Article highlights
 ;;;
 
diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index d6e62bf..9af23d9 100644
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -948,14 +948,15 @@ this is a reply."
   (interactive "P")
   (gnus-summary-select-article t)
   (set-buffer gnus-original-article-buffer)
-  (gnus-setup-message 'compose-bounce
-    (let* ((references (mail-fetch-field "references"))
-	   (parent (and references (gnus-parent-id references))))
-      (message-bounce)
-      ;; If there are references, we fetch the article we answered to.
-      (and fetch parent
-	   (gnus-summary-refer-article parent)
-	   (gnus-summary-show-all-headers)))))
+  (let (gnus-message-setup-hook)
+    (gnus-setup-message 'compose-bounce
+      (let* ((references (mail-fetch-field "references"))
+	     (parent (and references (gnus-parent-id references))))
+	(message-bounce)
+	;; If there are references, we fetch the article we answered to.
+	(and fetch parent
+	     (gnus-summary-refer-article parent)
+	     (gnus-summary-show-all-headers))))))
 
 ;;; Gcc handling.
 
diff --git a/lisp/message.el b/lisp/message.el
index 738e4a3..e09f367 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -157,6 +157,11 @@ If this variable is nil, no such courtesy message will be added."
   :group 'message-interface
   :type 'regexp)
 
+(defcustom message-bounce-setup-function 'message-bounce-setup-for-mime-edit
+  "Function to setup a re-sending bounced message."
+  :group 'message-sending
+  :type 'function)
+
 ;;;###autoload
 (defcustom message-from-style 'default
   "*Specifies how \"From\" headers look.
@@ -483,6 +488,12 @@ the signature is inserted."
   :group 'message-various
   :type 'hook)
 
+(defcustom message-bounce-setup-hook nil
+  "Normal hook, run each time a a re-sending bounced message is initialized.
+The function `message-bounce' runs this hook."
+  :group 'message-various
+  :type 'hook)
+
 (defcustom message-mode-hook nil
   "Hook run in message mode buffers."
   :group 'message-various
@@ -4100,6 +4111,13 @@ Optional NEWS will use news to forward instead of mail."
       (kill-buffer (current-buffer)))
     (message "Resending message to %s...done" address)))
 
+(defun message-bounce-setup-for-mime-edit ()
+  (goto-char (point-min))
+  (when (search-forward (concat "\n" mail-header-separator "\n") nil t)
+    (replace-match "\n\n"))
+  (set (make-local-variable 'message-setup-hook) nil)
+  (mime-edit-again))
+
 ;;;###autoload
 (defun message-bounce ()
   "Re-mail the current message.
@@ -4139,6 +4157,9 @@ you."
       (message-remove-header message-ignored-bounced-headers t)
       (goto-char (point-max))
       (insert mail-header-separator))
+    (when message-bounce-setup-function
+      (funcall message-bounce-setup-function))
+    (run-hooks 'message-bounce-setup-hook)
     (message-position-point)))
 
 ;;;