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