(wl-display-progress-with-gauge): Ditto.
(wl-progress-callback-function): Ditto.
* wl.el (wl-init): Set `elmo-progress-callback-function' as
`wl-progress-callback-function'
* wl-vars.el (wl-display-progress-threshold): New user option.
(wl-display-progress-function): Ditto.
* elmo-util.el (elmo-list-bigger-diff): Abolish.
(elmo-display-progress): Ditto.
(elmo-progress-counter-alist): Ditto.
(elmo-progress-set): Ditto.
(elmo-progress-clear): Ditto.
(elmo-progress-counter-all-value): Rename to
`elmo-progress-counter-total'.
(elmo-progress-counter-format): Rename to
`elmo-progress-counter-action'.
(elmo-progress-counter): New internal variable.
(elmo-progress-callback-function): Ditto.
(elmo-progress-counter-label): New function.
(elmo-progress-counter-set-total): Ditto.
(elmo-progress-counter-set-action): Ditto.
(elmo-progress-call-callback): Ditto.
(elmo-progress-start): Ditto.
(elmo-progress-done): Ditto.
(elmo-progress-notify): Rewrite.
(elmo-with-progress-display): Remove first arguemnt
`condition'. Add optional argument `var' in `spec'.
* elmo-vars.el (elmo-display-progress-threshold): Abolish.
(elmo-display-retrieval-progress-threshold): Ditto.
(elmo-inhibit-display-retrieval-progress): Ditto.
2006-10-31 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * elmo-util.el (elmo-list-bigger-diff): Abolish.
+ (elmo-display-progress): Ditto.
+ (elmo-progress-counter-alist): Ditto.
+ (elmo-progress-set): Ditto.
+ (elmo-progress-clear): Ditto.
+ (elmo-progress-counter-all-value): Rename to
+ `elmo-progress-counter-total'.
+ (elmo-progress-counter-format): Rename to
+ `elmo-progress-counter-action'.
+ (elmo-progress-counter): New internal variable.
+ (elmo-progress-callback-function): Ditto.
+ (elmo-progress-counter-label): New function.
+ (elmo-progress-counter-set-total): Ditto.
+ (elmo-progress-counter-set-action): Ditto.
+ (elmo-progress-call-callback): Ditto.
+ (elmo-progress-start): Ditto.
+ (elmo-progress-done): Ditto.
+ (elmo-progress-notify): Rewrite.
+ (elmo-with-progress-display): Remove first arguemnt
+ `condition'. Add optional argument `var' in `spec'.
+
+ * elmo-vars.el (elmo-display-progress-threshold): Abolish.
+ (elmo-display-retrieval-progress-threshold): Ditto.
+ (elmo-inhibit-display-retrieval-progress): Ditto.
+
+ * Replace all pair of `elmo-progress-set' and
+ `elmo-progress-clear' into `elmo-with-progress-display'.
+
+ * Replace to call `elmo-display-progress' into pair of
+ `elmo-progress-notify' and `elmo-with-progress-display'.
+
* elmo-version.el (elmo-version): Up to 2.15.5.
2006-10-15 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
numbers flag-table)
(when numbers
(save-excursion ;; 981005
- (if (and elmo-archive-use-izip-agent
- (elmo-archive-get-method
- (elmo-archive-folder-archive-type-internal folder)
- 'cat-headers))
- (elmo-archive-msgdb-create-as-numlist-subr2
- folder numbers flag-table)
- (elmo-archive-msgdb-create-as-numlist-subr1
- folder numbers flag-table)))))
+ (elmo-with-progress-display (elmo-folder-create-msgdb (length numbers))
+ "Creating msgdb"
+ (if (and elmo-archive-use-izip-agent
+ (elmo-archive-get-method
+ (elmo-archive-folder-archive-type-internal folder)
+ 'cat-headers))
+ (elmo-archive-msgdb-create-as-numlist-subr2
+ folder numbers flag-table)
+ (elmo-archive-msgdb-create-as-numlist-subr1
+ folder numbers flag-table))))))
(defun elmo-archive-msgdb-create-as-numlist-subr1 (folder numlist flag-table)
(let* ((type (elmo-archive-folder-archive-type-internal folder))
(file (elmo-archive-get-archive-name folder))
(method (elmo-archive-get-method type 'cat))
(new-msgdb (elmo-make-msgdb))
- entity i percent num message-id flags)
+ entity message-id flags)
(with-temp-buffer
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
(while numlist
(erase-buffer)
(setq entity
flags (elmo-flag-table-get flag-table message-id))
(elmo-global-flags-set flags folder (car numlist) message-id)
(elmo-msgdb-append-entity new-msgdb entity flags))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-archive-msgdb-create-as-numlist-subr1 "Creating msgdb..."
- percent))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)
(setq numlist (cdr numlist)))
- (message "Creating msgdb...done")
new-msgdb)))
;;; info-zip agent
(args (cdr method))
(arc (elmo-archive-get-archive-name folder))
(new-msgdb (elmo-make-msgdb))
- n i percent num msgs case-fold-search)
+ n msgs case-fold-search)
(with-temp-buffer
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
(while numlist
(setq n (min (1- elmo-archive-fetch-headers-volume)
(1- (length numlist))))
'concat
(mapcar '(lambda (x) (elmo-concat-path prefix (int-to-string x))) msgs)
"\n"))
- (message "Fetching headers...")
(as-binary-process (apply 'call-process-region
(point-min) (point-max)
prog t t nil (append args (list arc))))
;;; (elmo-archive-parse-unixmail msgs flag-table)))
(t ;; unknown format
(error "Unknown format!")))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ n i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-archive-msgdb-create-as-numlist-subr2 "Creating msgdb..."
- percent))))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb))
(defun elmo-archive-parse-mmdf (folder msgs flag-table)
;; updates match-data.
;; (msgs (or from-msgs (elmo-archive-list-folder spec)))
(msgs (or from-msgs (elmo-folder-list-messages folder)))
- (num (length msgs))
- (i 0)
(case-fold-search nil)
- number-list ret-val)
- (setq number-list msgs)
- (while msgs
- (if (elmo-archive-field-condition-match
- folder (car msgs) number-list
- condition
- (elmo-archive-folder-archive-prefix-internal folder))
- (setq ret-val (cons (car msgs) ret-val)))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-archive-search "Searching..."
- (/ (* i 100) num)))
- (setq msgs (cdr msgs)))
+ ret-val)
+ (elmo-with-progress-display (elmo-folder-search (length msgs)) "Searching"
+ (dolist (number msgs)
+ (when (elmo-archive-field-condition-match
+ folder number msgs
+ condition
+ (elmo-archive-folder-archive-prefix-internal folder))
+ (setq ret-val (cons number ret-val)))
+ (elmo-progress-notify 'elmo-folder-search)))
(nreverse ret-val)))
;;; method(alist)
(luna-define-method elmo-folder-msgdb-create ((folder elmo-cache-folder)
numbers flag-table)
- (let ((i 0)
- (len (length numbers))
- (new-msgdb (elmo-make-msgdb))
+ (let ((new-msgdb (elmo-make-msgdb))
entity message-id flags)
- (message "Creating msgdb...")
- (while numbers
- (setq entity
- (elmo-msgdb-create-message-entity-from-file
- (elmo-msgdb-message-entity-handler new-msgdb)
- (car numbers) (elmo-message-file-name folder (car numbers))))
- (when entity
- (setq message-id (elmo-message-entity-field entity 'message-id)
- flags (elmo-flag-table-get flag-table message-id))
- (elmo-global-flags-set flags folder (car numbers) message-id)
- (elmo-msgdb-append-entity new-msgdb entity flags))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-cache-folder-msgdb-create "Creating msgdb..."
- (/ (* i 100) len)))
- (setq numbers (cdr numbers)))
- (message "Creating msgdb...done")
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (setq entity
+ (elmo-msgdb-create-message-entity-from-file
+ (elmo-msgdb-message-entity-handler new-msgdb)
+ number
+ (elmo-message-file-name folder number)))
+ (when entity
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table message-id))
+ (elmo-global-flags-set flags folder number message-id)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb))
(luna-define-method elmo-folder-append-buffer ((folder elmo-cache-folder)
(luna-define-method elmo-folder-msgdb-create ((folder elmo-file-folder)
numlist flag-table)
(let ((new-msgdb (elmo-make-msgdb))
- entity mark i percent num)
- (setq num (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-file-msgdb-create-entity new-msgdb folder (car numlist)))
- (when entity
- (elmo-msgdb-append-entity new-msgdb entity '(new unread)))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-folder-msgdb-create "Creating msgdb..."
- percent))
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done")
+ entity)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numlist))
+ "Creating msgdb"
+ (dolist (number numlist)
+ (setq entity (elmo-file-msgdb-create-entity new-msgdb folder number))
+ (when entity
+ (elmo-msgdb-append-entity new-msgdb entity '(new unread)))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb))
(luna-define-method elmo-folder-message-file-p ((folder elmo-file-folder))
(when numbers
(let ((dir (elmo-localdir-folder-directory-internal folder))
(new-msgdb (elmo-make-msgdb))
- entity (i 0)
- (len (length numbers)))
- (message "Creating msgdb...")
- (while numbers
- (when (setq entity (elmo-localdir-msgdb-create-entity
- new-msgdb dir (car numbers)))
- (elmo-msgdb-append-entity new-msgdb entity
- (list (elmo-flag-folder-flag-internal
- folder))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-flag-folder-msgdb-create "Creating msgdb..."
- (/ (* i 100) len)))
- (setq numbers (cdr numbers)))
- (message "Creating msgdb...done")
+ (flags (list (elmo-flag-folder-flag-internal folder)))
+ entity)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (when (setq entity (elmo-localdir-msgdb-create-entity
+ new-msgdb dir number))
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb)))
(defun elmo-folder-append-messages-*-flag (dst-folder
(elmo-imap4-response-value element 'uid)
:size (elmo-imap4-response-value element 'rfc822size)))
(elmo-imap4-response-value element 'flags)
- app-data)))
+ app-data)
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
(defun elmo-imap4-parse-capability (string)
(if (string-match "^\\*\\(.*\\)$" string)
(defvar elmo-imap4-client-eol "\r\n"
"The EOL string we send to the server.")
-(defvar elmo-imap4-display-literal-progress nil)
+(defvar elmo-imap4-literal-progress-reporter nil)
(defun elmo-imap4-find-next-line ()
"Return point at end of current line, taking into account literals.
(if (match-string 1)
(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
(progn
- (if (and elmo-imap4-display-literal-progress
- (> (string-to-number (match-string 1))
- (min elmo-display-retrieval-progress-threshold 100)))
- (elmo-display-progress
- 'elmo-imap4-display-literal-progress
- (format "Retrieving (%d/%d bytes)..."
- (- (point-max) (point))
- (string-to-number (match-string 1)))
- (/ (- (point-max) (point))
- (/ (string-to-number (match-string 1)) 100))))
+ (when elmo-imap4-literal-progress-reporter
+ (elmo-progress-counter-set-total
+ elmo-imap4-literal-progress-reporter
+ (string-to-number (match-string 1)))
+ (elmo-progress-notify 'elmo-retrieve-message
+ :set (- (point-max) (point))))
nil)
(goto-char (+ (point) (string-to-number (match-string 1))))
(elmo-imap4-find-next-line))
(total 0)
(length (length from-msgs))
charset set-list end results)
- (message "Searching...")
(cond
((string= "last" search-key)
(let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
(elmo-date-get-datevec
(elmo-filter-value filter)))))
'search)))
- (when (> length elmo-display-progress-threshold)
- (setq total (+ total (car (car set-list))))
- (elmo-display-progress
- 'elmo-imap4-search "Searching..."
- (/ (* total 100) length)))
(setq set-list (cdr set-list)
end (null set-list)))
results)
(encode-mime-charset-string
(elmo-filter-value filter) charset))))
'search)))
- (when (> length elmo-display-progress-threshold)
- (setq total (+ total (car (car set-list))))
- (elmo-display-progress
- 'elmo-imap4-search "Searching..."
- (/ (* total 100) length)))
(setq set-list (cdr set-list)
end (null set-list)))
results))))
(if (elmo-folder-plugged-p folder)
(save-excursion
(let ((session (elmo-imap4-get-session folder)))
+ (message "Searching...")
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-folder-mailbox-internal folder))
- (elmo-imap4-search-internal folder session condition numbers)))
+ (elmo-imap4-search-internal folder session condition numbers)
+ (message "Searching...done")))
(luna-call-next-method)))
(luna-define-method elmo-folder-msgdb-create-plugged
"Message-Id" "References" "In-Reply-To")
(mapcar #'capitalize (elmo-msgdb-extra-fields 'non-virtual)))))
(total 0)
- (length (length numbers))
print-length print-depth
rfc2060 set-list)
(setq rfc2060 (memq 'imap4rev1
(elmo-imap4-session-capability-internal
session)))
- (message "Getting overview...")
- (elmo-imap4-session-select-mailbox
- session (elmo-imap4-folder-mailbox-internal folder))
- (setq set-list (elmo-imap4-make-number-set-list
- numbers
- elmo-imap4-overview-fetch-chop-length))
- ;; Setup callback.
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
- elmo-imap4-seen-messages nil
- elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
- elmo-imap4-fetch-callback-data (cons flag-table folder))
- (while set-list
- (elmo-imap4-send-command-wait
- session
- ;; get overview entity from IMAP4
- (format "%sfetch %s (%s rfc822.size flags)"
- (if elmo-imap4-use-uid "uid " "")
- (cdr (car set-list))
- (if rfc2060
- (format "body.peek[header.fields %s]" headers)
- (format "%s" headers))))
- (when (> length elmo-display-progress-threshold)
- (setq total (+ total (car (car set-list))))
- (elmo-display-progress
- 'elmo-imap4-msgdb-create "Getting overview..."
- (/ (* total 100) length)))
- (setq set-list (cdr set-list)))
- (message "Getting overview...done")
- (when elmo-imap4-seen-messages
- (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
- ;; cannot setup the global flag while retrieval.
- (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
- (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
- number)
- folder number
- (elmo-message-entity-field
- (elmo-msgdb-message-entity
- elmo-imap4-current-msgdb number)
- 'message-id)))
- elmo-imap4-current-msgdb))))
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (elmo-imap4-session-select-mailbox
+ session (elmo-imap4-folder-mailbox-internal folder))
+ (setq set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-overview-fetch-chop-length))
+ ;; Setup callback.
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
+ elmo-imap4-seen-messages nil
+ elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
+ elmo-imap4-fetch-callback-data (cons flag-table folder))
+ (while set-list
+ (elmo-imap4-send-command-wait
+ session
+ ;; get overview entity from IMAP4
+ (format "%sfetch %s (%s rfc822.size flags)"
+ (if elmo-imap4-use-uid "uid " "")
+ (cdr (car set-list))
+ (if rfc2060
+ (format "body.peek[header.fields %s]" headers)
+ (format "%s" headers))))
+ (setq set-list (cdr set-list)))
+ (when elmo-imap4-seen-messages
+ (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
+ ;; cannot setup the global flag while retrieval.
+ (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
+ (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
+ number)
+ folder number
+ (elmo-message-entity-field
+ (elmo-msgdb-message-entity
+ elmo-imap4-current-msgdb number)
+ 'message-id)))
+ elmo-imap4-current-msgdb)))))
(luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
numbers flag)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-fetch-callback nil)
(setq elmo-imap4-fetch-callback-data nil))
- (unless elmo-inhibit-display-retrieval-progress
- (setq elmo-imap4-display-literal-progress t))
- (unwind-protect
- (setq response
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body%s[%s]"
- "fetch %s body%s[%s]")
- number
- (if unseen ".peek" "")
- (or section "")
- )))
- (setq elmo-imap4-display-literal-progress nil))
- (unless elmo-inhibit-display-retrieval-progress
- (elmo-display-progress 'elmo-imap4-display-literal-progress
- "Retrieving..." 100) ; remove progress bar.
- (message "Retrieving...done"))
+ (elmo-with-progress-display (elmo-retrieve-message
+ (or (elmo-message-field folder number :size)
+ 0)
+ elmo-imap4-literal-progress-reporter)
+ "Retrieving"
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body%s[%s]"
+ "fetch %s body%s[%s]")
+ number
+ (if unseen ".peek" "")
+ (or section "")))))
(if (setq response (elmo-imap4-response-bodydetail-text
(elmo-imap4-response-value-all
response 'fetch)))
(when numbers
(let ((dir (elmo-localdir-folder-directory-internal folder))
(new-msgdb (elmo-make-msgdb))
- entity message-id
- flags
- (i 0)
- (len (length numbers)))
- (message "Creating msgdb...")
- (while numbers
- (setq entity
- (elmo-localdir-msgdb-create-entity
- new-msgdb dir (car numbers)))
- (when entity
- (setq message-id (elmo-message-entity-field entity 'message-id)
- flags (elmo-flag-table-get flag-table message-id))
- (elmo-global-flags-set flags folder (car numbers) message-id)
- (elmo-msgdb-append-entity new-msgdb entity flags))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-localdir-msgdb-create-as-numbers "Creating msgdb..."
- (/ (* i 100) len)))
- (setq numbers (cdr numbers)))
- (message "Creating msgdb...done")
+ entity message-id flags)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (setq entity (elmo-localdir-msgdb-create-entity
+ new-msgdb dir number))
+ (when entity
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table message-id))
+ (elmo-global-flags-set flags folder number message-id)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb)))
(luna-define-method elmo-folder-list-subfolders ((folder elmo-localdir-folder)
(not elmo-pack-number-check-strict))
'<))
(new-number 1) ; first ordinal position in localdir
- total entity)
- (setq total (length numbers))
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-folder-pack-numbers total "Packing...")
+ entity)
+ (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers))
+ "Packing"
(dolist (old-number numbers)
(setq entity (elmo-msgdb-message-entity msgdb old-number))
(when (not (eq old-number new-number)) ; why \=() is wrong..
(luna-define-method elmo-folder-msgdb-create ((folder elmo-maildir-folder)
numbers flag-table)
- (let* ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
- (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
- (answered-list (elmo-maildir-folder-answered-locations-internal
- folder))
- (len (length numbers))
- (new-msgdb (elmo-make-msgdb))
- (i 0)
- entity message-id flags location)
- (message "Creating msgdb...")
- (dolist (number numbers)
- (setq location (elmo-map-message-location folder number))
- (setq entity
- (elmo-msgdb-create-message-entity-from-file
- (elmo-msgdb-message-entity-handler new-msgdb)
- number
- (elmo-maildir-message-file-name folder location)))
- (when entity
- (setq message-id (elmo-message-entity-field entity 'message-id)
- ;; Precede flag-table to file-info.
- flags (copy-sequence
- (elmo-flag-table-get flag-table message-id)))
-
- ;; Already flagged on filename (precede it to flag-table).
- (when (member location flagged-list)
- (or (memq 'important flags)
- (setq flags (cons 'important flags))))
- (when (member location answered-list)
- (or (memq 'answered flags)
- (setq flags (cons 'answered flags))))
- (unless (member location unread-list)
- (and (memq 'unread flags)
- (setq flags (delq 'unread flags))))
-
- ;; Update filename's info portion according to the flag-table.
- (when (and (memq 'important flags)
- (not (member location flagged-list)))
- (elmo-maildir-set-mark
- (elmo-maildir-message-file-name folder location)
- ?F)
- ;; Append to flagged location list.
- (elmo-maildir-folder-set-flagged-locations-internal
- folder
- (cons location
- (elmo-maildir-folder-flagged-locations-internal
- folder)))
- (setq flags (delq 'unread flags)))
- (when (and (memq 'answered flags)
- (not (member location answered-list)))
- (elmo-maildir-set-mark
- (elmo-maildir-message-file-name folder location)
- ?R)
- ;; Append to answered location list.
- (elmo-maildir-folder-set-answered-locations-internal
- folder
- (cons location
- (elmo-maildir-folder-answered-locations-internal folder)))
- (setq flags (delq 'unread flags)))
- (when (and (not (memq 'unread flags))
- (member location unread-list))
- (elmo-maildir-set-mark
- (elmo-maildir-message-file-name folder location)
- ?S)
- ;; Delete from unread locations.
- (elmo-maildir-folder-set-unread-locations-internal
- folder
- (delete location
- (elmo-maildir-folder-unread-locations-internal
- folder))))
- (unless (memq 'unread flags)
- (setq flags (delq 'new flags)))
- (elmo-global-flags-set flags folder number message-id)
- (elmo-msgdb-append-entity new-msgdb entity flags)
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-maildir-msgdb-create "Creating msgdb..."
- (/ (* i 100) len)))))
- (message "Creating msgdb...done")
+ (let ((unread-list (elmo-maildir-folder-unread-locations-internal folder))
+ (flagged-list (elmo-maildir-folder-flagged-locations-internal folder))
+ (answered-list (elmo-maildir-folder-answered-locations-internal
+ folder))
+ (new-msgdb (elmo-make-msgdb))
+ entity message-id flags location)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (setq location (elmo-map-message-location folder number))
+ (setq entity
+ (elmo-msgdb-create-message-entity-from-file
+ (elmo-msgdb-message-entity-handler new-msgdb)
+ number
+ (elmo-maildir-message-file-name folder location)))
+ (when entity
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ ;; Precede flag-table to file-info.
+ flags (copy-sequence
+ (elmo-flag-table-get flag-table message-id)))
+
+ ;; Already flagged on filename (precede it to flag-table).
+ (when (member location flagged-list)
+ (or (memq 'important flags)
+ (setq flags (cons 'important flags))))
+ (when (member location answered-list)
+ (or (memq 'answered flags)
+ (setq flags (cons 'answered flags))))
+ (unless (member location unread-list)
+ (and (memq 'unread flags)
+ (setq flags (delq 'unread flags))))
+
+ ;; Update filename's info portion according to the flag-table.
+ (when (and (memq 'important flags)
+ (not (member location flagged-list)))
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder location)
+ ?F)
+ ;; Append to flagged location list.
+ (elmo-maildir-folder-set-flagged-locations-internal
+ folder
+ (cons location
+ (elmo-maildir-folder-flagged-locations-internal
+ folder)))
+ (setq flags (delq 'unread flags)))
+ (when (and (memq 'answered flags)
+ (not (member location answered-list)))
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder location)
+ ?R)
+ ;; Append to answered location list.
+ (elmo-maildir-folder-set-answered-locations-internal
+ folder
+ (cons location
+ (elmo-maildir-folder-answered-locations-internal folder)))
+ (setq flags (delq 'unread flags)))
+ (when (and (not (memq 'unread flags))
+ (member location unread-list))
+ (elmo-maildir-set-mark
+ (elmo-maildir-message-file-name folder location)
+ ?S)
+ ;; Delete from unread locations.
+ (elmo-maildir-folder-set-unread-locations-internal
+ folder
+ (delete location
+ (elmo-maildir-folder-unread-locations-internal
+ folder))))
+ (unless (memq 'unread flags)
+ (setq flags (delq 'new flags)))
+ (elmo-global-flags-set flags folder number message-id)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb))
(defun elmo-maildir-cleanup-temporal (dir)
'<))
(new-msgdb (elmo-make-msgdb (elmo-folder-msgdb-path folder)))
(number 1)
- total location entity)
- (setq total (length numbers))
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-folder-pack-numbers total "Packing...")
+ location entity)
+ (elmo-with-progress-display (elmo-folder-pack-numbers (length numbers))
+ "Packing"
(dolist (old-number numbers)
(setq entity (elmo-msgdb-message-entity msgdb old-number))
(elmo-message-entity-set-number entity number)
(insert (match-string 0 response) "\n")
(setq start (match-end 0)))))
(goto-char (point-min))
- (let ((len (count-lines (point-min) (point-max)))
- (i 0) regexp)
+ (elmo-with-progress-display
+ (elmo-nntp-parse-active (count-lines (point-min) (point-max)))
+ "Parsing active"
(if one-level
- (progn
- (setq regexp
- (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
- (if (and (elmo-nntp-folder-group-internal folder)
- (null (string=
- (elmo-nntp-folder-group-internal
- folder) "")))
- (concat (elmo-nntp-folder-group-internal
- folder)
- "\\.")
- "")))
+ (let ((regexp
+ (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
+ (if (and (elmo-nntp-folder-group-internal folder)
+ (null (string=
+ (elmo-nntp-folder-group-internal
+ folder) "")))
+ (concat (elmo-nntp-folder-group-internal
+ folder)
+ "\\.")
+ ""))))
(while (looking-at regexp)
(setq top-ng (elmo-match-buffer 1))
(if (string= (elmo-match-buffer 2) " ")
(setq ret-val (delete top-ng ret-val)))
(if (not (assoc top-ng ret-val))
(setq ret-val (nconc ret-val (list (list top-ng))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'elmo-nntp-list-folders "Parsing active..."
- (/ (* i 100) len))))
+ (elmo-progress-notify 'elmo-nntp-parse-active)
(forward-line 1)))
(while (re-search-forward "\\([^ ]+\\) .*\n" nil t)
(setq ret-val (nconc ret-val
(list (elmo-match-buffer 1))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'elmo-nntp-list-folders "Parsing active..."
- (/ (* i 100) len))))))
- (when (> len elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-list-folders "Parsing active..." 100))))
+ (elmo-progress-notify 'elmo-nntp-parse-active)))))
(setq username (or (elmo-net-folder-user-internal folder) ""))
(unless (string= username (or elmo-nntp-default-user ""))
cur beg-num
end-num (nth (1- (length numbers)) numbers)
length (+ (- end-num beg-num) 1))
- (message "Getting overview...")
- (while (<= cur end-num)
- (elmo-nntp-send-command
- session
- (format
- "xover %s-%s"
- (int-to-string cur)
- (int-to-string
- (+ cur
- elmo-nntp-overview-fetch-chop-length))))
- (with-current-buffer (elmo-network-session-buffer session)
- (if ov-str
- (elmo-msgdb-append
- new-msgdb
- (elmo-nntp-create-msgdb-from-overview-string
- folder
- ov-str
- flag-table
- filter))))
- (if (null (elmo-nntp-read-response session t))
- (progn
- (setq cur end-num);; exit while loop
- (elmo-nntp-set-xover session nil)
- (setq use-xover nil))
- (if (null (setq ov-str (elmo-nntp-read-contents session)))
- (error "Fetching overview failed")))
- (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
- (when (> length elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create "Getting overview..."
- (/ (* (+ (- (min cur end-num)
- beg-num) 1) 100) length))))
- (when (> length elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create "Getting overview..." 100)))
+ (elmo-with-progress-display (elmo-retrieve-overview length)
+ "Getting overview"
+ (while (<= cur end-num)
+ (elmo-nntp-send-command
+ session
+ (format
+ "xover %s-%s"
+ (int-to-string cur)
+ (int-to-string
+ (+ cur
+ elmo-nntp-overview-fetch-chop-length))))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (if ov-str
+ (elmo-msgdb-append
+ new-msgdb
+ (elmo-nntp-create-msgdb-from-overview-string
+ folder
+ ov-str
+ flag-table
+ filter))))
+ (if (null (elmo-nntp-read-response session t))
+ (progn
+ (setq cur end-num);; exit while loop
+ (elmo-nntp-set-xover session nil)
+ (setq use-xover nil))
+ (if (null (setq ov-str (elmo-nntp-read-contents session)))
+ (error "Fetching overview failed")))
+ (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
+ (elmo-progress-notify 'elmo-retrieve-overview
+ :set (+ (- (min cur end-num) beg-num) 1)))))
(if (not use-xover)
(setq new-msgdb (elmo-nntp-msgdb-create-by-header
session numbers flag-table))
(elmo-network-session-process-internal session) 1)
(discard-input)
;; Wait for all replies.
- (message "Getting folders info...")
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (setq received
- (1+ received)))
- (setq last-point (point))
- (< received count))
- (accept-process-output (elmo-network-session-process-internal session)
- 1)
- (discard-input)
- (when (> count elmo-display-progress-threshold)
- (if (or (zerop (% received 10)) (= received count))
- (elmo-display-progress
- 'elmo-nntp-groups-read-response "Getting folders info..."
- (/ (* received 100) count)))))
- (when (> count elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-groups-read-response "Getting folders info..." 100))
+ (elmo-with-progress-display (elmo-nntp-groups-read-response count)
+ "Getting folders info"
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ (accept-process-output
+ (elmo-network-session-process-internal session)
+ 1)
+ (discard-input)
+ (elmo-progress-notify 'elmo-nntp-groups-read-response :set received)))
;; Wait for the reply from the final command.
(goto-char (point-max))
(re-search-backward "^[0-9]" nil t)
(received 0)
(last-point (point-min))
article)
- ;; Send HEAD commands.
- (while (setq article (pop articles))
- (elmo-nntp-send-command session
- (format "head %s" article)
- 'noerase)
- (setq count (1+ count))
- ;; Every 200 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count elmo-nntp-header-fetch-chop-length)))
- (accept-process-output
- (elmo-network-session-process-internal session) 1)
- (discard-input)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (elmo-nntp-next-result-arrived-p)
- (setq last-point (point))
- (setq received (1+ received)))
- (< received count))
- (when (> number elmo-display-progress-threshold)
- (if (or (zerop (% received 20)) (= received number))
- (elmo-display-progress
- 'elmo-nntp-retrieve-headers "Getting headers..."
- (/ (* received 100) number))))
+ (elmo-with-progress-display (elmo-retrieve-header number)
+ "Getting headers"
+ ;; Send HEAD commands.
+ (while (setq article (pop articles))
+ (elmo-nntp-send-command session
+ (format "head %s" article)
+ 'noerase)
+ (setq count (1+ count))
+ ;; Every 200 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or (null articles) ;All requests have been sent.
+ (zerop (% count elmo-nntp-header-fetch-chop-length)))
(accept-process-output
(elmo-network-session-process-internal session) 1)
- (discard-input))))
- (when (> number elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-retrieve-headers "Getting headers..." 100))
- (message "Getting headers...done")
+ (discard-input)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (elmo-nntp-next-result-arrived-p)
+ (setq last-point (point))
+ (setq received (1+ received)))
+ (< received count))
+ (elmo-progress-notify 'elmo-retrieve-header :set received)
+ (accept-process-output
+ (elmo-network-session-process-internal session) 1)
+ (discard-input)))))
;; Replace all CRLF with LF.
(elmo-delete-cr-buffer)
(copy-to-buffer outbuf (point-min) (point-max)))))
(defun elmo-nntp-msgdb-create-message (len flag-table)
(save-excursion
(let ((new-msgdb (elmo-make-msgdb))
- beg entity i num message-id)
+ beg entity num message-id)
(set-buffer-multibyte nil)
(goto-char (point-min))
- (setq i 0)
- (message "Creating msgdb...")
- (while (not (eobp))
- (setq beg (save-excursion (forward-line 1) (point)))
- (setq num
- (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
- (string-to-int
- (elmo-match-buffer 1))))
- (elmo-nntp-next-result-arrived-p)
- (when num
- (save-excursion
- (forward-line -1)
- (save-restriction
- (narrow-to-region beg (point))
- (setq entity
- (elmo-msgdb-create-message-entity-from-buffer
- (elmo-msgdb-message-entity-handler new-msgdb) num))
- (when entity
- (setq message-id
- (elmo-message-entity-field entity 'message-id))
- (elmo-msgdb-append-entity
- new-msgdb
- entity
- (elmo-flag-table-get flag-table message-id))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 20)) (= i len))
- (elmo-display-progress
- 'elmo-nntp-msgdb-create-message "Creating msgdb..."
- (/ (* i 100) len)))))
- (when (> len elmo-display-progress-threshold)
- (elmo-display-progress
- 'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
+ (elmo-with-progress-display (elmo-folder-msgdb-create len)
+ "Creating msgdb"
+ (while (not (eobp))
+ (setq beg (save-excursion (forward-line 1) (point)))
+ (setq num
+ (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
+ (string-to-int
+ (elmo-match-buffer 1))))
+ (elmo-nntp-next-result-arrived-p)
+ (when num
+ (save-excursion
+ (forward-line -1)
+ (save-restriction
+ (narrow-to-region beg (point))
+ (setq entity
+ (elmo-msgdb-create-message-entity-from-buffer
+ (elmo-msgdb-message-entity-handler new-msgdb) num))
+ (when entity
+ (setq message-id
+ (elmo-message-entity-field entity 'message-id))
+ (elmo-msgdb-append-entity
+ new-msgdb
+ entity
+ (elmo-flag-table-get flag-table message-id))))))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb)))
(luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
(message "Checking %s..." (elmo-folder-name-internal src))
(elmo-folder-open src)
(unwind-protect
- (let* ((msgs (elmo-pipe-folder-list-target-messages src ignore-list))
- (len (length msgs)))
- (elmo-with-progress-display (> len elmo-display-progress-threshold)
- (elmo-folder-move-messages len (if copy
- "Copying messages..."
- "Moving messages..."))
+ (let ((msgs (elmo-pipe-folder-list-target-messages src ignore-list)))
+ (elmo-with-progress-display (elmo-folder-move-messages (length msgs))
+ (if copy "Copying messages" "Moving messages")
(elmo-folder-move-messages src msgs dst copy))
(when (and copy msgs)
(setq ignore-list (elmo-number-set-append-list ignore-list msgs))))
(defvar sasl-mechanism-alist)
-(defvar elmo-pop3-total-size nil)
+(defvar elmo-pop3-retrieve-progress-reporter nil)
;; For debugging.
(defvar elmo-pop3-debug nil
(goto-char (point-max))
(insert output)
(elmo-pop3-debug "RECEIVED: %s\n" output)
- (if (and elmo-pop3-total-size
- (> elmo-pop3-total-size
- (min elmo-display-retrieval-progress-threshold 100)))
- (elmo-display-progress
- 'elmo-display-retrieval-progress
- (format "Retrieving (%d/%d bytes)..."
- (buffer-size)
- elmo-pop3-total-size)
- (/ (buffer-size) (/ elmo-pop3-total-size 100)))))))
+ (when elmo-pop3-retrieve-progress-reporter
+ (elmo-progress-notify 'elmo-retrieve-message :set (buffer-size))))))
(defun elmo-pop3-auth-user (session)
(let ((process (elmo-network-session-process-internal session))
(save-excursion
(set-buffer (process-buffer process))
(erase-buffer)
- (let ((number (length articles))
- (count 0)
+ (let ((count 0)
(received 0)
(last-point (point-min)))
- ;; Send HEAD commands.
- (while articles
- (elmo-pop3-send-command process (format
- "top %s 0" (car articles))
- 'no-erase)
-;;; (accept-process-output process 1)
- (setq articles (cdr articles))
- (setq count (1+ count))
- ;; Every 200 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or elmo-pop3-send-command-synchronously
- (null articles) ;All requests have been sent.
- (zerop (% count elmo-pop3-header-fetch-chop-length)))
- (unless elmo-pop3-send-command-synchronously
- (accept-process-output process 1))
- (discard-input)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (elmo-pop3-next-result-arrived-p)
- (setq last-point (point))
- (setq received (1+ received)))
- (< received count))
- (when (> number elmo-display-progress-threshold)
- (if (or (zerop (% received 5)) (= received number))
- (elmo-display-progress
- 'elmo-pop3-retrieve-headers "Getting headers..."
- (/ (* received 100) number))))
- (accept-process-output process 1)
-;;; (accept-process-output process)
- (discard-input))))
+ (elmo-with-progress-display (elmo-retrieve-header (length articles))
+ "Getting headers"
+ ;; Send HEAD commands.
+ (while articles
+ (elmo-pop3-send-command process
+ (format "top %s 0" (car articles))
+ 'no-erase)
+ ;;; (accept-process-output process 1)
+ (setq articles (cdr articles))
+ (setq count (1+ count))
+ ;; Every 200 requests we have to read the stream in
+ ;; order to avoid deadlocks.
+ (when (or elmo-pop3-send-command-synchronously
+ (null articles) ;All requests have been sent.
+ (zerop (% count elmo-pop3-header-fetch-chop-length)))
+ (unless elmo-pop3-send-command-synchronously
+ (accept-process-output process 1))
+ (discard-input)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (elmo-pop3-next-result-arrived-p)
+ (setq last-point (point))
+ (setq received (1+ received)))
+ (< received count))
+ (elmo-progress-notify 'elmo-retrieve-header :set received)
+ (accept-process-output process 1)
+ ;;; (accept-process-output process)
+ (discard-input)))))
;; Replace all CRLF with LF.
(elmo-delete-cr-buffer)
(copy-to-buffer tobuffer (point-min) (point-max)))))
flag-table)
(save-excursion
(let ((new-msgdb (elmo-make-msgdb))
- beg entity i number message-id flags)
+ beg entity number message-id flags)
(set-buffer buffer)
(set-buffer-multibyte default-enable-multibyte-characters)
(goto-char (point-min))
- (setq i 0)
- (message "Creating msgdb...")
- (while (not (eobp))
- (setq beg (save-excursion (forward-line 1) (point)))
- (elmo-pop3-next-result-arrived-p)
- (save-excursion
- (forward-line -1)
- (save-restriction
- (narrow-to-region beg (point))
- (setq entity
- (elmo-msgdb-create-message-entity-from-buffer
- (elmo-msgdb-message-entity-handler new-msgdb)
- (car numlist)))
- (setq numlist (cdr numlist))
- (when entity
- (with-current-buffer (process-buffer process)
- (elmo-message-entity-set-field
- entity
- 'size
- (elmo-pop3-number-to-size
- (elmo-message-entity-number entity)))
- (when (setq number
- (elmo-map-message-number
- folder
- (elmo-pop3-number-to-uidl
- (elmo-message-entity-number entity))))
- (elmo-message-entity-set-number entity number)))
- (setq message-id (elmo-message-entity-field entity 'message-id)
- flags (elmo-flag-table-get flag-table message-id))
- (elmo-global-flags-set flags folder number message-id)
- (elmo-msgdb-append-entity new-msgdb entity flags))))
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'elmo-pop3-msgdb-create-message "Creating msgdb..."
- (/ (* i 100) num)))))
+ (elmo-with-progress-display (elmo-folder-msgdb-create num)
+ "Creating msgdb"
+ (while (not (eobp))
+ (setq beg (save-excursion (forward-line 1) (point)))
+ (elmo-pop3-next-result-arrived-p)
+ (save-excursion
+ (forward-line -1)
+ (save-restriction
+ (narrow-to-region beg (point))
+ (setq entity
+ (elmo-msgdb-create-message-entity-from-buffer
+ (elmo-msgdb-message-entity-handler new-msgdb)
+ (car numlist)))
+ (setq numlist (cdr numlist))
+ (when entity
+ (with-current-buffer (process-buffer process)
+ (elmo-message-entity-set-field
+ entity
+ 'size
+ (elmo-pop3-number-to-size
+ (elmo-message-entity-number entity)))
+ (when (setq number
+ (elmo-map-message-number
+ folder
+ (elmo-pop3-number-to-uidl
+ (elmo-message-entity-number entity))))
+ (elmo-message-entity-set-number entity number)))
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table message-id))
+ (elmo-global-flags-set flags folder number message-id)
+ (elmo-msgdb-append-entity new-msgdb entity flags))))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb)))
(defun elmo-pop3-read-body (process outbuf)
(elmo-map-message-location folder number))))
(setq size (elmo-pop3-number-to-size number))
(when number
- (elmo-pop3-send-command process
- (format "retr %s" number))
- (unless elmo-inhibit-display-retrieval-progress
- (setq elmo-pop3-total-size size)
- (elmo-display-progress
- 'elmo-display-retrieval-progress
- (format "Retrieving (0/%d bytes)..." elmo-pop3-total-size)
- 0))
- (unwind-protect
- (progn
- (when (null (setq response (cdr (elmo-pop3-read-response
- process t))))
- (error "Fetching message failed"))
- (setq response (elmo-pop3-read-body process outbuf)))
- (setq elmo-pop3-total-size nil))
- (unless elmo-inhibit-display-retrieval-progress
- (elmo-display-progress
- 'elmo-display-retrieval-progress
- "Retrieving..." 100) ; remove progress bar.
- (message "Retrieving...done"))
+ (elmo-with-progress-display
+ (elmo-retrieve-message size elmo-pop3-retrieve-progress-reporter)
+ "Retrieving"
+ (elmo-pop3-send-command process (format "retr %s" number))
+ (when (null (setq response (cdr (elmo-pop3-read-response
+ process t))))
+ (error "Fetching message failed"))
+ (setq response (elmo-pop3-read-body process outbuf)))
(set-buffer outbuf)
(goto-char (point-min))
(while (re-search-forward "^\\." nil t)
(luna-define-method elmo-folder-msgdb-create ((folder elmo-search-folder)
numbers flag-table)
(let ((new-msgdb (elmo-make-msgdb))
- (num (length numbers))
entity)
- (message "Creating msgdb...")
- (elmo-with-progress-display (> num elmo-display-progress-threshold)
- (elmo-folder-msgdb-create num "Creating msgdb...")
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
(dolist (number numbers)
(setq entity (elmo-search-engine-create-message-entity
(elmo-search-folder-engine-internal folder)
(when entity
(elmo-msgdb-append-entity new-msgdb entity '(new unread)))
(elmo-progress-notify 'elmo-folder-msgdb-create)))
- (message "Creating msgdb...done")
new-msgdb))
(luna-define-method elmo-folder-message-file-p ((folder elmo-search-folder))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-sendlog-folder)
numbers flag-table)
- (let ((i 0)
- (len (length numbers))
- (new-msgdb (elmo-make-msgdb))
+ (let ((new-msgdb (elmo-make-msgdb))
entity message-id flags)
- (message "Creating msgdb...")
- (while numbers
- (setq entity
- (elmo-msgdb-create-message-entity-from-file
- (elmo-msgdb-message-entity-handler new-msgdb) (car numbers)
- (elmo-message-file-name folder (car numbers))))
- (if (null entity)
- (elmo-folder-set-killed-list-internal
- folder
- (nconc
- (elmo-folder-killed-list-internal folder)
- (list (car numbers))))
- (setq message-id (elmo-message-entity-field entity 'message-id)
- flags (elmo-flag-table-get flag-table message-id))
- (elmo-global-flags-set flags folder (car numbers) message-id)
- (elmo-msgdb-append-entity new-msgdb entity flags))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-sendlog-folder-msgdb-create "Creating msgdb..."
- (/ (* i 100) len)))
- (setq numbers (cdr numbers)))
- (message "Creating msgdb...done")
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (dolist (number numbers)
+ (setq entity
+ (elmo-msgdb-create-message-entity-from-file
+ (elmo-msgdb-message-entity-handler new-msgdb) number
+ (elmo-message-file-name folder number)))
+ (if (null entity)
+ (elmo-folder-set-killed-list-internal
+ folder
+ (nconc
+ (elmo-folder-killed-list-internal folder)
+ (list number)))
+ (setq message-id (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table message-id))
+ (elmo-global-flags-set flags folder number message-id)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb))
(luna-define-method elmo-message-fetch
(luna-define-method elmo-folder-msgdb-create ((folder elmo-shimbun-folder)
numlist flag-table)
(let ((new-msgdb (elmo-make-msgdb))
- entity i percent length msgid flags)
- (setq length (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-shimbun-msgdb-create-entity
- folder (car numlist)))
- (when entity
- (setq msgid (elmo-message-entity-field entity 'message-id)
- flags (elmo-flag-table-get flag-table msgid))
- (elmo-global-flags-set flags folder (car numlist) msgid)
- (elmo-msgdb-append-entity new-msgdb entity flags))
- (when (> length elmo-display-progress-threshold)
- (setq i (1+ i))
- (setq percent (/ (* i 100) length))
- (elmo-display-progress
- 'elmo-folder-msgdb-create "Creating msgdb..."
- percent))
- (setq numlist (cdr numlist)))
- (message "Creating msgdb...done")
+ entity msgid flags)
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numlist))
+ "Creating msgdb"
+ (dolist (number numlist)
+ (setq entity (elmo-shimbun-msgdb-create-entity folder number))
+ (when entity
+ (setq msgid (elmo-message-entity-field entity 'message-id)
+ flags (elmo-flag-table-get flag-table msgid))
+ (elmo-global-flags-set flags folder number msgid)
+ (elmo-msgdb-append-entity new-msgdb entity flags))
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
new-msgdb))
(luna-define-method elmo-folder-message-file-p ((folder elmo-shimbun-folder))
count))
(defun elmo-split-subr (folder &optional reharsal)
- (let ((elmo-inhibit-display-retrieval-progress t)
- (count 0)
+ (let ((count 0)
(fcount 0)
(default-rule `((t ,elmo-split-default-action)))
msgs action target-folder failure delete-substance
(message "Splitting...")
(elmo-folder-open-internal folder)
(setq msgs (elmo-folder-list-messages folder))
- (elmo-progress-set 'elmo-split (length msgs) "Splitting...")
- (unwind-protect
- (progn
+ (elmo-with-progress-display (elmo-split (length msgs)) "Splitting messages"
+ (unwind-protect
(with-temp-buffer
(set-buffer-multibyte nil)
(dolist (msg msgs)
(unless (eq (nth 2 rule) 'continue)
(throw 'terminate nil))))))
(elmo-progress-notify 'elmo-split)))
- (elmo-folder-close-internal folder))
- (elmo-progress-clear 'elmo-split))
+ (elmo-folder-close-internal folder)))
(cons count fcount)))
(require 'product)
(setq list1 (cdr list1)))
(list clist1 clist2)))
-(defun elmo-list-bigger-diff (list1 list2 &optional mes)
- "Returns a list (- +). + is bigger than max of LIST1, in LIST2."
- (if (null list2)
- (cons list1 nil)
- (let* ((l1 list1)
- (l2 list2)
- (max-of-l2 (or (nth (max 0 (1- (length l2))) l2) 0))
- diff1 num i percent
- )
- (setq i 0)
- (setq num (+ (length l1)))
- (while l1
- (if (memq (car l1) l2)
- (if (eq (car l1) (car l2))
- (setq l2 (cdr l2))
- (delq (car l1) l2))
- (if (> (car l1) max-of-l2)
- (setq diff1 (nconc diff1 (list (car l1))))))
- (if mes
- (progn
- (setq i (+ i 1))
- (setq percent (/ (* i 100) num))
- (if (eq (% percent 5) 0)
- (elmo-display-progress
- 'elmo-list-bigger-diff "%s%d%%" percent mes))))
- (setq l1 (cdr l1)))
- (cons diff1 (list l2)))))
-
(defmacro elmo-get-hash-val (string hashtable)
(static-if (fboundp 'unintern)
`(symbol-value (intern-soft ,string ,hashtable))
(list 'error-message doc
'error-conditions (cons error conds))))))
-(cond ((fboundp 'progress-feedback-with-label)
- (defalias 'elmo-display-progress 'progress-feedback-with-label))
- ((fboundp 'lprogress-display)
- (defalias 'elmo-display-progress 'lprogress-display))
- (t
- (defun elmo-display-progress (label format &optional value &rest args)
- "Print a progress message."
- (if (and (null format) (null args))
- (message nil)
- (apply (function message) (concat format " %d%%")
- (nconc args (list value)))))))
+(defvar elmo-progress-counter nil)
-(defvar elmo-progress-counter-alist nil)
+(defalias 'elmo-progress-counter-label 'car-safe)
(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)))
+ `(aref (cdr ,counter) 0))
(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
- (elmo-progress-counter-format counter)
- 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))))))
+ `(aset (cdr ,counter) 0 ,value))
+
+(defmacro elmo-progress-counter-total (counter)
+ `(aref (cdr ,counter) 1))
+
+(defmacro elmo-progress-counter-set-total (counter value)
+ `(aset (cdr ,counter) 1 ,value))
+
+(defmacro elmo-progress-counter-action (counter)
+ `(aref (cdr ,counter) 2))
+
+(defmacro elmo-progress-counter-set-action (counter action)
+ `(aset (cdr ,counter) 2, action))
+
+(defvar elmo-progress-callback-function nil)
+
+(defun elmo-progress-call-callback (counter &optional value)
+ (when elmo-progress-callback-function
+ (funcall elmo-progress-callback-function
+ (elmo-progress-counter-label counter)
+ (elmo-progress-counter-action counter)
+ (or value
+ (elmo-progress-counter-value counter))
+ (elmo-progress-counter-total counter))))
+
+(defun elmo-progress-start (label total action)
+ (when (and (> total 0)
+ (null elmo-progress-counter))
+ (let ((counter (cons label (vector 0 total action))))
+ (elmo-progress-call-callback counter 'start)
+ (setq elmo-progress-counter
+ (if (elmo-progress-call-callback counter 'query)
+ (progn
+ (elmo-progress-call-callback counter)
+ counter)
+ t)))))
+
+(defun elmo-progress-done (counter)
+ (when counter
+ (when (elmo-progress-counter-label elmo-progress-counter)
+ (when (< (elmo-progress-counter-value counter)
+ (elmo-progress-counter-total counter))
+ (elmo-progress-call-callback counter 100))
+ (elmo-progress-call-callback counter 'done))
+ (when (eq counter elmo-progress-counter)
+ (setq elmo-progress-counter nil))))
+
+(defun elmo-progress-notify (label &rest params)
+ (when (and elmo-progress-counter
+ (eq (elmo-progress-counter-label elmo-progress-counter) label))
+ (let ((counter elmo-progress-counter))
+ (elmo-progress-counter-set-value
+ counter
+ (or (plist-get params :set)
+ (+ (elmo-progress-counter-value counter)
+ (or (plist-get params :inc)
+ (car params)
+ 1))))
+ (elmo-progress-call-callback counter))))
+
+(defmacro elmo-with-progress-display (spec message &rest body)
+ "Evaluate BODY with progress gauge if CONDITION is non-nil.
+SPEC is a list as followed (LABEL TOTAL [VAR])."
+ (let ((label (nth 0 spec))
+ (total (nth 1 spec))
+ (var (or (nth 2 spec) (make-symbol "--elmo-progress-temp--"))))
+ `(let ((,var (elmo-progress-start (quote ,label) ,total ,message)))
+ (unwind-protect
+ (progn
+ ,@body)
+ (elmo-progress-done ,var)))))
(put 'elmo-with-progress-display 'lisp-indent-function '2)
(def-edebug-spec elmo-with-progress-display
- (form (symbolp form &optional 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)))))
+ ((symbolp form &optional symbolp) form &rest form))
(defun elmo-time-expire (before-time diff-time)
(let* ((current (current-time))
oldest-entity))
(defun elmo-cache-get-sorted-cache-file-list ()
- (let ((dirs (directory-files
- elmo-cache-directory
- t "^[^\\.]"))
- (i 0) num
- elist
- ret-val)
- (setq num (length dirs))
- (message "Collecting cache info...")
- (while dirs
- (setq elist (mapcar (lambda (x)
- (elmo-cache-make-file-entity x (car dirs)))
- (directory-files (car dirs) nil "^[^\\.]")))
- (setq ret-val (append ret-val
- (list (cons
- (car dirs)
- (sort
- elist
- (lambda (x y)
- (< (cdr x)
- (cdr y))))))))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (elmo-display-progress
- 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
- (/ (* i 100) num)))
- (setq dirs (cdr dirs)))
- (message "Collecting cache info...done")
+ (let ((dirs (directory-files elmo-cache-directory t "^[^\\.]"))
+ elist ret-val)
+ (elmo-with-progress-display (elmo-collecting-cache (length dirs))
+ "Collecting cache info"
+ (dolist (dir dirs)
+ (setq elist (mapcar (lambda (x)
+ (elmo-cache-make-file-entity x dir))
+ (directory-files dir nil "^[^\\.]")))
+ (setq ret-val (append ret-val
+ (list (cons
+ dir
+ (sort
+ elist
+ (lambda (x y)
+ (< (cdr x)
+ (cdr y))))))))))
ret-val))
(defun elmo-cache-expire-by-age (&optional days)
(defvar elmo-use-decoded-cache (featurep 'xemacs)
"Use cache of decoded mime charset string.")
-(defvar elmo-display-progress-threshold 20
- "*Displaying progress gauge if number of messages are more than this value.")
-
(defvar elmo-inhibit-number-mapping nil
"Global switch to inhibit number mapping (e.g. Inhibit UIDL on POP3).")
-(defvar elmo-display-retrieval-progress-threshold 30000
- "*Don't display progress if the message size is smaller than this value.")
-
-(defvar elmo-inhibit-display-retrieval-progress nil
- "Global switch to inhibit display progress of each message's retrieval.")
-
(defvar elmo-dop-queue nil
"Global variable for storing disconnected operation queues.")
numbers))))
(setq numbers results
condition (nth 2 condition)))
- (let ((len (length numbers))
- matched)
- (elmo-with-progress-display (> len elmo-display-progress-threshold)
- (elmo-folder-search len "Searching...")
+ (let (matched)
+ (elmo-with-progress-display (elmo-folder-search (length numbers))
+ "Searching messages"
(dolist (number numbers)
(let (result)
(setq result (elmo-msgdb-match-condition msgdb
(when result
(setq matched (cons number matched))))
(elmo-progress-notify 'elmo-folder-search)))
- (message "Searching...done")
(nreverse matched)))))
(defun elmo-message-buffer-match-condition (condition number)
same-number)
(save-excursion
(let* ((messages msgs)
- (elmo-inhibit-display-retrieval-progress t)
(len (length msgs))
succeeds i result)
(if (eq dst-folder 'null)
2006-10-31 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * wl-util.el (wl-simple-display-progress): New function.
+ (wl-display-progress-with-gauge): Ditto.
+ (wl-progress-callback-function): Ditto.
+
+ * wl.el (wl-init): Set `elmo-progress-callback-function' as
+ `wl-progress-callback-function'
+
+ * wl-vars.el (wl-display-progress-threshold): New user option.
+ (wl-display-progress-function): Ditto.
+
* Version number is increased to 2.15.5.
2006-09-28 Yoichi NAKAYAMA <yoichi@geiin.org>
(let ((start (point))
(refiles (mapcar 'car mark-list))
(refile-failures 0)
- refile-len
dst-msgs ; loop counter
result)
;; begin refile...
- (setq refile-len (length refiles))
(goto-char start) ; avoid moving cursor to
; the bottom line.
- (message message)
- (when (> refile-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- refile-len message))
- (setq result nil)
- (condition-case nil
- (setq result (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- refiles
- (if (eq folder-name 'null)
- 'null
- (wl-folder-get-elmo-folder folder-name))))
- (error nil))
- (when result ; succeeded.
- ;; update buffer.
- (wl-summary-delete-messages-on-buffer refiles)
- ;; update wl-summary-buffer-temp-mark-list.
- (dolist (mark-info mark-list)
- (setq wl-summary-buffer-temp-mark-list
- (delq mark-info wl-summary-buffer-temp-mark-list))))
- (elmo-progress-clear 'elmo-folder-move-messages)
- (message (concat message "done"))
+ (elmo-with-progress-display
+ (elmo-folder-move-messages (length refiles))
+ message
+ (setq result nil)
+ (condition-case nil
+ (setq result (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ refiles
+ (if (eq folder-name 'null)
+ 'null
+ (wl-folder-get-elmo-folder folder-name))))
+ (error nil))
+ (when result ; succeeded.
+ ;; update buffer.
+ (wl-summary-delete-messages-on-buffer refiles)
+ ;; update wl-summary-buffer-temp-mark-list.
+ (dolist (mark-info mark-list)
+ (setq wl-summary-buffer-temp-mark-list
+ (delq mark-info wl-summary-buffer-temp-mark-list)))))
(wl-summary-set-message-modified)
;; Return the operation failed message numbers.
(if result
(wl-summary-move-mark-list-messages mark-list
(wl-summary-get-dispose-folder
(wl-summary-buffer-folder-name))
- "Disposing messages..."))
+ "Disposing messages"))
;; Delete action.
(defun wl-summary-exec-action-delete (mark-list)
(wl-summary-move-mark-list-messages mark-list
'null
- "Deleting messages..."))
+ "Deleting messages"))
;; Refile action
(defun wl-summary-set-action-refile (number mark data)
(save-excursion
(let ((start (point))
(failures 0)
- (refile-len (length mark-list))
dst-msgs)
;; begin refile...
(setq dst-msgs (wl-summary-make-destination-numbers-list mark-list))
(goto-char start) ; avoid moving cursor to the bottom line.
- (when (> refile-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- refile-len "Refiling messages..."))
- (dolist (pair dst-msgs)
- (if (condition-case nil
- (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- (cdr pair)
- (wl-folder-get-elmo-folder (car pair)))
- (error nil))
- (progn
- ;; update buffer.
- (wl-summary-delete-messages-on-buffer (cdr pair))
- (setq wl-summary-buffer-temp-mark-list
- (wl-delete-associations
- (cdr pair)
- wl-summary-buffer-temp-mark-list)))
- (setq failures (+ failures (length (cdr pair))))))
- (elmo-progress-clear 'elmo-folder-move-messages)
- (if (<= failures 0)
- (message "Refiling messages...done"))
+ (elmo-with-progress-display
+ (elmo-folder-move-messages (length mark-list))
+ "Refiling messages"
+ (dolist (pair dst-msgs)
+ (if (condition-case nil
+ (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr pair)
+ (wl-folder-get-elmo-folder (car pair)))
+ (error nil))
+ (progn
+ ;; update buffer.
+ (wl-summary-delete-messages-on-buffer (cdr pair))
+ (setq wl-summary-buffer-temp-mark-list
+ (wl-delete-associations
+ (cdr pair)
+ wl-summary-buffer-temp-mark-list)))
+ (setq failures (+ failures (length (cdr pair)))))))
failures)))
;; Copy action
(save-excursion
(let ((start (point))
(failures 0)
- (refile-len (length mark-list))
dst-msgs)
;; begin refile...
(setq dst-msgs
(wl-summary-make-destination-numbers-list mark-list))
(goto-char start) ; avoid moving cursor to the bottom line.
- (when (> refile-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- refile-len "Copying messages..."))
- (dolist (pair dst-msgs)
- (if (condition-case nil
- (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- (cdr pair)
- (wl-folder-get-elmo-folder (car pair))
- 'no-delete)
- (error nil))
- (progn
- ;; update buffer.
- (wl-summary-delete-copy-marks-on-buffer (cdr pair))
- (setq wl-summary-buffer-temp-mark-list
- (wl-delete-associations
- (cdr pair)
- wl-summary-buffer-temp-mark-list)))
- (setq failures (+ failures (length (cdr pair))))))
- (elmo-progress-clear 'elmo-folder-move-messages)
- (if (<= failures 0)
- (message "Copying messages...done"))
+ (elmo-with-progress-display
+ (elmo-folder-move-messages (length mark-list))
+ "Copying messages"
+ (dolist (pair dst-msgs)
+ (if (condition-case nil
+ (elmo-folder-move-messages
+ wl-summary-buffer-elmo-folder
+ (cdr pair)
+ (wl-folder-get-elmo-folder (car pair))
+ 'no-delete)
+ (error nil))
+ (progn
+ ;; update buffer.
+ (wl-summary-delete-copy-marks-on-buffer (cdr pair))
+ (setq wl-summary-buffer-temp-mark-list
+ (wl-delete-associations
+ (cdr pair)
+ wl-summary-buffer-temp-mark-list)))
+ (setq failures (+ failures (length (cdr pair)))))))
failures)))
;; Prefetch.
(wl-highlight-folder-current-line))
(setq removed (cdr removed)))
(remove-text-properties beg (point) '(wl-folder-entity-id)))
- (let* ((len (length flist))
- (mes (> len 100))
- (i 0))
+ (elmo-with-progress-display
+ (wl-folder-insert-entity (length flist))
+ (format "Inserting group %s" (car entity))
(while flist
(setq ret-val
(wl-folder-insert-entity
(setq new (+ (or new 0) (or (nth 0 ret-val) 0)))
(setq unread (+ (or unread 0) (or (nth 1 ret-val) 0)))
(setq all (+ (or all 0) (or (nth 2 ret-val) 0)))
- (when (and mes
- (> len elmo-display-progress-threshold))
- (setq i (1+ i))
- (elmo-display-progress
- 'wl-folder-insert-entity "Inserting group %s..."
- (/ (* i 100) len) (car entity)))
- (setq flist (cdr flist)))
- (if (> len 0)
- (message "Inserting group %s...done" (car entity))))
+ (elmo-progress-notify 'wl-folder-insert-entity)
+ (setq flist (cdr flist))))
(save-excursion
(goto-char group-name-end)
(delete-region (point) (save-excursion (end-of-line)
(erase-buffer)
(wl-folder-insert-entity " " wl-folder-entity)
(wl-folder-move-path id))
- (message "Opening all folders...")
- (wl-folder-open-all-pre)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$"
- nil t)
- (setq indent (wl-match-buffer 1))
- (setq name (wl-folder-get-entity-from-buffer))
- (setq entity (wl-folder-search-group-entity-by-name
- name
- wl-folder-entity))
- ;; insert as opened
- (setcdr (assoc (car entity) wl-folder-group-alist) t)
- (beginning-of-line)
- (wl-folder-insert-entity indent entity)
- (delete-region (save-excursion (beginning-of-line)
- (point))
- (save-excursion (end-of-line)
- (+ 1 (point))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 5)) (= i len))
- (elmo-display-progress
- 'wl-folder-open-all "Opening all folders..."
- (/ (* i 100) len)))))
- (when (> len elmo-display-progress-threshold)
- (elmo-display-progress
- 'wl-folder-open-all "Opening all folders..." 100))))
+ (elmo-with-progress-display
+ (wl-folder-open-all (length wl-folder-group-alist))
+ "Opening all folders"
+ (wl-folder-open-all-pre)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\([ ]*\\)\\[\\([+]\\)\\]\\(.+\\):[-0-9-]+/[0-9-]+/[0-9-]+$"
+ nil t)
+ (setq indent (wl-match-buffer 1))
+ (setq name (wl-folder-get-entity-from-buffer))
+ (setq entity (wl-folder-search-group-entity-by-name
+ name
+ wl-folder-entity))
+ ;; insert as opened
+ (setcdr (assoc (car entity) wl-folder-group-alist) t)
+ (beginning-of-line)
+ (wl-folder-insert-entity indent entity)
+ (delete-region (save-excursion (beginning-of-line)
+ (point))
+ (save-excursion (end-of-line)
+ (+ 1 (point))))
+ (elmo-progress-notify 'wl-folder-open-all)))))
(wl-highlight-folder-path wl-folder-buffer-cur-path)
- (message "Opening all folders...done")
(set-buffer-modified-p nil)))
(defun wl-folder-close-all ()
t)))
(defun wl-folder-update-access-group (entity new-flist)
- (let* ((flist (nth 2 entity))
- (unsubscribes (nth 3 entity))
- (len (+ (length flist) (length unsubscribes)))
- (i 0)
- diff new-unsubscribes removes
- subscribed-list folder group entry)
- ;; check subscribed groups
- (while flist
- (cond
- ((listp (car flist)) ;; group
- (setq group (elmo-string (caar flist)))
+ (let ((flist (nth 2 entity))
+ (unsubscribes (nth 3 entity))
+ diff new-unsubscribes removes
+ subscribed-list folder group entry)
+ (elmo-with-progress-display
+ (wl-folder-update-access-group (+ (length flist) (length unsubscribes)))
+ "Updating access group"
+ ;; check subscribed groups
+ (while flist
(cond
- ((assoc group new-flist) ;; found in new-flist
- (setq new-flist (delete (assoc group new-flist)
- new-flist))
- (if (wl-folder-access-subscribe-p (car entity) group)
- (wl-append subscribed-list (list (car flist)))
- (wl-append new-unsubscribes (list (car flist)))
- (setq diff t)))
- (t
- (setq wl-folder-group-alist
- (delete (wl-string-assoc group wl-folder-group-alist)
- wl-folder-group-alist))
- (wl-append removes (list (list group))))))
- (t ;; folder
- (setq folder (elmo-string (car flist)))
+ ((listp (car flist)) ;; group
+ (setq group (elmo-string (caar flist)))
+ (cond
+ ((assoc group new-flist) ;; found in new-flist
+ (setq new-flist (delete (assoc group new-flist)
+ new-flist))
+ (if (wl-folder-access-subscribe-p (car entity) group)
+ (wl-append subscribed-list (list (car flist)))
+ (wl-append new-unsubscribes (list (car flist)))
+ (setq diff t)))
+ (t
+ (setq wl-folder-group-alist
+ (delete (wl-string-assoc group wl-folder-group-alist)
+ wl-folder-group-alist))
+ (wl-append removes (list (list group))))))
+ (t ;; folder
+ (setq folder (elmo-string (car flist)))
+ (cond
+ ((member folder new-flist) ;; found in new-flist
+ (setq new-flist (delete folder new-flist))
+ (if (wl-folder-access-subscribe-p (car entity) folder)
+ (wl-append subscribed-list (list (car flist)))
+ (wl-append new-unsubscribes (list folder))
+ (setq diff t)))
+ (t
+ (wl-append removes (list folder))))))
+ (elmo-progress-notify 'wl-folder-update-access-group)
+ (setq flist (cdr flist)))
+ ;; check unsubscribed groups
+ (while unsubscribes
(cond
- ((member folder new-flist) ;; found in new-flist
- (setq new-flist (delete folder new-flist))
- (if (wl-folder-access-subscribe-p (car entity) folder)
- (wl-append subscribed-list (list (car flist)))
- (wl-append new-unsubscribes (list folder))
- (setq diff t)))
+ ((listp (car unsubscribes))
+ (when (setq entry (assoc (caar unsubscribes) new-flist))
+ (setq new-flist (delete entry new-flist))
+ (wl-append new-unsubscribes (list (car unsubscribes)))))
(t
- (wl-append removes (list folder))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'wl-folder-update-access-group "Updating access group..."
- (/ (* i 100) len))))
- (setq flist (cdr flist)))
- ;; check unsubscribed groups
- (while unsubscribes
- (cond
- ((listp (car unsubscribes))
- (when (setq entry (assoc (caar unsubscribes) new-flist))
- (setq new-flist (delete entry new-flist))
- (wl-append new-unsubscribes (list (car unsubscribes)))))
- (t
- (when (member (car unsubscribes) new-flist)
- (setq new-flist (delete (car unsubscribes) new-flist))
- (wl-append new-unsubscribes (list (car unsubscribes))))))
- (when (> len elmo-display-progress-threshold)
- (setq i (1+ i))
- (if (or (zerop (% i 10)) (= i len))
- (elmo-display-progress
- 'wl-folder-update-access-group "Updating access group..."
- (/ (* i 100) len))))
- (setq unsubscribes (cdr unsubscribes)))
- ;;
- (if (or new-flist removes)
- (setq diff t))
- (setq new-flist
- (mapcar '(lambda (x)
- (cond ((consp x) (list (car x) 'access))
- (t x)))
- new-flist))
- ;; check new groups
- (let ((new-list new-flist))
- (while new-list
- (if (not (wl-folder-access-subscribe-p
- (car entity)
- (if (listp (car new-list))
- (caar new-list)
- (car new-list))))
- ;; auto unsubscribe
- (progn
- (wl-append new-unsubscribes (list (car new-list)))
- (setq new-flist (delete (car new-list) new-flist)))
- (cond
- ((listp (car new-list))
- ;; check group exists
- (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
- (progn
- (message "%s: group already exists." (caar new-list))
- (sit-for 1)
- (wl-append new-unsubscribes (list (car new-list)))
- (setq new-flist (delete (car new-list) new-flist)))
- (wl-append wl-folder-group-alist
- (list (cons (caar new-list) nil)))))))
- (setq new-list (cdr new-list))))
- (if new-flist
- (message "%d new folder(s)." (length new-flist))
- (message "Updating access group...done"))
+ (when (member (car unsubscribes) new-flist)
+ (setq new-flist (delete (car unsubscribes) new-flist))
+ (wl-append new-unsubscribes (list (car unsubscribes))))))
+ (elmo-progress-notify 'wl-folder-update-access-group)
+ (setq unsubscribes (cdr unsubscribes)))
+ ;;
+ (if (or new-flist removes)
+ (setq diff t))
+ (setq new-flist
+ (mapcar '(lambda (x)
+ (cond ((consp x) (list (car x) 'access))
+ (t x)))
+ new-flist))
+ ;; check new groups
+ (let ((new-list new-flist))
+ (while new-list
+ (if (not (wl-folder-access-subscribe-p
+ (car entity)
+ (if (listp (car new-list))
+ (caar new-list)
+ (car new-list))))
+ ;; auto unsubscribe
+ (progn
+ (wl-append new-unsubscribes (list (car new-list)))
+ (setq new-flist (delete (car new-list) new-flist)))
+ (cond
+ ((listp (car new-list))
+ ;; check group exists
+ (if (wl-string-assoc (caar new-list) wl-folder-group-alist)
+ (progn
+ (message "%s: group already exists." (caar new-list))
+ (sit-for 1)
+ (wl-append new-unsubscribes (list (car new-list)))
+ (setq new-flist (delete (car new-list) new-flist)))
+ (wl-append wl-folder-group-alist
+ (list (cons (caar new-list) nil)))))))
+ (setq new-list (cdr new-list)))))
+ (when new-flist
+ (message "%d new folder(s)." (length new-flist)))
(wl-append new-flist subscribed-list) ;; new is first
(run-hooks 'wl-folder-update-access-group-hook)
(setcdr (cdr entity) (list new-flist new-unsubscribes))
(wl-score-headers scores force-msgs not-add))))
(defun wl-summary-score-update-all-lines (&optional update)
- (let* ((alist wl-summary-scored)
- (count (length alist))
- (i 0)
- (update-unread nil)
- wl-summary-unread-message-hook
- num score dels visible score-mark mark-alist)
+ (let ((alist wl-summary-scored)
+ (update-unread nil)
+ wl-summary-unread-message-hook
+ num score dels visible score-mark mark-alist)
(save-excursion
- (message "Updating score...")
- (while alist
- (setq num (caar alist)
- score (cdar alist))
- (when wl-score-debug
- (message "Scored %d with %d" score num)
- (wl-push (list (elmo-string (wl-summary-buffer-folder-name)) num score)
- wl-score-trace))
- (setq score-mark (wl-summary-get-score-mark num))
- (and (setq visible (wl-summary-jump-to-msg num))
- (wl-summary-set-score-mark score-mark))
- (cond ((and wl-summary-expunge-below
- (< score wl-summary-expunge-below))
- (wl-push num dels))
- ((< score wl-summary-mark-below)
- (if visible
- (wl-summary-mark-as-read num); opened
- (setq update-unread t)
- (wl-summary-mark-as-read num))) ; closed
- ((and wl-summary-important-above
- (> score wl-summary-important-above))
- (if (wl-thread-jump-to-msg num);; force open
- (wl-summary-set-persistent-mark 'important num)))
- ((and wl-summary-target-above
- (> score wl-summary-target-above))
- (if visible
- (wl-summary-set-mark "*"))))
- (setq alist (cdr alist))
- (when (> count elmo-display-progress-threshold)
- (setq i (1+ i))
- (elmo-display-progress
- 'wl-summary-score-update-all-lines "Updating score..."
- (/ (* i 100) count))))
- (when dels
- (dolist (del dels)
- (elmo-message-unset-flag wl-summary-buffer-elmo-folder
- del 'unread))
- (elmo-folder-kill-messages wl-summary-buffer-elmo-folder dels)
- (wl-summary-delete-messages-on-buffer dels))
- (when (and update update-unread)
- ;; Update Folder mode
- (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
- (list
- 0
- (let ((flag-count
- (wl-summary-count-unread)))
- (or (cdr (assq 'unread flag-count))
- 0))
- (elmo-folder-length
- wl-summary-buffer-elmo-folder)))
- (wl-summary-update-modeline))
- (message "Updating score...done")
+ (elmo-with-progress-display (wl-update-score (length alist))
+ "Updating score"
+ (while alist
+ (setq num (caar alist)
+ score (cdar alist))
+ (when wl-score-debug
+ (message "Scored %d with %d" score num)
+ (wl-push (list (elmo-string (wl-summary-buffer-folder-name)) num score)
+ wl-score-trace))
+ (setq score-mark (wl-summary-get-score-mark num))
+ (and (setq visible (wl-summary-jump-to-msg num))
+ (wl-summary-set-score-mark score-mark))
+ (cond ((and wl-summary-expunge-below
+ (< score wl-summary-expunge-below))
+ (wl-push num dels))
+ ((< score wl-summary-mark-below)
+ (if visible
+ (wl-summary-mark-as-read num); opened
+ (setq update-unread t)
+ (wl-summary-mark-as-read num))) ; closed
+ ((and wl-summary-important-above
+ (> score wl-summary-important-above))
+ (if (wl-thread-jump-to-msg num);; force open
+ (wl-summary-set-persistent-mark 'important num)))
+ ((and wl-summary-target-above
+ (> score wl-summary-target-above))
+ (if visible
+ (wl-summary-set-mark "*"))))
+ (setq alist (cdr alist))
+ (elmo-progress-notify 'wl-update-score))
+ (when dels
+ (dolist (del dels)
+ (elmo-message-unset-flag wl-summary-buffer-elmo-folder
+ del 'unread))
+ (elmo-folder-kill-messages wl-summary-buffer-elmo-folder dels)
+ (wl-summary-delete-messages-on-buffer dels))
+ (when (and update update-unread)
+ ;; Update Folder mode
+ (wl-folder-set-folder-updated (wl-summary-buffer-folder-name)
+ (list
+ 0
+ (let ((flag-count
+ (wl-summary-count-unread)))
+ (or (cdr (assq 'unread flag-count))
+ 0))
+ (elmo-folder-length
+ wl-summary-buffer-elmo-folder)))
+ (wl-summary-update-modeline)))
dels)))
(defun wl-score-edit-done ()
wl-spam-auto-check-marks)))
(defsubst wl-spam-map-spam-messages (folder numbers function &rest args)
- (let ((total (length numbers)))
- (message "Checking spam...")
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-spam-check-spam total "Checking spam...")
- (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
- folder
- numbers))
- (apply function number args)))
- (message "Checking spam...done")))
+ (elmo-with-progress-display (elmo-spam-check-spam (length numbers))
+ "Checking spam"
+ (dolist (number (elmo-spam-list-spam-messages (elmo-spam-processor)
+ folder
+ numbers))
+ (apply function number args))))
(defun wl-spam-apply-partitions (folder partitions function msg)
(when partitions
(let ((total 0))
(dolist (partition partitions)
(setq total (+ total (length (cdr partition)))))
- (message msg)
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-spam-register total msg)
+ (elmo-with-progress-display (elmo-spam-register total) msg
(dolist (partition partitions)
- (funcall function folder (cdr partition) (car partition))))
- (message (concat msg "done")))))
+ (funcall function folder (cdr partition) (car partition)))))))
(defun wl-spam-register-spam-messages (folder numbers)
- (let ((total (length numbers)))
- (message "Registering spam...")
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-spam-register total "Registering spam...")
- (elmo-spam-register-spam-messages (elmo-spam-processor)
- folder
- numbers))
- (message "Registering spam...done")))
+ (elmo-with-progress-display (elmo-spam-register (length numbers))
+ "Registering spam"
+ (elmo-spam-register-spam-messages (elmo-spam-processor)
+ folder
+ numbers)))
(defun wl-spam-register-good-messages (folder numbers)
- (let ((total (length numbers)))
- (message "Registering good...")
- (elmo-with-progress-display (> total elmo-display-progress-threshold)
- (elmo-spam-register total "Registering good...")
- (elmo-spam-register-good-messages (elmo-spam-processor)
- folder
- numbers))
- (message "Registering good...done")))
+ (elmo-with-progress-display (elmo-spam-register (length numbers))
+ "Registering good"
+ (elmo-spam-register-good-messages (elmo-spam-processor)
+ folder
+ numbers)))
(defun wl-spam-save-status (&optional force)
(interactive "P")
(elmo-spam-register-spam-messages (elmo-spam-processor)
folder numbers
(eq domain 'good)))
- "Registering spam...")
+ "Registering spam")
(wl-summary-move-mark-list-messages mark-list
wl-spam-folder
- "Refiling spam...")))
+ "Refiling spam")))
(defun wl-summary-exec-action-refile-with-register (mark-list)
(let ((folder wl-summary-buffer-elmo-folder)
(elmo-spam-register-spam-messages (elmo-spam-processor)
folder numbers
(eq domain 'good)))
- "Registering spam...")
+ "Registering spam")
(wl-spam-apply-partitions
folder
(wl-filter-associations '(undecided spam)
(elmo-spam-register-good-messages (elmo-spam-processor)
folder numbers
(eq domain 'spam)))
- "Registering good...")
+ "Registering good")
;; execute refile messages
(wl-summary-exec-action-refile mark-list)))
(and disable-thread wl-summary-search-parent-by-subject-regexp))
(wl-summary-divide-thread-when-subject-changed
(and disable-thread wl-summary-divide-thread-when-subject-changed))
- (i 0)
num
expunged)
(erase-buffer)
wl-summary-buffer-temp-mark-list nil
wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
- (while numbers
- (wl-summary-insert-message (elmo-message-entity
- wl-summary-buffer-elmo-folder
- (car numbers))
- wl-summary-buffer-elmo-folder
- nil)
- (setq numbers (cdr numbers))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'wl-summary-rescan "Constructing summary structure..."
- (/ (* i 100) num)))))
- (when wl-summary-delayed-update
+ (elmo-with-progress-display (wl-summary-insert-line num)
+ "Constructing summary structure"
+ (dolist (number numbers)
+ (wl-summary-insert-message (elmo-message-entity
+ wl-summary-buffer-elmo-folder
+ number)
+ wl-summary-buffer-elmo-folder
+ nil))
(while wl-summary-delayed-update
(message "Parent (%d) of message %d is no entity"
(caar wl-summary-delayed-update)
(cdar wl-summary-delayed-update)
wl-summary-buffer-elmo-folder nil t)
(setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
- (message "Constructing summary structure...done")
- (if (eq wl-summary-buffer-view 'thread)
- (progn
- (message "Inserting thread...")
- (wl-thread-insert-top)
- (message "Inserting thread...done")))
+ (when (eq wl-summary-buffer-view 'thread)
+ (wl-thread-insert-top))
(when wl-use-scoring
(wl-summary-score-headers (wl-summary-rescore-msgs
wl-summary-buffer-number-list)
"All uncached messages are cached."
(interactive)
(unless (elmo-folder-local-p wl-summary-buffer-elmo-folder)
- (let ((targets (elmo-folder-list-flagged wl-summary-buffer-elmo-folder
- 'uncached 'in-msgdb))
- (count 0)
- wl-prefetch-confirm
- wl-prefetch-threshold
- (elmo-inhibit-display-retrieval-progress t)
- length msg)
+ (let* ((targets (elmo-folder-list-flagged wl-summary-buffer-elmo-folder
+ 'uncached 'in-msgdb))
+ (count 0)
+ wl-prefetch-confirm
+ wl-prefetch-threshold
+ (length (length targets))
+ msg)
(save-excursion
- (goto-char (point-min))
- (setq length (length targets))
- (dolist (target targets)
- (when (if (not (wl-thread-entity-parent-invisible-p
- (wl-thread-get-entity target)))
- (progn
- (wl-summary-jump-to-msg target)
- (wl-summary-prefetch-msg
- (wl-summary-message-number)))
- (wl-summary-prefetch-msg target))
- (message "Retrieving... %d/%d" (incf count) length)))
+ (elmo-with-progress-display (wl-summary-prefetch-message length)
+ "Retrieving"
+ (goto-char (point-min))
+ (dolist (target targets)
+ (when (if (not (wl-thread-entity-parent-invisible-p
+ (wl-thread-get-entity target)))
+ (progn
+ (wl-summary-jump-to-msg target)
+ (wl-summary-prefetch-msg
+ (wl-summary-message-number)))
+ (wl-summary-prefetch-msg target))
+ (incf count))
+ (elmo-progress-notify 'wl-summary-prefetch-message)))
(message "Retrieved %d/%d message(s)" count length)))))
(defun wl-summary-prefetch-msg (number &optional arg)
(delete-char 1) ; delete '\n'
(setq wl-summary-buffer-number-list
(delq (car msgs) wl-summary-buffer-number-list)))))
-; (when (> len elmo-display-progress-threshold)
-; (setq i (1+ i))
-; (if (or (zerop (% i 5)) (= i len))
-; (elmo-display-progress
-; 'wl-summary-delete-messages-on-buffer deleting-info
-; (/ (* i 100) len))))
(setq msgs (cdr msgs)))
(when (eq wl-summary-buffer-view 'thread)
- (wl-thread-update-line-msgs (elmo-uniq-list update-list))
- (wl-thread-cleanup-symbols msgs2))
+ (let ((updates (elmo-uniq-list update-list)))
+ (elmo-with-progress-display (wl-thread-update-line (length updates))
+ "Updating deleted thread"
+ (wl-thread-update-line-msgs updates)
+ (wl-thread-cleanup-symbols msgs2))))
;;(message (concat deleting-info "done"))
(wl-summary-count-unread)
(wl-summary-update-modeline)
(not wl-summary-lazy-highlight)))
append-list delete-list
update-thread update-top-list
- num diff entity
- (i 0))
+ num diff entity)
;; Setup sync-all
(if sync-all (wl-summary-sync-all-init))
(setq diff (elmo-list-diff (elmo-folder-list-messages
(setq num (length append-list))
(setq wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
- (dolist (number append-list)
- (setq entity (elmo-message-entity folder number))
- (when (setq update-thread
- (wl-summary-insert-message
- entity folder
- (not sync-all)))
- (wl-append update-top-list update-thread))
- (if elmo-use-database
- (elmo-database-msgid-put
- (elmo-message-entity-field entity 'message-id)
- (elmo-folder-name-internal folder)
- (elmo-message-entity-number entity)))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'wl-summary-sync-update
- (if (eq wl-summary-buffer-view 'thread)
- "Making thread..."
- "Inserting message...")
- (/ (* i 100) num)))))
- (when wl-summary-delayed-update
+ (elmo-with-progress-display (wl-summary-insert-line num)
+ (if (eq wl-summary-buffer-view 'thread)
+ "Making thread"
+ "Inserting message")
+ (dolist (number append-list)
+ (setq entity (elmo-message-entity folder number))
+ (when (setq update-thread
+ (wl-summary-insert-message
+ entity folder
+ (not sync-all)))
+ (wl-append update-top-list update-thread))
+ (if elmo-use-database
+ (elmo-database-msgid-put
+ (elmo-message-entity-field entity 'message-id)
+ (elmo-folder-name-internal folder)
+ (elmo-message-entity-number entity))))
(while wl-summary-delayed-update
(message "Parent (%d) of message %d is no entity"
(caar wl-summary-delayed-update)
(not sync-all) t))
(wl-append update-top-list update-thread))
(setq wl-summary-delayed-update
- (cdr wl-summary-delayed-update))))
- (when (and (eq wl-summary-buffer-view 'thread)
- update-top-list)
- (wl-thread-update-indent-string-thread
- (elmo-uniq-list update-top-list)))
- (message (if (eq wl-summary-buffer-view 'thread)
- "Making thread...done"
- "Inserting message...done"))
+ (cdr wl-summary-delayed-update)))
+ (when (and (eq wl-summary-buffer-view 'thread)
+ update-top-list)
+ (wl-thread-update-indent-string-thread
+ (elmo-uniq-list update-top-list))))
(when (or delete-list append-list)
(wl-summary-set-message-modified))
(when (and sync-all (eq wl-summary-buffer-view 'thread))
(elmo-kill-buffer wl-summary-search-buf-name)
- (message "Inserting message...")
- (wl-thread-insert-top)
- (message "Inserting message...done"))
+ (wl-thread-insert-top))
(if elmo-use-database
(elmo-database-close))
(run-hooks 'wl-summary-sync-updated-hook)
(defun wl-summary-highlight-msgs (msgs)
(save-excursion
- (let ((len (length msgs))
- i)
- (message "Hilighting...")
- (setq i 0)
+ (elmo-with-progress-display (wl-summary-highlight-line (length msgs))
+ "Hilighting"
(while msgs
(if (wl-summary-jump-to-msg (car msgs))
(wl-highlight-summary-current-line))
(setq msgs (cdr msgs))
- (when (> len elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i len))
- (elmo-display-progress
- 'wl-summary-highlight-msgs "Highlighting..."
- (/ (* i 100) len)))))
- (message "Highlighting...done"))))
+ (elmo-progress-notify 'wl-summary-highlight-line)))))
(defun wl-summary-message-number ()
(save-excursion
(save-excursion (beginning-of-line)(point))
(save-excursion (end-of-line)(point))
'mouse-face nil))
+ (elmo-progress-notify 'wl-summary-insert-line)
(ignore-errors
(run-hooks 'wl-summary-line-inserted-hook)))
(defun wl-thread-close-all ()
"Close all top threads."
(interactive)
- (message "Closing all threads...")
- (save-excursion
- (let ((entities wl-thread-entity-list)
- (cur 0)
- (len (length wl-thread-entity-list)))
- (while entities
+ (elmo-with-progress-display
+ (wl-thread-close-all (length wl-thread-entity-list))
+ "Closing all threads"
+ (save-excursion
+ (dolist (entity wl-thread-entity-list)
(when (and (wl-thread-entity-get-opened (wl-thread-get-entity
- (car entities)))
+ entity))
(wl-thread-entity-get-children (wl-thread-get-entity
- (car entities))))
- (wl-summary-jump-to-msg (car entities))
+ entity)))
+ (wl-summary-jump-to-msg entity)
(wl-thread-open-close))
- (when (> len elmo-display-progress-threshold)
- (setq cur (1+ cur))
- (if (or (zerop (% cur 5)) (= cur len))
- (elmo-display-progress
- 'wl-thread-close-all "Closing all threads..."
- (/ (* cur 100) len))))
- (setq entities (cdr entities)))))
- (message "Closing all threads...done"))
+ (elmo-progress-notify 'wl-thread-close-all)))))
(defun wl-thread-open-all ()
"Open all threads."
(interactive)
- (message "Opening all threads...")
- (save-excursion
- (goto-char (point-min))
- (let ((len (count-lines (point-min) (point-max)))
- (cur 0)
- entity)
+ (elmo-with-progress-display
+ (wl-thread-open-all (count-lines (point-min) (point-max)))
+ "Opening all threads"
+ (save-excursion
+ (goto-char (point-min))
(while (not (eobp))
(if (wl-thread-entity-get-opened
- (setq entity (wl-thread-get-entity
- (wl-summary-message-number))))
+ (wl-thread-get-entity (wl-summary-message-number)))
(forward-line 1)
(wl-thread-force-open)
(wl-thread-goto-bottom-of-sub-thread))
- (when (> len elmo-display-progress-threshold)
- (setq cur (1+ cur))
- (elmo-display-progress
- 'wl-thread-open-all "Opening all threads..."
- (/ (* cur 100) len)))))
- ;; Make sure to be 100%.
- (elmo-display-progress
- 'wl-thread-open-all "Opening all threads..."
- 100))
- (message "Opening all threads...done"))
+ (elmo-progress-notify 'wl-thread-open-all)))))
(defun wl-thread-open-all-unread ()
(interactive)
(wl-thread-get-entity (car msgs)))))))))
updates))
-(defun wl-thread-update-line-msgs (msgs &optional no-msg)
+(defun wl-thread-update-line-msgs (msgs)
(wl-delete-all-overlays)
- (let ((i 0)
- (updates msgs)
- len)
-;;; (while msgs
-;;; (setq updates
-;;; (append updates
-;;; (wl-thread-get-children-msgs (car msgs))))
-;;; (setq msgs (cdr msgs)))
-;;; (setq updates (elmo-uniq-list updates))
- (setq len (length updates))
- (while updates
- (wl-thread-update-line-on-buffer-sub nil (car updates))
- (setq updates (cdr updates))
- (when (and (not no-msg)
- (> len elmo-display-progress-threshold))
- (setq i (1+ i))
- (if (or (zerop (% i 5)) (= i len))
- (elmo-display-progress
- 'wl-thread-update-line-msgs "Updating deleted thread..."
- (/ (* i 100) len)))))))
+ (dolist (message msgs)
+ (wl-thread-update-line-on-buffer-sub nil message)
+ (elmo-progress-notify 'wl-thread-update-line)))
(defun wl-thread-delete-line-from-buffer (msg)
"Simply delete msg line."
ret))
(defun wl-thread-update-indent-string-thread (top-list)
- (let* ((top-list (wl-thread-get-parent-list top-list))
- (num (length top-list))
- (i 0)
- beg)
- (while top-list
- (when (> num elmo-display-progress-threshold)
- (setq i (1+ i))
- (when (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'wl-thread-update-indent-string-thread
- "Updating thread indent..."
- (/ (* i 100) num))))
- (when (car top-list)
- (wl-summary-jump-to-msg (car top-list))
- (setq beg (point))
- (wl-thread-goto-bottom-of-sub-thread)
- (wl-thread-update-indent-string-region beg (point)))
- (setq top-list (cdr top-list)))
- (message "Updating thread indent...done")))
+ (let ((top-list (wl-thread-get-parent-list top-list))
+ beg)
+ (elmo-with-progress-display
+ (wl-thread-update-indent-string-thread (length top-list))
+ "Updating thread indent"
+ (while top-list
+ (when (car top-list)
+ (wl-summary-jump-to-msg (car top-list))
+ (setq beg (point))
+ (wl-thread-goto-bottom-of-sub-thread)
+ (wl-thread-update-indent-string-region beg (point)))
+ (elmo-progress-notify 'wl-thread-update-indent-string-thread)
+ (setq top-list (cdr top-list))))))
(defun wl-thread-update-children-number (entity)
"Update the children number."
(defun wl-thread-insert-top ()
(let ((elist wl-thread-entity-list)
- (len (length wl-thread-entity-list))
- (cur 0))
- (wl-delete-all-overlays)
- (while elist
- (wl-thread-insert-entity
- 0
- (wl-thread-get-entity (car elist))
- nil
- len)
- (setq elist (cdr elist))
- (when (> len elmo-display-progress-threshold)
- (setq cur (1+ cur))
- (if (or (zerop (% cur 2)) (= cur len))
- (elmo-display-progress
- 'wl-thread-insert-top "Inserting message..."
- (/ (* cur 100) len)))))))
+ (len (length wl-thread-entity-list)))
+ (elmo-with-progress-display
+ (wl-thread-insert-entity (length wl-thread-entity-list))
+ "Inserting message"
+ (wl-delete-all-overlays)
+ (while elist
+ (wl-thread-insert-entity
+ 0
+ (wl-thread-get-entity (car elist))
+ nil
+ len)
+ (elmo-progress-notify 'wl-thread-insert-entity)
+ (setq elist (cdr elist))))))
(defsubst wl-thread-insert-entity-sub (indent entity parent-entity all)
(let (msg-num
(wl-thread-entity-set-parent entity dst-parent)
;; update thread on buffer
(wl-thread-make-number-list)
- (wl-thread-update-line-msgs update-msgs t))))
+ (wl-thread-update-line-msgs update-msgs))))
(require 'product)
(product-provide (provide 'wl-thread) (require 'wl-version))
(if beg
(cons beg end)))))
+(defun wl-simple-display-progress (label action current total)
+ (message "%s... %d%%"
+ action
+ (if (> total 0) (floor (* (/ current (float total)) 100)) 0)))
+
+(when (fboundp 'progress-feedback-with-label)
+ (defun wl-display-progress-with-gauge (label action current total)
+ (progress-feedback-with-label
+ label
+ "%s..."
+ (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
+ action)))
+
+(defun wl-progress-callback-function (label action current total)
+ (case current
+ (query
+ (let ((threshold (if (consp wl-display-progress-threshold)
+ (cdr (or (assq label wl-display-progress-threshold)
+ (assq t wl-display-progress-threshold)))
+ wl-display-progress-threshold)))
+ (and threshold
+ (>= total threshold))))
+ (start
+ (message "%s..." action))
+ (done
+ (message "%s...done" action))
+ (t
+ (when wl-display-progress-function
+ (funcall wl-display-progress-function label action current total)))))
+
;; read multiple strings with completion
(defun wl-completing-read-multiple-1 (prompt
table
(const :tag "Don't use PGP" nil))
:group 'wl-pref)
+(defcustom wl-display-progress-threshold
+ '((wl-folder-insert-entity . 100)
+ (elmo-retrieve-message . 3000)
+ (t . 20))
+ "*Displaying progress message if number of total are more than this value."
+ :type '(choice (const :tag "No display" nil)
+ (const :tag "No limitation" 0)
+ (integer :tag "For all")
+ (repeat :tag "Each label"
+ (cons (choice (const :tag "Default" t)
+ (symbol :tag "Label"))
+ (choice (const :tag "No display" nil)
+ (const :tag "No limitation" 0)
+ (integer :tag "Threshold")))))
+ :group 'wl-pref)
+
+(defcustom wl-display-progress-function #'wl-simple-display-progress
+ "*A function to display progress message"
+ :type '(choice (const :tag "No display" nil)
+ (function :tag "Function"))
+ :group 'wl-pref)
+
;;; Internal variables
(defvar wl-init nil)
(make-face (intern
(format "wl-highlight-summary-%s-flag-face" (car spec))))
(nth 1 spec)))
- (setq elmo-get-folder-function #'wl-folder-make-elmo-folder)
+ (setq elmo-get-folder-function #'wl-folder-make-elmo-folder
+ elmo-progress-callback-function #'wl-progress-callback-function)
(setq elmo-no-from wl-summary-no-from-message)
(setq elmo-no-subject wl-summary-no-subject-message)
(elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
projects / elisp / wanderlust.git / commitdiff