X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-folder.el;h=fbf43fb922a038f9b3da3562c509253cedef18c7;hb=6ed5fd4b359fca51c29a7e59a723a651698855e2;hp=b25110d3eb80da60b84c345357551ad26c5784ec;hpb=9fe0df07710c297f935c5e796f33944457d4abec;p=elisp%2Fwanderlust.git

diff --git a/wl/wl-folder.el b/wl/wl-folder.el
index b25110d..fbf43fb 100644
--- a/wl/wl-folder.el
+++ b/wl/wl-folder.el
@@ -1,4 +1,4 @@
-;;; wl-folder.el -- Folder mode for Wanderlust.
+;;; 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>
@@ -46,6 +46,11 @@
   (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
@@ -84,10 +89,14 @@
     ["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]
@@ -105,12 +114,15 @@
      ["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 Satus"         wl-status-update t]
+    ["Update Status"        wl-status-update t]
     ["Exit"                 wl-exit t]
     ))
 
@@ -137,15 +149,19 @@
 ;  (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-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)
@@ -165,6 +181,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)
@@ -233,7 +251,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]*"
@@ -250,19 +269,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)
@@ -281,7 +295,7 @@
 (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))
@@ -290,7 +304,7 @@
 (defun wl-folder-persistent-p (folder)
   (or (and (wl-folder-search-entity-by-name folder wl-folder-entity
 					    'folder)
-	   t) 	; on Folder mode.
+	   t) ; on Folder mode.
       (catch 'found
 	(let ((li wl-save-folder-list))
 	  (while li
@@ -305,14 +319,6 @@
 		 (setq li (cdr li))))))))
 
 ;;; ELMO folder structure with cache.
-(defmacro wl-folder-get-elmo-folder (entity)
-  "Get elmo folder structure from 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))))
-
 (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'."
@@ -325,6 +331,16 @@ 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))
@@ -414,8 +430,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'."
 	  (setq entities (nth 2 entity)))
 	 ((stringp entity)
 	  (if (and (string= name entity)
-		   ;; don't use eq, `id' is string on Nemacs.
-		   (equal id (wl-folder-get-entity-id 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))
@@ -450,8 +465,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'."
 			     (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
 		(throw 'done entity))
 	    (if (and (string= name entity)
-		     ;; don't use eq, `id' is string on Nemacs.
-		     (equal id (wl-folder-get-entity-id entity)))
+		     (eq id (wl-folder-get-entity-id entity)))
 		(setq found t)))))
 	(unless entities
 	  (setq entities (wl-pop entity-stack)))))))
@@ -464,7 +478,7 @@ Default HASHTB is `wl-folder-elmo-folder-hashtb'."
 	(wl-plugged t)
 	emptied)
     (if elmo-enable-disconnected-operation
-	(elmo-dop-queue-flush 'force)) ; Try flushing all queue.
+	(elmo-dop-queue-flush))
     (if (not (elmo-folder-list-messages
 	      (wl-folder-get-elmo-folder wl-queue-folder)))
 	(message "No sending queue exists.")
@@ -583,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")
@@ -798,12 +816,14 @@ Optional argument ARG is repeart count."
     (run-hooks 'wl-folder-check-entity-hook)
     ret-val))
 
-(defun wl-folder-check-one-entity (entity)
-  (let* ((folder (wl-folder-get-elmo-folder 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 folder)
-		     (elmo-folder-diff folder))
+		   (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
@@ -811,39 +831,33 @@ Optional argument ARG is repeart count."
 			   (not (elmo-folder-exists-p folder)))
 		      (wl-folder-create-subr folder)
 		    (signal (car err) (cdr err))))))
-	 (new (elmo-diff-new nums))
-	 (nums (cons (elmo-diff-unread nums) (elmo-diff-all nums)))
-	 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 folder)))
+	  (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 unread (or ;; If server diff, All unreads are
-			; treated as unsync.
-		    (if (elmo-folder-use-flag-p folder)
-			(car nums))
-		    (elmo-folder-get-info-unread folder)
-		    (wl-summary-count-unread (elmo-msgdb-mark-load
-					      (elmo-folder-msgdb-path
-					       folder)))))
-      (setq unread (min unread (- (or (cdr nums) 0) (or (car nums) 0))))
-      (when new (setq unread (- unread new)))
+	(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 (or new (car nums))
-					 unread
-					 (cdr nums))
+				   (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)
-	    (or new (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)
@@ -892,7 +906,7 @@ Optional argument ARG is repeart count."
 	(setq ret-val
 	      (wl-folder-add-folder-info
 	       ret-val
-	       (wl-folder-check-one-entity (elmo-folder-name-internal 
+	       (wl-folder-check-one-entity (elmo-folder-name-internal
 					    folder))))
 	;;(sit-for 0)
 	))
@@ -986,14 +1000,21 @@ If current line is group folder, check all sub entries."
 					 (wl-summary-always-sticky-folder-p
 					  folder))
 				     wl-summary-highlight))
-	   wl-auto-select-first new unread)
+	   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)))
-	  (let ((wl-summary-buffer-name (concat
-					 wl-summary-buffer-name
-					 (symbol-name this-command)))
+	  (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
@@ -1002,7 +1023,9 @@ If current line is group folder, check all sub entries."
 					     (wl-summary-get-sync-range
 					      folder)
 					     nil nil nil t)
-		(wl-summary-exit)))))))))
+		(if sticky
+		    (wl-summary-save-status)
+		  (wl-summary-exit))))))))))
 
 (defun wl-folder-sync-current-entity (&optional unread-only)
   "Synchronize the folder at position.
@@ -1012,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
@@ -1036,22 +1059,32 @@ If current line is group folder, check all subfolders."
 					 (wl-summary-always-sticky-folder-p
 					  folder))
 				     wl-summary-highlight))
-	   wl-auto-select-first new unread)
+	   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
-	      (let ((wl-summary-buffer-name (concat
-					     wl-summary-buffer-name
-					     (symbol-name this-command)))
+	      (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)
-		(wl-summary-exit))))
+		(if sticky
+		    (wl-summary-save-status)
+		  (wl-summary-exit)))))
 	(sit-for 0))))))
 
 (defun wl-folder-mark-as-read-all-current-entity ()
@@ -1063,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
@@ -1462,8 +1495,16 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 		(switch-to-buffer folder-buf)))
 	  (switch-to-buffer folder-buf))
       (if wl-folder-use-frame
-	  (switch-to-buffer-other-frame
-	   (get-buffer-create wl-folder-buffer-name))
+	  (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)
@@ -1571,7 +1612,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 		(when (setq new-flist
 			    (elmo-folder-list-subfolders
 			     (wl-folder-get-elmo-folder (car entity))
-			     (wl-string-member
+			     (wl-string-match-member
 			      (car entity)
 			      wl-folder-hierarchy-access-folders)))
 		  (setq update-flist
@@ -1770,7 +1811,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	    (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
     (let ((buf (get-buffer wl-folder-buffer-name))
@@ -1911,8 +1952,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	 (cond
 	  ((consp entity)
 	   (if (and (or (not string) (string= string (car entity)))
-		    ;; don't use eq, `id' is string on Nemacs.
-		    (equal target-id (wl-folder-get-entity-id (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))
@@ -1920,8 +1960,7 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 	   (setq entities (nth 2 entity)))
 	  ((stringp entity)
 	   (if (and (or (not string) (string= string entity))
-		    ;; don't use eq, `id' is string on Nemacs.
-		    (equal target-id (wl-folder-get-entity-id entity)))
+		    (eq target-id (wl-folder-get-entity-id entity)))
 	       (throw 'done
 		      (wl-push target-id result-path)))))
 	 (unless entities
@@ -1996,7 +2035,8 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
   (interactive)
   (if wl-use-acap
       (wl-acap-init)
-    (funcall wl-folder-init-function)))
+    (funcall wl-folder-init-function))
+  (run-hooks 'wl-folder-init-hook))
 
 (defun wl-local-folder-init ()
   "Initialize local folder."
@@ -2029,23 +2069,11 @@ Entering Folder mode calls the value of `wl-folder-mode-hook'."
 (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 ((flist (elmo-folder-get-primitive-list
-		(wl-folder-get-elmo-folder folder))) ; multi
-	newsgroups fld ret)
-    (while (setq fld (car flist))
-      (if (setq ret
-		(cond ((eq 'nntp (elmo-folder-type-internal fld))
-		       (elmo-nntp-folder-group-internal fld))
-		      ((eq 'localnews (elmo-folder-type-internal fld))
-		       (elmo-replace-in-string
-			(elmo-nntp-folder-group-internal fld)
-			"/" "\\."))))
-	  ;; append newsgroup
-	  (setq newsgroups (if (stringp newsgroups)
-			       (concat newsgroups "," ret)
-			     ret)))
-      (setq flist (cdr flist)))
-    (list nil nil newsgroups)))
+  (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.
@@ -2053,17 +2081,18 @@ Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'."
   (let ((flist
 	 (elmo-folder-get-primitive-list
 	  (wl-folder-get-elmo-folder entity)))
-	fld ret mlist)
+	fld mladdr to)
     (while (setq fld (car flist))
-      (if (setq ret
-		(wl-folder-guess-mailing-list-by-refile-rule-subr
-		 (elmo-folder-name-internal fld)))
-	  (setq mlist (if (stringp mlist)
-			  (concat mlist ", " ret)
-			ret)))
+      (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 mlist
-	(list mlist nil nil))))
+    (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)
@@ -2090,17 +2119,18 @@ Use `wl-subscribed-mailing-list'."
   (let ((flist
 	 (elmo-folder-get-primitive-list
 	  (wl-folder-get-elmo-folder entity)))
-	fld ret mlist)
+	fld mladdr to)
     (while (setq fld (car flist))
-      (if (setq ret
-		(wl-folder-guess-mailing-list-by-folder-name-subr
-		 (elmo-folder-name-internal fld)))
-	  (setq mlist (if (stringp mlist)
-			  (concat mlist ", " ret)
-			ret)))
+      (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 mlist
-	(list mlist nil nil))))
+    (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)
@@ -2182,6 +2212,14 @@ Use `wl-subscribed-mailing-list'."
   (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)
@@ -2190,7 +2228,8 @@ Use `wl-subscribed-mailing-list'."
 ;;;	    (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
@@ -2207,7 +2246,7 @@ Use `wl-subscribed-mailing-list'."
 				 (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)
@@ -2217,6 +2256,10 @@ Use `wl-subscribed-mailing-list'."
   ;(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 ()
@@ -2476,6 +2519,7 @@ Use `wl-subscribed-mailing-list'."
 	(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)))
 
@@ -2494,6 +2538,7 @@ Use `wl-subscribed-mailing-list'."
     (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)))
 
@@ -2654,16 +2699,24 @@ Use `wl-subscribed-mailing-list'."
 				     wl-summary-highlight))
 	   wl-summary-exit-next-move
 	   wl-auto-select-first ret-val
-	   count)
+	   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 (concat
-					     wl-summary-buffer-name
-					     (symbol-name this-command)))
+	      (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
@@ -2671,7 +2724,9 @@ Use `wl-subscribed-mailing-list'."
 					      folder)
 					     nil)
 		(setq ret-val (wl-summary-incorporate))
-		(wl-summary-exit)
+		(if sticky
+		    (wl-summary-save-status)
+		  (wl-summary-exit))
 		ret-val)))
 	(cons 0 0))))))
 
@@ -2739,7 +2794,7 @@ If current line is group folder, all subfolders are prefetched."
 ;	  summary-buf entity)
 ;      (when (and entity-name
 ;		 (y-or-n-p (format
-;			    "Drop all unsync messages in %s?" entity-name)))
+;			    "Drop all unsync messages in %s? " entity-name)))
 ;	(setq entity
 ;	      (if group
 ;		  (wl-folder-search-group-entity-by-name entity-name
@@ -2771,19 +2826,19 @@ Call `wl-summary-write-current-folder' with current folder name."
       (kill-buffer bufname))))
 
 (defun wl-folder-create-subr (folder)
-  (if (not (elmo-folder-creatable-p folder))
-      (error "Folder %s is not found" (elmo-folder-name-internal folder))
-    (if (y-or-n-p
-	 (format "Folder %s does not exist, create it?"
-		 (elmo-folder-name-internal folder)))
-	(progn
-	  (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)))))
+  (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
@@ -2794,6 +2849,74 @@ Call `wl-summary-write-current-folder' with current folder name."
 		(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))