emacs/nxhtml/nxhtml/html-pagetoc.el

   1 ;;; html-pagetoc.el --- Insert/rebuild table of contents for html page
   2 ;;
   3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
   4 ;; Created: 2005-08-03
   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:
   9 ;;
  10 ;;   None
  11 ;;
  12
  13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14 ;;
  15 ;; This file is not part of Emacs
  16
  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.
  21
  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.
  26
  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.
  31
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33 ;;
  34 ;;; Commentary:
  35
  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
  41 ;; is just text.
  42
  43 ;; To use this module put it in emacs load-path and enter the line
  44 ;; below in your .emacs:
  45 ;;
  46 ;;    (require 'html-pagetoc)
  47 ;;
  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.
  50 ;;
  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.
  54 ;;
  55
  56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  57 ;;
  58 ;;; Code:
  59
  60 ;;(define-key global-map [f2] 'eval-buffer)
  61 ;;(define-key global-map [f3] 'html-pagetoc-insert-toc)
  62
  63 ;;;###autoload
  64 (defgroup html-pagetoc nil
  65   "Html page local table of contents settings"
  66   :group 'nxhtml
  67   :group 'hypermedia)
  68
  69 (defcustom html-pagetoc-tocheads
  70   '(
  71     ("" . "On THIS Page:")
  72     )
  73   "Head titles for table of contents.
  74 The titles are put above the table of contents.
  75
  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))
  81   :group 'html-pagetoc)
  82
  83 (defcustom html-pagetoc-min 1
  84   "Default for min header level"
  85   :type 'integer
  86   :group 'html-pagetoc)
  87 (make-variable-buffer-local 'html-pagetoc-min)
  88
  89 (defcustom html-pagetoc-max 3
  90   "Default for max header level"
  91   :type 'integer
  92   :group 'html-pagetoc)
  93 (make-variable-buffer-local 'html-pagetoc-max)
  94
  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")
  98
  99 ;;(defconst html-pagetoc-buffers nil)
 100
 101 (defun html-pagetoc-get-title (filename)
 102   "Find the head title for filename.
 103 See `html-pagetoc-tocheads'."
 104   (when filename
 105     (let ((ths html-pagetoc-tocheads)
 106           th
 107           re
 108           header)
 109       (while (and ths (not header))
 110         (setq th (car ths))
 111         (setq ths (cdr ths))
 112         (setq re (car th))
 113         (when (string-match re filename)
 114           (setq header (cdr th))))
 115       header)))
 116
 117 ;;;###autoload
 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)
 124                        (max 0)
 125                        (min 1)
 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? ")
 129                        )
 130                   (while (= max 0)
 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) )
 139                   (when (> max 1)
 140                     (when (not (y-or-n-p prmin)) (setq min 2)))
 141                   (list min max)))
 142
 143   (let* ((curr-buffer (current-buffer))
 144          (header (html-pagetoc-get-title (buffer-file-name)))
 145          (toc-buffer (get-buffer-create "*html-pagetoc*"))
 146          (toc)
 147          (buffer-val (cons (buffer-file-name) (list min-level max-level)))
 148         )
 149     (setq html-pagetoc-min min-level)
 150     (setq html-pagetoc-max max-level)
 151     (with-current-buffer toc-buffer (erase-buffer))
 152     (with-temp-buffer
 153       (insert-buffer-substring curr-buffer)
 154       ;;(replace-regexp "<!--.*?-->" "")
 155       (save-excursion
 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))
 164               (prev-level)
 165               )
 166           (princ html-pagetoc-begin-cmnt)
 167           (princ (format
 168                   html-pagetoc-maxmin-cmnt
 169                   min-level
 170                   max-level))
 171           (princ "<table id=\"PAGETOC\"><tr><td>\n")
 172           (when header
 173             (princ "<span class=\"tochead\">")
 174             (princ header)
 175             (princ "</span>\n"))
 176           (while (re-search-forward
 177                   (concat "\\(?:<h\\([1-9]\\)\\([^>]*\\)>\\(.*?\\)</h[1-9]>"
 178                           "\\|"
 179                           "<!--\\(?:.\\|\n\\)-->\\)")
 180                   nil t)
 181             (let ((m0 (match-string 0))
 182                   (m1 (match-string 1))
 183                   (m2 (match-string 2))
 184                   (title (match-string 3))
 185                   (id)
 186                   (new-level)
 187                   )
 188             (unless (not m1)
 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\">"))
 197                   (princ "<ul>\n")
 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))
 206                 (princ "<li>")
 207                 (if id
 208                     (princ (format "<a href=\"#%s\">%s</a>" id title))
 209                   (princ title))
 210                 (princ "</li>\n")
 211                 ))))
 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>"))
 216             (princ "\n"))
 217           (princ "</td></tr></table>\n")
 218           (princ html-pagetoc-end-cmnt)
 219           (with-current-buffer toc-buffer
 220             (setq toc (buffer-string)))
 221           )
 222         ) ; save-excursion
 223       ) ; with-temp-buffer
 224     (when toc
 225       (when (re-search-forward "<body.*?>" nil t)
 226         (forward-line))
 227       (set-mark (point))
 228       (insert toc)
 229       (let ((start (copy-marker (region-beginning)))
 230             (end (copy-marker (region-end))))
 231         (indent-region (region-beginning) (region-end) nil)
 232         (set-mark start)
 233         (goto-char end))
 234       (setq deactivate-mark nil)
 235       (message "Toc created"))
 236     )
 237   )
 238
 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."
 243   (interactive)
 244   (goto-char (point-min))
 245   (unless (re-search-forward "^\\s-*</head>")
 246     (error "%s" "Can not find ^\\s-*</head>"))
 247   (beginning-of-line)
 248   (set-mark (point))
 249   (insert "\n")
 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")
 255   (insert "}\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")
 263   (insert "}\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")
 269   (insert "}\n")
 270   (insert "#PAGETOC .tochead {\n")
 271   (insert "    font-weight: bold;\n")
 272   (insert "    margin-bottom: 0.5em;\n")
 273   (insert "}\n")
 274   (insert "</style>\n")
 275   (insert "\n")
 276   (let ((start (copy-marker (region-beginning)))
 277         (end (copy-marker (region-end))))
 278     (indent-region (region-beginning) (region-end) nil)
 279     (set-mark start)
 280     (goto-char end))
 281   (setq deactivate-mark nil)
 282   (message "Please edit the style guide!")
 283   )
 284
 285 ;;;###autoload
 286 (defun html-pagetoc-rebuild-toc ()
 287   "Update the table of contents inserted by `html-pagetoc-insert-toc'."
 288   (interactive)
 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)
 294          )
 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))
 299       (backward-char 4)
 300       (beginning-of-line)
 301       (let ((minmax-patt (format html-pagetoc-maxmin-cmnt "\\([[:alnum:]]+\\)" "\\([[:alnum:]]+\\)")))
 302         (save-excursion
 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)
 308           (beginning-of-line)
 309           (let ((end-toc (point)))
 310             (set-mark start-toc)
 311             (goto-char end-toc)
 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 ))))))))
 319
 320 ;;;###autoload
 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))
 329     map))
 330
 331
 332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 333 ;;;;;; Ready:
 334 (provide 'html-pagetoc)
 335
 336 ;;; html-pagetoc.el ends here