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-method-name-alist
  66   '((elmo-folder-append-buffer-dop-delayed . "Append")
  67     (elmo-folder-delete-messages-dop-delayed . "Delete")
  68     (elmo-message-encache-dop . "Encache")
  69     (elmo-create-folder-dop . "Create")
  70     (elmo-folder-mark-as-read-dop . "Read")
  71     (elmo-folder-unmark-read-dop . "Unread")
  72     (elmo-folder-mark-as-important-dop . "Important")
  73     (elmo-folder-unmark-important-dop . "Unimportant")))
  74
  75 (defmacro elmo-dop-queue-method-name (queue)
  76   `(cdr (assq (elmo-dop-queue-method ,queue)
  77               elmo-dop-queue-method-name-alist)))
  78
  79 (defun elmo-dop-queue-flush (&optional force)
  80   "Flush disconnected operations.
  81 If optional argument FORCE is non-nil, try flushing all operation queues
  82 even an operation concerns the unplugged folder."
  83   (elmo-dop-queue-merge)
  84   (let ((queue elmo-dop-queue)
  85         (count 0)
  86         folder
  87         len)
  88     ;; obsolete
  89     (unless (or (null queue)
  90                 (vectorp (car queue)))
  91       (when (y-or-n-p "Saved queue is old version(2.4). Clear all pending operations? ")
  92         (setq elmo-dop-queue nil)
  93         (message "All pending operations are cleared.")
  94         (elmo-dop-queue-save)))
  95     (setq count (length queue))
  96     (when (> count 0)
  97       (if (elmo-y-or-n-p
  98            (format "%d pending operation(s) exists.  Perform now? " count)
  99            (not elmo-dop-flush-confirm) t)
 100           (progn
 101             (message "")
 102             (sit-for 0)
 103             (let ((queue elmo-dop-queue)
 104                   (performed 0)
 105                   (i 0)
 106                   (num (length elmo-dop-queue))
 107                   folder func failure)
 108               (while queue
 109                 ;; now perform pending processes.
 110                 (setq failure nil)
 111                 (setq i (+ 1 i))
 112                 (message "Flushing queue....%d/%d." i num)
 113                 (condition-case err
 114                     (progn
 115                       (apply (elmo-dop-queue-method (car queue))
 116                              (prog1
 117                                  (setq folder
 118                                        (elmo-make-folder
 119                                         (elmo-dop-queue-fname (car queue))))
 120                                (elmo-folder-open folder))
 121                              (elmo-dop-queue-arguments (car queue)))
 122                       (elmo-folder-close folder))
 123                   (quit  (setq failure t))
 124                   (error (setq failure err)))
 125                 (if failure
 126                     ();
 127                   (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 128                   (setq performed (+ 1 performed)))
 129                 (setq queue (cdr queue)))
 130               (message "%d/%d operation(s) are performed successfully."
 131                        performed num)
 132               (sit-for 0) ;
 133               (elmo-dop-queue-save)))
 134         (if (elmo-y-or-n-p "Clear all pending operations? "
 135                            (not elmo-dop-flush-confirm) t)
 136             (progn
 137               (setq elmo-dop-queue nil)
 138               (message "All pending operations are cleared.")
 139               (elmo-dop-queue-save))
 140           (message "")))
 141       count)))
 142
 143 (defvar elmo-dop-merge-funcs nil)
 144 (defun elmo-dop-queue-merge ()
 145   ;; XXXX Not implemented yet.
 146   )
 147
 148 ;;; dop spool folder
 149 (defmacro elmo-dop-spool-folder (folder)
 150   "Return a spool folder for disconnected operations
 151 which is corresponded to the FOLDER."
 152   (` (elmo-make-folder
 153       (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path
 154                                              (, folder)))))))
 155
 156 (defun elmo-dop-spool-folder-append-buffer (folder)
 157   "Append current buffer content to the dop spool folder.
 158 FOLDER is the folder structure.
 159 Return a message number."
 160   (setq folder (elmo-dop-spool-folder folder))
 161   (unless (elmo-folder-exists-p folder)
 162     (elmo-folder-create folder))
 163   (let ((new-number (1+ (car (elmo-folder-status folder)))))
 164     ;; dop folder is a localdir folder.
 165     (write-region-as-binary (point-min) (point-max)
 166                           (expand-file-name
 167                            (int-to-string new-number)
 168                            (elmo-localdir-folder-directory-internal folder))
 169                           nil 'no-msg)
 170     new-number))
 171
 172
 173 (defun elmo-dop-spool-folder-list-messages (folder)
 174   "List messages in the dop spool folder.
 175 FOLDER is the folder structure."
 176   (setq folder (elmo-dop-spool-folder folder))
 177   (if (elmo-folder-exists-p folder)
 178       (elmo-folder-list-messages folder)))
 179
 180 (defun elmo-dop-list-deleting-messages (folder)
 181   "List messages which are on the deleting queue for the folder.
 182 FOLDER is the folder structure."
 183   (let (messages)
 184     (dolist (queue elmo-dop-queue)
 185       (if (and (string= (elmo-dop-queue-fname queue)
 186                         (elmo-folder-name-internal folder))
 187                (eq (elmo-dop-queue-method queue)
 188                    'elmo-folder-delete-messages-dop-delayed))
 189           (setq messages (nconc messages
 190                                 (mapcar
 191                                  'car
 192                                  (car (elmo-dop-queue-arguments queue)))))))))
 193
 194 ;;; DOP operations.
 195 (defsubst elmo-folder-append-buffer-dop (folder unread &optional number)
 196   (elmo-dop-queue-append
 197    folder 'elmo-folder-append-buffer-dop-delayed
 198    (list unread
 199          (elmo-dop-spool-folder-append-buffer
 200           folder)
 201          number)))
 202
 203 (defsubst elmo-folder-delete-messages-dop (folder numbers)
 204   (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed
 205                          (list
 206                           (mapcar
 207                            (lambda (number)
 208                              (cons number (elmo-message-field
 209                                            folder number 'message-id)))
 210                            numbers)))
 211   t)
 212
 213 (defsubst elmo-message-encache-dop (folder number)
 214   (elmo-dop-queue-append folder 'elmo-message-encache (list number)))
 215
 216 (defsubst elmo-create-folder-dop (folder)
 217   (elmo-dop-queue-append folder 'elmo-folder-create nil))
 218
 219 (defsubst elmo-folder-mark-as-read-dop (folder numbers)
 220   (elmo-dop-queue-append folder 'elmo-folder-mark-as-read (list numbers)))
 221
 222 (defsubst elmo-folder-unmark-read-dop (folder numbers)
 223   (elmo-dop-queue-append folder 'elmo-folder-unmark-read (list numbers)))
 224
 225 (defsubst elmo-folder-mark-as-important-dop (folder numbers)
 226   (elmo-dop-queue-append folder 'elmo-folder-mark-as-important (list numbers)))
 227
 228 (defsubst elmo-folder-unmark-important-dop (folder numbers)
 229   (elmo-dop-queue-append folder 'elmo-folder-unmark-important (list numbers)))
 230
 231 ;;; Execute as subsutitute for plugged operation.
 232 (defun elmo-folder-status-dop (folder)
 233   (let* ((number-alist (elmo-msgdb-number-load
 234                         (elmo-folder-msgdb-path folder)))
 235          (number-list (mapcar 'car number-alist))
 236          (spool-folder (elmo-dop-spool-folder folder))
 237          spool-length
 238          (i 0)
 239          max-num)
 240     (setq spool-length (length (car (if (elmo-folder-exists-p spool-folder)
 241                                         (elmo-folder-status spool-folder)))))
 242     (setq max-num
 243           (or (nth (max (- (length number-list) 1) 0) number-list)
 244               0))
 245     (cons (+ max-num spool-length) (+ (length number-list) spool-length))))
 246
 247 ;;; Delayed operation (executed at online status).
 248 (defun elmo-folder-append-buffer-dop-delayed (folder unread number set-number)
 249   (let ((spool-folder (elmo-dop-spool-folder folder)))
 250     (with-temp-buffer
 251       (elmo-message-fetch spool-folder number
 252                           (elmo-make-fetch-strategy 'entire)
 253                           nil (current-buffer) 'unread)
 254       (condition-case nil
 255           (elmo-folder-append-buffer folder unread set-number)
 256         (error
 257          ;; Append failed...
 258          (elmo-folder-append-buffer (elmo-make-folder elmo-lost+found-folder)
 259                                     unread set-number)))
 260       (elmo-folder-delete-messages spool-folder (list number))
 261       t)))
 262
 263 (defun elmo-folder-delete-messages-dop-delayed (folder number-alist)
 264   (elmo-folder-delete-messages
 265    folder
 266    ;; messages are deleted only if message-id is not changed.
 267    (mapcar 'car
 268            (elmo-delete-if
 269             (lambda (pair)
 270               (not (string=
 271                     (cdr pair)
 272                     (elmo-message-fetch-field folder (car pair)
 273                                               'message-id))))
 274             number-alist))))
 275
 276 ;;; Util
 277 (defun elmo-dop-msgdb (msgdb)
 278   (list (mapcar (function
 279                  (lambda (x)
 280                    (elmo-msgdb-overview-entity-set-number
 281                     x
 282                     (* -1
 283                        (elmo-msgdb-overview-entity-get-number x)))))
 284                 (nth 0 msgdb))
 285         (mapcar (function
 286                  (lambda (x) (cons
 287                               (* -1 (car x))
 288                               (cdr x))))
 289                 (nth 1 msgdb))
 290         (mapcar (function
 291                  (lambda (x) (cons
 292                               (* -1 (car x))
 293                               (cdr x)))) (nth 2 msgdb))))
 294
 295 (require 'product)
 296 (product-provide (provide 'elmo-dop) (require 'elmo-version))
 297
 298 ;;; elmo-dop.el ends here