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