X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-dop.el;h=3ddb76f031fddef0f7fa2fedcc22f2446677816b;hb=64eb91d7fe775e78e0f1e6555b595e40f391260a;hp=c53104b40060174950398e51fb69f820ae3fb091;hpb=de09334f0fb7b21d691cebc56a7a4ae88e58286d;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-dop.el b/elmo/elmo-dop.el index c53104b..3ddb76f 100644 --- a/elmo/elmo-dop.el +++ b/elmo/elmo-dop.el @@ -62,13 +62,23 @@ Automatically loaded/saved.") method arguments))) (setq elmo-dop-queue (nconc elmo-dop-queue (list queue))))) +(defvar elmo-dop-queue-merge-method-list + '(elmo-folder-mark-as-read + elmo-folder-unmark-read + elmo-folder-mark-as-important + elmo-folder-unmark-important + elmo-folder-mark-as-answered + elmo-folder-unmark-answered)) + (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-create-folder . "Create") + (elmo-folder-create-dop-delayed . "Create") (elmo-folder-mark-as-read . "Read") (elmo-folder-unmark-read . "Unread") + (elmo-folder-mark-as-answered . "Answered") + (elmo-folder-unmark-answered . "Unanswered") (elmo-folder-mark-as-important . "Important") (elmo-folder-unmark-important . "Unimportant"))) @@ -76,24 +86,28 @@ Automatically loaded/saved.") `(cdr (assq (elmo-dop-queue-method ,queue) elmo-dop-queue-method-name-alist))) -(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." +(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) - folder len) - ;; obsolete - (unless (or (null queue) - (vectorp (car 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."))) + (while queue-all + (if (elmo-folder-plugged-p + (elmo-make-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 @@ -119,9 +133,7 @@ even an operation concerns the unplugged folder." (setq folder (elmo-make-folder (elmo-dop-queue-fname (car queue)))) - (elmo-folder-open folder) - (unless (elmo-folder-plugged-p folder) - (error "Unplugged."))) + (elmo-folder-open folder)) (elmo-dop-queue-arguments (car queue))) (elmo-folder-close folder)) (quit (setq failure t)) @@ -135,19 +147,43 @@ even an operation concerns the unplugged folder." performed num) (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) (progn - (setq elmo-dop-queue nil) - (message "All pending operations are cleared.") + (while queue + (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)) + (setq queue (cdr queue))) + (message "Pending operations are cleared.") (elmo-dop-queue-save)) (message ""))) count))) -(defvar elmo-dop-merge-funcs nil) (defun elmo-dop-queue-merge () - ;; XXXX Not implemented yet. - ) + (let ((queue elmo-dop-queue) + new-queue match-queue que) + (while (setq que (car queue)) + (if (and + (memq (elmo-dop-queue-method que) + elmo-dop-queue-merge-method-list) + (setq match-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))) ;;; dop spool folder (defmacro elmo-dop-spool-folder (folder) @@ -205,20 +241,28 @@ FOLDER is the folder structure." number))) (defsubst elmo-folder-delete-messages-dop (folder numbers) - (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed - (list - (mapcar - (lambda (number) - (cons number (elmo-message-field - folder number 'message-id))) - numbers))) - t) + (let ((spool-folder (elmo-dop-spool-folder folder)) + queue) + (dolist (number numbers) + (if (< number 0) + (elmo-folder-delete-messages spool-folder + (list (abs number))) ; delete from 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)) (defsubst elmo-message-encache-dop (folder number &optional read) (elmo-dop-queue-append folder 'elmo-message-encache (list number read))) -(defsubst elmo-create-folder-dop (folder) - (elmo-dop-queue-append folder 'elmo-folder-create nil)) +(defsubst elmo-folder-create-dop (folder) + (elmo-dop-queue-append folder 'elmo-folder-create-dop-delayed nil)) (defsubst elmo-folder-mark-as-read-dop (folder numbers) (elmo-dop-queue-append folder 'elmo-folder-mark-as-read (list numbers))) @@ -232,6 +276,12 @@ FOLDER is the folder structure." (defsubst elmo-folder-unmark-important-dop (folder numbers) (elmo-dop-queue-append folder 'elmo-folder-unmark-important (list numbers))) +(defsubst elmo-folder-mark-as-answered-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-mark-as-answered (list numbers))) + +(defsubst elmo-folder-unmark-answered-dop (folder numbers) + (elmo-dop-queue-append folder 'elmo-folder-unmark-answered (list numbers))) + ;;; Execute as subsutitute for plugged operation. (defun elmo-folder-status-dop (folder) (let* ((number-alist (elmo-msgdb-number-load @@ -241,8 +291,8 @@ FOLDER is the folder structure." spool-length (i 0) max-num) - (setq spool-length (length (car (if (elmo-folder-exists-p spool-folder) - (elmo-folder-status spool-folder))))) + (setq spool-length (or (car (if (elmo-folder-exists-p spool-folder) + (elmo-folder-status spool-folder))) 0)) (setq max-num (or (nth (max (- (length number-list) 1) 0) number-list) 0)) @@ -251,22 +301,25 @@ FOLDER is the folder structure." ;;; Delayed operation (executed at online status). (defun elmo-folder-append-buffer-dop-delayed (folder unread number set-number) (let ((spool-folder (elmo-dop-spool-folder folder)) - failure saved) + failure saved dequeued) (with-temp-buffer - (elmo-message-fetch spool-folder number - (elmo-make-fetch-strategy 'entire) - nil (current-buffer) 'unread) - (condition-case nil - (setq failure (not - (elmo-folder-append-buffer folder unread set-number))) - (error (setq failure t))) + (if (elmo-message-fetch spool-folder number + (elmo-make-fetch-strategy 'entire) + nil (current-buffer) 'unread) + (condition-case nil + (setq failure (not + (elmo-folder-append-buffer + folder unread set-number))) + (error (setq failure t))) + (setq dequeued t)) ; Already deletef from queue. (when failure ;; Append failed... (setq saved (elmo-folder-append-buffer (elmo-make-folder elmo-lost+found-folder) unread set-number))) - (if (or (not failure) - saved) + (if (and (not dequeued) ; if dequeued, no need to delete. + (or (not failure) ; succeed + saved)) ; in lost+found (elmo-folder-delete-messages spool-folder (list number))) t))) @@ -283,6 +336,10 @@ FOLDER is the folder structure." 'message-id)))) number-alist)))) +(defun elmo-folder-create-dop-delayed (folder) + (unless (elmo-folder-exists-p folder) + (elmo-folder-create folder))) + ;;; Util (defun elmo-dop-msgdb (msgdb) (list (mapcar (function