X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-multi.el;h=a6619052c8c8535c0669fc9e07dfd272848d35a5;hb=144ad8d8073b3949634faa0f17fc4b4264b1d790;hp=5f3d5df6eff2828e84a58ec833a177c764868a5b;hpb=4b6415dfa236d5d0744a1079edee169f33152aa1;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index 5f3d5df..a661905 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,12 +45,12 @@ (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) @@ -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,11 +68,66 @@ (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)) @@ -80,9 +137,14 @@ (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 @@ -145,14 +207,16 @@ (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) @@ -170,8 +234,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) @@ -196,9 +261,9 @@ (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-flag-available-p ((folder elmo-multi-folder) number @@ -241,9 +306,9 @@ (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) @@ -263,26 +328,24 @@ (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)))) + diff value) + (dolist (child (elmo-multi-folder-children-internal folder)) + (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) @@ -296,11 +359,10 @@ (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)) @@ -348,13 +410,12 @@ (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))) @@ -440,11 +501,10 @@ (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)) @@ -467,6 +527,35 @@ (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))