;;; lookup-misc.el --- lookup-{select,history,help}-mode
;; Copyright (C) 1997,1998 NISHIDA Keisuke <knishida@ring.aist.go.jp>

;; Author: NISHIDA Keisuke <knishida@ring.aist.go.jp>
;; Version: $Id: lookup-misc.el,v 1.5 1999/01/27 18:29:26 kei Exp $

;; This file is part of Lookup.

;; Lookup 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 of the License, or
;; (at your option) any later version.

;; Lookup 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 Lookup; if not, write to the Free Software Foundation,
;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;; Code:

(require 'lookup)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;:  Lookup Select mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;:: Interface functions
;;;

(defun lookup-select-dictionary ()
  (interactive)
  (with-current-buffer (lookup-open-buffer "*Dictionary List*")
    (lookup-select-mode)
    (let ((inhibit-read-only t))
      (erase-buffer)
      (insert "Type `m' to select, `u' to unselect, `?' for help.\n\n")
      (lookup-table-insert
       "%c %-12t %-20t %s\n"
       (append '((?% "Identifier" "Title" "Method")
		 (?- "----------" "-----" "------"))
	       (mapcar (lambda (dict)
			 (list (if (lookup-dictionary-selected-p dict) ?* ? )
			       (lookup-dictionary-id dict)
			       (lookup-dictionary-title dict)
			       (mapconcat 'lookup-method-key
					  (lookup-dictionary-methods dict) "")))
		       (lookup-module-dictionaries lookup-current-module))))
      (goto-char (point-min))
      (forward-line 4))
    (lookup-pop-to-buffer (current-buffer))))


;;;
;:: Select mode
;;;

(defvar lookup-select-mode-map nil
  "*Keymap for Lookup Select mode.")

(unless lookup-select-mode-map
  (setq lookup-select-mode-map (make-sparse-keymap))
  (define-key lookup-select-mode-map " " 'lookup-select-next-line)
  (define-key lookup-select-mode-map "n" 'lookup-select-next-line)
  (define-key lookup-select-mode-map "p" 'lookup-select-previous-line)
  (define-key lookup-select-mode-map "m" 'lookup-select-do-select)
  (define-key lookup-select-mode-map "u" 'lookup-select-do-unselect)
  (define-key lookup-select-mode-map "a" 'lookup-select-do-select-all)
  (define-key lookup-select-mode-map "\C-m" 'lookup-select-do-select-only)
  (define-key lookup-select-mode-map "d" 'lookup-select-mark-disable)
  (define-key lookup-select-mode-map "x" 'lookup-select-do-execute)
;  (define-key lookup-select-mode-map "i" 'lookup-select-info)
  (define-key lookup-select-mode-map "M" 'lookup-select-menu)
  (define-key lookup-select-mode-map "f" 'lookup-select-search-pattern)
  (define-key lookup-select-mode-map "/" 'lookup-select-text-search)
  (define-key lookup-select-mode-map "g" 'lookup-select-update)
  (define-key lookup-select-mode-map "q" 'lookup-quit)
  (define-key lookup-select-mode-map "Q" 'lookup-exit)
  (define-key lookup-select-mode-map "R" 'lookup-restart)
  (define-key lookup-select-mode-map "?" 'lookup-select-help))

(defconst lookup-select-mode-help
  "Lookup Select モード:

`n'(ext)    - 次の辞書へ        `p'(revios) - 前の辞書へ

`m'(ark)    - 辞書を選択        `u'(nmark)  - 辞書を非選択
`a'(ll)     - 全ての辞書を選択  `RET'       - その辞書だけを選択
`d'(isable) - 辞書を無効化   (e)`x'(ecute)  - 無効化を実行

                                `M'(enu)    - 辞書のメニューを表示
`f'(ind)    - 検索を実行        `/'         - その辞書から全文検索

`q'    - バッファを抜ける       `g'    - モジュールを初期化し直す
`Q'    - Lookup を終了する      `R'    - Lookup を再起動する")

(defvar lookup-select-mode-hook nil)

(defun lookup-select-mode ()
  (interactive)
  (kill-all-local-variables)
  (buffer-disable-undo)
  (setq major-mode 'lookup-select-mode)
  (setq mode-name "Select")
  (setq mode-line-buffer-identification '("Lookup: %12b"))
  (setq buffer-read-only t)
  (setq truncate-lines t)
  (use-local-map lookup-select-mode-map)
  (run-hooks 'lookup-select-mode-hook))

;;;
;:: Interactive commands
;;;

(defun lookup-select-next-line ()
  "次の行に進む。"
  (interactive)
  (if (eobp) (ding)
    (forward-line)))

(defun lookup-select-previous-line ()
  "前の行に戻る。"
  (interactive)
  (if (bobp) (ding)
    (forward-line -1)))

(defun lookup-select-do-select ()
  "ポイント行の辞書を選択する。"
  (interactive)
  (lookup-select-set-selected t))

(defun lookup-select-do-unselect ()
  "ポイント行の辞書を非選択にする。"
  (interactive)
  (lookup-select-set-selected nil))

(defun lookup-select-toggle-selected ()
  "ポイント行の辞書の選択状態をトグルする。"
  (interactive)
  (let ((dict (lookup-select-current-line-dictionary)))
    (lookup-select-set-selected
     (not (lookup-dictionary-selected-p dict)))))

(defun lookup-select-do-select-all ()
  "全ての辞書を選択する。"
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (forward-line 4)
    (while (not (eobp))
      (lookup-select-set-selected t))))

(defun lookup-select-do-select-only ()
  "ポイント行の辞書のみを選択する。"
  (interactive)
  (if (not (lookup-select-current-line-dictionary))
      (error "No dictionary on current line")
    (save-excursion
      (goto-char (point-min))
      (forward-line 4)
      (while (not (eobp))
	(lookup-select-set-selected nil)))
    (lookup-select-set-selected t t)))

(defun lookup-select-mark-disable ()
  "ポイント行の辞書に無効化のマークを付ける。"
  (interactive)
  (lookup-select-mark ?D t))

(defun lookup-select-do-execute ()
  "無効化を実行する。"
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (forward-line 4)
    (let ((inhibit-read-only t)
	  (dicts (lookup-module-dictionaries lookup-current-module)))
      (while (re-search-forward "^D" nil t)
	(setq dicts (delq (lookup-select-current-line-dictionary) dicts))
	(beginning-of-line)
	(kill-line t))
      (lookup-module-set-dictionaries lookup-current-module dicts))))

(defun lookup-select-menu ()
  "辞書がメニューに対応している場合、それを参照する。"
  (interactive)
  (let* ((dict (lookup-select-current-line-dictionary))
	 (entries (lookup-vse-get-menu dict)))
    (if entries
	(let* ((title (lookup-dictionary-title dict))
	       (query (lookup-make-query 'reference title))
	       (session (lookup-make-session query entries)))
	  (lookup-open-session session))
      (error "This dictionary has no menu"))))

(defun lookup-select-search-pattern (pattern &optional force)
  "選択された辞書から検索を行なう。"
  (interactive "sLook up: \nP")
  (let ((lookup-force-update force))
    (lookup-search-pattern pattern)))

(defun lookup-select-text-search (string &optional force)
  "ポイント行の辞書から全文検索を行なう。"
  (interactive
   (list (let ((dictionary (lookup-select-current-line-dictionary)))
	   (if (memq 'text (lookup-dictionary-methods dictionary))
	       (lookup-read-string "Look up" nil 'lookup-input-history)
	     (error "This dictionary does not support text search")))
	 current-prefix-arg))
  (let ((dictionary (lookup-select-current-line-dictionary))
	(query (lookup-make-query 'text string))
	entries)
    (message "searcing...")
    (setq entries (lookup-vse-search-query dictionary query))
    (lookup-open-session (lookup-make-session query entries))
    (message "searcing...done")))

(defun lookup-select-update ()
  "現在の検索モジュールを初期化し直す。
ただし、設定ファイルで設定を変更した場合、それを反映させるには
\\[lookup-restart] を用いる必要がある。"
  (interactive)
  (lookup-module-clear lookup-current-module)
  (lookup-module-init lookup-current-module)
  (lookup-select-dictionary))

(defun lookup-select-help ()
  "Select モードの簡易ヘルプを表示する。"
  (interactive)
  (with-current-buffer (lookup-open-buffer (lookup-help-buffer))
    (help-mode)
    (let ((inhibit-read-only t))
      (erase-buffer)
      (insert lookup-select-mode-help))
    (lookup-display-help (current-buffer))))

;;;
;:: Internal functions
;;;

(defun lookup-select-current-line-dictionary ()
  (save-excursion
    (beginning-of-line)
    (forward-char 2)
    (when (looking-at "[^ ]+")
      (lookup-module-get-dictionary lookup-current-module (match-string 0)))))

(defun lookup-select-set-selected (value &optional dont-move)
  (let ((dict (lookup-select-current-line-dictionary)))
    (when dict
      (lookup-dictionary-set-selected dict value)
      (lookup-select-mark (if value ?* ? ) (not dont-move)))))

(defun lookup-select-mark (mark &optional down-after)
  (save-excursion
    (let ((inhibit-read-only t))
      (beginning-of-line)
      (delete-char 1)
      (insert-char mark 1)))
  (if down-after (forward-line)))

(provide 'lookup-select)

;;; lookup-misc.el ends here
