From 35acfe8e822c8d52ffa3d523826a131fbb99e451 Mon Sep 17 00:00:00 2001 From: hmurata Date: Sat, 6 Oct 2001 06:34:55 +0000 Subject: [PATCH] * 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. --- elmo/ChangeLog | 28 +++++++++++++++ elmo/elmo-archive.el | 92 +++++++++++++++++++++++++------------------------ elmo/elmo-imap4.el | 4 ++- elmo/elmo-localdir.el | 9 +++-- elmo/elmo-maildir.el | 3 +- elmo/elmo-pipe.el | 11 ++++-- elmo/elmo-util.el | 46 +++++++++++++++++++++++++ elmo/elmo.el | 11 +----- 8 files changed, 140 insertions(+), 64 deletions(-) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index d2e07a3..9f2d3f2 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,31 @@ +2001-10-06 Hiroya Murata + + * 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 * 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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) -- 1.7.10.4