X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-multi.el;h=d9c2cf1ca4a28cdfae0be2079e9989601e87bc81;hb=47b752addd6948e942ff3c3548e86b9c3c2b95d1;hp=8d82fd031b53f3a188485c1835ae623eef79fe3e;hpb=edc77daf0f76ff7123c9c5ec205cdf77682b8bb5;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index 8d82fd0..d9c2cf1 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -28,8 +28,10 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) (require 'elmo) +(require 'elmo-signal) (require 'luna) (defvar elmo-multi-divide-number 100000 @@ -43,7 +45,7 @@ (defmacro elmo-multi-real-folder-number (folder number) "Returns a cons cell of real FOLDER and NUMBER." - (` (cons (nth (- + (` (cons (nth (- (/ (, number) (elmo-multi-folder-divide-number-internal (, folder))) 1) (elmo-multi-folder-children-internal (, folder))) @@ -58,7 +60,7 @@ 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) ?,)) @@ -66,8 +68,57 @@ (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))) @@ -80,15 +131,31 @@ (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 ignore-msgdb - no-check) - (dolist (fld (elmo-multi-folder-children-internal folder)) - (elmo-folder-synchronize fld ignore-msgdb no-check)) + &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 @@ -99,14 +166,10 @@ 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 @@ -129,19 +192,35 @@ (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-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 @@ -149,8 +228,9 @@ (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) @@ -168,23 +248,36 @@ (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) + number field &optional type) (let ((pair (elmo-multi-real-folder-number folder number))) - (elmo-message-field (car pair) (cdr pair) field))) + (elmo-message-field (car pair) (cdr pair) field type))) -(luna-define-method elmo-message-mark ((folder elmo-multi-folder) number) +(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-mark (car pair) (cdr pair)))) + (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) @@ -207,106 +300,46 @@ (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) - (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) + 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))))) + (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) @@ -361,37 +394,28 @@ 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))) - (elmo-folder-search - (car flds) condition))))) - (when numlist - (setq numlist-list (cdr numlist-list))) + (setq matches (append matches + (mapcar + (function + (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) @@ -447,57 +471,20 @@ (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 @@ -529,16 +516,19 @@ 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))))) (require 'product) (product-provide (provide 'elmo-multi) (require 'elmo-version))