X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-imap4.el;h=0cc8e37afc0c25582f30c1289840b0872d68d8b5;hb=93025ed9d6792ef40793910e2a2b7ac46029b5cb;hp=ce4b708daf2dfd30a2c8e5968e802eb27ef921ae;hpb=4f64e5a159c23e9f43b2b7292602e17980213ed8;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index ce4b708..0cc8e37 100644
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -38,6 +38,7 @@
 ;;    Author: Simon Josefsson <jas@pdc.kth.se>
 ;;
 
+;;; 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
@@ -198,6 +198,9 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
 		     (capability current-mailbox read-only flags))
   (luna-define-internal-accessors 'elmo-imap4-session))
 
+(defmacro elmo-imap4-session-capable-p (session capability)
+  `(memq ,capability (elmo-imap4-session-capability-internal ,session)))
+
 ;;; MIME-ELMO-IMAP Location
 (eval-and-compile
   (luna-define-class mime-elmo-imap-location
@@ -207,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*")
@@ -231,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."
@@ -260,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]<partial>."
-  (` (nth 3 (assq 'bodydetail (, response)))))
+  `(nth 3 (assq 'bodydetail ,response)))
 
 ;;; Session commands.
 
@@ -324,20 +327,18 @@ Returns a TAG string which is assigned to the COMMAND."
 				    cmdstr
 				    (elmo-imap4-format-quoted (nth 1 token)))))
 		     ((eq kind 'literal)
-		      (if (memq 'literal+
-				(elmo-imap4-session-capability-internal
-				 session))
+		      (if (elmo-imap4-session-capable-p session 'literal+)
 			  ;; 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))
@@ -355,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)
@@ -927,7 +926,8 @@ If CHOP-LENGTH is not specified, message set is not chopped."
 	(elmo-imap4-response-value element 'uid)
 	:size (elmo-imap4-response-value element 'rfc822size)))
      (elmo-imap4-response-value element 'flags)
-     app-data)))
+     app-data)
+    (elmo-progress-notify 'elmo-folder-msgdb-create)))
 
 (defun elmo-imap4-parse-capability (string)
   (if (string-match "^\\*\\(.*\\)$" string)
@@ -935,6 +935,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
@@ -981,8 +983,8 @@ If CHOP-LENGTH is not specified, message set is not chopped."
       ;; Skip garbage output from process before greeting.
       (while (and (memq (process-status process) '(open run))
 		  (goto-char (point-max))
-		  (forward-line -1)
-		  (not (elmo-imap4-parse-greeting)))
+		  (or (/= (forward-line -1) 0)
+		      (not (elmo-imap4-parse-greeting))))
 	(accept-process-output process 1))
       (erase-buffer)
       (set-process-filter process 'elmo-imap4-arrival-filter)
@@ -1003,8 +1005,7 @@ If CHOP-LENGTH is not specified, message set is not chopped."
       (when (eq (elmo-network-stream-type-symbol
 		 (elmo-network-session-stream-type-internal session))
 		'starttls)
-	(or (memq 'starttls
-		  (elmo-imap4-session-capability-internal session))
+	(or (elmo-imap4-session-capable-p session 'starttls)
 	    (signal 'elmo-open-error
 		    '(elmo-imap4-starttls-error)))
 	(elmo-imap4-send-command-wait session "starttls")
@@ -1122,7 +1123,7 @@ If CHOP-LENGTH is not specified, message set is not chopped."
 (luna-define-method elmo-network-setup-session ((session
 						 elmo-imap4-session))
   (with-current-buffer (elmo-network-session-buffer session)
-    (when (memq 'namespace (elmo-imap4-session-capability-internal session))
+    (when (elmo-imap4-session-capable-p session 'namespace)
       (setq elmo-imap4-server-namespace
 	    (elmo-imap4-response-value
 	     (elmo-imap4-send-command-wait session "namespace")
@@ -1234,7 +1235,7 @@ If CHOP-LENGTH is not specified, message set is not chopped."
 (defvar elmo-imap4-client-eol "\r\n"
   "The EOL string we send to the server.")
 
-(defvar elmo-imap4-display-literal-progress nil)
+(defvar elmo-imap4-literal-progress-reporter nil)
 
 (defun elmo-imap4-find-next-line ()
   "Return point at end of current line, taking into account literals.
@@ -1245,16 +1246,11 @@ Return nil if no complete line has arrived."
     (if (match-string 1)
 	(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
 	    (progn
-	      (if (and elmo-imap4-display-literal-progress
-		       (> (string-to-number (match-string 1))
-			  (min elmo-display-retrieval-progress-threshold 100)))
-		  (elmo-display-progress
-		   'elmo-imap4-display-literal-progress
-		   (format "Retrieving (%d/%d bytes)..."
-			   (- (point-max) (point))
-			   (string-to-number (match-string 1)))
-		   (/ (- (point-max) (point))
-		      (/ (string-to-number (match-string 1)) 100))))
+	      (when elmo-imap4-literal-progress-reporter
+		(elmo-progress-notify
+		 'elmo-retrieve-message
+		 :set (- (point-max) (point))
+		 :total (string-to-number (match-string 1))))
 	      nil)
 	  (goto-char (+ (point) (string-to-number (match-string 1))))
 	  (elmo-imap4-find-next-line))
@@ -1278,22 +1274,19 @@ Return nil if no complete line has arrived."
 	  (delete-backward-char (length elmo-imap4-server-eol))
 	  (goto-char (point-min))
 	  (unwind-protect
-	      (cond ((eq elmo-imap4-status 'initial)
-		     (setq elmo-imap4-current-response
-			   (list
-			    (list 'greeting (elmo-imap4-parse-greeting)))))
-		    ((or (eq elmo-imap4-status 'auth)
-			 (eq elmo-imap4-status 'nonauth)
-			 (eq elmo-imap4-status 'selected)
-			 (eq elmo-imap4-status 'examine))
-		     (setq elmo-imap4-current-response
-			   (cons
-			    (elmo-imap4-parse-response)
-			    elmo-imap4-current-response)))
-		    (t
-		     (message "Unknown state %s in arrival filter"
-			      elmo-imap4-status))))
-	  (delete-region (point-min) (point-max))))))))
+	      (case elmo-imap4-status
+		(initial
+		 (setq elmo-imap4-current-response
+		       (list
+			(list 'greeting (elmo-imap4-parse-greeting)))))
+		((auth nonauth selected examine)
+		 (setq elmo-imap4-current-response
+		       (cons (elmo-imap4-parse-response)
+			     elmo-imap4-current-response)))
+		(t
+		 (message "Unknown state %s in arrival filter"
+			  elmo-imap4-status)))
+	    (delete-region (point-min) (point-max)))))))))
 
 ;; IMAP parser.
 
@@ -1609,22 +1602,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
@@ -1635,12 +1629,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
@@ -1947,15 +1942,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)
@@ -2039,13 +2036,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
@@ -2092,8 +2089,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))
@@ -2102,7 +2100,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 "
@@ -2194,18 +2194,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))
@@ -2214,17 +2220,16 @@ If optional argument REMOVE is non-nil, remove FLAG."
 	(total 0)
 	(length (length from-msgs))
 	charset set-list end results)
-    (message "Searching...")
     (cond
      ((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))
@@ -2263,11 +2268,6 @@ If optional argument REMOVE is non-nil, remove FLAG."
 		   (elmo-date-get-datevec
 		    (elmo-filter-value filter)))))
 		'search)))
-	(when (> length elmo-display-progress-threshold)
-	  (setq total (+ total (car (car set-list))))
-	  (elmo-display-progress
-	   'elmo-imap4-search "Searching..."
-	   (/ (* total 100) length)))
 	(setq set-list (cdr set-list)
 	      end (null set-list)))
       results)
@@ -2315,11 +2315,6 @@ If optional argument REMOVE is non-nil, remove FLAG."
 		   (encode-mime-charset-string
 		    (elmo-filter-value filter) charset))))
 		'search)))
-	(when (> length elmo-display-progress-threshold)
-	  (setq total (+ total (car (car set-list))))
-	  (elmo-display-progress
-	   'elmo-imap4-search "Searching..."
-	   (/ (* total 100) length)))
 	(setq set-list (cdr set-list)
 	      end (null set-list)))
       results))))
@@ -2350,11 +2345,15 @@ If optional argument REMOVE is non-nil, remove FLAG."
 						condition &optional numbers)
   (if (elmo-folder-plugged-p folder)
       (save-excursion
-	(let ((session (elmo-imap4-get-session folder)))
+	(let ((session (elmo-imap4-get-session folder))
+	      ret)
+	  (message "Searching...")
 	  (elmo-imap4-session-select-mailbox
 	   session
 	   (elmo-imap4-folder-mailbox-internal folder))
-	  (elmo-imap4-search-internal folder session condition numbers)))
+	  (setq ret (elmo-imap4-search-internal folder session condition numbers))
+	  (message "Searching...done")
+	  ret))
     (luna-call-next-method)))
 
 (luna-define-method elmo-folder-msgdb-create-plugged
@@ -2368,53 +2367,45 @@ If optional argument REMOVE is non-nil, remove FLAG."
 	       "Message-Id" "References" "In-Reply-To")
 	     (mapcar #'capitalize (elmo-msgdb-extra-fields 'non-virtual)))))
 	  (total 0)
-	  (length (length numbers))
 	  print-length print-depth
 	  rfc2060 set-list)
-      (setq rfc2060 (memq 'imap4rev1
-			  (elmo-imap4-session-capability-internal
-			   session)))
-      (message "Getting overview...")
-      (elmo-imap4-session-select-mailbox
-       session (elmo-imap4-folder-mailbox-internal folder))
-      (setq set-list (elmo-imap4-make-number-set-list
-		      numbers
-		      elmo-imap4-overview-fetch-chop-length))
-      ;; Setup callback.
-      (with-current-buffer (elmo-network-session-buffer session)
-	(setq elmo-imap4-current-msgdb (elmo-make-msgdb)
-	      elmo-imap4-seen-messages nil
-	      elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
-	      elmo-imap4-fetch-callback-data (cons flag-table folder))
-	(while set-list
-	  (elmo-imap4-send-command-wait
-	   session
-	   ;; get overview entity from IMAP4
-	   (format "%sfetch %s (%s rfc822.size flags)"
-		   (if elmo-imap4-use-uid "uid " "")
-		   (cdr (car set-list))
-		   (if rfc2060
-		       (format "body.peek[header.fields %s]" headers)
-		     (format "%s" headers))))
-	  (when (> length elmo-display-progress-threshold)
-	    (setq total (+ total (car (car set-list))))
-	    (elmo-display-progress
-	     'elmo-imap4-msgdb-create "Getting overview..."
-	     (/ (* total 100) length)))
-	  (setq set-list (cdr set-list)))
-	(message "Getting overview...done")
-	(when elmo-imap4-seen-messages
-	  (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
-	;; cannot setup the global flag while retrieval.
-	(dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
-	  (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
-						   number)
-				 folder number
-				 (elmo-message-entity-field
-				  (elmo-msgdb-message-entity
-				   elmo-imap4-current-msgdb number)
-				  'message-id)))
-	elmo-imap4-current-msgdb))))
+      (setq rfc2060 (elmo-imap4-session-capable-p session 'imap4rev1))
+      (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+	  "Creating msgdb"
+	(elmo-imap4-session-select-mailbox
+	 session (elmo-imap4-folder-mailbox-internal folder))
+	(setq set-list (elmo-imap4-make-number-set-list
+			numbers
+			elmo-imap4-overview-fetch-chop-length))
+	;; Setup callback.
+	(with-current-buffer (elmo-network-session-buffer session)
+	  (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
+		elmo-imap4-seen-messages nil
+		elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
+		elmo-imap4-fetch-callback-data (cons flag-table folder))
+	  (while set-list
+	    (elmo-imap4-send-command-wait
+	     session
+	     ;; get overview entity from IMAP4
+	     (format "%sfetch %s (%s rfc822.size flags)"
+		     (if elmo-imap4-use-uid "uid " "")
+		     (cdr (car set-list))
+		     (if rfc2060
+			 (format "body.peek[header.fields %s]" headers)
+		       (format "%s" headers))))
+	    (setq set-list (cdr set-list)))
+	  (when elmo-imap4-seen-messages
+	    (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
+	  ;; cannot setup the global flag while retrieval.
+	  (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
+	    (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
+						     number)
+				   folder number
+				   (elmo-message-entity-field
+				    (elmo-msgdb-message-entity
+				     elmo-imap4-current-msgdb number)
+				    'message-id)))
+	  elmo-imap4-current-msgdb)))))
 
 (luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
 						  numbers flag)
@@ -2647,12 +2638,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))
@@ -2676,16 +2667,18 @@ If optional argument REMOVE is non-nil, remove FLAG."
 	  response (elmo-imap4-response-value response 'status))
     (elmo-imap4-response-value response 'uidnext)))
 
-(luna-define-method elmo-folder-append-messages :around
-  ((folder elmo-imap4-folder) src-folder numbers &optional same-number)
-  (if (and (eq (elmo-folder-type-internal src-folder) 'imap4)
-	   (elmo-imap4-identical-system-p folder src-folder)
-	   (elmo-folder-plugged-p folder))
+(defun elmo-folder-append-messages-imap4-imap4 (dst-folder
+						src-folder
+						numbers
+						same-number)
+  (if (and (elmo-imap4-identical-system-p dst-folder src-folder)
+	   (elmo-folder-plugged-p dst-folder))
       ;; Plugged
       (prog1
-	  (elmo-imap4-copy-messages src-folder folder numbers)
+	  (elmo-imap4-copy-messages src-folder dst-folder numbers)
 	(elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
-    (luna-call-next-method)))
+    (elmo-folder-append-messages dst-folder src-folder numbers same-number
+				 'elmo-folder-append-messages-imap4-imap4)))
 
 (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
 					      number)
@@ -2711,24 +2704,19 @@ If optional argument REMOVE is non-nil, remove FLAG."
     (with-current-buffer (elmo-network-session-buffer session)
       (setq elmo-imap4-fetch-callback nil)
       (setq elmo-imap4-fetch-callback-data nil))
-    (unless elmo-inhibit-display-retrieval-progress
-      (setq elmo-imap4-display-literal-progress t))
-    (unwind-protect
-	(setq response
-	      (elmo-imap4-send-command-wait session
-					    (format
-					     (if elmo-imap4-use-uid
-						 "uid fetch %s body%s[%s]"
-					       "fetch %s body%s[%s]")
-					     number
-					     (if unseen ".peek" "")
-					     (or section "")
-					     )))
-      (setq elmo-imap4-display-literal-progress nil))
-    (unless elmo-inhibit-display-retrieval-progress
-      (elmo-display-progress 'elmo-imap4-display-literal-progress
-			     "Retrieving..." 100)  ; remove progress bar.
-      (message "Retrieving...done"))
+    (elmo-with-progress-display (elmo-retrieve-message
+				 (elmo-message-field folder number :size)
+				 elmo-imap4-literal-progress-reporter)
+	"Retrieving"
+      (setq response
+	    (elmo-imap4-send-command-wait session
+					  (format
+					   (if elmo-imap4-use-uid
+					       "uid fetch %s body%s[%s]"
+					     "fetch %s body%s[%s]")
+					   number
+					   (if unseen ".peek" "")
+					   (or section "")))))
     (if (setq response (elmo-imap4-response-bodydetail-text
 			(elmo-imap4-response-value-all
 			 response 'fetch)))