;;; -*- mode: lisp; package: editor -*-
;;; Last updated: <2005/06/02>

(provide "info+")

(in-package "editor")

(export '(*info+-bookmark-mode-hook*
		  *info+-bookmark-mode-map*
		  *info+-bookmark-window-height*
		  *info+-keyword-file*
		  info+-bookmark-add
		  info+-bookmark-close
		  info+-bookmark-delete
		  info+-bookmark-go
		  info+-bookmark-mode
		  info+-bookmark-view
		  info+-fontify
		  info+-goto-footnote)
		"ed")

;;; キーワード

(defvar *info+-keyword-hash-table* nil)
(defvar *info+-keyword-file* "~/etc/lisp")

(defun info+-fontify (&optional file (toggle t))
	"キーワード色付けトグル"
	(interactive)
	(if *info+-keyword-hash-table*
			(when toggle
				(make-local-variable 'keyword-hash-table)
				(setf keyword-hash-table nil
					  *info+-keyword-hash-table* nil)
				(message "keyword color ... clear"))
		(progn
			(unless file
				(setf file (read-file-name "Keyword File: "
										   :default *info+-keyword-file*)))
			(setf *info+-keyword-hash-table* (load-keyword-file file))
			(when *info+-keyword-hash-table*
				(make-local-variable 'keyword-hash-table)
				(setf keyword-hash-table *info+-keyword-hash-table*)
				(message "load ~A" file)))))

;;; Footnotes

(defun info+-goto-footnote ()
	"バッファ終わりのFootnotesに移動"
	(interactive)
	(let (cmd
		  pos)
		(save-excursion
			(when (progn
					  (next-line)
					  (scan-buffer "^---------- Footnotes ----------$" :regexp t))
				(setf pos (point))))
		(if pos
				(progn
					(set-mark-command)
					(goto-char pos)
					(recenter 0)
					(setf cmd (case (read-char)
								  ((#\1) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(1) " :regexp t)))
								  ((#\2) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(2) " :regexp t)))
								  ((#\3) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(3) " :regexp t)))
								  ((#\4) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(4) " :regexp t)))
								  ((#\5) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(5) " :regexp t)))
								  ((#\6) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(6) " :regexp t)))
								  ((#\7) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(7) " :regexp t)))
								  ((#\8) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(8) " :regexp t)))
								  ((#\9) #'(lambda ()
											   (interactive)
											   (scan-buffer "^(9) " :regexp t))))))
			(progn
				(setf cmd (case (read-char)
							  ((#\@) #'(lambda ()
										   (interactive)
										   (when (exchange-point-and-mark)
											   (refresh-screen))))))))
		(when cmd
			(call-interactively cmd))))

;;; ブックマーク

(defvar *info+-bookmark-mode-hook* nil
	"ブックマークモードフック変数")

(defvar *info+-bookmark-mode-map* nil
	"ブックマークモードキーマップ")
(unless *info+-bookmark-mode-map*
	(setf *info+-bookmark-mode-map* (make-sparse-keymap))
	(define-key *info+-bookmark-mode-map* #\RET 'info+-bookmark-go)
	(define-key *info+-bookmark-mode-map* #\TAB 'info+-bookmark-view)
	(define-key *info+-bookmark-mode-map* #\d 'info+-bookmark-delete)
	(define-key *info+-bookmark-mode-map* #\n 'next-virtual-line)
	(define-key *info+-bookmark-mode-map* #\p 'previous-virtual-line)
	(define-key *info+-bookmark-mode-map* #\q 'info+-bookmark-close)
	(define-key *info+-bookmark-mode-map* #\v 'next-page)
	(define-key *info+-bookmark-mode-map* #\z 'previous-page))

(defvar *info+-bookmark-list* nil
	"ブックマークリスト")

(defvar *info+-bookmark-window-height* 5
	"ブックマークウィンドウ高さ")

(defun info+-bookmark-close ()
	"ブックマーク閉じる"
	(interactive)
	(delete-buffer (selected-buffer))
	(delete-window))

(defun info+-bookmark-view ()
	"ブックマーク先閲覧"
	(interactive)
	(unless (eobp)
		(let* ((poslist (nth (1- (current-line-number)) *info+-bookmark-list*))
			   (node-name (first poslist))
			   (file-name (second poslist))
			   (lnum (third poslist)))
			(other-window)
			(info-find-node file-name node-name)
			(goto-line lnum)
			(other-window))))

(defun info+-bookmark-go ()
	"ブックマーク先へ"
	(interactive)
	(unless (eobp)
		(let* ((poslist (nth (1- (current-line-number)) *info+-bookmark-list*))
			   (node-name (first poslist))
			   (file-name (second poslist))
			   (lnum (third poslist)))
			(info+-bookmark-close)
			(info-find-node file-name node-name)
			(goto-line lnum))))

(defun info+-bookmark-delete ()
	"ブックマーク削除"
	(interactive)
	(unless (eobp)
		(let ((num (- (list-length *info+-bookmark-list*)
					  (current-line-number))))
			(setf buffer-read-only nil)
			(goto-bol)
			(delete-region (point)
						   (progn
							   (next-line)
							   (point)))
			(setf *info+-bookmark-list*
				  (append (butlast *info+-bookmark-list* (1+ num))
						  (last *info+-bookmark-list* num)))
			(setf buffer-read-only t)
			(set-buffer-modified-p nil))))

(defun info+-bookmark-add ()
	"ブックマーク追加"
	(interactive)
	(push (list *info-current-node*
				*info-current-file*
				(current-line-number))
		  *info+-bookmark-list*))

(defun info+-bookmark-mode ()
	"ブックマーク開く"
	(interactive)
	(split-window *info+-bookmark-window-height* nil)
	(set-buffer (get-buffer-create "*info+-bookmark*"))
	(kill-all-local-variables)
	(setf mode-name "info+-bookmark")
	(setf buffer-mode 'info+-bookmark-mode)
	(use-keymap *info+-bookmark-mode-map*)
	(make-local-variable 'mode-line-format)
	(setf mode-line-format "%M")
	(make-local-variable 'kept-undo-information)
	(setf kept-undo-information nil)
	(make-local-variable 'need-not-save)
	(setf need-not-save t)
	(make-local-variable 'auto-save)
	(setf auto-save nil)
	(set-buffer-fold-type-none)
	(set-local-window-flags (selected-buffer)
							(+ *window-flag-ruler*
							   *window-flag-newline*
							   *window-flag-full-width-space*
							   *window-flag-vscroll-bar*
							   *window-flag-eof*
							   *window-flag-half-width-space*)
							nil)
	(when *info+-bookmark-list*
		(setf buffer-read-only nil)
		(erase-buffer (selected-buffer))
		(dolist (tmp *info+-bookmark-list*)
			(with-output-to-selected-buffer
				(format t
						"~50@A, ~D, ~A~%"
						(first tmp)
						(third tmp)
						(second tmp))))
		(set-buffer-modified-p nil)
		(goto-char (point-min)))
	(toggle-ime nil)
	(setf buffer-read-only t)
	(run-hooks '*info+-bookmark-mode-hook*))

;;; Info-modeキーマップ

(defun info+-scroll (&optional (arg 1))
	(interactive)
	(let ((nlines (max (truncate (* (window-height) 4/5)) 1)))
		(if *info-smooth-scroll*
				(dotimes (x nlines t)
					(scroll-window arg)
					(refresh-screen))
			(next-page arg))))

(define-key *info-mode-map* #\@ 'info+-goto-footnote)
(define-key *info-mode-map* #\b 'info+-bookmark-mode)
(define-key *info-mode-map* #\B 'info+-bookmark-add)
(define-key *info-mode-map* #\k 'info+-fontify)
(define-key *info-mode-map* #\v 'info+-scroll)
(define-key *info-mode-map* #\z #'(lambda ()
									  (interactive)
									  (info+-scroll -1)))