* wl-expire.el (wl-summary-archive): Fixed;
[elisp/wanderlust.git] / 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 . "Encache")
69     (elmo-create-folder . "Create")
70     (elmo-folder-mark-as-read . "Read")
71     (elmo-folder-unmark-read . "Unread")
72     (elmo-folder-mark-as-important . "Important")
73     (elmo-folder-unmark-important . "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 &optional read)
214   (elmo-dop-queue-append folder 'elmo-message-encache (list number read)))
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         failure saved)
251     (with-temp-buffer
252       (elmo-message-fetch spool-folder number
253                           (elmo-make-fetch-strategy 'entire)
254                           nil (current-buffer) 'unread)
255       (condition-case nil 
256           (setq failure (not
257                          (elmo-folder-append-buffer folder unread set-number)))
258         (error (setq failure t)))
259       (when failure
260         ;; Append failed...
261         (setq saved (elmo-folder-append-buffer
262                      (elmo-make-folder elmo-lost+found-folder)
263                      unread set-number)))
264       (if (or (not failure)
265               saved)
266           (elmo-folder-delete-messages spool-folder (list number)))
267       t)))
268
269 (defun elmo-folder-delete-messages-dop-delayed (folder number-alist)
270   (elmo-folder-delete-messages
271    folder
272    ;; messages are deleted only if message-id is not changed.
273    (mapcar 'car
274            (elmo-delete-if 
275             (lambda (pair)
276               (not (string=
277                     (cdr pair)
278                     (elmo-message-fetch-field folder (car pair)
279                                               'message-id))))
280             number-alist))))
281
282 ;;; Util
283 (defun elmo-dop-msgdb (msgdb)
284   (list (mapcar (function
285                  (lambda (x)
286                    (elmo-msgdb-overview-entity-set-number
287                     x
288                     (* -1
289                        (elmo-msgdb-overview-entity-get-number x)))))
290                 (nth 0 msgdb))
291         (mapcar (function
292                  (lambda (x) (cons
293                               (* -1 (car x))
294                               (cdr x))))
295                 (nth 1 msgdb))
296         (mapcar (function
297                  (lambda (x) (cons
298                               (* -1 (car x))
299                               (cdr x)))) (nth 2 msgdb))))
300
301 (require 'product)
302 (product-provide (provide 'elmo-dop) (require 'elmo-version))
303
304 ;;; elmo-dop.el ends here