;;;
;;;  cmail.el - a mail utility for GNU Emacs
;;;
;;;  $Author: tmp $
;;;  $Revision: 1.7 $
;;;  $Date: 2002/10/12 14:25:58 $
;;;  created at: Mon Jul 12 10:09:15 JST 1993
;;;
;;;  Copyright (C) 1992-1998 Yukihiro Matsumoto

;;; cmail.el	フォルダ式メイル管理システム
;;;			- formerly known as chain-mail
;;; このシステムは, ユーザの規定するディレクトリにいくつかのフォ
;;; ルダを用意し, メイルを類別管理することを可能にしたシステムで
;;; す. フォルダは1つのファイルで, そのファイルはメイルが幾つか連
;;; なったものです.
;;; フォルダの先頭には, インデックス領域があり, そこにメイル1つ1つ
;;; のサマライズされた情報が1行ずつ収められています.
;;; 圧縮されたフォルダも扱うことができます(要jam-zcat.el).

;; 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-version)
(defun cmail-version ()
  (interactive)
  (if (interactive-p)
      (message "cmail - version %s" cmail-version))
  cmail-version)

(provide 'cmail)

(require 'cl)
(require 'emu)

(require 'cmail-vars)
(require 'cmail-modes)
(require 'cmail-summary)
(require 'cmail-misc)
(require 'cmail-reply)
(require 'cmail-thread)
(require 'cmail-resource)

(if (or cmail-mime-decode cmail-mime-encode)
    (require 'cmail-mime)
  (setq cmail-use-mime nil)
  (setq cmail-mime-decode nil)
  (setq cmail-mime-encode nil))

(if cmail-use-mailcrypt
    (require 'cmail-crypt))

(if (>= (string-to-int emacs-version) 20)
    (require 'cmail-20)
  (if (>= (string-to-int emacs-version) 19)
      (require 'cmail-19)))

(require 'cmail-folders)

(autoload 'cmail-edit "cmail-edit" nil t)
(autoload 'cmail-edit-index "cmail-edit" nil t)
(autoload 'cmail-r2c "cmail-trans" nil t)
(autoload 'cmail-m2c "cmail-trans" nil t)
(autoload 'cmail-c2m "cmail-trans" nil t)
(autoload 'cmail-save-mail-as-mbox "cmail-trans" nil t)
(autoload 'cmail-save-mail "cmail-trans" nil t)
(autoload 'cmail-pipe "cmail-trans" nil t)
(autoload 'cmail-burst-digest "cmail-digest" nil t)
(autoload 'cmail-send-digest "cmail-digest" nil t)

(autoload 'cmail-summary-search-article-forward "cmail-search" nil t)
(autoload 'cmail-summary-search-article-backward "cmail-search" nil t)
(autoload 'cmail-summary-isearch-article "cmail-search" nil t)

(defvar *cmail-window-conf nil)

;; ==== 鎖かたびらへの入口 =================================================
(defun cmail (&optional confirm)
  "フォルダ式メイル管理システムcmailを起動する.
prefix引数を指定した場合は, 新着メイルの有無を確認せずに,
指定されたフォルダを開く."
  (interactive "P")
  (if (functionp 'cmail-custom-init) (cmail-custom-init))
  (or cmail-use-full-window
      (setq *cmail-window-conf (current-window-configuration)))
  (cmail-start confirm)
  (and (not confirm) cmail-use-folders-mode-first
       (cmail-folders nil t confirm)))

(defun cmail-start (&optional confirm)
  (and *cmail-opened-folders-list (cmail-sync-headers))
  (or *cmail-folders-cache-alist
      (cmail-folders-load-cache))
  (let (folder)
    (if confirm
	(setq folder (if (stringp confirm)
			 confirm
		       (cmail-complete-foldername (cmail-get-resource 'start-1)
						  cmail-inbox-folder t)))
      (if (cmail-command-line-p)
	  (progn
	    (setq folder (car command-line-args-left))
	    (setq command-line-args-left (cdr command-line-args-left)))))
    (if (null folder)
	(progn
	  (cmail-delete-bk-files cmail-path)
	  (cmail-get-spooled-mail)
	  (setq *cmail-summary-limit nil)
	  (setq folder cmail-inbox-folder)))
    (setq *cmail-folder-list nil)
    (setq *cmail-current-folder "")
    (setq *cmail-current-page 0)
    (if confirm
	(cmail-visit-folder folder) ;; limitを尋ねる.
      (if (and (boundp 'cmail-folders-update-function)
	       (functionp cmail-folders-update-function))
	  (let ((updated-folders (funcall cmail-folders-update-function)))
	    (if cmail-archive-on-get
		(while updated-folders
		  (cmail-make-summary (car updated-folders))
		  (cmail-auto-archive nil t)
		  (setq updated-folders (cdr updated-folders))))))
      (setq *cmail-folder-curpos nil)
      (cmail-make-summary folder)
      (cmail-expand-summary-window)
      (and cmail-archive-on-get
;;	   (null (cmail-command-line-p))
	   (cmail-auto-archive))))
  (run-hooks 'cmail-startup-hook))

;; ---- 新しいメイルの取得 ------------------------------------------------
(defun cmail-summary-get-newmail ()
  (interactive)
  (if (and cmail-use-folders-mode-first cmail-archive-on-get)
      (progn
	(setq *cmail-prev-folder cmail-current-folder)
	(cmail-folders-get-newmail))
    (if (not (and (boundp 'cmail-summary-message-fetch-function)
		  (functionp cmail-summary-message-fetch-function)
		  (funcall cmail-summary-message-fetch-function)))
	(if (cmail-get-newmail)
	    (cmail-make-summary cmail-inbox-folder)
	  (cmail-message-resource 'get-spooled-mail-9)))))

(defun cmail-get-newmail ()
  "新着メイルを取ってくる."
  (interactive)
;;  (cmail-select-buffer *cmail-summary-buffer)
  (if (equal cmail-current-folder cmail-inbox-folder)
      nil
    (set-buffer *cmail-summary-buffer)
    (cmail-save-curpos))
  (setq *cmail-current-folder "")
  (let ((get (cmail-get-spooled-mail)))
    (if get
	(if (and cmail-use-folders-mode-first
		 (not (string= cmail-current-folder cmail-inbox-folder)))
	    (progn
	      (setq *cmail-prev-folder cmail-current-folder)
	      (cmail-folders)
	      (and (null cmail-archive-on-get)
		   (cmail-folders-visit-sub-folder cmail-inbox-folder)))
	  (if (string= cmail-current-folder cmail-inbox-folder)
	      (and (integerp *cmail-summary-limit)
		   (setq *cmail-summary-limit (1+ *cmail-summary-limit)))
	    (setq *cmail-summary-limit nil)
	    (or (cmail-virtual-folder-p cmail-current-folder)
		(setq *cmail-prev-folder cmail-current-folder)))
	  (and cmail-archive-on-get
	       (cmail-auto-archive))))
    get))

(defun cmail-check-crash-box ()
  (let ((size (nth 7 (file-attributes *cmail-crash-box))))
    (and size
	 (or (not (integerp cmail-max-crash-box-size))
	     (<= size cmail-max-crash-box-size)
	     (yes-or-no-p (format (cmail-get-resource
				   'get-spooled-mail-10) size))
	     (error "%s" (cmail-get-resource 'get-spooled-mail-11))))))

(defun cmail-get-spooled-mail ()
  "スプールからメイルを取ってくる."
  (let ((inhibit-quit t)
	(account-list (cmail-normalize-account-info))
	(mails 0))
    (cmail-open-folder cmail-inbox-folder)
    (if (cmail-check-crash-box)
	(progn
	  (cmail-message-resource 'get-spooled-mail-1)
	  (setq mails (cmail-gobble-crash-box))
	  (cmail-message-resource 'get-spooled-mail-2)))
    (while account-list
      ;; fetch message with specified protocol with
      ;; corresponding protocol handler.
      (cmail-fetch-messages *cmail-crash-box (car account-list))

      ;; convert format and add it to cmail inbox
      (if (cmail-check-crash-box)
	  (setq mails (+ mails (cmail-gobble-crash-box))))
      (setq account-list (cdr account-list)))
;;; imap4 mod: misleading to show this message when new mail
;;; is retrieved from some imap4 servers.
;;;    (if (= mails 0)
;;;	(cmail-message-resource 'get-spooled-mail-9))
    (> mails 0)))

(defun cmail-gobble-crash-box ()
  "クラッシュボックス(一時ファイル)からメイルを取り出し, INBOXへ格納する."
  (let ((nabf (get-buffer-create *cmail-new-arrivals-buffer))
	(*cmail-confirm-new-folder nil) cnt)
    (set-buffer nabf)
    (erase-buffer)
    (cmail-set-buffer-multibyte nil)
    (let ((jam-code-guess-input-coding-system *cmail-file-coding-system))
      (as-binary-input-file
       (insert-file-contents *cmail-crash-box))
      (while (re-search-forward "\r$" nil t)
	(replace-match "")))
    (run-hooks 'cmail-get-new-mail-hook)
    (setq cnt (cmail-get-articles-from-newmail nabf))
    (kill-buffer nabf)
    (and cmail-archive-on-get (cmail-flush-folders))
    (condition-case ()
	(delete-file *cmail-crash-box) (error nil))
    cnt))

(defun cmail-get-articles-from-newmail (buffer &optional folder)
  "BUFFERから個々のメイルを抜き出す."
  (if (null folder)
      (setq folder cmail-inbox-folder))
  (set-buffer buffer)
  (if (= (buffer-size) 0)
      0
    (goto-char (point-min))
    (let ((cnt 0) (case-fold-search nil) beg end s
	  d1     ;; delimiter1
	  d2     ;; delimiter2
	  fline) ;; t if leaves `From' line
      (cond
       ((looking-at "From ")
	(setq d1 "^From "
	      d2 "\n\nFrom "
	      fline t))
       ((looking-at "\^L\n0, unseen,,\n")
	(setq d1 "\^L\n0, unseen,,\n"
	      d2 "\n\^_"))
       ((looking-at "^\001\001\001\001\n")
	(setq d1 "^\001\001\001\001\n"
	      d2 "\n\001\001\001\001\n"))
       (t (error "non-supported MAILBOX format")))
      (while (re-search-forward d1 nil t)
	(setq beg (progn
		    (if fline (beginning-of-line))
		    (point)))
	(setq end (progn
		    (forward-line 1)
		    (if (and fline
			     (eq cmail-mbox-format 'mboxcl2))
			(let ((case-fold-search t)
			      header-end)
			  (re-search-forward "^$" nil t)
			  (setq header-end (point))
			  (if (re-search-backward
			       "^content-length:[ \t]+\\([0-9]+\\)"
			       beg t)
			      (goto-char
			       (+ header-end
				  (string-to-int (match-string 1)))))))
		    (if (search-forward d2 nil t)
			(let ((pos (match-beginning 0)))
			  (goto-char pos)
			  (1+ pos))
		      (point-max))))
	(goto-char end)
	(setq cnt (1+ cnt))
	(set-buffer (get-buffer-create *cmail-arrived-mail-buffer))
	(widen)
	(erase-buffer)
	(cmail-set-buffer-multibyte nil)
	(cmail-insert-buffer-substring buffer beg end)
	(goto-char (point-min))
	(while (re-search-forward *cmail-re-bdr nil t)
	  ;;デコード(ボーダと間違わないようにするため)
	  (replace-match *cmail-decoded-border t t))
	(goto-char (point-max))
	(delete-blank-lines)
	(insert *cmail-borderline)
      (goto-char (point-min))
      (cmail-set-mail-status-if-missing '("Unread"))
      (setq s (cmail-append-mail-to-folder *cmail-arrived-mail-buffer folder))
      (if cmail-incoming-mails-folder
          (let ((*cmail-confirm-new-folder nil))
            (cmail-append-mail-to-folder *cmail-arrived-mail-buffer
                                         cmail-incoming-mails-folder s)))
      (set-buffer buffer))
      (cmail-sync-header cmail-incoming-mails-folder)
      (cmail-get-folder cmail-incoming-mails-folder)
      (cmail-save-buffer)
      (cmail-sync-header folder)
      (if (cmail-virtual-folder-p folder)
	  nil
	(cmail-get-folder folder)
	(cmail-save-buffer))
      (kill-buffer *cmail-arrived-mail-buffer)
      cnt)))

;; ---- プロトコル取込み関数のテーブル操作関数 -------------------------
(defconst *cmail-fetch-default-handlers
  '((local-file . cmail-movemail-spool)
    (pop3 . cmail-movemail-pop3)))

(defvar *cmail-fetch-handlers
  (mapcar (function (lambda (element) (cons (car element) (cdr element))))
	  *cmail-fetch-default-handlers))

(defun cmail-fetch-messages (crash-box account-spec)
  (let ((handler (cdr (assoc (car account-spec) *cmail-fetch-handlers))))
    (if handler
	(apply handler (list crash-box account-spec)))))

(defun cmail-add-fetch-handler (proto-label handler-function)
  (let ((rec (assoc proto-label *cmail-fetch-handlers)))
    (if rec
	(setcdr rec handler-function))))

(defun cmail-del-fetch-handler (proto-label handler-function)
  (let ((rec (assoc proto-label *cmail-fetch-handlers))
	(def-rec (assoc proto-label *cmail-fetch-default-handlers)))
    (if (and rec (eq (cdr rec) handler-function) def-rec)
	(setcdr rec (cdr def-rec))
      (cdr rec))))

;; ---- 標準メールの取込みハンドラ (movemail) ----------------------------
(defun cmail-movemail-spool (crash-box proto-spec)
  "標準メールの取込みハンドラ (ローカルスプールファイル用)
外部プロセス movemail を利用する。

PROTO-SPEC は (local-file \"filename\") のリスト。"
  (let ((spool-file (elt proto-spec 1)) errors)
    (cmail-message-resource1 'get-spooled-mail-7 spool-file)
    (unwind-protect
      (save-excursion
	  (setq errors (generate-new-buffer " *cmail loss*"))
	  (buffer-flush-undo errors)
	  (call-process *cmail-movemail-command nil errors nil
			spool-file (expand-file-name *cmail-crash-box))
	  (if (not (buffer-modified-p errors))
	      ;; No output => movemail won
	      (cmail-message-resource1 'get-spooled-mail-8 spool-file)
	    (set-buffer errors)
	    (subst-char-in-region (point-min) (point-max) ?\n ?\  )
	    (goto-char (point-max))
	    (skip-chars-backward " \t")
	    (delete-region (point) (point-max))
	    (goto-char (point-min))
	    (if (looking-at "movemail: ")
		(delete-region (point-min) (match-end 0)))
	    (message "%s" (concat "movemail: "
				  (buffer-substring (point-min)
						    (point-max))))
	    (sit-for 1)))
      (if errors (kill-buffer errors)))))

(defun cmail-movemail-pop3 (crash-box proto-spec)
  "標準メールの取込みハンドラ (POP3 用)
外部プロセス movemail を利用する。
PROTO-SPEC は (pop3 \"server\" \"logname\" \"password\" \"option\")
のリスト。"
  (let ((server (elt proto-spec 1))
	(logname (elt proto-spec 2))
	(password (elt proto-spec 3))
	(options (elt proto-spec 4))
	(default-mailhost (getenv "MAILHOST"))
	(default-movemail (getenv "MOVEMAIL"))
	errors)
    (if (null password)
	(setq password (cmail-lookup-password 'pop3 server logname)))
    (if (or (null password) (string= password ""))
	(progn
	  (setq password (cmail-prompt-for-password server logname))
	  (cmail-save-password 'pop3 server logname password)))
    (if (and (stringp password) (not (string= password "")))
	(progn
	  (setenv "MAILHOST" server)
	  (setenv "MOVEMAIL" options)
	  (cmail-message-resource1 'get-spooled-mail-5 server)
	  (unwind-protect
	      (save-excursion
		(setq errors (generate-new-buffer " *cmail loss*"))
		(buffer-flush-undo errors)
		(call-process *cmail-movemail-command nil errors nil
			      (concat "po:" logname)
			      (expand-file-name *cmail-crash-box)
			      password)
		(if (not (buffer-modified-p errors))
		    ;; No output => movemail won
		    (cmail-message-resource1 'get-spooled-mail-6 server)
		  (cmail-save-password 'pop3 server logname "")
		  (set-buffer errors)
		  (subst-char-in-region (point-min) (point-max) ?\n ?\  )
		  (goto-char (point-max))
		  (skip-chars-backward " \t")
		  (delete-region (point) (point-max))
		  (goto-char (point-min))
		  (if (looking-at "movemail: ")
		      (delete-region (point-min) (match-end 0)))
		  (message "%s" (concat "movemail: "
					(buffer-substring (point-min)
							  (point-max))))
		  (sit-for 1)))
	    (if errors (kill-buffer errors)))
	  (setenv "MAILHOST" default-mailhost)
	  (setenv "MOVEMAIL" default-movemail)))))


;; ---- アカウント情報操作関数 --------------------------------------------
(defun cmail-normalize-account-info ()
  "メールの取り込み先(アカウント)毎にプロトコルを cmail-mail-spools お
よび cmail-spool-directory をもとに推測しそれぞれの識別されたプロトコ
ル毎に決められた情報をリストして返す。引数にプロトコルを指定するとその
プロトコルのみの情報を返す。引数でのプロトコルは複数指定できる。"
  (let ((spools cmail-mail-spools)
	spool res server logname password options)
    ;; cmail-mail-spools が定義されていない場合、他の情報をもとに同じ形
    ;; 式のリストを作成して spools に入れる
    (if (null spools)
	(let (mf)
	  (setq mf (getenv "MAIL"))
	  (if (null mf)
	      (progn
		(setq mf cmail-spool-directory)
		(or (string-match "^po:" mf)
		    (setq mf (concat mf (user-login-name))))))
	  (setq spools (list mf)))
      (if (stringp spools)
	  (setq spools (list spools))))
    
    ;; spools のそれぞれの要素に関してループ
    (while spools
      (setq spool (car spools))
      (setq spools (cdr spools))
      (if (and (listp spool) (memq 'skip spool))
	  ;; リストに 'skip が入っていた場合は処理しない
	  nil
	(cond
	 ;; (protocol "server" "login" "password" "option") 形式の場合
	 ((and (listp spool)
	       (= (length spool) 5)
	       (not (eq (car spool) nil))
	       (not (eq (car spool) t))
	       (symbolp (car spool)))
	  (setq res (cons spool res)))
	 
	 ;; ("po:foo" "host" "option" "passwd") 形式の場合 (POP)
	 ((and (listp spool)
	       (stringp (car spool))
	       (string-match "\\`po:\\(.+\\)\\'" (car spool)))
	  (setq logname (match-string 1 (car spool)))
	  (setq server (or (cadr spool) ""))
	  (setq options (or (caddr spool) ""))
	  (setq password (cadddr spool))
	  ;; if password is found in this list, remove and save it
	  ;; somewhere else. don't leave it in this list.
	  (if (and (stringp password) (not (string= password "")))
	      (progn
		(setcar (cdddr spool) nil)
		(cmail-save-password 'pop3 server logname password)))
	  (setq res (cons (list 'pop3 server logname password options) res)))
	 
	 ;; "po:user" の形式の場合 (POP)
	 ((and (stringp spool)
	       (not (string-match "@" spool))
	       (string-match "^po:\\(.+\\)$" spool))
	  (setq logname (match-string 1 spool))
	  (setq server (or (getenv "MAILHOST") ""))
	  (setq password nil)
	  (setq options (or (getenv "MOVEMAIL") ""))
	  (if (string= server "")
	      (cmail-error-resource 'get-spooled-mail-12)
	    (setq res (cons (list 'pop3 server logname password options)
			    res))))
	 
	 ;; "user@hostname" の形式の場合 (POP)
	 ((and (stringp spool)
	       (or (featurep 'cmail-e19) (featurep 'cmail-20))
	       (string-match "^\\(.*\\)@\\(.*\\)$" spool))
	  (setq logname (match-string 1 spool))
	  (setq server (match-string 2 spool))
	  (setq password nil)
	  (setq options (or (getenv "MOVEMAIL") ""))
	  (if (string= server "")
	      (cmail-error-resource 'get-spooled-mail-12)
	    (setq res (cons (list 'pop3 server logname password options)
			    res))))
	 
	 ;; "スプールファイル名" の場合
	 ((stringp spool)
	  (and (file-exists-p spool)
	       (not (equal 0 (nth 7 (file-attributes spool))))
	       (file-readable-p spool))
	  (setq spool (expand-file-name spool))
	  (setq res (cons (list 'local-file spool) res)))
	 (t
	  (cmail-error-resource 'get-spooled-mail-13)))))
    (reverse res)))

(defun cmail-prompt-for-password (server logname &optional proto-str)
  (let (hmesg pass)
    (setq hmesg
	  (cmail-format-resource 'get-spooled-mail-4
				 (concat logname "@" server)
				 (or proto-str "POP")))
    (require 'comint)
    (setq pass (comint-read-noecho hmesg t))
    (message "")
    pass))

(defun cmail-lookup-password (service server logname)
  (let (password)
    (setq password (cmail-account-db-get server service logname 'password))
    (if (and (null password)
	     *cmail-use-auth-file
	     (file-exists-p cmail-auth-file))
	(progn
	  (find-file cmail-auth-file)
	  (setq buffer-read-only t)
	  (goto-char (point-min))
	  (if (re-search-forward
	       (concat "^" server "\t+" (symbol-name service)
		       "\t+" logname "\t+\\([^\t\n]*\\)$") nil t)
	      (setq password (match-string 1)))
	  (kill-buffer (current-buffer))
	  (cmail-account-db-set server service logname 'password password)))
    (and password (cmail-passwd-unscramble (copy-sequence password)))))

(defvar *cmail-use-auth-file cmail-use-auth-file)
(defun cmail-save-password (service server logname password)
  (setq password (cmail-passwd-scramble (copy-sequence password)))
  (if (and *cmail-use-auth-file
	   (not (file-exists-p cmail-auth-file)))
      (if (y-or-n-p (cmail-get-resource 'save-pass-1))
	  (with-temp-buffer
	    (let ((inhibit-quit t))
	      (write-region (point-min) (point-max)
			    (expand-file-name cmail-auth-file))
	      (set-file-modes cmail-auth-file 384)
	      (if (not (string-match
			"\\`-r..------\\'"
			(elt (file-attributes cmail-auth-file) 8)))
		  (progn
		    (delete-file cmail-auth-file)
		    (cmail-message-resource 'save-pass-2)
		    (setq *cmail-use-auth-file nil)))))
	(setq *cmail-use-auth-file nil)))
  (if (and *cmail-use-auth-file (file-exists-p cmail-auth-file))
      (with-temp-buffer
	(insert-file-contents cmail-auth-file)
	(set-buffer-modified-p nil)
	(goto-char (point-min))
	(if (re-search-forward
	     (concat "^" server "\t+" (symbol-name service)
		     "\t+" logname "\t+\\([^\t\n]*\\)$") nil t)
	    (if (not (string= password
			      (buffer-substring (match-beginning 1)
						(match-end 1))))
		(progn
		  (delete-region (match-beginning 1) (match-end 1))
		  (goto-char (match-beginning 1))
		  (insert password)))
	  (if (y-or-n-p (cmail-get-resource 'save-pass-3))
	      (progn
		(goto-char (point-max))
		(or (eobp) (insert "\n"))
		(insert (concat server "\t" (symbol-name service) "\t"
				logname "\t" password "\n")))))
	(if (buffer-modified-p)
	    (write-region (point-min) (point-max)
			  (expand-file-name cmail-auth-file)))))
  (cmail-account-db-set server service logname 'password password))

(defconst *cmail-passwd-scramble-tab
  (concat "q\\Wy10fvSm5r`LnE<?6lH_^4#&s[bewDQ%ZKo$Mh]\"tzjk X"
	  "B:F),7VgT2Y8*.cd'}+=P@|iC{JGp3a-NAOIu;>~RU9!(/x"))

(defun cmail-passwd-scramble (password)
  (if (stringp password)
      (let ((i 0) (len (length password)) j)
	(while (< i len)
	  (setq j (aref password i))
	  (if (and (>= j 32) (< j 127))
	      (aset password i (aref *cmail-passwd-scramble-tab (- j 32))))
	  (setq i (1+ i)))))
  password)

(defun cmail-passwd-unscramble (password)
  (if (stringp password)
      (let ((i 0) (len (length password)) j n)
	(while (< i len)
	  (setq n (aref password i))
	  (setq j 0)
	  (while (and (< j 95)
		      (not (= n (aref *cmail-passwd-scramble-tab j))))
	    (setq j (1+ j)))
	  (if (and (integerp j) (< j 95))
	      (aset password i (+ 32 j)))
	  (setq i (1+ i)))))
  password)

(defvar *cmail-account-db nil)

(defun cmail-account-db-get (&rest key-list)
  (cmail-account-db-get1 *cmail-account-db key-list))

(defun cmail-account-db-get1 (alist key-list)
  (if key-list
      (let ((key-val (assoc (car key-list) alist)))
	(if key-val (cmail-account-db-get1 (cdr key-val) (cdr key-list))))
    alist))

(defun cmail-account-db-set (key1 key2-val &rest key3-n-val)
  (let* ((key-val-list (nreverse (cons key1 (cons key2-val key3-n-val))))
	 (val (car key-val-list))
	 (key-list (nreverse (cdr key-val-list))))
    (if *cmail-account-db
	(cmail-account-db-set1 *cmail-account-db key-list val)
      (setq *cmail-account-db
	    (list (cmail-account-db-make-list key-list val))))))

(defun cmail-account-db-set1 (alist key-list val)
  (let ((key-val (assoc (car key-list) alist)))
    (if key-val
	(if (cdr key-list)
	    (cmail-account-db-set1 key-val (cdr key-list) val)
	  (setcdr key-val val))
      (nconc alist (list (cmail-account-db-make-list key-list val))))))

(defun cmail-account-db-make-list (key-list val)
  (if (cdr key-list)
      (cons (car key-list)
	    (list (cmail-account-db-make-list (cdr key-list) val)))
    (cons (car key-list) val)))

;; ==== 新着メイルをフォルダに追加 ======================================
(defun cmail-append-mail-to-folder (mailbuffer folder &optional summary)
  "MAILBUFFERで指定したメイルの内容を, FOLDERに追加する."
  (setq *cmail-folders-cache-modified t)
  (cmail-get-folder folder)
  (let ((cnt (cmail-mail-counter)) smry)
    (goto-char (point-max))
    ;;メイルの追加
    (set-buffer mailbuffer)
    (if (null summary)
	(setq summary (cmail-get-mail-headers (point-min) (cmail-page-max))))
    (append-to-buffer (cmail-folder-buffer folder) (point-min) (point-max))
    (cmail-get-folder folder)
    (nconc *cmail-pagelist (list (point-max-marker)))
    (cmail-get-header folder)
    (goto-char (point-max))
    (insert (format "%d %s\n" cnt summary))
    (cmail-get-folder folder)
    (cmail-th-append folder cnt))
  summary)

;; ---- メイルのフォルダ変更 -----------------------------------------------
(defun cmail-copy-to-folder (target)
  "マークされたmail(マークがない場合は, カーソル行のmail)
をTO-FOLDERにコピーする."
  (interactive (list (cmail-complete-foldername
		      (cmail-get-resource 'copy-to-folder-1))))
  (cmail-move-to-folder target t))

(defun cmail-move-to-folder (target &optional undelete)
  "マークされたmail(マークがない場合は, カーソル行のmail)
をTO-FOLDERに移動する.
付加引数UNDELETEがnon-nilならば, 元mailを削除しない."
  (interactive (list (cmail-complete-foldername
		      (cmail-get-resource 'move-to-folder-1))))
  (if cmail-folders-nickname-display
      (setq target (cmail-folders-nickname-realname target)))
  (if (string= cmail-current-folder target)
      (cmail-error-resource 'move-to-folder-2))
  (or (cmail-virtual-folder-p target)
      (setq *cmail-prev-folder target))
  (cmail-fixcp)
  (cmail-message-resource (if undelete 'move-to-folder-3-1 'move-to-folder-3-2))
  (let (cnt)
    (setq cnt (cmail-exec '(lambda (page)
			     (cmail-refile-call page target undelete))))
    (message (cmail-format-resource (if undelete 'move-to-folder-4-1
				      'move-to-folder-4-2)
				    cnt
				    (cmail-get-resource (if (> cnt 1)
							    'move-to-folder-7
							  'move-to-folder-8))
				    target)))
  (if (and (cmail-thread-p) (null undelete))
      (progn
	(cmail-push-curpos)
	(cmail-make-summary cmail-current-folder t)
	(cmail-pop-curpos)))
  (cmail-sort-header target)
  (cmail-sync-header)
  (and (null undelete)
       (cmail-mode-line-update)
       (cmail-expand-summary-window))
  (cmail-fixcp))

(defun cmail-refile-call (page target &optional undelete)
  "PAGE番目のmailをフォルダTARGETに移動させる.
付加引数UNDELETEがnon-nilならば, 元mailを削除しない."
  (let (contents summary)
    (cmail-get-header)
    (if (null (re-search-forward (format "^%d \\(.*\\)$" page) nil t))
	(cmail-error-resource1 'refile-call-1 page))
    (setq summary (buffer-substring (match-beginning 1)
				    (match-end 1)))
    (cmail-get-folder)
    (cmail-n-page page)
    (setq contents (list (current-buffer) (point) (cmail-page-max)))
    (set-buffer (get-buffer-create *cmail-arrived-mail-buffer))
    (erase-buffer)
    (if running-emacs-20_3-or-later
	(cmail-set-buffer-multibyte nil))
    (apply 'insert-buffer-substring contents)
    ;; imap4 copy - BUG: currently cannot handle fallback situation
    ;; where a new folder is created on server but not on the local
    ;; file.
    (if (and (boundp 'cmail-message-copy-function)
	     (functionp cmail-message-copy-function))
	;; server folder will be created if target is imap4 server and
	;; it does not exist.
	(progn
	  (save-excursion
	    (goto-char (point-min))
	    (funcall cmail-message-copy-function
		     cmail-current-folder target
		     *cmail-confirm-new-folder))
	  (goto-char (point-max))
	  (if (not (eolp)) (insert "\n"))))
    (insert-string *cmail-borderline)
    (cmail-append-mail-to-folder *cmail-arrived-mail-buffer target summary))
  (or undelete
      (cmail-delete-mail page t))
  (set-buffer *cmail-summary-buffer)
  (if undelete
      nil
    (let ((buffer-read-only nil))
      (beginning-of-line)
      (cmail-delete-line 1)
      (forward-line -1))))

;; ==== メイル表示(interactive) ===========================================
(defun cmail-read-contents (page)
  "FOLDERのPAGE番目のメイルを表示・スクロールさせる.
終りまで読むと次のメイルを表示する."
  (interactive (list (cmail-get-page-number-from-summary)))
  (let ((disp (get-buffer-window *cmail-mail-buffer)))
    (if (equal page 0)
	(progn
	  (setq *cmail-current-folder "")
	  (setq *cmail-current-page 0)
	  (cmail-error-resource 'read-contents-1)))
    (cmail-select-buffer *cmail-mail-buffer)
    (cmail-select-buffer *cmail-summary-buffer)
    (if (or (null disp)
	    (not (string= cmail-current-folder *cmail-current-folder))
	    (not (equal page *cmail-current-page)))
	  (cmail-show-contents page)
      (let* ((win (get-buffer-window *cmail-mail-buffer))
	     (wh (window-height win))
	     (mbll (save-excursion
		     (set-buffer *cmail-mail-buffer)
		     (count-lines (window-start win) (point-max))))
	     (cp (/ wh 2))
	   (swin (get-buffer-window *cmail-summary-buffer))
	   (swh (window-height swin))
	   (scp (/ swh 2))
	   (ccp (count-lines (point-min) (point)))
	   (sll (- swh (count-lines (window-start swin) (point-max)))))
	(if (or (>= mbll wh)
		(not (save-window-excursion
		       (select-window (get-buffer-window *cmail-mail-buffer))
		       (pos-visible-in-window-p (point-max)))))
	    (cmail-scroll-up nil win)
	  (set-buffer *cmail-mail-buffer)
	  (goto-char (point-max))
	  (widen)
	  (if (/= (point) (point-max))
	      (progn
		(forward-line 2)
		(cmail-narrow-to-page))
	    (cmail-narrow-to-page)
	    (set-buffer *cmail-summary-buffer)
	    (let ((p (point)))
	      (if (and (< sll 2) (>= ccp scp))
		  (scroll-up 1))
	      (and (= p (point))
		   (forward-line 1)))
	    (if (eobp)
		(cmail-message-resource 'read-contents-2)
	      (cmail-show-contents (cmail-get-page-number-from-summary)))))
	(set-buffer *cmail-summary-buffer)))
    (cmail-fixcp)))

(defvar *cmail-last-shown-message-raw nil)
(defun cmail-insert-last-shown-message-raw ()
  (if (and (consp *cmail-last-shown-message-raw)
	   (buffer-live-p (car *cmail-last-shown-message-raw)))
      (apply 'cmail-insert-buffer-substring
	     *cmail-last-shown-message-raw)))

(defvar *cmail-last-shown-message-cooked nil)
(defun cmail-get-last-shown-message-cooked ()
  (if (and (consp *cmail-last-shown-message-raw)
	   (buffer-live-p (car *cmail-last-shown-message-raw)))
      (apply 'cmail-insert-buffer-substring
	     *cmail-last-shown-message-cooked)))

(defun cmail-show-contents (page &optional all-headers)
  "FOLDERのPAGE番目のメイルを表示する."
  (interactive (list (cmail-get-page-number-from-summary)))
  (setq *cmail-current-folder cmail-current-folder)
  (setq *cmail-current-page page)
  (if (= page 0) (cmail-message-resource 'show-contents-1)
    (let ((cnt 0)
	  (beg 0)
	  (end 0)
	  (pnt 0)
	  (act nil)
	  status-mark)
      (cmail-fixcp)
      (forward-char -1)
      (if (= (char-after (point)) ?U)
	  (setq act t))
      (save-excursion			; なぜこれが必要なのか…?
	(cmail-select-buffer *cmail-summary-buffer))
      (cmail-get-folder)
      (cmail-n-page page)
      (if act
	  (setq status-mark
		(cmail-set-mail-status '("Active") '("Unread"))))
      (cmail-n-page page)
      (setq beg (point))
      (setq end (cmail-page-max))

      ;; current buffer is the folder buffer. modifying this buffer
      ;; will cause change in folder file, and content will be saved
      ;; as part of folder file.  Try load body if this is a dynamic
      ;; load folder such as imap4.  After loading, it could swap to a
      ;; cache buffer if dynamic message loader will not need to save
      ;; info in the folder file.
      (if (and (boundp 'cmail-content-supply-function)
	       (functionp cmail-content-supply-function))
	  (save-restriction
	    (narrow-to-region beg end)
	    (funcall cmail-content-supply-function)
	    (goto-char (point-min)))
	(cmail-n-page page))

      ;; current buffer contains raw message, and corresponding body
      ;; may have been inserted if dynamically loaded.  It may contain
      ;; partial body in case of imap4 as well.  The raw buffer may be
      ;; cache buffer instead of the folder buffer. save info for
      ;; future reference by reply modules.
      (setq beg (point))
      (setq end (cmail-page-max))
      (setq *cmail-last-shown-message-raw
	    (list (current-buffer) beg end))

      ;; cook it up, bring up *cmail-mail* buffer.
      (save-restriction
        (narrow-to-region beg end)
        (funcall cmail-content-filter-function))
      (widen)
      (cmail-narrow-to-page)
      (setq mode-line-buffer-identification
	    (format "cmail:   << %s / %d >>" cmail-current-folder page))

      ;; current buffer contains a cooked message for easy viewing,
      ;; mime view for example. save information for future reference
      ;; by reply modules.
      (setq beg (point))
      (setq end (cmail-page-max))
      (setq *cmail-last-shown-message-cooked
	    (list (current-buffer) beg end))

      ;; Go back and adjust summary line cursor.
      (cmail-select-buffer *cmail-summary-buffer)
      (if act (apply 'cmail-put-mark page status-mark))
      (if cmail-current-point-mark
	  (progn
	    (setq pnt (point))
	    (let ((buffer-read-only nil))
	      (goto-char (point-min))
	      (if (not (re-search-forward "^+ *" nil t))
		  nil
		(beginning-of-line)
		(delete-char 1)
		(insert " "))
	      (goto-char pnt)
	      (beginning-of-line)
	      (delete-char 1)
	      (insert "+"))))
      (run-hooks 'cmail-show-contents-after-hook)
      (cmail-fixcp))))

(defun cmail-default-content-filter ()
  (let ((contents (current-buffer))
	(beg (point-min))
	(end (point-max)))
    (cmail-select-buffer *cmail-mail-buffer)
    (setq buffer-read-only nil)
    (erase-buffer)
    (cmail-insert-buffer-substring contents beg end))
  (goto-char (point-min))
  (let ((code (detect-coding-region (point-min) (point-max))))
    (if (listp code) (setq code (car code)))
    (decode-coding-region (point-min) (point-max) code))
  (setq *cmail-have-all-headers (or all-headers *cmail-show-all-headers))
  (or *cmail-have-all-headers (cmail-ignore-headers))
  (run-hooks 'cmail-show-contents-hook)
  (cmail-readmail-mode))

(defun cmail-read-reverse ()
  "メイルを逆に読む."
  (interactive)
  (let ((win (get-buffer-window *cmail-mail-buffer))
	(sum (get-buffer-window *cmail-summary-buffer)))
    (if win
	(select-window win)
      (cmail-select-buffer *cmail-mail-buffer))
    (if (> (window-start) (point-min))
	(scroll-down)
      (goto-char (point-min))
      (widen)
      (if (eq (point) 1)
	  (cmail-message-resource 'read-reverse-1)
	(forward-line -2)))
    (cmail-narrow-to-page)
    (select-window sum)))

(defun cmail-read-each-line (n)
  "メイルをN行ずつ読む."
  (interactive "p")
  (let ((win (get-buffer-window *cmail-mail-buffer)))
    (if win (cmail-scroll-up n win) 
      (cmail-read-contents (cmail-get-page-number-from-summary)))))

(defun cmail-read-each-line-backward (n)
  "メイルをN行ずつ逆方向に読む."
  (interactive "p")
  (let ((win (get-buffer-window *cmail-mail-buffer)))
    (if win (cmail-scroll-down n win) 
      (cmail-read-contents (cmail-get-page-number-from-summary)))))

(defun cmail-beginning-of-mail ()
  "メイルの先頭を表示する."
  (interactive)
  (cmail-select-buffer *cmail-mail-buffer)
  (widen)
  (beginning-of-buffer)
  (cmail-narrow-to-page)
  (cmail-select-buffer *cmail-summary-buffer))

(defun cmail-end-of-mail ()
  "メイルの終りを表示する."
  (interactive)
  (cmail-select-buffer *cmail-mail-buffer)
  (widen)
  (end-of-buffer)
  (cmail-narrow-to-page)
  (cmail-select-buffer *cmail-summary-buffer))
  
(defun cmail-next-mail ()
  "次のメイルを読む."
  (interactive)
  (cmail-go-down 1)
  (sit-for 0) ; これがないとカーソルと'+'がずれる(EmacsのBug???)
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(defun cmail-previous-mail ()
  "前のメイルを読む."
  (interactive)
  (cmail-go-up 1)
  (sit-for 0) ; これがないとカーソルと'+'がずれる(EmacsのBug???)
  (cmail-show-contents (cmail-get-page-number-from-summary)))

(defun cmail-next-unread-mail ()
  "次の未読のメイルを読む."
  (interactive)
  (if (not (re-search-forward "^[ +]*[0-9]+U " nil t))
      (progn
	(cmail-folders-buffer)
	(cmail-folders-goto-folder-line cmail-current-folder)
	(if (cmail-folders-next-unread-folder)
	    nil
	  (if cmail-use-folders-mode-first
	      (cmail-folders)
	    (cmail-message-resource 'next-unread-mail-1))))
    (cmail-go-down 0)
    (sit-for 0) ; これがないとカーソルと'+'がずれる(EmacsのBug???)
    (cmail-show-contents (cmail-get-page-number-from-summary))))

(defun cmail-previous-unread-mail ()
  "前の未読のメイルを読む."
  (interactive)
  (if (not (re-search-backward "^[ +]*[0-9]+U " nil t))
      (progn
	(cmail-folders-buffer)
	(cmail-folders-goto-folder-line cmail-current-folder)
	(if (cmail-folders-previous-unread-folder)
	    nil
	  (if cmail-use-folders-mode-first
	      (cmail-folders)
	    (cmail-message-resource 'next-unread-mail-1))))
    (cmail-go-up 0)
    (sit-for 0) ; これがないとカーソルと'+'がずれる(EmacsのBug???)
    (cmail-show-contents (cmail-get-page-number-from-summary))))

(defun cmail-toggle-header ()
  "全てのヘッダを見せるかどうかをトグルする."
  (interactive)
  (let ((*cmail-show-all-headers nil)
	(all-headers
	 (not *cmail-have-all-headers)))
    (cmail-show-contents (cmail-get-page-number-from-summary) all-headers)))

(defun cmail-stop-page-breaking ()
  "メイル本文の途中に入っている ^L を無効にする。"
  (interactive)
  (cmail-show-contents (cmail-get-page-number-from-summary))
  (save-excursion
    (set-buffer *cmail-mail-buffer)
    (widen))
  (cmail-fixcp))

(defun cmail-prepare-caesar (&optional n)
  (cond ((not (numberp n)) (setq n 13))
	((< n 0) (setq n (- 26 (% (- n) 26))))
	(t (setq n (% n 26))))		;canonicalize N
  (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
    (cmail-message-resource 'prepare-caesar-1)
    (setq caesar-translate-table (make-vector 256 0))
    (while (< i 256)
      (aset caesar-translate-table i i)
      (setq i (1+ i)))
    (setq lower (concat lower lower) upper (upcase lower) i 0)
    (while (< i 26)
      (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
      (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
      (setq i (1+ i)))
    ;; ROT47 for Japanese text.
    ;; Thanks to ichikawa@flab.fujitsu.junet.
    (setq i 161)
    (let ((t1 (logior ?O 128))
	  (t2 (logior ?! 128))
	  (t3 (logior ?~ 128)))
      (while (< i 256)
	(aset caesar-translate-table i
	      (let ((v (aref caesar-translate-table i)))
		(if (<= v t1) (if (< v t2) v (+ v 47))
		  (if (<= v t3) (- v 47) v))))
	(setq i (1+ i))))
    (cmail-message-resource 'prepare-caesar-2)))
  
(defun cmail-caesar-region (&optional n)
  "Caesar rotation of region by N, default 13, for decrypting netnews.
ROT47 will be performed for Japanese text in any case."
  (interactive (if current-prefix-arg	; Was there a prefix arg?
		   (list (prefix-numeric-value current-prefix-arg))
		 (list nil)))
  (cond ((not (numberp n)) (setq n 13))
	((< n 0) (setq n (- 26 (% (- n) 26))))
	(t (setq n (% n 26))))		;canonicalize N
  (if (not (zerop n))		; no action needed for a rot of 0
      (progn
	(if (or (not (boundp 'caesar-translate-table))
		(null caesar-translate-table)
		(/= (aref caesar-translate-table ?a) (+ ?a n)))
	    (cmail-prepare-caesar n))
	(let ((from (region-beginning))
	      (to (region-end))
	      (i 0) str len)
	  (setq str (buffer-substring from to))
	  (setq len (length str))
	  (while (< i len)
	    (aset str i (aref caesar-translate-table (aref str i)))
	    (setq i (1+ i)))
	  (goto-char from)
	  (delete-region from to)
	  (insert str)))))

(defun cmail-caesar-message (rotnum)
  (interactive "P")
  (let ((page (cmail-get-page-number-from-summary))
	(win (get-buffer-window *cmail-mail-buffer))
	(oldwin (get-buffer-window (current-buffer))))
    (if (and (= page *cmail-current-page) win)
	nil
      (cmail-show-contents page)
      (setq win (get-buffer-window *cmail-mail-buffer)))
    (set-buffer *cmail-mail-buffer)
    (select-window win)
    (save-restriction
      (widen)
      (move-to-window-line 0)
      (let ((buffer-read-only nil) (last (point)))
	(set-mark (point-max))
	(goto-char (point-min))
	(goto-char (cmail-head-max))
	(cmail-caesar-region rotnum)
	(goto-char last)
	(recenter 0)))
    (select-window oldwin)))

;; ==== バックアップファイル消去 ========================================
(defun cmail-delete-bk-file (bkfile)
  "バックアップファイルを実際に消去する."
  (if (not (file-readable-p bkfile))
      (cmail-message-resource1 'delete-bk-file-1 bkfile)
    (if (or (string= cmail-ok-if-backup-exists "DELETE")
	    (y-or-n-p (cmail-format-resource1 'delete-bk-file-2 bkfile)))
	(progn
	  (delete-file bkfile)
	  (cmail-message-resource1 'delete-bk-file-3 bkfile)))))

(defun cmail-delete-bk-files (path)
  "バックアップファイルを消す.
変数cmail-ok-if-backup-existsが\"DELETE\"の場合は確認なしで消去する."
  (if (string= cmail-ok-if-backup-exists "OK")
      nil
    (let ((list (directory-files path t "^[^\.#~][^~]+$")))
      (while list
	(let ((bkfile (car list)))
	  (if (file-directory-p bkfile)
	      (cmail-delete-bk-files bkfile)
	    (if (string-match (format "^%s" *cmail-backup-prefix)
			      (file-name-nondirectory bkfile))
		(cmail-delete-bk-file bkfile))))
	(setq list (cdr list))))))

;; ---- フォルダ関連(interactive) -------------------------------------
(defun cmail-visit-folder (newfolder &optional noarchive)
  "フォルダをNEWFOLDERに変更する.
\\[universal-argument]が与えられた場合, auto-archiveをしない."
  (interactive (list (cmail-complete-foldername (cmail-get-resource 'visit-folder-1))
		     current-prefix-arg))
  (if (null newfolder) (setq newfolder cmail-current-folder))
  (if cmail-folders-nickname-display
      (setq newfolder (cmail-folders-nickname-realname newfolder)))
  (and (string= newfolder cmail-inbox-folder)
       (string= *cmail-prev-folder cmail-inbox-folder)
       (setq *cmail-prev-folder nil))
  (and cmail-archive-on-visit
       (interactive-p)
       (null noarchive)
       (string= cmail-current-folder cmail-inbox-folder)
       (progn
	 (cmail-push-curpos)
	 (cmail-auto-archive newfolder)
	 (cmail-make-summary cmail-current-folder t)
	 (cmail-pop-curpos)))
  (and (interactive-p)
       (cmail-save-curpos))
  (let ((cmail-current-folder newfolder))
    (cmail-get-folder newfolder)
    (if (and (not (and (cmail-thread-p)
		       cmail-thread-ignore-limit))
	     (if (string= newfolder cmail-inbox-folder)
		 (not cmail-query-limit-except-inbox-folder)
	       t)
	     (> (cmail-num-of-mails) cmail-large-folder))
	(let ((input
	       (read-string (cmail-format-resource 'visit-folder-2
						   newfolder
						   (cmail-num-of-mails)))))
	  (setq *cmail-summary-limit
		(if (string= input "")
		    nil
		  (string-to-int input))))
      (setq *cmail-summary-limit nil)))
  (or (cmail-virtual-folder-p cmail-current-folder)
      (setq *cmail-prev-folder cmail-current-folder))
  (cmail-make-summary newfolder)
  (cmail-select-buffer *cmail-summary-buffer)
  (cmail-expand-summary-window))

(defun cmail-kill-folder (folder &optional force)
  "FOLDERを削除する."
  (interactive
   (list 
    (cmail-complete-foldername (cmail-get-resource 'kill-folder-1) cmail-current-folder t)))
  (if (string= folder cmail-inbox-folder)
      (cmail-error-resource1 'kill-folder-2 cmail-inbox-folder))
  (or force
      (yes-or-no-p (format (cmail-get-resource 'kill-folder-3) folder))
      (cmail-error-resource 'kill-folder-4))
  (cmail-get-folder folder)
  (set-buffer-modified-p nil)
  (kill-buffer (current-buffer))
  (cmail-get-header folder)
  (kill-buffer (current-buffer))
  (if (cmail-virtual-folder-p folder)
      (setq *cmail-virtual-folders
	    (delete-if '(lambda (str) (string= str folder))
		       *cmail-virtual-folders))
    (if (file-exists-p (expand-file-name folder cmail-path))
	(delete-file (expand-file-name folder cmail-path)))
    (if (file-exists-p (expand-file-name (concat folder "~") cmail-path))
	(delete-file (expand-file-name (concat folder "~") cmail-path))))
  (if (and (boundp 'cmail-mailbox-delete-function)
	   (functionp cmail-mailbox-delete-function))
      (funcall cmail-mailbox-delete-function folder))
  (setq *cmail-folder-list
	(delete-if '(lambda (lst) (string= (car lst) folder))
		   *cmail-folder-list))
  (setq *cmail-opened-folders-list
	(delete-if '(lambda (str) (string= str folder))
		   *cmail-opened-folders-list))
  (cmail-funcall-if-defined 'cmail-after-kill-folder-function folder)
  (if (string= folder cmail-current-folder)
      (if cmail-use-folders-mode-first
	  (cmail-folders)
	(if (null *cmail-prev-folder)
	    (cmail-make-summary cmail-inbox-folder)
	  (cmail-make-summary *cmail-prev-folder))))
  (if force
      nil
    (cmail-message-resource1 'kill-folder-5 folder)))

(defun cmail-copy-folder (folder1 folder2)
  "FOLDER1をFOLDER2にコピーする. FOLDER2は存在してはいけない.
interactiveだと, FOLDER1はカレントフォルダになる."
  (interactive
   (list cmail-current-folder
	 (cmail-complete-foldername
	  (cmail-format-resource1 'copy-folder-1
				  cmail-current-folder))))
  (if (cmail-virtual-folder-p folder2)
      (cmail-error-resource1 'copy-folder-2 folder2))
  ;; cmail-mailbox-copy-function should return t or stop with error if
  ;; the copy involves remote folders. Returning nil will result in a
  ;; local folder copy, which should not occur in the case of remote
  ;; folders.
  (if (not (and (boundp 'cmail-mailbox-copy-function)
		(functionp cmail-mailbox-copy-function)
		(funcall cmail-mailbox-copy-function
			 folder1 folder2 *cmail-confirm-new-folder)))
      (let ((file1 (expand-file-name folder1 cmail-path))
	    (file2 (expand-file-name folder2 cmail-path)))
	(if (file-exists-p file2)
	    (cmail-error-resource1 'copy-folder-3 folder2))
	(cmail-get-folder folder1)
	(if (not (file-exists-p file1))
	    (cmail-save-folder folder1))
	(cmail-make-directory (file-name-directory file2))
	(cmail-save-folder folder1)
	(copy-file file1 file2)))
  (cmail-funcall-if-defined 'cmail-after-copy-folder-function folder1 folder2)
  (message (cmail-format-resource 'copy-folder-4 folder1 folder2)))

(defun cmail-rename-folder (folder1 folder2)
  "FOLDER1の名前をFOLDER2にする. FOLDER2は存在してはいけない.
interactiveだと, FOLDER1はカレントフォルダになる."
  (interactive
   (list cmail-current-folder
	 (cmail-complete-foldername
	  (cmail-format-resource1 'rename-folder-1
				  cmail-current-folder))))
  (if (cmail-virtual-folder-p folder2)
      (cmail-error-resource1 'copy-folder-2 folder2))
  ;; cmail-mailbox-rename-function should stop with error if any of
  ;; the folders are on a remote server and the rename operation is
  ;; unsuccessful.
  (if (and (boundp 'cmail-mailbox-rename-function)
	   (functionp cmail-mailbox-rename-function))
      (funcall cmail-mailbox-rename-function folder1 folder2))
  (let ((file1 (expand-file-name folder1 cmail-path))
	(file2 (expand-file-name folder2 cmail-path)))
    (if (file-exists-p file2)
	(cmail-error-resource1 'copy-folder-3 folder2))
    (if (equal-member folder1 *cmail-opened-folders-list)
	(cmail-dismiss-folder folder1))
    (setq *cmail-folder-list
	  (delete-if '(lambda (lst) (string= (car lst) folder1))
		     *cmail-folder-list))
    (cmail-make-directory (file-name-directory file2))
    (rename-file file1 file2))
  (if (string= folder1 cmail-current-folder)
      (cmail-make-summary folder2))
  (cmail-funcall-if-defined 'cmail-after-rename-folder-function
			    folder1 folder2)
  (message (cmail-format-resource 'rename-folder-4 folder1 folder2)))

(defun cmail-reorder-folder ()
  "メイルを現在のindexの順に実際に並べ換える."
  (interactive)
  (let ((folder cmail-current-folder))
    (if (y-or-n-p (cmail-format-resource1 'reorder-folder-1 folder))
	nil
      (cmail-error-resource 'reorder-folder-2))
    (or (cmail-virtual-folder-p folder)
	(cmail-save-folder cmail-current-folder))
    (let (page summary idx plist buf hbuf fbuf idxept)
      (setq buf (get-buffer-create *cmail-reorder-buffer))
      (set-buffer buf)
      (erase-buffer)
      (cmail-set-buffer-multibyte nil)
      (cmail-get-folder folder)
      (setq fbuf (current-buffer))
      (goto-char (point-min))
      (if (re-search-forward *cmail-border)
	  (setq idxept (point))
	(error "cmail-reorder-folder: does not appear to be a folder file"))
      (goto-char (point-min))
      (setq idx 1)
      (while (re-search-forward "^\\([0-9]+\\) \\(.*\\)$" idxept t)
	(setq page (string-to-int (buffer-substring (match-beginning 1)
						    (match-end 1))))
	(setq summary (buffer-substring (match-beginning 2)
					(match-end 2)))
	(setq plist (cons page plist))
	(save-excursion
	  (set-buffer buf)
	  (insert (format "%d %s\n" idx summary))
	  (setq idx (1+ idx))))
      (set-buffer buf)
      (insert-string *cmail-borderline)
      (set-buffer fbuf)
      (setq plist (nreverse plist))
      (while plist
	(cmail-n-page (car plist))
	(message (cmail-format-resource 'reorder-folder-3 folder (car plist)))
	(append-to-buffer buf (point) (cmail-page-max))
	(save-excursion
	  (set-buffer buf)
	  (insert-string *cmail-borderline))
	(setq plist (cdr plist)))
      (set-buffer buf)
      (copy-to-buffer fbuf (point-min) (point-max))
      (cmail-make-header-buffer folder)
      (kill-buffer buf))
    (cmail-get-folder folder)
    (setq *cmail-pagelist nil)
    (setq *cmail-thread-data nil)
    (if (string= folder cmail-current-folder)
	(cmail-make-summary folder))
    (cmail-message-resource1 'reorder-folder-4 folder)))

(defun cmail-saving-folder-match (lt pnt max)
  (let (fldr)
    (goto-char (point-min))
    (setq clt (car lt))
    (if (not cmail-use-regexp-in-folder-alist)
	(setq clt (regexp-quote clt)))
    (if (re-search-forward (format "%s" clt) nil t)
	(progn
	  (setq fldr (cdr lt))
	  (if (functionp fldr)
	      (save-excursion
		(cmail-get-folder)
		(save-restriction
		  (narrow-to-region pnt max)
		  (goto-char (point-min))
		  (setq fldr (funcall fldr)))))))
    fldr))

(defun cmail-saving-folder (page &optional noecho)
  "mailのarchive先のフォルダ名を表示する.
付加引数 NOECHO がnon-nil の場合, 表示は行なわず, そのフォルダ名が返る."
  (interactive (list (cmail-get-page-number-from-summary)))
  (cmail-fixcp)
  (save-excursion
    (cmail-get-folder)
    (cmail-n-page page)
    (let* ((pnt (point))
	   (al cmail-folder-alist)
	   (lt (if (listp (car al)) (cdr (car al))))
	   (max (cmail-head-max))
	   fldr clt buf oldbuf
	   (case-fold-search t))
      (and cmail-mime-decode
	   (setq buf (get-buffer-create " *mime match*")))
      (setq oldbuf (current-buffer))
      (while al
	(if (functionp (car al))
	    (save-restriction
	      (narrow-to-region pnt max)
	      (goto-char pnt)
	      (setq fldr (funcall (car al)))
	      (if fldr (setq al nil)))
	  (while (and (null fldr)
		      (re-search-forward (format "^\\(%s\\):\\s *"
						 (car (car al))) max t))
	    (let (beg end)
	      (setq beg (point))
	      (setq end (progn
			  (if (re-search-forward "\n[^ \t]" max t)
			      (progn
				(forward-char -1)
				(point))
			    (end-of-line)
			    (point))))
	      (if (and cmail-mime-decode
		       (goto-char beg)
		       (search-forward "=?" end t nil)
		       (let ((oldbuf (current-buffer))
			     (buf (get-buffer-create " *mime match*")))
			 (save-excursion
			   (set-buffer buf)
			   (erase-buffer)
			   (cmail-insert-buffer-substring oldbuf beg end)
			   (eword-decode-region (point-min) (point-max))
			   (setq fldr (cmail-saving-folder-match (car lt) pnt max)))))
		  nil
		(save-restriction
		  (narrow-to-region beg end)
		  (setq fldr (cmail-saving-folder-match (car lt) pnt max))))
	      (and fldr (setq al nil))))
	  (goto-char pnt))
	(if (cdr lt)
	    (setq lt (cdr lt))
	  (setq al (cdr al))
	  (setq lt (cdr (car al)))))
      (if noecho
	  nil
	(if fldr
	    (cmail-message-resource1 'saving-folder-1 fldr)
	  (cmail-message-resource 'saving-folder-2)))
      (let ((buf (get-buffer " *mime match*")))
	(and buf (kill-buffer buf)))
      fldr)))

(defvar *cmail-hist-mark-field-names nil)
(defun cmail-mark-specified-mails (field value)
  "指定したフィールドの値にマッチするメイルにマークをつける"
  (interactive
   (let* ((completion-ignore-case t)
	  (hdr (completing-read (cmail-get-resource 'mark-specified-mails-1)
				cmail-default-headers nil nil nil
				'*cmail-hist-mark-field-names))
	  (hist (if (string= hdr "") (error (cmail-get-resource
					     'mark-specified-mails-3))
		  (intern (concat "*cmail-hist-mark-field-" (downcase hdr)))))
	  (pat (progn
		 (or (boundp hist) (set hist nil))
		 (read-string (cmail-format-resource1
			       'mark-specified-mails-2 hdr) nil hist))))
     (list hdr pat)))
  (let* ((found "found")
	 (cmail-use-regexp-in-folder-alist t)
	 (cmail-folder-alist (list (list field (cons value found))))
	 (page 0) 
	 (pos (cmail-get-page-number-from-summary)))
    (goto-char (point-min))
    (while (re-search-forward "^[ +]*[0-9]+" nil t)
      (setq page (cmail-get-page-number-from-summary))
      (if (eq (cmail-saving-folder page t) found)
	  (save-excursion
	    (setq pos page)
	    (cmail-mark-mail 1))))
    (cmail-goto-index pos)))

(defun cmail-auto-archive-all ()
  "フォルダの中身を未読メイルを含めて自動的にrefileする."
  (interactive)
  (cmail-auto-archive t))

(defun cmail-auto-archive (&optional folder noquery)
  "フォルダの中身を自動的にrefileする."
  (interactive "P")
  (or noquery (string= cmail-current-folder cmail-inbox-folder)
      (y-or-n-p (cmail-format-resource1 'auto-archive-1
					cmail-current-folder))
      (cmail-error-resource 'auto-archive-2))
  (cmail-fixcp)
  (save-excursion
    (goto-char (point-min))
    (let (page fldr stts flist force (*cmail-confirm-new-folder nil))
      (while (re-search-forward "^[ +]*[0-9]+\\(.\\)" nil t)
	(setq stts (buffer-substring (match-beginning 1) (match-end 1)))
	(setq page (cmail-get-page-number-from-summary))
	(cond
	 ((or (and (interactive-p) folder) (eq folder t))
	  (setq force t)
	  (setq folder cmail-current-folder)))
	(if (or (string= stts "D")
		(string= stts "H")
		(null (setq fldr (cmail-saving-folder page t)))
		(and (string= stts "U")
		     (not (or cmail-archive-on-get force))
		     (not (string= folder fldr))))
	    (cmail-message-resource 'auto-archive-3)
	  (if (string= fldr cmail-current-folder)
	      nil
	    (cmail-message-resource1 'auto-archive-4 page)
	    (cmail-refile-call page fldr)
	    (if (null (member fldr flist))
		(setq flist (cons fldr flist))))))
      (mapcar 'cmail-sort-header flist)
      (cmail-sync-header folder))
      (if cmail-always-display-folders
	  (save-excursion
	    (cmail-folders-buffer))))
  (cmail-mode-line-update)
  (cmail-fixcp)
  (and (interactive-p)
       (cmail-expand-summary-window))
  (cmail-message-resource 'auto-archive-5))

(defun cmail-visit-saving-folder (page)
  "mailのarchive先フォルダに移動する."
  (interactive (list (cmail-get-page-number-from-summary)))
  (let ((fld (cmail-saving-folder page t)))
    (if (and fld
	     (y-or-n-p (cmail-format-resource1 'visit-saving-folder-1 fld)))
	(cmail-visit-folder fld))))

(defun cmail-refile-to-saving-folder (page)
  "mailをauto refile先フォルダに移動する."
  (interactive (list (cmail-get-page-number-from-summary)))
  (let ((fld (cmail-saving-folder page t)))
    (or (cmail-virtual-folder-p target)
	(setq *cmail-prev-folder target))
    (cmail-refile-call page fld)
      (if (cmail-thread-p)
	  (progn
	    (cmail-push-curpos)
	    (cmail-make-summary cmail-current-folder t)
	    (cmail-pop-curpos)))
      (cmail-sync-header fld)
      (cmail-sync-header)
      (cmail-mode-line-update))
  (cmail-fixcp))

;; ==== カーソル移動(interactive) ====================================
(defun cmail-go-up (n)
  "カーソルをN行上に移動する(カーソルの位置は変わらずに,
画面が下にスクロールする."
  (interactive "p")
  (if (and (save-excursion
	     (beginning-of-line)
	     (bobp))
	   (integerp *cmail-summary-limit))
      (cmail-expand-summary n)
    (let* ((win (get-buffer-window (current-buffer)))
	   (wh (window-height win))
	   (cp (1- (/ wh 2))))
      (forward-line (- 0 n))
      (recenter cp)))
  (cmail-fixcp))

(defun cmail-go-down (n)
  "カーソルをN行下に移動する(カーソルの位置は変わらずに,
画面が上にスクロールする."
  (interactive "p")
  (let* ((win (get-buffer-window (current-buffer)))
	 (wh (window-height win))
	 (cp (1- (/ wh 2))))
    (forward-line n)
    (recenter cp)
    (cmail-fixcp)))

(defun cmail-up-imme (n)
  "素早いカーソルのN行上移動."
  (interactive "p")
  (if (and (save-excursion
	     (beginning-of-line)
	     (bobp))
	   (integerp *cmail-summary-limit))
      (cmail-expand-summary n)
    (forward-line (* -1 n)))
  (cmail-fixcp))

(defun cmail-down-imme (n)
  "素早いカーソルのN行下移動."
  (interactive "p")
  (forward-line n)
  (cmail-fixcp))

(defun cmail-go-summary ()
  "カーソルをサマリに移動する."
  (interactive)
  (cmail-select-buffer *cmail-summary-buffer)
  (cmail-fixcp))

(defun cmail-scroll-up (n &optional win)
  "N行上にスクロールする. 付加としてWINを指定すれば,
ウィンドウWINがスクロールする."
  (let ((curwin (get-buffer-window (current-buffer)))
	(dummy (select-window win))
	(lines (count-lines (window-start) (point-max))))
    (if (> lines 1)
	(scroll-up n)
      (widen)
      (if (> (count-lines (window-start) (point-max)) lines)
	  (forward-page 1)
	(cmail-message-resource 'scroll-up-1))
      (cmail-narrow-to-page))
    (select-window curwin)))

(defun cmail-scroll-down (n &optional win)
  "N行下にスクロールする. 付加としてWINを指定すれば,
ウィンドウWINがスクロールする."
  (let ((curwin (get-buffer-window (current-buffer))))
    (select-window win)
    (if (eq (window-start) (point-min))
	(cmail-message-resource 'scroll-down-1)
      (scroll-down n))
    (select-window curwin)))

(defun cmail-fixcp ()
  "カーソル位置を正す."
  (if (eobp) (forward-line -1))
  (beginning-of-line)
  (if (< (- (save-excursion (end-of-line) (point))
	    (point))
	 6)
      nil
    (forward-char 6)))

;; ---- 印刷 -------------------------------------------------------------
(defun cmail-print (page)
  "表示中のmailを印刷する. 印刷コマンドは変数cmail-print-commandで指定する."
  (interactive (list (cmail-get-page-number-from-summary)))
  (cmail-show-contents page)
  (set-buffer *cmail-mail-buffer)
  (widen)
  (if (y-or-n-p (cmail-get-resource 'print-1))
      nil
    (cmail-error-resource 'print-2))
  (cmail-message-resource 'print-3)
  (set-buffer (get-buffer-create *cmail-arrived-mail-buffer))
  (erase-buffer)
  (if running-emacs-20_3-or-later
      (cmail-set-buffer-multibyte t))
  (insert-buffer *cmail-mail-buffer)
  (funcall cmail-print-proc)
  (set-buffer *cmail-mail-buffer)
  (cmail-narrow-to-page)
  (cmail-message-resource 'print-4))

;; ---- コマンドへの出力 -------------------------------------------------
(defvar *cmail-last-pipe-command nil)

(defun cmail-pipe (comd prefix)
  "マークされたmail(マークがない場合は, カーソル行のmail)
をCOMDにパイプする. \\[universal-argument]が与えられた場合, mail毎にそれぞれ
独立にCOMDが起動される."
  (interactive
   (list (read-string (cmail-get-resource 'pipe-1) *cmail-last-pipe-command)
	 current-prefix-arg))
  (cmail-message-resource 'pipe-2)
  (setq *cmail-last-pipe-command comd)
  (let ((buffer (get-buffer-create "*Shell Command Output*"))
	(page-delimiter *cmail-re-bdr)
	msgout)
    (save-excursion
      (set-buffer buffer)
      (setq default-directory cmail-work-dir)
      (erase-buffer))
    (cmail-fixcp)
    (save-excursion
      (cmail-exec '(lambda (page)
		     (cmail-show-contents page)
		     (if prefix
			 (save-excursion
			   (set-buffer *cmail-mail-buffer)
			   (call-process-region (point-min) (point-max)
						(or shell-file-name "sh")
						nil buffer nil "-c" comd))
		       (save-excursion
			 (set-buffer *cmail-mail-buffer)
			 (append-to-buffer buffer (point-min) (point-max)))))))
    (if prefix
	nil
      (save-excursion
	(set-buffer buffer)
	(call-process-region (point-min) (point-max)
			     (or shell-file-name "sh") t t nil "-c" comd)))
    (set-buffer buffer)
    (let ((lines (count-lines (point-min) (point-max))))
      (cond
       ((= lines 0)
	(kill-buffer buffer))
       ((= lines 1)
	(setq msgout t)
	(message (buffer-substring (point-min) (1- (point-max)))))
       (t
	(display-buffer buffer))))
    (or msgout (cmail-message-resource 'pipe-3))))

;; ---- カーソル行のmailの名前を表示する(interactive) ----------------
(defun cmail-name-and-address (folder page &optional address)
  "FOLDERのPAGE番目のmailの名前と電子メイルアドレスを表示する.
付加引数ADDRESS がnon-nil の場合, 表示は行なわれずそのアドレスが返る."
  (interactive
   (list cmail-current-folder (cmail-get-page-number-from-summary)))
  (cmail-fixcp)
  (let ((str nil) (beg (if address 2 1)))
    (cmail-get-header folder)
    (setq str
	  (if (re-search-forward
		(format "^%d . [/0-9]+ \\(.*\\) \\(<[^<>]+>\\) [0-9]+" page)
		nil t)
	      (buffer-substring (match-beginning beg) (match-end 2))
	    (cmail-get-resource 'name-and-address-1)))
    (if address
	(substring str (1+ (string-match "<" str)) (string-match ">" str))
      (message (if str (cmail-format-resource1 'name-and-address-2 str)
		 (cmail-get-resource 'name-and-address-3))))))

;; ++++ 終了 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(defun cmail-summary-quit (&optional noarchive)
  (interactive "P")
  (if cmail-use-folders-mode-first
      (progn
	(setq *cmail-prev-folder cmail-current-folder)
	(cmail-folders)
	(cmail-folders-fixcp2 *cmail-prev-folder))
    (cmail-quit noarchive)))

(defun cmail-quit (&optional noarchive)
  "cmailを終了する."
  (run-hooks 'cmail-quit-hook)
  (let ((force (cmail-clean-virtual-folders)))
    (and cmail-archive-on-quit
	 (string= cmail-current-folder cmail-inbox-folder)
	 (null noarchive)
	 (cmail-auto-archive))
    (cmail-clean-virtual-folders force))
  (mapcar 'cmail-dismiss-folder *cmail-opened-folders-list)
  (setq *cmail-opened-folders-list nil)
  (setq *cmail-virtual-folders nil)
  (setq *cmail-prev-folder nil)
  (let* ((mailw (get-buffer-window *cmail-mail-buffer))
	 (summw (get-buffer-window *cmail-summary-buffer))
	 (comlp (cmail-command-line-p)))
    (if mailw (delete-windows-on *cmail-mail-buffer))
    (if summw (delete-windows-on *cmail-summary-buffer))
    (if comlp (setq command-line-args
		    (delete-if '(lambda (str)
				  (or (string= str "-f")
				      (string= str "cmail")))
			       command-line-args))))
  (let (bk)
    (and cmail-incoming-mails-folder
	 (setq bk (expand-file-name cmail-incoming-mails-folder cmail-path))
	 (file-exists-p bk)
	 (delete-file bk)))
  (let (buf)
    (and (setq buf (get-buffer *cmail-summary-buffer))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-mail-buffer))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-new-arrivals-buffer))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-arrived-mail-buffer))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-complete-address-buffer))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-reply-mail-buffer))
	 (kill-buffer buf))
    (and (boundp '*cmail-edit-buffer)
	 (setq buf (get-buffer *cmail-edit-buffer))
	 (kill-buffer buf)))
  (setq *cmail-folder-curpos nil)
  (cmail-funcall-if-defined 'cmail-after-quit-function)
  (or cmail-use-full-window
      (set-window-configuration *cmail-window-conf)))

(defun cmail-save-folder (&optional folder echo)
  "フォルダFOLDERをセーブする.
ECHO がnon-nil の場合はセーブしなかった場合にその旨を表示する."
  (interactive (list cmail-current-folder t))
  (if (null folder) (setq folder cmail-current-folder))
  (if (null (cmail-find-buffer folder))
      (and echo (cmail-message-resource1 'save-folder-1 folder))
    (if (and (not (cmail-virtual-folder-p folder))
	     (cmail-modified-p folder)
	     (or echo
		 (not cmail-query-save-folder)
		 (y-or-n-p (cmail-format-resource1 'save-folder-2 folder))))
	(progn
	  (and (cmail-expirable-folder folder)
	       (cmail-expire-mark folder t))
	  (cmail-get-folder folder)
	  (let ((modp *cmail-deleted))
	    (and cmail-expunge-on-save
		 *cmail-deleted
		 (if (not (interactive-p))
		     (cmail-execute-index folder)
		   (cmail-push-curpos)
		   (cmail-execute-index folder)
		   (cmail-make-summary cmail-current-folder t)
		   (cmail-pop-curpos)))
	    (cmail-sync-header folder)
	    (cmail-get-folder folder)
	    (cmail-backup-folder folder)
	    (cmail-save-buffer)
	    (and echo
		 (string= folder cmail-inbox-folder)
		 (cmail-flush-folders))
	    (and (interactive-p)
		 modp
		 (progn
		   (set-buffer *cmail-summary-buffer)
		   (cmail-fixcp)
		   (cmail-disp-summary)))
	    (if echo
		(cmail-message-resource1 'save-folder-3 folder)
	      (message ""))))
      (and echo
	   (cmail-message-resource1 'save-folder-4 folder)))))

(defun cmail-save-all-folders ()
  "全てのフォルダをセーブする."
  (interactive)
  (cmail-fixcp)
  (let (cmod mod idx)
    (if (equal-member cmail-current-folder *cmail-opened-folders-list)
	(save-excursion
	  (cmail-get-folder)
	  (setq cmod (and cmail-expunge-on-save *cmail-deleted))))
    (and cmod
	 (not (eobp))
	 (interactive-p)
	 (save-excursion
	   (set-buffer *cmail-summary-buffer)
	   (setq idx (cmail-get-page-number-from-summary))))
    (mapcar (function
	     (lambda (folder)
	       (if (cmail-modified-p folder)
		   (progn
		     (cmail-save-folder folder)
		     (setq mod t)))))
	    *cmail-opened-folders-list)
    (if cmod
	(cmail-make-summary)
      (and idx (cmail-goto-index idx)))
    (cmail-funcall-if-defined 'cmail-after-save-all-folders-function mod)
    (cmail-message-resource (if mod 'save-all-folders-1 'save-all-folders-2))))

(defun cmail-close-folder ()
  "現在のフォルダをクローズする."
  (interactive)
  (if cmail-use-folders-mode-first
      (progn
	(or (equal cmail-current-folder cmail-inbox-folder)
	    (cmail-dismiss-folder cmail-current-folder))
	(setq *cmail-prev-folder cmail-current-folder)
	(cmail-folders))
    (and (equal cmail-current-folder cmail-inbox-folder)
	 (cmail-error-resource1 'close-folder-1 cmail-inbox-folder))
    (let* ((new *cmail-prev-folder)
	   (*cmail-prev-folder new))
      (and (null new)
	   (setq new cmail-inbox-folder))
      (cmail-dismiss-folder cmail-current-folder)
      (or (equal-member new *cmail-opened-folders-list)
	  (setq new cmail-inbox-folder))
      (setq cmail-current-folder new)
      (cmail-visit-folder new))))

(defun cmail-dismiss-folder (folder)
  "フォルダFOLDERのバッファを削除する."
  (interactive (list cmail-current-folder))
  (cmail-save-folder folder nil)
  (cmail-funcall-if-defined 'cmail-before-dismiss-folder-function folder)
  (let (buf)
    (and (setq buf (cmail-find-buffer folder))
	 (kill-buffer buf))
    (and (setq buf (get-buffer (cmail-header-buffer folder)))
	 (kill-buffer buf)))
  (setq *cmail-opened-folders-list
	(delete-if '(lambda (str) (string= str folder))
		   *cmail-opened-folders-list))
  (and (cmail-virtual-folder-p folder)
       (setq *cmail-virtual-folders
	     (delete-if '(lambda (str) (string= str folder))
			*cmail-virtual-folders))))

(defun cmail-kill-emacs-hook ()
  (mapcar 'cmail-dismiss-folder
	  *cmail-opened-folders-list))
;; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defvar cmail-option-features '(all))
(defun cmail-load-option-features ()
  "cmail 専用の optionnal feature を読み込む。"
  (mapcar
   (function
    (lambda (dir)
      (when (file-directory-p dir)
	(let ((files (directory-files dir nil "\\`cmail-use-.*elc?\\'"))
	      name)
	  (mapcar
	   (function
	    (lambda (file)
	      (string-match "\\`\\(cmail-use.*\\)\\.elc?\\'" file)
	      (setq name (match-string 1 file))
	      (when (or (memq 'all cmail-option-features)
			(memq (intern-soft name) cmail-option-features))
		(unless (featurep (intern name))
		  ;; could not be provided unless intern
		  (if (ignore-errors (require (intern name)))
		      (message (cmail-format-resource 'options-load name)))))))
	   files)))))
   cmail-option-path-list))

;;
;; オプション用ファイルのロードを最後におこなう。
;;
(unless (and (fboundp 'cl-compiling-file) ; <- (require 'cl)
	     (cl-compiling-file))
; ... コンパイル時には実行しない。

  ;; ... オプションディレクトリを load-path に追加
  (require 'path-util) ; <- add-path
  (mapcar 'add-path cmail-option-path-list)

  ;; ... オプションファイルの組み込み
  (cmail-load-option-features)

  ;; ... custom 用の言語設定
  (cmail-i18n-swap-doc cmail-i18n-doc-language))

;;; @ End.
;;;

;;; cmail.el ends here
