1 ;;; html-pagetoc.el --- Insert/rebuild table of contents for html page
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
5 ;; Last-Updated: Sat Apr 21 14:11:13 2007 (7200 +0200)
6 (defconst html-pagetoc:version "0.85") ;; Version:
7 ;; Keywords: tools hypermedia html
8 ;; Features that might be required by this library:
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15 ;; This file is not part of Emacs
17 ;; This program is free software; you can redistribute it and/or
18 ;; modify it under the terms of the GNU General Public License as
19 ;; published by the Free Software Foundation; either version 2, or (at
20 ;; your option) any later version.
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 ;; General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with this program; see the file COPYING. If not, write to
29 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
30 ;; Boston, MA 02111-1307, USA.
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;; html-pagetoc.el has functions for building (and rebuilding) a
37 ;; simple table of contents for a single html file. It is supposed to
38 ;; be a quick tool for this. The table of contents are made from the
39 ;; header tags (H1, H2, H3 etc). If you have ID attributes on the
40 ;; header the table of contents will have links to those. Otherwise it
43 ;; To use this module put it in emacs load-path and enter the line
44 ;; below in your .emacs:
46 ;; (require 'html-pagetoc)
48 ;; When editing a html file put your cursor where you want the table
49 ;; of contents and do M-x html-pagetoc-insert-toc.
51 ;; To rebuild the table of contents use M-x html-pagetoc-rebuild-toc.
52 ;; If you want to add styles to it you can use M-x
53 ;; html-pagetoc-insert-style-guide.
56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 ;;(define-key global-map [f2] 'eval-buffer)
61 ;;(define-key global-map [f3] 'html-pagetoc-insert-toc)
64 (defgroup html-pagetoc nil
65 "Html page local table of contents settings"
69 (defcustom html-pagetoc-tocheads
71 ("" . "On THIS Page:")
73 "Head titles for table of contents.
74 The titles are put above the table of contents.
76 The value of this variable should be a list of cons cells where
77 the car is a regexp to match against file names and the cdr is
78 the head title to use. The first match in the list is used. If
79 there is no match then no head title is inserted."
80 :type '(repeat (cons regexp string))
83 (defcustom html-pagetoc-min 1
84 "Default for min header level"
87 (make-variable-buffer-local 'html-pagetoc-min)
89 (defcustom html-pagetoc-max 3
90 "Default for max header level"
93 (make-variable-buffer-local 'html-pagetoc-max)
95 (defconst html-pagetoc-begin-cmnt "<!-- Table of contents BEGIN -->\n")
96 (defconst html-pagetoc-end-cmnt "<!-- END of Table of contents -->\n")
97 (defconst html-pagetoc-maxmin-cmnt "<!-- Table of contents min=%s max=%s -->\n")
99 ;;(defconst html-pagetoc-buffers nil)
101 (defun html-pagetoc-get-title (filename)
102 "Find the head title for filename.
103 See `html-pagetoc-tocheads'."
105 (let ((ths html-pagetoc-tocheads)
109 (while (and ths (not header))
113 (when (string-match re filename)
114 (setq header (cdr th))))
118 (defun html-pagetoc-insert-toc (&optional min-level max-level)
119 "Inserts a table of contents for the current html file.
120 The html header tags h1-h6 found in the file are inserted into
121 this table. MIN-LEVEL and MAX-LEVEL specifies the minimum and
122 maximum level of h1-h6 to include. They should be integers."
123 (interactive (let* ((maxstr)
126 (prmax (format "Max header level (%s): " html-pagetoc-max))
127 (prmax2 (concat "Please give an integer 1-5. " prmax))
128 (prmin "Include header level 1? ")
131 (setq maxstr (read-string prmax))
132 (if (equal maxstr "")
133 (setq max html-pagetoc-max)
134 (when (not (string-match "\\." maxstr))
135 (setq max (string-to-number maxstr)) ))
136 (when (> max 5) (setq max 0))
137 (when (< max 0) (setq max 0))
138 (setq prmax prmax2) )
140 (when (not (y-or-n-p prmin)) (setq min 2)))
143 (let* ((curr-buffer (current-buffer))
144 (header (html-pagetoc-get-title (buffer-file-name)))
145 (toc-buffer (get-buffer-create "*html-pagetoc*"))
147 (buffer-val (cons (buffer-file-name) (list min-level max-level)))
149 (setq html-pagetoc-min min-level)
150 (setq html-pagetoc-max max-level)
151 (with-current-buffer toc-buffer (erase-buffer))
153 (insert-buffer-substring curr-buffer)
154 ;;(replace-regexp "<!--.*?-->" "")
156 (goto-char (point-min))
157 (while (re-search-forward "<!--.*?-->" nil t)
158 (replace-match "" nil nil))
159 (goto-char (point-min))
160 (let ((b (current-buffer))
161 (standard-output toc-buffer)
162 (level (- min-level 1))
163 (skip-level (- min-level 1))
166 (princ html-pagetoc-begin-cmnt)
168 html-pagetoc-maxmin-cmnt
171 (princ "<table id=\"PAGETOC\"><tr><td>\n")
173 (princ "<span class=\"tochead\">")
176 (while (re-search-forward
177 (concat "\\(?:<h\\([1-9]\\)\\([^>]*\\)>\\(.*?\\)</h[1-9]>"
179 "<!--\\(?:.\\|\n\\)-->\\)")
181 (let ((m0 (match-string 0))
182 (m1 (match-string 1))
183 (m2 (match-string 2))
184 (title (match-string 3))
189 (setq new-level (string-to-number m1))
190 (when (and (<= new-level max-level) (<= min-level new-level))
191 (setq prev-level level)
192 (setq level new-level)
193 (while (< prev-level level)
194 (princ (make-string (* (- prev-level skip-level) 4) 32))
195 ;; class liul is a fix for a problem in IE
196 (when (> prev-level (- min-level 1)) (princ "<li class=\"liul\">"))
198 (setq prev-level (+ prev-level 1)))
199 (while (> prev-level level)
200 (princ (make-string (* (- prev-level skip-level) 4) 32))
201 (princ "</ul></li>\n")(setq prev-level (- prev-level 1)))
202 (when (nth 3 (match-data t))
203 (when (string-match "id=\"\\([^\"]*\\)\"" m2)
204 (setq id (substring m2 (match-beginning 1) (match-end 1)))))
205 (princ (make-string (* (- level skip-level) 4) 32))
208 (princ (format "<a href=\"#%s\">%s</a>" id title))
212 (while (> level (- min-level 1))
213 (setq level (- level 1))
214 (princ (concat (make-string (* (- level skip-level) 4) 32) "</ul>"))
215 (when (> level (- min-level 1)) (princ "</li>"))
217 (princ "</td></tr></table>\n")
218 (princ html-pagetoc-end-cmnt)
219 (with-current-buffer toc-buffer
220 (setq toc (buffer-string)))
225 (when (re-search-forward "<body.*?>" nil t)
229 (let ((start (copy-marker (region-beginning)))
230 (end (copy-marker (region-end))))
231 (indent-region (region-beginning) (region-end) nil)
234 (setq deactivate-mark nil)
235 (message "Toc created"))
239 (defun html-pagetoc-insert-style-guide ()
240 "Inserts a style tag for toc inserted by `html-pagetoc-insert-toc'.
241 This can be used as a guide for creating your own style sheet for
242 the table of contents."
244 (goto-char (point-min))
245 (unless (re-search-forward "^\\s-*</head>")
246 (error "%s" "Can not find ^\\s-*</head>"))
250 (insert "<!-- Style for the table of contents. -->\n")
251 (insert "<style type=\"text/css\">\n")
252 (insert "#PAGETOC {\n")
253 (insert " background-color: #df7;\n")
254 (insert " padding: 0.5em;\n")
256 ;;(insert "#PAGETOC strong { color: #ac4; }\n")
257 (insert "#PAGETOC a { color: maroon; display: block; }\n")
258 (insert "#PAGETOC a:hover { background-color: yellow; }\n")
259 (insert "#PAGETOC ul {\n")
260 (insert " list-style-type: none;\n")
261 (insert " margin-left: 0;\n")
262 (insert " padding-left: 1.5em;\n")
264 (insert "#PAGETOC ul li { font-weight: bold; }\n")
265 (insert "#PAGETOC ul li ul { }\n")
266 (insert "#PAGETOC ul li ul li { font-weight: normal;}\n")
267 (insert "#PAGETOC .liul {\n")
268 (insert " //display:inline; /* IE fix */\n")
270 (insert "#PAGETOC .tochead {\n")
271 (insert " font-weight: bold;\n")
272 (insert " margin-bottom: 0.5em;\n")
274 (insert "</style>\n")
276 (let ((start (copy-marker (region-beginning)))
277 (end (copy-marker (region-end))))
278 (indent-region (region-beginning) (region-end) nil)
281 (setq deactivate-mark nil)
282 (message "Please edit the style guide!")
286 (defun html-pagetoc-rebuild-toc ()
287 "Update the table of contents inserted by `html-pagetoc-insert-toc'."
289 (let* (;;(old-val (assoc (buffer-file-name) html-pagetoc-buffers))
290 ;;(old-min (nth 1 old-val))
291 ;;(old-max (nth 2 old-val))
292 (old-min html-pagetoc-min)
293 (old-max html-pagetoc-max)
295 (goto-char (point-min))
296 (if (not (search-forward html-pagetoc-begin-cmnt nil t))
297 (when (y-or-n-p "Could not find table of contents. Insert one here? ")
298 (html-pagetoc-insert-toc))
301 (let ((minmax-patt (format html-pagetoc-maxmin-cmnt "\\([[:alnum:]]+\\)" "\\([[:alnum:]]+\\)")))
303 (when (search-forward-regexp minmax-patt nil t)
304 (setq old-min (string-to-number (match-string 1)))
305 (setq old-max (string-to-number (match-string 2))))))
306 (let ((start-toc (point)))
307 (when (search-forward html-pagetoc-end-cmnt)
309 (let ((end-toc (point)))
312 (when (y-or-n-p "Rebuild this TOC? ")
313 ;;(unless old-min (setq old-min 1))
314 (setq old-min (eval-minibuffer "Min TOC level: " (format "%s" old-min)))
315 ;;(unless old-max (setq old-max 3))
316 (setq old-max (eval-minibuffer "Max TOC level: " (format "%s" old-max)))
317 (delete-region start-toc end-toc)
318 (html-pagetoc-insert-toc old-min old-max ))))))))
321 (defconst html-pagetoc-menu-map
322 (let ((map (make-sparse-keymap)))
323 (define-key map [html-pagetoc-rebuild-toc]
324 (list 'menu-item "Update Page TOC" 'html-pagetoc-rebuild-toc))
325 (define-key map [html-pagetoc-insert-style-guide]
326 (list 'menu-item "Insert CSS Style for Page TOC" 'html-pagetoc-insert-style-guide))
327 (define-key map [html-pagetoc-insert-toc]
328 (list 'menu-item "Insert Page TOC" 'html-pagetoc-insert-toc))
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
334 (provide 'html-pagetoc)
336 ;;; html-pagetoc.el ends here