X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-nntp.el;h=f297f9518238f662a2652e9bc5a09cea9f04316d;hb=b476f8251148619523f158f1059f1b8bc3c114f6;hp=810da853f9a186d06d11f2fea2d4cfce7ea58209;hpb=ec5c134d3af552527568fa46900567f3b43eb898;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 810da85..f297f95 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) @@ -417,7 +419,8 @@ Don't cache if nil.") (with-current-buffer outbuf (erase-buffer) (insert-buffer-substring (elmo-network-session-buffer session) - start (- end 3)))) + start (- end 3)) + (elmo-delete-cr-buffer))) t)) (defun elmo-nntp-select-group (session group &optional force) @@ -463,16 +466,18 @@ Don't cache if nil.") ))))) (defsubst elmo-nntp-catchup-msgdb (msgdb max-number) - (let (msgdb-max number-alist) - (setq number-alist (elmo-msgdb-get-number-alist msgdb)) - (setq msgdb-max (car (nth (max (- (length number-alist) 1) 0) - number-alist))) - (if (or (not msgdb-max) - (and msgdb-max max-number - (< msgdb-max max-number))) - (elmo-msgdb-set-number-alist - msgdb - (nconc number-alist (list (cons max-number nil))))))) + (let ((numbers (elmo-msgdb-list-messages msgdb)) + msgdb-max) + (setq msgdb-max (if numbers (apply #'max numbers) 0)) + (when (and msgdb-max + max-number + (< msgdb-max max-number)) + (let ((i (1+ msgdb-max)) + killed) + (while (<= i max-number) + (setq killed (cons i killed)) + (incf i)) + (nreverse killed))))) (luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder) &optional one-level) @@ -502,9 +507,9 @@ Don't cache if nil.") (not (string= (elmo-nntp-folder-group-internal folder) ""))) (concat " active" - (format " %s.*" - (elmo-nntp-folder-group-internal folder) - ""))))) + (format + " %s.*" + (elmo-nntp-folder-group-internal folder)))))) (if (elmo-nntp-read-response session t) (if (null (setq response (elmo-nntp-read-contents session))) (error "NNTP List folders failed") @@ -538,20 +543,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) " ") @@ -562,37 +567,23 @@ 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 @@ -604,35 +595,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-set-work-buf - (let ((beg-num (string-to-int beg-str)) - (end-num (string-to-int end-str)) - i) - (setq i beg-num) - (insert "(") - (while (<= i end-num) - (insert (format "%s " i)) - (setq i (1+ i))) - (insert ")") - (goto-char (point-min)) - (read (current-buffer))))) + (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) @@ -661,7 +633,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))))) @@ -708,9 +680,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)) @@ -733,12 +705,14 @@ Don't cache if nil.") ("lines" . 7) ("xref" . 8))) -(defun elmo-nntp-create-msgdb-from-overview-string (str +(defun elmo-nntp-create-msgdb-from-overview-string (folder + str flag-table &optional numlist) - (let (ov-list gmark message-id seen - ov-entity overview number-alist mark-alist num - extras extra ext field field-index) + (let ((new-msgdb (elmo-make-msgdb)) + ov-list message-id entity + ov-entity num + field field-index flags) (setq ov-list (elmo-nntp-parse-overview-string str)) (while ov-list (setq ov-entity (car ov-list)) @@ -748,58 +722,41 @@ Don't cache if nil.") ;;; (<= num 0)) ;;; (setq num 0)) ;;; (setq num (int-to-string num)) - (setq num (string-to-int (aref ov-entity 0))) + (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 overview - (elmo-msgdb-append-element - overview - (cons (aref ov-entity 4) - (vector num - (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)) - (aref ov-entity 3) ;date - nil ; to - nil ; cc - (string-to-int - (aref ov-entity 6)) ; size - extra ; extra-field-list - )))) - (setq number-alist - (elmo-msgdb-number-add number-alist num - (aref ov-entity 4))) - (setq message-id (aref ov-entity 4)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (elmo-msgdb-mark - (elmo-flag-table-get flag-table message-id) - (elmo-file-cache-status - (elmo-file-cache-get message-id)) - 'new))) - (setq mark-alist - (elmo-msgdb-mark-append mark-alist - num gmark)))) + (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-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-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) + (elmo-msgdb-append-entity new-msgdb entity flags)) (setq ov-list (cdr ov-list))) - (list overview number-alist mark-alist))) + new-msgdb)) (luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder) numbers flag-table) @@ -808,8 +765,9 @@ Don't cache if nil.") (defun elmo-nntp-folder-msgdb-create (folder numbers flag-table) (let ((filter numbers) (session (elmo-nntp-get-session folder)) + (new-msgdb (elmo-make-msgdb)) beg-num end-num cur length - ret-val ov-str use-xover dir) + new-msgdb 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)) @@ -817,61 +775,55 @@ 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 - (setq ret-val - (elmo-msgdb-append - ret-val - (elmo-nntp-create-msgdb-from-overview-string - 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 ret-val (elmo-nntp-msgdb-create-by-header - session numbers flag-table)) + (setq new-msgdb (elmo-nntp-msgdb-create-by-header + session numbers flag-table)) (with-current-buffer (elmo-network-session-buffer session) (if ov-str - (setq ret-val - (elmo-msgdb-append - ret-val - (elmo-nntp-create-msgdb-from-overview-string - ov-str - flag-table - filter)))))) + (elmo-msgdb-append + new-msgdb + (elmo-nntp-create-msgdb-from-overview-string + folder + ov-str + flag-table + filter))))) (elmo-folder-set-killed-list-internal folder (nconc (elmo-folder-killed-list-internal folder) (car (elmo-list-diff numbers - (elmo-msgdb-list-messages ret-val))))) + (elmo-msgdb-list-messages new-msgdb))))) ;; If there are canceled messages, overviews are not obtained ;; to max-number(inn 2.3?). (when (and (elmo-nntp-max-number-precedes-list-active-p) @@ -884,42 +836,43 @@ Don't cache if nil.") (progn (elmo-nntp-set-list-active session nil) (error "NNTP list command failed"))) - (elmo-nntp-catchup-msgdb - ret-val - (nth 1 (read (concat "(" (elmo-nntp-read-contents - session) ")"))))) - ret-val)) + (let ((killed (elmo-nntp-catchup-msgdb + new-msgdb + (nth 1 (read (concat "(" (elmo-nntp-read-contents + session) ")")))))) + (when killed + (elmo-folder-kill-messages folder killed)))) + new-msgdb)) (luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder)) - (if (elmo-nntp-max-number-precedes-list-active-p) - (let ((session (elmo-nntp-get-session folder)) - (number-alist (elmo-msgdb-get-number-alist - (elmo-folder-msgdb folder)))) - (if (elmo-nntp-list-active-p session) - (let (msgdb-max max-number) - ;; If there are canceled messages, overviews are not obtained - ;; to max-number(inn 2.3?). - (elmo-nntp-select-group session - (elmo-nntp-folder-group-internal folder)) - (elmo-nntp-send-command session - (format "list active %s" - (elmo-nntp-folder-group-internal - folder))) - (if (null (elmo-nntp-read-response session)) - (error "NNTP list command failed")) - (setq max-number - (nth 1 (read (concat "(" (elmo-nntp-read-contents - session) ")")))) - (setq msgdb-max - (car (nth (max (- (length number-alist) 1) 0) - number-alist))) - (if (or (and number-alist (not msgdb-max)) - (and msgdb-max max-number - (< msgdb-max max-number))) - (elmo-msgdb-set-number-alist - (elmo-folder-msgdb folder) - (nconc number-alist - (list (cons max-number nil)))))))))) + (when (elmo-nntp-max-number-precedes-list-active-p) + (let ((session (elmo-nntp-get-session folder))) + (when (elmo-nntp-list-active-p session) + (let ((numbers (elmo-folder-list-messages folder nil 'in-msgdb)) + msgdb-max max-number) + ;; If there are canceled messages, overviews are not obtained + ;; to max-number(inn 2.3?). + (elmo-nntp-select-group session + (elmo-nntp-folder-group-internal folder)) + (elmo-nntp-send-command session + (format "list active %s" + (elmo-nntp-folder-group-internal + folder))) + (if (null (elmo-nntp-read-response session)) + (error "NNTP list command failed")) + (setq max-number + (nth 1 (read (concat "(" (elmo-nntp-read-contents + session) ")")))) + (setq msgdb-max (if numbers (apply #'max numbers) 0)) + (when (and msgdb-max + max-number + (< msgdb-max max-number)) + (let ((i (1+ msgdb-max)) + killed) + (while (<= i max-number) + (setq killed (cons i killed)) + (incf i)) + (elmo-folder-kill-messages folder (nreverse killed))))))))) (defun elmo-nntp-msgdb-create-by-header (session numbers flag-table) (with-temp-buffer @@ -934,7 +887,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))) @@ -946,7 +899,7 @@ Don't cache if nil.") ret-list ret-val beg) (set-buffer tmp-buffer) (erase-buffer) - (elmo-set-buffer-multibyte nil) + (set-buffer-multibyte nil) (insert string) (goto-char (point-min)) (setq beg (point)) @@ -980,8 +933,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 @@ -1080,22 +1033,15 @@ Don't cache if nil.") (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder) numbers) - (elmo-nntp-folder-delete-messages folder numbers)) - -(defun elmo-nntp-folder-delete-messages (folder numbers) - (let ((killed-list (elmo-folder-killed-list-internal folder))) - (dolist (number numbers) - (setq killed-list - (elmo-msgdb-set-as-killed killed-list number))) - (elmo-folder-set-killed-list-internal folder killed-list)) + (elmo-folder-kill-messages folder numbers) t) (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder)) (let ((session (elmo-nntp-get-session folder))) - (elmo-nntp-send-command - session - (format "group %s" - (elmo-nntp-folder-group-internal folder))) + (elmo-nntp-send-command + session + (format "group %s" + (elmo-nntp-folder-group-internal folder))) (elmo-nntp-read-response session))) (defun elmo-nntp-retrieve-field (spec field from-msgs) @@ -1129,12 +1075,12 @@ 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) numbers)) @@ -1214,10 +1160,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))) @@ -1304,26 +1256,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) @@ -1364,100 +1310,70 @@ 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") - ;; Remove all "\r"'s. - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) + (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))))) ;; end of from Gnus (defun elmo-nntp-msgdb-create-message (len flag-table) (save-excursion - (let (beg overview number-alist mark-alist - entity i num gmark seen message-id) - (elmo-set-buffer-multibyte nil) + (let ((new-msgdb (elmo-make-msgdb)) + 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-overview-from-buffer num)) - (when entity - (setq overview - (elmo-msgdb-append-element - overview entity)) - (setq number-alist - (elmo-msgdb-number-add - number-alist - (elmo-msgdb-overview-entity-get-number entity) - (car entity))) - (setq message-id (car entity)) - (if (setq gmark - (or (elmo-msgdb-global-mark-get message-id) - (elmo-msgdb-mark - (elmo-flag-table-get flag-table message-id) - (elmo-file-cache-status - (elmo-file-cache-get message-id)) - 'new))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - num gmark))) - )))) - (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)) - (list overview number-alist mark-alist)))) + (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) elmo-nntp-use-cache) @@ -1480,7 +1396,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ;; temp-crosses slot is a list of cons cell: ;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng)) ;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared, -;; 1.3. In elmo-folder-mark-as-read, move crosspost entry +;; 1.3. In elmo-folder-flag-as-read, move crosspost entry ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'. ;; 2. process crosspost alist. @@ -1525,7 +1441,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" ) (defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers) -;; 1.3. In elmo-folder-mark-as-read, move crosspost entry +;; 1.3. In elmo-folder-flag-as-read, move crosspost entry ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'. (let (elem) (dolist (number numbers) @@ -1538,11 +1454,19 @@ Returns a list of cons cells like (NUMBER . VALUE)" folder (delq elem (elmo-nntp-folder-temp-crosses-internal folder))))))) -(luna-define-method elmo-folder-mark-as-read :before ((folder - elmo-nntp-folder) - numbers - &optional ignore-flags) - (elmo-nntp-folder-update-crosspost-message-alist folder numbers)) +(luna-define-method elmo-folder-set-flag :before ((folder elmo-nntp-folder) + numbers + flag + &optional is-local) + (when (eq flag 'read) + (elmo-nntp-folder-update-crosspost-message-alist folder numbers))) + +(luna-define-method elmo-folder-unset-flag :before ((folder elmo-nntp-folder) + numbers + flag + &optional is-local) + (when (eq flag 'unread) + (elmo-nntp-folder-update-crosspost-message-alist folder numbers))) (defsubst elmo-nntp-folder-process-crosspost (folder) ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from @@ -1568,12 +1492,19 @@ Returns a list of cons cells like (NUMBER . VALUE)" (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)) (elmo-nntp-folder-process-crosspost folder)) -(luna-define-method elmo-folder-list-unreads :around ((folder - elmo-nntp-folder)) +(luna-define-method elmo-folder-list-flagged :around ((folder elmo-nntp-folder) + flag &optional in-msgdb) ;; 2.3. elmo-folder-list-unreads return unread message list according to ;; `reads' slot. - (elmo-living-messages (luna-call-next-method) - (elmo-nntp-folder-reads-internal folder))) + (let ((msgs (luna-call-next-method))) + (if in-msgdb + msgs + (case flag + (unread + (elmo-living-messages msgs (elmo-nntp-folder-reads-internal folder))) + ;; Should consider read, digest and any flag? + (otherwise + msgs))))) (require 'product) (product-provide (provide 'elmo-nntp) (require 'elmo-version))