elmo/elmo-dop.el

   1 ;;; elmo-dop.el -- Modules for Disconnected Operations on 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:39:23 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-vars)
  34 (require 'elmo-msgdb)
  35 (require 'elmo-util)
  36 (eval-when-compile
  37   (require 'elmo-imap4)
  38   (require 'elmo-localdir))
  39
  40 ;; global variable.
  41 (defvar elmo-dop-queue nil
  42   "A list of (folder-name function-to-be-called argument-list).
  43 Automatically loaded/saved.")
  44
  45 (defun elmo-dop-queue-append (folder function argument)
  46   (let ((operation (list (format "%s" folder) function argument)))
  47     (elmo-dop-queue-load)
  48     (unless (member operation elmo-dop-queue) ;; don't append same operation
  49       (setq elmo-dop-queue
  50             (append elmo-dop-queue
  51                     (list operation)))
  52       (elmo-dop-queue-save))))
  53
  54 (defun elmo-dop-queue-flush ()
  55   (elmo-dop-queue-load) ; load cache.
  56   (elmo-dop-queue-merge)
  57   (let ((queue elmo-dop-queue)
  58         (count 0)
  59         len)
  60     (while queue
  61       (if (elmo-folder-plugged-p (caar queue))
  62           (setq count (1+ count)))
  63       (setq queue (cdr queue)))
  64     (when (> count 0)
  65       (if (elmo-y-or-n-p
  66            (format "%d pending operation(s) exists. Perform now?" count)
  67            (not elmo-dop-flush-confirm) t)
  68           (progn
  69             (message "")
  70             (sit-for 0)
  71             (let ((queue elmo-dop-queue)
  72                   (performed 0)
  73                   (i 0)
  74                   (num (length elmo-dop-queue))
  75                   folder func failure)
  76               (while queue
  77                 ;; now perform pending processes.
  78                 (setq failure nil)
  79                 (setq i (+ 1 i))
  80                 (message "Flushing queue....%d/%d." i num)
  81                 (condition-case err
  82                     (if (not (elmo-folder-plugged-p (nth 0 (car queue))))
  83                         (setq failure t)
  84                       (setq folder (nth 0 (car queue))
  85                             func (nth 1 (car queue)))
  86                       (cond
  87                        ((string= func "prefetch-msgs")
  88                         (elmo-prefetch-msgs
  89                          folder
  90                          (nth 2 (car queue)))) ;argunemt
  91                        ((string= func "append-operations")
  92                         (elmo-dop-flush-pending-append-operations
  93                          folder nil t))
  94                        (t
  95                         (elmo-call-func
  96                          folder
  97                          func
  98                          (nth 2 (car queue)) ;argunemt
  99                          ))))
 100                   (quit  (setq failure t))
 101                   (error (setq failure err)))
 102                 (if failure
 103                     ;; create-folder was failed.
 104                     (when (and (string= func "create-folder-maybe")
 105                                (elmo-y-or-n-p
 106                                 (format
 107                                  "Create folder %s failed. Abort creating?"
 108                                  folder)
 109                                 (not elmo-dop-flush-confirm) t))
 110                       (elmo-dop-save-pending-messages folder)
 111                       (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)))
 112                   (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 113                   (setq performed (+ 1 performed)))
 114                 (setq queue (cdr queue)))
 115               (message "%d/%d operation(s) are performed successfully."
 116                        performed num)
 117               (sit-for 1) ;
 118               (elmo-dop-queue-save)))
 119         (if (elmo-y-or-n-p "Clear all pending operations?"
 120                            (not elmo-dop-flush-confirm) t)
 121             (let ((queue elmo-dop-queue))
 122               (while queue
 123                 (if (string= (nth 1 (car queue)) "append-operations")
 124                     (elmo-dop-append-list-save (nth 0 (car queue)) nil))
 125                 (setq queue (cdr queue)))
 126               (setq elmo-dop-queue nil)
 127               (message "All pending operations are cleared.")
 128               (elmo-dop-queue-save))
 129           (message "")))
 130       count)))
 131
 132 (defconst elmo-dop-merge-funcs
 133   '("delete-msgids"
 134     "prefetch-msgs"
 135     "unmark-important"
 136     "mark-as-important"
 137     "mark-as-read"
 138     "mark-as-unread"))
 139
 140 (defun elmo-dop-queue-merge ()
 141   (let ((queue elmo-dop-queue)
 142         new-queue match-queue que)
 143     (while (setq que (car queue))
 144       (if (and
 145            (member (cadr que) elmo-dop-merge-funcs)
 146            (setq match-queue
 147                  (car (delete nil
 148                               (mapcar '(lambda (new-queue)
 149                                          (if (and
 150                                               (string= (car que) (car new-queue))
 151                                               (string= (cadr que) (cadr new-queue)))
 152                                              new-queue))
 153                                       new-queue)))))
 154           (setcar (cddr match-queue)
 155                   (append (nth 2 match-queue) (nth 2 que)))
 156         (setq new-queue (append new-queue (list que))))
 157       (setq queue (cdr queue)))
 158     (setq elmo-dop-queue new-queue)))
 159
 160 (defun elmo-dop-queue-load ()
 161   (save-excursion
 162     (setq elmo-dop-queue
 163           (elmo-object-load
 164            (expand-file-name elmo-queue-filename
 165                              elmo-msgdb-dir)))))
 166
 167 (defun elmo-dop-queue-save ()
 168   (save-excursion
 169     (elmo-object-save
 170      (expand-file-name elmo-queue-filename
 171                        elmo-msgdb-dir)
 172      elmo-dop-queue)))
 173
 174 (defun elmo-dop-lock-message (message-id &optional lock-list)
 175   (let ((locked (or lock-list
 176                     (elmo-object-load
 177                      (expand-file-name
 178                       elmo-msgdb-lock-list-filename
 179                       elmo-msgdb-dir)))))
 180     (setq locked (cons message-id locked))
 181     (elmo-object-save
 182      (expand-file-name elmo-msgdb-lock-list-filename
 183                        elmo-msgdb-dir)
 184      locked)))
 185
 186 (defun elmo-dop-unlock-message (message-id &optional lock-list)
 187   (let ((locked (or lock-list
 188                     (elmo-object-load
 189                      (expand-file-name elmo-msgdb-lock-list-filename
 190                                        elmo-msgdb-dir)))))
 191     (setq locked (delete message-id locked))
 192     (elmo-object-save
 193      (expand-file-name elmo-msgdb-lock-list-filename
 194                        elmo-msgdb-dir)
 195      locked)))
 196
 197 (defun elmo-dop-lock-list-load ()
 198   (elmo-object-load
 199    (expand-file-name elmo-msgdb-lock-list-filename
 200                      elmo-msgdb-dir)))
 201
 202 (defun elmo-dop-lock-list-save (lock-list)
 203   (elmo-object-save
 204    (expand-file-name elmo-msgdb-lock-list-filename
 205                      elmo-msgdb-dir)
 206    lock-list))
 207
 208 (defun elmo-dop-append-list-load (folder &optional resume)
 209   (elmo-object-load
 210    (expand-file-name (if resume
 211                          elmo-msgdb-resume-list-filename
 212                        elmo-msgdb-append-list-filename)
 213                      (elmo-msgdb-expand-path folder))))
 214
 215 (defun elmo-dop-append-list-save (folder append-list &optional resume)
 216   (if append-list
 217       (elmo-object-save
 218        (expand-file-name (if resume
 219                              elmo-msgdb-resume-list-filename
 220                            elmo-msgdb-append-list-filename)
 221                          (elmo-msgdb-expand-path folder))
 222        append-list)
 223     (condition-case ()
 224         (delete-file (expand-file-name (if resume
 225                                            elmo-msgdb-resume-list-filename
 226                                          elmo-msgdb-append-list-filename)
 227                                        (elmo-msgdb-expand-path folder)))
 228       (error))))
 229
 230 (defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended)
 231   "returns (new-appended . deleting-msgids)."
 232   (let (msgid deleting-msgids)
 233     (while numbers
 234       (setq msgid (cdr (assq (car numbers) alist)))
 235       (if (member msgid appended)
 236           (setq appended (delete msgid appended))
 237         (setq deleting-msgids (append deleting-msgids (list msgid))))
 238       (setq numbers (cdr numbers)))
 239     (cons appended deleting-msgids)))
 240
 241 (defun elmo-dop-delete-msgs (folder msgs msgdb)
 242   (save-match-data
 243     (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
 244           appended-deleting)
 245       (while folder-numbers
 246         (if (eq (elmo-folder-get-type (car (car folder-numbers)))
 247                 'imap4)
 248             (if elmo-enable-disconnected-operation
 249                 (progn
 250                   (setq appended-deleting
 251                         (elmo-dop-deleting-numbers-to-msgids
 252                          (elmo-msgdb-get-number-alist msgdb)
 253                          msgs ; virtual number
 254                          (elmo-dop-append-list-load folder)))
 255                   (if (cdr appended-deleting)
 256                       (elmo-dop-queue-append
 257                        (car (car folder-numbers)) ; real folder
 258                        "delete-msgids" ;; for secure removal.
 259                        (cdr appended-deleting)))
 260                   (elmo-dop-append-list-save folder (car appended-deleting)))
 261               (error "Unplugged"))
 262           ;; not imap4 folder...delete now!
 263           (elmo-call-func (car (car folder-numbers)) "delete-msgs"
 264                           (cdr (car folder-numbers))))
 265         (setq folder-numbers (cdr folder-numbers))))
 266     t))
 267
 268 (defun elmo-dop-prefetch-msgs (folder msgs)
 269   (save-match-data
 270     (elmo-dop-queue-append folder "prefetch-msgs" msgs)))
 271
 272 (defun elmo-dop-list-folder (folder)
 273   (if (or (memq (elmo-folder-get-type folder)
 274                 '(imap4 nntp pop3 filter pipe))
 275           (and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
 276       (if elmo-enable-disconnected-operation
 277           (let* ((number-alist (elmo-msgdb-number-load
 278                                 (elmo-msgdb-expand-path folder)))
 279                  (number-list (mapcar 'car number-alist))
 280                  (append-list (elmo-dop-append-list-load folder))
 281                  (append-num (length append-list))
 282                  alreadies
 283                  (i 0)
 284                  max-num)
 285             (while append-list
 286               (if (rassoc (car append-list) number-alist)
 287                   (setq alreadies (append alreadies
 288                                           (list (car append-list)))))
 289               (setq append-list (cdr append-list)))
 290             (setq append-num (- append-num (length alreadies)))
 291             (setq max-num
 292                   (or (nth (max (- (length number-list) 1) 0)
 293                            number-list) 0))
 294             (while (< i append-num)
 295               (setq number-list
 296                     (append number-list
 297                             (list (+ max-num i 1))))
 298               (setq i (+ 1 i)))
 299             number-list)
 300         (error "Unplugged"))
 301     ;; not imap4 folder...list folder
 302     (elmo-call-func folder "list-folder")))
 303
 304 (defun elmo-dop-count-appended (folder)
 305   (length (elmo-dop-append-list-load folder)))
 306
 307 (defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb)
 308   (let ((append-list (elmo-dop-append-list-load folder))
 309         (number-alist (elmo-msgdb-get-number-alist msgdb))
 310         matched)
 311     (if (eq (elmo-folder-get-type folder) 'imap4)
 312         (progn
 313           (while append-list
 314             (if (setq matched (car (rassoc (car append-list) number-alist)))
 315                 (setq msgs (delete matched msgs)))
 316             (setq append-list (cdr append-list)))
 317           (if msgs
 318               (elmo-dop-queue-append folder func-name msgs)))
 319       ;; maildir... XXX hard coding.....
 320       (if (not (featurep 'elmo-maildir))
 321           (require 'maildir))
 322       (funcall (intern (format "elmo-maildir-%s" func-name))
 323                (elmo-folder-get-spec folder)
 324                msgs msgdb))))
 325
 326 (defun elmo-dop-max-of-folder (folder)
 327   (if (eq (elmo-folder-get-type folder) 'imap4)
 328       (if elmo-enable-disconnected-operation
 329           (let* ((number-alist (elmo-msgdb-number-load
 330                                        (elmo-msgdb-expand-path folder)))
 331                  (number-list (mapcar 'car number-alist))
 332                  (append-list (elmo-dop-append-list-load folder))
 333                  (append-num (length append-list))
 334                  alreadies
 335                  (i 0)
 336                  max-num)
 337             (while append-list
 338               (if (rassoc (car append-list) number-alist)
 339                   (setq alreadies (append alreadies
 340                                           (list (car append-list)))))
 341               (setq append-list (cdr append-list)))
 342             (setq max-num
 343                   (or (nth (max (- (length number-list) 1) 0) number-list)
 344                       0))
 345             (cons (- (+ max-num append-num) (length alreadies))
 346                   (- (+ (length number-list) append-num) (length alreadies))))
 347         (error "Unplugged"))
 348     ;; not imap4 folder.
 349     (elmo-call-func folder "max-of-folder")))
 350
 351 (defun elmo-dop-save-pending-messages (folder)
 352   (message (format "Saving queued message in %s..." elmo-lost+found-folder))
 353   (let* ((append-list (elmo-dop-append-list-load folder))
 354          file-string)
 355     (while append-list
 356       (when (setq file-string (elmo-get-file-string  ; message string
 357                                (elmo-cache-get-path
 358                                 (car append-list))))
 359         (elmo-append-msg elmo-lost+found-folder file-string)
 360         (elmo-dop-unlock-message (car append-list)))
 361       (setq append-list (cdr append-list))
 362       (elmo-dop-append-list-save folder nil)))
 363   (message (format "Saving queued message in %s...done."
 364                    elmo-lost+found-folder)))
 365
 366 (defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
 367   (message "Appending queued messages...")
 368   (let* ((append-list (or appends
 369                           (elmo-dop-append-list-load folder)))
 370          (appendings append-list)
 371          (i 0)
 372          (num (length append-list))
 373          failure file-string)
 374     (when resume
 375       ;; Resume msgdb changed by elmo-dop-msgdb-create.
 376       (let* ((resumed-list (elmo-dop-append-list-load folder t))
 377              (number-alist (elmo-msgdb-number-load
 378                             (elmo-msgdb-expand-path folder)))
 379              (appendings append-list)
 380              pair dels)
 381         (while appendings
 382           (if (setq pair (rassoc (car appendings) number-alist))
 383               (setq resumed-list (append resumed-list
 384                                          (list (car appendings)))))
 385           (setq appendings (cdr appendings)))
 386         (elmo-dop-append-list-save folder resumed-list t)))
 387     (while appendings
 388       (setq failure nil)
 389       (setq file-string (elmo-get-file-string  ; message string
 390                          (elmo-cache-get-path
 391                           (car appendings))))
 392       (when file-string
 393         (condition-case ()
 394             (elmo-append-msg folder file-string (car appendings))
 395           (quit  (setq failure t))
 396           (error (setq failure t)))
 397         (setq i (+ 1 i))
 398         (message (format "Appending queued messages...%d" i))
 399         (if failure
 400             (elmo-append-msg elmo-lost+found-folder
 401                              file-string (car appendings))))
 402       (elmo-dop-unlock-message (car appendings))
 403       (setq appendings (cdr appendings)))
 404     ;; All pending append operation is flushed.
 405     (elmo-dop-append-list-save folder nil)
 406     (elmo-commit folder)
 407     (unless resume
 408       ;; delete '(folder "append-operations") in elmo-dop-queue.
 409       (let (elmo-dop-queue)
 410         (elmo-dop-queue-load)
 411         (setq elmo-dop-queue (delete (list folder "append-operations" nil)
 412                                      elmo-dop-queue))
 413         (elmo-dop-queue-save))))
 414   (message "Appending queued messages...done."))
 415
 416 (defun elmo-dop-folder-exists-p (folder)
 417   (if (and elmo-enable-disconnected-operation
 418            (eq (elmo-folder-get-type folder) 'imap4))
 419       (file-exists-p (elmo-msgdb-expand-path folder))
 420     (elmo-call-func folder "folder-exists-p")))
 421
 422 (defun elmo-dop-create-folder (folder)
 423   (if (eq (elmo-folder-get-type folder) 'imap4)
 424       (if elmo-enable-disconnected-operation
 425           (elmo-dop-queue-append folder "create-folder-maybe" nil)
 426         (error "Unplugged"))
 427     (elmo-call-func folder "create-folder")))
 428
 429 (defun elmo-dop-delete-folder (folder)
 430   (error "Unplugged"))
 431
 432 (defun elmo-dop-rename-folder (old-folder new-folder)
 433   (error "Unplugged"))
 434
 435 (defun elmo-dop-append-msg (folder string message-id &optional msg)
 436   (if elmo-enable-disconnected-operation
 437       (if message-id
 438           (progn
 439             (unless (elmo-cache-exists-p message-id)
 440               (elmo-set-work-buf
 441                (insert string)
 442                (elmo-cache-save message-id nil folder msg (current-buffer))))
 443             (let ((append-list (elmo-dop-append-list-load folder))
 444                   (number-alist (elmo-msgdb-number-load
 445                                  (elmo-msgdb-expand-path folder))))
 446               (when (and ; not in current folder.
 447                      (not (rassoc message-id number-alist))
 448                      (not (member message-id append-list)))
 449                 (setq append-list
 450                       (append append-list (list message-id)))
 451                 (elmo-dop-lock-message message-id)
 452                 (elmo-dop-append-list-save folder append-list)
 453                 (elmo-dop-queue-append folder "append-operations" nil))
 454               t))
 455         nil)
 456     (error "Unplugged")))
 457
 458 (defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist)
 459
 460 (defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark
 461                                                 seen-mark important-mark
 462                                                 seen-list)
 463   (if (or (eq (elmo-folder-get-type folder) 'imap4)
 464           (eq (elmo-folder-get-type folder) 'nntp))
 465       (if elmo-enable-disconnected-operation
 466           (let* ((num-alist (elmo-msgdb-number-load
 467                              (elmo-msgdb-expand-path folder)))
 468                  (number-list (mapcar 'car num-alist))
 469                  (ov (elmo-msgdb-overview-load
 470                       (elmo-msgdb-expand-path folder)))
 471                  (append-list (elmo-dop-append-list-load folder))
 472                  (num (length numlist))
 473                  (i 0)
 474                  overview number-alist mark-alist msgid ov-entity
 475                  max-num percent seen gmark)
 476             (setq max-num
 477                   (or (nth (max (- (length number-list) 1) 0) number-list)
 478                       0))
 479             (while numlist
 480               (if (setq msgid
 481                         (nth (+ (length append-list)
 482                                 (- (car numlist) max-num 1 num))
 483                              append-list))
 484                   (progn
 485                     (setq overview
 486                           (elmo-msgdb-append-element
 487                            overview
 488                            (elmo-localdir-msgdb-create-overview-entity-from-file
 489                             (car numlist)
 490                             (elmo-cache-get-path msgid))))
 491                     (setq number-alist
 492                           (elmo-msgdb-number-add number-alist
 493                                                  (car numlist) msgid))
 494                     (setq seen (member msgid seen-list))
 495                     (if (setq gmark
 496                               (or (elmo-msgdb-global-mark-get msgid)
 497                                   (if (elmo-cache-exists-p
 498                                        msgid
 499                                        folder
 500                                        (car number-alist))
 501                                       (if seen
 502                                           nil
 503                                         already-mark)
 504                                     (if seen
 505                                         seen-mark)
 506                                     new-mark)))
 507                         (setq mark-alist
 508                               (elmo-msgdb-mark-append
 509                                mark-alist (car numlist) gmark))))
 510
 511                 (when (setq ov-entity (assoc
 512                                        (cdr (assq (car numlist) num-alist))
 513                                        ov))
 514                   (setq overview
 515                         (elmo-msgdb-append-element
 516                          overview ov-entity))
 517                   (setq number-alist
 518                         (elmo-msgdb-number-add number-alist
 519                                                (car numlist)
 520                                                (car ov-entity)))
 521                   (setq seen (member ov-entity seen-list))
 522                   (if (setq gmark
 523                             (or (elmo-msgdb-global-mark-get (car ov-entity))
 524                                 (if (elmo-cache-exists-p
 525                                      msgid
 526                                      folder
 527                                      (car ov-entity))
 528                                     (if seen
 529                                         nil
 530                                       already-mark)
 531                                   (if seen
 532                                       seen-mark)
 533                                   new-mark)))
 534                       (setq mark-alist
 535                             (elmo-msgdb-mark-append
 536                              mark-alist (car numlist) gmark)))))
 537               (setq i (1+ i))
 538               (setq percent (/ (* i 100) num))
 539               (elmo-display-progress
 540                'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
 541                percent)
 542               (setq numlist (cdr numlist)))
 543             (list overview number-alist mark-alist))
 544         (error "Unplugged"))
 545     ;; not imap4 folder...
 546     (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
 547                     seen-mark important-mark seen-list)))
 548
 549 (provide 'elmo-dop)
 550
 551 ;;; elmo-dop.el ends here