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]+"
  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 2)
  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 (or nndoc-first-article
 101                                nndoc-article-begin) nil t)
 102         (or (not nndoc-head-begin)
 103             (re-search-forward nndoc-head-begin nil t))
 104         (re-search-forward nndoc-head-end nil t)
 105         (while sequence
 106           (setq article (car sequence))
 107           (set-buffer nndoc-current-buffer)
 108           (if (not (nndoc-forward-article (max 0 (- article prev))))
 109               ()
 110             (setq p (point))
 111             (setq beg (or (and
 112                            (re-search-backward nndoc-article-begin nil t)
 113                            (match-end 0))
 114                           (point-min)))
 115             (goto-char p)
 116             (setq lines (count-lines
 117                          (point)
 118                          (or
 119                           (and (re-search-forward nndoc-article-end nil t)
 120                                (goto-char (match-beginning 0)))
 121                           (goto-char (point-max)))))
 122             (setq end (point))
 123
 124             (set-buffer nntp-server-buffer)
 125             (insert (format "221 %d Article retrieved.\n" article))
 126             (insert-buffer-substring nndoc-current-buffer beg p)
 127             (goto-char (point-max))
 128             (insert (format "Lines: %d\n" lines))
 129             (insert ".\n"))
 130
 131           (setq prev article
 132                 sequence (cdr sequence)))
 133
 134         ;; Fold continuation lines.
 135         (goto-char (point-min))
 136         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 137           (replace-match " " t t))
 138         'headers))))
 139
 140 (defun nndoc-open-server (server &optional defs)
 141   (nnheader-init-server-buffer)
 142   (if (equal server nndoc-current-server)
 143       t
 144     (if nndoc-current-server
 145         (setq nndoc-server-alist
 146               (cons (list nndoc-current-server
 147                           (nnheader-save-variables nndoc-server-variables))
 148                     nndoc-server-alist)))
 149     (let ((state (assoc server nndoc-server-alist)))
 150       (if state
 151           (progn
 152             (nnheader-restore-variables (nth 1 state))
 153             (setq nndoc-server-alist (delq state nndoc-server-alist)))
 154         (nnheader-set-init-variables nndoc-server-variables defs)))
 155     (setq nndoc-current-server server)
 156     (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
 157       (setq nndoc-article-begin (nth 0 defs))
 158       (setq nndoc-article-end (nth 1 defs))
 159       (setq nndoc-head-begin (nth 2 defs))
 160       (setq nndoc-head-end (nth 3 defs))
 161       (setq nndoc-first-article (nth 4 defs))
 162       (setq nndoc-end-of-file (nth 5 defs)))
 163     t))
 164
 165 (defun nndoc-close-server (&optional server)
 166   t)
 167
 168 (defun nndoc-server-opened (&optional server)
 169   (and (equal server nndoc-current-server)
 170        nntp-server-buffer
 171        (buffer-name nntp-server-buffer)))
 172
 173 (defun nndoc-status-message (&optional server)
 174   nndoc-status-string)
 175
 176 (defun nndoc-request-article (article &optional newsgroup server buffer)
 177   (nndoc-possibly-change-buffer newsgroup server)
 178   (save-excursion
 179     (let ((buffer (or buffer nntp-server-buffer)))
 180       (set-buffer buffer)
 181       (erase-buffer)
 182       (if (stringp article)
 183           nil
 184         (nndoc-narrow-to-article article)
 185         (insert-buffer-substring nndoc-current-buffer)
 186         t))))
 187
 188 (defun nndoc-request-group (group &optional server dont-check)
 189   "Select news GROUP."
 190   (save-excursion
 191     (if (not (nndoc-possibly-change-buffer group server))
 192         (progn
 193           (setq nndoc-status-string "No such file or buffer")
 194           nil)
 195       (if dont-check
 196           t
 197         (save-excursion
 198           (set-buffer nntp-server-buffer)
 199           (erase-buffer)
 200           (let ((number (nndoc-number-of-articles)))
 201             (if (zerop number)
 202                 (progn
 203                   (nndoc-close-group group)
 204                   nil)
 205               (insert (format "211 %d %d %d %s\n" number 1 number group))
 206               t)))))))
 207
 208 (defun nndoc-close-group (group &optional server)
 209   (nndoc-possibly-change-buffer group server)
 210   (kill-buffer nndoc-current-buffer)
 211   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 212                                 nndoc-group-alist))
 213   (setq nndoc-current-buffer nil)
 214   t)
 215
 216 (defun nndoc-request-list (&optional server)
 217   nil)
 218
 219 (defun nndoc-request-newgroups (date &optional server)
 220   nil)
 221
 222 (defun nndoc-request-list-newsgroups (&optional server)
 223   nil)
 224
 225 (defalias 'nndoc-request-post 'nnmail-request-post)
 226 (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
 227
 228 \f
 229 ;;; Internal functions.
 230
 231 (defun nndoc-possibly-change-buffer (group source)
 232   (let (buf)
 233     (cond
 234      ;; The current buffer is this group's buffer.
 235      ((and nndoc-current-buffer
 236            (eq nndoc-current-buffer
 237                (setq buf (cdr (assoc group nndoc-group-alist))))))
 238      ;; We change buffers by taking an old from the group alist.
 239      ;; `source' is either a string (a file name) or a buffer object.
 240      (buf
 241       (setq nndoc-current-buffer buf))
 242      ;; It's a totally new group.
 243      ((or (and (bufferp nndoc-address)
 244                (buffer-name nndoc-address))
 245           (and (stringp nndoc-address)
 246                (file-exists-p nndoc-address)
 247                (not (file-directory-p nndoc-address))))
 248       (setq nndoc-group-alist
 249             (cons (cons group (setq nndoc-current-buffer
 250                                     (get-buffer-create
 251                                      (concat " *nndoc " group "*"))))
 252                   nndoc-group-alist))
 253       (save-excursion
 254         (set-buffer nndoc-current-buffer)
 255         (buffer-disable-undo (current-buffer))
 256         (erase-buffer)
 257         (if (stringp nndoc-address)
 258             (insert-file-contents nndoc-address)
 259           (save-excursion
 260             (set-buffer nndoc-address)
 261             (widen))
 262           (insert-buffer-substring nndoc-address))
 263         t)))))
 264
 265 (defun nndoc-forward-article (n)
 266   (while (and (> n 0)
 267               (re-search-forward nndoc-article-begin nil t)
 268               (or (not nndoc-head-begin)
 269                   (re-search-forward nndoc-head-begin nil t))
 270               (re-search-forward nndoc-head-end nil t))
 271     (setq n (1- n)))
 272   (zerop n))
 273
 274 (defun nndoc-number-of-articles ()
 275   (save-excursion
 276     (set-buffer nndoc-current-buffer)
 277     (widen)
 278     (goto-char (point-min))
 279     (let ((num 0))
 280       (if (re-search-forward (or nndoc-first-article
 281                                  nndoc-article-begin) nil t)
 282         (progn
 283           (setq num 1)
 284           (while (and (re-search-forward nndoc-article-begin nil t)
 285                   (or (not nndoc-end-of-file)
 286                       (not (looking-at nndoc-end-of-file)))
 287                   (or (not nndoc-head-begin)
 288                       (re-search-forward nndoc-head-begin nil t))
 289                   (re-search-forward nndoc-head-end nil t))
 290             (setq num (1+ num)))))
 291       num)))
 292
 293 (defun nndoc-narrow-to-article (article)
 294   (save-excursion
 295     (set-buffer nndoc-current-buffer)
 296     (widen)
 297     (goto-char (point-min))
 298     (while (and (re-search-forward nndoc-article-begin nil t)
 299                 (not (zerop (setq article (1- article))))))
 300     (if (not (zerop article))
 301         ()
 302       (narrow-to-region
 303        (match-end 0)
 304        (or (and (re-search-forward nndoc-article-end nil t)
 305                 (match-beginning 0))
 306            (point-max)))
 307       t)))
 308
 309 (provide 'nndoc)
 310
 311 ;;; nndoc.el ends here