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

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