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-mark-as-read
  67     elmo-folder-unmark-read
  68     elmo-folder-mark-as-important
  69     elmo-folder-unmark-important
  70     elmo-folder-mark-as-answered
  71     elmo-folder-unmark-answered))
  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-mark-as-read . "Read")
  79     (elmo-folder-unmark-read . "Unread")
  80     (elmo-folder-mark-as-answered . "Answered")
  81     (elmo-folder-unmark-answered . "Unanswered")
  82     (elmo-folder-mark-as-important . "Important")
  83     (elmo-folder-unmark-important . "Unimportant")))
  84
  85 (defmacro elmo-dop-queue-method-name (queue)
  86   `(cdr (assq (elmo-dop-queue-method ,queue)
  87               elmo-dop-queue-method-name-alist)))
  88
  89 (defun elmo-dop-queue-flush ()
  90   "Flush disconnected operations that consern plugged folders."
  91   ;; obsolete
  92   (unless (or (null elmo-dop-queue)
  93               (vectorp (car elmo-dop-queue)))
  94     (if (y-or-n-p "\
  95 Saved queue is old version(2.6).  Clear all pending operations? ")
  96         (progn
  97           (setq elmo-dop-queue nil)
  98           (message "All pending operations are cleared.")
  99           (elmo-dop-queue-save))
 100       (error "Please use 2.6 or earlier")))
 101   (elmo-dop-queue-merge)
 102   (let ((queue-all elmo-dop-queue)
 103         queue
 104         (count 0)
 105         len)
 106     (while queue-all
 107       (if (elmo-folder-plugged-p
 108            (elmo-make-folder (elmo-dop-queue-fname (car queue-all))))
 109           (setq queue (append queue (list (car queue-all)))))
 110       (setq queue-all (cdr queue-all)))
 111     (setq count (length queue))
 112     (when (> count 0)
 113       (if (elmo-y-or-n-p
 114            (format "%d pending operation(s) exists.  Perform now? " count)
 115            (not elmo-dop-flush-confirm) t)
 116           (progn
 117             (message "")
 118             (sit-for 0)
 119             (let ((queue elmo-dop-queue)
 120                   (performed 0)
 121                   (i 0)
 122                   (num (length elmo-dop-queue))
 123                   folder func failure)
 124               (while queue
 125                 ;; now perform pending processes.
 126                 (setq failure nil)
 127                 (setq i (+ 1 i))
 128                 (message "Flushing queue....%d/%d." i num)
 129                 (condition-case err
 130                     (progn
 131                       (apply (elmo-dop-queue-method (car queue))
 132                              (prog1
 133                                  (setq folder
 134                                        (elmo-make-folder
 135                                         (elmo-dop-queue-fname (car queue))))
 136                                (elmo-folder-open folder)
 137                                (unless (elmo-folder-plugged-p folder)
 138                                  (error "Unplugged")))
 139                              (elmo-dop-queue-arguments (car queue)))
 140                       (elmo-folder-close folder))
 141                   (quit  (setq failure t))
 142                   (error (setq failure err)))
 143                 (if failure
 144                     ();
 145                   (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 146                   (setq performed (+ 1 performed)))
 147                 (setq queue (cdr queue)))
 148               (message "%d/%d operation(s) are performed successfully."
 149                        performed num)
 150               (sit-for 0) ;
 151               (elmo-dop-queue-save)))
 152         ;; when answer=NO against performing dop
 153         (if (elmo-y-or-n-p "Clear these pending operations? "
 154                            (not elmo-dop-flush-confirm) t)
 155             (progn
 156               (while queue
 157                 (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 158                 (setq queue (cdr queue)))
 159               (message "Pending operations are cleared.")
 160               (elmo-dop-queue-save))
 161           (message "")))
 162       count)))
 163
 164 (defun elmo-dop-queue-merge ()
 165   (let ((queue elmo-dop-queue)
 166         new-queue match-queue que)
 167     (while (setq que (car queue))
 168       (if (and
 169            (memq (elmo-dop-queue-method que)
 170                  elmo-dop-queue-merge-method-list)
 171            (setq match-queue
 172                  (car (delete
 173                        nil
 174                        (mapcar
 175                         (lambda (nqueue)
 176                           (if (and
 177                                (string= (elmo-dop-queue-fname que)
 178                                         (elmo-dop-queue-fname nqueue))
 179                                (string= (elmo-dop-queue-method que)
 180                                         (elmo-dop-queue-method nqueue)))
 181                               nqueue))
 182                         new-queue)))))
 183           (setcar (elmo-dop-queue-arguments match-queue)
 184                   (append (car (elmo-dop-queue-arguments match-queue))
 185                           (car (elmo-dop-queue-arguments que))))
 186         (setq new-queue (nconc new-queue (list que))))
 187       (setq queue (cdr queue)) )
 188     (setq elmo-dop-queue new-queue)))
 189
 190 ;;; dop spool folder
 191 (defmacro elmo-dop-spool-folder (folder)
 192   "Return a spool folder for disconnected operations
 193 which is corresponded to the FOLDER."
 194   (` (elmo-make-folder
 195       (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path
 196                                              (, folder)))))))
 197
 198 (defun elmo-dop-spool-folder-append-buffer (folder)
 199   "Append current buffer content to the dop spool folder.
 200 FOLDER is the folder structure.
 201 Return a message number."
 202   (setq folder (elmo-dop-spool-folder folder))
 203   (unless (elmo-folder-exists-p folder)
 204     (elmo-folder-create folder))
 205   (let ((new-number (1+ (car (elmo-folder-status folder)))))
 206     ;; dop folder is a localdir folder.
 207     (write-region-as-binary (point-min) (point-max)
 208                           (expand-file-name
 209                            (int-to-string new-number)
 210                            (elmo-localdir-folder-directory-internal folder))
 211                           nil 'no-msg)
 212     new-number))
 213
 214
 215 (defun elmo-dop-spool-folder-list-messages (folder)
 216   "List messages in the dop spool folder.
 217 FOLDER is the folder structure."
 218   (setq folder (elmo-dop-spool-folder folder))
 219   (if (elmo-folder-exists-p folder)
 220       (elmo-folder-list-messages folder)))
 221
 222 (defun elmo-dop-list-deleting-messages (folder)
 223   "List messages which are on the deleting queue for the folder.
 224 FOLDER is the folder structure."
 225   (let (messages)
 226     (dolist (queue elmo-dop-queue)
 227       (if (and (string= (elmo-dop-queue-fname queue)
 228                         (elmo-folder-name-internal folder))
 229                (eq (elmo-dop-queue-method queue)
 230                    'elmo-folder-delete-messages-dop-delayed))
 231           (setq messages (nconc messages
 232                                 (mapcar
 233                                  'car
 234                                  (car (elmo-dop-queue-arguments queue)))))))))
 235
 236 ;;; DOP operations.
 237 (defsubst elmo-folder-append-buffer-dop (folder &optional flag number)
 238   (elmo-dop-queue-append
 239    folder 'elmo-folder-append-buffer-dop-delayed
 240    (list flag
 241          (elmo-dop-spool-folder-append-buffer
 242           folder)
 243          number)))
 244
 245 (defsubst elmo-folder-delete-messages-dop (folder numbers)
 246   (let ((spool-folder (elmo-dop-spool-folder folder))
 247         queue)
 248     (dolist (number numbers)
 249       (if (< number 0)
 250           (elmo-folder-delete-messages spool-folder
 251                                        (list (abs number))) ; delete from queue
 252         (setq queue (cons number queue))))
 253     (when queue
 254       (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed
 255                              (list
 256                               (mapcar
 257                                (lambda (number)
 258                                  (cons number (elmo-message-field
 259                                                folder number 'message-id)))
 260                                queue))))
 261     t))
 262
 263 (defsubst elmo-message-encache-dop (folder number &optional read)
 264   (elmo-dop-queue-append folder 'elmo-message-encache (list number read)))
 265
 266 (defsubst elmo-folder-create-dop (folder)
 267   (elmo-dop-queue-append folder 'elmo-folder-create-dop-delayed nil))
 268
 269 (defsubst elmo-folder-mark-as-read-dop (folder numbers)
 270   (elmo-dop-queue-append folder 'elmo-folder-mark-as-read (list numbers)))
 271
 272 (defsubst elmo-folder-unmark-read-dop (folder numbers)
 273   (elmo-dop-queue-append folder 'elmo-folder-unmark-read (list numbers)))
 274
 275 (defsubst elmo-folder-mark-as-important-dop (folder numbers)
 276   (elmo-dop-queue-append folder 'elmo-folder-mark-as-important (list numbers)))
 277
 278 (defsubst elmo-folder-unmark-important-dop (folder numbers)
 279   (elmo-dop-queue-append folder 'elmo-folder-unmark-important (list numbers)))
 280
 281 (defsubst elmo-folder-mark-as-answered-dop (folder numbers)
 282   (elmo-dop-queue-append folder 'elmo-folder-mark-as-answered (list numbers)))
 283
 284 (defsubst elmo-folder-unmark-answered-dop (folder numbers)
 285   (elmo-dop-queue-append folder 'elmo-folder-unmark-answered (list numbers)))
 286
 287 ;;; Execute as subsutitute for plugged operation.
 288 (defun elmo-folder-status-dop (folder)
 289   (let ((number-list (elmo-folder-list-messages folder nil 'in-msgdb))
 290         (spool-folder (elmo-dop-spool-folder folder))
 291         spool-length
 292         (i 0)
 293         max-num)
 294     (setq spool-length (or (car (if (elmo-folder-exists-p spool-folder)
 295                                     (elmo-folder-status spool-folder))) 0))
 296     (setq max-num
 297           (or (nth (max (- (length number-list) 1) 0) number-list)
 298               0))
 299     (cons (+ max-num spool-length) (+ (length number-list) spool-length))))
 300
 301 ;;; Delayed operation (executed at online status).
 302 (defun elmo-folder-append-buffer-dop-delayed (folder flag number set-number)
 303   (let ((spool-folder (elmo-dop-spool-folder folder))
 304         failure saved dequeued)
 305     (with-temp-buffer
 306       (if (elmo-message-fetch spool-folder number
 307                               (elmo-make-fetch-strategy 'entire)
 308                               nil (current-buffer) 'unread)
 309           (condition-case nil
 310               (setq failure (not
 311                              (elmo-folder-append-buffer
 312                               folder
 313                               (if (eq flag t) nil flag) ; for compatibility
 314                               set-number)))
 315             (error (setq failure t)))
 316         (setq dequeued t)) ; Already deletef from queue.
 317       (when failure
 318         ;; Append failed...
 319         (setq saved (elmo-folder-append-buffer
 320                      (elmo-make-folder elmo-lost+found-folder)
 321                      (if (eq flag t) nil flag) ; for compatibility
 322                      set-number)))
 323       (if (and (not dequeued)    ; if dequeued, no need to delete.
 324                (or (not failure) ; succeed
 325                    saved))       ; in lost+found
 326           (elmo-folder-delete-messages spool-folder (list number)))
 327       t)))
 328
 329 (defun elmo-folder-delete-messages-dop-delayed (folder number-alist)
 330   (elmo-folder-delete-messages
 331    folder
 332    ;; messages are deleted only if message-id is not changed.
 333    (mapcar 'car
 334            (elmo-delete-if
 335             (lambda (pair)
 336               (not (string=
 337                     (cdr pair)
 338                     (elmo-message-fetch-field folder (car pair)
 339                                               'message-id))))
 340             number-alist))))
 341
 342 (defun elmo-folder-create-dop-delayed (folder)
 343   (unless (elmo-folder-exists-p folder)
 344     (elmo-folder-create folder)))
 345
 346 ;;; Util
 347 (defun elmo-dop-msgdb (msgdb)
 348   (list (mapcar (function
 349                  (lambda (x)
 350                    (elmo-msgdb-overview-entity-set-number
 351                     x
 352                     (* -1
 353                        (elmo-msgdb-overview-entity-get-number x)))))
 354                 (nth 0 msgdb))
 355         (mapcar (function
 356                  (lambda (x) (cons
 357                               (* -1 (car x))
 358                               (cdr x))))
 359                 (nth 1 msgdb))
 360         (mapcar (function
 361                  (lambda (x) (cons
 362                               (* -1 (car x))
 363                               (cdr x)))) (nth 2 msgdb))))
 364
 365 (require 'product)
 366 (product-provide (provide 'elmo-dop) (require 'elmo-version))
 367
 368 ;;; elmo-dop.el ends here