-;;
-
-(require 'elmo-msgdb)
-(require 'elmo-vars)
-(require 'elmo2)
-
-(defun elmo-multi-msgdb (msgdb base)
- (list (mapcar (function
- (lambda (x)
- (elmo-msgdb-overview-entity-set-number
- x
- (+ base
- (elmo-msgdb-overview-entity-get-number x)))))
- (nth 0 msgdb))
- (mapcar (function
- (lambda (x) (cons
- (+ base (car x))
- (cdr x))))
- (nth 1 msgdb))
- (mapcar (function
- (lambda (x) (cons
- (+ base (car x))
- (cdr x)))) (nth 2 msgdb))))
-
-(defun elmo-multi-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- (when numlist
- (let* ((flds (cdr spec))
- overview number-alist mark-alist entity
- one-list-list
- cur-number
- i percent num
- ret-val)
- (setq one-list-list (elmo-multi-get-intlist-list numlist))
- (setq cur-number 0)
- (while (< cur-number (length flds))
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-multi-msgdb
- (elmo-msgdb-create-as-numlist (nth cur-number flds)
- (nth cur-number one-list-list)
- new-mark already-mark
- seen-mark important-mark
- seen-list)
- (* elmo-multi-divide-number (1+ cur-number)))))
- (setq cur-number (1+ cur-number)))
- (elmo-msgdb-sort-by-date ret-val))))
-
-;; returns append-msgdb
-(defun elmo-multi-delete-crossposts (already-msgdb append-msgdb)
- (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
- (dummy (copy-sequence (append
- number-alist
- (elmo-msgdb-get-number-alist already-msgdb))))
- (cur number-alist)
- to-be-deleted
- overview mark-alist
- same)
- (while cur
- (setq dummy (delq (car cur) dummy))
- (if (setq same (rassoc (cdr (car cur)) dummy)) ;; same message id is remained
- (unless (= (/ (car (car cur)) elmo-multi-divide-number)
- (/ (car same) elmo-multi-divide-number))
- ;; base is also same...delete it!
- (setq to-be-deleted (append to-be-deleted (list (car cur))))))
- (setq cur (cdr cur)))
- (setq overview (elmo-delete-if
- (function
- (lambda (x)
- (assq
- (elmo-msgdb-overview-entity-get-number x)
- to-be-deleted)))
- (elmo-msgdb-get-overview append-msgdb)))
- (setq mark-alist (elmo-delete-if
- (function
- (lambda (x)
- (assq
- (car x) to-be-deleted)))
- (elmo-msgdb-get-mark-alist append-msgdb)))
- ;; keep number-alist untouched for folder diff!!
- (cons (and to-be-deleted (length to-be-deleted))
- (list overview number-alist mark-alist))))
-
-(defun elmo-multi-msgdb-create (spec numlist new-mark already-mark
- seen-mark important-mark seen-list)
- (when numlist
- (let* ((flds (cdr spec))
- overview number-alist mark-alist entity
- one-list-list
- cur-number
- i percent num
- ret-val)
- (setq one-list-list (elmo-multi-get-intlist-list numlist))
- (setq cur-number 0)
- (while (< cur-number (length flds))
- (setq ret-val
- (elmo-msgdb-append
- ret-val
- (elmo-multi-msgdb
- (elmo-msgdb-create (nth cur-number flds)
- (nth cur-number one-list-list)
- new-mark already-mark
- seen-mark important-mark
- seen-list)
- (* elmo-multi-divide-number (1+ cur-number)))))
- (setq cur-number (1+ cur-number)))
- (elmo-msgdb-sort-by-date ret-val))))
-
-(defun elmo-multi-list-folders (spec &optional hierarchy)
- ;; not implemented.
- nil)
-
-(defun elmo-multi-append-msg (spec string)
- (error "Cannot append messages to multi folder"))
-
-(defun elmo-multi-read-msg (spec number outbuf &optional msgdb unread)
- (let* ((flds (cdr spec))
- (folder (nth (- (/ number elmo-multi-divide-number) 1) flds))
- (number (% number elmo-multi-divide-number)))
- (elmo-call-func folder "read-msg" number outbuf msgdb unread)))
-
-(defun elmo-multi-delete-msgs (spec msgs)
- (let ((flds (cdr spec))
+;;
+
+(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)
+ (children divide-number))
+ (luna-define-internal-accessors 'elmo-multi-folder))
+
+(defmacro elmo-multi-real-folder-number (folder number)
+ "Returns a cons cell of real FOLDER and NUMBER."
+ (` (cons (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-folder-initialize ((folder
+ elmo-multi-folder)
+ 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)
+ folder)
+
+(luna-define-method elmo-folder-open-internal ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-open-internal fld)))
+
+(luna-define-method elmo-folder-check ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-check fld)))
+
+(luna-define-method elmo-folder-close-internal ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-close-internal fld)))
+
+(luna-define-method elmo-folder-close :after ((folder elmo-multi-folder))
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-set-msgdb-internal fld nil)))
+
+(luna-define-method elmo-folder-synchronize ((folder elmo-multi-folder)
+ &optional
+ disable-killed
+ ignore-msgdb
+ no-check)
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (elmo-folder-synchronize fld disable-killed ignore-msgdb no-check))
+ 0)
+
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-multi-folder))
+ (expand-file-name (elmo-replace-string-as-filename
+ (elmo-folder-name-internal folder))
+ (expand-file-name "multi"
+ 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
+ 'elmo-folder-get-primitive-list
+ (elmo-multi-folder-children-internal folder))))
+
+(luna-define-method elmo-folder-contains-type ((folder elmo-multi-folder) type)
+ (let ((children (elmo-multi-folder-children-internal folder))
+ match)
+ (while children
+ (when (elmo-folder-contains-type (car children) type)
+ (setq match t)
+ (setq children nil))
+ (setq children (cdr children)))
+ match))
+
+(luna-define-method elmo-message-folder ((folder elmo-multi-folder)
+ number)
+ (nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
+ (elmo-multi-folder-children-internal folder)))
+
+(luna-define-method elmo-message-cached-p ((folder elmo-multi-folder) number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-cached-p (car pair) (cdr pair))))
+
+(luna-define-method elmo-message-set-cached ((folder elmo-multi-folder)
+ number cached)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-set-cached (car pair) (cdr pair) cached)))
+
+(luna-define-method elmo-find-fetch-strategy
+ ((folder elmo-multi-folder) entity &optional ignore-cache)
+ (let ((pair (elmo-multi-real-folder-number
+ folder
+ (elmo-message-entity-number entity))))
+ (elmo-find-fetch-strategy
+ (car pair)
+ (elmo-message-entity (car pair) (cdr pair)) ignore-cache)))
+
+(luna-define-method elmo-message-entity ((folder elmo-multi-folder) key)
+ (cond
+ ((numberp key)
+ (let* ((pair (elmo-multi-real-folder-number folder key))
+ (entity (elmo-message-entity (car pair) (cdr pair))))
+ (when entity
+ (elmo-message-entity-set-number (elmo-message-copy-entity entity)
+ key))))
+ ((stringp key)
+ (let ((children (elmo-multi-folder-children-internal folder))
+ (cur-number 0)
+ match)
+ (while children
+ (setq cur-number (+ cur-number 1))
+ (when (setq match (elmo-message-entity (car children) key))
+ (setq match (elmo-message-copy-entity match))
+ (elmo-message-entity-set-number
+ match
+ (+ (* (elmo-multi-folder-divide-number-internal folder)
+ cur-number)
+ (elmo-message-entity-number match)))
+ (setq children nil))
+ (setq children (cdr children)))
+ match))))
+
+(luna-define-method elmo-message-entity-parent ((folder
+ elmo-multi-folder) entity)
+ (elmo-message-entity
+ folder
+ (elmo-message-entity-field entity 'references)))
+
+(luna-define-method elmo-message-field ((folder elmo-multi-folder)
+ number field)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-field (car pair) (cdr pair) field)))
+
+(luna-define-method elmo-message-mark ((folder elmo-multi-folder) number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-mark (car pair) (cdr pair))))
+
+(luna-define-method elmo-message-flags ((folder elmo-multi-folder) number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-flags (car pair) (cdr pair))))
+
+(defun elmo-multi-split-numbers (folder numlist &optional as-is)
+ (let ((numbers (sort numlist '<))
+ (divider (elmo-multi-folder-divide-number-internal folder))
+ (cur-number 0)
+ one-list numbers-list)
+ (while numbers
+ (setq cur-number (+ cur-number 1))
+ (setq one-list nil)
+ (while (and numbers
+ (eq 0
+ (/ (- (car numbers)
+ (* divider cur-number))
+ divider)))
+ (setq one-list (nconc
+ one-list
+ (list
+ (if as-is
+ (car numbers)
+ (% (car numbers)
+ (* divider cur-number))))))
+ (setq numbers (cdr numbers)))
+ (setq numbers-list (nconc numbers-list (list one-list))))
+ numbers-list))
+
+(luna-define-method elmo-folder-process-crosspost ((folder elmo-multi-folder))
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (elmo-folder-process-crosspost child)))
+
+(luna-define-method elmo-message-fetch ((folder elmo-multi-folder)
+ number strategy
+ &optional section outbuf unseen)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-fetch (car pair) (cdr pair) strategy section outbuf unseen)))
+
+(luna-define-method elmo-folder-delete-messages ((folder elmo-multi-folder)
+ numbers)
+ (let ((flds (elmo-multi-folder-children-internal folder))