;;; Code:
;;
+(eval-when-compile (require 'cl))
(require 'elmo)
+(require 'elmo-signal)
(require 'luna)
(defvar elmo-multi-divide-number 100000
(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))))))
+ `(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)
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))
(dolist (fld (elmo-multi-folder-children-internal folder))
(elmo-folder-close-internal fld)))
-(luna-define-method elmo-folder-close :after ((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-set-msgdb-internal fld nil)))
+ (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)
- (dolist (fld (elmo-multi-folder-children-internal folder))
- (elmo-folder-synchronize fld disable-killed ignore-msgdb no-check))
+ 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-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
(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-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
(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))))
+ (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)
(elmo-message-entity-field entity 'references)))
(luna-define-method elmo-message-field ((folder elmo-multi-folder)
- number field)
+ 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-field (car pair) (cdr pair) field)))
+ (elmo-message-flag-available-p (car pair) (cdr pair) flag)))
-(luna-define-method elmo-message-mark ((folder elmo-multi-folder) number)
+(luna-define-method elmo-message-flags ((folder elmo-multi-folder) number)
(let ((pair (elmo-multi-real-folder-number folder number)))
- (elmo-message-mark (car pair) (cdr pair))))
+ (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)
(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))
+ (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)
- (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-detach-messages (nth cur-number flds)
- (nth cur-number one-list-list))
- (setq cur-number (+ 1 cur-number)))
- t))
+ (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 ((flds (elmo-multi-folder-children-internal folder))
- (news 0)
+ (let ((news 0)
(unreads 0)
(alls 0)
- no-unreads diff)
- (while flds
- (setq diff (elmo-folder-diff (car flds)))
- (cond
- ((consp (cdr diff)) ; (new unread all)
- (setq news (+ news (nth 0 diff))
- unreads (+ unreads (nth 1 diff))
- alls (+ alls (nth 2 diff))))
- (t
- (setq no-unreads t)
- (setq news (+ news (car diff))
- alls (+ alls (cdr diff)))))
- (setq flds (cdr flds)))
- (if no-unreads
- (cons news alls)
- (list news unreads alls))))
-
-(luna-define-method elmo-folder-list-unreads ((folder elmo-multi-folder))
- (let ((cur-number 0)
- unreads)
+ diff value)
(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 (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)))))
+ (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)
(nconc
numbers
(mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal
- folder) cur-number) x)))
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder) cur-number) x))
list)))
(setq flds (cdr flds)))
numbers))
(setq cur-number (+ cur-number 1))
(setq matches (append matches
(mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal
- folder)
- cur-number)
- x)))
+ (lambda (x)
+ (+
+ (* (elmo-multi-folder-divide-number-internal
+ folder)
+ cur-number)
+ x))
(elmo-folder-search
(car flds) condition))))
(setq flds (cdr flds)))
(setq msg-list (cdr msg-list)))
ret-val))
-(luna-define-method elmo-folder-mark-as-important ((folder
- elmo-multi-folder)
- numbers
- &optional
- ignore-flags)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-mark-as-important (car folder-numbers)
- (cdr folder-numbers)
- ignore-flags)))
-
-(luna-define-method elmo-folder-unmark-important ((folder
- elmo-multi-folder)
- numbers
- &optional
- ignore-flags)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-unmark-important (car folder-numbers)
- (cdr folder-numbers)
- ignore-flags)))
-
-(luna-define-method elmo-folder-mark-as-read ((folder
- elmo-multi-folder)
- numbers
- &optional ignore-flag)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-mark-as-read (car folder-numbers)
- (cdr folder-numbers)
- ignore-flag)))
-
-(luna-define-method elmo-folder-unmark-read ((folder
- elmo-multi-folder)
- numbers
- &optional ignore-flag)
- (dolist (folder-numbers (elmo-multi-make-folder-numbers-list folder numbers))
- (elmo-folder-unmark-read (car folder-numbers)
- (cdr folder-numbers)
- ignore-flag)))
-
-(luna-define-method elmo-folder-mark-as-answered ((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-define-method elmo-folder-unmark-answered ((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-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
(nconc
numbers
(mapcar
- (function
- (lambda (x)
- (+
- (* (elmo-multi-folder-divide-number-internal folder)
- cur-number) x)))
+ (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-set-message-modified ((folder
- elmo-multi-folder)
- modified)
- (dolist (child (elmo-multi-folder-children-internal folder))
- (elmo-folder-set-message-modified child modified)))
-
(luna-define-method elmo-folder-commit ((folder elmo-multi-folder))
(dolist (child (elmo-multi-folder-children-internal folder))
(elmo-folder-commit child)))
sum))
(luna-define-method elmo-folder-count-flags ((folder elmo-multi-folder))
- (let ((new 0)
- (unreads 0)
- (answered 0)
- flags)
+ (let (flag-alist element)
(dolist (child (elmo-multi-folder-children-internal folder))
- (setq flags (elmo-folder-count-flags child))
- (setq new (+ new (nth 0 flags)))
- (setq unreads (+ unreads (nth 1 flags)))
- (setq answered (+ answered (nth 2 flags))))
- (list new unreads answered)))
+ (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