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 lines)
  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 lines (count-lines
  70                            (point)
  71                            (or
  72                             (save-excursion
  73                               (re-search-forward
  74                                (concat "^" rmail-unix-mail-delimiter) nil t))
  75                             (point-max))))
  76               (setq stop (1- (point)))
  77               (set-buffer nntp-server-buffer)
  78               (insert (format "221 %d Article retrieved.\n" article))
  79               (setq beg (point))
  80               (insert-buffer-substring nndoc-current-buffer start stop)
  81               (goto-char (point-max))
  82               (insert (format "Lines: %d\n" lines))
  83               (insert ".\n")))
  84         (setq sequence (cdr sequence)))
  85
  86       ;; Fold continuation lines.
  87       (goto-char (point-min))
  88       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  89         (replace-match " " t t))
  90       'headers)))
  91
  92 (defun nndoc-open-server (host &optional service)
  93   "Open mbox backend."
  94   (setq nndoc-status-string "")
  95   (setq nndoc-group-alist nil)
  96   (nnheader-init-server-buffer))
  97
  98 (defun nndoc-close-server (&optional server)
  99   "Close news server."
 100   t)
 101
 102 (defun nndoc-server-opened (&optional server)
 103   "Return server process status."
 104   (and nntp-server-buffer
 105        (get-buffer nntp-server-buffer)))
 106
 107 (defun nndoc-status-message (&optional server)
 108   "Return server status response as string."
 109   nndoc-status-string)
 110
 111 (defun nndoc-request-article (article &optional newsgroup server buffer)
 112   "Select ARTICLE by number."
 113   (nndoc-possibly-change-buffer newsgroup server)
 114   (if (stringp article)
 115       nil
 116     (save-excursion
 117       (set-buffer nndoc-current-buffer)
 118       (if (nndoc-search-for-article article)
 119           (let (start stop)
 120             (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t)
 121             (forward-line 1)
 122             (setq start (point))
 123             (or (and (re-search-forward
 124                       (concat "^" rmail-unix-mail-delimiter) nil t)
 125                      (forward-line -1))
 126                 (goto-char (point-max)))
 127             (setq stop (point))
 128             (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 129               (set-buffer nntp-server-buffer)
 130               (erase-buffer)
 131               (insert-buffer-substring nndoc-current-buffer start stop)
 132               t))))))
 133
 134 (defun nndoc-request-group (group &optional server dont-check)
 135   "Select news GROUP."
 136   (save-excursion
 137     (if (not (nndoc-possibly-change-buffer group server))
 138         (progn
 139           (setq nndoc-status-string "No such file")
 140           nil)
 141       (if dont-check
 142           t
 143         (save-excursion
 144           (set-buffer nntp-server-buffer)
 145           (erase-buffer)
 146           (let ((number (nndoc-number-of-articles)))
 147             (if (zerop number)
 148                 (progn
 149                   (nndoc-close-group group)
 150                   nil)
 151               (insert (format "211 %d %d %d %s\n"
 152                               number 1 number group))
 153               t)))))))
 154
 155 (defun nndoc-close-group (group &optional server)
 156   (nndoc-possibly-change-buffer group server)
 157   (kill-buffer nndoc-current-buffer)
 158   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 159                                 nndoc-group-alist))
 160   (setq nndoc-current-buffer nil)
 161   t)
 162
 163 (defun nndoc-request-list (&optional server)
 164   nil)
 165
 166 (defun nndoc-request-newgroups (date &optional server)
 167   nil)
 168
 169 (defun nndoc-request-list-newsgroups (&optional server)
 170   nil)
 171
 172 (defun nndoc-request-post (&optional server)
 173   (mail-send-and-exit nil))
 174
 175 (fset 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
 176
 177 \f
 178 ;;; Internal functions.
 179
 180 (defun nndoc-possibly-change-buffer (group file)
 181   (let (buf)
 182     (or (and nndoc-current-buffer
 183              (eq nndoc-current-buffer
 184                  (setq buf (cdr (assoc group nndoc-group-alist)))))
 185         (if buf
 186             (setq nndoc-current-buffer buf)
 187           (if (or (not (file-exists-p file))
 188                   (file-directory-p file))
 189               ()
 190             (setq nndoc-group-alist
 191                   (cons (cons group (setq nndoc-current-buffer
 192                                           (get-buffer-create
 193                                            (concat " *nndoc " group "*"))))
 194                         nndoc-group-alist))
 195             (save-excursion
 196               (set-buffer nndoc-current-buffer)
 197               (buffer-disable-undo (current-buffer))
 198               (erase-buffer)
 199               (insert-file-contents file)
 200               t))))))
 201
 202 (defun nndoc-number-of-articles ()
 203   (save-excursion
 204     (set-buffer nndoc-current-buffer)
 205     (goto-char (point-min))
 206     (let ((num 0)
 207           (delim (concat "^" rmail-unix-mail-delimiter)))
 208       (while (re-search-forward delim nil t)
 209         (setq num (1+ num)))
 210       num)))
 211
 212 (defun nndoc-search-for-article (article)
 213   (let ((obuf (current-buffer)))
 214     (set-buffer nndoc-current-buffer)
 215     (goto-char (point-min))
 216     (let ((delim (concat "^" rmail-unix-mail-delimiter)))
 217       (while (and (re-search-forward delim nil t)
 218                   (not (zerop (setq article (1- article))))))
 219       (set-buffer obuf)
 220       (if (zerop article)
 221           (progn
 222             (forward-line 1)
 223             t)
 224         nil))))
 225
 226 (provide 'nndoc)
 227
 228 ;;; nndoc.el ends here