[gnus] / lisp / nnvirtual.el

;;; nnvirtual.el --- virtual newsgroups access for Gnus
;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; The other access methods (nntp, nnspool, etc) are general news
;; access methods. This module relies on Gnus and can not be used
;; separately.

;;; Code:

(require 'nntp)
(require 'nnheader)
(require 'gnus)

(defvar nnvirtual-always-rescan nil
  "*If non-nil, always scan groups for unread articles when entering a group.
If this variable is nil (which is the default) and you read articles
in a component group after the virtual group has been activated, the
read articles from the component group will show up when you enter the
virtual group.")

\f

(defconst nnvirtual-version "nnvirtual 1.0"
  "Version number of this version of nnvirtual.")

(defvar nnvirtual-group-alist nil)
(defvar nnvirtual-current-group nil)
(defvar nnvirtual-component-groups nil)
(defvar nnvirtual-mapping nil)

(defvar nnvirtual-status-string "")

(eval-and-compile
  (autoload 'gnus-cache-articles-in-group "gnus-cache"))

\f

;;; Interface functions.

(defun nnvirtual-retrieve-headers (articles &optional newsgroup server fetch-old)
  (when (nnvirtual-possibly-change-group newsgroup server t)
    (save-excursion
      (if (stringp (car articles))
          'headers
        (let ((map nnvirtual-mapping)
              (vbuf (nnheader-set-temp-buffer 
                     (get-buffer-create " *virtual headers*")))
              (unfetched (mapcar (lambda (g) (list g))
                                 nnvirtual-component-groups))
              beg cgroup active article result prefix)
          (while articles
            (setq article (assq (pop articles) nnvirtual-mapping))
            (setq cgroup (cadr article))
            (gnus-request-group cgroup t)
            (setq prefix (gnus-group-real-prefix cgroup))
            (when (setq result (gnus-retrieve-headers 
                                (list (caddr article)) cgroup))
              (set-buffer nntp-server-buffer)
              (if (zerop (buffer-size))
                  (nconc (assq cgroup unfetched) (caddr article))
                ;; If we got HEAD headers, we convert them into NOV
                ;; headers.  This is slow, inefficient and, come to think
                ;; of it, downright evil.  So sue me.  I couldn't be
                ;; bothered to write a header parse routine that could
                ;; parse a mixed HEAD/NOV buffer.
                (when (eq result 'headers)
                  (nnvirtual-convert-headers))
                (goto-char (point-min))
                (while (not (eobp))
                  (delete-region 
                   (point) (progn (read nntp-server-buffer) (point)))
                  (insert (int-to-string (car article)))
                  (beginning-of-line)
                  (looking-at 
                   "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
                  (goto-char (match-end 0))
                  (or (search-forward 
                       "\t" (save-excursion (end-of-line) (point)) t)
                      (end-of-line))
                  (while (= (char-after (1- (point))) ? )
                    (forward-char -1)
                    (delete-char 1))
                  (if (eolp)
                      (progn
                        (end-of-line)
                        (or (= (char-after (1- (point))) ?\t)
                            (insert ?\t))
                        (insert (format "Xref: %s %s:%d\t" (system-name) 
                                        cgroup (caddr article))))
                    (if (not (string= "" prefix))
                        (while (re-search-forward 
                                "[^ ]+:[0-9]+"
                                (save-excursion (end-of-line) (point)) t)
                          (save-excursion
                            (goto-char (match-beginning 0))
                            (insert prefix))))
                    (end-of-line)
                    (or (= (char-after (1- (point))) ?\t)
                        (insert ?\t)))
                  (forward-line 1))
                (set-buffer vbuf)
                (goto-char (point-max))
                (insert-buffer-substring nntp-server-buffer))))
          
          ;; In case some of the articles have expired or been
          ;; cancelled, we have to mark them as read in the
          ;; component group.
          (while unfetched
            (when (cdar unfetched)
              (gnus-group-make-articles-read 
               (caar unfetched) (sort (cdar unfetched) '<)))
            (setq unfetched (cdr unfetched)))

          ;; The headers are ready for reading, so they are inserted into
          ;; the nntp-server-buffer, which is where Gnus expects to find
          ;; them.
          (prog1
              (save-excursion
                (set-buffer nntp-server-buffer)
                (erase-buffer)
                (insert-buffer-substring vbuf)
                'nov)
            (kill-buffer vbuf)))))))

(defun nnvirtual-open-server (server &optional something)
  (nnheader-init-server-buffer))

(defun nnvirtual-close-server (&rest dum)
  t)

(defun nnvirtual-request-close ()
  (setq nnvirtual-current-group nil
        nnvirtual-component-groups nil
        nnvirtual-mapping nil
        nnvirtual-group-alist nil)
  t)

(defun nnvirtual-server-opened (&optional server)
  (and nntp-server-buffer
       (get-buffer nntp-server-buffer)))

(defun nnvirtual-status-message (&optional server)
  nnvirtual-status-string)

(defun nnvirtual-request-article (article &optional group server buffer)
  (when (and (nnvirtual-possibly-change-group group server t)
             (numberp article))
    (let* ((amap (assq article nnvirtual-mapping))
           (cgroup (cadr amap)))
      (cond
       ((not amap)
        (nnheader-report 'nnvirtual "No such article: %s" article))
       ((not (gnus-check-group cgroup))
        (nnheader-report
         'nnvirtual "Can't open server where %s exists" cgroup))
       ((not (gnus-request-group cgroup t))
        (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
       (t
        (if buffer 
            (save-excursion
              (set-buffer buffer)
              (gnus-request-article-this-buffer (caddr amap) cgroup))
          (gnus-request-article (caddr amap) cgroup)))))))

(defun nnvirtual-request-group (group &optional server dont-check)
  (cond
   ((null (nnvirtual-possibly-change-group
           group server 
           (if nnvirtual-always-rescan nil dont-check)))
    (setq nnvirtual-current-group nil)
    (nnheader-report 'nnvirtual "No component groups in %s" group))
   (t
    (let ((len (length nnvirtual-mapping)))