From: 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/cgi-bin/gitweb.cgi?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 + + * elmo-util.el (elmo-with-progress-display): New macro. + + * elmo-localdir.el (elmo-folder-pack-numbers): Rewrite. + 2003-09-05 Hiroya Murata * 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.")