1 ;;; wl-folder.el --- Folder mode for Wanderlust.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
8 ;; Keywords: mail, net news
10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
39 (require 'easymenu) ; needed here.
49 (defcustom wl-folder-init-hook nil
50 "A hook called after folder initialization is finished."
54 (defvar wl-folder-buffer-name "Folder")
55 (defvar wl-folder-entity nil) ; desktop entity.
56 (defvar wl-folder-group-alist nil) ; opened or closed
57 (defvar wl-folder-entity-id nil) ; id
58 (defvar wl-folder-entity-hashtb nil)
59 (defvar wl-folder-entity-id-name-hashtb nil)
60 (defvar wl-folder-elmo-folder-hashtb nil) ; name => elmo folder structure
62 (defvar wl-folder-newsgroups-hashtb nil)
63 (defvar wl-folder-info-alist-modified nil)
64 (defvar wl-folder-completion-function nil)
66 (defvar wl-folder-mode-map nil)
68 (defvar wl-folder-buffer-disp-summary nil)
69 (defvar wl-folder-buffer-cur-entity-id nil)
70 (defvar wl-folder-buffer-cur-path nil)
71 (defvar wl-folder-buffer-cur-point nil)
73 (make-variable-buffer-local 'wl-folder-buffer-disp-summary)
74 (make-variable-buffer-local 'wl-folder-buffer-cur-entity-id)
75 (make-variable-buffer-local 'wl-folder-buffer-cur-path)
76 (make-variable-buffer-local 'wl-folder-buffer-cur-point)
78 (defconst wl-folder-entity-regexp "^\\([ ]*\\)\\(\\[[\\+-]\\]\\)?\\([^\\[].+\\):[-*0-9]+/[-*0-9]+/[-*0-9]+")
79 (defconst wl-folder-group-regexp "^\\([ ]*\\)\\[\\([\\+-]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n")
80 ;; 1:indent 2:opened 3:group-name
81 (defconst wl-folder-unsync-regexp ":[^0\\*][0-9]*/[0-9\\*-]+/[0-9\\*-]+$")
83 (defvar wl-folder-mode-menu-spec
85 ["Enter Current Folder" wl-folder-jump-to-current-entity t]
86 ["Prev Folder" wl-folder-prev-entity t]
87 ["Next Folder" wl-folder-next-entity t]
88 ["Check Current Folder" wl-folder-check-current-entity t]
89 ["Sync Current Folder" wl-folder-sync-current-entity t]
90 ; ["Drop Current Folder" wl-folder-drop-unsync-current-entity t]
91 ["Prefetch Current Folder" wl-folder-prefetch-current-entity t]
92 ["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t]
93 ["Expire Current Folder" wl-folder-expire-current-entity t]
94 ["Empty trash" wl-folder-empty-trash t]
95 ["Flush queue" wl-folder-flush-queue t]
96 ["Open All" wl-folder-open-all t]
97 ["Open All Unread folder" wl-folder-open-all-unread-folder t]
98 ["Close All" wl-folder-close-all t]
100 ["Add folder" wl-fldmgr-add t]
101 ["Add group" wl-fldmgr-make-group t]
102 ["Copy" wl-fldmgr-copy t]
103 ["Cut" wl-fldmgr-cut t]
104 ["Paste" wl-fldmgr-yank t]
105 ["Set petname" wl-fldmgr-set-petname t]
106 ["Rename" wl-fldmgr-rename t]
107 ["Save" wl-fldmgr-save-folders t]
109 ["Unsubscribe" wl-fldmgr-unsubscribe t]
110 ["Display all" wl-fldmgr-access-display-all t])
112 ["Write a message" wl-draft t]
113 ["Write for current folder" wl-folder-write-current-folder t]
115 ["Toggle Plug Status" wl-toggle-plugged t]
116 ["Change Plug Status" wl-plugged-change t]
118 ["Save Current Status" wl-save t]
119 ["Update Satus" wl-status-update t]
124 (defun wl-folder-setup-mouse ()
125 (define-key wl-folder-mode-map 'button2 'wl-folder-click)
126 (define-key wl-folder-mode-map 'button4 'wl-folder-prev-entity)
127 (define-key wl-folder-mode-map 'button5 'wl-folder-next-entity)
128 (define-key wl-folder-mode-map [(shift button4)]
129 'wl-folder-prev-unread)
130 (define-key wl-folder-mode-map [(shift button5)]
131 'wl-folder-next-unread))
132 (defun wl-folder-setup-mouse ()
133 (define-key wl-folder-mode-map [mouse-2] 'wl-folder-click)
134 (define-key wl-folder-mode-map [mouse-4] 'wl-folder-prev-entity)
135 (define-key wl-folder-mode-map [mouse-5] 'wl-folder-next-entity)
136 (define-key wl-folder-mode-map [S-mouse-4] 'wl-folder-prev-unread)
137 (define-key wl-folder-mode-map [S-mouse-5] 'wl-folder-next-unread)))
139 (if wl-folder-mode-map
141 (setq wl-folder-mode-map (make-sparse-keymap))
142 (define-key wl-folder-mode-map " " 'wl-folder-jump-to-current-entity)
143 ; (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close)
144 (define-key wl-folder-mode-map "/" 'wl-folder-open-close)
145 (define-key wl-folder-mode-map "\C-m" 'wl-folder-jump-to-current-entity)
146 (define-key wl-folder-mode-map [(shift return)] 'wl-folder-jump-to-current-entity-with-arg)
147 (define-key wl-folder-mode-map "\M-\C-m" 'wl-folder-update-recursive-current-entity)
148 (define-key wl-folder-mode-map "rc" 'wl-folder-mark-as-read-all-region)
149 (define-key wl-folder-mode-map "c" 'wl-folder-mark-as-read-all-current-entity)
150 (define-key wl-folder-mode-map "g" 'wl-folder-goto-folder)
151 (define-key wl-folder-mode-map "G" 'wl-folder-goto-folder-sticky)
152 (define-key wl-folder-mode-map "j" 'wl-folder-jump-to-current-entity)
153 (define-key wl-folder-mode-map "w" 'wl-draft)
154 (define-key wl-folder-mode-map "W" 'wl-folder-write-current-folder)
155 (define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
156 (define-key wl-folder-mode-map "\C-c\C-a" 'wl-addrmgr)
157 (define-key wl-folder-mode-map "rS" 'wl-folder-sync-region)
158 (define-key wl-folder-mode-map "S" 'wl-folder-sync-current-entity)
159 (define-key wl-folder-mode-map "rs" 'wl-folder-check-region)
160 (define-key wl-folder-mode-map "s" 'wl-folder-check-current-entity)
161 (define-key wl-folder-mode-map "I" 'wl-folder-prefetch-current-entity)
162 ; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
163 (define-key wl-folder-mode-map "p" 'wl-folder-prev-entity)
164 (define-key wl-folder-mode-map "n" 'wl-folder-next-entity)
165 (define-key wl-folder-mode-map "v" 'wl-folder-toggle-disp-summary)
166 (define-key wl-folder-mode-map "P" 'wl-folder-prev-unread)
167 (define-key wl-folder-mode-map "N" 'wl-folder-next-unread)
168 (define-key wl-folder-mode-map "J" 'wl-folder-jump-folder)
169 (define-key wl-folder-mode-map "f" 'wl-folder-goto-first-unread-folder)
170 (define-key wl-folder-mode-map "o" 'wl-folder-open-all-unread-folder)
171 (define-key wl-folder-mode-map "[" 'wl-folder-open-all)
172 (define-key wl-folder-mode-map "]" 'wl-folder-close-all)
173 (define-key wl-folder-mode-map "e" 'wl-folder-expire-current-entity)
174 (define-key wl-folder-mode-map "E" 'wl-folder-empty-trash)
175 (define-key wl-folder-mode-map "F" 'wl-folder-flush-queue)
176 (define-key wl-folder-mode-map "V" 'wl-folder-virtual)
177 (define-key wl-folder-mode-map "?" 'wl-folder-pick)
178 (define-key wl-folder-mode-map "q" 'wl-exit)
179 (define-key wl-folder-mode-map "z" 'wl-folder-suspend)
180 (define-key wl-folder-mode-map "\M-t" 'wl-toggle-plugged)
181 (define-key wl-folder-mode-map "\C-t" 'wl-plugged-change)
182 (define-key wl-folder-mode-map "<" 'beginning-of-buffer)
183 (define-key wl-folder-mode-map ">" 'end-of-buffer)
185 (define-key wl-folder-mode-map "m" 'wl-fldmgr-mode-map)
186 (define-key wl-folder-mode-map "*" 'wl-fldmgr-make-multi)
187 (define-key wl-folder-mode-map "+" 'wl-fldmgr-make-group)
188 (define-key wl-folder-mode-map "|" 'wl-fldmgr-make-filter)
189 (define-key wl-folder-mode-map "\M-c" 'wl-fldmgr-copy)
190 (define-key wl-folder-mode-map "\M-w" 'wl-fldmgr-copy-region)
191 (define-key wl-folder-mode-map "\C-k" 'wl-fldmgr-cut)
192 (define-key wl-folder-mode-map "\C-w" 'wl-fldmgr-cut-region)
193 (define-key wl-folder-mode-map "\C-y" 'wl-fldmgr-yank)
194 (define-key wl-folder-mode-map "R" 'wl-fldmgr-rename)
195 (define-key wl-folder-mode-map "u" 'wl-fldmgr-unsubscribe)
196 (define-key wl-folder-mode-map "ru" 'wl-fldmgr-unsubscribe-region)
197 (define-key wl-folder-mode-map "U" 'wl-fldmgr-unsubscribe-region)
198 (define-key wl-folder-mode-map "l" 'wl-fldmgr-access-display-normal)
199 (define-key wl-folder-mode-map "L" 'wl-fldmgr-access-display-all)
200 (define-key wl-folder-mode-map "Z" 'wl-status-update)
201 (define-key wl-folder-mode-map "\C-x\C-s" 'wl-save)
202 (define-key wl-folder-mode-map "\M-s" 'wl-save)
203 (define-key wl-folder-mode-map "\C-xk" 'wl-folder-mimic-kill-buffer)
204 (define-key wl-folder-mode-map "\M-\C-a"
205 'wl-folder-goto-top-of-current-folder)
206 (define-key wl-folder-mode-map "\M-\C-e"
207 'wl-folder-goto-bottom-of-current-folder)
209 (wl-folder-setup-mouse)
213 "Menu used in Folder mode."
214 wl-folder-mode-menu-spec))
216 (defmacro wl-folder-unread-regex (group)
217 (` (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
222 (defmacro wl-folder-buffer-group-p ()
223 (` (save-excursion (beginning-of-line)
224 (looking-at wl-folder-group-regexp))))
226 (defmacro wl-folder-folder-name ()
229 (if (or (looking-at "^[ ]*\\[[\\+-]\\]\\(.+\\):[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+\n")
230 (looking-at "^[ ]*\\([^\\[].+\\):.*\n"))
231 (wl-match-buffer 1)))))
233 (defmacro wl-folder-entity-name ()
236 (if (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
237 (wl-match-buffer 1)))))
239 (defun wl-folder-buffer-search-group (group)
242 "^\\([ \t]*\\)\\[[\\+-]\\]"
243 (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t))
245 (defun wl-folder-buffer-search-entity (folder &optional searchname)
246 (let ((search (or searchname (wl-folder-get-petname folder))))
250 (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+") nil t)))
252 (defsubst wl-folder-get-folder-name-by-id (entity-id &optional hashtb)
253 (and (numberp entity-id)
254 (elmo-get-hash-val (format "#%d" entity-id)
255 (or hashtb wl-folder-entity-id-name-hashtb))))
257 (defsubst wl-folder-set-id-name (entity-id entity &optional hashtb)
258 (and (numberp entity-id)
259 (elmo-set-hash-val (format "#%d" entity-id)
260 entity (or hashtb wl-folder-entity-id-name-hashtb))))
262 (defmacro wl-folder-get-entity-id (entity)
263 `(get-text-property 0 'wl-folder-entity-id ,entity))
265 (defmacro wl-folder-get-entity-from-buffer (&optional getid)
266 `(let ((id (get-text-property (point)
267 'wl-folder-entity-id)))
270 (wl-folder-get-folder-name-by-id id))))
272 (defmacro wl-folder-entity-exists-p (entity &optional hashtb)
273 (` (let ((sym (intern-soft (, entity)
274 (or (, hashtb) wl-folder-entity-hashtb))))
275 (and sym (boundp sym)))))
277 (defmacro wl-folder-clear-entity-info (entity &optional hashtb)
278 (` (let ((sym (intern-soft (, entity)
279 (or (, hashtb) wl-folder-entity-hashtb))))
283 (defmacro wl-folder-get-entity-info (entity &optional hashtb)
284 (` (elmo-get-hash-val (, entity) (or (, hashtb) wl-folder-entity-hashtb))))
286 (defmacro wl-folder-set-entity-info (entity value &optional hashtb)
287 (` (let* ((hashtb (or (, hashtb) wl-folder-entity-hashtb))
288 (info (wl-folder-get-entity-info (, entity) hashtb)))
289 (elmo-set-hash-val (, entity)
290 (if (< (length (, value)) 4)
291 (append (, value) (list (nth 3 info)))
295 (defun wl-folder-persistent-p (folder)
296 (or (and (wl-folder-search-entity-by-name folder wl-folder-entity
300 (let ((li wl-save-folder-list))
302 (if (string-match (car li) folder)
304 (setq li (cdr li)))))
306 (let ((li wl-no-save-folder-list))
308 (if (string-match (car li) folder)
310 (setq li (cdr li))))))))
312 ;;; ELMO folder structure with cache.
313 (defmacro wl-folder-get-elmo-folder (entity &optional no-cache)
314 "Get elmo folder structure from entity."
316 (elmo-make-folder (elmo-string (, entity)))
317 (or (wl-folder-elmo-folder-cache-get (, entity))
318 (let* ((name (elmo-string (, entity)))
319 (folder (elmo-make-folder name)))
320 (wl-folder-elmo-folder-cache-put name folder)
323 (defmacro wl-folder-elmo-folder-cache-get (name &optional hashtb)
324 "Returns a elmo folder structure associated with NAME from HASHTB.
325 Default HASHTB is `wl-folder-elmo-folder-hashtb'."
326 (` (elmo-get-hash-val (, name)
327 (or (, hashtb) wl-folder-elmo-folder-hashtb))))
329 (defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb)
330 "Get folder elmo folder structure on HASHTB for folder with NAME.
331 Default HASHTB is `wl-folder-elmo-folder-hashtb'."
332 (` (elmo-set-hash-val (, name) (, folder)
333 (or (, hashtb) wl-folder-elmo-folder-hashtb))))
335 (defun wl-folder-prev-entity ()
339 (defun wl-folder-next-entity ()
343 (defun wl-folder-prev-entity-skip-invalid (&optional hereto)
344 "move to previous entity. skip unsubscribed or removed entity."
348 (if (re-search-backward wl-folder-entity-regexp nil t)
350 (goto-char (point-min))))
352 (defun wl-folder-next-entity-skip-invalid (&optional hereto)
353 "Move to next entity. skip unsubscribed or removed entity."
358 (if (re-search-forward wl-folder-entity-regexp nil t)
360 (goto-char (point-max))))
362 (defun wl-folder-search-group-entity-by-name (name entity)
363 (wl-folder-search-entity-by-name name entity 'group))
365 (defun wl-folder-search-entity-by-name (name entity &optional type)
366 (let ((entities (list entity))
370 (setq entity (wl-pop entities))
373 (if (and (not (eq type 'folder))
374 (string= name (car entity)))
375 (throw 'done entity))
377 (wl-push entities entity-stack))
378 (setq entities (nth 2 entity)))
379 ((and (not (eq type 'group))
381 (if (string= name entity)
382 (throw 'done entity))))
384 (setq entities (wl-pop entity-stack)))))))
386 (defun wl-folder-search-entity-list-by-name (name entity &optional get-id)
387 (let ((entities (list entity))
388 entity-stack ret-val)
390 (setq entity (wl-pop entities))
394 (wl-push entities entity-stack))
395 (setq entities (nth 2 entity)))
397 (if (string= name entity)
398 (wl-append ret-val (if get-id
399 (list (wl-folder-get-entity-id entity))
402 (setq entities (wl-pop entity-stack))))
405 (defun wl-folder-get-prev-folder (id &optional unread)
406 (let ((name (if (stringp id)
408 (wl-folder-get-folder-name-by-id id)))
409 entity entity-stack last-entity finfo
410 (entities (list wl-folder-entity)))
413 (setq entity (wl-pop entities))
416 ;; (if (and (string= name (car entity))
417 ;; (eq id (wl-folder-get-entity-id (car entity))))
418 ;; (throw 'done last-entity))
420 (wl-push entities entity-stack))
421 (setq entities (nth 2 entity)))
423 (if (and (string= name entity)
424 ;; don't use eq, `id' is string on Nemacs.
425 (equal id (wl-folder-get-entity-id entity)))
426 (throw 'done last-entity))
428 (and (setq finfo (wl-folder-get-entity-info entity))
429 (and (nth 0 finfo)(nth 1 finfo))
430 (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
431 (setq last-entity entity))))
433 (setq entities (wl-pop entity-stack)))))))
435 (defun wl-folder-get-next-folder (id &optional unread)
436 (let ((name (if (stringp id)
438 (wl-folder-get-folder-name-by-id id)))
439 entity entity-stack found finfo
440 (entities (list wl-folder-entity)))
443 (setq entity (wl-pop entities))
446 ;;; (if (and (string= name (car entity))
447 ;;; (eq id (wl-folder-get-entity-id (car entity))))
450 (wl-push entities entity-stack))
451 (setq entities (nth 2 entity)))
454 (when (or (not unread)
455 (and (setq finfo (wl-folder-get-entity-info entity))
456 (and (nth 0 finfo)(nth 1 finfo))
457 (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
458 (throw 'done entity))
459 (if (and (string= name entity)
460 ;; don't use eq, `id' is string on Nemacs.
461 (equal id (wl-folder-get-entity-id entity)))
464 (setq entities (wl-pop entity-stack)))))))
466 (defun wl-folder-flush-queue ()
469 (let ((cur-buf (current-buffer))
470 (wl-auto-select-first nil)
473 (if elmo-enable-disconnected-operation
474 (elmo-dop-queue-flush 'force)) ; Try flushing all queue.
475 (if (not (elmo-folder-list-messages
476 (wl-folder-get-elmo-folder wl-queue-folder)))
477 (message "No sending queue exists.")
478 (if wl-stay-folder-window
479 (wl-folder-select-buffer
480 (wl-summary-get-buffer-create wl-queue-folder)))
481 (wl-summary-goto-folder-subr wl-queue-folder 'force-update nil)
483 (wl-draft-queue-flush)
484 (if (get-buffer-window cur-buf)
485 (select-window (get-buffer-window cur-buf)))
487 (if wl-stay-folder-window
488 (wl-folder-toggle-disp-summary 'off wl-queue-folder)
489 (switch-to-buffer cur-buf))))))
491 (defun wl-folder-empty-trash ()
494 (let ((cur-buf (current-buffer))
495 (wl-auto-select-first nil)
497 (if wl-stay-folder-window
498 (wl-folder-select-buffer
499 (wl-summary-get-buffer-create wl-trash-folder)))
500 (wl-summary-goto-folder-subr wl-trash-folder 'force-update nil nil t)
501 (setq trash-buf (current-buffer))
503 (setq emptied (wl-summary-delete-all-msgs))
505 (setq wl-thread-entities nil
506 wl-thread-entity-list nil)
507 (if wl-summary-cache-use (wl-summary-save-view-cache))
508 (elmo-folder-commit wl-summary-buffer-elmo-folder))
509 (if (get-buffer-window cur-buf)
510 (select-window (get-buffer-window cur-buf)))
513 (wl-folder-set-folder-updated wl-trash-folder '(0 0 0)))
514 (if wl-stay-folder-window
515 (wl-folder-toggle-disp-summary 'off wl-trash-folder)
516 (switch-to-buffer cur-buf))
518 (kill-buffer trash-buf)))))
520 (defun wl-folder-goto-top-of-current-folder (&optional arg)
521 "Move backward to the top of the current folder group.
522 Optional argument ARG is repeart count."
524 (if (re-search-backward
525 "^ *\\[[\\+-]\\]" nil t (if arg (prefix-numeric-value arg)))
527 (goto-char (point-min))))
529 (defun wl-folder-goto-bottom-of-current-folder (indent)
530 "Move forward to the bottom of the current folder group."
535 (if (looking-at "^ *")
536 (buffer-substring (match-beginning 0)(1- (match-end 0)))
540 (while (re-search-forward "^ *" nil t)
541 (if (<= (length (match-string 0))
545 (goto-char (point-max))))
547 (defsubst wl-folder-update-group (entity diffs &optional is-group)
549 (let ((path (wl-folder-get-path
551 (wl-folder-get-entity-id entity)
554 ;; delete itself from path
555 (setq path (delete (nth (- (length path) 1) path) path)))
556 (goto-char (point-min))
559 ;; goto the path line.
560 (if (or (eq (car path) 0) ; update desktop
561 (wl-folder-buffer-search-group
562 (wl-folder-get-petname
563 (if (stringp (car path))
565 (wl-folder-get-folder-name-by-id
568 (wl-folder-update-diff-line diffs)
570 (setq path (cdr path)))))))
572 (defun wl-folder-maybe-load-folder-list (entity)
573 (when (null (caddr entity))
575 (elmo-msgdb-flist-load (car entity)))
579 (wl-folder-entity-assign-id entity
580 wl-folder-entity-id-name-hashtb
582 (setq diffs (wl-fldmgr-add-entity-hashtb (list entity)))
583 (unless (equal diffs '(0 0 0))
584 (wl-folder-update-group (car entity) diffs t)))))))
586 (defsubst wl-folder-force-fetch-p (entity)
588 ((consp wl-force-fetch-folders)
589 (wl-string-match-member entity wl-force-fetch-folders))
591 wl-force-fetch-folders)))
593 (defun wl-folder-jump-to-current-entity-with-arg ()
595 (wl-folder-jump-to-current-entity t))
597 (defun wl-folder-jump-to-current-entity (&optional arg)
598 "Enter the current folder. If optional ARG exists, update folder list."
601 (let (entity beg end indent opened fname err fld-name)
603 ((looking-at wl-folder-group-regexp)
605 (setq fname (wl-folder-get-realname (wl-match-buffer 3)))
606 (setq indent (wl-match-buffer 1))
607 (setq opened (wl-match-buffer 2))
608 (if (string= opened "+")
610 (setq entity (wl-folder-search-group-entity-by-name
615 (wl-folder-update-recursive-current-entity entity)
617 (setcdr (assoc (car entity) wl-folder-group-alist) t)
618 (if (eq 'access (cadr entity))
619 (wl-folder-maybe-load-folder-list entity))
620 ;(condition-case errobj
622 (if (or (wl-folder-force-fetch-p (car entity))
624 (eq 'access (cadr entity))
625 (null (caddr entity))))
626 (wl-folder-update-newest indent entity)
627 (wl-folder-insert-entity indent entity))
628 (wl-highlight-folder-path wl-folder-buffer-cur-path))
631 ; (setcdr (assoc fname wl-folder-group-alist) nil))
633 ; (elmo-display-error errobj t)
636 ; (setcdr (assoc fname wl-folder-group-alist) nil)))
638 (let ((buffer-read-only nil))
639 (delete-region (save-excursion (beginning-of-line)
641 (save-excursion (end-of-line)
647 (progn (wl-folder-goto-bottom-of-current-folder indent)
650 (setq entity (wl-folder-search-group-entity-by-name
653 (let ((buffer-read-only nil))
654 (delete-region beg end))
655 (setcdr (assoc (car entity) wl-folder-group-alist) nil)
656 (wl-folder-insert-entity indent entity) ; insert entity
658 (wl-highlight-folder-path wl-folder-buffer-cur-path)
659 ; (wl-delete-all-overlays)
660 ; (wl-highlight-folder-current-line)
662 ((setq fld-name (wl-folder-entity-name))
663 (wl-folder-set-current-entity-id
664 (get-text-property (point) 'wl-folder-entity-id))
665 (setq fld-name (wl-folder-get-folder-name-by-id
666 wl-folder-buffer-cur-entity-id))
667 (let ((summary-buf (wl-summary-get-buffer-create fld-name arg))
669 (if (or wl-stay-folder-window wl-summary-use-frame)
670 (wl-folder-select-buffer summary-buf)
672 (get-buffer-window summary-buf))
674 (wl-summary-goto-folder-subr fld-name
675 (wl-summary-get-sync-range
676 (wl-folder-get-elmo-folder fld-name))
678 (set-buffer-modified-p nil))
680 (defun wl-folder-close-entity (entity)
681 (let ((entities (list entity))
684 (setq entity (wl-pop entities))
687 (setcdr (assoc (car entity) wl-folder-group-alist) nil)
689 (wl-push entities entity-stack))
690 (setq entities (nth 2 entity))))
692 (setq entities (wl-pop entity-stack))))))
694 (defun wl-folder-update-recursive-current-entity (&optional entity)
696 (when (wl-folder-buffer-group-p)
698 ((string= (wl-match-buffer 2) "+")
702 (wl-folder-search-group-entity-by-name
703 (wl-folder-get-realname (wl-match-buffer 3))
705 (let ((inhibit-read-only t)
706 (entities (list entity))
707 entity-stack err indent)
708 (while (and entities (not err))
709 (setq entity (wl-pop entities))
712 (wl-folder-close-entity entity)
713 (setcdr (assoc (car entity) wl-folder-group-alist) t)
714 (unless (wl-folder-buffer-search-group
715 (wl-folder-get-petname (car entity)))
716 (error "%s: not found group" (car entity)))
717 (setq indent (wl-match-buffer 1))
718 (if (eq 'access (cadr entity))
719 (wl-folder-maybe-load-folder-list entity))
723 (condition-case errobj
724 (wl-folder-update-newest indent entity)
727 (setcdr (assoc (car entity) wl-folder-group-alist) nil))
729 (elmo-display-error errobj t)
732 (setcdr (assoc (car entity) wl-folder-group-alist) nil)))
734 (delete-region (save-excursion (beginning-of-line)
736 (save-excursion (end-of-line)
740 (wl-push entities entity-stack))
741 (setq entities (nth 2 entity))))
743 (setq entities (wl-pop entity-stack)))))
744 (set-buffer-modified-p nil)))
746 (wl-folder-jump-to-current-entity)))))
748 (defun wl-folder-no-auto-check-folder-p (folder)
751 (let ((li wl-auto-check-folder-list))
753 (if (string-match (car li) folder)
755 (setq li (cdr li)))))
758 (let ((li wl-auto-uncheck-folder-list))
760 (if (string-match (car li) folder)
761 (throw 'found t)) ; no check!
762 (setq li (cdr li))))))))
764 (defsubst wl-folder-add-folder-info (pre-value value)
766 (+ (or (nth 0 pre-value) 0) (or (nth 0 value) 0))
767 (+ (or (nth 1 pre-value) 0) (or (nth 1 value) 0))
768 (+ (or (nth 2 pre-value) 0) (or (nth 2 value) 0))))
770 (defun wl-folder-check-entity (entity &optional auto)
771 "Check unsync message number."
772 (let ((start-pos (point))
774 (run-hooks 'wl-folder-check-entity-pre-hook)
775 (if (and (consp entity) ;; group entity
776 wl-folder-check-async) ;; very fast
777 (setq ret-val (wl-folder-check-entity-async entity auto))
781 (let ((flist (if auto
783 'wl-folder-no-auto-check-folder-p
786 (wl-folder-check-entity-pre-hook nil)
787 (wl-folder-check-entity-hook nil)
791 (wl-folder-add-folder-info
793 (wl-folder-check-entity (car flist))))
794 (setq flist (cdr flist)))
795 ;(wl-folder-buffer-search-entity (car entity))
796 ;(wl-folder-update-line ret-val)
799 (message "Checking \"%s\"" entity)
800 (setq ret-val (wl-folder-check-one-entity
802 (goto-char start-pos)
805 (message "Uncheck(unplugged) \"%s\"" entity)))))
807 (message "Checking \"%s\" is done."
808 (if (consp entity) (car entity) entity)))
809 (run-hooks 'wl-folder-check-entity-hook)
812 (defun wl-folder-check-one-entity (entity &optional biff)
813 (let* ((folder (wl-folder-get-elmo-folder entity biff))
814 (nums (condition-case err
816 (if biff (elmo-folder-set-biff-internal folder t))
817 (if (wl-string-match-member entity wl-strict-diff-folders)
818 (elmo-strict-folder-diff folder)
819 (elmo-folder-diff folder)))
821 ;; maybe not exist folder.
822 (if (and (not (memq 'elmo-open-error
823 (get (car err) 'error-conditions)))
824 (not (elmo-folder-exists-p folder)))
825 (wl-folder-create-subr folder)
826 (signal (car err) (cdr err))))))
827 (new (elmo-diff-new nums))
828 (unread (elmo-diff-unread nums))
829 (all (elmo-diff-all nums))
831 (if (and (eq wl-folder-notify-deleted 'sync)
832 (or (and new (> 0 new))
833 (and unread (> 0 unread))
834 (and all (> 0 all))))
836 (wl-folder-sync-entity entity)
837 (setq nums (elmo-folder-diff folder)
838 new (elmo-diff-new nums)
839 unread (elmo-diff-unread nums)
840 all (elmo-diff-all nums)))
841 (unless wl-folder-notify-deleted
842 (setq new (and new (max 0 new))
843 unread (and unread (max 0 unread))
844 all (and all (max 0 all))))
845 (setq unread (or (and unread (- unread (or new 0)))
846 (elmo-folder-get-info-unread folder)
847 (cdr (wl-summary-count-unread
848 (elmo-msgdb-get-mark-alist
849 (elmo-folder-msgdb folder))))))
850 (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
851 (list new unread all)
852 (get-buffer wl-folder-buffer-name)))
853 (setq wl-folder-info-alist-modified t)
855 (list new unread all)))
857 (defun wl-folder-check-entity-async (entity &optional auto)
858 (let ((elmo-nntp-groups-async t)
861 'wl-folder-no-auto-check-folder-p
862 (wl-folder-get-entity-list entity))
863 (wl-folder-get-entity-list entity)))
864 (nntp-connection-keys nil)
865 name folder folder-list
871 (setq folder (wl-folder-get-elmo-folder (car elist)))
872 (if (not (elmo-folder-plugged-p folder))
873 (message "Uncheck \"%s\"" (car elist))
875 (elmo-folder-get-primitive-list folder))
876 (cond ((elmo-folder-contains-type folder 'nntp)
877 (wl-append async-folder-list (list folder))
879 (when (eq (elmo-folder-type-internal (car folder-list))
883 (elmo-net-folder-server-internal
885 (setq server (elmo-net-folder-server-internal
887 (message "Checking on \"%s\"" server))
888 (setq nntp-connection-keys
889 (elmo-nntp-get-folders-info-prepare
891 nntp-connection-keys)))
892 (setq folder-list (cdr folder-list))))
894 (wl-append sync-folder-list (list folder)))))
895 (setq elist (cdr elist)))
896 ;; check local entity at first
897 (while (setq folder (pop sync-folder-list))
898 (if (not (elmo-folder-plugged-p folder))
899 (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
900 (message "Checking \"%s\"" (elmo-folder-name-internal folder))
902 (wl-folder-add-folder-info
904 (wl-folder-check-one-entity (elmo-folder-name-internal
908 ;; check network entity at last
909 (when async-folder-list
910 (elmo-nntp-get-folders-info nntp-connection-keys)
911 (while (setq folder (pop async-folder-list))
912 (if (not (elmo-folder-plugged-p folder))
913 (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
914 (message "Checking \"%s\"" (elmo-folder-name-internal folder))
916 (wl-folder-add-folder-info
918 (wl-folder-check-one-entity (elmo-folder-name-internal
925 (defun wl-folder-resume-entity-hashtb-by-finfo (entity-hashtb info-alist)
926 "Resume unread info for entity alist."
929 (setq info (nth 1 (car info-alist)))
930 (wl-folder-set-entity-info (caar info-alist)
931 (list (nth 2 info)(nth 3 info)(nth 1 info))
933 (setq info-alist (cdr info-alist)))))
935 (defun wl-folder-move-path (path)
936 (let ((fp (if (consp path)
939 (wl-folder-get-path wl-folder-entity path))))
940 (goto-char (point-min))
943 (when (equal (car fp)
944 (wl-folder-get-entity-from-buffer t))
946 (setq wl-folder-buffer-cur-point (point)))
948 (and wl-folder-buffer-cur-point
949 (goto-char wl-folder-buffer-cur-point))))
951 (defun wl-folder-set-current-entity-id (entity-id)
952 (let ((buf (get-buffer wl-folder-buffer-name)))
956 (setq wl-folder-buffer-cur-entity-id entity-id)
957 (setq wl-folder-buffer-cur-path (wl-folder-get-path wl-folder-entity
959 (wl-highlight-folder-path wl-folder-buffer-cur-path)
960 (and wl-folder-move-cur-folder
961 wl-folder-buffer-cur-point
962 (goto-char wl-folder-buffer-cur-point))))
963 (if (eq (current-buffer) buf)
964 (and wl-folder-move-cur-folder
965 wl-folder-buffer-cur-point
966 (goto-char wl-folder-buffer-cur-point)))))
968 (defun wl-folder-check-current-entity ()
969 "Check folder at position.
970 If current line is group folder, check all sub entries."
972 (let* ((entity-name (wl-folder-get-entity-from-buffer))
973 (group (wl-folder-buffer-group-p))
974 (desktop (string= entity-name wl-folder-desktop-name)))
976 (wl-folder-check-entity
978 (wl-folder-search-group-entity-by-name entity-name
983 (defun wl-folder-sync-entity (entity &optional unread-only)
984 "Synchronize the msgdb of ENTITY."
987 (let ((flist (nth 2 entity)))
989 (wl-folder-sync-entity (car flist) unread-only)
990 (setq flist (cdr flist)))))
992 (let* ((folder (wl-folder-get-elmo-folder entity))
993 (nums (wl-folder-get-entity-info entity))
994 (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
995 (wl-summary-always-sticky-folder-p
997 wl-summary-highlight))
998 wl-auto-select-first new unread)
999 (setq new (or (car nums) 0))
1000 (setq unread (or (cadr nums) 0))
1001 (if (or (not unread-only)
1002 (or (< 0 new) (< 0 unread)))
1003 (let ((wl-summary-buffer-name (concat
1004 wl-summary-buffer-name
1005 (symbol-name this-command)))
1006 (wl-summary-use-frame nil)
1007 (wl-summary-always-sticky-folder-list nil))
1008 (save-window-excursion
1010 (wl-summary-goto-folder-subr entity
1011 (wl-summary-get-sync-range
1014 (wl-summary-exit)))))))))
1016 (defun wl-folder-sync-current-entity (&optional unread-only)
1017 "Synchronize the folder at position.
1018 If current line is group folder, check all subfolders."
1021 (let ((entity-name (wl-folder-get-entity-from-buffer))
1022 (group (wl-folder-buffer-group-p)))
1023 (when (and entity-name
1024 (y-or-n-p (format "Sync %s? " entity-name)))
1025 (wl-folder-sync-entity
1027 (wl-folder-search-group-entity-by-name entity-name
1031 (message "Syncing %s is done!" entity-name)))))
1033 (defun wl-folder-mark-as-read-all-entity (entity)
1034 "Mark as read all messages in the ENTITY."
1037 (let ((flist (nth 2 entity)))
1039 (wl-folder-mark-as-read-all-entity (car flist))
1040 (setq flist (cdr flist)))))
1042 (let* ((nums (wl-folder-get-entity-info entity))
1043 (folder (wl-folder-get-elmo-folder entity))
1044 (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
1045 (wl-summary-always-sticky-folder-p
1047 wl-summary-highlight))
1048 wl-auto-select-first new unread)
1049 (setq new (or (car nums) 0))
1050 (setq unread (or (cadr nums) 0))
1051 (if (or (< 0 new) (< 0 unread))
1052 (save-window-excursion
1054 (let ((wl-summary-buffer-name (concat
1055 wl-summary-buffer-name
1056 (symbol-name this-command)))
1057 (wl-summary-use-frame nil)
1058 (wl-summary-always-sticky-folder-list nil))
1059 (wl-summary-goto-folder-subr entity
1060 (wl-summary-get-sync-range folder)
1062 (wl-summary-mark-as-read-all)
1063 (wl-summary-exit))))
1066 (defun wl-folder-mark-as-read-all-current-entity ()
1067 "Mark as read all messages in the folder at position.
1068 If current line is group folder, all subfolders are marked."
1071 (let ((entity-name (wl-folder-get-entity-from-buffer))
1072 (group (wl-folder-buffer-group-p))
1074 (when (and entity-name
1075 (y-or-n-p (format "Mark all messages in %s as read? " entity-name)))
1076 (wl-folder-mark-as-read-all-entity
1078 (wl-folder-search-group-entity-by-name entity-name
1081 (message "All messages in %s are marked!" entity-name)))))
1083 (defun wl-folder-check-region (beg end)
1092 (let ((inhibit-read-only t)
1094 (while (< (point) end)
1095 ;; normal folder entity
1096 (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
1098 (setq entity (wl-folder-get-entity-from-buffer))
1099 (if (not (elmo-folder-plugged-p (wl-folder-get-elmo-folder
1101 (message "Uncheck %s" entity)
1102 (message "Checking %s" entity)
1103 (wl-folder-check-one-entity entity)
1108 (defun wl-folder-sync-region (beg end)
1117 (while (< (point) end)
1118 ;; normal folder entity
1119 (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
1121 (let ((inhibit-read-only t)
1123 (setq entity (wl-folder-get-entity-from-buffer))
1124 (wl-folder-sync-entity entity)
1125 (message "Syncing %s is done!" entity)
1130 (defun wl-folder-mark-as-read-all-region (beg end)
1139 (while (< (point) end)
1140 ;; normal folder entity
1141 (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
1143 (let ((inhibit-read-only t)
1145 (setq entity (wl-folder-get-entity-from-buffer))
1146 (wl-folder-mark-as-read-all-entity entity)
1147 (message "All messages in %s are marked!" entity)
1152 (defsubst wl-create-access-init-load-p (folder)
1153 (let ((no-load-regexp (when (and
1154 (not wl-folder-init-load-access-folders)
1155 wl-folder-init-no-load-access-folders)
1156 (mapconcat 'identity
1157 wl-folder-init-no-load-access-folders
1159 (load-regexp (and wl-folder-init-load-access-folders
1160 (mapconcat 'identity
1161 wl-folder-init-load-access-folders
1163 (cond (load-regexp (string-match load-regexp folder))
1164 (t (not (and no-load-regexp
1165 (string-match no-load-regexp folder)))))))
1167 (defun wl-create-access-folder-entity (name)
1169 (when (wl-create-access-init-load-p name)
1170 (setq flists (elmo-msgdb-flist-load name)) ; load flist.
1171 (setq flist (car flists))
1173 (when (consp (car flist))
1174 (setcdr (cdar flist)
1175 (wl-create-access-folder-entity (caar flist))))
1176 (setq flist (cdr flist)))
1179 (defun wl-create-folder-entity-from-buffer ()
1180 "Create folder entity recursively."
1182 ((looking-at "^[ \t]*$") ; blank line
1183 (goto-char (+ 1(match-end 0)))
1185 ((looking-at "^#.*$") ; comment
1186 (goto-char (+ 1 (match-end 0)))
1188 ((looking-at "^[\t ]*\\(.+\\)[\t ]*{[\t ]*$") ; group definition
1189 (let (name entity flist)
1190 (setq name (wl-match-buffer 1))
1191 (goto-char (+ 1 (match-end 0)))
1192 (while (setq entity (wl-create-folder-entity-from-buffer))
1193 (unless (eq entity 'ignore)
1194 (wl-append flist (list entity))))
1195 (if (looking-at "^[\t ]*}[\t ]*$") ; end of group
1197 (goto-char (+ 1 (match-end 0)))
1198 (if (wl-string-assoc name wl-folder-petname-alist)
1199 (error "%s already defined as petname" name))
1200 (list name 'group flist))
1201 (error "Syntax error in folder definition"))))
1202 ((looking-at "^[\t ]*\\([^\t \n]+\\)[\t ]*/$") ; access it!
1204 (setq name (wl-match-buffer 1))
1205 (goto-char (+ 1 (match-end 0)))
1206 ; (condition-case ()
1208 ; (setq flist (elmo-list-folders name)))
1209 ; (error (message "Access to folder %s failed." name)))
1210 ;; (setq flist (elmo-msgdb-flist-load name)) ; load flist.
1211 ;; (setq unsublist (nth 1 flist))
1212 ;; (setq flist (car flist))
1213 ;; (list name 'access flist unsublist)))
1214 (append (list name 'access) (wl-create-access-folder-entity name))))
1215 ;((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
1216 ((looking-at "^[\t ]*=[ \t]+\\([^\n]+\\)$"); petname definition
1217 (goto-char (+ 1 (match-end 0)))
1218 (let ((rest (elmo-match-buffer 1))
1220 (when (string-match "\\(\"[^\"]*\"\\)[\t ]*$" rest)
1221 (setq petname (elmo-delete-char ?\" (elmo-match-string 1 rest)))
1222 (setq rest (substring rest 0 (match-beginning 0))))
1223 (when (string-match "^[\t ]*\\(.*[^\t ]+\\)[\t ]+$" rest)
1224 (wl-folder-append-petname (elmo-match-string 1 rest)
1227 ((looking-at "^[ \t]*}[ \t]*$") ; end of group
1229 ((looking-at "^.*$") ; normal folder entity
1230 (goto-char (+ 1 (match-end 0)))
1231 (let ((rest (elmo-match-buffer 0))
1233 (if (string-match "\\(\"[^\"]*\"\\)[\t ]*$" rest)
1235 (setq petname (elmo-delete-char ?\" (elmo-match-string 1 rest)))
1236 (setq rest (substring rest 0 (match-beginning 0)))
1237 (when (string-match "^[\t ]*\\(.*[^\t ]+\\)[\t ]+$" rest)
1238 (wl-folder-append-petname
1239 (setq realname (elmo-match-string 1 rest))
1242 (if (string-match "^[\t ]*\\(.+\\)$" rest)
1243 (elmo-match-string 1 rest)
1246 (defun wl-folder-create-folder-entity ()
1247 "Create folder entries."
1248 (let ((tmp-buf (get-buffer-create " *wl-folder-tmp*"))
1252 (with-current-buffer tmp-buf
1254 (insert-file-contents wl-folders-file)
1255 (goto-char (point-min))
1256 (while (and (not (eobp))
1257 (setq entity (wl-create-folder-entity-from-buffer)))
1258 (unless (eq entity 'ignore)
1259 (wl-append ret-val (list entity)))))
1260 (kill-buffer tmp-buf))
1262 (setq ret-val (list wl-folder-desktop-name 'group ret-val))))
1264 (defun wl-folder-entity-assign-id (entity &optional hashtb on-noid)
1265 (let ((hashtb (or hashtb
1266 (setq wl-folder-entity-id-name-hashtb
1267 (elmo-make-hash wl-folder-entity-id))))
1268 (entities (list entity))
1271 (setq entity (wl-pop entities))
1274 (when (not (and on-noid
1275 (get-text-property 0
1276 'wl-folder-entity-id
1278 (put-text-property 0 (length (car entity))
1279 'wl-folder-entity-id
1282 (wl-folder-set-id-name wl-folder-entity-id
1283 (car entity) hashtb))
1285 (wl-push entities entity-stack))
1286 (setq entities (nth 2 entity)))
1288 (when (not (and on-noid
1289 (get-text-property 0
1290 'wl-folder-entity-id
1292 (put-text-property 0 (length entity)
1293 'wl-folder-entity-id
1296 (wl-folder-set-id-name wl-folder-entity-id
1298 (setq wl-folder-entity-id (+ 1 wl-folder-entity-id))
1300 (setq entities (wl-pop entity-stack))))))
1302 (defun wl-folder-click (e)
1307 (wl-folder-jump-to-current-entity)))
1309 (defun wl-folder-select-buffer (buffer)
1310 (let ((gbw (get-buffer-window buffer))
1313 (progn (select-window gbw)
1315 (unless wl-summary-use-frame
1318 (split-window-horizontally wl-folder-window-width)
1322 (if wl-summary-use-frame
1323 (switch-to-buffer-other-frame buffer)
1324 (switch-to-buffer buffer))
1327 (defun wl-folder-toggle-disp-summary (&optional arg folder)
1329 (if (or (and folder (assoc folder wl-folder-group-alist))
1330 (and (interactive-p) (wl-folder-buffer-group-p)))
1331 (error "This command is not available on Group"))
1333 (let (wl-auto-select-first
1334 (wl-stay-folder-window t))
1337 (setq wl-folder-buffer-disp-summary t))
1339 (setq wl-folder-buffer-disp-summary nil)
1340 ;; hide wl-summary window.
1341 (let ((cur-buf (current-buffer))
1342 (summary-buffer (wl-summary-get-buffer folder)))
1343 (wl-folder-select-buffer summary-buffer)
1345 (select-window (get-buffer-window cur-buf))))
1347 (setq wl-folder-buffer-disp-summary
1348 (not wl-folder-buffer-disp-summary))
1349 (let ((cur-buf (current-buffer))
1351 (when (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
1352 (setq folder-name (wl-folder-get-entity-from-buffer))
1353 (if wl-folder-buffer-disp-summary
1355 (wl-folder-select-buffer
1356 (wl-summary-get-buffer-create folder-name))
1358 (wl-summary-goto-folder-subr folder-name 'no-sync nil)
1359 (select-window (get-buffer-window cur-buf))))
1360 (wl-folder-select-buffer (wl-summary-get-buffer folder-name))
1362 (select-window (get-buffer-window cur-buf)))))))))
1364 (defun wl-folder-prev-unsync ()
1365 "Move cursor to the previous unsync folder."
1368 (setq start-point (point))
1370 (if (re-search-backward wl-folder-unsync-regexp nil t)
1372 (goto-char start-point)
1373 (message "No more unsync folder"))))
1375 (defun wl-folder-next-unsync (&optional plugged)
1376 "Move cursor to the next unsync."
1378 (let (start-point entity)
1379 (setq start-point (point))
1382 (while (re-search-forward wl-folder-unsync-regexp nil t)
1383 (if (or (wl-folder-buffer-group-p)
1386 (wl-folder-get-realname
1387 (wl-folder-folder-name)))
1388 (elmo-folder-plugged-p entity))
1391 (goto-char start-point)
1392 (message "No more unsync folder"))))
1394 (defun wl-folder-prev-unread (&optional group)
1395 "Move cursor to the previous unread folder."
1398 (setq start-point (point))
1400 (if (re-search-backward (wl-folder-unread-regex group) nil t)
1403 (wl-folder-folder-name))
1404 (goto-char start-point)
1405 (message "No more unread folder")
1408 (defun wl-folder-next-unread (&optional group)
1409 "Move cursor to the next unread folder."
1412 (setq start-point (point))
1414 (if (re-search-forward (wl-folder-unread-regex group) nil t)
1417 (wl-folder-folder-name))
1418 (goto-char start-point)
1419 (message "No more unread folder")
1422 (defun wl-folder-mode ()
1423 "Major mode for Wanderlust Folder.
1424 See Info under Wanderlust for full documentation.
1427 \\{wl-folder-mode-map}
1429 Entering Folder mode calls the value of `wl-folder-mode-hook'."
1431 (setq major-mode 'wl-folder-mode)
1432 (setq mode-name "Folder")
1433 (use-local-map wl-folder-mode-map)
1434 (setq buffer-read-only t)
1435 (setq inhibit-read-only nil)
1436 (setq truncate-lines t)
1437 (setq wl-folder-buffer-cur-entity-id nil
1438 wl-folder-buffer-cur-path nil
1439 wl-folder-buffer-cur-point nil)
1440 (wl-mode-line-buffer-identification)
1441 (easy-menu-add wl-folder-mode-menu)
1442 ;; This hook may contain the functions `wl-folder-init-icons' and
1443 ;; `wl-setup-folder' for reasons of system internal to accord
1444 ;; facilities for the Emacs variants.
1445 (run-hooks 'wl-folder-mode-hook))
1447 (defun wl-folder-append-petname (realname petname)
1449 ;; check group name.
1450 (if (wl-folder-search-group-entity-by-name petname wl-folder-entity)
1451 (error "%s already defined as group name" petname))
1452 (when (setq pentry (wl-string-assoc realname wl-folder-petname-alist))
1453 (setq wl-folder-petname-alist
1454 (delete pentry wl-folder-petname-alist)))
1455 (wl-append wl-folder-petname-alist
1456 (list (cons realname petname)))))
1458 (defun wl-folder (&optional arg)
1460 (let (initialize folder-buf)
1461 (if (setq folder-buf (get-buffer wl-folder-buffer-name))
1462 (if wl-folder-use-frame
1464 (save-selected-window
1465 (dolist (frame (visible-frame-list))
1466 (select-frame frame)
1467 (if (get-buffer-window folder-buf)
1468 (setq select-frame frame))))
1470 (select-frame select-frame)
1471 (switch-to-buffer folder-buf)))
1472 (switch-to-buffer folder-buf))
1473 (if wl-folder-use-frame
1475 (switch-to-buffer-other-frame
1476 (get-buffer-create wl-folder-buffer-name))
1477 (let ((frame (selected-frame)))
1478 (setq wl-delete-startup-frame-function
1480 (setq wl-delete-startup-frame-function nil)
1481 (let ((frame ,frame))
1482 (if (eq (selected-frame) frame)
1483 (delete-frame frame)))))))
1484 (switch-to-buffer (get-buffer-create wl-folder-buffer-name)))
1485 (set-buffer wl-folder-buffer-name)
1488 (setq wl-folder-entity-id 0)
1489 (wl-folder-entity-assign-id wl-folder-entity)
1490 (setq wl-folder-entity-hashtb
1491 (wl-folder-create-entity-hashtb wl-folder-entity))
1492 (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id))
1493 (setq wl-folder-group-alist
1494 (wl-folder-create-group-alist wl-folder-entity))
1495 (setq wl-folder-newsgroups-hashtb
1496 (wl-folder-create-newsgroups-hashtb wl-folder-entity))
1497 (wl-folder-init-info-hashtb)
1498 (let ((inhibit-read-only t)
1499 (buffer-read-only nil))
1501 (setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
1503 (wl-folder-insert-entity " " wl-folder-entity)))
1505 (set-buffer-modified-p nil)
1506 (setq initialize t))
1509 (defun wl-folder-auto-check ()
1510 "Check and update folders in `wl-auto-check-folder-name'."
1512 (when (get-buffer wl-folder-buffer-name)
1513 (switch-to-buffer wl-folder-buffer-name)
1515 ((eq wl-auto-check-folder-name 'none))
1516 ((or (consp wl-auto-check-folder-name)
1517 (stringp wl-auto-check-folder-name))
1518 (let ((folder-list (if (consp wl-auto-check-folder-name)
1519 wl-auto-check-folder-name
1520 (list wl-auto-check-folder-name)))
1523 (if (setq entity (wl-folder-search-entity-by-name
1526 (wl-folder-check-entity entity 'auto))
1527 (setq folder-list (cdr folder-list)))))
1529 (wl-folder-check-entity wl-folder-entity 'auto)))))
1531 (defun wl-folder-set-folder-updated (name value)
1534 (if (setq buf (get-buffer wl-folder-buffer-name))
1535 (wl-folder-entity-hashtb-set
1536 wl-folder-entity-hashtb name value buf))
1537 (setq wl-folder-info-alist-modified t))))
1539 (defun wl-folder-calc-finfo (entity)
1540 ;; calcurate finfo without inserting.
1541 (let ((entities (list entity))
1543 new unread all nums)
1545 (setq entity (wl-pop entities))
1549 (wl-push entities entity-stack))
1550 (setq entities (nth 2 entity)))
1552 (setq nums (wl-folder-get-entity-info entity))
1553 (setq new (+ (or new 0) (or (nth 0 nums) 0)))
1554 (setq unread (+ (or unread 0)
1555 (or (and (nth 0 nums)(nth 1 nums)
1556 (+ (nth 0 nums)(nth 1 nums))) 0)))
1557 (setq all (+ (or all 0) (or (nth 2 nums) 0)))))
1559 (setq entities (wl-pop entity-stack))))
1560 (list new unread all)))
1562 (defsubst wl-folder-make-save-access-list (list)
1563 (mapcar '(lambda (x)
1566 (list (elmo-string (car x)) 'access))
1571 (defun wl-folder-update-newest (indent entity)
1572 (let (ret-val new unread all)
1575 (let ((inhibit-read-only t)
1576 (buffer-read-only nil)
1577 (flist (nth 2 entity))
1578 (as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
1583 (let (update-flist flist-unsub new-flist removed group-name-end)
1584 (when (and (eq (cadr entity) 'access)
1585 (elmo-folder-plugged-p
1586 (wl-folder-get-elmo-folder (car entity))))
1587 (message "Fetching folder entries...")
1588 (when (setq new-flist
1589 (elmo-folder-list-subfolders
1590 (wl-folder-get-elmo-folder (car entity))
1591 (wl-string-match-member
1593 wl-folder-hierarchy-access-folders)))
1595 (wl-folder-update-access-group entity new-flist))
1596 (setq flist (nth 1 update-flist))
1597 (when (car update-flist) ;; diff
1598 (setq flist-unsub (nth 2 update-flist))
1599 (setq removed (nth 3 update-flist))
1600 (elmo-msgdb-flist-save
1603 (wl-folder-make-save-access-list flist)
1604 (wl-folder-make-save-access-list flist-unsub)))
1605 (wl-folder-entity-assign-id
1607 wl-folder-entity-id-name-hashtb
1609 (setq wl-folder-entity-hashtb
1610 (wl-folder-create-entity-hashtb
1612 wl-folder-entity-hashtb
1614 (setq wl-folder-newsgroups-hashtb
1616 (wl-folder-create-newsgroups-hashtb
1618 wl-folder-newsgroups-hashtb))))
1619 (message "Fetching folder entries...done"))
1620 (wl-folder-insert-entity indent entity))))))))
1622 (defun wl-folder-insert-entity (indent entity &optional onlygroup)
1623 (let (ret-val new unread all)
1626 (let ((inhibit-read-only t)
1627 (buffer-read-only nil)
1628 (flist (nth 2 entity))
1629 (as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
1632 ;;; (insert indent "[" (if as-opened "-" "+") "]" (car entity) "\n")
1633 ;;; (save-excursion (forward-line -1)
1634 ;;; (wl-highlight-folder-current-line))
1638 (let (update-flist flist-unsub new-flist removed group-name-end)
1639 ;;; (when (and (eq (cadr entity) 'access)
1641 ;;; (message "fetching folder entries...")
1642 ;;; (when (setq new-flist
1643 ;;; (elmo-list-folders
1644 ;;; (elmo-string (car entity))
1645 ;;; (wl-string-member
1647 ;;; wl-folder-hierarchy-access-folders)
1649 ;;; (setq update-flist
1650 ;;; (wl-folder-update-access-group entity new-flist))
1651 ;;; (setq flist (nth 1 update-flist))
1652 ;;; (when (car update-flist) ;; diff
1653 ;;; (setq flist-unsub (nth 2 update-flist))
1654 ;;; (setq removed (nth 3 update-flist))
1655 ;;; (elmo-msgdb-flist-save
1658 ;;; (wl-folder-make-save-access-list flist)
1659 ;;; (wl-folder-make-save-access-list flist-unsub)))
1661 ;;; ;; reconstruct wl-folder-entity-id-name-hashtb and
1662 ;;; ;; wl-folder-entity-hashtb
1664 ;;; (wl-folder-entity-assign-id
1666 ;;; wl-folder-entity-id-name-hashtb
1668 ;;; (setq wl-folder-entity-hashtb
1669 ;;; (wl-folder-create-entity-hashtb
1671 ;;; wl-folder-entity-hashtb
1673 ;;; (setq wl-folder-newsgroups-hashtb
1675 ;;; (wl-folder-create-newsgroups-hashtb
1677 ;;; wl-folder-newsgroups-hashtb))))
1678 ;;; (message "fetching folder entries...done"))
1679 (insert indent "[" (if as-opened "-" "+") "]"
1680 (wl-folder-get-petname (car entity)))
1681 (setq group-name-end (point))
1683 (put-text-property beg (point) 'wl-folder-entity-id
1684 (get-text-property 0 'wl-folder-entity-id
1690 wl-folder-removed-mark
1691 (if (listp (car removed))
1692 (concat "[+]" (caar removed))
1695 (save-excursion (forward-line -1)
1696 (wl-highlight-folder-current-line))
1697 (setq removed (cdr removed)))
1698 (remove-text-properties beg (point) '(wl-folder-entity-id)))
1699 (let* ((len (length flist))
1704 (wl-folder-insert-entity
1705 (concat indent " ") (car flist)))
1706 (setq new (+ (or new 0) (or (nth 0 ret-val) 0)))
1707 (setq unread (+ (or unread 0) (or (nth 1 ret-val) 0)))
1708 (setq all (+ (or all 0) (or (nth 2 ret-val) 0)))
1710 (> len elmo-display-progress-threshold))
1712 (elmo-display-progress
1713 'wl-folder-insert-entity "Inserting group %s..."
1714 (/ (* i 100) len) (car entity)))
1715 (setq flist (cdr flist))))
1717 (goto-char group-name-end)
1718 (delete-region (point) (save-excursion (end-of-line)
1720 (insert (format ":%d/%d/%d" (or new 0)
1721 (or unread 0) (or all 0)))
1722 (setq ret-val (list new unread all))
1723 (wl-highlight-folder-current-line ret-val)))
1724 (setq ret-val (wl-folder-calc-finfo entity))
1725 (insert indent "[" (if as-opened "-" "+") "]"
1726 (wl-folder-get-petname (car entity))
1728 (or (nth 0 ret-val) 0)
1729 (or (nth 1 ret-val) 0)
1730 (or (nth 2 ret-val) 0))
1732 (put-text-property beg (point) 'wl-folder-entity-id
1733 (get-text-property 0 'wl-folder-entity-id
1735 (save-excursion (forward-line -1)
1736 (wl-highlight-folder-current-line ret-val)))))
1738 (let* ((inhibit-read-only t)
1739 (buffer-read-only nil)
1740 (nums (wl-folder-get-entity-info entity))
1743 (insert indent (wl-folder-get-petname entity)
1744 (format ":%s/%s/%s\n"
1745 (or (setq new (nth 0 nums)) "*")
1746 (or (setq unread (and (nth 0 nums)(nth 1 nums)
1747 (+ (nth 0 nums)(nth 1 nums))))
1749 (or (setq all (nth 2 nums)) "*")))
1750 (put-text-property beg (point) 'wl-folder-entity-id
1751 (get-text-property 0 'wl-folder-entity-id entity))
1752 (save-excursion (forward-line -1)
1753 (wl-highlight-folder-current-line nums))
1754 (setq ret-val (list new unread all)))))
1755 (set-buffer-modified-p nil)
1758 (defun wl-folder-check-all ()
1760 (wl-folder-check-entity wl-folder-entity))
1762 (defun wl-folder-entity-hashtb-set (entity-hashtb name value buffer)
1769 (setq cur-val (wl-folder-get-entity-info name entity-hashtb))
1770 (setq new-diff (- (or (nth 0 value) 0) (or (nth 0 cur-val) 0)))
1773 (- (or (nth 1 value) 0) (or (nth 1 cur-val) 0))))
1774 (setq all-diff (- (or (nth 2 value) 0) (or (nth 2 cur-val) 0)))
1775 (setq diffs (list new-diff unread-diff all-diff))
1776 (unless (and (nth 0 cur-val)
1777 (equal diffs '(0 0 0)))
1778 (wl-folder-set-entity-info name value entity-hashtb)
1780 (with-current-buffer buffer
1782 (setq entity-list (wl-folder-search-entity-list-by-name
1783 name wl-folder-entity))
1785 (wl-folder-update-group (car entity-list) diffs)
1786 (setq entity-list (cdr entity-list)))
1787 (goto-char (point-min))
1788 (while (wl-folder-buffer-search-entity name)
1789 (wl-folder-update-line value))))))))
1791 (defun wl-folder-update-unread (folder unread)
1792 ; (save-window-excursion
1793 (let ((buf (get-buffer wl-folder-buffer-name))
1796 ;;(fld (elmo-string folder))
1797 value newvalue entity-list)
1798 ;;; Update folder-info
1799 ;;; (elmo-folder-set-info-hashtb fld nil nil nil unread)
1800 (setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0))
1801 (setq unread-diff (- (or unread 0) cur-unread))
1802 (setq value (wl-folder-get-entity-info folder))
1803 (setq newvalue (list (nth 0 value)
1806 (wl-folder-set-entity-info folder newvalue)
1807 (setq wl-folder-info-alist-modified t)
1809 (not (eq unread-diff 0)))
1811 (with-current-buffer buf
1813 (setq entity-list (wl-folder-search-entity-list-by-name
1814 folder wl-folder-entity))
1816 (wl-folder-update-group (car entity-list) (list 0
1819 (setq entity-list (cdr entity-list)))
1820 (goto-char (point-min))
1821 (while (wl-folder-buffer-search-entity folder)
1822 (wl-folder-update-line newvalue))))))));)
1824 (defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst)
1825 (let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
1826 (entities (list entity))
1829 (setq entity (wl-pop entities))
1833 (wl-push entities entity-stack))
1834 (setq entities (nth 2 entity)))
1836 (when (not (and reconst
1837 (wl-folder-get-entity-info entity)))
1838 (wl-folder-set-entity-info entity
1842 (setq entities (wl-pop entity-stack))))
1845 ;; Unsync number is reserved.
1846 ;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
1847 ;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
1848 ;; (entities (list entity))
1851 ;; (setq entity (wl-pop entities))
1855 ;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
1858 ;; (wl-push entities entity-stack))
1859 ;; (setq entities (nth 2 entity))
1861 ;; ((stringp entity)
1862 ;; (wl-folder-set-entity-info entity
1863 ;; (wl-folder-get-entity-info entity)
1866 ;; (wl-folder-set-id-name (wl-folder-get-entity-id entity)
1869 ;; (setq entities (wl-pop entity-stack))))
1872 (defun wl-folder-create-newsgroups-from-nntp-access (entity)
1873 (let ((flist (nth 2 entity))
1878 ((consp (car flist))
1879 (wl-folder-create-newsgroups-from-nntp-access (car flist)))
1882 (elmo-nntp-folder-group-internal
1883 (wl-folder-get-elmo-folder (car flist)))))))
1884 (setq flist (cdr flist)))
1887 (defun wl-folder-create-newsgroups-hashtb (entity &optional is-list info)
1888 "Create NNTP group hashtable for ENTITY."
1889 (let ((entities (if is-list entity (list entity)))
1890 entity-stack folder-list newsgroups newsgroup make-hashtb)
1891 (and info (message "Creating newsgroups..."))
1893 (setq entity (wl-pop entities))
1896 (if (eq (nth 1 entity) 'access)
1897 (when (eq (elmo-folder-type-internal
1898 (elmo-make-folder (car entity))) 'nntp)
1899 (wl-append newsgroups
1900 (wl-folder-create-newsgroups-from-nntp-access entity))
1901 (setq make-hashtb t))
1903 (wl-push entities entity-stack))
1904 (setq entities (nth 2 entity))))
1906 (setq folder-list (elmo-folder-get-primitive-list
1907 (elmo-make-folder entity)))
1909 (when (and (eq (elmo-folder-type-internal (car folder-list))
1911 (setq newsgroup (elmo-nntp-folder-group-internal
1912 (car folder-list))))
1913 (wl-append newsgroups (list (elmo-string newsgroup))))
1914 (setq folder-list (cdr folder-list)))))
1916 (setq entities (wl-pop entity-stack))))
1917 (and info (message "Creating newsgroups...done"))
1918 (if (or newsgroups make-hashtb)
1919 (elmo-setup-subscribed-newsgroups newsgroups))))
1921 (defun wl-folder-get-path (entity target-id &optional string)
1922 (let ((entities (list entity))
1923 entity-stack result-path)
1927 (setq entity (wl-pop entities))
1930 (if (and (or (not string) (string= string (car entity)))
1931 ;; don't use eq, `id' is string on Nemacs.
1932 (equal target-id (wl-folder-get-entity-id (car entity))))
1934 (wl-push target-id result-path))
1935 (wl-push (wl-folder-get-entity-id (car entity)) result-path))
1936 (wl-push entities entity-stack)
1937 (setq entities (nth 2 entity)))
1939 (if (and (or (not string) (string= string entity))
1940 ;; don't use eq, `id' is string on Nemacs.
1941 (equal target-id (wl-folder-get-entity-id entity)))
1943 (wl-push target-id result-path)))))
1945 (while (and entity-stack
1947 (setq result-path (cdr result-path))
1948 (setq entities (wl-pop entity-stack)))))))))
1950 (defun wl-folder-create-group-alist (entity)
1952 (let ((flist (nth 2 entity))
1953 (cur-alist (list (cons (car entity) nil)))
1956 (if (consp (car flist))
1957 (wl-append append-alist
1958 (wl-folder-create-group-alist (car flist))))
1959 (setq flist (cdr flist)))
1960 (append cur-alist append-alist))))
1962 (defun wl-folder-init-info-hashtb ()
1963 (let ((info-alist (and wl-folder-info-save
1964 (elmo-msgdb-finfo-load))))
1965 (elmo-folder-info-make-hashtb
1967 wl-folder-entity-hashtb)))
1968 ;;; (wl-folder-resume-entity-hashtb-by-finfo
1969 ;;; wl-folder-entity-hashtb
1972 (defun wl-folder-cleanup-variables ()
1973 (setq wl-folder-entity nil
1974 wl-folder-entity-hashtb nil
1975 wl-folder-entity-id-name-hashtb nil
1976 wl-folder-group-alist nil
1977 wl-folder-petname-alist nil
1978 wl-folder-newsgroups-hashtb nil
1979 wl-fldmgr-cut-entity-list nil
1980 wl-fldmgr-modified nil
1981 wl-fldmgr-modified-access-list nil
1985 (defun wl-make-plugged-alist ()
1986 (let ((entity-list (wl-folder-get-entity-list wl-folder-entity))
1987 (add (not wl-reset-plugged-alist)))
1989 (elmo-folder-set-plugged
1990 (wl-folder-get-elmo-folder (car entity-list)) wl-plugged add)
1991 (setq entity-list (cdr entity-list)))
1992 ;; smtp posting server
1993 (when wl-smtp-posting-server
1994 (elmo-set-plugged wl-plugged
1995 wl-smtp-posting-server ; server
1996 (or (and (boundp 'smtp-service) smtp-service)
1998 wl-smtp-connection-type
1999 nil nil "smtp" add))
2000 ;; nntp posting server
2001 (when wl-nntp-posting-server
2002 (elmo-set-plugged wl-plugged
2003 wl-nntp-posting-server
2004 wl-nntp-posting-stream-type
2005 wl-nntp-posting-port
2006 nil nil "nntp" add))
2007 (run-hooks 'wl-make-plugged-hook)))
2009 (defvar wl-folder-init-function 'wl-local-folder-init)
2011 (defun wl-folder-init ()
2012 "Return top-level folder entity."
2016 (funcall wl-folder-init-function))
2017 (run-hooks 'wl-folder-init-hook))
2019 (defun wl-local-folder-init ()
2020 "Initialize local folder."
2021 (message "Initializing folder...")
2022 (setq wl-folder-entity (wl-folder-create-folder-entity))
2023 (message "Initializing folder...done"))
2025 (defun wl-folder-get-realname (petname)
2029 wl-folder-petname-alist))
2032 (defun wl-folder-get-petname (name)
2036 wl-folder-petname-alist))
2039 (defun wl-folder-get-entity-with-petname ()
2040 (let ((alist wl-folder-petname-alist)
2041 (hashtb (copy-sequence wl-folder-entity-hashtb)))
2043 (wl-folder-set-entity-info (cdar alist) nil hashtb)
2044 (setq alist (cdr alist)))
2047 (defun wl-folder-get-newsgroups (folder)
2048 "Return Newsgroups field value string for FOLDER newsgroup.
2049 If FOLDER is multi, return comma separated string (cross post)."
2050 (let ((nlist (elmo-folder-newsgroups
2051 (wl-folder-get-elmo-folder folder))))
2053 (list nil nil (mapconcat 'identity nlist ","))
2056 (defun wl-folder-guess-mailing-list-by-refile-rule (entity)
2057 "Return ML address guess by FOLDER.
2058 Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'."
2060 (elmo-folder-get-primitive-list
2061 (wl-folder-get-elmo-folder entity)))
2063 (while (setq fld (car flist))
2064 (setq mladdr (wl-folder-guess-mailing-list-by-refile-rule-subr
2065 (elmo-folder-name-internal fld)))
2067 (setq to (if (stringp to)
2068 (concat to ", " mladdr)
2070 (setq flist (cdr flist)))
2075 (defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity)
2076 (unless (memq (elmo-folder-type entity)
2078 (let ((rules wl-refile-rule-alist)
2081 (if (or (and (stringp (car (car rules)))
2082 (string-match "[Tt]o" (car (car rules))))
2083 (and (listp (car (car rules)))
2084 (elmo-string-matched-member "to" (car (car rules))
2086 (setq toalist (append toalist (cdr (car rules)))))
2087 (setq rules (cdr rules)))
2088 (setq tokey (car (rassoc entity toalist)))
2089 ;;; (setq histkey (car (rassoc folder wl-refile-alist)))
2090 ;; case-ignore search `wl-subscribed-mailing-list'
2092 (elmo-string-matched-member tokey wl-subscribed-mailing-list t)))))
2094 (defun wl-folder-guess-mailing-list-by-folder-name (entity)
2095 "Return ML address guess by FOLDER name's last hierarchy.
2096 Use `wl-subscribed-mailing-list'."
2098 (elmo-folder-get-primitive-list
2099 (wl-folder-get-elmo-folder entity)))
2101 (while (setq fld (car flist))
2102 (setq mladdr (wl-folder-guess-mailing-list-by-folder-name-subr
2103 (elmo-folder-name-internal fld)))
2105 (setq to (if (stringp to)
2106 (concat to ", " mladdr)
2108 (setq flist (cdr flist)))
2113 (defun wl-folder-guess-mailing-list-by-folder-name-subr (entity)
2114 (when (memq (elmo-folder-type entity)
2115 '(localdir imap4 maildir))
2116 (let (key foldername)
2117 ;; Get foldername and Remove folder type symbol.
2118 (setq foldername (substring entity 1))
2119 (if (string-match "@" foldername)
2120 (setq foldername (substring foldername 0 (match-beginning 0))))
2121 (when (string-match "[^\\./]+$" foldername)
2122 (setq key (regexp-quote
2123 (concat (substring foldername (match-beginning 0)) "@")))
2124 (elmo-string-matched-member
2125 key wl-subscribed-mailing-list 'case-ignore)))))
2127 (defun wl-folder-update-diff-line (diffs)
2128 (let ((inhibit-read-only t)
2129 (buffer-read-only nil)
2131 cur-unread new-unread
2136 (setq id (get-text-property (point) 'wl-folder-entity-id))
2137 (when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)")
2138 ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
2139 (setq cur-new (string-to-int
2140 (wl-match-buffer 2)))
2141 (setq cur-unread (string-to-int
2142 (wl-match-buffer 3)))
2143 (setq cur-all (string-to-int
2144 (wl-match-buffer 4)))
2145 (delete-region (match-beginning 2)
2147 (goto-char (match-beginning 2))
2148 (insert (format "%s/%s/%s"
2149 (setq new-new (+ cur-new (nth 0 diffs)))
2150 (setq new-unread (+ cur-unread (nth 1 diffs)))
2151 (setq new-all (+ cur-all (nth 2 diffs)))))
2152 (put-text-property (match-beginning 2) (point)
2153 'wl-folder-entity-id id)
2154 (if wl-use-highlight-mouse-line
2155 (put-text-property (match-beginning 2) (point)
2156 'mouse-face 'highlight))
2157 (wl-highlight-folder-group-line (list new-new new-unread new-all))
2158 (setq buffer-read-only t)
2159 (set-buffer-modified-p nil)))))
2161 (defun wl-folder-update-line (nums &optional is-group)
2162 (let ((inhibit-read-only t)
2163 (buffer-read-only nil)
2167 (setq id (get-text-property (point) 'wl-folder-entity-id))
2168 (if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
2169 ;;; (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
2171 (delete-region (match-beginning 2)
2173 (goto-char (match-beginning 2))
2174 (insert (format "%s/%s/%s"
2175 (or (nth 0 nums) "*")
2176 (or (and (nth 0 nums)(nth 1 nums)
2177 (+ (nth 0 nums)(nth 1 nums)))
2179 (or (nth 2 nums) "*")))
2180 (put-text-property (match-beginning 2) (point)
2181 'wl-folder-entity-id id)
2183 ;; update only colors
2184 (wl-highlight-folder-group-line nums)
2185 (wl-highlight-folder-current-line nums))
2187 (set-buffer-modified-p nil))))))
2189 (defun wl-folder-goto-folder (&optional arg)
2191 (wl-folder-goto-folder-subr nil arg))
2193 (defun wl-folder-goto-folder-sticky ()
2195 (wl-folder-goto-folder-subr nil t))
2197 (defun wl-folder-goto-folder-subr (&optional folder sticky)
2199 (let (summary-buf fld-name entity id error-selecting)
2200 ;;; (setq fld-name (wl-folder-get-entity-from-buffer))
2201 ;;; (if (or (null fld-name)
2202 ;;; (assoc fld-name wl-folder-group-alist))
2203 (setq fld-name wl-default-folder)
2204 (setq fld-name (or folder
2205 (wl-summary-read-folder fld-name)))
2206 (if (and (setq entity
2207 (wl-folder-search-entity-by-name fld-name
2210 (setq id (wl-folder-get-entity-id entity)))
2211 (wl-folder-set-current-entity-id id))
2212 (setq summary-buf (wl-summary-get-buffer-create fld-name sticky))
2213 (if (or wl-stay-folder-window wl-summary-use-frame)
2214 (wl-folder-select-buffer summary-buf)
2215 (if (and summary-buf
2216 (get-buffer-window summary-buf))
2218 (wl-summary-goto-folder-subr fld-name
2219 (wl-summary-get-sync-range
2220 (wl-folder-get-elmo-folder fld-name))
2223 (defun wl-folder-suspend ()
2225 (run-hooks 'wl-folder-suspend-hook)
2226 (wl-folder-info-save)
2227 (elmo-crosspost-message-alist-save)
2229 ;(if (fboundp 'mmelmo-cleanup-entity-buffers)
2230 ;(mmelmo-cleanup-entity-buffers))
2231 (bury-buffer wl-folder-buffer-name)
2232 (delete-windows-on wl-folder-buffer-name t))
2234 (defun wl-folder-info-save ()
2235 (when (and wl-folder-info-save
2236 wl-folder-info-alist-modified)
2237 (let ((entities (list wl-folder-entity))
2238 entity entity-stack info-alist info)
2240 (setq entity (wl-pop entities))
2244 (wl-push entities entity-stack))
2245 (setq entities (nth 2 entity)))
2247 (when (and (setq info (elmo-folder-get-info
2248 (wl-folder-get-elmo-folder entity)))
2249 (not (equal info '(nil))))
2251 (wl-append info-alist (list (list (elmo-string entity)
2252 (list (nth 3 info) ;; max
2253 (nth 2 info) ;; length
2255 (nth 1 info)) ;; unread
2258 (setq entities (wl-pop entity-stack))))
2259 (elmo-msgdb-finfo-save info-alist)
2260 (setq wl-folder-info-alist-modified nil))))
2262 (defun wl-folder-goto-first-unread-folder (&optional arg)
2264 (let ((entities (list wl-folder-entity))
2265 entity entity-stack ret-val
2270 (setq entity (wl-pop entities))
2274 (wl-push entities entity-stack))
2275 (setq entities (nth 2 entity)))
2277 (if (and (setq finfo (wl-folder-get-entity-info entity))
2278 (and (nth 0 finfo)(nth 1 finfo))
2279 (> (+ (nth 0 finfo)(nth 1 finfo)) 0))
2280 (throw 'done entity))
2281 (wl-append ret-val (list entity))))
2283 (setq entities (wl-pop entity-stack))))))
2287 (wl-folder-jump-folder first-entity)
2289 (wl-folder-goto-folder-subr first-entity))
2290 (message "No unread folder"))))
2292 (defun wl-folder-jump-folder (&optional fld-name noopen)
2295 (setq fld-name (wl-summary-read-folder wl-default-folder)))
2296 (goto-char (point-min))
2298 (wl-folder-open-folder fld-name))
2299 (and (wl-folder-buffer-search-entity fld-name)
2300 (beginning-of-line)))
2302 (defun wl-folder-get-entity-list (entity)
2303 (let ((entities (list entity))
2304 entity-stack ret-val)
2306 (setq entity (wl-pop entities))
2310 (wl-push entities entity-stack))
2311 (setq entities (nth 2 entity)))
2313 (wl-append ret-val (list entity))))
2315 (setq entities (wl-pop entity-stack))))
2318 (defun wl-folder-open-unread-folder (entity)
2320 (let ((alist (wl-folder-get-entity-list entity))
2322 finfo path-list path id)
2324 (when (and (setq finfo (wl-folder-get-entity-info (car alist)))
2325 (nth 0 finfo) (nth 1 finfo)
2326 (> (+ (nth 0 finfo)(nth 1 finfo)) 0))
2327 (setq unread (+ unread (+ (nth 0 finfo)(nth 1 finfo))))
2328 (setq id (wl-folder-get-entity-id (car alist)))
2329 (setq path (delete id (wl-folder-get-path
2333 (if (not (member path path-list))
2334 (wl-append path-list (list path))))
2335 (setq alist (cdr alist)))
2337 (wl-folder-open-folder-sub (car path-list))
2338 (setq path-list (cdr path-list)))
2339 (message "%s unread folder"
2340 (if (> unread 0) unread "No")))))
2342 (defun wl-folder-open-unread-current-entity ()
2344 (let ((entity-name (wl-folder-get-entity-from-buffer))
2345 (group (wl-folder-buffer-group-p)))
2347 (wl-folder-open-unread-folder
2349 (wl-folder-search-group-entity-by-name entity-name
2353 (defun wl-folder-open-only-unread-folder ()
2356 (wl-folder-prev-entity-skip-invalid t)
2357 (wl-folder-get-entity-from-buffer t))))
2358 (wl-folder-open-all-unread-folder)
2360 (goto-char (point-max))
2361 (while (and (re-search-backward
2362 "^[ ]*\\[[-]\\].+:0/0/[0-9-]+" nil t)
2364 (wl-folder-jump-to-current-entity) ;; close it
2366 (wl-folder-move-path id)
2369 (defun wl-folder-open-all-unread-folder (&optional arg)
2372 (wl-folder-prev-entity-skip-invalid t)
2373 (wl-folder-get-entity-from-buffer t))))
2374 (wl-folder-open-unread-folder wl-folder-entity)
2376 (wl-folder-move-path id)
2377 (goto-char (point-min))
2378 (wl-folder-next-unread t))))
2380 (defun wl-folder-open-folder (&optional fld-name)
2383 (setq fld-name (wl-summary-read-folder wl-default-folder)))
2384 (let* ((id (wl-folder-get-entity-id
2385 (wl-folder-search-entity-by-name fld-name wl-folder-entity
2387 (path (and id (wl-folder-get-path wl-folder-entity id))))
2389 (wl-folder-open-folder-sub path))))
2391 (defun wl-folder-open-folder-sub (path)
2392 (let ((inhibit-read-only t)
2393 (buffer-read-only nil)
2397 (goto-char (point-min))
2399 (wl-folder-buffer-search-group
2400 (wl-folder-get-petname
2401 (if (stringp (car path))
2403 (wl-folder-get-folder-name-by-id
2406 (setq path (cdr path))
2407 (if (and (looking-at wl-folder-group-regexp)
2408 (string= "+" (wl-match-buffer 2)));; closed group
2410 (setq indent (wl-match-buffer 1))
2411 (setq name (wl-folder-get-realname (wl-match-buffer 3)))
2412 (setq entity (wl-folder-search-group-entity-by-name
2416 (setcdr (assoc (car entity) wl-folder-group-alist) t)
2417 (if (eq 'access (cadr entity))
2418 (wl-folder-maybe-load-folder-list entity))
2419 (wl-folder-insert-entity indent entity)
2420 (delete-region (save-excursion (beginning-of-line)
2422 (save-excursion (end-of-line)
2424 (set-buffer-modified-p nil))))
2426 (defun wl-folder-open-all-pre ()
2427 (let ((entities (list wl-folder-entity))
2428 entity entity-stack group-entry)
2430 (setq entity (wl-pop entities))
2433 (unless (or (not (setq group-entry
2434 (assoc (car entity) wl-folder-group-alist)))
2436 (setcdr group-entry t)
2437 (when (eq 'access (cadr entity))
2438 (wl-folder-maybe-load-folder-list entity)))
2440 (wl-push entities entity-stack))
2441 (setq entities (nth 2 entity))))
2443 (setq entities (wl-pop entity-stack))))))
2445 (defun wl-folder-open-all (&optional refresh)
2447 (let* ((inhibit-read-only t)
2448 (buffer-read-only nil)
2449 (len (length wl-folder-group-alist))
2454 (wl-folder-prev-entity-skip-invalid t)
2455 (wl-folder-get-entity-from-buffer t)))
2456 (alist wl-folder-group-alist))
2458 (setcdr (pop alist) t))
2460 (wl-folder-insert-entity " " wl-folder-entity)
2461 (wl-folder-move-path id))
2462 (message "Opening all folders...")
2463 (wl-folder-open-all-pre)
2465 (goto-char (point-min))
2466 (while (re-search-forward
2467 "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n"
2469 (setq indent (wl-match-buffer 1))
2470 (setq name (wl-folder-get-realname (wl-match-buffer 3)))
2471 (setq entity (wl-folder-search-group-entity-by-name
2475 (setcdr (assoc (car entity) wl-folder-group-alist) t)
2477 (wl-folder-insert-entity indent entity)
2478 (delete-region (save-excursion (beginning-of-line)
2480 (save-excursion (end-of-line)
2482 (when (> len elmo-display-progress-threshold)
2484 (if (or (zerop (% i 5)) (= i len))
2485 (elmo-display-progress
2486 'wl-folder-open-all "Opening all folders..."
2487 (/ (* i 100) len)))))
2488 (when (> len elmo-display-progress-threshold)
2489 (elmo-display-progress
2490 'wl-folder-open-all "Opening all folders..." 100))))
2491 (message "Opening all folders...done")
2492 (set-buffer-modified-p nil)))
2494 (defun wl-folder-close-all ()
2496 (let ((inhibit-read-only t)
2497 (buffer-read-only nil)
2498 (alist wl-folder-group-alist)
2500 (wl-folder-prev-entity-skip-invalid t)
2501 (wl-folder-get-entity-from-buffer t))))
2503 (setcdr (car alist) nil)
2504 (setq alist (cdr alist)))
2505 (setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
2507 (wl-folder-insert-entity " " wl-folder-entity)
2508 (wl-folder-move-path id)
2510 (set-buffer-modified-p nil)))
2512 (defun wl-folder-open-close ()
2513 "Open or close parent entity."
2517 (if (wl-folder-buffer-group-p)
2518 ;; if group (whether opend or closed.)
2519 (wl-folder-jump-to-current-entity)
2522 (setq indent (save-excursion
2523 (re-search-forward "\\([ ]*\\)." nil t)
2524 (wl-match-buffer 1)))
2525 (while (looking-at indent)
2527 (wl-folder-jump-to-current-entity))))
2529 (defsubst wl-folder-access-subscribe-p (group folder)
2530 (let (subscr regexp match)
2531 (if (setq subscr (wl-get-assoc-list-value
2532 wl-folder-access-subscribe-alist
2535 (setq regexp (mapconcat 'identity (cdr subscr) "\\|"))
2536 (setq match (string-match regexp folder))
2542 (defun wl-folder-update-access-group (entity new-flist)
2543 (let* ((flist (nth 2 entity))
2544 (unsubscribes (nth 3 entity))
2545 (len (+ (length flist) (length unsubscribes)))
2547 diff new-unsubscribes removes
2548 subscribed-list folder group entry)
2549 ;; check subscribed groups
2552 ((listp (car flist)) ;; group
2553 (setq group (elmo-string (caar flist)))
2555 ((assoc group new-flist) ;; found in new-flist
2556 (setq new-flist (delete (assoc group new-flist)
2558 (if (wl-folder-access-subscribe-p (car entity) group)
2559 (wl-append subscribed-list (list (car flist)))
2560 (wl-append new-unsubscribes (list (car flist)))
2563 (setq wl-folder-group-alist
2564 (delete (wl-string-assoc group wl-folder-group-alist)
2565 wl-folder-group-alist))
2566 (wl-append removes (list (list group))))))
2568 (setq folder (elmo-string (car flist)))
2570 ((member folder new-flist) ;; found in new-flist
2571 (setq new-flist (delete folder new-flist))
2572 (if (wl-folder-access-subscribe-p (car entity) folder)
2573 (wl-append subscribed-list (list (car flist)))
2574 (wl-append new-unsubscribes (list folder))
2577 (wl-append removes (list folder))))))
2578 (when (> len elmo-display-progress-threshold)
2580 (if (or (zerop (% i 10)) (= i len))
2581 (elmo-display-progress
2582 'wl-folder-update-access-group "Updating access group..."
2583 (/ (* i 100) len))))
2584 (setq flist (cdr flist)))
2585 ;; check unsubscribed groups
2588 ((listp (car unsubscribes))
2589 (when (setq entry (assoc (caar unsubscribes) new-flist))
2590 (setq new-flist (delete entry new-flist))
2591 (wl-append new-unsubscribes (list (car unsubscribes)))))
2593 (when (member (car unsubscribes) new-flist)
2594 (setq new-flist (delete (car unsubscribes) new-flist))
2595 (wl-append new-unsubscribes (list (car unsubscribes))))))
2596 (when (> len elmo-display-progress-threshold)
2598 (if (or (zerop (% i 10)) (= i len))
2599 (elmo-display-progress
2600 'wl-folder-update-access-group "Updating access group..."
2601 (/ (* i 100) len))))
2602 (setq unsubscribes (cdr unsubscribes)))
2604 (if (or new-flist removes)
2607 (mapcar '(lambda (x)
2608 (cond ((consp x) (list (car x) 'access))
2612 (let ((new-list new-flist))
2614 (if (not (wl-folder-access-subscribe-p
2616 (if (listp (car new-list))
2621 (wl-append new-unsubscribes (list (car new-list)))
2622 (setq new-flist (delete (car new-list) new-flist)))
2624 ((listp (car new-list))
2625 ;; check group exists
2626 (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
2628 (message "%s: group already exists." (caar new-list))
2630 (wl-append new-unsubscribes (list (car new-list)))
2631 (setq new-flist (delete (car new-list) new-flist)))
2632 (wl-append wl-folder-group-alist
2633 (list (cons (caar new-list) nil)))))))
2634 (setq new-list (cdr new-list))))
2636 (message "%d new folder(s)." (length new-flist))
2637 (message "Updating access group...done"))
2638 (wl-append new-flist subscribed-list) ;; new is first
2639 (run-hooks 'wl-folder-update-access-group-hook)
2640 (setcdr (cdr entity) (list new-flist new-unsubscribes))
2641 (list diff new-flist new-unsubscribes removes)))
2643 (defun wl-folder-prefetch-entity (entity)
2644 "Prefetch all new messages in the ENTITY."
2647 (let ((flist (nth 2 entity))
2652 (setq result (wl-folder-prefetch-entity (car flist)))
2653 (setq sum-done (+ sum-done (car result)))
2654 (setq sum-all (+ sum-all (cdr result)))
2655 (setq flist (cdr flist)))
2656 (message "Prefetched %d/%d message(s) in \"%s\"."
2658 (wl-folder-get-petname (car entity)))
2659 (cons sum-done sum-all)))
2661 (let* ((folder (wl-folder-get-elmo-folder entity))
2662 (nums (wl-folder-get-entity-info entity))
2663 (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
2664 (wl-summary-always-sticky-folder-p
2666 wl-summary-highlight))
2667 wl-summary-exit-next-move
2668 wl-auto-select-first ret-val
2670 (setq count (or (car nums) 0))
2671 (setq count (+ count (wl-folder-count-incorporates folder)))
2672 (if (or (null (car nums)) ; unknown
2674 (save-window-excursion
2676 (let ((wl-summary-buffer-name (concat
2677 wl-summary-buffer-name
2678 (symbol-name this-command)))
2679 (wl-summary-use-frame nil)
2680 (wl-summary-always-sticky-folder-list nil))
2681 (wl-summary-goto-folder-subr entity
2682 (wl-summary-get-sync-range
2685 (setq ret-val (wl-summary-incorporate))
2690 (defun wl-folder-count-incorporates (folder)
2691 (let ((marks (elmo-msgdb-mark-load
2692 (elmo-folder-msgdb-path folder)))
2695 (if (member (cadr (car marks))
2696 wl-summary-incorporate-marks)
2698 (setq marks (cdr marks)))
2701 (defun wl-folder-prefetch-current-entity (&optional no-check)
2702 "Prefetch all uncached messages in the folder at position.
2703 If current line is group folder, all subfolders are prefetched."
2706 (let ((entity-name (wl-folder-get-entity-from-buffer))
2707 (group (wl-folder-buffer-group-p))
2708 wl-folder-check-entity-hook
2713 (wl-folder-search-group-entity-by-name entity-name
2717 (wl-folder-check-entity entity))
2718 (wl-folder-prefetch-entity entity)))))
2720 ;(defun wl-folder-drop-unsync-entity (entity)
2721 ; "Drop all unsync messages in the ENTITY."
2724 ; (let ((flist (nth 2 entity)))
2726 ; (wl-folder-drop-unsync-entity (car flist))
2727 ; (setq flist (cdr flist)))))
2729 ; (let ((nums (wl-folder-get-entity-info entity))
2730 ; wl-summary-highlight wl-auto-select-first new)
2731 ; (setq new (or (car nums) 0))
2733 ; (save-window-excursion
2735 ; (let ((wl-summary-buffer-name (concat
2736 ; wl-summary-buffer-name
2737 ; (symbol-name this-command))))
2738 ; (wl-summary-goto-folder-subr entity 'no-sync nil)
2739 ; (wl-summary-drop-unsync)
2740 ; (wl-summary-exit)))))))))
2742 ;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
2743 ; "Drop all unsync messages in the folder at position.
2744 ;If current line is group folder, all subfolders are dropped.
2745 ;If optional arg exists, don't check any folders."
2748 ; (let ((entity-name (wl-folder-get-entity-from-buffer))
2749 ; (group (wl-folder-buffer-group-p))
2750 ; wl-folder-check-entity-hook
2751 ; summary-buf entity)
2752 ; (when (and entity-name
2754 ; "Drop all unsync messages in %s? " entity-name)))
2757 ; (wl-folder-search-group-entity-by-name entity-name
2760 ; (if (null force-check)
2761 ; (wl-folder-check-entity entity))
2762 ; (wl-folder-drop-unsync-entity entity)
2763 ; (message "All unsync messages in %s are dropped!" entity-name)))))
2765 (defun wl-folder-write-current-folder ()
2766 "Write message to current folder's newsgroup or mailing-list.
2767 Call `wl-summary-write-current-folder' with current folder name."
2769 (unless (wl-folder-buffer-group-p)
2770 (wl-summary-write-current-folder
2771 (wl-folder-get-realname (wl-folder-entity-name)))))
2773 (defun wl-folder-mimic-kill-buffer ()
2774 "Kill the current (Folder) buffer with query."
2776 (let ((bufname (read-buffer (format "Kill buffer: (default %s) "
2778 wl-interactive-exit)
2779 (if (or (not bufname)
2780 (string-equal bufname "")
2781 (string-equal bufname (buffer-name)))
2783 (kill-buffer bufname))))
2785 (defun wl-folder-create-subr (folder)
2786 (if (y-or-n-p (format "Folder %s does not exist, create it? "
2787 (elmo-folder-name-internal folder)))
2790 (setq wl-folder-entity-hashtb
2791 (wl-folder-create-entity-hashtb
2792 (elmo-folder-name-internal folder)
2793 wl-folder-entity-hashtb))
2794 (unless (elmo-folder-create folder)
2795 (error "Create folder failed")))
2796 (error "Folder %s is not created" (elmo-folder-name-internal folder))))
2798 (defun wl-folder-confirm-existence (folder &optional force)
2800 (unless (elmo-folder-exists-p folder)
2801 (wl-folder-create-subr folder))
2802 (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder))
2803 (file-exists-p (elmo-folder-msgdb-path folder))
2804 (elmo-folder-exists-p folder))
2805 (wl-folder-create-subr folder))))
2807 (defun wl-folder-virtual ()
2808 "Goto virtual folder."
2810 (let ((entity (wl-folder-get-entity-from-buffer)))
2811 (if (wl-folder-buffer-group-p)
2815 (mapconcat 'identity
2816 (wl-folder-get-entity-list
2817 (wl-folder-search-group-entity-by-name
2819 wl-folder-entity)) ","))))
2820 (unless entity (error "No folder"))
2821 (wl-folder-goto-folder-subr
2823 (elmo-read-search-condition
2824 wl-fldmgr-make-filter-default)
2827 (defun wl-folder-pick ()
2830 (let* ((condition (car (elmo-parse-search-condition
2831 (elmo-read-search-condition
2832 wl-summary-pick-field-default))))
2833 (entity (wl-folder-get-entity-from-buffer))
2835 (if (wl-folder-buffer-group-p)
2836 (wl-folder-get-entity-list
2837 (wl-folder-search-group-entity-by-name
2842 (while (car folder-list)
2843 (setq ret (elmo-folder-search
2844 (wl-folder-get-elmo-folder (car folder-list))
2849 (list (cons (car folder-list) ret)))))
2850 (setq folder-list (cdr folder-list)))
2852 (message "%s are picked."
2853 (mapconcat '(lambda (res)
2856 (length (cdr res))))
2859 (message "No message was picked.")))))
2862 (product-provide (provide 'wl-folder) (require 'wl-version))
2864 ;;; wl-folder.el ends here