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

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