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

   1 ;;;; nnvirtual.el --- Virtual newsgroups access for (ding) Gnus
   2
   3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
   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 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
  27 ;;
  28 ;; The other access methods (nntp.el and nnspool.el) are general news
  29 ;; access methods. This module relies on Gnus and can not be used
  30 ;; separately.
  31
  32 ;;; Code:
  33
  34 (require 'nntp)
  35 (require 'nnheader)
  36 (require 'gnus)
  37
  38 (defconst nnvirtual-version "nnvirtual 0.0"
  39   "Version numbers of this version of nnvirual.")
  40
  41 (defvar nnvirtual-large-newsgroup 50
  42   "*The number of the articles which indicates a large newsgroup.
  43 If the number of the articles is greater than the value, verbose
  44 messages will be shown to indicate the current status.")
  45
  46 \f
  47
  48 (defvar nnvirtual-newsgroups nil
  49   "The newsgroups that belong to this virtual newsgroup.")
  50
  51 (defvar nnvirtual-newsgroups-regexp nil
  52   "The newsgroups that belong to this virtual newsgroup.")
  53
  54 (defvar nnvirtual-mapping nil)
  55
  56 (defvar nnvirtual-do-not-open nil)
  57
  58 (defvar nnvirtual-status-string "")
  59
  60 \f
  61
  62 ;;; Interface functions.
  63
  64 (defun nnvirtual-retrieve-headers (sequence &optional newsgroup server)
  65   "Retrieve the headers for the articles in SEQUENCE."
  66   (nnvirtual-possibly-change-newsgroups newsgroup server)
  67   (save-excursion
  68     (set-buffer (get-buffer-create "*virtual headers*"))
  69     (erase-buffer)
  70     (let ((number (length sequence))
  71           (count 0)
  72           (i 0)
  73           prev articles group-articles beg art-info article group)
  74       (if sequence (setq prev (car (aref nnvirtual-mapping (car sequence)))))
  75       (while sequence
  76         (setq art-info (aref nnvirtual-mapping (car sequence)))
  77         (if (not (equal prev (car art-info)))
  78             (progn
  79               (setq group-articles (cons (list prev (nreverse articles))
  80                                          group-articles))
  81               (setq articles nil)
  82               (setq prev (car art-info))))
  83         (setq articles (cons (cdr art-info) articles))
  84         (setq sequence (cdr sequence)))
  85       (if prev
  86           (setq group-articles (cons (list prev (nreverse articles))
  87                                      group-articles)))
  88       (setq group-articles (nreverse group-articles))
  89       (while group-articles
  90         (setq group (car (car group-articles)))
  91         (gnus-retrieve-headers (car (cdr (car group-articles))) group)
  92         (save-excursion
  93           (set-buffer nntp-server-buffer)
  94           (goto-char 1)
  95           (insert "\n.\n")
  96           (goto-char 1)
  97           (while (search-forward "\n.\n" nil t)
  98             (if (not (looking-at ".[0-9]+ \\([0-9]+\\) "))
  99                 ()
 100               (setq article (string-to-int (gnus-buffer-substring 1 1)))
 101               (setq i 1)
 102               (while (/= article (cdr (aref nnvirtual-mapping i)))
 103                 (setq i (1+ i)))
 104               (goto-char (match-beginning 1))
 105               (looking-at "[0-9]+ ")
 106               (replace-match (format "%d " i))
 107               (setq beg (point))
 108               (search-forward "\n.\n" nil t)
 109               (if (not (re-search-backward "^Xref: " beg t))
 110                   (progn
 111                     (forward-char -2)
 112                     (insert (format "Xref: ding %s:%d\n" 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       (prog1
 119           (save-excursion
 120             (if (not nntp-server-buffer)
 121                 (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
 122             (set-buffer nntp-server-buffer)
 123             (erase-buffer)
 124             (insert-buffer-substring "*virtual headers*")
 125             'headers)
 126         (kill-buffer (current-buffer))))))
 127
 128 (defun nnvirtual-open-server (newsgroups &optional something)
 129   "Open a virtual newsgroup that contains NEWSGROUPS."
 130   (let ((newsrc gnus-newsrc-assoc))
 131     (setq nnvirtual-newsgroups nil)
 132     (setq nnvirtual-newsgroups-regexp newsgroups)
 133     (while newsrc
 134       (if (string-match newsgroups (car (car newsrc)))
 135           (setq nnvirtual-newsgroups (cons (car (car newsrc))
 136                                            nnvirtual-newsgroups)))
 137       (setq newsrc (cdr newsrc)))
 138     (if (null nnvirtual-newsgroups)
 139         (setq nnvirtual-status-string
 140               (format
 141                "nnvirtual: No newsgroups for this virtual newsgroup"))
 142       (nnvirtual-open-server-internal))
 143     nnvirtual-newsgroups))
 144
 145 (defun nnvirtual-close-server (&rest dum)
 146   "Close news server."
 147   (nnvirtual-close-server-internal))
 148
 149 (fset 'nnvirtual-request-quit (symbol-function 'nnvirtual-close-server))
 150
 151 (defun nnvirtual-server-opened (&optional server)
 152   "Return server process status, T or NIL.
 153 If the stream is opened, return T, otherwise return NIL."
 154   (and nntp-server-buffer
 155        (get-buffer nntp-server-buffer)))
 156
 157 (defun nnvirtual-status-message ()
 158   "Return server status response as string."
 159   nnvirtual-status-string)
 160
 161 (defun nnvirtual-request-article (id &optional newsgroup server buffer)
 162   "Select article by message ID (or number)."
 163   (nnvirtual-possibly-change-newsgroups newsgroup server)
 164   (let (art)
 165     (setq art (aref nnvirtual-mapping id))
 166     (gnus-request-group (car art))
 167     (gnus-request-article (cdr art) (car art) buffer)))
 168
 169 (defun nnvirtual-request-group (group &optional server dont-check)
 170   "Make GROUP the current newsgroup."
 171   (nnvirtual-possibly-change-newsgroups nil server)
 172   (let* ((group (concat gnus-foreign-group-prefix group))
 173          (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
 174          (groups nnvirtual-newsgroups)
 175          (i 0)
 176          (total 0)
 177          unread igroup)
 178     (if (not info)
 179         (error "No such group: %s" group))
 180     (setcar (nthcdr 2 info) nil)
 181     (while groups
 182       (setq unread (car (gnus-gethash (car groups) gnus-newsrc-hashtb)))
 183       (if (numberp unread) (setq total (+ total unread)))
 184       (setq groups (cdr groups)))
 185     (setq nnvirtual-mapping (make-vector (+ 3 total) nil))
 186     (setq groups nnvirtual-newsgroups)
 187     (while groups
 188       (setq igroup (car groups))
 189       (setq unread (gnus-list-of-unread-articles igroup))
 190       (while unread
 191         (aset nnvirtual-mapping (setq i (1+ i)) (cons igroup (car unread)))
 192         (setq unread (cdr unread)))
 193       (setq groups (cdr groups)))
 194     (save-excursion
 195       (set-buffer nntp-server-buffer)
 196       (erase-buffer)
 197       (insert (format "211 %d %d %d %s\n" (1+ total) 1 total group)))
 198     t))
 199
 200 (defun nnvirtual-request-list (&optional server)
 201   "List active newsgoups."
 202   (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.")
 203   nil)
 204
 205 (defun nnvirtual-request-list-newsgroups (&optional server)
 206   "List newsgroups (defined in NNTP2)."
 207   (setq nnvirtual-status-string "nnvirtual: LIST NEWSGROUPS is not implemented.")
 208   nil)
 209
 210 (fset 'nnvirtual-request-post 'nntp-request-post)
 211
 212 (fset 'nnvirtual-request-post-buffer 'nntp-request-post-buffer)
 213
 214 \f
 215 ;;; Low-Level Interface
 216
 217 (defun nnvirtual-open-server-internal ()
 218   "Fix some internal variables."
 219   (save-excursion
 220     ;; Initialize communicatin buffer.
 221     (setq nnvirtual-mapping nil)
 222     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
 223     (set-buffer nntp-server-buffer)
 224     (buffer-disable-undo (current-buffer))
 225     (kill-all-local-variables)
 226     (setq case-fold-search t)))
 227
 228 (defun nnvirtual-close-server-internal (&rest dum)
 229   "Close connection to news server."
 230   nil)
 231
 232 (defun nnvirtual-possibly-change-newsgroups (group groups-regexp)
 233   (if (and groups-regexp
 234            (not (and nnvirtual-newsgroups-regexp
 235                      (string= groups-regexp nnvirtual-newsgroups-regexp))))
 236       (nnvirtual-open-server groups-regexp)))
 237
 238 (provide 'nnvirtual)
 239
 240 ;;; nnvirtual.el ends here