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]
93 ["Mark as Read all Current Folder" wl-folder-mark-as-read-all-current-entity t]
94 ["Expire Current Folder" wl-folder-expire-current-entity t]
96 ["Go to Draft Folder" wl-folder-goto-draft-folder t]
97 ["Empty trash" wl-folder-empty-trash t]
98 ["Flush queue" wl-folder-flush-queue t]
100 ["Open All" wl-folder-open-all t]
101 ["Open All Unread folder" wl-folder-open-all-unread-folder t]
102 ["Close All" wl-folder-close-all t]
104 ["Add folder" wl-fldmgr-add t]
105 ["Add group" wl-fldmgr-make-group t]
106 ["Copy" wl-fldmgr-copy t]
107 ["Cut" wl-fldmgr-cut t]
108 ["Paste" wl-fldmgr-yank t]
109 ["Set petname" wl-fldmgr-set-petname t]
110 ["Rename" wl-fldmgr-rename t]
111 ["Save" wl-fldmgr-save-folders t]
113 ["Unsubscribe" wl-fldmgr-unsubscribe t]
114 ["Display all" wl-fldmgr-access-display-all t])
116 ["Write a message" wl-draft t]
117 ["Write for current folder" wl-folder-write-current-folder t]
119 ["Wanderlust NEWS" wl-news t]
121 ["Toggle Plug Status" wl-toggle-plugged t]
122 ["Change Plug Status" wl-plugged-change t]
124 ["Save Current Status" wl-save t]
125 ["Update Status" wl-status-update t]
130 (defun wl-folder-setup-mouse ()
131 (define-key wl-folder-mode-map 'button2 'wl-folder-click)
132 (define-key wl-folder-mode-map 'button4 'wl-folder-prev-entity)
133 (define-key wl-folder-mode-map 'button5 'wl-folder-next-entity)
134 (define-key wl-folder-mode-map [(shift button4)]
135 'wl-folder-prev-unread)
136 (define-key wl-folder-mode-map [(shift button5)]
137 'wl-folder-next-unread))
138 (defun wl-folder-setup-mouse ()
139 (define-key wl-folder-mode-map [mouse-2] 'wl-folder-click)
140 (define-key wl-folder-mode-map [mouse-4] 'wl-folder-prev-entity)
141 (define-key wl-folder-mode-map [mouse-5] 'wl-folder-next-entity)
142 (define-key wl-folder-mode-map [S-mouse-4] 'wl-folder-prev-unread)
143 (define-key wl-folder-mode-map [S-mouse-5] 'wl-folder-next-unread)))
145 (if wl-folder-mode-map
147 (setq wl-folder-mode-map (make-sparse-keymap))
148 (define-key wl-folder-mode-map " " 'wl-folder-jump-to-current-entity)
149 ; (define-key wl-folder-mode-map "\M- " 'wl-folder-open-close)
150 (define-key wl-folder-mode-map "/" 'wl-folder-open-close)
151 (define-key wl-folder-mode-map "\C-m" 'wl-folder-jump-to-current-entity)
152 (define-key wl-folder-mode-map [(shift return)] 'wl-folder-jump-to-current-entity-with-arg)
153 (define-key wl-folder-mode-map "\M-\C-m" 'wl-folder-update-recursive-current-entity)
154 (define-key wl-folder-mode-map "rc" 'wl-folder-mark-as-read-all-region)
155 (define-key wl-folder-mode-map "c" 'wl-folder-mark-as-read-all-current-entity)
156 (define-key wl-folder-mode-map "g" 'wl-folder-goto-folder)
157 (define-key wl-folder-mode-map "G" 'wl-folder-goto-folder-sticky)
158 (define-key wl-folder-mode-map "j" 'wl-folder-jump-to-current-entity)
159 (define-key wl-folder-mode-map "w" 'wl-draft)
160 (define-key wl-folder-mode-map "W" 'wl-folder-write-current-folder)
161 (define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
162 (define-key wl-folder-mode-map "\C-c\C-a" 'wl-addrmgr)
163 (define-key wl-folder-mode-map "\C-c\C-p" 'wl-folder-jump-to-previous-summary)
164 (define-key wl-folder-mode-map "\C-c\C-n" 'wl-folder-jump-to-next-summary)
165 (define-key wl-folder-mode-map "rS" 'wl-folder-sync-region)
166 (define-key wl-folder-mode-map "S" 'wl-folder-sync-current-entity)
167 (define-key wl-folder-mode-map "rs" 'wl-folder-check-region)
168 (define-key wl-folder-mode-map "s" 'wl-folder-check-current-entity)
169 (define-key wl-folder-mode-map "I" 'wl-folder-prefetch-current-entity)
170 ; (define-key wl-folder-mode-map "D" 'wl-folder-drop-unsync-current-entity)
171 (define-key wl-folder-mode-map "p" 'wl-folder-prev-entity)
172 (define-key wl-folder-mode-map "n" 'wl-folder-next-entity)
173 (define-key wl-folder-mode-map "v" 'wl-folder-toggle-disp-summary)
174 (define-key wl-folder-mode-map "P" 'wl-folder-prev-unread)
175 (define-key wl-folder-mode-map "N" 'wl-folder-next-unread)
176 (define-key wl-folder-mode-map "J" 'wl-folder-jump-folder)
177 (define-key wl-folder-mode-map "f" 'wl-folder-goto-first-unread-folder)
178 (define-key wl-folder-mode-map "o" 'wl-folder-open-all-unread-folder)
179 (define-key wl-folder-mode-map "[" 'wl-folder-open-all)
180 (define-key wl-folder-mode-map "]" 'wl-folder-close-all)
181 (define-key wl-folder-mode-map "e" 'wl-folder-expire-current-entity)
182 (define-key wl-folder-mode-map "E" 'wl-folder-empty-trash)
183 (define-key wl-folder-mode-map "F" 'wl-folder-flush-queue)
184 (define-key wl-folder-mode-map "V" 'wl-folder-virtual)
185 (define-key wl-folder-mode-map "?" 'wl-folder-pick)
186 (define-key wl-folder-mode-map "q" 'wl-exit)
187 (define-key wl-folder-mode-map "z" 'wl-folder-suspend)
188 (define-key wl-folder-mode-map "\M-t" 'wl-toggle-plugged)
189 (define-key wl-folder-mode-map "\C-t" 'wl-plugged-change)
190 (define-key wl-folder-mode-map "<" 'beginning-of-buffer)
191 (define-key wl-folder-mode-map ">" 'end-of-buffer)
193 (define-key wl-folder-mode-map "m" 'wl-fldmgr-mode-map)
194 (define-key wl-folder-mode-map "*" 'wl-fldmgr-make-multi)
195 (define-key wl-folder-mode-map "+" 'wl-fldmgr-make-group)
196 (define-key wl-folder-mode-map "|" 'wl-fldmgr-make-filter)
197 (define-key wl-folder-mode-map "\M-c" 'wl-fldmgr-copy)
198 (define-key wl-folder-mode-map "\M-w" 'wl-fldmgr-copy-region)
199 (define-key wl-folder-mode-map "\C-k" 'wl-fldmgr-cut)
200 (define-key wl-folder-mode-map "\C-w" 'wl-fldmgr-cut-region)
201 (define-key wl-folder-mode-map "\C-y" 'wl-fldmgr-yank)
202 (define-key wl-folder-mode-map "R" 'wl-fldmgr-rename)
203 (define-key wl-folder-mode-map "u" 'wl-fldmgr-unsubscribe)
204 (define-key wl-folder-mode-map "ru" 'wl-fldmgr-unsubscribe-region)
205 (define-key wl-folder-mode-map "U" 'wl-fldmgr-unsubscribe-region)
206 (define-key wl-folder-mode-map "l" 'wl-fldmgr-access-display-normal)
207 (define-key wl-folder-mode-map "L" 'wl-fldmgr-access-display-all)
208 (define-key wl-folder-mode-map "Z" 'wl-status-update)
209 (define-key wl-folder-mode-map "\C-x\C-s" 'wl-save)
210 (define-key wl-folder-mode-map "\M-s" 'wl-save)
211 (define-key wl-folder-mode-map "\C-xk" 'wl-folder-mimic-kill-buffer)
212 (define-key wl-folder-mode-map "\M-\C-a"
213 'wl-folder-goto-top-of-current-folder)
214 (define-key wl-folder-mode-map "\M-\C-e"
215 'wl-folder-goto-bottom-of-current-folder)
217 (wl-folder-setup-mouse)
221 "Menu used in Folder mode."
222 wl-folder-mode-menu-spec))
224 (defmacro wl-folder-unread-regex (group)
225 (` (concat "^[ ]*.+:[0-9\\*-]+/[^0\\*][0-9]*/[0-9\\*-]+$"
230 (defmacro wl-folder-buffer-group-p ()
231 (` (save-excursion (beginning-of-line)
232 (looking-at wl-folder-group-regexp))))
234 (defmacro wl-folder-folder-name ()
237 (if (or (looking-at "^[ ]*\\[[\\+-]\\]\\(.+\\):[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+\n")
238 (looking-at "^[ ]*\\([^\\[].+\\):.*\n"))
239 (wl-match-buffer 1)))))
241 (defmacro wl-folder-entity-name ()
244 (if (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
245 (wl-match-buffer 1)))))
247 (defun wl-folder-buffer-search-group (group)
250 "^\\([ \t]*\\)\\[[\\+-]\\]"
251 (regexp-quote group) ":[-0-9-]+/[0-9-]+/[0-9-]+") nil t))
253 (defun wl-folder-buffer-search-entity (folder &optional searchname)
254 (let ((search (or searchname (wl-folder-get-petname folder)))
259 (regexp-quote search) ":[-0-9\\*-]+/[0-9\\*-]+/[0-9\\*-]+") nil t)))
261 (defsubst wl-folder-get-folder-name-by-id (entity-id &optional hashtb)
262 (and (numberp entity-id)
263 (elmo-get-hash-val (format "#%d" entity-id)
264 (or hashtb wl-folder-entity-id-name-hashtb))))
266 (defsubst wl-folder-set-id-name (entity-id entity &optional hashtb)
267 (and (numberp entity-id)
268 (elmo-set-hash-val (format "#%d" entity-id)
269 entity (or hashtb wl-folder-entity-id-name-hashtb))))
271 (defmacro wl-folder-get-entity-id (entity)
272 `(get-text-property 0 'wl-folder-entity-id ,entity))
274 (defmacro wl-folder-get-entity-from-buffer (&optional getid)
275 `(let ((id (get-text-property (point)
276 'wl-folder-entity-id)))
279 (wl-folder-get-folder-name-by-id id))))
281 (defmacro wl-folder-entity-exists-p (entity &optional hashtb)
282 (` (let ((sym (intern-soft (, entity)
283 (or (, hashtb) wl-folder-entity-hashtb))))
284 (and sym (boundp sym)))))
286 (defmacro wl-folder-clear-entity-info (entity &optional hashtb)
287 (` (let ((sym (intern-soft (, entity)
288 (or (, hashtb) wl-folder-entity-hashtb))))
292 (defmacro wl-folder-get-entity-info (entity &optional hashtb)
293 (` (elmo-get-hash-val (, entity) (or (, hashtb) wl-folder-entity-hashtb))))
295 (defmacro wl-folder-set-entity-info (entity value &optional hashtb)
296 (` (let* ((hashtb (or (, hashtb) wl-folder-entity-hashtb))
297 (info (wl-folder-get-entity-info (, entity) hashtb)))
298 (elmo-set-hash-val (elmo-string (, entity))
299 (if (< (length (, value)) 4)
300 (append (, value) (list (nth 3 info)))
304 (defun wl-folder-persistent-p (folder)
305 (or (and (wl-folder-search-entity-by-name folder wl-folder-entity
309 (let ((li wl-save-folder-list))
311 (if (string-match (car li) folder)
313 (setq li (cdr li)))))
315 (let ((li wl-no-save-folder-list))
317 (if (string-match (car li) folder)
319 (setq li (cdr li))))))))
321 ;;; ELMO folder structure with cache.
322 (defmacro wl-folder-elmo-folder-cache-get (name &optional hashtb)
323 "Returns a elmo folder structure associated with NAME from HASHTB.
324 Default HASHTB is `wl-folder-elmo-folder-hashtb'."
325 (` (elmo-get-hash-val (, name)
326 (or (, hashtb) wl-folder-elmo-folder-hashtb))))
328 (defmacro wl-folder-elmo-folder-cache-put (name folder &optional hashtb)
329 "Get folder elmo folder structure on HASHTB for folder with NAME.
330 Default HASHTB is `wl-folder-elmo-folder-hashtb'."
331 (` (elmo-set-hash-val (, name) (, folder)
332 (or (, hashtb) wl-folder-elmo-folder-hashtb))))
334 (defmacro wl-folder-get-elmo-folder (entity &optional no-cache)
335 "Get elmo folder structure from entity."
337 (elmo-make-folder (elmo-string (, entity)))
338 (or (wl-folder-elmo-folder-cache-get (, entity))
339 (let* ((name (elmo-string (, entity)))
340 (folder (elmo-make-folder name)))
341 (wl-folder-elmo-folder-cache-put name folder)
344 (defun wl-folder-prev-entity ()
348 (defun wl-folder-next-entity ()
352 (defun wl-folder-prev-entity-skip-invalid (&optional hereto)
353 "move to previous entity. skip unsubscribed or removed entity."
357 (if (re-search-backward wl-folder-entity-regexp nil t)
359 (goto-char (point-min))))
361 (defun wl-folder-next-entity-skip-invalid (&optional hereto)
362 "Move to next entity. skip unsubscribed or removed entity."
367 (if (re-search-forward wl-folder-entity-regexp nil t)
369 (goto-char (point-max))))
371 (defun wl-folder-search-group-entity-by-name (name entity)
372 (wl-folder-search-entity-by-name name entity 'group))
374 (defun wl-folder-search-entity-by-name (name entity &optional type)
375 (let ((entities (list entity))
379 (setq entity (wl-pop entities))
382 (if (and (not (eq type 'folder))
383 (string= name (car entity)))
384 (throw 'done entity))
386 (wl-push entities entity-stack))
387 (setq entities (nth 2 entity)))
388 ((and (not (eq type 'group))
390 (if (string= name entity)
391 (throw 'done entity))))
393 (setq entities (wl-pop entity-stack)))))))
395 (defun wl-folder-search-entity-list-by-name (name entity &optional get-id)
396 (let ((entities (list entity))
397 entity-stack ret-val)
399 (setq entity (wl-pop entities))
403 (wl-push entities entity-stack))
404 (setq entities (nth 2 entity)))
406 (if (string= name entity)
407 (wl-append ret-val (if get-id
408 (list (wl-folder-get-entity-id entity))
411 (setq entities (wl-pop entity-stack))))
414 (defun wl-folder-get-prev-folder (id &optional unread)
415 (let ((name (if (stringp id)
417 (wl-folder-get-folder-name-by-id id)))
418 entity entity-stack last-entity finfo
419 (entities (list wl-folder-entity)))
422 (setq entity (wl-pop entities))
425 ;; (if (and (string= name (car entity))
426 ;; (eq id (wl-folder-get-entity-id (car entity))))
427 ;; (throw 'done last-entity))
429 (wl-push entities entity-stack))
430 (setq entities (nth 2 entity)))
432 (if (and (string= name entity)
433 (eq id (wl-folder-get-entity-id entity)))
434 (throw 'done last-entity))
436 (and (setq finfo (wl-folder-get-entity-info entity))
437 (and (nth 0 finfo)(nth 1 finfo))
438 (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
439 (setq last-entity entity))))
441 (setq entities (wl-pop entity-stack)))))))
443 (defun wl-folder-get-next-folder (id &optional unread)
444 (let ((name (if (stringp id)
446 (wl-folder-get-folder-name-by-id id)))
447 entity entity-stack found finfo
448 (entities (list wl-folder-entity)))
451 (setq entity (wl-pop entities))
454 ;;; (if (and (string= name (car entity))
455 ;;; (eq id (wl-folder-get-entity-id (car entity))))
458 (wl-push entities entity-stack))
459 (setq entities (nth 2 entity)))
462 (when (or (not unread)
463 (and (setq finfo (wl-folder-get-entity-info entity))
464 (and (nth 0 finfo)(nth 1 finfo))
465 (> (+ (nth 0 finfo)(nth 1 finfo)) 0)))
466 (throw 'done entity))
467 (if (and (string= name entity)
468 (eq id (wl-folder-get-entity-id entity)))
471 (setq entities (wl-pop entity-stack)))))))
473 (defun wl-folder-flush-queue ()
476 (let ((cur-buf (current-buffer))
477 (wl-auto-select-first nil)
480 (if elmo-enable-disconnected-operation
481 (elmo-dop-queue-flush))
482 (if (not (elmo-folder-list-messages
483 (wl-folder-get-elmo-folder wl-queue-folder)))
484 (message "No sending queue exists.")
485 (if wl-stay-folder-window
486 (wl-folder-select-buffer
487 (wl-summary-get-buffer-create wl-queue-folder)))
488 (wl-summary-goto-folder-subr wl-queue-folder 'force-update nil)
490 (wl-draft-queue-flush)
491 (if (get-buffer-window cur-buf)
492 (select-window (get-buffer-window cur-buf)))
494 (if wl-stay-folder-window
495 (wl-folder-toggle-disp-summary 'off wl-queue-folder)
496 (switch-to-buffer cur-buf))))))
498 (defun wl-folder-empty-trash ()
501 (let ((cur-buf (current-buffer))
502 (wl-auto-select-first nil)
504 (setq trash-buf (wl-summary-get-buffer-create wl-trash-folder))
505 (wl-summary-goto-folder-subr wl-trash-folder 'force-update)
506 (if wl-stay-folder-window
507 (wl-folder-select-buffer trash-buf)
508 (switch-to-buffer trash-buf))
510 (setq emptied (wl-summary-delete-all-msgs))
512 (setq wl-thread-entities nil
513 wl-thread-entity-list nil)
514 (if wl-summary-cache-use (wl-summary-save-view-cache))
515 (elmo-folder-commit wl-summary-buffer-elmo-folder))
516 (if (get-buffer-window cur-buf)
517 (select-window (get-buffer-window cur-buf)))
520 (wl-folder-set-folder-updated wl-trash-folder '(0 0 0)))
521 (if wl-stay-folder-window
522 (wl-folder-toggle-disp-summary 'off wl-trash-folder)
523 (switch-to-buffer cur-buf))
525 (kill-buffer trash-buf)))))
527 (defun wl-folder-goto-top-of-current-folder (&optional arg)
528 "Move backward to the top of the current folder group.
529 Optional argument ARG is repeart count."
531 (if (re-search-backward
532 "^ *\\[[\\+-]\\]" nil t (if arg (prefix-numeric-value arg)))
534 (goto-char (point-min))))
536 (defun wl-folder-goto-bottom-of-current-folder (indent)
537 "Move forward to the bottom of the current folder group."
542 (if (looking-at "^ *")
543 (buffer-substring (match-beginning 0)(1- (match-end 0)))
547 (while (re-search-forward "^ *" nil t)
548 (if (<= (length (match-string 0))
552 (goto-char (point-max))))
554 (defsubst wl-folder-update-group (entity diffs &optional is-group)
556 (let ((path (wl-folder-get-path
558 (wl-folder-get-entity-id entity)
561 ;; delete itself from path
562 (setq path (delete (nth (- (length path) 1) path) path)))
563 (goto-char (point-min))
566 ;; goto the path line.
567 (if (or (eq (car path) 0) ; update desktop
568 (wl-folder-buffer-search-group
569 (wl-folder-get-petname
570 (if (stringp (car path))
572 (wl-folder-get-folder-name-by-id
575 (wl-folder-update-diff-line diffs)
577 (setq path (cdr path)))))))
579 (defun wl-folder-maybe-load-folder-list (entity)
580 (when (null (caddr entity))
582 (elmo-msgdb-flist-load (car entity)))
586 (wl-folder-entity-assign-id entity
587 wl-folder-entity-id-name-hashtb
589 (setq diffs (wl-fldmgr-add-entity-hashtb (list entity)))
590 (unless (equal diffs '(0 0 0))
591 (wl-folder-update-group (car entity) diffs t)))))))
593 (defsubst wl-folder-force-fetch-p (entity)
595 ((consp wl-force-fetch-folders)
596 (wl-string-match-member entity wl-force-fetch-folders))
598 wl-force-fetch-folders)))
600 (defun wl-folder-jump-to-current-entity-with-arg ()
602 (wl-folder-jump-to-current-entity t))
604 (defun wl-folder-jump-to-current-entity (&optional arg)
605 "Enter the current folder. If optional ARG exists, update folder list."
608 (let (entity beg end indent opened fname err fld-name)
610 ((looking-at wl-folder-group-regexp)
612 (setq fname (wl-folder-get-realname (wl-match-buffer 3)))
613 (setq indent (wl-match-buffer 1))
614 (setq opened (wl-match-buffer 2))
615 (if (string= opened "+")
617 (setq entity (wl-folder-search-group-entity-by-name
622 (wl-folder-update-recursive-current-entity entity)
624 (setcdr (assoc (car entity) wl-folder-group-alist) t)
625 (if (eq 'access (cadr entity))
626 (wl-folder-maybe-load-folder-list entity))
627 ;(condition-case errobj
629 (if (or (wl-folder-force-fetch-p (car entity))
631 (eq 'access (cadr entity))
632 (null (caddr entity))))
633 (wl-folder-update-newest indent entity)
634 (wl-folder-insert-entity indent entity))
635 (wl-highlight-folder-path wl-folder-buffer-cur-path))
638 ; (setcdr (assoc fname wl-folder-group-alist) nil))
640 ; (elmo-display-error errobj t)
643 ; (setcdr (assoc fname wl-folder-group-alist) nil)))
645 (let ((buffer-read-only nil))
646 (delete-region (save-excursion (beginning-of-line)
648 (save-excursion (end-of-line)
654 (progn (wl-folder-goto-bottom-of-current-folder indent)
657 (setq entity (wl-folder-search-group-entity-by-name
660 (let ((buffer-read-only nil))
661 (delete-region beg end))
662 (setcdr (assoc (car entity) wl-folder-group-alist) nil)
663 (wl-folder-insert-entity indent entity) ; insert entity
665 (wl-highlight-folder-path wl-folder-buffer-cur-path)
666 ; (wl-delete-all-overlays)
667 ; (wl-highlight-folder-current-line)
669 ((setq fld-name (wl-folder-entity-name))
670 (wl-folder-set-current-entity-id
671 (get-text-property (point) 'wl-folder-entity-id))
672 (setq fld-name (wl-folder-get-folder-name-by-id
673 wl-folder-buffer-cur-entity-id))
674 (let ((summary-buf (wl-summary-get-buffer-create fld-name arg))
676 (if (or wl-stay-folder-window wl-summary-use-frame)
677 (wl-folder-select-buffer summary-buf)
679 (get-buffer-window summary-buf))
681 (wl-summary-goto-folder-subr fld-name
682 (wl-summary-get-sync-range
683 (wl-folder-get-elmo-folder fld-name))
685 (set-buffer-modified-p nil))
687 (defun wl-folder-close-entity (entity)
688 (let ((entities (list entity))
691 (setq entity (wl-pop entities))
694 (setcdr (assoc (car entity) wl-folder-group-alist) nil)
696 (wl-push entities entity-stack))
697 (setq entities (nth 2 entity))))
699 (setq entities (wl-pop entity-stack))))))
701 (defun wl-folder-update-recursive-current-entity (&optional entity)
703 (when (wl-folder-buffer-group-p)
705 ((string= (wl-match-buffer 2) "+")
709 (wl-folder-search-group-entity-by-name
710 (wl-folder-get-realname (wl-match-buffer 3))
712 (let ((inhibit-read-only t)
713 (entities (list entity))
714 entity-stack err indent)
715 (while (and entities (not err))
716 (setq entity (wl-pop entities))
719 (wl-folder-close-entity entity)
720 (setcdr (assoc (car entity) wl-folder-group-alist) t)
721 (unless (wl-folder-buffer-search-group
722 (wl-folder-get-petname (car entity)))
723 (error "%s: not found group" (car entity)))
724 (setq indent (wl-match-buffer 1))
725 (if (eq 'access (cadr entity))
726 (wl-folder-maybe-load-folder-list entity))
730 (condition-case errobj
731 (wl-folder-update-newest indent entity)
734 (setcdr (assoc (car entity) wl-folder-group-alist) nil))
736 (elmo-display-error errobj t)
739 (setcdr (assoc (car entity) wl-folder-group-alist) nil)))
741 (delete-region (save-excursion (beginning-of-line)
743 (save-excursion (end-of-line)
747 (wl-push entities entity-stack))
748 (setq entities (nth 2 entity))))
750 (setq entities (wl-pop entity-stack)))))
751 (set-buffer-modified-p nil)))
753 (wl-folder-jump-to-current-entity)))))
755 (defun wl-folder-no-auto-check-folder-p (folder)
758 (let ((li wl-auto-check-folder-list))
760 (if (string-match (car li) folder)
762 (setq li (cdr li)))))
765 (let ((li wl-auto-uncheck-folder-list))
767 (if (string-match (car li) folder)
768 (throw 'found t)) ; no check!
769 (setq li (cdr li))))))))
771 (defsubst wl-folder-add-folder-info (pre-value value)
773 (+ (or (nth 0 pre-value) 0) (or (nth 0 value) 0))
774 (+ (or (nth 1 pre-value) 0) (or (nth 1 value) 0))
775 (+ (or (nth 2 pre-value) 0) (or (nth 2 value) 0))))
777 (defun wl-folder-check-entity (entity &optional auto)
778 "Check unsync message number."
779 (let ((start-pos (point))
781 (run-hooks 'wl-folder-check-entity-pre-hook)
782 (if (and (consp entity) ;; group entity
783 wl-folder-check-async) ;; very fast
784 (setq ret-val (wl-folder-check-entity-async entity auto))
788 (let ((flist (if auto
790 'wl-folder-no-auto-check-folder-p
793 (wl-folder-check-entity-pre-hook nil)
794 (wl-folder-check-entity-hook nil)
798 (wl-folder-add-folder-info
800 (wl-folder-check-entity (car flist))))
801 (setq flist (cdr flist)))
802 ;(wl-folder-buffer-search-entity (car entity))
803 ;(wl-folder-update-line ret-val)
806 (message "Checking \"%s\"" entity)
807 (setq ret-val (wl-folder-check-one-entity
809 (goto-char start-pos)
812 (message "Uncheck(unplugged) \"%s\"" entity)))))
814 (message "Checking \"%s\" is done."
815 (if (consp entity) (car entity) entity)))
816 (run-hooks 'wl-folder-check-entity-hook)
819 (defun wl-folder-check-one-entity (entity &optional biff)
820 (let* ((folder (wl-folder-get-elmo-folder entity biff))
821 (nums (condition-case err
823 (if biff (elmo-folder-set-biff-internal folder t))
824 (if (wl-string-match-member entity wl-strict-diff-folders)
825 (elmo-strict-folder-diff folder)
826 (elmo-folder-diff folder)))
828 ;; maybe not exist folder.
829 (if (and (not (memq 'elmo-open-error
830 (get (car err) 'error-conditions)))
831 (not (elmo-folder-exists-p folder)))
832 (wl-folder-create-subr folder)
833 (signal (car err) (cdr err))))))
834 (new (elmo-diff-new nums))
835 (unread (elmo-diff-unread nums))
836 (all (elmo-diff-all nums))
838 (if (and (eq wl-folder-notify-deleted 'sync)
839 (or (and new (> 0 new))
840 (and unread (> 0 unread))
841 (and all (> 0 all))))
843 (wl-folder-sync-entity entity)
844 (setq nums (elmo-folder-diff folder)
845 new (elmo-diff-new nums)
846 unread (elmo-diff-unread nums)
847 all (elmo-diff-all nums)))
848 (unless wl-folder-notify-deleted
849 (setq new (and new (max 0 new))
850 unread (and unread (max 0 unread))
851 all (and all (max 0 all))))
852 (setq unread (or (and unread (- unread (or new 0)))
853 (elmo-folder-get-info-unread folder)
854 (cdr (wl-summary-count-unread))))
855 (wl-folder-entity-hashtb-set wl-folder-entity-hashtb entity
856 (list new unread all)
857 (get-buffer wl-folder-buffer-name)))
858 (setq wl-folder-info-alist-modified t)
860 (list new unread all)))
862 (defun wl-folder-check-entity-async (entity &optional auto)
863 (let ((elmo-nntp-groups-async t)
866 'wl-folder-no-auto-check-folder-p
867 (wl-folder-get-entity-list entity))
868 (wl-folder-get-entity-list entity)))
869 (nntp-connection-keys nil)
870 name folder folder-list
876 (setq folder (wl-folder-get-elmo-folder (car elist)))
877 (if (not (elmo-folder-plugged-p folder))
878 (message "Uncheck \"%s\"" (car elist))
880 (elmo-folder-get-primitive-list folder))
881 (cond ((elmo-folder-contains-type folder 'nntp)
882 (wl-append async-folder-list (list folder))
884 (when (eq (elmo-folder-type-internal (car folder-list))
888 (elmo-net-folder-server-internal
890 (setq server (elmo-net-folder-server-internal
892 (message "Checking on \"%s\"" server))
893 (setq nntp-connection-keys
894 (elmo-nntp-get-folders-info-prepare
896 nntp-connection-keys)))
897 (setq folder-list (cdr folder-list))))
899 (wl-append sync-folder-list (list folder)))))
900 (setq elist (cdr elist)))
901 ;; check local entity at first
902 (while (setq folder (pop sync-folder-list))
903 (if (not (elmo-folder-plugged-p folder))
904 (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
905 (message "Checking \"%s\"" (elmo-folder-name-internal folder))
907 (wl-folder-add-folder-info
909 (wl-folder-check-one-entity (elmo-folder-name-internal
913 ;; check network entity at last
914 (when async-folder-list
915 (elmo-nntp-get-folders-info nntp-connection-keys)
916 (while (setq folder (pop async-folder-list))
917 (if (not (elmo-folder-plugged-p folder))
918 (message "Uncheck \"%s\"" (elmo-folder-name-internal folder))
919 (message "Checking \"%s\"" (elmo-folder-name-internal folder))
921 (wl-folder-add-folder-info
923 (wl-folder-check-one-entity (elmo-folder-name-internal
930 (defun wl-folder-resume-entity-hashtb-by-finfo (entity-hashtb info-alist)
931 "Resume unread info for entity alist."
934 (setq info (nth 1 (car info-alist)))
935 (wl-folder-set-entity-info (caar info-alist)
936 (list (nth 2 info)(nth 3 info)(nth 1 info))
938 (setq info-alist (cdr info-alist)))))
940 (defun wl-folder-move-path (path)
941 (let ((fp (if (consp path)
944 (wl-folder-get-path wl-folder-entity path))))
945 (goto-char (point-min))
948 (when (equal (car fp)
949 (wl-folder-get-entity-from-buffer t))
951 (setq wl-folder-buffer-cur-point (point)))
953 (and wl-folder-buffer-cur-point
954 (goto-char wl-folder-buffer-cur-point))))
956 (defun wl-folder-set-current-entity-id (entity-id)
957 (let* ((buf (get-buffer wl-folder-buffer-name))
958 (buf-win (get-buffer-window buf)))
961 (save-selected-window
963 (select-window buf-win)
965 (setq wl-folder-buffer-cur-entity-id entity-id)
966 (setq wl-folder-buffer-cur-path (wl-folder-get-path wl-folder-entity
968 (wl-highlight-folder-path wl-folder-buffer-cur-path)
969 (and wl-folder-move-cur-folder
970 wl-folder-buffer-cur-point
971 (goto-char wl-folder-buffer-cur-point)))))))
973 (defun wl-folder-check-current-entity ()
974 "Check folder at position.
975 If current line is group folder, check all sub entries."
977 (let* ((entity-name (wl-folder-get-entity-from-buffer))
978 (group (wl-folder-buffer-group-p))
979 (desktop (string= entity-name wl-folder-desktop-name)))
981 (wl-folder-check-entity
983 (wl-folder-search-group-entity-by-name entity-name
988 (defun wl-folder-sync-entity (entity &optional unread-only)
989 "Synchronize the msgdb of ENTITY."
992 (let ((flist (nth 2 entity)))
994 (wl-folder-sync-entity (car flist) unread-only)
995 (setq flist (cdr flist)))))
997 (let* ((folder (wl-folder-get-elmo-folder entity))
998 (nums (wl-folder-get-entity-info entity))
999 (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
1000 (wl-summary-always-sticky-folder-p
1002 wl-summary-highlight))
1003 wl-auto-select-first new unread sticky)
1004 (setq new (or (car nums) 0))
1005 (setq unread (or (cadr nums) 0))
1006 (if (or (not unread-only)
1007 (or (< 0 new) (< 0 unread)))
1008 (let ((wl-summary-buffer-name
1009 (if (setq sticky (get-buffer (wl-summary-sticky-buffer-name
1010 (elmo-folder-name-internal
1012 ;; Sticky folder exists.
1013 (wl-summary-sticky-buffer-name
1014 (elmo-folder-name-internal folder))
1016 wl-summary-buffer-name
1017 (symbol-name this-command))))
1018 (wl-summary-use-frame nil)
1019 (wl-summary-always-sticky-folder-list nil))
1020 (save-window-excursion
1022 (wl-summary-goto-folder-subr entity
1023 (wl-summary-get-sync-range
1027 (wl-summary-save-status)
1028 (wl-summary-exit))))))))))
1030 (defun wl-folder-sync-current-entity (&optional unread-only)
1031 "Synchronize the folder at position.
1032 If current line is group folder, check all subfolders."
1035 (let ((entity-name (wl-folder-get-entity-from-buffer))
1036 (group (wl-folder-buffer-group-p)))
1037 (when (and entity-name
1038 (y-or-n-p (format "Sync %s? " entity-name)))
1039 (wl-folder-sync-entity
1041 (wl-folder-search-group-entity-by-name entity-name
1045 (message "Syncing %s is done!" entity-name)))))
1047 (defun wl-folder-mark-as-read-all-entity (entity)
1048 "Mark as read all messages in the ENTITY."
1051 (let ((flist (nth 2 entity)))
1053 (wl-folder-mark-as-read-all-entity (car flist))
1054 (setq flist (cdr flist)))))
1056 (let* ((nums (wl-folder-get-entity-info entity))
1057 (folder (wl-folder-get-elmo-folder entity))
1058 (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
1059 (wl-summary-always-sticky-folder-p
1061 wl-summary-highlight))
1062 wl-auto-select-first new unread sticky)
1063 (setq new (or (car nums) 0))
1064 (setq unread (or (cadr nums) 0))
1065 (if (or (< 0 new) (< 0 unread))
1066 (save-window-excursion
1068 (let ((wl-summary-buffer-name
1069 (if (setq sticky (get-buffer
1070 (wl-summary-sticky-buffer-name
1071 (elmo-folder-name-internal
1073 ;; Sticky folder exists.
1074 (wl-summary-sticky-buffer-name
1075 (elmo-folder-name-internal folder))
1077 wl-summary-buffer-name
1078 (symbol-name this-command))))
1079 (wl-summary-use-frame nil)
1080 (wl-summary-always-sticky-folder-list nil))
1081 (wl-summary-goto-folder-subr entity
1082 (wl-summary-get-sync-range folder)
1084 (wl-summary-mark-as-read-all)
1086 (wl-summary-save-status)
1087 (wl-summary-exit)))))
1090 (defun wl-folder-mark-as-read-all-current-entity ()
1091 "Mark as read all messages in the folder at position.
1092 If current line is group folder, all subfolders are marked."
1095 (let ((entity-name (wl-folder-get-entity-from-buffer))
1096 (group (wl-folder-buffer-group-p))
1098 (when (and entity-name
1099 (y-or-n-p (format "Mark all messages in %s as read? " entity-name)))
1100 (wl-folder-mark-as-read-all-entity
1102 (wl-folder-search-group-entity-by-name entity-name
1105 (message "All messages in %s are marked!" entity-name)))))
1107 (defun wl-folder-check-region (beg end)
1116 (let ((inhibit-read-only t)
1118 (while (< (point) end)
1119 ;; normal folder entity
1120 (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
1122 (setq entity (wl-folder-get-entity-from-buffer))
1123 (if (not (elmo-folder-plugged-p (wl-folder-get-elmo-folder
1125 (message "Uncheck %s" entity)
1126 (message "Checking %s" entity)
1127 (wl-folder-check-one-entity entity)
1132 (defun wl-folder-sync-region (beg end)
1141 (while (< (point) end)
1142 ;; normal folder entity
1143 (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
1145 (let ((inhibit-read-only t)
1147 (setq entity (wl-folder-get-entity-from-buffer))
1148 (wl-folder-sync-entity entity)
1149 (message "Syncing %s is done!" entity)
1154 (defun wl-folder-mark-as-read-all-region (beg end)
1163 (while (< (point) end)
1164 ;; normal folder entity
1165 (if (looking-at "^[\t ]*\\([^\\[]+\\):\\(.*\\)\n")
1167 (let ((inhibit-read-only t)
1169 (setq entity (wl-folder-get-entity-from-buffer))
1170 (wl-folder-mark-as-read-all-entity entity)
1171 (message "All messages in %s are marked!" entity)
1176 (defsubst wl-create-access-init-load-p (folder)
1177 (let ((no-load-regexp (when (and
1178 (not wl-folder-init-load-access-folders)
1179 wl-folder-init-no-load-access-folders)
1180 (mapconcat 'identity
1181 wl-folder-init-no-load-access-folders
1183 (load-regexp (and wl-folder-init-load-access-folders
1184 (mapconcat 'identity
1185 wl-folder-init-load-access-folders
1187 (cond (load-regexp (string-match load-regexp folder))
1188 (t (not (and no-load-regexp
1189 (string-match no-load-regexp folder)))))))
1191 (defun wl-create-access-folder-entity (name)
1193 (when (wl-create-access-init-load-p name)
1194 (setq flists (elmo-msgdb-flist-load name)) ; load flist.
1195 (setq flist (car flists))
1197 (when (consp (car flist))
1198 (setcdr (cdar flist)
1199 (wl-create-access-folder-entity (caar flist))))
1200 (setq flist (cdr flist)))
1203 (defun wl-create-folder-entity-from-buffer ()
1204 "Create folder entity recursively."
1206 ((looking-at "^[ \t]*$") ; blank line
1207 (goto-char (+ 1(match-end 0)))
1209 ((looking-at "^#.*$") ; comment
1210 (goto-char (+ 1 (match-end 0)))
1212 ((looking-at "^[\t ]*\\(.+\\)[\t ]*{[\t ]*$") ; group definition
1213 (let (name entity flist)
1214 (setq name (wl-match-buffer 1))
1215 (goto-char (+ 1 (match-end 0)))
1216 (while (setq entity (wl-create-folder-entity-from-buffer))
1217 (unless (eq entity 'ignore)
1218 (wl-append flist (list entity))))
1219 (if (looking-at "^[\t ]*}[\t ]*$") ; end of group
1221 (goto-char (+ 1 (match-end 0)))
1222 (if (wl-string-assoc name wl-folder-petname-alist)
1223 (error "%s already defined as petname" name))
1224 (list name 'group flist))
1225 (error "Syntax error in folder definition"))))
1226 ((looking-at "^[\t ]*\\([^\t \n]+\\)[\t ]*/$") ; access it!
1228 (setq name (wl-match-buffer 1))
1229 (goto-char (+ 1 (match-end 0)))
1230 ; (condition-case ()
1232 ; (setq flist (elmo-list-folders name)))
1233 ; (error (message "Access to folder %s failed." name)))
1234 ;; (setq flist (elmo-msgdb-flist-load name)) ; load flist.
1235 ;; (setq unsublist (nth 1 flist))
1236 ;; (setq flist (car flist))
1237 ;; (list name 'access flist unsublist)))
1238 (append (list name 'access) (wl-create-access-folder-entity name))))
1239 ;((looking-at "^[\t ]*\\([^\t \n}]+\\)[\t ]*\\(\"[^\"]*\"\\)?[\t ]*$") ; normal folder entity
1240 ((looking-at "^[\t ]*=[ \t]+\\([^\n]+\\)$"); petname definition
1241 (goto-char (+ 1 (match-end 0)))
1242 (let ((rest (elmo-match-buffer 1))
1244 (when (string-match "\\(\"[^\"]*\"\\)[\t ]*$" rest)
1245 (setq petname (elmo-delete-char ?\" (elmo-match-string 1 rest)))
1246 (setq rest (substring rest 0 (match-beginning 0))))
1247 (when (string-match "^[\t ]*\\(.*[^\t ]+\\)[\t ]+$" rest)
1248 (wl-folder-append-petname (elmo-match-string 1 rest)
1251 ((looking-at "^[ \t]*}[ \t]*$") ; end of group
1253 ((looking-at "^.*$") ; normal folder entity
1254 (goto-char (+ 1 (match-end 0)))
1255 (let ((rest (elmo-match-buffer 0))
1257 (if (string-match "\\(\"[^\"]*\"\\)[\t ]*$" rest)
1259 (setq petname (elmo-delete-char ?\" (elmo-match-string 1 rest)))
1260 (setq rest (substring rest 0 (match-beginning 0)))
1261 (when (string-match "^[\t ]*\\(.*[^\t ]+\\)[\t ]+$" rest)
1262 (wl-folder-append-petname
1263 (setq realname (elmo-match-string 1 rest))
1266 (if (string-match "^[\t ]*\\(.+\\)$" rest)
1267 (elmo-match-string 1 rest)
1270 (defun wl-folder-create-folder-entity ()
1271 "Create folder entries."
1272 (let ((tmp-buf (get-buffer-create " *wl-folder-tmp*"))
1276 (with-current-buffer tmp-buf
1278 (insert-file-contents wl-folders-file)
1279 (goto-char (point-min))
1280 (while (and (not (eobp))
1281 (setq entity (wl-create-folder-entity-from-buffer)))
1282 (unless (eq entity 'ignore)
1283 (wl-append ret-val (list entity)))))
1284 (kill-buffer tmp-buf))
1286 (setq ret-val (list wl-folder-desktop-name 'group ret-val))))
1288 (defun wl-folder-entity-assign-id (entity &optional hashtb on-noid)
1289 (let ((hashtb (or hashtb
1290 (setq wl-folder-entity-id-name-hashtb
1291 (elmo-make-hash wl-folder-entity-id))))
1292 (entities (list entity))
1295 (setq entity (wl-pop entities))
1298 (when (not (and on-noid
1299 (get-text-property 0
1300 'wl-folder-entity-id
1302 (put-text-property 0 (length (car entity))
1303 'wl-folder-entity-id
1306 (wl-folder-set-id-name wl-folder-entity-id
1307 (car entity) hashtb))
1309 (wl-push entities entity-stack))
1310 (setq entities (nth 2 entity)))
1312 (when (not (and on-noid
1313 (get-text-property 0
1314 'wl-folder-entity-id
1316 (put-text-property 0 (length entity)
1317 'wl-folder-entity-id
1320 (wl-folder-set-id-name wl-folder-entity-id
1322 (setq wl-folder-entity-id (+ 1 wl-folder-entity-id))
1324 (setq entities (wl-pop entity-stack))))))
1326 (defun wl-folder-click (e)
1331 (wl-folder-jump-to-current-entity)))
1333 (defun wl-folder-select-buffer (buffer)
1334 (let ((gbw (get-buffer-window buffer))
1337 (progn (select-window gbw)
1339 (unless wl-summary-use-frame
1342 (split-window-horizontally wl-folder-window-width)
1346 (if wl-summary-use-frame
1347 (switch-to-buffer-other-frame buffer)
1348 (switch-to-buffer buffer))
1351 (defun wl-folder-toggle-disp-summary (&optional arg folder)
1353 (if (or (and folder (assoc folder wl-folder-group-alist))
1354 (and (interactive-p) (wl-folder-buffer-group-p)))
1355 (error "This command is not available on Group"))
1357 (let (wl-auto-select-first
1358 (wl-stay-folder-window t))
1361 (setq wl-folder-buffer-disp-summary t))
1363 (setq wl-folder-buffer-disp-summary nil)
1364 ;; hide wl-summary window.
1365 (let ((cur-buf (current-buffer))
1366 (summary-buffer (wl-summary-get-buffer folder)))
1367 (wl-folder-select-buffer summary-buffer)
1369 (select-window (get-buffer-window cur-buf))))
1371 (setq wl-folder-buffer-disp-summary
1372 (not wl-folder-buffer-disp-summary))
1373 (let ((cur-buf (current-buffer))
1375 (when (looking-at "^[ ]*\\([^\\[].+\\):.*\n")
1376 (setq folder-name (wl-folder-get-entity-from-buffer))
1377 (if wl-folder-buffer-disp-summary
1379 (wl-folder-select-buffer
1380 (wl-summary-get-buffer-create folder-name))
1382 (wl-summary-goto-folder-subr folder-name 'no-sync nil)
1383 (select-window (get-buffer-window cur-buf))))
1384 (wl-folder-select-buffer (wl-summary-get-buffer folder-name))
1386 (select-window (get-buffer-window cur-buf)))))))))
1388 (defun wl-folder-prev-unsync ()
1389 "Move cursor to the previous unsync folder."
1392 (setq start-point (point))
1394 (if (re-search-backward wl-folder-unsync-regexp nil t)
1396 (goto-char start-point)
1397 (message "No more unsync folder"))))
1399 (defun wl-folder-next-unsync (&optional plugged)
1400 "Move cursor to the next unsync."
1402 (let (start-point entity)
1403 (setq start-point (point))
1406 (while (re-search-forward wl-folder-unsync-regexp nil t)
1407 (if (or (wl-folder-buffer-group-p)
1410 (wl-folder-get-realname
1411 (wl-folder-folder-name)))
1412 (elmo-folder-plugged-p entity))
1415 (goto-char start-point)
1416 (message "No more unsync folder"))))
1418 (defun wl-folder-prev-unread (&optional group)
1419 "Move cursor to the previous unread folder."
1422 (setq start-point (point))
1424 (if (re-search-backward (wl-folder-unread-regex group) nil t)
1427 (wl-folder-folder-name))
1428 (goto-char start-point)
1429 (message "No more unread folder")
1432 (defun wl-folder-next-unread (&optional group)
1433 "Move cursor to the next unread folder."
1436 (setq start-point (point))
1438 (if (re-search-forward (wl-folder-unread-regex group) nil t)
1441 (wl-folder-folder-name))
1442 (goto-char start-point)
1443 (message "No more unread folder")
1446 (defun wl-folder-mode ()
1447 "Major mode for Wanderlust Folder.
1448 See Info under Wanderlust for full documentation.
1451 \\{wl-folder-mode-map}
1453 Entering Folder mode calls the value of `wl-folder-mode-hook'."
1455 (setq major-mode 'wl-folder-mode)
1456 (setq mode-name "Folder")
1457 (use-local-map wl-folder-mode-map)
1458 (setq buffer-read-only t)
1459 (setq inhibit-read-only nil)
1460 (setq truncate-lines t)
1461 (setq wl-folder-buffer-cur-entity-id nil
1462 wl-folder-buffer-cur-path nil
1463 wl-folder-buffer-cur-point nil)
1464 (wl-mode-line-buffer-identification)
1465 (easy-menu-add wl-folder-mode-menu)
1466 ;; This hook may contain the functions `wl-folder-init-icons' and
1467 ;; `wl-setup-folder' for reasons of system internal to accord
1468 ;; facilities for the Emacs variants.
1469 (run-hooks 'wl-folder-mode-hook))
1471 (defun wl-folder-append-petname (realname petname)
1473 ;; check group name.
1474 (if (wl-folder-search-group-entity-by-name petname wl-folder-entity)
1475 (error "%s already defined as group name" petname))
1476 (when (setq pentry (wl-string-assoc realname wl-folder-petname-alist))
1477 (setq wl-folder-petname-alist
1478 (delete pentry wl-folder-petname-alist)))
1479 (wl-append wl-folder-petname-alist
1480 (list (cons realname petname)))))
1482 (defun wl-folder (&optional arg)
1484 (let (initialize folder-buf)
1485 (if (setq folder-buf (get-buffer wl-folder-buffer-name))
1486 (if wl-folder-use-frame
1488 (save-selected-window
1489 (dolist (frame (visible-frame-list))
1490 (select-frame frame)
1491 (if (get-buffer-window folder-buf)
1492 (setq select-frame frame))))
1494 (select-frame select-frame)
1495 (switch-to-buffer folder-buf)))
1496 (switch-to-buffer folder-buf))
1497 (if wl-folder-use-frame
1499 (switch-to-buffer-other-frame
1500 (get-buffer-create wl-folder-buffer-name))
1501 (let ((frame (selected-frame)))
1502 (setq wl-delete-startup-frame-function
1504 (setq wl-delete-startup-frame-function nil)
1505 (let ((frame ,frame))
1506 (if (eq (selected-frame) frame)
1507 (delete-frame frame)))))))
1508 (switch-to-buffer (get-buffer-create wl-folder-buffer-name)))
1509 (set-buffer wl-folder-buffer-name)
1512 (setq wl-folder-entity-id 0)
1513 (wl-folder-entity-assign-id wl-folder-entity)
1514 (setq wl-folder-entity-hashtb
1515 (wl-folder-create-entity-hashtb wl-folder-entity))
1516 (setq wl-folder-elmo-folder-hashtb (elmo-make-hash wl-folder-entity-id))
1517 (setq wl-folder-group-alist
1518 (wl-folder-create-group-alist wl-folder-entity))
1519 (setq wl-folder-newsgroups-hashtb
1520 (wl-folder-create-newsgroups-hashtb wl-folder-entity))
1521 (wl-folder-init-info-hashtb)
1522 (let ((inhibit-read-only t)
1523 (buffer-read-only nil))
1525 (setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
1527 (wl-folder-insert-entity " " wl-folder-entity)))
1529 (set-buffer-modified-p nil)
1530 (setq initialize t))
1533 (defun wl-folder-auto-check ()
1534 "Check and update folders in `wl-auto-check-folder-name'."
1536 (when (get-buffer wl-folder-buffer-name)
1537 (switch-to-buffer wl-folder-buffer-name)
1539 ((eq wl-auto-check-folder-name 'none))
1540 ((or (consp wl-auto-check-folder-name)
1541 (stringp wl-auto-check-folder-name))
1542 (let ((folder-list (if (consp wl-auto-check-folder-name)
1543 wl-auto-check-folder-name
1544 (list wl-auto-check-folder-name)))
1547 (if (setq entity (wl-folder-search-entity-by-name
1550 (wl-folder-check-entity entity 'auto))
1551 (setq folder-list (cdr folder-list)))))
1553 (wl-folder-check-entity wl-folder-entity 'auto)))))
1555 (defun wl-folder-set-folder-updated (name value)
1558 (if (setq buf (get-buffer wl-folder-buffer-name))
1559 (wl-folder-entity-hashtb-set
1560 wl-folder-entity-hashtb name value buf))
1561 (setq wl-folder-info-alist-modified t))))
1563 (defun wl-folder-calc-finfo (entity)
1564 ;; calcurate finfo without inserting.
1565 (let ((entities (list entity))
1567 new unread all nums)
1569 (setq entity (wl-pop entities))
1573 (wl-push entities entity-stack))
1574 (setq entities (nth 2 entity)))
1576 (setq nums (wl-folder-get-entity-info entity))
1577 (setq new (+ (or new 0) (or (nth 0 nums) 0)))
1578 (setq unread (+ (or unread 0)
1579 (or (and (nth 0 nums)(nth 1 nums)
1580 (+ (nth 0 nums)(nth 1 nums))) 0)))
1581 (setq all (+ (or all 0) (or (nth 2 nums) 0)))))
1583 (setq entities (wl-pop entity-stack))))
1584 (list new unread all)))
1586 (defsubst wl-folder-make-save-access-list (list)
1587 (mapcar '(lambda (x)
1590 (list (elmo-string (car x)) 'access))
1595 (defun wl-folder-update-newest (indent entity)
1596 (let (ret-val new unread all)
1599 (let ((inhibit-read-only t)
1600 (buffer-read-only nil)
1601 (flist (nth 2 entity))
1602 (as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
1607 (let (update-flist flist-unsub new-flist removed group-name-end)
1608 (when (and (eq (cadr entity) 'access)
1609 (elmo-folder-plugged-p
1610 (wl-folder-get-elmo-folder (car entity))))
1611 (message "Fetching folder entries...")
1612 (when (setq new-flist
1613 (elmo-folder-list-subfolders
1614 (wl-folder-get-elmo-folder (car entity))
1615 (wl-string-match-member
1617 wl-folder-hierarchy-access-folders)))
1619 (wl-folder-update-access-group entity new-flist))
1620 (setq flist (nth 1 update-flist))
1621 (when (car update-flist) ;; diff
1622 (setq flist-unsub (nth 2 update-flist))
1623 (setq removed (nth 3 update-flist))
1624 (elmo-msgdb-flist-save
1627 (wl-folder-make-save-access-list flist)
1628 (wl-folder-make-save-access-list flist-unsub)))
1629 (wl-folder-entity-assign-id
1631 wl-folder-entity-id-name-hashtb
1633 (setq wl-folder-entity-hashtb
1634 (wl-folder-create-entity-hashtb
1636 wl-folder-entity-hashtb
1638 (setq wl-folder-newsgroups-hashtb
1640 (wl-folder-create-newsgroups-hashtb
1642 wl-folder-newsgroups-hashtb))))
1643 (message "Fetching folder entries...done"))
1644 (wl-folder-insert-entity indent entity))))))))
1646 (defun wl-folder-insert-entity (indent entity &optional onlygroup)
1647 (let (ret-val new unread all)
1650 (let ((inhibit-read-only t)
1651 (buffer-read-only nil)
1652 (flist (nth 2 entity))
1653 (as-opened (cdr (assoc (car entity) wl-folder-group-alist)))
1656 ;;; (insert indent "[" (if as-opened "-" "+") "]" (car entity) "\n")
1657 ;;; (save-excursion (forward-line -1)
1658 ;;; (wl-highlight-folder-current-line))
1662 (let (update-flist flist-unsub new-flist removed group-name-end)
1663 ;;; (when (and (eq (cadr entity) 'access)
1665 ;;; (message "fetching folder entries...")
1666 ;;; (when (setq new-flist
1667 ;;; (elmo-list-folders
1668 ;;; (elmo-string (car entity))
1669 ;;; (wl-string-member
1671 ;;; wl-folder-hierarchy-access-folders)
1673 ;;; (setq update-flist
1674 ;;; (wl-folder-update-access-group entity new-flist))
1675 ;;; (setq flist (nth 1 update-flist))
1676 ;;; (when (car update-flist) ;; diff
1677 ;;; (setq flist-unsub (nth 2 update-flist))
1678 ;;; (setq removed (nth 3 update-flist))
1679 ;;; (elmo-msgdb-flist-save
1682 ;;; (wl-folder-make-save-access-list flist)
1683 ;;; (wl-folder-make-save-access-list flist-unsub)))
1685 ;;; ;; reconstruct wl-folder-entity-id-name-hashtb and
1686 ;;; ;; wl-folder-entity-hashtb
1688 ;;; (wl-folder-entity-assign-id
1690 ;;; wl-folder-entity-id-name-hashtb
1692 ;;; (setq wl-folder-entity-hashtb
1693 ;;; (wl-folder-create-entity-hashtb
1695 ;;; wl-folder-entity-hashtb
1697 ;;; (setq wl-folder-newsgroups-hashtb
1699 ;;; (wl-folder-create-newsgroups-hashtb
1701 ;;; wl-folder-newsgroups-hashtb))))
1702 ;;; (message "fetching folder entries...done"))
1703 (insert indent "[" (if as-opened "-" "+") "]"
1704 (wl-folder-get-petname (car entity)))
1705 (setq group-name-end (point))
1707 (put-text-property beg (point) 'wl-folder-entity-id
1708 (get-text-property 0 'wl-folder-entity-id
1714 wl-folder-removed-mark
1715 (if (listp (car removed))
1716 (concat "[+]" (caar removed))
1719 (save-excursion (forward-line -1)
1720 (wl-highlight-folder-current-line))
1721 (setq removed (cdr removed)))
1722 (remove-text-properties beg (point) '(wl-folder-entity-id)))
1723 (let* ((len (length flist))
1728 (wl-folder-insert-entity
1729 (concat indent " ") (car flist)))
1730 (setq new (+ (or new 0) (or (nth 0 ret-val) 0)))
1731 (setq unread (+ (or unread 0) (or (nth 1 ret-val) 0)))
1732 (setq all (+ (or all 0) (or (nth 2 ret-val) 0)))
1734 (> len elmo-display-progress-threshold))
1736 (elmo-display-progress
1737 'wl-folder-insert-entity "Inserting group %s..."
1738 (/ (* i 100) len) (car entity)))
1739 (setq flist (cdr flist))))
1741 (goto-char group-name-end)
1742 (delete-region (point) (save-excursion (end-of-line)
1744 (insert (format ":%d/%d/%d" (or new 0)
1745 (or unread 0) (or all 0)))
1746 (setq ret-val (list new unread all))
1747 (wl-highlight-folder-current-line ret-val)))
1748 (setq ret-val (wl-folder-calc-finfo entity))
1749 (insert indent "[" (if as-opened "-" "+") "]"
1750 (wl-folder-get-petname (car entity))
1752 (or (nth 0 ret-val) 0)
1753 (or (nth 1 ret-val) 0)
1754 (or (nth 2 ret-val) 0))
1756 (put-text-property beg (point) 'wl-folder-entity-id
1757 (get-text-property 0 'wl-folder-entity-id
1759 (save-excursion (forward-line -1)
1760 (wl-highlight-folder-current-line ret-val)))))
1762 (let* ((inhibit-read-only t)
1763 (buffer-read-only nil)
1764 (nums (wl-folder-get-entity-info entity))
1767 (insert indent (wl-folder-get-petname entity)
1768 (format ":%s/%s/%s\n"
1769 (or (setq new (nth 0 nums)) "*")
1770 (or (setq unread (and (nth 0 nums)(nth 1 nums)
1771 (+ (nth 0 nums)(nth 1 nums))))
1773 (or (setq all (nth 2 nums)) "*")))
1774 (put-text-property beg (point) 'wl-folder-entity-id
1775 (get-text-property 0 'wl-folder-entity-id entity))
1776 (save-excursion (forward-line -1)
1777 (wl-highlight-folder-current-line nums))
1778 (setq ret-val (list new unread all)))))
1779 (set-buffer-modified-p nil)
1782 (defun wl-folder-check-all ()
1784 (wl-folder-check-entity wl-folder-entity))
1786 (defun wl-folder-entity-hashtb-set (entity-hashtb name value buffer)
1793 (setq cur-val (wl-folder-get-entity-info name entity-hashtb))
1794 (setq new-diff (- (or (nth 0 value) 0) (or (nth 0 cur-val) 0)))
1797 (- (or (nth 1 value) 0) (or (nth 1 cur-val) 0))))
1798 (setq all-diff (- (or (nth 2 value) 0) (or (nth 2 cur-val) 0)))
1799 (setq diffs (list new-diff unread-diff all-diff))
1800 (unless (and (nth 0 cur-val)
1801 (equal diffs '(0 0 0)))
1802 (wl-folder-set-entity-info name value entity-hashtb)
1804 (with-current-buffer buffer
1806 (setq entity-list (wl-folder-search-entity-list-by-name
1807 name wl-folder-entity))
1809 (wl-folder-update-group (car entity-list) diffs)
1810 (setq entity-list (cdr entity-list)))
1811 (goto-char (point-min))
1812 (while (wl-folder-buffer-search-entity name)
1813 (wl-folder-update-line value))))))))
1815 (defun wl-folder-update-unread (folder unread)
1816 ; (save-window-excursion
1817 (let ((buf (get-buffer wl-folder-buffer-name))
1820 ;;(fld (elmo-string folder))
1821 value newvalue entity-list)
1822 ;;; Update folder-info
1823 ;;; (elmo-folder-set-info-hashtb fld nil nil nil unread)
1824 (setq cur-unread (or (nth 1 (wl-folder-get-entity-info folder)) 0))
1825 (setq unread-diff (- (or unread 0) cur-unread))
1826 (setq value (wl-folder-get-entity-info folder))
1827 (setq newvalue (list (nth 0 value)
1830 (wl-folder-set-entity-info folder newvalue)
1831 (setq wl-folder-info-alist-modified t)
1833 (not (eq unread-diff 0)))
1835 (with-current-buffer buf
1837 (setq entity-list (wl-folder-search-entity-list-by-name
1838 folder wl-folder-entity))
1840 (wl-folder-update-group (car entity-list) (list 0
1843 (setq entity-list (cdr entity-list)))
1844 (goto-char (point-min))
1845 (while (wl-folder-buffer-search-entity folder)
1846 (wl-folder-update-line newvalue))))))));)
1848 (defun wl-folder-create-entity-hashtb (entity &optional hashtb reconst)
1849 (let ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
1850 (entities (list entity))
1853 (setq entity (wl-pop entities))
1857 (wl-push entities entity-stack))
1858 (setq entities (nth 2 entity)))
1860 (when (not (and reconst
1861 (wl-folder-get-entity-info entity)))
1862 (wl-folder-set-entity-info entity
1866 (setq entities (wl-pop entity-stack))))
1869 ;; Unsync number is reserved.
1870 ;;(defun wl-folder-reconstruct-entity-hashtb (entity &optional hashtb id-name)
1871 ;; (let* ((hashtb (or hashtb (elmo-make-hash wl-folder-entity-id)))
1872 ;; (entities (list entity))
1875 ;; (setq entity (wl-pop entities))
1879 ;; (wl-folder-set-id-name (wl-folder-get-entity-id (car entity))
1882 ;; (wl-push entities entity-stack))
1883 ;; (setq entities (nth 2 entity))
1885 ;; ((stringp entity)
1886 ;; (wl-folder-set-entity-info entity
1887 ;; (wl-folder-get-entity-info entity)
1890 ;; (wl-folder-set-id-name (wl-folder-get-entity-id entity)
1893 ;; (setq entities (wl-pop entity-stack))))
1896 (defun wl-folder-create-newsgroups-from-nntp-access (entity)
1897 (let ((flist (nth 2 entity))
1902 ((consp (car flist))
1903 (wl-folder-create-newsgroups-from-nntp-access (car flist)))
1906 (elmo-nntp-folder-group-internal
1907 (wl-folder-get-elmo-folder (car flist)))))))
1908 (setq flist (cdr flist)))
1911 (defun wl-folder-create-newsgroups-hashtb (entity &optional is-list info)
1912 "Create NNTP group hashtable for ENTITY."
1913 (let ((entities (if is-list entity (list entity)))
1914 entity-stack folder-list newsgroups newsgroup make-hashtb)
1915 (and info (message "Creating newsgroups..."))
1917 (setq entity (wl-pop entities))
1920 (if (eq (nth 1 entity) 'access)
1921 (when (eq (elmo-folder-type-internal
1922 (elmo-make-folder (car entity))) 'nntp)
1923 (wl-append newsgroups
1924 (wl-folder-create-newsgroups-from-nntp-access entity))
1925 (setq make-hashtb t))
1927 (wl-push entities entity-stack))
1928 (setq entities (nth 2 entity))))
1930 (setq folder-list (elmo-folder-get-primitive-list
1931 (elmo-make-folder entity)))
1933 (when (and (eq (elmo-folder-type-internal (car folder-list))
1935 (setq newsgroup (elmo-nntp-folder-group-internal
1936 (car folder-list))))
1937 (wl-append newsgroups (list (elmo-string newsgroup))))
1938 (setq folder-list (cdr folder-list)))))
1940 (setq entities (wl-pop entity-stack))))
1941 (and info (message "Creating newsgroups...done"))
1942 (if (or newsgroups make-hashtb)
1943 (elmo-setup-subscribed-newsgroups newsgroups))))
1945 (defun wl-folder-get-path (entity target-id &optional string)
1946 (let ((entities (list entity))
1947 entity-stack result-path)
1951 (setq entity (wl-pop entities))
1954 (if (and (or (not string) (string= string (car entity)))
1955 (eq target-id (wl-folder-get-entity-id (car entity))))
1957 (wl-push target-id result-path))
1958 (wl-push (wl-folder-get-entity-id (car entity)) result-path))
1959 (wl-push entities entity-stack)
1960 (setq entities (nth 2 entity)))
1962 (if (and (or (not string) (string= string entity))
1963 (eq target-id (wl-folder-get-entity-id entity)))
1965 (wl-push target-id result-path)))))
1967 (while (and entity-stack
1969 (setq result-path (cdr result-path))
1970 (setq entities (wl-pop entity-stack)))))))))
1972 (defun wl-folder-create-group-alist (entity)
1974 (let ((flist (nth 2 entity))
1975 (cur-alist (list (cons (car entity) nil)))
1978 (if (consp (car flist))
1979 (wl-append append-alist
1980 (wl-folder-create-group-alist (car flist))))
1981 (setq flist (cdr flist)))
1982 (append cur-alist append-alist))))
1984 (defun wl-folder-init-info-hashtb ()
1985 (let ((info-alist (and wl-folder-info-save
1986 (elmo-msgdb-finfo-load))))
1987 (elmo-folder-info-make-hashtb
1989 wl-folder-entity-hashtb)))
1990 ;;; (wl-folder-resume-entity-hashtb-by-finfo
1991 ;;; wl-folder-entity-hashtb
1994 (defun wl-folder-cleanup-variables ()
1995 (setq wl-folder-entity nil
1996 wl-folder-entity-hashtb nil
1997 wl-folder-entity-id-name-hashtb nil
1998 wl-folder-group-alist nil
1999 wl-folder-petname-alist nil
2000 wl-folder-newsgroups-hashtb nil
2001 wl-fldmgr-cut-entity-list nil
2002 wl-fldmgr-modified nil
2003 wl-fldmgr-modified-access-list nil
2007 (defun wl-make-plugged-alist ()
2008 (let ((entity-list (wl-folder-get-entity-list wl-folder-entity))
2009 (add (not wl-reset-plugged-alist)))
2011 (elmo-folder-set-plugged
2012 (wl-folder-get-elmo-folder (car entity-list)) wl-plugged add)
2013 (setq entity-list (cdr entity-list)))
2014 ;; smtp posting server
2015 (when wl-smtp-posting-server
2016 (elmo-set-plugged wl-plugged
2017 wl-smtp-posting-server ; server
2018 (or (and (boundp 'smtp-service) smtp-service)
2020 wl-smtp-connection-type
2021 nil nil "smtp" add))
2022 ;; nntp posting server
2023 (when wl-nntp-posting-server
2024 (elmo-set-plugged wl-plugged
2025 wl-nntp-posting-server
2026 wl-nntp-posting-stream-type
2027 wl-nntp-posting-port
2028 nil nil "nntp" add))
2029 (run-hooks 'wl-make-plugged-hook)))
2031 (defvar wl-folder-init-function 'wl-local-folder-init)
2033 (defun wl-folder-init ()
2034 "Return top-level folder entity."
2038 (funcall wl-folder-init-function))
2039 (run-hooks 'wl-folder-init-hook))
2041 (defun wl-local-folder-init ()
2042 "Initialize local folder."
2043 (message "Initializing folder...")
2044 (setq wl-folder-entity (wl-folder-create-folder-entity))
2045 (message "Initializing folder...done"))
2047 (defun wl-folder-get-realname (petname)
2051 wl-folder-petname-alist))
2054 (defun wl-folder-get-petname (name)
2058 wl-folder-petname-alist))
2061 (defun wl-folder-get-entity-with-petname ()
2062 (let ((alist wl-folder-petname-alist)
2063 (hashtb (copy-sequence wl-folder-entity-hashtb)))
2065 (wl-folder-set-entity-info (cdar alist) nil hashtb)
2066 (setq alist (cdr alist)))
2069 (defun wl-folder-get-newsgroups (folder)
2070 "Return Newsgroups field value string for FOLDER newsgroup.
2071 If FOLDER is multi, return comma separated string (cross post)."
2072 (let ((nlist (elmo-folder-newsgroups
2073 (wl-folder-get-elmo-folder folder))))
2075 (list nil nil (mapconcat 'identity nlist ","))
2078 (defun wl-folder-guess-mailing-list-by-refile-rule (entity)
2079 "Return ML address guess by FOLDER.
2080 Use `wl-subscribed-mailing-list' and `wl-refile-rule-alist'."
2082 (elmo-folder-get-primitive-list
2083 (wl-folder-get-elmo-folder entity)))
2085 (while (setq fld (car flist))
2086 (setq mladdr (wl-folder-guess-mailing-list-by-refile-rule-subr
2087 (elmo-folder-name-internal fld)))
2089 (setq to (if (stringp to)
2090 (concat to ", " mladdr)
2092 (setq flist (cdr flist)))
2097 (defun wl-folder-guess-mailing-list-by-refile-rule-subr (entity)
2098 (unless (memq (elmo-folder-type entity)
2100 (let ((rules wl-refile-rule-alist)
2103 (if (or (and (stringp (car (car rules)))
2104 (string-match "[Tt]o" (car (car rules))))
2105 (and (listp (car (car rules)))
2106 (elmo-string-matched-member "to" (car (car rules))
2108 (setq toalist (append toalist (cdr (car rules)))))
2109 (setq rules (cdr rules)))
2110 (setq tokey (car (rassoc entity toalist)))
2111 ;;; (setq histkey (car (rassoc folder wl-refile-alist)))
2112 ;; case-ignore search `wl-subscribed-mailing-list'
2114 (elmo-string-matched-member tokey wl-subscribed-mailing-list t)))))
2116 (defun wl-folder-guess-mailing-list-by-folder-name (entity)
2117 "Return ML address guess by FOLDER name's last hierarchy.
2118 Use `wl-subscribed-mailing-list'."
2120 (elmo-folder-get-primitive-list
2121 (wl-folder-get-elmo-folder entity)))
2123 (while (setq fld (car flist))
2124 (setq mladdr (wl-folder-guess-mailing-list-by-folder-name-subr
2125 (elmo-folder-name-internal fld)))
2127 (setq to (if (stringp to)
2128 (concat to ", " mladdr)
2130 (setq flist (cdr flist)))
2135 (defun wl-folder-guess-mailing-list-by-folder-name-subr (entity)
2136 (when (memq (elmo-folder-type entity)
2137 '(localdir imap4 maildir))
2138 (let (key foldername)
2139 ;; Get foldername and Remove folder type symbol.
2140 (setq foldername (substring entity 1))
2141 (if (string-match "@" foldername)
2142 (setq foldername (substring foldername 0 (match-beginning 0))))
2143 (when (string-match "[^\\./]+$" foldername)
2144 (setq key (regexp-quote
2145 (concat (substring foldername (match-beginning 0)) "@")))
2146 (elmo-string-matched-member
2147 key wl-subscribed-mailing-list 'case-ignore)))))
2149 (defun wl-folder-update-diff-line (diffs)
2150 (let ((inhibit-read-only t)
2151 (buffer-read-only nil)
2153 cur-unread new-unread
2158 (setq id (get-text-property (point) 'wl-folder-entity-id))
2159 (when (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*\\)/\\([0-9\\*-]*\\)/\\([0-9\\*]*\\)")
2160 ;;(looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
2161 (setq cur-new (string-to-int
2162 (wl-match-buffer 2)))
2163 (setq cur-unread (string-to-int
2164 (wl-match-buffer 3)))
2165 (setq cur-all (string-to-int
2166 (wl-match-buffer 4)))
2167 (delete-region (match-beginning 2)
2169 (goto-char (match-beginning 2))
2170 (insert (format "%s/%s/%s"
2171 (setq new-new (+ cur-new (nth 0 diffs)))
2172 (setq new-unread (+ cur-unread (nth 1 diffs)))
2173 (setq new-all (+ cur-all (nth 2 diffs)))))
2174 (put-text-property (match-beginning 2) (point)
2175 'wl-folder-entity-id id)
2176 (if wl-use-highlight-mouse-line
2177 (put-text-property (match-beginning 2) (point)
2178 'mouse-face 'highlight))
2179 (wl-highlight-folder-group-line (list new-new new-unread new-all))
2180 (setq buffer-read-only t)
2181 (set-buffer-modified-p nil)))))
2183 (defun wl-folder-update-line (nums &optional is-group)
2184 (let ((inhibit-read-only t)
2185 (buffer-read-only nil)
2189 (setq id (get-text-property (point) 'wl-folder-entity-id))
2190 (if (looking-at "^[ ]*\\(.*\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
2191 ;;; (looking-at "^[ ]*\\([^\\[].+\\):\\([0-9\\*-]*/[0-9\\*-]*/[0-9\\*]*\\)")
2193 (delete-region (match-beginning 2)
2195 (goto-char (match-beginning 2))
2196 (insert (format "%s/%s/%s"
2197 (or (nth 0 nums) "*")
2198 (or (and (nth 0 nums)(nth 1 nums)
2199 (+ (nth 0 nums)(nth 1 nums)))
2201 (or (nth 2 nums) "*")))
2202 (put-text-property (match-beginning 2) (point)
2203 'wl-folder-entity-id id)
2205 ;; update only colors
2206 (wl-highlight-folder-group-line nums)
2207 (wl-highlight-folder-current-line nums))
2209 (set-buffer-modified-p nil))))))
2211 (defun wl-folder-goto-folder (&optional arg)
2213 (wl-folder-goto-folder-subr nil arg))
2215 (defun wl-folder-goto-folder-sticky ()
2217 (wl-folder-goto-folder-subr nil t))
2219 (defun wl-folder-goto-draft-folder (&optional arg)
2221 (wl-folder-goto-folder-subr wl-draft-folder arg))
2223 (defun wl-folder-goto-folder-subr (&optional folder sticky)
2225 (let (summary-buf fld-name entity id error-selecting)
2226 ;;; (setq fld-name (wl-folder-get-entity-from-buffer))
2227 ;;; (if (or (null fld-name)
2228 ;;; (assoc fld-name wl-folder-group-alist))
2229 (setq fld-name wl-default-folder)
2230 (setq fld-name (or folder
2232 (wl-summary-read-folder fld-name))))
2233 (if (and (setq entity
2234 (wl-folder-search-entity-by-name fld-name
2237 (setq id (wl-folder-get-entity-id entity)))
2238 (wl-folder-set-current-entity-id id))
2239 (setq summary-buf (wl-summary-get-buffer-create fld-name sticky))
2240 (if (or wl-stay-folder-window wl-summary-use-frame)
2241 (wl-folder-select-buffer summary-buf)
2242 (if (and summary-buf
2243 (get-buffer-window summary-buf))
2245 (wl-summary-goto-folder-subr fld-name
2246 (wl-summary-get-sync-range
2247 (wl-folder-get-elmo-folder fld-name))
2250 (defun wl-folder-suspend ()
2252 (run-hooks 'wl-folder-suspend-hook)
2253 (wl-folder-info-save)
2254 (elmo-crosspost-message-alist-save)
2256 ;(if (fboundp 'mmelmo-cleanup-entity-buffers)
2257 ;(mmelmo-cleanup-entity-buffers))
2258 (bury-buffer wl-folder-buffer-name)
2259 (dolist (summary-buf (wl-collect-summary))
2260 (bury-buffer summary-buf))
2261 (dolist (draft-buf (wl-collect-draft))
2262 (bury-buffer draft-buf))
2263 (delete-windows-on wl-folder-buffer-name t))
2265 (defun wl-folder-info-save ()
2266 (when (and wl-folder-info-save
2267 wl-folder-info-alist-modified)
2268 (let ((entities (list wl-folder-entity))
2269 entity entity-stack info-alist info)
2271 (setq entity (wl-pop entities))
2275 (wl-push entities entity-stack))
2276 (setq entities (nth 2 entity)))
2278 (when (and (setq info (elmo-folder-get-info
2279 (wl-folder-get-elmo-folder entity)))
2280 (not (equal info '(nil))))
2282 (wl-append info-alist (list (list (elmo-string entity)
2283 (list (nth 3 info) ;; max
2284 (nth 2 info) ;; length
2286 (nth 1 info)) ;; unread
2289 (setq entities (wl-pop entity-stack))))
2290 (elmo-msgdb-finfo-save info-alist)
2291 (setq wl-folder-info-alist-modified nil))))
2293 (defun wl-folder-goto-first-unread-folder (&optional arg)
2295 (let ((entities (list wl-folder-entity))
2296 entity entity-stack ret-val
2301 (setq entity (wl-pop entities))
2305 (wl-push entities entity-stack))
2306 (setq entities (nth 2 entity)))
2308 (if (and (setq finfo (wl-folder-get-entity-info entity))
2309 (and (nth 0 finfo)(nth 1 finfo))
2310 (> (+ (nth 0 finfo)(nth 1 finfo)) 0))
2311 (throw 'done entity))
2312 (wl-append ret-val (list entity))))
2314 (setq entities (wl-pop entity-stack))))))
2318 (wl-folder-jump-folder first-entity)
2320 (wl-folder-goto-folder-subr first-entity))
2321 (message "No unread folder"))))
2323 (defun wl-folder-jump-folder (&optional fld-name noopen)
2326 (setq fld-name (wl-summary-read-folder wl-default-folder)))
2327 (goto-char (point-min))
2329 (wl-folder-open-folder fld-name))
2330 (and (wl-folder-buffer-search-entity fld-name)
2331 (beginning-of-line)))
2333 (defun wl-folder-get-entity-list (entity)
2334 (let ((entities (list entity))
2335 entity-stack ret-val)
2337 (setq entity (wl-pop entities))
2341 (wl-push entities entity-stack))
2342 (setq entities (nth 2 entity)))
2344 (wl-append ret-val (list entity))))
2346 (setq entities (wl-pop entity-stack))))
2349 (defun wl-folder-open-unread-folder (entity)
2351 (let ((alist (wl-folder-get-entity-list entity))
2353 finfo path-list path id)
2355 (when (and (setq finfo (wl-folder-get-entity-info (car alist)))
2356 (nth 0 finfo) (nth 1 finfo)
2357 (> (+ (nth 0 finfo)(nth 1 finfo)) 0))
2358 (setq unread (+ unread (+ (nth 0 finfo)(nth 1 finfo))))
2359 (setq id (wl-folder-get-entity-id (car alist)))
2360 (setq path (delete id (wl-folder-get-path
2364 (if (not (member path path-list))
2365 (wl-append path-list (list path))))
2366 (setq alist (cdr alist)))
2368 (wl-folder-open-folder-sub (car path-list))
2369 (setq path-list (cdr path-list)))
2370 (message "%s unread folder"
2371 (if (> unread 0) unread "No")))))
2373 (defun wl-folder-open-unread-current-entity ()
2375 (let ((entity-name (wl-folder-get-entity-from-buffer))
2376 (group (wl-folder-buffer-group-p)))
2378 (wl-folder-open-unread-folder
2380 (wl-folder-search-group-entity-by-name entity-name
2384 (defun wl-folder-open-only-unread-folder ()
2387 (wl-folder-prev-entity-skip-invalid t)
2388 (wl-folder-get-entity-from-buffer t))))
2389 (wl-folder-open-all-unread-folder)
2391 (goto-char (point-max))
2392 (while (and (re-search-backward
2393 "^[ ]*\\[[-]\\].+:0/0/[0-9-]+" nil t)
2395 (wl-folder-jump-to-current-entity) ;; close it
2397 (wl-folder-move-path id)
2400 (defun wl-folder-open-all-unread-folder (&optional arg)
2403 (wl-folder-prev-entity-skip-invalid t)
2404 (wl-folder-get-entity-from-buffer t))))
2405 (wl-folder-open-unread-folder wl-folder-entity)
2407 (wl-folder-move-path id)
2408 (goto-char (point-min))
2409 (wl-folder-next-unread t))))
2411 (defun wl-folder-open-folder (&optional fld-name)
2414 (setq fld-name (wl-summary-read-folder wl-default-folder)))
2415 (let* ((id (wl-folder-get-entity-id
2416 (wl-folder-search-entity-by-name fld-name wl-folder-entity
2418 (path (and id (wl-folder-get-path wl-folder-entity id))))
2420 (wl-folder-open-folder-sub path))))
2422 (defun wl-folder-open-folder-sub (path)
2423 (let ((inhibit-read-only t)
2424 (buffer-read-only nil)
2428 (goto-char (point-min))
2430 (wl-folder-buffer-search-group
2431 (wl-folder-get-petname
2432 (if (stringp (car path))
2434 (wl-folder-get-folder-name-by-id
2437 (setq path (cdr path))
2438 (if (and (looking-at wl-folder-group-regexp)
2439 (string= "+" (wl-match-buffer 2)));; closed group
2441 (setq indent (wl-match-buffer 1))
2442 (setq name (wl-folder-get-realname (wl-match-buffer 3)))
2443 (setq entity (wl-folder-search-group-entity-by-name
2447 (setcdr (assoc (car entity) wl-folder-group-alist) t)
2448 (if (eq 'access (cadr entity))
2449 (wl-folder-maybe-load-folder-list entity))
2450 (wl-folder-insert-entity indent entity)
2451 (delete-region (save-excursion (beginning-of-line)
2453 (save-excursion (end-of-line)
2455 (set-buffer-modified-p nil))))
2457 (defun wl-folder-open-all-pre ()
2458 (let ((entities (list wl-folder-entity))
2459 entity entity-stack group-entry)
2461 (setq entity (wl-pop entities))
2464 (unless (or (not (setq group-entry
2465 (assoc (car entity) wl-folder-group-alist)))
2467 (setcdr group-entry t)
2468 (when (eq 'access (cadr entity))
2469 (wl-folder-maybe-load-folder-list entity)))
2471 (wl-push entities entity-stack))
2472 (setq entities (nth 2 entity))))
2474 (setq entities (wl-pop entity-stack))))))
2476 (defun wl-folder-open-all (&optional refresh)
2478 (let* ((inhibit-read-only t)
2479 (buffer-read-only nil)
2480 (len (length wl-folder-group-alist))
2485 (wl-folder-prev-entity-skip-invalid t)
2486 (wl-folder-get-entity-from-buffer t)))
2487 (alist wl-folder-group-alist))
2489 (setcdr (pop alist) t))
2491 (wl-folder-insert-entity " " wl-folder-entity)
2492 (wl-folder-move-path id))
2493 (message "Opening all folders...")
2494 (wl-folder-open-all-pre)
2496 (goto-char (point-min))
2497 (while (re-search-forward
2498 "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+\n"
2500 (setq indent (wl-match-buffer 1))
2501 (setq name (wl-folder-get-realname (wl-match-buffer 3)))
2502 (setq entity (wl-folder-search-group-entity-by-name
2506 (setcdr (assoc (car entity) wl-folder-group-alist) t)
2508 (wl-folder-insert-entity indent entity)
2509 (delete-region (save-excursion (beginning-of-line)
2511 (save-excursion (end-of-line)
2513 (when (> len elmo-display-progress-threshold)
2515 (if (or (zerop (% i 5)) (= i len))
2516 (elmo-display-progress
2517 'wl-folder-open-all "Opening all folders..."
2518 (/ (* i 100) len)))))
2519 (when (> len elmo-display-progress-threshold)
2520 (elmo-display-progress
2521 'wl-folder-open-all "Opening all folders..." 100))))
2522 (wl-highlight-folder-path wl-folder-buffer-cur-path)
2523 (message "Opening all folders...done")
2524 (set-buffer-modified-p nil)))
2526 (defun wl-folder-close-all ()
2528 (let ((inhibit-read-only t)
2529 (buffer-read-only nil)
2530 (alist wl-folder-group-alist)
2532 (wl-folder-prev-entity-skip-invalid t)
2533 (wl-folder-get-entity-from-buffer t))))
2535 (setcdr (car alist) nil)
2536 (setq alist (cdr alist)))
2537 (setcdr (assoc (car wl-folder-entity) wl-folder-group-alist) t)
2539 (wl-folder-insert-entity " " wl-folder-entity)
2540 (wl-folder-move-path id)
2541 (wl-highlight-folder-path wl-folder-buffer-cur-path)
2543 (set-buffer-modified-p nil)))
2545 (defun wl-folder-open-close ()
2546 "Open or close parent entity."
2550 (if (wl-folder-buffer-group-p)
2551 ;; if group (whether opend or closed.)
2552 (wl-folder-jump-to-current-entity)
2555 (setq indent (save-excursion
2556 (re-search-forward "\\([ ]*\\)." nil t)
2557 (wl-match-buffer 1)))
2558 (while (looking-at indent)
2560 (wl-folder-jump-to-current-entity))))
2562 (defsubst wl-folder-access-subscribe-p (group folder)
2563 (let (subscr regexp match)
2564 (if (setq subscr (wl-get-assoc-list-value
2565 wl-folder-access-subscribe-alist
2568 (setq regexp (mapconcat 'identity (cdr subscr) "\\|"))
2569 (setq match (string-match regexp folder))
2575 (defun wl-folder-update-access-group (entity new-flist)
2576 (let* ((flist (nth 2 entity))
2577 (unsubscribes (nth 3 entity))
2578 (len (+ (length flist) (length unsubscribes)))
2580 diff new-unsubscribes removes
2581 subscribed-list folder group entry)
2582 ;; check subscribed groups
2585 ((listp (car flist)) ;; group
2586 (setq group (elmo-string (caar flist)))
2588 ((assoc group new-flist) ;; found in new-flist
2589 (setq new-flist (delete (assoc group new-flist)
2591 (if (wl-folder-access-subscribe-p (car entity) group)
2592 (wl-append subscribed-list (list (car flist)))
2593 (wl-append new-unsubscribes (list (car flist)))
2596 (setq wl-folder-group-alist
2597 (delete (wl-string-assoc group wl-folder-group-alist)
2598 wl-folder-group-alist))
2599 (wl-append removes (list (list group))))))
2601 (setq folder (elmo-string (car flist)))
2603 ((member folder new-flist) ;; found in new-flist
2604 (setq new-flist (delete folder new-flist))
2605 (if (wl-folder-access-subscribe-p (car entity) folder)
2606 (wl-append subscribed-list (list (car flist)))
2607 (wl-append new-unsubscribes (list folder))
2610 (wl-append removes (list folder))))))
2611 (when (> len elmo-display-progress-threshold)
2613 (if (or (zerop (% i 10)) (= i len))
2614 (elmo-display-progress
2615 'wl-folder-update-access-group "Updating access group..."
2616 (/ (* i 100) len))))
2617 (setq flist (cdr flist)))
2618 ;; check unsubscribed groups
2621 ((listp (car unsubscribes))
2622 (when (setq entry (assoc (caar unsubscribes) new-flist))
2623 (setq new-flist (delete entry new-flist))
2624 (wl-append new-unsubscribes (list (car unsubscribes)))))
2626 (when (member (car unsubscribes) new-flist)
2627 (setq new-flist (delete (car unsubscribes) new-flist))
2628 (wl-append new-unsubscribes (list (car unsubscribes))))))
2629 (when (> len elmo-display-progress-threshold)
2631 (if (or (zerop (% i 10)) (= i len))
2632 (elmo-display-progress
2633 'wl-folder-update-access-group "Updating access group..."
2634 (/ (* i 100) len))))
2635 (setq unsubscribes (cdr unsubscribes)))
2637 (if (or new-flist removes)
2640 (mapcar '(lambda (x)
2641 (cond ((consp x) (list (car x) 'access))
2645 (let ((new-list new-flist))
2647 (if (not (wl-folder-access-subscribe-p
2649 (if (listp (car new-list))
2654 (wl-append new-unsubscribes (list (car new-list)))
2655 (setq new-flist (delete (car new-list) new-flist)))
2657 ((listp (car new-list))
2658 ;; check group exists
2659 (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
2661 (message "%s: group already exists." (caar new-list))
2663 (wl-append new-unsubscribes (list (car new-list)))
2664 (setq new-flist (delete (car new-list) new-flist)))
2665 (wl-append wl-folder-group-alist
2666 (list (cons (caar new-list) nil)))))))
2667 (setq new-list (cdr new-list))))
2669 (message "%d new folder(s)." (length new-flist))
2670 (message "Updating access group...done"))
2671 (wl-append new-flist subscribed-list) ;; new is first
2672 (run-hooks 'wl-folder-update-access-group-hook)
2673 (setcdr (cdr entity) (list new-flist new-unsubscribes))
2674 (list diff new-flist new-unsubscribes removes)))
2676 (defun wl-folder-prefetch-entity (entity)
2677 "Prefetch all new messages in the ENTITY."
2680 (let ((flist (nth 2 entity))
2685 (setq result (wl-folder-prefetch-entity (car flist)))
2686 (setq sum-done (+ sum-done (car result)))
2687 (setq sum-all (+ sum-all (cdr result)))
2688 (setq flist (cdr flist)))
2689 (message "Prefetched %d/%d message(s) in \"%s\"."
2691 (wl-folder-get-petname (car entity)))
2692 (cons sum-done sum-all)))
2694 (let* ((folder (wl-folder-get-elmo-folder entity))
2695 (nums (wl-folder-get-entity-info entity))
2696 (wl-summary-highlight (if (or (wl-summary-sticky-p folder)
2697 (wl-summary-always-sticky-folder-p
2699 wl-summary-highlight))
2700 wl-summary-exit-next-move
2701 wl-auto-select-first ret-val
2703 (setq count (or (car nums) 0))
2704 (setq count (+ count (wl-folder-count-incorporates folder)))
2705 (if (or (null (car nums)) ; unknown
2707 (save-window-excursion
2709 (let ((wl-summary-buffer-name
2710 (if (setq sticky (get-buffer
2711 (wl-summary-sticky-buffer-name
2712 (elmo-folder-name-internal
2714 ;; Sticky folder exists.
2715 (wl-summary-sticky-buffer-name
2716 (elmo-folder-name-internal folder))
2718 wl-summary-buffer-name
2719 (symbol-name this-command))))
2720 (wl-summary-use-frame nil)
2721 (wl-summary-always-sticky-folder-list nil))
2722 (wl-summary-goto-folder-subr entity
2723 (wl-summary-get-sync-range
2726 (setq ret-val (wl-summary-incorporate))
2728 (wl-summary-save-status)
2733 (defun wl-folder-count-incorporates (folder)
2734 (let ((marks (elmo-msgdb-mark-load
2735 (elmo-folder-msgdb-path folder)))
2738 (if (member (cadr (car marks))
2739 wl-summary-incorporate-marks)
2741 (setq marks (cdr marks)))
2744 (defun wl-folder-prefetch-current-entity (&optional no-check)
2745 "Prefetch all uncached messages in the folder at position.
2746 If current line is group folder, all subfolders are prefetched."
2749 (let ((entity-name (wl-folder-get-entity-from-buffer))
2750 (group (wl-folder-buffer-group-p))
2751 wl-folder-check-entity-hook
2756 (wl-folder-search-group-entity-by-name entity-name
2760 (wl-folder-check-entity entity))
2761 (wl-folder-prefetch-entity entity)))))
2763 ;(defun wl-folder-drop-unsync-entity (entity)
2764 ; "Drop all unsync messages in the ENTITY."
2767 ; (let ((flist (nth 2 entity)))
2769 ; (wl-folder-drop-unsync-entity (car flist))
2770 ; (setq flist (cdr flist)))))
2772 ; (let ((nums (wl-folder-get-entity-info entity))
2773 ; wl-summary-highlight wl-auto-select-first new)
2774 ; (setq new (or (car nums) 0))
2776 ; (save-window-excursion
2778 ; (let ((wl-summary-buffer-name (concat
2779 ; wl-summary-buffer-name
2780 ; (symbol-name this-command))))
2781 ; (wl-summary-goto-folder-subr entity 'no-sync nil)
2782 ; (wl-summary-drop-unsync)
2783 ; (wl-summary-exit)))))))))
2785 ;(defun wl-folder-drop-unsync-current-entity (&optional force-check)
2786 ; "Drop all unsync messages in the folder at position.
2787 ;If current line is group folder, all subfolders are dropped.
2788 ;If optional arg exists, don't check any folders."
2791 ; (let ((entity-name (wl-folder-get-entity-from-buffer))
2792 ; (group (wl-folder-buffer-group-p))
2793 ; wl-folder-check-entity-hook
2794 ; summary-buf entity)
2795 ; (when (and entity-name
2797 ; "Drop all unsync messages in %s? " entity-name)))
2800 ; (wl-folder-search-group-entity-by-name entity-name
2803 ; (if (null force-check)
2804 ; (wl-folder-check-entity entity))
2805 ; (wl-folder-drop-unsync-entity entity)
2806 ; (message "All unsync messages in %s are dropped!" entity-name)))))
2808 (defun wl-folder-write-current-folder ()
2809 "Write message to current folder's newsgroup or mailing-list.
2810 Call `wl-summary-write-current-folder' with current folder name."
2812 (unless (wl-folder-buffer-group-p)
2813 (wl-summary-write-current-folder
2814 (wl-folder-get-realname (wl-folder-entity-name)))))
2816 (defun wl-folder-mimic-kill-buffer ()
2817 "Kill the current (Folder) buffer with query."
2819 (let ((bufname (read-buffer (format "Kill buffer: (default %s) "
2821 wl-interactive-exit)
2822 (if (or (not bufname)
2823 (string-equal bufname "")
2824 (string-equal bufname (buffer-name)))
2826 (kill-buffer bufname))))
2828 (defun wl-folder-create-subr (folder)
2829 (if (elmo-folder-creatable-p folder)
2830 (if (y-or-n-p (format "Folder %s does not exist, create it? "
2831 (elmo-folder-name-internal folder)))
2834 (setq wl-folder-entity-hashtb
2835 (wl-folder-create-entity-hashtb
2836 (elmo-folder-name-internal folder)
2837 wl-folder-entity-hashtb))
2838 (unless (elmo-folder-create folder)
2839 (error "Create folder failed")))
2840 (error "Folder %s is not created" (elmo-folder-name-internal folder)))
2841 (error "Folder %s does not exist" (elmo-folder-name-internal folder))))
2843 (defun wl-folder-confirm-existence (folder &optional force)
2845 (unless (elmo-folder-exists-p folder)
2846 (wl-folder-create-subr folder))
2847 (unless (or (wl-folder-entity-exists-p (elmo-folder-name-internal folder))
2848 (file-exists-p (elmo-folder-msgdb-path folder))
2849 (elmo-folder-exists-p folder))
2850 (wl-folder-create-subr folder))))
2852 (defun wl-folder-virtual ()
2853 "Goto virtual folder."
2855 (let ((entity (wl-folder-get-entity-from-buffer)))
2856 (if (wl-folder-buffer-group-p)
2860 (mapconcat 'identity
2861 (wl-folder-get-entity-list
2862 (wl-folder-search-group-entity-by-name
2864 wl-folder-entity)) ","))))
2865 (unless entity (error "No folder"))
2866 (wl-folder-goto-folder-subr
2868 (elmo-read-search-condition
2869 wl-fldmgr-make-filter-default)
2872 (defun wl-folder-pick ()
2875 (let* ((condition (car (elmo-parse-search-condition
2876 (elmo-read-search-condition
2877 wl-summary-pick-field-default))))
2878 (entity (wl-folder-get-entity-from-buffer))
2880 (if (wl-folder-buffer-group-p)
2881 (wl-folder-get-entity-list
2882 (wl-folder-search-group-entity-by-name
2887 (while (car folder-list)
2888 (setq ret (elmo-folder-search
2889 (wl-folder-get-elmo-folder (car folder-list))
2894 (list (cons (car folder-list) ret)))))
2895 (setq folder-list (cdr folder-list)))
2897 (message "%s are picked."
2898 (mapconcat '(lambda (res)
2901 (length (cdr res))))
2904 (message "No message was picked.")))))
2906 (defun wl-folder-jump-to-next-summary ()
2908 (when (wl-collect-summary)
2909 (if (get-buffer-window (car (wl-collect-summary)))
2910 (switch-to-buffer-other-window (car (wl-collect-summary))))
2911 (wl-summary-next-buffer)))
2913 (defun wl-folder-jump-to-previous-summary ()
2915 (when (wl-collect-summary)
2916 (if (get-buffer-window (car (wl-collect-summary)))
2917 (switch-to-buffer-other-window (car (wl-collect-summary))))
2918 (wl-summary-previous-buffer)))
2921 (product-provide (provide 'wl-folder) (require 'wl-version))
2923 ;;; wl-folder.el ends here