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

   1 ;;; nndoc.el --- single file access for Gnus
   2 ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   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 the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'nnheader)
  30 (require 'message)
  31 (require 'nnmail)
  32 (require 'nnoo)
  33 (require 'gnus-util)
  34 (eval-when-compile (require 'cl))
  35
  36 (nnoo-declare nndoc)
  37
  38 (defvoo nndoc-article-type 'guess
  39   "*Type of the file.
  40 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
  41 `rfc934', `rfc822-forward', `mime-digest', `mime-parts', `standard-digest',
  42 `slack-digest', `clari-briefs' or `guess'.")
  43
  44 (defvoo nndoc-post-type 'mail
  45   "*Whether the nndoc group is `mail' or `post'.")
  46
  47 (defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr
  48   "Hook run after opening a document.
  49 The default function removes all trailing carriage returns
  50 from the document.")
  51
  52 (defvar nndoc-type-alist
  53   `((mmdf
  54      (article-begin .  "^\^A\^A\^A\^A\n")
  55      (body-end .  "^\^A\^A\^A\^A\n"))
  56     (news
  57      (article-begin . "^Path:"))
  58     (rnews
  59      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
  60      (body-end-function . nndoc-rnews-body-end))
  61     (mbox
  62      (article-begin-function . nndoc-mbox-article-begin)
  63      (body-end-function . nndoc-mbox-body-end))
  64     (babyl
  65      (article-begin . "\^_\^L *\n")
  66      (body-end . "\^_")
  67      (body-begin-function . nndoc-babyl-body-begin)
  68      (head-begin-function . nndoc-babyl-head-begin))
  69     (forward
  70      (article-begin . "^-+ Start of forwarded message -+\n+")
  71      (body-end . "^-+ End of forwarded message -+$")
  72      (prepare-body-function . nndoc-unquote-dashes))
  73     (rfc934
  74      (article-begin . "^--.*\n+")
  75      (body-end . "^--.*$")
  76      (prepare-body-function . nndoc-unquote-dashes))
  77     (clari-briefs
  78      (article-begin . "^ \\*")
  79      (body-end . "^\t------*[ \t]^*\n^ \\*")
  80      (body-begin . "^\t")
  81      (head-end . "^\t")
  82      (generate-head-function . nndoc-generate-clari-briefs-head)
  83      (article-transform-function . nndoc-transform-clari-briefs))
  84     (mime-digest
  85      (article-begin . "")
  86      (head-end . "^ ?$")
  87      (body-end . "")
  88      (file-end . "")
  89      (subtype digest guess))
  90     (mime-parts
  91      (generate-head-function . nndoc-generate-mime-parts-head)
  92      (article-transform-function . nndoc-transform-mime-parts))
  93     (standard-digest
  94      (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
  95      (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
  96      (prepare-body-function . nndoc-unquote-dashes)
  97      (body-end-function . nndoc-digest-body-end)
  98      (head-end . "^ *$")
  99      (body-begin . "^ *\n")
 100      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
 101      (subtype digest guess))
 102     (slack-digest
 103      (article-begin . "^------------------------------*[\n \t]+")
 104      (head-end . "^ ?$")
 105      (body-end-function . nndoc-digest-body-end)
 106      (body-begin . "^ ?$")
 107      (file-end . "^End of")
 108      (prepare-body-function . nndoc-unquote-dashes)
 109      (subtype digest guess))
 110     (lanl-gov-announce
 111      (article-begin . "^\\\\\\\\\n")
 112      (head-begin . "^Paper.*:")
 113      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
 114      (body-begin . "")
 115      (body-end   . "-------------------------------------------------")
 116      (file-end   . "^Title: Recent Seminal")
 117      (generate-head-function . nndoc-generate-lanl-gov-head)
 118      (article-transform-function . nndoc-transform-lanl-gov-announce)
 119      (subtype preprints guess))
 120     (rfc822-forward
 121      (article-begin . "^\n")
 122      (body-end-function . nndoc-rfc822-forward-body-end-function))
 123     (guess
 124      (guess . t)
 125      (subtype nil))
 126     (digest
 127      (guess . t)
 128      (subtype nil))
 129     (preprints
 130      (guess . t)
 131      (subtype nil))))
 132
 133 \f
 134 (defvoo nndoc-file-begin nil)
 135 (defvoo nndoc-first-article nil)
 136 (defvoo nndoc-article-begin nil)
 137 (defvoo nndoc-head-begin nil)
 138 (defvoo nndoc-head-end nil)
 139 (defvoo nndoc-file-end nil)
 140 (defvoo nndoc-body-begin nil)
 141 (defvoo nndoc-body-end-function nil)
 142 (defvoo nndoc-body-begin-function nil)
 143 (defvoo nndoc-head-begin-function nil)
 144 (defvoo nndoc-body-end nil)
 145 ;; nndoc-dissection-alist is a list of sublists.  Each sublist holds the
 146 ;; following items.  ARTICLE is an ordinal starting at 1.  HEAD-BEGIN,
 147 ;; HEAD-END, BODY-BEGIN and BODY-END are positions in the `nndoc' buffer.
 148 ;; LINE-COUNT is a count of lines in the body.  SUBJECT, MESSAGE-ID and
 149 ;; REFERENCES, only present for MIME dissections, are field values.
 150 (defvoo nndoc-dissection-alist nil)
 151 (defvoo nndoc-prepare-body-function nil)
 152 (defvoo nndoc-generate-head-function nil)
 153 (defvoo nndoc-article-transform-function nil)
 154 (defvoo nndoc-article-begin-function nil)
 155
 156 (defvoo nndoc-status-string "")
 157 (defvoo nndoc-group-alist nil)
 158 (defvoo nndoc-current-buffer nil
 159   "Current nndoc news buffer.")
 160 (defvoo nndoc-address nil)
 161 (defvoo nndoc-mime-header nil)
 162 (defvoo nndoc-mime-subject nil)
 163
 164 (defconst nndoc-version "nndoc 1.0"
 165   "nndoc version.")
 166
 167 \f
 168
 169 ;;; Interface functions
 170
 171 (nnoo-define-basics nndoc)
 172
 173 (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
 174   (when (nndoc-possibly-change-buffer newsgroup server)
 175     (save-excursion
 176       (set-buffer nntp-server-buffer)
 177       (erase-buffer)
 178       (let (article entry)
 179         (if (stringp (car articles))
 180             'headers
 181           (while articles
 182             (when (setq entry (cdr (assq (setq article (pop articles))
 183                                          nndoc-dissection-alist)))
 184               (insert (format "221 %d Article retrieved.\n" article))
 185               (if nndoc-generate-head-function
 186                   (funcall nndoc-generate-head-function article)
 187                 (insert-buffer-substring
 188                  nndoc-current-buffer (car entry) (nth 1 entry)))
 189               (goto-char (point-max))
 190               (unless (= (char-after (1- (point))) ?\n)
 191                 (insert "\n"))
 192               (insert (format "Lines: %d\n" (nth 4 entry)))
 193               (insert ".\n")))
 194
 195           (nnheader-fold-continuation-lines)
 196           'headers)))))
 197
 198 (deffoo nndoc-request-article (article &optional newsgroup server buffer)
 199   (nndoc-possibly-change-buffer newsgroup server)
 200   (save-excursion
 201     (let ((buffer (or buffer nntp-server-buffer))
 202           (entry (cdr (assq article nndoc-dissection-alist)))
 203           beg)
 204       (set-buffer buffer)
 205       (erase-buffer)
 206       (when entry
 207         (if (stringp article)
 208             nil
 209           (insert-buffer-substring
 210            nndoc-current-buffer (car entry) (nth 1 entry))
 211           (insert "\n")
 212           (setq beg (point))
 213           (insert-buffer-substring
 214            nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 215           (goto-char beg)
 216           (when nndoc-prepare-body-function
 217             (funcall nndoc-prepare-body-function))
 218           (when nndoc-article-transform-function
 219             (funcall nndoc-article-transform-function article))
 220           t)))))
 221
 222 (deffoo nndoc-request-group (group &optional server dont-check)
 223   "Select news GROUP."
 224   (let (number)
 225     (cond
 226      ((not (nndoc-possibly-change-buffer group server))
 227       (nnheader-report 'nndoc "No such file or buffer: %s"
 228                        nndoc-address))
 229      (dont-check
 230       (nnheader-report 'nndoc "Selected group %s" group)
 231       t)
 232      ((zerop (setq number (length nndoc-dissection-alist)))
 233       (nndoc-close-group group)
 234       (nnheader-report 'nndoc "No articles in group %s" group))
 235      (t
 236       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
 237
 238 (deffoo nndoc-request-type (group &optional article)
 239   (cond ((not article) 'unknown)
 240         (nndoc-post-type nndoc-post-type)
 241         (t 'unknown)))
 242
 243 (deffoo nndoc-close-group (group &optional server)
 244   (nndoc-possibly-change-buffer group server)
 245   (and nndoc-current-buffer
 246        (buffer-name nndoc-current-buffer)
 247        (kill-buffer nndoc-current-buffer))
 248   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 249                                 nndoc-group-alist))
 250   (setq nndoc-current-buffer nil)
 251   (nnoo-close-server 'nndoc server)
 252   (setq nndoc-dissection-alist nil)
 253   t)
 254
 255 (deffoo nndoc-request-list (&optional server)
 256   nil)
 257
 258 (deffoo nndoc-request-newgroups (date &optional server)
 259   nil)
 260
 261 (deffoo nndoc-request-list-newsgroups (&optional server)
 262   nil)
 263
 264 \f
 265 ;;; Internal functions.
 266
 267 (defun nndoc-possibly-change-buffer (group source)
 268   (let (buf)
 269     (cond
 270      ;; The current buffer is this group's buffer.
 271      ((and nndoc-current-buffer
 272            (buffer-name nndoc-current-buffer)
 273            (eq nndoc-current-buffer
 274                (setq buf (cdr (assoc group nndoc-group-alist))))))
 275      ;; We change buffers by taking an old from the group alist.
 276      ;; `source' is either a string (a file name) or a buffer object.
 277      (buf
 278       (setq nndoc-current-buffer buf))
 279      ;; It's a totally new group.
 280      ((or (and (bufferp nndoc-address)
 281                (buffer-name nndoc-address))
 282           (and (stringp nndoc-address)
 283                (file-exists-p nndoc-address)
 284                (not (file-directory-p nndoc-address))))
 285       (push (cons group (setq nndoc-current-buffer
 286                               (get-buffer-create
 287                                (concat " *nndoc " group "*"))))
 288             nndoc-group-alist)
 289       (setq nndoc-dissection-alist nil)
 290       (save-excursion
 291         (set-buffer nndoc-current-buffer)
 292         (erase-buffer)
 293         (if (stringp nndoc-address)
 294             (nnheader-insert-file-contents nndoc-address)
 295           (insert-buffer-substring nndoc-address))
 296         (run-hooks 'nndoc-open-document-hook))))
 297     ;; Initialize the nndoc structures according to this new document.
 298     (when (and nndoc-current-buffer
 299                (not nndoc-dissection-alist))
 300       (save-excursion
 301         (set-buffer nndoc-current-buffer)
 302         (nndoc-set-delims)
 303         (if (eq nndoc-article-type 'mime-parts)
 304             (nndoc-dissect-mime-parts)
 305           (nndoc-dissect-buffer))))
 306     (unless nndoc-current-buffer
 307       (nndoc-close-server))
 308     ;; Return whether we managed to select a file.
 309     nndoc-current-buffer))
 310
 311 ;;;
 312 ;;; Deciding what document type we have
 313 ;;;
 314
 315 (defun nndoc-set-delims ()
 316   "Set the nndoc delimiter variables according to the type of the document."
 317   (let ((vars '(nndoc-file-begin
 318                 nndoc-first-article
 319                 nndoc-article-begin-function
 320                 nndoc-head-begin nndoc-head-end
 321                 nndoc-file-end nndoc-article-begin
 322                 nndoc-body-begin nndoc-body-end-function nndoc-body-end
 323                 nndoc-prepare-body-function nndoc-article-transform-function
 324                 nndoc-generate-head-function nndoc-body-begin-function
 325                 nndoc-head-begin-function)))
 326     (while vars
 327       (set (pop vars) nil)))
 328   (let (defs)
 329     ;; Guess away until we find the real file type.
 330     (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
 331                                               nndoc-type-alist))))
 332       (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
 333     ;; Set the nndoc variables.
 334     (while defs
 335       (set (intern (format "nndoc-%s" (caar defs)))
 336            (cdr (pop defs))))))
 337
 338 (defun nndoc-guess-type (subtype)
 339   (let ((alist nndoc-type-alist)
 340         results result entry)
 341     (while (and (not result)
 342                 (setq entry (pop alist)))
 343       (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
 344         (goto-char (point-min))
 345         (when (numberp (setq result (funcall (intern
 346                                               (format "nndoc-%s-type-p"
 347                                                       (car entry))))))
 348           (push (cons result entry) results)
 349           (setq result nil))))
 350     (unless (or result results)
 351       (error "Document is not of any recognized type"))
 352     (if result
 353         (car entry)
 354       (cadar (sort results 'car-less-than-car)))))
 355
 356 ;;;
 357 ;;; Built-in type predicates and functions
 358 ;;;
 359
 360 (defun nndoc-mbox-type-p ()
 361   (when (looking-at message-unix-mail-delimiter)
 362     t))
 363
 364 (defun nndoc-mbox-article-begin ()
 365   (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
 366     (goto-char (match-beginning 0))))
 367
 368 (defun nndoc-mbox-body-end ()
 369   (let ((beg (point))
 370         len end)
 371     (when
 372         (save-excursion
 373           (and (re-search-backward
 374                 (concat "^" message-unix-mail-delimiter) nil t)
 375                (setq end (point))
 376                (search-forward "\n\n" beg t)
 377                (re-search-backward
 378                 "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
 379                (setq len (string-to-int (match-string 1)))
 380                (search-forward "\n\n" beg t)
 381                (unless (= (setq len (+ (point) len)) (point-max))
 382                  (and (< len (point-max))
 383                       (goto-char len)
 384                       (looking-at message-unix-mail-delimiter)))))
 385       (goto-char len))))
 386
 387 (defun nndoc-mmdf-type-p ()
 388   (when (looking-at "\^A\^A\^A\^A$")
 389     t))
 390
 391 (defun nndoc-news-type-p ()
 392   (when (looking-at "^Path:.*\n")
 393     t))
 394
 395 (defun nndoc-rnews-type-p ()
 396   (when (looking-at "#! *rnews")
 397     t))
 398
 399 (defun nndoc-rnews-body-end ()
 400   (and (re-search-backward nndoc-article-begin nil t)
 401        (forward-line 1)
 402        (goto-char (+ (point) (string-to-int (match-string 1))))))
 403
 404 (defun nndoc-babyl-type-p ()
 405   (when (re-search-forward "\^_\^L *\n" nil t)
 406     t))
 407
 408 (defun nndoc-babyl-body-begin ()
 409   (re-search-forward "^\n" nil t)
 410   (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 411     (let ((next (or (save-excursion
 412                       (re-search-forward nndoc-article-begin nil t))
 413                     (point-max))))
 414       (unless (re-search-forward "^\n" next t)
 415         (goto-char next)
 416         (forward-line -1)
 417         (insert "\n")
 418         (forward-line -1)))))
 419
 420 (defun nndoc-babyl-head-begin ()
 421   (when (re-search-forward "^[0-9].*\n" nil t)
 422     (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 423       (forward-line 1))
 424     t))
 425
 426 (defun nndoc-forward-type-p ()
 427   (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
 428              (not (re-search-forward "^Subject:.*digest" nil t))
 429              (not (re-search-backward "^From:" nil t 2))
 430              (not (re-search-forward "^From:" nil t 2)))
 431     t))
 432
 433 (defun nndoc-rfc934-type-p ()
 434   (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
 435              (not (re-search-forward "^Subject:.*digest" nil t))
 436              (not (re-search-backward "^From:" nil t 2))
 437              (not (re-search-forward "^From:" nil t 2)))
 438     t))
 439
 440 (defun nndoc-rfc822-forward-type-p ()
 441   (save-restriction
 442     (message-narrow-to-head)
 443     (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
 444       t)))
 445
 446 (defun nndoc-rfc822-forward-body-end-function ()
 447   (goto-char (point-max)))
 448
 449 (defun nndoc-mime-parts-type-p ()
 450   (let ((case-fold-search t)
 451         (limit (search-forward "\n\n" nil t)))
 452     (goto-char (point-min))
 453     (when (and limit
 454                 (re-search-forward
 455                  (concat "\
 456 ^Content-Type:[ \t]*multipart/[a-z]+;\\(.*;\\)*"
 457                          "[ \t\n]*[ \t]boundary=\"?[^\"\n]*[^\" \t\n]")
 458            limit t))
 459       t)))
 460
 461 (defun nndoc-transform-mime-parts (article)
 462   (unless (= article 1)
 463     ;; Ensure some MIME-Version.
 464     (goto-char (point-min))
 465     (search-forward "\n\n")
 466     (let ((case-fold-search nil)
 467           (limit (point)))
 468       (goto-char (point-min))
 469       (or (save-excursion (re-search-forward "^MIME-Version:" limit t))
 470           (insert "Mime-Version: 1.0\n")))
 471     ;; Generate default header before entity fields.
 472     (goto-char (point-min))
 473     (nndoc-generate-mime-parts-head article t)))
 474
 475 (defun nndoc-generate-mime-parts-head (article &optional body-present)
 476   (let ((entry (cdr (assq (if body-present 1 article) nndoc-dissection-alist))))
 477     (let ((subject (if body-present
 478                        nndoc-mime-subject
 479                      (concat "<" (nth 5 entry) ">")))
 480           (message-id (nth 6 entry))
 481           (references (nth 7 entry)))
 482       (insert nndoc-mime-header)
 483       (and subject (insert "Subject: " subject "\n"))
 484       (and message-id (insert "Message-ID: " message-id "\n"))
 485       (and references (insert "References: " references "\n")))))
 486
 487 (defun nndoc-clari-briefs-type-p ()
 488   (when (let ((case-fold-search nil))
 489           (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
 490     t))
 491
 492 (defun nndoc-transform-clari-briefs (article)
 493   (goto-char (point-min))
 494   (when (looking-at " *\\*\\(.*\\)\n")
 495     (replace-match "" t t))
 496   (nndoc-generate-clari-briefs-head article))
 497
 498 (defun nndoc-generate-clari-briefs-head (article)
 499   (let ((entry (cdr (assq article nndoc-dissection-alist)))
 500         subject from)
 501     (save-excursion
 502       (set-buffer nndoc-current-buffer)
 503       (save-restriction
 504         (narrow-to-region (car entry) (nth 3 entry))
 505         (goto-char (point-min))
 506         (when (looking-at " *\\*\\(.*\\)$")
 507           (setq subject (match-string 1))
 508           (when (string-match "[ \t]+$" subject)
 509             (setq subject (substring subject 0 (match-beginning 0)))))
 510         (when
 511             (let ((case-fold-search nil))
 512               (re-search-forward
 513                "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
 514           (setq from (match-string 1)))))
 515     (insert "From: " "clari@clari.net (" (or from "unknown") ")"
 516             "\nSubject: " (or subject "(no subject)") "\n")))
 517
 518 (defun nndoc-mime-digest-type-p ()
 519   (let ((case-fold-search t)
 520         boundary-id b-delimiter entry)
 521     (when (and
 522            (re-search-forward
 523             (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
 524                     "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
 525             nil t)
 526            (match-beginning 1))
 527       (setq boundary-id (match-string 1)
 528             b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
 529       (setq entry (assq 'mime-digest nndoc-type-alist))
 530       (setcdr entry
 531               (list
 532                (cons 'head-end "^ ?$")
 533                (cons 'body-begin "^ ?\n")
 534                (cons 'article-begin b-delimiter)
 535                (cons 'body-end-function 'nndoc-digest-body-end)
 536                (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
 537       t)))
 538
 539 (defun nndoc-standard-digest-type-p ()
 540   (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
 541              (re-search-forward
 542               (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
 543     t))
 544
 545 (defun nndoc-digest-body-end ()
 546   (and (re-search-forward nndoc-article-begin nil t)
 547        (goto-char (match-beginning 0))))
 548
 549 (defun nndoc-slack-digest-type-p ()
 550   0)
 551
 552 (defun nndoc-lanl-gov-announce-type-p ()
 553   (when (let ((case-fold-search nil))
 554           (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
 555     t))
 556
 557 (defun nndoc-transform-lanl-gov-announce (article)
 558   (goto-char (point-max))
 559   (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
 560     (replace-match "\n\nGet it at \\1 (\\2)" t nil))
 561   ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
 562   ;;    (replace-match "" t t))
 563   )
 564
 565 (defun nndoc-generate-lanl-gov-head (article)
 566   (let ((entry (cdr (assq article nndoc-dissection-alist)))
 567         (e-mail "no address given")
 568         subject from)
 569     (save-excursion
 570       (set-buffer nndoc-current-buffer)
 571       (save-restriction
 572         (narrow-to-region (car entry) (nth 1 entry))
 573         (goto-char (point-min))
 574         (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
 575           (setq subject (concat " (" (match-string 1) ")"))
 576           (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
 577             (setq e-mail (match-string 1)))
 578           (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
 579                                    nil t)
 580             (setq subject (concat (match-string 1) subject))
 581             (setq from (concat (match-string 2) " <" e-mail ">"))))
 582         ))
 583     (while (and from (string-match "(\[^)\]*)" from))
 584       (setq from (replace-match "" t t from)))
 585     (insert "From: "  (or from "unknown")
 586             "\nSubject: " (or subject "(no subject)") "\n")))
 587
 588 (deffoo nndoc-request-accept-article (group &optional server last)
 589   nil)
 590
 591
 592
 593 ;;;
 594 ;;; Functions for dissecting the documents
 595 ;;;
 596
 597 (defun nndoc-search (regexp)
 598   (prog1
 599       (re-search-forward regexp nil t)
 600     (beginning-of-line)))
 601
 602 (defun nndoc-dissect-buffer ()
 603   "Go through the document and partition it into heads/bodies/articles."
 604   (let ((i 0)
 605         (first t)
 606         head-begin head-end body-begin body-end)
 607     (setq nndoc-dissection-alist nil)
 608     (save-excursion
 609       (set-buffer nndoc-current-buffer)
 610       (goto-char (point-min))
 611       ;; Find the beginning of the file.
 612       (when nndoc-file-begin
 613         (nndoc-search nndoc-file-begin))
 614       ;; Go through the file.
 615       (while (if (and first nndoc-first-article)
 616                  (nndoc-search nndoc-first-article)
 617                (nndoc-article-begin))
 618         (setq first nil)
 619         (cond (nndoc-head-begin-function
 620                (funcall nndoc-head-begin-function))
 621               (nndoc-head-begin
 622                (nndoc-search nndoc-head-begin)))
 623         (if (or (eobp)
 624                 (and nndoc-file-end
 625                      (looking-at nndoc-file-end)))
 626             (goto-char (point-max))
 627           (setq head-begin (point))
 628           (nndoc-search (or nndoc-head-end "^$"))
 629           (setq head-end (point))
 630           (if nndoc-body-begin-function
 631               (funcall nndoc-body-begin-function)
 632             (nndoc-search (or nndoc-body-begin "^\n")))
 633           (setq body-begin (point))
 634           (or (and nndoc-body-end-function
 635                    (funcall nndoc-body-end-function))
 636               (and nndoc-body-end
 637                    (nndoc-search nndoc-body-end))
 638               (nndoc-article-begin)
 639               (progn
 640                 (goto-char (point-max))
 641                 (when nndoc-file-end
 642                   (and (re-search-backward nndoc-file-end nil t)
 643                        (beginning-of-line)))))
 644           (setq body-end (point))
 645           (push (list (incf i) head-begin head-end body-begin body-end
 646                       (count-lines body-begin body-end))
 647                 nndoc-dissection-alist))))))
 648
 649 (defun nndoc-article-begin ()
 650   (if nndoc-article-begin-function
 651       (funcall nndoc-article-begin-function)
 652     (ignore-errors
 653       (nndoc-search nndoc-article-begin))))
 654
 655 (defun nndoc-unquote-dashes ()
 656   "Unquote quoted non-separators in digests."
 657   (while (re-search-forward "^- -"nil t)
 658     (replace-match "-" t t)))
 659
 660 ;; Against compiler warnings.
 661 (defvar nndoc-mime-split-ordinal)
 662
 663 (defun nndoc-dissect-mime-parts ()
 664   "Go through a MIME composite article and partition it into sub-articles.
 665 When a MIME entity contains sub-entities, dissection produces one article for
 666 the header of this entity, and one article per sub-entity."
 667   (setq nndoc-dissection-alist nil
 668         nndoc-mime-split-ordinal 0)
 669   (save-excursion
 670     (set-buffer nndoc-current-buffer)
 671     (message-narrow-to-head)
 672     (let ((case-fold-search t)
 673           (message-id (message-fetch-field "Message-ID"))
 674           (references (message-fetch-field "References")))
 675       (setq nndoc-mime-header (buffer-substring (point-min) (point-max))
 676             nndoc-mime-subject (message-fetch-field "Subject"))
 677       (while (string-match "\
 678 ^\\(Subject\\|Message-ID\\|References\\|Lines\\|\
 679 MIME-Version\\|Content-Type\\|Content-Transfer-Encoding\\|\
 680 \\):.*\n\\([ \t].*\n\\)*"
 681                            nndoc-mime-header)
 682         (setq nndoc-mime-header (replace-match "" t t nndoc-mime-header)))
 683       (widen)
 684       (nndoc-dissect-mime-parts-sub (point-min) (point-max)
 685                                     nil message-id references))))
 686
 687 (defun nndoc-dissect-mime-parts-sub (begin end position message-id references)
 688   "Dissect an entity within a composite MIME message.
 689 The article, which corresponds to a MIME entity, extends from BEGIN to END.
 690 The string POSITION holds a dotted decimal representation of the article
 691 position in the hierarchical structure, it is nil for the outer entity.
 692 The generated article should use MESSAGE-ID and REFERENCES field values."
 693   ;; Note: `case-fold-search' is already `t' from the calling function.
 694   (let ((head-begin begin)
 695         (body-end end)
 696         head-end body-begin type subtype composite comment)
 697     (save-excursion
 698       ;; Gracefully handle a missing body.
 699       (goto-char head-begin)
 700       (if (search-forward "\n\n" body-end t)
 701           (setq head-end (1- (point))
 702                 body-begin (point))
 703         (setq head-end end
 704               body-begin end))
 705       ;; Save MIME attributes.
 706       (goto-char head-begin)
 707       (if (re-search-forward "\
 708 ^Content-Type: *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)"
 709                              head-end t)
 710           (setq type (downcase (match-string 1))
 711                 subtype (downcase (match-string 2)))
 712         (setq type "text"
 713               subtype "plain"))
 714       (setq composite (string= type "multipart")
 715             comment (concat position
 716                             (when (and position composite) ".")
 717                             (when composite "*")
 718                             (when (or position composite) " ")
 719                             (cond ((string= subtype "plain") type)
 720                                   ((string= subtype "basic") type)
 721                                   (t subtype))))
 722       ;; Generate dissection information for this entity.
 723       (push (list (incf nndoc-mime-split-ordinal)
 724                   head-begin head-end body-begin body-end
 725                   (count-lines body-begin body-end)
 726                   comment message-id references)
 727             nndoc-dissection-alist)
 728       ;; Recurse for all sub-entities, if any.
 729       (goto-char head-begin)
 730       (when (re-search-forward
 731              (concat "\
 732 ^Content-Type: *multipart/\\([a-z]+\\);\\(.*;\\)*"
 733                      "[ \t\n]*[ \t]boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
 734            head-end t)
 735         (let ((boundary (concat "\n--" (match-string 3) "\\(--\\)?[ \t]*\n"))
 736               (part-counter 0)
 737               begin end eof-flag)
 738           (goto-char head-end)
 739           (setq eof-flag (not (re-search-forward boundary body-end t)))
 740           (while (not eof-flag)
 741             (setq begin (point))
 742             (cond ((re-search-forward boundary body-end t)
 743                    (or (not (match-string 1))
 744                        (string= (match-string 1) "")
 745                        (setq eof-flag t))
 746                    (forward-line -1)
 747                    (setq end (point))
 748                    (forward-line 1))
 749                   (t (setq end body-end
 750                            eof-flag t)))
 751             (nndoc-dissect-mime-parts-sub begin end
 752                                           (concat position (when position ".")
 753                                                   (format "%d"
 754                                                           (incf part-counter)))
 755                                           (nnmail-message-id)
 756                                           message-id)))))))
 757
 758 ;;;###autoload
 759 (defun nndoc-add-type (definition &optional position)
 760   "Add document DEFINITION to the list of nndoc document definitions.
 761 If POSITION is nil or `last', the definition will be added
 762 as the last checked definition, if t or `first', add as the
 763 first definition, and if any other symbol, add after that
 764 symbol in the alist."
 765   ;; First remove any old instances.
 766   (gnus-pull (car definition) nndoc-type-alist)
 767   ;; Then enter the new definition in the proper place.
 768   (cond
 769    ((or (null position) (eq position 'last))
 770     (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
 771    ((or (eq position t) (eq position 'first))
 772     (push definition nndoc-type-alist))
 773    (t
 774     (let ((list (memq (assq position nndoc-type-alist)
 775                       nndoc-type-alist)))
 776       (unless list
 777         (error "No such position: %s" position))
 778       (setcdr list (cons definition (cdr list)))))))
 779
 780 (provide 'nndoc)
 781
 782 ;;; nndoc.el ends here