X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=780cae093f918ea3efeacf3816c318f071cebd08;hb=4177b3f63f8a756293f7d72b553ecc8e478147fd;hp=cdc3dde0770cd7952262e3571fa57e8edc428a31;hpb=12486e286f2e8098a18078919ee9f29074f737c2;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-folder.el b/wl/wl-folder.el
index cdc3dde..780cae0 100644
--- a/wl/wl-folder.el
+++ b/wl/wl-folder.el
@@ -1,7 +1,7 @@
-;;; wl-folder.el -- Folder mode for Wanderlust.
+;;; wl-folder.el --- Folder mode for Wanderlust.
 
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;;                          Masahiro MURATA <muse@ba2.so-net.ne.jp>
+;; 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>
@@ -33,7 +33,7 @@
 
 (require 'elmo-vars)
 (require 'elmo-util)
-(require 'elmo2)
+(require 'elmo)
 (require 'wl-vars)
 (condition-case ()
     (require 'easymenu) ; needed here.
@@ -44,12 +44,12 @@
   (require 'wl-util)
   (provide 'wl-folder)
   (require 'wl)
-  (require 'elmo-nntp)
-  (if wl-use-semi
-      (require 'mmelmo))
-  (unless (boundp ':file)
-    (set (make-local-variable ':file) nil))
-  (defun-maybe mmelmo-cleanup-entity-buffers ()))
+  (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.
@@ -57,9 +57,11 @@
 (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-completion-func nil)
+(defvar wl-folder-completion-function nil)
 
 (defvar wl-folder-mode-map nil)
 
@@ -85,12 +87,16 @@
     ["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]
+;    ["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]
@@ -108,12 +114,13 @@
      ["Display all" wl-fldmgr-access-display-all t])
     "----"
     ["Write a message" wl-draft t]
+    ["Write for current folder" wl-folder-write-current-folder t]
     "----"
     ["Toggle Plug Status" wl-toggle-plugged t]
     ["Change Plug Status" wl-plugged-change t]
     "----"
     ["Save Current Status"  wl-save t]
-    ["Update Satus"         wl-status-update t]
+    ["Update Status"        wl-status-update t]
     ["Exit"                 wl-exit t]
     ))
 
@@ -126,14 +133,12 @@
 	'wl-folder-prev-unread)
       (define-key wl-folder-mode-map [(shift button5)]
 	'wl-folder-next-unread))
-  (if wl-on-nemacs
-      (defun wl-folder-setup-mouse ())
-    (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))))
+  (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
@@ -142,20 +147,25 @@
 ;  (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 "w"    'wl-draft)
-  (define-key wl-folder-mode-map "W"    'wl-folder-write-current-newsgroup)
+  (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 "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)
@@ -169,6 +179,8 @@
   (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 "\M-t" 'wl-toggle-plugged)
@@ -176,8 +188,7 @@
   (define-key wl-folder-mode-map "<"    'beginning-of-buffer)
   (define-key wl-folder-mode-map ">"    'end-of-buffer)
   ;; wl-fldmgr
-  (unless wl-on-nemacs
-    (define-key wl-folder-mode-map "m"    'wl-fldmgr-mode-map))
+  (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)
@@ -238,7 +249,8 @@
     (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t))
 
 (defun wl-folder-buffer-search-entity (folder &optional searchname)
-  (let ((search (or searchname (wl-folder-get-petname folder))))
+  (let ((search (or searchname (wl-folder-get-petname folder)))
+	case-fold-search)
     (re-search-forward
      (concat
       "^[ \t]*"
@@ -255,19 +267,14 @@
 			  entity (or hashtb wl-folder-entity-id-name-hashtb))))
 
 (defmacro wl-folder-get-entity-id (entity)
-  (` (or (get-text-property 0
-			    'wl-folder-entity-id
-			    (, entity))
-	 (, entity)))) ;; for nemacs
+  `(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 (not id) ;; for nemacs
-	   (wl-folder-get-realname (wl-folder-folder-name))
-	 (if (, getid)
-	     id
-	   (wl-folder-get-folder-name-by-id id))))))
+  `(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)
@@ -286,14 +293,16 @@
 (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 (, entity)
+       (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 (elmo-get-hash-val folder wl-folder-entity-hashtb) ; on Folder mode.
+  (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
@@ -307,6 +316,29 @@
 		     (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))))
+
+(defmacro wl-folder-get-elmo-folder (entity &optional no-cache)
+  "Get elmo folder structure from entity."
+  (` (if (, no-cache)
+	 (elmo-make-folder (elmo-string (, entity)))
+       (or (wl-folder-elmo-folder-cache-get (, entity))
+	   (let* ((name (elmo-string (, entity)))
+		  (folder (elmo-make-folder name)))
+	     (wl-folder-elmo-folder-cache-put name folder)
+	     folder)))))
+
 (defun wl-folder-prev-entity ()
   (interactive)
   (forward-line -1))
@@ -446,8 +478,9 @@
 	(wl-plugged t)
 	emptied)
     (if elmo-enable-disconnected-operation
-	(elmo-dop-queue-flush 'force)) ; Try flushing all queue.
-    (if (not (elmo-list-folder wl-queue-folder))
+	(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
@@ -479,7 +512,7 @@
 	(setq wl-thread-entities nil
 	      wl-thread-entity-list nil)
 	(if wl-summary-cache-use (wl-summary-save-view-cache))
-	(wl-summary-msgdb-save))
+	(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)
@@ -519,28 +552,29 @@ Optional argument ARG is repeart count."
       (goto-char (point-max))))
 
 (defsubst wl-folder-update-group (entity diffs &optional is-group)
-  (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))))))
+  (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))
@@ -563,6 +597,10 @@ Optional argument ARG is repeart count."
    (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")
@@ -582,33 +620,33 @@ Optional argument ARG is repeart count."
 	      (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 fname wl-folder-group-alist) nil))
-		(error
-		 (elmo-display-error errobj t)
-		 (ding)
-		 (setq err t)
-		 (setcdr (assoc fname 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))))))))
+		;; 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 fname wl-folder-group-alist) nil))
+		 ; (error
+		 ;  (elmo-display-error errobj t)
+		 ;  (ding)
+		 ;  (setq err t)
+		 ;  (setcdr (assoc fname 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
@@ -629,24 +667,20 @@ Optional argument ARG is repeart count."
 ;	  (wl-highlight-folder-current-line)
 	  )))
      ((setq fld-name (wl-folder-entity-name))
-      (if wl-on-nemacs
-	  (progn
-	    (wl-folder-set-current-entity-id
-	     (wl-folder-get-entity-from-buffer))
-	    (setq fld-name (wl-folder-get-realname fld-name)))
-	(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)))
+      (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 wl-stay-folder-window
+	(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 fld-name)
+				     (wl-summary-get-sync-range
+				      (wl-folder-get-elmo-folder fld-name))
 				     nil arg t)))))
   (set-buffer-modified-p nil))
 
@@ -768,10 +802,10 @@ Optional argument ARG is repeart count."
 	    ;(wl-folder-buffer-search-entity (car entity))
 	    ;(wl-folder-update-line ret-val)
 	    ))
-	 ((and (stringp entity)
-	       (elmo-folder-plugged-p entity))
+	 ((stringp entity)
 	  (message "Checking \"%s\"" entity)
-	  (setq ret-val (wl-folder-check-one-entity entity))
+	  (setq ret-val (wl-folder-check-one-entity
+			 entity))
 	  (goto-char start-pos)
 	  (sit-for 0))
 	 (t
@@ -782,70 +816,48 @@ Optional argument ARG is repeart count."
     (run-hooks 'wl-folder-check-entity-hook)
     ret-val))
 
-;; All contained folders are imap4 and persistent flag, then
-;; use server diff.
-(defun wl-folder-use-server-diff-p (folder)
-  (let ((spec (elmo-folder-get-spec folder)))
-    (cond
-     ((eq (car spec) 'multi)
-      (let ((folders (cdr spec)))
-	(catch 'done
-	  (while folders
-	    (if (wl-folder-use-server-diff-p (car folders))
-		(throw 'done t))
-	    (setq folders (cdr folders)))
-	  nil)))
-    ((eq (car spec) 'filter)
-     (wl-folder-use-server-diff-p (nth 2 spec)))
-    ((eq (car spec) 'imap4)
-     (and wl-folder-use-server-diff
-	  (elmo-imap4-use-flag-p spec)))
-    (t nil))))
-
-(defun wl-folder-check-one-entity (entity)
-  (let* ((elmo-use-server-diff (wl-folder-use-server-diff-p entity))
+(defun wl-folder-check-one-entity (entity &optional biff)
+  (let* ((folder (wl-folder-get-elmo-folder entity biff))
 	 (nums (condition-case err
-		   (if (wl-string-match-member entity wl-strict-diff-folders)
-		       (elmo-strict-folder-diff entity)
-		     (elmo-folder-diff entity))
+		   (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)))
 		 (error
 		  ;; maybe not exist folder.
 		  (if (and (not (memq 'elmo-open-error
 				      (get (car err) 'error-conditions)))
-			   (not (elmo-folder-exists-p entity)))
-		      (wl-folder-create-subr entity)
+			   (not (elmo-folder-exists-p folder)))
+		      (wl-folder-create-subr folder)
 		    (signal (car err) (cdr err))))))
-	 unread unsync nomif)
+	 (new    (elmo-diff-new nums))
+	 (unread (elmo-diff-unread nums))
+	 (all    (elmo-diff-all nums))
+	 unsync nomif)
     (if (and (eq wl-folder-notify-deleted 'sync)
-	     (car nums)
-	     (or (> 0 (car nums)) (> 0 (cdr nums))))
+	     (or (and new    (> 0 new))
+		 (and unread (> 0 unread))
+		 (and all    (> 0 all))))
 	(progn
 	  (wl-folder-sync-entity entity)
-	  (setq nums (elmo-folder-diff 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 unsync (if (and (car nums) (> 0 (car nums))) 0 (car nums)))
-	(setq nomif (if (and (car nums) (> 0 (cdr nums))) 0 (cdr nums)))
-	(setq nums (cons unsync nomif)))
+	(setq new    (and new    (max 0 new))
+	      unread (and unread (max 0 unread))
+	      all    (and all    (max 0 all))))
+      (setq unread (or (and unread (- unread (or new 0)))
+		       (elmo-folder-get-info-unread folder)
+		       (cdr (wl-summary-count-unread))))
       (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
-				   (list (car nums)
-					 (setq
-					  unread
-					  (or
-					   ;; If server diff, All unreads are
-					   ;; treated as unsync.
-					   (if elmo-use-server-diff 0)
-					   (elmo-folder-get-info-unread entity)
-					   (wl-summary-count-unread
-					    (elmo-msgdb-mark-load
-					     (elmo-msgdb-expand-path entity))
-					    entity)))
-					 (cdr nums))
-				   (current-buffer)))
+				   (list new unread all)
+				   (get-buffer wl-folder-buffer-name)))
     (setq wl-folder-info-alist-modified t)
     (sit-for 0)
-    (list (if wl-folder-notify-deleted
-	      (car nums)
-	    (max (or (car nums) 0))) unread (cdr nums))))
+    (list new unread all)))
 
 (defun wl-folder-check-entity-async (entity &optional auto)
   (let ((elmo-nntp-groups-async t)
@@ -855,50 +867,61 @@ Optional argument ARG is repeart count."
 		    (wl-folder-get-entity-list entity))
 		 (wl-folder-get-entity-list entity)))
 	(nntp-connection-keys nil)
-	folder spec-list local-elist net-elist server
+	name folder folder-list
+	sync-folder-list
+	async-folder-list
+	server
 	ret-val)
     (while elist
-      (if (not (elmo-folder-plugged-p (car elist)))
+      (setq folder (wl-folder-get-elmo-folder (car elist)))
+      (if (not (elmo-folder-plugged-p folder))
 	  (message "Uncheck \"%s\"" (car elist))
-	(setq spec-list
-	      (elmo-folder-get-primitive-spec-list (elmo-string (car elist))))
-	(cond ((assq 'nntp spec-list)
-	       (wl-append net-elist (list (car elist)))
-	       (while spec-list
-		 (when (eq (caar spec-list) 'nntp)
-		   (when (not (string= server (elmo-nntp-spec-hostname (car spec-list))))
-		     (setq server (elmo-nntp-spec-hostname (car spec-list)))
+	(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 spec-list)
+			  (car folder-list)
 			  nntp-connection-keys)))
-		 (setq spec-list (cdr spec-list))))
+		 (setq folder-list (cdr folder-list))))
 	      (t
-	       (wl-append local-elist (list (car elist))))))
+	       (wl-append sync-folder-list (list folder)))))
       (setq elist (cdr elist)))
     ;; check local entity at first
-    (while (setq folder (pop local-elist))
+    (while (setq folder (pop sync-folder-list))
       (if (not (elmo-folder-plugged-p folder))
-	  (message "Uncheck \"%s\"" folder)
-	(message "Checking \"%s\"" 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 folder)))
+	       (wl-folder-check-one-entity (elmo-folder-name-internal
+					    folder))))
 	;;(sit-for 0)
 	))
     ;; check network entity at last
-    (when net-elist
+    (when async-folder-list
       (elmo-nntp-get-folders-info nntp-connection-keys)
-      (while (setq folder (pop net-elist))
+      (while (setq folder (pop async-folder-list))
 	(if (not (elmo-folder-plugged-p folder))
-	    (message "Uncheck \"%s\"" folder)
-	  (message "Checking \"%s\"" 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 folder)))
+		 (wl-folder-check-one-entity (elmo-folder-name-internal
+					      folder))))
 	  ;;(sit-for 0)
 	  )))
     ret-val))
@@ -971,22 +994,38 @@ If current line is group folder, check all sub entries."
 	(wl-folder-sync-entity (car flist) unread-only)
 	(setq flist (cdr flist)))))
    ((stringp entity)
-    (let ((nums (wl-folder-get-entity-info entity))
-	  (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
-					(wl-summary-always-sticky-folder-p
-					 entity))
-				    wl-summary-highlight))
-	  wl-auto-select-first new unread)
+    (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-auto-select-first new unread sticky)
       (setq new (or (car nums) 0))
       (setq unread (or (cadr nums) 0))
       (if (or (not unread-only)
 	      (or (< 0 new) (< 0 unread)))
-	  (save-window-excursion
-	    (save-excursion
-	      (wl-summary-goto-folder-subr entity
-					   (wl-summary-get-sync-range entity)
-					   nil nil nil t)
-	      (wl-summary-exit))))))))
+	  (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))
+	    (save-window-excursion
+	      (save-excursion
+		(wl-summary-goto-folder-subr entity
+					     (wl-summary-get-sync-range
+					      folder)
+					     nil nil nil t)
+		(if sticky
+		    (wl-summary-save-status)
+		  (wl-summary-exit))))))))))
 
 (defun wl-folder-sync-current-entity (&optional unread-only)
   "Synchronize the folder at position.
@@ -996,7 +1035,7 @@ If current line is group folder, check all subfolders."
     (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)))
+		 (y-or-n-p (format "Sync %s? " entity-name)))
 	(wl-folder-sync-entity
 	 (if group
 	     (wl-folder-search-group-entity-by-name entity-name
@@ -1014,22 +1053,38 @@ If current line is group folder, check all subfolders."
 	(wl-folder-mark-as-read-all-entity (car flist))
 	(setq flist (cdr flist)))))
    ((stringp entity)
-    (let ((nums (wl-folder-get-entity-info entity))
-	  (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
-					(wl-summary-always-sticky-folder-p
-					 entity))
-				    wl-summary-highlight))
-	  wl-auto-select-first new unread)
+    (let* ((nums (wl-folder-get-entity-info entity))
+	   (folder (wl-folder-get-elmo-folder entity))
+	   (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
+					 (wl-summary-always-sticky-folder-p
+					  folder))
+				     wl-summary-highlight))
+	   wl-auto-select-first new unread sticky)
       (setq new (or (car nums) 0))
       (setq unread (or (cadr nums) 0))
       (if (or (< 0 new) (< 0 unread))
-	(save-window-excursion
-	  (save-excursion
-	    (wl-summary-goto-folder-subr entity
-					 (wl-summary-get-sync-range entity)
-					 nil)
-	    (wl-summary-mark-as-read-all)
-	    (wl-summary-exit)))
+	  (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)
+		(wl-summary-mark-as-read-all)
+		(if sticky
+		    (wl-summary-save-status)
+		  (wl-summary-exit)))))
 	(sit-for 0))))))
 
 (defun wl-folder-mark-as-read-all-current-entity ()
@@ -1041,7 +1096,7 @@ If current line is group folder, all subfolders are marked."
 	  (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)))
+		 (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
@@ -1065,7 +1120,8 @@ If current line is group folder, all subfolders are marked."
       (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
 	  (save-excursion
 	    (setq entity (wl-folder-get-entity-from-buffer))
-	    (if (not (elmo-folder-plugged-p entity))
+	    (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)
@@ -1276,19 +1332,21 @@ If current line is group folder, all subfolders are marked."
 
 (defun wl-folder-select-buffer (buffer)
   (let ((gbw (get-buffer-window buffer))
-	ret-val)
+	exists)
     (if gbw
 	(progn (select-window gbw)
-	       (setq ret-val t))
-      (condition-case ()
-	  (unwind-protect
-	      (split-window-horizontally wl-folder-window-width)
-	    (other-window 1))
-	(error nil)))
+	       (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)
-    (switch-to-buffer buffer)
-    ret-val
-    ))
+    (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)
@@ -1296,7 +1354,8 @@ If current line is group folder, all subfolders are marked."
 	  (and (interactive-p) (wl-folder-buffer-group-p)))
       (error "This command is not available on Group"))
   (beginning-of-line)
-  (let (wl-auto-select-first)
+  (let (wl-auto-select-first
+	(wl-stay-folder-window t))
     (cond
      ((eq arg 'on)
       (setq wl-folder-buffer-disp-summary t))
@@ -1386,7 +1445,7 @@ If current line is group folder, all subfolders are marked."
 
 (defun wl-folder-mode ()
   "Major mode for Wanderlust Folder.
-See info under Wanderlust for full documentation.
+See Info under Wanderlust for full documentation.
 
 Special commands:
 \\{wl-folder-mode-map}
@@ -1422,22 +1481,52 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 
 (defun wl-folder (&optional arg)
   (interactive "P")
-  (let (initialize)
-;;; (delete-other-windows)
-    (if (get-buffer wl-folder-buffer-name)
-	(switch-to-buffer  wl-folder-buffer-name)
-      (switch-to-buffer (get-buffer-create wl-folder-buffer-name))
-      (wl-folder-mode)
-      (wl-folder-init)
+  (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.
+      (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)
-      ;(sit-for 0)
       (setq initialize t))
     initialize))
 
@@ -1469,11 +1558,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
       (if (setq buf (get-buffer wl-folder-buffer-name))
 	  (wl-folder-entity-hashtb-set
 	   wl-folder-entity-hashtb name value buf))
-;;;   (elmo-folder-set-info-hashtb (elmo-string name)
-;;;				   nil
-;;;				   (nth 2 value)
-;;;				   (nth 0 value)
-;;;				   (nth 1 value))
       (setq wl-folder-info-alist-modified t))))
 
 (defun wl-folder-calc-finfo (entity)
@@ -1522,12 +1606,13 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	(if as-opened
 	    (let (update-flist flist-unsub new-flist removed group-name-end)
 	      (when (and (eq (cadr entity) 'access)
-			 (elmo-folder-plugged-p (car entity)))
+			 (elmo-folder-plugged-p
+			  (wl-folder-get-elmo-folder (car entity))))
 		(message "Fetching folder entries...")
 		(when (setq new-flist
-			    (elmo-list-folders
-			     (elmo-string (car entity))
-			     (wl-string-member
+			    (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
@@ -1716,19 +1801,19 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 		 (equal diffs '(0 0 0)))
       (wl-folder-set-entity-info name value entity-hashtb)
       (save-match-data
-	(save-excursion
-	  (set-buffer buffer)
-	  (setq 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)))))))
+	(with-current-buffer buffer
+	  (save-excursion
+	    (setq 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)
-  (save-window-excursion
+;  (save-window-excursion
     (let ((buf (get-buffer wl-folder-buffer-name))
 	  cur-unread
 	  (unread-diff 0)
@@ -1739,7 +1824,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
       (setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0))
       (setq unread-diff (- (or unread 0) cur-unread))
       (setq value (wl-folder-get-entity-info folder))
-
       (setq newvalue (list (nth 0 value)
 			   unread
 			   (nth 2 value)))
@@ -1748,8 +1832,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
       (when (and buf
 		 (not (eq unread-diff 0)))
 	(save-match-data
-	  (save-excursion
-	    (set-buffer buf)
+	  (with-current-buffer buf
 	    (save-excursion
 	      (setq entity-list (wl-folder-search-entity-list-by-name
 				 folder wl-folder-entity))
@@ -1760,7 +1843,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 		(setq entity-list (cdr entity-list)))
 	      (goto-char (point-min))
 	      (while (wl-folder-buffer-search-entity folder)
-		(wl-folder-update-line newvalue)))))))))
+		(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)))
@@ -1810,22 +1893,6 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 ;;	(setq entities (wl-pop entity-stack))))
 ;;    hashtb))
 
-(defun wl-folder-create-newsgroups-from-nntp-access2 (entity)
-  (let ((flist (nth 2 entity))
-	folders)
-    (and
-     (setq folders
-	   (delq
-	    nil
-	    (mapcar
-	     '(lambda (fld)
-		(if (consp fld)
-		    (wl-folder-create-newsgroups-from-nntp-access2 fld)
-		  (nth 1 (elmo-folder-get-spec fld))))
-	     flist)))
-     (elmo-nntp-make-groups-hashtb folders 1024))
-    nil))
-
 (defun wl-folder-create-newsgroups-from-nntp-access (entity)
   (let ((flist (nth 2 entity))
 	folders)
@@ -1835,38 +1902,45 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 		  ((consp (car flist))
 		   (wl-folder-create-newsgroups-from-nntp-access (car flist)))
 		  (t
-		   (list (nth 1 (elmo-folder-get-spec (car flist)))))))
+		   (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 spec-list folders fld make-hashtb)
+	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-get-type (car entity)) 'nntp)
-	      (wl-append folders
+	    (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 spec-list (elmo-folder-get-primitive-spec-list entity))
-	(while spec-list
-	  (when (and (eq (caar spec-list) 'nntp)
-		     (setq fld (nth 1 (car spec-list))))
-	    (wl-append folders (list (elmo-string fld))))
-	  (setq spec-list (cdr spec-list)))))
+	(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 folders make-hashtb)
-	(elmo-nntp-make-groups-hashtb folders))))
+    (if (or newsgroups make-hashtb)
+	(elmo-setup-subscribed-newsgroups newsgroups))))
 
 (defun wl-folder-get-path (entity target-id &optional string)
   (let ((entities (list entity))
@@ -1937,7 +2011,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	(add (not wl-reset-plugged-alist)))
     (while entity-list
       (elmo-folder-set-plugged
-       (elmo-string (car entity-list)) wl-plugged add)
+       (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
@@ -1945,42 +2019,31 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 			wl-smtp-posting-server  ; server
 			(or (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
-			elmo-default-nntp-port
+			wl-nntp-posting-stream-type
+			wl-nntp-posting-port
 			nil nil "nntp" add))
-    ;; This hook may contain the functions `wl-plugged-init-icons' and
-    ;; `wl-biff-init-icons' for reasons of system internal to accord
-    ;; facilities for the Emacs variants.
     (run-hooks 'wl-make-plugged-hook)))
 
-(defvar wl-folder-init-func 'wl-local-folder-init)
+(defvar wl-folder-init-function 'wl-local-folder-init)
 
 (defun wl-folder-init ()
-  "Call `wl-folder-init-func' function."
+  "Return top-level folder entity."
   (interactive)
-  (funcall wl-folder-init-func))
+  (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...")
-  (save-excursion
-    (set-buffer wl-folder-buffer-name)
-    (let ((entity (wl-folder-create-folder-entity))
-	  (inhibit-read-only t))
-      (setq wl-folder-entity entity)
-      (setq wl-folder-entity-id 0)
-      (wl-folder-entity-assign-id wl-folder-entity)
-      (setq wl-folder-entity-hashtb
-	    (wl-folder-create-entity-hashtb entity))
-      (setq wl-folder-group-alist
-	    (wl-folder-create-group-alist entity))
-      (setq wl-folder-newsgroups-hashtb
-	    (wl-folder-create-newsgroups-hashtb wl-folder-entity))
-      (wl-folder-init-info-hashtb)))
+  (setq wl-folder-entity (wl-folder-create-folder-entity))
   (message "Initializing folder...done"))
 
 (defun wl-folder-get-realname (petname)
@@ -1990,12 +2053,12 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	wl-folder-petname-alist))
       petname))
 
-(defun wl-folder-get-petname (folder)
+(defun wl-folder-get-petname (name)
   (or (cdr
        (wl-string-assoc
-	folder
+	name
 	wl-folder-petname-alist))
-      folder))
+      name))
 
 (defun wl-folder-get-entity-with-petname ()
   (let ((alist wl-folder-petname-alist)
@@ -2005,6 +2068,86 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
       (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 FOLDER.
+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 FOLDER 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)
@@ -2064,12 +2207,21 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 		;; 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)
   (interactive "P")
   (wl-folder-goto-folder-subr nil arg))
 
+(defun wl-folder-goto-folder-sticky ()
+  (interactive)
+  (wl-folder-goto-folder-subr nil t))
+
+(defun wl-folder-goto-draft-folder (&optional arg)
+  (interactive "P")
+  (wl-folder-goto-folder-subr wl-draft-folder arg))
+
 (defun wl-folder-goto-folder-subr (&optional folder sticky)
   (beginning-of-line)
   (let (summary-buf fld-name entity id error-selecting)
@@ -2078,7 +2230,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 ;;;	    (assoc fld-name wl-folder-group-alist))
     (setq fld-name wl-default-folder)
     (setq fld-name (or folder
-		       (wl-summary-read-folder fld-name)))
+		       (let (this-command)
+			 (wl-summary-read-folder fld-name))))
     (if (and (setq entity
 		   (wl-folder-search-entity-by-name fld-name
 						    wl-folder-entity
@@ -2086,30 +2239,29 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	     (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 wl-stay-folder-window
+    (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 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)
-  (wl-crosspost-alist-save)
-  (wl-kill-buffers
-   (format "^\\(%s\\)$"
-	   (mapconcat 'identity
-		      (list (format "%s\\(:.*\\)?"
-				    (default-value 'wl-message-buf-name))
-			    wl-original-buf-name)
-		      "\\|")))
-  (if (fboundp 'mmelmo-cleanup-entity-buffers)
-      (mmelmo-cleanup-entity-buffers))
+  (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 ()
@@ -2125,14 +2277,16 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	       (wl-push entities entity-stack))
 	  (setq entities (nth 2 entity)))
 	 ((stringp entity)
-	  (when (and (setq info (elmo-folder-get-info entity))
+	  (when (and (setq info (elmo-folder-get-info
+				 (wl-folder-get-elmo-folder entity)))
 		     (not (equal info '(nil))))
-	    (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
-					      ))))))
+	    (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)
@@ -2367,6 +2521,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	(when (> len elmo-display-progress-threshold)
 	  (elmo-display-progress
 	   'wl-folder-open-all "Opening all folders..." 100))))
+    (wl-highlight-folder-path wl-folder-buffer-cur-path)
     (message "Opening all folders...done")
     (set-buffer-modified-p nil)))
 
@@ -2385,6 +2540,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
     (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)))
 
@@ -2537,30 +2693,48 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	       (wl-folder-get-petname (car entity)))
       (cons sum-done sum-all)))
    ((stringp entity)
-    (let ((nums (wl-folder-get-entity-info entity))
-	  (wl-summary-highlight (if (or (wl-summary-sticky-p entity)
-					(wl-summary-always-sticky-folder-p
-					 entity))
-				    wl-summary-highlight))
-	  wl-summary-exit-next-move
-	  wl-auto-select-first ret-val
-	  count)
+    (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 entity)))
+      (setq count (+ count (wl-folder-count-incorporates folder)))
       (if (or (null (car nums)) ; unknown
 	      (< 0 count))
 	  (save-window-excursion
 	    (save-excursion
-	      (wl-summary-goto-folder-subr entity
-					   (wl-summary-get-sync-range entity)
-					   nil)
-	      (setq ret-val (wl-summary-incorporate))
-	      (wl-summary-exit)
-	      ret-val))
+	      (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 ((marks (elmo-msgdb-mark-load (elmo-msgdb-expand-path folder)))
+  (let ((marks (elmo-msgdb-mark-load
+		(elmo-folder-msgdb-path folder)))
 	(sum 0))
     (while marks
       (if (member (cadr (car marks))
@@ -2588,52 +2762,58 @@ If current line is group folder, all subfolders are prefetched."
 	    (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
-	      (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-newsgroup ()
-  ""
+;(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)
-  (wl-summary-write-current-newsgroup (wl-folder-entity-name)))
+  (unless (wl-folder-buffer-group-p)
+    (wl-summary-write-current-folder
+     (wl-folder-get-realname (wl-folder-entity-name)))))
 
 (defun wl-folder-mimic-kill-buffer ()
   "Kill the current (Folder) buffer with query."
@@ -2647,29 +2827,98 @@ If optional arg exists, don't check any folders."
 	(wl-exit)
       (kill-buffer bufname))))
 
-(defun wl-folder-create-subr (entity)
-  (if (not (elmo-folder-creatable-p entity))
-      (error "Folder %s is not found" entity)
-    (if (y-or-n-p
-	 (format "Folder %s does not exist, create it?"
-		 entity))
-	(progn
-	  (setq wl-folder-entity-hashtb
-		(wl-folder-create-entity-hashtb
-		 entity wl-folder-entity-hashtb))
-	  (unless (elmo-create-folder entity)
-	    (error "Create folder failed")))
-      (error "Folder %s is not created" entity))))
+(defun wl-folder-create-subr (folder)
+  (if (elmo-folder-creatable-p folder)
+  (if (y-or-n-p (format "Folder %s does not exist, create it? "
+			(elmo-folder-name-internal folder)))
+      (progn
+	(message "")
+	(setq wl-folder-entity-hashtb
+	      (wl-folder-create-entity-hashtb
+	       (elmo-folder-name-internal folder)
+	       wl-folder-entity-hashtb))
+	(unless (elmo-folder-create folder)
+	  (error "Create folder failed")))
+	(error "Folder %s is not created" (elmo-folder-name-internal folder)))
+    (error "Folder %s does not exist" (elmo-folder-name-internal folder))))
 
 (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 folder)
-		(file-exists-p (elmo-msgdb-expand-path folder))
+    (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal 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 "/"
+	     (elmo-read-search-condition
+	      wl-fldmgr-make-filter-default)
+	     "/" entity))))
+
+(defun wl-folder-pick ()
+  (interactive)
+  (save-excursion
+    (let* ((condition (car (elmo-parse-search-condition
+			    (elmo-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)))
+
 (require 'product)
 (product-provide (provide 'wl-folder) (require 'wl-version))