;;;
;;; cmail-folders.el
;;;
;;; Author: IWAMURO Motonori <iwa@mmp.fujitsu.co.jp>
;;;
(eval-when-compile
  (require 'cmail))

;;;
;;; 変数/定数
;;;

;; キーマップの設定
(defvar cmail-folders-mode-map nil)
(cond
 ((null cmail-folders-mode-map)
  (setq cmail-folders-mode-map (make-sparse-keymap))
  (define-key cmail-folders-mode-map "P" 'cmail-folders-previous-unread-folder)
  (define-key cmail-folders-mode-map "N" 'cmail-folders-next-unread-folder)
  (define-key cmail-folders-mode-map "p" 'cmail-folders-previous-line)
  (define-key cmail-folders-mode-map "n" 'cmail-folders-next-line)
  (define-key cmail-folders-mode-map "k" 'cmail-folders-previous-line)
  (define-key cmail-folders-mode-map "j" 'cmail-folders-next-line)
  (define-key cmail-folders-mode-map " " 'cmail-folders-visit-folder)
  (define-key cmail-folders-mode-map "\C-m" 'cmail-folders-visit-folder)
  (define-key cmail-folders-mode-map "\M- " 'cmail-folders-visit-folder-without-thread)
  (define-key cmail-folders-mode-map "\M-\C-m" 'cmail-folders-visit-folder-without-thread)
  (define-key cmail-folders-mode-map "\M-\C-t" 'cmail-toggle-thread-ignore-limit)
  (define-key cmail-folders-mode-map "=" 'cmail-folders-expand-folder-window)
  (define-key cmail-folders-mode-map "l" 'cmail-folders-redisplay)
  (define-key cmail-folders-mode-map "L" 'cmail-folders-redisplay-all)
  (define-key cmail-folders-mode-map "c" 'cmail-folders-catch-up-all)
  (define-key cmail-folders-mode-map "u" 'cmail-folders-visit-parent-dir)
  (define-key cmail-folders-mode-map "d" 'cmail-folders-visit-top-dir)
  (define-key cmail-folders-mode-map "x" 'cmail-folders-toggle-unfold)
  (define-key cmail-folders-mode-map "v" 'cmail-folders-visit-folder-directly)
  (define-key cmail-folders-mode-map "V" 'cmail-folders-visit-folder-directly-without-thread)
  (define-key cmail-folders-mode-map "m" 'cmail-folders-mail)
  (define-key cmail-folders-mode-map "g" 'cmail-folders-get-newmail)
  (define-key cmail-folders-mode-map "q" 'cmail-folders-quit)
  (define-key cmail-folders-mode-map "Q" 'cmail-folders-close-all-folders)
  (define-key cmail-folders-mode-map "w" 'cmail-folders-update)
  (define-key cmail-folders-mode-map "\M-w" 'cmail-folders-update)
  (define-key cmail-folders-mode-map "\M-y" 'cmail-folders-copy-folder)
  (define-key cmail-folders-mode-map "\M-c" 'cmail-folders-copy-folder)
  (define-key cmail-folders-mode-map "\M-n" 'cmail-folders-rename-folder)
  (define-key cmail-folders-mode-map "\M-k" 'cmail-folders-kill-folder)
  (define-key cmail-folders-mode-map "C" 'cmail-folders-copy-folder)
  (define-key cmail-folders-mode-map "R" 'cmail-folders-rename-folder)
  (define-key cmail-folders-mode-map "D" 'cmail-folders-kill-folder)
  (define-key cmail-folders-mode-map "h" 'describe-mode)
  (define-key cmail-folders-mode-map "?" 'describe-mode)
  (define-key cmail-folders-mode-map "\C-i" 'cmail-folders-to-summary)))

;; メニューバー/マウスの設定
(cond
 (window-system
  (defun cmail-folders-mouse-select (event)
    (interactive "e")
    (mouse-set-point event)
    (cmail-folders-visit-folder))
  (cond
   ((or (featurep 'cmail-e19) (featurep 'cmail-e20))
    ;; メニューバー
    (define-key cmail-folders-mode-map [menu-bar] (make-sparse-keymap))
    (define-key cmail-folders-mode-map [menu-bar cmail]
      (cons "Cmail" (make-sparse-keymap "Cmail")))
    (define-key cmail-folders-mode-map [menu-bar cmail folders-quit]
      '("Folders Quit" . cmail-folders-quit))
    (define-key cmail-folders-mode-map [menu-bar cmail separator-quit]
      '("---"))
    (define-key cmail-folders-mode-map [menu-bar cmail update]
      '("Save All Folders" . cmail-folders-update))
    (define-key cmail-folders-mode-map [menu-bar cmail rename]
      '("Rename Folder" . cmail-folders-rename-folder))
    (define-key cmail-folders-mode-map [menu-bar cmail copy]
      '("Copy Folder" . cmail-folders-copy-folder))
    (define-key cmail-folders-mode-map [menu-bar cmail get]
      '("New Mail" . cmail-folders-get-newmail))
    (define-key cmail-folders-mode-map [menu-bar cmail mail]
      '("Mail Send" . cmail-folders-mail))
    (define-key cmail-folders-mode-map [menu-bar cmail unfold]
      '("Toggle Unfolding" . cmail-folders-toggle-unfold))
    (define-key cmail-folders-mode-map [menu-bar cmail top-dir]
      '("Top Directory" . cmail-folders-visit-top-dir))
    (define-key cmail-folders-mode-map [menu-bar cmail up-to-dir]
      '("Up to Directory" . cmail-folders-visit-parent-dir))
    (define-key cmail-folders-mode-map [menu-bar cmail visit]
      '("Visit Folder" . cmail-folders-visit-folder-directly))
    (if (fboundp 'customize-group)
	(progn
	  (define-key cmail-folders-mode-map [menu-bar cmail separator-folder]
	    '("--"))
	  (define-key cmail-folders-mode-map [menu-bar cmail customize]
	    '("Cmail Customize" . cmail-customize))))
    ;; マウスイベント
    (define-key cmail-folders-mode-map [mouse-2] 'cmail-folders-mouse-select))
   ((featurep 'cmail-x20)
    ;; マウスイベント
    (define-key cmail-folders-mode-map 'button2 'cmail-folders-mouse-select)))
  ))

;; キャッシュファイル名
(defvar *cmail-folders-cache
  (expand-file-name ".cmail-folders-cache.el" cmail-path))

;; その他内部変数
(defvar *cmail-folders-current-dir "")
(defvar *cmail-folders-current-dir-length
  (length *cmail-folders-current-dir))
(defvar *cmail-folders-current-dir-pattern
  (concat "^\\(" (regexp-quote *cmail-folders-current-dir) "\\)."))
(defvar *cmail-folders-beginning-point nil)
(defvar *cmail-folders-updated-folders-list '())
(defvar *cmail-folders-removed-folders-list '())
(defvar *cmail-folders-modified nil)
(defvar *cmail-folders-cache-modified nil)
(defvar *cmail-folders-system-folders-list
  (list cmail-incoming-mails-folder))
(defvar *cmail-folders-set-overlay 'ignore)
(defvar cmail-folders-mail-count-column 6) ;;; 後でcmail-vars.elあたりに移動
(defvar *cmail-folders-folder-format
  (concat "%s %" (int-to-string cmail-folders-mail-count-column) "d%s %s"))
(defvar *cmail-folders-dir-format
  (if (< cmail-folders-mail-count-column 3)
      (format "  %s: "
	      (make-string cmail-folders-mail-count-column ?*))
    (format "  %s***: "
	    (make-string (- cmail-folders-mail-count-column 3) 32))))
(defvar *cmail-folders-num-part-length
  (1- (length *cmail-folders-dir-format)))
(defvar *cmail-folders-sparate-line
  (concat (make-string cmail-folders-mail-count-column ?-) "--+---\n"))

;; 定数
(defconst *cmail-folders-buffer "**cmail-folders**")
(defconst *cmail-folders-pattern "^. *[0-9*]+[-+:] ")
(defconst *cmail-folders-pattern2 (concat *cmail-folders-pattern "\\(.*\\)$"))
(defconst *cmail-folders-tmp-buffer " *cmail-folders-tmp*")
(defconst *cmail-folders-cache-buffer " *cmail-folders-cache*")

;;;
;;; マクロ/インライン関数定義
;;;

;;; キャッシュエントリリストのクリア
(defsubst cmail-folders-init-cache-alist ()
  (setq *cmail-folders-cache-alist (list (list ""))))

;;; キャッシュエントリリストの実効部 (先頭はダミー)
(defsubst cmail-folders-cache-alist ()
  (cdr *cmail-folders-cache-alist))

;;; キャッシュエントリのディレクトリ深さを返す
(defsubst cmail-folders-get-ce-depth (entry)
  (nth 1 entry))

;;; キャッシュエントリのステータス値を返す
(defsubst cmail-folders-get-ce-status (entry)
  (nth 2 entry))

;;; キャッシュエントリのステータス値を設定する
(defsubst cmail-folders-set-ce-status (entry status)
  (setcar (nthcdr 2 entry) status))

;;; キャッシュエントリのメール数及び未読メール数を取得する
(defsubst cmail-folders-get-ce-mail-nums (entry)
  (nthcdr 3 entry))

;;; キャッシュエントリのメール数及び未読メール数を設定する
(defsubst cmail-folders-set-ce-mail-nums (entry nums)
  (setcdr (nthcdr 2 entry) nums))

;;; キャッシュエントリ中のメール数を取得する (フォルダ)
(defsubst cmail-folders-get-ce-mail-num (entry)
  (nth 3 entry))

;;; キャッシュエントリ中のメール数を設定する (フォルダ)
(defsubst cmail-folders-set-ce-mail-num (entry num)
  (setcar (nthcdr 3 entry) num))

;;; キャッシュエントリ中のフォルダ数を取得する (ディレクトリ)
(defsubst cmail-folders-get-ce-folder-num (entry)
  (nth 3 entry))

;;; キャッシュエントリ中のフォルダ数を設定する (ディレクトリ)
(defsubst cmail-folders-set-ce-folder-num (entry num)
  (setcar (nthcdr 3 entry) num))

;;; キャッシュエントリ中の未読メール数を取得する
(defsubst cmail-folders-get-ce-unread-mail-num (entry)
  (nth 4 entry))

;;; キャッシュエントリ中の未読メール数を設定する
(defsubst cmail-folders-set-ce-unread-mail-num (entry unum)
  (setcar (nthcdr 4 entry) unum))

;;; キャッシュエントリのエントリ使用フラグを取得する
(defsubst cmail-folders-get-ce-update-flag (entry)
  (nthcdr 5 entry))

;;; キャッシュエントリのエントリ使用フラグを設定する
(defsubst cmail-folders-set-ce-update-flag (entry flag)
  (setcdr (nthcdr 4 entry) flag))

;;; 仮想フォルダか?
(defsubst cmail-folders-is-virtual-folder (folder)
  (if folder
      (or (eq (aref folder 0) ?/)
	  (if (and
	       (boundp 'cmail-virtual-folder-check-function)
	       (functionp cmail-virtual-folder-check-function))
	      (funcall
	       cmail-virtual-folder-check-function folder)))))

;;; フォルダのディレクトリ部全体を返す (トップ階層以外は終端に`/'が付く)
;;; folderの終端が`/'ならばfolder全体を返す
(defsubst cmail-folders-get-dir-head (folder)
  (substring folder 0 (string-match "[^/]+$" folder)))

;;; フォルダのディレクトリ部全体を返す (トップ階層以外は終端に`/'が付く)
;;; folderの終端が`/'ならば最後のディレクトリ部は除かれる
(defsubst cmail-folders-get-dir-head2 (folder)
  (substring folder 0 (string-match "[^/]+/?$" folder)))

;;; カレントディレクトリにあるフォルダか?
(defsubst cmail-folders-is-in-dir (folder)
  (and (> (length folder) *cmail-folders-current-dir-length)
       (string-match *cmail-folders-current-dir-pattern folder)))

;;; フォルダ中、カレントディレクトリから見て一つ目のディレクトリ部を返
;;; す(終端に`/'が付く)
;;; ディレクトリ部が無ければnil
(defsubst cmail-folders-get-sub-dir (folder)
  (let ((sep (string-match "/" folder *cmail-folders-current-dir-length)))
    (if sep (substring folder *cmail-folders-current-dir-length (1+ sep)))))

;;; フォルダ名からカレントディレクトリの部分を除いた文字列を返す
(defsubst cmail-folders-get-sub-folder (folder)
  (substring folder *cmail-folders-current-dir-length))

(defsubst cmail-folders-nickname (folder)
  (if cmail-folders-nickname-display
      (let ((nick (rassoc folder (cmail-folders-nickname-alist))))
	(if nick
	    (concat *cmail-folders-current-dir (concat (car nick) "*"))
	  folder))
    folder))

(defun cmail-folders-nickname-realname (nick)
  (let (fname f)
    (if (and cmail-folders-nickname-display
	     (string-match "\\*$" nick)
	     (setq fname (substring nick 0 -1))
	     (setq f (assoc fname (cmail-folders-nickname-alist))))
	(cdr f)
      nick)))

;;; 指定のフォルダにマッチするパターンを返す
(defsubst cmail-folders-get-pattern (folder)
  (concat *cmail-folders-pattern
	  "\\(" (regexp-quote (cmail-folders-get-sub-folder (cmail-folders-nickname folder))) "\\)$"))

;;; カレントディレクトリの変更
(defsubst cmail-folders-chdir (dir)
  (setq *cmail-folders-current-dir dir
	*cmail-folders-current-dir-length (length dir)
	*cmail-folders-current-dir-pattern
	(concat "^\\(" (regexp-quote dir) "\\).")))

;;; ディレクトリ名
(defsubst cmail-folders-dir-name ()
  (if (zerop *cmail-folders-current-dir-length)
      "TOP" *cmail-folders-current-dir))

;;; 画面クリアなしでrecenterをかける
(defsubst cmail-folders-recenter ()
  (let ((height (window-height)))
    (if (> (count-lines (point-min) (1- (point-max))) height)
	(recenter (/ height 2)))))

;;; 更新されたフォルダをプッシュする
(defsubst cmail-folders-put-updated-folder (folder)
  (if (not (member folder *cmail-folders-updated-folders-list))
      (push folder *cmail-folders-updated-folders-list)))

;;; 削除されたフォルダをプッシュする
(defsubst cmail-folders-put-removed-folder (folder)
  (setq *cmail-folders-updated-folders-list
	(delete folder *cmail-folders-updated-folders-list))
  (if (not (member folder *cmail-folders-removed-folders-list))
      (push folder *cmail-folders-removed-folders-list)))

;;; 更新されたフォルダをプッシュする
(defun cmail-folders-put-updated-folder2 (folder)
  (mapcar 'cmail-folders-put-updated-folder
	  (cons folder (cmail-folders-get-path-list folder))))

;;; 削除されたフォルダをプッシュする
(defun cmail-folders-put-removed-folder2 (folder)
  (cmail-folders-put-removed-folder folder)
  (mapcar 'cmail-folders-put-updated-folder
	  (cmail-folders-get-path-list folder)))

;;; 指定のフォルダの更新状態を取得する。
;;; save-excursionしていないので要注意。
;;; 更新されたフォルダの場合、updated-folders-listに追加される
(defsubst cmail-folders-is-updated-folder (folder)
  (set-buffer (cmail-find-buffer folder))
  (when (or *cmail-folders-modified
	    (cmail-modified-p folder))
    (push folder updated-folders-list)
    (setq *cmail-folders-cache-modified t)))

;;; 通常のフォルダか?
(defsubst cmail-folders-is-normal-folder (folder)
  (not (member folder *cmail-folders-system-folders-list)))

;;; ディレクトリの深さ(=`/'の数)を取得する
(defun cmail-folders-get-depth (folder)
  (let ((index (1- (length folder)))
	(depth 0))
    (while (natnump index)
      (if (= (elt folder index) ?/)
	  (setq depth (1+ depth)))
      (setq index (1- index)))
    depth))

;;; ディレクトリエントリの生成
(defsubst cmail-folders-create-ce-directory (dir)
  (list dir (cmail-folders-get-depth dir) 'directory 0 0))

;;;
;;; 関数定義
;;;

;;; モード設定
(defun cmail-folders-mode ()
  "cmailのフォルダを選択する.
キーバインドは以下の通り,
\\{cmail-folders-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map cmail-folders-mode-map)
  (setq mode-name "Folders")
  (setq major-mode 'cmail-folders-mode)
  (setq truncate-lines t)
  (setq case-fold-search nil)
  (setq buffer-read-only t)
  (run-hooks 'cmail-folders-mode-hook))

;;; フォルダ一覧を常時表示させるかどうかをトグルする
(defun cmail-toggle-always-display-folders ()
  (interactive)
  (setq cmail-always-display-folders (not cmail-always-display-folders)))

;;; 下記のようなリストを返す
;;; "DIR1/DIR2/"       -> ("DIR1/")
;;; "DIR1/DIR2/FOLDER" -> ("DIR1/" "DIR1/DIR2/")
;;; folderが"/"で始まる仮想フォルダならnilを返す
(defun cmail-folders-get-path-list (folder)
 (if (and (cmail-folders-is-virtual-folder folder)
	  (= (elt folder 0) ?/))
     nil
    (let ((index (- (length folder) 2)) path-list)
      (while (natnump index)
	(if (= (elt folder index) ?/)
	    (push (substring folder 0 (1+ index)) path-list))
	(setq index (1- index)))
      path-list)))

;;; ファイルのサイズ及び修正時刻を返す
(defun cmail-folders-get-file-status (filename)
  (let ((status (file-attributes filename)))
    (if status
	(cons (nth 7 status) (nth 5 status)))))

;;; フォルダ中のメール数/未読メール数を数える。
;;; filenameが与えられたときは指定のファイルを調べる
(defun cmail-folders-count-mails (folder &optional filename)
  (save-excursion
    (cmail-message-resource1 'folders-count-mails-1 folder)
    (if (null filename)
	(setq filename (expand-file-name folder cmail-path)))
    (let (num unum)
      (set-buffer (get-buffer-create *cmail-folders-tmp-buffer))
      (as-binary-input-file
       (insert-file-contents filename nil nil nil t))
      (goto-char (point-min))
      (cond
       ((re-search-forward *cmail-re-bdr nil t)
	(setq num (count-lines (point-min) (match-beginning 0)))
	(setq unum 0)
	(while (re-search-backward "^[0-9]+ U" nil t)
	  (setq unum (1+ unum)))))
      (erase-buffer)
      (cmail-message-resource1 'folders-count-mails-2 folder)
      (list num unum))))

;;; バッファを元にキャッシュのエントリを返す
(defun cmail-folders-get-cache-entry-from-buffer (folder)
  (save-excursion
    (let ((unum 0))
      (set-buffer (cmail-find-buffer folder))
      (setq *cmail-folders-modified nil)
      (set-buffer (cmail-header-buffer folder))
      (save-restriction
	(widen)
	(goto-char (point-min))
	(while (re-search-forward "^[0-9]+ U" nil t)
	  (setq unum (1+ unum)))
	(list folder (cmail-folders-get-depth folder)
	      nil (count-lines (point-min) (point-max)) unum)))))

;;; ファイルを元にキャッシュのエントリを返す
(defun cmail-folders-get-cache-entry-from-file (folder)
  (let ((filename (expand-file-name folder cmail-path)))
    (nconc
     (list folder (cmail-folders-get-depth folder)
	   (cmail-folders-get-file-status filename))
     (cmail-folders-count-mails folder filename))))

;;; キャッシュエントリ群new-entriesを*cmail-folders-cache-alistに挿入す
;;; る。new-entriesの要素はソート済でなければならない。またエントリには
;;; *cmail-folders-cache-alistと同じキーがあってはならない。
(defun cmail-folders-add-new-entries (new-entries)
  (let ((alist *cmail-folders-cache-alist) alist-next)
    (mapcar
     '(lambda (new-entry)
	(while (and (setq alist-next (cdr alist))
		    (string< (car (car alist-next)) (car new-entry)))
	  (setq alist alist-next))
	(setcdr alist (cons new-entry alist-next)))
     (sort new-entries '(lambda (a b) (string< (car a) (car b)))))))

;;; entryをnew-entriesにプッシュ。ディレクトリ部がキャッシュ上になけれ
;;; ば、ディレクトリ部もnew-entriesに追加する (降順)
(defun cmail-folders-push-new-entry (entry)
  (push entry new-entries)
  (mapcar
   '(lambda (dir)
      (if (and (null (assoc dir (cmail-folders-cache-alist)))
	       (null (assoc dir new-entries)))
	  (push (cmail-folders-create-ce-directory dir) new-entries)))
   (cmail-folders-get-path-list (car entry))))

;;; バッファに保持されたフォルダのキャッシュエントリを更新する。
;;; all-opened-foldersがtならopenされているフォルダ全てに関するキャッ
;;; シュエントリを更新する。all-opened-foldersがnilなら更新されたフォ
;;; ルダに関するエントリを更新し、更新されたフォルダのリストを返す
(defun cmail-folders-update-cache-entries-on-buffer (&optional
						     all-opened-folders)
  (save-excursion
    (let (new-entries updated-folders-list)
      (mapcar
       '(lambda (folder)
	  (and (cmail-folders-is-normal-folder folder)
	       (or (cmail-folders-is-updated-folder folder)
		   all-opened-folders)
	       (let ((entry (assoc folder (cmail-folders-cache-alist)))
		     (new-entry
		      (cmail-folders-get-cache-entry-from-buffer folder)))
		 (if entry
		     (if (listp (cmail-folders-get-ce-status entry))
			 (setcdr entry (cdr new-entry))
		       (cmail-folders-set-ce-mail-nums
			entry (cmail-folders-get-ce-mail-nums new-entry)))
		   (cmail-folders-push-new-entry new-entry)))))
       *cmail-opened-folders-list)
      (cmail-folders-add-new-entries new-entries)
      updated-folders-list)))

;;; ディレクトリを再帰的に走査して*cmail-folders-cache-alistを更新する。
;;; ・入力
;;;   dir: 走査するディレクトリ (cmail-pathからの相対パス)
;;;   status-flag: non nilのときバッファ上に保持されているフォルダであっ
;;;                てもファイルステータスを取り込む
;;; ・出力
;;;   new-entries: *cmail-folders-cache-alistにエントリのないフォルダ
;;;                に対応するエントリのリスト。結果的に降順でソートさ
;;;                れる。
(defun cmail-folders-scan-folders-recursively (dir)
  (let ((dir-list (directory-files (expand-file-name dir cmail-path)
				   nil "^[^\.#%~][^~]+$")))
    (while dir-list
      (let* ((sub-folder (car dir-list))
	     (folder (concat dir sub-folder))
	     (filename (expand-file-name folder cmail-path))
	     status entry)
	(cond
	 ;; ディレクトリ
	 ((file-directory-p filename)
	  (setq folder (concat folder "/"))
	  (setq entry (assoc folder (cmail-folders-cache-alist)))
	  (if entry (nconc entry t)
	    (push (cmail-folders-create-ce-directory folder) new-entries))
	  (cmail-folders-scan-folders-recursively folder))
	 ;; フォルダファイル
	 ((setq status (cmail-folders-get-file-status filename))
	  (setq entry (assoc folder (cmail-folders-cache-alist)))
	  (if entry
	      (let ((e-status (cmail-folders-get-ce-status entry)))
		(cond
		 ((null e-status)
		  (if status-flag
		      (cmail-folders-set-ce-status entry status)))
		 ((not (equal e-status status))
		  (setcdr (cdr entry)
			  (cons status
				(cmail-folders-count-mails folder filename)))))
		(nconc entry t))
	    (push (nconc (list folder (cmail-folders-get-depth folder) status)
			 (cmail-folders-count-mails folder filename))
		  new-entries)))))
      (setq dir-list (cdr dir-list)))))

;;; *cmail-opened-folders-listのキャッシュエントリ、及び末尾のcdrがtで
;;; あるキャッシュエントリの場合、cdrをnilにする。それ以外の場合、キャッ
;;; シュエントリを*cmail-folder-cache-alistから削除する
(defun cmail-folders-remove-unused-entries ()
  (let ((alist (copy-sequence (cmail-folders-cache-alist))))
    (while alist
      (let ((entry (car alist)))
	(if (or (null (cmail-folders-get-ce-status entry))
		(cmail-folders-get-ce-update-flag entry))
	    (cmail-folders-set-ce-update-flag entry nil)
	  (delq entry *cmail-folders-cache-alist)))
      (setq alist (cdr alist)))))

;;; フォルダディレクトリをスキャンして全キャッシュエントリを更新する
(defun cmail-folders-scan-all-folders (&optional status-flag)
  (let (new-entries)
    (mapcar 'cmail-folders-put-updated-folder2
	    (cmail-folders-update-cache-entries-on-buffer t))
    (cmail-folders-scan-folders-recursively "")
    (cmail-folders-remove-unused-entries)
    (cmail-folders-add-new-entries new-entries)))

;;; エントリ中のフォルダ数を増加させる
(defsubst cmail-folders-add-ce-folder-num (dir-entry num)
  (cmail-folders-set-ce-folder-num
   dir-entry (+ (cmail-folders-get-ce-folder-num dir-entry) num)))

;;; エントリ中の未読数を増加させる
(defsubst cmail-folders-add-ce-unread-mail-num (dir-entry num)
  (cmail-folders-set-ce-unread-mail-num
   dir-entry (+ (cmail-folders-get-ce-unread-mail-num dir-entry) num)))

;;; dir-entry-listの先頭のエントリのディレクトリの深さが、depth以下に
;;; なるまでdir-entry-listをポップする。また、ポップされたエントリ中の
;;; 未読メール数を上位のエントリに足し込む
;;; ・入力
;;;   depth: ディレクトリの深さ
;;;   cur-dir-depth: dir-entry-listの先頭にあるディレクトリの深さ
;;;   dir-entry-list: ディレクトリエントリリスト
;;; ・出力
;;;   返り値: dir-entry-listの値
;;;   cur-dir-depth: dir-entry-listの先頭にあるディレクトリの深さ
;;;   dir-entry-list: ディレクトリエントリリスト
(defun cmail-folders-pop-dir-entry-list (depth)
  (let (dir-entry parent-dir-entry)
    (while (< depth cur-dir-depth)
      (setq dir-entry (pop dir-entry-list))
      (cond
       (dir-entry-list
	(setq parent-dir-entry (car dir-entry-list))
	(setq cur-dir-depth (cmail-folders-get-ce-depth parent-dir-entry))
	(cmail-folders-add-ce-unread-mail-num
	 parent-dir-entry
	 (cmail-folders-get-ce-unread-mail-num dir-entry)))
       (t
	(setq cur-dir-depth 0))))
    dir-entry-list))

;;; ディレクトリ下のフォルダ数をカウントする。結果はキャッシュエントリ
;;; に格納される
(defun cmail-folders-count-folder-num ()
  (let ((alist (cmail-folders-cache-alist))
	dir-entry-list
	(cur-dir-depth 0))
    (while alist
      (let* ((entry (car alist))
	     (folder (car entry))
	     (depth (cmail-folders-get-ce-depth entry))
	     (unum (cmail-folders-get-ce-unread-mail-num entry)))
	(cond
	 ;; 通常のファイルと"/"ではじまる仮想フォルダは無視
	 ((or (null unum)
	      (and (cmail-folders-is-virtual-folder folder)
		   (= (elt folder 0) ?/)))
	  nil)
	 ;; それ以外の仮想フォルダまたはディレクトリ
	 ((eq (cmail-folders-get-ce-status entry) 'directory)
	  (cmail-folders-set-ce-folder-num entry 0)
	  (cmail-folders-set-ce-unread-mail-num entry 0)
	  (if (<= depth cur-dir-depth)
	      ;; 階層が変わらない/浅くなる場合
	      (cmail-folders-pop-dir-entry-list (1- depth)))
	  (if dir-entry-list
	      (cmail-folders-add-ce-folder-num (car dir-entry-list) 1))
	  (push entry dir-entry-list)
	  (setq cur-dir-depth depth))
	 ;; フォルダ (トップディレクトリのフォルダは自動的に無視される)
	 ((cmail-folders-pop-dir-entry-list depth)
	  (cmail-folders-add-ce-folder-num (car dir-entry-list) 1)
	  (cmail-folders-add-ce-unread-mail-num (car dir-entry-list) unum))))
      (setq alist (cdr alist)))
    (cmail-folders-pop-dir-entry-list 0)))

;;; 旧バージョンのキャッシュデータをコンバートする
(defun cmail-folders-convert-old-cache ()
  (when (= cmail-folders-cache-format-version 1)
    (mapcar
     '(lambda (entry)
	(setcdr entry (cons (cmail-folders-get-depth (car entry))
			    (cdr entry))))
     (cmail-folders-cache-alist)))
  (when (<= cmail-folders-cache-format-version 2)
    (setq *cmail-folders-cache-alist
	  (sort *cmail-folders-cache-alist
		'(lambda (a b) (string< (car a) (car b)))))))

;;; キャッシュファイルをロードする
(defun cmail-folders-load-cache ()
  (save-excursion
    (cmail-message-resource 'folders-load-cache-1)
    (set-buffer (find-file-noselect *cmail-folders-cache))
    (auto-save-mode nil)
    (rename-buffer *cmail-folders-cache-buffer)
    (setq buffer-read-only t)
    (setq inhibit-read-only t)
    (cond
     ((and (boundp 'cmail-folders-cache-format-version)
	   (<= cmail-folders-cache-format-version 3))
      (eval-current-buffer)
      (cmail-folders-convert-old-cache))
     (t
      (erase-buffer)
      (set-buffer-modified-p nil)
      (cmail-folders-init-cache-alist)))
    (cmail-folders-scan-all-folders)
    (setq inhibit-read-only nil)
    (cmail-message-resource 'folders-load-cache-2)))

;;; キャッシュファイルをセーブする。
(defun cmail-folders-save-cache ()
  (save-excursion
    (let ((buf (get-buffer-create *cmail-folders-cache-buffer)))
      (set-buffer buf)
      (if buffer-file-name
	  nil
	(set-visited-file-name *cmail-folders-cache t)
	(auto-save-mode nil)
	(setq buffer-read-only t))
      (let ((inhibit-read-only t))
	(erase-buffer)
	(insert "(setq *cmail-folders-cache-alist '((\"\")\n")
	(mapcar
	 '(lambda (entry)
	    (when (cmail-folders-get-ce-status entry)
	      (prin1 entry buf)
	      (terpri buf)))
       (cmail-folders-cache-alist))
	(insert "))\n"
		"; Local Variables:\n"
		"; mode: Fundamental\n"
		"; cmail-folders-cache-format-version: 3\n"
		"; End:\n"))
      (save-buffer)
      (rename-buffer *cmail-folders-cache-buffer) ;keep buffer-name
      )))

;;; フォルダ/ディレクトリに対応する出力文字列を返す
(defun cmail-folders-format (entry)
  (format *cmail-folders-folder-format
	  (if (zerop (cmail-folders-get-ce-unread-mail-num entry)) " " "*")
	  (if cmail-folders-display-unread-mails
	      (cmail-folders-get-ce-unread-mail-num entry)
	    (cmail-folders-get-ce-mail-num entry))
	  (cond
	   ((listp (cmail-folders-get-ce-status entry)) ":")
	   ((member (car entry) cmail-folders-unfold-dirs) "-")
	   (t "+"))
	  (let ((folder (car entry)) f)
	    (if cmail-folders-nickname-display
		(progn
		  (if (setq f (rassoc folder (cmail-folders-nickname-alist)))
		      (concat (car f) "*")
		    (cmail-folders-get-sub-folder folder)))
	      (cmail-folders-get-sub-folder folder)))))

;;; 折りたたまずに表示してもよいフォルダ/ディレクトリか? 
(defun cmail-folders-output-p (folder)
  (and folder
       ;; extract the part of the folder string relative to current
       ;; directory.
       (string-match *cmail-folders-current-dir-pattern folder)
       (or 
	;; display if the folder is NOT in the subdirectory, either
	;; plain folder or directory name.
	(string-match "^[^/]+/?$" (substring folder (match-end 1)))
	;; display if the folder dir is NOT in the dir to be folded
	(member (cmail-folders-get-dir-head2 folder)
		cmail-folders-unfold-dirs)
	;; display if the folder dir is NOT the dir to be folded
	(member folder cmail-folders-unfold-dirs)
	;; display if the folder dir is top dir and is virtual folder
	;; and is one that start with "/" character.
	(and (cmail-folders-is-virtual-folder folder)
	     (zerop *cmail-folders-current-dir-length)
	     (= (elt folder 0) ?/))
	(and cmail-folders-nickname-display
	     (rassoc folder (cmail-folders-nickname-alist))))))

;;; エントリに対応する表示用文字列を返す。
;;; 出力しないエントリに対してはnilを返す
(defun cmail-folders-folder-line (entry)
  (and (cmail-folders-get-ce-mail-num entry)
       (or cmail-folders-display-all-folders
	   (if cmail-always-display-folders
	       (string= (car entry) cmail-inbox-folder))
	   (> (cmail-folders-get-ce-unread-mail-num entry) 0))
       (cmail-folders-output-p (car entry))
       (cmail-folders-format entry)))

(defsubst cmail-folders-output-line (entry)
  (let ((line (cmail-folders-folder-line entry)))
    (if line
	(let ((pos (point)))
	  (insert line "\n")
	  (funcall *cmail-folders-set-overlay pos)))))

(defun cmail-folders-output-all-lines ()
  (let ((cache-alist (cmail-folders-cache-alist))
	(skip-folders-list (append cmail-folders-list-top
				   cmail-folders-list-bottom nil))
	cursor)
    (if cmail-folders-nickname-display
	(progn
	  (setq cursor (cmail-folders-nickname-realnames))
	  (while cursor
	    (let* ((folder (car cursor))
		   (entry (assoc folder cache-alist)))
	      (cmail-folders-output-line entry)
	      (setq skip-folders-list (cons folder skip-folders-list))
	      (setq cursor (cdr cursor))))))
    (setq cursor cmail-folders-list-top)
    (while cursor
      (let ((entry (assoc (car cursor) cache-alist)))
	(if entry (cmail-folders-output-line entry))
	(setq cursor (cdr cursor))))
    (setq cursor cache-alist)
    (while cursor
      (let* ((entry (car cursor))
	     (folder (car entry)))
	(if (member folder skip-folders-list)
	    (setq skip-folders-list (delete folder skip-folders-list))
	  (cmail-folders-output-line entry)))
	(setq cursor (cdr cursor)))
    (setq cursor cmail-folders-list-bottom)
    (while cursor
      (let ((entry (assoc (car cursor) cache-alist)))
	(if entry (cmail-folders-output-line entry))
	(setq cursor (cdr cursor))))))

;;; バッファの作成
(defun cmail-folders-create-buffer ()
  (let ((buf (get-buffer-create *cmail-folders-buffer)) pos)
    (set-buffer buf)
    (if (not (eq major-mode 'cmail-folders-mode))
	(cmail-folders-mode))
    (setq mode-line-buffer-identification
	  (concat "cmail:   [" (cmail-folders-dir-name) "]"))
    (setq inhibit-read-only t)
    (erase-buffer)
    (insert "Directory = [" (cmail-folders-dir-name) "]\n"
	    *cmail-folders-sparate-line)
    (setq *cmail-folders-beginning-point (point))
    (if (zerop *cmail-folders-current-dir-length)
	nil
      (insert *cmail-folders-dir-format "../\n")
      (funcall *cmail-folders-set-overlay *cmail-folders-beginning-point))
    (cmail-folders-update-cache-entries-on-buffer)
    (cmail-folders-count-folder-num)
    (cmail-folders-output-all-lines)
    (setq *cmail-folders-updated-folders-list '())
    (setq *cmail-folders-removed-folders-list '())
    (set-buffer-modified-p nil)
    (setq inhibit-read-only nil)
    buf))

;;; フォルダバッファの更新

;;; list上の順序が e1 < e2 か否か
(defun cmail-folders-<-on-list (e1 e2 list)
  (let ((l1 (member e1 list))
	(l2 (member e2 list)))
    (if (and l1 l2)
	(> (length l1) (length l2))
      'error)))

;;; 挿入位置の検索
(defun cmail-folders-goto-inserting-point (sub-folder type)
  (while (and (re-search-forward *cmail-folders-pattern2 nil 0)
	      (cond
	       ((eq type 'middle)
		(let ((match-folder (match-string 1)))
		  (cond ((member match-folder sub-list-top) t)
			((member match-folder sub-list-bottom) nil)
			((string< match-folder sub-folder) t))))
	       ((eq type 'top)
		(eq (cmail-folders-<-on-list (match-string 1) sub-folder
					     sub-list-top) t))
	       ((eq type 'nick)
		(eq (cmail-folders-<-on-list (match-string 1) sub-folder
					     nick-list) t))
	       (t ;;; (eq type 'bottom)
		(cmail-folders-<-on-list (match-string 1) sub-folder
					 sub-list-bottom)))))
  (beginning-of-line))

;;; 指定のフォルダに対応する行を更新/追加する
(defun cmail-folders-update-line (folder type)
  (if (cmail-folders-output-p folder)
      (let* ((sub-folder (cmail-folders-get-sub-folder folder))
	     (pattern (cmail-folders-get-pattern folder))
	     (entry (assoc folder (cmail-folders-cache-alist)))
	     (line (cmail-folders-format entry))
	     pos overlay)
	(cond
	 ((re-search-forward pattern nil t) ;; 一致行あり
	  (setq overlay t)
	  (setq pos (match-beginning 0))
	  (replace-match line t t))
	 ((or cmail-folders-display-all-folders;; 一致行なし
	      (> (cmail-folders-get-ce-unread-mail-num entry) 0))
	  (setq overlay t)
	  (cmail-folders-goto-inserting-point sub-folder type)
	  (backward-char)
	  (insert "\n")
	  (setq pos (point))
	  (insert line)))
	(and overlay
	     (funcall *cmail-folders-set-overlay pos)))))

;;; 指定のフォルダに対応する行を削除する
(defun cmail-folders-remove-line (folder type)
  (and (cmail-folders-output-p folder)
       (re-search-forward (cmail-folders-get-pattern folder) nil t)
       (delete-region (match-beginning 0) (1+ (match-end 0)))))

;;; match-listとlistとの共通部分をmatch-listの順で返す。
;;; listにおけるmatch-listとの共通部分はnilに置換される
(defun cmail-folders-pickup-folders (match-list list)
  (delq nil (mapcar
	     '(lambda (folder)
		(let ((mem (member folder list)))
		  (when mem
		    (setcar mem nil)
		    folder))) match-list)))

(defun cmail-folders-get-sub-folders-list (list)
  (delq nil
	(mapcar
	 '(lambda (folder)
	    (if (> (length folder) *cmail-folders-current-dir-length)
		(cmail-folders-get-sub-folder folder)
	      nil))
	 list)))
      
;;; フォルダバッファの各行を更新/追加/削除する
(defun cmail-folders-modify-lines (func list)
  (let ((top-list (cmail-folders-pickup-folders 
		   cmail-folders-list-top list))
	(nick-list (cmail-folders-pickup-folders
		    (cmail-folders-nickname-realnames) list))
	(bottom-list (cmail-folders-pickup-folders
		      cmail-folders-list-bottom list))
	(sub-list-top (cmail-folders-get-sub-folders-list 
		       cmail-folders-list-top))
	(sub-list-bottom (cmail-folders-get-sub-folders-list
			  cmail-folders-list-bottom))
	folder-list type)
    (setq folder-list (nconc (list 'top)
			     top-list
			     (list 'nick)
			     nick-list
			     (list 'middle)
			     (sort (delq nil list) 'string<)
			     (list 'bottom)
			     bottom-list))
    (while folder-list
      (let ((folder (car folder-list)))
	(if (symbolp folder)
	    (setq type folder)
	  (funcall func folder type))
	(setq folder-list (cdr folder-list))))))

;;; フォルダバッファの更新
(defun cmail-folders-update-buffer ()
  (mapcar 'cmail-folders-put-updated-folder2
	  (cmail-folders-update-cache-entries-on-buffer))
  (cmail-folders-count-folder-num)
  (let ((buf (set-buffer *cmail-folders-buffer))
	(inhibit-read-only t))
    (goto-char *cmail-folders-beginning-point)
    (if (not (zerop *cmail-folders-current-dir-length))
	(beginning-of-line 2))
    (cmail-folders-modify-lines 'cmail-folders-update-line
				*cmail-folders-updated-folders-list)
    (goto-char *cmail-folders-beginning-point)
    (cmail-folders-modify-lines 'cmail-folders-remove-line
				*cmail-folders-removed-folders-list)
    (setq *cmail-folders-updated-folders-list '())
    (setq *cmail-folders-removed-folders-list '())
    (set-buffer-modified-p nil)
    buf))

;;; 指定されたフォルダのある行へ移動
(defun cmail-folders-goto-folder-line (folder)
  (if (cmail-folders-is-in-dir folder)
      (let ((pattern (cmail-folders-get-pattern folder)) window)
	(beginning-of-line)
	(when (or (re-search-forward pattern nil t)
		  (re-search-backward pattern nil t))
	  (goto-char (1- (match-beginning 1)))
	  (when (setq window (get-buffer-window (current-buffer)))
	    (select-window window)
	    (cmail-folders-recenter))
	  t))))

(defun cmail-folders-select-buffer ()
  (switch-to-buffer *cmail-folders-buffer)
  (if cmail-use-full-window
      (progn
	(delete-other-windows)
	(and cmail-always-display-folders
	     (cmail-folders-split-window t)))
    (set-window-configuration *cmail-window-conf)
    (let ((gbw (get-buffer-window *cmail-folders-buffer)))
      (if gbw
	  (select-window gbw)
	(switch-to-buffer *cmail-folders-buffer)))))

;;; cmail-foldersバッファの表示
(defun cmail-folders-buffer (&optional rescan recreate)
  (if rescan
      (cmail-folders-scan-all-folders))
  (let ((prev-dir *cmail-folders-current-dir)
	(buf (get-buffer *cmail-folders-buffer)))
    ;; cmail-current-folderの値に応じてカレントディレクトリを設定
    ;;   cmail-current-folderがフォルダモードが保持するカレントディレ
    ;;   クトリに存在しない場合、一旦トップディレクトリに移ってから表
    ;;   示の有無を確認し、表示されないならcmail-current-folderの存在
    ;;   するディレクトリに移る。ディレクトリ展開機能に対応するためこ
    ;;   のような仕様となっている。例えば、フォルダDIR-A/FOLDER-1,
    ;;   DIR-B/FOLDER-2があるとき、DIR-Bを展開してトップディレクトリか
    ;;   ら直接アクセスできるようにしているとする。ここで、一旦
    ;;   DIR-A/FOLDER-1に入ってからフォルダモードを経由せずに
    ;;   DIR-B/FOLDER-2に入ったとする。この後フォルダモードに移行する
    ;;   と、DIR-Bではなくトップディレクトリに移動することになる
    (unless (cmail-folders-is-in-dir cmail-current-folder)
      (cmail-folders-chdir ""))
    (unless (cmail-folders-output-p cmail-current-folder)
      (cmail-folders-chdir
       (cmail-folders-get-dir-head cmail-current-folder)))
    (if (or rescan
	    recreate
	    (null buf)
	    (not (string= prev-dir *cmail-folders-current-dir)))
	(cmail-folders-create-buffer) ; バッファを新規作成
      (cmail-folders-update-buffer))  ; バッファを更新
    ))

(defun cmail-folders-fixcp ()
  (goto-char *cmail-folders-beginning-point)
  (if (or cmail-folders-display-unread-mails
	  cmail-always-display-folders
	  (not (re-search-forward "^\\*[ ]*[0-9]+[:\\+] " nil t)))
      (if (or (null cmail-current-folder)
	      (not (cmail-folders-goto-folder-line cmail-current-folder)))
	  (progn
	    (goto-char *cmail-folders-beginning-point)
	    (move-to-column *cmail-folders-num-part-length)))))

(defun cmail-folders-fixcp2 (folder)
  (if (and folder
	   (not (string= folder ""))
	   (>= (length folder) *cmail-folders-current-dir-length)
	   (cmail-folders-goto-folder-line folder))
      nil
    (goto-char *cmail-folders-beginning-point)
    (move-to-column *cmail-folders-num-part-length)))

(defun cmail-folders-push-curpos ()
  (let ((buf (get-buffer *cmail-folders-buffer)))
    (if buf
	(save-excursion
	  (set-buffer buf)
	  (cmail-folders-get-current-folder))
      cmail-current-folder)))

(defun cmail-folders-pop-curpos (pos)
  (let ((cmail-current-folder pos))
    (cmail-folders-fixcp)))

(defun cmail-folders (&optional rescan recreate confirm)
  "フォルダ一覧モードに入る.
\\[universal-argument]が与えられた場合, メールディレクトリを再走査する."
  (interactive "P")
  ;; cmailが起動されていなければcmail-startを実行
  (if (null (get-buffer *cmail-summary-buffer))
      (save-excursion (cmail-start (if confirm cmail-inbox-folder))))
  (let ((pos (cmail-folders-push-curpos)))
    (cmail-folders-buffer rescan recreate)
    (cmail-folders-select-buffer)
    (cmail-folders-pop-curpos pos)))

(defun cmail-folders-expand-folder-window ()
  "サマリウィンドウとメイルウィンドウを消去する"
  (interactive)
  (if cmail-use-full-window
      (delete-other-windows)
    (let ((swin (get-buffer-window *cmail-summary-buffer))
	  (mwin (get-buffer-window *cmail-mail-buffer)))
      (and swin (delete-window swin))
      (and mwin (delete-window mwin))))
  (switch-to-buffer *cmail-folders-buffer)
  (recenter))

(defun cmail-folders-redisplay ()
  (interactive)
  (let ((pos (cmail-folders-push-curpos)))
    (cmail-folders-create-buffer)
    (cmail-folders-pop-curpos pos)))

(defun cmail-folders-redisplay-all ()
  (interactive)
  (let ((pos (cmail-folders-push-curpos))
	(cmail-folders-display-all-folders t))
    (cmail-folders-create-buffer)
    (cmail-folders-pop-curpos pos)))

(defun cmail-folders-split-window (&optional called-from-folders-mode)
  "Summaryバッファが表示されていたらそちらに飛ぶ.
表示されていない場合や, 生成されていない場合には，
そのウィンドウを生成する."
  (let ((fol (car cmail-window-horizontal-size))
	(smr (cdr cmail-window-horizontal-size))
	wwi adf)
    (setq wwi (window-width))
    (and cmail-always-display-folders
	 (get-buffer *cmail-folders-buffer)
	 (if (and (eq cmail-always-display-folders 'auto)
		  (< wwi cmail-always-display-folders-threshold))
	     (setq adf nil)
	   (setq adf t)))
    (if adf
	(progn
	  (if fol
	      (let ((total (+ fol smr)))
		(setq fol (max window-min-width (/ (* wwi fol) total)))
		(setq smr (max window-min-width (/ (* wwi smr) total)))
		(if (< wwi smr)
		    (enlarge-window (- smr wwi))))
	    (if (< (- wwi window-min-width) smr)
		(setq smr (- wwi window-min-width)))
	    (setq fol (- wwi smr)))
	  (save-excursion
	    (split-window nil fol t)
	    (if called-from-folders-mode
		(switch-to-buffer-other-window *cmail-summary-buffer)
	      (switch-to-buffer *cmail-folders-buffer)
	      (save-excursion
		(cmail-folders-buffer)))
	    (other-window 1))))))

;;; cmail本体との同期処理

;;; folderに対応するキャッシュエントリを更新する
(defun cmail-folders-update-cache-entry (folder)
  (let ((entry (assoc folder (cmail-folders-cache-alist))) new-entries)
    (if entry
	(setcdr entry
		(cdr (if (member folder *cmail-opened-folders-list)
			 (cmail-folders-get-cache-entry-from-buffer folder)
		       (cmail-folders-get-cache-entry-from-file folder))))
      (cmail-folders-push-new-entry
       (if (and (cmail-folders-is-virtual-folder folder)
		(member folder *cmail-opened-folders-list))
	   (cmail-folders-get-cache-entry-from-buffer folder)
	 (cmail-folders-get-cache-entry-from-file folder)))
      (cmail-folders-add-new-entries new-entries))))

;;; folderに対応するキャッシュエントリを削除する
(defun cmail-folders-remove-cache-entry (folder)
  (let ((entry (assoc folder (cmail-folders-cache-alist))))
    (if entry
	(delq entry *cmail-folders-cache-alist))))

;;; オープン済フォルダにおけるキャッシュエントリを更新する
(defun cmail-folders-scan-opened-folders ()
  (mapcar 'cmail-folders-put-updated-folder2
	  (cmail-folders-update-cache-entries-on-buffer))
  (mapcar
   '(lambda (folder)
      (let ((entry (assoc folder (cmail-folders-cache-alist))))
	(and entry
	     (cmail-folders-is-normal-folder folder)
	     (not (cmail-folders-is-virtual-folder folder))
	     (cmail-folders-set-ce-status
	      entry
	      (cmail-folders-get-file-status
	       (expand-file-name folder cmail-path))))))
   *cmail-opened-folders-list))

;;; オープン済フォルダにおけるキャッシュエントリのファイルステータス部
;;; をクリアする。各関数でそのエントリがオープン済みファイルであると認
;;; 識される。
(defun cmail-folders-clear-opened-folder-status ()
  (mapcar
   '(lambda (folder)
      (if (cmail-folders-is-normal-folder folder)
	  (let ((entry (assoc folder (cmail-folders-cache-alist))))
	    (if entry
		(cmail-folders-set-ce-status entry nil)))))
   *cmail-opened-folders-list))

;;; cmail-copy-folder実行時に呼び出される
(defun cmail-after-copy-folder-function (folder1 folder2)
  (when *cmail-folders-cache-alist
    (when (cmail-folders-is-normal-folder folder1)
      (cmail-folders-update-cache-entry folder1)
      (cmail-folders-put-updated-folder2 folder1))
    (when (cmail-folders-is-normal-folder folder2)
      (cmail-folders-update-cache-entry folder2)
      (cmail-folders-put-updated-folder2 folder2))
    (setq *cmail-folders-cache-modified t)))

;;; cmail-rename-folder実行時に呼び出される
(defun cmail-after-rename-folder-function (folder1 folder2)
  (when *cmail-folders-cache-alist
    (when (cmail-folders-is-normal-folder folder1)
      (cmail-folders-remove-cache-entry folder1)
      (cmail-folders-put-removed-folder2 folder1))
    (when (cmail-folders-is-normal-folder folder2)
      (cmail-folders-update-cache-entry folder2)
      (cmail-folders-put-updated-folder2 folder2))
    (setq *cmail-folders-cache-modified t)))

;;; cmail-kill-folder実行時に呼び出される
(defun cmail-after-kill-folder-function (folder)
  (when (and *cmail-folders-cache-alist
	     (cmail-folders-is-normal-folder folder))
    (cmail-folders-remove-cache-entry folder)
    (cmail-folders-put-removed-folder2 folder)
    (setq *cmail-folders-cache-modified t)))

;;; cmail-save-all-folders実行時に呼び出される
(defun cmail-after-save-all-folders-function (mod)
  (when (and (or mod
		 *cmail-folders-cache-modified)
	     *cmail-folders-cache-alist)
    (cmail-message-resource 'after-save-all-folders-function-1)
    (cmail-folders-scan-opened-folders)
    (cmail-folders-save-cache)
    (cmail-folders-clear-opened-folder-status)
    (setq *cmail-folders-cache-modified nil)))

;;; cmail-quit実行時に呼び出される
(defun cmail-after-quit-function ()
  (when (and *cmail-folders-cache-modified
	     *cmail-folders-cache-alist)
    (cmail-message-resource 'after-save-all-folders-function-1)
    (cmail-folders-scan-all-folders t)
    (cmail-folders-save-cache)
    (cmail-message-resource 'after-quit-function-2))
  (let (buf)
    (and (setq buf (get-buffer *cmail-folders-buffer))
	 (kill-buffer buf))
    (and (setq buf (find-buffer-visiting *cmail-folders-cache))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-folders-tmp-buffer))
	 (kill-buffer buf))
    (and (setq buf (get-buffer *cmail-folders-nickname-buffer))
	 (kill-buffer buf)))
  (setq *cmail-folders-cache-modified nil)
  (setq *cmail-folders-cache-alist nil)
  (setq *cmail-folders-updated-folders-list nil)
  (setq *cmail-folders-removed-folders-list nil))

;;; cmail-dismiss-folder実行時に呼び出される
(defun cmail-before-dismiss-folder-function (folder)
  (when (and *cmail-folders-cache-alist
	     (cmail-folders-is-normal-folder folder))
    (let ((entry (assoc folder (cmail-folders-cache-alist))))
      (when entry
	(if (cmail-folders-is-virtual-folder folder)
	    (progn
	      (delq entry *cmail-folders-cache-alist)
	      (cmail-folders-put-removed-folder folder))
	  (setcdr entry
		  (cdr (cmail-folders-get-cache-entry-from-buffer folder)))
	  (cmail-folders-set-ce-status entry
				       (cmail-folders-get-file-status
					(expand-file-name folder cmail-path)))
	  (cmail-folders-put-updated-folder2 folder))))))

(defun cmail-folders-previous-unread-folder ()
  "上の未読メイルのあるフォルダへ移動する."
  (interactive)
  (let ((pos (point)))
    (beginning-of-line)
    (if (re-search-backward "^\\*[ ]*[0-9]+[:\\+]" nil t)
	(progn
	  (forward-char *cmail-folders-num-part-length)
	  (cmail-folders-visit-folder) t)
      (goto-char pos)
      (cmail-message-resource 'folders-previous-unread-folder-1)
      nil)))

(defun cmail-folders-next-unread-folder ()
  "下の未読メイルのあるフォルダへ移動する."
  (interactive)
  (let ((found (re-search-forward "^\\*[ ]*[0-9]+[:\\+]" nil t)))
    (if found
	(cmail-folders-visit-folder)
      (cmail-message-resource 'folders-previous-unread-folder-1))
    found))

(defun cmail-folders-previous-line ()
  "上のフォルダへ移動する."
  (interactive)
  (beginning-of-line 0)
  (if (>= (point) *cmail-folders-beginning-point)
      (move-to-column *cmail-folders-num-part-length)))

(defun cmail-folders-next-line ()
  "下のフォルダへ移動する."
  (interactive)
  (beginning-of-line 2)
  (if (>= (point) *cmail-folders-beginning-point)
      (move-to-column *cmail-folders-num-part-length)))

(defun cmail-folders-to-summary ()
  "フォルダバッファからサマリバッファにカーソルを移動させる."
  (interactive)
  (cmail-select-buffer *cmail-summary-buffer))

(defun cmail-summary-to-folders ()
  "サマリバッファからフォルダバッファにカーソルを移動させる."
  (interactive)
  (cmail-select-buffer *cmail-folders-buffer)
  (beginning-of-line)
  (forward-char *cmail-folders-num-part-length))

;;; 親ディレクトリを取得する
(defun cmail-folders-get-parent-dir ()
  (let ((sep (string-match "/[^/]+/$" *cmail-folders-current-dir)))
    (if sep (substring *cmail-folders-current-dir 0 (1+ sep)) "")))

;;; 現在行のフォルダ名
(defun cmail-folders-get-current-folder ()
  (save-excursion
    (when (>= (point) *cmail-folders-beginning-point)
      (beginning-of-line)
      (if (re-search-forward *cmail-folders-pattern2 nil t)
	  (let ((sub-folder (match-string 1)))
	    (goto-char (match-beginning 1))
	    (if (string= sub-folder "../")
		(cmail-folders-get-parent-dir)
	      (if (and cmail-folders-nickname-display
		       (string-match "\\*$" sub-folder)
		       (setq sub-folder (substring sub-folder 0 -1)))
		  (let ((f (assoc sub-folder (cmail-folders-nickname-alist))))
		    (and f (cdr f)))
		(concat *cmail-folders-current-dir sub-folder))))))))

;;; ディレクトリか否か
(defun cmail-folders-is-dir (folder)
  (or (zerop (length folder))
      (eq (elt folder (1- (length folder))) ?/)))

;;; ディレクトリにvisitする
(defun cmail-folders-visit-dir (dir)
  (let ((prev-dir *cmail-folders-current-dir))
    (cmail-folders-chdir dir)
    (cmail-folders-create-buffer)
    (cmail-folders-select-buffer)
    (if (cmail-folders-is-in-dir prev-dir)
	(or (cmail-folders-goto-folder-line
	     (substring
	      prev-dir
	      0 (1+ (string-match "/" prev-dir
				  *cmail-folders-current-dir-length))))
	    (let ((pattern (cmail-folders-get-pattern prev-dir)))
	      (goto-char *cmail-folders-beginning-point)
	      (if (re-search-forward
		   (substring pattern 0 (1- (length pattern))) nil t)
		  (goto-char (match-beginning 1))
		(move-to-column *cmail-folders-num-part-length))))
      (goto-char *cmail-folders-beginning-point)
      (move-to-column *cmail-folders-num-part-length))))

;;; フォルダにvisitする
(defun cmail-folders-visit-sub-folder (folder)
  (let (*cmail-prev-folder)
    (set-buffer (get-buffer-create *cmail-summary-buffer))
    (cmail-visit-folder folder t)))

(defun cmail-folders-visit-folder-without-thread ()
  "FOLDERに入る. thread表示対象のFOLDERでもthread表示を行わない."
  (interactive)
  (let ((folder (cmail-folders-get-current-folder)))
    (if folder
	(if (cmail-folders-is-dir folder)
	    (cmail-folders-visit-dir folder)
	  (cmail-get-folder folder)
	  (setq *cmail-disp-thread nil)
	  (setq cmail-current-folder nil)
	  (cmail-folders-visit-sub-folder folder)))))

(defun cmail-folders-visit-folder ()
  "FOLDERに入る."
  (interactive)
  (let ((folder (cmail-folders-get-current-folder)))
    (if folder
	(if (cmail-folders-is-dir folder)
	    (cmail-folders-visit-dir folder)
	  (cmail-folders-visit-sub-folder folder)))))

(defun cmail-folders-visit-parent-dir ()
  "一つ上の階層に移る."
  (interactive)
  (cmail-folders-visit-dir (cmail-folders-get-parent-dir)))

(defun cmail-folders-visit-top-dir ()
  "トップの階層に移る."
  (interactive)
  (cmail-folders-visit-dir ""))

;;; ディレクトリを展開する
(defun cmail-folders-unfold-dir (dir)
  (let ((pos (point)))
    (push dir cmail-folders-unfold-dirs)
    (cmail-folders-create-buffer)
    (goto-char pos)
    (cmail-folders-recenter)))

;;; ディレクトリを折り畳む
(defun cmail-folders-fold-dir (dir)
  (setq cmail-folders-unfold-dirs (delete dir cmail-folders-unfold-dirs))
  (cmail-folders-create-buffer)
  (let ((path-list (cons dir (nreverse (cmail-folders-get-path-list dir)))))
    (while (cond
	    ((cmail-folders-goto-folder-line (car path-list)) nil)
	    ((setq path-list (cdr path-list)) t)
	    (t (goto-char *cmail-folders-beginning-point)
	       (move-to-column *cmail-folders-num-part-length) nil)))))

(defun cmail-folders-toggle-unfold ()
  "ディレクトリの展開状態を切り換える."
  (interactive)
  (let ((dir (cmail-folders-get-dir-head (cmail-folders-get-current-folder))))
    (cond
     ((or (string= dir "/")
	  (<= (length dir) *cmail-folders-current-dir-length))
      nil)
     ((member dir cmail-folders-unfold-dirs)
      (cmail-folders-fold-dir dir))
     (t
      (cmail-folders-unfold-dir dir)))))

(defun cmail-folders-visit-folder-directly-without-thread (folder)
  "直接FOLDERに入る. thread表示対象のFOLDERでもthread表示を行わない."
  (interactive (list (cmail-complete-foldername (cmail-get-resource 'visit-folder-1))))
  (cmail-get-folder folder)
  (setq *cmail-disp-thread nil)
  (setq cmail-current-folder nil)
  (cmail-folders-visit-sub-folder folder))

(defun cmail-folders-visit-folder-directly (folder)
  "直接FOLDERに入る."
  (interactive (list (cmail-complete-foldername (cmail-get-resource 'visit-folder-1))))
  (cmail-folders-visit-sub-folder folder))

(defun cmail-folders-mail ()
  "メイルを出す."
  (interactive)
  (let ((gbw (get-buffer-window *cmail-summary-buffer)))
    (if gbw
	(select-window gbw))
    (cmail-mail2 t nil nil nil nil nil nil nil
		 (cmail-cc-me-p 'when-new-compose))))

(defun cmail-folders-update (&optional rescan)
  "全てのフォルダをセーブしてフォルダ一覧画面を更新する.
\\[universal-argument]が与えられた場合, メールディレクトリを再走査する."
  (interactive "P")
  (if (null rescan)
      (save-excursion
	(cmail-message-resource 'folders-update-1)
	(save-window-excursion
	  (cmail-save-all-folders)))
    (save-excursion
      (save-window-excursion
	(set-buffer *cmail-summary-buffer)
	(cmail-flush-folders)))
    (cmail-folders-save-cache)
    (cmail-message-resource 'folders-update-2)
    (cmail-folders-scan-all-folders))
  (let ((folder (cmail-folders-get-current-folder)))
    (cmail-folders-create-buffer)
    (cmail-folders-fixcp2 folder))
  (when rescan
    (cmail-message-resource 'folders-update-3)))

(defun cmail-folders-get-newmail ()
  "新着メールを取得する."
  (interactive)
  (let (updated-folders updated-p)
    (if (and (boundp 'cmail-folders-update-function)
	     (functionp cmail-folders-update-function))
	(progn
	  (setq updated-folders (funcall cmail-folders-update-function))
	  (if updated-folders
	      (progn
		(setq updated-p t)
		(if cmail-archive-on-get
		    (progn
		      (while updated-folders
			(cmail-make-summary (car updated-folders))
			(cmail-auto-archive nil t)
			(setq updated-folders (cdr updated-folders)))
		      (cmail-folders nil t))
		  (cmail-folders-redisplay))))))
    (cond
     ((cmail-get-spooled-mail)
      (setq updated-p t)
      (setq cmail-current-folder cmail-inbox-folder)
      (cond
       (cmail-archive-on-get
	(cmail-make-summary cmail-inbox-folder)
	(cmail-auto-archive)
	(cmail-folders nil t))
       (cmail-use-folders-mode-first
	(cmail-folders nil t)
	(cmail-make-summary cmail-inbox-folder)
	(cmail-folders-visit-sub-folder cmail-inbox-folder))
       (t
	(cmail-folders nil t))))
     (t
      (or cmail-folders-display-all-folders
	  (cmail-folders nil t))))
    (if (not updated-p)
	(cmail-message-resource 'get-spooled-mail-9))))

;;; interactiveのためのパラメータを返す
(defun cmail-folders-get-interactive-param (prompt emes)
  (let ((folder (cmail-folders-get-current-folder)))
    (if (and folder (not (cmail-folders-is-dir folder)))
	(list folder
	      (cmail-complete-foldername
	       (cmail-format-resource1 prompt folder) nil nil *cmail-folders-current-dir))
      (cmail-error-resource emes)
      (list nil nil))))

;;; cmail-foldersバッファ中の位置をマークする
(defun cmail-folders-keep-position ()
  (beginning-of-line)
  (point-marker))

;;; cmail-foldersバッファ中でマークした位置を回復する
(defun cmail-folders-recover-position (m)
  (goto-char m)
  (beginning-of-line)
  (if (or (re-search-forward *cmail-folders-pattern nil t)
	  (re-search-backward *cmail-folders-pattern nil t))
      (goto-char (1- (match-end 0))))
  (set-marker m nil))

(defun cmail-folders-copy-folder (folder1 folder2)
  "カレント行のFOLDERをFOLDER2にコピーする.
注意事項はcmail-copy-folderと同じ."
  (interactive (cmail-folders-get-interactive-param
		'folders-copy-folder-1 'folders-copy-folder-2))
  (when folder1
    (save-window-excursion
      (cmail-copy-folder folder1 folder2))
    (let ((m (cmail-folders-keep-position)))
      (cmail-folders-update-buffer)
      (cmail-folders-recover-position m))))

(defun cmail-folders-rename-folder (folder1 folder2)
  "カレント行のFOLDERの名前をFOLDER2にする.
注意事項はcmail-rename-folderと同じ."
  (interactive (cmail-folders-get-interactive-param
		'folders-rename-folder-1 'folders-rename-folder-2))
  (when folder1
    (save-window-excursion
      (cmail-rename-folder folder1 folder2))
    (let ((m (cmail-folders-keep-position)))
      (cmail-folders-update-buffer)
      (cmail-folders-recover-position m))))

;;; カレント行のディレクトリを削除する
(defun cmail-folders-kill-dir (dir)
  (when (yes-or-no-p (cmail-format-resource1 'folders-kill-dir-1 dir))
    (delete-directory (expand-file-name dir cmail-path))
    (cmail-folders-remove-cache-entry dir)
    (cmail-folders-put-removed-folder dir)))

(defun cmail-folders-kill-folder ()
  "カレント行のFOLDERを削除する."
  (interactive)
  (let ((folder (cmail-folders-get-current-folder))
	m *cmail-prev-folder)
    (cond
     ((null folder)
      (cmail-error-resource 'folders-kill-folder-1))
     ((cmail-folders-is-dir folder)
      (if (<= (length folder) *cmail-folders-current-dir-length)
	  (cmail-error-resource 'folders-kill-folder-2))
      (cmail-folders-kill-dir folder))
     (t
      (save-window-excursion
	(condition-case nil
	    (cmail-kill-folder folder)
	  (error nil)))))
    (setq m (cmail-folders-keep-position))
    (cmail-folders-update-buffer)
    (cmail-folders-recover-position m)))

(defun cmail-folders-quit-internal ()
  (cond
   ((y-or-n-p (cmail-get-resource 'folders-quit-internal-1))
    (cmail-select-buffer *cmail-summary-buffer)
    (if (not cmail-archive-on-quit)
	(cmail-quit t)
      (if (not (string= cmail-current-folder cmail-inbox-folder))
	(cmail-folders-visit-sub-folder cmail-inbox-folder))
      (cmail-quit)))
   (t
    (message nil))))

(defun cmail-folders-quit ()
  "cmailを終了する."
  (interactive)
  (if (and cmail-use-visiting-parent-dir-as-quit
	   (not (zerop *cmail-folders-current-dir-length)))
      (cmail-folders-visit-parent-dir)
    (if cmail-use-folders-mode-first
	(cmail-folders-quit-internal)
      (cmail-folders-visit-sub-folder cmail-current-folder))))

(defun cmail-folders-catch-up-all ()
  (interactive)
  (cmail-folders-visit-folder)
  (cmail-catch-up-all nil))

;;; フォルダ一覧を返す
(defun cmail-folders-get-folders-list (&optional with-dir)
  (mapcar 'cmail-folders-put-updated-folder2
	  (cmail-folders-update-cache-entries-on-buffer))
  (let (folders-list folder)
    (mapcar
     '(lambda (entry)
	(and (cmail-folders-get-ce-mail-num entry)
	     (or (listp (cmail-folders-get-ce-status entry)) with-dir)
	     (progn
	       (setq folder (car entry))
	       (and (eq cmail-compressed-folders 'jam-zcat)
		    (string-match "\\.gz$\\|\\.Z$" folder)
		    (setq folder (substring folder 0 (match-beginning 0))))
	       (and cmail-folders-nickname-display
		    (let ((f (rassoc folder *cmail-folders-nickname-alist)))
		      (if f (setq folder (concat (car f) "*")))))
	       (push (list folder) folders-list))))
     (cmail-folders-cache-alist))
    (nreverse folders-list)))

(defun cmail-folders-close-all-folders ()
  "INBOXを除く全フォルダをクローズする."
  (interactive)
  (save-excursion
    (save-window-excursion
      (cmail-save-all-folders)
      (mapcar
       '(lambda (folder)
	  (if (equal folder cmail-inbox-folder)
	      (cmail-save-folder folder)
	    (unless (cmail-folders-is-virtual-folder folder)
	      (cmail-dismiss-folder folder)
	      (cmail-message-resource1 'folders-close-all-folders-1 folder))))
       *cmail-opened-folders-list))
    (cmail-message-resource 'folders-close-all-folders-2)))

(defvar cmail-folders-nickname-display nil)
(defvar *cmail-folders-nickname-alist '())
(defun cmail-folders-nickname-realnames ()
  (let ((cursor (cmail-folders-nickname-alist)) realnames)
    (while cursor
      (setq realnames (cons (cdr (car cursor)) realnames))
      (setq cursor (cdr cursor)))
    realnames))

(defvar *cmail-folders-nicknames
  (expand-file-name ".cmail-folder-nicknames" cmail-path))
(defvar *cmail-folders-nicknames-age nil)
(defconst *cmail-folders-nickname-buffer " *cmail-folders-nicknames*")

(defun cmail-folders-load-nicknames ()
  (save-excursion
    (set-buffer (find-file-noselect *cmail-folders-nicknames))
    (auto-save-mode nil)
    (rename-buffer *cmail-folders-nickname-buffer)
    (let ((buffer-read-only t)
	  (inhibit-read-only t)
	  nick folder alist)
      (goto-char (point-min))
      (while (re-search-forward "^\\([^ \t]*\\)[ \t]+\\(.*\\)" nil t)
	(setq folder (buffer-substring (match-beginning 1) (match-end 1)))
	(setq nick (buffer-substring (match-beginning 2) (match-end 2)))
	(setq alist (cons (cons folder nick) alist)))
      (setq inhibit-read-only nil)
      alist)))

(defun cmail-folders-nickname-alist ()
  (if (and *cmail-folders-nickname-alist
	   *cmail-folders-nicknames-age
	   (cmail-older (nth 5 (file-attributes *cmail-folders-nicknames))
			*cmail-folders-nicknames-age))
      *cmail-folders-nickname-alist
    (setq *cmail-folders-nickname-alist (cmail-folders-load-nicknames))))

(provide 'cmail-folders)
