* elmo-util.el (elmo-progress-counter-alist): New internal

variable.
(elmo-progress-counter-value): New macro.
(elmo-progress-counter-all-value): Ditto.
(elmo-progress-counter-format): Ditto.
(elmo-progress-counter-set-value): Ditto.
(elmo-progress-set): New function.
(elmo-progress-clear): Ditto.
(elmo-progress-notify): Ditto.

* elmo-pipe.el (elmo-pipe-drain): Setup and clear progress
counter.

* elmo.el (elmo-generic-folder-append-messages): Call
`elmo-progress-notify'.
(elmo-folder-move-messages): Don't call `elmo-display-progress'.

* elmo-archive.el (elmo-folder-append-messages): Call
`elmo-progress-notify'.

* elmo-imap4.el (elmo-folder-append-messages): Ditto.

* elmo-localdir.el (elmo-folder-append-messages): Ditto.

* elmo-maildir.el (elmo-folder-append-messages): Ditto.

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index d2e07a3..9f2d3f2 100644 (file)
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,31 @@
+2001-10-06  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+       * elmo-util.el (elmo-progress-counter-alist): New internal
+       variable.
+       (elmo-progress-counter-value): New macro.
+       (elmo-progress-counter-all-value): Ditto.
+       (elmo-progress-counter-format): Ditto.
+       (elmo-progress-counter-set-value): Ditto.
+       (elmo-progress-set): New function.
+       (elmo-progress-clear): Ditto.
+       (elmo-progress-notify): Ditto.
+
+       * elmo-pipe.el (elmo-pipe-drain): Setup and clear progress
+       counter.
+
+       * elmo.el (elmo-generic-folder-append-messages): Call
+       `elmo-progress-notify'.
+       (elmo-folder-move-messages): Don't call `elmo-display-progress'.
+
+       * elmo-archive.el (elmo-folder-append-messages): Call
+       `elmo-progress-notify'.
+
+       * elmo-imap4.el (elmo-folder-append-messages): Ditto.
+
+       * elmo-localdir.el (elmo-folder-append-messages): Ditto.
+
+       * elmo-maildir.el (elmo-folder-append-messages): Ditto.
+
 2001-10-03  Yuuichi Teranishi  <teranisi@gohome.org>
 
        * elmo-dop.el (elmo-dop-queue-method-name-alist): Fixed 'Encache' and

diff --git a/elmo/elmo-archive.el b/elmo/elmo-archive.el
index eb3e895..767ebb7 100644 (file)
--- a/elmo/elmo-archive.el
+++ b/elmo/elmo-archive.el
@@ -594,51 +594,53 @@ TYPE specifies the archiver's symbol."
   ((folder elmo-archive-folder) src-folder numbers unread-marks
    &optional same-number)
   (let ((prefix (elmo-archive-folder-archive-prefix-internal folder)))
-  (cond
-   ((and same-number
-        (null prefix)
-        (elmo-folder-message-file-p src-folder)
-        (elmo-folder-message-file-number-p src-folder))
-    ;; same-number(localdir, localnews) -> archive
-    (elmo-archive-append-files folder
-                              (elmo-folder-message-file-directory src-folder)
-                              numbers)
-    numbers)
-   ((elmo-folder-message-make-temp-file-p src-folder)
-    ;; not-same-number (localdir, localnews), (archive maildir) -> archive
-    (let ((temp-dir (elmo-folder-message-make-temp-files
-                    src-folder
-                    numbers
-                    (unless same-number
-                      (1+ (if (file-exists-p (elmo-archive-get-archive-name
-                                              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)))
-    numbers)
-   (t (luna-call-next-method)))))
+    (cond
+     ((and same-number
+          (null prefix)
+          (elmo-folder-message-file-p src-folder)
+          (elmo-folder-message-file-number-p src-folder))
+      ;; same-number(localdir, localnews) -> archive
+      (elmo-archive-append-files folder
+                                (elmo-folder-message-file-directory src-folder)
+                                numbers)
+      (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
+      numbers)
+     ((elmo-folder-message-make-temp-file-p src-folder)
+      ;; not-same-number (localdir, localnews), (archive maildir) -> archive
+      (let ((temp-dir (elmo-folder-message-make-temp-files
+                      src-folder
+                      numbers
+                      (unless same-number
+                        (1+ (if (file-exists-p (elmo-archive-get-archive-name
+                                                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)))
+      (elmo-progress-notify 'elmo-folder-move-messages (length numbers))
+      numbers)
+     (t (luna-call-next-method)))))
 
 (luna-define-method elmo-folder-message-make-temp-file-p
   ((folder elmo-archive-folder))

diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index 3bdc212..eb9ff61 100644 (file)
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -2422,7 +2422,9 @@ If optional argument REMOVE is non-nil, remove FLAG."
           (elmo-imap4-identical-system-p folder src-folder)
           (elmo-folder-plugged-p folder))
       ;; Plugged
-      (elmo-imap4-copy-messages src-folder folder numbers)
+      (prog1
+         (elmo-imap4-copy-messages src-folder folder numbers)
+       (elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
     (luna-call-next-method)))
 
 (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)

diff --git a/elmo/elmo-localdir.el b/elmo/elmo-localdir.el
index 7769c2b..7d7a917 100644 (file)
--- a/elmo/elmo-localdir.el
+++ b/elmo/elmo-localdir.el
@@ -225,11 +225,9 @@
        (point-min) (point-max) filename nil 'no-msg)
       t)))
 
-(luna-define-method elmo-folder-append-messages :around ((folder
-                                                         elmo-localdir-folder)
-                                                        src-folder numbers
-                                                        unread-marks
-                                                        &optional same-number)
+(luna-define-method elmo-folder-append-messages :around
+  ((folder elmo-localdir-folder)
+   src-folder numbers unread-marks &optional same-number)
   (if (elmo-folder-message-file-p src-folder)
       (let ((dir (elmo-localdir-folder-directory-internal folder))
            (succeeds numbers)
@@ -241,6 +239,7 @@
            (int-to-string
             (if same-number (car numbers) next-num))
            dir))
+         (elmo-progress-notify 'elmo-folder-move-messages)
          (if (and (setq numbers (cdr numbers))
                   (not same-number))
              (setq next-num

diff --git a/elmo/elmo-maildir.el b/elmo/elmo-maildir.el
index 7e3bf1c..6ce2367 100644 (file)
--- a/elmo/elmo-maildir.el
+++ b/elmo/elmo-maildir.el
@@ -403,7 +403,8 @@ file name for maildir directories."
           filename
           (expand-file-name
            (concat "new/" (file-name-nondirectory filename))
-           dir)))
+           dir))
+         (elmo-progress-notify 'elmo-folder-move-messages))
        succeeds)
     (luna-call-next-method)))
 

diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el
index a6a1933..7d212e6 100644 (file)
--- a/elmo/elmo-pipe.el
+++ b/elmo/elmo-pipe.el
@@ -97,10 +97,17 @@
 
 (defun elmo-pipe-drain (src dst)
   "Move all messages of SRC to DST."
-  (let ((elmo-inhibit-number-mapping t)) ; No need to use UIDL
+  (let ((elmo-inhibit-number-mapping t) ; No need to use UIDL
+       msgs len)
     (message "Checking %s..." (elmo-folder-name-internal src))
     (elmo-folder-open-internal src)
-    (elmo-folder-move-messages src (elmo-folder-list-messages src) dst))
+    (setq msgs (elmo-folder-list-messages src)
+         len (length msgs))
+    (when (> len elmo-display-progress-threshold)
+      (elmo-progress-set 'elmo-folder-move-messages
+                        len "Moving messages..."))
+    (elmo-folder-move-messages src msgs dst)
+    (elmo-progress-clear 'elmo-folder-move-messages))
   ;; Don't save msgdb here.
   ;; Because summary view of original folder is not updated yet.
   (elmo-folder-close-internal src)

diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index a35a28a..ee46191 100644 (file)
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -1158,6 +1158,52 @@ the value of `foo'."
           (apply (function message) (concat format " %d%%")
                  (nconc args (list value)))))))
 
+(defvar elmo-progress-counter-alist nil)
+
+(defmacro elmo-progress-counter-value (counter)
+  (` (aref (cdr (, counter)) 0)))
+
+(defmacro elmo-progress-counter-all-value (counter)
+  (` (aref (cdr (, counter)) 1)))
+
+(defmacro elmo-progress-counter-format (counter)
+  (` (aref (cdr (, counter)) 2)))
+
+(defmacro elmo-progress-counter-set-value (counter value)
+  (` (aset (cdr (, counter)) 0 (, value))))
+
+(defun elmo-progress-set (label all-value &optional format)
+  (unless (assq label elmo-progress-counter-alist)
+    (setq elmo-progress-counter-alist
+         (cons (cons label (vector 0 all-value (or format "")))
+               elmo-progress-counter-alist))))
+
+(defun elmo-progress-clear (label)
+  (let ((counter (assq label elmo-progress-counter-alist)))
+    (when counter
+      (elmo-display-progress label "" 100)
+      (setq elmo-progress-counter-alist
+           (delq counter elmo-progress-counter-alist)))))
+
+(defun elmo-progress-notify (label &optional value op &rest args)
+  (let ((counter (assq label elmo-progress-counter-alist)))
+    (when counter
+      (let* ((value (or value 1))
+            (cur-value (elmo-progress-counter-value counter))
+            (all-value (elmo-progress-counter-all-value counter))
+            (new-value (if (eq op 'set) value (+ cur-value value)))
+            (cur-rate (/ (* cur-value 100) all-value))
+            (new-rate (/ (* new-value 100) all-value)))
+       (elmo-progress-counter-set-value counter new-value)
+       (unless (= cur-rate new-rate)
+         (apply 'elmo-display-progress
+                label
+                (elmo-progress-counter-format counter)
+                new-rate
+                args))
+       (when (>= new-rate 100)
+         (elmo-progress-clear 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 621c771..a8e1d62 100644 (file)
--- a/elmo/elmo.el
+++ b/elmo/elmo.el
@@ -893,6 +893,7 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
                                   'message-id)
                                  seen-list)))
          (setq succeed-numbers (cons (car numbers) succeed-numbers)))
+       (elmo-progress-notify 'elmo-folder-move-messages)
        (setq numbers (cdr numbers)))
       (if (and seen-list (elmo-folder-persistent-p folder))
          (elmo-msgdb-seen-save (elmo-folder-msgdb-path folder)
@@ -913,11 +914,6 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
     (let* ((messages msgs)
           (elmo-inhibit-display-retrieval-progress t)
           (len (length msgs))
-          (all-msg-num (or all len))
-          (done-msg-num (or done 0))
-          (progress-message (if no-delete
-                                "Copying messages..."
-                              "Moving messages..."))
           succeeds i result)
       (if (eq dst-folder 'null)
          (setq succeeds messages)
@@ -945,11 +941,6 @@ Return a cons cell of (NUMBER-CROSSPOSTS . NEW-MARK-ALIST).")
                   msgs (elmo-folder-msgdb src-folder)
                   unread-marks seen-list))
            (elmo-msgdb-seen-save dir seen-list))))
-      (when (and done
-                (> all-msg-num elmo-display-progress-threshold))
-       (elmo-display-progress
-        'elmo-folder-move-messages progress-message
-        (/ (* done-msg-num 100) all-msg-num)))
       (if (and (not no-delete) succeeds)
          (progn
            (if (not no-delete-info)