X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-archive.el;h=274bde1c3ab960e88495e120dd12fc3277044ee8;hb=refs%2Fheads%2Fmaster;hp=b7e7b443a5b7f2cfd20475e3f19b5d9770bf5257;hpb=8619238b902483ab5daad292fff97bc70d4828f5;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el
index b7e7b44..274bde1 100644
--- a/elmo/elmo-archive.el
+++ b/elmo/elmo-archive.el
@@ -33,11 +33,10 @@
 
 ;;; Code:
 ;;
+(eval-when-compile (require 'cl))
 
+(require 'elmo)
 (require 'elmo-msgdb)
-(require 'emu)
-(require 'std11)
-(eval-when-compile (require 'elmo-localdir))
 
 ;;; User vars.
 (defvar elmo-archive-lha-dos-compatible
@@ -147,15 +146,15 @@
      (rar . "^[ \t]%s\\([0-9]+\\)$"))))
 
 (defvar elmo-archive-suffix-alist
-   '((lha . ".lzh")  ; default
-;;;  (lha . ".lzs")
-     (zip . ".zip")
-     (zoo . ".zoo")
-;;;  (arc . ".arc")
-;;;  (arj . ".arj")
-     (rar . ".rar")
-     (tar . ".tar")
-     (tgz . ".tar.gz")))
+  '((lha . ".lzh")			; default
+;;;     (lha . ".lzs")
+    (zip . ".zip")
+    (zoo . ".zoo")
+;;;     (arc . ".arc")
+;;;     (arj . ".arj")
+    (rar . ".rar")
+    (tar . ".tar")
+    (tgz . ".tar.gz")))
 
 ;;; lha
 (defvar elmo-archive-lha-method-alist
@@ -220,7 +219,7 @@
     '((ls    . ("gtar" "-tf"))
       (cat   . ("gtar" "-Oxf"))
       (ext   . ("gtar" "-xf"))
-;;;	(rm    . ("gtar" "--delete" "-f")) ;; well not work
+;;;      (rm    . ("gtar" "--delete" "-f")) ; well not work
       )))
 
 ;;; GNU tar (*.tar.gz, *.tar.Z, *.tar.bz2)
@@ -228,7 +227,7 @@
   '((ls         . ("gtar" "-ztf"))
     (cat        . ("gtar" "-Ozxf"))
     (create     . ("gtar" "-zcf"))
-;;; (rm         . elmo-archive-tgz-rm-func)
+;;;    (rm         . elmo-archive-tgz-rm-func)
     (cp         . elmo-archive-tgz-cp-func)
     (mv         . elmo-archive-tgz-mv-func)
     (ext        . ("gtar" "-zxf"))
@@ -236,17 +235,17 @@
     (decompress . ("gzip" "-d"))
     (compress   . ("gzip"))
     (append     . ("gtar" "-uf"))
-;;; (delete     . ("gtar" "--delete" "-f")) ; well not work
+;;;    (delete     . ("gtar" "--delete" "-f")) ; well not work
     ))
 
 (defvar elmo-archive-method-list
   '(elmo-archive-lha-method-alist
     elmo-archive-zip-method-alist
     elmo-archive-zoo-method-alist
-;;; elmo-archive-tar-method-alist
+;;;    elmo-archive-tar-method-alist
     elmo-archive-tgz-method-alist
-;;; elmo-archive-arc-method-alist
-;;; elmo-archive-arj-method-alist
+;;;    elmo-archive-arc-method-alist
+;;;    elmo-archive-arj-method-alist
     elmo-archive-rar-method-alist))
 
 ;;; Internal vars.
@@ -256,16 +255,13 @@
 
 ;;; Macro
 (defmacro elmo-archive-get-method (type action)
-  (` (cdr (assq (, action) (cdr (assq (, type)
-				      elmo-archive-method-alist))))))
+  `(cdr (assq ,action (cdr (assq ,type elmo-archive-method-alist)))))
 
 (defmacro elmo-archive-get-suffix (type)
-  (` (cdr (assq (, type)
-		elmo-archive-suffix-alist))))
+  `(cdr (assq ,type elmo-archive-suffix-alist)))
 
 (defmacro elmo-archive-get-regexp (type)
-  (` (cdr (assq (, type)
-		elmo-archive-file-regexp-alist))))
+  `(cdr (assq ,type elmo-archive-file-regexp-alist)))
 
 (defsubst elmo-archive-call-process (prog args &optional output)
   (= (apply 'call-process prog nil output nil args) 0))
@@ -307,7 +303,7 @@ TYPE specifies the archiver's symbol."
 	      (goto-char (point-min))))
 	  (while (and (re-search-forward file-regexp nil t)
 		      (not (eobp)))  ; for GNU tar 981010
-	    (setq file-list (nconc file-list (list (string-to-int
+	    (setq file-list (nconc file-list (list (string-to-number
 						    (match-string 1)))))))
       (error "%s does not exist" file))
     (if nonsort
@@ -432,20 +428,19 @@ TYPE specifies the archiver's symbol."
 	(error "WARNING: read-only mode: %s (method undefined)" type))
       (cond
        ((file-directory-p tmp-dir)
-	()) ;nop
+	())				; nop
        ((file-exists-p tmp-dir)
 	;; file exists
 	(error "Create directory failed; File \"%s\" exists" tmp-dir))
        (t
 	(elmo-make-directory tmp-dir)))
-      (elmo-bind-directory
-       tmp-dir
-       (write-region (point) (point) dummy nil 'no-msg)
-       (prog1
-	   (elmo-archive-call-method method args)
-	 (if (file-exists-p dummy)
-	     (delete-file dummy)))
-       ))))
+      (elmo-bind-directory tmp-dir
+	(write-region (point) (point) dummy nil 'no-msg)
+	(prog1
+	    (elmo-archive-call-method method args)
+	  (if (file-exists-p dummy)
+	      (delete-file dummy)))
+	))))
 
 (luna-define-method elmo-folder-delete ((folder elmo-archive-folder))
   (let ((msgs (and (elmo-folder-exists-p folder)
@@ -512,7 +507,7 @@ TYPE specifies the archiver's symbol."
 					  nil)))
 	     (regexp (format "^\\(.*\\)\\(%s\\)$"
 			     (mapconcat
-			      '(lambda (x) (regexp-quote (cdr x)))
+			      (lambda (x) (regexp-quote (cdr x)))
 			      elmo-archive-suffix-alist
 			      "\\|"))))
 	(if (string-match "\\(.*\\)/$" base-folder) ; ends with '/'.
@@ -522,29 +517,29 @@ TYPE specifies the archiver's symbol."
 	(delq
 	 nil
 	 (mapcar
-	  '(lambda (x)
-	     (when (and (string-match regexp x)
-			(eq suffix
-			    (car
-			     (rassoc (elmo-match-string 2 x)
-				     elmo-archive-suffix-alist))))
-	       (format "%s%s;%s%s"
-		       (elmo-folder-prefix-internal folder)
-		       (elmo-concat-path base-folder (elmo-match-string 1 x))
-		       suffix prefix)))
+	  (lambda (x)
+	    (when (and (string-match regexp x)
+		       (eq suffix
+			   (car
+			    (rassoc (elmo-match-string 2 x)
+				    elmo-archive-suffix-alist))))
+	      (format "%s%s;%s%s"
+		      (elmo-folder-prefix-internal folder)
+		      (elmo-concat-path base-folder (elmo-match-string 1 x))
+		      suffix prefix)))
 	  flist)))
     (elmo-mapcar-list-of-list
-     (function (lambda (x)
-		 (if (file-exists-p
-		      (expand-file-name
-		       (concat elmo-archive-basename
-			       (elmo-archive-get-suffix
-				(elmo-archive-folder-archive-type-internal
-				 folder)))
-		       (expand-file-name
-			x
-			(elmo-archive-folder-path folder))))
-		     (concat (elmo-folder-prefix-internal folder) x))))
+     (lambda (x)
+       (if (file-exists-p
+	    (expand-file-name
+	     (concat elmo-archive-basename
+		     (elmo-archive-get-suffix
+		      (elmo-archive-folder-archive-type-internal
+		       folder)))
+	     (expand-file-name
+	      x
+	      (elmo-archive-folder-path folder))))
+	   (concat (elmo-folder-prefix-internal folder) x)))
      (elmo-list-subdirectories
       (elmo-archive-folder-path folder)
       (or (elmo-archive-folder-dir-name-internal folder) "")
@@ -564,7 +559,7 @@ TYPE specifies the archiver's symbol."
 	 (prefix (elmo-archive-folder-archive-prefix-internal folder))
 	 (method (elmo-archive-get-method type 'cat))
 	 (args (list arc (elmo-concat-path
-			  prefix (int-to-string number)))))
+			  prefix (number-to-string number)))))
     (and (file-exists-p arc)
 	 (as-binary-process
 	  (elmo-archive-call-method method args t))
@@ -604,29 +599,29 @@ TYPE specifies the archiver's symbol."
 	  (elmo-make-directory (directory-file-name tmp-dir))))
       (setq newfile (elmo-concat-path
 		     prefix
-		     (int-to-string next-num)))
-      (unwind-protect
-	  (elmo-bind-directory
-	   tmp-dir
-	   (if (and (or (functionp method) (car method))
-		    (file-writable-p newfile))
-	       (progn
-		 (setq dst-buffer (current-buffer))
+		     (number-to-string next-num)))
+      (elmo-bind-directory tmp-dir
+	(if (and (or (functionp method) (car method))
+		 (file-writable-p newfile))
+	    (progn
+	      (setq dst-buffer (current-buffer))
+	      (with-current-buffer src-buffer
+		(copy-to-buffer dst-buffer (point-min) (point-max)))
+	      (as-binary-output-file
+	       (write-region (point-min) (point-max) newfile nil 'no-msg))
+	      (when (elmo-archive-call-method method (list arc newfile))
+		(elmo-folder-preserve-flags
+		 folder
 		 (with-current-buffer src-buffer
-		   (copy-to-buffer dst-buffer (point-min) (point-max)))
-		 (as-binary-output-file
-		  (write-region (point-min) (point-max) newfile nil 'no-msg))
-		 (when (elmo-archive-call-method method (list arc newfile))
-		   (elmo-folder-preserve-flags
-		    folder
-		    (with-current-buffer src-buffer
-		      (elmo-msgdb-get-message-id-from-buffer))
-		    flags)
-		   t))
-	     nil))))))
-
-(luna-define-method elmo-folder-append-messages :around
-  ((folder elmo-archive-folder) src-folder numbers &optional same-number)
+		   (elmo-msgdb-get-message-id-from-buffer))
+		 flags)
+		t))
+	  nil)))))
+
+(defun elmo-folder-append-messages-*-archive (folder
+					      src-folder
+					      numbers
+					      same-number)
   (let ((prefix (elmo-archive-folder-archive-prefix-internal folder)))
     (cond
      ((and same-number
@@ -634,9 +629,10 @@ TYPE specifies the archiver's symbol."
 	   (elmo-folder-message-file-p src-folder)
 	   (elmo-folder-message-file-number-p src-folder))
       ;; same-number(localdir, localnews) -> archive
-      (unless (elmo-archive-append-files folder
-					 (elmo-folder-message-file-directory src-folder)
-					 numbers)
+      (unless (elmo-archive-append-files
+	       folder
+	       (elmo-folder-message-file-directory src-folder)
+	       numbers)
 	(setq numbers nil))
       (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
       numbers)
@@ -650,33 +646,37 @@ TYPE specifies the archiver's symbol."
 						 folder))
 				 (car (elmo-folder-status folder)) 0)))))
 	    new-dir base-dir files)
-	(setq base-dir temp-dir)
-	(when (> (length prefix) 0)
-	  (when (file-name-directory prefix)
-	    (elmo-make-directory (file-name-directory prefix)))
-	  (rename-file
-	   temp-dir
-	   (setq new-dir
-		 (expand-file-name
-		  prefix
-		  ;; parent of temp-dir..(works in windows?)
-		  (expand-file-name ".." temp-dir))))
-	  ;; now temp-dir has name prefix.
-	  (setq temp-dir new-dir)
-	  ;; parent of prefix becomes base-dir.
-	  (setq base-dir (expand-file-name ".." temp-dir)))
-	(setq files
-	      (mapcar
-	       '(lambda (x) (elmo-concat-path prefix x))
-	       (directory-files temp-dir nil "^[^\\.]")))
-	(if (elmo-archive-append-files folder
-				       base-dir
-				       files)
-	    (elmo-delete-directory temp-dir)
-	  (setq numbers nil)))
+	(unwind-protect
+	    (progn
+	      (setq base-dir temp-dir)
+	      (when (> (length prefix) 0)
+		(when (file-name-directory prefix)
+		  (elmo-make-directory (file-name-directory prefix)))
+		(rename-file
+		 temp-dir
+		 (setq new-dir
+		       (expand-file-name
+			prefix
+			;; parent of temp-dir..(works in windows?)
+			(expand-file-name ".." temp-dir))))
+		;; now temp-dir has name prefix.
+		(setq temp-dir new-dir)
+		;; parent of prefix becomes base-dir.
+		(setq base-dir (expand-file-name ".." temp-dir)))
+	      (setq files
+		    (mapcar
+		     (lambda (x) (elmo-concat-path prefix x))
+		     (directory-files temp-dir nil "^[^\\.]")))
+	      (unless (elmo-archive-append-files folder
+						 base-dir
+						 files)
+		(setq numbers nil)))
+	  (elmo-delete-directory temp-dir)))
       (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
       numbers)
-     (t (luna-call-next-method)))))
+     (t
+      (elmo-folder-append-messages folder src-folder numbers same-number
+				   'elmo-folder-append-messages-*-archive)))))
 
 (luna-define-method elmo-folder-message-make-temp-file-p
   ((folder elmo-archive-folder))
@@ -701,25 +701,24 @@ TYPE specifies the archiver's symbol."
 	 (n-method (elmo-archive-get-method type 'ext))
 	 (tmp-msgs (mapcar (lambda (x) (elmo-concat-path
 					prefix
-					(int-to-string x))) numbers))
+					(number-to-string x))) numbers))
 	 number)
     ;; Expand files in the tmp-dir-src.
-    (elmo-bind-directory
-     tmp-dir-src
-     (cond
-      ((functionp n-method)
-       (funcall n-method (cons arc tmp-msgs)))
-      (p-method
-       (let ((p-prog (car p-method))
-	     (p-prog-arg (cdr p-method)))
-	 (elmo-archive-exec-msgs-subr1
-	  p-prog (append p-prog-arg (list arc)) tmp-msgs)))
-      (t
-       (let ((n-prog (car n-method))
-	     (n-prog-arg (cdr n-method)))
-	 (elmo-archive-exec-msgs-subr2
-	  n-prog (append n-prog-arg (list arc)) tmp-msgs
-	  (length arc))))))
+    (elmo-bind-directory tmp-dir-src
+      (cond
+       ((functionp n-method)
+	(funcall n-method (cons arc tmp-msgs)))
+       (p-method
+	(let ((p-prog (car p-method))
+	      (p-prog-arg (cdr p-method)))
+	  (elmo-archive-exec-msgs-subr1
+	   p-prog (append p-prog-arg (list arc)) tmp-msgs)))
+       (t
+	(let ((n-prog (car n-method))
+	      (n-prog-arg (cdr n-method)))
+	  (elmo-archive-exec-msgs-subr2
+	   n-prog (append n-prog-arg (list arc)) tmp-msgs
+	   (length arc))))))
     ;; Move files to the tmp-dir-dst.
     (setq number start-number)
     (dolist (tmp-file tmp-msgs)
@@ -728,7 +727,7 @@ TYPE specifies the archiver's symbol."
 		    tmp-dir-src)
 		   (expand-file-name
 		    (if start-number
-			(int-to-string number)
+			(number-to-string number)
 		      (file-name-nondirectory tmp-file))
 		    tmp-dir-dst))
       (if start-number (incf number)))
@@ -750,32 +749,32 @@ TYPE specifies the archiver's symbol."
       (ding)
       (error "WARNING: read-only mode: %s (method undefined)" dst-type))
     (save-excursion
-      (elmo-bind-directory
-       dir
-       (cond
-	((functionp n-method)
-	 (funcall n-method (cons arc files)))
-	(p-method
-	 (let ((p-prog (car p-method))
-	       (p-prog-arg (cdr p-method)))
-	   (elmo-archive-exec-msgs-subr1
-	    p-prog (append p-prog-arg (list arc)) files)))
-	(t
-	 (let ((n-prog (car n-method))
-	       (n-prog-arg (cdr n-method)))
-	   (elmo-archive-exec-msgs-subr2
-	    n-prog (append n-prog-arg (list arc)) files (length arc)))))))))
-
-(luna-define-method elmo-folder-delete-messages ((folder elmo-archive-folder)
-						 numbers)
+      (elmo-bind-directory dir
+	(cond
+	 ((functionp n-method)
+	  (funcall n-method (cons arc files)))
+	 (p-method
+	  (let ((p-prog (car p-method))
+		(p-prog-arg (cdr p-method)))
+	    (elmo-archive-exec-msgs-subr1
+	     p-prog (append p-prog-arg (list arc)) files)))
+	 (t
+	  (let ((n-prog (car n-method))
+		(n-prog-arg (cdr n-method)))
+	    (elmo-archive-exec-msgs-subr2
+	     n-prog (append n-prog-arg (list arc)) files (length arc)))))))))
+
+(luna-define-method elmo-folder-delete-messages-internal ((folder
+							   elmo-archive-folder)
+							  numbers)
   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 	 (prefix (elmo-archive-folder-archive-prefix-internal folder))
 	 (arc (elmo-archive-get-archive-name folder))
 	 (p-method (elmo-archive-get-method type 'rm-pipe))
 	 (n-method (elmo-archive-get-method type 'rm))
-	 (numbers (mapcar '(lambda (x) (elmo-concat-path
-					prefix
-					(int-to-string x)))
+	 (numbers (mapcar (lambda (x) (elmo-concat-path
+				       prefix
+				       (number-to-string x)))
 			  numbers)))
     (cond ((functionp n-method)
 	   (funcall n-method (cons arc numbers)))
@@ -808,20 +807,22 @@ TYPE specifies the archiver's symbol."
     (setq sum 0)
     (catch 'done
       (while (and rest (<= i n))
-	(mapcar '(lambda (x)
-		   (let* ((len (length x))
-			  (files (member x (reverse rest))))
-		     ;; total(previous) + current + white space
-		     (if (<= max-len (+ sum len 1))
-			 (progn
-			   (unless
-			       (elmo-archive-call-process
-				prog (append args files))
-			     (throw 'done nil))
-			   (setq sum 0) ;; reset
-			   (setq rest (nthcdr i rest)))
-		       (setq sum (+ sum len 1)))
-		     (setq i (1+ i)))) msgs))
+	(mapc
+	 (lambda (x)
+	   (let* ((len (length x))
+		  (files (member x (reverse rest))))
+	     ;; total(previous) + current + white space
+	     (if (<= max-len (+ sum len 1))
+		 (progn
+		   (unless
+		       (elmo-archive-call-process
+			prog (append args files))
+		     (throw 'done nil))
+		   (setq sum 0) ;; reset
+		   (setq rest (nthcdr i rest)))
+	       (setq sum (+ sum len 1)))
+	     (setq i (1+ i))))
+	 msgs))
       (throw 'done
 	     (or (not rest)
 		 (elmo-archive-call-process prog (append args rest))))
@@ -916,7 +917,7 @@ TYPE specifies the archiver's symbol."
 					    method
 					    archive number type
 					    &optional prefix)
-  (let* ((msg (elmo-concat-path prefix (int-to-string number)))
+  (let* ((msg (elmo-concat-path prefix (number-to-string number)))
 	 (arg-list (list archive msg)))
     (when (elmo-archive-article-exists-p archive msg type)
       ;; insert article.
@@ -928,25 +929,24 @@ TYPE specifies the archiver's symbol."
 					      numbers flag-table)
   (when numbers
     (save-excursion ;; 981005
-      (if (and elmo-archive-use-izip-agent
-	       (elmo-archive-get-method
-		(elmo-archive-folder-archive-type-internal folder)
-		'cat-headers))
-	  (elmo-archive-msgdb-create-as-numlist-subr2
-	   folder numbers flag-table)
-	(elmo-archive-msgdb-create-as-numlist-subr1
-	 folder numbers flag-table)))))
+      (elmo-with-progress-display (elmo-folder-create-msgdb (length numbers))
+	  "Creating msgdb"
+	(if (and elmo-archive-use-izip-agent
+		 (elmo-archive-get-method
+		  (elmo-archive-folder-archive-type-internal folder)
+		  'cat-headers))
+	    (elmo-archive-msgdb-create-as-numlist-subr2
+	     folder numbers flag-table)
+	  (elmo-archive-msgdb-create-as-numlist-subr1
+	   folder numbers flag-table))))))
 
 (defun elmo-archive-msgdb-create-as-numlist-subr1 (folder numlist flag-table)
   (let* ((type (elmo-archive-folder-archive-type-internal folder))
 	 (file (elmo-archive-get-archive-name folder))
 	 (method (elmo-archive-get-method type 'cat))
 	 (new-msgdb (elmo-make-msgdb))
-	 entity i percent num message-id flags)
+	 entity message-id flags)
     (with-temp-buffer
-      (setq num (length numlist))
-      (setq i 0)
-      (message "Creating msgdb...")
       (while numlist
 	(erase-buffer)
 	(setq entity
@@ -959,14 +959,8 @@ TYPE specifies the archiver's symbol."
 		flags (elmo-flag-table-get flag-table message-id))
 	  (elmo-global-flags-set flags folder (car numlist) message-id)
 	  (elmo-msgdb-append-entity new-msgdb entity flags))
-	(when (> num elmo-display-progress-threshold)
-	  (setq i (1+ i))
-	  (setq percent (/ (* i 100) num))
-	  (elmo-display-progress
-	   'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
-	   percent))
+	(elmo-progress-notify 'elmo-folder-msgdb-create)
 	(setq numlist (cdr numlist)))
-      (message "Creating msgdb...done")
       new-msgdb)))
 
 ;;; info-zip agent
@@ -982,11 +976,8 @@ TYPE specifies the archiver's symbol."
 	 (args (cdr method))
 	 (arc (elmo-archive-get-archive-name folder))
 	 (new-msgdb (elmo-make-msgdb))
-	 n i percent num msgs case-fold-search)
+	 n msgs case-fold-search)
     (with-temp-buffer
-      (setq num (length numlist))
-      (setq i 0)
-      (message "Creating msgdb...")
       (while numlist
 	(setq n (min (1- elmo-archive-fetch-headers-volume)
 		     (1- (length numlist))))
@@ -996,9 +987,9 @@ TYPE specifies the archiver's symbol."
 	(insert
 	 (mapconcat
 	  'concat
-	  (mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
+	  (mapcar (lambda (x) (elmo-concat-path prefix (number-to-string x)))
+		  msgs)
 	  "\n"))
-	(message "Fetching headers...")
 	(as-binary-process (apply 'call-process-region
 				  (point-min) (point-max)
 				  prog t t nil (append args (list arc))))
@@ -1008,18 +999,13 @@ TYPE specifies the archiver's symbol."
 	  (elmo-msgdb-append
 	   new-msgdb
 	   (elmo-archive-parse-mmdf folder msgs flag-table)))
-;;; 	 ((looking-at delim2)	;; UNIX MAIL
+;;; 	 ((looking-at delim2)		; UNIX MAIL
 ;;; 	  (elmo-msgdb-append
 ;;; 	   new-msgdb
 ;;; 	   (elmo-archive-parse-unixmail msgs flag-table)))
 	 (t			;; unknown format
 	  (error "Unknown format!")))
-	(when (> num elmo-display-progress-threshold)
-	  (setq i (+ n i))
-	  (setq percent (/ (* i 100) num))
-	  (elmo-display-progress
-	   'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
-	   percent))))
+	(elmo-progress-notify 'elmo-folder-msgdb-create)))
     new-msgdb))
 
 (defun elmo-archive-parse-mmdf (folder msgs flag-table)
@@ -1059,39 +1045,31 @@ TYPE specifies the archiver's symbol."
     (let* ((type (elmo-archive-folder-archive-type-internal folder))
 	   (arc (elmo-archive-get-archive-name folder))
 	   (method (elmo-archive-get-method type 'cat))
-	   (args (list arc (elmo-concat-path prefix (int-to-string number)))))
+	   (args (list arc (elmo-concat-path prefix (number-to-string number)))))
       (elmo-set-work-buf
-       (when (file-exists-p arc)
-	 (as-binary-process
-	  (elmo-archive-call-method method args t))
-	 (set-buffer-multibyte default-enable-multibyte-characters)
-	 (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
-	 (elmo-buffer-field-condition-match condition number number-list))))))
+	(when (file-exists-p arc)
+	  (as-binary-process
+	   (elmo-archive-call-method method args t))
+	  (set-buffer-multibyte default-enable-multibyte-characters)
+	  (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
+	  (elmo-message-buffer-match-condition condition number))))))
 
 (luna-define-method elmo-folder-search ((folder elmo-archive-folder)
 					condition &optional from-msgs)
-  (let* (;;(args (elmo-string-to-list key))
-	 ;; XXX: I don't know whether `elmo-archive-list-folder'
-	 ;;      updates match-data.
-	 ;; (msgs (or from-msgs (elmo-archive-list-folder spec)))
+  (let* ((case-fold-search nil)
+;;;	 (args (elmo-string-to-list key))
+;;; XXX: I don't know whether `elmo-archive-list-folder' updates match-data.
+;;;	 (msgs (or from-msgs (elmo-archive-list-folder spec)))
 	 (msgs (or from-msgs (elmo-folder-list-messages folder)))
-	 (num (length msgs))
-	 (i 0)
-	 (case-fold-search nil)
-	 number-list ret-val)
-    (setq number-list msgs)
-    (while msgs
-      (if (elmo-archive-field-condition-match
-	   folder (car msgs) number-list
-	   condition
-	   (elmo-archive-folder-archive-prefix-internal folder))
-	  (setq ret-val (cons (car msgs) ret-val)))
-      (when (> num elmo-display-progress-threshold)
-	(setq i (1+ i))
-	(elmo-display-progress
-	 'elmo-archive-search "Searching..."
-	 (/ (* i 100) num)))
-      (setq msgs (cdr msgs)))
+	 ret-val)
+    (elmo-with-progress-display (elmo-folder-search (length msgs)) "Searching"
+      (dolist (number msgs)
+	(when (elmo-archive-field-condition-match
+	       folder number msgs
+	       condition
+	       (elmo-archive-folder-archive-prefix-internal folder))
+	  (setq ret-val (cons number ret-val)))
+	(elmo-progress-notify 'elmo-folder-search)))
     (nreverse ret-val)))
 
 ;;; method(alist)