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)
  33 (require 'elmo-vars)
  34 (require 'elmo-msgdb)
  35 (require 'elmo-util)
  36 (require 'elmo-localdir)
  37
  38 ;; global variable.
  39 (defvar elmo-dop-queue nil
  40   "A list of (folder-name function-to-be-called argument-list).
  41 Automatically loaded/saved.")
  42
  43 (defmacro elmo-make-dop-queue (fname method arguments)
  44   "Make a dop queue."
  45   (` (vector (, fname) (, method) (, arguments))))
  46
  47 (defmacro elmo-dop-queue-fname (queue)
  48   "Return the folder name string of the QUEUE."
  49   (` (aref (, queue) 0)))
  50
  51 (defmacro elmo-dop-queue-method (queue)
  52   "Return the method symbol of the QUEUE."
  53   (` (aref (, queue) 1)))
  54
  55 (defmacro elmo-dop-queue-arguments (queue)
  56   "Return the arguments of the QUEUE."
  57   (` (aref (, queue) 2)))
  58
  59 (defun elmo-dop-queue-append (folder method arguments)
  60   "Append to disconnected operation queue."
  61   (let ((queue (elmo-make-dop-queue (elmo-folder-name-internal folder)
  62                                     method arguments)))
  63     (setq elmo-dop-queue (nconc elmo-dop-queue (list queue)))))
  64
  65 (defvar elmo-dop-queue-merge-method-list
  66   '(elmo-folder-set-read-delayed
  67     elmo-folder-unset-read-delayed
  68     elmo-folder-set-important-delayed
  69     elmo-folder-unset-important-delayed
  70     elmo-folder-set-answered-delayed
  71     elmo-folder-unset-answered-delayed))
  72
  73 (defvar elmo-dop-queue-method-name-alist
  74   '((elmo-folder-append-buffer-dop-delayed . "Append")
  75     (elmo-folder-delete-messages-dop-delayed . "Delete")
  76     (elmo-message-encache . "Encache")
  77     (elmo-folder-create-dop-delayed . "Create")
  78     (elmo-folder-set-read-delayed . "Read")
  79     (elmo-folder-unset-read-delayed . "Unread")
  80     (elmo-folder-set-answered-delayed . "Answered")
  81     (elmo-folder-unset-answered-delayed . "Unanswered")
  82     (elmo-folder-set-important-delayed . "Important")
  83     (elmo-folder-unset-important-delayed . "Unimportant")
  84     (elmo-folder-set-flag . "Set flag")
  85     (elmo-folder-unset-flag . "Unset flag")))
  86
  87 (defmacro elmo-dop-queue-method-name (queue)
  88   `(cdr (assq (elmo-dop-queue-method ,queue)
  89               elmo-dop-queue-method-name-alist)))
  90
  91 (defun elmo-dop-queue-flush ()
  92   "Flush disconnected operations that consern plugged folders."
  93   ;; obsolete
  94   (unless (or (null elmo-dop-queue)
  95               (vectorp (car elmo-dop-queue)))
  96     (if (y-or-n-p "\
  97 Saved queue is old version(2.6).  Clear all pending operations? ")
  98         (progn
  99           (setq elmo-dop-queue nil)
 100           (message "All pending operations are cleared.")
 101           (elmo-dop-queue-save))
 102       (error "Please use 2.6 or earlier")))
 103   (elmo-dop-queue-merge)
 104   (let ((queue-all elmo-dop-queue)
 105         queue
 106         (count 0)
 107         len)
 108     (while queue-all
 109       (if (elmo-folder-plugged-p
 110            (elmo-make-folder (elmo-dop-queue-fname (car queue-all))))
 111           (setq queue (append queue (list (car queue-all)))))
 112       (setq queue-all (cdr queue-all)))
 113     (setq count (length queue))
 114     (when (> count 0)
 115       (if (elmo-y-or-n-p
 116            (format "%d pending operation(s) exists.  Perform now? " count)
 117            (not elmo-dop-flush-confirm) t)
 118           (progn
 119             (message "")
 120             (sit-for 0)
 121             (let ((queue elmo-dop-queue)
 122                   (performed 0)
 123                   (i 0)
 124                   (num (length elmo-dop-queue))
 125                   folder func failure)
 126               (while queue
 127                 ;; now perform pending processes.
 128                 (setq failure nil)
 129                 (setq i (+ 1 i))
 130                 (message "Flushing queue....%d/%d." i num)
 131                 (condition-case err
 132                     (progn
 133                       (apply (elmo-dop-queue-method (car queue))
 134                              (prog1
 135                                  (setq folder
 136                                        (elmo-make-folder
 137                                         (elmo-dop-queue-fname (car queue))))
 138                                (elmo-folder-open folder)
 139                                (unless (elmo-folder-plugged-p folder)
 140                                  (error "Unplugged")))
 141                              (elmo-dop-queue-arguments (car queue)))
 142                       (elmo-folder-close folder))
 143                   (quit  (setq failure t))
 144                   (error (setq failure err)))
 145                 (if failure
 146                     ();
 147                   (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 148                   (setq performed (+ 1 performed)))
 149                 (setq queue (cdr queue)))
 150               (message "%d/%d operation(s) are performed successfully."
 151                        performed num)
 152               (sit-for 0) ;
 153               (elmo-dop-queue-save)))
 154         ;; when answer=NO against performing dop
 155         (if (elmo-y-or-n-p "Clear these pending operations? "
 156                            (not elmo-dop-flush-confirm) t)
 157             (progn
 158               (while queue
 159                 (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 160                 (setq queue (cdr queue)))
 161               (message "Pending operations are cleared.")
 162               (elmo-dop-queue-save))
 163           (message "")))
 164       count)))
 165
 166 (defun elmo-dop-queue-merge ()
 167   (let ((queue elmo-dop-queue)
 168         new-queue match-queue que)
 169     (while (setq que (car queue))
 170       (if (and
 171            (memq (elmo-dop-queue-method que)
 172                  elmo-dop-queue-merge-method-list)
 173            (setq match-queue
 174                  (car (delete
 175                        nil
 176                        (mapcar
 177                         (lambda (nqueue)
 178                           (if (and
 179                                (string= (elmo-dop-queue-fname que)
 180                                         (elmo-dop-queue-fname nqueue))
 181                                (string= (elmo-dop-queue-method que)
 182                                         (elmo-dop-queue-method nqueue)))
 183                               nqueue))
 184                         new-queue)))))
 185           (setcar (elmo-dop-queue-arguments match-queue)
 186                   (append (car (elmo-dop-queue-arguments match-queue))
 187                           (car (elmo-dop-queue-arguments que))))
 188         (setq new-queue (nconc new-queue (list que))))
 189       (setq queue (cdr queue)) )
 190     (setq elmo-dop-queue new-queue)))
 191
 192 ;;; dop spool folder
 193 (defmacro elmo-dop-spool-folder (folder)
 194   "Return a spool folder for disconnected operations
 195 which is corresponded to the FOLDER."
 196   (` (elmo-make-folder
 197       (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path
 198                                              (, folder)))))))
 199
 200 (defun elmo-dop-spool-folder-append-buffer (folder)
 201   "Append current buffer content to the dop spool folder.
 202 FOLDER is the folder structure.
 203 Return a message number."
 204   (setq folder (elmo-dop-spool-folder folder))
 205   (unless (elmo-folder-exists-p folder)
 206     (elmo-folder-create folder))
 207   (let ((new-number (1+ (car (elmo-folder-status folder)))))
 208     ;; dop folder is a localdir folder.
 209     (write-region-as-binary (point-min) (point-max)
 210                           (expand-file-name
 211                            (int-to-string new-number)
 212                            (elmo-localdir-folder-directory-internal folder))
 213                           nil 'no-msg)
 214     new-number))
 215
 216
 217 (defun elmo-dop-spool-folder-list-messages (folder)
 218   "List messages in the dop spool folder.
 219 FOLDER is the folder structure."
 220   (setq folder (elmo-dop-spool-folder folder))
 221   (if (elmo-folder-exists-p folder)
 222       (elmo-folder-list-messages folder)))
 223
 224 (defun elmo-dop-list-deleting-messages (folder)
 225   "List messages which are on the deleting queue for the folder.
 226 FOLDER is the folder structure."
 227   (let (messages)
 228     (dolist (queue elmo-dop-queue)
 229       (if (and (string= (elmo-dop-queue-fname queue)
 230                         (elmo-folder-name-internal folder))
 231                (eq (elmo-dop-queue-method queue)
 232                    'elmo-folder-delete-messages-dop-delayed))
 233           (setq messages (nconc messages
 234                                 (mapcar
 235                                  'car
 236                                  (car (elmo-dop-queue-arguments queue)))))))))
 237
 238 ;;; DOP operations.
 239 (defsubst elmo-folder-append-buffer-dop (folder &optional flag number)
 240   (elmo-dop-queue-append
 241    folder 'elmo-folder-append-buffer-dop-delayed
 242    (list flag
 243          (elmo-dop-spool-folder-append-buffer
 244           folder)
 245          number)))
 246
 247 (defsubst elmo-folder-delete-messages-dop (folder numbers)
 248   (let ((spool-folder (elmo-dop-spool-folder folder))
 249         queue)
 250     (dolist (number numbers)
 251       (if (< number 0)
 252           (elmo-folder-delete-messages spool-folder
 253                                        (list (abs number))) ; delete from queue
 254         (setq queue (cons number queue))))
 255     (when queue
 256       (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed
 257                              (list
 258                               (mapcar
 259                                (lambda (number)
 260                                  (cons number (elmo-message-field
 261                                                folder number 'message-id)))
 262                                queue))))
 263     t))
 264
 265 (defsubst elmo-message-encache-dop (folder number &optional read)
 266   (elmo-dop-queue-append folder 'elmo-message-encache (list number read)))
 267
 268 (defsubst elmo-folder-create-dop (folder)
 269   (elmo-dop-queue-append folder 'elmo-folder-create-dop-delayed nil))
 270
 271 (defsubst elmo-folder-set-flag-dop (folder numbers flag)
 272   (let ((method (case flag
 273                   (unread
 274                    'elmo-folder-unset-read-delayed)
 275                   (read
 276                    'elmo-folder-set-read-delayed)
 277                   (important
 278                    'elmo-folder-set-important-delayed)
 279                   (answered
 280                    'elmo-folder-set-answered-delayed))))
 281     (if method
 282         (elmo-dop-queue-append folder method (list numbers))
 283       (elmo-dop-queue-append folder 'elmo-folder-set-flag
 284                              (list numbers flag)))))
 285
 286 (defsubst elmo-folder-unset-flag-dop (folder numbers flag)
 287   (let ((method (case flag
 288                   (unread
 289                    'elmo-folder-set-read-delayed)
 290                   (read
 291                    'elmo-folder-unset-read-delayed)
 292                   (important
 293                    'elmo-folder-unset-important-delayed)
 294                   (answered
 295                    'elmo-folder-unset-answered-delayed))))
 296     (if method
 297         (elmo-dop-queue-append folder method (list numbers))
 298       (elmo-dop-queue-append folder 'elmo-folder-unset-flag
 299                              (list numbers flag)))))
 300
 301 ;;; Execute as subsutitute for plugged operation.
 302 (defun elmo-folder-status-dop (folder)
 303   (let ((number-list (elmo-folder-list-messages folder nil 'in-msgdb))
 304         (spool-folder (elmo-dop-spool-folder folder))
 305         spool-length
 306         max-num)
 307     (setq spool-length (or (if (elmo-folder-exists-p spool-folder)
 308                                (car (elmo-folder-status spool-folder)))
 309                            0))
 310     (setq max-num (if number-list (apply #'max number-list) 0))
 311     (cons (+ max-num spool-length) (+ (length number-list) spool-length))))
 312
 313 (defun elmo-folder-next-message-number-dop (folder)
 314   (let ((number-list (elmo-folder-list-messages folder nil 'in-msgdb))
 315         (spool-folder (elmo-dop-spool-folder folder))
 316         spool-length
 317         max-num)
 318     (setq spool-length (or (if (elmo-folder-exists-p spool-folder)
 319                                (car (elmo-folder-status spool-folder)))
 320                            0))
 321     (setq max-num (if number-list (apply #'max number-list) 0))
 322     (+ max-num spool-length)))
 323
 324 ;;; Delayed operation (executed at online status).
 325 (defun elmo-folder-append-buffer-dop-delayed (folder flag number set-number)
 326   (let ((spool-folder (elmo-dop-spool-folder folder))
 327         (flags (cond ((listp flag)
 328                       flag)
 329                      ;; for compatibility
 330                      ((eq flag t)
 331                       nil)
 332                      (t
 333                       (list flag))))
 334         failure saved dequeued)
 335     (with-temp-buffer
 336       (if (elmo-message-fetch spool-folder number
 337                               (elmo-make-fetch-strategy 'entire)
 338                               nil (current-buffer) 'unread)
 339           (condition-case nil
 340               (setq failure (not
 341                              (elmo-folder-append-buffer
 342                               folder
 343                               flags
 344                               set-number)))
 345             (error (setq failure t)))
 346         (setq dequeued t)) ; Already deletef from queue.
 347       (when failure
 348         ;; Append failed...
 349         (setq saved (elmo-folder-append-buffer
 350                      (elmo-make-folder elmo-lost+found-folder)
 351                      flags
 352                      set-number)))
 353       (if (and (not dequeued)    ; if dequeued, no need to delete.
 354                (or (not failure) ; succeed
 355                    saved))       ; in lost+found
 356           (elmo-folder-delete-messages spool-folder (list number)))
 357       t)))
 358
 359 (defun elmo-folder-delete-messages-dop-delayed (folder number-alist)
 360   (ignore-errors
 361     (elmo-folder-delete-messages
 362      folder
 363      ;; messages are deleted only if message-id is not changed.
 364      (mapcar 'car
 365              (elmo-delete-if
 366               (lambda (pair)
 367                 (not (string=
 368                       (cdr pair)
 369                       (elmo-message-fetch-field folder (car pair)
 370                                                 'message-id))))
 371               number-alist)))
 372     t)) ; Always success (If failure, just remain)
 373
 374 (defun elmo-folder-create-dop-delayed (folder)
 375   (unless (elmo-folder-exists-p folder)
 376     (elmo-folder-create folder)))
 377
 378 (defun elmo-folder-set-important-delayed (folder numbers)
 379   (elmo-folder-set-flag folder numbers 'important))
 380
 381 (defun elmo-folder-unset-important-delayed (folder numbers)
 382   (elmo-folder-unset-flag folder numbers 'important))
 383
 384 (defun elmo-folder-set-read-delayed (folder numbers)
 385   (elmo-folder-set-flag folder numbers 'read))
 386
 387 (defun elmo-folder-unset-read-delayed (folder numbers)
 388   (elmo-folder-unset-flag folder numbers 'read))
 389
 390 (defun elmo-folder-set-answered-delayed (folder numbers)
 391   (elmo-folder-set-flag folder numbers 'answered))
 392
 393 (defun elmo-folder-unset-answered-delayed (folder numbers)
 394   (elmo-folder-unset-flag folder numbers 'answered))
 395
 396 ;;; Util
 397 (defun elmo-dop-msgdb (msgdb)
 398   (let ((new-db (elmo-make-msgdb))
 399         entity)
 400     (dolist (dop-entity (mapcar
 401                          (lambda (number)
 402                            (setq entity (elmo-msgdb-message-entity
 403                                          msgdb number))
 404                            (elmo-message-entity-set-number
 405                             entity
 406                             (* -1 (elmo-message-entity-number entity)))
 407                            entity)
 408                          (elmo-msgdb-list-messages msgdb)))
 409       (elmo-msgdb-append-entity new-db
 410                                 dop-entity
 411                                 (elmo-msgdb-flags
 412                                  msgdb
 413                                  (abs (elmo-message-entity-number
 414                                        dop-entity)))))
 415     new-db))
 416
 417 (require 'product)
 418 (product-provide (provide 'elmo-dop) (require 'elmo-version))
 419
 420 ;;; elmo-dop.el ends here