1 ;;; html-toc.el --- Building and updating TOC for a site
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: Wed Feb 01 14:40:13 2006
5 (defconst html-toc:version "0.4");; Version:
6 ;; Last-Updated: Tue Apr 10 04:09:29 2007 (7200 +0200)
10 ;; Features that might be required by this library:
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18 ;; Create table of contents for a static web site. See
19 ;; `html-toc-write-toc-file' and `html-toc-write-frames-file' for
22 ;; To use this you can add (require 'html-toc) to your .emacs.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 ;; This program is free software; you can redistribute it and/or modify
33 ;; it under the terms of the GNU General Public License as published by
34 ;; the Free Software Foundation; either version 2, or (at your option)
37 ;; This program is distributed in the hope that it will be useful,
38 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
39 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
40 ;; GNU General Public License for more details.
42 ;; You should have received a copy of the GNU General Public License
43 ;; along with this program; see the file COPYING. If not, write to the
44 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
45 ;; Boston, MA 02111-1307, USA.
47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 (eval-when-compile (require 'cl))
52 (eval-when-compile (add-to-list 'load-path default-directory load-path))
53 (eval-when-compile (require 'fupd nil t))
54 ;;(require 'html-move)
55 (eval-when-compile (require 'html-site nil t))
59 (defconst html-toc-mark-begin "<!-- html-toc START -->")
60 (defconst html-toc-mark-middle "<!-- html-toc MIDDLE -->")
61 (defconst html-toc-mark-end "<!-- html-toc END -->")
63 (defun html-toc-create-pages-file ()
64 "Write a list of pages to be used for table of contents.
65 Return the file name."
67 (html-site-current-ensure-site-defined)
69 (site-dir (html-site-current-site-dir))
70 (page-file (html-site-current-page-list))
71 (page-file-dir (file-name-directory page-file))
72 (page-file-exists (file-exists-p page-file))
73 (sub-files (html-site-get-sub-files
79 (sort (mapcar (lambda (full-file)
80 (assert (file-exists-p full-file))
81 (file-relative-name full-file page-file-dir))
84 ;;(setq sub-files (delete html-toc-file-default-name sub-files))
90 (dolist (file sub-files)
91 (setq full-file (expand-file-name file page-file-dir))
92 (setq dir-title (file-name-nondirectory
93 (substring (file-name-directory full-file) 0 -1)))
94 (setq title (html-toc-get-title full-file))
96 (mapc (lambda (c) (when (eq c ?/) (setq this-level (1+ this-level)))) file)
97 (insert (format "%s ### %s ### %s\n" this-level title file))))
98 (setq pages-text (buffer-string)))
99 (with-current-buffer (find-file page-file)
100 (if (string= pages-text (buffer-string))
101 (message "List of pages is already the default list")
102 (if (= 0 (length (buffer-string)))
107 (if (y-or-n-p "Replace old list of pages? ")
113 (message "Keeping old list of pages.")))))
115 (defun html-toc-dir ()
116 (let* ((this-file (if load-file-name
119 (this-dir (file-name-directory this-file))
121 (expand-file-name "html-toc" this-dir)))
124 (defgroup html-toc nil
125 "Customization group for html-toc."
128 (defcustom html-toc-template-file
129 (expand-file-name "html-toc-template.html" (html-toc-dir))
130 "Template file for table of contents file."
135 (defun html-toc-write-toc-file ()
136 "Write a table of contents for a web site.
137 Build the table of content from the information in
138 `html-site-current-page-list'. Write it to the file
139 `html-site-current-toc-file' and return that file name.
141 When viewed in a browser the table of contents can be
142 expanded/collapsed (if JavaScript is allowed)."
144 (html-site-current-ensure-site-defined)
145 (let* ((toc-file (html-site-current-toc-file))
146 (page-file (html-site-current-page-list))
149 (unless (< 0 (length toc-file))
150 (error "There is no name for the table of content file in site \"%s\""
152 (unless (< 0 (length page-file))
153 (error "There is no name for the pages file in site \"%s\""
156 (insert-file-contents page-file)
157 (goto-char (point-min))
159 (let* ((line (buffer-substring (point) (line-end-position)))
160 (line-parts (split-string line "\\s-+###\\s-+")))
161 (setq page-lines (cons line-parts page-lines)))
163 (setq page-lines (reverse page-lines))
165 (html-toc-insert-toc page-lines toc-file)
166 (setq toc (buffer-substring-no-properties (point-min) (point-max))))
167 (with-current-buffer (find-file-noselect toc-file)
169 (insert-file-contents-literally html-toc-template-file)
171 (while (search-forward "%%TOC%%" nil t)
173 (setq toc-start (match-beginning 0)))
174 (replace-match toc t t))
175 (forward-line) ;; for indentation
176 (indent-region toc-start (point-marker)))
177 (goto-char (point-min))
182 (defun html-toc-insert-toc (page-lines toc-file)
186 (site-directory (html-site-current-site-dir))
187 (toc-rel-file (file-relative-name toc-file site-directory)))
188 (dolist (line page-lines)
189 (let ((level (string-to-number (nth 0 line))))
190 (when (< level min-level)
191 (setq min-level level))))
192 (setq curr-level min-level)
194 (let* ((line (car page-lines))
197 (this-level (string-to-number (nth 0 line)))
200 (setq page-lines (cdr page-lines))
201 (let ((next-line (car page-lines)))
203 (string-to-number (nth 0 next-line))))))
204 (full-file (expand-file-name file site-directory))
205 (dir-title (file-name-nondirectory
206 (substring (file-name-directory full-file) 0 -1))))
207 ;;(insert "<!-- " (format "%s, %s, %s" curr-level this-level div-levels) " -->\n")
208 ;; Don't insert a link to the toc file
209 (unless (string= toc-rel-file file)
210 ;; If there are childs then insert a <div> before them. Save
211 ;; the level so we can close the div-tag later.
212 (when (< curr-level this-level)
213 ;; Save level so we can find the end of the <div>.
214 (setq div-levels (cons this-level div-levels))
215 (insert "<div class=\"html-toc-childs\">\n"))
216 ;; Close div-tags if this level is lower when the previous.
217 (when (> curr-level this-level)
218 (while (and div-levels
219 (> (car div-levels) this-level))
221 (setq div-levels (cdr div-levels))))
222 (setq curr-level this-level)
223 (insert "<div class=\"html-toc-link\">"
224 "<span style=\"display:table-cell; width:15em; background-color:yellow;\">"
225 "<a style=\"padding-left:" (number-to-string (1+ (- curr-level min-level))) "em;\" "
226 (format "href=\"%s\">%s</a>" file title)
228 (when (and next-level (> next-level this-level))
229 (insert "<span onclick=\"html_toc_hs(this)\" class=\"html-toc-hs\""
230 " style=\"display:table-cell; background-color:white;\">HS</span>"))
236 (setq div-levels (cdr div-levels)))))
238 (defun html-toc-get-title (file)
241 (insert-file-contents file nil 0 1000)
242 (goto-char (point-min))
243 (when (search-forward-regexp "<title>\\(.*\\)</title>" nil t)
246 (defun html-toc-parse-toc (toc-str)
250 (setq nodes (xml-parse-region (point-min) (point-max))))
253 (defun html-toc-get-hrefs (nodes)
254 (let ((atags (html-toc-get-atags nodes)))
255 (mapcar (lambda (atag)
256 (xml-get-attribute atag 'href))
258 (defun html-toc-get-atags (nodes)
262 (setq atags (append atags (xml-get-children node 'a)))
263 (setq atags (append atags (html-toc-get-atags (xml-node-children node))))))
267 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
268 ;;; Frames and viewing
269 (defcustom html-toc-frames-default-name "html-toc-frames.html"
270 "Default file name sans directory for frames file."
274 (defvar html-toc-frames-contents
275 "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>
276 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">
277 <html xmlns=\"http://www.w3.org/1999/xhtml\">
279 <title>Frames for html-toc</title>
281 <frameset cols=\"20%, 80%\">
282 <frame name=\"html-toc-TOC\" src=\"%%TOCFILE%%\"/>
283 <frame name=\"html-toc-Document\" />
286 Html frame support required
293 (defun html-toc-browse-frames-file ()
294 "View frames file written by `html-toc-write-frames-file'."
296 (html-site-current-ensure-site-defined)
297 (let ((frames-file (html-site-current-frames-file)))
298 (unless (< 0 (length frames-file))
299 (error "There is no frames file set for site \"%s\"" html-site-current))
300 ;;(message "frames-file=%s" frames-file)(sit-for 4)
301 (unless (file-exists-p frames-file)
302 (html-toc-write-frames-file))
303 (browse-url-of-file frames-file)))
305 ;; (defun html-toc-frames-file-name ()
306 ;; "Return name of file written by `html-toc-write-frames-file'."
307 ;; (html-toc-get-site)
308 ;; (expand-file-name html-toc-frames-default-name html-move-site-directory))
310 (defun html-toc-write-frames-file ()
311 "Write a frames file.
312 This frames file should load the table of contents build by
313 `html-toc-write-toc-file' in one frame and shows the documents in
316 The contents of the frames file is defined by
317 `html-toc-frames-contents'.
319 Returns the file name of the written or existing frames file.
321 You may also want to look at `html-wtoc-write-pages-with-toc'."
323 ;;(html-toc-get-site)
324 (html-site-current-ensure-site-defined)
325 (let* ((frames-file (html-site-current-frames-file))
326 (frames-cont html-toc-frames-contents)
327 (toc-file (html-toc-write-toc-file))
330 (setq toc-file-relative (file-relative-name
332 (file-name-directory frames-file)))
334 (unless (string-match "%%TOCFILE%%" frames-cont)
335 (error "Can't find %%TOCFILE%% in html-toc-frames-contents"))
336 (setq frames-cont (replace-match toc-file-relative t t frames-cont)))
337 (with-current-buffer (find-file-noselect frames-file)
344 (defconst html-toc-menu-map
345 (let ((map (make-sparse-keymap)))
346 (define-key map [html-toc-browse-frames-file]
347 (list 'menu-item "Browse Frames File" 'html-toc-browse-frames-file))
348 (define-key map [html-toc-write-frames-file]
349 (list 'menu-item "Write Frames File" 'html-toc-write-frames-file))
350 (define-key map [html-toc-write-toc-file]
351 (list 'menu-item "Write TOC File for Frames" 'html-toc-write-toc-file))
352 (define-key map [html-toc-sep1] (list 'menu-item "--"))
353 (define-key map [html-toc-edit-pages-file]
354 (list 'menu-item "Edit List of Pages for TOC" 'html-site-edit-pages-file))
355 (define-key map [html-toc-create-pages-file]
356 (list 'menu-item "Write List of Pages for TOC" 'html-toc-create-pages-file))
362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
363 ;;; html-toc.el ends here