elmo/elmo-multi.el

   1 ;;; elmo-multi.el -- Multiple Folder Interface for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31
  32 (require 'elmo-msgdb)
  33 (require 'elmo-vars)
  34 (require 'elmo2)
  35
  36 (defun elmo-multi-msgdb (msgdb base)
  37   (list (mapcar (function
  38                  (lambda (x)
  39                    (elmo-msgdb-overview-entity-set-number
  40                     x
  41                     (+ base
  42                        (elmo-msgdb-overview-entity-get-number x)))))
  43                 (nth 0 msgdb))
  44         (mapcar (function
  45                  (lambda (x) (cons
  46                               (+ base (car x))
  47                               (cdr x))))
  48                 (nth 1 msgdb))
  49         (mapcar (function
  50                  (lambda (x) (cons
  51                               (+ base (car x))
  52                               (cdr x)))) (nth 2 msgdb))))
  53
  54 (defun elmo-multi-msgdb-create-as-numlist (spec numlist new-mark already-mark
  55                                                 seen-mark important-mark
  56                                                 seen-list)
  57   (when numlist
  58     (let* ((flds (cdr spec))
  59            overview number-alist mark-alist entity
  60            one-list-list
  61            cur-number
  62            i percent num
  63            ret-val)
  64       (setq one-list-list (elmo-multi-get-intlist-list numlist))
  65       (setq cur-number 0)
  66       (while (< cur-number (length flds))
  67         (setq ret-val
  68               (elmo-msgdb-append
  69                ret-val
  70                (elmo-multi-msgdb
  71                 (elmo-msgdb-create-as-numlist (nth cur-number flds)
  72                                               (nth cur-number one-list-list)
  73                                               new-mark already-mark
  74                                               seen-mark important-mark
  75                                               seen-list)
  76                 (* elmo-multi-divide-number (1+ cur-number)))))
  77         (setq cur-number (1+ cur-number)))
  78       (elmo-msgdb-sort-by-date ret-val))))
  79
  80 ;; returns append-msgdb
  81 (defun elmo-multi-delete-crossposts (already-msgdb append-msgdb)
  82   (let* ((number-alist (elmo-msgdb-get-number-alist append-msgdb))
  83          (dummy (copy-sequence (append
  84                                 number-alist
  85                                 (elmo-msgdb-get-number-alist already-msgdb))))
  86          (cur number-alist)
  87          to-be-deleted
  88          overview mark-alist
  89          same)
  90     (while cur
  91       (setq dummy (delq (car cur) dummy))
  92       (if (setq same (rassoc (cdr (car cur)) dummy)) ;; same message id is remained
  93           (unless (= (/ (car (car cur)) elmo-multi-divide-number)
  94                      (/ (car same) elmo-multi-divide-number))
  95             ;; base is also same...delete it!
  96             (setq to-be-deleted (append to-be-deleted (list (car cur))))))
  97       (setq cur (cdr cur)))
  98     (setq overview (elmo-delete-if
  99                     (function
 100                      (lambda (x)
 101                        (assq
 102                         (elmo-msgdb-overview-entity-get-number x)
 103                         to-be-deleted)))
 104                     (elmo-msgdb-get-overview append-msgdb)))
 105     (setq mark-alist (elmo-delete-if
 106                       (function
 107                        (lambda (x)
 108                          (assq
 109                           (car x) to-be-deleted)))
 110                       (elmo-msgdb-get-mark-alist append-msgdb)))
 111     ;; keep number-alist untouched for folder diff!!
 112     (cons (and to-be-deleted (length to-be-deleted))
 113           (list overview number-alist mark-alist))))
 114
 115 (defun elmo-multi-msgdb-create (spec numlist new-mark already-mark
 116                                      seen-mark important-mark seen-list)
 117   (when numlist
 118     (let* ((flds (cdr spec))
 119            overview number-alist mark-alist entity
 120            one-list-list
 121            cur-number
 122            i percent num
 123            ret-val)
 124       (setq one-list-list (elmo-multi-get-intlist-list numlist))
 125       (setq cur-number 0)
 126       (while (< cur-number (length flds))
 127         (setq ret-val
 128               (elmo-msgdb-append
 129                ret-val
 130                (elmo-multi-msgdb
 131                 (elmo-msgdb-create (nth cur-number flds)
 132                                    (nth cur-number one-list-list)
 133                                    new-mark already-mark
 134                                    seen-mark important-mark
 135                                    seen-list)
 136                 (* elmo-multi-divide-number (1+ cur-number)))))
 137         (setq cur-number (1+ cur-number)))
 138       (elmo-msgdb-sort-by-date ret-val))))
 139
 140 (defun elmo-multi-list-folders (spec &optional hierarchy)
 141   ;; not implemented.
 142   nil)
 143
 144 (defun elmo-multi-append-msg (spec string)
 145   (error "Cannot append messages to multi folder"))
 146
 147 (defun elmo-multi-read-msg (spec number outbuf &optional msgdb unread)
 148   (let* ((flds (cdr spec))
 149          (folder (nth (- (/ number elmo-multi-divide-number) 1) flds))
 150          (number (% number elmo-multi-divide-number)))
 151     (elmo-call-func folder "read-msg" number outbuf msgdb unread)))
 152
 153 (defun elmo-multi-delete-msgs (spec msgs)
 154   (let ((flds (cdr spec))
 155         one-list-list
 156         (cur-number 0))
 157     (setq one-list-list (elmo-multi-get-intlist-list msgs))
 158     (while (< cur-number (length flds))
 159       (elmo-delete-msgs (nth cur-number flds)
 160                         (nth cur-number one-list-list))
 161       (setq cur-number (+ 1 cur-number)))
 162     t))
 163
 164 (defun elmo-multi-folder-diff (spec folder &optional number-list)
 165   (let ((flds (cdr spec))
 166         (num-alist-list
 167          (elmo-multi-split-number-alist
 168           (elmo-msgdb-number-load (elmo-msgdb-expand-path spec))))
 169         (count 0)
 170         (unsync 0)
 171         (messages 0)
 172         diffs)
 173     (while flds
 174       (setq diffs (nconc diffs (list (elmo-folder-diff
 175                                       (car flds)
 176                                       (mapcar 'car
 177                                               (nth count num-alist-list))))))
 178       (setq count (+ 1 count))
 179       (setq flds (cdr flds)))
 180     (while diffs
 181       (and (car (car diffs))
 182            (setq unsync (+ unsync (car (car diffs)))))
 183       (setq messages  (+ messages (cdr (car diffs))))
 184       (setq diffs (cdr diffs)))
 185     (elmo-folder-set-info-hashtb folder
 186                                  nil messages)
 187     (cons unsync messages)))
 188
 189 (defun elmo-multi-split-mark-alist (mark-alist)
 190   (let ((cur-number 0)
 191         (alist (sort (copy-sequence mark-alist)
 192                      (lambda (pair1 pair2)
 193                        (< (car pair1)(car pair2)))))
 194         one-alist result)
 195     (while alist
 196       (setq cur-number (+ cur-number 1))
 197       (setq one-alist nil)
 198       (while (and alist
 199                   (eq 0
 200                       (/ (- (car (car alist))
 201                             (* elmo-multi-divide-number cur-number))
 202                          elmo-multi-divide-number)))
 203         (setq one-alist (nconc
 204                          one-alist
 205                          (list
 206                           (list (% (car (car alist))
 207                                    (* elmo-multi-divide-number cur-number))
 208                                 (cadr (car alist))))))
 209         (setq alist (cdr alist)))
 210       (setq result (nconc result (list one-alist))))
 211     result))
 212
 213 (defun elmo-multi-split-number-alist (number-alist)
 214   (let ((alist (sort (copy-sequence number-alist)
 215                      (lambda (pair1 pair2)
 216                        (< (car pair1)(car pair2)))))
 217         (cur-number 0)
 218         one-alist split num)
 219     (while alist
 220       (setq cur-number (+ cur-number 1))
 221       (setq one-alist nil)
 222       (while (and alist
 223                   (eq 0
 224                       (/ (- (setq num (car (car alist)))
 225                             (* elmo-multi-divide-number cur-number))
 226                          elmo-multi-divide-number)))
 227         (setq one-alist (nconc
 228                          one-alist
 229                          (list
 230                           (cons
 231                            (% num (* elmo-multi-divide-number cur-number))
 232                            (cdr (car alist))))))
 233         (setq alist (cdr alist)))
 234       (setq split (nconc split (list one-alist))))
 235     split))
 236
 237 (defun elmo-multi-list-folder-unread (spec number-alist mark-alist
 238                                            unread-marks)
 239   (let ((folders (cdr spec))
 240         (cur-number 0)
 241         (split-mark-alist (elmo-multi-split-mark-alist mark-alist))
 242         (split-number-alist (elmo-multi-split-number-alist number-alist))
 243         unreads)
 244     (while folders
 245       (setq cur-number (+ cur-number 1)
 246             unreads (append
 247                      unreads
 248                      (mapcar
 249                       (function
 250                        (lambda (x)
 251                          (+
 252                           (* elmo-multi-divide-number cur-number) x)))
 253                       (elmo-list-folder-unread (car folders)
 254                                                (car split-number-alist)
 255                                                (car split-mark-alist)
 256                                                unread-marks)))
 257             split-number-alist (cdr split-number-alist)
 258             split-mark-alist (cdr split-mark-alist)
 259             folders (cdr folders)))
 260     unreads))
 261
 262 (defun elmo-multi-list-folder-important (spec number-alist)
 263   (let ((folders (cdr spec))
 264         (cur-number 0)
 265         (split-number-alist (elmo-multi-split-number-alist number-alist))
 266         importants)
 267     (while folders
 268       (setq cur-number (+ cur-number 1)
 269             importants (nconc
 270                         importants
 271                         (mapcar
 272                          (function
 273                           (lambda (x)
 274                             (+ (* elmo-multi-divide-number cur-number) x)))
 275                          (elmo-list-folder-important
 276                           (car folders)
 277                           (car split-number-alist))))
 278             folders (cdr folders)))
 279     importants))
 280
 281 (defun elmo-multi-list-folder (spec &optional nohide)
 282   (let* ((flds (cdr spec))
 283          (cur-number 0)
 284          (killed (and elmo-use-killed-list
 285                       (elmo-msgdb-killed-list-load
 286                        (elmo-msgdb-expand-path spec))))
 287          numbers)
 288     (while flds
 289       (setq cur-number (+ cur-number 1))
 290       (setq numbers (append
 291                      numbers
 292                      (mapcar
 293                       (function
 294                        (lambda (x)
 295                          (+
 296                           (* elmo-multi-divide-number cur-number) x)))
 297                       (elmo-list-folder (car flds)))))
 298       (setq flds (cdr flds)))
 299     (elmo-living-messages numbers killed)))
 300
 301 (defun elmo-multi-folder-exists-p (spec)
 302   (let* ((flds (cdr spec)))
 303     (catch 'exists
 304       (while flds
 305         (unless (elmo-folder-exists-p (car flds))
 306           (throw 'exists nil))
 307         (setq flds (cdr flds)))
 308       t)))
 309
 310 (defun elmo-multi-folder-creatable-p (spec)
 311   (let* ((flds (cdr spec)))
 312     (catch 'creatable
 313       (while flds
 314         (when (and (elmo-call-func (car flds) "folder-creatable-p")
 315                    (not (elmo-folder-exists-p (car flds))))
 316               ;; If folder already exists, don't to `creatable'.
 317               ;; Because this function is called, when folder doesn't exists.
 318           (throw 'creatable t))
 319         (setq flds (cdr flds)))
 320       nil)))
 321
 322 (defun elmo-multi-create-folder (spec)
 323   (let* ((flds (cdr spec)))
 324     (catch 'create
 325       (while flds
 326         (unless (or (elmo-folder-exists-p (car flds))
 327                     (elmo-create-folder (car flds)))
 328           (throw 'create nil))
 329         (setq flds (cdr flds)))
 330       t)))
 331
 332 (defun elmo-multi-search (spec condition &optional numlist)
 333   (let* ((flds (cdr spec))
 334          (cur-number 0)
 335          numlist-list cur-numlist ; for filtered search.
 336          ret-val)
 337     (if numlist
 338         (setq numlist-list
 339               (elmo-multi-get-intlist-list numlist t)))
 340     (while flds
 341       (setq cur-number (+ cur-number 1))
 342       (when numlist
 343         (setq cur-numlist (car numlist-list))
 344         (if (null cur-numlist)
 345             ;; t means filter all.
 346             (setq cur-numlist t)))
 347       (setq ret-val (append
 348                      ret-val
 349                      (elmo-list-filter
 350                       cur-numlist
 351                       (mapcar
 352                        (function
 353                         (lambda (x)
 354                           (+
 355                            (* elmo-multi-divide-number cur-number) x)))
 356                        (elmo-call-func
 357                         (car flds) "search" condition)))))
 358       (when numlist
 359         (setq numlist-list (cdr numlist-list)))
 360       (setq flds (cdr flds)))
 361     ret-val))
 362
 363 (defun elmo-multi-use-cache-p (spec number)
 364   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 365                        (cdr spec))
 366                   "use-cache-p"
 367                   (% number elmo-multi-divide-number)))
 368
 369 (defun elmo-multi-local-file-p (spec number)
 370   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 371                        (cdr spec))
 372                   "local-file-p"
 373                   (% number elmo-multi-divide-number)))
 374
 375 (defun elmo-multi-commit (spec)
 376   (mapcar 'elmo-commit (cdr spec)))
 377
 378 (defun elmo-multi-plugged-p (spec)
 379   (let* ((flds (cdr spec)))
 380     (catch 'plugged
 381       (while flds
 382         (unless (elmo-folder-plugged-p (car flds))
 383           (throw 'plugged nil))
 384         (setq flds (cdr flds)))
 385       t)))
 386
 387 (defun elmo-multi-set-plugged (spec plugged add)
 388   (let* ((flds (cdr spec)))
 389     (while flds
 390       (elmo-folder-set-plugged (car flds) plugged add)
 391       (setq flds (cdr flds)))))
 392
 393 (defun elmo-multi-get-msg-filename (spec number &optional loc-alist)
 394   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 395                        (cdr spec))
 396                   "get-msg-filename"
 397                   (% number elmo-multi-divide-number)
 398                   loc-alist))
 399
 400 (defun elmo-multi-sync-number-alist (spec number-alist)
 401   (let ((folder-list (cdr spec))
 402         (number-alist-list
 403          (elmo-multi-split-number-alist number-alist))
 404         (multi-base 0)
 405         append-alist result-alist)
 406     (while folder-list
 407       (incf multi-base)
 408       (setq append-alist
 409             (elmo-call-func (nth (- multi-base 1) (cdr spec)) ;; folder name
 410                             "sync-number-alist"
 411                             (nth (- multi-base 1) number-alist-list)))
 412       (mapcar
 413        (function
 414         (lambda (x)
 415           (setcar x
 416                   (+ (* elmo-multi-divide-number multi-base) (car x)))))
 417        append-alist)
 418       (setq result-alist (nconc result-alist append-alist))
 419       (setq folder-list (cdr folder-list)))
 420     result-alist))
 421
 422 (require 'product)
 423 (product-provide (provide 'elmo-multi) (require 'elmo-version))
 424
 425 ;;; elmo-multi.el ends here