;;; Code:
;;
+(eval-when-compile (require 'cl))
(require 'elmo)
+(require 'elmo-signal)
(require 'luna)
(defvar elmo-multi-divide-number 100000
(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)
folder
(nconc (elmo-multi-folder-children-internal
folder)
- (list (elmo-make-folder (car name)))))
+ (list (elmo-get-folder (car name)))))
(setq name (cdr name))
(when (and (> (length name) 0)
(eq (aref name 0) ?,))
(elmo-multi-folder-set-divide-number-internal
folder
elmo-multi-divide-number)
+ (elmo-multi-connect-signals folder)
folder)
+(defun elmo-multi-connect-signals (folder)
+ (elmo-connect-signal
+ nil 'flag-changing folder
+ (elmo-define-signal-handler (folder child number old-flags new-flags)
+ (elmo-emit-signal 'flag-changing folder
+ (car (elmo-multi-map-numbers folder child (list number)))
+ old-flags new-flags))
+ (elmo-define-signal-filter (folder sender)
+ (memq sender (elmo-multi-folder-children-internal folder))))
+ (elmo-connect-signal
+ nil 'flag-changed folder
+ (elmo-define-signal-handler (folder child numbers)
+ (elmo-emit-signal 'flag-changed folder
+ (elmo-multi-map-numbers folder child numbers)))
+ (elmo-define-signal-filter (folder sender)
+ (memq sender (elmo-multi-folder-children-internal folder))))
+ (elmo-connect-signal
+ nil 'status-changed folder
+ (elmo-define-signal-handler (folder child numbers)
+ (elmo-emit-signal 'status-changed folder
+ (elmo-multi-map-numbers folder child numbers)))
+ (elmo-define-signal-filter (folder sender)
+ (memq sender (elmo-multi-folder-children-internal folder))))
+ (elmo-connect-signal
+ nil 'update-overview folder
+ (elmo-define-signal-handler (folder child number)
+ (elmo-emit-signal
+ 'update-overview folder
+ (car (elmo-multi-map-numbers folder child (list number)))))
+ (elmo-define-signal-filter (folder sender)
+ (memq sender (elmo-multi-folder-children-internal folder)))))
+
+(defun elmo-multi-map-numbers (folder child numbers)
+ (let ((multi (catch 'found
+ (let ((children (elmo-multi-folder-children-internal folder))
+ (index 0))
+ (while children
+ (setq index (1+ index))
+ (when (eq (car children) child)
+ (throw 'found index))
+ (setq children (cdr children)))))))
+ (when multi
+ (let ((offset (* (elmo-multi-folder-divide-number-internal folder)
+ multi)))
+ (mapcar (lambda (number) (+ offset number))
+ numbers)))))
+
+
(luna-define-method elmo-folder-open-internal ((folder elmo-multi-folder))
(dolist (fld (elmo-multi-folder-children-internal folder))
- (elmo-folder-open-internal fld)))
+ (unless (elmo-folder-open-internal-p fld)
+ (elmo-folder-open-internal fld))))
+
+(luna-define-method elmo-folder-open-internal-p ((folder elmo-multi-folder))
+ (let (open t)
+ (dolist (fld (elmo-multi-folder-children-internal folder))
+ (setq open (and open (elmo-folder-open-internal-p fld))))))
(luna-define-method elmo-folder-check ((folder elmo-multi-folder))
(dolist (fld (elmo-multi-folder-children-internal folder))
- (elmo-folder-synchronize fld)))
+ (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 :around ((folder elmo-multi-folder))
+(luna-define-method elmo-folder-close ((folder elmo-multi-folder))
+ (elmo-generic-folder-close folder)
(dolist (fld (elmo-multi-folder-children-internal folder))
(elmo-folder-close fld)))
+(luna-define-method elmo-message-killed-p ((folder elmo-multi-folder) number)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-killed-p (car pair) (cdr pair))))
+
+(luna-define-method elmo-folder-synchronize ((folder elmo-multi-folder)
+ &optional
+ disable-killed
+ ignore-msgdb
+ no-check
+ mask)
+ (if mask
+ (dolist (element (elmo-multi-split-numbers folder mask))
+ (when (cdr element)
+ (elmo-folder-synchronize (car element)
+ disable-killed
+ ignore-msgdb
+ no-check
+ (cdr element))))
+ (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-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)))))))
+ (apply #'nconc
+ (mapcar
+ 'elmo-folder-newsgroups
+ (elmo-multi-folder-children-internal folder))))
(luna-define-method elmo-folder-get-primitive-list ((folder elmo-multi-folder))
(elmo-flatten
(nth (- (/ number (elmo-multi-folder-divide-number-internal folder)) 1)
(elmo-multi-folder-children-internal folder)))
-(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))))
+(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)
+ number
+ &optional
+ ignore-cache
+ require-entireness)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-find-fetch-strategy (car pair)
+ (cdr pair)
+ ignore-cache
+ require-entireness)))
+
+(luna-define-method elmo-message-number ((folder elmo-multi-folder)
+ message-id)
+ (let ((children (elmo-multi-folder-children-internal folder))
+ match)
+ (while children
+ (when (setq match (elmo-message-number (car children) message-id))
+ (setq children nil))
+ (setq children (cdr children)))
+ match))
+
+(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
+ (setq entity (elmo-message-copy-entity entity))
+ (elmo-message-entity-set-number entity key)
+ entity)))
+ ((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 &optional type)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-field (car pair) (cdr pair) field type)))
+
+(luna-define-method elmo-message-flag-available-p ((folder
+ elmo-multi-folder) number
+ flag)
+ (let ((pair (elmo-multi-real-folder-number folder number)))
+ (elmo-message-flag-available-p (car pair) (cdr pair) flag)))
+
+(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 '<))
+ (folders (elmo-multi-folder-children-internal folder))
(divider (elmo-multi-folder-divide-number-internal folder))
(cur-number 0)
one-list numbers-list)
(while numbers
+ (setq one-list (list (nth cur-number folders)))
(setq cur-number (+ cur-number 1))
- (setq one-list nil)
(while (and numbers
(eq 0
(/ (- (car numbers)
(setq numbers-list (nconc numbers-list (list one-list))))
numbers-list))
-(luna-define-method elmo-folder-msgdb-create ((folder elmo-multi-folder)
- numbers seen-list)
- (let* ((folders (elmo-multi-folder-children-internal folder))
- overview number-alist mark-alist entity
- numbers-list
- cur-number
- i percent num
- msgdb)
- (setq numbers-list (elmo-multi-split-numbers folder numbers))
- (setq cur-number 0)
- (while (< cur-number (length folders))
- (if (nth cur-number numbers-list)
- (setq msgdb
- (elmo-msgdb-append
- msgdb
- (elmo-multi-msgdb
- (elmo-folder-msgdb-create (nth cur-number folders)
- (nth cur-number numbers-list)
- seen-list)
- (* (elmo-multi-folder-divide-number-internal folder)
- (1+ cur-number))))))
- (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)
- (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))
- (length to-be-deleted))
- 0))
-
-(luna-define-method elmo-folder-append-msgdb ((folder elmo-multi-folder)
- append-msgdb)
- (elmo-multi-folder-append-msgdb folder append-msgdb))
-
-(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))))))
-
-(defsubst elmo-multi-find-fetch-strategy (folder entity ignore-cache)
- (if entity
- (let ((pair (elmo-multi-real-folder-number
- folder
- (elmo-msgdb-overview-entity-get-number entity)))
- (new-entity (elmo-msgdb-copy-overview-entity entity)))
- (setq new-entity
- (elmo-msgdb-overview-entity-set-number new-entity (cdr pair)))
- (elmo-find-fetch-strategy (car pair) new-entity ignore-cache))
- (elmo-make-fetch-strategy 'entire)))
-
-(luna-define-method elmo-find-fetch-strategy
- ((folder elmo-multi-folder)
- entity &optional ignore-cache)
- (elmo-multi-find-fetch-strategy folder entity ignore-cache))
+(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)
+ &optional unseen section)
(let ((pair (elmo-multi-real-folder-number folder number)))
- (elmo-message-fetch (car pair) (cdr pair) strategy section outbuf unseen)))
+ (elmo-message-fetch (car pair) (cdr pair) strategy unseen section)))
(luna-define-method elmo-folder-delete-messages ((folder elmo-multi-folder)
numbers)
- (let ((flds (elmo-multi-folder-children-internal folder))
- one-list-list
- (cur-number 0))
- (setq one-list-list (elmo-multi-split-numbers folder numbers))
- (while (< cur-number (length flds))
- (elmo-folder-delete-messages (nth cur-number flds)
- (nth cur-number one-list-list))
- (setq cur-number (+ 1 cur-number)))
- t))
-
-(luna-define-method elmo-folder-diff ((folder elmo-multi-folder)
- &optional numbers)
- (elmo-multi-folder-diff folder numbers))
-
-(defun elmo-multi-folder-diff (folder numbers)
- (let ((flds (elmo-multi-folder-children-internal folder))
- (numbers (mapcar 'car
- (elmo-msgdb-number-load
- (elmo-folder-msgdb-path folder))))
- (killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
- (count 0)
- (unsync 0)
- (messages 0)
- num-list
- 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
- (nconc
- (elmo-number-set-to-number-list killed)
- numbers))))
- (while flds
- (setq nums (elmo-folder-diff (car flds) (car num-list))
- nums (cons (or (elmo-diff-unread nums)
- (elmo-diff-new 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)))
- (while diffs
- (and (car (car diffs))
- (setq unsync (+ unsync (car (car diffs)))))
- (setq messages (+ messages (cdr (car diffs))))
- (setq diffs (cdr diffs)))
- (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)
- (lambda (pair1 pair2)
- (< (car pair1)(car pair2)))))
- one-alist result)
- (while alist
- (setq cur-number (+ cur-number 1))
- (setq one-alist nil)
- (while (and alist
- (eq 0
- (/ (- (car (car alist))
- (* (elmo-multi-folder-divide-number-internal
- folder) cur-number))
- (elmo-multi-folder-divide-number-internal folder))))
- (setq one-alist (nconc
- one-alist
- (list
- (list (% (car (car alist))
- (* (elmo-multi-folder-divide-number-internal
- folder) cur-number))
- (cadr (car alist))))))
- (setq alist (cdr alist)))
- (setq result (nconc result (list one-alist))))
- result))
-
-(luna-define-method elmo-folder-list-unreads ((folder elmo-multi-folder))
- (let ((cur-number 0)
- unreads)
- (dolist (child (elmo-multi-folder-children-internal folder))
- (setq cur-number (+ cur-number 1))
- (setq unreads
- (nconc
- unreads
- (mapcar (lambda (x)
- (+ x (* cur-number
- (elmo-multi-folder-divide-number-internal
- folder))))
- (elmo-folder-list-unreads child)))))
- unreads))
-
-(luna-define-method elmo-folder-list-answereds ((folder elmo-multi-folder))
- (let ((cur-number 0)
- answereds)
- (dolist (child (elmo-multi-folder-children-internal folder))
- (setq cur-number (+ cur-number 1))
- (setq answereds
- (nconc
- answereds
- (mapcar (lambda (x)
- (+ x (* cur-number
- (elmo-multi-folder-divide-number-internal
- folder))))
- (elmo-folder-list-answereds child)))))
- answereds))
-
-(luna-define-method elmo-folder-list-importants ((folder elmo-multi-folder))
- (let ((cur-number 0)
- importants)
+ (dolist (element (elmo-multi-split-numbers folder numbers))
+ (when (cdr element)
+ (elmo-folder-delete-messages (car element) (cdr element))))
+ t)
+
+(luna-define-method elmo-folder-detach-messages ((folder elmo-multi-folder)
+ numbers)
+ (dolist (element (elmo-multi-split-numbers folder numbers))
+ (when (cdr element)
+ (elmo-folder-detach-messages (car element) (cdr element))))
+ t)
+
+(luna-define-method elmo-folder-diff ((folder elmo-multi-folder))
+ (elmo-multi-folder-diff folder))
+
+(defun elmo-multi-folder-diff (folder)
+ (let ((news 0)
+ (unreads 0)
+ (alls 0)
+ diff value)
(dolist (child (elmo-multi-folder-children-internal folder))
- (setq cur-number (+ cur-number 1))
- (setq importants
- (nconc
- importants
- (mapcar (lambda (x)
- (+ x (* cur-number
- (elmo-multi-folder-divide-number-internal
- folder))))
- (elmo-folder-list-importants child)))))
- (elmo-uniq-list
- (nconc importants
- (elmo-folder-list-messages-with-global-mark
- folder elmo-msgdb-important-mark)))))
-
-(luna-define-method elmo-folder-list-messages-internal
- ((folder elmo-multi-folder) &optional nohide)
+ (setq diff (elmo-folder-diff child))
+ (setq news (and news
+ (setq value (elmo-diff-new diff))
+ (+ news value))
+ unreads (and unreads
+ (setq value (elmo-diff-unread diff))
+ (+ unreads value))
+ alls (and alls
+ (setq value (elmo-diff-all diff))
+ (+ alls value))))
+ (if unreads
+ (list news unreads alls)
+ (cons news alls))))
+
+(luna-define-method elmo-folder-list-messages
+ ((folder elmo-multi-folder) &optional visible-only in-msgdb)
(let* ((flds (elmo-multi-folder-children-internal folder))
(cur-number 0)
list numbers)
(while flds
(setq cur-number (+ cur-number 1))
- (setq list (elmo-folder-list-messages-internal (car flds)))
+ (setq list (elmo-folder-list-messages (car flds) visible-only in-msgdb))
(setq numbers
- (append
+ (nconc
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)))))))
+ (mapcar
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number) x))
+ list)))
(setq flds (cdr flds)))
numbers))
t)))
(luna-define-method elmo-folder-search ((folder elmo-multi-folder)
- condition &optional numlist)
+ condition &optional numbers)
(let* ((flds (elmo-multi-folder-children-internal folder))
(cur-number 0)
- numlist-list cur-numlist ; for filtered search.
- ret-val)
- (if numlist
- (setq numlist-list
- (elmo-multi-split-numbers folder numlist t)))
+ numlist
+ matches)
+ (setq numbers (or numbers
+ (elmo-folder-list-messages folder)))
(while flds
(setq cur-number (+ cur-number 1))
- (when numlist
- (setq cur-numlist (car numlist-list))
- (if (null cur-numlist)
- ;; t means filter all.
- (setq cur-numlist t)))
- (setq ret-val (append
- ret-val
- (elmo-list-filter
- cur-numlist
- (mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal
- folder) cur-number) x)))
- (ignore-errors
- (elmo-folder-search
- (car flds) condition))))))
- (when numlist
- (setq numlist-list (cdr numlist-list)))
+ (setq matches (append matches
+ (mapcar
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder)
+ cur-number)
+ x))
+ (elmo-folder-search
+ (car flds) condition))))
(setq flds (cdr flds)))
- ret-val))
+ (elmo-list-filter numbers matches)))
(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder)
number)
(setq msg-list (cdr msg-list)))
ret-val))
-(luna-define-method elmo-folder-mark-as-important :around ((folder
- elmo-multi-folder)
- numbers)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-mark-as-important (car folder-numbers)
- (cdr folder-numbers)))
- (luna-call-next-method))
-
-(luna-define-method elmo-folder-unmark-important :around ((folder
- elmo-multi-folder)
- numbers)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-unmark-important (car folder-numbers)
- (cdr folder-numbers)))
- (luna-call-next-method))
-
-(luna-define-method elmo-folder-mark-as-read :around ((folder
- elmo-multi-folder)
- numbers)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-mark-as-read (car folder-numbers)
- (cdr folder-numbers)))
- (luna-call-next-method))
-
-(luna-define-method elmo-folder-unmark-read :around ((folder
- elmo-multi-folder)
- numbers)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-unmark-read (car folder-numbers)
- (cdr folder-numbers)))
- (luna-call-next-method))
-
-(luna-define-method elmo-folder-mark-as-answered :around ((folder
- elmo-multi-folder)
- numbers)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-mark-as-answered (car folder-numbers)
- (cdr folder-numbers)))
- (luna-call-next-method))
-
-(luna-define-method elmo-folder-unmark-answered :around ((folder
- elmo-multi-folder)
- numbers)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-unmark-answered (car folder-numbers)
- (cdr folder-numbers)))
- (luna-call-next-method))
+(luna-define-method elmo-folder-set-flag ((folder elmo-multi-folder)
+ numbers
+ flag
+ &optional is-local)
+ (dolist (pair (elmo-multi-make-folder-numbers-list folder numbers))
+ (elmo-folder-set-flag (car pair) (cdr pair) flag is-local)))
+
+(luna-define-method elmo-folder-unset-flag ((folder elmo-multi-folder)
+ numbers
+ flag
+ &optional is-local)
+ (dolist (pair (elmo-multi-make-folder-numbers-list folder numbers))
+ (ignore-errors
+ (elmo-folder-unset-flag (car pair) (cdr pair) flag is-local))))
+
+(luna-define-method elmo-folder-list-flagged ((folder elmo-multi-folder)
+ flag
+ &optional in-msgdb)
+ (let ((cur-number 0)
+ numbers)
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (setq cur-number (+ cur-number 1)
+ numbers
+ (nconc
+ numbers
+ (mapcar
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal folder)
+ cur-number) x))
+ (elmo-folder-list-flagged child flag in-msgdb)))))
+ numbers))
+
+(luna-define-method elmo-folder-commit ((folder elmo-multi-folder))
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (elmo-folder-commit child)))
+
+(luna-define-method elmo-folder-length ((folder elmo-multi-folder))
+ (let ((sum 0))
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (setq sum (+ sum (elmo-folder-length child))))
+ sum))
+
+(luna-define-method elmo-folder-count-flags ((folder elmo-multi-folder))
+ (let (flag-alist element)
+ (dolist (child (elmo-multi-folder-children-internal folder))
+ (dolist (pair (elmo-folder-count-flags child))
+ (if (setq element (assq (car pair) flag-alist))
+ (setcdr element (+ (cdr element) (cdr pair)))
+ (setq flag-alist (cons pair flag-alist)))))
+ flag-alist))
+
+(luna-define-method elmo-folder-recover-messages ((folder elmo-multi-folder)
+ numbers)
+ (dolist (element (elmo-multi-split-numbers folder numbers))
+ (when (cdr element)
+ (elmo-folder-recover-messages (car element) (cdr element)))))
+
+(defun elmo-folder-append-messages-multi-* (dst-folder
+ src-folder
+ numbers
+ same-number)
+ (if same-number
+ (elmo-folder-append-messages dst-folder src-folder numbers same-number
+ 'elmo-folder-append-messages-multi-*)
+ (let ((divider (elmo-multi-folder-divide-number-internal src-folder))
+ (cur-number 0)
+ succeeds)
+ (dolist (element (elmo-multi-split-numbers src-folder numbers))
+ (setq cur-number (+ cur-number 1))
+ (when (cdr element)
+ (setq succeeds
+ (nconc
+ succeeds
+ (mapcar
+ (lambda (x)
+ (+ (* divider cur-number) x))
+ (elmo-folder-append-messages
+ dst-folder (car element) (cdr element)))))))
+ succeeds)))
(require 'product)
(product-provide (provide 'elmo-multi) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff