;;;
;;;  gnus-cmail.el - reply and save articles using cmail
;;;                                            in GNUS newsreader.
;;;
;;;  GNUSでのリプライと記事の保存を、cmailで行うためのモジュール。
;;;
;;;  [使用法]
;;;     gnus-Article-prepare-hook または gnus-article-prepare-hook に
;;;     (lambda () (require 'gnus-cmail)) を追加する。
;;;
;;; by Tadashi Kobayashi, 1994/11/30
;;; patch by Kazutaka Shigeno, 1995/12/25
;;;

(provide 'gnus-cmail)

;;;  @ require modules
(require 'gnus)
(require 'cmail)

(defvar gnus-cmail-gnus3 (not (not (string-match "^GNUS [0-3]" gnus-version))))
(if (not (fboundp 'add-hook))
    (require 'tl-18)
  )
(let ((func (function
	     (lambda ()
	       (setq gnus-newsgroup-last-cmail nil)
	       )))
      )
  (if gnus-cmail-gnus3
      (add-hook 'gnus-Subject-prepare-hook func)
    (add-hook 'gnus-summary-prepare-hook func)
    (autoload 'cmail-prepare-caesar "cmail" nil t)
    (add-hook 'gnus-startup-hook 'cmail-prepare-caesar))
  )

(setq gnus-mail-reply-method
      (function gnus-mail-reply-using-cmail))
(setq gnus-mail-forward-method
      (function gnus-mail-forward-using-cmail))
(setq gnus-mail-other-window-method
      (function gnus-mail-other-window-using-cmail))
(setq gnus-default-article-saver
      (function gnus-Subject-save-in-cmail))

(defvar gnus-cmail-save-name (function gnus-cmail-file-name)
  "*A function generating a file name to save articles in cmail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
(defvar gnus-newsgroup-last-cmail nil)

(defun gnus-mail-reply-using-cmail (&optional yank)
  "Compose reply mail using cmail.
Optional argument YANK means yank original article."
  (set-buffer (if gnus-cmail-gnus3
		  gnus-Article-buffer
		gnus-article-buffer))
  (let (from cc subject date to reply-to
	     (buffer (current-buffer)))
    (save-restriction
      (narrow-to-region (point-min) (progn (goto-line (point-min))
					   (search-forward "\n\n")
					   (- (point) 1)))
      (setq from (mail-fetch-field "from")
	    subject (mail-fetch-field "subject")
	    reply-to (mail-fetch-field "reply-to")
	    date (mail-fetch-field "date"))
      (setq to from)
      (pop-to-buffer "*mail*")
      (cmail-mail
	    (if reply-to reply-to to)
	    subject
	    (let ((stop-pos (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
	      (concat (if stop-pos (substring from 0 stop-pos) from)
		      "'s message of "
		      date))
	    nil
	   buffer)))
  (if yank
      (let ((last (point)))
	(goto-char (point-max))
	(cmail-yank-original nil)
	(goto-char last)
	)))

(defun gnus-mail-forward-using-cmail (&optional buffer)
  "Forward the current message to another user using cmail."
  (set-buffer (if gnus-cmail-gnus3
		  gnus-Article-buffer
		(or buffer gnus-article-buffer)))
  (let ((forward-buffer (current-buffer))
	(subject
	 (concat "[" gnus-newsgroup-name "] "
		 ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
		 (or (gnus-fetch-field "Subject") ""))))
    ;; If only one window, use it for the mail buffer.
    ;; Otherwise, use another window for the mail buffer
    ;; so that the Rmail buffer remains visible
    ;; and sending the mail will get back to it.
    (let ((to (cmail-complete-field-to))
	  pt)
      (if (if (one-window-p t)
	      (cmail-mail to subject)
	    (cmail-mail-other-window to subject))
	  (set-buffer "*mail*")
	(save-excursion
	  (insert (car cmail-forwarded-mail-border-cons))
	  (setq pt (point))
	  (save-restriction
	    (save-excursion
	      (set-buffer forward-buffer)
	      (widen))
	    (insert-buffer forward-buffer))
	  (exchange-point-and-mark)
	  (cmail-rfc934-char-stuff-region pt (point))
	  (insert (cdr cmail-forwarded-mail-border-cons))
	  (exchange-point-and-mark))
	(run-hooks 'gnus-mail-forward-hook)))))

(defun gnus-mail-other-window-using-cmail ()
  "Compose mail other window using cmail."
  (interactive)
  (let* ((to (cmail-complete-field-to))
	 (subject (read-string "Subject: ")))
    (cmail-mail-other-window to subject)))

(defun cmail-mail-other-window (user subject &optional reply cc replybuffer)
  "Send mail by cmail-mail in another windoow."
  (interactive (list
		(cmail-complete-field-to)
		(read-string "Subject")))
  (let ((pop-up-windows t))
    (pop-to-buffer "*mail*"))
  (cmail-mail user subject reply cc replybuffer))

(defun gnus-cmail-file-name (newsgroup headers &optional last-file)
  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
If variable `gnus-use-long-file-name' is nil, it is ~/Mail/News.group.
Otherwise, it is like ~/Mail/news/group/news."
  (or last-file
      newsgroup))

(defun gnus-Subject-save-in-cmail (&optional filename)
  "Append this article to cmail file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory' which
is initialized from the SAVEDIR environment variable."
  (interactive)
  (require 'cmail)
  (let (article-buffer-name)
    (if gnus-cmail-gnus3
	(progn
	  (gnus-Subject-select-article gnus-save-all-headers
				       gnus-save-all-headers)
	  (setq article-buffer-name gnus-Article-buffer))
      (setq article-buffer-name gnus-article-buffer)
      (gnus-summary-select-article gnus-save-all-headers
				   gnus-save-all-headers))
    (gnus-eval-in-buffer-window article-buffer-name
     (save-excursion
      (save-restriction
	(widen)
	(let ((default-name
		(funcall gnus-cmail-save-name
			 gnus-newsgroup-name
			 gnus-current-headers
			 gnus-newsgroup-last-cmail
			 )))
	  (or filename
	      (setq filename
		    (cmail-complete-foldername
		     "Save article in cmail folder"
		     default-name)))
	  (gnus-make-directory (file-name-directory
				(expand-file-name filename cmail-path)))
	  (cmail-output filename)
	  ;; Remember the directory name to save articles.
	  (setq gnus-newsgroup-last-cmail filename)
	  )))
    )))

(defun cmail-output (file-name)
  "Append this message to cmail file named FILE-NAME."
  (let ((cmailbuf (current-buffer))
	(tembuf (get-buffer-create " cmail-output"))
	(case-fold-search t))
    (save-excursion
      (set-buffer tembuf)
      (erase-buffer)
      (cmail-insert-buffer-substring cmailbuf)
      (insert "\n")
      (encode-coding-region (point-min) (point-max)
			    *cmail-primary-coding-system)
      (goto-char (point-min))
      (insert "From "
	      (if (mail-fetch-field "from")
		  (mail-strip-quoted-names (mail-fetch-field "from"))
		"unknown")
	      " " (current-time-string) "\n")
      (insert-string "X-cmail-status: Active\n")
      ;; ``Quote'' "\nFrom " as "\n>From "
      ;;  (note that this isn't really quoting, as there is no requirement
      ;;   that "\n[>]+From " be quoted in the same transparent way.)
      (while (search-forward "\nFrom " nil t)
	(forward-char -5)
	(insert ?>))
      (goto-char (point-max))
      (insert "\n" *cmail-borderline)
      (cmail-append-mail-to-folder (current-buffer) file-name)
      (if (string= file-name cmail-current-folder)
	  (progn
	    (cmail-save-folder file-name)
	    (cmail-make-summary file-name))
	(cmail-dismiss-folder file-name)))
    (kill-buffer tembuf)))
