* 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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.")