nxhtml/nxhtml/html-toc.el

   1 ;;; html-toc.el --- Building and updating TOC for a site
   2 ;;
   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)
   7 ;; Keywords:
   8 ;; Compatibility:
   9 ;;
  10 ;; Features that might be required by this library:
  11 ;;
  12 ;;   None
  13 ;;
  14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15 ;;
  16 ;;; Commentary:
  17 ;;
  18 ;;  Create table of contents for a static web site.  See
  19 ;;  `html-toc-write-toc-file' and `html-toc-write-frames-file' for
  20 ;;  more info.
  21 ;;
  22 ;;  To use this you can add (require 'html-toc) to your .emacs.
  23 ;;
  24 ;;
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;;; Change log:
  28 ;;
  29 ;;
  30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31 ;;
  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)
  35 ;; any later version.
  36 ;;
  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.
  41 ;;
  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.
  46 ;;
  47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48 ;;
  49 ;;; Code:
  50
  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))
  56 ;;(require 'dom)
  57 (require 'xml)
  58
  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 -->")
  62
  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."
  66   (interactive)
  67   (html-site-current-ensure-site-defined)
  68   (let* (
  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
  74                      site-dir
  75                      html-site-files-re))
  76          (pages-text)
  77          )
  78     (setq sub-files
  79           (sort (mapcar (lambda (full-file)
  80                           (assert (file-exists-p full-file))
  81                           (file-relative-name full-file page-file-dir))
  82                         sub-files)
  83                 'string<))
  84     ;;(setq sub-files (delete html-toc-file-default-name sub-files))
  85     (with-temp-buffer
  86       (let ((this-level)
  87             (dir-title)
  88             (title)
  89             (full-file))
  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))
  95           (setq this-level 0)
  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)))
 103             (progn
 104               (insert pages-text)
 105               (save-buffer)
 106               )
 107           (if (y-or-n-p "Replace old list of pages? ")
 108               (progn
 109                 (erase-buffer)
 110                 (insert pages-text)
 111                 (save-buffer)
 112                 )
 113             (message "Keeping old list of pages.")))))
 114     page-file))
 115 (defun html-toc-dir ()
 116   (let* ((this-file (if load-file-name
 117                        load-file-name
 118                       buffer-file-name))
 119          (this-dir (file-name-directory this-file))
 120          )
 121     (expand-file-name "html-toc" this-dir)))
 122
 123 ;;;###autoload
 124 (defgroup html-toc nil
 125   "Customization group for html-toc."
 126   :group 'nxhtml)
 127
 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."
 131   :type 'file
 132   :group 'html-toc)
 133
 134
 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.
 140
 141 When viewed in a browser the table of contents can be
 142 expanded/collapsed (if JavaScript is allowed)."
 143   (interactive)
 144   (html-site-current-ensure-site-defined)
 145   (let* ((toc-file (html-site-current-toc-file))
 146          (page-file (html-site-current-page-list))
 147          page-lines
 148          toc)
 149     (unless (< 0 (length toc-file))
 150       (error "There is no name for the table of content file in site \"%s\""
 151              html-site-current))
 152     (unless (< 0 (length page-file))
 153       (error "There is no name for the pages file in site \"%s\""
 154              html-site-current))
 155       (with-temp-buffer
 156         (insert-file-contents page-file)
 157         (goto-char (point-min))
 158         (while (not (eobp))
 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)))
 162           (forward-line)))
 163       (setq page-lines (reverse page-lines))
 164       (with-temp-buffer
 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)
 168         (erase-buffer)
 169         (insert-file-contents-literally html-toc-template-file)
 170         (let (toc-start)
 171           (while (search-forward "%%TOC%%" nil t)
 172             (unless toc-start
 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))
 178         (save-buffer))
 179       toc-file))
 180
 181
 182 (defun html-toc-insert-toc (page-lines toc-file)
 183   (let* ((curr-level)
 184          (min-level 100)
 185          div-levels
 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)
 193     (while page-lines
 194       (let* ((line (car page-lines))
 195              (file (nth 2 line))
 196              (title (nth 1 line))
 197              (this-level (string-to-number (nth 0 line)))
 198              (next-level (progn
 199                           ;; Note:
 200                            (setq page-lines (cdr page-lines))
 201                            (let ((next-line (car page-lines)))
 202                              (when next-line
 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))
 220               (insert "</div>\n")
 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)
 227                   "</span>")
 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>"))
 231           (insert "</div>"
 232                   "\n")
 233           )))
 234     (while div-levels
 235       (insert "</div>\n")
 236       (setq div-levels (cdr div-levels)))))
 237
 238 (defun html-toc-get-title (file)
 239   (save-excursion
 240     (with-temp-buffer
 241       (insert-file-contents file nil 0 1000)
 242       (goto-char (point-min))
 243       (when (search-forward-regexp "<title>\\(.*\\)</title>" nil t)
 244         (match-string 1)))))
 245
 246 (defun html-toc-parse-toc (toc-str)
 247   (let ((nodes))
 248     (with-temp-buffer
 249       (insert toc-str)
 250       (setq nodes (xml-parse-region (point-min) (point-max))))
 251     ))
 252
 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))
 257             atags)))
 258 (defun html-toc-get-atags (nodes)
 259   (let ((atags))
 260     (dolist (node nodes)
 261       (when (listp node)
 262         (setq atags (append atags (xml-get-children node 'a)))
 263         (setq atags (append atags (html-toc-get-atags (xml-node-children node))))))
 264     atags))
 265
 266
 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."
 271   :type 'string
 272   :group 'html-toc)
 273
 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\">
 278   <head>
 279     <title>Frames for html-toc</title>
 280   </head>
 281   <frameset cols=\"20%, 80%\">
 282     <frame name=\"html-toc-TOC\" src=\"%%TOCFILE%%\"/>
 283     <frame name=\"html-toc-Document\" />
 284     <noframes>
 285       <body>
 286         Html frame support required
 287       </body>
 288     </noframes>
 289   </frameset>
 290 </html>
 291 ")
 292
 293 (defun html-toc-browse-frames-file ()
 294   "View frames file written by `html-toc-write-frames-file'."
 295   (interactive)
 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)))
 304
 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))
 309
 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
 314 another.
 315
 316 The contents of the frames file is defined by
 317 `html-toc-frames-contents'.
 318
 319 Returns the file name of the written or existing frames file.
 320
 321 You may also want to look at `html-wtoc-write-pages-with-toc'."
 322   (interactive)
 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))
 328          toc-file-relative)
 329     (when toc-file
 330       (setq toc-file-relative (file-relative-name
 331                                toc-file
 332                                (file-name-directory frames-file)))
 333       (save-match-data
 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)
 338         (erase-buffer)
 339         (insert frames-cont)
 340         (save-buffer))
 341       frames-file)))
 342
 343 ;;;###autoload
 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))
 357     map))
 358
 359
 360
 361 (provide 'html-toc)
 362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 363 ;;; html-toc.el ends here