1 ;;; egg/canna.el --- Canna Support (high level interface) in
2 ;;; Egg 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.
37 "CANNA interface for Tamago 4."
40 (defcustom canna-hostname "localhost"
41 "Hostname of CANNA server"
42 :group 'canna :type 'string)
44 (defcustom canna-server-port 5680
45 "Port number of CANNA server"
46 :group 'canna :type 'integer)
48 (defcustom canna-user-name nil
49 "User Name on CANNA server"
50 :group 'canna :type 'string)
52 (defcustom canna-group-name nil
53 "Group Name on CANNA server"
54 :group 'canna :type 'string)
57 ; (defmacro CANNA-const (c)
58 ; (cond ((eq c 'FileNotExist) xxxxxxxxxxxxxx)
63 (canna-connect-error "
\e$B%5!<%P$H@\B3$G$-$^$;$s$G$7$?
\e(B")
64 (canna-fail-make-env "
\e$B4D6-$r:n$k$3$H$O$G$-$^$;$s$G$7$?
\e(B")
65 (canna-dict-missing-1 "
\e$B<-=q%U%!%$%k
\e(B %s
\e$B$,$"$j$^$;$s!#
\e(B")
66 (canna-dict-missing-2 "
\e$B<-=q%U%!%$%k
\e(B %s
\e$B$,$"$j$^$;$s!#:n$j$^$9$+
\e(B? ")
67 (canna-dict-created "
\e$B<-=q%U%!%$%k
\e(B %s
\e$B$r:n$j$^$7$?
\e(B")
68 (canna-dict-saving "%s
\e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9
\e(B")
69 (canna-dict-saved "%s
\e$B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?
\e(B")
70 (canna-register-1 "
\e$BEPO?<-=qL>
\e(B:")
71 (canna-register-2 "
\e$BIJ;lL>
\e(B"))))
73 (defvar canna-hinshi-alist
74 '(("
\e$B?ML>
\e(B" . "#JN") ("
\e$BCOL>
\e(B" . "#CN") ("
\e$B8GM-L>;l
\e(B" . "#KK")
75 ("
\e$B0lHLL>;l
\e(B" . "#T35") ("
\e$BL>;l
\e(B(
\e$BNc
\e(B)
\e$B6/NO$J
\e(B" . "#T15")
76 ("
\e$B%5JQL>;l
\e(B" . "#T30") ("
\e$B%5JQL>;l
\e(B(
\e$BNc
\e(B)
\e$B0B?4$J
\e(B" . "#T10") ("
\e$BC14A;z
\e(B" . "#KJ")
77 ("
\e$BF0;l%+9TJQ3J3hMQ
\e(B" . "#KX") ("
\e$BF0;l%s%69TJQ3J3hMQ
\e(B" . "#NZX")
78 ("
\e$BF0;l%69TJQ3J3hMQ
\e(B" . "#ZX") ("
\e$BF0;l%59TJQ3J3hMQ
\e(B" . "#SX")
79 ("
\e$BF0;l%+9T8^CJ3hMQ
\e(B" . "#K5") ("
\e$BF0;l%,9T8^CJ3hMQ
\e(B" . "#G5")
80 ("
\e$BF0;l%59T8^CJ3hMQ
\e(B" . "#S5") ("
\e$BF0;l%?9T8^CJ3hMQ
\e(B" . "#T5")
81 ("
\e$BF0;l%J9T8^CJ3hMQ
\e(B" . "#N5") ("
\e$BF0;l%P9T8^CJ3hMQ
\e(B" . "#B5")
82 ("
\e$BF0;l%^9T8^CJ3hMQ
\e(B" . "#M5") ("
\e$BF0;l%i9T8^CJ3hMQ
\e(B" . "#R5")
83 ("
\e$BF0;l%o9T8^CJ3hMQ
\e(B" . "#W5") ("
\e$BF0;l>e2<0lCJ3hMQ
\e(B" . "#KS")
84 ("
\e$BF0;l%+9T8^CJO"MQL>;l
\e(B" . "#K5r") ("
\e$BF0;l%,9T8^CJO"MQL>;l
\e(B" . "#G5r")
85 ("
\e$BF0;l%59T8^CJO"MQL>;l
\e(B" . "#S5r") ("
\e$BF0;l%?9T8^CJO"MQL>;l
\e(B" . "#T5r")
86 ("
\e$BF0;l%J9T8^CJO"MQL>;l
\e(B" . "#N5r") ("
\e$BF0;l%P9T8^CJO"MQL>;l
\e(B" . "#B5r")
87 ("
\e$BF0;l%^9T8^CJO"MQL>;l
\e(B" . "#M5r") ("
\e$BF0;l%i9T8^CJO"MQL>;l
\e(B" . "#R5r")
88 ("
\e$BF0;l%o9T8^CJO"MQL>;l
\e(B" . "#W5r") ("
\e$BF0;l>e2<0lCJ8l44L>;l
\e(B" . "#KSr")
89 ("
\e$B7AMF;l
\e(B" . "#KY") ("
\e$B7AMF;l
\e(B(
\e$BNc
\e(B)
\e$B$-$$$m$$
\e(B" . "#KYT")
90 ("
\e$B7AMFF0;l
\e(B" . "#T05")
91 ("
\e$B7AMFF0;l
\e(B(
\e$BNc
\e(B)
\e$B4X?4$@
\e(B" . "#T10") ("
\e$B7AMFF0;l
\e(B(
\e$BNc
\e(B)
\e$BB?92$F$@
\e(B" . "#T13")
92 ("
\e$B7AMFF0;l
\e(B(
\e$BNc
\e(B)
\e$B0U30$@
\e(B" . "#T15") ("
\e$B7AMFF0;l
\e(B(
\e$BNc
\e(B)
\e$BJXMx$@
\e(B" . "#T18")
93 ("
\e$BI{;l
\e(B" . "#F14") ("
\e$BI{;l
\e(B(
\e$BNc
\e(B)
\e$B$U$C$/$i
\e(B" . "#F04")
94 ("
\e$BI{;l
\e(B(
\e$BNc
\e(B)
\e$B$=$C$H
\e(B" . "#F12") ("
\e$BI{;l
\e(B(
\e$BNc
\e(B)
\e$BFMA3
\e(B" . "#F06")
95 ("
\e$B?t;l
\e(B" . "#NN") ("
\e$B@\B3;l!&46F0;l
\e(B" . "#CJ") ("
\e$BO"BN;l
\e(B" . "#RT")))
97 (defvar canna-hinshi-menu
98 '("
\e$B?ML>
\e(B" "
\e$BCOL>
\e(B" ("
\e$BCDBN!&2q<RL>
\e(B" . "
\e$B8GM-L>;l
\e(B") ("
\e$BL>;l
\e(B" . MEISHI)
99 ("
\e$B%5JQL>;l
\e(B" . SAHEN-MEISHI) "
\e$BC14A;z
\e(B" ("
\e$BF0;l
\e(B" . DOUSHI)
100 ("
\e$B7AMF;l
\e(B" . KEIYOUSHI) ("
\e$B7AMFF0;l
\e(B" . KEIYOUDOUSHI) ("
\e$BI{;l
\e(B" . FUKUSHI)
101 "
\e$B?t;l
\e(B" "
\e$B@\B3;l!&46F0;l
\e(B" "
\e$BO"BN;l
\e(B" ("
\e$B$=$NB>$N8GM-L>;l
\e(B" . "
\e$B8GM-L>;l
\e(B"))
102 "Menu data for a hinshi (a part of speech) selection.")
104 (defun canna-hinshi-name (id &optional reverse)
106 (cdr (assoc id canna-hinshi-alist))
107 (car (rassoc id canna-hinshi-alist))))
109 (defmacro canna-backend-plist ()
110 ''(egg-start-conversion canna-start-conversion
111 egg-get-bunsetsu-source canna-get-bunsetsu-source
112 egg-get-bunsetsu-converted canna-get-bunsetsu-converted
113 egg-get-source-language canna-get-source-language
114 egg-get-converted-language canna-get-converted-language
115 egg-list-candidates canna-list-candidates
116 egg-decide-candidate canna-decide-candidate
117 egg-special-candidate canna-special-candidate
118 egg-change-bunsetsu-length canna-change-bunsetsu-length
119 egg-end-conversion canna-end-conversion
120 egg-word-registration canna-word-registration))
122 (defconst canna-backend-language-alist nil)
124 (defvar canna-backend-alist nil)
126 (defun canna-backend-func-name (name lang &optional env)
127 (intern (concat name "-" (symbol-name lang)
128 (and env "-") (and env (symbol-name env)))))
130 (defun canna-make-backend (lang env &optional source-lang converted-lang)
131 (let ((finalize (canna-backend-func-name "canna-finalize-backend" lang))
132 (backend (canna-backend-func-name "canna-backend" lang env)))
133 (if (null (fboundp finalize))
135 (fset finalize (function (lambda () (canna-finalize-backend))))
136 (egg-set-finalize-backend (list finalize))))
137 (if (null (get backend 'egg-start-conversion))
138 (setplist backend (apply 'list
140 'source-language (or source-lang lang)
141 'converted-language (or converted-lang lang)
142 (canna-backend-plist))))
145 (defun canna-define-backend (lang env-name-list)
146 (mapcar (lambda (env)
148 (canna-define-backend lang env)
149 (canna-make-backend lang env)))
152 (defun canna-define-backend-alist (deflist)
153 (setq canna-backend-alist
154 (mapcar (lambda (slot)
155 (let* ((lang (car slot))
156 (alt (cdr (assq lang canna-backend-language-alist))))
157 (cons lang (canna-define-backend (or alt lang) (cdr slot)))))
160 (defcustom canna-backend-define-list
161 '((Japanese ((nil nil nil))
162 ((Bushu Bushu Bushu))))
163 "Alist of Japanese language and lists of the Canna backend suffixes."
165 :set (lambda (sym value)
166 (set-default sym value)
167 (canna-define-backend-alist value))
170 :tag "Language - Backend"
171 (choice :tag "Language"
173 (symbol :tag "Other"))
176 :tag "Backend Sequece"
177 (cons :tag "First Conversion Stage"
178 (symbol :tag "Backend for Start Conversion")
179 (repeat :tag "Backends for Reconvert"
180 (symbol :tag "Backend")))
182 :tag "Following Conversion Stages"
185 (symbol :tag "Backend for This Stage")
186 (repeat :tag "Backends for Reconvert"
187 (symbol :tag "Backend")))))))))
189 (defsubst canna-backend-get-language (backend)
190 (get backend 'language))
192 (defsubst canna-backend-get-source-language (backend)
193 (get backend 'source-language))
195 (defsubst canna-backend-get-converted-language (backend)
196 (get backend 'converted-language))
198 (defvar canna-envspec-list nil)
199 (defvar canna-current-envspec nil)
201 ;; Should support multiple outstanding context
202 ;; <env> ::= [ <proc> <context> <backend> <convert-mode> <nostudy> <dic-list> ]
203 (defvar canna-environments nil
204 "Environment for CANNA kana-kanji conversion")
206 (defun cannaenv-create (proc context &optional backend mode nostudy)
207 (vector proc context backend mode nostudy (list nil)))
209 (defsubst cannaenv-get-proc (env) (aref env 0))
210 (defsubst cannaenv-get-context (env) (aref env 1))
211 (defsubst cannaenv-get-backend (env) (aref env 2))
212 (defsubst cannaenv-get-mode (env) (aref env 3))
213 (defsubst cannaenv-get-nostudy (env) (aref env 4))
214 (defsubst cannaenv-get-dic-list (env) (cdr (aref env 5)))
216 (defsubst cannaenv-add-dic-list (env &rest dic)
217 (nconc (aref env 5) (list (apply 'vector dic))))
219 ;; <canna-bunsetsu> ::=
220 ;; [ <env> <converted> <bunsetsu-pos> <source>
221 ;; <zenkouho-pos> <zenkouho> <zenkouho-converted> ]
222 (defsubst canna-make-bunsetsu (env converted bunsetsu-pos source)
224 (cannaenv-get-backend env)
225 (vector env converted bunsetsu-pos source nil nil nil)))
227 (defsubst canna-bunsetsu-get-env (b)
228 (aref (egg-bunsetsu-get-info b) 0))
229 (defsubst canna-bunsetsu-get-converted (b)
230 (aref (egg-bunsetsu-get-info b) 1))
231 (defsubst canna-bunsetsu-get-bunsetsu-pos (b)
232 (aref (egg-bunsetsu-get-info b) 2))
233 (defsubst canna-bunsetsu-get-source (b)
234 (aref (egg-bunsetsu-get-info b) 3))
235 (defsubst canna-bunsetsu-set-source (b s)
236 (aset (egg-bunsetsu-get-info b) 3 s))
237 (defsubst canna-bunsetsu-get-zenkouho-pos (b)
238 (aref (egg-bunsetsu-get-info b) 4))
239 (defsubst canna-bunsetsu-set-zenkouho-pos (b p)
240 (aset (egg-bunsetsu-get-info b) 4 p))
241 (defsubst canna-bunsetsu-get-zenkouho (b)
242 (aref (egg-bunsetsu-get-info b) 5))
243 (defsubst canna-bunsetsu-set-zenkouho (b z)
244 (aset (egg-bunsetsu-get-info b) 5 z))
245 (defsubst canna-bunsetsu-get-zenkouho-converted (b)
246 (aref (egg-bunsetsu-get-info b) 6))
247 (defsubst canna-bunsetsu-set-zenkouho-converted (b zc)
248 (aset (egg-bunsetsu-get-info b) 6 zc))
250 (defun canna-get-bunsetsu-source (b)
251 (let ((s (canna-bunsetsu-get-source b)))
253 (let* ((env (canna-bunsetsu-get-env b))
254 (bp (canna-bunsetsu-get-bunsetsu-pos b))
255 (s (cannarpc-get-bunsetsu-source env bp)))
256 (canna-bunsetsu-set-source b s)))))
257 (defun canna-get-bunsetsu-converted (b) (canna-bunsetsu-get-converted b))
258 (defun canna-get-source-language (b) 'Japanese)
259 (defun canna-get-converted-language (b) 'Japanese)
261 (defun canna-envspec-create (env-name convert-mode nostudy)
262 (vector (and env-name (setq env-name (intern env-name)))
263 (canna-make-backend egg-language env-name)
264 convert-mode nostudy (list nil)))
266 (defsubst canna-envspec-env-type (spec) (aref spec 0))
267 (defsubst canna-envspec-backend (spec) (aref spec 1))
268 (defsubst canna-envspec-mode (spec) (aref spec 2))
269 (defsubst canna-envspec-nostudy (spec) (aref spec 3))
270 (defsubst canna-envspec-dic-list (spec) (cdr (aref spec 4)))
272 (defsubst canna-envspec-add-dic-list (spec &rest dic)
273 (nconc (aref spec 4) (list (apply 'vector dic))))
275 (defmacro canna-arg-type-error (func)
276 `(egg-error ,(format "%s: Wrong type argument" func)))
278 (defun canna-define-environment (&optional env-name convert-mode nostudy)
279 "Define a Canna environment. ENV-NAME specifies suffix of the Canna
280 environment name. CONVERT-MODE specifies including hiragana or
281 katakana to candidates list. NOSTUDY specifies not study."
282 (if (and env-name (null (stringp env-name)))
283 (canna-arg-type-error canna-define-environment))
284 (setq canna-current-envspec (canna-envspec-create env-name
285 convert-mode nostudy)
286 canna-envspec-list (nconc canna-envspec-list
287 (list canna-current-envspec))))
289 (defun canna-add-dict (dict dict-rw)
290 (canna-envspec-add-dic-list canna-current-envspec dict dict-rw))
292 (defun canna-comm-sentinel (proc reason) ; assume it is close
293 (let ((inhibit-quit t))
294 (kill-buffer (process-buffer proc))
295 ;; delete env from the list.
296 (setq canna-environments
297 (delq nil (mapcar (lambda (env)
298 (if (null (eq (cannaenv-get-proc env) proc))
300 canna-environments)))))
302 (defun canna-open (hostname-list)
303 "Establish the connection to CANNA server. Return environment object."
304 (let* ((save-inhibit-quit inhibit-quit)
307 (msg-form "Canna: connecting to %S at %s...")
308 (user-name (or canna-user-name (user-login-name)))
309 (id (shell-command-to-string "id"))
310 (group (or canna-group-name
311 (if (string-match "gid=[0-9]+(\\([^)]+\\))" id)
314 buf hostname port proc result msg)
317 (setq buf (generate-new-buffer " *CANNA*"))
321 (buffer-disable-undo)
322 (set-buffer-multibyte nil)
323 (setq egg-fixed-euc 'fixed-euc-jp))
324 (or (consp hostname-list)
325 (setq hostname-list (list hostname-list)))
326 (while (and hostname-list (null proc))
327 (setq hostname (or (car hostname-list) "")
328 hostname-list (cdr hostname-list))
329 (if (null (string-match ":" hostname))
330 (setq port canna-server-port)
331 (setq port (string-to-int (substring hostname (match-end 0)))
332 hostname (substring hostname 0 (match-beginning 0))))
333 (and (equal hostname "")
334 (setq hostname (or (getenv "CANNAHOST") "localhost")))
335 (let ((inhibit-quit save-inhibit-quit))
337 (null (y-or-n-p (format "%s failed. Try to %s? "
339 (egg-error "abort connect")))
340 (setq msg (format "Canna: connecting to %s..." hostname))
342 (let ((inhibit-quit save-inhibit-quit))
344 (setq proc (open-network-stream proc-name buf hostname port))
347 (process-kill-without-query proc)
348 (set-process-coding-system proc 'no-conversion 'no-conversion)
349 (set-process-sentinel proc 'canna-comm-sentinel)
350 (set-marker-insertion-type (process-mark proc) t)
351 (setq result (cannarpc-open proc user-name)) ;; result is context
354 (delete-process proc)
356 (cannarpc-notice-group-name proc result group)
357 (cannarpc-set-app-name proc result "EGG4"))))
360 (message (concat msg "done"))
361 (if buf (kill-buffer buf))
362 (egg-error 'canna-connect-error)))))
364 (defun canna-filename (p)
366 (cond ((consp p) (concat (car p) "/" (user-login-name)))
369 (defun canna-search-environment (backend)
370 (let ((env-list canna-environments)
372 (while (and (null env) env-list)
373 (setq env (and (eq (cannaenv-get-backend (car env-list)) backend)
375 env-list (cdr env-list)))
378 (defun canna-get-environment (backend)
379 "Return the backend of CANNA environment."
380 (let ((env (canna-search-environment backend))
384 (let* ((language (canna-backend-get-language backend))
386 (setq proc (canna-open canna-hostname)
389 canna-envspec-list nil)
391 (egg-load-startup-file 'canna language)
394 (signal (car error) (cdr error))))
395 (setq specs canna-envspec-list)
397 (canna-create-environment proc context (car specs))
399 (setq specs (cdr specs)))
400 (setq env (canna-search-environment backend)))
401 (when (and proc (null env))
402 (cannarpc-close proc)
404 (signal (car error) (cdr error))
405 (egg-error 'canna-fail-make-env)))
408 (defun canna-create-environment (proc context spec)
409 (let* ((save-inhibit-quit inhibit-quit)
411 (backend (canna-envspec-backend spec))
412 (convert-mode (canna-envspec-mode spec))
413 (nostudy (canna-envspec-nostudy spec))
414 (dic-list (canna-envspec-dic-list spec))
419 (setq context (cannarpc-create-context proc)))
421 (egg-error "%s" (cannarpc-get-error-message (- context))))
422 (setq env (cannaenv-create proc context backend convert-mode nostudy))
423 (let ((inhibit-quit save-inhibit-quit))
425 (canna-set-dictionary env (car dic-list))
426 (setq dic-list (cdr dic-list))))
427 (setq canna-environments (nconc canna-environments (list env))))
429 (if (eq (car err) 'egg-error)
430 (message "%s" (nth 1 err)))
433 (cannarpc-close-context env)
434 (setq canna-environments (delq env canna-environments))))
435 (if (eq (car err) 'quit)
436 (signal 'quit (cdr err)))))))
438 (defun canna-set-dictionary (env dic-spec)
439 (let ((dname (aref dic-spec 0))
440 (drw (aref dic-spec 1))
442 (if (= 0 (canna-open-dictionary env dname drw))
443 (cannaenv-add-dic-list env dname drw))))
445 (defun canna-open-dictionary (env name rw)
449 (setq ret (cannarpc-open-dictionary env name 0)) ; XXX MODE=0
452 (message (egg-get-message 'canna-dict-missing-1) name)
455 (format (egg-get-message 'canna-dict-missing-2) name))
456 (= (cannarpc-make-dictionary env name) 0))
457 (message (egg-get-message 'canna-dict-created) name)
458 (message "%s" (cannarpc-get-error-message (- ret))))
462 (defun canna-save-dictionaries (env)
463 (let ((dic-list (canna-list-writable-dictionaries-byname env))
466 (setq dic (car dic-list)
467 dic-list (cdr dic-list))
468 (cannarpc-save-dictionary env dic))))
473 (defun canna-start-conversion (backend yomi &optional context)
474 "Convert YOMI string to kanji, and enter conversion mode.
475 Return the list of bunsetsu."
476 (let* ((env (canna-get-environment backend))
477 (bunsetsu-list (cannarpc-begin-conversion env yomi)))
478 (if (numberp bunsetsu-list) ; XXX error
\e$B$N=hM}E,Ev
\e(B
480 (if (= -1 (cannarpc-cancel-conversion env))
482 (setq env (canna-get-environment backend))
483 (canna-finalize-backend)))
484 (setq bunsetsu-list (cannarpc-begin-conversion env yomi))))
487 (defun canna-end-conversion (bunsetsu-list abort)
488 (let* ((env (canna-bunsetsu-get-env (car bunsetsu-list)))
490 (len (length bunsetsu-list))
491 (zenkouho-pos-vector (make-vector (* 2 len) 0))
493 (mode (if (cannaenv-get-nostudy env) 0 1)) ; MODE=1
\e$B3X=,
\e(B 0
\e$B$7$J$$
\e(B
494 bunsetsu zenkouho-pos)
498 (setq bunsetsu (car l))
500 (setq zenkouho-pos (canna-bunsetsu-get-zenkouho-pos bunsetsu))
501 (if (null zenkouho-pos)
502 () ; XXX: NIL--> 0 atteru???
503 (aset zenkouho-pos-vector i 0) ; XXX Don't support >=256
504 (aset zenkouho-pos-vector (1+ i) zenkouho-pos))
506 (cannarpc-end-conversion env len zenkouho-pos-vector mode)))
508 (defun canna-list-candidates (bunsetsu prev-b next-b major)
509 (setq bunsetsu (car bunsetsu))
510 (if (canna-bunsetsu-get-zenkouho bunsetsu)
511 (cons (canna-bunsetsu-get-zenkouho-pos bunsetsu)
512 (canna-bunsetsu-get-zenkouho-converted bunsetsu))
513 (let* ((env (canna-bunsetsu-get-env bunsetsu))
514 (yomi (canna-get-bunsetsu-source bunsetsu))
515 (bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos bunsetsu))
516 (z (cannarpc-get-bunsetsu-candidates env bunsetsu-pos yomi)))
517 (canna-bunsetsu-set-zenkouho bunsetsu z)
518 (cons (canna-bunsetsu-set-zenkouho-pos bunsetsu 0)
519 (canna-bunsetsu-set-zenkouho-converted
521 (mapcar 'canna-bunsetsu-get-converted z))))))
524 (defun canna-get-number-of-candidates (bunsetsu)
525 (let ((l (canna-bunsetsu-get-zenkouho bunsetsu)))
530 (defun canna-decide-candidate (bunsetsu pos prev-b next-b)
531 (let* ((head (car bunsetsu))
532 (candidate-list (canna-bunsetsu-get-zenkouho head))
533 (candidate (nth pos candidate-list)))
534 (canna-bunsetsu-set-zenkouho candidate candidate-list)
535 (canna-bunsetsu-set-zenkouho-pos candidate pos)
536 (canna-bunsetsu-set-zenkouho-converted
537 candidate (canna-bunsetsu-get-zenkouho-converted head))
538 (list (list candidate))))
540 (defun canna-special-candidate (bunsetsu prev-b next-b major type)
541 (let* ((head (car bunsetsu))
542 (env (canna-bunsetsu-get-env head))
543 (backend (egg-bunsetsu-get-backend head))
544 (lang (get backend 'language))
545 source converted zenkouho-list kouho-list pos)
546 (when (and (eq lang (get backend 'source-language))
547 (eq lang (get backend 'converted-language)))
548 (cond ((eq lang 'Japanese)
549 (setq source (canna-get-bunsetsu-source head))
550 (cond ((eq type 'egg-hiragana)
551 (setq converted source))
552 ((eq type 'egg-katakana)
553 (setq converted (japanese-katakana source))))
555 (cdr (canna-list-candidates bunsetsu prev-b next-b major)))
557 (when (setq kouho-list (member converted zenkouho-list))
558 (- (length zenkouho-list) (length kouho-list))))))
560 (canna-decide-candidate bunsetsu pos prev-b next-b)))))
563 (defun canna-get-current-candidate-number (bunsetsu)
564 (canna-bunsetsu-get-zenkouho-pos bunsetsu))
567 (defun canna-get-all-candidates (bunsetsu)
568 (let* ((l (canna-bunsetsu-get-zenkouho bunsetsu))
569 (result (cons nil nil))
573 (let ((candidate (car l)))
574 (setcar r (canna-bunsetsu-get-converted candidate))
575 (if (null (setq l (cdr l)))
577 (setq r (setcdr r (cons nil nil)))))))
580 (defun canna-change-bunsetsu-length (bunsetsu prev-b next-b len major)
581 (let* ((env (canna-bunsetsu-get-env (car bunsetsu)))
582 (yomi (canna-get-bunsetsu-source (car bunsetsu)))
583 (yomi-length (cond ((< (length yomi) len) -1)
584 ((> (length yomi) len) -2)
586 (bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos (car bunsetsu)))
589 (setq new (cannarpc-set-kugiri-changed env yomi-length bunsetsu-pos))
591 (list (list (car new)) prev-b (cdr new))))
593 (defun canna-finalize-backend (&optional action)
594 (let* ((save-inhibit-quit inhibit-quit)
596 (env-list canna-environments)
599 (setq env (car env-list)
600 env-list (cdr env-list))
603 (unless (memq (cannaenv-get-proc env) proc-list)
604 (setq proc-list (cons (cannaenv-get-proc env) proc-list)))
605 (unless (eq action 'disconnect-only)
608 (message (egg-get-message 'canna-dict-saving) "Canna"))
609 (let ((inhibit-quit save-inhibit-quit))
610 (canna-save-dictionaries env)))
611 (unless (eq action 'save-only)
612 (cannarpc-close-context env)))
614 (message "signal %S occured when dictionary saving" err))))
616 (message (egg-get-message 'canna-dict-saved) "Canna"))
617 (unless (eq action 'save-only)
619 (if (and (car proc-list)
620 (eq (process-status (car proc-list)) 'open))
621 (cannarpc-close (car proc-list)))
622 (setq proc-list (cdr proc-list)))))
623 (setq canna-environments nil))
625 ;;; word registration
627 (defun canna-list-writable-dictionaries-byname (env)
628 (let ((dic-list (cannaenv-get-dic-list env)))
630 (mapcar (lambda (dic)
631 (let ((dname (aref dic 0))
636 (defun canna-dictionary-select (env)
637 (let ((dic-list (canna-list-writable-dictionaries-byname env)))
638 (if (= 1 (length dic-list))
640 (menudiag-select (list 'menu
641 (egg-get-message 'canna-register-1)
644 (defun canna-hinshi-MEISHI (kanji yomi)
645 (if (y-or-n-p (concat "
\e$B!V
\e(B" kanji "
\e$B$J!W$O@5$7$$$G$9$+!#
\e(B")) "#T15" "#T35"))
647 (defun canna-hinshi-SAHEN-MEISHI (kanji yomi)
648 (if (y-or-n-p (concat "
\e$B!V
\e(B" kanji "
\e$B$J!W$O@5$7$$$G$9$+!#
\e(B") "#T10" "#T30")))
650 (defmacro canna-hinshi-DOUSHI-check-gobi ()
654 (if (string-match (concat (substring gobi i (1+ i)) "$") kanji)
656 (setq renyou (substring re-gobi i (1+ i)))
657 (setq mizen (substring mi-gobi i (1+ i)))
658 (setq kanji-gobi (substring kanji (match-beginning 0)))
659 (setq kanji-gokan (substring kanji 0 (match-beginning 0)))
660 (setq ret (nth i hinshi))
665 (if (string-match (concat (substring gobi i (1+ i)) "$") yomi)
667 (setq yomi-gobi (substring yomi (match-beginning 0)))
668 (setq yomi-gokan (substring yomi 0 (match-beginning 0)))
672 (defun canna-hinshi-DOUSHI (kanji yomi)
673 (let ((gobi "
\e$B$/$0$9$D$L$V$`$k$&
\e(B")
674 (re-gobi "
\e$B$-$.$7$A$K$S$_$j$$
\e(B")
675 (mi-gobi "
\e$B$+$,$5$?$J$P$^$i$o
\e(B")
676 (hinshi (list "#K5" "#G5" "#S5" "#T5" "#N5" "#B5" "#M5" "#R5" "#W5"))
677 kanji-gokan yomi-gokan kanji-gobi yomi-gobi mizen renyou
679 (canna-hinshi-DOUSHI-check-gobi)
680 (if (not (and (> (length kanji) 1) (> (length yomi) 1)
681 (and kanji-gobi yomi-gobi (equal kanji-gobi yomi-gobi))))
682 (if (and kanji-gobi yomi-gobi)
683 (egg-error "
\e$BFI$_$H8uJd$N3hMQ$,0c$$$^$9!#F~NO$7$J$*$7$F$/$@$5$$!#
\e(B")
684 (egg-error "
\e$BFI$_$H8uJd$r=*;_7A$GF~NO$7$F$/$@$5$$!#
\e(B")))
685 (cond ((and (> (length kanji) 2) (> (length yomi) 2)
686 (string-match "
\e$B$/$k
\e(B$" kanji) (string-match "
\e$B$/$k
\e(B$" yomi))
688 (setq kanji-gokan (substring kanji 0 (- (length kanji) 2)))
689 (setq yomi-gokan (substring yomi 0 (- (length yomi) 2))))
690 ((and (> (length kanji) 3) (> (length yomi) 3)
691 (string-match "
\e$B$s$:$k
\e(B$" kanji) (string-match "
\e$B$s$:$k
\e(B$" yomi))
693 (setq kanji-gokan (substring kanji 0 (- (length kanji) 3)))
694 (setq yomi-gokan (substring yomi 0 (- (length yomi) 3))))
695 ((and (> (length kanji) 2) (> (length yomi) 2)
696 (string-match "
\e$B$:$k
\e(B$" kanji) (string-match "
\e$B$:$k
\e(B$" yomi))
698 (setq kanji-gokan (substring kanji 0 (- (length kanji) 2)))
699 (setq yomi-gokan (substring yomi 0 (- (length yomi) 2))))
700 ((and (> (length kanji) 2) (> (length yomi) 2)
701 (string-match "
\e$B$9$k
\e(B$" kanji) (string-match "
\e$B$9$k
\e(B$" yomi))
703 (setq kanji-gokan (substring kanji 0 (- (length kanji) 2)))
704 (setq yomi-gokan (substring yomi 0 (- (length yomi) 2)))))
705 (if (not (string-match "5$" ret))
706 (if (y-or-n-p (concat "
\e$B!X
\e(B" kanji "
\e$B!Y$r
\e(B (" (canna-hinshi-name ret)
707 ")
\e$B$H$7$FEPO?$7$^$9$+
\e(B? "))
708 (setq ret (list kanji-gokan yomi-gokan ret))
710 (setq kanji-gokan (substring kanji 0 (- (length kanji) 1)))
711 (setq yomi-gokan (substring yomi 0 (- (length yomi) 1)))))
714 (if (y-or-n-p "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
716 (setq ret1 (y-or-n-p (concat "
\e$B!V
\e(B" kanji-gokan mizen
717 "
\e$B$J$$!W$O@5$7$$$G$9$+!#
\e(B")))
721 (if (string-match (concat (substring re-gobi i (1+ i)) "$")
723 (progn (setq renyou nil)
726 (setq ret2 (y-or-n-p (concat "
\e$B!V
\e(B" kanji-gokan renyou
727 "
\e$B$,$$$$!W$O@5$7$$$G$9$+!#
\e(B")))
728 (setq ret (if ret1 (if ret2 (concat ret "r") ret)
729 (if ret2 "#KSr" "#KS")))))
730 (list kanji-gokan yomi-gokan ret))))
732 (defun canna-hinshi-KEIYOUSHI (kanji yomi)
734 (if (not (and (> (length kanji) 1) (> (length yomi) 1)
735 (string-match "
\e$B$$
\e(B$" yomi) (string-match "
\e$B$$
\e(B$" kanji)))
736 (egg-error "
\e$BFI$_$H8uJd$r
\e(B
\e$B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc
\e(B)
\e$BAa$$
\e(B"))
737 (setq kanji (substring kanji 0 (1- (length kanji))))
738 (setq yomi (substring yomi 0 (1- (length yomi))))
740 (if (y-or-n-p "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
741 (if (y-or-n-p (concat "
\e$B!V
\e(B" kanji "
\e$B!W$O@5$7$$$G$9$+!#
\e(B"))
744 (list kanji yomi ret)))
746 (defun canna-hinshi-KEIYOUDOUSHI (kanji yomi)
748 (if (not (and (> (length kanji) 1) (> (length yomi) 1)
749 (string-match "
\e$B$@
\e(B$" yomi) (string-match "
\e$B$@
\e(B$" kanji)))
750 (egg-error "
\e$BFI$_$H8uJd$r
\e(B
\e$B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc
\e(B)
\e$B@E$+$@
\e(B"))
751 (setq kanji (substring kanji 0 (1- (length kanji))))
752 (setq yomi (substring yomi 0 (1- (length yomi))))
754 (if (y-or-n-p "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
757 (concat "
\e$B!V
\e(B" kanji "
\e$B$9$k!W$O@5$7$$$G$9$+!#
\e(B")))
759 (concat "
\e$B!V
\e(B" kanji "
\e$B$,$"$k!W$O@5$7$$$G$9$+!#
\e(B")))
760 (if ret1 (if ret2 "#T10" "#T13") (if ret2 "#T15" "#T18")))
762 (list kanji yomi ret)))
764 (defun canna-hinshi-FUKUSHI (kanji yomi)
766 (if (y-or-n-p "
\e$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+
\e(B? ")
768 (setq ret1 (y-or-n-p (concat "
\e$B!V
\e(B" kanji "
\e$B$9$k!W$O@5$7$$$G$9$+!#
\e(B")))
769 (setq ret2 (y-or-n-p (concat "
\e$B!V
\e(B" kanji "
\e$B$H!W$O@5$7$$$G$9$+!#
\e(B")))
770 (if ret1 (if ret2 "#F04" "#F12") (if ret2 "#F06" "#F14")))
773 (defun canna-hinshi-select (kanji yomi)
774 (let ((key (menudiag-select (list 'menu
775 (egg-get-message 'canna-register-2)
776 canna-hinshi-menu))))
777 (cond ((symbolp key) (funcall
778 (intern (concat "canna-hinshi-" (symbol-name key)))
780 ((stringp key) (cdr (assoc key canna-hinshi-alist))))))
782 (defun canna-word-registration (backend kanji yomi)
783 "Register a word KANJI with a pronunciation YOMI."
784 (if (or (null (eq (egg-get-language 0 kanji)
785 (canna-get-converted-language backend)))
786 (next-single-property-change 0 'egg-lang kanji)
787 (null (eq (egg-get-language 0 yomi)
788 (canna-get-source-language backend)))
789 (next-single-property-change 0 'egg-lang yomi))
790 (egg-error "word registration: invalid character")
791 (let* ((env (canna-get-environment backend))
792 (dic (canna-dictionary-select env))
793 (hinshi-id (canna-hinshi-select kanji yomi))
795 (if (listp hinshi-id)
796 (progn (setq kanji (car hinshi-id))
797 (setq yomi (nth 1 hinshi-id))
798 (setq hinshi-id (nth 2 hinshi-id))))
799 (setq result (cannarpc-add-word env dic yomi kanji hinshi-id))
802 (cannarpc-save-dictionary env dic)
803 (list (canna-hinshi-name hinshi-id) dic))
804 (egg-error (cannarpc-get-error-message (- result)))))))
806 ;;; word delete registration
808 (defun canna-word-delete-regist (backend yomi)
809 "Delete a word KANJI from dictionary."
810 (let* ((env (canna-get-environment backend))
811 (dic (canna-dictionary-select env))
812 proc context envd bunsetsu bunsetsu-pos z zpos kouho-list hinshi i
814 (setq proc (cannaenv-get-proc env))
815 (setq context (cannarpc-create-context proc))
816 (setq envd (cannaenv-create proc context
817 'canna-backend-Japanese-tmp-delete-regist
819 (canna-set-dictionary envd (vector dic t))
820 (canna-set-dictionary envd (vector "fuzokugo" nil))
821 (setq bunsetsu (car (cannarpc-begin-conversion envd yomi)))
822 (setq bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos bunsetsu))
823 (setq z (cannarpc-get-bunsetsu-candidates envd bunsetsu-pos yomi))
824 (canna-bunsetsu-set-zenkouho bunsetsu z)
825 (canna-bunsetsu-set-zenkouho-pos bunsetsu 0)
827 (canna-bunsetsu-set-zenkouho-converted
829 (mapcar 'canna-bunsetsu-get-converted z)))
830 (setq yomi (car (last kouho-list)))
831 (setq kouho-list (cdr (reverse kouho-list)))
832 (setq kouho-list (reverse kouho-list))
834 (setq kouho-list (mapcar '(lambda (k)
839 (let ((hiragana (assoc yomi kouho-list))
842 (setq hinshi (cannarpc-get-hinshi envd bunsetsu-pos (cdr hiragana))))
844 (if (equal "#T35" hinshi)
845 (setq kouho-list (delete hiragana kouho-list)))
846 (setq kouho-list (delete hiragana kouho-list))))
849 (cannarpc-close-context envd)
850 (egg-error "
\e$BEPO?$5$l$F$$$^$;$s!#
\e(B"))
851 ((eq 1 (length kouho-list))
853 (setq kanji (car (car kouho-list))))
855 (setq kanji (menudiag-select (list 'menu "
\e$B:o=|
\e(B:" kouho-list) nil nil t))
856 (setq zpos (cdr (car kanji)))
857 (setq kanji (car (car kanji)))))
858 (setq hinshi (cannarpc-get-hinshi envd bunsetsu-pos zpos))
859 (setq lex (cannarpc-get-lex envd bunsetsu-pos zpos))
860 (cannarpc-cancel-conversion envd)
861 (if (string-match "#[^#]+" hinshi)
862 (setq hinshi (substring hinshi 0 (match-end 0)))
863 (egg-error "
\e$BIJ;l>pJs$,<hF@$G$-$^$;$s!#
\e(B"))
864 (setq kanji (substring kanji 0 (nth 1 (car lex))))
865 (setq yomi (substring yomi 0 (car (car lex))))
866 (if (y-or-n-p (concat "
\e$B!X
\e(B" kanji "
\e$B!Y
\e(B(" yomi ": "
867 (canna-hinshi-name hinshi) ")
\e$B$r
\e(B "
868 dic "
\e$B$+$i:o=|$7$^$9$+
\e(B? "))
870 (cannarpc-delete-word envd dic yomi kanji hinshi))
874 (cannarpc-save-dictionary envd dic)
875 (cannarpc-close-context envd)
876 (list kanji yomi (canna-hinshi-name hinshi) dic))
877 (cannarpc-close-context envd)
878 (egg-error (cannarpc-get-error-message (- result))))
882 (load "egg/cannarpc")
883 (run-hooks 'canna-load-hook)
886 (defun egg-activate-canna (&rest arg)
887 "Activate CANNA backend of Tamago 4."
888 (apply 'egg-mode (append arg canna-backend-alist)))
890 ;;; egg/canna.el ends here.