1 ;;; elmo-dop.el -- Modules for Disconnected Operations on ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
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)
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.
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.
38 (defvar elmo-dop-queue nil
39 "A list of (folder-name function-to-be-called argument-list).
40 Automatically loaded/saved.")
42 (defvar elmo-dop-folder (concat "+" (expand-file-name "dop"
44 "A folder for `elmo-folder-append-messages' disconnected operations.")
46 (defun elmo-dop-queue-append (folder function arguments)
47 (let ((operation (list (elmo-folder-name-internal folder)
49 (unless (member operation elmo-dop-queue) ;; don't append same operation
51 (append elmo-dop-queue
53 (elmo-dop-queue-save))))
55 (defun elmo-dop-queue-flush (&optional force)
56 "Flush Disconnected operations.
57 If optional argument FORCE is non-nil, try flushing all operation queues
58 even an operation concerns the unplugged folder."
59 (elmo-dop-queue-merge)
60 (let ((queue elmo-dop-queue)
64 (if (or force (elmo-folder-plugged-p (elmo-make-folder (caar queue))))
65 (setq count (1+ count)))
66 (setq queue (cdr queue)))
69 (format "%d pending operation(s) exists. Perform now? " count)
70 (not elmo-dop-flush-confirm) t)
74 (let ((queue elmo-dop-queue)
77 (num (length elmo-dop-queue))
80 ;; now perform pending processes.
83 (message "Flushing queue....%d/%d." i num)
86 (not (elmo-folder-plugged-p (nth 0 (car queue)))))
88 (setq folder (nth 0 (car queue))
89 func (nth 1 (car queue)))
91 ((string= func "prefetch-msgs")
94 (nth 2 (car queue)))) ;argunemt
95 ((string= func "append-operations")
96 (elmo-dop-flush-pending-append-operations
102 (nth 2 (car queue)) ;argunemt
104 (quit (setq failure t))
105 (error (setq failure err)))
107 ;; create-folder was failed.
108 (when (and (string= func "create-folder-maybe")
111 "Create folder %s failed. Abort creating? "
113 (not elmo-dop-flush-confirm) t))
114 (elmo-dop-save-pending-messages folder)
115 (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)))
116 (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
117 (setq performed (+ 1 performed)))
118 (setq queue (cdr queue)))
119 (message "%d/%d operation(s) are performed successfully."
122 (elmo-dop-queue-save)))
123 (if (elmo-y-or-n-p "Clear all pending operations? "
124 (not elmo-dop-flush-confirm) t)
125 (let ((queue elmo-dop-queue))
127 (if (string= (nth 1 (car queue)) "append-operations")
128 (elmo-dop-append-list-save (nth 0 (car queue)) nil))
129 (setq queue (cdr queue)))
130 (setq elmo-dop-queue nil)
131 (message "All pending operations are cleared.")
132 (elmo-dop-queue-save))
136 (defconst elmo-dop-merge-funcs
144 (defun elmo-dop-queue-merge ()
145 (let ((queue elmo-dop-queue)
146 new-queue match-queue que)
147 (while (setq que (car queue))
149 (member (cadr que) elmo-dop-merge-funcs)
155 (string= (car que) (car new-queue))
156 (string= (cadr que) (cadr new-queue)))
159 (setcar (cddr match-queue)
160 (append (nth 2 match-queue) (nth 2 que)))
161 (setq new-queue (append new-queue (list que))))
162 (setq queue (cdr queue)))
163 (setq elmo-dop-queue new-queue)))
165 (defun elmo-dop-queue-load ()
169 (expand-file-name elmo-queue-filename
172 (defun elmo-dop-queue-save ()
175 (expand-file-name elmo-queue-filename
179 (defun elmo-dop-append-list-load (folder &optional resume)
181 (expand-file-name (if resume
182 elmo-msgdb-resume-list-filename
183 elmo-msgdb-append-list-filename)
184 (elmo-folder-msgdb-path folder))))
186 (defun elmo-dop-append-list-save (folder append-list &optional resume)
189 (expand-file-name (if resume
190 elmo-msgdb-resume-list-filename
191 elmo-msgdb-append-list-filename)
192 (elmo-folder-msgdb-path folder))
195 (delete-file (expand-file-name (if resume
196 elmo-msgdb-resume-list-filename
197 elmo-msgdb-append-list-filename)
198 (elmo-folder-msgdb-path folder)))
201 (defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended)
202 "returns (new-appended . deleting-msgids)."
203 (let (msgid deleting-msgids)
205 (setq msgid (cdr (assq (car numbers) alist)))
206 (if (member msgid appended)
207 (setq appended (delete msgid appended))
208 (setq deleting-msgids (append deleting-msgids (list msgid))))
209 (setq numbers (cdr numbers)))
210 (cons appended deleting-msgids)))
212 (defun elmo-dop-list-deleted (name number-alist)
213 "List message numbers to be deleted on folder with NAME from NUMBER-ALIST."
214 (elmo-dop-queue-load)
215 (let ((queue elmo-dop-queue)
216 numbers matches nalist)
218 (if (and (string= (nth 0 (car queue)) name)
219 (string= (nth 1 (car queue)) "delete-msgids"))
225 (elmo-string-rassoc-all
227 (nth 2 (car queue)))))))
228 (setq queue (cdr queue)))
229 (elmo-uniq-list (elmo-flatten numbers))))
231 (defun elmo-dop-delete-msgs (folder msgs msgdb)
233 (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
235 (while folder-numbers
236 (if (eq (elmo-folder-get-type (car (car folder-numbers)))
238 (if elmo-enable-disconnected-operation
240 (setq appended-deleting
241 (elmo-dop-deleting-numbers-to-msgids
242 (elmo-msgdb-get-number-alist msgdb)
243 msgs ; virtual number
244 (elmo-dop-append-list-load folder)))
245 (if (cdr appended-deleting)
246 (elmo-dop-queue-append
247 (car (car folder-numbers)) ; real folder
248 "delete-msgids" ;; for secure removal.
249 (cdr appended-deleting)))
250 (elmo-dop-append-list-save folder (car appended-deleting)))
252 ;; not imap4 folder...delete now!
253 (elmo-call-func (car (car folder-numbers)) "delete-msgs"
254 (cdr (car folder-numbers))))
255 (setq folder-numbers (cdr folder-numbers))))
258 (defun elmo-dop-prefetch-msgs (folder msgs)
260 (elmo-dop-queue-append folder "prefetch-msgs" msgs)))
262 (defun elmo-dop-list-folder (folder &optional nohide)
263 (if (or (memq (elmo-folder-get-type folder)
264 '(imap4 nntp pop3 filter pipe))
265 (and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
266 (if elmo-enable-disconnected-operation
267 (let* ((path (elmo-msgdb-expand-path folder))
268 (number-alist (elmo-msgdb-number-load path))
269 (number-list (mapcar 'car number-alist))
270 (append-list (elmo-dop-append-list-load folder))
271 (append-num (length append-list))
272 (killed (and elmo-use-killed-list
273 (elmo-msgdb-killed-list-load path)))
277 (setq killed (nconc (elmo-dop-list-deleted folder number-alist)
280 (if (rassoc (car append-list) number-alist)
281 (setq alreadies (append alreadies
282 (list (car append-list)))))
283 (setq append-list (cdr append-list)))
284 (setq append-num (- append-num (length alreadies)))
286 (or (nth (max (- (length number-list) 1) 0)
288 (while (< i append-num)
291 (list (+ max-num i 1))))
293 (elmo-living-messages number-list killed))
295 ;; not imap4 folder...list folder
296 (elmo-call-func folder "list-folder")))
298 (defun elmo-dop-count-appended (folder)
299 (length (elmo-dop-append-list-load folder)))
301 (defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb)
302 (let ((append-list (elmo-dop-append-list-load folder))
303 (number-alist (elmo-msgdb-get-number-alist msgdb))
305 (if (eq (elmo-folder-get-type folder) 'imap4)
307 ;;; (while append-list
308 ;;; (if (setq matched (car (rassoc (car append-list) number-alist)))
309 ;;; (setq msgs (delete matched msgs)))
310 ;;; (setq append-list (cdr append-list)))
312 (elmo-dop-queue-append folder func-name msgs)))
313 ;; maildir... XXX hard coding.....
314 (if (not (featurep 'elmo-maildir))
316 (funcall (intern (format "elmo-maildir-%s" func-name))
317 (elmo-folder-get-spec folder)
320 (defun elmo-dop-folder-status (folder)
321 (let* ((number-alist (elmo-msgdb-number-load
322 (elmo-folder-msgdb-path folder)))
323 (number-list (mapcar 'car number-alist))
324 (append-list (elmo-dop-append-list-load folder))
325 (append-num (length append-list))
330 (if (rassoc (car append-list) number-alist)
331 (setq alreadies (append alreadies
332 (list (car append-list)))))
333 (setq append-list (cdr append-list)))
335 (or (nth (max (- (length number-list) 1) 0) number-list)
337 (cons (- (+ max-num append-num) (length alreadies))
338 (- (+ (length number-list) append-num) (length alreadies)))))
340 (defun elmo-dop-max-of-folder (folder)
341 (if (eq (elmo-folder-get-type folder) 'imap4)
342 (if elmo-enable-disconnected-operation
343 (let* ((number-alist (elmo-msgdb-number-load
344 (elmo-msgdb-expand-path folder)))
345 (number-list (mapcar 'car number-alist))
346 (append-list (elmo-dop-append-list-load folder))
347 (append-num (length append-list))
352 (if (rassoc (car append-list) number-alist)
353 (setq alreadies (append alreadies
354 (list (car append-list)))))
355 (setq append-list (cdr append-list)))
357 (or (nth (max (- (length number-list) 1) 0) number-list)
359 (cons (- (+ max-num append-num) (length alreadies))
360 (- (+ (length number-list) append-num) (length alreadies))))
363 (elmo-call-func folder "max-of-folder")))
365 (defun elmo-dop-save-pending-messages (folder)
366 (message (format "Saving queued message in %s..." elmo-lost+found-folder))
367 (let* ((append-list (elmo-dop-append-list-load folder))
370 (when (setq file-string (elmo-get-file-string ; message string
373 (elmo-append-msg elmo-lost+found-folder file-string)
374 (elmo-dop-unlock-message (car append-list)))
375 (setq append-list (cdr append-list))
376 (elmo-dop-append-list-save folder nil)))
377 (message (format "Saving queued message in %s...done"
378 elmo-lost+found-folder)))
380 (defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
381 (message "Appending queued messages...")
382 (let* ((append-list (or appends
383 (elmo-dop-append-list-load folder)))
384 (appendings append-list)
386 (num (length append-list))
389 ;; Resume msgdb changed by elmo-dop-msgdb-create.
390 (let* ((resumed-list (elmo-dop-append-list-load folder t))
391 (number-alist (elmo-msgdb-number-load
392 (elmo-msgdb-expand-path folder)))
393 (appendings append-list)
396 (if (setq pair (rassoc (car appendings) number-alist))
397 (setq resumed-list (append resumed-list
398 (list (car appendings)))))
399 (setq appendings (cdr appendings)))
400 (elmo-dop-append-list-save folder resumed-list t)))
402 (let* ((seen-list (elmo-msgdb-seen-load
403 (elmo-msgdb-expand-path folder))))
405 (setq file-string (elmo-get-file-string ; message string
410 (elmo-append-msg folder file-string (car appendings) nil
411 (not (member (car appendings) seen-list)))
412 (quit (setq failure t))
413 (error (setq failure t)))
415 (message (format "Appending queued messages...%d" i))
417 (elmo-append-msg elmo-lost+found-folder
418 file-string (car appendings) nil
419 (not (member (car appendings) seen-list)))))
420 (elmo-dop-unlock-message (car appendings))
421 (setq appendings (cdr appendings))))
422 ;; All pending append operation is flushed.
423 (elmo-dop-append-list-save folder nil)
426 ;; delete '(folder "append-operations") in elmo-dop-queue.
427 (let (elmo-dop-queue)
428 (elmo-dop-queue-load)
429 (setq elmo-dop-queue (delete (list folder "append-operations" nil)
431 (elmo-dop-queue-save))))
432 (message "Appending queued messages...done"))
434 (defun elmo-dop-folder-exists-p (folder)
435 (or (file-exists-p (elmo-msgdb-expand-path folder))
436 (if (and elmo-enable-disconnected-operation
437 (eq (elmo-folder-get-type folder) 'imap4))
438 (file-exists-p (elmo-msgdb-expand-path folder))
439 (elmo-call-func folder "folder-exists-p"))))
441 (defun elmo-dop-create-folder (folder)
442 (if (eq (elmo-folder-get-type folder) 'imap4)
443 (if elmo-enable-disconnected-operation
444 (elmo-dop-queue-append folder "create-folder-maybe" nil)
446 (elmo-call-func folder "create-folder")))
448 (defun elmo-dop-append-msg (folder string message-id &optional msg)
449 (if elmo-enable-disconnected-operation
452 (unless (elmo-cache-exists-p message-id)
455 (elmo-cache-save message-id nil folder msg (current-buffer))))
456 (let ((append-list (elmo-dop-append-list-load folder))
457 (number-alist (elmo-msgdb-number-load
458 (elmo-msgdb-expand-path folder))))
459 (when (and ; not in current folder.
460 (not (rassoc message-id number-alist))
461 (not (member message-id append-list)))
463 (append append-list (list message-id)))
464 (elmo-dop-lock-message message-id)
465 (elmo-dop-append-list-save folder append-list)
466 (elmo-dop-queue-append folder "append-operations" nil))
469 (error "Unplugged")))
471 (defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist)
473 (defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark
474 seen-mark important-mark
476 (if (or (eq (elmo-folder-get-type folder) 'imap4)
477 (eq (elmo-folder-get-type folder) 'nntp))
478 (if elmo-enable-disconnected-operation
479 (let* ((num-alist (elmo-msgdb-number-load
480 (elmo-msgdb-expand-path folder)))
481 (number-list (mapcar 'car num-alist))
482 (ov (elmo-msgdb-overview-load
483 (elmo-msgdb-expand-path folder)))
484 (append-list (elmo-dop-append-list-load folder))
485 (num (length numlist))
487 overview number-alist mark-alist msgid ov-entity
488 max-num percent seen gmark)
490 (or (nth (max (- (length number-list) 1) 0) number-list)
494 (nth (+ (length append-list)
495 (- (car numlist) max-num 1 num))
499 (elmo-msgdb-append-element
501 (elmo-localdir-msgdb-create-overview-entity-from-file
503 (elmo-cache-get-path msgid))))
505 (elmo-msgdb-number-add number-alist
506 (car numlist) msgid))
507 (setq seen (member msgid seen-list))
509 (or (elmo-msgdb-global-mark-get msgid)
510 (if (elmo-cache-exists-p
521 (elmo-msgdb-mark-append
522 mark-alist (car numlist) gmark))))
524 (when (setq ov-entity (assoc
525 (cdr (assq (car numlist) num-alist))
528 (elmo-msgdb-append-element
531 (elmo-msgdb-number-add number-alist
534 (setq seen (member ov-entity seen-list))
536 (or (elmo-msgdb-global-mark-get (car ov-entity))
537 (if (elmo-cache-exists-p
548 (elmo-msgdb-mark-append
549 mark-alist (car numlist) gmark)))))
550 (when (> num elmo-display-progress-threshold)
552 (setq percent (/ (* i 100) num))
553 (elmo-display-progress
554 'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
556 (setq numlist (cdr numlist)))
557 (list overview number-alist mark-alist))
559 ;; not imap4 folder...
560 (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
561 seen-mark important-mark seen-list)))
564 (product-provide (provide 'elmo-dop) (require 'elmo-version))
566 ;;; elmo-dop.el ends here