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