;;; faq-o-mat.el --- Generate TOC for FAQs ;; Copyright (C) 2003 Sascha Wilde ;; $Id: faq-o-mat.el,v 0.4 2003/07/20 14:30:14 wilde Exp $ ;; This file 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 file 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. (defvar faq-toc-start-regex "^#[\t ]+Inhalt:[\t ]*" "*This is a regex matching the beginning of the table of contest") (defvar faq-header-regex "[0-9]+\\.[\t ]+\\w+.*" "*This is a regex matching a header") (defvar faq-subheader-regex "[0-9]+\\.[0-9.]+[\t ]+\\w+[^\\?]*\\?" "*This is a regex matching a subheader") (defvar faq-html-header " FAQ \n" "*This is the header insert during HTML generation") (defvar faq-html-footer "\n " "*This is the footer insert during HTML generation") (defun faq-insert-toc (faq-toc) (if (null faq-toc) (insert "\n\n") (let ((line (concat (car faq-toc) "\n"))) (insert line) (faq-insert-toc (cdr faq-toc))))) (defun faq-generate-toc () "Generates a table of contents based upon the marks in the buffer as defined by ####" (interactive) (save-excursion (save-match-data (save-restriction (widen) (let ((faq-toc '("\n")) (faq-any-header-regex (concat "^\n\\(" faq-header-regex "\\|" faq-subheader-regex "\\)\n$"))) (goto-char (point-min)) (while (re-search-forward faq-any-header-regex nil t) (setq faq-toc (append faq-toc (list (match-string 1))))) (goto-char (point-min)) (re-search-forward faq-toc-start-regex nil t) (save-excursion (delete-region (point) (progn (re-search-forward faq-any-header-regex nil t) (match-beginning 0)))) (faq-insert-toc faq-toc)))))) (defun faq-generate-html-toc () "Generates a html table of contents based upon the marks in the buffer as defined by ####" (save-excursion (save-match-data (save-restriction (widen) (let ((faq-toc '("\n

")) (faq-any-header-regex (concat ""))) (goto-char (point-min)) (while (re-search-forward faq-any-header-regex nil t) (setq faq-toc (append faq-toc (list (concat "" (match-string 2) "
"))))) (goto-char (point-min)) (re-search-forward faq-toc-start-regex nil t) (save-excursion (delete-region (point) (progn (re-search-forward faq-any-header-regex nil t) (match-beginning 0)))) (faq-insert-toc (append faq-toc (list "

")))))))) (defun faq-goto-next-header (arg) (interactive "p") (save-match-data (and (if (< arg 0) (progn (beginning-of-line) (re-search-backward faq-header-regex nil t)) (progn (end-of-line) (re-search-forward faq-header-regex nil t))) (goto-char (match-end 0))))) (defun faq-goto-prev-header () (faq-goto-next-header -1)) (defun faq-generate-html () (interactive) (let ((html-buffer (generate-new-buffer "faq.html")) (old-buffer (current-buffer))) (switch-to-buffer html-buffer) (insert faq-html-header) (insert "\n

")
    (let ((start-point (point)))
      (insert-buffer-substring old-buffer)
      ;; change html donots to entities
      (goto-char start-point)
      (while (re-search-forward "&" nil t)
	(replace-match "&"))
      (goto-char start-point)
      (while (re-search-forward "<" nil t)
	(replace-match "<"))
      (goto-char start-point)
      (while (re-search-forward ">" nil t)
	(replace-match ">")))
    (goto-char (point-max))
    (insert faq-html-footer)
    (goto-char (point-min))
    (re-search-forward faq-toc-start-regex)
    (goto-char (match-beginning 0))
    (insert "
\n") ;; mark headers (let ((num 1) (faq-ext-header-regex (concat "^\n\\(" faq-header-regex "\\)\n$"))) (goto-char (point-min)) (while (re-search-forward faq-ext-header-regex nil t) (replace-match (concat "

" (match-string 1) "

")) (setq num (1+ num)))) (let ((num 1) (faq-ext-header-regex (concat "^\n\\(" faq-subheader-regex "\\)\n$"))) (goto-char (point-min)) (while (re-search-forward faq-ext-header-regex nil t) (replace-match (concat "

" (match-string 1) "

")) (setq num (1+ num)))) ;; generate TOC (faq-generate-html-toc) ;; insert paragraph breaks (goto-char (point-min)) (while (re-search-forward "\\([^>\\s ]\\)\n\n\\([^<\\s ]\\)" nil t) (replace-match (concat (match-string 1) "

\n" (match-string 2)))) ;; insert url-links breaks (goto-char (point-min)) (while (re-search-forward "\\(http\\|ftp\\)://[^ \t\n]+" nil t) (replace-match (concat "" (match-string 0) ""))) (goto-char (point-min))))