;;; elmo-dop.el -- Modules for Disconnected Operations on ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
-;; Time-stamp: <00/03/14 19:39:23 teranisi>
;; This file is part of ELMO (Elisp Library for Message Orchestration).
Automatically loaded/saved.")
(defun elmo-dop-queue-append (folder function argument)
- (let ((operation (list (format "%s" folder) function argument)))
+ (let ((operation (list (elmo-string folder) function argument)))
(elmo-dop-queue-load)
(unless (member operation elmo-dop-queue) ;; don't append same operation
- (setq elmo-dop-queue
+ (setq elmo-dop-queue
(append elmo-dop-queue
(list operation)))
(elmo-dop-queue-save))))
-(defun elmo-dop-queue-flush ()
+(defun elmo-dop-queue-flush (&optional force)
+ "Flush Disconnected operations.
+If optional argument FORCE is non-nil, try flushing all operation queues
+even an operation concerns the unplugged folder."
(elmo-dop-queue-load) ; load cache.
(elmo-dop-queue-merge)
(let ((queue elmo-dop-queue)
(count 0)
len)
(while queue
- (if (elmo-folder-plugged-p (caar queue))
+ (if (or force (elmo-folder-plugged-p (caar queue)))
(setq count (1+ count)))
(setq queue (cdr queue)))
(when (> count 0)
- (if (elmo-y-or-n-p
- (format "%d pending operation(s) exists. Perform now?" count)
+ (if (elmo-y-or-n-p
+ (format "%d pending operation(s) exists. Perform now? " count)
(not elmo-dop-flush-confirm) t)
(progn
(message "")
(setq i (+ 1 i))
(message "Flushing queue....%d/%d." i num)
(condition-case err
- (if (not (elmo-folder-plugged-p (nth 0 (car queue))))
+ (if (and (not force)
+ (not (elmo-folder-plugged-p (nth 0 (car queue)))))
(setq failure t)
(setq folder (nth 0 (car queue))
func (nth 1 (car queue)))
))))
(quit (setq failure t))
(error (setq failure err)))
- (if failure
+ (if failure
;; create-folder was failed.
(when (and (string= func "create-folder-maybe")
- (elmo-y-or-n-p
- (format
- "Create folder %s failed. Abort creating?"
+ (elmo-y-or-n-p
+ (format
+ "Create folder %s failed. Abort creating? "
folder)
(not elmo-dop-flush-confirm) t))
(elmo-dop-save-pending-messages folder)
performed num)
(sit-for 1) ;
(elmo-dop-queue-save)))
- (if (elmo-y-or-n-p "Clear all pending operations?"
+ (if (elmo-y-or-n-p "Clear all pending operations? "
(not elmo-dop-flush-confirm) t)
(let ((queue elmo-dop-queue))
(while queue
(let ((queue elmo-dop-queue)
new-queue match-queue que)
(while (setq que (car queue))
- (if (and
+ (if (and
(member (cadr que) elmo-dop-merge-funcs)
(setq match-queue
(car (delete nil
(mapcar '(lambda (new-queue)
- (if (and
+ (if (and
(string= (car que) (car new-queue))
(string= (cadr que) (cadr new-queue)))
new-queue))
(defun elmo-dop-queue-load ()
(save-excursion
- (setq elmo-dop-queue
+ (setq elmo-dop-queue
(elmo-object-load
(expand-file-name elmo-queue-filename
elmo-msgdb-dir)))))
(defun elmo-dop-lock-message (message-id &optional lock-list)
(let ((locked (or lock-list
- (elmo-object-load
+ (elmo-object-load
(expand-file-name
elmo-msgdb-lock-list-filename
elmo-msgdb-dir)))))
(defun elmo-dop-unlock-message (message-id &optional lock-list)
(let ((locked (or lock-list
- (elmo-object-load
+ (elmo-object-load
(expand-file-name elmo-msgdb-lock-list-filename
elmo-msgdb-dir)))))
(setq locked (delete message-id locked))
locked)))
(defun elmo-dop-lock-list-load ()
- (elmo-object-load
+ (elmo-object-load
(expand-file-name elmo-msgdb-lock-list-filename
elmo-msgdb-dir)))
lock-list))
(defun elmo-dop-append-list-load (folder &optional resume)
- (elmo-object-load
+ (elmo-object-load
(expand-file-name (if resume
elmo-msgdb-resume-list-filename
elmo-msgdb-append-list-filename)
(setq numbers (cdr numbers)))
(cons appended deleting-msgids)))
+(defun elmo-dop-list-deleted (folder number-alist)
+ "List message numbers to be deleted on FOLDER from NUMBER-ALIST."
+ (elmo-dop-queue-load)
+ (let ((queue elmo-dop-queue)
+ numbers matches nalist)
+ (while queue
+ (if (and (string= (nth 0 (car queue)) folder)
+ (string= (nth 1 (car queue)) "delete-msgids"))
+ (setq numbers
+ (nconc numbers
+ (delq nil (mapcar
+ (lambda (x)
+ (mapcar 'car
+ (elmo-string-rassoc-all
+ x number-alist)))
+ (nth 2 (car queue)))))))
+ (setq queue (cdr queue)))
+ (elmo-uniq-list (elmo-flatten numbers))))
+
(defun elmo-dop-delete-msgs (folder msgs msgdb)
(save-match-data
(let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
appended-deleting)
(while folder-numbers
- (if (eq (elmo-folder-get-type (car (car folder-numbers)))
+ (if (eq (elmo-folder-get-type (car (car folder-numbers)))
'imap4)
(if elmo-enable-disconnected-operation
(progn
msgs ; virtual number
(elmo-dop-append-list-load folder)))
(if (cdr appended-deleting)
- (elmo-dop-queue-append
+ (elmo-dop-queue-append
(car (car folder-numbers)) ; real folder
"delete-msgids" ;; for secure removal.
(cdr appended-deleting)))
(save-match-data
(elmo-dop-queue-append folder "prefetch-msgs" msgs)))
-(defun elmo-dop-list-folder (folder)
+(defun elmo-dop-list-folder (folder &optional nohide)
(if (or (memq (elmo-folder-get-type folder)
'(imap4 nntp pop3 filter pipe))
(and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
(if elmo-enable-disconnected-operation
- (let* ((number-alist (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder)))
+ (let* ((path (elmo-msgdb-expand-path folder))
+ (number-alist (elmo-msgdb-number-load path))
(number-list (mapcar 'car number-alist))
(append-list (elmo-dop-append-list-load folder))
(append-num (length append-list))
+ (killed (and elmo-use-killed-list
+ (elmo-msgdb-killed-list-load path)))
alreadies
- (i 0)
- max-num)
+ max-num
+ (i 0))
+ (setq killed (nconc (elmo-dop-list-deleted folder number-alist)
+ killed))
(while append-list
(if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
+ (setq alreadies (append alreadies
(list (car append-list)))))
(setq append-list (cdr append-list)))
(setq append-num (- append-num (length alreadies)))
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0)
+ (setq max-num
+ (or (nth (max (- (length number-list) 1) 0)
number-list) 0))
(while (< i append-num)
(setq number-list
(append number-list
(list (+ max-num i 1))))
(setq i (+ 1 i)))
- number-list)
+ (elmo-living-messages number-list killed))
(error "Unplugged"))
;; not imap4 folder...list folder
(elmo-call-func folder "list-folder")))
matched)
(if (eq (elmo-folder-get-type folder) 'imap4)
(progn
- (while append-list
- (if (setq matched (car (rassoc (car append-list) number-alist)))
- (setq msgs (delete matched msgs)))
- (setq append-list (cdr append-list)))
+;;; (while append-list
+;;; (if (setq matched (car (rassoc (car append-list) number-alist)))
+;;; (setq msgs (delete matched msgs)))
+;;; (setq append-list (cdr append-list)))
(if msgs
(elmo-dop-queue-append folder func-name msgs)))
;; maildir... XXX hard coding.....
(defun elmo-dop-max-of-folder (folder)
(if (eq (elmo-folder-get-type folder) 'imap4)
(if elmo-enable-disconnected-operation
- (let* ((number-alist (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder)))
+ (let* ((number-alist (elmo-msgdb-number-load
+ (elmo-msgdb-expand-path folder)))
(number-list (mapcar 'car number-alist))
(append-list (elmo-dop-append-list-load folder))
(append-num (length append-list))
max-num)
(while append-list
(if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
+ (setq alreadies (append alreadies
(list (car append-list)))))
(setq append-list (cdr append-list)))
- (setq max-num
+ (setq max-num
(or (nth (max (- (length number-list) 1) 0) number-list)
0))
(cons (- (+ max-num append-num) (length alreadies))
file-string)
(while append-list
(when (setq file-string (elmo-get-file-string ; message string
- (elmo-cache-get-path
+ (elmo-cache-get-path
(car append-list))))
(elmo-append-msg elmo-lost+found-folder file-string)
(elmo-dop-unlock-message (car append-list)))
(setq append-list (cdr append-list))
(elmo-dop-append-list-save folder nil)))
- (message (format "Saving queued message in %s...done."
+ (message (format "Saving queued message in %s...done"
elmo-lost+found-folder)))
(defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
(message "Appending queued messages...")
- (let* ((append-list (or appends
+ (let* ((append-list (or appends
(elmo-dop-append-list-load folder)))
(appendings append-list)
(i 0)
(when resume
;; Resume msgdb changed by elmo-dop-msgdb-create.
(let* ((resumed-list (elmo-dop-append-list-load folder t))
- (number-alist (elmo-msgdb-number-load
+ (number-alist (elmo-msgdb-number-load
(elmo-msgdb-expand-path folder)))
(appendings append-list)
pair dels)
(setq appendings (cdr appendings)))
(elmo-dop-append-list-save folder resumed-list t)))
(while appendings
- (setq failure nil)
- (setq file-string (elmo-get-file-string ; message string
- (elmo-cache-get-path
- (car appendings))))
- (when file-string
- (condition-case ()
- (elmo-append-msg folder file-string (car appendings))
- (quit (setq failure t))
- (error (setq failure t)))
- (setq i (+ 1 i))
- (message (format "Appending queued messages...%d" i))
- (if failure
- (elmo-append-msg elmo-lost+found-folder
- file-string (car appendings))))
- (elmo-dop-unlock-message (car appendings))
- (setq appendings (cdr appendings)))
+ (let* ((seen-list (elmo-msgdb-seen-load
+ (elmo-msgdb-expand-path folder))))
+ (setq failure nil)
+ (setq file-string (elmo-get-file-string ; message string
+ (elmo-cache-get-path
+ (car appendings))))
+ (when file-string
+ (condition-case ()
+ (setq failure (not
+ (elmo-append-msg
+ folder file-string (car appendings) nil
+ (not (member (car appendings) seen-list)))))
+ (quit (setq failure t))
+ (error (setq failure t)))
+ (setq i (+ 1 i))
+ (message (format "Appending queued messages...%d" i))
+ (if failure
+ (elmo-append-msg elmo-lost+found-folder
+ file-string (car appendings) nil
+ (not (member (car appendings) seen-list)))))
+ (elmo-dop-unlock-message (car appendings))
+ (setq appendings (cdr appendings))))
;; All pending append operation is flushed.
(elmo-dop-append-list-save folder nil)
(elmo-commit folder)
(setq elmo-dop-queue (delete (list folder "append-operations" nil)
elmo-dop-queue))
(elmo-dop-queue-save))))
- (message "Appending queued messages...done."))
+ (message "Appending queued messages...done"))
(defun elmo-dop-folder-exists-p (folder)
- (if (and elmo-enable-disconnected-operation
- (eq (elmo-folder-get-type folder) 'imap4))
- (file-exists-p (elmo-msgdb-expand-path folder))
- (elmo-call-func folder "folder-exists-p")))
+ (or (file-exists-p (elmo-msgdb-expand-path folder))
+ (if (and elmo-enable-disconnected-operation
+ (eq (elmo-folder-get-type folder) 'imap4))
+ (file-exists-p (elmo-msgdb-expand-path folder))
+ (elmo-call-func folder "folder-exists-p"))))
(defun elmo-dop-create-folder (folder)
(if (eq (elmo-folder-get-type folder) 'imap4)
(insert string)
(elmo-cache-save message-id nil folder msg (current-buffer))))
(let ((append-list (elmo-dop-append-list-load folder))
- (number-alist (elmo-msgdb-number-load
+ (number-alist (elmo-msgdb-number-load
(elmo-msgdb-expand-path folder))))
(when (and ; not in current folder.
(not (rassoc message-id number-alist))
(if (or (eq (elmo-folder-get-type folder) 'imap4)
(eq (elmo-folder-get-type folder) 'nntp))
(if elmo-enable-disconnected-operation
- (let* ((num-alist (elmo-msgdb-number-load
+ (let* ((num-alist (elmo-msgdb-number-load
(elmo-msgdb-expand-path folder)))
(number-list (mapcar 'car num-alist))
(ov (elmo-msgdb-overview-load
0))
(while numlist
(if (setq msgid
- (nth (+ (length append-list)
+ (nth (+ (length append-list)
(- (car numlist) max-num 1 num))
append-list))
(progn
(setq seen (member msgid seen-list))
(if (setq gmark
(or (elmo-msgdb-global-mark-get msgid)
- (if (elmo-cache-exists-p
+ (if (elmo-cache-exists-p
msgid
folder
(car number-alist))
(elmo-msgdb-mark-append
mark-alist (car numlist) gmark))))
- (when (setq ov-entity (assoc
+ (when (setq ov-entity (assoc
(cdr (assq (car numlist) num-alist))
ov))
(setq overview
(setq mark-alist
(elmo-msgdb-mark-append
mark-alist (car numlist) gmark)))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
- percent)
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
+ percent))
(setq numlist (cdr numlist)))
(list overview number-alist mark-alist))
(error "Unplugged"))
(elmo-call-func folder "msgdb-create" numlist new-mark already-mark
seen-mark important-mark seen-list)))
-(provide 'elmo-dop)
+(require 'product)
+(product-provide (provide 'elmo-dop) (require 'elmo-version))
;;; elmo-dop.el ends here
projects / elisp / wanderlust.git / blobdiff