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', `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     (standard-digest
  91      (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
  92      (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
  93      (prepare-body-function . nndoc-unquote-dashes)
  94      (body-end-function . nndoc-digest-body-end)
  95      (head-end . "^ *$")
  96      (body-begin . "^ *\n")
  97      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
  98      (subtype digest guess))
  99     (slack-digest
 100      (article-begin . "^------------------------------*[\n \t]+")
 101      (head-end . "^ ?$")
 102      (body-end-function . nndoc-digest-body-end)
 103      (body-begin . "^ ?$")
 104      (file-end . "^End of")
 105      (prepare-body-function . nndoc-unquote-dashes)
 106      (subtype digest guess))
 107     (lanl-gov-announce
 108      (article-begin . "^\\\\\\\\\n")
 109      (head-begin . "^Paper.*:")
 110      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
 111      (body-begin . "")
 112      (body-end   . "-------------------------------------------------")
 113      (file-end   . "^Title: Recent Seminal")
 114      (generate-head-function . nndoc-generate-lanl-gov-head)
 115      (article-transform-function . nndoc-transform-lanl-gov-announce)
 116      (subtype preprints guess))
 117     (rfc822-forward
 118      (article-begin . "^\n")
 119      (body-end-function . nndoc-rfc822-forward-body-end-function))
 120     (guess
 121      (guess . t)
 122      (subtype nil))
 123     (digest
 124      (guess . t)
 125      (subtype nil))
 126     (preprints
 127      (guess . t)
 128      (subtype nil))))
 129
 130 \f
 131
 132 (defvoo nndoc-file-begin nil)
 133 (defvoo nndoc-first-article nil)
 134 (defvoo nndoc-article-end nil)
 135 (defvoo nndoc-article-begin nil)
 136 (defvoo nndoc-head-begin nil)
 137 (defvoo nndoc-head-end nil)
 138 (defvoo nndoc-file-end nil)
 139 (defvoo nndoc-body-begin nil)
 140 (defvoo nndoc-body-end-function nil)
 141 (defvoo nndoc-body-begin-function nil)
 142 (defvoo nndoc-head-begin-function nil)
 143 (defvoo nndoc-body-end nil)
 144 (defvoo nndoc-dissection-alist nil)
 145 (defvoo nndoc-prepare-body-function nil)
 146 (defvoo nndoc-generate-head-function nil)
 147 (defvoo nndoc-article-transform-function nil)
 148 (defvoo nndoc-article-begin-function nil)
 149
 150 (defvoo nndoc-status-string "")
 151 (defvoo nndoc-group-alist nil)
 152 (defvoo nndoc-current-buffer nil
 153   "Current nndoc news buffer.")
 154 (defvoo nndoc-address nil)
 155
 156 (defconst nndoc-version "nndoc 1.0"
 157   "nndoc version.")
 158
 159 \f
 160
 161 ;;; Interface functions
 162
 163 (nnoo-define-basics nndoc)
 164
 165 (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
 166   (when (nndoc-possibly-change-buffer newsgroup server)
 167     (save-excursion
 168       (set-buffer nntp-server-buffer)
 169       (erase-buffer)
 170       (let (article entry)
 171         (if (stringp (car articles))
 172             'headers
 173           (while articles
 174             (when (setq entry (cdr (assq (setq article (pop articles))
 175                                          nndoc-dissection-alist)))
 176               (insert (format "221 %d Article retrieved.\n" article))
 177               (if nndoc-generate-head-function
 178                   (funcall nndoc-generate-head-function article)
 179                 (insert-buffer-substring
 180                  nndoc-current-buffer (car entry) (nth 1 entry)))
 181               (goto-char (point-max))
 182               (unless (= (char-after (1- (point))) ?\n)
 183                 (insert "\n"))
 184               (insert (format "Lines: %d\n" (nth 4 entry)))
 185               (insert ".\n")))
 186
 187           (nnheader-fold-continuation-lines)
 188           'headers)))))
 189
 190 (deffoo nndoc-request-article (article &optional newsgroup server buffer)
 191   (nndoc-possibly-change-buffer newsgroup server)
 192   (save-excursion
 193     (let ((buffer (or buffer nntp-server-buffer))
 194           (entry (cdr (assq article nndoc-dissection-alist)))
 195           beg)
 196       (set-buffer buffer)
 197       (erase-buffer)
 198       (when entry
 199         (if (stringp article)
 200             nil
 201           (insert-buffer-substring
 202            nndoc-current-buffer (car entry) (nth 1 entry))
 203           (insert "\n")
 204           (setq beg (point))
 205           (insert-buffer-substring
 206            nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 207           (goto-char beg)
 208           (when nndoc-prepare-body-function
 209             (funcall nndoc-prepare-body-function))
 210           (when nndoc-article-transform-function
 211             (funcall nndoc-article-transform-function article))
 212           t)))))
 213
 214 (deffoo nndoc-request-group (group &optional server dont-check)
 215   "Select news GROUP."
 216   (let (number)
 217     (cond
 218      ((not (nndoc-possibly-change-buffer group server))
 219       (nnheader-report 'nndoc "No such file or buffer: %s"
 220                        nndoc-address))
 221      (dont-check
 222       (nnheader-report 'nndoc "Selected group %s" group)
 223       t)
 224      ((zerop (setq number (length nndoc-dissection-alist)))
 225       (nndoc-close-group group)
 226       (nnheader-report 'nndoc "No articles in group %s" group))
 227      (t
 228       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
 229
 230 (deffoo nndoc-request-type (group &optional article)
 231   (cond ((not article) 'unknown)
 232         (nndoc-post-type nndoc-post-type)
 233         (t 'unknown)))
 234
 235 (deffoo nndoc-close-group (group &optional server)
 236   (nndoc-possibly-change-buffer group server)
 237   (and nndoc-current-buffer
 238        (buffer-name nndoc-current-buffer)
 239        (kill-buffer nndoc-current-buffer))
 240   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 241                                 nndoc-group-alist))
 242   (setq nndoc-current-buffer nil)
 243   (nnoo-close-server 'nndoc server)
 244   (setq nndoc-dissection-alist nil)
 245   t)
 246
 247 (deffoo nndoc-request-list (&optional server)
 248   nil)
 249
 250 (deffoo nndoc-request-newgroups (date &optional server)
 251   nil)
 252
 253 (deffoo nndoc-request-list-newsgroups (&optional server)
 254   nil)
 255
 256 \f
 257 ;;; Internal functions.
 258
 259 (defun nndoc-possibly-change-buffer (group source)
 260   (let (buf)
 261     (cond
 262      ;; The current buffer is this group's buffer.
 263      ((and nndoc-current-buffer
 264            (buffer-name nndoc-current-buffer)
 265            (eq nndoc-current-buffer
 266                (setq buf (cdr (assoc group nndoc-group-alist))))))
 267      ;; We change buffers by taking an old from the group alist.
 268      ;; `source' is either a string (a file name) or a buffer object.
 269      (buf
 270       (setq nndoc-current-buffer buf))
 271      ;; It's a totally new group.
 272      ((or (and (bufferp nndoc-address)
 273                (buffer-name nndoc-address))
 274           (and (stringp nndoc-address)
 275                (file-exists-p nndoc-address)
 276                (not (file-directory-p nndoc-address))))
 277       (push (cons group (setq nndoc-current-buffer
 278                               (get-buffer-create
 279                                (concat " *nndoc " group "*"))))
 280             nndoc-group-alist)
 281       (setq nndoc-dissection-alist nil)
 282       (save-excursion
 283         (set-buffer nndoc-current-buffer)
 284         (buffer-disable-undo (current-buffer))
 285         (erase-buffer)
 286         (if (stringp nndoc-address)
 287             (nnheader-insert-file-contents nndoc-address)
 288           (insert-buffer-substring nndoc-address))
 289         (run-hooks 'nndoc-open-document-hook))))
 290     ;; Initialize the nndoc structures according to this new document.
 291     (when (and nndoc-current-buffer
 292                (not nndoc-dissection-alist))
 293       (save-excursion
 294         (set-buffer nndoc-current-buffer)
 295         (nndoc-set-delims)
 296         (nndoc-dissect-buffer)))
 297     (unless nndoc-current-buffer
 298       (nndoc-close-server))
 299     ;; Return whether we managed to select a file.
 300     nndoc-current-buffer))
 301
 302 ;;;
 303 ;;; Deciding what document type we have
 304 ;;;
 305
 306 (defun nndoc-set-delims ()
 307   "Set the nndoc delimiter variables according to the type of the document."
 308   (let ((vars '(nndoc-file-begin
 309                 nndoc-first-article
 310                 nndoc-article-end nndoc-head-begin nndoc-head-end
 311                 nndoc-file-end nndoc-article-begin
 312                 nndoc-body-begin nndoc-body-end-function nndoc-body-end
 313                 nndoc-prepare-body-function nndoc-article-transform-function
 314                 nndoc-generate-head-function nndoc-body-begin-function
 315                 nndoc-head-begin-function)))
 316     (while vars
 317       (set (pop vars) nil)))
 318   (let (defs)
 319     ;; Guess away until we find the real file type.
 320     (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
 321                                               nndoc-type-alist))))
 322       (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
 323     ;; Set the nndoc variables.
 324     (while defs
 325       (set (intern (format "nndoc-%s" (caar defs)))
 326            (cdr (pop defs))))))
 327
 328 (defun nndoc-guess-type (subtype)
 329   (let ((alist nndoc-type-alist)
 330         results result entry)
 331     (while (and (not result)
 332                 (setq entry (pop alist)))
 333       (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
 334         (goto-char (point-min))
 335         (when (numberp (setq result (funcall (intern
 336                                               (format "nndoc-%s-type-p"
 337                                                       (car entry))))))
 338           (push (cons result entry) results)
 339           (setq result nil))))
 340     (unless (or result results)
 341       (error "Document is not of any recognized type"))
 342     (if result
 343         (car entry)
 344       (cadar (sort results 'car-less-than-car)))))
 345
 346 ;;;
 347 ;;; Built-in type predicates and functions
 348 ;;;
 349
 350 (defun nndoc-mbox-type-p ()
 351   (when (looking-at message-unix-mail-delimiter)
 352     t))
 353
 354 (defun nndoc-mbox-article-begin ()
 355   (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
 356     (goto-char (match-beginning 0))))
 357
 358 (defun nndoc-mbox-body-end ()
 359   (let ((beg (point))
 360         len end)
 361     (when
 362         (save-excursion
 363           (and (re-search-backward
 364                 (concat "^" message-unix-mail-delimiter) nil t)
 365                (setq end (point))
 366                (search-forward "\n\n" beg t)
 367                (re-search-backward
 368                 "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
 369                (setq len (string-to-int (match-string 1)))
 370                (search-forward "\n\n" beg t)
 371                (unless (= (setq len (+ (point) len)) (point-max))
 372                  (and (< len (point-max))
 373                       (goto-char len)
 374                       (looking-at message-unix-mail-delimiter)))))
 375       (goto-char len))))
 376
 377 (defun nndoc-mmdf-type-p ()
 378   (when (looking-at "\^A\^A\^A\^A$")
 379     t))
 380
 381 (defun nndoc-news-type-p ()
 382   (when (looking-at "^Path:.*\n")
 383     t))
 384
 385 (defun nndoc-rnews-type-p ()
 386   (when (looking-at "#! *rnews")
 387     t))
 388
 389 (defun nndoc-rnews-body-end ()
 390   (and (re-search-backward nndoc-article-begin nil t)
 391        (forward-line 1)
 392        (goto-char (+ (point) (string-to-int (match-string 1))))))
 393
 394 (defun nndoc-babyl-type-p ()
 395   (when (re-search-forward "\^_\^L *\n" nil t)
 396     t))
 397
 398 (defun nndoc-babyl-body-begin ()
 399   (re-search-forward "^\n" nil t)
 400   (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 401     (let ((next (or (save-excursion
 402                       (re-search-forward nndoc-article-begin nil t))
 403                     (point-max))))
 404       (unless (re-search-forward "^\n" next t)
 405         (goto-char next)
 406         (forward-line -1)
 407         (insert "\n")
 408         (forward-line -1)))))
 409
 410 (defun nndoc-babyl-head-begin ()
 411   (when (re-search-forward "^[0-9].*\n" nil t)
 412     (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 413       (forward-line 1))
 414     t))
 415
 416 (defun nndoc-forward-type-p ()
 417   (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
 418              (not (re-search-forward "^Subject:.*digest" nil t))
 419              (not (re-search-backward "^From:" nil t 2))
 420              (not (re-search-forward "^From:" nil t 2)))
 421     t))
 422
 423 (defun nndoc-rfc934-type-p ()
 424   (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
 425              (not (re-search-forward "^Subject:.*digest" nil t))
 426              (not (re-search-backward "^From:" nil t 2))
 427              (not (re-search-forward "^From:" nil t 2)))
 428     t))
 429
 430 (defun nndoc-rfc822-forward-type-p ()
 431   (save-restriction
 432     (message-narrow-to-head)
 433     (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
 434       t)))
 435
 436 (defun nndoc-rfc822-forward-body-end-function ()
 437   (goto-char (point-max)))
 438
 439 (defun nndoc-clari-briefs-type-p ()
 440   (when (let ((case-fold-search nil))
 441           (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
 442     t))
 443
 444 (defun nndoc-transform-clari-briefs (article)
 445   (goto-char (point-min))
 446   (when (looking-at " *\\*\\(.*\\)\n")
 447     (replace-match "" t t))
 448   (nndoc-generate-clari-briefs-head article))
 449
 450 (defun nndoc-generate-clari-briefs-head (article)
 451   (let ((entry (cdr (assq article nndoc-dissection-alist)))
 452         subject from)
 453     (save-excursion
 454       (set-buffer nndoc-current-buffer)
 455       (save-restriction
 456         (narrow-to-region (car entry) (nth 3 entry))
 457         (goto-char (point-min))
 458         (when (looking-at " *\\*\\(.*\\)$")
 459           (setq subject (match-string 1))
 460           (when (string-match "[ \t]+$" subject)
 461             (setq subject (substring subject 0 (match-beginning 0)))))
 462         (when
 463             (let ((case-fold-search nil))
 464               (re-search-forward
 465                "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
 466           (setq from (match-string 1)))))
 467     (insert "From: " "clari@clari.net (" (or from "unknown") ")"
 468             "\nSubject: " (or subject "(no subject)") "\n")))
 469
 470 (defun nndoc-mime-digest-type-p ()
 471   (let ((case-fold-search t)
 472         boundary-id b-delimiter entry)
 473     (when (and
 474            (re-search-forward
 475             (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
 476                     "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
 477             nil t)
 478            (match-beginning 1))
 479       (setq boundary-id (match-string 1)
 480             b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
 481       (setq entry (assq 'mime-digest nndoc-type-alist))
 482       (setcdr entry
 483               (list
 484                (cons 'head-end "^ ?$")
 485                (cons 'body-begin "^ ?\n")
 486                (cons 'article-begin b-delimiter)
 487                (cons 'body-end-function 'nndoc-digest-body-end)
 488                (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
 489       t)))
 490
 491 (defun nndoc-standard-digest-type-p ()
 492   (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
 493              (re-search-forward
 494               (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
 495     t))
 496
 497 (defun nndoc-digest-body-end ()
 498   (and (re-search-forward nndoc-article-begin nil t)
 499        (goto-char (match-beginning 0))))
 500
 501 (defun nndoc-slack-digest-type-p ()
 502   0)
 503
 504 (defun nndoc-lanl-gov-announce-type-p ()
 505   (when (let ((case-fold-search nil))
 506           (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
 507     t))
 508
 509 (defun nndoc-transform-lanl-gov-announce (article)
 510   (goto-char (point-max))
 511   (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
 512     (replace-match "\n\nGet it at \\1 (\\2)" t nil))
 513   ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
 514   ;;    (replace-match "" t t))
 515   )
 516
 517 (defun nndoc-generate-lanl-gov-head (article)
 518   (let ((entry (cdr (assq article nndoc-dissection-alist)))
 519         (e-mail "no address given")
 520         subject from)
 521     (save-excursion
 522       (set-buffer nndoc-current-buffer)
 523       (save-restriction
 524         (narrow-to-region (car entry) (nth 1 entry))
 525         (goto-char (point-min))
 526         (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
 527           (setq subject (concat " (" (match-string 1) ")"))
 528           (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
 529             (setq e-mail (match-string 1)))
 530           (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
 531                                    nil t)
 532             (setq subject (concat (match-string 1) subject))
 533             (setq from (concat (match-string 2) " <" e-mail ">"))))
 534         ))
 535     (while (and from (string-match "(\[^)\]*)" from))
 536       (setq from (replace-match "" t t from)))
 537     (insert "From: "  (or from "unknown")
 538             "\nSubject: " (or subject "(no subject)") "\n")))
 539
 540 (deffoo nndoc-request-accept-article (group &optional server last)
 541   nil)
 542
 543
 544
 545 ;;;
 546 ;;; Functions for dissecting the documents
 547 ;;;
 548
 549 (defun nndoc-search (regexp)
 550   (prog1
 551       (re-search-forward regexp nil t)
 552     (beginning-of-line)))
 553
 554 (defun nndoc-dissect-buffer ()
 555   "Go through the document and partition it into heads/bodies/articles."
 556   (let ((i 0)
 557         (first t)
 558         head-begin head-end body-begin body-end)
 559     (setq nndoc-dissection-alist nil)
 560     (save-excursion
 561       (set-buffer nndoc-current-buffer)
 562       (goto-char (point-min))
 563       ;; Find the beginning of the file.
 564       (when nndoc-file-begin
 565         (nndoc-search nndoc-file-begin))
 566       ;; Go through the file.
 567       (while (if (and first nndoc-first-article)
 568                  (nndoc-search nndoc-first-article)
 569                (nndoc-article-begin))
 570         (setq first nil)
 571         (cond (nndoc-head-begin-function
 572                (funcall nndoc-head-begin-function))
 573               (nndoc-head-begin
 574                (nndoc-search nndoc-head-begin)))
 575         (if (or (>= (point) (point-max))
 576                 (and nndoc-file-end
 577                      (looking-at nndoc-file-end)))
 578             (goto-char (point-max))
 579           (setq head-begin (point))
 580           (nndoc-search (or nndoc-head-end "^$"))
 581           (setq head-end (point))
 582           (if nndoc-body-begin-function
 583               (funcall nndoc-body-begin-function)
 584             (nndoc-search (or nndoc-body-begin "^\n")))
 585           (setq body-begin (point))
 586           (or (and nndoc-body-end-function
 587                    (funcall nndoc-body-end-function))
 588               (and nndoc-body-end
 589                    (nndoc-search nndoc-body-end))
 590               (nndoc-article-begin)
 591               (progn
 592                 (goto-char (point-max))
 593                 (when nndoc-file-end
 594                   (and (re-search-backward nndoc-file-end nil t)
 595                        (beginning-of-line)))))
 596           (setq body-end (point))
 597           (push (list (incf i) head-begin head-end body-begin body-end
 598                       (count-lines body-begin body-end))
 599                 nndoc-dissection-alist))))))
 600
 601 (defun nndoc-article-begin ()
 602   (if nndoc-article-begin-function
 603       (funcall nndoc-article-begin-function)
 604     (ignore-errors
 605       (nndoc-search nndoc-article-begin))))
 606
 607 (defun nndoc-unquote-dashes ()
 608   "Unquote quoted non-separators in digests."
 609   (while (re-search-forward "^- -"nil t)
 610     (replace-match "-" t t)))
 611
 612 ;;;###autoload
 613 (defun nndoc-add-type (definition &optional position)
 614   "Add document DEFINITION to the list of nndoc document definitions.
 615 If POSITION is nil or `last', the definition will be added
 616 as the last checked definition, if t or `first', add as the
 617 first definition, and if any other symbol, add after that
 618 symbol in the alist."
 619   ;; First remove any old instances.
 620   (gnus-pull (car definition) nndoc-type-alist)
 621   ;; Then enter the new definition in the proper place.
 622   (cond
 623    ((or (null position) (eq position 'last))
 624     (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
 625    ((or (eq position t) (eq position 'first))
 626     (push definition nndoc-type-alist))
 627    (t
 628     (let ((list (memq (assq position nndoc-type-alist)
 629                       nndoc-type-alist)))
 630       (unless list
 631         (error "No such position: %s" position))
 632       (setcdr list (cons definition (cdr list)))))))
 633
 634 (provide 'nndoc)
 635
 636 ;;; nndoc.el ends here