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

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