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

   1 ;;; nndoc.el --- single file access for Gnus
   2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne 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 ;;; Code:
  27
  28 (require 'nnheader)
  29 (require 'rmail)
  30 (require 'nnmail)
  31
  32 \f
  33
  34 (defconst nndoc-version "nndoc 0.1"
  35   "nndoc version.")
  36
  37 (defvar nndoc-current-buffer nil
  38   "Current nndoc news buffer.")
  39
  40 (defvar nndoc-status-string "")
  41
  42 (defvar nndoc-group-alist nil)
  43
  44 ;;; Interface functions
  45
  46 (defun nndoc-retrieve-headers (sequence &optional newsgroup server)
  47   "Retrieve the headers for the articles in SEQUENCE.
  48 Newsgroup must be selected before calling this function."
  49   (save-excursion
  50     (set-buffer nntp-server-buffer)
  51     (erase-buffer)
  52     (let ((file nil)
  53           (number (length sequence))
  54           (count 0)
  55           beg article art-string start stop)
  56       (nndoc-possibly-change-buffer newsgroup server)
  57       (while sequence
  58         (setq article (car sequence))
  59         (set-buffer nndoc-current-buffer)
  60         (if (nndoc-search-for-article article)
  61             (progn
  62               (setq start
  63                     (save-excursion
  64                       (or
  65                        (re-search-backward
  66                         (concat "^" rmail-unix-mail-delimiter) nil t)
  67                        (point-min))))
  68               (search-forward "\n\n" nil t)
  69               (setq stop (1- (point)))
  70               (set-buffer nntp-server-buffer)
  71               (insert (format "221 %d Article retrieved.\n" article))
  72               (setq beg (point))
  73               (insert-buffer-substring nndoc-current-buffer start stop)
  74               (goto-char (point-max))
  75               (insert ".\n")))
  76         (setq sequence (cdr sequence)))
  77
  78       ;; Fold continuation lines.
  79       (goto-char 1)
  80       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  81         (replace-match " " t t))
  82       'headers)))
  83
  84 (defun nndoc-open-server (host &optional service)
  85   "Open mbox backend."
  86   (setq nndoc-status-string "")
  87   (setq nndoc-group-alist nil)
  88   (nnheader-init-server-buffer))
  89
  90 (defun nndoc-close-server (&optional server)
  91   "Close news server."
  92   t)
  93
  94 (defun nndoc-server-opened (&optional server)
  95   "Return server process status."
  96   (and nntp-server-buffer
  97        (get-buffer nntp-server-buffer)))
  98
  99 (defun nndoc-status-message (&optional server)
 100   "Return server status response as string."
 101   nndoc-status-string)
 102
 103 (defun nndoc-request-article (article &optional newsgroup server buffer)
 104   "Select ARTICLE by number."
 105   (nndoc-possibly-change-buffer newsgroup server)
 106   (if (stringp article)
 107       nil
 108     (save-excursion
 109       (set-buffer nndoc-current-buffer)
 110       (if (nndoc-search-for-article article)
 111           (let (start stop)
 112             (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
 113             (forward-line 1)
 114             (setq start (point))
 115             (or (and (re-search-forward
 116                       (concat "^" rmail-unix-mail-delimiter) nil t)
 117                      (forward-line -1))
 118                 (goto-char (point-max)))
 119             (setq stop (point))
 120             (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 121               (set-buffer nntp-server-buffer)
 122               (erase-buffer)
 123               (insert-buffer-substring nndoc-current-buffer start stop)
 124               t))))))
 125
 126 (defun nndoc-request-group (group &optional server dont-check)
 127   "Select news GROUP."
 128   (save-excursion
 129     (if (not (nndoc-possibly-change-buffer group server))
 130         (progn
 131           (setq nndoc-status-string "No such file")
 132           nil)
 133       (if dont-check
 134           t
 135         (save-excursion
 136           (set-buffer nntp-server-buffer)
 137           (erase-buffer)
 138           (let ((number (nndoc-number-of-articles)))
 139             (if (zerop number)
 140                 (progn
 141                   (nndoc-close-group group)
 142                   nil)
 143               (insert (format "211 %d %d %d %s\n"
 144                               number 1 number group))
 145               t)))))))
 146
 147 (defun nndoc-close-group (group &optional server)
 148   (nndoc-possibly-change-buffer group server)
 149   (kill-buffer nndoc-current-buffer)
 150   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 151                                 nndoc-group-alist))
 152   (setq nndoc-current-buffer nil)
 153   t)
 154
 155 (defun nndoc-request-list (&optional server)
 156   nil)
 157
 158 (defun nndoc-request-newgroups (date &optional server)
 159   nil)
 160
 161 (defun nndoc-request-list-newsgroups (&optional server)
 162   nil)
 163
 164 (defun nndoc-request-post (&optional server)
 165   (mail-send-and-exit nil))
 166
 167 (fset 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
 168
 169 \f
 170 ;;; Internal functions.
 171
 172 (defun nndoc-possibly-change-buffer (group file)
 173   (let (buf)
 174     (or (and nndoc-current-buffer
 175              (eq nndoc-current-buffer
 176                  (setq buf (cdr (assoc group nndoc-group-alist)))))
 177         (if buf
 178             (setq nndoc-current-buffer buf)
 179           (if (or (not (file-exists-p file))
 180                   (file-directory-p file))
 181               ()
 182             (setq nndoc-group-alist
 183                   (cons (cons group (setq nndoc-current-buffer
 184                                           (get-buffer-create
 185                                            (concat " *nndoc " group "*"))))
 186                         nndoc-group-alist))
 187             (save-excursion
 188               (set-buffer nndoc-current-buffer)
 189               (buffer-disable-undo (current-buffer))
 190               (erase-buffer)
 191               (insert-file-contents file)
 192               t))))))
 193
 194 (defun nndoc-number-of-articles ()
 195   (save-excursion
 196     (set-buffer nndoc-current-buffer)
 197     (goto-char (point-min))
 198     (let ((num 0)
 199           (delim (concat "^" rmail-unix-mail-delimiter)))
 200       (while (re-search-forward delim nil t)
 201         (setq num (1+ num)))
 202       num)))
 203
 204 (defun nndoc-search-for-article (article)
 205   (let ((obuf (current-buffer)))
 206     (set-buffer nndoc-current-buffer)
 207     (goto-char (point-min))
 208     (let ((delim (concat "^" rmail-unix-mail-delimiter)))
 209       (while (and (re-search-forward delim nil t)
 210                   (not (zerop (setq article (1- article))))))
 211       (set-buffer obuf)
 212       (if (zerop article)
 213           (progn
 214             (forward-line 1)
 215             t)
 216         nil))))
 217
 218 (provide 'nndoc)
 219
 220 ;;; nndoc.el ends here