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