-;;; elmo-multi.el -- Multiple Folder Interface for ELMO.
+;;; elmo-multi.el --- Multiple Folder Interface for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'elmo)
(require 'luna)
+
+(defvar elmo-multi-divide-number 100000
+ "*Multi divider number.")
+
;;; ELMO Multi folder
(eval-and-compile
(luna-define-class elmo-multi-folder (elmo-folder)
(luna-define-method elmo-folder-initialize ((folder
elmo-multi-folder)
name)
- (elmo-multi-folder-set-children-internal
- folder
- (mapcar 'elmo-make-folder (split-string name ",")))
+ (while (> (length (car (setq name (elmo-parse-token name ",")))) 0)
+ (elmo-multi-folder-set-children-internal
+ folder
+ (nconc (elmo-multi-folder-children-internal
+ folder)
+ (list (elmo-make-folder (car name)))))
+ (setq name (cdr name))
+ (when (and (> (length name) 0)
+ (eq (aref name 0) ?,))
+ (setq name (substring name 1))))
(elmo-multi-folder-set-divide-number-internal
folder
elmo-multi-divide-number)
(luna-define-method elmo-folder-expand-msgdb-path ((folder
elmo-multi-folder))
- (expand-file-name (elmo-replace-string-as-filename
+ (expand-file-name (elmo-replace-string-as-filename
(elmo-folder-name-internal folder))
(expand-file-name "multi"
- elmo-msgdb-dir)))
+ elmo-msgdb-directory)))
+
+(luna-define-method elmo-folder-newsgroups ((folder elmo-multi-folder))
+ (delq nil
+ (elmo-flatten
+ (mapcar
+ 'elmo-folder-newsgroups
+ (elmo-flatten
+ (mapcar
+ 'elmo-folder-get-primitive-list
+ (elmo-multi-folder-children-internal folder)))))))
(luna-define-method elmo-folder-get-primitive-list ((folder elmo-multi-folder))
(elmo-flatten
- (mapcar
+ (mapcar
'elmo-folder-get-primitive-list
(elmo-multi-folder-children-internal folder))))
(setq children (cdr children)))
match))
-(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder)
- number)
- (elmo-message-use-cache-p
- (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
- (elmo-multi-folder-children-internal folder))
- (% number (elmo-multi-folder-divide-number-internal folder))))
-
(luna-define-method elmo-message-folder ((folder elmo-multi-folder)
number)
(nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
(setq cur-number (1+ cur-number)))
(elmo-msgdb-sort-by-date msgdb)))
+(luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder)
+ &optional
+ number-alist)
+ (let ((number-alists (elmo-multi-split-number-alist
+ folder
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb folder))))
+ (cur-number 1))
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (elmo-folder-process-crosspost child (car number-alists))
+ (setq cur-number (+ 1 cur-number)
+ number-alists (cdr number-alists)))))
+
(defsubst elmo-multi-folder-append-msgdb (folder append-msgdb)
- (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
- (all-alist (copy-sequence (append
- (elmo-msgdb-get-number-alist
- (elmo-folder-msgdb-internal folder))
- number-alist)))
- (cur number-alist)
- to-be-deleted
- mark-alist same)
- (while cur
- (setq all-alist (delq (car cur) all-alist))
- ;; same message id exists.
- (if (setq same (rassoc (cdr (car cur)) all-alist))
- (unless (= (/ (car (car cur))
- (elmo-multi-folder-divide-number-internal folder))
- (/ (car same)
- (elmo-multi-folder-divide-number-internal folder)))
- ;; base is also same...delete it!
- (setq to-be-deleted (append to-be-deleted (list (car cur))))))
- (setq cur (cdr cur)))
- (setq mark-alist (elmo-delete-if
- (function
- (lambda (x)
- (assq (car x) to-be-deleted)))
- (elmo-msgdb-get-mark-alist append-msgdb)))
- (elmo-msgdb-set-mark-alist append-msgdb mark-alist)
- (elmo-folder-set-msgdb-internal folder
- (elmo-msgdb-append
- (elmo-folder-msgdb-internal folder)
- append-msgdb t))
- (length to-be-deleted)))
+ (if append-msgdb
+ (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
+ (all-alist (copy-sequence (append
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb folder))
+ number-alist)))
+ (cur number-alist)
+ overview to-be-deleted
+ mark-alist same)
+ (while cur
+ (setq all-alist (delq (car cur) all-alist))
+ ;; same message id exists.
+ (if (setq same (rassoc (cdr (car cur)) all-alist))
+ (unless (= (/ (car (car cur))
+ (elmo-multi-folder-divide-number-internal folder))
+ (/ (car same)
+ (elmo-multi-folder-divide-number-internal folder)))
+ ;; base is also same...delete it!
+ (setq to-be-deleted
+ (append to-be-deleted (list (car (car cur)))))))
+ (setq cur (cdr cur)))
+ (cond ((eq (elmo-folder-process-duplicates-internal folder)
+ 'hide)
+ ;; Hide duplicates.
+ (elmo-msgdb-append-to-killed-list folder to-be-deleted)
+ (setq overview (elmo-delete-if
+ (lambda (x)
+ (memq (elmo-msgdb-overview-entity-get-number
+ x)
+ to-be-deleted))
+ (elmo-msgdb-get-overview append-msgdb)))
+ ;; Should be mark as read.
+ (elmo-folder-mark-as-read folder to-be-deleted)
+ (elmo-msgdb-set-overview append-msgdb overview))
+ ((eq (elmo-folder-process-duplicates-internal folder)
+ 'read)
+ ;; Mark as read duplicates.
+ (elmo-folder-mark-as-read folder to-be-deleted))
+ (t
+ ;; Do nothing.
+ (setq to-be-deleted nil)))
+ (elmo-folder-set-msgdb-internal folder
+ (elmo-msgdb-append
+ (elmo-folder-msgdb folder)
+ append-msgdb t))
+ (length to-be-deleted))
+ 0))
(luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder)
append-msgdb)
(unsync 0)
(messages 0)
num-list
- diffs)
+ diffs nums)
+ ;; If first time, dummy numbers is used as current number list.
+ (unless numbers
+ (let ((i 0)
+ (divider (elmo-multi-folder-divide-number-internal folder)))
+ (dolist (folder flds)
+ (setq i (+ i 1))
+ (setq numbers
+ (cons (* i divider) numbers)))))
(setq num-list
(elmo-multi-split-numbers folder
(elmo-uniq-list
(elmo-number-set-to-number-list killed)
numbers))))
(while flds
- (setq diffs (nconc diffs (list (elmo-folder-diff
- (car flds)
- (car num-list)))))
+ (setq nums (elmo-folder-diff (car flds) (car num-list))
+ nums (cons (elmo-diff-unread nums) (elmo-diff-all nums)))
+ (setq diffs (nconc diffs (list nums)))
(setq count (+ 1 count))
(setq num-list (cdr num-list))
(setq flds (cdr flds)))
(elmo-folder-set-info-hashtb folder nil messages)
(cons unsync messages)))
+(defun elmo-multi-split-number-alist (folder number-alist)
+ (let ((alist (sort (copy-sequence number-alist)
+ (lambda (pair1 pair2)
+ (< (car pair1)(car pair2)))))
+ (cur-number 0)
+ one-alist split num)
+ (while alist
+ (setq cur-number (+ cur-number 1))
+ (setq one-alist nil)
+ (while (and alist
+ (eq 0
+ (/ (- (setq num (car (car alist)))
+ (* elmo-multi-divide-number cur-number))
+ (elmo-multi-folder-divide-number-internal folder))))
+ (setq one-alist (nconc
+ one-alist
+ (list
+ (cons
+ (% num (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number))
+ (cdr (car alist))))))
+ (setq alist (cdr alist)))
+ (setq split (nconc split (list one-alist))))
+ split))
+
(defun elmo-multi-split-mark-alist (folder mark-alist)
(let ((cur-number 0)
(alist (sort (copy-sequence mark-alist)
result))
(luna-define-method elmo-folder-list-unreads-internal
- ((folder elmo-multi-folder) unread-marks)
+ ((folder elmo-multi-folder) unread-marks &optional mark-alist)
(elmo-multi-folder-list-unreads-internal folder unread-marks))
(defun elmo-multi-folder-list-unreads-internal (folder unread-marks)
(mark-alists (elmo-multi-split-mark-alist
folder
(elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(cur-number 0)
unreads
all-unreads)
(setq cur-number (+ cur-number 1))
(unless (listp (setq unreads
(elmo-folder-list-unreads-internal
- (car folders) unread-marks)))
+ (car folders) unread-marks (car mark-alists))))
(setq unreads (delq nil
(mapcar
(lambda (x)
(mark-alists (elmo-multi-split-mark-alist
folder
(elmo-msgdb-get-mark-alist
- (elmo-folder-msgdb-internal folder))))
+ (elmo-folder-msgdb folder))))
(cur-number 0)
importants
all-importants)
(while folders
(setq cur-number (+ cur-number 1))
- (unless (listp (setq importants
- (elmo-folder-list-importants-internal
- (car folders) important-mark)))
- (setq importants (delq nil
- (mapcar
- (lambda (x)
- (if (string= (cadr x) important-mark)
- (car x)))
- (car mark-alists)))))
- (setq all-importants
- (nconc all-importants
- (mapcar
- (lambda (x)
- (+ x
- (* cur-number
- (elmo-multi-folder-divide-number-internal
- folder))))
- importants)))
+ (when (listp (setq importants
+ (elmo-folder-list-importants-internal
+ (car folders) important-mark)))
+ (setq all-importants
+ (nconc all-importants
+ (mapcar
+ (lambda (x)
+ (+ x
+ (* cur-number
+ (elmo-multi-folder-divide-number-internal
+ folder))))
+ importants))))
(setq mark-alists (cdr mark-alists)
folders (cdr folders)))
all-importants))
(luna-define-method elmo-folder-list-messages-internal
- ((folder elmo-multi-folder))
+ ((folder elmo-multi-folder) &optional nohide)
(let* ((flds (elmo-multi-folder-children-internal folder))
(cur-number 0)
- numbers)
+ list numbers)
(while flds
(setq cur-number (+ cur-number 1))
- (setq numbers (append
- numbers
- (mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal
- folder) cur-number) x)))
- (elmo-folder-list-messages-internal (car flds)))))
+ (setq list (elmo-folder-list-messages-internal (car flds)))
+ (setq numbers
+ (append
+ numbers
+ (if (listp list)
+ (mapcar
+ (function
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number) x)))
+ list)
+ ;; Use current list.
+ (elmo-delete-if
+ (lambda (num)
+ (not
+ (eq cur-number (/ num
+ (elmo-multi-folder-divide-number-internal
+ folder)))))
+ (mapcar
+ 'car
+ (elmo-msgdb-get-number-alist
+ (elmo-folder-msgdb folder)))))))
(setq flds (cdr flds)))
numbers))
(luna-define-method elmo-message-file-name ((folder elmo-multi-folder) number)
(let ((pair (elmo-multi-real-folder-number folder number)))
(elmo-message-file-name (car pair) (cdr pair))))
-
+
(luna-define-method elmo-folder-plugged-p ((folder elmo-multi-folder))
(let ((flds (elmo-multi-folder-children-internal folder)))
(catch 'plugged
(elmo-folder-mark-as-important (car folder-numbers)
(cdr folder-numbers)))
t)
-
+
(luna-define-method elmo-folder-unmark-important ((folder elmo-multi-folder)
numbers)
(dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
projects / elisp / wanderlust.git / blobdiff