X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-multi.el;h=4d5b9a6621fc1772c76f34cbf23a88f1b0404bcc;hb=a6d5a5adb70f71665568e1189525fc4eb98b088d;hp=afa7669526660864ff3b81d04d178a400f050035;hpb=1e366a559be4aec4ad4d3cf3e954b8e62a20d2f3;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index afa7669..4d5b9a6 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -1,10 +1,9 @@ -;;; elmo-multi.el -- Multiple Folder Interface for ELMO. +;;; elmo-multi.el --- Multiple Folder Interface for ELMO. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news -;; Time-stamp: <00/03/14 19:41:07 teranisi> ;; This file is part of ELMO (Elisp Library for Message Orchestration). @@ -25,222 +24,343 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; - -(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) - (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))) - -(defun elmo-multi-delete-msgs (spec msgs) - (let ((flds (cdr spec)) - one-list-list - (cur-number 0)) - (setq one-list-list (elmo-multi-get-intlist-list msgs)) - (while (< cur-number (length flds)) - (elmo-delete-msgs (nth cur-number flds) - (nth cur-number one-list-list)) - (setq cur-number (+ 1 cur-number))) - t)) - -(defun elmo-multi-mark-alist-list (mark-alist) - (let ((cur-number 0) - one-alist result) - (while mark-alist +;; +(eval-when-compile (require 'cl)) + +(require 'elmo) +(require 'elmo-signal) +(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-get-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) + (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 'cache-changed folder + (elmo-define-signal-handler (folder child number) + (elmo-emit-signal + 'cache-changed folder + (car (elmo-multi-map-numbers folder child (list number))))) + (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))) + +(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 ((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-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-folder-name-internal folder)) + (expand-file-name "multi" + elmo-msgdb-directory))) + +(luna-define-method elmo-folder-newsgroups ((folder elmo-multi-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 + (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) + 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-alist nil) - (while (and mark-alist + (while (and numbers (eq 0 - (/ (- (car (car mark-alist)) - (* elmo-multi-divide-number cur-number)) - elmo-multi-divide-number))) - (setq one-alist (nconc - one-alist - (list - (list (% (car (car mark-alist)) - (* elmo-multi-divide-number cur-number)) - (cadr (car mark-alist)))))) - (setq mark-alist (cdr mark-alist))) - (setq result (nconc result (list one-alist)))) - result)) - -(defun elmo-multi-list-folder-unread (spec mark-alist unread-marks) - (let* ((flds (cdr spec)) + (/ (- (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 unseen section) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-fetch (car pair) (cdr pair) strategy unseen section))) + +(luna-define-method elmo-folder-delete-messages ((folder elmo-multi-folder) + numbers) + (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 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) - mark-alist-list - ret-val) - (setq mark-alist-list (elmo-multi-mark-alist-list mark-alist)) + list numbers) (while flds (setq cur-number (+ cur-number 1)) - (setq ret-val (append - ret-val - (mapcar - (function - (lambda (x) - (+ - (* elmo-multi-divide-number cur-number) x))) - (elmo-list-folder-unread (car flds) - (car mark-alist-list) - unread-marks)))) - (setq mark-alist-list (cdr mark-alist-list)) + (setq list (elmo-folder-list-messages (car flds) visible-only in-msgdb)) + (setq numbers + (nconc + numbers + (mapcar + (function + (lambda (x) + (+ + (* (elmo-multi-folder-divide-number-internal + folder) cur-number) x))) + list))) (setq flds (cdr flds))) - ret-val)) + numbers)) -(defun elmo-multi-list-folder-important (spec overview) - (let* ((flds (cdr spec)) - (cur-number 0) - ret-val) - (while flds - (setq cur-number (+ cur-number 1)) - (setq ret-val (append - ret-val - (mapcar - (function - (lambda (x) - (+ - (* elmo-multi-divide-number cur-number) x))) - (elmo-list-folder-important (car flds) overview)))) - (setq flds (cdr flds))) - ret-val)) - -(defun elmo-multi-list-folder (spec) - (let* ((flds (cdr spec)) - (cur-number 0) - ret-val) - (while flds - (setq cur-number (+ cur-number 1)) - (setq ret-val (append - ret-val - (mapcar - (function - (lambda (x) - (+ - (* elmo-multi-divide-number cur-number) x))) - (elmo-list-folder (car flds))))) - (setq flds (cdr flds))) - ret-val)) - -(defun elmo-multi-folder-exists-p (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-exists-p ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'exists (while flds (unless (elmo-folder-exists-p (car flds)) @@ -248,76 +368,67 @@ (setq flds (cdr flds))) t))) -(defun elmo-multi-folder-creatable-p (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-creatable-p ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'creatable (while flds - (when (and (elmo-call-func (car flds) "folder-creatable-p") + (when (and (elmo-folder-creatable-p (car flds)) (not (elmo-folder-exists-p (car flds)))) - ;; If folder already exists, don't to `creatable'. - ;; Because this function is called, when folder doesn't exists. + ;; If folder already exists, don't to `creatable'. + ;; Because this function is called, when folder doesn't exists. (throw 'creatable t)) (setq flds (cdr flds))) nil))) -(defun elmo-multi-create-folder (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-create ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'create (while flds (unless (or (elmo-folder-exists-p (car flds)) - (elmo-create-folder (car flds))) + (elmo-folder-create (car flds))) (throw 'create nil)) (setq flds (cdr flds))) t))) -(defun elmo-multi-search (spec condition &optional numlist) - (let* ((flds (cdr spec)) +(luna-define-method elmo-folder-search ((folder elmo-multi-folder) + 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-get-intlist-list 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-divide-number cur-number) x))) - (elmo-call-func - (car flds) "search" 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))) -(defun elmo-multi-use-cache-p (spec number) - (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1) - (cdr spec)) - "use-cache-p" - (% number elmo-multi-divide-number))) +(luna-define-method elmo-message-use-cache-p ((folder elmo-multi-folder) + number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-use-cache-p (car pair) (cdr pair)))) -(defun elmo-multi-local-file-p (spec number) - (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1) - (cdr spec)) - "local-file-p" - (% number elmo-multi-divide-number))) +(luna-define-method elmo-message-file-p ((folder elmo-multi-folder) number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-file-p (car pair) (cdr pair)))) -(defun elmo-multi-commit (spec) - (mapcar 'elmo-commit (cdr spec))) +(luna-define-method elmo-message-file-name ((folder elmo-multi-folder) number) + (let ((pair (elmo-multi-real-folder-number folder number))) + (elmo-message-file-name (car pair) (cdr pair)))) -(defun elmo-multi-plugged-p (spec) - (let* ((flds (cdr spec))) +(luna-define-method elmo-folder-plugged-p ((folder elmo-multi-folder)) + (let ((flds (elmo-multi-folder-children-internal folder))) (catch 'plugged (while flds (unless (elmo-folder-plugged-p (car flds)) @@ -325,41 +436,92 @@ (setq flds (cdr flds))) t))) -(defun elmo-multi-set-plugged (spec plugged add) - (let* ((flds (cdr spec))) - (while flds - (elmo-folder-set-plugged (car flds) plugged add) - (setq flds (cdr flds))))) - -(defun elmo-multi-get-msg-filename (spec number &optional loc-alist) - (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1) - (cdr spec)) - "get-msg-filename" - (% number elmo-multi-divide-number) - loc-alist)) - -(defun elmo-multi-sync-number-alist (spec number-alist) - (let ((folder-list (cdr spec)) - (number-alist-list - (elmo-multi-get-number-alist-list number-alist)) - (multi-base 0) - append-alist result-alist) - (while folder-list - (incf multi-base) - (setq append-alist - (elmo-call-func (nth (- multi-base 1) (cdr spec)) ;; folder name - "sync-number-alist" - (nth (- multi-base 1) number-alist-list))) - (mapcar - (function - (lambda (x) - (setcar x - (+ (* elmo-multi-divide-number multi-base) (car x))))) - append-alist) - (setq result-alist (nconc result-alist append-alist)) - (setq folder-list (cdr folder-list))) - result-alist)) - -(provide 'elmo-multi) +(luna-define-method elmo-folder-set-plugged ((folder elmo-multi-folder) + plugged add) + (let ((flds (elmo-multi-folder-children-internal folder))) + (dolist (fld flds) + (elmo-folder-set-plugged fld plugged add)))) + +(defun elmo-multi-folder-numbers-list-assoc (folder folder-numbers) + (let (ent) + (while folder-numbers + (when (string= (elmo-folder-name-internal (car (car folder-numbers))) + (elmo-folder-name-internal folder)) + (setq ent (car folder-numbers) + folder-numbers nil)) + (setq folder-numbers (cdr folder-numbers))) + ent)) + +(defun elmo-multi-make-folder-numbers-list (folder msgs) + (let ((msg-list msgs) + pair fld-list + ret-val) + (while msg-list + (when (and (numberp (car msg-list)) + (> (car msg-list) 0)) + (setq pair (elmo-multi-real-folder-number folder (car msg-list))) + (if (setq fld-list (elmo-multi-folder-numbers-list-assoc + (car pair) + ret-val)) + (setcdr fld-list (cons (cdr pair) (cdr fld-list))) + (setq ret-val (cons (cons (car pair) (list (cdr pair))) ret-val)))) + (setq msg-list (cdr msg-list))) + ret-val)) + +(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 + (function + (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)) + +(require 'product) +(product-provide (provide 'elmo-multi) (require 'elmo-version)) ;;; elmo-multi.el ends here