X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-imap4.el;h=795d27ff1eac77827c8145cf14c225a99003fc59;hb=7b1c7e63938a59f9e887f91104ac866dd2fdd573;hp=8d14bf7a9663511d6d7f03a0e1ec7f51b78b3df6;hpb=66f5b4f47cfa5da62cbbda72ac37d6557355a120;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 8d14bf7..795d27f 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -66,7 +66,7 @@ ;; ranges so that the command line is within that length, it should ;; split the request into multiple commands. The client should use ;; literals instead of long quoted strings, in order to keep the command -;; length down. +;; length down. ;; For its part, a server should allow for a command line of at least ;; 8000 octets. This provides plenty of leeway for accepting reasonable ;; length commands from clients. The server should send a BAD response @@ -91,8 +91,10 @@ "Use cache in imap4 folder.") (defvar elmo-imap4-extra-namespace-alist - '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox... - "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).") + '(("^\\({.*/nntp}\\).*$" . ".")) ; Default is for UW's remote nntp mailbox... + "Extra namespace alist. +A list of cons cell like: (REGEXP . DELIMITER). +REGEXP should have a grouping for namespace prefix.") ;; ;;; internal variables ;; @@ -251,9 +253,9 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") ; "Send COMMAND to the SESSION and wait for response. ; Returns RESPONSE (parsed lisp object) of IMAP session." ; (elmo-imap4-read-response session -; (elmo-imap4-send-command -; session -; command))) +; (elmo-imap4-send-command +; session +; command))) (defun elmo-imap4-send-command-wait (session command) "Send COMMAND to the SESSION. @@ -1580,11 +1582,11 @@ Return nil if no complete line has arrived." (if (eq (length prefix) 0) (progn (setq default-delim delim) nil) (cons - (concat "^" + (concat "^\\(" (if (string= (downcase prefix) "inbox") "[Ii][Nn][Bb][Oo][Xx]" (regexp-quote prefix)) - ".*$") + "\\).*$") delim))) (elmo-imap4-nth i ns)))))) (if default-delim @@ -1890,13 +1892,21 @@ Return nil if no complete line has arrived." (with-current-buffer (elmo-network-session-buffer session) elmo-imap4-server-namespace))) elmo-imap4-default-hierarchy-delimiter)) + ;; Append delimiter when root with namespace. + (root (if (and (match-end 1) + (string= (substring root (match-end 1)) + "")) + (concat root delim) + root)) result append-serv type) (setq result (elmo-imap4-response-get-selectable-mailbox-list (elmo-imap4-send-command-wait session (list "list " (elmo-imap4-mailbox root) " *")))) - (unless (string= (elmo-net-folder-user-internal folder) - elmo-imap4-default-user) + (when (or (not (string= (elmo-net-folder-user-internal folder) + elmo-imap4-default-user)) + (not (eq (elmo-net-folder-auth-internal folder) + (or elmo-imap4-default-authenticate-type 'clear)))) (setq append-serv (concat ":" (elmo-net-folder-user-internal folder)))) (unless (eq (elmo-net-folder-auth-internal folder) (or elmo-imap4-default-authenticate-type 'clear)) @@ -1920,6 +1930,7 @@ Return nil if no complete line has arrived." type))))) (if one-level (let ((re-delim (regexp-quote delim)) + (case-fold-search nil) folder ret has-child-p) ;; Append delimiter (when (and root @@ -2001,7 +2012,9 @@ Return nil if no complete line has arrived." (elmo-imap4-folder-mailbox-internal folder)) " " (elmo-imap4-mailbox - (elmo-imap4-folder-mailbox-internal new-folder)))))) + (elmo-imap4-folder-mailbox-internal new-folder)))) + (elmo-imap4-session-set-current-mailbox-internal + session (elmo-imap4-folder-mailbox-internal new-folder)))) (defun elmo-imap4-copy-messages (src-folder dst-folder numbers) (let ((session (elmo-imap4-get-session src-folder)) @@ -2205,14 +2218,16 @@ If optional argument REMOVE is non-nil, remove FLAG." folder session (nth 2 condition) from-msgs))) result (sort result '<)))))) -(luna-define-method elmo-folder-search ((folder elmo-imap4-folder) - condition &optional numbers) - (save-excursion - (let ((session (elmo-imap4-get-session folder))) - (elmo-imap4-session-select-mailbox - session - (elmo-imap4-folder-mailbox-internal folder)) - (elmo-imap4-search-internal folder session condition numbers)))) +(luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder) + condition &optional numbers) + (if (elmo-folder-plugged-p folder) + (save-excursion + (let ((session (elmo-imap4-get-session folder))) + (elmo-imap4-session-select-mailbox + session + (elmo-imap4-folder-mailbox-internal folder)) + (elmo-imap4-search-internal folder session condition numbers))) + (luna-call-next-method))) (luna-define-method elmo-folder-msgdb-create-plugged ((folder elmo-imap4-folder) numbers &rest args) @@ -2305,8 +2320,7 @@ If optional argument REMOVE is non-nil, remove FLAG." (defsubst elmo-imap4-folder-diff-plugged (folder) (let ((session (elmo-imap4-get-session folder)) - messages - response killed) + messages new unread response killed) ;;; (elmo-imap4-commit spec) (with-current-buffer (elmo-network-session-buffer session) (setq elmo-imap4-status-callback nil) @@ -2326,9 +2340,10 @@ If optional argument REMOVE is non-nil, remove FLAG." (setq messages (- messages (elmo-msgdb-killed-list-length killed)))) - (list (elmo-imap4-response-value response 'recent) - (elmo-imap4-response-value response 'unseen) - messages))) + (setq new (elmo-imap4-response-value response 'recent) + unread (elmo-imap4-response-value response 'unseen)) + (if (< unread new) (setq new unread)) + (list new unread messages))) (luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder)) (elmo-imap4-folder-diff-plugged folder)) @@ -2523,14 +2538,15 @@ If optional argument REMOVE is non-nil, remove FLAG." (setq elmo-imap4-display-literal-progress nil)) (unless elmo-inhibit-display-retrieval-progress (elmo-display-progress 'elmo-imap4-display-literal-progress - "" 100) ; remove progress bar. + "Retrieving..." 100) ; remove progress bar. (message "Retrieving...done.")) (if (setq response (elmo-imap4-response-bodydetail-text (elmo-imap4-response-value-all response 'fetch))) (with-current-buffer outbuf (erase-buffer) - (insert response))))) + (insert response) + t)))) (luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder) number strategy