cgit.sxemacs.org Git - packages/blob - mule-packages/lookup/lisp/lookup-misc.el

   1 ;;; lookup-misc.el --- lookup-{select,history,help}-mode
   2 ;; Copyright (C) 1997,1998 NISHIDA Keisuke <knishida@ring.aist.go.jp>
   3
   4 ;; Author: NISHIDA Keisuke <knishida@ring.aist.go.jp>
   5 ;; Version: $Id: lookup-misc.el,v 1.5 1999/01/27 18:29:26 kei Exp $
   6
   7 ;; This file is part of Lookup.
   8
   9 ;; Lookup is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; Lookup is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with Lookup; if not, write to the Free Software Foundation,
  21 ;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 ;;; Code:
  24
  25 (require 'lookup)
  26
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;:  Lookup Select mode
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30
  31 ;;;
  32 ;:: Interface functions
  33 ;;;
  34
  35 (defun lookup-select-dictionary ()
  36   (interactive)
  37   (with-current-buffer (lookup-open-buffer "*Dictionary List*")
  38     (lookup-select-mode)
  39     (let ((inhibit-read-only t))
  40       (erase-buffer)
  41       (insert "Type `m' to select, `u' to unselect, `?' for help.\n\n")
  42       (lookup-table-insert
  43        "%c %-12t %-20t %s\n"
  44        (append '((?% "Identifier" "Title" "Method")
  45                  (?- "----------" "-----" "------"))
  46                (mapcar (lambda (dict)
  47                          (list (if (lookup-dictionary-selected-p dict) ?* ? )
  48                                (lookup-dictionary-id dict)
  49                                (lookup-dictionary-title dict)
  50                                (mapconcat 'lookup-method-key
  51                                           (lookup-dictionary-methods dict) "")))
  52                        (lookup-module-dictionaries lookup-current-module))))
  53       (goto-char (point-min))
  54       (forward-line 4))
  55     (lookup-pop-to-buffer (current-buffer))))
  56
  57
  58 ;;;
  59 ;:: Select mode
  60 ;;;
  61
  62 (defvar lookup-select-mode-map nil
  63   "*Keymap for Lookup Select mode.")
  64
  65 (unless lookup-select-mode-map
  66   (setq lookup-select-mode-map (make-sparse-keymap))
  67   (define-key lookup-select-mode-map " " 'lookup-select-next-line)
  68   (define-key lookup-select-mode-map "n" 'lookup-select-next-line)
  69   (define-key lookup-select-mode-map "p" 'lookup-select-previous-line)
  70   (define-key lookup-select-mode-map "m" 'lookup-select-do-select)
  71   (define-key lookup-select-mode-map "u" 'lookup-select-do-unselect)
  72   (define-key lookup-select-mode-map "a" 'lookup-select-do-select-all)
  73   (define-key lookup-select-mode-map "\C-m" 'lookup-select-do-select-only)
  74   (define-key lookup-select-mode-map "d" 'lookup-select-mark-disable)
  75   (define-key lookup-select-mode-map "x" 'lookup-select-do-execute)
  76 ;  (define-key lookup-select-mode-map "i" 'lookup-select-info)
  77   (define-key lookup-select-mode-map "M" 'lookup-select-menu)
  78   (define-key lookup-select-mode-map "f" 'lookup-select-search-pattern)
  79   (define-key lookup-select-mode-map "/" 'lookup-select-text-search)
  80   (define-key lookup-select-mode-map "g" 'lookup-select-update)
  81   (define-key lookup-select-mode-map "q" 'lookup-quit)
  82   (define-key lookup-select-mode-map "Q" 'lookup-exit)
  83   (define-key lookup-select-mode-map "R" 'lookup-restart)
  84   (define-key lookup-select-mode-map "?" 'lookup-select-help))
  85
  86 (defconst lookup-select-mode-help
  87   "Lookup Select \e$B%b!<%I\e(B:
  88
  89 `n'(ext)    - \e$B<!$N<-=q$X\e(B        `p'(revios) - \e$BA0$N<-=q$X\e(B
  90
  91 `m'(ark)    - \e$B<-=q$rA*Br\e(B        `u'(nmark)  - \e$B<-=q$rHsA*Br\e(B
  92 `a'(ll)     - \e$BA4$F$N<-=q$rA*Br\e(B  `RET'       - \e$B$=$N<-=q$@$1$rA*Br\e(B
  93 `d'(isable) - \e$B<-=q$rL58z2=\e(B   (e)`x'(ecute)  - \e$BL58z2=$r<B9T\e(B
  94
  95                                 `M'(enu)    - \e$B<-=q$N%a%K%e!<$rI=<(\e(B
  96 `f'(ind)    - \e$B8!:w$r<B9T\e(B        `/'         - \e$B$=$N<-=q$+$iA4J88!:w\e(B
  97
  98 `q'    - \e$B%P%C%U%!$rH4$1$k\e(B       `g'    - \e$B%b%8%e!<%k$r=i4|2=$7D>$9\e(B
  99 `Q'    - Lookup \e$B$r=*N;$9$k\e(B      `R'    - Lookup \e$B$r:F5/F0$9$k\e(B")
 100
 101 (defvar lookup-select-mode-hook nil)
 102
 103 (defun lookup-select-mode ()
 104   (interactive)
 105   (kill-all-local-variables)
 106   (buffer-disable-undo)
 107   (setq major-mode 'lookup-select-mode)
 108   (setq mode-name "Select")
 109   (setq mode-line-buffer-identification '("Lookup: %12b"))
 110   (setq buffer-read-only t)
 111   (setq truncate-lines t)
 112   (use-local-map lookup-select-mode-map)
 113   (run-hooks 'lookup-select-mode-hook))
 114
 115 ;;;
 116 ;:: Interactive commands
 117 ;;;
 118
 119 (defun lookup-select-next-line ()
 120   "\e$B<!$N9T$K?J$`!#\e(B"
 121   (interactive)
 122   (if (eobp) (ding)
 123     (forward-line)))
 124
 125 (defun lookup-select-previous-line ()
 126   "\e$BA0$N9T$KLa$k!#\e(B"
 127   (interactive)
 128   (if (bobp) (ding)
 129     (forward-line -1)))
 130
 131 (defun lookup-select-do-select ()
 132   "\e$B%]%$%s%H9T$N<-=q$rA*Br$9$k!#\e(B"
 133   (interactive)
 134   (lookup-select-set-selected t))
 135
 136 (defun lookup-select-do-unselect ()
 137   "\e$B%]%$%s%H9T$N<-=q$rHsA*Br$K$9$k!#\e(B"
 138   (interactive)
 139   (lookup-select-set-selected nil))
 140
 141 (defun lookup-select-toggle-selected ()
 142   "\e$B%]%$%s%H9T$N<-=q$NA*Br>uBV$r%H%0%k$9$k!#\e(B"
 143   (interactive)
 144   (let ((dict (lookup-select-current-line-dictionary)))
 145     (lookup-select-set-selected
 146      (not (lookup-dictionary-selected-p dict)))))
 147
 148 (defun lookup-select-do-select-all ()
 149   "\e$BA4$F$N<-=q$rA*Br$9$k!#\e(B"
 150   (interactive)
 151   (save-excursion
 152     (goto-char (point-min))
 153     (forward-line 4)
 154     (while (not (eobp))
 155       (lookup-select-set-selected t))))
 156
 157 (defun lookup-select-do-select-only ()
 158   "\e$B%]%$%s%H9T$N<-=q$N$_$rA*Br$9$k!#\e(B"
 159   (interactive)
 160   (if (not (lookup-select-current-line-dictionary))
 161       (error "No dictionary on current line")
 162     (save-excursion
 163       (goto-char (point-min))
 164       (forward-line 4)
 165       (while (not (eobp))
 166         (lookup-select-set-selected nil)))
 167     (lookup-select-set-selected t t)))
 168
 169 (defun lookup-select-mark-disable ()
 170   "\e$B%]%$%s%H9T$N<-=q$KL58z2=$N%^!<%/$rIU$1$k!#\e(B"
 171   (interactive)
 172   (lookup-select-mark ?D t))
 173
 174 (defun lookup-select-do-execute ()
 175   "\e$BL58z2=$r<B9T$9$k!#\e(B"
 176   (interactive)
 177   (save-excursion
 178     (goto-char (point-min))
 179     (forward-line 4)
 180     (let ((inhibit-read-only t)
 181           (dicts (lookup-module-dictionaries lookup-current-module)))
 182       (while (re-search-forward "^D" nil t)
 183         (setq dicts (delq (lookup-select-current-line-dictionary) dicts))
 184         (beginning-of-line)
 185         (kill-line t))
 186       (lookup-module-set-dictionaries lookup-current-module dicts))))
 187
 188 (defun lookup-select-menu ()
 189   "\e$B<-=q$,%a%K%e!<$KBP1~$7$F$$$k>l9g!"$=$l$r;2>H$9$k!#\e(B"
 190   (interactive)
 191   (let* ((dict (lookup-select-current-line-dictionary))
 192          (entries (lookup-vse-get-menu dict)))
 193     (if entries
 194         (let* ((title (lookup-dictionary-title dict))
 195                (query (lookup-make-query 'reference title))
 196                (session (lookup-make-session query entries)))
 197           (lookup-open-session session))
 198       (error "This dictionary has no menu"))))
 199
 200 (defun lookup-select-search-pattern (pattern &optional force)
 201   "\e$BA*Br$5$l$?<-=q$+$i8!:w$r9T$J$&!#\e(B"
 202   (interactive "sLook up: \nP")
 203   (let ((lookup-force-update force))
 204     (lookup-search-pattern pattern)))
 205
 206 (defun lookup-select-text-search (string &optional force)
 207   "\e$B%]%$%s%H9T$N<-=q$+$iA4J88!:w$r9T$J$&!#\e(B"
 208   (interactive
 209    (list (let ((dictionary (lookup-select-current-line-dictionary)))
 210            (if (memq 'text (lookup-dictionary-methods dictionary))
 211                (lookup-read-string "Look up" nil 'lookup-input-history)
 212              (error "This dictionary does not support text search")))
 213          current-prefix-arg))
 214   (let ((dictionary (lookup-select-current-line-dictionary))
 215         (query (lookup-make-query 'text string))
 216         entries)
 217     (message "searcing...")
 218     (setq entries (lookup-vse-search-query dictionary query))
 219     (lookup-open-session (lookup-make-session query entries))
 220     (message "searcing...done")))
 221
 222 (defun lookup-select-update ()
 223   "\e$B8=:_$N8!:w%b%8%e!<%k$r=i4|2=$7D>$9!#\e(B
 224 \e$B$?$@$7!"@_Dj%U%!%$%k$G@_Dj$rJQ99$7$?>l9g!"$=$l$rH?1G$5$;$k$K$O\e(B
 225 \\[lookup-restart] \e$B$rMQ$$$kI,MW$,$"$k!#\e(B"
 226   (interactive)
 227   (lookup-module-clear lookup-current-module)
 228   (lookup-module-init lookup-current-module)
 229   (lookup-select-dictionary))
 230
 231 (defun lookup-select-help ()
 232   "Select \e$B%b!<%I$N4J0W%X%k%W$rI=<($9$k!#\e(B"
 233   (interactive)
 234   (with-current-buffer (lookup-open-buffer (lookup-help-buffer))
 235     (help-mode)
 236     (let ((inhibit-read-only t))
 237       (erase-buffer)
 238       (insert lookup-select-mode-help))
 239     (lookup-display-help (current-buffer))))
 240
 241 ;;;
 242 ;:: Internal functions
 243 ;;;
 244
 245 (defun lookup-select-current-line-dictionary ()
 246   (save-excursion
 247     (beginning-of-line)
 248     (forward-char 2)
 249     (when (looking-at "[^ ]+")
 250       (lookup-module-get-dictionary lookup-current-module (match-string 0)))))
 251
 252 (defun lookup-select-set-selected (value &optional dont-move)
 253   (let ((dict (lookup-select-current-line-dictionary)))
 254     (when dict
 255       (lookup-dictionary-set-selected dict value)
 256       (lookup-select-mark (if value ?* ? ) (not dont-move)))))
 257
 258 (defun lookup-select-mark (mark &optional down-after)
 259   (save-excursion
 260     (let ((inhibit-read-only t))
 261       (beginning-of-line)
 262       (delete-char 1)
 263       (insert-char mark 1)))
 264   (if down-after (forward-line)))
 265
 266 (provide 'lookup-select)
 267
 268 ;;; lookup-misc.el ends here