1 ;;; elmo-nntp.el --- NNTP Interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
5 ;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
7 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
8 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
9 ;; Kenichi OKADA <okada@opaopa.org>
10 ;; Keywords: mail, net news
12 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
14 ;; This program is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; This program is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
44 (defvar elmo-nntp-overview-fetch-chop-length 200
45 "*Number of overviews to fetch in one request in nntp.")
47 (defvar elmo-nntp-use-cache t
48 "Use cache in nntp folder.")
50 (defvar elmo-nntp-max-number-precedes-list-active nil
51 "Non-nil means max number of msgdb is set as the max number of `list active'.
52 \(Needed for inn 2.3 or later?\).")
54 (defvar elmo-nntp-group-coding-system nil
55 "A coding system for newsgroup string.")
57 (defsubst elmo-nntp-encode-group-string (string)
58 (if elmo-nntp-group-coding-system
59 (encode-coding-string string elmo-nntp-group-coding-system)
62 (defsubst elmo-nntp-decode-group-string (string)
63 (if elmo-nntp-group-coding-system
64 (decode-coding-string string elmo-nntp-group-coding-system)
68 (defvar elmo-nntp-debug nil
69 "Non-nil forces NNTP folder as debug mode.
70 Debug information is inserted in the buffer \"*NNTP DEBUG*\"")
73 (defsubst elmo-nntp-debug (message &rest args)
75 (let ((biff (string-match "BIFF-" (buffer-name)))
77 (with-current-buffer (get-buffer-create (concat "*NNTP DEBUG*"
79 (goto-char (point-max))
81 (insert (apply 'format message args) "\n")))))
85 (luna-define-class elmo-nntp-folder (elmo-net-folder)
86 (group temp-crosses reads))
87 (luna-define-internal-accessors 'elmo-nntp-folder))
89 (luna-define-method elmo-folder-initialize :around ((folder
92 (let ((elmo-network-stream-type-alist
93 (if elmo-nntp-stream-type-alist
94 (setq elmo-network-stream-type-alist
95 (append elmo-nntp-stream-type-alist
96 elmo-network-stream-type-alist))
97 elmo-network-stream-type-alist))
99 (setq name (luna-call-next-method))
100 (setq parse (elmo-parse-token name ":"))
101 (elmo-nntp-folder-set-group-internal folder
102 (elmo-nntp-encode-group-string
104 (setq explicit-user (eq ?: (string-to-char (cdr parse))))
105 (setq parse (elmo-parse-prefixed-element ?: (cdr parse)))
106 (elmo-net-folder-set-user-internal folder
107 (if (eq (length (car parse)) 0)
108 (unless explicit-user
109 elmo-nntp-default-user)
111 (unless (elmo-net-folder-server-internal folder)
112 (elmo-net-folder-set-server-internal folder
113 elmo-nntp-default-server))
114 (unless (elmo-net-folder-port-internal folder)
115 (elmo-net-folder-set-port-internal folder
116 elmo-nntp-default-port))
117 (unless (elmo-net-folder-stream-type-internal folder)
118 (elmo-net-folder-set-stream-type-internal
120 (elmo-get-network-stream-type
121 elmo-nntp-default-stream-type)))
124 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-nntp-folder))
125 (convert-standard-filename
127 (elmo-nntp-folder-group-internal folder)
128 (expand-file-name (or (elmo-net-folder-server-internal folder) "nowhere")
129 (expand-file-name "nntp"
130 elmo-msgdb-directory)))))
132 (luna-define-method elmo-folder-newsgroups ((folder elmo-nntp-folder))
133 (list (elmo-nntp-folder-group-internal folder)))
137 (luna-define-class elmo-nntp-session (elmo-network-session)
139 (luna-define-internal-accessors 'elmo-nntp-session))
142 ;; internal variables
145 (defvar elmo-nntp-connection-cache nil
146 "Cache of NNTP connection.")
147 ;; buffer local variable
149 (defvar elmo-nntp-list-folders-use-cache 600
150 "*Time to cache of list folders, as the number of seconds.
151 Don't cache if nil.")
153 (defvar elmo-nntp-list-folders-cache nil)
155 (defvar elmo-nntp-groups-async nil)
156 (defvar elmo-nntp-header-fetch-chop-length 200)
158 (defvar elmo-nntp-read-point 0)
160 (defvar elmo-nntp-send-mode-reader t)
162 (defvar elmo-nntp-opened-hook nil)
164 (defvar elmo-nntp-get-folders-securely nil)
166 (defvar elmo-nntp-default-use-xover t)
168 (defvar elmo-nntp-default-use-listgroup t)
170 (defvar elmo-nntp-default-use-list-active t)
172 (defvar elmo-nntp-default-use-xhdr t)
174 (defvar elmo-nntp-server-command-alist nil)
177 (defconst elmo-nntp-server-command-index '((xover . 0)
181 (defmacro elmo-nntp-get-server-command (session)
182 (` (assoc (cons (elmo-network-session-server-internal (, session))
183 (elmo-network-session-port-internal (, session)))
184 elmo-nntp-server-command-alist)))
186 (defmacro elmo-nntp-set-server-command (session com value)
188 (unless (setq entry (cdr (elmo-nntp-get-server-command
190 (setq elmo-nntp-server-command-alist
191 (nconc elmo-nntp-server-command-alist
194 (elmo-network-session-server-internal (, session))
195 (elmo-network-session-port-internal (, session)))
198 elmo-nntp-default-use-xover
199 elmo-nntp-default-use-listgroup
200 elmo-nntp-default-use-list-active
201 elmo-nntp-default-use-xhdr)))))))
203 (cdr (assq (, com) elmo-nntp-server-command-index))
206 (defmacro elmo-nntp-xover-p (session)
207 (` (let ((entry (elmo-nntp-get-server-command (, session))))
210 (cdr (assq 'xover elmo-nntp-server-command-index)))
211 elmo-nntp-default-use-xover))))
213 (defmacro elmo-nntp-set-xover (session value)
214 (` (elmo-nntp-set-server-command (, session) 'xover (, value))))
216 (defmacro elmo-nntp-listgroup-p (session)
217 (` (let ((entry (elmo-nntp-get-server-command (, session))))
220 (cdr (assq 'listgroup elmo-nntp-server-command-index)))
221 elmo-nntp-default-use-listgroup))))
223 (defmacro elmo-nntp-set-listgroup (session value)
224 (` (elmo-nntp-set-server-command (, session) 'listgroup (, value))))
226 (defmacro elmo-nntp-list-active-p (session)
227 (` (let ((entry (elmo-nntp-get-server-command (, session))))
230 (cdr (assq 'list-active elmo-nntp-server-command-index)))
231 elmo-nntp-default-use-list-active))))
233 (defmacro elmo-nntp-set-list-active (session value)
234 (` (elmo-nntp-set-server-command (, session) 'list-active (, value))))
236 (defmacro elmo-nntp-xhdr-p (session)
237 (` (let ((entry (elmo-nntp-get-server-command (, session))))
240 (cdr (assq 'xhdr elmo-nntp-server-command-index)))
241 elmo-nntp-default-use-xhdr))))
243 (defmacro elmo-nntp-set-xhdr (session value)
244 (` (elmo-nntp-set-server-command (, session) 'xhdr (, value))))
246 (defsubst elmo-nntp-max-number-precedes-list-active-p ()
247 elmo-nntp-max-number-precedes-list-active)
249 (defsubst elmo-nntp-folder-postfix (user server port type)
251 (and user (concat ":" user))
253 (null (string= server elmo-nntp-default-server)))
256 (null (eq port elmo-nntp-default-port)))
257 (concat ":" (if (numberp port)
258 (int-to-string port) port)))
259 (unless (eq (elmo-network-stream-type-symbol type)
260 elmo-nntp-default-stream-type)
261 (elmo-network-stream-type-spec-string type))))
263 (defun elmo-nntp-get-session (folder &optional if-exists)
264 (elmo-network-get-session
267 (if (elmo-folder-biff-internal folder)
273 (luna-define-method elmo-network-initialize-session ((session
275 (let ((process (elmo-network-session-process-internal session))
277 (set-process-filter (elmo-network-session-process-internal session)
278 'elmo-nntp-process-filter)
279 (with-current-buffer (elmo-network-session-buffer session)
280 (setq elmo-nntp-read-point (point-min))
281 ;; Skip garbage output from process before greeting.
282 (while (and (memq (process-status process) '(open run))
283 (goto-char (point-max))
285 (not (looking-at "^[2-5][0-9][0-9]")))
286 (accept-process-output process 1))
287 (setq elmo-nntp-read-point (point))
288 (setq response (elmo-nntp-read-response session t t))
289 (unless (car response)
290 (signal 'elmo-open-error (list (cdr response))))
291 (if elmo-nntp-send-mode-reader
292 (elmo-nntp-send-mode-reader session))
293 (when (eq (elmo-network-stream-type-symbol
294 (elmo-network-session-stream-type-internal session))
296 (elmo-nntp-send-command session "starttls")
297 (or (elmo-nntp-read-response session)
298 (error "Cannot open starttls session"))
299 (starttls-negotiate process)))))
301 (luna-define-method elmo-network-authenticate-session ((session
303 (with-current-buffer (elmo-network-session-buffer session)
304 (when (elmo-network-session-user-internal session)
305 (elmo-nntp-send-command session
306 (format "authinfo user %s"
307 (elmo-network-session-user-internal
311 (or (elmo-nntp-read-response session)
312 (signal 'elmo-authenticate-error '(authinfo)))
313 (elmo-nntp-send-command
315 (format "authinfo pass %s"
316 (elmo-get-passwd (elmo-network-session-password-key session)))
319 (or (elmo-nntp-read-response session)
320 (signal 'elmo-authenticate-error '(authinfo))))))
322 (luna-define-method elmo-network-setup-session ((session
324 (run-hooks 'elmo-nntp-opened-hook))
326 (defun elmo-nntp-process-filter (process output)
327 (when (buffer-live-p (process-buffer process))
328 (with-current-buffer (process-buffer process)
329 (goto-char (point-max))
331 (elmo-nntp-debug "RECEIVED: %s\n" output))))
333 (defun elmo-nntp-send-mode-reader (session)
334 (elmo-nntp-send-command session "mode reader")
335 (if (null (elmo-nntp-read-response session t))
336 (message "Mode reader failed")))
338 (defun elmo-nntp-send-command (session command &optional noerase no-log)
339 (with-current-buffer (elmo-network-session-buffer session)
342 (goto-char (point-min)))
343 (setq elmo-nntp-read-point (point))
344 (elmo-nntp-debug "SEND: %s\n" (if no-log "<NO LOGGING>" command))
345 (process-send-string (elmo-network-session-process-internal
347 (process-send-string (elmo-network-session-process-internal
350 (defun elmo-nntp-read-response (session &optional not-command error-msg)
351 (with-current-buffer (elmo-network-session-buffer session)
352 (let ((process (elmo-network-session-process-internal session))
353 (case-fold-search nil)
354 (response-string nil)
355 (response-continue t)
357 (while response-continue
358 (goto-char elmo-nntp-read-point)
359 (while (not (search-forward "\r\n" nil t))
360 (accept-process-output process)
361 (goto-char elmo-nntp-read-point))
362 (setq match-end (point))
363 (setq response-string
364 (buffer-substring elmo-nntp-read-point (- match-end 2)))
365 (goto-char elmo-nntp-read-point)
366 (if (looking-at "[23][0-9]+ .*$")
367 (progn (setq response-continue nil)
368 (setq elmo-nntp-read-point match-end)
371 (concat response "\n" response-string)
373 (if (looking-at "[^23][0-9]+ .*$")
374 (progn (setq response-continue nil)
375 (setq elmo-nntp-read-point match-end)
377 (setq elmo-nntp-read-point match-end)
379 (setq response-continue nil))
382 (concat response "\n" response-string)
384 (setq elmo-nntp-read-point match-end)))
386 (cons response response-string)
389 (defun elmo-nntp-read-raw-response (session)
390 (with-current-buffer (elmo-network-session-buffer session)
391 (goto-char elmo-nntp-read-point)
392 (while (not (search-forward "\r\n" nil t))
393 (accept-process-output (elmo-network-session-process-internal
395 (goto-char elmo-nntp-read-point))
396 (buffer-substring elmo-nntp-read-point (- (point) 2))))
398 (defun elmo-nntp-read-contents (session)
399 (with-current-buffer (elmo-network-session-buffer session)
400 (goto-char elmo-nntp-read-point)
401 (while (not (re-search-forward "^\\.\r\n" nil t))
402 (accept-process-output (elmo-network-session-process-internal
404 (goto-char elmo-nntp-read-point))
406 (buffer-substring elmo-nntp-read-point
409 (defun elmo-nntp-read-body (session outbuf)
410 (with-current-buffer (elmo-network-session-buffer session)
411 (goto-char elmo-nntp-read-point)
412 (while (not (re-search-forward "^\\.\r\n" nil t))
413 (accept-process-output (elmo-network-session-process-internal session))
414 (goto-char elmo-nntp-read-point))
415 (let ((start elmo-nntp-read-point)
417 (with-current-buffer outbuf
419 (insert-buffer-substring (elmo-network-session-buffer session)
423 (defun elmo-nntp-select-group (session group &optional force)
426 (not (string= (elmo-nntp-session-current-group-internal session)
430 (elmo-nntp-send-command session (format "group %s" group))
431 (setq response (elmo-nntp-read-response session)))
432 (elmo-nntp-session-set-current-group-internal session
433 (and response group))
436 (defun elmo-nntp-list-folders-get-cache (group server buf)
437 (when (and elmo-nntp-list-folders-use-cache
438 elmo-nntp-list-folders-cache
439 (string-match (concat "^"
442 (nth 1 elmo-nntp-list-folders-cache)
445 (string-match (concat "^"
448 (nth 2 elmo-nntp-list-folders-cache)
451 (let* ((cache-time (car elmo-nntp-list-folders-cache)))
452 (unless (elmo-time-expire cache-time
453 elmo-nntp-list-folders-use-cache)
457 (insert (nth 3 elmo-nntp-list-folders-cache))
458 (goto-char (point-min))
459 (or (string= group "")
461 (keep-lines (concat "^" (regexp-quote group) "\\."))))
465 (defsubst elmo-nntp-catchup-msgdb (msgdb max-number)
466 (let (msgdb-max number-alist)
467 (setq number-alist (elmo-msgdb-get-number-alist msgdb))
468 (setq msgdb-max (car (nth (max (- (length number-alist) 1) 0)
470 (if (or (not msgdb-max)
471 (and msgdb-max max-number
472 (< msgdb-max max-number)))
473 (elmo-msgdb-set-number-alist
475 (nconc number-alist (list (cons max-number nil)))))))
477 (luna-define-method elmo-folder-list-subfolders ((folder elmo-nntp-folder)
479 (elmo-nntp-folder-list-subfolders folder one-level))
481 (defun elmo-nntp-folder-list-subfolders (folder one-level)
482 (let ((session (elmo-nntp-get-session folder))
483 (case-fold-search nil)
484 response ret-val top-ng username append-serv use-list-active start)
486 (set-buffer-multibyte nil)
487 (if (and (elmo-nntp-folder-group-internal folder)
488 (elmo-nntp-select-group
490 (elmo-nntp-folder-group-internal folder)))
491 ;; add top newsgroups
492 (setq ret-val (list (elmo-nntp-folder-group-internal folder))))
493 (unless (setq response (elmo-nntp-list-folders-get-cache
494 (elmo-nntp-folder-group-internal folder)
495 (elmo-net-folder-server-internal folder)
497 (when (setq use-list-active (elmo-nntp-list-active-p session))
498 (elmo-nntp-send-command
501 (if (and (elmo-nntp-folder-group-internal folder)
502 (not (string= (elmo-nntp-folder-group-internal
506 (elmo-nntp-folder-group-internal folder)
508 (if (elmo-nntp-read-response session t)
509 (if (null (setq response (elmo-nntp-read-contents session)))
510 (error "NNTP List folders failed")
511 (when elmo-nntp-list-folders-use-cache
512 (setq elmo-nntp-list-folders-cache
514 (elmo-nntp-folder-group-internal folder)
515 (elmo-net-folder-server-internal folder)
519 (elmo-nntp-set-list-active session nil)
520 (setq use-list-active nil)))
521 (when (null use-list-active)
522 (elmo-nntp-send-command session "list")
523 (if (null (and (elmo-nntp-read-response session t)
524 (setq response (elmo-nntp-read-contents session))))
525 (error "NNTP List folders failed"))
526 (when elmo-nntp-list-folders-use-cache
527 (setq elmo-nntp-list-folders-cache
528 (list (current-time) nil nil response)))
531 (while (string-match (concat "^"
534 (elmo-nntp-folder-group-internal
538 (insert (match-string 0 response) "\n")
539 (setq start (match-end 0)))))
540 (goto-char (point-min))
541 (let ((len (count-lines (point-min) (point-max)))
546 (format "^\\(%s[^. ]+\\)\\([. ]\\).*\n"
548 (elmo-nntp-folder-group-internal folder)
550 (elmo-nntp-folder-group-internal
552 (concat (elmo-nntp-folder-group-internal
555 (while (looking-at regexp)
556 (setq top-ng (elmo-match-buffer 1))
557 (if (string= (elmo-match-buffer 2) " ")
558 (if (not (or (member top-ng ret-val)
559 (assoc top-ng ret-val)))
560 (setq ret-val (nconc ret-val (list top-ng))))
561 (if (member top-ng ret-val)
562 (setq ret-val (delete top-ng ret-val)))
563 (if (not (assoc top-ng ret-val))
564 (setq ret-val (nconc ret-val (list (list top-ng))))))
565 (when (> len elmo-display-progress-threshold)
567 (if (or (zerop (% i 10)) (= i len))
568 (elmo-display-progress
569 'elmo-nntp-list-folders "Parsing active..."
572 (while (re-search-forward "\\([^ ]+\\) .*\n" nil t)
573 (setq ret-val (nconc ret-val
574 (list (elmo-match-buffer 1))))
575 (when (> len elmo-display-progress-threshold)
577 (if (or (zerop (% i 10)) (= i len))
578 (elmo-display-progress
579 'elmo-nntp-list-folders "Parsing active..."
580 (/ (* i 100) len))))))
581 (when (> len elmo-display-progress-threshold)
582 (elmo-display-progress
583 'elmo-nntp-list-folders "Parsing active..." 100))))
585 (setq username (elmo-net-folder-user-internal folder))
587 elmo-nntp-default-user
588 (string= username elmo-nntp-default-user))
591 (when (or username ; XXX: ad-hoc fix against username includes "@"
592 (not (string= (elmo-net-folder-server-internal folder)
593 elmo-nntp-default-server)))
594 (setq append-serv (concat "@" (elmo-net-folder-server-internal
596 (unless (eq (elmo-net-folder-port-internal folder) elmo-nntp-default-port)
597 (setq append-serv (concat append-serv
599 (elmo-net-folder-port-internal folder)))))
600 (unless (eq (elmo-network-stream-type-symbol
601 (elmo-net-folder-stream-type-internal folder))
602 elmo-nntp-default-stream-type)
605 (elmo-network-stream-type-spec-string
606 (elmo-net-folder-stream-type-internal folder)))))
607 (mapcar '(lambda (fld)
609 (list (concat "-" (elmo-nntp-decode-group-string (car fld))
615 (concat append-serv))))
616 (concat "-" (elmo-nntp-decode-group-string fld)
618 (concat ":" username))
620 (concat append-serv)))))
623 (defun elmo-nntp-make-msglist (beg-str end-str)
625 (let ((beg-num (string-to-int beg-str))
626 (end-num (string-to-int end-str))
630 (while (<= i end-num)
631 (insert (format "%s " i))
634 (goto-char (point-min))
635 (read (current-buffer)))))
637 (luna-define-method elmo-folder-list-messages-plugged ((folder
640 (let ((session (elmo-nntp-get-session folder))
641 (group (elmo-nntp-folder-group-internal folder))
642 response numbers use-listgroup)
644 (when (setq use-listgroup (elmo-nntp-listgroup-p session))
645 (elmo-nntp-send-command session
646 (format "listgroup %s" group))
647 (if (not (elmo-nntp-read-response session t))
649 (elmo-nntp-set-listgroup session nil)
650 (setq use-listgroup nil))
651 (if (null (setq response (elmo-nntp-read-contents session)))
652 (error "Fetching listgroup failed"))
653 (setq numbers (elmo-string-to-list response))
654 (elmo-nntp-session-set-current-group-internal session
656 (unless use-listgroup
657 (elmo-nntp-send-command session (format "group %s" group))
658 (if (null (setq response (elmo-nntp-read-response session)))
659 (error "Select group failed"))
662 "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
664 (> (string-to-int (elmo-match-string 1 response)) 0))
665 (setq numbers (elmo-nntp-make-msglist
666 (elmo-match-string 2 response)
667 (elmo-match-string 3 response)))))
670 (luna-define-method elmo-folder-status ((folder elmo-nntp-folder))
671 (elmo-nntp-folder-status folder))
673 (defun elmo-nntp-folder-status (folder)
674 (let ((killed-list (elmo-msgdb-killed-list-load
675 (elmo-folder-msgdb-path folder)))
677 (if elmo-nntp-groups-async
680 (concat (elmo-nntp-folder-group-internal folder)
681 (elmo-nntp-folder-postfix
682 (elmo-net-folder-user-internal folder)
683 (elmo-net-folder-server-internal folder)
684 (elmo-net-folder-port-internal folder)
685 (elmo-net-folder-stream-type-internal folder)))
686 elmo-newsgroups-hashtb))
688 (setq end-num (nth 2 entry))
689 (when (and killed-list
690 (elmo-number-set-member end-num killed-list))
693 (cons end-num (car entry)))
694 (error "No such newsgroup \"%s\""
695 (elmo-nntp-folder-group-internal folder)))
696 (let ((session (elmo-nntp-get-session folder))
699 (error "Connection failed"))
701 (elmo-nntp-send-command session
704 (elmo-nntp-folder-group-internal folder)))
705 (setq response (elmo-nntp-read-response session))
708 "211 \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\) [^.].+$"
711 (setq end-num (string-to-int
712 (elmo-match-string 3 response)))
713 (setq e-num (string-to-int
714 (elmo-match-string 1 response)))
715 (when (and killed-list
716 (elmo-number-set-member end-num killed-list))
719 (cons end-num e-num))
721 (error "Selecting newsgroup \"%s\" failed"
722 (elmo-nntp-folder-group-internal folder))
725 (defconst elmo-nntp-overview-index
736 (defun elmo-nntp-create-msgdb-from-overview-string (str
739 (let ((new-msgdb (elmo-make-msgdb))
740 ov-list gmark message-id entity
742 extras extra ext field field-index)
743 (setq ov-list (elmo-nntp-parse-overview-string str))
745 (setq ov-entity (car ov-list))
747 ;;; (if (or (> (setq num (string-to-int (aref ov-entity 0)))
751 ;;; (setq num (int-to-string num))
752 (setq num (string-to-int (aref ov-entity 0)))
753 (when (or (null numlist)
755 (setq extras elmo-msgdb-extra-fields
758 (setq ext (downcase (car extras)))
759 (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index)))
760 (when (> (length ov-entity) field-index)
761 (setq field (aref ov-entity field-index))
762 (when (eq field-index 8) ;; xref
763 (setq field (elmo-msgdb-remove-field-string field)))
764 (setq extra (cons (cons ext field) extra))))
765 (setq extras (cdr extras)))
766 (setq entity (elmo-msgdb-make-message-entity
767 :message-id (aref ov-entity 4)
769 :references (elmo-msgdb-get-last-message-id
771 :from (elmo-mime-string (elmo-delete-char
776 :subject (elmo-mime-string (or (aref ov-entity 1)
778 :date (aref ov-entity 3)
779 :size (string-to-int (aref ov-entity 6))
781 (setq message-id (elmo-message-entity-field entity 'message-id))
782 (setq gmark (or (elmo-msgdb-global-mark-get message-id)
784 (elmo-flag-table-get flag-table message-id)
785 (elmo-file-cache-status
786 (elmo-file-cache-get message-id))
788 (elmo-msgdb-append-entity new-msgdb entity gmark))
789 (setq ov-list (cdr ov-list)))
792 (luna-define-method elmo-folder-msgdb-create ((folder elmo-nntp-folder)
794 (elmo-nntp-folder-msgdb-create folder numbers flag-table))
796 (defun elmo-nntp-folder-msgdb-create (folder numbers flag-table)
797 (let ((filter numbers)
798 (session (elmo-nntp-get-session folder))
799 (new-msgdb (elmo-make-msgdb))
800 beg-num end-num cur length
801 new-msgdb ov-str use-xover dir)
802 (elmo-nntp-select-group session (elmo-nntp-folder-group-internal
804 (when (setq use-xover (elmo-nntp-xover-p session))
805 (setq beg-num (car numbers)
807 end-num (nth (1- (length numbers)) numbers)
808 length (+ (- end-num beg-num) 1))
809 (message "Getting overview...")
810 (while (<= cur end-num)
811 (elmo-nntp-send-command
818 elmo-nntp-overview-fetch-chop-length))))
819 (with-current-buffer (elmo-network-session-buffer session)
823 (elmo-nntp-create-msgdb-from-overview-string
827 (if (null (elmo-nntp-read-response session t))
829 (setq cur end-num);; exit while loop
830 (elmo-nntp-set-xover session nil)
831 (setq use-xover nil))
832 (if (null (setq ov-str (elmo-nntp-read-contents session)))
833 (error "Fetching overview failed")))
834 (setq cur (+ elmo-nntp-overview-fetch-chop-length cur 1))
835 (when (> length elmo-display-progress-threshold)
836 (elmo-display-progress
837 'elmo-nntp-msgdb-create "Getting overview..."
838 (/ (* (+ (- (min cur end-num)
839 beg-num) 1) 100) length))))
840 (when (> length elmo-display-progress-threshold)
841 (elmo-display-progress
842 'elmo-nntp-msgdb-create "Getting overview..." 100)))
844 (setq new-msgdb (elmo-nntp-msgdb-create-by-header
845 session numbers flag-table))
846 (with-current-buffer (elmo-network-session-buffer session)
850 (elmo-nntp-create-msgdb-from-overview-string
854 (elmo-folder-set-killed-list-internal
857 (elmo-folder-killed-list-internal folder)
860 (elmo-msgdb-list-messages new-msgdb)))))
861 ;; If there are canceled messages, overviews are not obtained
862 ;; to max-number(inn 2.3?).
863 (when (and (elmo-nntp-max-number-precedes-list-active-p)
864 (elmo-nntp-list-active-p session))
865 (elmo-nntp-send-command session
866 (format "list active %s"
867 (elmo-nntp-folder-group-internal
869 (if (null (elmo-nntp-read-response session))
871 (elmo-nntp-set-list-active session nil)
872 (error "NNTP list command failed")))
873 (elmo-nntp-catchup-msgdb
875 (nth 1 (read (concat "(" (elmo-nntp-read-contents
879 (luna-define-method elmo-folder-update-number ((folder elmo-nntp-folder))
880 (if (elmo-nntp-max-number-precedes-list-active-p)
881 (let ((session (elmo-nntp-get-session folder))
882 (number-alist (elmo-msgdb-get-number-alist
883 (elmo-folder-msgdb folder))))
884 (if (elmo-nntp-list-active-p session)
885 (let (msgdb-max max-number)
886 ;; If there are canceled messages, overviews are not obtained
887 ;; to max-number(inn 2.3?).
888 (elmo-nntp-select-group session
889 (elmo-nntp-folder-group-internal folder))
890 (elmo-nntp-send-command session
891 (format "list active %s"
892 (elmo-nntp-folder-group-internal
894 (if (null (elmo-nntp-read-response session))
895 (error "NNTP list command failed"))
897 (nth 1 (read (concat "(" (elmo-nntp-read-contents
900 (car (nth (max (- (length number-alist) 1) 0)
902 (if (or (and number-alist (not msgdb-max))
903 (and msgdb-max max-number
904 (< msgdb-max max-number)))
905 (elmo-msgdb-set-number-alist
906 (elmo-folder-msgdb folder)
908 (list (cons max-number nil))))))))))
910 (defun elmo-nntp-msgdb-create-by-header (session numbers flag-table)
912 (elmo-nntp-retrieve-headers session (current-buffer) numbers)
913 (elmo-nntp-msgdb-create-message
914 (length numbers) flag-table)))
916 (defun elmo-nntp-parse-xhdr-response (string)
920 (goto-char (point-min))
922 (if (looking-at "^\\([0-9]+\\) \\(.*\\)$")
923 (setq response (cons (cons (string-to-int (elmo-match-buffer 1))
924 (elmo-match-buffer 2))
927 (nreverse response)))
929 (defun elmo-nntp-parse-overview-string (string)
931 (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))
932 ret-list ret-val beg)
933 (set-buffer tmp-buffer)
935 (elmo-set-buffer-multibyte nil)
937 (goto-char (point-min))
941 (setq ret-list (save-match-data
942 (apply 'vector (split-string
943 (buffer-substring beg (point))
948 (setq ret-val (nconc ret-val (list ret-list))))
949 ;;; (kill-buffer tmp-buffer)
952 (defun elmo-nntp-get-newsgroup-by-msgid (msgid server user port type)
953 "Get nntp header string."
955 (let ((session (elmo-nntp-get-session
961 :stream-type type))))
962 (elmo-nntp-send-command session
963 (format "head %s" msgid))
964 (if (elmo-nntp-read-response session)
965 (elmo-nntp-read-contents session))
966 (with-current-buffer (elmo-network-session-buffer session)
967 (std11-field-body "Newsgroups")))))
969 (luna-define-method elmo-message-fetch-with-cache-process :around
970 ((folder elmo-nntp-folder) number strategy &optional section unread)
971 (when (luna-call-next-method)
972 (elmo-nntp-setup-crosspost-buffer folder number)
974 (elmo-nntp-folder-update-crosspost-message-alist
975 folder (list number)))
978 (luna-define-method elmo-message-fetch-plugged ((folder elmo-nntp-folder)
980 &optional section outbuf
982 (elmo-nntp-message-fetch folder number strategy section outbuf unread))
984 (defun elmo-nntp-message-fetch (folder number strategy section outbuf unread)
985 (let ((session (elmo-nntp-get-session folder))
987 (with-current-buffer (elmo-network-session-buffer session)
988 (elmo-nntp-select-group session (elmo-nntp-folder-group-internal folder))
989 (elmo-nntp-send-command session (format "article %s" number))
990 (if (null (elmo-nntp-read-response session t))
992 (with-current-buffer outbuf (erase-buffer))
993 (message "Fetching message failed")
995 (prog1 (elmo-nntp-read-body session outbuf)
996 (with-current-buffer outbuf
997 (goto-char (point-min))
998 (while (re-search-forward "^\\." nil t)
1001 (elmo-nntp-setup-crosspost-buffer folder number)
1003 (elmo-nntp-folder-update-crosspost-message-alist
1004 folder (list number)))))))))
1006 (defun elmo-nntp-post (hostname content-buf)
1007 (let ((session (elmo-nntp-get-session
1010 :user elmo-nntp-default-user
1012 :port elmo-nntp-default-port
1014 (elmo-get-network-stream-type
1015 elmo-nntp-default-stream-type))))
1016 response has-message-id)
1018 (set-buffer content-buf)
1019 (goto-char (point-min))
1020 (if (search-forward mail-header-separator nil t)
1021 (delete-region (match-beginning 0)(match-end 0)))
1022 (setq has-message-id (std11-field-body "message-id"))
1023 (elmo-nntp-send-command session "post")
1024 (if (string-match "^340" (setq response
1025 (elmo-nntp-read-raw-response session)))
1026 (if (string-match "recommended ID \\(<[^@]+@[^>]+>\\)" response)
1027 (unless has-message-id
1028 (goto-char (point-min))
1029 (insert (concat "Message-ID: "
1030 (elmo-match-string 1 response)
1032 (error "POST failed"))
1033 (run-hooks 'elmo-nntp-post-pre-hook)
1034 (elmo-nntp-send-buffer session content-buf)
1035 (elmo-nntp-send-command session ".")
1036 ;;; (elmo-nntp-read-response buffer process t)
1037 (if (not (string-match
1038 "^2" (setq response (elmo-nntp-read-raw-response
1040 (error "NNTP error: %s" response)))))
1042 (defsubst elmo-nntp-send-data-line (session line)
1043 "Send LINE to SESSION."
1044 ;; Escape "." at start of a line
1045 (if (eq (string-to-char line) ?.)
1046 (process-send-string (elmo-network-session-process-internal
1048 (process-send-string (elmo-network-session-process-internal
1050 (process-send-string (elmo-network-session-process-internal
1053 (defun elmo-nntp-send-buffer (session databuf)
1054 "Send data content of DATABUF to SESSION."
1055 (let ((data-continue t)
1057 (with-current-buffer databuf
1058 (goto-char (point-min))
1059 (while data-continue
1063 (setq line (buffer-substring bol (point)))
1064 (unless (eq (forward-line 1) 0) (setq data-continue nil))
1065 (elmo-nntp-send-data-line session line)))))
1067 (luna-define-method elmo-folder-delete-messages ((folder elmo-nntp-folder)
1069 (elmo-nntp-folder-delete-messages folder numbers))
1071 (defun elmo-nntp-folder-delete-messages (folder numbers)
1072 (let ((killed-list (elmo-folder-killed-list-internal folder)))
1073 (dolist (number numbers)
1075 (elmo-msgdb-set-as-killed killed-list number)))
1076 (elmo-folder-set-killed-list-internal folder killed-list))
1079 (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-nntp-folder))
1080 (let ((session (elmo-nntp-get-session folder)))
1081 (elmo-nntp-send-command
1084 (elmo-nntp-folder-group-internal folder)))
1085 (elmo-nntp-read-response session)))
1087 (defun elmo-nntp-retrieve-field (spec field from-msgs)
1088 "Retrieve FIELD values from FROM-MSGS.
1089 Returns a list of cons cells like (NUMBER . VALUE)"
1090 (let ((session (elmo-nntp-get-session spec)))
1091 (if (elmo-nntp-xhdr-p session)
1093 (elmo-nntp-select-group session (elmo-nntp-folder-group-internal spec))
1094 (elmo-nntp-send-command session
1095 (format "xhdr %s %s"
1103 (- (length from-msgs) 1) 0)
1106 (if (elmo-nntp-read-response session t)
1107 (elmo-nntp-parse-xhdr-response
1108 (elmo-nntp-read-contents session))
1109 (elmo-nntp-set-xhdr session nil)
1110 (error "NNTP XHDR command failed"))))))
1112 (defun elmo-nntp-search-primitive (spec condition &optional from-msgs)
1113 (let ((search-key (elmo-filter-key condition)))
1115 ((string= "last" search-key)
1116 (let ((numbers (or from-msgs (elmo-folder-list-messages spec))))
1117 (nthcdr (max (- (length numbers)
1118 (string-to-int (elmo-filter-value condition)))
1121 ((string= "first" search-key)
1122 (let* ((numbers (or from-msgs (elmo-folder-list-messages spec)))
1123 (rest (nthcdr (string-to-int (elmo-filter-value condition) )
1125 (mapcar '(lambda (x) (delete x numbers)) rest)
1127 ((or (string= "since" search-key)
1128 (string= "before" search-key))
1129 (let* ((specified-date (elmo-date-make-sortable-string
1130 (elmo-date-get-datevec (elmo-filter-value
1132 (since (string= "since" search-key))
1134 (if (eq (elmo-filter-type condition) 'unmatch)
1135 (setq since (not since)))
1141 (elmo-date-make-sortable-string
1144 (current-time-zone) nil)))
1146 (or (string= specified-date field-date)
1147 (string< specified-date field-date))
1151 (elmo-nntp-retrieve-field spec "date" from-msgs))))
1153 (elmo-list-filter from-msgs result)
1155 ((string= "body" search-key)
1158 (let ((val (elmo-filter-value condition))
1159 (negative (eq (elmo-filter-type condition) 'unmatch))
1160 (case-fold-search t)
1166 (if (string-match val
1167 (eword-decode-string
1168 (decode-mime-charset-string
1169 (cdr pair) elmo-mime-charset)))
1170 (unless negative (car pair))
1171 (if negative (car pair))))
1172 (elmo-nntp-retrieve-field spec search-key
1175 (elmo-list-filter from-msgs result)
1178 (defun elmo-nntp-search-internal (folder condition from-msgs)
1181 ((vectorp condition)
1182 (setq result (elmo-nntp-search-primitive
1183 folder condition from-msgs)))
1184 ((eq (car condition) 'and)
1185 (setq result (elmo-nntp-search-internal folder
1188 result (elmo-list-filter result
1189 (elmo-nntp-search-internal
1190 folder (nth 2 condition)
1192 ((eq (car condition) 'or)
1193 (setq result (elmo-nntp-search-internal folder
1196 result (elmo-uniq-list
1198 (elmo-nntp-search-internal folder
1201 result (sort result '<))))))
1203 (luna-define-method elmo-folder-search :around ((folder elmo-nntp-folder)
1204 condition &optional from-msgs)
1205 (if (and (elmo-folder-plugged-p folder)
1206 (not (string= "body" (elmo-filter-key condition))))
1207 (elmo-nntp-search-internal folder condition from-msgs)
1208 (luna-call-next-method)))
1210 (defun elmo-nntp-get-folders-info-prepare (folder session-keys)
1212 (let ((session (elmo-nntp-get-session folder))
1214 (with-current-buffer (elmo-network-session-buffer session)
1215 (unless (setq key (assoc session session-keys))
1217 (setq key (cons session
1219 (elmo-net-folder-server-internal folder)
1220 (elmo-net-folder-user-internal folder)
1221 (elmo-net-folder-port-internal folder)
1222 (elmo-net-folder-stream-type-internal
1224 (setq session-keys (nconc session-keys (list key))))
1225 (elmo-nntp-send-command session
1227 (elmo-nntp-folder-group-internal
1230 (if elmo-nntp-get-folders-securely
1231 (accept-process-output
1232 (elmo-network-session-process-internal session)
1234 (setq count (aref (cdr key) 0))
1235 (aset (cdr key) 0 (1+ count))))
1237 (when elmo-auto-change-plugged
1242 (defun elmo-nntp-get-folders-info (session-keys)
1243 (let ((sessions session-keys)
1244 (cur (get-buffer-create " *ELMO NNTP Temp*")))
1246 (let* ((session (caar sessions))
1247 (key (cdar sessions))
1248 (count (aref key 0))
1249 (server (aref key 1))
1253 (hashtb (or elmo-newsgroups-hashtb
1254 (setq elmo-newsgroups-hashtb
1255 (elmo-make-hash count)))))
1257 (elmo-nntp-groups-read-response session cur count)
1259 (goto-char (point-min))
1260 (let ((case-replace nil)
1261 (postfix (elmo-nntp-folder-postfix user server port type)))
1262 (if (not (string= postfix ""))
1264 (while (re-search-forward "^\\(211 [0-9]+ [0-9]+ [0-9]+ [^ \n]+\\)\\(.*\\)$" nil t)
1265 (replace-match (concat (match-string 1)
1266 (elmo-replace-in-string
1268 "\\\\" "\\\\\\\\\\\\\\\\")))))))
1269 (let (len min max group)
1272 (when (= (following-char) ?2)
1274 (setq len (read cur)
1277 (set (setq group (let ((obarray hashtb)) (read cur)))
1278 (list len min max)))
1279 (error (and group (symbolp group) (set group nil))))
1281 (setq sessions (cdr sessions))))
1284 ;; original is 'nntp-retrieve-groups [Gnus]
1285 (defun elmo-nntp-groups-read-response (session outbuf count)
1287 (last-point (point-min)))
1288 (with-current-buffer (elmo-network-session-buffer session)
1289 (accept-process-output
1290 (elmo-network-session-process-internal session) 1)
1292 ;; Wait for all replies.
1293 (message "Getting folders info...")
1295 (goto-char last-point)
1297 (while (re-search-forward "^[0-9]" nil t)
1300 (setq last-point (point))
1302 (accept-process-output (elmo-network-session-process-internal session)
1305 (when (> count elmo-display-progress-threshold)
1306 (if (or (zerop (% received 10)) (= received count))
1307 (elmo-display-progress
1308 'elmo-nntp-groups-read-response "Getting folders info..."
1309 (/ (* received 100) count)))))
1310 (when (> count elmo-display-progress-threshold)
1311 (elmo-display-progress
1312 'elmo-nntp-groups-read-response "Getting folders info..." 100))
1313 ;; Wait for the reply from the final command.
1314 (goto-char (point-max))
1315 (re-search-backward "^[0-9]" nil t)
1316 (when (looking-at "^[23]")
1318 (goto-char (point-max))
1319 (not (re-search-backward "\r?\n" (- (point) 3) t)))
1320 (accept-process-output
1321 (elmo-network-session-process-internal session) 1)
1323 ;; Now all replies are received. We remove CRs.
1324 (goto-char (point-min))
1325 (while (search-forward "\r" nil t)
1326 (replace-match "" t t))
1327 (copy-to-buffer outbuf (point-min) (point-max)))))
1329 ;; from nntp.el [Gnus]
1331 (defsubst elmo-nntp-next-result-arrived-p ()
1333 ((eq (following-char) ?2)
1334 (if (re-search-forward "\n\\.\r?\n" nil t)
1337 ((looking-at "[34]")
1338 (if (search-forward "\n" nil t)
1344 (defun elmo-nntp-retrieve-headers (session outbuf articles)
1345 "Retrieve the headers of ARTICLES."
1346 (with-current-buffer (elmo-network-session-buffer session)
1348 (let ((number (length articles))
1351 (last-point (point-min))
1353 ;; Send HEAD commands.
1354 (while (setq article (pop articles))
1355 (elmo-nntp-send-command session
1356 (format "head %s" article)
1358 (setq count (1+ count))
1359 ;; Every 200 requests we have to read the stream in
1360 ;; order to avoid deadlocks.
1361 (when (or (null articles) ;All requests have been sent.
1362 (zerop (% count elmo-nntp-header-fetch-chop-length)))
1363 (accept-process-output
1364 (elmo-network-session-process-internal session) 1)
1367 (goto-char last-point)
1369 (while (elmo-nntp-next-result-arrived-p)
1370 (setq last-point (point))
1371 (setq received (1+ received)))
1373 (when (> number elmo-display-progress-threshold)
1374 (if (or (zerop (% received 20)) (= received number))
1375 (elmo-display-progress
1376 'elmo-nntp-retrieve-headers "Getting headers..."
1377 (/ (* received 100) number))))
1378 (accept-process-output
1379 (elmo-network-session-process-internal session) 1)
1381 (when (> number elmo-display-progress-threshold)
1382 (elmo-display-progress
1383 'elmo-nntp-retrieve-headers "Getting headers..." 100))
1384 (message "Getting headers...done")
1385 ;; Remove all "\r"'s.
1386 (goto-char (point-min))
1387 (while (search-forward "\r\n" nil t)
1388 (replace-match "\n"))
1389 (copy-to-buffer outbuf (point-min) (point-max)))))
1393 (defun elmo-nntp-msgdb-create-message (len flag-table)
1395 (let ((new-msgdb (elmo-make-msgdb))
1396 beg entity i num gmark message-id)
1397 (elmo-set-buffer-multibyte nil)
1398 (goto-char (point-min))
1400 (message "Creating msgdb...")
1402 (setq beg (save-excursion (forward-line 1) (point)))
1404 (and (looking-at "^2[0-9]*[ ]+\\([0-9]+\\)")
1406 (elmo-match-buffer 1))))
1407 (elmo-nntp-next-result-arrived-p)
1412 (narrow-to-region beg (point))
1414 (elmo-msgdb-create-overview-from-buffer num))
1417 (elmo-message-entity-field entity 'message-id)
1419 (or (elmo-msgdb-global-mark-get message-id)
1421 (elmo-flag-table-get flag-table message-id)
1422 (elmo-file-cache-status
1423 (elmo-file-cache-get message-id))
1425 (elmo-msgdb-append-entity new-msgdb entity gmark)))))
1426 (when (> len elmo-display-progress-threshold)
1428 (if (or (zerop (% i 20)) (= i len))
1429 (elmo-display-progress
1430 'elmo-nntp-msgdb-create-message "Creating msgdb..."
1431 (/ (* i 100) len)))))
1432 (when (> len elmo-display-progress-threshold)
1433 (elmo-display-progress
1434 'elmo-nntp-msgdb-create-message "Creating msgdb..." 100))
1437 (luna-define-method elmo-message-use-cache-p ((folder elmo-nntp-folder) number)
1438 elmo-nntp-use-cache)
1440 (defun elmo-nntp-parse-newsgroups (string &optional subscribe-only)
1441 (let ((nglist (elmo-parse string "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)"))
1443 (if (not subscribe-only)
1446 (if (intern-soft ng elmo-newsgroups-hashtb)
1447 (setq ngs (cons ng ngs))))
1450 ;;; Crosspost processing.
1452 ;; 1. setup crosspost alist.
1453 ;; 1.1. When message is fetched and is crossposted message,
1454 ;; it is remembered in `temp-crosses' slot.
1455 ;; temp-crosses slot is a list of cons cell:
1456 ;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1457 ;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1458 ;; 1.3. In elmo-folder-mark-as-read, move crosspost entry
1459 ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1461 ;; 2. process crosspost alist.
1462 ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1463 ;; `elmo-crosspost-message-alist'.
1464 ;; 2.2. remove crosspost entry for current newsgroup from
1465 ;; `elmo-crosspost-message-alist'.
1466 ;; 2.3. elmo-folder-list-unreads return unread message list according to
1468 ;; (There's a problem that if `elmo-folder-list-unreads'
1469 ;; never executed, crosspost information is thrown away.)
1470 ;; 2.4. In elmo-folder-close, `read' slot is cleared,
1472 (defun elmo-nntp-setup-crosspost-buffer (folder number)
1473 ;; 1.1. When message is fetched and is crossposted message,
1474 ;; it is remembered in `temp-crosses' slot.
1475 ;; temp-crosses slot is a list of cons cell:
1476 ;; (NUMBER . (MESSAGE-ID (LIST-OF-NEWSGROUPS) 'ng))
1477 (let (newsgroups crosspost-newsgroups message-id)
1479 (std11-narrow-to-header)
1480 (setq newsgroups (std11-fetch-field "newsgroups")
1481 message-id (std11-msg-id-string
1482 (car (std11-parse-msg-id-string
1483 (std11-fetch-field "message-id"))))))
1485 (when (setq crosspost-newsgroups
1487 (elmo-nntp-folder-group-internal folder)
1488 (elmo-nntp-parse-newsgroups newsgroups t)))
1489 (unless (assq number
1490 (elmo-nntp-folder-temp-crosses-internal folder))
1491 (elmo-nntp-folder-set-temp-crosses-internal
1493 (cons (cons number (list message-id crosspost-newsgroups 'ng))
1494 (elmo-nntp-folder-temp-crosses-internal folder))))))))
1496 (luna-define-method elmo-folder-close-internal ((folder elmo-nntp-folder))
1497 ;; 1.2. In elmo-folder-close, `temp-crosses' slot is cleared,
1498 (elmo-nntp-folder-set-temp-crosses-internal folder nil)
1499 (elmo-nntp-folder-set-reads-internal folder nil)
1502 (defun elmo-nntp-folder-update-crosspost-message-alist (folder numbers)
1503 ;; 1.3. In elmo-folder-mark-as-read, move crosspost entry
1504 ;; from `temp-crosses' slot to `elmo-crosspost-message-alist'.
1506 (dolist (number numbers)
1507 (when (setq elem (assq number
1508 (elmo-nntp-folder-temp-crosses-internal folder)))
1509 (unless (assoc (cdr (cdr elem)) elmo-crosspost-message-alist)
1510 (setq elmo-crosspost-message-alist
1511 (cons (cdr elem) elmo-crosspost-message-alist)))
1512 (elmo-nntp-folder-set-temp-crosses-internal
1514 (delq elem (elmo-nntp-folder-temp-crosses-internal folder)))))))
1516 (luna-define-method elmo-folder-mark-as-read :before ((folder
1519 &optional ignore-flags)
1520 (elmo-nntp-folder-update-crosspost-message-alist folder numbers))
1522 (defsubst elmo-nntp-folder-process-crosspost (folder)
1523 ;; 2.1. At elmo-folder-process-crosspost, setup `reads' slot from
1524 ;; `elmo-crosspost-message-alist'.
1525 ;; 2.2. remove crosspost entry for current newsgroup from
1526 ;; `elmo-crosspost-message-alist'.
1527 (let (cross-deletes reads entity ngs)
1528 (dolist (cross elmo-crosspost-message-alist)
1529 (when (setq entity (elmo-message-entity folder (nth 0 cross)))
1530 (setq reads (cons (elmo-message-entity-number entity) reads)))
1532 (if (setq ngs (delete (elmo-nntp-folder-group-internal folder)
1534 (setcar (cdr cross) ngs)
1535 (setq cross-deletes (cons cross cross-deletes)))
1536 (setq elmo-crosspost-message-alist-modified t)))
1537 (dolist (dele cross-deletes)
1538 (setq elmo-crosspost-message-alist (delq
1540 elmo-crosspost-message-alist)))
1541 (elmo-nntp-folder-set-reads-internal folder reads)))
1543 (luna-define-method elmo-folder-process-crosspost ((folder elmo-nntp-folder))
1544 (elmo-nntp-folder-process-crosspost folder))
1546 (luna-define-method elmo-folder-list-unreads :around ((folder
1548 ;; 2.3. elmo-folder-list-unreads return unread message list according to
1550 (elmo-living-messages (luna-call-next-method)
1551 (elmo-nntp-folder-reads-internal folder)))
1554 (product-provide (provide 'elmo-nntp) (require 'elmo-version))
1556 ;;; elmo-nntp.el ends here