cgit.sxemacs.org Git - gnus/blob - lisp/nndoc.el

   1 ;;; nndoc.el --- single file access for Gnus
   2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/
  29
  30 ;;; Code:
  31
  32 (require 'nnheader)
  33 (require 'message)
  34 (require 'nnmail)
  35 (require 'nnoo)
  36 (require 'gnus-util)
  37 (require 'mm-util)
  38 (eval-when-compile (require 'cl))
  39
  40 (nnoo-declare nndoc)
  41
  42 (defvoo nndoc-article-type 'guess
  43   "*Type of the file.
  44 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
  45 `rfc934', `rfc822-forward', `mime-parts', `standard-digest',
  46 `slack-digest', `clari-briefs', `nsmail', `outlook', `oe-dbx',
  47 `mailman', `exim-bounce', or `guess'.")
  48
  49 (defvoo nndoc-post-type 'mail
  50   "*Whether the nndoc group is `mail' or `post'.")
  51
  52 (defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr
  53   "Hook run after opening a document.
  54 The default function removes all trailing carriage returns
  55 from the document.")
  56
  57 (defvar nndoc-type-alist
  58   `((mmdf
  59      (article-begin .  "^\^A\^A\^A\^A\n")
  60      (body-end .  "^\^A\^A\^A\^A\n"))
  61     (mime-parts
  62      (generate-head-function . nndoc-generate-mime-parts-head)
  63      (article-transform-function . nndoc-transform-mime-parts))
  64     (nsmail
  65      (article-begin .  "^From - "))
  66     (news
  67      (article-begin . "^Path:"))
  68     (rnews
  69      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
  70      (body-end-function . nndoc-rnews-body-end))
  71     (mbox
  72      (article-begin-function . nndoc-mbox-article-begin)
  73      (body-end-function . nndoc-mbox-body-end))
  74     (babyl
  75      (article-begin . "\^_\^L *\n")
  76      (body-end . "\^_")
  77      (body-begin-function . nndoc-babyl-body-begin)
  78      (head-begin-function . nndoc-babyl-head-begin))
  79     (exim-bounce
  80      (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n")
  81      (body-end-function . nndoc-exim-bounce-body-end-function))
  82     (rfc934
  83      (article-begin . "^--.*\n+")
  84      (body-end . "^--.*$")
  85      (prepare-body-function . nndoc-unquote-dashes))
  86     (mailman
  87      (article-begin . "^--__--__--\n\nMessage:")
  88      (body-end . "^--__--__--$")
  89      (prepare-body-function . nndoc-unquote-dashes))
  90     (clari-briefs
  91      (article-begin . "^ \\*")
  92      (body-end . "^\t------*[ \t]^*\n^ \\*")
  93      (body-begin . "^\t")
  94      (head-end . "^\t")
  95      (generate-head-function . nndoc-generate-clari-briefs-head)
  96      (article-transform-function . nndoc-transform-clari-briefs))
  97     (mime-digest
  98      (article-begin . "")
  99      (head-begin . "^ ?\n")
 100      (head-end . "^ ?$")
 101      (body-end . "")
 102      (file-end . "")
 103      (subtype digest guess))
 104     (standard-digest
 105      (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
 106      (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
 107      (prepare-body-function . nndoc-unquote-dashes)
 108      (body-end-function . nndoc-digest-body-end)
 109      (head-end . "^ *$")
 110      (body-begin . "^ *\n")
 111      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
 112      (subtype digest guess))
 113     (slack-digest
 114      (article-begin . "^------------------------------*[\n \t]+")
 115      (head-end . "^ ?$")
 116      (body-end-function . nndoc-digest-body-end)
 117      (body-begin . "^ ?$")
 118      (file-end . "^End of")
 119      (prepare-body-function . nndoc-unquote-dashes)
 120      (subtype digest guess))
 121     (lanl-gov-announce
 122      (article-begin . "^\\\\\\\\\n")
 123      (head-begin . "^Paper.*:")
 124      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
 125      (body-begin . "")
 126      (body-end   . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)")
 127      (file-end   . "\\(^Title: Recent Seminal\\|%%%---%%%---%%%---%%%---\\)")
 128      (generate-head-function . nndoc-generate-lanl-gov-head)
 129      (article-transform-function . nndoc-transform-lanl-gov-announce)
 130      (subtype preprints guess))
 131     (rfc822-forward
 132      (article-begin . "^\n")
 133      (body-end-function . nndoc-rfc822-forward-body-end-function))
 134     (outlook
 135      (article-begin-function . nndoc-outlook-article-begin)
 136      (body-end .  "\0"))
 137     (oe-dbx  ;; Outlook Express DBX format
 138      (dissection-function . nndoc-oe-dbx-dissection)
 139      (generate-head-function . nndoc-oe-dbx-generate-head)
 140      (generate-article-function . nndoc-oe-dbx-generate-article))
 141     (forward
 142      (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+")
 143      (body-end . "^-+ End \\(of \\)?forwarded message.*$")
 144      (prepare-body-function . nndoc-unquote-dashes))
 145     (mail-in-mail ;; Wild guess on mailer daemon's messages or others
 146      (article-begin-function . nndoc-mail-in-mail-article-begin))
 147     (guess
 148      (guess . t)
 149      (subtype nil))
 150     (digest
 151      (guess . t)
 152      (subtype nil))
 153     (preprints
 154      (guess . t)
 155      (subtype nil))))
 156
 157 (defvar nndoc-binary-file-names ".[Dd][Bb][Xx]$"
 158   "Regexp for binary nndoc file names.")
 159
 160 \f
 161 (defvoo nndoc-file-begin nil)
 162 (defvoo nndoc-first-article nil)
 163 (defvoo nndoc-article-begin nil)
 164 (defvoo nndoc-head-begin nil)
 165 (defvoo nndoc-head-end nil)
 166 (defvoo nndoc-file-end nil)
 167 (defvoo nndoc-body-begin nil)
 168 (defvoo nndoc-body-end-function nil)
 169 (defvoo nndoc-body-begin-function nil)
 170 (defvoo nndoc-head-begin-function nil)
 171 (defvoo nndoc-body-end nil)
 172 ;; nndoc-dissection-alist is a list of sublists.  Each sublist holds the
 173 ;; following items.  ARTICLE acts as the association key and is an ordinal
 174 ;; starting at 1.  HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END
 175 ;; [3] are positions in the `nndoc' buffer.  LINE-COUNT [4] is a count of
 176 ;; lines in the body.  For MIME dissections only, ARTICLE-INSERT [5] and
 177 ;; SUMMARY-INSERT [6] give headers to insert for full article or summary line
 178 ;; generation, respectively.  Other headers usually follow directly from the
 179 ;; buffer.  Value `nil' means no insert.
 180 (defvoo nndoc-dissection-alist nil)
 181 (defvoo nndoc-prepare-body-function nil)
 182 (defvoo nndoc-generate-head-function nil)
 183 (defvoo nndoc-article-transform-function nil)
 184 (defvoo nndoc-article-begin-function nil)
 185 (defvoo nndoc-generate-article-function nil)
 186 (defvoo nndoc-dissection-function nil)
 187
 188 (defvoo nndoc-status-string "")
 189 (defvoo nndoc-group-alist nil)
 190 (defvoo nndoc-current-buffer nil
 191   "Current nndoc news buffer.")
 192 (defvoo nndoc-address nil)
 193
 194 (defconst nndoc-version "nndoc 1.0"
 195   "nndoc version.")
 196
 197 \f
 198
 199 ;;; Interface functions
 200
 201 (nnoo-define-basics nndoc)
 202
 203 (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
 204   (when (nndoc-possibly-change-buffer newsgroup server)
 205     (save-excursion
 206       (set-buffer nntp-server-buffer)
 207       (erase-buffer)
 208       (let (article entry)
 209         (if (stringp (car articles))
 210             'headers
 211           (while articles
 212             (when (setq entry (cdr (assq (setq article (pop articles))
 213                                          nndoc-dissection-alist)))
 214               (insert (format "221 %d Article retrieved.\n" article))
 215               (if nndoc-generate-head-function
 216                   (funcall nndoc-generate-head-function article)
 217                 (insert-buffer-substring
 218                  nndoc-current-buffer (car entry) (nth 1 entry)))
 219               (goto-char (point-max))
 220               (unless (eq (char-after (1- (point))) ?\n)
 221                 (insert "\n"))
 222               (insert (format "Lines: %d\n" (nth 4 entry)))
 223               (insert ".\n")))
 224
 225           (nnheader-fold-continuation-lines)
 226           'headers)))))
 227
 228 (deffoo nndoc-request-article (article &optional newsgroup server buffer)
 229   (nndoc-possibly-change-buffer newsgroup server)
 230   (save-excursion
 231     (let ((buffer (or buffer nntp-server-buffer))
 232           (entry (cdr (assq article nndoc-dissection-alist)))
 233           beg)
 234       (set-buffer buffer)
 235       (erase-buffer)
 236       (when entry
 237         (cond
 238          ((stringp article) nil)
 239          (nndoc-generate-article-function
 240           (funcall nndoc-generate-article-function article))
 241          (t
 242           (insert-buffer-substring
 243            nndoc-current-buffer (car entry) (nth 1 entry))
 244           (insert "\n")
 245           (setq beg (point))
 246           (insert-buffer-substring
 247            nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 248           (goto-char beg)
 249           (when nndoc-prepare-body-function
 250             (funcall nndoc-prepare-body-function))
 251           (when nndoc-article-transform-function
 252             (funcall nndoc-article-transform-function article))
 253           t))))))
 254
 255 (deffoo nndoc-request-group (group &optional server dont-check)
 256   "Select news GROUP."
 257   (let (number)
 258     (cond
 259      ((not (nndoc-possibly-change-buffer group server))
 260       (nnheader-report 'nndoc "No such file or buffer: %s"
 261                        nndoc-address))
 262      (dont-check
 263       (nnheader-report 'nndoc "Selected group %s" group)
 264       t)
 265      ((zerop (setq number (length nndoc-dissection-alist)))
 266       (nndoc-close-group group)
 267       (nnheader-report 'nndoc "No articles in group %s" group))
 268      (t
 269       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
 270
 271 (deffoo nndoc-request-type (group &optional article)
 272   (cond ((not article) 'unknown)
 273         (nndoc-post-type nndoc-post-type)
 274         (t 'unknown)))