elmo/elmo-multi.el

   1 ;;; elmo-multi.el -- Multiple Folder Interface for ELMO.
   2
   3 ;; Copyright 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)
 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)))
 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-mark-alist-list (mark-alist)
 165   (let ((cur-number 0)
 166         one-alist result)
 167     (while mark-alist
 168       (setq cur-number (+ cur-number 1))
 169       (setq one-alist nil)
 170       (while (and mark-alist
 171                   (eq 0
 172                       (/ (- (car (car mark-alist))
 173                             (* elmo-multi-divide-number cur-number))
 174                          elmo-multi-divide-number)))
 175         (setq one-alist (nconc
 176                          one-alist
 177                          (list
 178                           (list (% (car (car mark-alist))
 179                                    (* elmo-multi-divide-number cur-number))
 180                                 (cadr (car mark-alist))))))
 181         (setq mark-alist (cdr mark-alist)))
 182       (setq result (nconc result (list one-alist))))
 183     result))
 184
 185 (defun elmo-multi-list-folder-unread (spec mark-alist unread-marks)
 186   (let* ((flds (cdr spec))
 187          (cur-number 0)
 188          mark-alist-list
 189          ret-val)
 190     (setq mark-alist-list (elmo-multi-mark-alist-list mark-alist))
 191     (while flds
 192       (setq cur-number (+ cur-number 1))
 193       (setq ret-val (append
 194                      ret-val
 195                      (mapcar
 196                       (function
 197                        (lambda (x)
 198                          (+
 199                           (* elmo-multi-divide-number cur-number) x)))
 200                       (elmo-list-folder-unread (car flds)
 201                                                (car mark-alist-list)
 202                                                unread-marks))))
 203       (setq mark-alist-list (cdr mark-alist-list))
 204       (setq flds (cdr flds)))
 205     ret-val))
 206
 207 (defun elmo-multi-list-folder-important (spec overview)
 208   (let* ((flds (cdr spec))
 209          (cur-number 0)
 210          ret-val)
 211     (while flds
 212       (setq cur-number (+ cur-number 1))
 213       (setq ret-val (append
 214                      ret-val
 215                      (mapcar
 216                       (function
 217                        (lambda (x)
 218                          (+
 219                           (* elmo-multi-divide-number cur-number) x)))
 220                       (elmo-list-folder-important (car flds) overview))))
 221       (setq flds (cdr flds)))
 222     ret-val))
 223
 224 (defun elmo-multi-list-folder (spec)
 225   (let* ((flds (cdr spec))
 226          (cur-number 0)
 227          ret-val)
 228     (while flds
 229       (setq cur-number (+ cur-number 1))
 230       (setq ret-val (append
 231                      ret-val
 232                      (mapcar
 233                       (function
 234                        (lambda (x)
 235                          (+
 236                           (* elmo-multi-divide-number cur-number) x)))
 237                       (elmo-list-folder (car flds)))))
 238       (setq flds (cdr flds)))
 239     ret-val))
 240
 241 (defun elmo-multi-folder-exists-p (spec)
 242   (let* ((flds (cdr spec)))
 243     (catch 'exists
 244       (while flds
 245         (unless (elmo-folder-exists-p (car flds))
 246           (throw 'exists nil))
 247         (setq flds (cdr flds)))
 248       t)))
 249
 250 (defun elmo-multi-folder-creatable-p (spec)
 251   (let* ((flds (cdr spec)))
 252     (catch 'creatable
 253       (while flds
 254         (when (and (elmo-call-func (car flds) "folder-creatable-p")
 255                    (not (elmo-folder-exists-p (car flds))))
 256               ;; If folder already exists, don't to `creatable'.
 257               ;; Because this function is called, when folder doesn't exists.
 258           (throw 'creatable t))
 259         (setq flds (cdr flds)))
 260       nil)))
 261
 262 (defun elmo-multi-create-folder (spec)
 263   (let* ((flds (cdr spec)))
 264     (catch 'create
 265       (while flds
 266         (unless (or (elmo-folder-exists-p (car flds))
 267                     (elmo-create-folder (car flds)))
 268           (throw 'create nil))
 269         (setq flds (cdr flds)))
 270       t)))
 271
 272 (defun elmo-multi-search (spec condition &optional numlist)
 273   (let* ((flds (cdr spec))
 274          (cur-number 0)
 275          numlist-list cur-numlist ; for filtered search.
 276          ret-val)
 277     (if numlist
 278         (setq numlist-list
 279               (elmo-multi-get-intlist-list numlist t)))
 280     (while flds
 281       (setq cur-number (+ cur-number 1))
 282       (when numlist
 283         (setq cur-numlist (car numlist-list))
 284         (if (null cur-numlist)
 285             ;; t means filter all.
 286             (setq cur-numlist t)))
 287       (setq ret-val (append
 288                      ret-val
 289                      (elmo-list-filter
 290                       cur-numlist
 291                       (mapcar
 292                        (function
 293                         (lambda (x)
 294                           (+
 295                            (* elmo-multi-divide-number cur-number) x)))
 296                        (elmo-call-func
 297                         (car flds) "search" condition)))))
 298       (when numlist
 299         (setq numlist-list (cdr numlist-list)))
 300       (setq flds (cdr flds)))
 301     ret-val))
 302
 303 (defun elmo-multi-use-cache-p (spec number)
 304   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 305                        (cdr spec))
 306                   "use-cache-p"
 307                   (% number elmo-multi-divide-number)))
 308
 309 (defun elmo-multi-local-file-p (spec number)
 310   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 311                        (cdr spec))
 312                   "local-file-p"
 313                   (% number elmo-multi-divide-number)))
 314
 315 (defun elmo-multi-commit (spec)
 316   (mapcar 'elmo-commit (cdr spec)))
 317
 318 (defun elmo-multi-plugged-p (spec)
 319   (let* ((flds (cdr spec)))
 320     (catch 'plugged
 321       (while flds
 322         (unless (elmo-folder-plugged-p (car flds))
 323           (throw 'plugged nil))
 324         (setq flds (cdr flds)))
 325       t)))
 326
 327 (defun elmo-multi-set-plugged (spec plugged add)
 328   (let* ((flds (cdr spec)))
 329     (while flds
 330       (elmo-folder-set-plugged (car flds) plugged add)
 331       (setq flds (cdr flds)))))
 332
 333 (defun elmo-multi-get-msg-filename (spec number &optional loc-alist)
 334   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 335                        (cdr spec))
 336                   "get-msg-filename"
 337                   (% number elmo-multi-divide-number)
 338                   loc-alist))
 339
 340 (defun elmo-multi-sync-number-alist (spec number-alist)
 341   (let ((folder-list (cdr spec))
 342         (number-alist-list
 343          (elmo-multi-get-number-alist-list number-alist))
 344         (multi-base 0)
 345         append-alist result-alist)
 346     (while folder-list
 347       (incf multi-base)
 348       (setq append-alist
 349             (elmo-call-func (nth (- multi-base 1) (cdr spec)) ;; folder name
 350                             "sync-number-alist"
 351                             (nth (- multi-base 1) number-alist-list)))
 352       (mapcar
 353        (function
 354         (lambda (x)
 355           (setcar x
 356                   (+ (* elmo-multi-divide-number multi-base) (car x)))))
 357        append-alist)
 358       (setq result-alist (nconc result-alist append-alist))
 359       (setq folder-list (cdr folder-list)))
 360     result-alist))
 361
 362 (provide 'elmo-multi)
 363
 364 ;;; elmo-multi.el ends here