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

   1 ;;; nnvirtual.el --- virtual newsgroups access for Gnus
   2 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: David Moore <dmoore@ucsd.edu>
   6 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   8 ;; Keywords: news
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; The other access methods (nntp, nnspool, etc) are general news
  30 ;; access methods.  This module relies on Gnus and can not be used
  31 ;; separately.
  32
  33 ;;; Code:
  34
  35 (require 'nntp)
  36 (require 'nnheader)
  37 (require 'gnus)
  38 (require 'nnoo)
  39 (require 'gnus-util)
  40 (require 'gnus-start)
  41 (require 'gnus-sum)
  42 (require 'gnus-msg)
  43 (eval-when-compile (require 'cl))
  44
  45 (nnoo-declare nnvirtual)
  46
  47 (defvoo nnvirtual-always-rescan t
  48   "If non-nil, always scan groups for unread articles when entering a group.
  49 If this variable is nil and you read articles in a component group
  50 after the virtual group has been activated, the read articles from the
  51 component group will show up when you enter the virtual group.")
  52
  53 (defvoo nnvirtual-component-regexp nil
  54   "Regexp to match component groups.")
  55
  56 (defvoo nnvirtual-component-groups nil
  57   "Component group in this nnvirtual group.")
  58
  59 \f
  60
  61 (defconst nnvirtual-version "nnvirtual 1.1")
  62
  63 (defvoo nnvirtual-current-group nil)
  64
  65 (defvoo nnvirtual-mapping-table nil
  66   "Table of rules on how to map between component group and article number to virtual article number.")
  67
  68 (defvoo nnvirtual-mapping-offsets nil
  69   "Table indexed by component group to an offset to be applied to article numbers in that group.")
  70
  71 (defvoo nnvirtual-mapping-len 0
  72   "Number of articles in this virtual group.")
  73
  74 (defvoo nnvirtual-mapping-reads nil
  75   "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
  76
  77 (defvoo nnvirtual-mapping-marks nil
  78   "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
  79
  80 (defvoo nnvirtual-info-installed nil
  81   "T if we have already installed the group info for this group, and shouldn't blast over it again.")
  82
  83 (defvoo nnvirtual-status-string "")
  84
  85 (eval-and-compile
  86   (autoload 'gnus-cache-articles-in-group "gnus-cache"))
  87
  88 \f
  89
  90 ;;; Interface functions.
  91
  92 (nnoo-define-basics nnvirtual)
  93
  94
  95 (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
  96                                              server fetch-old)
  97   (when (nnvirtual-possibly-change-server server)
  98     (save-excursion
  99       (set-buffer nntp-server-buffer)
 100       (erase-buffer)
 101       (if (stringp (car articles))
 102           'headers
 103         (let ((vbuf (nnheader-set-temp-buffer
 104                      (get-buffer-create " *virtual headers*")))
 105               (carticles (nnvirtual-partition-sequence articles))
 106               (system-name (system-name))
 107               cgroup carticle article result prefix)
 108           (while carticles
 109             (setq cgroup (caar carticles))
 110             (setq articles (cdar carticles))
 111             (pop carticles)
 112             (when (and articles
 113                        (gnus-check-server
 114                         (gnus-find-method-for-group cgroup) t)
 115                        (gnus-request-group cgroup t)
 116                        (setq prefix (gnus-group-real-prefix cgroup))
 117                        ;; FIX FIX FIX we want to check the cache!
 118                        ;; This is probably evil if people have set
 119                        ;; gnus-use-cache to nil themselves, but I
 120                        ;; have no way of finding the true value of it.
 121                        (let ((gnus-use-cache t))
 122                          (setq result (gnus-retrieve-headers
 123                                        articles cgroup nil))))
 124               (set-buffer nntp-server-buffer)
 125               ;; If we got HEAD headers, we convert them into NOV
 126               ;; headers.  This is slow, inefficient and, come to think
 127               ;; of it, downright evil.  So sue me.  I couldn't be
 128               ;; bothered to write a header parse routine that could
 129               ;; parse a mixed HEAD/NOV buffer.
 130               (when (eq result 'headers)
 131                 (nnvirtual-convert-headers))
 132               (goto-char (point-min))
 133               (while (not (eobp))
 134                 (delete-region (point)
 135                                (progn
 136                                  (setq carticle (read nntp-server-buffer))
 137                                  (point)))
 138
 139                 ;; We remove this article from the articles list, if
 140                 ;; anything is left in the articles list after going through
 141                 ;; the entire buffer, then those articles have been
 142                 ;; expired or canceled, so we appropriately update the
 143                 ;; component group below.  They should be coming up
 144                 ;; generally in order, so this shouldn't be slow.
 145                 (setq articles (delq carticle articles))
 146
 147                 (setq article (nnvirtual-reverse-map-article cgroup carticle))
 148                 (if (null article)
 149                     ;; This line has no reverse mapping, that means it
 150                     ;; was an extra article reference returned by nntp.
 151                     (progn
 152                       (beginning-of-line)
 153                       (delete-region (point) (progn (forward-line 1) (point))))
 154                   ;; Otherwise insert the virtual article number,
 155                   ;; and clean up the xrefs.
 156                   (princ article nntp-server-buffer)
 157                   (nnvirtual-update-xref-header cgroup carticle
 158                                                 prefix system-name)
 159                   (forward-line 1))
 160                 )
 161
 162               (set-buffer vbuf)
 163               (goto-char (point-max))
 164               (insert-buffer-substring nntp-server-buffer))
 165             ;; Anything left in articles is expired or canceled.
 166             ;; Could be smart and not tell it about articles already known?
 167             (when articles
 168               (gnus-group-make-articles-read cgroup articles))
 169             )
 170
 171           ;; The headers are ready for reading, so they are inserted into
 172           ;; the nntp-server-buffer, which is where Gnus expects to find
 173           ;; them.
 174           (prog1
 175               (save-excursion
 176                 (set-buffer nntp-server-buffer)
 177                 (erase-buffer)
 178                 (insert-buffer-substring vbuf)
 179                 ;; FIX FIX FIX, we should be able to sort faster than
 180                 ;; this if needed, since each cgroup is sorted, we just
 181                 ;; need to merge
 182                 (sort-numeric-fields 1 (point-min) (point-max))
 183                 'nov)
 184             (kill-buffer vbuf)))))))
 185
 186
 187 (defvoo nnvirtual-last-accessed-component-group nil)
 188
 189 (deffoo nnvirtual-request-article (article &optional group server buffer)
 190   (when (nnvirtual-possibly-change-server server)
 191     (if (stringp article)
 192         ;; This is a fetch by Message-ID.
 193         (cond
 194          ((not nnvirtual-last-accessed-component-group)
 195           (nnheader-report
 196            'nnvirtual "Don't know what server to request from"))
 197          (t
 198           (save-excursion
 199             (when buffer
 200               (set-buffer buffer))
 201             (let* ((gnus-override-method nil)
 202                    (method (gnus-find-method-for-group
 203                             nnvirtual-last-accessed-component-group)))
 204               (funcall (gnus-get-function method 'request-article)
 205                        article nil (nth 1 method) buffer)))))
 206       ;; This is a fetch by number.
 207       (let* ((amap (nnvirtual-map-article article))
 208              (cgroup (car amap)))
 209         (cond
 210          ((not amap)
 211           (nnheader-report 'nnvirtual "No such article: %s" article))
 212          ((not (gnus-check-group cgroup))
 213           (nnheader-report
 214            'nnvirtual "Can't open server where %s exists" cgroup))
 215          ((not (gnus-request-group cgroup t))
 216           (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
 217          (t
 218           (setq nnvirtual-last-accessed-component-group cg