Index: elmo-imap4.el
===================================================================
RCS file: /cvs/root/wanderlust/elmo/elmo-imap4.el,v
retrieving revision 1.149
diff -u -r1.149 elmo-imap4.el
--- elmo-imap4.el	29 Apr 2006 15:00:04 -0000	1.149
+++ elmo-imap4.el	5 Jun 2006 11:54:32 -0000
@@ -89,6 +89,9 @@
 (defvar elmo-imap4-use-cache t
   "Use cache in imap4 folder.")
 
+(defvar elmo-imap4-use-multiappend t
+  "Use multiappend (rfc3502).")
+
 (defvar elmo-imap4-extra-namespace-alist
   '(("^\\({.*/nntp}\\).*$" . ".")) ; Default is for UW's remote nntp mailbox...
   "Extra namespace alist.
@@ -1129,7 +1132,7 @@
 	     'namespace)))))
 
 (defun elmo-imap4-setup-send-buffer (&optional string)
-  (let ((send-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*"))
+  (let ((send-buf (generate-new-buffer " *elmo-imap4-setup-send-buffer*"))
 	(source-buf (unless string (current-buffer))))
     (save-excursion
       (save-match-data
@@ -2155,6 +2158,87 @@
       (setq set-list (cdr set-list)))
     succeeds))
 
+(defun elmo-imap4-multiappend-messages (folder src-folder numbers)
+  (unless (elmo-folder-plugged-p folder)
+    (error "Unplgged"))
+  (let ((session (elmo-imap4-get-session folder))
+	(command (list
+		  "append "
+		  (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
+				       folder))))
+	flags-list succeeds result send-buffer-list)
+    (unwind-protect
+	(progn
+	  (setq succeeds
+		(let ((append-function
+		       (lambda (folder flags)
+			 (let ((send-buffer (elmo-imap4-setup-send-buffer)))
+			   (setq send-buffer-list (append send-buffer-list (list send-buffer)))
+			   (setq command (append
+					  command
+					  (list
+					   (if (and flags (elmo-folder-use-flag-p folder))
+					       (concat " (" (elmo-imap4-flags-to-imap flags) ") ")
+					     " () ")
+					 (elmo-imap4-buffer-literal send-buffer)))))
+			 (setq flags-list (append flags-list
+						  (list (cons (elmo-msgdb-get-message-id-from-buffer) flags)))))))
+		  ;; XXX: copied from elmo-generic-folder-append-messages
+		  (let ((src-msgdb-exists (not (zerop (elmo-folder-length src-folder))))
+			unseen table
+			succeed-numbers failure cache id)
+		    (setq table (elmo-folder-flag-table folder))
+		    (with-temp-buffer
+		      (set-buffer-multibyte nil)
+		      (while numbers
+			(setq failure nil
+			      id (and src-msgdb-exists
+				      (elmo-message-field src-folder (car numbers)
+							  'message-id)))
+			(condition-case nil
+			    (setq cache (elmo-file-cache-get id)
+				  failure
+				  (not
+				   (and
+				    (elmo-message-fetch
+				     src-folder (car numbers)
+				     (if (elmo-folder-plugged-p src-folder)
+					 (elmo-make-fetch-strategy
+					  'entire 'maybe nil
+					  (and cache (elmo-file-cache-path cache)))
+				       (or (and elmo-enable-disconnected-operation
+						cache
+						(eq (elmo-file-cache-status cache) 'entire)
+						(elmo-make-fetch-strategy
+						 'entire t nil
+						 (elmo-file-cache-path cache)))
+					   (error "Unplugged")))
+				     'unread)
+				    (> (buffer-size) 0)
+				    (apply
+				     append-function
+				     folder
+				     (elmo-message-flags-for-append src-folder (car numbers))
+				     nil))))
+			  (error (setq failure t)))
+			;; FETCH & APPEND finished
+			(unless failure
+			  (setq succeed-numbers (cons (car numbers) succeed-numbers)))
+			(elmo-progress-notify 'elmo-folder-move-messages)
+			(setq numbers (cdr numbers)))
+		      (when (elmo-folder-persistent-p folder)
+			(elmo-folder-close-flag-table folder))
+		      succeed-numbers))))
+	  (elmo-imap4-session-select-mailbox session
+					     (elmo-imap4-folder-mailbox-internal
+					      folder))
+	  (setq result (elmo-imap4-send-command-wait session command)))
+      (dolist (buffer send-buffer-list) (kill-buffer buffer)))
+    (when result
+      (dolist (flags flags-list)
+	(elmo-folder-preserve-flags folder (car flags) (cdr flags)))
+      succeeds)))
+
 (defun elmo-imap4-set-flag (folder numbers flag &optional remove)
   "Set flag on messages.
 FOLDER is the ELMO folder structure.
@@ -2677,14 +2761,24 @@
 
 (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))
-      ;; Plugged
-      (prog1
-	  (elmo-imap4-copy-messages src-folder folder numbers)
-	(elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
-    (luna-call-next-method)))
+  (cond ((and (eq (elmo-folder-type-internal src-folder) 'imap4)
+	      (elmo-imap4-identical-system-p folder src-folder)
+	      (elmo-folder-plugged-p folder))
+	 ;; Plugged and same system
+	 (prog1
+	     (elmo-imap4-copy-messages src-folder folder numbers)
+	   (elmo-progress-notify 'elmo-folder-move-messages (length numbers))))
+	((and (elmo-folder-plugged-p folder)
+	      elmo-imap4-use-multiappend
+	      (memq 'multiappend
+		    (elmo-imap4-session-capability-internal
+		     (elmo-imap4-get-session folder))))
+	 ;; Plugged and MULTIAPPEND (rfc3502) is available
+	 (prog1
+	     (elmo-imap4-multiappend-messages folder src-folder numbers)
+	   (elmo-progress-notify 'elmo-folder-move-messages (length numbers))))
+	(t
+	 (luna-call-next-method))))
 
 (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
 					      number)
