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