;;;
;;;  cmail-archive.el - utility functions for archiving
;;; 
;;;  $Author: tmp $
;;;  created at: Fri May 27 13:33:49 JST 1994
;;;
;;;  Copyright (C) 1992-1996 Yukihiro Matsumoto.

;; cmail-archive.el
;; mail を送信する時に、cmail-archive-folder で指定された folder に
;; cmail 形式で自動的に記録が残ります。

;; Change Log:
;; 1994年5月27日 nao
;;     quick hack をもとに、ファイルを構築。
;; 1994年5月28日 nao
;;     cmail-archive-from を追加。
;;     robust にするための細かい修正。
;; 1994年6月1日 nao
;;     bug fix--date command!
;; 1994年6月1日 nagano@rd.yahata.enicom.nsc.co.jp
;;     sendmail.el のインプリメントに依存していた部分を修正。
;;     cmail への組み込み 
;;     ( 以後、cmail の ChangeLog へ )

;; 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.

; cmail-vars.el
;(defvar cmail-use-send-mail-archive nil 
;  "送信したメイルのログを指定したフォルダに残すかどうか.")

(defvar cmail-archive-folder "archive"
  "*送信したメイルを保存するためのフォルダ名または、フォルダ名を返す関数。")

(defvar cmail-archive-from nil
  "*保存される From: 行の内容。nil の場合には、(user-login-name) を使う。")

;;; Code:
(provide 'cmail-archive)

(defun cmail-archive ()
  (let (day month date time timezone year folder limit
	    (buffer (current-buffer)))
    (goto-char (point-min))
    (set-buffer (get-buffer-create *cmail-arrived-mail-buffer))
    (widen)
    (erase-buffer)
    (cmail-set-buffer-multibyte t)
    (insert (current-time-string))
    (goto-char (point-min))
    (re-search-forward 
     "\\(\\w+\\) \\(\\w+\\) +\\(\\w+\\) \\([^ ]+\\) \\(\\w+\\)")
    (setq day (buffer-substring (match-beginning 1) (match-end 1)))
    (setq month (buffer-substring (match-beginning 2) (match-end 2)))
    (setq date (buffer-substring (match-beginning 3) (match-end 3)))
    (setq time (buffer-substring (match-beginning 4) (match-end 4)))
    (setq year (buffer-substring (match-beginning 5) (match-end 5)))
    (if (fboundp 'current-time-zone)
	(setq timezone (nth 1 (current-time-zone)))
      (setq timezone "GMT"))
    (erase-buffer)
    (insert-buffer buffer)
    (goto-char (point-min))
    (re-search-forward (concat "^" mail-header-separator "$") nil nil)
    (replace-match "")
    (setq limit (point-marker))
    (goto-char (point-min))
    (if (null (re-search-forward "^From: " limit t))
	(let (from)
	  (if (functionp cmail-archive-from)
	      (save-restriction
		(narrow-to-region (point-min) limit)
		(goto-char (point-min))
		(setq from (funcall cmail-archive-from)))
	    (setq from cmail-archive-from))
	  (if (null from) (setq from (user-login-name)))
	  (beginning-of-line)
	  (insert "From: " from "\n")))
    (goto-char (point-min))
    (if (null (re-search-forward "^Date: " limit t))
	(insert 
	 (format "Date: %s, %s %s %s %s %s\n" 
		 day date month 
		 (if (> (length year) 2) (substring year -2) year )
		 time timezone)))
    (goto-char (point-min))
    (insert "From " (user-login-name)
	    (format " %s %s %s %s %s\n" day month date time year))
    (insert-string "X-cmail-status: Active\n")
    (setq folder
	  (cond ((functionp cmail-archive-folder)
		 (save-restriction
		   (narrow-to-region (point-min) limit)
		   (goto-char (point-min))
		   (funcall cmail-archive-folder)))
		(t cmail-archive-folder)))
    (cond ((stringp folder)
	   (encode-coding-region (point-min) (point-max)
				 *cmail-primary-coding-system)
	   (goto-char (point-max))
	   (insert "\n" *cmail-borderline)
	   (cmail-append-mail-to-folder (current-buffer) folder)
	   (cmail-save-folder folder)
	   (if (string= folder cmail-current-folder)
	       (cmail-make-summary folder))))
    (set-marker limit nil)
    (set-buffer buffer))
  )

;;; cmail-archive.el ends here
