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@ifi.uio.no>
   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 (eval-when-compile (require 'cl))
  34
  35 (nnoo-declare nndoc)
  36
  37 (defvoo nndoc-article-type 'guess
  38   "*Type of the file.
  39 One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
  40 `rfc934', `rfc822-forward', `mime-digest', `standard-digest',
  41 `slack-digest', `clari-briefs' or `guess'.")
  42
  43 (defvoo nndoc-post-type 'mail
  44   "*Whether the nndoc group is `mail' or `post'.")
  45
  46 (defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr
  47   "Hook run after opening a document.
  48 The default function removes all trailing carriage returns
  49 from the document.")
  50
  51 (defvar nndoc-type-alist
  52   `((mmdf
  53      (article-begin .  "^\^A\^A\^A\^A\n")
  54      (body-end .  "^\^A\^A\^A\^A\n"))
  55     (news
  56      (article-begin . "^Path:"))
  57     (rnews
  58      (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
  59      (body-end-function . nndoc-rnews-body-end))
  60     (mbox
  61      (article-begin-function . nndoc-mbox-article-begin)
  62      (body-end-function . nndoc-mbox-body-end))
  63     (babyl
  64      (article-begin . "\^_\^L *\n")
  65      (body-end . "\^_")
  66      (body-begin-function . nndoc-babyl-body-begin)
  67      (head-begin-function . nndoc-babyl-head-begin))
  68     (forward
  69      (article-begin . "^-+ Start of forwarded message -+\n+")
  70      (body-end . "^-+ End of forwarded message -+$")
  71      (prepare-body-function . nndoc-unquote-dashes))
  72     (rfc934
  73      (article-begin . "^--.*\n+")
  74      (body-end . "^--.*$")
  75      (prepare-body-function . nndoc-unquote-dashes))
  76     (clari-briefs
  77      (article-begin . "^ \\*")
  78      (body-end . "^\t------*[ \t]^*\n^ \\*")
  79      (body-begin . "^\t")
  80      (head-end . "^\t")
  81      (generate-head-function . nndoc-generate-clari-briefs-head)
  82      (article-transform-function . nndoc-transform-clari-briefs))
  83     (mime-digest
  84      (article-begin . "")
  85      (head-end . "^ ?$")
  86      (body-end . "")
  87      (file-end . "")
  88      (subtype digest guess))
  89     (standard-digest
  90      (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
  91      (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
  92      (prepare-body-function . nndoc-unquote-dashes)
  93      (body-end-function . nndoc-digest-body-end)
  94      (head-end . "^ *$")
  95      (body-begin . "^ *\n")
  96      (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
  97      (subtype digest guess))
  98     (slack-digest
  99      (article-begin . "^------------------------------*[\n \t]+")
 100      (head-end . "^ ?$")
 101      (body-end-function . nndoc-digest-body-end)
 102      (body-begin . "^ ?$")
 103      (file-end . "^End of")
 104      (prepare-body-function . nndoc-unquote-dashes)
 105      (subtype digest guess))
 106     (lanl-gov-announce
 107      (article-begin . "^\\\\\\\\\n")
 108      (head-begin . "^Paper.*:")
 109      (head-end   . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
 110      (body-begin . "")
 111      (body-end   . "-------------------------------------------------")
 112      (file-end   . "^Title: Recent Seminal")
 113      (generate-head-function . nndoc-generate-lanl-gov-head)
 114      (article-transform-function . nndoc-transform-lanl-gov-announce)
 115      (subtype preprints guess))
 116     (rfc822-forward
 117      (article-begin . "^\n")
 118      (body-end-function . nndoc-rfc822-forward-body-end-function))
 119     (guess
 120      (guess . t)
 121      (subtype nil))
 122     (digest
 123      (guess . t)
 124      (subtype nil))
 125     (preprints
 126      (guess . t)
 127      (subtype nil))))
 128
 129 \f
 130
 131 (defvoo nndoc-file-begin nil)
 132 (defvoo nndoc-first-article nil)
 133 (defvoo nndoc-article-end 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-end nndoc-head-begin nndoc-head-end
 310                 nndoc-file-end nndoc-article-begin
 311                 nndoc-body-begin nndoc-body-end-function nndoc-body-end
 312                 nndoc-prepare-body-function nndoc-article-transform-function
 313                 nndoc-generate-head-function nndoc-body-begin-function
 314                 nndoc-head-begin-function)))
 315     (while vars
 316       (set (pop vars) nil)))
 317   (let (defs)
 318     ;; Guess away until we find the real file type.
 319     (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
 320                                               nndoc-type-alist))))
 321       (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
 322     ;; Set the nndoc variables.
 323     (while defs
 324       (set (intern (format "nndoc-%s" (caar defs)))
 325            (cdr (pop defs))))))
 326
 327 (defun nndoc-guess-type (subtype)
 328   (let ((alist nndoc-type-alist)
 329         results result entry)
 330     (while (and (not result)
 331                 (setq entry (pop alist)))
 332       (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
 333         (goto-char (point-min))
 334         (when (numberp (setq result (funcall (intern
 335                                               (format "nndoc-%s-type-p"
 336                                                       (car entry))))))
 337           (push (cons result entry) results)
 338           (setq result nil))))
 339     (unless (or result results)
 340       (error "Document is not of any recognized type"))
 341     (if result
 342         (car entry)
 343       (cadar (sort results 'car-less-than-car)))))
 344
 345 ;;;
 346 ;;; Built-in type predicates and functions
 347 ;;;
 348
 349 (defun nndoc-mbox-type-p ()
 350   (when (looking-at message-unix-mail-delimiter)
 351     t))
 352
 353 (defun nndoc-mbox-article-begin ()
 354   (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
 355     (goto-char (match-beginning 0))))
 356
 357 (defun nndoc-mbox-body-end ()
 358   (let ((beg (point))
 359         len end)
 360     (when
 361         (save-excursion
 362           (and (re-search-backward
 363                 (concat "^" message-unix-mail-delimiter) nil t)
 364                (setq end (point))
 365                (search-forward "\n\n" beg t)
 366                (re-search-backward
 367                 "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
 368                (setq len (string-to-int (match-string 1)))
 369                (search-forward "\n\n" beg t)
 370                (unless (= (setq len (+ (point) len)) (point-max))
 371                  (and (< len (point-max))
 372                       (goto-char len)
 373                       (looking-at message-unix-mail-delimiter)))))
 374       (goto-char len))))
 375
 376 (defun nndoc-mmdf-type-p ()
 377   (when (looking-at "\^A\^A\^A\^A$")
 378     t))
 379
 380 (defun nndoc-news-type-p ()
 381   (when (looking-at "^Path:.*\n")
 382     t))
 383
 384 (defun nndoc-rnews-type-p ()
 385   (when (looking-at "#! *rnews")
 386     t))
 387
 388 (defun nndoc-rnews-body-end ()
 389   (and (re-search-backward nndoc-article-begin nil t)
 390        (forward-line 1)
 391        (goto-char (+ (point) (string-to-int (match-string 1))))))
 392
 393 (defun nndoc-babyl-type-p ()
 394   (when (re-search-forward "\^_\^L *\n" nil t)
 395     t))
 396
 397 (defun nndoc-babyl-body-begin ()
 398   (re-search-forward "^\n" nil t)
 399   (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 400     (let ((next (or (save-excursion
 401                       (re-search-forward nndoc-article-begin nil t))
 402                     (point-max))))
 403       (unless (re-search-forward "^\n" next t)
 404         (goto-char next)
 405         (forward-line -1)
 406         (insert "\n")
 407         (forward-line -1)))))
 408
 409 (defun nndoc-babyl-head-begin ()
 410   (when (re-search-forward "^[0-9].*\n" nil t)
 411     (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
 412       (forward-line 1))
 413     t))
 414
 415 (defun nndoc-forward-type-p ()
 416   (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
 417              (not (re-search-forward "^Subject:.*digest" nil t))
 418              (not (re-search-backward "^From:" nil t 2))
 419              (not (re-search-forward "^From:" nil t 2)))
 420     t))
 421
 422 (defun nndoc-rfc934-type-p ()
 423   (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
 424              (not (re-search-forward "^Subject:.*digest" nil t))
 425              (not (re-search-backward "^From:" nil t 2))
 426              (not (re-search-forward "^From:" nil t 2)))
 427     t))
 428
 429 (defun nndoc-rfc822-forward-type-p ()
 430   (save-restriction
 431     (message-narrow-to-head)
 432     (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
 433       t)))
 434
 435 (defun nndoc-rfc822-forward-body-end-function ()
 436   (goto-char (point-max)))
 437
 438 (defun nndoc-clari-briefs-type-p ()
 439   (when (let ((case-fold-search nil))
 440           (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
 441     t))
 442
 443 (defun nndoc-transform-clari-briefs (article)
 444   (goto-char (point-min))
 445   (when (looking-at " *\\*\\(.*\\)\n")
 446     (replace-match "" t t))
 447   (nndoc-generate-clari-briefs-head article))
 448
 449 (defun nndoc-generate-clari-briefs-head (article)
 450   (let ((entry (cdr (assq article nndoc-dissection-alist)))
 451         subject from)
 452     (save-excursion
 453       (set-buffer nndoc-current-buffer)
 454       (save-restriction
 455         (narrow-to-region (car entry) (nth 3 entry))
 456         (goto-char (point-min))
 457         (when (looking-at " *\\*\\(.*\\)$")
 458           (setq subject (match-string 1))
 459           (when (string-match "[ \t]+$" subject)
 460             (setq subject (substring subject 0 (match-beginning 0)))))
 461         (when
 462             (let ((case-fold-search nil))
 463               (re-search-forward
 464                "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
 465           (setq from (match-string 1)))))
 466     (insert "From: " "clari@clari.net (" (or from "unknown") ")"
 467             "\nSubject: " (or subject "(no subject)") "\n")))
 468
 469 (defun nndoc-mime-digest-type-p ()
 470   (let ((case-fold-search t)
 471         boundary-id b-delimiter entry)
 472     (when (and
 473            (re-search-forward
 474             (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
 475                     "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
 476             nil t)
 477            (match-beginning 1))
 478       (setq boundary-id (match-string 1)
 479             b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
 480       (setq entry (assq 'mime-digest nndoc-type-alist))
 481       (setcdr entry
 482               (list
 483                (cons 'head-end "^ ?$")
 484                (cons 'body-begin "^ ?\n")
 485                (cons 'article-begin b-delimiter)
 486                (cons 'body-end-function 'nndoc-digest-body-end)
 487                (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
 488       t)))
 489
 490 (defun nndoc-standard-digest-type-p ()
 491   (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
 492              (re-search-forward
 493               (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
 494     t))
 495
 496 (defun nndoc-digest-body-end ()
 497   (and (re-search-forward nndoc-article-begin nil t)
 498        (goto-char (match-beginning 0))))
 499
 500 (defun nndoc-slack-digest-type-p ()
 501   0)
 502
 503 (defun nndoc-lanl-gov-announce-type-p ()
 504   (when (let ((case-fold-search nil))
 505           (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t))
 506     t))
 507
 508 (defun nndoc-transform-lanl-gov-announce (article)
 509   (goto-char (point-max))
 510   (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
 511     (replace-match "\n\nGet it at \\1 (\\2)" t nil))
 512   ;;  (when (re-search-backward "^\\\\\\\\$" nil t)
 513   ;;    (replace-match "" t t))
 514   )
 515
 516 (defun nndoc-generate-lanl-gov-head (article)
 517   (let ((entry (cdr (assq article nndoc-dissection-alist)))
 518         (e-mail "no address given")
 519         subject from)
 520     (save-excursion
 521       (set-buffer nndoc-current-buffer)
 522       (save-restriction
 523         (narrow-to-region (car entry) (nth 1 entry))
 524         (goto-char (point-min))
 525         (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)")
 526           (setq subject (concat " (" (match-string 1) ")"))
 527           (when (re-search-forward "^From: \\([^ ]+\\)" nil t)
 528             (setq e-mail (match-string 1)))
 529           (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
 530                                    nil t)
 531             (setq subject (concat (match-string 1) subject))
 532             (setq from (concat (match-string 2) " <" e-mail ">"))))
 533         ))
 534     (while (and from (string-match "(\[^)\]*)" from))
 535       (setq from (replace-match "" t t from)))
 536     (insert "From: "  (or from "unknown")
 537             "\nSubject: " (or subject "(no subject)") "\n")))
 538
 539 (deffoo nndoc-request-accept-article (group &optional server last)
 540   nil)
 541
 542
 543
 544 ;;;
 545 ;;; Functions for dissecting the documents
 546 ;;;
 547
 548 (defun nndoc-search (regexp)
 549   (prog1
 550       (re-search-forward regexp nil t)
 551     (beginning-of-line)))
 552
 553 (defun nndoc-dissect-buffer ()
 554   "Go through the document and partition it into heads/bodies/articles."
 555   (let ((i 0)
 556         (first t)
 557         head-begin head-end body-begin body-end)
 558     (setq nndoc-dissection-alist nil)
 559     (save-excursion
 560       (set-buffer nndoc-current-buffer)
 561       (goto-char (point-min))
 562       ;; Find the beginning of the file.
 563       (when nndoc-file-begin
 564         (nndoc-search nndoc-file-begin))
 565       ;; Go through the file.
 566       (while (if (and first nndoc-first-article)
 567                  (nndoc-search nndoc-first-article)
 568                (nndoc-article-begin))
 569         (setq first nil)
 570         (cond (nndoc-head-begin-function
 571                (funcall nndoc-head-begin-function))
 572               (nndoc-head-begin
 573                (nndoc-search nndoc-head-begin)))
 574         (if (or (>= (point) (point-max))
 575                 (and nndoc-file-end
 576                      (looking-at nndoc-file-end)))
 577             (goto-char (point-max))
 578           (setq head-begin (point))
 579           (nndoc-search (or nndoc-head-end "^$"))
 580           (setq head-end (point))
 581           (if nndoc-body-begin-function
 582               (funcall nndoc-body-begin-function)
 583             (nndoc-search (or nndoc-body-begin "^\n")))
 584           (setq body-begin (point))
 585           (or (and nndoc-body-end-function
 586                    (funcall nndoc-body-end-function))
 587               (and nndoc-body-end
 588                    (nndoc-search nndoc-body-end))
 589               (nndoc-article-begin)
 590               (progn
 591                 (goto-char (point-max))
 592                 (when nndoc-file-end
 593                   (and (re-search-backward nndoc-file-end nil t)
 594                        (beginning-of-line)))))
 595           (setq body-end (point))
 596           (push (list (incf i) head-begin head-end body-begin body-end
 597                       (count-lines body-begin body-end))
 598                 nndoc-dissection-alist))))))
 599
 600 (defun nndoc-article-begin ()
 601   (if nndoc-article-begin-function
 602       (funcall nndoc-article-begin-function)
 603     (ignore-errors
 604       (nndoc-search nndoc-article-begin))))
 605
 606 (defun nndoc-unquote-dashes ()
 607   "Unquote quoted non-separators in digests."
 608   (while (re-search-forward "^- -"nil t)
 609     (replace-match "-" t t)))
 610
 611 ;;;###autoload
 612 (defun nndoc-add-type (definition &optional position)
 613   "Add document DEFINITION to the list of nndoc document definitions.
 614 If POSITION is nil or `last', the definition will be added
 615 as the last checked definition, if t or `first', add as the
 616 first definition, and if any other symbol, add after that
 617 symbol in the alist."
 618   ;; First remove any old instances.
 619   (setq nndoc-type-alist
 620         (delq (assq (car definition) nndoc-type-alist)
 621               nndoc-type-alist))
 622   ;; Then enter the new definition in the proper place.
 623   (cond
 624    ((or (null position) (eq position 'last))
 625     (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
 626    ((or (eq position t) (eq position 'first))
 627     (push definition nndoc-type-alist))
 628    (t
 629     (let ((list (memq (assq position nndoc-type-alist)
 630                       nndoc-type-alist)))
 631       (unless list
 632         (error "No such position: %s" position))
 633       (setcdr list (cons definition (cdr list)))))))
 634
 635 (provide 'nndoc)
 636
 637 ;;; nndoc.el ends here