;;; Code:
;;
+(eval-when-compile (require 'cl))
(require 'elmo-vars)
(require 'elmo-util)
(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)
(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))
(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)
(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))))
(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))
(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))))
-
- (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))
(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)
(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)))))
"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))
(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)
(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))
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))
(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)))
(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)
(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
(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)))
(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))))
((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))
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)))
(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-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)
projects / elisp / wanderlust.git / blobdiff