[Mew-dist 489] Re: gnus(v5.2.40) de Mew

[SAKAI Kiyotaka]

>> In article <19970213085529B/tamura at example.com>, tamura at example.com (田村　進司 ) writes:

> もし、Mew 1.54 に付いている物と別物ならば、非常にお手数ですが、送って
> もらえないでしょうか？

以前に流れた中島さんのパッチも含めて、少し update してみました。
-- 
酒井 清隆 (E-mail: ksakai at example.com)

-------------- next part --------------
;;
;; Temporary solution to link Mew to Gnus.
;; This code will be obsolated because Mew supports USENET news soon.
;;
;;  (add-hook
;;   'gnus-summary-mode-hook
;;   (function
;;    (lambda ()
;;      (require 'mew-gnus)
;;      (define-key gnus-summary-mode-map "r" 'mew-gnus-reply)
;;      (define-key gnus-summary-mode-map "R" 'mew-gnus-reply-with-citation)
;;      (define-key gnus-summary-mode-map "f" 'mew-gnus-mail-forward))))
;;  (setq gnus-default-article-saver 'gnus-summary-save-in-mew)
;;

(eval-when-compile 
  (require 'gnus))

(require 'mew)

(defvar mh-lib "/usr/local/lib/mh")

(defvar mew-gnus-save-fixed-folder nil)

(defun gnus-summary-save-in-mew (&optional folder)
  "Save this article to MH folder (using `rcvstore' in MH library).
Optional argument FOLDER specifies folder name."
  (interactive)
  (let ((gnus-show-mime nil))
    (gnus-summary-select-article t t))  ;; force to display all headers
  (gnus-eval-in-buffer-window gnus-article-buffer
    (save-restriction
      (widen)
      (or mew-folder-alist
	  (setq mew-folder-list (mew-folder-make-list)
		mew-folder-alist (mew-folder-make-alist mew-folder-list)))
      (let ((folder
	     (or folder
		 (mew-input-folder
		  (or mew-gnus-save-fixed-folder
		      (car (mew-guess-by-alist))
		      (concat "+" gnus-newsgroup-name)))))
	    (errbuf (get-buffer-create " *GNUS rcvstore*")))
	(if (not (equal (aref folder 0) ?+))
	    (message (format 
		      "First letter of '%s' must be '+'."
		      folder))
	  (unwind-protect
	      (call-process-region (point-min) (point-max)
				   (expand-file-name "rcvstore" mh-lib)
				   nil errbuf nil folder)
	    (set-buffer errbuf)
	    (if (zerop (buffer-size))
		(message "Article saved in folder: %s" folder)
	      (message "%s" (buffer-string)))
	    (kill-buffer errbuf)))))))

(defun mew-gnus-reply (&optional yank)
  "Reply or followup to GNUS article using mew.
Optional argument YANK means yank original article."
  (interactive)
  (let (from cc subject date to reply-to newsgroups)
    (if (null mew-path) (mew-init))
    (mew-current-set 'window (current-window-configuration))
    (delete-other-windows)
    (gnus-summary-display-article (gnus-summary-article-number) t) ;; redisplay
    (pop-to-buffer gnus-article-buffer)
    (search-forward "\n\n" nil t)
    (push-mark)
    (goto-char (point-max))
    (let ((split-window-keep-point t))
      (split-window-vertically))
    (other-window 1)
    (gnus-article-show-all-headers)
    (setq from (gnus-fetch-field "From")
	  subject (let ((subject (gnus-fetch-field "Subject")))
		    (if (and subject
			     (not (string-match "^[Rr][Ee]:.+$" subject)))
			(concat "Re: " subject) subject))
	  reply-to (gnus-fetch-field "Reply-to")
	  cc (gnus-fetch-field "Cc")
	  newsgroups (or (gnus-fetch-field "Followup-To")
			 (gnus-fetch-field "Newsgroups"))
	  date (gnus-fetch-field "Date"))
    (setq to (or reply-to from))
    (mew-summary-send t to (or cc "") subject)
    (save-excursion
      (goto-char (point-min))
      (insert (concat "Newsgroups: " newsgroups "\n")))
    (make-variable-buffer-local 'mew-message-citation-buffer) 
    (setq mew-message-citation-buffer gnus-article-buffer))
  (if yank (mew-draft-cite)))

(defun mew-gnus-reply-with-citation ()
  "Reply or followup to GNUS article using mew.
Original article is yanked automatically."
  (interactive)
  (mew-gnus-reply t))

(defun mew-gnus-mail-forward (&optional buffer)
  "Forward the current message to another user using mew."
  (interactive)
  (or (bufferp mew-buffer-tmp)
      (save-excursion
	(mew-set-environment)))
  (mew-current-set 'window (current-window-configuration))
  (pop-to-buffer (or (and (boundp 'gnus-original-article-buffer)
			  gnus-original-article-buffer)
		     gnus-article-buffer))
  (let* ((subject (concat "[" gnus-newsgroup-name "] "
			  (or (gnus-fetch-field "subject") "")))
	 (file (mew-draft-get-new))
	 (mimefolder (mew-draft-to-mime file))
         (mimedir (mew-expand-file-name mimefolder)))
    (if (null (file-directory-p mimedir))
        (mew-make-directory mimedir)
      (if (null (mew-directory-empty-p mimedir))
          (if (mew-y-or-n-p (format "Mime folder %s is not empty. Delete it? "
				    mimefolder))
              (progn
                (call-process "rm" nil nil nil "-rf" mimedir)
                (mew-make-directory mimedir)))))
    (unwind-protect
	(progn
	  (write-region (point-min) (point-max) (mew-draft-get-new mimefolder))
	  (let ((split-window-keep-point t))
	    (split-window-vertically))
	  (switch-to-buffer-other-window (find-file-noselect file))
	  (mew-draft-rename file)
	  (mew-draft-header subject 'nl)
	  (mew-draft-mode)
	  (setq mew-encode-syntax
		(mew-encode-syntax-initial-multi
		 (file-name-nondirectory mimedir) 1))
	  (save-excursion
	    (mew-draft-prepare-attachments)))
      (save-buffer))) ;; to make sure no to use this draft again
  (message "Draft is prepared"))

(provide 'mew-gnus)
;;; mew-gnus.el ends here