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', `digest', or `forward'.")
  34
  35 (defvar nndoc-digest-type 'traditional
  36   "Type of the last digest.  Auto-detected from the article header.
  37 Possible values:
  38   `traditional' -- the \"lots of dashes\" (30+) rules used;
  39                    we currently also do unconditional RFC 934 unquoting.
  40   `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).")
  41
  42 (defconst nndoc-type-to-regexp
  43   (` ((mbox
  44        (, (concat "^" rmail-unix-mail-delimiter))
  45        (, (concat "^" rmail-unix-mail-delimiter))
  46        nil "^$" nil nil nil)
  47       (babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
  48              "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*")
  49       (digest
  50        "^------------------------------*[\n \t]+"
  51        "^------------------------------*[\n \t]+"
  52        nil "^ ?$"
  53        "^------------------------------*[\n \t]+"
  54        "^End of" nil)
  55       (forward
  56        "^-+ Start of forwarded message -+\n+"
  57        "^-+ End of forwarded message -+\n"
  58        nil "^ ?$" nil nil nil)))
  59   "Regular expressions for articles of the various types.
  60 article-begin, article-end, head-begin, head-end,
  61 first-article, end-of-file, body-begin.")
  62
  63 \f
  64
  65 (defvar nndoc-article-begin nil)
  66 (defvar nndoc-article-end nil)
  67 (defvar nndoc-head-begin nil)
  68 (defvar nndoc-head-end nil)
  69 (defvar nndoc-first-article nil)
  70 (defvar nndoc-end-of-file nil)
  71 (defvar nndoc-body-begin nil)
  72
  73 (defvar nndoc-current-server nil)
  74 (defvar nndoc-server-alist nil)
  75 (defvar nndoc-server-variables
  76   (list
  77    (list 'nndoc-article-type nndoc-article-type)
  78    '(nndoc-article-begin nil)
  79    '(nndoc-article-end nil)
  80    '(nndoc-head-begin nil)
  81    '(nndoc-head-end nil)
  82    '(nndoc-first-article nil)
  83    '(nndoc-current-buffer nil)
  84    '(nndoc-group-alist nil)
  85    '(nndoc-end-of-file nil)
  86    '(nndoc-body-begin nil)
  87    '(nndoc-address nil)))
  88
  89 (defconst nndoc-version "nndoc 1.0"
  90   "nndoc version.")
  91
  92 (defvar nndoc-current-buffer nil
  93   "Current nndoc news buffer.")
  94
  95 (defvar nndoc-address nil)
  96
  97 \f
  98
  99 (defvar nndoc-status-string "")
 100
 101 (defvar nndoc-group-alist nil)
 102
 103 ;;; Interface functions
 104
 105 (defun nndoc-retrieve-headers (sequence &optional newsgroup server fetch-old)
 106   (save-excursion
 107     (set-buffer nntp-server-buffer)
 108     (erase-buffer)
 109     (let ((prev 2)
 110           article p beg lines)
 111       (nndoc-possibly-change-buffer newsgroup server)
 112       (if (stringp (car sequence))
 113           'headers
 114         (set-buffer nndoc-current-buffer)
 115         (widen)
 116         (goto-char (point-min))
 117         (re-search-forward (or nndoc-first-article
 118                                nndoc-article-begin) nil t)
 119         (or (not nndoc-head-begin)
 120             (re-search-forward nndoc-head-begin nil t))
 121         (re-search-forward nndoc-head-end nil t)
 122         (while sequence
 123           (setq article (car sequence))
 124           (set-buffer nndoc-current-buffer)
 125           (if (not (nndoc-forward-article (max 0 (- article prev))))
 126               ()
 127             (setq p (point))
 128             (setq beg (or (and
 129                            (re-search-backward nndoc-article-begin nil t)
 130                            (match-end 0))
 131                           (point-min)))
 132             (goto-char p)
 133             (setq lines (count-lines
 134                          (point)
 135                          (or
 136                           (and (re-search-forward nndoc-article-end nil t)
 137                                (goto-char (match-beginning 0)))
 138                           (goto-char (point-max)))))
 139
 140             (set-buffer nntp-server-buffer)
 141             (insert (format "221 %d Article retrieved.\n" article))
 142             (insert-buffer-substring nndoc-current-buffer beg p)
 143             (goto-char (point-max))
 144             (or (= (char-after (1- (point))) ?\n) (insert "\n"))
 145             (insert (format "Lines: %d\n" lines))
 146             (insert ".\n"))
 147
 148           (setq prev article
 149                 sequence (cdr sequence)))
 150
 151         ;; Fold continuation lines.
 152         (set-buffer nntp-server-buffer)
 153         (goto-char (point-min))
 154         (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
 155           (replace-match " " t t))
 156         'headers))))
 157
 158 (defun nndoc-open-server (server &optional defs)
 159   (nnheader-init-server-buffer)
 160   (if (equal server nndoc-current-server)
 161       t
 162     (if nndoc-current-server
 163         (setq nndoc-server-alist
 164               (cons (list nndoc-current-server
 165                           (nnheader-save-variables nndoc-server-variables))
 166                     nndoc-server-alist)))
 167     (let ((state (assoc server nndoc-server-alist)))
 168       (if state
 169           (progn
 170             (nnheader-restore-variables (nth 1 state))
 171             (setq nndoc-server-alist (delq state nndoc-server-alist)))
 172         (nnheader-set-init-variables nndoc-server-variables defs)))
 173     (setq nndoc-current-server server)
 174     (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
 175       (setq nndoc-article-begin (nth 0 defs))
 176       (setq nndoc-article-end (nth 1 defs))
 177       (setq nndoc-head-begin (nth 2 defs))
 178       (setq nndoc-head-end (nth 3 defs))
 179       (setq nndoc-first-article (nth 4 defs))
 180       (setq nndoc-end-of-file (nth 5 defs))
 181       (setq nndoc-body-begin (nth 6 defs)))
 182     t))
 183
 184 (defun nndoc-close-server (&optional server)
 185   t)
 186
 187 (defun nndoc-server-opened (&optional server)
 188   (and (equal server nndoc-current-server)
 189        nntp-server-buffer
 190        (buffer-name nntp-server-buffer)))
 191
 192 (defun nndoc-status-message (&optional server)
 193   nndoc-status-string)
 194
 195 (defun nndoc-request-article (article &optional newsgroup server buffer)
 196   (nndoc-possibly-change-buffer newsgroup server)
 197   (save-excursion
 198     (let ((buffer (or buffer nntp-server-buffer)))
 199       (set-buffer buffer)
 200       (erase-buffer)
 201       (if (stringp article)
 202           nil
 203         (nndoc-insert-article article)
 204         ;; Unquote quoted non-separators in digests.
 205         (if (and (eq nndoc-article-type 'digest)
 206                  (eq nndoc-digest-type 'traditional))
 207             (progn
 208               (goto-char (point-min))
 209               (while (re-search-forward "^- -"nil t)
 210                 (replace-match "-" t t))))
 211         ;; Some assholish digests do not have a blank line after the
 212         ;; headers. Aargh!
 213         (goto-char (point-min))
 214         (if (search-forward "\n\n" nil t)
 215             ()                          ; We let this one pass.
 216           (if (re-search-forward "^[ \t]+$" nil t)
 217               (replace-match "" t t)    ; We nix out a line of blanks.
 218             (while (and (looking-at "[^ ]+:")
 219                         (zerop (forward-line 1))))
 220             ;; We just insert a couple of lines. If you read digests
 221             ;; that are so badly formatted, you don't deserve any
 222             ;; better. Blphphpht!
 223             (insert "\n\n")))
 224         t))))
 225
 226 (defun nndoc-request-group (group &optional server dont-check)
 227   "Select news GROUP."
 228   (save-excursion
 229     (if (not (nndoc-possibly-change-buffer group server))
 230         (progn
 231           (setq nndoc-status-string "No such file or buffer")
 232           nil)
 233       (nndoc-set-header-dependent-regexps) ; hack for MIME digests
 234       (if dont-check
 235           t
 236         (save-excursion
 237           (set-buffer nntp-server-buffer)
 238           (erase-buffer)
 239           (let ((number (nndoc-number-of-articles)))
 240             (if (zerop number)
 241                 (progn
 242                   (nndoc-close-group group)
 243                   nil)
 244               (insert (format "211 %d %d %d %s\n" number 1 number group))
 245               t)))))))
 246
 247 (defun nndoc-close-group (group &optional server)
 248   (nndoc-possibly-change-buffer group server)
 249   (kill-buffer nndoc-current-buffer)
 250   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 251                                 nndoc-group-alist))
 252   (setq nndoc-current-buffer nil)
 253   (setq nndoc-current-server nil)
 254   t)
 255
 256 (defun nndoc-request-list (&optional server)
 257   nil)
 258
 259 (defun nndoc-request-newgroups (date &optional server)
 260   nil)
 261
 262 (defun nndoc-request-list-newsgroups (&optional server)
 263   nil)
 264
 265 (defalias 'nndoc-request-post 'nnmail-request-post)
 266
 267 \f
 268 ;;; Internal functions.
 269
 270 (defun nndoc-possibly-change-buffer (group source)
 271   (let (buf)
 272     (cond
 273      ;; The current buffer is this group's buffer.
 274      ((and nndoc-current-buffer
 275            (eq nndoc-current-buffer
 276                (setq buf (cdr (assoc group nndoc-group-alist))))))
 277      ;; We change buffers by taking an old from the group alist.
 278      ;; `source' is either a string (a file name) or a buffer object.
 279      (buf
 280       (setq nndoc-current-buffer buf))
 281      ;; It's a totally new group.
 282      ((or (and (bufferp nndoc-address)
 283                (buffer-name nndoc-address))
 284           (and (stringp nndoc-address)
 285                (file-exists-p nndoc-address)
 286                (not (file-directory-p nndoc-address))))
 287       (setq nndoc-group-alist
 288             (cons (cons group (setq nndoc-current-buffer
 289                                     (get-buffer-create
 290                                      (concat " *nndoc " group "*"))))
 291                   nndoc-group-alist))
 292       (save-excursion
 293         (set-buffer nndoc-current-buffer)
 294         (buffer-disable-undo (current-buffer))
 295         (erase-buffer)
 296         (if (stringp nndoc-address)
 297             (insert-file-contents nndoc-address)
 298           (save-excursion
 299             (set-buffer nndoc-address)
 300             (widen))
 301           (insert-buffer-substring nndoc-address))
 302         t)))))
 303
 304 ;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
 305 (defun nndoc-set-header-dependent-regexps ()
 306   (if (not (eq nndoc-article-type 'digest))
 307       ()
 308     (let ((case-fold-search t)          ; We match a bit too much, keep it simple.
 309           (boundary-id) (b-delimiter))
 310       (save-excursion
 311         (set-buffer nndoc-current-buffer)
 312         (goto-char (point-min))
 313         (if (and
 314              (re-search-forward
 315               (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
 316                       "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
 317               nil t)
 318              (match-beginning 1))
 319             (setq nndoc-digest-type 'rfc1341
 320                   boundary-id (format "%s"
 321                                       (buffer-substring
 322                                        (match-beginning 1) (match-end 1)))
 323                   b-delimiter       (concat "\n--" boundary-id "[\n \t]+")
 324                   nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$"
 325                   nndoc-article-end (concat "\n--" boundary-id
 326                                             "\\(--\\)?[\n \t]+")
 327                   nndoc-first-article b-delimiter ; ^eof ends article too.
 328                   nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$"))
 329           (setq nndoc-digest-type 'traditional))))))
 330
 331 (defun nndoc-forward-article (n)
 332   (while (and (> n 0)
 333               (re-search-forward nndoc-article-begin nil t)
 334               (or (not nndoc-head-begin)
 335                   (re-search-forward nndoc-head-begin nil t))
 336               (re-search-forward nndoc-head-end nil t))
 337     (setq n (1- n)))
 338   (zerop n))
 339
 340 (defun nndoc-number-of-articles ()
 341   (save-excursion
 342     (set-buffer nndoc-current-buffer)
 343     (widen)
 344     (goto-char (point-min))
 345     (let ((num 0))
 346       (if (re-search-forward (or nndoc-first-article
 347                                  nndoc-article-begin) nil t)
 348           (progn
 349             (setq num 1)
 350             (while (and (re-search-forward nndoc-article-begin nil t)
 351                         (or (not nndoc-end-of-file)
 352                             (not (looking-at nndoc-end-of-file)))
 353                         (or (not nndoc-head-begin)
 354                             (re-search-forward nndoc-head-begin nil t))
 355                         (re-search-forward nndoc-head-end nil t))
 356               (setq num (1+ num)))))
 357       num)))
 358
 359 (defun nndoc-narrow-to-article (article)
 360   (save-excursion
 361     (set-buffer nndoc-current-buffer)
 362     (widen)
 363     (goto-char (point-min))
 364     (while (and (re-search-forward nndoc-article-begin nil t)
 365                 (not (zerop (setq article (1- article))))))
 366     (if (not (zerop article))
 367         ()
 368       (narrow-to-region
 369        (match-end 0)
 370        (or (and (re-search-forward nndoc-article-end nil t)
 371                 (match-beginning 0))
 372            (point-max)))
 373       t)))
 374
 375 ;; Insert article ARTICLE in the current buffer.
 376 (defun nndoc-insert-article (article)
 377   (let ((ibuf (current-buffer)))
 378     (save-excursion
 379       (set-buffer nndoc-current-buffer)
 380       (widen)
 381       (goto-char (point-min))
 382       (while (and (re-search-forward nndoc-article-begin nil t)
 383                   (not (zerop (setq article (1- article))))))
 384       (if (not (zerop article))
 385           ()
 386         (narrow-to-region
 387          (match-end 0)
 388          (or (and (re-search-forward nndoc-article-end nil t)
 389                   (match-beginning 0))
 390              (point-max)))
 391         (goto-char (point-min))
 392         (and nndoc-head-begin
 393              (re-search-forward nndoc-head-begin nil t)
 394              (narrow-to-region (point) (point-max)))
 395         (or (re-search-forward nndoc-head-end nil t)
 396             (goto-char (point-max)))
 397         (append-to-buffer ibuf (point-min) (point))
 398         (and nndoc-body-begin
 399              (re-search-forward nndoc-body-begin nil t))
 400         (append-to-buffer ibuf (point) (point-max))
 401         t))))
 402
 403 (provide 'nndoc)
 404
 405 ;;; nndoc.el ends here