;;; Code:
;;
+(eval-when-compile (require 'cl))
(require 'elmo-vars)
(require 'elmo-util)
(defvar elmo-nntp-max-number-precedes-list-active nil
"Non-nil means max number of msgdb is set as the max number of `list active'.
-(Needed for inn 2.3 or later?).")
+\(Needed for inn 2.3 or later?\).")
(defvar elmo-nntp-group-coding-system nil
"A coding system for newsgroup string.")
(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)
(append elmo-nntp-stream-type-alist
elmo-network-stream-type-alist))
elmo-network-stream-type-alist))
- parse)
+ explicit-user parse)
(setq name (luna-call-next-method))
(setq parse (elmo-parse-token name ":"))
(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)))
(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)))
(unless (elmo-net-folder-server-internal folder)
(elmo-net-folder-set-server-internal 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-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))))))
(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 "<NO LOGGING>" command))
(process-send-string (elmo-network-session-process-internal
session) command)
(process-send-string (elmo-network-session-process-internal
(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)
)))))
(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)
(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)
(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")
(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) " ")
(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)
(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)
("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
+ extras extra ext field field-index flags)
(setq ov-list (elmo-nntp-parse-overview-string str))
(while ov-list
(setq ov-entity (car ov-list))
(while extras
(setq ext (downcase (car extras)))
(when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
- (when (> (length ov-entity) field-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 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-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))
+ :date (aref ov-entity 3)
+ :size (string-to-int (aref ov-entity 6))
+ :extra extra))
+ (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))
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
(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)
(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)
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))
(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
(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."
(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)
(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 ()
(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...")
(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))
(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)
;; 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.
)
(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)
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)))
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))
projects / elisp / wanderlust.git / blobdiff