1 ;;;; nnvirtual.el --- Virtual newsgroups access for (ding) Gnus
2 ;; Copyright (C) 1994,95 Free Software Foundation, Inc.
4 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;; The other access methods (nntp, nnspool, etc) are general news
27 ;; access methods. This module relies on Gnus and can not be used
36 (defconst nnvirtual-version "nnvirtual 0.0"
37 "Version numbers of this version of nnvirual.")
39 (defvar nnvirtual-large-newsgroup 50
40 "*The number of the articles which indicates a large newsgroup.
41 If the number of the articles is greater than the value, verbose
42 messages will be shown to indicate the current status.")
46 (defvar nnvirtual-newsgroups nil
47 "The newsgroups that belong to this virtual newsgroup.")
49 (defvar nnvirtual-newsgroups-regexp nil
50 "The newsgroups that belong to this virtual newsgroup.")
52 (defvar nnvirtual-mapping nil)
54 (defvar nnvirtual-do-not-open nil)
56 (defvar nnvirtual-status-string "")
60 ;;; Interface functions.
62 (defun nnvirtual-retrieve-headers (sequence &optional newsgroup server)
63 "Retrieve the headers for the articles in SEQUENCE."
64 (nnvirtual-possibly-change-newsgroups newsgroup server)
66 (set-buffer (get-buffer-create "*virtual headers*"))
68 (let ((number (length sequence))
70 (nntp-xover-is-evil t)
72 prev articles group-articles beg art-info article group)
73 (if sequence (setq prev (car (aref nnvirtual-mapping (car sequence)))))
75 (setq art-info (aref nnvirtual-mapping (car sequence)))
76 (if (not (equal prev (car art-info)))
78 (setq group-articles (cons (list prev (nreverse articles))
81 (setq prev (car art-info))))
82 (setq articles (cons (cdr art-info) articles))
83 (setq sequence (cdr sequence)))
85 (setq group-articles (cons (list prev (nreverse articles))
87 (setq group-articles (nreverse group-articles))
89 (setq group (car (car group-articles)))
90 (gnus-retrieve-headers (car (cdr (car group-articles))) group)
92 (set-buffer nntp-server-buffer)
96 (while (search-forward "\n.\n" nil t)
97 (if (not (looking-at ".[0-9]+ \\([0-9]+\\) "))
99 (setq article (string-to-int (gnus-buffer-substring 1 1)))
101 (while (/= article (cdr (aref nnvirtual-mapping i)))
103 (goto-char (match-beginning 1))
104 (looking-at "[0-9]+ ")
105 (replace-match (format "%d " i))
107 (search-forward "\n.\n" nil t)
108 (if (not (re-search-backward "^Xref: " beg t))
111 (insert (format "Xref: %s %s:%d\n" (system-name)
115 (goto-char (point-max))
116 (insert-buffer-substring nntp-server-buffer 4)
117 (setq group-articles (cdr group-articles)))
118 ;; Weed out articles that appear twice because of cross-posting.
119 ;; Suggested by Stephane Laveau <laveau@corse.inria.fr>.
120 (let ((id-hashtb (make-vector number 0))
122 (goto-char (point-min))
123 ;; We look at the message-ids...
124 (while (search-forward "\nMessage-ID: " nil t)
125 ;; ... and check if they are entered into the hash table.
126 (if (boundp (setq id (intern (buffer-substring
127 (point) (progn (end-of-line) (point)))
129 ;; Yup, so we delete this header.
131 (if (search-backward "\n.\n" nil t) (1+ (point)) (point-min))
132 (if (search-forward "\n.\n" nil t) (1+ (match-beginning 0))
134 ;; Nope, so we just enter it into the hash table.
136 ;; The headers are ready for reading, so they are inserted into
137 ;; the nntp-server-buffer, which is where Gnus expects to find
141 (if (not nntp-server-buffer)
142 (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
143 (set-buffer nntp-server-buffer)
145 (insert-buffer-substring "*virtual headers*")
147 (kill-buffer (current-buffer))))))
149 (defun nnvirtual-open-server (newsgroups &optional something)
150 "Open a virtual newsgroup that contains NEWSGROUPS."
151 (let ((newsrc gnus-newsrc-assoc))
152 (setq nnvirtual-newsgroups nil)
153 (setq nnvirtual-newsgroups-regexp newsgroups)
155 (if (string-match newsgroups (car (car newsrc)))
156 (setq nnvirtual-newsgroups (cons (car (car newsrc))
157 nnvirtual-newsgroups)))
158 (setq newsrc (cdr newsrc)))
159 (if (null nnvirtual-newsgroups)
160 (setq nnvirtual-status-string
162 "nnvirtual: No newsgroups for this virtual newsgroup"))
163 (nnvirtual-open-server-internal))
164 nnvirtual-newsgroups))
166 (defun nnvirtual-close-server (&rest dum)
168 (nnvirtual-close-server-internal))
170 (fset 'nnvirtual-request-quit (symbol-function 'nnvirtual-close-server))
172 (defun nnvirtual-server-opened (&optional server)
173 "Return server process status, T or NIL.
174 If the stream is opened, return T, otherwise return NIL."
175 (and nntp-server-buffer
176 (get-buffer nntp-server-buffer)))
178 (defun nnvirtual-status-message ()
179 "Return server status response as string."
180 nnvirtual-status-string)
182 (defun nnvirtual-request-article (id &optional newsgroup server buffer)
183 "Select article by message ID (or number)."
184 (nnvirtual-possibly-change-newsgroups newsgroup server)
186 (setq art (aref nnvirtual-mapping id))
187 (gnus-request-group (car art))
188 (gnus-request-article (cdr art) (car art) buffer)))
190 (defun nnvirtual-request-group (group &optional server dont-check)
191 "Make GROUP the current newsgroup."
192 (nnvirtual-possibly-change-newsgroups nil server)
193 (let* ((group (concat gnus-foreign-group-prefix group))
194 (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
195 (groups nnvirtual-newsgroups)
200 (error "No such group: %s" group))
201 (setcar (nthcdr 2 info) nil)
203 (setq unread (car (gnus-gethash (car groups) gnus-newsrc-hashtb)))
204 (if (numberp unread) (setq total (+ total unread)))
205 (setq groups (cdr groups)))
206 (setq nnvirtual-mapping (make-vector (+ 3 total) nil))
207 (setq groups nnvirtual-newsgroups)
209 (setq igroup (car groups))
210 (setq unread (gnus-list-of-unread-articles igroup))
212 (aset nnvirtual-mapping (setq i (1+ i)) (cons igroup (car unread)))
213 (setq unread (cdr unread)))
214 (setq groups (cdr groups)))
216 (set-buffer nntp-server-buffer)
218 (insert (format "211 %d %d %d %s\n" (1+ total) 1 total group)))
221 (defun nnvirtual-request-list (&optional server)
222 "List active newsgoups."
223 (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.")
226 (defun nnvirtual-request-list-newsgroups (&optional server)
227 "List newsgroups (defined in NNTP2)."
228 (setq nnvirtual-status-string "nnvirtual: LIST NEWSGROUPS is not implemented.")
231 (fset 'nnvirtual-request-post 'nntp-request-post)
233 (fset 'nnvirtual-request-post-buffer 'nntp-request-post-buffer)
236 ;;; Low-Level Interface
238 (defun nnvirtual-open-server-internal ()
239 "Fix some internal variables."
241 ;; Initialize communicatin buffer.
242 (setq nnvirtual-mapping nil)
243 (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
244 (set-buffer nntp-server-buffer)
245 (buffer-disable-undo (current-buffer))
246 (kill-all-local-variables)
247 (setq case-fold-search t)))
249 (defun nnvirtual-close-server-internal (&rest dum)
250 "Close connection to news server."
253 (defun nnvirtual-possibly-change-newsgroups (group groups-regexp)
254 (if (and groups-regexp
255 (not (and nnvirtual-newsgroups-regexp
256 (string= groups-regexp nnvirtual-newsgroups-regexp))))
257 (nnvirtual-open-server groups-regexp)))
261 ;;; nnvirtual.el ends here