diff options
Diffstat (limited to 'emacs.d/nxhtml/nxhtml/html-pagetoc.el')
| -rw-r--r-- | emacs.d/nxhtml/nxhtml/html-pagetoc.el | 336 |
1 files changed, 336 insertions, 0 deletions
diff --git a/emacs.d/nxhtml/nxhtml/html-pagetoc.el b/emacs.d/nxhtml/nxhtml/html-pagetoc.el new file mode 100644 index 0000000..adcdcb7 --- /dev/null +++ b/emacs.d/nxhtml/nxhtml/html-pagetoc.el @@ -0,0 +1,336 @@ +;;; html-pagetoc.el --- Insert/rebuild table of contents for html page +;; +;; Author: Lennart Borgman (lennart O borgman A gmail O com) +;; Created: 2005-08-03 +;; Last-Updated: Sat Apr 21 14:11:13 2007 (7200 +0200) +(defconst html-pagetoc:version "0.85") ;; Version: +;; Keywords: tools hypermedia html +;; Features that might be required by this library: +;; +;; None +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This file is not part of Emacs + +;; This program 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 program 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 this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; html-pagetoc.el has functions for building (and rebuilding) a +;; simple table of contents for a single html file. It is supposed to +;; be a quick tool for this. The table of contents are made from the +;; header tags (H1, H2, H3 etc). If you have ID attributes on the +;; header the table of contents will have links to those. Otherwise it +;; is just text. + +;; To use this module put it in emacs load-path and enter the line +;; below in your .emacs: +;; +;; (require 'html-pagetoc) +;; +;; When editing a html file put your cursor where you want the table +;; of contents and do M-x html-pagetoc-insert-toc. +;; +;; To rebuild the table of contents use M-x html-pagetoc-rebuild-toc. +;; If you want to add styles to it you can use M-x +;; html-pagetoc-insert-style-guide. +;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +;;(define-key global-map [f2] 'eval-buffer) +;;(define-key global-map [f3] 'html-pagetoc-insert-toc) + +;;;###autoload +(defgroup html-pagetoc nil + "Html page local table of contents settings" + :group 'nxhtml + :group 'hypermedia) + +(defcustom html-pagetoc-tocheads + '( + ("" . "On THIS Page:") + ) + "Head titles for table of contents. +The titles are put above the table of contents. + +The value of this variable should be a list of cons cells where +the car is a regexp to match against file names and the cdr is +the head title to use. The first match in the list is used. If +there is no match then no head title is inserted." + :type '(repeat (cons regexp string)) + :group 'html-pagetoc) + +(defcustom html-pagetoc-min 1 + "Default for min header level" + :type 'integer + :group 'html-pagetoc) +(make-variable-buffer-local 'html-pagetoc-min) + +(defcustom html-pagetoc-max 3 + "Default for max header level" + :type 'integer + :group 'html-pagetoc) +(make-variable-buffer-local 'html-pagetoc-max) + +(defconst html-pagetoc-begin-cmnt "<!-- Table of contents BEGIN -->\n") +(defconst html-pagetoc-end-cmnt "<!-- END of Table of contents -->\n") +(defconst html-pagetoc-maxmin-cmnt "<!-- Table of contents min=%s max=%s -->\n") + +;;(defconst html-pagetoc-buffers nil) + +(defun html-pagetoc-get-title (filename) + "Find the head title for filename. +See `html-pagetoc-tocheads'." + (when filename + (let ((ths html-pagetoc-tocheads) + th + re + header) + (while (and ths (not header)) + (setq th (car ths)) + (setq ths (cdr ths)) + (setq re (car th)) + (when (string-match re filename) + (setq header (cdr th)))) + header))) + +;;;###autoload +(defun html-pagetoc-insert-toc (&optional min-level max-level) + "Inserts a table of contents for the current html file. +The html header tags h1-h6 found in the file are inserted into +this table. MIN-LEVEL and MAX-LEVEL specifies the minimum and +maximum level of h1-h6 to include. They should be integers." + (interactive (let* ((maxstr) + (max 0) + (min 1) + (prmax (format "Max header level (%s): " html-pagetoc-max)) + (prmax2 (concat "Please give an integer 1-5. " prmax)) + (prmin "Include header level 1? ") + ) + (while (= max 0) + (setq maxstr (read-string prmax)) + (if (equal maxstr "") + (setq max html-pagetoc-max) + (when (not (string-match "\\." maxstr)) + (setq max (string-to-number maxstr)) )) + (when (> max 5) (setq max 0)) + (when (< max 0) (setq max 0)) + (setq prmax prmax2) ) + (when (> max 1) + (when (not (y-or-n-p prmin)) (setq min 2))) + (list min max))) + + (let* ((curr-buffer (current-buffer)) + (header (html-pagetoc-get-title (buffer-file-name))) + (toc-buffer (get-buffer-create "*html-pagetoc*")) + (toc) + (buffer-val (cons (buffer-file-name) (list min-level max-level))) + ) + (setq html-pagetoc-min min-level) + (setq html-pagetoc-max max-level) + (with-current-buffer toc-buffer (erase-buffer)) + (with-temp-buffer + (insert-buffer-substring curr-buffer) + ;;(replace-regexp "<!--.*?-->" "") + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "<!--.*?-->" nil t) + (replace-match "" nil nil)) + (goto-char (point-min)) + (let ((b (current-buffer)) + (standard-output toc-buffer) + (level (- min-level 1)) + (skip-level (- min-level 1)) + (prev-level) + ) + (princ html-pagetoc-begin-cmnt) + (princ (format + html-pagetoc-maxmin-cmnt + min-level + max-level)) + (princ "<table id=\"PAGETOC\"><tr><td>\n") + (when header + (princ "<span class=\"tochead\">") + (princ header) + (princ "</span>\n")) + (while (re-search-forward + (concat "\\(?:<h\\([1-9]\\)\\([^>]*\\)>\\(.*?\\)</h[1-9]>" + "\\|" + "<!--\\(?:.\\|\n\\)-->\\)") + nil t) + (let ((m0 (match-string 0)) + (m1 (match-string 1)) + (m2 (match-string 2)) + (title (match-string 3)) + (id) + (new-level) + ) + (unless (not m1) + (setq new-level (string-to-number m1)) + (when (and (<= new-level max-level) (<= min-level new-level)) + (setq prev-level level) + (setq level new-level) + (while (< prev-level level) + (princ (make-string (* (- prev-level skip-level) 4) 32)) + ;; class liul is a fix for a problem in IE + (when (> prev-level (- min-level 1)) (princ "<li class=\"liul\">")) + (princ "<ul>\n") + (setq prev-level (+ prev-level 1))) + (while (> prev-level level) + (princ (make-string (* (- prev-level skip-level) 4) 32)) + (princ "</ul></li>\n")(setq prev-level (- prev-level 1))) + (when (nth 3 (match-data t)) + (when (string-match "id=\"\\([^\"]*\\)\"" m2) + (setq id (substring m2 (match-beginning 1) (match-end 1))))) + (princ (make-string (* (- level skip-level) 4) 32)) + (princ "<li>") + (if id + (princ (format "<a href=\"#%s\">%s</a>" id title)) + (princ title)) + (princ "</li>\n") + )))) + (while (> level (- min-level 1)) + (setq level (- level 1)) + (princ (concat (make-string (* (- level skip-level) 4) 32) "</ul>")) + (when (> level (- min-level 1)) (princ "</li>")) + (princ "\n")) + (princ "</td></tr></table>\n") + (princ html-pagetoc-end-cmnt) + (with-current-buffer toc-buffer + (setq toc (buffer-string))) + ) + ) ; save-excursion + ) ; with-temp-buffer + (when toc + (when (re-search-forward "<body.*?>" nil t) + (forward-line)) + (set-mark (point)) + (insert toc) + (let ((start (copy-marker (region-beginning))) + (end (copy-marker (region-end)))) + (indent-region (region-beginning) (region-end) nil) + (set-mark start) + (goto-char end)) + (setq deactivate-mark nil) + (message "Toc created")) + ) + ) + +(defun html-pagetoc-insert-style-guide () + "Inserts a style tag for toc inserted by `html-pagetoc-insert-toc'. +This can be used as a guide for creating your own style sheet for +the table of contents." + (interactive) + (goto-char (point-min)) + (unless (re-search-forward "^\\s-*</head>") + (error "%s" "Can not find ^\\s-*</head>")) + (beginning-of-line) + (set-mark (point)) + (insert "\n") + (insert "<!-- Style for the table of contents. -->\n") + (insert "<style type=\"text/css\">\n") + (insert "#PAGETOC {\n") + (insert " background-color: #df7;\n") + (insert " padding: 0.5em;\n") + (insert "}\n") + ;;(insert "#PAGETOC strong { color: #ac4; }\n") + (insert "#PAGETOC a { color: maroon; display: block; }\n") + (insert "#PAGETOC a:hover { background-color: yellow; }\n") + (insert "#PAGETOC ul {\n") + (insert " list-style-type: none;\n") + (insert " margin-left: 0;\n") + (insert " padding-left: 1.5em;\n") + (insert "}\n") + (insert "#PAGETOC ul li { font-weight: bold; }\n") + (insert "#PAGETOC ul li ul { }\n") + (insert "#PAGETOC ul li ul li { font-weight: normal;}\n") + (insert "#PAGETOC .liul {\n") + (insert " //display:inline; /* IE fix */\n") + (insert "}\n") + (insert "#PAGETOC .tochead {\n") + (insert " font-weight: bold;\n") + (insert " margin-bottom: 0.5em;\n") + (insert "}\n") + (insert "</style>\n") + (insert "\n") + (let ((start (copy-marker (region-beginning))) + (end (copy-marker (region-end)))) + (indent-region (region-beginning) (region-end) nil) + (set-mark start) + (goto-char end)) + (setq deactivate-mark nil) + (message "Please edit the style guide!") + ) + +;;;###autoload +(defun html-pagetoc-rebuild-toc () + "Update the table of contents inserted by `html-pagetoc-insert-toc'." + (interactive) + (let* (;;(old-val (assoc (buffer-file-name) html-pagetoc-buffers)) + ;;(old-min (nth 1 old-val)) + ;;(old-max (nth 2 old-val)) + (old-min html-pagetoc-min) + (old-max html-pagetoc-max) + ) + (goto-char (point-min)) + (if (not (search-forward html-pagetoc-begin-cmnt nil t)) + (when (y-or-n-p "Could not find table of contents. Insert one here? ") + (html-pagetoc-insert-toc)) + (backward-char 4) + (beginning-of-line) + (let ((minmax-patt (format html-pagetoc-maxmin-cmnt "\\([[:alnum:]]+\\)" "\\([[:alnum:]]+\\)"))) + (save-excursion + (when (search-forward-regexp minmax-patt nil t) + (setq old-min (string-to-number (match-string 1))) + (setq old-max (string-to-number (match-string 2)))))) + (let ((start-toc (point))) + (when (search-forward html-pagetoc-end-cmnt) + (beginning-of-line) + (let ((end-toc (point))) + (set-mark start-toc) + (goto-char end-toc) + (when (y-or-n-p "Rebuild this TOC? ") + ;;(unless old-min (setq old-min 1)) + (setq old-min (eval-minibuffer "Min TOC level: " (format "%s" old-min))) + ;;(unless old-max (setq old-max 3)) + (setq old-max (eval-minibuffer "Max TOC level: " (format "%s" old-max))) + (delete-region start-toc end-toc) + (html-pagetoc-insert-toc old-min old-max )))))))) + +;;;###autoload +(defconst html-pagetoc-menu-map + (let ((map (make-sparse-keymap))) + (define-key map [html-pagetoc-rebuild-toc] + (list 'menu-item "Update Page TOC" 'html-pagetoc-rebuild-toc)) + (define-key map [html-pagetoc-insert-style-guide] + (list 'menu-item "Insert CSS Style for Page TOC" 'html-pagetoc-insert-style-guide)) + (define-key map [html-pagetoc-insert-toc] + (list 'menu-item "Insert Page TOC" 'html-pagetoc-insert-toc)) + map)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;; Ready: +(provide 'html-pagetoc) + +;;; html-pagetoc.el ends here |