Sender: rolfn@localhost Newsgroups: gnu.emacs.sources Subject: REPOST: html-toc.el create a table-of-contents in a html-document From: Rolf Rander Naess Organization: ProgramVareVerkstedet Message-ID: Date: 17 Mar 2001 20:02:10 -0800 Warning: the previous post of this module had a serious bug (name-conflict with a built-in function)! ;;; html-toc.el creates a table-of-contents on a html-document ;; Copyright (c) 2001 Rolf Rander Nęss ;; Author: Rolf Rander Nęss ;; Created: 17-Mar-2001 ;; Version: 0.1 ;; Keywords: html ;; X-URL: http://www.pvv.org/~rolfn/html-toc.el ;; This is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. This is distributed in the hope that it will be ;; useful, but without any warranty; without even the implied warranty ;; of merchantability or fitness for a particular purpose. See the ;; GNU General Public License for more details. You should have ;; received a copy of the GNU General Public License along with GNU ;; Emacs; see the file `COPYING'. If not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA ;; 02111-1307, USA. ;; Brief users guide: ;; ;; This package will create a table-of-contents in a HTML-document ;; based on tags. The toc will be placed between the ;; strings defined by *toc-open* and *toc-close*. If these doesn't ;; exist, it will be placed right after . If no -tag ;; exists, it will be put right before the first header. ;; Known bugs: ;; ;; - strange things will happen if your headers aren't valid (lack a ;; close-tag), but in this case your page will also look strange in a ;; browser... (defvar *head-open* "<[ \t\n]*[Hh]\\([1-3]\\)[ \t\n]*>") (defvar *head-close* "<[ \t\n]*/[ \t\n]*[Hh][1-3][ \t\n]*>") (defvar *a-name* "") (defvar *toc-open* "") (defvar *toc-close* "") (defvar *body-open* "<[ \t\n]*[Bb][Oo][Dd][Yy][ \t\n]*>") (defvar *list-open* "
    ") (defvar *list-close* "
") (defvar *list-item* "
  • ") (defun find-toc-position () (if (search-forward *toc-open* nil t) (let ((toc-start (point))) (if (search-forward *toc-close* nil t) (delete-region toc-start (match-beginning 0)) (insert *toc-close*)) (goto-char toc-start) (insert "\n")) (progn (goto-char (point-min)) (if (not (search-forward-regexp *body-open* nil t)) (progn (goto-char (point-min)) (search-forward-regexp *head-open* nil t) (goto-char (match-beginning 0)))) (insert *toc-open* "\n") (let ((p (point))) (insert *toc-close* "\n\n") (goto-char p))))) (defun build-toc () (let ((toc '())) (while (search-forward-regexp *head-open* nil t) (let* ((level (string-to-int (match-string 1))) (name (if (looking-at *a-name*) (progn (goto-char (match-end 0)) (match-string 1)) (let ((n (concat "tocref" (random)))) (insert "") n))) (head-start (point))) (search-forward-regexp *head-close* nil t) (push (list level name (buffer-substring head-start (match-beginning 0))) toc))) (nreverse toc))) (defun html-aref (name text) (concat "" text "")) (defun write-toc-level (toc cur-level) (if toc (let* ((entry (car toc)) (level (car entry)) (name (cadr entry)) (text (caddr entry)) (rest (cdr toc))) (cond ((> level cur-level) (insert *list-open* "\n") (setq rest (write-toc-level toc (1+ cur-level))) (insert *list-close* "\n") (write-toc-level rest cur-level)) ((= level cur-level) (insert *list-item* (html-aref name text) "\n") (write-toc-level rest cur-level)) ((< level cur-level) toc))))) (defun write-toc (toc) (insert "

    Table of Contents

    \n") (write-toc-level toc 0)) (defun html-toc () (interactive) (save-excursion (goto-char (point-min)) (find-toc-position) (let ((toc-pos (point)) (toc (progn (goto-char (point-min)) (build-toc)))) (goto-char toc-pos) (write-toc toc)))) (provide 'html-toc)