cgit.sxemacs.org Git - gnus/blob - lisp/nnvirtual.el

   1 ;;;; nnvirtual.el --- Virtual newsgroups access for (ding) Gnus
   2 ;; Copyright (C) 1994,95 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
   5 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  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)
  13 ;; any later version.
  14
  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.
  19
  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.
  23
  24 ;;; Commentary:
  25
  26 ;; The other access methods (nntp, nnspool, etc) are general news
  27 ;; access methods. This module relies on Gnus and can not be used
  28 ;; separately.
  29
  30 ;;; Code:
  31
  32 (require 'nntp)
  33 (require 'nnheader)
  34 (require 'gnus)
  35
  36 (defconst nnvirtual-version "nnvirtual 0.0"
  37   "Version numbers of this version of nnvirual.")
  38
  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.")
  43
  44 \f
  45
  46 (defvar nnvirtual-newsgroups nil
  47   "The newsgroups that belong to this virtual newsgroup.")
  48
  49 (defvar nnvirtual-newsgroups-regexp nil
  50   "The newsgroups that belong to this virtual newsgroup.")
  51
  52 (defvar nnvirtual-mapping nil)
  53
  54 (defvar nnvirtual-do-not-open nil)
  55
  56 (defvar nnvirtual-status-string "")
  57
  58 \f
  59
  60 ;;; Interface functions.
  61
  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)
  65   (save-excursion
  66     (set-buffer (get-buffer-create "*virtual headers*"))
  67     (erase-buffer)
  68     (let ((number (length sequence))
  69           (count 0)
  70           (nntp-xover-is-evil t)
  71           (i 0)
  72           prev articles group-articles beg art-info article group)
  73       (if sequence (setq prev (car (aref nnvirtual-mapping (car sequence)))))
  74       (while sequence
  75         (setq art-info (aref nnvirtual-mapping (car sequence)))
  76         (if (not (equal prev (car art-info)))
  77             (progn
  78               (setq group-articles (cons (list prev (nreverse articles))
  79                                          group-articles))
  80               (setq articles nil)
  81               (setq prev (car art-info))))
  82         (setq articles (cons (cdr art-info) articles))
  83         (setq sequence (cdr sequence)))
  84       (if prev
  85           (setq group-articles (cons (list prev (nreverse articles))
  86                                      group-articles)))
  87       (setq group-articles (nreverse group-articles))
  88       (while group-articles
  89         (setq group (car (car group-articles)))
  90         (gnus-retrieve-headers (car (cdr (car group-articles))) group)
  91         (save-excursion
  92           (set-buffer nntp-server-buffer)
  93           (goto-char 1)
  94           (insert "\n.\n")
  95           (goto-char 1)
  96           (while (search-forward "\n.\n" nil t)
  97             (if (not (looking-at ".[0-9]+ \\([0-9]+\\) "))
  98                 ()
  99               (setq article (string-to-int (gnus-buffer-substring 1 1)))
 100               (setq i 1)
 101               (while (/= article (cdr (aref nnvirtual-mapping i)))
 102                 (setq i (1+ i)))
 103               (goto-char (match-beginning 1))
 104               (looking-at "[0-9]+ ")
 105               (replace-match (format "%d " i))
 106               (setq beg (point))
 107               (search-forward "\n.\n" nil t)
 108               (if (not (re-search-backward "^Xref: " beg t))
 109                   (progn
 110                     (forward-char -2)
 111                     (insert (format "Xref: %s %s:%d\n" (system-name)
 112                                     group article))
 113                     (forward-char -1)))
 114               )))
 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))
 121             id)
 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)))
 128                                        id-hashtb)))
 129               ;; Yup, so we delete this header.
 130               (delete-region
 131                (if (search-backward "\n.\n" nil t) (1+ (point)) (point-min))
 132                (if (search-forward "\n.\n" nil t) (1+ (match-beginning 0))
 133                  (point-max))))
 134           ;; Nope, so we just enter it into the hash table.
 135           (set id t)))
 136       ;; The headers are ready for reading, so they are inserted into
 137       ;; the nntp-server-buffer, which is where Gnus expects to find
 138       ;; them.
 139       (prog1
 140           (save-excursion
 141             (if (not nntp-server-buffer)
 142                 (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
 143             (set-buffer nntp-server-buffer)
 144             (erase-buffer)
 145             (insert-buffer-substring "*virtual headers*")
 146             'headers)
 147         (kill-buffer (current-buffer))))))
 148
 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)
 154     (while newsrc
 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
 161               (format
 162                "nnvirtual: No newsgroups for this virtual newsgroup"))
 163       (nnvirtual-open-server-internal))
 164     nnvirtual-newsgroups))
 165
 166 (defun nnvirtual-close-server (&rest dum)
 167   "Close news server."
 168   (nnvirtual-close-server-internal))
 169
 170 (fset 'nnvirtual-request-quit (symbol-function 'nnvirtual-close-server))
 171
 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)))
 177
 178 (defun nnvirtual-status-message ()
 179   "Return server status response as string."
 180   nnvirtual-status-string)
 181
 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)
 185   (let (art)
 186     (setq art (aref nnvirtual-mapping id))
 187     (gnus-request-group (car art))
 188     (gnus-request-article (cdr art) (car art) buffer)))
 189
 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)
 196          (i 0)
 197          (total 0)
 198          unread igroup)
 199     (if (not info)
 200         (error "No such group: %s" group))
 201     (setcar (nthcdr 2 info) nil)
 202     (while groups
 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)
 208     (while groups
 209       (setq igroup (car groups))
 210       (setq unread (gnus-list-of-unread-articles igroup))
 211       (while unread
 212         (aset nnvirtual-mapping (setq i (1+ i)) (cons igroup (car unread)))
 213         (setq unread (cdr unread)))
 214       (setq groups (cdr groups)))
 215     (save-excursion
 216       (set-buffer nntp-server-buffer)
 217       (erase-buffer)
 218       (insert (format "211 %d %d %d %s\n" (1+ total) 1 total group)))
 219     t))
 220
 221 (defun nnvirtual-request-list (&optional server)
 222   "List active newsgoups."
 223   (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.")
 224   nil)
 225
 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.")
 229   nil)
 230
 231 (fset 'nnvirtual-request-post 'nntp-request-post)
 232
 233 (fset 'nnvirtual-request-post-buffer 'nntp-request-post-buffer)
 234
 235 \f
 236 ;;; Low-Level Interface
 237
 238 (defun nnvirtual-open-server-internal ()
 239   "Fix some internal variables."
 240   (save-excursion
 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)))
 248
 249 (defun nnvirtual-close-server-internal (&rest dum)
 250   "Close connection to news server."
 251   nil)
 252
 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)))
 258
 259 (provide 'nnvirtual)
 260
 261 ;;; nnvirtual.el ends here