1 ;;; egg/sj3.el --- SJ3 Support (high level interface) in Egg
2 ;;; Input Method Architecture
4 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
6 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
8 ;; Maintainer: TOMURA Satoru <tomura@etl.go.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.
38 "SJ3 interface for Tamago 4."
41 (defcustom sj3-hostname "localhost"
42 "Hostname of SJ3 server"
43 :group 'sj3 :type 'string)
45 (defcustom sj3-server-port 3086
46 "Port number of SJ3 server"
47 :group 'sj3 :type 'integer)
51 (defmacro SJ3-const (c)
52 (cond ((eq c 'FileNotExist) 35)
57 (sj3-register-1 "
\e$BEPO?<-=qL>
\e(B:")
58 (sj3-register-2 "
\e$BIJ;lL>
\e(B"))))
60 (defvar sj3-hinshi-menu
62 (menu "
\e$BIJ;l
\e(B:
\e$BL>;l
\e(B:"
64 ("
\e$BL>;l
\e(B(
\e$B$*!D
\e(B)" . 2)
65 ("
\e$BL>;l
\e(B(
\e$B$4!D
\e(B)" . 3)
66 ("
\e$BL>;l
\e(B(
\e$B!DE*
\e(B/
\e$B2=
\e(B)" . 4)
67 ("
\e$BL>;l
\e(B(
\e$B$*!D$9$k
\e(B)" . 5)
68 ("
\e$BL>;l
\e(B(
\e$B!D$9$k
\e(B)" . 6)
69 ("
\e$BL>;l
\e(B(
\e$B$4!D$9$k
\e(B)" . 7)
70 ("
\e$BL>;l
\e(B(
\e$B!D$J
\e(B/
\e$B$K
\e(B)" . 8)
71 ("
\e$BL>;l
\e(B(
\e$B$*!D$J
\e(B/
\e$B$K
\e(B)" . 9)
72 ("
\e$BL>;l
\e(B(
\e$B$4!D$J
\e(B/
\e$B$K
\e(B)" . 10)
73 ("
\e$BL>;l
\e(B(
\e$BI{;l
\e(B)" . 11))))
74 ("
\e$BBeL>;l
\e(B" . 12)
78 ("
\e$B8)
\e(B/
\e$B6hL>
\e(B" . 25)
80 (menu "
\e$BIJ;l
\e(B:
\e$BF0;l
\e(B:"
81 (("
\e$B%5JQ8l44
\e(B" . 80)
82 ("
\e$B%6JQ8l44
\e(B" . 81)
83 ("
\e$B0lCJITJQ2=It
\e(B" . 90)
84 ("
\e$B%+9T8^CJ8l44
\e(B" . 91)
85 ("
\e$B%,9T8^CJ8l44
\e(B" . 92)
86 ("
\e$B%59T8^CJ8l44
\e(B" . 93)
87 ("
\e$B%?9T8^CJ8l44
\e(B" . 94)
88 ("
\e$B%J9T8^CJ8l44
\e(B" . 95)
89 ("
\e$B%P9T8^CJ8l44
\e(B" . 96)
90 ("
\e$B%^9T8^CJ8l44
\e(B" . 97)
91 ("
\e$B%i9T8^CJ8l44
\e(B" . 98)
92 ("
\e$B%o9T8^CJ8l44
\e(B" . 99))))
93 ("
\e$BO"BN;l
\e(B" . 26)
94 ("
\e$B@\B3;l
\e(B" . 27)
95 ("
\e$B=u?t;l
\e(B" . 29)
97 ("
\e$B@\F,8l
\e(B" . 31)
98 ("
\e$B@\Hx8l
\e(B" . 36)
100 ("
\e$BI{;l
\e(B2" . 46)
101 ("
\e$B7AMF;l8l44
\e(B" . 60)
102 ("
\e$B7AMFF0;l8l44
\e(B" . 71)
103 ("
\e$BC14A;z
\e(B" . 189))
104 "Menu data for a hinshi (a part of speech) selection.")
106 (defun sj3-hinshi-name (id &optional menu alist)
107 "Return a hinshi (a part of speech) name corresponding to ID.
108 If ID is nil, return a flattened alist from `sj3-hinshi-menu'.
109 Don't specify the optional arguments in normal use."
110 (let ((menu (or menu sj3-hinshi-menu)))
112 (if (consp (cdr menu))
113 (mapcar (lambda (elem)
114 (setq alist (sj3-hinshi-name nil elem alist)))
116 (setq alist (nconc alist (list (cons (cdr menu) (car menu)))))))
118 (cdr (assq id alist))
121 (setplist 'sj3-conversion-backend
122 '(egg-start-conversion sj3-start-conversion
123 egg-get-bunsetsu-source sj3-get-bunsetsu-source
124 egg-get-bunsetsu-converted sj3-get-bunsetsu-converted
125 egg-get-source-language sj3-get-source-language
126 egg-get-converted-language sj3-get-converted-language
127 egg-list-candidates sj3-list-candidates
128 egg-decide-candidate sj3-decide-candidate
129 egg-change-bunsetsu-length sj3-change-bunsetsu-length
130 egg-end-conversion sj3-end-conversion
131 egg-word-registration sj3-word-registration))
133 (defconst sj3-backend-alist '((Japanese ((sj3-conversion-backend)))))
135 (egg-set-finalize-backend '(sj3-finalize-backend))
137 (defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
139 (defvar sj3-open-message)
141 (defun sj3-open (hostname)
142 "Establish the connection to SJ3 server. Return process object."
143 (let* ((buf (generate-new-buffer " *SJ3*"))
146 (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
148 (egg-error "failed to connect sj3 server")))
149 (process-kill-without-query proc)
150 (set-process-coding-system proc 'binary 'binary)
151 (set-marker-insertion-type (process-mark proc) t)
155 (buffer-disable-undo)
156 (set-buffer-multibyte nil))
157 ;; Initialize dictionaries
158 (setq sj3-sys-dict-list nil)
159 (setq sj3-user-dict-list nil)
160 (setq result (sj3rpc-open proc (system-name) (user-login-name)))
162 (let ((msg (sj3rpc-get-error-message (- result))))
163 (delete-process proc)
165 (egg-error "Can't open SJ3 session (%s): %s" hostname msg)))
166 (setq result (sj3rpc-get-stdy-size proc))
168 (let ((msg (sj3rpc-get-error-message (- result))))
169 (delete-process proc)
171 (egg-error "Can't get SJ3 STDYSIZE: %s"msg)))
172 (setq sj3-stdy-size result)
175 ;; (defun sj3-open (hostname-list)
176 ;; "Establish the connection to SJ3 server. Return process object."
177 ;; (let* ((buf (generate-new-buffer " *SJ3*"))
178 ;; (msg-form "SJ3: connecting to sj3serv at %s...")
179 ;; hostname proc result msg)
183 ;; (buffer-disable-undo)
184 ;; (setq enable-multibyte-characters nil))
186 ;; ((null hostname-list)
187 ;; (setq hostname-list '("localhost")))
188 ;; ((null (listp hostname-list))
189 ;; (setq hostname-list (list hostname-list))))
190 ;; (while (and hostname-list (null proc))
191 ;; (setq hostname (car hostname-list)
192 ;; hostname-list (cdr hostname-list))
193 ;; (message msg-form hostname)
195 ;; (condition-case result
196 ;; (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
200 ;; (process-kill-without-query proc)
201 ;; (set-process-coding-system proc 'binary 'binary)
202 ;; (set-marker-insertion-type (process-mark proc) t)
203 ;; ;; Initialize dictionaries
204 ;; (setq sj3-sys-dict-list nil)
205 ;; (setq sj3-user-dict-list nil)
206 ;; (setq result (sj3rpc-open proc (system-name) (user-login-name)))
209 ;; (delete-process proc)
211 ;; msg (format "Can't open SJ3 session (%s): %s"
213 ;; (setq result (sj3rpc-get-stdy-size proc))
216 ;; (delete-process proc)
218 ;; msg (format "Can't get SJ3 STDYSIZE: %s"
219 ;; (sj3rpc-get-error-message (- result)))))
220 ;; (setq sj3-stdy-size result))))))
223 ;; (setq sj3-open-message (format (concat msg-form "done") hostname))
226 ;; (error "%s" (or msg "no sj3serv available")))))
228 ;; <env> ::= [ <proc> <dictionary-list> ]
229 (defvar sj3-environment nil
230 "Environment for SJ3 kana-kanji conversion")
232 (defsubst sj3env-get-proc (env)
234 (defsubst sj3env-get-dictionary-list (env)
237 ;; <sj3-bunsetsu> ::=
238 ;; [ <env> <source> <converted> <rest> <stdy>
239 ;; <zenkouho> <zenkouho-pos> <zenkouho-converted>
240 ;; <kugiri-changed> ]
241 (defsubst sj3-make-bunsetsu (env source converted rest stdy)
243 'sj3-conversion-backend
244 (vector env source converted rest stdy nil nil nil nil nil)))
246 (defsubst sj3bunsetsu-get-env (b)
247 (aref (egg-bunsetsu-get-info b) 0))
248 (defsubst sj3bunsetsu-get-source (b)
249 (aref (egg-bunsetsu-get-info b) 1))
250 (defsubst sj3bunsetsu-get-converted (b)
251 (aref (egg-bunsetsu-get-info b) 2))
252 (defsubst sj3bunsetsu-get-rest (b)
253 (aref (egg-bunsetsu-get-info b) 3))
254 (defsubst sj3bunsetsu-get-stdy (b)
255 (aref (egg-bunsetsu-get-info b) 4))
257 (defsubst sj3bunsetsu-get-zenkouho (b)
258 (aref (egg-bunsetsu-get-info b) 5))
259 (defsubst sj3bunsetsu-set-zenkouho (b z)
260 (aset (egg-bunsetsu-get-info b) 5 z))
262 (defsubst sj3bunsetsu-get-zenkouho-pos (b)
263 (aref (egg-bunsetsu-get-info b) 6))
264 (defsubst sj3bunsetsu-set-zenkouho-pos (b zp)
265 (aset (egg-bunsetsu-get-info b) 6 zp))
267 (defsubst sj3bunsetsu-get-zenkouho-converted (b)
268 (aref (egg-bunsetsu-get-info b) 7))
269 (defsubst sj3bunsetsu-set-zenkouho-converted (b zc)
270 (aset (egg-bunsetsu-get-info b) 7 zc))
272 (defsubst sj3bunsetsu-get-kugiri-changed (b)
273 (aref (egg-bunsetsu-get-info b) 8))
274 (defsubst sj3bunsetsu-set-kugiri-changed (b s)
275 (aset (egg-bunsetsu-get-info b) 8 s))
277 (defun sj3-get-bunsetsu-source (b)
278 (sj3bunsetsu-get-source b))
280 (defun sj3-get-bunsetsu-converted (b)
281 (concat (sj3bunsetsu-get-converted b) (sj3bunsetsu-get-rest b)))
283 (defun sj3-get-source-language (b) 'Japanese)
284 (defun sj3-get-converted-language (b) 'Japanese)
285 (defun sj3-get-bunsetsu-stdy (b) (sj3bunsetsu-get-stdy b))
287 (defvar sj3-dictionary-specification
290 [("private.dic") ""])
291 "Dictionary specification of SJ3.")
293 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
294 "*Directory of user dictionary for SJ3.")
296 (defun sj3-filename (p)
298 (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
301 (defun sj3-get-environment ()
302 "Return the backend of SJ3 environment."
305 (let* ((proc (sj3-open sj3-hostname))
306 (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
307 (l (cdr sj3-dictionary-specification))
309 (sj3-open-freq-info proc freq-info-name)
314 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
317 (egg-error "Dame2") ; XXX
318 (setq dict-list (cons dic-id dict-list)
320 (setq sj3-environment (vector proc dict-list)))))
322 (defun sj3-open-freq-info (proc name)
326 (setq ret (sj3rpc-open-stdy proc name))
329 (message "
\e$B3X=,%U%!%$%k
\e(B(%s)
\e$B$,$"$j$^$;$s
\e(B" name)
330 (if (/= ret (SJ3-const FileNotExist))
331 (egg-error "Fatal1") ; XXX
333 (format "
\e$B3X=,%U%!%$%k
\e(B(%s)
\e$B$,$"$j$^$;$s!#:n$j$^$9$+
\e(B? "
335 (sj3rpc-make-directory proc
336 (file-name-directory name))
338 (= (sj3rpc-make-stdy proc name) 0))
339 (message "
\e$B3X=,%U%!%$%k
\e(B(%s)
\e$B$r:n$j$^$7$?
\e(B" name)
340 (egg-error "Fatal2"))))))) ; XXX
342 (defun sj3-open-dictionary (proc name passwd)
346 (setq ret (sj3rpc-open-dictionary proc name passwd))
349 (message "
\e$B<-=q%U%!%$%k
\e(B(%s)
\e$B$,$"$j$^$;$s
\e(B" name)
350 (setq ret (- ret)) ; Get error code.
351 (if (/= ret (SJ3-const FileNotExist))
352 (egg-error "Fatal3 %d" ret) ; XXX
354 (format "
\e$B<-=q%U%!%$%k
\e(B(%s)
\e$B$,$"$j$^$;$s!#:n$j$^$9$+
\e(B? "
356 (= (sj3rpc-make-dictionary proc name) 0))
357 (message "
\e$B<-=q%U%!%$%k
\e(B(%s)
\e$B$r:n$j$^$7$?
\e(B" name)
358 (egg-error "Fatal4"))))) ; XXX
361 (defun sj3-start-conversion (backend yomi &optional context)
362 "Convert YOMI string to kanji, and enter conversion mode.
363 Return the list of bunsetsu."
364 (let ((env (sj3-get-environment)))
365 (sj3rpc-begin env yomi)))
367 (defun sj3-end-conversion (bunsetsu-list abort)
370 (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
372 bunsetsu stdy kugiri-changed)
374 (setq bunsetsu (car l))
376 (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
378 (sj3rpc-bunsetsu-stdy env stdy))
380 (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed
382 (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
383 (yomi2 (sj3bunsetsu-get-source (car l))))
384 (if (/= kugiri-changed (length yomi1))
385 (sj3rpc-kugiri-stdy env yomi1 yomi2
386 (sj3bunsetsu-get-stdy (car l))))))))))
388 (defun sj3-list-candidates (bunsetsu prev-bunsetsu next-bunsetsu major)
389 (setq bunsetsu (car bunsetsu))
390 (if (sj3bunsetsu-get-zenkouho bunsetsu)
391 (cons (sj3bunsetsu-get-zenkouho-pos bunsetsu)
392 (sj3bunsetsu-get-zenkouho-converted bunsetsu))
393 (let* ((env (sj3bunsetsu-get-env bunsetsu))
394 (yomi (sj3bunsetsu-get-source bunsetsu))
395 (z (sj3rpc-get-bunsetsu-candidates env yomi)))
396 (sj3bunsetsu-set-zenkouho bunsetsu z)
397 (cons (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
398 (sj3bunsetsu-set-zenkouho-converted
400 (mapcar 'sj3bunsetsu-get-converted z))))))
402 (defun sj3-decide-candidate (bunsetsu candidate-pos prev-b next-b)
403 (setq bunsetsu (car bunsetsu))
404 (let* ((candidate-list (sj3bunsetsu-get-zenkouho bunsetsu))
405 (candidate (nth candidate-pos candidate-list)))
406 (sj3bunsetsu-set-zenkouho candidate candidate-list)
407 (sj3bunsetsu-set-zenkouho-pos candidate candidate-pos)
408 (sj3bunsetsu-set-zenkouho-converted
409 candidate (sj3bunsetsu-get-zenkouho-converted bunsetsu))
410 (list (list candidate))))
412 (defun sj3-change-bunsetsu-length (bunsetsu prev-b next-b len major)
413 (let ((yomi (mapconcat 'sj3bunsetsu-get-source bunsetsu nil))
414 (env (sj3bunsetsu-get-env (car bunsetsu)))
417 (setq yomi1 (substring yomi 0 len)
418 yomi2 (substring yomi len))
419 (setq new (sj3rpc-tanbunsetsu-conversion env yomi1))
420 ;; Only set once (memory original length of the bunsetsu).
421 (sj3bunsetsu-set-kugiri-changed new
422 (or (sj3bunsetsu-get-kugiri-changed old)
423 (length (sj3bunsetsu-get-source old))))
424 (if (> (length yomi2) 0)
425 (list (list new (sj3rpc-tanbunsetsu-conversion env yomi2)))
428 (defun sj3-finalize-backend ()
430 (let ((proc (sj3env-get-proc sj3-environment))
431 (dict-list (sj3env-get-dictionary-list sj3-environment))
434 (setq dict (car dict-list))
435 (setq dict-list (cdr dict-list))
436 (sj3rpc-close-dictionary proc dict)) ; XXX: check error
437 (sj3rpc-close-stdy proc)
439 (setq sj3-environment nil))))
441 ;;; word registration
443 (defun sj3-dictionary-select ()
444 (menudiag-select (list 'menu
445 (egg-get-message 'sj3-register-1)
446 (aref (nth 2 sj3-dictionary-specification) 0))))
448 (defun sj3-hinshi-select ()
449 (menudiag-select (list 'menu
450 (egg-get-message 'sj3-register-2)
453 (defun sj3-word-registration (backend kanji yomi)
454 "Register a word KANJI with a pronunciation YOMI."
455 (if (or (null (eq (egg-get-language 0 kanji)
456 (sj3-get-converted-language backend)))
457 (next-single-property-change 0 'egg-lang kanji)
458 (null (eq (egg-get-language 0 yomi)
459 (sj3-get-source-language backend)))
460 (next-single-property-change 0 'egg-lang yomi))
461 (egg-error "word registration: invalid character")
462 (let* ((env (sj3-get-environment))
463 (dic (sj3-dictionary-select))
464 (hinshi-id (sj3-hinshi-select))
465 (result (sj3rpc-add-word env
467 yomi kanji hinshi-id)))
469 (list (sj3-hinshi-name hinshi-id) dic)
470 (egg-error (sj3rpc-get-error-message (- result)))))))
475 (run-hooks 'sj3-load-hook)
478 (defun egg-activate-sj3 (&rest arg)
479 "Activate SJ3 backend of Tamago 4."
480 (apply 'egg-mode (append arg sj3-backend-alist)))
482 ;;; egg/sj3.el ends here.