elmo/elmo-dop.el

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