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     (nsmail
  68      (article-begin .  "^From - "))
  69     (news
  70      (article-begin . "^Path:"))
  71     (rnews
  72      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
  73      (body-end-function . nndoc-rnews-body-end))
  74     (mbox
  75      (article-begin-function . nndoc-mbox-article-begin)
  76      (body-end-function . nndoc-mbox-body-end))
  77     (babyl
  78      (article-begin . "\^_\^L *\n")
  79      (body-end . "\^_")
  80      (body-begin-function . nndoc-babyl-body-begin)
  81      (head-begin-function . nndoc-babyl-head-begin))
  82     (mime-parts
  83      (generate-head-function . nndoc-generate-mime-parts-head)
  84      (article-transform-function . nndoc-transform-mime-parts))
  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     (git
 142      (file-begin . "\n- Log ---.*")
 143      (article-begin . "^commit ")
 144      (head-begin . "^Author: ")
 145      (body-begin . "^$")
 146      (file-end . "\n-----------------------------------------------------------------------")
 147      (article-transform-function . nndoc-transform-git-article)
 148      (header-transform-function . nndoc-transform-git-headers))
 149     (rfc822-forward
 150      (article-begin . "^\n+")
 151      (body-end-function . nndoc-rfc822-forward-body-end-function)
 152      (generate-head-function . nndoc-rfc822-forward-generate-head)
 153      (generate-article-function . nndoc-rfc822-forward-generate-article))
 154     (outlook
 155      (article-begin-function . nndoc-outlook-article-begin)
 156      (body-end .  "\0"))
 157     (oe-dbx  ;; Outlook Express DBX format
 158      (dissection-function . nndoc-oe-dbx-dissection)
 159      (generate-head-function . nndoc-oe-dbx-generate-head)
 160      (generate-article-function . nndoc-oe-dbx-generate-article))
 161     (forward
 162      (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+")
 163      (body-end . "^-+ End \\(of \\)?forwarded message.*$")
 164      (prepare-body-function . nndoc-unquote-dashes))
 165     (mail-in-mail ;; Wild guess on mailer daemon's messages or others
 166      (article-begin-function . nndoc-mail-in-mail-article-begin))
 167     (guess
 168      (guess . t)
 169      (subtype nil))
 170     (digest
 171      (guess . t)
 172      (subtype nil))
 173     (preprints
 174      (guess . t)
 175      (subtype nil))))
 176
 177 (defvar nndoc-binary-file-names ".[Dd][Bb][Xx]$"
 178   "Regexp for binary nndoc file names.")
 179
 180 \f
 181 (defvoo nndoc-file-begin nil)
 182 (defvoo nndoc-first-article nil)
 183 (defvoo nndoc-article-begin nil)
 184 (defvoo nndoc-head-begin nil)
 185 (defvoo nndoc-head-end nil)
 186 (defvoo nndoc-file-end nil)
 187 (defvoo nndoc-body-begin nil)
 188 (defvoo nndoc-body-end-function nil)
 189 (defvoo nndoc-body-begin-function nil)
 190 (defvoo nndoc-head-begin-function nil)
 191 (defvoo nndoc-body-end nil)
 192 ;; nndoc-dissection-alist is a list of sublists.  Each sublist holds the
 193 ;; following items.  ARTICLE acts as the association key and is an ordinal
 194 ;; starting at 1.  HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END
 195 ;; [3] are positions in the `nndoc' buffer.  LINE-COUNT [4] is a count of
 196 ;; lines in the body.  For MIME dissections only, ARTICLE-INSERT [5] and
 197 ;; SUMMARY-INSERT [6] give headers to insert for full article or summary line
 198 ;; generation, respectively.  Other headers usually follow directly from the
 199 ;; buffer.  Value `nil' means no insert.
 200 (defvoo nndoc-dissection-alist nil)
 201 (defvoo nndoc-prepare-body-function nil)
 202 (defvoo nndoc-generate-head-function nil)
 203 (defvoo nndoc-article-transform-function nil)
 204 (defvoo nndoc-header-transform-function nil)
 205 (defvoo nndoc-article-begin-function nil)
 206 (defvoo nndoc-generate-article-function nil)
 207 (defvoo nndoc-dissection-function nil)
 208 (defvoo nndoc-pre-dissection-function nil)
 209
 210 (defvoo nndoc-status-string "")
 211 (defvoo nndoc-group-alist nil)
 212 (defvoo nndoc-current-buffer nil
 213   "Current nndoc news buffer.")
 214 (defvoo nndoc-address nil)
 215
 216 (defconst nndoc-version "nndoc 1.0"
 217   "nndoc version.")
 218
 219 \f
 220
 221 ;;; Interface functions
 222
 223 (nnoo-define-basics nndoc)
 224
 225 (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
 226   (when (nndoc-possibly-change-buffer newsgroup server)
 227     (with-current-buffer nntp-server-buffer
 228       (erase-buffer)
 229       (let (article entry)
 230         (if (stringp (car articles))
 231             'headers
 232           (while articles
 233             (when (setq entry (cdr (assq (setq article (pop articles))
 234                                          nndoc-dissection-alist)))
 235               (let ((start (point)))
 236                 (insert (format "221 %d Article retrieved.\n" article))
 237                 (if nndoc-generate-head-function
 238                     (funcall nndoc-generate-head-function article)
 239                   (insert-buffer-substring
 240                    nndoc-current-buffer (car entry) (nth 1 entry)))
 241                 (goto-char (point-max))
 242                 (unless (eq (char-after (1- (point))) ?\n)
 243                   (insert "\n"))
 244                 (insert (format "Lines: %d\n" (nth 4 entry)))
 245                 (insert ".\n")
 246                 (when nndoc-header-transform-function
 247                   (save-excursion
 248                     (save-restriction
 249                       (narrow-to-region start (point))
 250                       (funcall nndoc-header-transform-function entry)))))))
 251           (nnheader-fold-continuation-lines)
 252           'headers)))))
 253
 254 (deffoo nndoc-request-article (article &optional newsgroup server buffer)
 255   (nndoc-possibly-change-buffer newsgroup server)
 256   (save-excursion
 257     (let ((buffer (or buffer nntp-server-buffer))
 258           (entry (cdr (assq article nndoc-dissection-alist)))
 259           beg)
 260       (set-buffer buffer)
 261       (erase-buffer)
 262       (when entry
 263         (cond
 264          ((stringp article) nil)
 265          (nndoc-generate-article-function
 266           (funcall nndoc-generate-article-function article))
 267          (t
 268           (insert-buffer-substring
 269            nndoc-current-buffer (car entry) (nth 1 entry))
 270           (insert "\n")
 271           (setq beg (point))
 272           (insert-buffer-substring
 273            nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 274           (goto-char beg)
 275           (when nndoc-prepare-body-function
 276             (funcall nndoc-prepare-body-function))
 277           (when nndoc-article-transform-function
 278             (funcall nndoc-article-transform-function article))
 279           t))))))
 280
 281 (deffoo nndoc-request-group (group &optional server dont-check info)
 282   "Select news GROUP."
 283   (let (number)
 284     (cond
 285      ((not (nndoc-possibly-change-buffer group server))
 286       (nnheader-report 'nndoc "No such file or buffer: %s"
 287                        nndoc-address))
 288      (dont-check
 289       (nnheader-report 'nndoc "Selected group %s" group)
 290       t)
 291      ((zerop (setq number (length nndoc-dissection-alist)))
 292       (nndoc-close-group group)
 293       (nnheader-report 'nndoc "No articles in group %s" group))
 294      (t
 295       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
 296
 297 (deffoo nndoc-retrieve-groups (groups &optional server)
 298   (dolist (group groups)
 299     (nndoc-request-group group server))
 300   t)
 301
 302 (deffoo nndoc-request-type (group &optional article)
 303   (cond ((not article) 'unkno