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          (killed (and elmo-use-killed-list
 228                       (elmo-msgdb-killed-list-load
 229                        (elmo-msgdb-expand-path nil spec))))
 230          numbers)
 231     (while flds
 232       (setq cur-number (+ cur-number 1))
 233       (setq numbers (append
 234                      numbers
 235                      (mapcar
 236                       (function
 237                        (lambda (x)
 238                          (+
 239                           (* elmo-multi-divide-number cur-number) x)))
 240                       (elmo-list-folder (car flds)))))
 241       (setq flds (cdr flds)))
 242     (if killed
 243         (delq nil
 244               (mapcar (lambda (number)
 245                         (unless (memq number killed) number))
 246                       numbers))
 247       numbers)))
 248
 249 (defun elmo-multi-folder-exists-p (spec)
 250   (let* ((flds (cdr spec)))
 251     (catch 'exists
 252       (while flds
 253         (unless (elmo-folder-exists-p (car flds))
 254           (throw 'exists nil))
 255         (setq flds (cdr flds)))
 256       t)))
 257
 258 (defun elmo-multi-folder-creatable-p (spec)
 259   (let* ((flds (cdr spec)))
 260     (catch 'creatable
 261       (while flds
 262         (when (and (elmo-call-func (car flds) "folder-creatable-p")
 263                    (not (elmo-folder-exists-p (car flds))))
 264               ;; If folder already exists, don't to `creatable'.
 265               ;; Because this function is called, when folder doesn't exists.
 266           (throw 'creatable t))
 267         (setq flds (cdr flds)))
 268       nil)))
 269
 270 (defun elmo-multi-create-folder (spec)
 271   (let* ((flds (cdr spec)))
 272     (catch 'create
 273       (while flds
 274         (unless (or (elmo-folder-exists-p (car flds))
 275                     (elmo-create-folder (car flds)))
 276           (throw 'create nil))
 277         (setq flds (cdr flds)))
 278       t)))
 279
 280 (defun elmo-multi-search (spec condition &optional numlist)
 281   (let* ((flds (cdr spec))
 282          (cur-number 0)
 283          numlist-list cur-numlist ; for filtered search.
 284          ret-val)
 285     (if numlist
 286         (setq numlist-list
 287               (elmo-multi-get-intlist-list numlist t)))
 288     (while flds
 289       (setq cur-number (+ cur-number 1))
 290       (when numlist
 291         (setq cur-numlist (car numlist-list))
 292         (if (null cur-numlist)
 293             ;; t means filter all.
 294             (setq cur-numlist t)))
 295       (setq ret-val (append
 296                      ret-val
 297                      (elmo-list-filter
 298                       cur-numlist
 299                       (mapcar
 300                        (function
 301                         (lambda (x)
 302                           (+
 303                            (* elmo-multi-divide-number cur-number) x)))
 304                        (elmo-call-func
 305                         (car flds) "search" condition)))))
 306       (when numlist
 307         (setq numlist-list (cdr numlist-list)))
 308       (setq flds (cdr flds)))
 309     ret-val))
 310
 311 (defun elmo-multi-use-cache-p (spec number)
 312   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 313                        (cdr spec))
 314                   "use-cache-p"
 315                   (% number elmo-multi-divide-number)))
 316
 317 (defun elmo-multi-local-file-p (spec number)
 318   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 319                        (cdr spec))
 320                   "local-file-p"
 321                   (% number elmo-multi-divide-number)))
 322
 323 (defun elmo-multi-commit (spec)
 324   (mapcar 'elmo-commit (cdr spec)))
 325
 326 (defun elmo-multi-plugged-p (spec)
 327   (let* ((flds (cdr spec)))
 328     (catch 'plugged
 329       (while flds
 330         (unless (elmo-folder-plugged-p (car flds))
 331           (throw 'plugged nil))
 332         (setq flds (cdr flds)))
 333       t)))
 334
 335 (defun elmo-multi-set-plugged (spec plugged add)
 336   (let* ((flds (cdr spec)))
 337     (while flds
 338       (elmo-folder-set-plugged (car flds) plugged add)
 339       (setq flds (cdr flds)))))
 340
 341 (defun elmo-multi-get-msg-filename (spec number &optional loc-alist)
 342   (elmo-call-func (nth (- (/ number elmo-multi-divide-number) 1)
 343                        (cdr spec))
 344                   "get-msg-filename"
 345                   (% number elmo-multi-divide-number)
 346                   loc-alist))
 347
 348 (defun elmo-multi-sync-number-alist (spec number-alist)
 349   (let ((folder-list (cdr spec))
 350         (number-alist-list
 351          (elmo-multi-get-number-alist-list number-alist))
 352         (multi-base 0)
 353         append-alist result-alist)
 354     (while folder-list
 355       (incf multi-base)
 356       (setq append-alist
 357             (elmo-call-func (nth (- multi-base 1) (cdr spec)) ;; folder name
 358                             "sync-number-alist"
 359                             (nth (- multi-base 1) number-alist-list)))
 360       (mapcar
 361        (function
 362         (lambda (x)
 363           (setcar x
 364                   (+ (* elmo-multi-divide-number multi-base) (car x)))))
 365        append-alist)
 366       (setq result-alist (nconc result-alist append-alist))
 367       (setq folder-list (cdr folder-list)))
 368     result-alist))
 369
 370 (provide 'elmo-multi)
 371
 372 ;;; elmo-multi.el ends here