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