From: hmurata <hmurata>
Date: Sat, 6 Sep 2003 10:12:20 +0000 (+0000)
Subject: * elmo-util.el (elmo-with-progress-display): New macro.
X-Git-Tag: wl-2_11_11~10
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=707bdddbcbc93ae6557dceb3ff8eec1e7342acfe;p=elisp%2Fwanderlust.git

* elmo-util.el (elmo-with-progress-display): New macro.

* elmo-localdir.el (elmo-folder-pack-numbers): Rewrite.
---

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index 2c8db2d..b593fbe 100644
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,9 @@
+2003-09-06  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+	* elmo-util.el (elmo-with-progress-display): New macro.
+
+	* elmo-localdir.el (elmo-folder-pack-numbers): Rewrite.
+
 2003-09-05  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
 	* elmo-shimbun.el (elmo-shimbun-folder-entity-hash): Use
diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el
index 7ebcf1c..e128a3f 100644
--- a/elmo/elmo-localdir.el
+++ b/elmo/elmo-localdir.el
@@ -339,48 +339,30 @@
 (luna-define-method elmo-folder-pack-numbers ((folder elmo-localdir-folder))
   (let* ((dir (elmo-localdir-folder-directory-internal folder))
 	 (msgdb (elmo-folder-msgdb folder))
-	 (onum-alist (elmo-msgdb-get-number-alist msgdb))
-	 (omark-alist (elmo-msgdb-get-mark-alist msgdb))
-	 (new-number 1)			; first ordinal position in localdir
-	 flist onum mark new-mark-alist total)
-    (setq flist
-	  (if elmo-pack-number-check-strict
-	      (elmo-folder-list-messages folder) ; allow localnews
-	    (mapcar 'car onum-alist)))
-    (setq total (length flist))
-    (while flist
-      (when (> total elmo-display-progress-threshold)
-	(elmo-display-progress
-	 'elmo-folder-pack-numbers "Packing..."
-	 (/ (* new-number 100) total)))
-      (setq onum (car flist))
-      (when (not (eq onum new-number))		; why \=() is wrong..
-	(elmo-bind-directory
-	 dir
-	 ;; xxx  nfs,hardlink
-	 (rename-file (int-to-string onum) (int-to-string new-number) t))
-	;; update overview
-	(elmo-msgdb-overview-entity-set-number
-	 (elmo-msgdb-overview-get-entity onum msgdb)
-	 new-number)
-	;; update number-alist
-	(and (assq onum onum-alist)
-	     (setcar (assq onum onum-alist) new-number)))
-      ;; update mark-alist
-      (when (setq mark (cadr (assq onum omark-alist)))
-	(setq new-mark-alist
-	      (elmo-msgdb-mark-append
-	       new-mark-alist
-	       new-number mark)))
-      (setq new-number (1+ new-number))
-      (setq flist (cdr flist)))
+	 (new-msgdb (elmo-make-msgdb))
+	 (numbers (elmo-folder-list-messages
+		   folder
+		   (not elmo-pack-number-check-strict)))
+	 (new-number 1)		  ; first ordinal position in localdir
+	 total entity)
+    (elmo-msgdb-set-path new-msgdb (elmo-folder-msgdb-path folder))
+    (setq total (length numbers))
+    (elmo-with-progress-display (> total elmo-display-progress-threshold)
+	(elmo-folder-pack-numbers total "Packing...")
+      (dolist (old-number numbers)
+	(setq entity (elmo-msgdb-message-entity msgdb old-number))
+	(when (not (eq old-number new-number)) ; why \=() is wrong..
+	  (elmo-bind-directory
+	   dir
+	   ;; xxx  nfs,hardlink
+	   (rename-file (int-to-string old-number)
+			(int-to-string new-number) t))
+	  (elmo-msgdb-overview-entity-set-number entity new-number))
+	(elmo-msgdb-append-entity new-msgdb entity
+				  (elmo-msgdb-get-mark msgdb old-number))
+	(setq new-number (1+ new-number))))
     (message "Packing...done")
-    (elmo-folder-set-msgdb-internal
-     folder
-     (elmo-make-msgdb
-      (elmo-msgdb-get-overview msgdb)
-      onum-alist
-      new-mark-alist))))
+    (elmo-folder-set-msgdb-internal folder new-msgdb)))
 
 (luna-define-method elmo-folder-message-file-p ((folder elmo-localdir-folder))
   t)
diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index d63c538..0f3a5b2 100644
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -1222,6 +1222,23 @@ If optional DELETE-FUNCTION is speficied, it is used as delete procedure."
 	(when (>= new-rate 100)
 	  (elmo-progress-clear label))))))
 
+(put 'elmo-with-progress-display 'lisp-indent-function '2)
+(def-edebug-spec elmo-with-progress-display
+  (form (symbolp form &rest form) &rest form))
+
+(defmacro elmo-with-progress-display (condition spec &rest body)
+  "Evaluate BODY with progress gauge if CONDITION is non-nil.
+SPEC is a list as followed (LABEL MAX-VALUE [FORMAT])."
+  (let ((label (car spec))
+	(max-value (cadr spec))
+	(fmt (caddr spec)))
+    `(unwind-protect
+	 (progn
+	   (when ,condition
+	     (elmo-progress-set (quote ,label) ,max-value ,fmt))
+	   ,@body)
+       (elmo-progress-clear (quote ,label)))))
+
 (defun elmo-time-expire (before-time diff-time)
   (let* ((current (current-time))
 	 (rest (when (< (nth 1 current) (nth 1 before-time))
diff --git a/elmo/elmo.el b/elmo/elmo.el
index 241cfdd..9f5e2e1 100644
--- a/elmo/elmo.el
+++ b/elmo/elmo.el
@@ -408,7 +408,7 @@ Caller should make sure FOLDER is `writable'.
 SRC-FOLDER is the source ELMO folder structure.
 NUMBERS is the message numbers to be appended in the SRC-FOLDER.
 If second optional argument SAME-NUMBER is specified,
-message number is preserved (if possible).")
+message number is preserved \(if possible\).")
 
 (luna-define-generic elmo-folder-pack-numbers (folder)
   "Pack message numbers of FOLDER.")