X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-imap4.el;h=82e8dbff2890a68c7d1211b029d3f660709b6be4;hb=824fe18b2ad090f609041a4af11de484bdb7e3a8;hp=b8d850a2d4af8a62176a4de103483e395bd94bc4;hpb=a5c3defd7c03a0a077616e7d44d3641e5d61c2ba;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index b8d850a..82e8dbf 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -38,6 +38,7 @@ ;; Author: Simon Josefsson ;; +;;; Code: (require 'elmo-vars) (require 'elmo-util) (require 'elmo-date) @@ -48,7 +49,6 @@ (require 'utf7) (require 'elmo-mime) -;;; Code: (eval-when-compile (require 'cl)) (defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd @@ -210,8 +210,8 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") ;;; Debug (defmacro elmo-imap4-debug (message &rest args) - (` (if elmo-imap4-debug - (elmo-imap4-debug-1 (, message) (,@ args))))) + `(if elmo-imap4-debug + (elmo-imap4-debug-1 ,message ,@args))) (defun elmo-imap4-debug-1 (message &rest args) (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*") @@ -234,23 +234,23 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") (defmacro elmo-imap4-response-continue-req-p (response) "Returns non-nil if RESPONSE is '+' response." - (` (assq 'continue-req (, response)))) + `(assq 'continue-req ,response)) (defmacro elmo-imap4-response-ok-p (response) "Returns non-nil if RESPONSE is an 'OK' response." - (` (assq 'ok (, response)))) + `(assq 'ok ,response)) (defmacro elmo-imap4-response-bye-p (response) "Returns non-nil if RESPONSE is an 'BYE' response." - (` (assq 'bye (, response)))) + `(assq 'bye ,response)) (defmacro elmo-imap4-response-garbage-p (response) "Returns non-nil if RESPONSE is an 'garbage' response." - (` (assq 'garbage (, response)))) + `(assq 'garbage ,response)) (defmacro elmo-imap4-response-value (response symbol) "Get value of the SYMBOL from RESPONSE." - (` (nth 1 (assq (, symbol) (, response))))) + `(nth 1 (assq ,symbol ,response))) (defsubst elmo-imap4-response-value-all (response symbol) "Get all value of the SYMBOL from RESPONSE." @@ -263,13 +263,13 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"") (defmacro elmo-imap4-response-error-text (response) "Returns text of NO, BAD, BYE response." - (` (nth 1 (or (elmo-imap4-response-value (, response) 'no) - (elmo-imap4-response-value (, response) 'bad) - (elmo-imap4-response-value (, response) 'bye))))) + `(nth 1 (or (elmo-imap4-response-value ,response 'no) + (elmo-imap4-response-value ,response 'bad) + (elmo-imap4-response-value ,response 'bye)))) (defmacro elmo-imap4-response-bodydetail-text (response) "Returns text of BODY[section]." - (` (nth 3 (assq 'bodydetail (, response))))) + `(nth 3 (assq 'bodydetail ,response))) ;;; Session commands. @@ -331,14 +331,14 @@ Returns a TAG string which is assigned to the COMMAND." ;; rfc2088 (progn (setq cmdstr (concat cmdstr - (format "{%d+}" (nth 2 token)))) + (format "{%d+}" (nth 2 token)) + "\r\n")) (process-send-string process cmdstr) - (process-send-string process "\r\n") (setq cmdstr nil)) (setq cmdstr (concat cmdstr - (format "{%d}" (nth 2 token)))) + (format "{%d}" (nth 2 token)) + "\r\n")) (process-send-string process cmdstr) - (process-send-string process "\r\n") (setq cmdstr nil) (elmo-imap4-accept-continue-req session)) (cond ((stringp (nth 1 token)) @@ -356,9 +356,7 @@ Returns a TAG string which is assigned to the COMMAND." (t (error "Invalid argument"))) (setq command-args (cdr command-args))) - (if cmdstr - (process-send-string process cmdstr)) - (process-send-string process "\r\n") + (process-send-string process (concat cmdstr "\r\n")) tag))) (defun elmo-imap4-send-string (session string) @@ -823,16 +821,7 @@ FLAG is one of the `unread', `read', `important', `answered', `any'." (let ((session (elmo-imap4-get-session folder)) (criteria (elmo-imap4-flag-to-imap-criteria flag))) (if (elmo-imap4-session-flag-available-p session flag) - (progn - (elmo-imap4-session-select-mailbox - session - (elmo-imap4-folder-mailbox-internal folder)) - (elmo-imap4-response-value - (elmo-imap4-send-command-wait - session - (format (if elmo-imap4-use-uid "uid search %s" - "search %s") criteria)) - 'search)) + (elmo-imap4-list folder criteria) ;; List flagged messages in the msgdb. (elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag)))) @@ -937,6 +926,8 @@ If CHOP-LENGTH is not specified, message set is not chopped." (concat "(" (downcase (elmo-match-string 1 string)) ")")))) (defun elmo-imap4-clear-login (session) + (when (elmo-imap4-session-capable-p session 'logindisabled) + (signal 'elmo-authenticate-error '(elmo-imap4-clear-login))) (let ((elmo-imap4-debug-inhibit-logging t)) (or (elmo-imap4-read-ok @@ -1602,22 +1593,23 @@ Return nil if no complete line has arrived." (setq status (cons (let ((token (read (current-buffer)))) - (cond ((eq token 'MESSAGES) - (list 'messages (read (current-buffer)))) - ((eq token 'RECENT) - (list 'recent (read (current-buffer)))) - ((eq token 'UIDNEXT) - (list 'uidnext (read (current-buffer)))) - ((eq token 'UIDVALIDITY) - (and (looking-at " \\([0-9]+\\)") - (prog1 (list 'uidvalidity (match-string 1)) - (goto-char (match-end 1))))) - ((eq token 'UNSEEN) - (list 'unseen (read (current-buffer)))) - (t - (message - "Unknown status data %s in mailbox %s ignored" - token mailbox)))) + (case (intern (upcase (symbol-name token))) + (MESSAGES + (list 'messages (read (current-buffer)))) + (RECENT + (list 'recent (read (current-buffer)))) + (UIDNEXT + (list 'uidnext (read (current-buffer)))) + (UIDVALIDITY + (and (looking-at " \\([0-9]+\\)") + (prog1 (list 'uidvalidity (match-string 1)) + (goto-char (match-end 1))))) + (UNSEEN + (list 'unseen (read (current-buffer)))) + (t + (message + "Unknown status data %s in mailbox %s ignored" + token mailbox)))) status)) (skip-chars-forward " "))) (and elmo-imap4-status-callback @@ -1628,12 +1620,13 @@ Return nil if no complete line has arrived." (defmacro elmo-imap4-value (value) - (` (if (eq (, value) 'NIL) nil - (, value)))) + `(if (eq ,value 'NIL) + nil + ,value)) (defmacro elmo-imap4-nth (pos list) - (` (let ((value (nth (, pos) (, list)))) - (elmo-imap4-value value)))) + `(let ((value (nth ,pos ,list))) + (elmo-imap4-value value))) (defun elmo-imap4-parse-namespace () (list 'namespace @@ -1940,15 +1933,17 @@ Return nil if no complete line has arrived." &optional enable-killed) (elmo-imap4-list folder - (let ((killed - (elmo-folder-killed-list-internal - folder))) - (if (and killed - (eq (length killed) 1) - (consp (car killed)) - (eq (car (car killed)) 1)) - (format "uid %d:*" (cdr (car killed))) - "all")))) + (concat + (let ((killed + (elmo-folder-killed-list-internal + folder))) + (if (and killed + (eq (length killed) 1) + (consp (car killed)) + (eq (car (car killed)) 1)) + (format "uid %d:*" (cdr (car killed))) + "all")) + " undeleted"))) (luna-define-method elmo-folder-list-flagged-plugged ((folder elmo-imap4-folder) flag) @@ -2032,13 +2027,13 @@ Return nil if no complete line has arrived." root))) (setq root (concat root delim))) (while (setq folder (car result)) - (when (string-match - (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)" - re-delim) - folder) - (setq folder (match-string 1 folder))) - (setq has-child-p nil - result (delq + (setq has-child-p + (when (string-match + (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)" + re-delim) + folder) + (setq folder (match-string 1 folder)))) + (setq result (delq nil (mapcar (lambda (fld) (if (string-match @@ -2085,8 +2080,9 @@ Return nil if no complete line has arrived." t) (luna-define-method elmo-folder-delete ((folder elmo-imap4-folder)) - (let ((msgs (and (elmo-folder-exists-p folder) - (elmo-folder-list-messages folder)))) + (let* ((exists (elmo-folder-exists-p folder)) + (msgs (and exists + (elmo-folder-list-messages folder)))) (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? " (if (> (length msgs) 0) (format "%d msg(s) exists. " (length msgs)) @@ -2095,7 +2091,9 @@ Return nil if no complete line has arrived." (let ((session (elmo-imap4-get-session folder))) (when (elmo-imap4-folder-mailbox-internal folder) (when msgs (elmo-folder-delete-messages-internal folder msgs)) - (elmo-imap4-send-command-wait session "close") + ;; close selected mailbox except one with \Noselect attribute + (when exists + (elmo-imap4-send-command-wait session "close")) (elmo-imap4-send-command-wait session (list "delete " @@ -2187,18 +2185,24 @@ If optional argument REMOVE is non-nil, remove FLAG." (luna-define-method elmo-folder-delete-messages-plugged ((folder elmo-imap4-folder) numbers) - (let ((session (elmo-imap4-get-session folder))) + (let ((session (elmo-imap4-get-session folder)) + (expunge + (or (null (elmo-imap4-list folder "deleted")) + (y-or-n-p + "There's hidden deleted messages, expunge anyway?")))) (elmo-imap4-session-select-mailbox session (elmo-imap4-folder-mailbox-internal folder)) (unless (elmo-imap4-set-flag folder numbers "\\Deleted") (error "Failed to set deleted flag")) - (elmo-imap4-send-command session "expunge"))) + (when expunge + (elmo-imap4-send-command session "expunge")) + t)) (defmacro elmo-imap4-detect-search-charset (string) - (` (with-temp-buffer - (insert (, string)) - (detect-mime-charset-region (point-min) (point-max))))) + `(with-temp-buffer + (insert ,string) + (detect-mime-charset-region (point-min) (point-max)))) (defun elmo-imap4-search-internal-primitive (folder session filter from-msgs) (let ((search-key (elmo-filter-key filter)) @@ -2211,12 +2215,12 @@ If optional argument REMOVE is non-nil, remove FLAG." ((string= "last" search-key) (let ((numbers (or from-msgs (elmo-folder-list-messages folder)))) (nthcdr (max (- (length numbers) - (string-to-int (elmo-filter-value filter))) + (string-to-number (elmo-filter-value filter))) 0) numbers))) ((string= "first" search-key) (let* ((numbers (or from-msgs (elmo-folder-list-messages folder))) - (rest (nthcdr (string-to-int (elmo-filter-value filter) ) + (rest (nthcdr (string-to-number (elmo-filter-value filter) ) numbers))) (mapcar '(lambda (x) (delete x numbers)) rest) numbers)) @@ -2625,12 +2629,12 @@ If optional argument REMOVE is non-nil, remove FLAG." (eval-when-compile (defmacro elmo-imap4-identical-system-p (folder1 folder2) "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system." - (` (and (string= (elmo-net-folder-server-internal (, folder1)) - (elmo-net-folder-server-internal (, folder2))) - (eq (elmo-net-folder-port-internal (, folder1)) - (elmo-net-folder-port-internal (, folder2))) - (string= (elmo-net-folder-user-internal (, folder1)) - (elmo-net-folder-user-internal (, folder2))))))) + `(and (string= (elmo-net-folder-server-internal ,folder1) + (elmo-net-folder-server-internal ,folder2)) + (eq (elmo-net-folder-port-internal ,folder1) + (elmo-net-folder-port-internal ,folder2)) + (string= (elmo-net-folder-user-internal ,folder1) + (elmo-net-folder-user-internal ,folder2))))) (luna-define-method elmo-folder-next-message-number-plugged ((folder elmo-imap4-folder))