git.chise.org Git - elisp/gnus.git-/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-begin nil)
 135 (defvoo nndoc-head-begin nil)
 136 (defvoo nndoc-head-end nil)
 137 (defvoo nndoc-file-end nil)
 138 (defvoo nndoc-body-begin nil)
 139 (defvoo nndoc-body-end-function nil)
 140 (defvoo nndoc-body-begin-function nil)
 141 (defvoo nndoc-head-begin-function nil)
 142 (defvoo nndoc-body-end nil)
 143 (defvoo nndoc-dissection-alist nil)
 144 (defvoo nndoc-prepare-body-function nil)
 145 (defvoo nndoc-generate-head-function nil)
 146 (defvoo nndoc-article-transform-function nil)
 147 (defvoo nndoc-article-begin-function nil)
 148
 149 (defvoo nndoc-status-string "")
 150 (defvoo nndoc-group-alist nil)
 151 (defvoo nndoc-current-buffer nil
 152   "Current nndoc news buffer.")
 153 (defvoo nndoc-address nil)
 154
 155 (defconst nndoc-version "nndoc 1.0"
 156   "nndoc version.")
 157
 158 \f
 159
 160 ;;; Interface functions
 161
 162 (nnoo-define-basics nndoc)
 163
 164 (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
 165   (when (nndoc-possibly-change-buffer newsgroup server)
 166     (save-excursion
 167       (set-buffer nntp-server-buffer)
 168       (erase-buffer)
 169       (let (article entry)
 170         (if (stringp (car articles))
 171             'headers
 172           (while articles
 173             (when (setq entry (cdr (assq (setq article (pop articles))
 174                                          nndoc-dissection-alist)))
 175               (insert (format "221 %d Article retrieved.\n" article))
 176               (if nndoc-generate-head-function
 177                   (funcall nndoc-generate-head-function article)
 178                 (insert-buffer-substring
 179                  nndoc-current-buffer (car entry) (nth 1 entry)))
 180               (goto-char (point-max))
 181               (unless (= (char-after (1- (point))) ?\n)
 182                 (insert "\n"))
 183               (insert (format "Lines: %d\n" (nth 4 entry)))
 184               (insert ".\n")))
 185
 186           (nnheader-fold-continuation-lines)
 187           'headers)))))
 188
 189 (deffoo nndoc-request-article (article &optional newsgroup server buffer)
 190   (nndoc-possibly-change-buffer newsgroup server)
 191   (save-excursion
 192     (let ((buffer (or buffer nntp-server-buffer))
 193           (entry (cdr (assq article nndoc-dissection-alist)))
 194           beg)
 195       (set-buffer buffer)
 196       (erase-buffer)
 197       (when entry
 198         (if (stringp article)
 199             nil
 200           (insert-buffer-substring
 201            nndoc-current-buffer (car entry) (nth 1 entry))
 202           (insert "\n")
 203           (setq beg (point))
 204           (insert-buffer-substring
 205            nndoc-current-buffer (nth 2 entry) (nth 3 entry))
 206           (goto-char beg)
 207           (when nndoc-prepare-body-function
 208             (funcall nndoc-prepare-body-function))
 209           (when nndoc-article-transform-function
 210             (funcall nndoc-article-transform-function article))
 211           t)))))
 212
 213 (deffoo nndoc-request-group (group &optional server dont-check)
 214   "Select news GROUP."
 215   (let (number)
 216     (cond
 217      ((not (nndoc-possibly-change-buffer group server))
 218       (nnheader-report 'nndoc "No such file or buffer: %s"
 219                        nndoc-address))
 220      (dont-check
 221       (nnheader-report 'nndoc "Selected group %s" group)
 222       t)
 223      ((zerop (setq number (length nndoc-dissection-alist)))
 224       (nndoc-close-group group)
 225       (nnheader-report 'nndoc "No articles in group %s" group))
 226      (t
 227       (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
 228
 229 (deffoo nndoc-request-type (group &optional article)
 230   (cond ((not article) 'unknown)
 231         (nndoc-post-type nndoc-post-type)
 232         (t 'unknown)))
 233
 234 (deffoo nndoc-close-group (group &optional server)
 235   (nndoc-possibly-change-buffer group server)
 236   (and nndoc-current-buffer
 237        (buffer-name nndoc-current-buffer)
 238        (kill-buffer nndoc-current-buffer))
 239   (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
 240                                 nndoc-group-alist))
 241   (setq nndoc-current-buffer nil)
 242   (nnoo-close-server 'nndoc server)
 243   (setq nndoc-dissection-alist nil)
 244   t)
 245
 246 (deffoo nndoc-request-list (&optional server)
 247   nil)
 248
 249 (deffoo nndoc-request-newgroups (date &optional server)
 250   nil)
 251
 252 (deffoo nndoc-request-list-newsgroups (&optional server)
 253   nil)
 254
 255 \f
 256 ;;; Internal functions.
 257
 258 (defun nndoc-possibly-change-buffer (group source)
 259   (let (buf)
 260     (cond
 261      ;; The current buffer is this group's buffer.
 262      ((and nndoc-current-buffer
 263            (buffer-name nndoc-current-buffer)
 264            (eq nndoc-current-buffer
 265                (setq buf (cdr (assoc group nndoc-group-alist))))))
 266      ;; We change buffers by taking an old from the group alist.
 267      ;; `source' is either a string (a file name) or a buffer object.
 268      (buf
 269       (setq nndoc-current-buffer buf))
 270      ;; It's a totally new group.
 271      ((or (and (bufferp nndoc-address)
 272                (buffer-name nndoc-address))
 273           (and (stringp nndoc-address)
 274                (file-exists-p nndoc-address)
 275                (not (file-directory-p nndoc-address))))
 276       (push (cons group (setq nndoc-current-buffer
 277                               (get-buffer-create
 278                                (concat " *nndoc " group "*"))))
 279             nndoc-group-alist)
 280       (setq nndoc-dissection-alist nil)
 281       (save-excursion
 282         (set-buffer nndoc-current-buffer)
 283         (buffer-disable-undo (current-buffer))
 284         (erase-buffer)
 285         (if (stringp nndoc-address)
 286             (nnheader-insert-file-contents nndoc-address)
 287           (insert-buffer-substring nndoc-address))
 288         (run-hooks 'nndoc-open-document-hook))))
 289     ;; Initialize the nndoc structures according to this new document.
 290     (when (and nndoc-current-buffer
 291                (not nndoc-dissection-alist))
 292       (save-excursion
 293         (set-buffer nndoc-current-buffer)
 294         (nndoc-set-delims)
 295         (nndoc-dissect-buffer)))
 296     (unless nndoc-current-buffer
 297       (nndoc-close-server))
 298     ;; Return whether we managed to select a file.
 299     nndoc-current-buffer))
 300
 301 ;;;
 302 ;;; Deciding what document type we have
 303 ;;;
 304
 305 (defun nndoc-set-delims ()
 306   "Set the nndoc delimiter variables according to the type of the document."
 307   (let ((vars '(nndoc-file-begin
 308                 nndoc-first-article
 309                 nndoc-article-begin-function
 310                 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 (eobp)
 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