;;;
;;;  cmail-trans.el - mail saving and folder converting
;;;
;;;  $Author: tmp $
;;;  created at: Mon Jul 12 10:31:28 JST 1993
;;;
;;;  Copyright (C) 1992-1996 Yukihiro Matsumoto.

;; This file is not part of GNU Emacs but obeys its copyright notice.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

(require 'cmail)
(provide 'cmail-trans)

;;
;; メイルファイルのコンバート関係
;;

;; ++++ mbox形式からのコンバート(interactive) ++++++++++++++++++++++++++++++++
(defun cmail-m2c (file)
  "mbox形式のメイルファイルFILEを, 新着メイルとして各フォルダに振り分ける."
  (interactive
   (list (cmail-complete-filename (cmail-get-resource 'm2c-1) "mbox")))
  (let ((nabf (set-buffer (get-buffer-create *cmail-new-arrivals-buffer)))
	(fld (cmail-complete-foldername (cmail-get-resource 'm2c-2)
					cmail-inbox-folder))
	(cnt 0))
    (cmail-open-folder fld)
    (cmail-message-resource 'm2c-3)
    (set-buffer nabf)
    (erase-buffer)
    (let ((jam-code-guess-input-coding-system *cmail-file-coding-system)
	  mc-flag
	  kanji-fileio-code) ; NEmacs 用
      (as-binary-input-file
       (insert-file-contents file))
      (while (re-search-forward "\r$" nil t)
	(replace-match "")))
    (goto-char (point-min))
    (setq cnt (cmail-get-articles-from-newmail nabf fld))
    (message (cmail-format-resource 'm2c-4 cnt
				    (cmail-get-resource (if (= 1 cnt)
							    'm2c-5
							  'm2c-6))))
    (if cmail-delete-file-after-conversion
        (delete-file file))
    (cmail-visit-folder fld)))
;; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

;; ---- RMAIL形式からのコンバート -----------------------------------------
(defun cmail-r2c (file)
  "rmail形式のメイルファイルFILEを新着メイルとして, 各フォルダに振り分ける."
  (interactive
   (list (cmail-complete-filename (cmail-get-resource 'r2c-1) "RMAIL")))
  (let* ((inhibit-local-variables t)
	 (enable-local-variables nil)
	 (rmbf (get-buffer-create " *cmail-r2c-work"))
	 (nabf (get-buffer-create *cmail-new-arrivals-buffer))
	 (fld (cmail-complete-foldername (cmail-get-resource 'r2c-2)
					 cmail-inbox-folder))
	 (beg 0)
	 (end 0)
	 (hbeg 0))
    (save-excursion
      (cmail-message-resource 'r2c-3)
      (set-buffer rmbf)
      (erase-buffer)
      (let ((jam-code-guess-input-coding-system *cmail-file-coding-system)
	    mc-flag
	    kanji-fileio-code) ; NEmacs 用
	(as-binary-input-file
	 (insert-file-contents file))
	(while (re-search-forward "\r$" nil t)
	  (replace-match "")))
      (set-buffer nabf)
      (erase-buffer)
      (set-buffer rmbf)
      (widen)
      (goto-char (point-min))
      (if (not (re-search-forward "^BABYL" nil t))
	  (cmail-error-resource1 'r2c-4 file))
      (while (re-search-forward "^\^_\^L" nil t)
	(save-excursion
	  (re-search-forward "^\^_" nil t)
	  (beginning-of-line)
	  (setq end (point)))
	(forward-line 2)
	(if (re-search-forward "^Summary-line: " end t)
	    (forward-line 1))
	(beginning-of-line)
	(setq beg (point))
	(let ((head1end (progn
			  (re-search-forward "^*** EOOH ***" end t)
			  (beginning-of-line)
			  (point)))
	      (head2end (progn
			  (re-search-forward "\n\n" end t)
			  (point))))
	  (if (> (count-lines beg head1end)
		 (count-lines head1end head2end))
	      nil
	    (goto-char head1end)
	    (forward-line 1)
	    (setq beg (point))))
	(set-buffer nabf)
	(setq hbeg (point))
	(insert-string "From someone\n")
	(cmail-insert-buffer-substring rmbf beg end)
	(insert-string "\n")
	(goto-char hbeg)
	(if (not (re-search-forward "^*** EOOH ***" nil t)) nil
	  (beginning-of-line)
	  (setq hbeg (point))
	  (search-forward "\n\n" (point-max) t)
	  (delete-region hbeg (point)))
	(goto-char (point-max))
	(set-buffer rmbf))
      (cmail-message-resource 'r2c-5)
      (goto-char (point-min))
      (kill-buffer rmbf)
      (setq beg (cmail-get-articles-from-newmail nabf fld))
      (kill-buffer nabf)
      (message (cmail-format-resource 'r2c-6 beg
				      (cmail-get-resource (if (= 1 beg)
							      'r2c-7 'r2c-8)))))
    (if cmail-delete-file-after-conversion
        (delete-file file))
    (cmail-visit-folder fld)))
;; ------------------------------------------------------------------------

;; ==== あるフォルダをmbox形式にコンバートする ============================
(defun cmail-c2m (folder file)
  "FOLDERをmbox形式に変換し, FILEに追加する."
  (interactive
   (let* ((pmt (cmail-get-resource 'c2m-1))
	  (fdr (cmail-complete-foldername pmt cmail-current-folder t))
	  (pmt (cmail-format-resource 'c2m-2 pmt fdr))
	  (fl (cmail-complete-filename pmt)))
     (list fdr fl)))
  (cmail-message-resource 'c2m-3)
  (let* ((beg 0)
	 (end 0)
	 (inhibit-local-variables t)
	 (enable-local-variables nil)
	 (mbbf (find-file-noselect file))
	 (fdbf (progn (cmail-open-folder folder)
		      (get-buffer (cmail-folder-buffer folder)))))
    (cmail-get-folder)
    (cmail-n-page 1)
    (setq beg (point))
    (while (re-search-forward *cmail-re-bln nil t)
      (forward-line -1)
      (setq end (point))
      (if (eq beg end)
	  (forward-line 1)
	(cmail-convert-into-mbox fdbf beg end mbbf)
	(forward-line 1))
      (setq beg (point)))
    (set-buffer mbbf)
    (cmail-save-buffer)
    (kill-buffer mbbf)
    (cmail-message-resource 'c2m-4)))

(defun cmail-convert-into-mbox (folderbuffer start end mboxbuffer)
  "FOLDERBUFFERのポイントBEGからENDまでをMBOXBUFFERにmbox形式にして入れる.
呼び出す時点のバッファはFOLDERBUFFERである必要がある."
  (let ((from nil) ; mail doesn't have a From line
	border)
    (goto-char start)
    (save-excursion
      (if (re-search-forward "^From " (cmail-head-max) t)
	  (let ((beg (progn (beginning-of-line) (point)))
		(end (progn (end-of-line) (point))))
	    (setq from t)
	    (setq border (format "%s\n" (buffer-substring beg end))))))
    (if (null from)
	(setq border
	      (format "From %s %s\n"
		      (or (cmail-get-field-values "Return-Path")
			  (cmail-get-field-values "From")
			  "someone")
		      (or (cmail-get-field-values "Date")
			  "someday"))))
    (set-buffer mboxbuffer)
    (goto-char (point-max))
    (if (null from) (insert-string border))
    (cmail-insert-buffer-substring folderbuffer start end)
    (goto-char (point-min))
    (if (and (boundp 'cmail-content-supply-function)
	     (functionp cmail-content-supply-function))
	(funcall cmail-content-supply-function))
    (let ((tmpbuf (current-buffer)))
      (if (eq tmpbuf mboxbuffer)
	  nil
	(copy-to-buffer mboxbuffer (point-min) (point-max))))
    (goto-char (point-max))
    (insert-string "\n")
    (set-buffer folderbuffer)
    (goto-char end)))
;; ==========================================================================

;;
;; メイルのセーブ
;;

;; ==== mbox形式でカーソル行のメイルをセーブする(interactive) ===============
(defvar *cmail-last-save-mbox nil)
(defun cmail-save-mail-as-mbox (filename)
  "カーソル行のmailをFILENAMEにmbox形式でアペンドする."
  (interactive
   (list (cmail-complete-filename (cmail-get-resource 'save-mail-as-mbox-1)
				  *cmail-last-save-mbox)))
  (setq *cmail-last-save-mbox *cmail-save-to-name)
  (cmail-fixcp)
  (save-excursion
    (cmail-exec '(lambda (page)
		   (cmail-show-contents page)
		   (cmail-save-mail-as-mbox-call filename page))))
  (cmail-message-resource 'save-mail-as-mbox-2))

(defun cmail-save-mail-as-mbox-call (filename page)
  (save-excursion
    (let ((page-delimiter *cmail-re-bdr)
	  (beg 0)
	  (end 0)
	  (nabf (save-excursion
		  (set-buffer (get-buffer-create *cmail-new-arrivals-buffer))
		  (erase-buffer)
		  (current-buffer)))
	  (fdbf (set-buffer (cmail-folder-buffer cmail-current-folder))))
      (goto-char (point-min))
      (while (> page 0)
	(re-search-forward *cmail-re-bln nil t)
	(setq page (1- page)))
      (setq beg (point))
      (re-search-forward *cmail-re-bln nil t)
      (forward-line -1)
      (setq end (point))
      (cmail-convert-into-mbox fdbf beg end nabf)
      (set-buffer nabf)
      (as-binary-output-file
       (append-to-file (point-min) (point-max) filename)))))

;; ==========================================================================

;; ---- カーソル行のmailをセーブする(interactive) ---------------------------
(defvar *cmail-last-save-file nil)
(defun cmail-save-mail (filename)
  "カーソル行のmailをFILENAMEにアペンドする."
  (interactive
   (let* ((pg (cmail-get-page-number-from-summary))
	  (exfl (cmail-complete-filename (cmail-get-resource 'save-mail-1)
					 *cmail-last-save-file)))
     (list exfl)))
  (setq *cmail-last-save-file *cmail-save-to-name)
  (cmail-fixcp)
  (let ((page-delimiter *cmail-re-bdr))
    (save-excursion
      (cmail-exec '(lambda (page)
		     (cmail-show-contents page)
		     (cmail-save-mail-call filename)))))
  (cmail-message-resource 'save-mail-2))

(defun cmail-save-mail-call (filename)
  (save-excursion
    (set-buffer *cmail-mail-buffer)
    (append-to-file (point-min) (point-max) filename)))
;; --------------------------------------------------------------------------
