X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-nntp.el;h=120ae00481eade2b339a05c5e0c5c7e20d07d1bb;hb=31665e949babd625632818bb0470f9486367fc88;hp=62867ec5c1a6d7da4faa075d9dd614604d668bb6;hpb=e68565651b2b6fc9539a95da15382145088353a5;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 62867ec..120ae00 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) @@ -64,32 +65,49 @@ (decode-coding-string string elmo-nntp-group-coding-system) string)) +;; For debugging. +(defvar elmo-nntp-debug nil + "Non-nil forces NNTP folder as debug mode. +Debug information is inserted in the buffer \"*NNTP DEBUG*\"") + +;;; Debug +(defsubst elmo-nntp-debug (message &rest args) + (if elmo-nntp-debug + (let ((biff (string-match "BIFF-" (buffer-name))) + pos) + (with-current-buffer (get-buffer-create (concat "*NNTP DEBUG*" + (if biff "BIFF"))) + (goto-char (point-max)) + (setq pos (point)) + (insert (apply 'format message args) "\n"))))) + ;;; ELMO NNTP folder (eval-and-compile (luna-define-class elmo-nntp-folder (elmo-net-folder) (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)) - parse) - (setq name (luna-call-next-method)) - (setq parse (elmo-parse-token name ":")) + explicit-user parse) + (setq parse (elmo-parse-token name ":@")) (elmo-nntp-folder-set-group-internal folder (elmo-nntp-encode-group-string (car parse))) - (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) + (setq explicit-user (eq ?: (string-to-char (cdr parse)))) + (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "@")) (elmo-net-folder-set-user-internal folder (if (eq (length (car parse)) 0) - elmo-nntp-default-user + (unless explicit-user + elmo-nntp-default-user) (car parse))) + ;; network + (elmo-net-parse-network folder (cdr parse)) (unless (elmo-net-folder-server-internal folder) (elmo-net-folder-set-server-internal folder elmo-nntp-default-server)) @@ -158,7 +176,8 @@ 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)) @@ -287,13 +306,17 @@ Don't cache if nil.") (elmo-nntp-send-command session (format "authinfo user %s" (elmo-network-session-user-internal - session))) + session)) + nil + 'no-log) (or (elmo-nntp-read-response session) (signal 'elmo-authenticate-error '(authinfo))) (elmo-nntp-send-command session (format "authinfo pass %s" - (elmo-get-passwd (elmo-network-session-password-key session)))) + (elmo-get-passwd (elmo-network-session-password-key session))) + nil + 'no-log) (or (elmo-nntp-read-response session) (signal 'elmo-authenticate-error '(authinfo)))))) @@ -302,22 +325,24 @@ Don't cache if nil.") (run-hooks 'elmo-nntp-opened-hook)) (defun elmo-nntp-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (goto-char (point-max)) + (insert output) + (elmo-nntp-debug "RECEIVED: %s\n" output)))) (defun elmo-nntp-send-mode-reader (session) (elmo-nntp-send-command session "mode reader") (if (null (elmo-nntp-read-response session t)) (message "Mode reader failed"))) -(defun elmo-nntp-send-command (session command &optional noerase) +(defun elmo-nntp-send-command (session command &optional noerase no-log) (with-current-buffer (elmo-network-session-buffer session) (unless noerase (erase-buffer) (goto-char (point-min))) (setq elmo-nntp-read-point (point)) + (elmo-nntp-debug "SEND: %s\n" (if no-log "" command)) (process-send-string (elmo-network-session-process-internal session) command) (process-send-string (elmo-network-session-process-internal @@ -393,7 +418,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) @@ -439,16 +465,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) @@ -457,7 +485,7 @@ Don't cache if nil.") (defun elmo-nntp-folder-list-subfolders (folder one-level) (let ((session (elmo-nntp-get-session folder)) (case-fold-search nil) - response ret-val top-ng append-serv use-list-active start) + response ret-val top-ng username append-serv use-list-active start) (with-temp-buffer (set-buffer-multibyte nil) (if (and (elmo-nntp-folder-group-internal folder) @@ -478,9 +506,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") @@ -520,14 +548,14 @@ Don't cache if nil.") (progn (setq regexp (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n" - (if (and - (elmo-nntp-folder-group-internal folder) - (null (string= - (elmo-nntp-folder-group-internal - folder) ""))) + (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) " ") @@ -557,8 +585,16 @@ Don't cache if nil.") (when (> len elmo-display-progress-threshold) (elmo-display-progress 'elmo-nntp-list-folders "Parsing active..." 100)))) - (unless (string= (elmo-net-folder-server-internal folder) - elmo-nntp-default-server) + + (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)))) (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port) @@ -575,33 +611,21 @@ Don't cache if nil.") (mapcar '(lambda (fld) (if (consp fld) (list (concat "-" (elmo-nntp-decode-group-string (car fld)) - (and (elmo-net-folder-user-internal folder) + (and username (concat ":" - (elmo-net-folder-user-internal folder))) + username)) (and append-serv (concat append-serv)))) (concat "-" (elmo-nntp-decode-group-string fld) - (and (elmo-net-folder-user-internal folder) - (concat ":" (elmo-net-folder-user-internal - folder))) + (and username + (concat ":" username)) (and append-serv (concat 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-int beg-str) (string-to-int end-str))) (luna-define-method elmo-folder-list-messages-plugged ((folder elmo-nntp-folder) @@ -702,16 +726,14 @@ Don't cache if nil.") ("lines" . 7) ("xref" . 8))) -(defun elmo-nntp-create-msgdb-from-overview-string (str - new-mark - already-mark - seen-mark - important-mark - seen-list +(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)) @@ -724,76 +746,49 @@ Don't cache if nil.") (setq num (string-to-int (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)) - (setq seen (member message-id seen-list)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-nntp-use-cache - seen-mark) - new-mark)))) - (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-int (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 new-mark already-mark - seen-mark important-mark - seen-list) - (elmo-nntp-folder-msgdb-create folder numbers new-mark already-mark - seen-mark important-mark - seen-list)) - -(defun elmo-nntp-folder-msgdb-create (folder numbers new-mark already-mark - seen-mark important-mark - seen-list) + numbers flag-table) + (elmo-nntp-folder-msgdb-create folder numbers flag-table)) + +(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)) @@ -813,18 +808,13 @@ Don't cache if nil.") 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 - new-mark - already-mark - seen-mark - important-mark - seen-list - filter - ))))) + (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 @@ -842,31 +832,24 @@ Don't cache if nil.") (elmo-display-progress 'elmo-nntp-msgdb-create "Getting overview..." 100))) (if (not use-xover) - (setq ret-val (elmo-nntp-msgdb-create-by-header - session numbers - new-mark already-mark seen-mark seen-list)) + (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 - new-mark - already-mark - seen-mark - important-mark - seen-list - 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 - (mapcar 'car - (elmo-msgdb-get-number-alist - 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) @@ -879,50 +862,49 @@ 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)))))))))) - -(defun elmo-nntp-msgdb-create-by-header (session numbers - new-mark already-mark - seen-mark seen-list) + (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 (elmo-nntp-retrieve-headers session (current-buffer) numbers) (elmo-nntp-msgdb-create-message - (length numbers) new-mark already-mark seen-mark seen-list))) + (length numbers) flag-table))) (defun elmo-nntp-parse-xhdr-response (string) (let (response) @@ -943,7 +925,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)) @@ -977,8 +959,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 @@ -1048,7 +1030,7 @@ Don't cache if nil.") (if (not (string-match "^2" (setq response (elmo-nntp-read-raw-response session)))) - (error (concat "NNTP error: " response)))))) + (error "NNTP error: %s" response))))) (defsubst elmo-nntp-send-data-line (session line) "Send LINE to SESSION." @@ -1077,22 +1059,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) @@ -1211,10 +1186,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))) @@ -1272,11 +1253,11 @@ Returns a list of cons cells like (NUMBER . VALUE)" (postfix (elmo-nntp-folder-postfix user server port type))) (if (not (string= postfix "")) (save-excursion - (replace-regexp "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\).*$" - (concat "\\1" - (elmo-replace-in-string - postfix - "\\\\" "\\\\\\\\\\\\\\\\")))))) + (while (re-search-forward "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\)\\(.*\\)$" nil t) + (replace-match (concat (match-string 1) + (elmo-replace-in-string + postfix + "\\\\" "\\\\\\\\\\\\\\\\"))))))) (let (len min max group) (while (not (eobp)) (condition-case () @@ -1393,20 +1374,17 @@ Returns a list of cons cells like (NUMBER . VALUE)" (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")) + ;; 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 new-mark - already-mark seen-mark seen-list) +(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 i num message-id) + (set-buffer-multibyte nil) (goto-char (point-min)) (setq i 0) (message "Creating msgdb...") @@ -1423,34 +1401,15 @@ Returns a list of cons cells like (NUMBER . VALUE)" (save-restriction (narrow-to-region beg (point)) (setq entity - (elmo-msgdb-create-overview-from-buffer num)) + (elmo-msgdb-create-message-entity-from-buffer + (elmo-msgdb-message-entity-handler new-msgdb) 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)) - (setq seen (member message-id seen-list)) - (if (setq gmark - (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-nntp-use-cache - seen-mark) - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - num gmark))) - )))) + (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)) @@ -1460,7 +1419,7 @@ Returns a list of cons cells like (NUMBER . VALUE)" (when (> len elmo-display-progress-threshold) (elmo-display-progress 'elmo-nntp-msgdb-create-message "Creating msgdb..." 100)) - (list overview number-alist mark-alist)))) + new-msgdb))) (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number) elmo-nntp-use-cache) @@ -1483,7 +1442,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. @@ -1528,7 +1487,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) @@ -1541,31 +1500,29 @@ 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 ((folder elmo-nntp-folder) - numbers) - (elmo-nntp-folder-update-crosspost-message-alist folder numbers) - t) - -(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder) - &optional - number-alist) - (elmo-nntp-folder-process-crosspost folder number-alist)) - -(defun elmo-nntp-folder-process-crosspost (folder number-alist) +(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 ;; `elmo-crosspost-message-alist'. ;; 2.2. remove crosspost entry for current newsgroup from ;; `elmo-crosspost-message-alist'. (let (cross-deletes reads entity ngs) (dolist (cross elmo-crosspost-message-alist) - (if number-alist - (when (setq entity (rassoc (nth 0 cross) number-alist)) - (setq reads (cons (car entity) reads))) - (when (setq entity (elmo-msgdb-overview-get-entity - (nth 0 cross) - (elmo-folder-msgdb folder))) - (setq reads (cons (elmo-msgdb-overview-entity-get-number entity) - reads)))) + (when (setq entity (elmo-message-entity folder (nth 0 cross))) + (setq reads (cons (elmo-message-entity-number entity) reads))) (when entity (if (setq ngs (delete (elmo-nntp-folder-group-internal folder) (nth 1 cross))) @@ -1578,19 +1535,22 @@ Returns a list of cons cells like (NUMBER . VALUE)" elmo-crosspost-message-alist))) (elmo-nntp-folder-set-reads-internal folder reads))) -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-nntp-folder) unread-marks mark-alist) +(luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder)) + (elmo-nntp-folder-process-crosspost 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. - (let ((mark-alist (or mark-alist (elmo-msgdb-get-mark-alist - (elmo-folder-msgdb folder))))) - (elmo-living-messages (delq nil - (mapcar - (lambda (x) - (if (member (nth 1 x) unread-marks) - (car x))) - mark-alist)) - (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))