X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-nntp.el;h=6a05ec00538d072a3507ec36513d5ff34c869145;hb=f89ecc0bb760887e19533ff124a80529a5c4b50e;hp=e472fdc1ee3226d7a6b95022dfd6763f50205b83;hpb=4b05f2cdd75f3d4cadc42b1c3d097b6b03121427;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index e472fdc..6a05ec0 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -32,6 +32,7 @@ ;;; Code: ;; +(eval-when-compile (require 'cl)) (require 'elmo-vars) (require 'elmo-util) @@ -54,6 +55,10 @@ (defvar elmo-nntp-group-coding-system nil "A coding system for newsgroup string.") +(defconst elmo-nntp-folder-name-syntax `(group + (?: [user "^\\([A-Za-z]\\|$\\)"]) + ,@elmo-net-folder-name-syntax)) + (defsubst elmo-nntp-encode-group-string (string) (if elmo-nntp-group-coding-system (encode-coding-string string elmo-nntp-group-coding-system) @@ -86,39 +91,35 @@ Debug information is inserted in the buffer \"*NNTP DEBUG*\"") (group temp-crosses reads)) (luna-define-internal-accessors 'elmo-nntp-folder)) -(luna-define-method elmo-folder-initialize :around ((folder - elmo-nntp-folder) - name) +(luna-define-method elmo-folder-initialize ((folder elmo-nntp-folder) name) (let ((elmo-network-stream-type-alist (if elmo-nntp-stream-type-alist (setq elmo-network-stream-type-alist (append elmo-nntp-stream-type-alist elmo-network-stream-type-alist)) elmo-network-stream-type-alist)) - explicit-user parse) - (setq name (luna-call-next-method)) - (setq parse (elmo-parse-token name ":")) + tokens) + (setq tokens (car (elmo-parse-separated-tokens + name + elmo-nntp-folder-name-syntax))) + ;; group (elmo-nntp-folder-set-group-internal folder (elmo-nntp-encode-group-string - (car parse))) - (setq explicit-user (eq ?: (string-to-char (cdr parse)))) - (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) + (cdr (assq 'group tokens)))) + ;; user (elmo-net-folder-set-user-internal folder - (if (eq (length (car parse)) 0) - (unless explicit-user - elmo-nntp-default-user) - (car parse))) - (unless (elmo-net-folder-server-internal folder) - (elmo-net-folder-set-server-internal folder - elmo-nntp-default-server)) - (unless (elmo-net-folder-port-internal folder) - (elmo-net-folder-set-port-internal folder - elmo-nntp-default-port)) - (unless (elmo-net-folder-stream-type-internal folder) - (elmo-net-folder-set-stream-type-internal - folder - (elmo-get-network-stream-type - elmo-nntp-default-stream-type))) + (let ((user (cdr (assq 'user tokens)))) + (if user + (and (> (length user) 0) user) + elmo-nntp-default-user))) + ;; network + (elmo-net-folder-set-parameters + folder + tokens + (list :server elmo-nntp-default-server + :port elmo-nntp-default-port + :stream-type + (elmo-get-network-stream-type elmo-nntp-default-stream-type))) folder)) (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder)) @@ -176,72 +177,73 @@ Don't cache if nil.") (defconst elmo-nntp-server-command-index '((xover . 0) (listgroup . 1) - (list-active . 2))) + (list-active . 2) + (xhdr . 3))) (defmacro elmo-nntp-get-server-command (session) - (` (assoc (cons (elmo-network-session-server-internal (, session)) - (elmo-network-session-port-internal (, session))) - elmo-nntp-server-command-alist))) + `(assoc (cons (elmo-network-session-server-internal ,session) + (elmo-network-session-port-internal ,session)) + elmo-nntp-server-command-alist)) (defmacro elmo-nntp-set-server-command (session com value) - (` (let (entry) - (unless (setq entry (cdr (elmo-nntp-get-server-command - (, session)))) - (setq elmo-nntp-server-command-alist - (nconc elmo-nntp-server-command-alist - (list (cons - (cons - (elmo-network-session-server-internal (, session)) - (elmo-network-session-port-internal (, session))) - (setq entry - (vector - elmo-nntp-default-use-xover - elmo-nntp-default-use-listgroup - elmo-nntp-default-use-list-active - elmo-nntp-default-use-xhdr))))))) - (aset entry - (cdr (assq (, com) elmo-nntp-server-command-index)) - (, value))))) + `(let (entry) + (unless (setq entry (cdr (elmo-nntp-get-server-command + ,session))) + (setq elmo-nntp-server-command-alist + (nconc elmo-nntp-server-command-alist + (list (cons + (cons + (elmo-network-session-server-internal ,session) + (elmo-network-session-port-internal ,session)) + (setq entry + (vector + elmo-nntp-default-use-xover + elmo-nntp-default-use-listgroup + elmo-nntp-default-use-list-active + elmo-nntp-default-use-xhdr))))))) + (aset entry + (cdr (assq ,com elmo-nntp-server-command-index)) + ,value))) (defmacro elmo-nntp-xover-p (session) - (` (let ((entry (elmo-nntp-get-server-command (, session)))) - (if entry - (aref (cdr entry) - (cdr (assq 'xover elmo-nntp-server-command-index))) - elmo-nntp-default-use-xover)))) + `(let ((entry (elmo-nntp-get-server-command ,session))) + (if entry + (aref (cdr entry) + (cdr (assq 'xover elmo-nntp-server-command-index))) + elmo-nntp-default-use-xover))) (defmacro elmo-nntp-set-xover (session value) - (` (elmo-nntp-set-server-command (, session) 'xover (, value)))) + `(elmo-nntp-set-server-command ,session 'xover ,value)) (defmacro elmo-nntp-listgroup-p (session) - (` (let ((entry (elmo-nntp-get-server-command (, session)))) - (if entry - (aref (cdr entry) - (cdr (assq 'listgroup elmo-nntp-server-command-index))) - elmo-nntp-default-use-listgroup)))) + `(let ((entry (elmo-nntp-get-server-command ,session))) + (if entry + (aref (cdr entry) + (cdr (assq 'listgroup elmo-nntp-server-command-index))) + elmo-nntp-default-use-listgroup))) (defmacro elmo-nntp-set-listgroup (session value) - (` (elmo-nntp-set-server-command (, session) 'listgroup (, value)))) + `(elmo-nntp-set-server-command ,session 'listgroup ,value)) (defmacro elmo-nntp-list-active-p (session) - (` (let ((entry (elmo-nntp-get-server-command (, session)))) - (if entry - (aref (cdr entry) - (cdr (assq 'list-active elmo-nntp-server-command-index))) - elmo-nntp-default-use-list-active)))) + `(let ((entry (elmo-nntp-get-server-command ,session))) + (if entry + (aref (cdr entry) + (cdr (assq 'list-active elmo-nntp-server-command-index))) + elmo-nntp-default-use-list-active))) (defmacro elmo-nntp-set-list-active (session value) - (` (elmo-nntp-set-server-command (, session) 'list-active (, value)))) + `(elmo-nntp-set-server-command ,session 'list-active ,value)) (defmacro elmo-nntp-xhdr-p (session) - (` (let ((entry (elmo-nntp-get-server-command (, session)))) - (if entry - (aref (cdr entry) - (cdr (assq 'xhdr elmo-nntp-server-command-index))) - elmo-nntp-default-use-xhdr)))) + `(let ((entry (elmo-nntp-get-server-command ,session))) + (if entry + (aref (cdr entry) + (cdr (assq 'xhdr elmo-nntp-server-command-index))) + elmo-nntp-default-use-xhdr))) (defmacro elmo-nntp-set-xhdr (session value) - (` (elmo-nntp-set-server-command (, session) 'xhdr (, value)))) + `(elmo-nntp-set-server-command ,session 'xhdr ,value)) (defsubst elmo-nntp-max-number-precedes-list-active-p () elmo-nntp-max-number-precedes-list-active) @@ -255,7 +257,7 @@ Don't cache if nil.") (if (and port (null (eq port elmo-nntp-default-port))) (concat ":" (if (numberp port) - (int-to-string port) port))) + (number-to-string port) port))) (unless (eq (elmo-network-stream-type-symbol type) elmo-nntp-default-stream-type) (elmo-network-stream-type-spec-string type)))) @@ -452,8 +454,7 @@ Don't cache if nil.") (let* ((cache-time (car elmo-nntp-list-folders-cache))) (unless (elmo-time-expire cache-time elmo-nntp-list-folders-use-cache) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (erase-buffer) (insert (nth 3 elmo-nntp-list-folders-cache)) (goto-char (point-min)) @@ -541,20 +542,20 @@ Don't cache if nil.") (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) " ") @@ -565,40 +566,26 @@ Don't cache if nil.") (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)))) - - (setq username (elmo-net-folder-user-internal folder)) - (when (and username - elmo-nntp-default-user - (string= username elmo-nntp-default-user)) - (setq username nil)) - - (when (or username ; XXX: ad-hoc fix against username includes "@" - (not (string= (elmo-net-folder-server-internal folder) - elmo-nntp-default-server))) - (setq append-serv (concat "@" (elmo-net-folder-server-internal - folder)))) + (elmo-progress-notify 'elmo-nntp-parse-active))))) + + (setq username (or (elmo-net-folder-user-internal folder) "")) + (unless (string= username (or elmo-nntp-default-user "")) + (setq append-serv (concat append-serv + ":" (elmo-quote-syntactical-element + username + 'user elmo-nntp-folder-name-syntax)))) + (unless (string= (elmo-net-folder-server-internal folder) + elmo-nntp-default-server) + (setq append-serv (concat append-serv + "@" (elmo-net-folder-server-internal folder)))) (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port) (setq append-serv (concat append-serv - ":" (int-to-string + ":" (number-to-string (elmo-net-folder-port-internal folder))))) (unless (eq (elmo-network-stream-type-symbol (elmo-net-folder-stream-type-internal folder)) @@ -607,24 +594,16 @@ Don't cache if nil.") (concat append-serv (elmo-network-stream-type-spec-string (elmo-net-folder-stream-type-internal folder))))) - (mapcar '(lambda (fld) - (if (consp fld) - (list (concat "-" (elmo-nntp-decode-group-string (car fld)) - (and username - (concat - ":" - username)) - (and append-serv - (concat append-serv)))) - (concat "-" (elmo-nntp-decode-group-string fld) - (and username - (concat ":" username)) - (and append-serv - (concat append-serv))))) + (mapcar (lambda (fld) + (if (consp fld) + (list (concat "-" (elmo-nntp-decode-group-string (car fld)) + append-serv)) + (concat "-" (elmo-nntp-decode-group-string fld) append-serv))) ret-val))) (defun elmo-nntp-make-msglist (beg-str end-str) - (elmo-make-number-list (string-to-int beg-str) (string-to-int end-str))) + (elmo-make-number-list (string-to-number beg-str) + (string-to-number end-str))) (luna-define-method elmo-folder-list-messages-plugged ((folder elmo-nntp-folder) @@ -653,7 +632,7 @@ Don't cache if nil.") (string-match "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$" response) - (> (string-to-int (elmo-match-string 1 response)) 0)) + (> (string-to-number (elmo-match-string 1 response)) 0)) (setq numbers (elmo-nntp-make-msglist (elmo-match-string 2 response) (elmo-match-string 3 response))))) @@ -700,9 +679,9 @@ Don't cache if nil.") "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$" response)) (progn - (setq end-num (string-to-int + (setq end-num (string-to-number (elmo-match-string 3 response))) - (setq e-num (string-to-int + (setq e-num (string-to-number (elmo-match-string 1 response))) (when (and killed-list (elmo-number-set-member end-num killed-list)) @@ -732,46 +711,45 @@ Don't cache if nil.") (let ((new-msgdb (elmo-make-msgdb)) ov-list message-id entity ov-entity num - extras extra ext field field-index flags) + field field-index flags) (setq ov-list (elmo-nntp-parse-overview-string str)) (while ov-list (setq ov-entity (car ov-list)) ;;; INN bug?? -;;; (if (or (> (setq num (string-to-int (aref ov-entity 0))) +;;; (if (or (> (setq num (string-to-number (aref ov-entity 0))) ;;; 99999) ;;; (<= num 0)) ;;; (setq num 0)) -;;; (setq num (int-to-string num)) - (setq num (string-to-int (aref ov-entity 0))) +;;; (setq num (number-to-string num)) + (setq num (string-to-number (aref ov-entity 0))) (when (or (null numlist) (memq num numlist)) - (setq extras elmo-msgdb-extra-fields - extra nil) - (while extras - (setq ext (downcase (car extras))) - (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index))) - (when (> (length ov-entity) field-index) - (setq field (aref ov-entity field-index)) - (when (eq field-index 8) ;; xref - (setq field (elmo-msgdb-remove-field-string field))) - (setq extra (cons (cons ext field) extra)))) - (setq extras (cdr extras))) (setq entity (elmo-msgdb-make-message-entity (elmo-msgdb-message-entity-handler new-msgdb) :message-id (aref ov-entity 4) :number num :references (elmo-msgdb-get-last-message-id (aref ov-entity 5)) - :from (elmo-mime-string (elmo-delete-char - ?\" - (or - (aref ov-entity 2) - elmo-no-from) 'uni)) - :subject (elmo-mime-string (or (aref ov-entity 1) - elmo-no-subject)) + :from (elmo-with-enable-multibyte + (eword-decode-string + (elmo-delete-char ?\" + (or (aref ov-entity 2) + elmo-no-from)))) + :subject (or (elmo-with-enable-multibyte + (eword-decode-string + (aref ov-entity 1))) + elmo-no-subject) :date (aref ov-entity 3) - :size (string-to-int (aref ov-entity 6)) - :extra extra)) + :size (string-to-number (aref ov-entity 6)))) + (dolist (extra elmo-msgdb-extra-fields) + (setq extra (downcase extra)) + (when (and (setq field-index + (cdr (assoc extra elmo-nntp-overview-index))) + (> (length ov-entity) field-index)) + (setq field (aref ov-entity field-index)) + (when (eq field-index 8) ;; xref + (setq field (elmo-msgdb-remove-field-string field))) + (elmo-message-entity-set-field entity (intern extra) field))) (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 num message-id) @@ -788,7 +766,7 @@ Don't cache if nil.") (session (elmo-nntp-get-session folder)) (new-msgdb (elmo-make-msgdb)) beg-num end-num cur length - new-msgdb ov-str use-xover dir) + ov-str use-xover dir) (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder)) (when (setq use-xover (elmo-nntp-xover-p session)) @@ -796,41 +774,36 @@ Don't cache if nil.") 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" + (number-to-string cur) + (number-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)) @@ -913,7 +886,7 @@ Don't cache if nil.") (goto-char (point-min)) (while (not (eobp)) (if (looking-at "^\\([0-9]+\\) \\(.*\\)$") - (setq response (cons (cons (string-to-int (elmo-match-buffer 1)) + (setq response (cons (cons (string-to-number (elmo-match-buffer 1)) (elmo-match-buffer 2)) response))) (forward-line 1))) @@ -939,7 +912,7 @@ Don't cache if nil.") (forward-line 1) (setq beg (point)) (setq ret-val (nconc ret-val (list ret-list)))) -;;; (kill-buffer tmp-buffer) +;;; (kill-buffer tmp-buffer) ret-val))) (defun elmo-nntp-get-newsgroup-by-msgid (msgid server user port type) @@ -959,8 +932,8 @@ Don't cache if nil.") (with-current-buffer (elmo-network-session-buffer session) (std11-field-body "Newsgroups"))))) -(luna-define-method elmo-message-fetch-with-cache-process :around - ((folder elmo-nntp-folder) number strategy &optional section unread) +(luna-define-method elmo-message-fetch :around + ((folder elmo-nntp-folder) number strategy &optional unread section) (when (luna-call-next-method) (elmo-nntp-setup-crosspost-buffer folder number) (unless unread @@ -1007,8 +980,7 @@ Don't cache if nil.") (elmo-get-network-stream-type elmo-nntp-default-stream-type)))) response has-message-id) - (save-excursion - (set-buffer content-buf) + (with-current-buffer content-buf (goto-char (point-min)) (if (search-forward mail-header-separator nil t) (delete-region (match-beginning 0)(match-end 0))) @@ -1026,7 +998,7 @@ Don't cache if nil.") (run-hooks 'elmo-nntp-post-pre-hook) (elmo-nntp-send-buffer session content-buf) (elmo-nntp-send-command session ".") -;;; (elmo-nntp-read-response buffer process t) +;;; (elmo-nntp-read-response buffer process t) (if (not (string-match "^2" (setq response (elmo-nntp-read-raw-response session)))) @@ -1101,14 +1073,14 @@ Returns a list of cons cells like (NUMBER . VALUE)" ((string= "last" search-key) (let ((numbers (or from-msgs (elmo-folder-list-messages spec)))) (nthcdr (max (- (length numbers) - (string-to-int (elmo-filter-value condition))) + (string-to-number (elmo-filter-value condition))) 0) numbers))) ((string= "first" search-key) (let* ((numbers (or from-msgs (elmo-folder-list-messages spec))) - (rest (nthcdr (string-to-int (elmo-filter-value condition) ) + (rest (nthcdr (string-to-number (elmo-filter-value condition) ) numbers))) - (mapcar '(lambda (x) (delete x numbers)) rest) + (mapc (lambda (x) (delete x numbers)) rest) numbers)) ((or (string= "since" search-key) (string= "before" search-key)) @@ -1186,10 +1158,16 @@ Returns a list of cons cells like (NUMBER . VALUE)" from-msgs))) result (sort result '<)))))) +(defun elmo-nntp-use-server-search-p (condition) + (if (vectorp condition) + (not (string= "body" (elmo-filter-key condition))) + (and (elmo-nntp-use-server-search-p (nth 1 condition)) + (elmo-nntp-use-server-search-p (nth 2 condition))))) + (luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder) condition &optional from-msgs) (if (and (elmo-folder-plugged-p folder) - (not (string= "body" (elmo-filter-key condition)))) + (elmo-nntp-use-server-search-p condition)) (elmo-nntp-search-internal folder condition from-msgs) (luna-call-next-method))) @@ -1276,26 +1254,20 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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) @@ -1336,38 +1308,32 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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))))) @@ -1377,42 +1343,34 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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-number + (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)