From: dmaus Date: Fri, 16 Apr 2010 17:59:00 +0000 (+0000) Subject: Record mailbox size changes of selected IMAP4 mailbox. Required to X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=1bdf4d44be6f08f9293dadf647c65d66eb521a7f;p=elisp%2Fwanderlust.git Record mailbox size changes of selected IMAP4 mailbox. Required to comply with RFC 3501, section 7.3 and 7.4.1. Note: EXPUNGE response is recognized to decrement number of messages in mailbox only. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 3ceb6d7..674de7d 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,15 @@ +2010-04-16 David Maus + + * elmo-imap4.el (luna-define-class): Add slot + `current-mailbox-size'. + (elmo-imap4-mailbox-size-update-maybe): New function. + (elmo-imap4-read-response): Update mailbox size when untagged + EXISTS, RECENT and EXPUNGE responses arrive. + (elmo-imap4-session-check, elmo-folder-delete-messages-plugged): + Wait for and evaluate server response. + (elmo-imap4-session-select-mailbox, elmo-folder-delete) + (elmo-folder-open): Reset mailbox size when no mailbox selected. + 2010-04-15 David Maus * elmo-imap4.el (elmo-imap4-folder-name-syntax): Allow numbers in diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index a526fe4..3a0cd8f 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -200,7 +200,11 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") ;;; Session (eval-and-compile (luna-define-class elmo-imap4-session (elmo-network-session) - (capability current-mailbox read-only flags)) + (capability + current-mailbox + current-mailbox-size + read-only + flags)) (luna-define-internal-accessors 'elmo-imap4-session)) (defmacro elmo-imap4-session-capable-p (session capability) @@ -277,6 +281,32 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") "Returns text of BODY[section]." `(nth 3 (assq 'bodydetail ,response))) +(defun elmo-imap4-mailbox-size-update-maybe (session response) + "Update size of selected mailbox in SESSION according to RESPONSE." + (let ((exists (elmo-imap4-response-value response 'exists)) + (recent (elmo-imap4-response-value response 'recent)) + (expunge (delq nil (mapcar '(lambda (r) + (if (eq (car r) 'expunge) + (cadr r))) + response))) + (current-size (or (elmo-imap4-session-current-mailbox-size-internal + session) (cons nil nil)))) + (when (or expunge exists recent) + (when expunge + (if (null (car current-size)) + (elmo-imap4-debug "[%s] -> (bug) cannot reduce mailbox size" + (format-time-string "%T")) + (setcar current-size (- (car current-size) + (length expunge))))) + (if exists (setcar current-size exists)) + (if recent (setcdr current-size recent)) + (elmo-imap4-session-set-current-mailbox-size-internal + session current-size) + (elmo-imap4-debug "[%s] -> mailbox size adjusted: %s, %s" + (format-time-string "%T") + (elmo-imap4-session-current-mailbox-internal session) + current-size)))) + ;;; Session commands. ;;;(defun elmo-imap4-send-command-wait (session command) @@ -399,6 +429,7 @@ TAG is the tag of the command" 1))) (elmo-imap4-debug "[%s] => %s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response)) (setq elmo-imap4-parsing nil) + (elmo-imap4-mailbox-size-update-maybe session elmo-imap4-current-response) elmo-imap4-current-response)) (defsubst elmo-imap4-read-untagged (process) @@ -506,7 +537,7 @@ If response is not `OK' response, causes error with IMAP response text." (with-current-buffer (elmo-network-session-buffer session) (setq elmo-imap4-fetch-callback nil) (setq elmo-imap4-fetch-callback-data nil)) - (elmo-imap4-send-command session "check")) + (elmo-imap4-send-command-wait session "check")) (defun elmo-imap4-atom-p (string) "Return t if STRING is an atom defined in rfc2060." @@ -729,6 +760,7 @@ Returns response value if selecting folder succeed. " (nth 1 (or (assq 'permanentflags response) (assq 'flags response))))) (elmo-imap4-session-set-current-mailbox-internal session nil) + (elmo-imap4-session-set-current-mailbox-size-internal session nil) (if (and (eq no-error 'notify-bye) (elmo-imap4-response-bye-p response)) (elmo-imap4-process-bye session) @@ -2169,7 +2201,9 @@ Return nil if no complete line has arrived." (list "delete " (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal folder))))) - (elmo-imap4-session-set-current-mailbox-internal session nil)) + (elmo-imap4-session-set-current-mailbox-internal session nil) + (elmo-imap4-session-set-current-mailbox-size-internal session nil) + ) (elmo-msgdb-delete-path folder) t))) @@ -2266,7 +2300,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (unless (elmo-imap4-set-flag folder numbers "\\Deleted") (error "Failed to set deleted flag")) (when expunge - (elmo-imap4-send-command session "expunge")) + (elmo-imap4-send-command-wait session "expunge")) t)) (defun elmo-imap4-detect-search-charset (string) @@ -2586,6 +2620,8 @@ If optional argument REMOVE is non-nil, remove FLAG." (nth 1 (or (assq 'permanentflags response) (assq 'flags response))))) (elmo-imap4-session-set-current-mailbox-internal session nil) + (elmo-imap4-session-set-current-mailbox-size-internal + session nil) (if (elmo-imap4-response-bye-p response) (elmo-imap4-process-bye session) (error "%s" @@ -2601,13 +2637,16 @@ If optional argument REMOVE is non-nil, remove FLAG." session mailbox) (and session (elmo-imap4-session-set-current-mailbox-internal - session nil)))) + session nil)) + )) (error (if (elmo-imap4-response-ok-p response) (elmo-imap4-session-set-current-mailbox-internal session mailbox) (and session (elmo-imap4-session-set-current-mailbox-internal + session nil) + (elmo-imap4-session-set-current-mailbox-size-internal session nil)))))) (luna-call-next-method)))