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
   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 (format "%s" 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-delete-msgs (folder msgs msgdb)
 245   (save-match-data
 246     (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
 247           appended-deleting)
 248       (while folder-numbers
 249         (if (eq (elmo-folder-get-type (car (car folder-numbers)))
 250                 'imap4)
 251             (if elmo-enable-disconnected-operation
 252                 (progn
 253                   (setq appended-deleting
 254                         (elmo-dop-deleting-numbers-to-msgids
 255                          (elmo-msgdb-get-number-alist msgdb)
 256                          msgs ; virtual number
 257                          (elmo-dop-append-list-load folder)))
 258                   (if (cdr appended-deleting)
 259                       (elmo-dop-queue-append
 260                        (car (car folder-numbers)) ; real folder
 261                        "delete-msgids" ;; for secure removal.
 262                        (cdr appended-deleting)))
 263                   (elmo-dop-append-list-save folder (car appended-deleting)))
 264               (error "Unplugged"))
 265           ;; not imap4 folder...delete now!
 266           (elmo-call-func (car (car folder-numbers)) "delete-msgs"
 267                           (cdr (car folder-numbers))))
 268         (setq folder-numbers (cdr folder-numbers))))
 269     t))
 270
 271 (defun elmo-dop-prefetch-msgs (folder msgs)
 272   (save-match-data
 273     (elmo-dop-queue-append folder "prefetch-msgs" msgs)))
 274
 275 (defun elmo-dop-list-folder (folder)
 276   (if (or (memq (elmo-folder-get-type folder)
 277                 '(imap4 nntp pop3 filter pipe))
 278           (and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
 279       (if elmo-enable-disconnected-operation
 280           (let* ((path (elmo-msgdb-expand-path folder))
 281                  (number-alist (elmo-msgdb-number-load path))
 282                  (number-list (mapcar 'car number-alist))
 283                  (append-list (elmo-dop-append-list-load folder))
 284                  (append-num (length append-list))
 285                  (killed (and elmo-use-killed-list
 286                               (elmo-msgdb-killed-list-load path)))
 287                  alreadies
 288                  max-num
 289                  (i 0))
 290             (while append-list
 291               (if (rassoc (car append-list) number-alist)
 292                   (setq alreadies (append alreadies
 293                                           (list (car append-list)))))
 294               (setq append-list (cdr append-list)))
 295             (setq append-num (- append-num (length alreadies)))
 296             (setq max-num
 297                   (or (nth (max (- (length number-list) 1) 0)
 298                            number-list) 0))
 299             (while (< i append-num)
 300               (setq number-list
 301                     (append number-list
 302                             (list (+ max-num i 1))))
 303               (setq i (+ 1 i)))
 304             (if killed
 305                 (delq nil
 306                       (mapcar (lambda (number)
 307                                 (unless (memq number killed) number))
 308                               number-list))
 309               number-list))
 310         (error "Unplugged"))
 311     ;; not imap4 folder...list folder
 312     (elmo-call-func folder "list-folder")))
 313
 314 (defun elmo-dop-count-appended (folder)
 315   (length (elmo-dop-append-list-load folder)))
 316
 317 (defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb)
 318   (let ((append-list (elmo-dop-append-list-load folder))
 319         (number-alist (elmo-msgdb-get-number-alist msgdb))
 320         matched)
 321     (if (eq (elmo-folder-get-type folder) 'imap4)
 322         (progn
 323           (while append-list
 324             (if (setq matched (car (rassoc (car append-list) number-alist)))
 325                 (setq msgs (delete matched msgs)))
 326             (setq append-list (cdr append-list)))
 327           (if msgs
 328               (elmo-dop-queue-append folder func-name msgs)))
 329       ;; maildir... XXX hard coding.....
 330       (if (not (featurep 'elmo-maildir))
 331           (require 'maildir))
 332       (funcall (intern (format "elmo-maildir-%s" func-name))
 333                (elmo-folder-get-spec folder)
 334                msgs msgdb))))
 335
 336 (defun elmo-dop-max-of-folder (folder)
 337   (if (eq (elmo-folder-get-type folder) 'imap4)
 338       (if elmo-enable-disconnected-operation
 339           (let* ((number-alist (elmo-msgdb-number-load
 340                                        (elmo-msgdb-expand-path folder)))
 341                  (number-list (mapcar 'car number-alist))
 342                  (append-list (elmo-dop-append-list-load folder))
 343                  (append-num (length append-list))
 344                  alreadies
 345                  (i 0)
 346                  max-num)
 347             (while append-list
 348               (if (rassoc (car append-list) number-alist)
 349                   (setq alreadies (append alreadies
 350                                           (list (car append-list)))))
 351               (setq append-list (cdr append-list)))
 352             (setq max-num
 353                   (or (nth (max (- (length number-list) 1) 0) number-list)
 354                       0))
 355             (cons (- (+ max-num append-num) (length alreadies))
 356                   (- (+ (length number-list) append-num) (length alreadies))))
 357         (error "Unplugged"))
 358     ;; not imap4 folder.
 359     (elmo-call-func folder "max-of-folder")))
 360
 361 (defun elmo-dop-save-pending-messages (folder)
 362   (message (format "Saving queued message in %s..." elmo-lost+found-folder))
 363   (let* ((append-list (elmo-dop-append-list-load folder))
 364          file-string)
 365     (while append-list
 366       (when (setq file-string (elmo-get-file-string  ; message string
 367                                (elmo-cache-get-path
 368                                 (car append-list))))
 369         (elmo-append-msg elmo-lost+found-folder file-string)
 370         (elmo-dop-unlock-message (car append-list)))
 371       (setq append-list (cdr append-list))
 372       (elmo-dop-append-list-save folder nil)))
 373   (message (format "Saving queued message in %s...done."
 374                    elmo-lost+found-folder)))
 375
 376 (defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
 377   (message "Appending queued messages...")
 378   (let* ((append-list (or appends
 379                           (elmo-dop-append-list-load folder)))
 380          (appendings append-list)
 381          (i 0)
 382          (num (length append-list))
 383          failure file-string)
 384     (when resume
 385       ;; Resume msgdb changed by elmo-dop-msgdb-create.
 386       (let* ((resumed-list (elmo-dop-append-list-load folder t))
 387              (number-alist (elmo-msgdb-number-load
 388                             (elmo-msgdb-expand-path folder)))
 389              (appendings append-list)
 390              pair dels)
 391         (while appendings
 392           (if (setq pair (rassoc (car appendings) number-alist))
 393               (setq resumed-list (append resumed-list
 394                                          (list (car appendings)))))
 395           (setq appendings (cdr appendings)))
 396         (elmo-dop-append-list-save folder resumed-list t)))
 397     (while appendings
 398       (setq failure nil)
 399       (setq file-string (elmo-get-file-string  ; message string
 400                          (elmo-cache-get-path
 401                           (car appendings))))
 402       (when file-string
 403         (condition-case ()
 404             (elmo-append-msg folder file-string (car appendings))
 405           (quit  (setq failure t))
 406           (error (setq failure t)))
 407         (setq i (+ 1 i))
 408         (message (format "Appending queued messages...%d" i))
 409         (if failure
 410             (elmo-append-msg elmo-lost+found-folder
 411                              file-string (car appendings))))
 412       (elmo-dop-unlock-message (car appendings))
 413       (setq appendings (cdr appendings)))
 414     ;; All pending append operation is flushed.
 415     (elmo-dop-append-list-save folder nil)
 416     (elmo-commit folder)
 417     (unless resume
 418       ;; delete '(folder "append-operations") in elmo-dop-queue.
 419       (let (elmo-dop-queue)
 420         (elmo-dop-queue-load)
 421         (setq elmo-dop-queue (delete (list folder "append-operations" nil)
 422                                      elmo-dop-queue))
 423         (elmo-dop-queue-save))))
 424   (message "Appending queued messages...done."))
 425
 426 (defun elmo-dop-folder-exists-p (folder)
 427   (if (and elmo-enable-disconnected-operation
 428            (eq (elmo-folder-get-type folder) 'imap4))
 429       (file-exists-p (elmo-msgdb-expand-path folder))
 430     (elmo-call-func folder "folder-exists-p")))
 431
 432 (defun elmo-dop-create-folder (folder)
 433   (if (eq (elmo-folder-get-type folder) 'imap4)
 434       (if elmo-enable-disconnected-operation
 435           (elmo-dop-queue-append folder "create-folder-maybe" nil)
 436         (error "Unplugged"))
 437     (elmo-call-func folder "create-folder")))
 438
 439 (defun elmo-dop-delete-folder (folder)
 440   (error "Unplugged"))
 441
 442 (defun elmo-dop-rename-folder (old-folder new-folder)
 443   (error "Unplugged"))
 444
 445 (defun elmo-dop-append-msg (folder string message-id &optional msg)
 446   (if elmo-enable-disconnected-operation
 447       (if message-id
 448           (progn
 449             (unless (elmo-cache-exists-p message-id)
 450               (elmo-set-work-buf
 451                (insert string)
 452                (elmo-cache-save message-id nil folder msg (current-buffer))))
 453             (let ((append-list (elmo-dop-append-list-load folder))
 454                   (number-alist (elmo-msgdb-number-load
 455                                  (elmo-msgdb-expand-path folder))))
 456               (when (and ; not in current folder.
 457                      (not (rassoc message-id number-alist))
 458                      (not (member message-id append-list)))
 459                 (setq append-list
 460                       (append append-list (list message-id)))
 461                 (elmo-dop-lock-message message-id)
 462                 (elmo-dop-append-list-save folder append-list)
 463                 (elmo-dop-queue-append folder "append-operations" nil))
 464               t))
 465         nil)
 466     (error "Unplugged")))
 467
 468 (defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist)
 469
 470 (defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark
 471                                                 seen-mark important-mark
 472                                                 seen-list)
 473   (if (or (eq (elmo-folder-get-type folder) 'imap4)
 474           (eq (elmo-folder-get-type folder) 'nntp))
 475       (if elmo-enable-disconnected-operation
 476           (let* ((num-alist (elmo-msgdb-number-load
 477                              (elmo-msgdb-expand-path folder)))
 478                  (number-list (mapcar 'car num-alist))
 479                  (ov (elmo-msgdb-overview-load
 480                       (elmo-msgdb-expand-path folder)))
 481                  (append-list (elmo-dop-append-list-load folder))
 482                  (num (length numlist))
 483                  (i 0)
 484                  overview number-alist mark-alist msgid ov-entity
 485                  max-num percent seen gmark)
 486             (setq max-num
 487                   (or (nth (max (- (length number-list) 1) 0) number-list)
 488                       0))
 489             (while numlist
 490               (if (setq msgid
 491                         (nth (+ (length append-list)
 492                                 (- (car numlist) max-num 1 num))
 493                              append-list))
 494                   (progn
 495                     (setq overview
 496                           (elmo-msgdb-append-element
 497                            overview
 498                            (elmo-localdir-msgdb-create-overview-entity-from-file
 499                             (car numlist)
 500                             (elmo-cache-get-path msgid))))
 501                     (setq number-alist
 502                           (elmo-msgdb-number-add number-alist
 503                                                  (car numlist) msgid))
 504                     (setq seen (member msgid seen-list))
 505                     (if (setq gmark
 506                               (or (elmo-msgdb-global-mark-get msgid)
 507                                   (if (elmo-cache-exists-p
 508                                        msgid
 509                                        folder
 510                                        (car number-alist))
 511                                       (if seen
 512                                           nil
 513                                         already-mark)
 514                                     (if seen
 515                                         seen-mark)
 516                                     new-mark)))
 517                         (setq mark-alist
 518                               (elmo-msgdb-mark-append
 519                                mark-alist (car numlist) gmark))))
 520
 521                 (when (setq ov-entity (assoc
 522                                        (cdr (assq (car numlist) num-alist))
 523                                        ov))
 524                   (setq overview
 525                         (elmo-msgdb-append-element
 526                          overview ov-entity))
 527                   (setq number-alist
 528                         (elmo-msgdb-number-add number-alist
 529                                                (car numlist)
 530                                                (car ov-entity)))
 531                   (setq seen (member ov-entity seen-list))
 532                   (if (setq gmark
 533                             (or (elmo-msgdb-global-mark-get (car ov-entity))
 534                                 (if (elmo-cache-exists-p
 535                                      msgid
 536                                      folder
 537                                      (car ov-entity))
 538                                     (if seen
 539                                         nil
 540                                       already-mark)
 541                                   (if seen
 542                                       seen-mark)
 543                                   new-mark)))
 544                       (setq mark-alist
 545                             (elmo-msgdb-mark-append
 546                              mark-alist (car numlist) gmark)))))
 547               (when (> num elmo-display-progress-threshold)
 548                 (setq i (1+ i))
 549                 (setq percent (/ (* i 100) num))
 550                 (elmo-display-progress
 551                  'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
 552                  percent))
 553               (setq numlist (cdr numlist)))
 554             (list overview number-alist mark-alist))
 555         (error "Unplugged"))
 556     ;; not imap4 folder...
 557     (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
 558                     seen-mark important-mark seen-list)))
 559
 560 (provide 'elmo-dop)
 561
 562 ;;; elmo-dop.el ends here