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