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

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