1 ;;; egg.el --- EGG Input Method Architecture
3 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
5 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
7 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
8 ;; KATAYAMA Yoshio <kate@pfu.co.jp>
9 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
10 ;; Keywords: mule, multilingual, input method
12 ;; This file is part of EGG.
14 ;; EGG is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; EGG is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
34 (defvar egg-mode-preference t
35 "Non-nil if modefull.")
37 (defvar egg-default-language)
38 (defvar egg-last-method-name)
39 (make-variable-buffer-local 'egg-last-method-name)
42 (defun egg-mode (&rest arg)
53 ((egg-get-bunsetsu-info (point))
54 (egg-exit-conversion)))
55 (setq describe-current-input-method-function nil)
56 (setq current-input-method nil)
57 (use-local-map (keymap-parent (current-local-map)))
58 (remove-hook 'input-method-activate-hook 'its-set-mode-line-title t)
59 (force-mode-line-update))
61 (if (null (string= (car arg) egg-last-method-name))
64 (setq egg-default-language its-current-language)))
65 (setq egg-last-method-name (car arg))
66 (use-local-map (if egg-mode-preference
69 (setq inactivate-current-input-method-function 'egg-mode)
70 (setq describe-current-input-method-function 'egg-help)
71 (make-local-hook 'input-method-activate-hook)
72 (add-hook 'input-method-activate-hook 'its-set-mode-line-title nil t)))
74 (defun egg-modefull-map ()
75 "Generate modefull keymap for EGG mode."
76 (let ((map (make-sparse-keymap))
78 ;; BAD BAD BAD it should be UNDO
79 ;; (define-key map "\C-_" 'egg-jis-code-input)
81 (define-key map (vector i) 'egg-self-insert-char)
83 (its-define-select-keys map)
84 (set-keymap-parent map (current-local-map))
87 (defun egg-modeless-map ()
88 "Generate modeless keymap for EGG mode."
89 (let ((map (make-sparse-keymap)))
90 (define-key map " " 'mlh-space-bar-backward-henkan)
91 (define-key map "\C-_" 'egg-jis-code-input)
92 (set-keymap-parent map (current-local-map))
95 (defun egg-self-insert-char ()
97 (its-start last-command-char))
99 (defvar egg-mark-list nil)
100 (defvar egg-suppress-marking nil)
102 (defun egg-set-face (beg eng face &optional object)
103 (put face 'face face)
104 (add-text-properties beg eng
107 'modification-hooks '(egg-mark-modification))
110 (defun egg-mark-modification (beg end)
111 (if (and (null egg-suppress-marking)
112 (or (get-text-property beg 'egg-face)
113 (setq beg (next-single-property-change beg 'egg-face)))
114 (or (get-text-property (1- end) 'egg-face)
115 (setq end (previous-single-property-change end 'egg-face)))
117 (let ((list egg-mark-list)
120 (add-hook 'post-command-hook 'egg-redraw-face t)
121 (setq list egg-mark-list)
122 (while (and list (< found 2))
123 (setq pair (car list)
127 b (marker-position mb)
128 e (marker-position me))
130 ;; no overwrapping -- SKIP
131 ((or (null (eq (marker-buffer mb) (current-buffer)))
132 (or (> beg e) (< end b))))
133 ;; completely included
134 ((and (>= beg b) (<= end e))
136 ;; partially overwrapping
140 (setq egg-mark-list (delete pair egg-mark-list)
146 (setq b (make-marker)
148 egg-mark-list (cons (cons b e) egg-mark-list))
150 (set-marker e end))))))
152 (defun egg-redraw-face ()
153 (let ((inhibit-read-only t)
154 (inhibit-point-motion-hooks t)
155 (egg-suppress-marking t)
157 (org-buffer (current-buffer))
160 (setq egg-mark-list nil)
161 (remove-hook 'post-command-hook 'egg-redraw-face)
163 (setq mb (car (car list))
166 (when (marker-buffer mb)
167 (set-buffer (marker-buffer mb))
168 (let ((before-change-functions nil) (after-change-functions nil))
171 (setq b (max mb (point-min))
172 e (min me (point-max)))
176 (if (null (get-text-property b 'egg-face))
177 (setq b (next-single-property-change b 'egg-face nil e)))
178 (setq p (next-single-property-change b 'egg-face nil e))
181 (setq str (buffer-substring b p))
183 (remove-text-properties 0 (- p b) '(face) str)
186 (set-buffer org-buffer)
187 (goto-char org-point)))
189 (defun egg-hinshi-select ()
190 (menudiag-select ; Should generate at initialization time
191 '(menu "
\e$BIJ;lL>
\e(B:"
192 (("
\e$BIaDLL>;l
\e(B" .
193 (menu "
\e$BIJ;lL>
\e(B[
\e$BIaDLL>;l
\e(B]:"
194 ("
\e$BL>;l
\e(B" "
\e$B%59T
\e(B(
\e$B$9$k
\e(B)&
\e$BL>;l
\e(B" "
\e$B0lCJ
\e(B&
\e$BL>;l
\e(B"
195 "
\e$B7AMFF0;l
\e(B&
\e$BL>;l
\e(B" "
\e$B?t;l
\e(B")))
196 ("
\e$B8GM-L>;l
\e(B" .
197 (menu "
\e$BIJ;lL>
\e(B[
\e$B8GM-L>;l
\e(B]:"
198 ("
\e$B?ML>
\e(B" "
\e$BCOL>
\e(B" "
\e$B?ML>
\e(B&
\e$BCOL>
\e(B" "
\e$B8GM-L>;l
\e(B")))
200 (menu "
\e$BIJ;lL>
\e(B[
\e$BF0;l
\e(B]:"
201 ("
\e$B0lCJ
\e(B" "
\e$B0lCJ
\e(B&
\e$BL>;l
\e(B" "
\e$B%+9T8^CJ
\e(B" "
\e$B%,9T8^CJ
\e(B"
202 "
\e$B%59T8^CJ
\e(B" "
\e$B%?9T8^CJ
\e(B")))
203 ("
\e$BFC<l$JF0;l
\e(B" .
204 (menu "
\e$BIJ;lL>
\e(B[
\e$BFC<l$JF0;l
\e(B]:"
205 ("
\e$B%+9T
\e(B(
\e$B9T$/
\e(B)" "
\e$B%i9T
\e(B(
\e$B2<$5$$
\e(B)" "
\e$BMh
\e(B(
\e$B$3
\e(B)"
206 "
\e$BMh
\e(B(
\e$B$-
\e(B)" "
\e$BMh
\e(B(
\e$B$/
\e(B)" "
\e$B0Y
\e(B(
\e$B$7
\e(B)")))
207 ("
\e$BF0;l0J30$NMQ8@
\e(B" .
208 (menu "
\e$BIJ;lL>
\e(B[
\e$BF0;l0J30$NMQ8@
\e(B]:"
209 ("
\e$B7AMF;l
\e(B" "
\e$B7AMFF0;l
\e(B" "
\e$B7AMFF0;l
\e(B&
\e$BL>;l
\e(B"
210 "
\e$B7AMFF0;l
\e(B(
\e$B$?$k
\e(B)")))))))
212 ;; XXX: Should use backend interface
213 (defun egg-toroku-region (start end)
215 (let* ((env (wnn-get-environment wnn-dictionary-specification)) ; XXX
216 (kanji (buffer-substring start end))
217 (yomi (read-multilingual-string
218 (format "
\e$B<-=qEPO?!X
\e(B%s
\e$B!Y
\e(B
\e$BFI$_
\e(B:" kanji)))
219 (dic (menudiag-select (list 'menu "
\e$BEPO?<-=qL>
\e(B:"
221 (wnn-list-writable-dictionaries-byname env))))
222 (dic-name (wnn-dict-name dic))
223 (hinshi (egg-hinshi-select))
224 (hinshi-id (wnn-hinshi-number env hinshi)))
226 (format "
\e$B<-=q9`L\!X
\e(B%s
\e$B!Y
\e(B(%s: %s)
\e$B$r
\e(B %s
\e$B$KEPO?$7$^$9
\e(B"
227 kanji yomi hinshi dic-name))
228 (let ((r (wnn-add-word env dic yomi kanji "" hinshi-id 0)))
230 (error "
\e$B<-=qEPO?!X
\e(B%s
\e$B!Y
\e(B(%s: %s) %s
\e$B$K<:GT$7$^$7$?
\e(B: %s"
231 kanji yomi hinshi dic-name
232 (wnnrpc-get-error-message (- r)))
234 "
\e$B<-=q9`L\!X
\e(B%s
\e$B!Y
\e(B(%s: %s)
\e$B$r
\e(B %s
\e$B$KEPO?$7$^$7$?
\e(B"
235 kanji yomi hinshi dic-name))))))
238 ;;; auto fill controll
241 (defun egg-do-auto-fill ()
242 (if (and auto-fill-function (> (current-column) fill-column))
243 (let ((ocolumn (current-column)))
244 (funcall auto-fill-function)
245 (while (and (< fill-column (current-column))
246 (< (current-column) ocolumn))
247 (setq ocolumn (current-column))
248 (funcall auto-fill-function)))))
255 (require 'custom) ; Really?
258 "Tamagotchy --- EGG Versio 4.0")
260 (add-hook 'kill-emacs-hook 'egg-kill-emacs-function)
261 (defun egg-kill-emacs-function ()
262 (egg-finalize-backend))