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 (defvar nndoc-article-type 'mbox
  33   "*Type of the file - one of `mbox', `babyl' or `digest'.")
  34
  35 (defconst nndoc-type-to-regexp
  36   (list (list 'mbox
  37               (concat "^" rmail-unix-mail-delimiter)
  38               (concat "^" rmail-unix-mail-delimiter)
  39               nil "^$" nil nil)
  40         (list 'babyl "\^_\^L *\n" "\^_" nil "^$" nil nil)
  41         (list 'digest
  42               "^------------------------------[\n \t]+"
  43               "^------------------------------[\n \t]+"
  44               nil "^$"
  45               "^------------------------------*[\n \t]*\n[^ ]+: "
  46               "End of"))
  47   "Regular expressions for articles of the various types.")
  48
  49 \f
  50
  51 (defvar nndoc-article-begin nil)
  52 (defvar nndoc-article-end nil)
  53 (defvar nndoc-head-begin nil)
  54 (defvar nndoc-head-end nil)
  55 (defvar nndoc-first-article nil)
  56 (defvar nndoc-end-of-file nil)
  57
  58 (defvar nndoc-current-server nil)
  59 (defvar nndoc-server-alist nil)
  60 (defvar nndoc-server-variables
  61   (list
  62    (list 'nndoc-article-type nndoc-article-type)
  63    '(nndoc-article-begin nil)
  64    '(nndoc-article-end nil)
  65    '(nndoc-head-begin nil)
  66    '(nndoc-head-end nil)
  67    '(nndoc-first-article nil)
  68    '(nndoc-current-buffer nil)
  69    '(nndoc-group-alist nil)
  70    '(nndoc-end-of-file nil)
  71    '(nndoc-address nil)))
  72
  73 (defconst nndoc-version "nndoc 0.1"
  74   "nndoc version.")
  75
  76 (defvar nndoc-current-buffer nil
  77   "Current nndoc news buffer.")
  78
  79 (defvar nndoc-address nil)
  80
  81 \f
  82
  83 (defvar nndoc-status-string "")
  84
  85 (defvar nndoc-group-alist nil)
  86
  87 ;;; Interface functions
  88
  89 (defun nndoc-retrieve-headers (sequence &optional newsgroup server)
  90   (save-excursion
  91     (set-buffer nntp-server-buffer)
  92     (erase-buffer)
  93     (let ((prev 1)
  94           article p beg end lines)
  95       (nndoc-possibly-change-buffer newsgroup server)
  96       (if (stringp (car sequence))
  97           'headers
  98         (set-buffer nndoc-current-buffer)
  99         (goto-char (point-min))
 100         (re-search-forward nndoc-article-begin nil t)
 101         (or (not nndoc-head-begin)
 102             (re-search-forward nndoc-head-begin nil t))
 103         (re-search-forward nndoc-head-end nil t)
 104         (while sequence
 105           (setq article (car sequence))
 106           (set-buffer nndoc-current-buffer)
 107           (if (not (nndoc-forward-article (- article prev)))
 108               ()
 109             (setq p (point))
 110             (setq beg (or (re-search-backward nndoc-article-begin nil t)
 111                           (point-min)))
 112             (goto-char p)
 113             (setq lines (count-lines
 114                          (point)
 115                          (or
 116                           (and (re-search-forward nndoc-article-end nil t)
 117                                (goto-char (match-beginning 0)))
 118                           (goto-char (point-max)))))
 119             (setq end (point))
 120
 121             (set-buffer nntp-server-buffer)
 122             (insert (format "221 %d Article retrieved.\n" article))
 123             (insert-buffer-substring nndoc-current-buffer beg end)
 124             (goto-char (point-max))
 125             (insert (format "Lines: %d\n" lines))
 126             (insert ".\n"))
 127
 128           (setq prev article
 129                 sequence (cdr sequence)))
 130
 131         ;; Fold continuation lines.
 132         (goto-char (point-min))
 133         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 134           (replace-match " " t t))
 135         'headers))))
 136
 137 (defun nndoc-open-server (server &optional defs)
 138   (nnheader-init-server-buffer)
 139   (if (equal server nndoc-current-server)
 140       t
 141     (if nndoc-current-server
 142         (setq nndoc-server-alist
 143               (cons (list nndoc-current-server
 144                           (nnheader-save-variables nndoc-server-variables))
 145                     nndoc-server-alist)))
 146     (let ((state (assoc server nndoc-server-alist)))
 147       (if state
 148           (progn
 149             (nnheader-restore-variables (nth 1 state))
 150             (setq nndoc-server-alist (delq state nndoc-server-alist)))
 151         (nnheader-set-init-variables nndoc-server-variables defs)))
 152     (setq nndoc-current-server server)
 153     (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
 154       (setq nndoc-article-begin (nth 0 defs))
 155       (setq nndoc-article-end (nth 1 defs))
 156       (setq nndoc-head-begin (nth 2 defs))
 157       (setq nndoc-head-end (nth 3 defs))
 158       (setq nndoc-first-article (nth 4 defs))
 159       (setq nndoc-end-of-file (nth 5 defs)))
 160     t))
 161
 162 (defun nndoc-close-server (&optional server)
 163   t)
 164
 165 (defun nndoc-server-opened (&optional server)
 166   (and (equal server nndoc-current-server)
 167        nntp-server-buffer
 168        (buffer-name nntp-server-buffer)))
 169
 170 (defun nndoc-status-message (&optional server)
 171   nndoc-status-string)
 172
 173 (defun nndoc-request-article (article &optional newsgroup server buffer)
 174   (nndoc-possibly-change-buffer newsgroup server)
 175   (save-excursion
 176     (let ((buffer (or buffer nntp-server-buffer)))
 177       (set-buffer buffer)
 178       (erase-buffer)
 179       (if (stringp article)
 180           nil
 181         (nndoc-narrow-to-article article)
 182         (insert-buffer-substring nndoc-current-buffer)
 183         t))))
 184
 185 (defun nndoc-request-group (group &optional server dont-check)
 186   "Select news GROUP."
 187   (save-excursion
 188     (if (not (nndoc-possibly-change-buffer group server))
 189         (progn
 190           (setq nndoc-status-string "No such file or buffer")
 191           nil)
 192       (if dont-check
 193           t
 194         (save-excursion
 195           (set-buffer nntp-server-buffer)
 196           (erase-buffer)
 197           (let ((number (nndoc-number-of-articles)))
 198             (if (zerop number)
 199                 (progn
 200                   (nndoc-close-group group)
 201                   nil)
 202               (insert (format "211 %d %d %d %s\n" number 1 number group))
 203               t)))))))
 204
 205 (defun nndoc-close-group (group &optional server)
 206   (nndoc-possibly-change-buffer group server)
 207   (kill-buffer nndoc-current-buffer)
 208   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 209                                 nndoc-group-alist))
 210   (setq nndoc-current-buffer nil)
 211   t)
 212
 213 (defun nndoc-request-list (&optional server)
 214   nil)
 215
 216 (defun nndoc-request-newgroups (date &optional server)
 217   nil)
 218
 219 (defun nndoc-request-list-newsgroups (&optional server)
 220   nil)
 221
 222 (defalias 'nndoc-request-post 'nnmail-request-post)
 223 (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
 224
 225 \f
 226 ;;; Internal functions.
 227
 228 (defun nndoc-possibly-change-buffer (group source)
 229   (let (buf)
 230     (cond
 231      ;; The current buffer is this group's buffer.
 232      ((and nndoc-current-buffer
 233            (eq nndoc-current-buffer
 234                (setq buf (cdr (assoc group nndoc-group-alist))))))
 235      ;; We change buffers by taking an old from the group alist.
 236      ;; `source' is either a string (a file name) or a buffer object.
 237      (buf
 238       (setq nndoc-current-buffer buf))
 239      ;; It's a totally new group.
 240      ((or (and (bufferp nndoc-address)
 241                (buffer-name nndoc-address))
 242           (and (stringp nndoc-address)
 243                (file-exists-p nndoc-address)
 244                (not (file-directory-p nndoc-address))))
 245       (setq nndoc-group-alist
 246             (cons (cons group (setq nndoc-current-buffer
 247                                     (get-buffer-create
 248                                      (concat " *nndoc " group "*"))))
 249                   nndoc-group-alist))
 250       (save-excursion
 251         (set-buffer nndoc-current-buffer)
 252         (buffer-disable-undo (current-buffer))
 253         (erase-buffer)
 254         (if (stringp nndoc-address)
 255             (insert-file-contents nndoc-address)
 256           (save-excursion
 257             (set-buffer nndoc-address)
 258             (widen))
 259           (insert-buffer-substring nndoc-address))
 260         t)))))
 261
 262 (defun nndoc-forward-article (n)
 263   (while (and (> n 0)
 264               (re-search-forward nndoc-article-begin nil t)
 265               (or (not nndoc-head-begin)
 266                   (re-search-forward nndoc-head-begin nil t))
 267               (re-search-forward nndoc-head-end nil t))
 268     (setq n (1- n)))
 269   (zerop n))
 270
 271 (defun nndoc-number-of-articles ()
 272   (save-excursion
 273     (set-buffer nndoc-current-buffer)
 274     (widen)
 275     (goto-char (point-min))
 276     (let ((num 0))
 277       (while (and (re-search-forward nndoc-article-begin nil t)
 278                   (or (not nndoc-end-of-file)
 279                       (not (looking-at nndoc-end-of-file)))
 280                   (or (not nndoc-head-begin)
 281                       (re-search-forward nndoc-head-begin nil t))
 282                   (re-search-forward nndoc-head-end nil t))
 283         (setq num (1+ num)))
 284       num)))
 285
 286 (defun nndoc-narrow-to-article (article)
 287   (save-excursion
 288     (set-buffer nndoc-current-buffer)
 289     (widen)
 290     (goto-char (point-min))
 291     (while (and (re-search-forward nndoc-article-begin nil t)
 292                 (not (zerop (setq article (1- article))))))
 293     (if (not (zerop article))
 294         ()
 295       (narrow-to-region
 296        (match-end 0)
 297        (or (and (re-search-forward nndoc-article-end nil t)
 298                 (match-beginning 0))
 299            (point-max)))
 300       t)))
 301
 302 (provide 'nndoc)
 303
 304 ;;; nndoc.el ends here