diff options
Diffstat (limited to 'emacs.d/nxhtml/nxhtml/html-toc.el')
| -rw-r--r-- | emacs.d/nxhtml/nxhtml/html-toc.el | 363 |
1 files changed, 0 insertions, 363 deletions
diff --git a/emacs.d/nxhtml/nxhtml/html-toc.el b/emacs.d/nxhtml/nxhtml/html-toc.el deleted file mode 100644 index 866b43f..0000000 --- a/emacs.d/nxhtml/nxhtml/html-toc.el +++ /dev/null @@ -1,363 +0,0 @@ -;;; html-toc.el --- Building and updating TOC for a site -;; -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Created: Wed Feb 01 14:40:13 2006 -(defconst html-toc:version "0.4");; Version: -;; Last-Updated: Tue Apr 10 04:09:29 2007 (7200 +0200) -;; Keywords: -;; Compatibility: -;; -;; Features that might be required by this library: -;; -;; None -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Create table of contents for a static web site. See -;; `html-toc-write-toc-file' and `html-toc-write-frames-file' for -;; more info. -;; -;; To use this you can add (require 'html-toc) to your .emacs. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 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. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -(eval-when-compile (require 'cl)) -(eval-when-compile (add-to-list 'load-path default-directory load-path)) -(eval-when-compile (require 'fupd nil t)) -;;(require 'html-move) -(eval-when-compile (require 'html-site nil t)) -;;(require 'dom) -(require 'xml) - -(defconst html-toc-mark-begin "<!-- html-toc START -->") -(defconst html-toc-mark-middle "<!-- html-toc MIDDLE -->") -(defconst html-toc-mark-end "<!-- html-toc END -->") - -(defun html-toc-create-pages-file () - "Write a list of pages to be used for table of contents. -Return the file name." - (interactive) - (html-site-current-ensure-site-defined) - (let* ( - (site-dir (html-site-current-site-dir)) - (page-file (html-site-current-page-list)) - (page-file-dir (file-name-directory page-file)) - (page-file-exists (file-exists-p page-file)) - (sub-files (html-site-get-sub-files - site-dir - html-site-files-re)) - (pages-text) - ) - (setq sub-files - (sort (mapcar (lambda (full-file) - (assert (file-exists-p full-file)) - (file-relative-name full-file page-file-dir)) - sub-files) - 'string<)) - ;;(setq sub-files (delete html-toc-file-default-name sub-files)) - (with-temp-buffer - (let ((this-level) - (dir-title) - (title) - (full-file)) - (dolist (file sub-files) - (setq full-file (expand-file-name file page-file-dir)) - (setq dir-title (file-name-nondirectory - (substring (file-name-directory full-file) 0 -1))) - (setq title (html-toc-get-title full-file)) - (setq this-level 0) - (mapc (lambda (c) (when (eq c ?/) (setq this-level (1+ this-level)))) file) - (insert (format "%s ### %s ### %s\n" this-level title file)))) - (setq pages-text (buffer-string))) - (with-current-buffer (find-file page-file) - (if (string= pages-text (buffer-string)) - (message "List of pages is already the default list") - (if (= 0 (length (buffer-string))) - (progn - (insert pages-text) - (save-buffer) - ) - (if (y-or-n-p "Replace old list of pages? ") - (progn - (erase-buffer) - (insert pages-text) - (save-buffer) - ) - (message "Keeping old list of pages."))))) - page-file)) -(defun html-toc-dir () - (let* ((this-file (if load-file-name - load-file-name - buffer-file-name)) - (this-dir (file-name-directory this-file)) - ) - (expand-file-name "html-toc" this-dir))) - -;;;###autoload -(defgroup html-toc nil - "Customization group for html-toc." - :group 'nxhtml) - -(defcustom html-toc-template-file - (expand-file-name "html-toc-template.html" (html-toc-dir)) - "Template file for table of contents file." - :type 'file - :group 'html-toc) - - -(defun html-toc-write-toc-file () - "Write a table of contents for a web site. -Build the table of content from the information in -`html-site-current-page-list'. Write it to the file -`html-site-current-toc-file' and return that file name. - -When viewed in a browser the table of contents can be -expanded/collapsed (if JavaScript is allowed)." - (interactive) - (html-site-current-ensure-site-defined) - (let* ((toc-file (html-site-current-toc-file)) - (page-file (html-site-current-page-list)) - page-lines - toc) - (unless (< 0 (length toc-file)) - (error "There is no name for the table of content file in site \"%s\"" - html-site-current)) - (unless (< 0 (length page-file)) - (error "There is no name for the pages file in site \"%s\"" - html-site-current)) - (with-temp-buffer - (insert-file-contents page-file) - (goto-char (point-min)) - (while (not (eobp)) - (let* ((line (buffer-substring (point) (line-end-position))) - (line-parts (split-string line "\\s-+###\\s-+"))) - (setq page-lines (cons line-parts page-lines))) - (forward-line))) - (setq page-lines (reverse page-lines)) - (with-temp-buffer - (html-toc-insert-toc page-lines toc-file) - (setq toc (buffer-substring-no-properties (point-min) (point-max)))) - (with-current-buffer (find-file-noselect toc-file) - (erase-buffer) - (insert-file-contents-literally html-toc-template-file) - (let (toc-start) - (while (search-forward "%%TOC%%" nil t) - (unless toc-start - (setq toc-start (match-beginning 0))) - (replace-match toc t t)) - (forward-line) ;; for indentation - (indent-region toc-start (point-marker))) - (goto-char (point-min)) - (save-buffer)) - toc-file)) - - -(defun html-toc-insert-toc (page-lines toc-file) - (let* ((curr-level) - (min-level 100) - div-levels - (site-directory (html-site-current-site-dir)) - (toc-rel-file (file-relative-name toc-file site-directory))) - (dolist (line page-lines) - (let ((level (string-to-number (nth 0 line)))) - (when (< level min-level) - (setq min-level level)))) - (setq curr-level min-level) - (while page-lines - (let* ((line (car page-lines)) - (file (nth 2 line)) - (title (nth 1 line)) - (this-level (string-to-number (nth 0 line))) - (next-level (progn - ;; Note: - (setq page-lines (cdr page-lines)) - (let ((next-line (car page-lines))) - (when next-line - (string-to-number (nth 0 next-line)))))) - (full-file (expand-file-name file site-directory)) - (dir-title (file-name-nondirectory - (substring (file-name-directory full-file) 0 -1)))) - ;;(insert "<!-- " (format "%s, %s, %s" curr-level this-level div-levels) " -->\n") - ;; Don't insert a link to the toc file - (unless (string= toc-rel-file file) - ;; If there are childs then insert a <div> before them. Save - ;; the level so we can close the div-tag later. - (when (< curr-level this-level) - ;; Save level so we can find the end of the <div>. - (setq div-levels (cons this-level div-levels)) - (insert "<div class=\"html-toc-childs\">\n")) - ;; Close div-tags if this level is lower when the previous. - (when (> curr-level this-level) - (while (and div-levels - (> (car div-levels) this-level)) - (insert "</div>\n") - (setq div-levels (cdr div-levels)))) - (setq curr-level this-level) - (insert "<div class=\"html-toc-link\">" - "<span style=\"display:table-cell; width:15em; background-color:yellow;\">" - "<a style=\"padding-left:" (number-to-string (1+ (- curr-level min-level))) "em;\" " - (format "href=\"%s\">%s</a>" file title) - "</span>") - (when (and next-level (> next-level this-level)) - (insert "<span onclick=\"html_toc_hs(this)\" class=\"html-toc-hs\"" - " style=\"display:table-cell; background-color:white;\">HS</span>")) - (insert "</div>" - "\n") - ))) - (while div-levels - (insert "</div>\n") - (setq div-levels (cdr div-levels))))) - -(defun html-toc-get-title (file) - (save-excursion - (with-temp-buffer - (insert-file-contents file nil 0 1000) - (goto-char (point-min)) - (when (search-forward-regexp "<title>\\(.*\\)</title>" nil t) - (match-string 1))))) - -(defun html-toc-parse-toc (toc-str) - (let ((nodes)) - (with-temp-buffer - (insert toc-str) - (setq nodes (xml-parse-region (point-min) (point-max)))) - )) - -(defun html-toc-get-hrefs (nodes) - (let ((atags (html-toc-get-atags nodes))) - (mapcar (lambda (atag) - (xml-get-attribute atag 'href)) - atags))) -(defun html-toc-get-atags (nodes) - (let ((atags)) - (dolist (node nodes) - (when (listp node) - (setq atags (append atags (xml-get-children node 'a))) - (setq atags (append atags (html-toc-get-atags (xml-node-children node)))))) - atags)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Frames and viewing -(defcustom html-toc-frames-default-name "html-toc-frames.html" - "Default file name sans directory for frames file." - :type 'string - :group 'html-toc) - -(defvar html-toc-frames-contents - "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?> -<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\"> -<html xmlns=\"http://www.w3.org/1999/xhtml\"> - <head> - <title>Frames for html-toc</title> - </head> - <frameset cols=\"20%, 80%\"> - <frame name=\"html-toc-TOC\" src=\"%%TOCFILE%%\"/> - <frame name=\"html-toc-Document\" /> - <noframes> - <body> - Html frame support required - </body> - </noframes> - </frameset> -</html> -") - -(defun html-toc-browse-frames-file () - "View frames file written by `html-toc-write-frames-file'." - (interactive) - (html-site-current-ensure-site-defined) - (let ((frames-file (html-site-current-frames-file))) - (unless (< 0 (length frames-file)) - (error "There is no frames file set for site \"%s\"" html-site-current)) - ;;(message "frames-file=%s" frames-file)(sit-for 4) - (unless (file-exists-p frames-file) - (html-toc-write-frames-file)) - (browse-url-of-file frames-file))) - -;; (defun html-toc-frames-file-name () -;; "Return name of file written by `html-toc-write-frames-file'." -;; (html-toc-get-site) -;; (expand-file-name html-toc-frames-default-name html-move-site-directory)) - -(defun html-toc-write-frames-file () - "Write a frames file. -This frames file should load the table of contents build by -`html-toc-write-toc-file' in one frame and shows the documents in -another. - -The contents of the frames file is defined by -`html-toc-frames-contents'. - -Returns the file name of the written or existing frames file. - -You may also want to look at `html-wtoc-write-pages-with-toc'." - (interactive) - ;;(html-toc-get-site) - (html-site-current-ensure-site-defined) - (let* ((frames-file (html-site-current-frames-file)) - (frames-cont html-toc-frames-contents) - (toc-file (html-toc-write-toc-file)) - toc-file-relative) - (when toc-file - (setq toc-file-relative (file-relative-name - toc-file - (file-name-directory frames-file))) - (save-match-data - (unless (string-match "%%TOCFILE%%" frames-cont) - (error "Can't find %%TOCFILE%% in html-toc-frames-contents")) - (setq frames-cont (replace-match toc-file-relative t t frames-cont))) - (with-current-buffer (find-file-noselect frames-file) - (erase-buffer) - (insert frames-cont) - (save-buffer)) - frames-file))) - -;;;###autoload -(defconst html-toc-menu-map - (let ((map (make-sparse-keymap))) - (define-key map [html-toc-browse-frames-file] - (list 'menu-item "Browse Frames File" 'html-toc-browse-frames-file)) - (define-key map [html-toc-write-frames-file] - (list 'menu-item "Write Frames File" 'html-toc-write-frames-file)) - (define-key map [html-toc-write-toc-file] - (list 'menu-item "Write TOC File for Frames" 'html-toc-write-toc-file)) - (define-key map [html-toc-sep1] (list 'menu-item "--")) - (define-key map [html-toc-edit-pages-file] - (list 'menu-item "Edit List of Pages for TOC" 'html-site-edit-pages-file)) - (define-key map [html-toc-create-pages-file] - (list 'menu-item "Write List of Pages for TOC" 'html-toc-create-pages-file)) - map)) - - - -(provide 'html-toc) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; html-toc.el ends here |