-;;; elmo-dop.el -- Modules for Disconnected Operations on ELMO.
+;;; elmo-dop.el --- Modules for Disconnected Operations on ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
+(eval-when-compile (require 'cl))
+(require 'elmo)
(require 'elmo-vars)
(require 'elmo-msgdb)
(require 'elmo-util)
-(eval-when-compile
- (require 'elmo-imap4)
- (require 'elmo-localdir))
+(require 'elmo-localdir)
;; global variable.
(defvar elmo-dop-queue nil
"A list of (folder-name function-to-be-called argument-list).
Automatically loaded/saved.")
-(defun elmo-dop-queue-append (folder function argument)
- (let ((operation (list (format "%s" folder) function argument)))
- (elmo-dop-queue-load)
- (unless (member operation elmo-dop-queue) ;; don't append same operation
- (setq elmo-dop-queue
- (append elmo-dop-queue
- (list operation)))
- (elmo-dop-queue-save))))
-
-(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.
+(defmacro elmo-make-dop-queue (fname method arguments)
+ "Make a dop queue."
+ `(vector ,fname ,method ,arguments))
+
+(defmacro elmo-dop-queue-fname (queue)
+ "Return the folder name string of the QUEUE."
+ `(aref ,queue 0))
+
+(defmacro elmo-dop-queue-method (queue)
+ "Return the method symbol of the QUEUE."
+ `(aref ,queue 1))
+
+(defmacro elmo-dop-queue-arguments (queue)
+ "Return the arguments of the QUEUE."
+ `(aref ,queue 2))
+
+(defun elmo-dop-queue-append (folder method arguments)
+ "Append to disconnected operation queue."
+ (let ((queue (elmo-make-dop-queue (elmo-folder-name-internal folder)
+ method arguments)))
+ (setq elmo-dop-queue (nconc elmo-dop-queue (list queue)))))
+
+(defvar elmo-dop-queue-merge-method-list
+ '(elmo-folder-set-read-delayed
+ elmo-folder-unset-read-delayed
+ elmo-folder-set-important-delayed
+ elmo-folder-unset-important-delayed
+ elmo-folder-set-answered-delayed
+ elmo-folder-unset-answered-delayed))
+
+(defvar elmo-dop-queue-method-name-alist
+ '((elmo-folder-append-buffer-dop-delayed . "Append")
+ (elmo-folder-delete-messages-dop-delayed . "Delete")
+ (elmo-message-encache . "Encache")
+ (elmo-folder-create-dop-delayed . "Create")
+ (elmo-folder-set-read-delayed . "Read")
+ (elmo-folder-unset-read-delayed . "Unread")
+ (elmo-folder-set-answered-delayed . "Answered")
+ (elmo-folder-unset-answered-delayed . "Unanswered")
+ (elmo-folder-set-important-delayed . "Important")
+ (elmo-folder-unset-important-delayed . "Unimportant")
+ (elmo-folder-set-flag . "Set flag")
+ (elmo-folder-unset-flag . "Unset flag")))
+
+(defmacro elmo-dop-queue-method-name (queue)
+ `(cdr (assq (elmo-dop-queue-method ,queue)
+ elmo-dop-queue-method-name-alist)))
+
+(defun elmo-dop-queue-flush ()
+ "Flush disconnected operations that consern plugged folders."
+ ;; obsolete
+ (unless (or (null elmo-dop-queue)
+ (vectorp (car elmo-dop-queue)))
+ (if (y-or-n-p "\
+Saved queue is old version(2.6). Clear all pending operations? ")
+ (progn
+ (setq elmo-dop-queue nil)
+ (message "All pending operations are cleared.")
+ (elmo-dop-queue-save))
+ (error "Please use 2.6 or earlier")))
(elmo-dop-queue-merge)
- (let ((queue elmo-dop-queue)
+ (let ((queue-all elmo-dop-queue)
+ queue
(count 0)
len)
- (while queue
- (if (or force (elmo-folder-plugged-p (caar queue)))
- (setq count (1+ count)))
- (setq queue (cdr queue)))
+ (while queue-all
+ (if (elmo-folder-plugged-p
+ (elmo-get-folder (elmo-dop-queue-fname (car queue-all))))
+ (setq queue (append queue (list (car queue-all)))))
+ (setq queue-all (cdr queue-all)))
+ (setq count (length queue))
(when (> count 0)
(if (elmo-y-or-n-p
(format "%d pending operation(s) exists. Perform now? " count)
(setq i (+ 1 i))
(message "Flushing queue....%d/%d." i num)
(condition-case err
- (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)))
- (cond
- ((string= func "prefetch-msgs")
- (elmo-prefetch-msgs
- folder
- (nth 2 (car queue)))) ;argunemt
- ((string= func "append-operations")
- (elmo-dop-flush-pending-append-operations
- folder nil t))
- (t
- (elmo-call-func
- folder
- func
- (nth 2 (car queue)) ;argunemt
- ))))
+ (progn
+ (apply (elmo-dop-queue-method (car queue))
+ (prog1
+ (setq folder
+ (elmo-get-folder
+ (elmo-dop-queue-fname (car queue))))
+ (elmo-folder-open folder)
+ (unless (elmo-folder-plugged-p folder)
+ (error "Unplugged")))
+ (elmo-dop-queue-arguments (car queue)))
+ (elmo-folder-close folder))
(quit (setq failure t))
(error (setq failure err)))
(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? "
- folder)
- (not elmo-dop-flush-confirm) t))
- (elmo-dop-save-pending-messages folder)
- (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)))
+ ();
(setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
(setq performed (+ 1 performed)))
(setq queue (cdr queue)))
(message "%d/%d operation(s) are performed successfully."
performed num)
- (sit-for 1) ;
+ (sit-for 0) ;
(elmo-dop-queue-save)))
- (if (elmo-y-or-n-p "Clear all pending operations? "
+ ;; when answer=NO against performing dop
+ (if (elmo-y-or-n-p "Clear these pending operations? "
(not elmo-dop-flush-confirm) t)
- (let ((queue elmo-dop-queue))
+ (progn
(while queue
- (if (string= (nth 1 (car queue)) "append-operations")
- (elmo-dop-append-list-save (nth 0 (car queue)) nil))
+ (when (eq (elmo-dop-queue-method (car queue))
+ 'elmo-folder-append-buffer-dop-delayed)
+ (elmo-folder-delete-messages
+ (elmo-dop-spool-folder
+ (elmo-get-folder (elmo-dop-queue-fname (car queue))))
+ (list (nth 1 (elmo-dop-queue-arguments (car queue))))))
+ (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
(setq queue (cdr queue)))
- (setq elmo-dop-queue nil)
- (message "All pending operations are cleared.")
+ (message "Pending operations are cleared.")
(elmo-dop-queue-save))
(message "")))
count)))
-(defconst elmo-dop-merge-funcs
- '("delete-msgids"
- "prefetch-msgs"
- "unmark-important"
- "mark-as-important"
- "mark-as-read"
- "mark-as-unread"))
-
(defun elmo-dop-queue-merge ()
(let ((queue elmo-dop-queue)
- new-queue match-queue que)
+ new-queue match-queue que)
(while (setq que (car queue))
(if (and
- (member (cadr que) elmo-dop-merge-funcs)
+ (memq (elmo-dop-queue-method que)
+ elmo-dop-queue-merge-method-list)
(setq match-queue
- (car (delete nil
- (mapcar '(lambda (new-queue)
- (if (and
- (string= (car que) (car new-queue))
- (string= (cadr que) (cadr new-queue)))
- new-queue))
- new-queue)))))
- (setcar (cddr match-queue)
- (append (nth 2 match-queue) (nth 2 que)))
- (setq new-queue (append new-queue (list que))))
- (setq queue (cdr queue)))
+ (car (delete
+ nil
+ (mapcar
+ (lambda (nqueue)
+ (if (and
+ (string= (elmo-dop-queue-fname que)
+ (elmo-dop-queue-fname nqueue))
+ (string= (elmo-dop-queue-method que)
+ (elmo-dop-queue-method nqueue)))
+ nqueue))
+ new-queue)))))
+ (setcar (elmo-dop-queue-arguments match-queue)
+ (append (car (elmo-dop-queue-arguments match-queue))
+ (car (elmo-dop-queue-arguments que))))
+ (setq new-queue (nconc new-queue (list que))))
+ (setq queue (cdr queue)) )
(setq elmo-dop-queue new-queue)))
-(defun elmo-dop-queue-load ()
- (save-excursion
- (setq elmo-dop-queue
- (elmo-object-load
- (expand-file-name elmo-queue-filename
- elmo-msgdb-dir)))))
-
-(defun elmo-dop-queue-save ()
- (save-excursion
- (elmo-object-save
- (expand-file-name elmo-queue-filename
- elmo-msgdb-dir)
- elmo-dop-queue)))
-
-(defun elmo-dop-lock-message (message-id &optional lock-list)
- (let ((locked (or lock-list
- (elmo-object-load
- (expand-file-name
- elmo-msgdb-lock-list-filename
- elmo-msgdb-dir)))))
- (setq locked (cons message-id locked))
- (elmo-object-save
- (expand-file-name elmo-msgdb-lock-list-filename
- elmo-msgdb-dir)
- locked)))
-
-(defun elmo-dop-unlock-message (message-id &optional lock-list)
- (let ((locked (or lock-list
- (elmo-object-load
- (expand-file-name elmo-msgdb-lock-list-filename
- elmo-msgdb-dir)))))
- (setq locked (delete message-id locked))
- (elmo-object-save
- (expand-file-name elmo-msgdb-lock-list-filename
- elmo-msgdb-dir)
- locked)))
-
-(defun elmo-dop-lock-list-load ()
- (elmo-object-load
- (expand-file-name elmo-msgdb-lock-list-filename
- elmo-msgdb-dir)))
-
-(defun elmo-dop-lock-list-save (lock-list)
- (elmo-object-save
- (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
- (expand-file-name (if resume
- elmo-msgdb-resume-list-filename
- elmo-msgdb-append-list-filename)
- (elmo-msgdb-expand-path folder))))
-
-(defun elmo-dop-append-list-save (folder append-list &optional resume)
- (if append-list
- (elmo-object-save
- (expand-file-name (if resume
- elmo-msgdb-resume-list-filename
- elmo-msgdb-append-list-filename)
- (elmo-msgdb-expand-path folder))
- append-list)
- (condition-case ()
- (delete-file (expand-file-name (if resume
- elmo-msgdb-resume-list-filename
- elmo-msgdb-append-list-filename)
- (elmo-msgdb-expand-path folder)))
- (error))))
-
-(defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended)
- "returns (new-appended . deleting-msgids)."
- (let (msgid deleting-msgids)
- (while numbers
- (setq msgid (cdr (assq (car numbers) alist)))
- (if (member msgid appended)
- (setq appended (delete msgid appended))
- (setq deleting-msgids (append deleting-msgids (list msgid))))
- (setq numbers (cdr numbers)))
- (cons appended deleting-msgids)))
-
-(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)))
- 'imap4)
- (if elmo-enable-disconnected-operation
- (progn
- (setq appended-deleting
- (elmo-dop-deleting-numbers-to-msgids
- (elmo-msgdb-get-number-alist msgdb)
- msgs ; virtual number
- (elmo-dop-append-list-load folder)))
- (if (cdr appended-deleting)
- (elmo-dop-queue-append
- (car (car folder-numbers)) ; real folder
- "delete-msgids" ;; for secure removal.
- (cdr appended-deleting)))
- (elmo-dop-append-list-save folder (car appended-deleting)))
- (error "Unplugged"))
- ;; not imap4 folder...delete now!
- (elmo-call-func (car (car folder-numbers)) "delete-msgs"
- (cdr (car folder-numbers))))
- (setq folder-numbers (cdr folder-numbers))))
+;;; dop spool folder
+(defun elmo-dop-spool-folder (folder)
+ "Return a spool folder for disconnected operations
+which is corresponded to the FOLDER."
+ (elmo-make-folder
+ (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path folder)))
+ nil
+ (elmo-folder-mime-charset-internal folder)))
+
+(defun elmo-dop-spool-folder-append-buffer (folder flags)
+ "Append current buffer content to the dop spool folder.
+FOLDER is the folder structure.
+Return a message number."
+ (let ((spool (elmo-dop-spool-folder folder)))
+ (unless (elmo-folder-exists-p spool)
+ (elmo-folder-create spool))
+ (let ((new-number (1+ (car (elmo-folder-status spool)))))
+ (elmo-folder-append-buffer spool flags new-number)
+ new-number)))
+
+
+(defun elmo-dop-spool-folder-list-messages (folder)
+ "List messages in the dop spool folder.
+FOLDER is the folder structure."
+ (setq folder (elmo-dop-spool-folder folder))
+ (if (elmo-folder-exists-p folder)
+ (elmo-folder-list-messages folder)))
+
+(defun elmo-dop-list-deleting-messages (folder)
+ "List messages which are on the deleting queue for the folder.
+FOLDER is the folder structure."
+ (let (messages)
+ (dolist (queue elmo-dop-queue)
+ (if (and (string= (elmo-dop-queue-fname queue)
+ (elmo-folder-name-internal folder))
+ (eq (elmo-dop-queue-method queue)
+ 'elmo-folder-delete-messages-dop-delayed))
+ (setq messages (nconc messages
+ (mapcar
+ 'car
+ (car (elmo-dop-queue-arguments queue)))))))))
+
+(defun elmo-dop-filter-pending-messages (numbers)
+ (elmo-delete-if (lambda (number) (< number 0)) numbers))
+
+;;; DOP operations.
+(defsubst elmo-folder-append-buffer-dop (folder &optional flag number)
+ (elmo-dop-queue-append
+ folder 'elmo-folder-append-buffer-dop-delayed
+ (list flag
+ (elmo-dop-spool-folder-append-buffer folder flag)
+ number)))
+
+(defsubst elmo-folder-delete-messages-dop (folder numbers)
+ (let ((spool-folder (elmo-dop-spool-folder folder))
+ queue)
+ (dolist (number numbers)
+ (if (< number 0)
+ (progn
+ ;; delete from queue
+ (elmo-folder-delete-messages spool-folder
+ (list (abs number)))
+ (dolist (queue elmo-dop-queue)
+ (when (and (eq (elmo-dop-queue-fname queue)
+ (elmo-folder-name-internal folder))
+ (eq (elmo-dop-queue-method queue)
+ 'elmo-folder-append-buffer-dop-delayed)
+ (eq (abs number)
+ (nth 1 (elmo-dop-queue-arguments queue))))
+ (setq elmo-dop-queue (delq queue elmo-dop-queue)))))
+ (setq queue (cons number queue))))
+ (when queue
+ (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed
+ (list
+ (mapcar
+ (lambda (number)
+ (cons number (elmo-message-field
+ folder number 'message-id)))
+ queue))))
t))
-(defun elmo-dop-prefetch-msgs (folder msgs)
- (save-match-data
- (elmo-dop-queue-append folder "prefetch-msgs" msgs)))
-
-(defun elmo-dop-list-folder (folder)
- (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* ((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
- max-num
- (i 0))
- (while append-list
- (if (rassoc (car append-list) number-alist)
- (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)
- number-list) 0))
- (while (< i append-num)
- (setq number-list
- (append number-list
- (list (+ max-num i 1))))
- (setq i (+ 1 i)))
- (elmo-living-messages number-list killed))
- (error "Unplugged"))
- ;; not imap4 folder...list folder
- (elmo-call-func folder "list-folder")))
-
-(defun elmo-dop-count-appended (folder)
- (length (elmo-dop-append-list-load folder)))
-
-(defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb)
- (let ((append-list (elmo-dop-append-list-load folder))
- (number-alist (elmo-msgdb-get-number-alist msgdb))
- 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)))
- (if msgs
- (elmo-dop-queue-append folder func-name msgs)))
- ;; maildir... XXX hard coding.....
- (if (not (featurep 'elmo-maildir))
- (require 'maildir))
- (funcall (intern (format "elmo-maildir-%s" func-name))
- (elmo-folder-get-spec folder)
- msgs msgdb))))
-
-(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)))
- (number-list (mapcar 'car number-alist))
- (append-list (elmo-dop-append-list-load folder))
- (append-num (length append-list))
- alreadies
- (i 0)
- max-num)
- (while append-list
- (if (rassoc (car append-list) number-alist)
- (setq alreadies (append alreadies
- (list (car append-list)))))
- (setq append-list (cdr append-list)))
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0) number-list)
- 0))
- (cons (- (+ max-num append-num) (length alreadies))
- (- (+ (length number-list) append-num) (length alreadies))))
- (error "Unplugged"))
- ;; not imap4 folder.
- (elmo-call-func folder "max-of-folder")))
-
-(defun elmo-dop-save-pending-messages (folder)
- (message (format "Saving queued message in %s..." elmo-lost+found-folder))
- (let* ((append-list (elmo-dop-append-list-load folder))
- file-string)
- (while append-list
- (when (setq file-string (elmo-get-file-string ; message string
- (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"
- elmo-lost+found-folder)))
-
-(defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
- (message "Appending queued messages...")
- (let* ((append-list (or appends
- (elmo-dop-append-list-load folder)))
- (appendings append-list)
- (i 0)
- (num (length append-list))
- failure file-string)
- (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
- (elmo-msgdb-expand-path folder)))
- (appendings append-list)
- pair dels)
- (while appendings
- (if (setq pair (rassoc (car appendings) number-alist))
- (setq resumed-list (append resumed-list
- (list (car appendings)))))
- (setq appendings (cdr appendings)))
- (elmo-dop-append-list-save folder resumed-list t)))
- (while 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 ()
- (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)
- (unless resume
- ;; delete '(folder "append-operations") in elmo-dop-queue.
- (let (elmo-dop-queue)
- (elmo-dop-queue-load)
- (setq elmo-dop-queue (delete (list folder "append-operations" nil)
- elmo-dop-queue))
- (elmo-dop-queue-save))))
- (message "Appending queued messages...done"))
-
-(defun elmo-dop-folder-exists-p (folder)
- (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)
- (if elmo-enable-disconnected-operation
- (elmo-dop-queue-append folder "create-folder-maybe" nil)
- (error "Unplugged"))
- (elmo-call-func folder "create-folder")))
-
-(defun elmo-dop-delete-folder (folder)
- (error "Unplugged"))
-
-(defun elmo-dop-rename-folder (old-folder new-folder)
- (error "Unplugged"))
-
-(defun elmo-dop-append-msg (folder string message-id &optional msg)
- (if elmo-enable-disconnected-operation
- (if message-id
- (progn
- (unless (elmo-cache-exists-p message-id)
- (elmo-set-work-buf
- (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
- (elmo-msgdb-expand-path folder))))
- (when (and ; not in current folder.
- (not (rassoc message-id number-alist))
- (not (member message-id append-list)))
- (setq append-list
- (append append-list (list message-id)))
- (elmo-dop-lock-message message-id)
- (elmo-dop-append-list-save folder append-list)
- (elmo-dop-queue-append folder "append-operations" nil))
- t))
- nil)
- (error "Unplugged")))
-
-(defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist)
-
-(defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- (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
- (elmo-msgdb-expand-path folder)))
- (number-list (mapcar 'car num-alist))
- (ov (elmo-msgdb-overview-load
- (elmo-msgdb-expand-path folder)))
- (append-list (elmo-dop-append-list-load folder))
- (num (length numlist))
- (i 0)
- overview number-alist mark-alist msgid ov-entity
- max-num percent seen gmark)
- (setq max-num
- (or (nth (max (- (length number-list) 1) 0) number-list)
- 0))
- (while numlist
- (if (setq msgid
- (nth (+ (length append-list)
- (- (car numlist) max-num 1 num))
- append-list))
- (progn
- (setq overview
- (elmo-msgdb-append-element
- overview
- (elmo-localdir-msgdb-create-overview-entity-from-file
- (car numlist)
- (elmo-cache-get-path msgid))))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (car numlist) msgid))
- (setq seen (member msgid seen-list))
- (if (setq gmark
- (or (elmo-msgdb-global-mark-get msgid)
- (if (elmo-cache-exists-p
- msgid
- folder
- (car number-alist))
- (if seen
- nil
- already-mark)
- (if seen
- seen-mark)
- new-mark)))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist (car numlist) gmark))))
-
- (when (setq ov-entity (assoc
- (cdr (assq (car numlist) num-alist))
- ov))
- (setq overview
- (elmo-msgdb-append-element
- overview ov-entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist
- (car numlist)
- (car ov-entity)))
- (setq seen (member ov-entity seen-list))
- (if (setq gmark
- (or (elmo-msgdb-global-mark-get (car ov-entity))
- (if (elmo-cache-exists-p
- msgid
- folder
- (car ov-entity))
- (if seen
- nil
- already-mark)
- (if seen
- seen-mark)
- new-mark)))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist (car numlist) gmark)))))
- (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"))
- ;; not imap4 folder...
- (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
- seen-mark important-mark seen-list)))
+(defsubst elmo-message-encache-dop (folder number &optional read)
+ (elmo-dop-queue-append folder 'elmo-message-encache (list number read)))
+
+(defsubst elmo-folder-create-dop (folder)
+ (elmo-dop-queue-append folder 'elmo-folder-create-dop-delayed nil))
+
+(defsubst elmo-folder-set-flag-dop (folder numbers flag)
+ (when (setq numbers (elmo-dop-filter-pending-messages numbers))
+ (let ((method (case flag
+ (unread
+ 'elmo-folder-unset-read-delayed)
+ (read
+ 'elmo-folder-set-read-delayed)
+ (important
+ 'elmo-folder-set-important-delayed)
+ (answered
+ 'elmo-folder-set-answered-delayed))))
+ (if method
+ (elmo-dop-queue-append folder method (list numbers))
+ (elmo-dop-queue-append folder 'elmo-folder-set-flag
+ (list numbers flag))))))
+
+(defsubst elmo-folder-unset-flag-dop (folder numbers flag)
+ (when (setq numbers (elmo-dop-filter-pending-messages numbers))
+ (let ((method (case flag
+ (unread
+ 'elmo-folder-set-read-delayed)
+ (read
+ 'elmo-folder-unset-read-delayed)
+ (important
+ 'elmo-folder-unset-important-delayed)
+ (answered
+ 'elmo-folder-unset-answered-delayed))))
+ (if method
+ (elmo-dop-queue-append folder method (list numbers))
+ (elmo-dop-queue-append folder 'elmo-folder-unset-flag
+ (list numbers flag))))))
+
+;;; Execute as subsutitute for plugged operation.
+(defun elmo-folder-status-dop (folder)
+ (let ((number-list (elmo-folder-list-messages folder nil 'in-msgdb))
+ (spool-folder (elmo-dop-spool-folder folder))
+ spool-length
+ max-num)
+ (setq spool-length (or (if (elmo-folder-exists-p spool-folder)
+ (car (elmo-folder-status spool-folder)))
+ 0))
+ (setq max-num (if number-list (apply #'max number-list) 0))
+ (cons (+ max-num spool-length) (+ (length number-list) spool-length))))
+
+(defun elmo-folder-next-message-number-dop (folder)
+ (let ((spool-folder (elmo-dop-spool-folder folder)))
+ (- (+ 1 (elmo-max-of-list (or (elmo-folder-list-messages
+ spool-folder)
+ '(0)))))))
+
+;;; Delayed operation (executed at online status).
+(defun elmo-folder-append-buffer-dop-delayed (folder flag number set-number)
+ (let ((spool-folder (elmo-dop-spool-folder folder))
+ flags)
+ (with-temp-buffer
+ (when (elmo-message-fetch spool-folder number
+ (elmo-make-fetch-strategy 'entire)
+ 'unread)
+ (setq flags (or (elmo-message-flags-for-append folder (* -1 number))
+ (cond ((listp flag)
+ flag)
+ ;; for compatibility with 2.11.12 or earlier
+ ((eq flag t)
+ nil)
+ (t
+ (list flag)))))
+ (when (or (condition-case nil
+ (let ((new-num (elmo-folder-next-message-number folder)))
+ (prog1
+ (elmo-folder-append-buffer folder flags set-number)
+ (elmo-emit-signal 'message-number-changed
+ folder (- number) new-num)))
+ (error))
+ ;; Append failed...
+ (elmo-folder-append-buffer
+ (elmo-get-folder elmo-lost+found-folder)
+ flags))
+ (elmo-folder-delete-messages spool-folder (list number)))))
+ ;; ignore failure (already dequed)
+ t))
+
+(defun elmo-folder-delete-messages-dop-delayed (folder number-alist)
+ (ignore-errors
+ (elmo-folder-delete-messages
+ folder
+ ;; messages are deleted only if message-id is not changed.
+ (mapcar 'car
+ (elmo-delete-if
+ (lambda (pair)
+ (not (string=
+ (cdr pair)
+ (elmo-message-fetch-field folder (car pair)
+ 'message-id))))
+ number-alist)))
+ t)) ; Always success (If failure, just remain)
+
+(defun elmo-folder-create-dop-delayed (folder)
+ (unless (elmo-folder-exists-p folder)
+ (elmo-folder-create folder)))
+
+(defun elmo-folder-set-important-delayed (folder numbers)
+ (elmo-folder-set-flag folder numbers 'important))
+
+(defun elmo-folder-unset-important-delayed (folder numbers)
+ (elmo-folder-unset-flag folder numbers 'important))
+
+(defun elmo-folder-set-read-delayed (folder numbers)
+ (elmo-folder-unset-flag folder numbers 'unread))
+
+(defun elmo-folder-unset-read-delayed (folder numbers)
+ (elmo-folder-set-flag folder numbers 'unread))
+
+(defun elmo-folder-set-answered-delayed (folder numbers)
+ (elmo-folder-set-flag folder numbers 'answered))
+
+(defun elmo-folder-unset-answered-delayed (folder numbers)
+ (elmo-folder-unset-flag folder numbers 'answered))
+
+;;; Util
+(defun elmo-dop-msgdb (msgdb)
+ (let ((new-db (elmo-make-msgdb))
+ entity)
+ (dolist (dop-entity (mapcar
+ (lambda (number)
+ (setq entity (elmo-msgdb-message-entity
+ msgdb number))
+ (elmo-message-entity-set-number
+ entity
+ (* -1 (elmo-message-entity-number entity)))
+ entity)
+ (elmo-msgdb-list-messages msgdb)))
+ (elmo-msgdb-append-entity new-db
+ dop-entity
+ (elmo-msgdb-flags
+ msgdb
+ (abs (elmo-message-entity-number
+ dop-entity)))))
+ new-db))
(require 'product)
(product-provide (provide 'elmo-dop) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff