;;; yahtml-insert-index.el --- Insert index of HTML source -*- coding: euc-japan; -*-

;; Copyright (C) 1998-2004 TSUCHIYA Masatoshi <tsuchiya@namazu.org>

;; Author: TSUCHIYA Masatoshi <tsuchiya@namazu.org>
;; Keywords: yahtml
;; Version: $Revision: 1.6 $

;; 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; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:

;; 見出しタグ H1,H2,...,H6 とアンカータグ <A NAME="..."> から，階層的
;; な索引を作成するコマンド `yahtml-insert-index' を定義しています．
;;
;; 最新版は http://namazu.org/~tsuchiya/elisp/yahtml-insert-index.el
;; からダウンロードできます．

;;; Install:

;; このファイルを適当なディレクトリに置き，以下の設定を ~/.emacs に追
;; 加してください．
;;
;;   (autoload 'yahtml-insert-index "yahtml-insert-index" nil t)
;;   (autoload 'yahtml-delete-index "yahtml-insert-index" nil t)
;;   (autoload 'yahtml-update-index "yahtml-insert-index" nil t)
;;   (add-hook 'yahtml-mode-hook
;;             (lambda ()
;;               (define-key yahtml-mode-map "\C-ci" 'yahtml-update-index)))

;;; Code:

(eval-and-compile
  (if (locate-library "yahtml")
      (require 'yahtml)
    (defvar yahtml-prefer-upcases nil
      "*Non-nil for preferring upcase TAGs"))
  (cond
   ((locate-library "yatexlib")
    (autoload 'YaTeX-match-string "yatexlib"))
   ((fboundp 'match-string)
    (defalias 'YaTeX-match-string 'match-string))))

(defvar yahtml-index-identifier "_index"
  "*Identifier of the index that has been insereted by `yahtml-insert-index'.
索引を区別する識別文字列．")

(defvar yahtml-index-tag "ul"
  "*Element to display the index created by `yahtml-insert-index'.
索引を作る時に使うタグ．")

(defvar yahtml-index-item-tag "li"
  "*Element to display items of the index created by `yahtml-insert-index'.
索引の項目を作るタグ．")

;;;###autoload
(defun yahtml-insert-index (&optional interactive-p)
  "Insert index of HTML source in this buffer.
カレントバッファに含まれている見出しタグ H1,H2,...,H6 とアンカータグ
<A NAME=\"...\"> から階層的な索引を作成し，カーソル位置に挿入する．他
ファイルへのリンクを索引に付け加えたい場合は，

    <!-- <h?><a href=\"foo\">bar</a></h?> -->

というタグをその場所に書いておく．\(? の部分には 1-6 の数字が入る\)"
  (interactive (list t))
  (let ((start (concat "<"
		       (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
				yahtml-index-tag)
		       ">"))
	(end (concat "</"
		     (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
			      yahtml-index-tag)
		     ">"))
	(tags))
    (save-match-data
      (save-excursion
	(goto-char (point-min))
	(let ((case-fold-search t)
	      (prelevel 0)
	      (template
	       (concat "<"
		       (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
				yahtml-index-item-tag)
		       "><"
		       (if yahtml-prefer-upcases "A HREF" "a href")
		       "=\"%s\">%s</"
		       (if yahtml-prefer-upcases "A" "a")
		       "></"
		       (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
				yahtml-index-item-tag)
		       ">")))
	  (while (re-search-forward "\\(<h\\([1-6]\\)>\\)?\
<a[ \t\r\f\n]+\\(href\\|\\(name\\)\\)=\"\\([^\"]+\\)\">" nil t)
	    (let ((begin (point))
		  (label (if (match-beginning 4)
			     (concat "#" (YaTeX-match-string 5))
			   (and (match-beginning 2)
				(not (eq ?# (char-after (match-beginning 5))))
				(YaTeX-match-string 5))))
		  (level (if (match-beginning 2)
			     (string-to-number (YaTeX-match-string 2))
			   7)))
	      (if (and label (search-forward "</a>" nil t))
		  (progn
		    (cond
		     ((< prelevel level)
		      (setq tags (cons start tags)))
		     ((> prelevel level)
		      (setq tags (cons end tags))))
		    (setq tags
			  (cons (format template label
					(buffer-substring begin
							  (match-beginning 0)))
				tags)
			  prelevel level))))))))
    (if tags
	(let ((begin (point))
	      (level 1))
	  (setq tags (nreverse tags))
	  (if (string= start (car tags))
	      (setq tags (cdr tags)))
	  (insert "<"
		  (funcall (if yahtml-prefer-upcases 'upcase 'downcase)
			   yahtml-index-tag)
		  " " (if yahtml-prefer-upcases "ID" "id") "=\""
		  yahtml-index-identifier "\">\n")
	  (while tags
	    (setq level
		  (+ level
		     (cond
		      ((string= start (car tags)) 1)
		      ((string= end (car tags)) -1)
		      (t 0))))
	    (insert (car tags) "\n")
	    (setq tags (cdr tags)))
	  (while (> level 0)
	    (insert end "\n")
	    (setq level (1- level)))
	  (indent-region begin (point) nil))
      (if interactive-p
	  (error "No heading is found")))))

;;;###autoload
(defun yahtml-delete-index (&optional interactive-p)
  "Delete an index that has already been inserted by `yahtml-insert-index'."
  (interactive (list t))
  (save-excursion
    (save-match-data
      (let ((case-fold-search t))
	(goto-char (point-min))
	(if (re-search-forward
	     (concat "<" yahtml-index-tag "[ \t\r\f\n]+id=\""
		     yahtml-index-identifier "\"[^>]*>")
	     nil t)
	    (let ((level 1)
		  (begin (match-beginning 0))
		  (pattern
		   (concat "<\\(/\\)?" yahtml-index-tag ">\n?")))
	      (while (and (or (re-search-forward pattern nil t)
			      (error "Cannot find correnponding tag"))
			  (setq level
				(+ level
				   (if (match-beginning 1) -1 1)))
			  (> level 0)))
	      (delete-region begin (match-end 0))
	      (if interactive-p
		  (message "Inserted index is removed"))
	      begin)
	  (if interactive-p
	      (error "Cannot find inserted index")))))))

;;;###autoload
(defun yahtml-update-index (&optional interactive-p)
  "Update index of HTML source in this buffer."
  (interactive (list t))
  (let ((pos (yahtml-delete-index)))
    (if pos (goto-char pos))
    (yahtml-insert-index interactive-p)))

(provide 'yahtml-insert-index)

;;; yahtml-insert-index.el ends here.