New feature: toggle visibility of mime buttons.

[more-wl.git] / wl / wl-folder.el

;;; wl-folder.el --- Folder mode for Wanderlust.

;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>

;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
;; Keywords: mail, net news

;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;

;;; Commentary:
;;

;;; Code:
;;

(require 'elmo-vars)
(require 'elmo-util)
(require 'elmo)
(require 'wl-vars)
(condition-case ()
    (require 'easymenu) ; needed here.
  (error))

(eval-when-compile
  (require 'cl)
  (require 'wl-util)
  (provide 'wl-folder)
  (require 'wl)
  (require 'elmo-nntp))

(defcustom wl-folder-init-hook nil
  "A hook called after folder initialization is finished."
  :type 'hook
  :group 'wl)

(defvar wl-folder-buffer-name "Folder")
(defvar wl-folder-entity nil)           ; desktop entity.
(defvar wl-folder-group-alist nil)      ; opened or closed
(defvar wl-folder-entity-id nil) ; id
(defvar wl-folder-entity-hashtb nil)
(defvar wl-folder-entity-id-name-hashtb nil)
(defvar wl-folder-elmo-folder-hashtb nil)  ; name => elmo folder structure

(defvar wl-folder-newsgroups-hashtb nil)
(defvar wl-folder-info-alist-modified nil)

(defvar wl-folder-mode-map nil)

(defvar wl-folder-buffer-disp-summary nil)
(defvar wl-folder-buffer-cur-entity-id nil)
(defvar wl-folder-buffer-last-visited-entity-id nil)
(defvar wl-folder-buffer-cur-path nil)
(defvar wl-folder-buffer-cur-point nil)

(make-variable-buffer-local 'wl-folder-buffer-disp-summary)
(make-variable-buffer-local 'wl-folder-buffer-cur-entity-id)
(make-variable-buffer-local 'wl-folder-buffer-last-visited-entity-id)
(make-variable-buffer-local 'wl-folder-buffer-cur-path)
(make-variable-buffer-local 'wl-folder-buffer-cur-point)

(defconst wl-folder-entity-regexp "^\\([ ]*\\)\\(\\[[\\+-]\\]\\)?\\([^\\[].+\\):[-*0-9]+/[-*0-9]+/[-*0-9]+")
(defconst wl-folder-group-regexp  "^\\([ ]*\\)\\[\\([\\+-]\\)\\]\\(.+\\):[0-9-]+/[0-9-]+/[0-9-]+\n")
;;                              1:indent 2:opened 3:group-name
(defconst wl-folder-unsync-regexp ":[^0\\*][0-9]*/[0-9\\*-]+/[0-9\\*-]+$")

(defvar wl-folder-mode-menu-spec
  '("Folder"
    ["Enter Current Folder" wl-folder-jump-to-current-entity t]
    ["Prev Folder"          wl-folder-prev-entity t]
    ["Next Folder"          wl-folder-next-entity t]
    ["Check Current Folder" wl-folder-check-current-entity t]
    ["Sync Current Folder"  wl-folder-sync-current-entity t]
;    ["Drop Current Folder" wl-folder-drop-unsync-current-entity t]
    ["Prefetch Current Folder" wl-folder-prefetch-current-entity t]
    "----"
    ["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t]
    ["Expire Current Folder" wl-folder-expire-current-entity t]
    "----"
    ["Go to Draft Folder" wl-folder-goto-draft-folder t]
    ["Empty trash" wl-folder-empty-trash t]
    ["Flush queue" wl-folder-flush-queue t]
    "----"
    ["Open All" wl-folder-open-all t]
    ["Open All Unread folder" wl-folder-open-all-unread-folder t]
    ["Close All" wl-folder-close-all t]
    ("Folder Manager"
     ["Add folder" wl-fldmgr-add t]
     ["Add group" wl-fldmgr-make-group t]
     ["Copy" wl-fldmgr-copy t]
     ["Cut" wl-fldmgr-cut t]
     ["Paste" wl-fldmgr-yank t]
     ["Set petname" wl-fldmgr-set-petname t]
     ["Rename" wl-fldmgr-rename t]
     ["Save" wl-fldmgr-save-folders t]
     "----"
     ["Unsubscribe" wl-fldmgr-unsubscribe t]
     ["Display all" wl-fldmgr-access-display-all t])
    "----"
    ["Write a message" wl-draft t]
    ["Write for current folder" wl-folder-write-current-folder t]
    "----"
    ["Wanderlust NEWS" wl-news t]
    "----"
    ["Toggle Plug Status" wl-toggle-plugged t]
    ["Change Plug Status" wl-plugged-change t]
    "----"
    ["Save Current Status"  wl-save t]
    ["Update Status"        wl-status-update t]
    ["Exit"                 wl-exit t]
    ))

(if wl-on-xemacs
    (defun wl-folder-setup-mouse ()
      (define-key wl-folder-mode-map 'button2 'wl-folder-click)
      (define-key wl-folder-mode-map 'button4 'wl-folder-prev-entity)
      (define-key wl-folder-mode-map 'button5 'wl-folder-next-entity)
      (define-key wl-folder-mode-map [(shift button4)]
        'wl-folder-prev-unread)
      (define-key wl-folder-mode-map [(shift button5)]
        'wl-folder-next-unread))
  (defun wl-folder-setup-mouse ()
    (define-key wl-folder-mode-map [mouse-2] 'wl-folder-click)
    (define-key wl-folder-mode-map [mouse-4] 'wl-folder-prev-entity)
    (define-key wl-folder-mode-map [mouse-5] 'wl-folder-next-entity)
    (define-key wl-folder-mode-map [S-mouse-4] 'wl-folder-prev-unread)
    (define-key wl-folder-mode-map [S-mouse-5] 'wl-folder-next-unread)))

(if wl-folder-mode-map
    nil
  (setq wl-folder-mode-map (make-sparse-keymap))
  (define-key wl-folder-mode-map " "    'wl-folder-jump-to-current-entity)
;  (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close)
  (define-key wl-folder-mode-map "/"    'wl-folder-open-close)
  (define-key wl-folder-mode-map "\C-m" 'wl-folder-jump-to-current-entity)
  (define-key wl-folder-mode-map [(shift return)] 'wl-folder-jump-to-current-entity-with-arg)
  (define-key wl-folder-mode-map "\M-\C-m" 'wl-folder-update-recursive-current-entity)
  (define-key wl-folder-mode-map "rc"    'wl-folder-mark-as-read-all-region)
  (define-key wl-folder-mode-map "c"    'wl-folder-mark-as-read-all-current-entity)
  (define-key wl-folder-mode-map "g"    'wl-folder-goto-folder)
  (define-key wl-folder-mode-map "G"    'wl-folder-goto-folder-sticky)
  (define-key wl-folder-mode-map "j"    'wl-folder-jump-to-current-entity)
  (define-key wl-folder-mode-map "\C-i" 'wl-folder-revisit-last-visited-folder)
  (define-key wl-folder-mode-map "w"    'wl-draft)
  (define-key wl-folder-mode-map "W"    'wl-folder-write-current-folder)
  (define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
  (define-key wl-folder-mode-map "\C-c\C-a" 'wl-addrmgr)
  (define-key wl-folder-mode-map "\C-c\C-p" 'wl-folder-jump-to-previous-summary)
  (define-key wl-folder-mode-map "\C-c\C-n" 'wl-folder-jump-to-next-summary)
  (define-key wl-folder-mode-map "rS"   'wl-folder-sync-region)
  (define-key wl-folder-mode-map "S"    'wl-folder-sync-current-entity)
  (define-key wl-folder-mode-map "rs"   'wl-folder-check-region)
  (define-key wl-folder-mode-map "s"    'wl-folder-check-current-entity)
  (define-key wl-folder-mode-map "I"    'wl-folder-prefetch-current-entity)
;  (define-key wl-folder-mode-map "D"    'wl-folder-drop-unsync-current-entity)
  (define-key wl-folder-mode-map "p"    'wl-folder-prev-entity)
  (define-key wl-folder-mode-map "n"    'wl-folder-next-entity)
  (define-key wl-folder-mode-map "v"    'wl-folder-toggle-disp-summary)
  (define-key wl-folder-mode-map "P"    'wl-folder-prev-unread)
  (define-key wl-folder-mode-map "N"    'wl-folder-next-unread)
  (define-key wl-folder-mode-map "J"    'wl-folder-jump-folder)
  (define-key wl-folder-mode-map "f"    'wl-folder-goto-first-unread-folder)
  (define-key wl-folder-mode-map "o"    'wl-folder-open-all-unread-folder)
  (define-key wl-folder-mode-map "["    'wl-folder-open-all)
  (define-key wl-folder-mode-map "]"    'wl-folder-close-all)
  (define-key wl-folder-mode-map "e"    'wl-folder-expire-current-entity)
  (define-key wl-folder-mode-map "E"    'wl-folder-empty-trash)
  (define-key wl-folder-mode-map "F"    'wl-folder-flush-queue)
  (define-key wl-folder-mode-map "V"    'wl-folder-virtual)
  (define-key wl-folder-mode-map "?"    'wl-folder-pick)
  (define-key wl-folder-mode-map "q"    'wl-exit)
  (define-key wl-folder-mode-map "z"    'wl-folder-suspend)
  (define-key wl-folder-mode-map "x"    'wl-execute-temp-marks)
  (define-key wl-folder-mode-map "\M-t" 'wl-toggle-plugged)
  (define-key wl-folder-mode-map "\C-t" 'wl-plugged-change)
  (define-key wl-folder-mode-map "<"    'beginning-of-buffer)
  (define-key wl-folder-mode-map ">"    'end-of-buffer)
  ;; wl-fldmgr
  (define-key wl-folder-mode-map "m"    'wl-fldmgr-mode-map)
  (define-key wl-folder-mode-map "*"    'wl-fldmgr-make-multi)
  (define-key wl-folder-mode-map "+"    'wl-fldmgr-make-group)
  (define-key wl-folder-mode-map "|"    'wl-fldmgr-make-filter)
  (define-key wl-folder-mode-map "\M-c" 'wl-fldmgr-copy)
  (define-key wl-folder-mode-map "\M-w" 'wl-fldmgr-copy-region)
  (define-key wl-folder-mode-map "\C-k" 'wl-fldmgr-cut)
  (define-key wl-folder-mode-map "\C-w" 'wl-fldmgr-cut-region)
  (define-key wl-folder-mode-map "\C-y" 'wl-fldmgr-yank)
  (define-key wl-folder-mode-map "R"    'wl-fldmgr-rename)
  (define-key wl-folder-mode-map "u"    'wl-fldmgr-unsubscribe)
  (define-key wl-folder-mode-map "ru"   'wl-fldmgr-unsubscribe-region)
  (define-key wl-folder-mode-map "U"    'wl-fldmgr-unsubscribe-region)
  (define-key wl-folder-mode-map "l"    'wl-fldmgr-access-display-normal)
  (define-key wl-folder-mode-map "L"    'wl-fldmgr-access-display-all)
  (define-key wl-folder-mode-map "Z"    'wl-status-update)
  (define-key wl-folder-mode-map "\C-x\C-s" 'wl-save)
  (define-key wl-folder-mode-map "\M-s"     'wl-save)
  (define-key wl-folder-mode-map "\C-xk"    'wl-folder-mimic-kill-buffer)
  (define-key wl-folder-mode-map "\M-\C-a"
    'wl-folder-goto-top-of-current-folder)
  (define-key wl-folder-mode-map "\M-\C-e"
    'wl-folder-goto-bottom-of-current-folder)

  (wl-folder-setup-mouse)
  (easy-menu-define
   wl-folder-mode-menu
   wl-folder-mode-map
   "Menu used in Folder mode."
   wl-folder-mode-menu-spec))

(defmacro wl-folder-unread-regex (group)
  `(concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
           (if ,group
               "\\|^[ ]*\\[[+-]\\]"
             "")))

(defmacro wl-folder-buffer-group-p ()
  '(get-text-property (point) 'wl-folder-is-group))

(defun wl-folder-buffer-search-group (group)
  (let ((prev-point (point))
        (group-regexp (concat
                       "^\\([ \t]*\\)\\[[\\+-]\\]"
                       (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+")))
    (or (catch 'found
          (while (re-search-forward group-regexp nil t)
            (if (wl-folder-buffer-group-p)
                (throw 'found (point)))))
        (progn ; not found
          (goto-char prev-point)
          nil))))

(defun wl-folder-buffer-search-entity (folder &optional searchname)
  (let ((search (or searchname (wl-folder-get-petname folder)))
        case-fold-search
        result)
    (catch 'found
      (while (setq result
                   (re-search-forward
                    (concat
                     "^[ \t]*"
                     (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+")
                    nil t))
        (when (string= (wl-folder-get-entity-from-buffer) folder)
          (throw 'found result))))))

(defsubst wl-folder-get-folder-name-by-id (entity-id &optional hashtb)
  (and (numberp entity-id)
       (elmo-get-hash-val (format "#%d" entity-id)
                          (or hashtb wl-folder-entity-id-name-hashtb))))

(defsubst wl-folder-set-id-name (entity-id entity &optional hashtb)
  (and (numberp entity-id)
       (elmo-set-hash-val (format "#%d" entity-id)
                          entity (or hashtb wl-folder-entity-id-name-hashtb))))

(defmacro wl-folder-get-entity-id (entity)
  `(get-text-property 0 'wl-folder-entity-id ,entity))

(defmacro wl-folder-get-entity-from-buffer (&optional getid)
  `(let ((id (get-text-property (point)
                                'wl-folder-entity-id)))
     (if ,getid
         id
       (wl-folder-get-folder-name-by-id id))))

(defmacro wl-folder-entity-exists-p (entity &optional hashtb)
  `(let ((sym (intern-soft ,entity (or ,hashtb wl-folder-entity-hashtb))))
     (and sym (boundp sym))))

(defmacro wl-folder-clear-entity-info (entity &optional hashtb)
  `(elmo-clear-hash-val ,entity (or ,hashtb wl-folder-entity-hashtb)))

(defmacro wl-folder-get-entity-info (entity &optional hashtb)
  `(elmo-get-hash-val ,entity (or ,hashtb wl-folder-entity-hashtb)))

(defmacro wl-folder-set-entity-info (entity value &optional hashtb)
  `(let* ((hashtb (or ,hashtb wl-folder-entity-hashtb))
          (info (wl-folder-get-entity-info ,entity hashtb)))
     (elmo-set-hash-val (elmo-string ,entity)
                        (if (< (length ,value) 4)
                            (append ,value (list (nth 3 info)))
                          ,value)
                        hashtb)))

(defun wl-folder-persistent-p (folder)
  (or (and (wl-folder-search-entity-by-name folder wl-folder-entity
                                            'folder)
           t) ; on Folder mode.
      (catch 'found
        (let ((li wl-save-folder-list))
          (while li
            (if (string-match (car li) folder)
                (throw 'found t))
            (setq li (cdr li)))))
      (not (catch 'found
             (let ((li wl-no-save-folder-list))
               (while li
                 (if (string-match (car li) folder)
                     (throw 'found t))
                 (setq li (cdr li))))))))

;;; ELMO folder structure with cache.
(defmacro wl-folder-elmo-folder-cache-get (name &optional hashtb)
  "Returns a elmo folder structure associated with NAME from HASHTB.
Default HASHTB is `wl-folder-elmo-folder-hashtb'."
  `(elmo-get-hash-val ,name
                      (or ,hashtb wl-folder-elmo-folder-hashtb)))

(defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb)
  "Get folder elmo folder structure on HASHTB for folder with NAME.
Default HASHTB is `wl-folder-elmo-folder-hashtb'."
  `(elmo-set-hash-val ,name ,folder
                      (or ,hashtb wl-folder-elmo-folder-hashtb)))

(defun wl-draft-get-folder ()
  "A function to obtain `opened' draft elmo folder structure."
  (if (and wl-draft-folder-internal
           (string= (elmo-folder-name-internal wl-draft-folder-internal)
                    wl-draft-folder))
      wl-draft-folder-internal
    (setq wl-draft-folder-internal (wl-folder-make-elmo-folder
                                    wl-draft-folder))
    (wl-folder-confirm-existence wl-draft-folder-internal)
    (elmo-folder-open wl-draft-folder-internal 'load-msgdb)
    wl-draft-folder-internal))

(defun wl-folder-mime-charset (folder-name)
  (or (wl-get-assoc-list-value wl-folder-mime-charset-alist folder-name)
      wl-mime-charset))

(defun wl-folder-make-elmo-folder (folder-name)
  (elmo-make-folder folder-name nil (wl-folder-mime-charset folder-name)))

(defsubst wl-folder-get-elmo-folder (entity &optional no-cache)
  "Get elmo folder structure from ENTITY."
  (let ((name (elmo-string entity)))
    (if no-cache
        (wl-folder-make-elmo-folder name)
      (if (string= name wl-draft-folder)
          (wl-draft-get-folder)
        (or (wl-folder-elmo-folder-cache-get name)
            (let ((folder (wl-folder-make-elmo-folder name)))
              (wl-folder-elmo-folder-cache-put name folder)
              folder))))))

(defsubst wl-folder-put-folder-property (beg end id is-group &optional object)
  (put-text-property beg end 'wl-folder-entity-id id object)
  (put-text-property beg end 'wl-folder-is-group is-group object))

(defun wl-folder-prev-entity ()
  (interactive)
  (forward-line -1))

(defun wl-folder-next-entity ()
  (interactive)
  (forward-line 1))

(defun wl-folder-prev-entity-skip-invalid (&optional hereto)
  "Move to previous entity. skip unsubscribed or removed entity."
  (interactive)
  (if hereto
      (end-of-line))
  (if (re-search-backward wl-folder-entity-regexp nil t)
      (beginning-of-line)
    (goto-char (point-min))))

(defun wl-folder-next-entity-skip-invalid (&optional hereto)
  "Move to next entity. skip unsubscribed or removed entity."
  (interactive)
  (beginning-of-line)
  (if (not hereto)
      (forward-line 1))
  (if (re-search-forward wl-folder-entity-regexp nil t)
      (beginning-of-line)
    (goto-char (point-max))))

(defun wl-folder-search-group-entity-by-name (name entity)
  (wl-folder-search-entity-by-name name entity 'group))

(defun wl-folder-search-entity-by-name (name entity &optional type)
  (let ((entities (list entity))
        entity-stack)
    (catch 'done
      (while entities
        (setq entity (wl-pop entities))
        (cond
         ((consp entity)
          (if (and (not (eq type 'folder))
                   (string= name (car entity)))
              (throw 'done entity))
          (and entities
               (wl-push entities entity-stack))
          (setq entities (nth 2 entity)))
         ((and (not (eq type 'group))
               (stringp entity))
          (if (string= name entity)
              (throw 'done entity))))
        (unless entities
          (setq entities (wl-pop entity-stack)))))))

(defun wl-folder-search-entity-list-by-name (name entity &optional get-id)
  (let ((entities (list entity))
        entity-stack ret-val)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity)))
       ((stringp entity)
        (if (string= name entity)
            (wl-append ret-val (if get-id
                                   (list (wl-folder-get-entity-id entity))
                                 (list entity))))))
      (unless entities
        (setq entities (wl-pop entity-stack))))
    ret-val))

(defun wl-folder-get-prev-folder (id &optional unread)
  (let ((name (if (stringp id)
                  id
                (wl-folder-get-folder-name-by-id id)))
        entity entity-stack last-entity finfo
        (entities (list wl-folder-entity)))
    (catch 'done
      (while entities
        (setq entity (wl-pop entities))
        (cond
         ((consp entity)
;;        (if (and (string= name (car entity))
;;                 (eq id (wl-folder-get-entity-id (car entity))))
;;            (throw 'done last-entity))
          (and entities
               (wl-push entities entity-stack))
          (setq entities (nth 2 entity)))
         ((stringp entity)
          (if (and (string= name entity)
                   (eq id (wl-folder-get-entity-id entity)))
              (throw 'done last-entity))
          (if (or (not unread)
                  (and (setq finfo (wl-folder-get-entity-info entity))
                       (and (nth 0 finfo)(nth 1 finfo))
                       (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
              (setq last-entity entity))))
        (unless entities
          (setq entities (wl-pop entity-stack)))))))

(defun wl-folder-get-next-folder (id &optional unread)
  (let ((name (if (stringp id)
                  id
                (wl-folder-get-folder-name-by-id id)))
        entity entity-stack found finfo
        (entities (list wl-folder-entity)))
    (catch 'done
      (while entities
        (setq entity (wl-pop entities))
        (cond
         ((consp entity)
;;;       (if (and (string= name (car entity))
;;;                (eq id (wl-folder-get-entity-id (car entity))))
;;;           (setq found t))
          (and entities
               (wl-push entities entity-stack))
          (setq entities (nth 2 entity)))
         ((stringp entity)
          (if found
              (when (or (not unread)
                        (and (setq finfo (wl-folder-get-entity-info entity))
                             (and (nth 0 finfo)(nth 1 finfo))
                             (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
                (throw 'done entity))
            (if (and (string= name entity)
                     (eq id (wl-folder-get-entity-id entity)))
                (setq found t)))))
        (unless entities
          (setq entities (wl-pop entity-stack)))))))

(defun wl-folder-flush-queue ()
  "Flush queue."
  (interactive)
  (let ((cur-buf (current-buffer))
        (wl-auto-select-first nil)
        (wl-plugged t)
        emptied)
    (if elmo-enable-disconnected-operation
        (elmo-dop-queue-flush))
    (if (not (elmo-folder-list-messages
              (wl-folder-get-elmo-folder wl-queue-folder)))
        (message "No sending queue exists.")
      (if wl-stay-folder-window
          (wl-folder-select-buffer
           (wl-summary-get-buffer-create wl-queue-folder)))
      (wl-summary-goto-folder-subr wl-queue-folder 'force-update nil)
      (unwind-protect
          (wl-draft-queue-flush)
        (if (get-buffer-window cur-buf)
            (select-window (get-buffer-window cur-buf)))
        (set-buffer cur-buf)
        (if wl-stay-folder-window
            (wl-folder-toggle-disp-summary 'off wl-queue-folder)
          (switch-to-buffer cur-buf))))))

(defun wl-folder-set-persistent-mark (folder number flag)
  "Set a persistent mark which corresponds to the specified flag on message."
  (let ((buffer (wl-summary-get-buffer folder)))
    (if buffer
        (with-current-buffer buffer
          (wl-summary-set-persistent-mark flag number))
      ;; Parent buffer does not exist.
      (let ((elmo-folder (wl-folder-get-elmo-folder folder)))
        (elmo-folder-open elmo-folder 'load-msgdb)
        (elmo-folder-set-flag elmo-folder (list wl-draft-parent-number) flag)
        (elmo-folder-close elmo-folder)))))

(defun wl-folder-empty-trash ()
  "Empty trash."
  (interactive)
  (let ((cur-buf (current-buffer))
        (wl-auto-select-first nil)
        trash-buf emptied)
    (wl-summary-goto-folder-subr wl-trash-folder 'force-update)
    (setq trash-buf (wl-summary-get-buffer-create wl-trash-folder))
    (if wl-stay-folder-window
        (wl-folder-select-buffer trash-buf)
      (switch-to-buffer trash-buf))
    (unwind-protect
        (setq emptied (wl-summary-delete-all-msgs))
      (when emptied
        (setq wl-thread-entities nil
              wl-thread-entity-list nil)
        (if wl-summary-cache-use (wl-summary-save-view-cache))
        (elmo-folder-commit wl-summary-buffer-elmo-folder))
      (if (get-buffer-window cur-buf)
          (select-window (get-buffer-window cur-buf)))
      (set-buffer cur-buf)
      (if emptied
          (wl-folder-set-folder-updated wl-trash-folder '(0 0 0)))
      (if wl-stay-folder-window
          (wl-folder-toggle-disp-summary 'off wl-trash-folder)
        (switch-to-buffer cur-buf))
      (and trash-buf
           (kill-buffer trash-buf)))))

(defun wl-folder-goto-top-of-current-folder (&optional arg)
  "Move backward to the top of the current folder group.
Optional argument ARG is repeart count."
  (interactive "P")
  (if (re-search-backward
       "^ *\\[[\\+-]\\]" nil t (if arg (prefix-numeric-value arg)))
      (beginning-of-line)
    (goto-char (point-min))))

(defun wl-folder-goto-bottom-of-current-folder (indent)
  "Move forward to the bottom of the current folder group."
  (interactive
   (let ((indent
          (save-excursion
            (beginning-of-line)
            (if (looking-at "^ *")
                (buffer-substring (match-beginning 0)(1- (match-end 0)))
              ""))))
     (list indent)))
  (if (catch 'done
        (while (re-search-forward "^ *" nil t)
          (if (<= (length (match-string 0))
                  (length indent))
              (throw 'done nil)))
        (throw 'done t))
      (goto-char (point-max))))

(defun wl-folder-update-group (entity diffs &optional is-group)
  (save-excursion
    (let ((path (wl-folder-get-path
                 wl-folder-entity
                 (wl-folder-get-entity-id entity)
                 entity)))
      (if (not is-group)
          ;; delete itself from path
          (setq path (delete (nth (- (length path) 1) path) path)))
      (goto-char (point-min))
      (catch 'done
        (while path
          ;; goto the path line.
          (if (or (eq (car path) 0) ; update desktop
                  (wl-folder-buffer-search-group
                   (wl-folder-get-petname
                    (if (stringp (car path))
                        (car path)
                      (wl-folder-get-folder-name-by-id
                       (car path))))))
              ;; update it.
              (wl-folder-update-diff-line diffs)
            (throw 'done t))
          (setq path (cdr path)))))))

(defun wl-folder-maybe-load-folder-list (entity)
  (when (null (caddr entity))
    (setcdr (cdr entity)
            (elmo-msgdb-flist-load (car entity)))
    (when (cddr entity)
      (let (diffs)
        (save-excursion
          (wl-folder-entity-assign-id entity
                                      wl-folder-entity-id-name-hashtb
                                      t)
          (setq diffs (wl-fldmgr-add-entity-hashtb (list entity)))
          (unless (equal diffs '(0 0 0))
            (wl-folder-update-group (car entity) diffs t)))))))

(defsubst wl-folder-force-fetch-p (entity)
  (cond
   ((consp wl-force-fetch-folders)
    (wl-string-match-member entity wl-force-fetch-folders))
   (t
    wl-force-fetch-folders)))

(defun wl-folder-jump-to-current-entity-with-arg ()
  (interactive)
  (wl-folder-jump-to-current-entity t))

(defun wl-folder-jump-to-current-entity (&optional arg)
  "Enter the current folder.  If optional ARG exists, update folder list."
  (interactive "P")
  (let ((fld-name (wl-folder-get-entity-from-buffer))
        entity beg end indent opened err)
    (unless fld-name
      (error "No folder"))
    (beginning-of-line)
    (if (and (wl-folder-buffer-group-p)
             (looking-at wl-folder-group-regexp))
        ;; folder group
        (save-excursion
          (setq indent (wl-match-buffer 1))
          (setq opened (wl-match-buffer 2))
          (if (string= opened "+")
              (progn
                (setq entity (wl-folder-search-group-entity-by-name
                              fld-name
                              wl-folder-entity))
                (setq beg (point))
                (if arg
                    (wl-folder-update-recursive-current-entity entity)
                  ;; insert as opened
                  (setcdr (assoc (car entity) wl-folder-group-alist) t)
                  (if (eq 'access (cadr entity))
                      (wl-folder-maybe-load-folder-list entity))
                  ;(condition-case errobj
                  (progn
                    (if (or (wl-folder-force-fetch-p (car entity))
                            (and
                             (eq 'access (cadr entity))
                             (null (caddr entity))))
                        (wl-folder-update-newest indent entity)
                      (wl-folder-insert-entity indent entity))
                    (wl-highlight-folder-path wl-folder-buffer-cur-path))
                  ; (quit
                  ;  (setq err t)
                  ;  (setcdr (assoc fld-name wl-folder-group-alist) nil))
                  ; (error
                  ;  (elmo-display-error errobj t)
                  ;  (ding)
                  ;  (setq err t)
                  ;  (setcdr (assoc fld-name wl-folder-group-alist) nil)))
                  (if (not err)
                      (let ((buffer-read-only nil))
                        (delete-region (save-excursion (beginning-of-line)
                                                       (point))
                                       (save-excursion (end-of-line)
                                                       (+ 1 (point))))))))
            (setq beg (point))
            (end-of-line)
            (save-match-data
              (setq end
                    (progn (wl-folder-goto-bottom-of-current-folder indent)
                           (beginning-of-line)
                           (point))))
            (setq entity (wl-folder-search-group-entity-by-name
                          fld-name
                          wl-folder-entity))
            (let ((buffer-read-only nil))
              (delete-region beg end))
            (setcdr (assoc (car entity) wl-folder-group-alist) nil)
            (wl-folder-insert-entity indent entity) ; insert entity
            (forward-line -1)
            (wl-highlight-folder-path wl-folder-buffer-cur-path)
            ; (wl-delete-all-overlays)
            ; (wl-highlight-folder-current-line)
            ))
      ;; ordinal folder
      (wl-folder-set-current-entity-id
       (get-text-property (point) 'wl-folder-entity-id))
      (setq fld-name (wl-folder-get-folder-name-by-id
                      wl-folder-buffer-cur-entity-id))
      (let ((summary-buf (wl-summary-get-buffer-create fld-name arg))
            error-selecting)
        (if (or wl-stay-folder-window wl-summary-use-frame)
            (wl-folder-select-buffer summary-buf)
          (if (and summary-buf
                   (get-buffer-window summary-buf))
              (delete-window)))
        (wl-summary-goto-folder-subr fld-name
                                     (wl-summary-get-sync-range
                                      (wl-folder-get-elmo-folder fld-name))
                                     nil arg t))))
  (set-buffer-modified-p nil))

(defun wl-folder-close-entity (entity)
  (let ((entities (list entity))
        entity-stack)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (setcdr (assoc (car entity) wl-folder-group-alist) nil)
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity))))
      (unless entities
        (setq entities (wl-pop entity-stack))))))

(defun wl-folder-update-recursive-current-entity (&optional entity)
  (interactive)
  (beginning-of-line)
  (when (and (wl-folder-buffer-group-p)
             (looking-at wl-folder-group-regexp))
    (cond
     ((string= (wl-match-buffer 2) "+")
      (save-excursion
        (if entity ()
          (setq entity
                (wl-folder-search-group-entity-by-name
                 (wl-folder-get-entity-from-buffer)
                 wl-folder-entity)))
        (let ((inhibit-read-only t)
              (entities (list entity))
              entity-stack err indent)
          (while (and entities (not err))
            (setq entity (wl-pop entities))
            (cond
             ((consp entity)
              (wl-folder-close-entity entity)
              (setcdr (assoc (car entity) wl-folder-group-alist) t)
              (unless (wl-folder-buffer-search-group
                       (wl-folder-get-petname (car entity)))
                (error "%s: not found group" (car entity)))
              (setq indent (wl-match-buffer 1))
              (if (eq 'access (cadr entity))
                  (wl-folder-maybe-load-folder-list entity))
              (beginning-of-line)
              (setq err nil)
              (save-excursion
                (condition-case errobj
                    (wl-folder-update-newest indent entity)
                  (quit
                   (setq err t)
                   (setcdr (assoc (car entity) wl-folder-group-alist) nil))
                  (error
                   (elmo-display-error errobj t)
                   (ding)
                   (setq err t)
                   (setcdr (assoc (car entity) wl-folder-group-alist) nil)))
                (if (not err)
                    (delete-region (save-excursion (beginning-of-line)
                                                   (point))
                                   (save-excursion (end-of-line)
                                                   (+ 1 (point))))))
              ;;
              (and entities
                   (wl-push entities entity-stack))
              (setq entities (nth 2 entity))))
            (unless entities
              (setq entities (wl-pop entity-stack)))))
        (set-buffer-modified-p nil)))
     (t
      (wl-folder-jump-to-current-entity)))))

(defun wl-folder-no-auto-check-folder-p (folder)
  (if (stringp folder)
      (if (catch 'found
            (let ((li wl-auto-check-folder-list))
              (while li
                (if (string-match (car li) folder)
                    (throw 'found t))
                (setq li (cdr li)))))
          nil
        (catch 'found
          (let ((li wl-auto-uncheck-folder-list))
            (while li
              (if (string-match (car li) folder)
                  (throw 'found t))     ; no check!
              (setq li (cdr li))))))))

(defsubst wl-folder-add-folder-info (pre-value value)
  (list
   (+ (or (nth 0 pre-value) 0) (or (nth 0 value) 0))
   (+ (or (nth 1 pre-value) 0) (or (nth 1 value) 0))
   (+ (or (nth 2 pre-value) 0) (or (nth 2 value) 0))))

(defun wl-folder-check-entity (entity &optional auto)
  "Check unsync message number."
  (let ((start-pos (point))
        ret-val)
    (run-hooks 'wl-folder-check-entity-pre-hook)
    (if (and (consp entity)             ;; group entity
             wl-folder-check-async)     ;; very fast
        (setq ret-val (wl-folder-check-entity-async entity auto))
      (save-excursion
        (cond
         ((consp entity)
          (let ((flist (if auto
                           (elmo-delete-if
                            'wl-folder-no-auto-check-folder-p
                            (nth 2 entity))
                         (nth 2 entity)))
                (wl-folder-check-entity-pre-hook nil)
                (wl-folder-check-entity-hook nil)
                new unread all)
            (while flist
              (setq ret-val
                    (wl-folder-add-folder-info
                     ret-val
                     (wl-folder-check-entity (car flist))))
              (setq flist (cdr flist)))
            ;(wl-folder-buffer-search-entity (car entity))
            ;(wl-folder-update-line ret-val)
            ))
         ((stringp entity)
          (message "Checking \"%s\"" entity)
          (setq ret-val (wl-folder-check-one-entity
                         entity))
          (goto-char start-pos)
          (sit-for 0))
         (t
          (message "Uncheck(unplugged) \"%s\"" entity)))))
    (if ret-val
        (message "Checking \"%s\" is done"
                 (if (consp entity) (car entity) entity)))
    (run-hooks 'wl-folder-check-entity-hook)
    ret-val))

(defun wl-folder-check-one-entity (entity &optional biff)
  (let* ((folder (wl-folder-get-elmo-folder entity biff))
         (nums (condition-case err
                   (progn
                     (if biff (elmo-folder-set-biff-internal folder t))
                     (if (wl-string-match-member entity wl-strict-diff-folders)
                         (elmo-strict-folder-diff folder)
                       (elmo-folder-diff folder)))
                 (elmo-open-error
                  (signal (car err) (cdr err)))
                 (error
                  ;; maybe not exist folder.
                  (if (not (elmo-folder-exists-p folder))
                      (wl-folder-create-subr folder)
                    (signal (car err) (cdr err))))))
         (new    (elmo-diff-new nums))
         (unread (elmo-diff-unread nums))
         (all    (elmo-diff-all nums)))
    (if (and (eq wl-folder-notify-deleted 'sync)
             (or (and new    (> 0 new))
                 (and unread (> 0 unread))
                 (and all    (> 0 all))))
        (progn
          (wl-folder-sync-entity entity)
          (setq nums (elmo-folder-diff folder)
                new    (elmo-diff-new nums)
                unread (elmo-diff-unread nums)
                all    (elmo-diff-all nums)))
      (unless wl-folder-notify-deleted
        (setq new    (and new    (max 0 new))
              unread (and unread (max 0 unread))
              all    (and all    (max 0 all))))
      (setq unread (if unread
                       (- unread (or new 0))
                     (or (elmo-folder-get-info-unread folder)
                         (cdr (assq 'unread (elmo-folder-count-flags folder)))
                         0)))
      (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
                                   (list new unread all)
                                   (get-buffer wl-folder-buffer-name)))
    (setq wl-folder-info-alist-modified t)
    (sit-for 0)
    (list new unread all)))

(defun wl-folder-check-entity-async (entity &optional auto)
  (let ((elmo-nntp-groups-async t)
        (elist (if auto
                   (elmo-delete-if
                    'wl-folder-no-auto-check-folder-p
                    (wl-folder-get-entity-list entity))
                 (wl-folder-get-entity-list entity)))
        (nntp-connection-keys nil)
        name folder folder-list
        sync-folder-list
        async-folder-list
        server
        ret-val)
    (while elist
      (setq folder (wl-folder-get-elmo-folder (car elist)))
      (if (not (elmo-folder-plugged-p folder))
          (message "Uncheck \"%s\"" (car elist))
        (setq folder-list
              (elmo-folder-get-primitive-list folder))
        (cond ((elmo-folder-contains-type folder 'nntp)
               (wl-append async-folder-list (list folder))
               (while folder-list
                 (when (eq (elmo-folder-type-internal (car folder-list))
                           'nntp)
                   (when (not (string=
                               server
                               (elmo-net-folder-server-internal
                                (car folder-list))))
                     (setq server (elmo-net-folder-server-internal
                                   (car folder-list)))
                     (message "Checking on \"%s\"" server))
                   (setq nntp-connection-keys
                         (elmo-nntp-get-folders-info-prepare
                          (car folder-list)
                          nntp-connection-keys)))
                 (setq folder-list (cdr folder-list))))
              (t
               (wl-append sync-folder-list (list folder)))))
      (setq elist (cdr elist)))
    ;; check local entity at first
    (while (setq folder (pop sync-folder-list))
      (if (not (elmo-folder-plugged-p folder))
          (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
        (message "Checking \"%s\"" (elmo-folder-name-internal folder))
        (setq ret-val
              (wl-folder-add-folder-info
               ret-val
               (wl-folder-check-one-entity (elmo-folder-name-internal
                                            folder))))
        ;;(sit-for 0)
        ))
    ;; check network entity at last
    (when async-folder-list
      (elmo-nntp-get-folders-info nntp-connection-keys)
      (while (setq folder (pop async-folder-list))
        (if (not (elmo-folder-plugged-p folder))
            (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
          (message "Checking \"%s\"" (elmo-folder-name-internal folder))
          (setq ret-val
                (wl-folder-add-folder-info
                 ret-val
                 (wl-folder-check-one-entity (elmo-folder-name-internal
                                              folder))))
          ;;(sit-for 0)
          )))
    ret-val))

;;
(defun wl-folder-resume-entity-hashtb-by-finfo (entity-hashtb info-alist)
  "Resume unread info for entity alist."
  (let (info)
    (while info-alist
      (setq info (nth 1 (car info-alist)))
      (wl-folder-set-entity-info (caar info-alist)
                                 (list (nth 2 info)(nth 3 info)(nth 1 info))
                                 entity-hashtb)
      (setq info-alist (cdr info-alist)))))

(defun wl-folder-move-path (path)
  (let ((fp (if (consp path)
                path
              ;; path is entity-id
              (wl-folder-get-path wl-folder-entity path))))
    (goto-char (point-min))
    (while (and fp
                (not (eobp)))
      (when (equal (car fp)
                   (wl-folder-get-entity-from-buffer t))
        (setq fp (cdr fp))
        (setq wl-folder-buffer-cur-point (point)))
      (forward-line 1))
    (and wl-folder-buffer-cur-point
         (goto-char wl-folder-buffer-cur-point))))

(defun wl-folder-set-current-entity-id (entity-id)
  (let* ((buf (get-buffer wl-folder-buffer-name))
         (buf-win (get-buffer-window buf)))
    (if buf
        (save-current-buffer
          (save-selected-window
            (if buf-win
                (select-window buf-win)
              (set-buffer buf))
            (when (and wl-folder-buffer-cur-entity-id
                       (not (eq wl-folder-buffer-cur-entity-id entity-id)))
              (setq wl-folder-buffer-last-visited-entity-id wl-folder-buffer-cur-entity-id))
            (setq wl-folder-buffer-cur-entity-id entity-id)
            (setq wl-folder-buffer-cur-path
                  (wl-folder-get-path wl-folder-entity entity-id))
            (wl-highlight-folder-path wl-folder-buffer-cur-path)
            (and wl-folder-move-cur-folder
                 wl-folder-buffer-cur-point
                 (goto-char wl-folder-buffer-cur-point)))))))

(defun wl-folder-check-current-entity ()
  "Check folder at position.
If current line is group folder, check all sub entries."
  (interactive)
  (let* ((entity-name (wl-folder-get-entity-from-buffer))
         (group (wl-folder-buffer-group-p))
         (desktop (string= entity-name wl-folder-desktop-name)))
    (when entity-name
      (wl-folder-check-entity
       (if group
           (wl-folder-search-group-entity-by-name entity-name
                                                  wl-folder-entity)
         entity-name)
       desktop))))

(defun wl-folder-sync-entity (entity &optional unread-only)
  "Synchronize the msgdb of ENTITY."
  (cond
   ((consp entity)
    (let ((flist (nth 2 entity)))
      (while flist
        (wl-folder-sync-entity (car flist) unread-only)
        (setq flist (cdr flist)))))
   ((stringp entity)
    (let* ((folder (wl-folder-get-elmo-folder entity))
           (nums (wl-folder-get-entity-info entity))
           (new (or (car nums) 0))
           (unread (or (cadr nums) 0)))
      (when (or (not unread-only)
                (or (> new 0) (> unread 0)))
        (let ((summary (wl-summary-get-buffer entity))
              (range (wl-summary-get-sync-range folder)))
          (if summary
              (save-selected-window
                (with-current-buffer summary
                  (let ((win (get-buffer-window summary t)))
                    (when win
                      (select-window win)))
                  (wl-summary-sync 'unset-cursor range)
                  (wl-summary-save-status)))
            (elmo-folder-open folder 'load-msgdb)
            (unwind-protect
                (progn
                  (elmo-folder-synchronize folder nil (eq range 'all))
                  (wl-folder-set-folder-updated
                   entity
                   (list
                    0
                    (or (cdr (assq 'unread (elmo-folder-count-flags folder)))
                        0)
                    (elmo-folder-length folder))))
              (elmo-folder-close folder)))))))))

(defun wl-folder-sync-current-entity (&optional unread-only)
  "Synchronize the folder at position.
If current line is group folder, check all subfolders."
  (interactive "P")
  (save-excursion
    (let ((entity-name (wl-folder-get-entity-from-buffer))
          (group (wl-folder-buffer-group-p)))
      (when (and entity-name
                 (y-or-n-p (format "Sync %s? " entity-name)))
        (wl-folder-sync-entity
         (if group
             (wl-folder-search-group-entity-by-name entity-name
                                                    wl-folder-entity)
           entity-name)
         unread-only)
        (message "Syncing %s is done!" entity-name)))))

(defun wl-folder-mark-as-read-all-entity (entity)
  "Mark as read all messages in the ENTITY."
  (cond
   ((consp entity)
    (let ((flist (nth 2 entity)))
      (while flist
        (wl-folder-mark-as-read-all-entity (car flist))
        (setq flist (cdr flist)))))
   ((stringp entity)
    (let* ((folder (wl-folder-get-elmo-folder entity))
           (nums (wl-folder-get-entity-info entity))
           (new (or (car nums) 0))
           (unread (or (cadr nums) 0)))
      (when (or (> new 0) (> unread 0))
        (let ((summary (wl-summary-get-buffer entity))
              (range (wl-summary-get-sync-range folder)))
          (if summary
              (save-selected-window
                (with-current-buffer summary
                  (let ((win (get-buffer-window summary t)))
                    (when win
                      (select-window win)))
                  (wl-summary-sync 'unset-cursor range)
                  (wl-summary-mark-as-read-all)
                  (wl-summary-save-status)))
            (elmo-folder-open folder 'load-msgdb)
            (unwind-protect
                (progn
                  (elmo-folder-synchronize folder nil (eq range 'all))
                  (elmo-folder-unset-flag
                   folder
                   (elmo-folder-list-flagged folder 'unread 'in-msgdb)
                   'unread)
                  (wl-folder-set-folder-updated
                   entity
                   (list 0 0 (elmo-folder-length folder))))
              (elmo-folder-close folder)))))))))

(defun wl-folder-mark-as-read-all-current-entity ()
  "Mark as read all messages in the folder at position.
If current line is group folder, all subfolders are marked."
  (interactive)
  (save-excursion
    (let ((entity-name (wl-folder-get-entity-from-buffer))
          (group (wl-folder-buffer-group-p))
          summary-buf)
      (when (and entity-name
                 (y-or-n-p (format "Mark all messages in %s as read? "
                                   entity-name)))
        (wl-folder-mark-as-read-all-entity
         (if group
             (wl-folder-search-group-entity-by-name entity-name
                                                    wl-folder-entity)
           entity-name))
        (message "All messages in %s are marked!" entity-name)))))

(defun wl-folder-check-region (beg end)
  (interactive "r")
  (goto-char beg)
  (beginning-of-line)
  (setq beg (point))
  (goto-char end)
  (beginning-of-line)
  (setq end (point))
  (goto-char beg)
  (let ((inhibit-read-only t)
        entity)
    (while (< (point) end)
      ;; normal folder entity
      (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
          (save-excursion
            (setq entity (wl-folder-get-entity-from-buffer))
            (if (not (elmo-folder-plugged-p (wl-folder-get-elmo-folder
                                             entity)))
                (message "Uncheck %s" entity)
              (message "Checking %s" entity)
              (wl-folder-check-one-entity entity)
              (sit-for 0))))
      (forward-line 1)))
  (message ""))

(defun wl-folder-sync-region (beg end)
  (interactive "r")
  (goto-char beg)
  (beginning-of-line)
  (setq beg (point))
  (goto-char end)
  (end-of-line)
  (setq end (point))
  (goto-char beg)
  (while (< (point) end)
    ;; normal folder entity
    (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
        (save-excursion
          (let ((inhibit-read-only t)
                entity)
            (setq entity (wl-folder-get-entity-from-buffer))
            (wl-folder-sync-entity entity)
            (message "Syncing %s is done!" entity)
            (sit-for 0))))
    (forward-line 1))
  (message ""))

(defun wl-folder-mark-as-read-all-region (beg end)
  (interactive "r")
  (goto-char beg)
  (beginning-of-line)
  (setq beg (point))
  (goto-char end)
  (end-of-line)
  (setq end (point))
  (goto-char beg)
  (while (< (point) end)
    ;; normal folder entity
    (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
        (save-excursion
          (let ((inhibit-read-only t)
                entity)
            (setq entity (wl-folder-get-entity-from-buffer))
            (wl-folder-mark-as-read-all-entity entity)
            (message "All messages in %s are marked!" entity)
            (sit-for 0))))
    (forward-line 1))
  (message ""))

(defsubst wl-create-access-init-load-p (folder)
  (let ((no-load-regexp (when (and
                               (not wl-folder-init-load-access-folders)
                               wl-folder-init-no-load-access-folders)
                          (mapconcat 'identity
                                     wl-folder-init-no-load-access-folders
                                     "\\|")))
        (load-regexp (and wl-folder-init-load-access-folders
                          (mapconcat 'identity
                                     wl-folder-init-load-access-folders
                                     "\\|"))))
    (cond (load-regexp (string-match load-regexp folder))
          (t (not (and no-load-regexp
                       (string-match no-load-regexp folder)))))))

(defun wl-create-access-folder-entity (name)
  (let (flists flist)
    (when (wl-create-access-init-load-p name)
      (setq flists (elmo-msgdb-flist-load name)) ; load flist.
      (setq flist (car flists))
      (while flist
        (when (consp (car flist))
          (setcdr (cdar flist)
                  (wl-create-access-folder-entity (caar flist))))
        (setq flist (cdr flist)))
      flists)))

(defun wl-create-folder-entity-from-buffer ()
  "Create folder entity recursively."
  (cond
   ((looking-at "^[ \t]*$")             ; blank line
    (goto-char (+ 1(match-end 0)))
    'ignore)
   ((looking-at "^#.*$")                ; comment
    (goto-char (+ 1 (match-end 0)))
    'ignore)
   ((looking-at "^[\t ]*\\(.+\\)[\t ]*{[\t ]*$") ; group definition
    (let (name entity flist)
      (setq name (wl-match-buffer 1))
      (goto-char (+ 1 (match-end 0)))
      (while (setq entity (wl-create-folder-entity-from-buffer))
        (unless (eq entity 'ignore)
          (wl-append flist (list entity))))
      (if (looking-at "^[\t ]*}[\t ]*$") ; end of group
          (progn
            (goto-char (+ 1 (match-end 0)))
            (if (wl-string-assoc name wl-folder-petname-alist)
                (error "%s already defined as petname" name))
            (list name 'group flist))
        (error "Syntax error in folder definition"))))
   ((looking-at "^[\t ]*\\([^\t \n]+\\)[\t ]*/$") ; access it!
    (let (name)
      (setq name (wl-match-buffer 1))
      (goto-char (+ 1 (match-end 0)))
;      (condition-case ()
;         (unwind-protect
;             (setq flist (elmo-list-folders name)))
;       (error (message "Access to folder %s failed." name)))
;;       (setq flist (elmo-msgdb-flist-load name)) ; load flist.
;;       (setq unsublist (nth 1 flist))
;;       (setq flist (car flist))
;;       (list name 'access flist unsublist)))
      (append (list name 'access) (wl-create-access-folder-entity name))))
   ;((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
   ((looking-at "^[\t ]*=[ \t]+\\([^\n]+\\)$"); petname definition
    (goto-char (+ 1 (match-end 0)))
    (let ((rest (elmo-match-buffer 1))
          petname)
      (when (string-match "\\(\"[^\"]*\"\\)[\t ]*$" rest)
        (setq petname (elmo-delete-char ?\" (elmo-match-string 1 rest)))
        (setq rest (substring rest 0 (match-beginning 0))))
      (when (string-match "^[\t ]*\\(.*[^\t ]+\\)[\t ]+$" rest)
        (wl-folder-append-petname (elmo-match-string 1 rest)
                                  petname))
      'ignore))
   ((looking-at "^[ \t]*}[ \t]*$") ; end of group
    nil)
   ((looking-at "^.*$") ; normal folder entity
    (goto-char (+ 1 (match-end 0)))
    (let ((rest (elmo-match-buffer 0))
          realname petname)
      (if (string-match "\\(\"[^\"]*\"\\)[\t ]*$" rest)
          (progn
            (setq petname (elmo-delete-char ?\" (elmo-match-string 1 rest)))
            (setq rest (substring rest 0 (match-beginning 0)))
            (when (string-match "^[\t ]*\\(.*[^\t ]+\\)[\t ]+$" rest)
              (wl-folder-append-petname
               (setq realname (elmo-match-string 1 rest))
               petname)
              realname))
        (if (string-match "^[\t ]*\\(.+\\)$" rest)
            (elmo-match-string 1 rest)
          rest))))))

(defun wl-folder-create-folder-entity ()
  "Create folder entries."
  (let ((tmp-buf (get-buffer-create " *wl-folder-tmp*"))
        entity ret-val)
    (condition-case ()
        (progn
          (with-current-buffer tmp-buf
            (erase-buffer)
            (insert-file-contents wl-folders-file)
            (goto-char (point-min))
            (while (and (not (eobp))
                        (setq entity (wl-create-folder-entity-from-buffer)))
              (unless (eq entity 'ignore)
                (wl-append ret-val (list entity)))))
          (kill-buffer tmp-buf))
      (file-error nil))
    (setq ret-val (list wl-folder-desktop-name 'group ret-val))))

(defun wl-folder-entity-assign-id (entity &optional hashtb on-noid)
  (let ((hashtb (or hashtb
                    (setq wl-folder-entity-id-name-hashtb
                          (elmo-make-hash wl-folder-entity-id))))
        (entities (list entity))
        entity-stack)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (when (not (and on-noid
                        (get-text-property 0
                                           'wl-folder-entity-id
                                           (car entity))))
          (wl-folder-put-folder-property
           0 (length (car entity))
           wl-folder-entity-id
           'is-group
           (car entity))
          (wl-folder-set-id-name wl-folder-entity-id
                                 (car entity) hashtb)
          (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)))
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity)))
       ((stringp entity)
        (when (not (and on-noid
                        (get-text-property 0
                                           'wl-folder-entity-id
                                           entity)))
          (wl-folder-put-folder-property
           0 (length entity)
           wl-folder-entity-id
           nil
           entity)
          (wl-folder-set-id-name wl-folder-entity-id
                                 entity hashtb)
          (setq wl-folder-entity-id (+ 1 wl-folder-entity-id)))))
      (unless entities
        (setq entities (wl-pop entity-stack))))))

(defun wl-folder-click (e)
  (interactive "e")
  (mouse-set-point e)
  (beginning-of-line)
  (save-excursion
    (wl-folder-jump-to-current-entity)))

(defun wl-folder-select-buffer (buffer)
  (let ((gbw (get-buffer-window buffer))
        exists)
    (if gbw
        (progn (select-window gbw)
               (setq exists t))
      (unless wl-summary-use-frame
        (condition-case ()
            (unwind-protect
                (split-window-horizontally wl-folder-window-width)
              (other-window 1))
          (error nil))))
    (set-buffer buffer)
    (if wl-summary-use-frame
        (switch-to-buffer-other-frame buffer)
      (switch-to-buffer buffer))
    exists))

(defun wl-folder-toggle-disp-summary (&optional arg folder)
  (interactive)
  (if (or (and folder (assoc folder wl-folder-group-alist))
          (and (interactive-p) (wl-folder-buffer-group-p)))
      (error "This command is not available on Group"))
  (beginning-of-line)
  (let (wl-auto-select-first
        (wl-stay-folder-window t))
    (cond
     ((eq arg 'on)
      (setq wl-folder-buffer-disp-summary t))
     ((eq arg 'off)
      (setq wl-folder-buffer-disp-summary nil)
      ;; hide wl-summary window.
      (let ((cur-buf (current-buffer))
            (summary-buffer (wl-summary-get-buffer folder)))
        (when summary-buffer
          (wl-folder-select-buffer summary-buffer)
          (delete-window))
        (select-window (get-buffer-window cur-buf))))
     (t
      (setq wl-folder-buffer-disp-summary
            (not wl-folder-buffer-disp-summary))
      (let ((cur-buf (current-buffer))
            folder-name)
        (when (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
          (setq folder-name (wl-folder-get-entity-from-buffer))
          (if wl-folder-buffer-disp-summary
              (progn
                (wl-folder-select-buffer
                 (wl-summary-get-buffer-create folder-name))
                (unwind-protect
                    (wl-summary-goto-folder-subr folder-name 'no-sync nil)
                  (select-window (get-buffer-window cur-buf))))
            (let ((summary-buffer (wl-summary-get-buffer folder-name)))
              (when summary-buffer
                (wl-folder-select-buffer summary-buffer)
                (delete-window))
              (select-window (get-buffer-window cur-buf))))))))))

(defun wl-folder-prev-unsync ()
  "Move cursor to the previous unsync folder."
  (interactive)
  (let (start-point)
    (setq start-point (point))
    (beginning-of-line)
    (if (re-search-backward wl-folder-unsync-regexp nil t)
        (beginning-of-line)
      (goto-char start-point)
      (message "No more unsync folder"))))

(defun wl-folder-next-unsync (&optional plugged)
  "Move cursor to the next unsync."
  (interactive)
  (let (start-point entity)
    (setq start-point (point))
    (end-of-line)
    (if (catch 'found
          (while (re-search-forward wl-folder-unsync-regexp nil t)
            (if (or (wl-folder-buffer-group-p)
                    (not plugged)
                    (setq entity
                          (wl-folder-get-entity-from-buffer))
                    (elmo-folder-plugged-p entity))
                (throw 'found t))))
        (beginning-of-line)
      (goto-char start-point)
      (message "No more unsync folder"))))

(defun wl-folder-prev-unread (&optional group)
  "Move cursor to the previous unread folder."
  (interactive "P")
  (let (start-point)
    (setq start-point (point))
    (beginning-of-line)
    (if (re-search-backward (wl-folder-unread-regex group) nil t)
        (progn
          (beginning-of-line)
          (wl-folder-get-entity-from-buffer))
      (goto-char start-point)
      (message "No more unread folder")
      nil)))

(defun wl-folder-next-unread (&optional group)
  "Move cursor to the next unread folder."
  (interactive "P")
  (let (start-point)
    (setq start-point (point))
    (end-of-line)
    (if (re-search-forward (wl-folder-unread-regex group) nil t)
        (progn
          (beginning-of-line)
          (wl-folder-get-entity-from-buffer))
      (goto-char start-point)
      (message "No more unread folder")
      nil)))

(defun wl-folder-mode ()
  "Major mode for Wanderlust Folder.
See Info under Wanderlust for full documentation.

Special commands:
\\{wl-folder-mode-map}

Entering Folder mode calls the value of `wl-folder-mode-hook'."
  (interactive)
  (setq major-mode 'wl-folder-mode)
  (setq mode-name "Folder")
  (use-local-map wl-folder-mode-map)
  (setq buffer-read-only t)
  (setq inhibit-read-only nil)
  (setq truncate-lines t)
  (setq wl-folder-buffer-cur-entity-id nil
        wl-folder-buffer-cur-path nil
        wl-folder-buffer-cur-point nil)
  (wl-mode-line-buffer-identification)
  (easy-menu-add wl-folder-mode-menu)
  ;; This hook may contain the functions `wl-folder-init-icons' and
  ;; `wl-setup-folder' for reasons of system internal to accord
  ;; facilities for the Emacs variants.
  (run-hooks 'wl-folder-mode-hook))

(defun wl-folder-append-petname (realname petname)
  (let ((pentry (wl-string-assoc realname wl-folder-petname-alist)))
    (when pentry
      (setq wl-folder-petname-alist
            (delete pentry wl-folder-petname-alist))))
  (wl-append wl-folder-petname-alist
             (list (cons realname petname))))

(defun wl-folder ()
  (let (initialize folder-buf)
    (if (setq folder-buf (get-buffer wl-folder-buffer-name))
        (if wl-folder-use-frame
            (let (select-frame)
              (save-selected-window
                (dolist (frame (visible-frame-list))
                  (select-frame frame)
                  (if (get-buffer-window folder-buf)
                      (setq select-frame frame))))
              (if select-frame
                  (select-frame select-frame)
                (switch-to-buffer folder-buf)))
          (switch-to-buffer folder-buf))
      (if wl-folder-use-frame
          (progn
            (switch-to-buffer-other-frame
             (get-buffer-create wl-folder-buffer-name))
            (let ((frame (selected-frame)))
              (setq wl-delete-startup-frame-function
                    `(lambda ()
                       (setq wl-delete-startup-frame-function nil)
                       (let ((frame ,frame))
                         (if (eq (selected-frame) frame)
                             (delete-frame frame)))))))
        (switch-to-buffer (get-buffer-create wl-folder-buffer-name)))
      (set-buffer wl-folder-buffer-name)
      (wl-folder-mode)
      ;; Initialization.
      (unless wl-folder-entity
        (wl-folder-init))
      (setq wl-folder-entity-id 0)
      (wl-folder-entity-assign-id wl-folder-entity)
      (setq wl-folder-entity-hashtb
            (wl-folder-create-entity-hashtb wl-folder-entity))
      (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id))
      (setq wl-folder-group-alist
            (wl-folder-create-group-alist wl-folder-entity))
      (setq wl-folder-newsgroups-hashtb
            (wl-folder-create-newsgroups-hashtb wl-folder-entity))
      (wl-folder-init-info-hashtb)
      (let ((inhibit-read-only t)
            (buffer-read-only nil))
        (erase-buffer)
        (setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
        (save-excursion
          (wl-folder-insert-entity " " wl-folder-entity)))
      (sit-for 0)
      (set-buffer-modified-p nil)
      (setq initialize t))
    initialize))

(defun wl-folder-auto-check ()
  "Check and update folders in `wl-auto-check-folder-name'."
  (interactive)
  (when (get-buffer wl-folder-buffer-name)
    (switch-to-buffer  wl-folder-buffer-name)
    (cond
     ((eq wl-auto-check-folder-name 'none))
     ((or (consp wl-auto-check-folder-name)
          (stringp wl-auto-check-folder-name))
      (let ((folder-list (if (consp wl-auto-check-folder-name)
                             wl-auto-check-folder-name
                           (list wl-auto-check-folder-name)))
            entity)
        (while folder-list
          (if (setq entity (wl-folder-search-entity-by-name
                            (car folder-list)
                            wl-folder-entity))
              (wl-folder-check-entity entity 'auto))
          (setq folder-list (cdr folder-list)))))
     (t
      (wl-folder-check-entity wl-folder-entity 'auto)))))

(defun wl-folder-set-folder-updated (name value)
  (save-excursion
    (let ((buf (get-buffer wl-folder-buffer-name)))
      (if buf
          (wl-folder-entity-hashtb-set
           wl-folder-entity-hashtb name value buf))
      (setq wl-folder-info-alist-modified t))))

(defun wl-folder-calc-finfo (entity)
  ;; calcurate finfo without inserting.
  (let ((entities (list entity))
        entity-stack
        new unread all nums)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity)))
       ((stringp entity)
        (setq nums (wl-folder-get-entity-info entity))
        (setq new    (+ (or new 0) (or (nth 0 nums) 0)))
        (setq unread (+ (or unread 0)
                        (or (and (nth 0 nums)(nth 1 nums)
                                 (+ (nth 0 nums)(nth 1 nums))) 0)))
        (setq all    (+ (or all 0) (or (nth 2 nums) 0)))))
      (unless entities
        (setq entities (wl-pop entity-stack))))
    (list new unread all)))

(defsubst wl-folder-make-save-access-list (list)
  (mapcar '(lambda (x)
             (cond
              ((consp x)
               (list (elmo-string (car x)) 'access))
              (t
               (elmo-string x))))
          list))

(defun wl-folder-update-newest (indent entity)
  (let (ret-val new unread all)
    (cond
     ((consp entity)
      (let ((inhibit-read-only t)
            (buffer-read-only nil)
            (flist (nth 2 entity))
            (as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
            beg
            )
        (setq beg (point))
        (if as-opened
            (let (update-flist flist-unsub new-flist removed group-name-end)
              (when (and (eq (cadr entity) 'access)
                         (elmo-folder-plugged-p
                          (wl-folder-get-elmo-folder (car entity))))
                (message "Fetching folder entries...")
                (when (setq new-flist
                            (elmo-folder-list-subfolders
                             (wl-folder-get-elmo-folder (car entity))
                             (wl-string-match-member
                              (car entity)
                              wl-folder-hierarchy-access-folders)))
                  (setq update-flist
                        (wl-folder-update-access-group entity new-flist))
                  (setq flist (nth 1 update-flist))
                  (when (car update-flist) ;; diff
                    (setq flist-unsub (nth 2 update-flist))
                    (setq removed (nth 3 update-flist))
                    (elmo-msgdb-flist-save
                     (car entity)
                     (list
                      (wl-folder-make-save-access-list flist)
                      (wl-folder-make-save-access-list flist-unsub)))
                    (wl-folder-entity-assign-id
                     entity
                     wl-folder-entity-id-name-hashtb
                     t)
                    (setq wl-folder-entity-hashtb
                          (wl-folder-create-entity-hashtb
                           entity
                           wl-folder-entity-hashtb
                           t))
                    (setq wl-folder-newsgroups-hashtb
                          (or
                           (wl-folder-create-newsgroups-hashtb
                            entity nil)
                           wl-folder-newsgroups-hashtb))))
                (message "Fetching folder entries...done"))
              (wl-folder-insert-entity indent entity))))))))

(defun wl-folder-insert-entity (indent entity &optional onlygroup)
  (let (ret-val new unread all)
    (cond
     ((consp entity)
      (let ((inhibit-read-only t)
            (buffer-read-only nil)
            (flist (nth 2 entity))
            (as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
            beg
            )
;;;     (insert indent "[" (if as-opened "-" "+") "]" (car entity) "\n")
;;;     (save-excursion (forward-line -1)
;;;                     (wl-highlight-folder-current-line))
        (setq beg (point))
        (if (and as-opened
                 (not onlygroup))
            (let (update-flist flist-unsub new-flist removed group-name-end)
;;;           (when (and (eq (cadr entity) 'access)
;;;                      newest)
;;;             (message "fetching folder entries...")
;;;             (when (setq new-flist
;;;                         (elmo-list-folders
;;;                          (elmo-string (car entity))
;;;                          (wl-string-member
;;;                           (car entity)
;;;                           wl-folder-hierarchy-access-folders)
;;;                          ))
;;;               (setq update-flist
;;;                     (wl-folder-update-access-group entity new-flist))
;;;               (setq flist (nth 1 update-flist))
;;;               (when (car update-flist) ;; diff
;;;                 (setq flist-unsub (nth 2 update-flist))
;;;                 (setq removed (nth 3 update-flist))
;;;                 (elmo-msgdb-flist-save
;;;                  (car entity)
;;;                  (list
;;;                   (wl-folder-make-save-access-list flist)
;;;                   (wl-folder-make-save-access-list flist-unsub)))
;;;                 ;;
;;;                 ;; reconstruct wl-folder-entity-id-name-hashtb and
;;;                 ;;           wl-folder-entity-hashtb
;;;                 ;;
;;;                 (wl-folder-entity-assign-id
;;;                  entity
;;;                  wl-folder-entity-id-name-hashtb
;;;                  t)
;;;                 (setq wl-folder-entity-hashtb
;;;                       (wl-folder-create-entity-hashtb
;;;                        entity
;;;                        wl-folder-entity-hashtb
;;;                        t))
;;;                 (setq wl-folder-newsgroups-hashtb
;;;                       (or
;;;                        (wl-folder-create-newsgroups-hashtb
;;;                         entity nil)
;;;                        wl-folder-newsgroups-hashtb))))
;;;             (message "fetching folder entries...done"))
              (insert indent "[" (if as-opened "-" "+") "]"
                      (if (eq (cadr entity) 'access)
                          (wl-folder-get-petname (car entity))
                        (car entity)))
              (setq group-name-end (point))
              (insert ":0/0/0\n")
              (wl-folder-put-folder-property
               beg (point)
               (get-text-property 0 'wl-folder-entity-id (car entity))
               'is-group)
              (when removed
                (setq beg (point))
                (while removed
                  (insert indent "  "
                          wl-folder-removed-mark
                          (if (listp (car removed))
                              (concat "[+]" (caar removed))
                            (car removed))
                          "\n")
                  (save-excursion (forward-line -1)
                                  (wl-highlight-folder-current-line))
                  (setq removed (cdr removed)))
                (remove-text-properties beg (point) '(wl-folder-entity-id)))
              (elmo-with-progress-display
                  (wl-folder-insert-entity (length flist))
                  (format "Inserting group %s" (car entity))
                (while flist
                  (setq ret-val
                        (wl-folder-insert-entity
                         (concat indent "  ") (car flist)))
                  (setq new    (+ (or new 0) (or (nth 0 ret-val) 0)))
                  (setq unread (+ (or unread 0) (or (nth 1 ret-val) 0)))
                  (setq all    (+ (or all 0) (or (nth 2 ret-val) 0)))
                  (elmo-progress-notify 'wl-folder-insert-entity)
                  (setq flist (cdr flist))))
              (save-excursion
                (goto-char group-name-end)
                (delete-region (point) (save-excursion (end-of-line)
                                                       (point)))
                (insert (format ":%d/%d/%d" (or new 0)
                                (or unread 0) (or all 0)))
                (setq ret-val (list new unread all))
                (wl-highlight-folder-current-line ret-val)))
          (setq ret-val (wl-folder-calc-finfo entity))
          (insert indent "[" (if as-opened "-" "+") "]"
                  (if (eq (cadr entity) 'access)
                      (wl-folder-get-petname (car entity))
                    (car entity))
                  (format ":%d/%d/%d"
                          (or (nth 0 ret-val) 0)
                          (or (nth 1 ret-val) 0)
                          (or (nth 2 ret-val) 0))
                  "\n")
          (wl-folder-put-folder-property
           beg (point)
           (get-text-property 0 'wl-folder-entity-id (car entity))
           'is-group)
          (save-excursion (forward-line -1)
                          (wl-highlight-folder-current-line ret-val)))))
     ((stringp entity)
      (let* ((inhibit-read-only t)
             (buffer-read-only nil)
             (nums (wl-folder-get-entity-info entity))
             beg)
        (setq beg (point))
        (insert indent (wl-folder-get-petname entity)
                (format ":%s/%s/%s\n"
                        (or (setq new (nth 0 nums)) "*")
                        (or (setq unread (and (nth 0 nums)(nth 1 nums)
                                              (+ (nth 0 nums)(nth 1 nums))))
                            "*")
                        (or (setq all (nth 2 nums)) "*")))
        (wl-folder-put-folder-property
         beg (point)
         (get-text-property 0 'wl-folder-entity-id entity)
         nil)
        (save-excursion (forward-line -1)
                        (wl-highlight-folder-current-line nums))
        (setq ret-val (list new unread all)))))
    (set-buffer-modified-p nil)
    ret-val))

(defun wl-folder-check-all ()
  (interactive)
  (wl-folder-check-entity wl-folder-entity))

(defun wl-folder-entity-hashtb-set (entity-hashtb name value buffer)
  (let ((cur-val (wl-folder-get-entity-info name entity-hashtb))
        (new-diff 0)
        (unread-diff 0)
        (all-diff 0)
        diffs)
    (setq new-diff    (- (or (nth 0 value) 0) (or (nth 0 cur-val) 0)))
    (setq unread-diff
          (+ new-diff
             (- (or (nth 1 value) 0) (or (nth 1 cur-val) 0))))
    (setq all-diff    (- (or (nth 2 value) 0) (or (nth 2 cur-val) 0)))
    (setq diffs (list new-diff unread-diff all-diff))
    (unless (and (nth 0 cur-val)
                 (equal diffs '(0 0 0)))
      (wl-folder-set-entity-info name value entity-hashtb)
      (save-match-data
        (with-current-buffer buffer
          (save-excursion
            (let ((entity-list (wl-folder-search-entity-list-by-name
                                name wl-folder-entity)))
              (while entity-list
                (wl-folder-update-group (car entity-list) diffs)
                (setq entity-list (cdr entity-list))))
            (goto-char (point-min))
            (while (wl-folder-buffer-search-entity name)
              (wl-folder-update-line value))))))))

(defun wl-folder-update-unread (folder unread)
  (let ((buf (get-buffer wl-folder-buffer-name))
        (value (wl-folder-get-entity-info folder))
        cur-unread
        (unread-diff 0)
        newvalue)
;;; Update folder-info
;;;    (elmo-folder-set-info-hashtb fld nil nil nil unread)
    (setq cur-unread (or (nth 1 value) 0))
    (setq unread-diff (- (or unread 0) cur-unread))
    (setq newvalue (list (nth 0 value)
                         unread
                         (nth 2 value)))
    (wl-folder-set-entity-info folder newvalue)
    (setq wl-folder-info-alist-modified t)
    (when (and buf
               (not (eq unread-diff 0)))
      (save-match-data
        (with-current-buffer buf
          (save-excursion
            (let ((entity-list (wl-folder-search-entity-list-by-name
                                folder wl-folder-entity)))
              (while entity-list
                (wl-folder-update-group (car entity-list) (list 0
                                                                unread-diff
                                                                0))
                (setq entity-list (cdr entity-list))))
            (goto-char (point-min))
            (while (wl-folder-buffer-search-entity folder)
              (wl-folder-update-line newvalue))))))))

(defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst)
  (let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
        (entities (list entity))
        entity-stack)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity)))
       ((stringp entity)
        (when (not (and reconst
                        (wl-folder-get-entity-info entity)))
          (wl-folder-set-entity-info entity
                                     nil
                                     hashtb))))
      (unless entities
        (setq entities (wl-pop entity-stack))))
    hashtb))

;; Unsync number is reserved.
;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
;;  (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
;;       (entities (list entity))
;;       entity-stack)
;;    (while entities
;;      (setq entity (wl-pop entities))
;;      (cond
;;       ((consp entity)
;;      (if id-name
;;          (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
;;                                 (car entity)))
;;      (and entities
;;           (wl-push entities entity-stack))
;;      (setq entities (nth 2 entity))
;;      )
;;       ((stringp entity)
;;      (wl-folder-set-entity-info entity
;;                                 (wl-folder-get-entity-info entity)
;;                                 hashtb)
;;      (if id-name
;;          (wl-folder-set-id-name (wl-folder-get-entity-id entity)
;;                                 entity))))
;;      (unless entities
;;      (setq entities (wl-pop entity-stack))))
;;    hashtb))

(defun wl-folder-create-newsgroups-from-nntp-access (entity)
  (let ((flist (nth 2 entity))
        folders)
    (while flist
      (wl-append folders
                 (cond
                  ((consp (car flist))
                   (wl-folder-create-newsgroups-from-nntp-access (car flist)))
                  (t
                   (list
                    (elmo-nntp-folder-group-internal
                     (wl-folder-get-elmo-folder (car flist)))))))
      (setq flist (cdr flist)))
    folders))

(defun wl-folder-create-newsgroups-hashtb (entity &optional is-list info)
  "Create NNTP group hashtable for ENTITY."
  (let ((entities (if is-list entity (list entity)))
        entity-stack folder-list newsgroups newsgroup make-hashtb)
    (and info (message "Creating newsgroups..."))
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (if (eq (nth 1 entity) 'access)
            (when (eq (elmo-folder-type-internal
                       (elmo-make-folder (car entity))) 'nntp)
              (wl-append newsgroups
                         (wl-folder-create-newsgroups-from-nntp-access entity))
              (setq make-hashtb t))
          (and entities
               (wl-push entities entity-stack))
          (setq entities (nth 2 entity))))
       ((stringp entity)
        (setq folder-list (elmo-folder-get-primitive-list
                           (elmo-make-folder entity)))
        (while folder-list
          (when (and (eq (elmo-folder-type-internal (car folder-list))
                         'nntp)
                     (setq newsgroup (elmo-nntp-folder-group-internal
                                      (car folder-list))))
            (wl-append newsgroups (list (elmo-string newsgroup))))
          (setq folder-list (cdr folder-list)))))
      (unless entities
        (setq entities (wl-pop entity-stack))))
    (and info (message "Creating newsgroups...done"))
    (if (or newsgroups make-hashtb)
        (elmo-setup-subscribed-newsgroups newsgroups))))

(defun wl-folder-get-path (entity target-id &optional string)
  (let ((entities (list entity))
        entity-stack result-path)
    (reverse
     (catch 'done
       (while entities
         (setq entity (wl-pop entities))
         (cond
          ((consp entity)
           (if (and (or (not string) (string= string (car entity)))
                    (eq target-id (wl-folder-get-entity-id (car entity))))
               (throw 'done
                      (wl-push target-id result-path))
             (wl-push (wl-folder-get-entity-id (car entity)) result-path))
           (wl-push entities entity-stack)
           (setq entities (nth 2 entity)))
          ((stringp entity)
           (if (and (or (not string) (string= string entity))
                    (eq target-id (wl-folder-get-entity-id entity)))
               (throw 'done
                      (wl-push target-id result-path)))))
         (unless entities
           (while (and entity-stack
                       (not entities))
             (setq result-path (cdr result-path))
             (setq entities (wl-pop entity-stack)))))))))

(defun wl-folder-create-group-alist (entity)
  (if (consp entity)
      (let ((flist (nth 2 entity))
            (cur-alist (list (cons (car entity) nil)))
             append-alist)
        (while flist
          (if (consp (car flist))
              (wl-append append-alist
                         (wl-folder-create-group-alist (car flist))))
          (setq flist (cdr flist)))
        (append cur-alist append-alist))))

(defun wl-folder-init-info-hashtb ()
  (let ((info-alist (and wl-folder-info-save
                         (elmo-msgdb-finfo-load))))
    (elmo-folder-info-make-hashtb
     info-alist
     wl-folder-entity-hashtb)))
;;; (wl-folder-resume-entity-hashtb-by-finfo
;;;  wl-folder-entity-hashtb
;;;  info-alist)))

(defun wl-folder-cleanup-variables ()
  (setq wl-folder-entity nil
        wl-folder-entity-hashtb nil
        wl-folder-entity-id-name-hashtb nil
        wl-folder-group-alist nil
        wl-folder-petname-alist nil
        wl-folder-newsgroups-hashtb nil
        wl-fldmgr-cut-entity-list nil
        wl-fldmgr-modified nil
        wl-fldmgr-modified-access-list nil
        wl-score-cache nil
        ))

(defun wl-make-plugged-alist ()
  (let ((entity-list (wl-folder-get-entity-list wl-folder-entity))
        (add (not wl-reset-plugged-alist)))
    (while entity-list
      (elmo-folder-set-plugged
       (wl-folder-get-elmo-folder (car entity-list)) wl-plugged add)
      (setq entity-list (cdr entity-list)))
    ;; smtp posting server
    (when wl-smtp-posting-server
      (elmo-set-plugged wl-plugged
                        wl-smtp-posting-server  ; server
                        (or wl-smtp-posting-port
                            (and (boundp 'smtp-service) smtp-service)
                            "smtp")     ; port
                        wl-smtp-connection-type
                        nil nil "smtp" add))
    ;; nntp posting server
    (when wl-nntp-posting-server
      (elmo-set-plugged wl-plugged
                        wl-nntp-posting-server
                        wl-nntp-posting-port
                        wl-nntp-posting-stream-type
                        nil nil "nntp" add))
    (run-hooks 'wl-make-plugged-hook)))

(defvar wl-folder-init-function 'wl-local-folder-init)

(defun wl-folder-init ()
  "Return top-level folder entity."
  (interactive)
  (if wl-use-acap
      (wl-acap-init)
    (funcall wl-folder-init-function))
  (run-hooks 'wl-folder-init-hook))

(defun wl-local-folder-init ()
  "Initialize local folder."
  (message "Initializing folder...")
  (setq wl-folder-entity (wl-folder-create-folder-entity))
  (message "Initializing folder...done"))

(defun wl-folder-get-realname (petname)
  (or (car
       (wl-string-rassoc
        petname
        wl-folder-petname-alist))
      petname))

(defun wl-folder-get-petname (name)
  (or (cdr
       (wl-string-assoc
        name
        wl-folder-petname-alist))
      name))

(defun wl-folder-get-entity-with-petname ()
  (let ((alist wl-folder-petname-alist)
        (hashtb (copy-sequence wl-folder-entity-hashtb)))
    (while alist
      (wl-folder-set-entity-info (cdar alist) nil hashtb)
      (setq alist (cdr alist)))
    hashtb))

(defun wl-folder-get-newsgroups (folder)
  "Return Newsgroups field value string for FOLDER newsgroup.
If FOLDER is multi, return comma separated string (cross post)."
  (let ((nlist (elmo-folder-newsgroups
                        (wl-folder-get-elmo-folder folder))))
    (if nlist
        (list nil nil (mapconcat 'identity nlist ","))
      nil)))

(defun wl-folder-guess-mailing-list-by-refile-rule (entity)
  "Return ML address guess by ENTITY.
Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'."
  (let ((flist
         (elmo-folder-get-primitive-list
          (wl-folder-get-elmo-folder entity)))
        fld mladdr to)
    (while (setq fld (car flist))
      (setq mladdr (wl-folder-guess-mailing-list-by-refile-rule-subr
                    (elmo-folder-name-internal fld)))
      (when mladdr
        (setq to (if (stringp to)
                     (concat to ", " mladdr)
                   mladdr)))
      (setq flist (cdr flist)))
    (if (stringp to)
        (list to nil nil)
      nil)))

(defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity)
  (unless (memq (elmo-folder-type entity)
                '(localnews nntp))
    (let ((rules wl-refile-rule-alist)
          tokey toalist)
      (while rules
        (if (or (and (stringp (car (car rules)))
                     (string-match "[Tt]o" (car (car rules))))
                (and (listp (car (car rules)))
                     (elmo-string-matched-member "to" (car (car rules))
                                                 'case-ignore)))
            (setq toalist (append toalist (cdr (car rules)))))
        (setq rules (cdr rules)))
      (setq tokey (car (rassoc entity toalist)))
;;;     (setq histkey (car (rassoc folder wl-refile-alist)))
      ;; case-ignore search `wl-subscribed-mailing-list'
      (if (stringp tokey)
          (elmo-string-matched-member tokey wl-subscribed-mailing-list t)))))

(defun wl-folder-guess-mailing-list-by-folder-name (entity)
  "Return ML address guess by ENTITY name's last hierarchy.
Use `wl-subscribed-mailing-list'."
  (let ((flist
         (elmo-folder-get-primitive-list
          (wl-folder-get-elmo-folder entity)))
        fld mladdr to)
    (while (setq fld (car flist))
      (setq mladdr (wl-folder-guess-mailing-list-by-folder-name-subr
                    (elmo-folder-name-internal fld)))
      (when mladdr
        (setq to (if (stringp to)
                     (concat to ", " mladdr)
                   mladdr)))
      (setq flist (cdr flist)))
    (if (stringp to)
        (list to nil nil)
      nil)))

(defun wl-folder-guess-mailing-list-by-folder-name-subr (entity)
  (when (memq (elmo-folder-type entity)
              '(localdir imap4 maildir))
    (let (key foldername)
      ;; Get foldername and Remove folder type symbol.
      (setq foldername (substring entity 1))
      (if (string-match "@" foldername)
          (setq foldername (substring foldername 0 (match-beginning 0))))
      (when (string-match "[^\\./]+$" foldername)
        (setq key (regexp-quote
                   (concat (substring foldername (match-beginning 0)) "@")))
        (elmo-string-matched-member
         key wl-subscribed-mailing-list 'case-ignore)))))

(defun wl-folder-update-diff-line (diffs)
  (let ((inhibit-read-only t)
        (buffer-read-only nil)
        cur-new new-new
        cur-unread new-unread
        cur-all new-all
        id is-group)
    (save-excursion
      (beginning-of-line)
      (setq id (get-text-property (point) 'wl-folder-entity-id))
      (setq is-group (get-text-property (point) 'wl-folder-is-group))
      (when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)")
        ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
        (setq cur-new (string-to-number
                       (wl-match-buffer 2)))
        (setq cur-unread (string-to-number
                          (wl-match-buffer 3)))
        (setq cur-all (string-to-number
                       (wl-match-buffer 4)))
        (delete-region (match-beginning 2)
                       (match-end 4))
        (goto-char (match-beginning 2))
        (insert (format "%s/%s/%s"
                        (setq new-new (+ cur-new (nth 0 diffs)))
                        (setq new-unread (+ cur-unread (nth 1 diffs)))
                        (setq new-all (+ cur-all (nth 2 diffs)))))
        (wl-folder-put-folder-property (match-beginning 2) (point) id is-group)
        (if wl-use-highlight-mouse-line
            (put-text-property (match-beginning 2) (point)
                               'mouse-face 'highlight))
        (wl-highlight-folder-group-line (list new-new new-unread new-all))
        (setq buffer-read-only t)
        (set-buffer-modified-p nil)))))

(defun wl-folder-update-line (nums &optional is-group)
  (let ((inhibit-read-only t)
        (buffer-read-only nil)
        id is-group)
    (save-excursion
      (beginning-of-line)
      (setq id (get-text-property (point) 'wl-folder-entity-id))
      (setq is-group (get-text-property (point) 'wl-folder-is-group))
      (if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
;;;       (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
          (progn
            (delete-region (match-beginning 2)
                           (match-end 2))
            (goto-char (match-beginning 2))
            (insert (format "%s/%s/%s"
                            (or (nth 0 nums) "*")
                            (or (and (nth 0 nums)(nth 1 nums)
                                     (+ (nth 0 nums)(nth 1 nums)))
                                "*")
                            (or (nth 2 nums) "*")))
            (wl-folder-put-folder-property (match-beginning 2) (point) id is-group)
            (if is-group
                ;; update only colors
                (wl-highlight-folder-group-line nums)
              (wl-highlight-folder-current-line nums))
            (beginning-of-line)
            (set-buffer-modified-p nil))))))

(defun wl-folder-goto-folder (&optional arg)
  "Visit some folder."
  (interactive "P")
  (wl-folder-goto-folder-subr nil arg))

(defun wl-folder-goto-folder-sticky ()
  "Visit some folder and make it sticky."
  (interactive)
  (wl-folder-goto-folder-subr nil t))

(defun wl-folder-goto-draft-folder (&optional arg)
  "Visit draft folder."
  (interactive "P")
  (wl-folder-goto-folder-subr wl-draft-folder arg))

(defun wl-folder-revisit-last-visited-folder (&optional arg)
  "Revisit last visited folder."
  (interactive "P")
  (let ((folder
         (wl-folder-get-folder-name-by-id wl-folder-buffer-last-visited-entity-id)))
    (if (and folder
             (y-or-n-p (format "Revisit %s? " folder)))
        (wl-folder-goto-folder-subr folder arg))))

(defun wl-folder-goto-folder-subr (&optional folder sticky)
  (beginning-of-line)
  (let (summary-buf fld-name entity id error-selecting)
;;; (setq fld-name (wl-folder-get-entity-from-buffer))
;;; (if (or (null fld-name)
;;;         (assoc fld-name wl-folder-group-alist))
    (setq fld-name wl-default-folder)
    (setq fld-name (or folder
                       (let (this-command)
                         (wl-summary-read-folder fld-name))))
    (if (and (setq entity
                   (wl-folder-search-entity-by-name fld-name
                                                    wl-folder-entity
                                                    'folder))
             (setq id (wl-folder-get-entity-id entity)))
        (wl-folder-set-current-entity-id id))
    (setq summary-buf (wl-summary-get-buffer-create fld-name sticky))
    (if (or wl-stay-folder-window wl-summary-use-frame)
        (wl-folder-select-buffer summary-buf)
      (if (and summary-buf
               (get-buffer-window summary-buf))
          (delete-window)))
    (wl-summary-goto-folder-subr fld-name
                                 (wl-summary-get-sync-range
                                  (wl-folder-get-elmo-folder fld-name))
                                 nil sticky t)))

(defun wl-folder-suspend ()
  (interactive)
  (run-hooks 'wl-folder-suspend-hook)
  (wl-folder-info-save)
  (elmo-crosspost-message-alist-save)
  (elmo-quit)
  ;(if (fboundp 'mmelmo-cleanup-entity-buffers)
  ;(mmelmo-cleanup-entity-buffers))
  (bury-buffer wl-folder-buffer-name)
  (dolist (summary-buf (wl-collect-summary))
    (bury-buffer summary-buf))
  (dolist (draft-buf (wl-collect-draft))
    (bury-buffer draft-buf))
  (delete-windows-on wl-folder-buffer-name t))

(defun wl-folder-info-save ()
  (when (and wl-folder-info-save
             wl-folder-info-alist-modified)
    (let ((entities (list wl-folder-entity))
          entity entity-stack info-alist info)
      (while entities
        (setq entity (wl-pop entities))
        (cond
         ((consp entity)
          (and entities
               (wl-push entities entity-stack))
          (setq entities (nth 2 entity)))
         ((stringp entity)
          (when (and (setq info (elmo-folder-get-info
                                 (wl-folder-get-elmo-folder entity)))
                     (not (equal info '(nil))))
            (if (listp info)
                (wl-append info-alist (list (list (elmo-string entity)
                                                  (list (nth 3 info)  ;; max
                                                        (nth 2 info)  ;; length
                                                        (nth 0 info)  ;; new
                                                        (nth 1 info)) ;; unread
                                                  )))))))
        (unless entities
          (setq entities (wl-pop entity-stack))))
      (elmo-msgdb-finfo-save info-alist)
      (setq wl-folder-info-alist-modified nil))))

(defun wl-folder-goto-first-unread-folder (&optional arg)
  (interactive "P")
  (let ((entities (list wl-folder-entity))
        entity entity-stack ret-val
        first-entity finfo)
    (setq first-entity
          (catch 'done
            (while entities
              (setq entity (wl-pop entities))
              (cond
               ((consp entity)
                (and entities
                     (wl-push entities entity-stack))
                (setq entities (nth 2 entity)))
               ((stringp entity)
                (if (and (setq finfo (wl-folder-get-entity-info entity))
                         (and (nth 0 finfo)(nth 1 finfo))
                         (> (+ (nth 0 finfo)(nth 1 finfo)) 0))
                    (throw 'done entity))
                (wl-append ret-val (list entity))))
              (unless entities
                (setq entities (wl-pop entity-stack))))))
    (if first-entity
        (progn
          (when arg
            (wl-folder-jump-folder first-entity)
            (sit-for 0))
          (wl-folder-goto-folder-subr first-entity))
      (message "No unread folder"))))

(defun wl-folder-jump-folder (&optional fld-name noopen)
  (interactive)
  (if (not fld-name)
      (setq fld-name (wl-summary-read-folder wl-default-folder)))
  (goto-char (point-min))
  (if (not noopen)
      (wl-folder-open-folder fld-name))
  (and (wl-folder-buffer-search-entity fld-name)
       (beginning-of-line)))

(defun wl-folder-get-entity-list (entity)
  (let ((entities (list entity))
        entity-stack ret-val)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity)))
       ((stringp entity)
        (wl-append ret-val (list entity))))
      (unless entities
        (setq entities (wl-pop entity-stack))))
    ret-val))

(defun wl-folder-open-unread-folder (entity)
  (save-excursion
    (let ((alist (wl-folder-get-entity-list entity))
          (unread 0)
          finfo path-list path id)
      (while alist
        (when (and (setq finfo (wl-folder-get-entity-info (car alist)))
                   (nth 0 finfo) (nth 1 finfo)
                   (> (+ (nth 0 finfo)(nth 1 finfo)) 0))
          (setq unread (+ unread (+ (nth 0 finfo)(nth 1 finfo))))
          (setq id (wl-folder-get-entity-id (car alist)))
          (setq path (delete id (wl-folder-get-path
                                 wl-folder-entity
                                 id
                                 (car alist))))
          (if (not (member path path-list))
              (wl-append path-list (list path))))
        (setq alist (cdr alist)))
      (while path-list
        (wl-folder-open-folder-sub (car path-list))
        (setq path-list (cdr path-list)))
      (message "%s unread folder"
               (if (> unread 0) unread "No")))))

(defun wl-folder-open-unread-current-entity ()
  (interactive)
  (let ((entity-name (wl-folder-get-entity-from-buffer))
        (group (wl-folder-buffer-group-p)))
    (when entity-name
      (wl-folder-open-unread-folder
       (if group
           (wl-folder-search-group-entity-by-name entity-name
                                                  wl-folder-entity)
         entity-name)))))

(defun wl-folder-open-only-unread-folder ()
  (interactive)
  (let ((id (progn
              (wl-folder-prev-entity-skip-invalid t)
              (wl-folder-get-entity-from-buffer t))))
    (wl-folder-open-all-unread-folder)
    (save-excursion
      (goto-char (point-max))
      (while (and (re-search-backward
                   "^[ ]*\\[[-]\\].+:0/0/[0-9-]+" nil t)
                  (not (bobp)))
        (wl-folder-jump-to-current-entity) ;; close it
        ))
    (wl-folder-move-path id)
    (recenter)))

(defun wl-folder-open-all-unread-folder (&optional arg)
  (interactive "P")
  (let ((id (progn
              (wl-folder-prev-entity-skip-invalid t)
              (wl-folder-get-entity-from-buffer t))))
    (wl-folder-open-unread-folder wl-folder-entity)
    (if (not arg)
        (wl-folder-move-path id)
      (goto-char (point-min))
      (wl-folder-next-unread t))))

(defun wl-folder-open-folder (&optional fld-name)
  (interactive)
  (if (not fld-name)
      (setq fld-name (wl-summary-read-folder wl-default-folder)))
  (let ((entity (wl-folder-search-entity-by-name
                 fld-name wl-folder-entity 'folder)))
    (if entity
        (let* ((id (wl-folder-get-entity-id entity))
               (path (and id (wl-folder-get-path wl-folder-entity id))))
          (if path (wl-folder-open-folder-sub path)))
      (message "%s: not found" fld-name))))

(defun wl-folder-open-folder-sub (path)
  (let ((inhibit-read-only t)
        (buffer-read-only nil)
        indent name entity
        err)
    (save-excursion
      (goto-char (point-min))
      (while (and path
                  (wl-folder-buffer-search-group
                   (wl-folder-get-petname
                    (if (stringp (car path))
                        (car path)
                      (wl-folder-get-folder-name-by-id
                       (car path))))))
        (beginning-of-line)
        (setq path (cdr path))
        (if (and (wl-folder-buffer-group-p)
                  (looking-at wl-folder-group-regexp)
                 (string= "+" (wl-match-buffer 2)));; closed group
            (save-excursion
              (setq indent (wl-match-buffer 1))
              (setq name (wl-folder-get-entity-from-buffer))
              (setq entity (wl-folder-search-group-entity-by-name
                            name
                            wl-folder-entity))
              ;; insert as opened
              (setcdr (assoc (car entity) wl-folder-group-alist) t)
              (if (eq 'access (cadr entity))
                  (wl-folder-maybe-load-folder-list entity))
              (wl-folder-insert-entity indent entity)
              (delete-region (save-excursion (beginning-of-line)
                                             (point))
                             (save-excursion (end-of-line)
                                             (+ 1 (point)))))))
      (set-buffer-modified-p nil))))

(defun wl-folder-open-all-pre ()
  (let ((entities (list wl-folder-entity))
        entity entity-stack group-entry)
    (while entities
      (setq entity (wl-pop entities))
      (cond
       ((consp entity)
        (unless (or (not (setq group-entry
                               (assoc (car entity) wl-folder-group-alist)))
                    (cdr group-entry))
          (setcdr group-entry t)
          (when (eq 'access (cadr entity))
            (wl-folder-maybe-load-folder-list entity)))
        (and entities
             (wl-push entities entity-stack))
        (setq entities (nth 2 entity))))
      (unless entities
        (setq entities (wl-pop entity-stack))))))

(defun wl-folder-open-all (&optional refresh)
  (interactive "P")
  (let* ((inhibit-read-only t)
         (buffer-read-only nil)
         (len (length wl-folder-group-alist))
         (i 0)
         indent name entity)
    (if refresh
        (let ((id (progn
                    (wl-folder-prev-entity-skip-invalid t)
                    (wl-folder-get-entity-from-buffer t)))
              (alist wl-folder-group-alist))
          (while alist
            (setcdr (pop alist) t))
          (erase-buffer)
          (wl-folder-insert-entity " " wl-folder-entity)
          (wl-folder-move-path id))
      (elmo-with-progress-display
          (wl-folder-open-all (length wl-folder-group-alist))
          "Opening all folders"
        (wl-folder-open-all-pre)
        (save-excursion
          (goto-char (point-min))
          (while (re-search-forward
                  "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$"
                  nil t)
            (setq indent (wl-match-buffer 1))
            (setq name (wl-folder-get-entity-from-buffer))
            (setq entity (wl-folder-search-group-entity-by-name
                          name
                          wl-folder-entity))
            ;; insert as opened
            (setcdr (assoc (car entity) wl-folder-group-alist) t)
            (beginning-of-line)
            (wl-folder-insert-entity indent entity)
            (delete-region (save-excursion (beginning-of-line)
                                           (point))
                           (save-excursion (end-of-line)
                                           (+ 1 (point))))
            (elmo-progress-notify 'wl-folder-open-all)))))
    (wl-highlight-folder-path wl-folder-buffer-cur-path)
    (set-buffer-modified-p nil)))

(defun wl-folder-close-all ()
  (interactive)
  (let ((inhibit-read-only t)
        (buffer-read-only nil)
        (alist wl-folder-group-alist)
        (id (progn
              (wl-folder-prev-entity-skip-invalid t)
              (wl-folder-get-entity-from-buffer t))))
    (while alist
      (setcdr (car alist) nil)
      (setq alist (cdr alist)))
    (setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
    (erase-buffer)
    (wl-folder-insert-entity " " wl-folder-entity)
    (wl-folder-move-path id)
    (wl-highlight-folder-path wl-folder-buffer-cur-path)
    (recenter)
    (set-buffer-modified-p nil)))

(defun wl-folder-open-close ()
  "Open or close parent entity."
  (interactive)
  (unless (wl-folder-get-entity-from-buffer)
    (error "No folder"))
  (beginning-of-line)
  (if (wl-folder-buffer-group-p)
      ;; if group (whether opend or closed.)
      (wl-folder-jump-to-current-entity)
    ;; if folder
    (let (indent)
      (setq indent (save-excursion
                     (re-search-forward "\\([ ]*\\)." nil t)
                     (wl-match-buffer 1)))
      (while (looking-at indent)
        (forward-line -1)))
    (wl-folder-jump-to-current-entity)))

(defsubst wl-folder-access-subscribe-p (group folder)
  (let (subscr regexp match)
    (if (setq subscr (wl-get-assoc-list-value
                      wl-folder-access-subscribe-alist
                      group))
        (progn
          (setq regexp (mapconcat 'identity (cdr subscr) "\\|"))
          (setq match (string-match regexp folder))
          (if (car subscr)
              match
            (not match)))
      t)))

(defun wl-folder-update-access-group (entity new-flist)
  (let ((flist (nth 2 entity))
        (unsubscribes (nth 3 entity))
        diff new-unsubscribes removes
        subscribed-list folder group entry)
    (elmo-with-progress-display
        (wl-folder-update-access-group (+ (length flist) (length unsubscribes)))
        "Updating access group"
      ;; check subscribed groups
      (while flist
        (cond
         ((listp (car flist))   ;; group
          (setq group (elmo-string (caar flist)))
          (cond
           ((assoc group new-flist)     ;; found in new-flist
            (setq new-flist (delete (assoc group new-flist)
                                    new-flist))
            (if (wl-folder-access-subscribe-p (car entity) group)
                (wl-append subscribed-list (list (car flist)))
              (wl-append new-unsubscribes (list (car flist)))
              (setq diff t)))
           (t
            (setq wl-folder-group-alist
                  (delete (wl-string-assoc group wl-folder-group-alist)
                          wl-folder-group-alist))
            (wl-append removes (list (list group))))))
         (t                     ;; folder
          (setq folder (elmo-string (car flist)))
          (cond
           ((member folder new-flist)   ;; found in new-flist
            (setq new-flist (delete folder new-flist))
            (if (wl-folder-access-subscribe-p (car entity) folder)
                (wl-append subscribed-list (list (car flist)))
              (wl-append new-unsubscribes (list folder))
              (setq diff t)))
           (t
            (wl-append removes (list folder))))))
        (elmo-progress-notify 'wl-folder-update-access-group)
        (setq flist (cdr flist)))
      ;; check unsubscribed groups
      (while unsubscribes
        (cond
         ((listp (car unsubscribes))
          (when (setq entry (assoc (caar unsubscribes) new-flist))
            (setq new-flist (delete entry new-flist))
            (wl-append new-unsubscribes (list (car unsubscribes)))))
         (t
          (when (member (car unsubscribes) new-flist)
            (setq new-flist (delete (car unsubscribes) new-flist))
            (wl-append new-unsubscribes (list (car unsubscribes))))))
        (elmo-progress-notify 'wl-folder-update-access-group)
        (setq unsubscribes (cdr unsubscribes)))
      ;;
      (if (or new-flist removes)
          (setq diff t))
      (setq new-flist
            (mapcar '(lambda (x)
                       (cond ((consp x) (list (car x) 'access))
                             (t x)))
                    new-flist))
      ;; check new groups
      (let ((new-list new-flist))
        (while new-list
          (if (not (wl-folder-access-subscribe-p
                    (car entity)
                    (if (listp (car new-list))
                        (caar new-list)
                      (car new-list))))
              ;; auto unsubscribe
              (progn
                (wl-append new-unsubscribes (list (car new-list)))
                (setq new-flist (delete (car new-list) new-flist)))
            (cond
             ((listp (car new-list))
              ;; check group exists
              (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
                  (progn
                    (message "%s: group already exists." (caar new-list))
                    (sit-for 1)
                    (wl-append new-unsubscribes (list (car new-list)))
                    (setq new-flist (delete (car new-list) new-flist)))
                (wl-append wl-folder-group-alist
                           (list (cons (caar new-list) nil)))))))
          (setq new-list (cdr new-list)))))
    (when new-flist
      (message "%d new folder(s)." (length new-flist)))
    (wl-append new-flist subscribed-list)       ;; new is first
    (run-hooks 'wl-folder-update-access-group-hook)
    (setcdr (cdr entity) (list new-flist new-unsubscribes))
    (list diff new-flist new-unsubscribes removes)))

(defun wl-folder-prefetch-entity (entity)
  "Prefetch all new messages in the ENTITY."
  (cond
   ((consp entity)
    (let ((flist (nth 2 entity))
          (sum-done 0)
          (sum-all 0)
          result)
      (while flist
        (setq result (wl-folder-prefetch-entity (car flist)))
        (setq sum-done (+ sum-done (car result)))
        (setq sum-all (+ sum-all (cdr result)))
        (setq flist (cdr flist)))
      (message "Prefetched %d/%d message(s) in \"%s\"."
               sum-done sum-all
               (wl-folder-get-petname (car entity)))
      (cons sum-done sum-all)))
   ((stringp entity)
    (let* ((folder (wl-folder-get-elmo-folder entity))
           (nums (wl-folder-get-entity-info entity))
           (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
                                         (wl-summary-always-sticky-folder-p
                                          folder))
                                     wl-summary-highlight))
           wl-summary-exit-next-move
           wl-auto-select-first ret-val
           count sticky)
      (setq count (or (car nums) 0))
      (setq count (+ count (wl-folder-count-incorporates folder)))
      (if (or (null (car nums)) ; unknown
              (< 0 count))
          (save-window-excursion
            (save-excursion
              (let ((wl-summary-buffer-name
                     (if (setq sticky (get-buffer
                                       (wl-summary-sticky-buffer-name
                                        (elmo-folder-name-internal
                                         folder))))
                         ;; Sticky folder exists.
                         (wl-summary-sticky-buffer-name
                          (elmo-folder-name-internal folder))
                       (concat
                        wl-summary-buffer-name
                        (symbol-name this-command))))
                    (wl-summary-use-frame nil)
                    (wl-summary-always-sticky-folder-list nil))
                (wl-summary-goto-folder-subr entity
                                             (wl-summary-get-sync-range
                                              folder)
                                             nil)
                (setq ret-val (wl-summary-incorporate))
                (if sticky
                    (wl-summary-save-status)
                  (wl-summary-exit))
                ret-val)))
        (cons 0 0))))))

(defun wl-folder-count-incorporates (folder)
  (let ((sum 0))
    (dolist (number (elmo-folder-list-flagged folder 'any))
      (when (member (wl-summary-message-mark folder number)
                    wl-summary-incorporate-marks)
        (incf sum)))
    sum))

(defun wl-folder-prefetch-current-entity (&optional no-check)
  "Prefetch all uncached messages in the folder at position.
If current line is group folder, all subfolders are prefetched."
  (interactive "P")
  (save-excursion
    (let ((entity-name (wl-folder-get-entity-from-buffer))
          (group (wl-folder-buffer-group-p))
          wl-folder-check-entity-hook
          summary-buf entity)
      (when entity-name
        (setq entity
              (if group
                  (wl-folder-search-group-entity-by-name entity-name
                                                         wl-folder-entity)
                entity-name))
        (if (not no-check)
            (wl-folder-check-entity entity))
        (wl-folder-prefetch-entity entity)))))

;(defun wl-folder-drop-unsync-entity (entity)
;  "Drop all unsync messages in the ENTITY."
;  (cond
;   ((consp entity)
;    (let ((flist (nth 2 entity)))
;      (while flist
;       (wl-folder-drop-unsync-entity (car flist))
;       (setq flist (cdr flist)))))
;   ((stringp entity)
;    (let ((nums (wl-folder-get-entity-info entity))
;         wl-summary-highlight wl-auto-select-first new)
;      (setq new (or (car nums) 0))
;      (if (< 0 new)
;         (save-window-excursion
;           (save-excursion
;             (let ((wl-summary-buffer-name (concat
;                                            wl-summary-buffer-name
;                                            (symbol-name this-command))))
;               (wl-summary-goto-folder-subr entity 'no-sync nil)
;               (wl-summary-drop-unsync)
;               (wl-summary-exit)))))))))

;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
;  "Drop all unsync messages in the folder at position.
;If current line is group folder, all subfolders are dropped.
;If optional arg exists, don't check any folders."
;  (interactive "P")
;  (save-excursion
;    (let ((entity-name (wl-folder-get-entity-from-buffer))
;         (group (wl-folder-buffer-group-p))
;         wl-folder-check-entity-hook
;         summary-buf entity)
;      (when (and entity-name
;                (y-or-n-p (format
;                           "Drop all unsync messages in %s? " entity-name)))
;       (setq entity
;             (if group
;                 (wl-folder-search-group-entity-by-name entity-name
;                                                        wl-folder-entity)
;               entity-name))
;       (if (null force-check)
;           (wl-folder-check-entity entity))
;       (wl-folder-drop-unsync-entity entity)
;       (message "All unsync messages in %s are dropped!" entity-name)))))

(defun wl-folder-write-current-folder ()
  "Write message to current folder's newsgroup or mailing-list.
Call `wl-summary-write-current-folder' with current folder name."
  (interactive)
  (unless (wl-folder-buffer-group-p)
    (wl-summary-write-current-folder
     (wl-folder-get-entity-from-buffer))))

(defun wl-folder-mimic-kill-buffer ()
  "Kill the current (Folder) buffer with query."
  (interactive)
  (let ((bufname (read-buffer (format "Kill buffer: (default %s) "
                                      (buffer-name))))
        wl-interactive-exit)
    (if (or (not bufname)
            (string-equal bufname "")
            (string-equal bufname (buffer-name)))
        (wl-exit)
      (kill-buffer bufname))))

(defun wl-folder-create-subr (folder)
  (let ((name (elmo-folder-name-internal folder)))
    (unless (elmo-folder-creatable-p folder)
      (error "Folder %s does not exist" name))
    (unless (y-or-n-p (format "Folder %s does not exist, create it? " name))
      (error "Folder %s is not created" name))
    (message "")
    (setq wl-folder-entity-hashtb
          (wl-folder-create-entity-hashtb name wl-folder-entity-hashtb))
    (unless (elmo-folder-create folder)
      (error "Create folder failed"))))

(defun wl-folder-confirm-existence (folder &optional force)
  (if force
      (unless (elmo-folder-exists-p folder)
        (wl-folder-create-subr folder))
    (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder))
                (and (elmo-folder-msgdb-path folder)
                     (file-exists-p (elmo-folder-msgdb-path folder)))
                (elmo-folder-exists-p folder))
      (wl-folder-create-subr folder))))

(defun wl-folder-virtual ()
  "Goto virtual folder."
  (interactive)
  (let ((entity (wl-folder-get-entity-from-buffer)))
    (if (wl-folder-buffer-group-p)
        (setq entity
              (concat
               "*"
               (mapconcat 'identity
                          (wl-folder-get-entity-list
                           (wl-folder-search-group-entity-by-name
                            entity
                            wl-folder-entity)) ","))))
    (unless entity (error "No folder"))
    (wl-folder-goto-folder-subr
     (concat "/"
             (wl-read-search-condition
              wl-fldmgr-make-filter-default)
             "/" entity))))

(defun wl-folder-pick ()
  (interactive)
  (save-excursion
    (let* ((condition (car (elmo-parse-search-condition
                            (wl-read-search-condition
                             wl-summary-pick-field-default))))
           (entity (wl-folder-get-entity-from-buffer))
           (folder-list
            (if (wl-folder-buffer-group-p)
                (wl-folder-get-entity-list
                 (wl-folder-search-group-entity-by-name
                  entity
                  wl-folder-entity))
              (list entity)))
           results ret)
      (while (car folder-list)
        (setq ret (elmo-folder-search
                   (wl-folder-get-elmo-folder (car folder-list))
                   condition))
        (if ret
            (setq results
                  (append results
                          (list (cons (car folder-list) ret)))))
        (setq folder-list (cdr folder-list)))
      (if results
          (message "%s are picked."
                   (mapconcat '(lambda (res)
                                 (format "%s(%d)"
                                         (car res)
                                         (length (cdr res))))
                              results
                              ","))
        (message "No message was picked.")))))

(defun wl-folder-jump-to-next-summary ()
  (interactive)
  (when (wl-collect-summary)
    (if (get-buffer-window (car (wl-collect-summary)))
        (switch-to-buffer-other-window (car (wl-collect-summary))))
    (wl-summary-next-buffer)))

(defun wl-folder-jump-to-previous-summary ()
  (interactive)
  (when (wl-collect-summary)
    (if (get-buffer-window (car (wl-collect-summary)))
        (switch-to-buffer-other-window (car (wl-collect-summary))))
    (wl-summary-previous-buffer)))

;;;
;; Completion
(defvar wl-folder-complete-folder-candidate nil)

(defun wl-folder-complete-folder (string predicate flag)
  (cond ((or (string-match "^\\(/[^/]*/\\)\\(.*\\)$" string) ; filter
             (string-match "^\\(\*\\|\*.*,\\)\\([^,]*\\)$" string) ; multi
             (string-match "^\\(|[^|]*|:?\\)\\(.*\\)$" string) ;pipe-src
             (string-match "^\\(|\\)\\([^|]*\\)$" string)) ;pipe-dst
         (let* ((str1 (match-string 1 string))
                (str2 (match-string 2 string))
                (str2-comp (wl-folder-complete-folder str2 predicate flag)))
           (cond
            ((listp str2-comp) ; flag=t
             (mapcar (lambda (x) (concat str1 x)) str2-comp))
            ((stringp str2-comp)
             (concat str1 str2-comp))
            (t
             str2-comp))))
        ((string-match "^\\(/\\)\\([^/]*\\)$" string) ; filter-condition
         (let* ((str1 (match-string 1 string))
                (str2 (match-string 2 string))
                (str2-comp
                 (wl-folder-complete-filter-condition str2 predicate flag)))
           (cond
            ((listp str2-comp) ; flag=t
             (mapcar (lambda (x) (concat str1 x)) str2-comp))
            ((stringp str2-comp)
             (concat str1 str2-comp))
            (t
             str2-comp))))
        (t
         (let ((candidate
                (or wl-folder-complete-folder-candidate
                    (if (memq 'read-folder wl-use-folder-petname)
                        (wl-folder-get-entity-with-petname)
                      wl-folder-entity-hashtb))))
           (if (not flag)
               (try-completion string candidate)
             (all-completions string candidate))))))

(defun wl-folder-complete-filter-condition (string predicate flag)
  (cond
   ((string-match "^\\(.*|\\|.*&\\|.*(\\)\\([^:]*\\)$" string)
    (let* ((str1 (match-string 1 string))
           (str2 (match-string 2 string))
           (str2-comp
            (wl-folder-complete-filter-condition str2 predicate flag)))
      (cond
       ((listp str2-comp) ; flag=t
        (mapcar (lambda (x) (concat str1 x)) str2-comp))
       ((stringp str2-comp)
        (concat str1 str2-comp))
       (t
        str2-comp))))
   (t
    (let ((candidate
           (mapcar (lambda (x) (list (concat (downcase x) ":")))
                   (wl-search-condition-fields))))
      (if (not flag)
          (try-completion string candidate)
        (all-completions string candidate))))))

(require 'product)
(product-provide (provide 'wl-folder) (require 'wl-version))

;;; wl-folder.el ends here