;;; -*- Mode: Lisp -*-
;;;
;;; This file is not part of xyzzy.
;;;

;;; $Id: namazu.l 1.5 2000-01-16 19:24:03+09 hattori Exp hattori $
;;;
;;; Namazu mode for xyzzy
;;;
;;; by HATTORI Masashi <hat@kme.biglobe.ne.jp>
;;;
;;; へなちょこNamazu検索モードです
;;; 使用するには "Namazu for Win32"が必要です。
;;;   <http://www.namazu.org/windows/>
;;;
;;; ■設定
;;; (autoload 'namazu "namazu" t)
;;; ;indexへのパス。標準のindex以外を使う場合は指定する。[nil]
;;; ;(setq *namazu-index* "C:/path/to/index")
;;; ;一度に表示する件数 [20]
;;; (setq *namazu-search-num* 30)
;;;
;;; ■使用方法
;;; M-x namazu として検索文字列を入力して下さい
;;; C-u M-x namazu とするとindexの場所を指定できます。
;;;
;;; ■キーバインド
;;;
;;; -- 検索結果画面
;;;	r	再検索
;;; 	↓	次の検索結果へ
;;; 	TAB	同上
;;; 	↑	前の検索結果へ
;;;	SPACE	次のページへ
;;;	BS	前のページへ
;;; 	→	次の検索ページへ
;;; 	←	前の検索ページへ
;;; 	RETURN	ファイルを表示
;;;	q	終了
;;;
;;; -- 検索表示画面
;;;	SPACE	次のページへ
;;;	BS	前のページへ
;;;	RETURN	検索結果画面へ
;;;
;;; ■その他
;;; -- 拡張子別のファイルを開く設定例。
;;;    デフォルトでは "*.html","*.htm"を標準のブラウザで、それ以外をxyzzyで開く。
;;;
;;; ;HTMLファイルは www-modeで、数字のみのファイルはメールとして開く。
;;; (setq *namazu-open-type* '(
;;; 			   ("\.html?$" namazu-open-www)
;;; 			   ("/[0-9]+$" namazu-open-mail)
;;; 			  ))
;;; 
;;; (defun namazu-open-www (file)
;;;   (require "www/www")
;;;   (let (buf)
;;;     (save-excursion
;;;       (www-open-local-file file)
;;;       (setq buf (selected-buffer))
;;;     )
;;;     (pop-to-buffer buf)
;;;   ))
;;; 
;;; (defun namazu-open-mail (file)
;;;   (require "encdec")
;;;   (pop-to-buffer (get-buffer-create *namazu-buffer-show*))
;;;   (setq buffer-read-only nil)
;;;   (erase-buffer (selected-buffer))
;;;   (insert-file-contents file)
;;;   (decode-mime-header);encdec.l
;;;   (goto-char (point-min))
;;;   (while (not (eolp))
;;;     (or (forward-line 1) (return)))
;;;   (recenter 0)
;;;   (namazu-show-mode)
;;; )

(provide "namazu")

(defvar *namazu-buffer-prefix* "*NAMAZU ")
(defvar *namazu-pframe-name* "Namazu")

(defvar *namazu-buffer-search* (concat *namazu-buffer-prefix* "SEARCH*"))
(defvar *namazu-buffer-show* (concat *namazu-buffer-prefix* "SHOW*"))

(defvar *namazu-open-type* '(
			     ("\.html?$" namazu-open-system)
			    ))

(defvar *namazu-command* "namazu")
(defvar *namazu-index* nil)
(defvar *namazu-last-word* nil)
(defvar *namazu-search-num* 20)
(defvar *namazu-current-page* 0)
(defvar *namazu-max-number* 0)

(defvar *namazu-number-forecolor* 1)
(defvar *namazu-title-forecolor* 13)
(defvar *namazu-score-forecolor* 11)
(defvar *namazu-file-forecolor* 12)
(defvar *namazu-size-forecolor* 10)

(defvar *namazu-mode-hook* nil)
(defvar *namazu-show-mode-hook* nil)

(defvar *namazu-mode-map* nil)
;(unless *namazu-mode-map*
  (setq *namazu-mode-map* (make-sparse-keymap))
  (define-key *namazu-mode-map* #\r 'namazu-research)
  (define-key *namazu-mode-map* #\TAB 'namazu-next)
  (define-key *namazu-mode-map* #\Down 'namazu-next)
  (define-key *namazu-mode-map* #\Up 'namazu-previous)
  (define-key *namazu-mode-map* #\Right 'namazu-next-page)
  (define-key *namazu-mode-map* #\Left 'namazu-previous-page)
  (define-key *namazu-mode-map* #\SPC 'next-page)
  (define-key *namazu-mode-map* #\C-h 'previous-page)
   (define-key *namazu-mode-map* #\h 'namazu-hide)
  (define-key *namazu-mode-map* #\q 'namazu-quit)
  (define-key *namazu-mode-map* #\RET 'namazu-show)
;)

(defvar *namazu-show-mode-map* nil)
;(unless *namazu-show-mode-map*
   (setq *namazu-show-mode-map* (make-sparse-keymap))
   (define-key *namazu-show-mode-map* #\SPC 'namazu-show-next-page)
   (define-key *namazu-show-mode-map* #\C-h 'namazu-show-previous-page)
   (define-key *namazu-show-mode-map* #\Right 'namazu-show-next)
   (define-key *namazu-show-mode-map* #\Left 'namazu-show-previous)
   (define-key *namazu-show-mode-map* #\RET 'namazu-show-back)
   (define-key *namazu-show-mode-map* #\q 'namazu-show-back)
;)

(defun namazu-show-back ()
  (interactive)
  (pop-to-buffer *namazu-buffer-search*))

(defun namazu-show-next-page ()
  (interactive)
  (if (pos-visible-in-window-p (point-max))
      (namazu-show-next)
    (next-page)))

(defun namazu-show-previous-page ()
  (interactive)
  (if (pos-visible-in-window-p (point-min))
      (namazu-show-previous)
    (previous-page)))

(defun namazu-show-next ()
  (interactive)
  (pop-to-buffer *namazu-buffer-search*)
  (namazu-next))

(defun namazu-show-previous ()
  (interactive)
  (pop-to-buffer *namazu-buffer-search*)
  (namazu-previous))

(defun namazu-show-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq buffer-mode 'namazu-show-mode)
  (setq mode-name "Namazu Show")
  (use-keymap *namazu-show-mode-map*)
  (setq buffer-read-only t)
  (setq need-not-save t)
  (run-hooks '*namazu-show-mode-hook*))

(defun namazu (word &optional index)
  (interactive "sSearch Word: \np" :default0 (or *namazu-last-word* ""))
  (when index
    (setq *namazu-index*
	  (read-directory-name "Index: " :default (or *namazu-index* (default-directory)))))
  (when (string-equal word "")
    (return-from namazu))
  (when (not (equal *namazu-last-word* word))
    (setq *namazu-current-page* 0))
  (setq *namazu-last-word* word)
  (unless (namazu-restore-pframe)
    (new-pseudo-frame *namazu-pframe-name*))
  (namazu-set-buffer)
  (set-buffer (get-buffer-create *namazu-buffer-show*))
  (delete-other-windows)
  (namazu-exec)
  (pop-to-buffer *namazu-buffer-search*)
  (namazu-mode)
  (run-hooks '*namazu-hook*)
)

(defun namazu-research ()
  (interactive)
  (call-interactively 'namazu))

(defun namazu-get-buffer ()
  (get-buffer-create *namazu-buffer-search*))
  
(defun namazu-set-buffer ()
  (set-buffer (namazu-get-buffer))
  (setq buffer-read-only nil))

(defun namazu-mode ()
  (namazu-set-buffer)
  (kill-all-local-variables)
  (setq buffer-mode 'namazu-mode)
  (setq mode-name "Namazu Search")
  (use-keymap *namazu-mode-map*)
  (make-local-variable 'need-not-save)
  (set-buffer-fold-width t)
  (namazu-format)
  (setq buffer-read-only t)
  (setq need-not-save t)
  (run-hooks '*namazu-mode-hook*)
)

(defun namazu-exec ()
  (let (com)
   (setq com (format nil
		     "~A -n ~D -w ~D \"~A\""
		     *namazu-command*
		     *namazu-search-num*
		     (* *namazu-search-num* *namazu-current-page*)
		     *namazu-last-word*))
    (when *namazu-index*
      (setq com (concat com " " *namazu-index*)))
    ;(message-box com)
    (execute-shell-command com nil *namazu-buffer-search*)
  ))

(defun namazu-next-page ()
  (interactive)
  (when (< (+ (* *namazu-current-page* *namazu-search-num*) *namazu-search-num*)
	   *namazu-max-number*)
    (incf *namazu-current-page*)
    (namazu *namazu-last-word*)))

(defun namazu-previous-page ()
  (interactive)
  (when (< 0 *namazu-current-page*)
    (incf *namazu-current-page* -1)
    (namazu *namazu-last-word*)))

(defun namazu-format ()
  (let ()
    (save-excursion
      (goto-char (point-min))
      (if (scan-buffer "^検索式にマッチする[ \t]*\\([0-9]+\\)[ \t]*個" :regexp t :tail nil)
	  (progn
	    (forward-line 1)
	    (setq *namazu-max-number* (parse-integer (match-string 1))))
	(return-from namazu-format))
      (while (scan-buffer "^\\([0-9]+\.\\)[ \t]+\\(.*\\)[ \t]+\\(([^)]+)\\)" :regexp t :tail nil)
	(set-text-attribute (match-beginning 1)
			    (match-end 1)
			    'namazu-number
			    :bold t
			    :foreground *namazu-number-forecolor*)
	(set-text-attribute (match-beginning 2)
			    (match-end 2)
			    'namazu-title
			    :bold t
			    :foreground *namazu-title-forecolor*)
	(set-text-attribute (match-beginning 3)
			    (match-end 3)
			    'namazu-score
			    :foreground *namazu-score-forecolor*)
	(or (forward-line 1) (return))
	(while (not (eolp))
	  (or (forward-line 1) (return)))
	(forward-line -1)
	(when (looking-at "^/\\([a-zA-Z]\\)|\\(.*\\)[ \t]*\\(\\(size[ \t]+\\)?\([0-9,]+ bytes\)\\)")
	  (set-text-attribute (match-beginning 0)
			      (match-end 2)
			      'namazu-file
			      :underline t
			      :foreground *namazu-file-forecolor*)
	  (set-text-attribute (match-beginning 3)
			      (match-end 3)
			      'namazu-size
			      :foreground *namazu-size-forecolor*))
      ))))

(defun namazu-quit ()
  (interactive)
  (dolist (x (buffer-list))
    (let ((buf (buffer-name x)))
      (when (string-match *namazu-buffer-prefix* buf)
	(delete-buffer buf))))
  (delete-pseudo-frame))

(defun namazu-hide ()
  (interactive)
  (previous-pseudo-frame))

(defun namazu-restore ()
  (interactive)
  (unless (namazu-restore-pframe)
    (namazu)))

(defun namazu-restore-pframe ()
  (let ((frame (find-pseudo-frame *namazu-pframe-name*)))
    (when frame
      (select-pseudo-frame frame))
    frame
  ))

(defun namazu-toggle ()
  (interactive)
  (if (eq *namazu-pframe-name*
	  (ed::pseudo-frame-name ed::*current-pseudo-frame*))
      (namazu-hide)
    (namazu-restore)))

(defun namazu-next ()
  (interactive)
  (let (next)
;    (setq next (or (find-text-attribute 'namazu-file :start (1+ (point)))
;		   (find-text-attribute 'namazu-file)))
    (setq next (find-text-attribute 'namazu-file :start (1+ (point))))
    (when next
      (goto-char next)
      (recenter))
    (run-hooks '*namazu-next-hook*)
  ))

(defun namazu-previous ()
  (interactive)
  (let (next)
    (setq next (find-text-attribute 'namazu-file :end (1- (point)) :from-end t))
    (when next
      (goto-char next)
      (recenter))
    (run-hooks '*namazu-previous-hook*)
  ))

#|
(defun namazu-previous ()
  (interactive)
  (goto-bol)
  (while (not (or (bobp) (eolp)))
    (forward-line -1))
  (while (and (eolp) (not (bobp)))
    (forward-line -1))
  (while (not (or (bobp) (eolp)))
    (forward-line -1))
  (namazu-next))
|#

(defun namazu-show ()
  (interactive)
  (let (file buf)
    (save-excursion
      (goto-bol)
      (when (looking-at "^/\\([a-zA-Z]\\)|\\([^ \t]+\\)")
	(setq file (concat (match-string 1) ":" (match-string 2)))
	;(message-box file)
      )
    )
    (when file
      (namazu-open file))
  ))

(defun namazu-open (file)
  (let ((types *namazu-open-type*))
    (while types
      (let* ((type (car types))
	     (regexp (car type))
	     (func (car (cdr type))))
	(when (string-matchp regexp file)
	  (funcall (symbol-function func) file)
	  (return-from namazu-open t)
	)
      )
      (setq types (cdr types))
    )
    (namazu-open-xyzzy file)
  ))

(defun namazu-open-xyzzy (file)
  (pop-to-buffer (get-buffer-create *namazu-buffer-show*))
  (setq buffer-read-only nil)
  (erase-buffer (selected-buffer))
  (insert-file-contents file)
  (goto-char (point-min))
  (namazu-show-mode)
)

(defun namazu-open-system (file)
  (shell-execute file t))