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, 2003, 2004
   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-digest
  62      (article-begin . "")
  63      (head-begin . "^ ?\n")
  64      (head-end . "^ ?$")
  65      (body-end . "")
  66      (file-end . "")
  67      (subtype digest guess))
  68     (mime-parts
  69      (generate-head-function . nndoc-generate-mime-parts-head)
  70      (article-transform-function . nndoc-transform-mime-parts))
  71     (nsmail
  72      (article-begin .  "^From - "))
  73     (news
  74      (article-begin . "^Path:"))
  75     (rnews
  76      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
  77      (body-end-function . nndoc-rnews-body-end))
  78     (mbox
  79      (article-begin-function . nndoc-mbox-article-begin)
  80      (body-end-function . nndoc-mbox-body-end))
  81     (babyl
  82      (article-begin . "\^_\^L *\n")
  83      (body-end . "\^_")
  84      (body-begin-function . nndoc-babyl-body-begin)
  85      (head-begin-function . nndoc-babyl-head-begin))
  86     (exim-bounce
  87      (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n")
  88      (body-end-function . nndoc-exim-bounce-body-end-function))
  89     (rfc934
  90      (article-begin . "^--.*\n+")
  91      (body-end . "^--.*$")
  92      (prepare-body-function . nndoc-unquote-dashes))
  93     (mailman
  94      (article-begin . "^--__--__--\n\nMessage:")
  95      (body-end . "^--__--__--$")
  96      (prepare-body-function . nndoc-unquote-dashes))
  97     (clari-briefs
  98      (article-begin . "^ \\*")
  99      (body-end . "^\t------*[ \t]^*\n^ \\*")
 100      (body-begin . "^\t")
 101      (head-end . "^\t")
 102      (generate-head-function . nndoc-generate-clari-briefs-head)
 103      (article-transform-function . nndoc-transform-clari-briefs))
 104
 105     (standard-digest
 106      (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
 107      (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
 108      (prepare-body-function . nndoc-unquote-dashes)
 109      (body-end-function . nndoc-digest-body-end)
 110      (head-end . "^ *$")
 111      (body-begin . "^ *\n")
 112      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
 113      (subtype digest guess))
 114     (slack-digest
 115      (article-begin . "^------------------------------*[\n \t]+")
 116      (head-end . "^ ?$")
 117      (body-end-function . nndoc-digest-body-end)
 118      (body-begin . "^ ?$")
 119      (file-end . "^End of")
 120      (prepare-body-function . nndoc-unquote-dashes)
 121      (subtype digest guess))
 122     (lanl-gov-announce
 123      (article-begin . "^\\\\\\\\\n")
 124      (head-begin . "^Paper.*:")
 125      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
 126      (body-begin . "")
 127      (body-end   . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)")
 128      (file-end   . "\\(^Title: Recent Seminal\\|%%%---%%%---%%%---%%%---\\)")
 129      (generate-head-function . nndoc-generate-lanl-gov-head)
 130      (article-transform-function . nndoc-transform-lanl-gov-announce)
 131      (subtype preprints guess))
 132     (rfc822-forward
 133      (article-begin . "^\n+")
 134      (body-end-function . nndoc-rfc822-forward-body-end-function)
 135      (generate-head-function . nndoc-rfc822-forward-generate-head)
 136      (generate-article-function . nndoc-rfc822-forward-generate-article))
 137     (outlook
 138      (article-begin-function . nndoc-outlook-article-begin)
 139      (body-end .  "\0"))
 140     (oe-dbx  ;; Outlook Express DBX format
 141      (dissection-function . nndoc-oe-dbx-dissection)
 142      (generate-head-function . nndoc-oe-dbx-generate-head)
 143      (generate-article-function . nndoc-oe-dbx-generate-article))
 144     (forward
 145      (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+")
 146      (body-end . "^-+ End \\(of \\)?forwarded message.*$")
 147      (prepare-body-function . nndoc-unquote-dashes))
 148     (mail-in-mail ;; Wild guess on mailer daemon's messages or others
 149      (article-begin-function . nndoc-mail-in-mail-article-begin))
 150     (guess
 151      (guess . t)
 152      (subtype nil))
 153     (digest
 154      (guess . t)
 155      (subtype nil))
 156     (preprints
 157      (guess . t)
 158      (subtype nil))))
 159
 160 (defvar nndoc-binary-file-names ".[Dd][Bb][Xx]$"
 161   "Regexp for binary nndoc file names.")
 162
 163 \f
 164 (defvoo nndoc-file-begin nil)
 165 (defvoo nndoc-first-article nil)
 166 (defvoo nndoc-article-begin nil)
 167 (defvoo nndoc-head-begin nil)
 168 (defvoo nndoc-head-end nil)
 169 (defvoo nndoc-file-end nil)
 170 (defvoo nndoc-body-begin nil)
 171 (defvoo nndoc-body-end-function nil)
 172 (defvoo nndoc-body-begin-function nil)
 173 (defvoo nndoc-head-begin-function nil)
 174 (defvoo nndoc-body-end nil)
 175 ;; nndoc-dissection-alist is a list of sublists.  Each sublist holds the
 176 ;; following items.  ARTICLE acts as the association key and is an ordinal
 177 ;; starting at 1.  HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END
 178 ;; [3] are positions in the `nndoc' buffer.  LINE-COUNT [4] is a count of
 179 ;; lines in the body.  For MIME dissections only, ARTICLE-INSERT [5] and
 180 ;; SUMMARY-INSERT [6] give headers to insert for full article or summary line
 181 ;; generation, respectively.  Other headers usually follow directly from the
 182 ;; buffer.  Value `nil' means no insert.
 183 (defvoo nndoc-dissection-alist nil)
 184 (defvoo nndoc-prepare-body-function nil)
 185 (defvoo nndoc-generate-head-function nil)
 186 (defvoo nndoc-article-transform-function nil)
 187 (defvoo nndoc-article-begin-function nil)
 188 (defvoo nndoc-generate-article-function nil)
 189 (defvoo nndoc-dissection-function nil)
 190
 191 (defvoo nndoc-status-string "")
 192 (defvoo nndoc-group-alist nil)
 193 (defvoo nndoc-current-buffer nil
 194   "Current nndoc news buffer.")
 195 (defvoo nndoc-address nil)
 196
 197 (defconst nndoc-version "nndoc 1.0"
 198   "nndoc version.")
 199
 200 \f
 201
 202 ;;; Interface functions
 203
 204 (nnoo-define-basics nndoc)
 205
 206 (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
 207   (when (nndoc-possibly-change-buffer newsgroup server)
 208     (save-excursion
 209       (set-buffer nntp-server-buffer)
 210       (erase-buffer)
 211       (let (article entry)
 212         (if (stringp (car articles))
 213             'headers
 214           (while articles
 215             (when (setq entry (cdr (assq (setq article (pop articles))
 216                                          nndoc-dissection-alist)))
 217               (insert (format "221 %d Article retrieved.\n" article))
 218               (if nndoc-generate-head-function
 219                   (funcall nndoc-generate-head-function article)
 220                 (insert-buffer-substring
 221                  nndoc-current-buffer (car entry) (nth 1 entry)))
 222               (goto-char (point-max))
 223               (unless (eq (char-after (1- (point))) ?\n)
 224                 (insert "\n"))
 225               (insert (format "Lines: %d\n" (nth 4 entry)))
 226               (insert ".\n")))
 227
 228           (nnheader-fold-continuation-lines)
 229           'headers)))))
 230
 231 (deffoo nndoc-request-article (article &optional newsgroup server buffer)
 232   (nndoc-possibly-change-buffer newsgroup server)
 233   (save-excursion
 234     (let ((buffer (or buffer nntp-server-buffer))
 235           (entry (cdr (assq article nndoc-dissection-alist)))
 236           beg)
 237       (set-buffer buffer)
 238       (erase-buffer)
 239       (when entry
 240         (cond
 241          ((stringp article) nil)
 242          (nndoc-generate-article-function
 243           (funcall nndoc-generate-article-function article))
 244          (t
 245           (insert-buffer-substring
 246            nndoc-current-buffer (car entry) (nth 1 entry))
 247           (insert "\n")
 248           (setq beg (point))
 249           (insert-buffer-substring
 250            nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 251           (goto-char beg)
 252           (when nndoc-prepare-body-function
 253             (funcall nndoc-prepare-body-function))
 254           (when nndoc-article-transform-function
 255             (funcall nndoc-article-transform-function article))
 256           t))))))
 257
 258 (deffoo nndoc-request-group (group &optional server dont-check)
 259   "Select news GROUP."
 260   (let (number)
 261     (cond
 262      ((not (nndoc-possibly-change-buffer group server))
 263       (nnheader-report 'nndoc "No such file or buffer: %s"
 264                        nndoc-address))
 265      (dont-check
 266       (nnheader-report 'nndoc "Selected group %s" group)
 267       t)
 268      ((zerop (setq number (length nndoc-dissection-alist)))
 269       (nndoc-close-group group)
 270       (nnheader-report 'nndoc "No articles in group %s" group))
 271      (t
 272       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
 273
 274 (deffoo nndoc-request-type (group &optional article)
 275   (cond ((not article) 'unknown)
 276         (nndoc-post-type nndoc-post-type)
 277         (t 'unknown)))
 278
 279 (deffoo nndoc-close-group (group &optional server)
 280   (nndoc-possibly-change-buffer group server)
 281   (and nndoc-current-buffer
 282        (buffer-name nndoc-current-buffer)
 283        (kill-buffer nndoc-current-buffer))
 284   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 285                                 nndoc-group-alist))
 286   (setq nndoc-current-buffer nil)
 287   (nnoo-close-server 'nndoc server)
 288   (setq nndoc-dissection-alist nil)
 289   t)
 290
 291 (deffoo nndoc-request-list (&optional server)
 292   nil)
 293
 294 (deffoo nndoc-request-newgroups (date &optional server)
 295   nil)
 296
 297 (deffoo nndoc-request-list-newsgroups (&optional server)
 298   nil)
 299
 300 \f
 301 ;;; Internal functions.
 302
 303 (defun nndoc-possibly-change-buffer (group source)
 304   (let (buf)
 305     (cond
 306      ;; The current buffer is this group's buffer.
 307      ((and nndoc-current-buffer
 308            (buffer-name nndoc-current-buffer)
 309            (eq nndoc-current-buffer
 310                (setq buf (cdr (assoc group nndoc-group-alist))))))
 311      ;; We change buffers by taking an old from the group alist.
 312      ;; `source' is either a string (a file name) or a buffer object.
 313      (buf
 314       (setq nndoc-current-buffer buf))
 315      ;; It's a totally new group.
 316      ((or (and (bufferp nndoc-address)
 317                (buffer-name nndoc-address))
 318           (and (stringp nndoc-address)
 319                (file-exists-p nndoc-address)
 320                (not (file-directory-p nndoc-address))))
 321       (push (cons group (setq nndoc-current-buffer
 322                               (get-buffer-create
 323                                (concat " *nndoc " group "*"))))
 324             nndoc-group-alist)
 325       (setq nndoc-dissection-alist nil)
 326       (save-excursion
 327         (set-buffer nndoc-current-buffer)
 328         (erase-buffer)
 329         (if (and (stringp nndoc-address)
 330                  (string-match nndoc-binary-file-names nndoc-address))
 331             (let ((coding-system-for-read 'binary))
 332               (mm-insert-file-contents nndoc-address))
 333           (if (stringp nndoc-address)
 334               (nnheader-insert-file-contents nndoc-address)
 335