1 ;;; elmo-multi.el --- Multiple Folder Interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
35 (defvar elmo-multi-divide-number 100000
36 "*Multi divider number.")
40 (luna-define-class elmo-multi-folder (elmo-folder)
41 (children divide-number))
42 (luna-define-internal-accessors 'elmo-multi-folder))
44 (luna-define-method elmo-folder-initialize ((folder
47 (while (> (length (car (setq name (elmo-parse-token name ",")))) 0)
48 (elmo-multi-folder-set-children-internal
50 (nconc (elmo-multi-folder-children-internal
52 (list (elmo-make-folder (car name)))))
53 (setq name (cdr name))
54 (when (and (> (length name) 0)
55 (eq (aref name 0) ?,))
56 (setq name (substring name 1))))
57 (elmo-multi-folder-set-divide-number-internal
59 elmo-multi-divide-number)
62 (luna-define-method elmo-folder-open-internal ((folder elmo-multi-folder))
63 (dolist (fld (elmo-multi-folder-children-internal folder))
64 (elmo-folder-open-internal fld)))
66 (luna-define-method elmo-folder-check ((folder elmo-multi-folder))
67 (dolist (fld (elmo-multi-folder-children-internal folder))
68 (elmo-folder-check fld)))
70 (luna-define-method elmo-folder-close-internal ((folder elmo-multi-folder))
71 (dolist (fld (elmo-multi-folder-children-internal folder))
72 (elmo-folder-close-internal fld)))
74 (luna-define-method elmo-folder-expand-msgdb-path ((folder
76 (expand-file-name (elmo-replace-string-as-filename
77 (elmo-folder-name-internal folder))
78 (expand-file-name "multi"
79 elmo-msgdb-directory)))
81 (luna-define-method elmo-folder-newsgroups ((folder elmo-multi-folder))
85 'elmo-folder-newsgroups
88 'elmo-folder-get-primitive-list
89 (elmo-multi-folder-children-internal folder)))))))
91 (luna-define-method elmo-folder-get-primitive-list ((folder elmo-multi-folder))
94 'elmo-folder-get-primitive-list
95 (elmo-multi-folder-children-internal folder))))
97 (luna-define-method elmo-folder-contains-type ((folder elmo-multi-folder) type)
98 (let ((children (elmo-multi-folder-children-internal folder))
101 (when (elmo-folder-contains-type (car children) type)
104 (setq children (cdr children)))
107 (luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder)
109 (elmo-message-use-cache-p
110 (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
111 (elmo-multi-folder-children-internal folder))
112 (% number (elmo-multi-folder-divide-number-internal folder))))
114 (luna-define-method elmo-message-folder ((folder elmo-multi-folder)
116 (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
117 (elmo-multi-folder-children-internal folder)))
119 (defun elmo-multi-msgdb (msgdb base)
120 (list (mapcar (function
122 (elmo-msgdb-overview-entity-set-number
125 (elmo-msgdb-overview-entity-get-number x)))))
135 (cdr x)))) (nth 2 msgdb))))
137 (defun elmo-multi-split-numbers (folder numlist &optional as-is)
138 (let ((numbers (sort numlist '<))
139 (divider (elmo-multi-folder-divide-number-internal folder))
141 one-list numbers-list)
143 (setq cur-number (+ cur-number 1))
148 (* divider cur-number))
150 (setq one-list (nconc
156 (* divider cur-number))))))
157 (setq numbers (cdr numbers)))
158 (setq numbers-list (nconc numbers-list (list one-list))))
161 (luna-define-method elmo-folder-msgdb-create ((folder elmo-multi-folder)
162 numbers new-mark already-mark
163 seen-mark important-mark
165 (let* ((folders (elmo-multi-folder-children-internal folder))
166 overview number-alist mark-alist entity
171 (setq numbers-list (elmo-multi-split-numbers folder numbers))
173 (while (< cur-number (length folders))
174 (if (nth cur-number numbers-list)
179 (elmo-folder-msgdb-create (nth cur-number folders)
180 (nth cur-number numbers-list)
181 new-mark already-mark
182 seen-mark important-mark
184 (* (elmo-multi-folder-divide-number-internal folder)
186 (setq cur-number (1+ cur-number)))
187 (elmo-msgdb-sort-by-date msgdb)))
189 (luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder)
192 (let ((number-alists (elmo-multi-split-number-alist
194 (elmo-msgdb-get-number-alist
195 (elmo-folder-msgdb folder))))
197 (dolist (child (elmo-multi-folder-children-internal folder))
198 (elmo-folder-process-crosspost child (car number-alists))
199 (setq cur-number (+ 1 cur-number)
200 number-alists (cdr number-alists)))))
202 (defsubst elmo-multi-folder-append-msgdb (folder append-msgdb)
204 (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
205 (all-alist (copy-sequence (append
206 (elmo-msgdb-get-number-alist
207 (elmo-folder-msgdb folder))
210 overview to-be-deleted
213 (setq all-alist (delq (car cur) all-alist))
214 ;; same message id exists.
215 (if (setq same (rassoc (cdr (car cur)) all-alist))
216 (unless (= (/ (car (car cur))
217 (elmo-multi-folder-divide-number-internal folder))
219 (elmo-multi-folder-divide-number-internal folder)))
220 ;; base is also same...delete it!
222 (append to-be-deleted (list (car (car cur)))))))
223 (setq cur (cdr cur)))
224 (cond ((eq (elmo-folder-process-duplicates-internal folder)
227 (elmo-msgdb-append-to-killed-list folder to-be-deleted)
228 (setq overview (elmo-delete-if
230 (memq (elmo-msgdb-overview-entity-get-number
233 (elmo-msgdb-get-overview append-msgdb)))
234 ;; Should be mark as read.
235 (elmo-folder-mark-as-read folder to-be-deleted)
236 (elmo-msgdb-set-overview append-msgdb overview))
237 ((eq (elmo-folder-process-duplicates-internal folder)
239 ;; Mark as read duplicates.
240 (elmo-folder-mark-as-read folder to-be-deleted))
243 (setq to-be-deleted nil)))
244 (elmo-folder-set-msgdb-internal folder
246 (elmo-folder-msgdb folder)
248 (length to-be-deleted))
251 (luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder)
253 (elmo-multi-folder-append-msgdb folder append-msgdb))
255 (defmacro elmo-multi-real-folder-number (folder number)
256 "Returns a cons cell of real FOLDER and NUMBER."
259 (elmo-multi-folder-divide-number-internal (, folder)))
260 1) (elmo-multi-folder-children-internal (, folder)))
261 (% (, number) (elmo-multi-folder-divide-number-internal
264 (defsubst elmo-multi-find-fetch-strategy (folder entity ignore-cache)
266 (let ((pair (elmo-multi-real-folder-number
268 (elmo-msgdb-overview-entity-get-number entity)))
269 (new-entity (elmo-msgdb-copy-overview-entity entity)))
271 (elmo-msgdb-overview-entity-set-number new-entity (cdr pair)))
272 (elmo-find-fetch-strategy (car pair) new-entity ignore-cache))
273 (elmo-make-fetch-strategy 'entire)))
275 (luna-define-method elmo-find-fetch-strategy
276 ((folder elmo-multi-folder)
277 entity &optional ignore-cache)
278 (elmo-multi-find-fetch-strategy folder entity ignore-cache))
280 (luna-define-method elmo-message-fetch ((folder elmo-multi-folder)
282 &optional section outbuf unseen)
283 (let ((pair (elmo-multi-real-folder-number folder number)))
284 (elmo-message-fetch (car pair) (cdr pair) strategy section outbuf unseen)))
286 (luna-define-method elmo-folder-delete-messages ((folder elmo-multi-folder)
288 (let ((flds (elmo-multi-folder-children-internal folder))
291 (setq one-list-list (elmo-multi-split-numbers folder numbers))
292 (while (< cur-number (length flds))
293 (elmo-folder-delete-messages (nth cur-number flds)
294 (nth cur-number one-list-list))
295 (setq cur-number (+ 1 cur-number)))
298 (luna-define-method elmo-folder-diff ((folder elmo-multi-folder)
300 (elmo-multi-folder-diff folder numbers))
302 (defun elmo-multi-folder-diff (folder numbers)
303 (let ((flds (elmo-multi-folder-children-internal folder))
304 (numbers (mapcar 'car
305 (elmo-msgdb-number-load
306 (elmo-folder-msgdb-path folder))))
307 (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
313 ;; If first time, dummy numbers is used as current number list.
316 (divider (elmo-multi-folder-divide-number-internal folder)))
317 (dolist (folder flds)
320 (cons (* i divider) numbers)))))
322 (elmo-multi-split-numbers folder
325 (elmo-number-set-to-number-list killed)
328 (setq nums (elmo-folder-diff (car flds) (car num-list))
329 nums (cons (elmo-diff-unread nums) (elmo-diff-all nums)))
330 (setq diffs (nconc diffs (list nums)))
331 (setq count (+ 1 count))
332 (setq num-list (cdr num-list))
333 (setq flds (cdr flds)))
335 (and (car (car diffs))
336 (setq unsync (+ unsync (car (car diffs)))))
337 (setq messages (+ messages (cdr (car diffs))))
338 (setq diffs (cdr diffs)))
339 (elmo-folder-set-info-hashtb folder nil messages)
340 (cons unsync messages)))
342 (defun elmo-multi-split-number-alist (folder number-alist)
343 (let ((alist (sort (copy-sequence number-alist)
344 (lambda (pair1 pair2)
345 (< (car pair1)(car pair2)))))
349 (setq cur-number (+ cur-number 1))
353 (/ (- (setq num (car (car alist)))
354 (* elmo-multi-divide-number cur-number))
355 (elmo-multi-folder-divide-number-internal folder))))
356 (setq one-alist (nconc
360 (% num (* (elmo-multi-folder-divide-number-internal
362 (cdr (car alist))))))
363 (setq alist (cdr alist)))
364 (setq split (nconc split (list one-alist))))
367 (defun elmo-multi-split-mark-alist (folder mark-alist)
369 (alist (sort (copy-sequence mark-alist)
370 (lambda (pair1 pair2)
371 (< (car pair1)(car pair2)))))
374 (setq cur-number (+ cur-number 1))
378 (/ (- (car (car alist))
379 (* (elmo-multi-folder-divide-number-internal
381 (elmo-multi-folder-divide-number-internal folder))))
382 (setq one-alist (nconc
385 (list (% (car (car alist))
386 (* (elmo-multi-folder-divide-number-internal
388 (cadr (car alist))))))
389 (setq alist (cdr alist)))
390 (setq result (nconc result (list one-alist))))
393 (luna-define-method elmo-folder-list-unreads-internal
394 ((folder elmo-multi-folder) unread-marks &optional mark-alist)
395 (elmo-multi-folder-list-unreads-internal folder unread-marks))
397 (defun elmo-multi-folder-list-unreads-internal (folder unread-marks)
398 (let ((folders (elmo-multi-folder-children-internal folder))
399 (mark-alists (elmo-multi-split-mark-alist
401 (elmo-msgdb-get-mark-alist
402 (elmo-folder-msgdb folder))))
407 (setq cur-number (+ cur-number 1))
408 (unless (listp (setq unreads
409 (elmo-folder-list-unreads-internal
410 (car folders) unread-marks (car mark-alists))))
411 (setq unreads (delq nil
414 (if (member (cadr x) unread-marks)
416 (car mark-alists)))))
423 (elmo-multi-folder-divide-number-internal
426 (setq mark-alists (cdr mark-alists)
427 folders (cdr folders)))
430 (luna-define-method elmo-folder-list-importants-internal
431 ((folder elmo-multi-folder) important-mark)
432 (let ((folders (elmo-multi-folder-children-internal folder))
433 (mark-alists (elmo-multi-split-mark-alist
435 (elmo-msgdb-get-mark-alist
436 (elmo-folder-msgdb folder))))
441 (setq cur-number (+ cur-number 1))
442 (when (listp (setq importants
443 (elmo-folder-list-importants-internal
444 (car folders) important-mark)))
446 (nconc all-importants
451 (elmo-multi-folder-divide-number-internal
454 (setq mark-alists (cdr mark-alists)
455 folders (cdr folders)))
458 (luna-define-method elmo-folder-list-messages-internal
459 ((folder elmo-multi-folder) &optional nohide)
460 (let* ((flds (elmo-multi-folder-children-internal folder))
464 (setq cur-number (+ cur-number 1))
465 (setq list (elmo-folder-list-messages-internal (car flds)))
474 (* (elmo-multi-folder-divide-number-internal
475 folder) cur-number) x)))
481 (eq cur-number (/ num
482 (elmo-multi-folder-divide-number-internal
486 (elmo-msgdb-get-number-alist
487 (elmo-folder-msgdb folder)))))))
488 (setq flds (cdr flds)))
491 (luna-define-method elmo-folder-exists-p ((folder elmo-multi-folder))
492 (let ((flds (elmo-multi-folder-children-internal folder)))
495 (unless (elmo-folder-exists-p (car flds))
497 (setq flds (cdr flds)))
500 (luna-define-method elmo-folder-creatable-p ((folder elmo-multi-folder))
501 (let ((flds (elmo-multi-folder-children-internal folder)))
504 (when (and (elmo-folder-creatable-p (car flds))
505 (not (elmo-folder-exists-p (car flds))))
506 ;; If folder already exists, don't to `creatable'.
507 ;; Because this function is called, when folder doesn't exists.
508 (throw 'creatable t))
509 (setq flds (cdr flds)))
512 (luna-define-method elmo-folder-create ((folder elmo-multi-folder))
513 (let ((flds (elmo-multi-folder-children-internal folder)))
516 (unless (or (elmo-folder-exists-p (car flds))
517 (elmo-folder-create (car flds)))
519 (setq flds (cdr flds)))
522 (luna-define-method elmo-folder-search ((folder elmo-multi-folder)
523 condition &optional numlist)
524 (let* ((flds (elmo-multi-folder-children-internal folder))
526 numlist-list cur-numlist ; for filtered search.
530 (elmo-multi-split-numbers folder numlist t)))
532 (setq cur-number (+ cur-number 1))
534 (setq cur-numlist (car numlist-list))
535 (if (null cur-numlist)
536 ;; t means filter all.
537 (setq cur-numlist t)))
538 (setq ret-val (append
546 (* (elmo-multi-folder-divide-number-internal
547 folder) cur-number) x)))
549 (car flds) condition)))))
551 (setq numlist-list (cdr numlist-list)))
552 (setq flds (cdr flds)))
555 (luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder)
557 (let ((pair (elmo-multi-real-folder-number folder number)))
558 (elmo-message-use-cache-p (car pair) (cdr pair))))
560 (luna-define-method elmo-message-file-p ((folder elmo-multi-folder) number)
561 (let ((pair (elmo-multi-real-folder-number folder number)))
562 (elmo-message-file-p (car pair) (cdr pair))))
564 (luna-define-method elmo-message-file-name ((folder elmo-multi-folder) number)
565 (let ((pair (elmo-multi-real-folder-number folder number)))
566 (elmo-message-file-name (car pair) (cdr pair))))
568 (luna-define-method elmo-folder-plugged-p ((folder elmo-multi-folder))
569 (let ((flds (elmo-multi-folder-children-internal folder)))
572 (unless (elmo-folder-plugged-p (car flds))
573 (throw 'plugged nil))
574 (setq flds (cdr flds)))
577 (luna-define-method elmo-folder-set-plugged ((folder elmo-multi-folder)
579 (let ((flds (elmo-multi-folder-children-internal folder)))
581 (elmo-folder-set-plugged fld plugged add))))
583 (defun elmo-multi-folder-numbers-list-assoc (folder folder-numbers)
585 (while folder-numbers
586 (when (string= (elmo-folder-name-internal (car (car folder-numbers)))
587 (elmo-folder-name-internal folder))
588 (setq ent (car folder-numbers)
590 (setq folder-numbers (cdr folder-numbers)))
593 (defun elmo-multi-make-folder-numbers-list (folder msgs)
594 (let ((msg-list msgs)
598 (when (and (numberp (car msg-list))
599 (> (car msg-list) 0))
600 (setq pair (elmo-multi-real-folder-number folder (car msg-list)))
601 (if (setq fld-list (elmo-multi-folder-numbers-list-assoc
604 (setcdr fld-list (cons (cdr pair) (cdr fld-list)))
605 (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val))))
606 (setq msg-list (cdr msg-list)))
609 (luna-define-method elmo-folder-mark-as-important ((folder elmo-multi-folder)
611 (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
612 (elmo-folder-mark-as-important (car folder-numbers)
613 (cdr folder-numbers)))
616 (luna-define-method elmo-folder-unmark-important ((folder elmo-multi-folder)
618 (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
619 (elmo-folder-unmark-important (car folder-numbers)
620 (cdr folder-numbers)))
623 (luna-define-method elmo-folder-mark-as-read ((folder elmo-multi-folder)
625 (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
626 (elmo-folder-mark-as-read (car folder-numbers)
627 (cdr folder-numbers)))
630 (luna-define-method elmo-folder-unmark-read ((folder elmo-multi-folder)
632 (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
633 (elmo-folder-unmark-read (car folder-numbers)
634 (cdr folder-numbers)))
638 (product-provide (provide 'elmo-multi) (require 'elmo-version))
640 ;;; elmo-multi.el ends here