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" "\^_" "^[0-9].*\n" "^$" 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         (set-buffer nntp-server-buffer)
 138         (goto-char (point-min))
 139         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 140           (replace-match " " t t))
 141         'headers))))
 142
 143 (defun nndoc-open-server (server &optional defs)
 144   (nnheader-init-server-buffer)
 145   (if (equal server nndoc-current-server)
 146       t
 147     (if nndoc-current-server
 148         (setq nndoc-server-alist
 149               (cons (list nndoc-current-server
 150                           (nnheader-save-variables nndoc-server-variables))
 151                     nndoc-server-alist)))
 152     (let ((state (assoc server nndoc-server-alist)))
 153       (if state
 154           (progn
 155             (nnheader-restore-variables (nth 1 state))
 156             (setq nndoc-server-alist (delq state nndoc-server-alist)))
 157         (nnheader-set-init-variables nndoc-server-variables defs)))
 158     (setq nndoc-current-server server)
 159     (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
 160       (setq nndoc-article-begin (nth 0 defs))
 161       (setq nndoc-article-end (nth 1 defs))
 162       (setq nndoc-head-begin (nth 2 defs))
 163       (setq nndoc-head-end (nth 3 defs))
 164       (setq nndoc-first-article (nth 4 defs))
 165       (setq nndoc-end-of-file (nth 5 defs))
 166       (setq nndoc-body-begin (nth 6 defs)))
 167     t))
 168
 169 (defun nndoc-close-server (&optional server)
 170   t)
 171
 172 (defun nndoc-server-opened (&optional server)
 173   (and (equal server nndoc-current-server)
 174        nntp-server-buffer
 175        (buffer-name nntp-server-buffer)))
 176
 177 (defun nndoc-status-message (&optional server)
 178   nndoc-status-string)
 179
 180 (defun nndoc-request-article (article &optional newsgroup server buffer)
 181   (nndoc-possibly-change-buffer newsgroup server)
 182   (save-excursion
 183     (let ((buffer (or buffer nntp-server-buffer)))
 184       (set-buffer buffer)
 185       (erase-buffer)
 186       (if (stringp article)
 187           nil
 188         (nndoc-insert-article article)
 189         ;; Unquote quoted non-separators in digests.
 190         (if (eq nndoc-article-type 'digest)
 191             (progn
 192               (goto-char (point-min))
 193               (while (re-search-forward "^- -"nil t)
 194                 (replace-match "-" t t))))
 195         t))))
 196
 197 (defun nndoc-request-group (group &optional server dont-check)
 198   "Select news GROUP."
 199   (save-excursion
 200     (if (not (nndoc-possibly-change-buffer group server))
 201         (progn
 202           (setq nndoc-status-string "No such file or buffer")
 203           nil)
 204       (nndoc-set-header-dependent-regexps) ; hack for MIME digests
 205       (if dont-check
 206           t
 207         (save-excursion
 208           (set-buffer nntp-server-buffer)
 209           (erase-buffer)
 210           (let ((number (nndoc-number-of-articles)))
 211             (if (zerop number)
 212                 (progn
 213                   (nndoc-close-group group)
 214                   nil)
 215               (insert (format "211 %d %d %d %s\n" number 1 number group))
 216               t)))))))
 217
 218 (defun nndoc-close-group (group &optional server)
 219   (nndoc-possibly-change-buffer group server)
 220   (kill-buffer nndoc-current-buffer)
 221   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 222                                 nndoc-group-alist))
 223   (setq nndoc-current-buffer nil)
 224   t)
 225
 226 (defun nndoc-request-list (&optional server)
 227   nil)
 228
 229 (defun nndoc-request-newgroups (date &optional server)
 230   nil)
 231
 232 (defun nndoc-request-list-newsgroups (&optional server)
 233   nil)
 234
 235 (defalias 'nndoc-request-post 'nnmail-request-post)
 236 (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer)
 237
 238 \f
 239 ;;; Internal functions.
 240
 241 (defun nndoc-possibly-change-buffer (group source)
 242   (let (buf)
 243     (cond
 244      ;; The current buffer is this group's buffer.
 245      ((and nndoc-current-buffer
 246            (eq nndoc-current-buffer
 247                (setq buf (cdr (assoc group nndoc-group-alist))))))
 248      ;; We change buffers by taking an old from the group alist.
 249      ;; `source' is either a string (a file name) or a buffer object.
 250      (buf
 251       (setq nndoc-current-buffer buf))
 252      ;; It's a totally new group.
 253      ((or (and (bufferp nndoc-address)
 254                (buffer-name nndoc-address))
 255           (and (stringp nndoc-address)
 256                (file-exists-p nndoc-address)
 257                (not (file-directory-p nndoc-address))))
 258       (setq nndoc-group-alist
 259             (cons (cons group (setq nndoc-current-buffer
 260                                     (get-buffer-create
 261                                      (concat " *nndoc " group "*"))))
 262                   nndoc-group-alist))
 263       (save-excursion
 264         (set-buffer nndoc-current-buffer)
 265         (buffer-disable-undo (current-buffer))
 266         (erase-buffer)
 267         (if (stringp nndoc-address)
 268             (insert-file-contents nndoc-address)
 269           (save-excursion
 270             (set-buffer nndoc-address)
 271             (widen))
 272           (insert-buffer-substring nndoc-address))
 273         t)))))
 274
 275 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
 276 (defun nndoc-set-header-dependent-regexps ()
 277   (if (not (eq nndoc-article-type 'digest))
 278       ()
 279     (let ((case-fold-search t)      ; We match a bit too much, keep it simple.
 280           (boundary-id) (b-delimiter))
 281       (save-excursion
 282         (set-buffer nndoc-current-buffer)
 283         (goto-char (point-min))
 284         (and
 285          (re-search-forward
 286           (concat "\n\n\\|^Content-Type: multipart/digest;[ \t\n]*[ \t]"
 287                   "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
 288           nil t)
 289          (match-beginning 1)
 290          (setq boundary-id (buffer-substring-no-properties (match-beginning 1)
 291                                                            (match-end 1))
 292                b-delimiter       (concat "\n--" boundary-id "[\n \t]+")
 293                nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
 294                nndoc-article-end (concat "\n--" boundary-id
 295                                          "\\(--\\)?[\n \t]+")
 296                nndoc-first-article b-delimiter ; ^end-of-file ends article too.
 297                nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$")))))))
 298
 299 (defun nndoc-forward-article (n)
 300   (while (and (> n 0)
 301               (re-search-forward nndoc-article-begin nil t)
 302               (or (not nndoc-head-begin)
 303                   (re-search-forward nndoc-head-begin nil t))
 304               (re-search-forward nndoc-head-end nil t))
 305     (setq n (1- n)))
 306   (zerop n))
 307
 308 (defun nndoc-number-of-articles ()
 309   (save-excursion
 310     (set-buffer nndoc-current-buffer)
 311     (widen)
 312     (goto-char (point-min))
 313     (let ((num 0))
 314       (if (re-search-forward (or nndoc-first-article
 315                                  nndoc-article-begin) nil t)
 316         (progn
 317           (setq num 1)
 318           (while (and (re-search-forward nndoc-article-begin nil t)
 319                   (or (not nndoc-end-of-file)
 320                       (not (looking-at nndoc-end-of-file)))
 321                   (or (not nndoc-head-begin)
 322                       (re-search-forward nndoc-head-begin nil t))
 323                   (re-search-forward nndoc-head-end nil t))
 324             (setq num (1+ num)))))
 325       num)))
 326
 327 (defun nndoc-narrow-to-article (article)
 328   (save-excursion
 329     (set-buffer nndoc-current-buffer)
 330     (widen)
 331     (goto-char (point-min))
 332     (while (and (re-search-forward nndoc-article-begin nil t)
 333                 (not (zerop (setq article (1- article))))))
 334     (if (not (zerop article))
 335         ()
 336       (narrow-to-region
 337        (match-end 0)
 338        (or (and (re-search-forward nndoc-article-end nil t)
 339                 (match-beginning 0))
 340            (point-max)))
 341       t)))
 342
 343 ;; Insert article ARTICLE in the current buffer.
 344 (defun nndoc-insert-article (article)
 345   (let ((ibuf (current-buffer)))
 346     (save-excursion
 347       (set-buffer nndoc-current-buffer)
 348       (widen)
 349       (goto-char (point-min))
 350       (while (and (re-search-forward nndoc-article-begin nil t)
 351                   (not (zerop (setq article (1- article))))))
 352       (if (not (zerop article))
 353           ()
 354         (narrow-to-region
 355          (match-end 0)
 356          (or (and (re-search-forward nndoc-article-end nil t)
 357                   (match-beginning 0))
 358              (point-max)))
 359         (goto-char (point-min))
 360         (and nndoc-head-begin
 361              (re-search-forward nndoc-head-begin nil t)
 362              (narrow-to-region (point) (point-max)))
 363         (or (re-search-forward nndoc-head-end nil t)
 364             (goto-char (point-max)))
 365         (append-to-buffer ibuf (point-min) (point))
 366         (and nndoc-body-begin
 367              (re-search-forward nndoc-body-begin nil t))
 368         (append-to-buffer ibuf (point) (point-max))
 369         t))))
 370
 371 (provide 'nndoc)
 372
 373 ;;; nndoc.el ends here