1;;; egg/canna.el --- Canna Support (high level interface) in 2;;; Egg Input Method Architecture 3 4;; Copyright (C) 1999, 2000 Free Software Foundation, Inc 5 6;; Author: NIIBE Yutaka <gniibe@chroot.org> 7 8;; Maintainer: TOMURA Satoru <tomura@etl.go.jp> 9 10;; Keywords: mule, multilingual, input method 11 12;; This file is part of EGG. 13 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) 17;; any later version. 18 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. 23 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. 28 29;;; Commentary: 30 31;;; Code: 32 33(require 'egg) 34(require 'egg-edep) 35 36(defgroup canna nil 37 "CANNA interface for Tamago 4." 38 :group 'egg) 39 40(defcustom canna-hostname "unix/" 41 "Hostname of CANNA server" 42 :group 'canna :type 'string) 43 44(defcustom canna-server-port "/tmp/.iroha_unix/IROHA" 45 "A service name or a port number (should be a string) of CANNA server" 46 :group 'canna :type 'string) 47 48(defcustom canna-user-name nil 49 "User Name on CANNA server" 50 :group 'canna :type 'string) 51 52(defcustom canna-group-name nil 53 "Group Name on CANNA server" 54 :group 'canna :type 'string) 55 56(defcustom egg-canna-helper-path "@libexecdir@/egg-helper" 57 "path of canna unix domain connection helper program" 58 :group 'canna :type 'file) 59 60; (eval-when-compile 61; (defmacro CANNA-const (c) 62; (cond ((eq c 'FileNotExist) xxxxxxxxxxxxxx) 63; ))) 64 65(egg-add-message 66 '((Japanese 67 (canna-connect-error "$B%5!<%P$H@\B3$G$-$^$;$s$G$7$?(B") 68 (canna-fail-make-env "$B4D6-$r:n$k$3$H$O$G$-$^$;$s$G$7$?(B") 69 (canna-dict-missing-1 "$B<-=q%U%!%$%k(B %s $B$,$"$j$^$;$s!#(B") 70 (canna-dict-missing-2 "$B<-=q%U%!%$%k(B %s $B$,$"$j$^$;$s!#:n$j$^$9$+(B? ") 71 (canna-dict-created "$B<-=q%U%!%$%k(B %s $B$r:n$j$^$7$?(B") 72 (canna-dict-saving "%s $B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$F$$$^$9(B") 73 (canna-dict-saved "%s $B$NIQEY>pJs!&<-=q>pJs$rB`Hr$7$^$7$?(B") 74 (canna-register-1 "$BEPO?<-=qL>(B:") 75 (canna-register-2 "$BIJ;lL>(B")))) 76 77(defvar canna-hinshi-alist 78 '(("$B?ML>(B" . "#JN") ("$BCOL>(B" . "#CN") ("$B8GM-L>;l(B" . "#KK") 79 ("$B0lHLL>;l(B" . "#T35") ("$BL>;l(B($BNc(B)$B6/NO$J(B" . "#T15") 80 ("$B%5JQL>;l(B" . "#T30") ("$B%5JQL>;l(B($BNc(B)$B0B?4$J(B" . "#T10") ("$BC14A;z(B" . "#KJ") 81 ("$BF0;l%+9TJQ3J3hMQ(B" . "#KX") ("$BF0;l%s%69TJQ3J3hMQ(B" . "#NZX") 82 ("$BF0;l%69TJQ3J3hMQ(B" . "#ZX") ("$BF0;l%59TJQ3J3hMQ(B" . "#SX") 83 ("$BF0;l%+9T8^CJ3hMQ(B" . "#K5") ("$BF0;l%,9T8^CJ3hMQ(B" . "#G5") 84 ("$BF0;l%59T8^CJ3hMQ(B" . "#S5") ("$BF0;l%?9T8^CJ3hMQ(B" . "#T5") 85 ("$BF0;l%J9T8^CJ3hMQ(B" . "#N5") ("$BF0;l%P9T8^CJ3hMQ(B" . "#B5") 86 ("$BF0;l%^9T8^CJ3hMQ(B" . "#M5") ("$BF0;l%i9T8^CJ3hMQ(B" . "#R5") 87 ("$BF0;l%o9T8^CJ3hMQ(B" . "#W5") ("$BF0;l>e2<0lCJ3hMQ(B" . "#KS") 88 ("$BF0;l%+9T8^CJO"MQL>;l(B" . "#K5r") ("$BF0;l%,9T8^CJO"MQL>;l(B" . "#G5r") 89 ("$BF0;l%59T8^CJO"MQL>;l(B" . "#S5r") ("$BF0;l%?9T8^CJO"MQL>;l(B" . "#T5r") 90 ("$BF0;l%J9T8^CJO"MQL>;l(B" . "#N5r") ("$BF0;l%P9T8^CJO"MQL>;l(B" . "#B5r") 91 ("$BF0;l%^9T8^CJO"MQL>;l(B" . "#M5r") ("$BF0;l%i9T8^CJO"MQL>;l(B" . "#R5r") 92 ("$BF0;l%o9T8^CJO"MQL>;l(B" . "#W5r") ("$BF0;l>e2<0lCJ8l44L>;l(B" . "#KSr") 93 ("$B7AMF;l(B" . "#KY") ("$B7AMF;l(B($BNc(B)$B$-$$$m$$(B" . "#KYT") 94 ("$B7AMFF0;l(B" . "#T05") 95 ("$B7AMFF0;l(B($BNc(B)$B4X?4$@(B" . "#T10") ("$B7AMFF0;l(B($BNc(B)$BB?92$F$@(B" . "#T13") 96 ("$B7AMFF0;l(B($BNc(B)$B0U30$@(B" . "#T15") ("$B7AMFF0;l(B($BNc(B)$BJXMx$@(B" . "#T18") 97 ("$BI{;l(B" . "#F14") ("$BI{;l(B($BNc(B)$B$U$C$/$i(B" . "#F04") 98 ("$BI{;l(B($BNc(B)$B$=$C$H(B" . "#F12") ("$BI{;l(B($BNc(B)$BFMA3(B" . "#F06") 99 ("$B?t;l(B" . "#NN") ("$B@\B3;l!&46F0;l(B" . "#CJ") ("$BO"BN;l(B" . "#RT"))) 100 101(defvar canna-hinshi-menu 102 '("$B?ML>(B" "$BCOL>(B" ("$BCDBN!&2q<RL>(B" . "$B8GM-L>;l(B") ("$BL>;l(B" . MEISHI) 103 ("$B%5JQL>;l(B" . SAHEN-MEISHI) "$BC14A;z(B" ("$BF0;l(B" . DOUSHI) 104 ("$B7AMF;l(B" . KEIYOUSHI) ("$B7AMFF0;l(B" . KEIYOUDOUSHI) ("$BI{;l(B" . FUKUSHI) 105 "$B?t;l(B" "$B@\B3;l!&46F0;l(B" "$BO"BN;l(B" ("$B$=$NB>$N8GM-L>;l(B" . "$B8GM-L>;l(B")) 106 "Menu data for a hinshi (a part of speech) selection.") 107 108(defun canna-hinshi-name (id &optional reverse) 109 (if reverse 110 (cdr (assoc id canna-hinshi-alist)) 111 (car (rassoc id canna-hinshi-alist)))) 112 113(defmacro canna-backend-plist () 114 ''(egg-start-conversion canna-start-conversion 115 egg-get-bunsetsu-source canna-get-bunsetsu-source 116 egg-get-bunsetsu-converted canna-get-bunsetsu-converted 117 egg-get-source-language canna-get-source-language 118 egg-get-converted-language canna-get-converted-language 119 egg-list-candidates canna-list-candidates 120 egg-decide-candidate canna-decide-candidate 121 egg-special-candidate canna-special-candidate 122 egg-change-bunsetsu-length canna-change-bunsetsu-length 123 egg-end-conversion canna-end-conversion 124 egg-word-registration canna-word-registration)) 125 126(defconst canna-backend-language-alist nil) 127 128(defvar canna-backend-alist nil) 129 130(defun canna-backend-func-name (name lang &optional env) 131 (intern (concat name "-" (symbol-name lang) 132 (and env "-") (and env (symbol-name env))))) 133 134(defun canna-make-backend (lang env &optional source-lang converted-lang) 135 (let ((finalize (canna-backend-func-name "canna-finalize-backend" lang)) 136 (backend (canna-backend-func-name "canna-backend" lang env))) 137 (if (null (fboundp 'finalize)) 138 (progn 139 (fset finalize (function (lambda () (canna-finalize-backend)))) 140 (egg-set-finalize-backend (list finalize)))) 141 (if (null (get backend 'egg-start-conversion)) 142 (setplist backend (apply 'list 143 'language lang 144 'source-language (or source-lang lang) 145 'converted-language (or converted-lang lang) 146 (canna-backend-plist)))) 147 backend)) 148 149(defun canna-define-backend (lang env-name-list) 150 (mapcar (lambda (env) 151 (if (consp env) 152 (canna-define-backend lang env) 153 (canna-make-backend lang env))) 154 env-name-list)) 155 156(defun canna-define-backend-alist (deflist) 157 (setq canna-backend-alist 158 (mapcar (lambda (slot) 159 (let* ((lang (car slot)) 160 (alt (cdr (assq lang canna-backend-language-alist)))) 161 (cons lang (canna-define-backend (or alt lang) (cdr slot))))) 162 deflist))) 163 164(defcustom canna-backend-define-list 165 '((Japanese ((nil nil nil)) 166 ((Bushu Bushu Bushu)))) 167 "Alist of Japanese language and lists of the Canna backend suffixes." 168 :group 'canna 169 :set (lambda (sym value) 170 (set-default sym value) 171 (canna-define-backend-alist value)) 172 :type '(repeat 173 (cons 174 :tag "Language - Backend" 175 (choice :tag "Language" 176 (const Japanese) 177 (symbol :tag "Other")) 178 (repeat 179 (cons 180 :tag "Backend Sequece" 181 (cons :tag "First Conversion Stage" 182 (symbol :tag "Backend for Start Conversion") 183 (repeat :tag "Backends for Reconvert" 184 (symbol :tag "Backend"))) 185 (repeat 186 :tag "Following Conversion Stages" 187 (cons 188 :tag "N-th Stage" 189 (symbol :tag "Backend for This Stage") 190 (repeat :tag "Backends for Reconvert" 191 (symbol :tag "Backend"))))))))) 192 193(defsubst canna-backend-get-language (backend) 194 (get backend 'language)) 195 196(defsubst canna-backend-get-source-language (backend) 197 (get backend 'source-language)) 198 199(defsubst canna-backend-get-converted-language (backend) 200 (get backend 'converted-language)) 201 202(defvar canna-envspec-list nil) 203(defvar canna-current-envspec nil) 204 205;; Should support multiple outstanding context 206;; <env> ::= [ <proc> <context> <backend> <convert-mode> <nostudy> <dic-list> ] 207(defvar canna-environments nil 208 "Environment for CANNA kana-kanji conversion") 209 210(defun cannaenv-create (proc context &optional backend mode nostudy) 211 (vector proc context backend mode nostudy (list nil))) 212 213(defsubst cannaenv-get-proc (env) (aref env 0)) 214(defsubst cannaenv-get-context (env) (aref env 1)) 215(defsubst cannaenv-get-backend (env) (aref env 2)) 216(defsubst cannaenv-get-mode (env) (aref env 3)) 217(defsubst cannaenv-get-nostudy (env) (aref env 4)) 218(defsubst cannaenv-get-dic-list (env) (cdr (aref env 5))) 219 220(defsubst cannaenv-add-dic-list (env &rest dic) 221 (nconc (aref env 5) (list (apply 'vector dic)))) 222 223;; <canna-bunsetsu> ::= 224;; [ <env> <converted> <bunsetsu-pos> <source> 225;; <zenkouho-pos> <zenkouho> <zenkouho-converted> ] 226(defsubst canna-make-bunsetsu (env converted bunsetsu-pos source) 227 (egg-bunsetsu-create 228 (cannaenv-get-backend env) 229 (vector env converted bunsetsu-pos source nil nil nil))) 230 231(defsubst canna-bunsetsu-get-env (b) 232 (aref (egg-bunsetsu-get-info b) 0)) 233(defsubst canna-bunsetsu-get-converted (b) 234 (aref (egg-bunsetsu-get-info b) 1)) 235(defsubst canna-bunsetsu-get-bunsetsu-pos (b) 236 (aref (egg-bunsetsu-get-info b) 2)) 237(defsubst canna-bunsetsu-get-source (b) 238 (aref (egg-bunsetsu-get-info b) 3)) 239(defsubst canna-bunsetsu-set-source (b s) 240 (aset (egg-bunsetsu-get-info b) 3 s)) 241(defsubst canna-bunsetsu-get-zenkouho-pos (b) 242 (aref (egg-bunsetsu-get-info b) 4)) 243(defsubst canna-bunsetsu-set-zenkouho-pos (b p) 244 (aset (egg-bunsetsu-get-info b) 4 p)) 245(defsubst canna-bunsetsu-get-zenkouho (b) 246 (aref (egg-bunsetsu-get-info b) 5)) 247(defsubst canna-bunsetsu-set-zenkouho (b z) 248 (aset (egg-bunsetsu-get-info b) 5 z)) 249(defsubst canna-bunsetsu-get-zenkouho-converted (b) 250 (aref (egg-bunsetsu-get-info b) 6)) 251(defsubst canna-bunsetsu-set-zenkouho-converted (b zc) 252 (aset (egg-bunsetsu-get-info b) 6 zc)) 253 254(defun canna-get-bunsetsu-source (b) 255 (let ((s (canna-bunsetsu-get-source b))) 256 (or s 257 (let* ((env (canna-bunsetsu-get-env b)) 258 (bp (canna-bunsetsu-get-bunsetsu-pos b)) 259 (s (cannarpc-get-bunsetsu-source env bp))) 260 (canna-bunsetsu-set-source b s))))) 261(defun canna-get-bunsetsu-converted (b) (canna-bunsetsu-get-converted b)) 262(defun canna-get-source-language (b) 'Japanese) 263(defun canna-get-converted-language (b) 'Japanese) 264 265(defun canna-envspec-create (env-name convert-mode nostudy) 266 (vector (and env-name (setq env-name (intern env-name))) 267 (canna-make-backend egg-language env-name) 268 convert-mode nostudy (list nil))) 269 270(defsubst canna-envspec-env-type (spec) (aref spec 0)) 271(defsubst canna-envspec-backend (spec) (aref spec 1)) 272(defsubst canna-envspec-mode (spec) (aref spec 2)) 273(defsubst canna-envspec-nostudy (spec) (aref spec 3)) 274(defsubst canna-envspec-dic-list (spec) (cdr (aref spec 4))) 275 276(defsubst canna-envspec-add-dic-list (spec &rest dic) 277 (nconc (aref spec 4) (list (apply 'vector dic)))) 278 279(defmacro canna-arg-type-error (func) 280 `(egg-error ,(format "%s: Wrong type argument" func))) 281 282(defun canna-define-environment (&optional env-name convert-mode nostudy) 283 "Define a Canna environment. ENV-NAME specifies suffix of the Canna 284environment name. CONVERT-MODE specifies including hiragana or 285katakana to candidates list. NOSTUDY specifies not study." 286 (if (and env-name (null (stringp env-name))) 287 (canna-arg-type-error canna-define-environment)) 288 (setq canna-current-envspec (canna-envspec-create env-name 289 convert-mode nostudy) 290 canna-envspec-list (nconc canna-envspec-list 291 (list canna-current-envspec)))) 292 293(defun canna-add-dict (dict dict-rw) 294 (canna-envspec-add-dic-list canna-current-envspec dict dict-rw)) 295 296(defun canna-comm-sentinel (proc reason) ; assume it is close 297 (let ((inhibit-quit t)) 298 (kill-buffer (process-buffer proc)) 299 ;; delete env from the list. 300 (setq canna-environments 301 (delq nil (mapcar (lambda (env) 302 (if (null (eq (cannaenv-get-proc env) proc)) 303 env)) 304 canna-environments))))) 305 306(defun canna-open (hostname-list) 307 "Establish the connection to CANNA server. Return environment object." 308 (let* ((save-inhibit-quit inhibit-quit) 309 (inhibit-quit t) 310 (proc-name "CANNA") 311 (msg-form "Canna: connecting to %S at %s...") 312 (user-name (or canna-user-name (user-login-name))) 313 (id (shell-command-to-string "id")) 314 (group (or canna-group-name 315 (if (string-match "gid=[0-9]+(\\([^)]+\\))" id) 316 (match-string 1 id) 317 "user"))) 318 buf hostname port proc result msg) 319 (unwind-protect 320 (progn 321 (setq buf (generate-new-buffer " *CANNA*")) 322 (with-current-buffer buf 323 (erase-buffer) 324 (buffer-disable-undo) 325 (set-buffer-multibyte nil) 326 (setq egg-fixed-euc 'fixed-euc-jp)) 327 (or (consp hostname-list) 328 (setq hostname-list (list hostname-list))) 329 (while (and hostname-list (null proc)) 330 (setq hostname (or (car hostname-list) "") 331 hostname-list (cdr hostname-list)) 332 (if (null (string-match "^unix/" hostname)) 333 (progn 334 (if (null (string-match ":" hostname)) 335 (setq port canna-server-port) 336 (setq port (substring hostname (match-end 0)) 337 hostname (substring hostname 0 (match-beginning 0)))) 338 (if (and (stringp port) (string-match "^[0-9]+$" port)) 339 (setq port (string-to-number port))) 340 (and (equal hostname "") 341 (setq hostname (or (getenv "CANNAHOST") "localhost"))) 342 (setq host hostname) 343 (setq family nil)) 344 (setq family 'local) 345 (setq host nil) 346 (setq port canna-server-port) 347 (if (null (and (stringp port) (string-match "IROHA$" port))) 348 (setq port "/tmp/.iroha_unix/IROHA"))) 349 (let ((inhibit-quit save-inhibit-quit)) 350 (if (and msg 351 (null (y-or-n-p (format "%s failed. Try to %s? " 352 msg hostname)))) 353 (egg-error "abort connect"))) 354 (setq msg (format "Canna: connecting to %s..." hostname)) 355 (message "%s" msg) 356 (let ((inhibit-quit save-inhibit-quit)) 357 (if (fboundp 'make-network-process) 358 (condition-case nil 359 (setq proc (make-network-process :name proc-name :buffer buf :host host :service port :family family)) 360 ((error quit))) 361 ; for old emacs (<= 21.3) bellow 362 (if (string-match "^unix/" hostname) 363 (let ((process-connection-type nil)) 364 (setq proc (start-process proc-name buf egg-canna-helper-path port))) 365 (condition-case nil 366 (setq proc (open-network-stream proc-name buf hostname port)) 367 (error quit))))) 368 (when (processp proc) 369 (set-process-query-on-exit-flag proc nil) 370 (set-process-coding-system proc 'binary 'binary) 371 (set-process-sentinel proc 'canna-comm-sentinel) 372 (set-marker-insertion-type (process-mark proc) t) 373 (setq result (cannarpc-open proc user-name)) ;; result is context 374 (if (= result -1) 375 (progn 376 (delete-process proc) 377 (setq proc nil)) 378 (cannarpc-notice-group-name proc result group) 379 (cannarpc-set-app-name proc result "EGG4")))) 380 (cons proc result)) 381 (if proc 382 (message (concat msg "done")) 383 (if buf (kill-buffer buf)) 384 (egg-error 'canna-connect-error))))) 385 386(defun canna-filename (p) 387 "" 388 (cond ((consp p) (concat (car p) "/" (user-login-name))) 389 (t p))) 390 391(defun canna-search-environment (backend) 392 (let ((env-list canna-environments) 393 env) 394 (while (and (null env) env-list) 395 (setq env (and (eq (cannaenv-get-backend (car env-list)) backend) 396 (car env-list)) 397 env-list (cdr env-list))) 398 env)) 399 400(defun canna-get-environment (backend) 401 "Return the backend of CANNA environment." 402 (let ((env (canna-search-environment backend)) 403 proc context error) 404 (or env 405 (unwind-protect 406 (let* ((language (canna-backend-get-language backend)) 407 specs) 408 (setq proc (canna-open canna-hostname) 409 context (cdr proc) 410 proc (car proc) 411 canna-envspec-list nil) 412 (condition-case err 413 (egg-load-startup-file 'canna language) 414 (egg-error 415 (setq error err) 416 (signal (car error) (cdr error)))) 417 (setq specs canna-envspec-list) 418 (while specs 419 (canna-create-environment proc context (car specs)) 420 (setq context nil) 421 (setq specs (cdr specs))) 422 (setq env (canna-search-environment backend))) 423 (when (and proc (null env)) 424 (cannarpc-close proc) 425 (if error 426 (signal (car error) (cdr error)) 427 (egg-error 'canna-fail-make-env))) 428 )))) 429 430(defun canna-create-environment (proc context spec) 431 (let* ((save-inhibit-quit inhibit-quit) 432 (inhibit-quit t) 433 (backend (canna-envspec-backend spec)) 434 (convert-mode (canna-envspec-mode spec)) 435 (nostudy (canna-envspec-nostudy spec)) 436 (dic-list (canna-envspec-dic-list spec)) 437 env) 438 (condition-case err 439 (progn 440 (if (not context) 441 (setq context (cannarpc-create-context proc))) 442 (if (< context 0) 443 (egg-error "%s" (cannarpc-get-error-message (- context)))) 444 (setq env (cannaenv-create proc context backend convert-mode nostudy)) 445 (let ((inhibit-quit save-inhibit-quit)) 446 (while dic-list 447 (canna-set-dictionary env (car dic-list)) 448 (setq dic-list (cdr dic-list)))) 449 (setq canna-environments (nconc canna-environments (list env)))) 450 ((egg-error quit) 451 (if (eq (car err) 'egg-error) 452 (message "%s" (nth 1 err))) 453 (if env 454 (progn 455 (cannarpc-close-context env) 456 (setq canna-environments (delq env canna-environments)))) 457 (if (eq (car err) 'quit) 458 (signal 'quit (cdr err))))))) 459 460(defun canna-set-dictionary (env dic-spec) 461 (let ((dname (aref dic-spec 0)) 462 (drw (aref dic-spec 1)) 463 did result) 464 (if (= 0 (canna-open-dictionary env dname drw)) 465 (cannaenv-add-dic-list env dname drw)))) 466 467(defun canna-open-dictionary (env name rw) 468 (let ((trying t) 469 ret) 470 (while trying 471 (setq ret (cannarpc-open-dictionary env name 0)) ; XXX MODE=0 472 (if (= ret 0) 473 (setq trying nil) 474 (message (egg-get-message 'canna-dict-missing-1) name) 475 (if rw 476 (if (and (y-or-n-p 477 (format (egg-get-message 'canna-dict-missing-2) name)) 478 (= (cannarpc-make-dictionary env name) 0)) 479 (message (egg-get-message 'canna-dict-created) name) 480 (message "%s" (cannarpc-get-error-message (- ret)))) 481 (setq trying nil)))) 482 ret)) 483 484(defun canna-save-dictionaries (env) 485 (let ((dic-list (canna-list-writable-dictionaries-byname env)) 486 dic) 487 (while dic-list 488 (setq dic (car dic-list) 489 dic-list (cdr dic-list)) 490 (cannarpc-save-dictionary env dic)))) 491 492(defun canna-init () 493 ) 494 495(defun canna-set-converted-yomi (bunsetsu-pos bunsetsu-list) 496 (let ((bl bunsetsu-list) 497 (i bunsetsu-pos) 498 b) 499 (while bl 500 (setq b (car bl)) 501 (canna-bunsetsu-set-source b (cannarpc-get-bunsetsu-source env i)) 502 (setq i (1+ i) 503 bl (cdr bl))) 504 bunsetsu-list)) 505 506(defun canna-start-conversion (backend yomi &optional context) 507 "Convert YOMI string to kanji, and enter conversion mode. 508Return the list of bunsetsu." 509 (let* ((env (canna-get-environment backend)) 510 (bunsetsu-list (cannarpc-begin-conversion env yomi))) 511 (if (numberp bunsetsu-list) ; XXX error $B$N=hM}E,Ev(B 512 (progn 513 (if (= -1 (cannarpc-cancel-conversion env)) 514 (progn 515 (setq env (canna-get-environment backend)) 516 (canna-finalize-backend))) 517 (setq bunsetsu-list (cannarpc-begin-conversion env yomi)))) 518 (canna-set-converted-yomi 0 bunsetsu-list))) 519 520(defun canna-end-conversion (bunsetsu-list abort) 521 (let* ((env (canna-bunsetsu-get-env (car bunsetsu-list))) 522 (l bunsetsu-list) 523 (len (length bunsetsu-list)) 524 (zenkouho-pos-vector (make-vector (* 2 len) 0)) 525 (i 0) 526 (mode (if (cannaenv-get-nostudy env) 0 1)) ; MODE=1 $B3X=,(B 0 $B$7$J$$(B 527 bunsetsu zenkouho-pos) 528 (if abort 529 (setq mode 0)) 530 (while l 531 (setq bunsetsu (car l)) 532 (setq l (cdr l)) 533 (setq zenkouho-pos (canna-bunsetsu-get-zenkouho-pos bunsetsu)) 534 (if (null zenkouho-pos) 535 () ; XXX: NIL--> 0 atteru??? 536 (aset zenkouho-pos-vector i 0) ; XXX Don't support >=256 537 (aset zenkouho-pos-vector (1+ i) zenkouho-pos)) 538 (setq i (+ i 2))) 539 (cannarpc-end-conversion env len zenkouho-pos-vector mode))) 540 541(defun canna-list-candidates (bunsetsu prev-b next-b major) 542 (setq bunsetsu (car bunsetsu)) 543 (if (canna-bunsetsu-get-zenkouho bunsetsu) 544 (cons (canna-bunsetsu-get-zenkouho-pos bunsetsu) 545 (canna-bunsetsu-get-zenkouho-converted bunsetsu)) 546 (let* ((env (canna-bunsetsu-get-env bunsetsu)) 547 (yomi (canna-get-bunsetsu-source bunsetsu)) 548 (bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos bunsetsu)) 549 (z (cannarpc-get-bunsetsu-candidates env bunsetsu-pos yomi))) 550 (canna-bunsetsu-set-zenkouho bunsetsu z) 551 (cons (canna-bunsetsu-set-zenkouho-pos bunsetsu 0) 552 (canna-bunsetsu-set-zenkouho-converted 553 bunsetsu 554 (mapcar 'canna-bunsetsu-get-converted z)))))) 555 556;;; XXX not use ? 557(defun canna-get-number-of-candidates (bunsetsu) 558 (let ((l (canna-bunsetsu-get-zenkouho bunsetsu))) 559 (if l 560 (length l) 561 nil))) 562 563(defun canna-decide-candidate (bunsetsu pos prev-b next-b) 564 (let* ((head (car bunsetsu)) 565 (candidate-list (canna-bunsetsu-get-zenkouho head)) 566 (candidate (nth pos candidate-list))) 567 (canna-bunsetsu-set-zenkouho candidate candidate-list) 568 (canna-bunsetsu-set-zenkouho-pos candidate pos) 569 (canna-bunsetsu-set-zenkouho-converted 570 candidate (canna-bunsetsu-get-zenkouho-converted head)) 571 (list (list candidate)))) 572 573(defun canna-special-candidate (bunsetsu prev-b next-b major type) 574 (let* ((head (car bunsetsu)) 575 (env (canna-bunsetsu-get-env head)) 576 (backend (egg-bunsetsu-get-backend head)) 577 (lang (get backend 'language)) 578 source converted zenkouho-list kouho-list pos) 579 (when (and (eq lang (get backend 'source-language)) 580 (eq lang (get backend 'converted-language))) 581 (cond ((eq lang 'Japanese) 582 (setq source (canna-get-bunsetsu-source head)) 583 (cond ((eq type 'egg-hiragana) 584 (setq converted source)) 585 ((eq type 'egg-katakana) 586 (setq converted (japanese-katakana source)))) 587 (setq zenkouho-list 588 (cdr (canna-list-candidates bunsetsu prev-b next-b major))) 589 (setq pos 590 (when (setq kouho-list (member converted zenkouho-list)) 591 (- (length zenkouho-list) (length kouho-list)))))) 592 (when pos 593 (canna-decide-candidate bunsetsu pos prev-b next-b))))) 594 595;;; XXX not used ? 596(defun canna-get-current-candidate-number (bunsetsu) 597 (canna-bunsetsu-get-zenkouho-pos bunsetsu)) 598 599;;; XXX not used ? 600(defun canna-get-all-candidates (bunsetsu) 601 (let* ((l (canna-bunsetsu-get-zenkouho bunsetsu)) 602 (result (cons nil nil)) 603 (r result)) 604 (catch 'break 605 (while t 606 (let ((candidate (car l))) 607 (setcar r (canna-bunsetsu-get-converted candidate)) 608 (if (null (setq l (cdr l))) 609 (throw 'break nil) 610 (setq r (setcdr r (cons nil nil))))))) 611 result)) 612 613(defun canna-change-bunsetsu-length (bunsetsu prev-b next-b len major) 614 (let* ((env (canna-bunsetsu-get-env (car bunsetsu))) 615 (yomi (canna-get-bunsetsu-source (car bunsetsu))) 616 (yomi-length (cond ((< (length yomi) len) -1) 617 ((> (length yomi) len) -2) 618 (t nil))) 619 (bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos (car bunsetsu))) 620 new) 621 (if yomi-length 622 (setq new (canna-set-converted-yomi 623 bunsetsu-pos 624 (cannarpc-set-kugiri-changed env yomi-length bunsetsu-pos))) 625 (setq new bunsetsu)) 626 (list (list (car new)) prev-b (cdr new)))) 627 628(defun canna-finalize-backend (&optional action) 629 (let* ((save-inhibit-quit inhibit-quit) 630 (inhibit-quit t) 631 (env-list canna-environments) 632 env proc-list saved) 633 (while env-list 634 (setq env (car env-list) 635 env-list (cdr env-list)) 636 (condition-case err 637 (progn 638 (unless (memq (cannaenv-get-proc env) proc-list) 639 (setq proc-list (cons (cannaenv-get-proc env) proc-list))) 640 (unless (eq action 'disconnect-only) 641 (unless saved 642 (setq saved t) 643 (message (egg-get-message 'canna-dict-saving) "Canna")) 644 (let ((inhibit-quit save-inhibit-quit)) 645 (canna-save-dictionaries env))) 646 (unless (eq action 'save-only) 647 (cannarpc-close-context env))) 648 ((error quit) 649 (message "signal %S occured when dictionary saving" err)))) 650 (if saved 651 (message (egg-get-message 'canna-dict-saved) "Canna")) 652 (unless (eq action 'save-only) 653 (while proc-list 654 (if (and (car proc-list) 655 (memq (process-status (car proc-list)) '(open run))) 656 (cannarpc-close (car proc-list))) 657 (setq proc-list (cdr proc-list))))) 658 (setq canna-environments nil)) 659 660;;; word registration 661 662(defun canna-list-writable-dictionaries-byname (env) 663 (let ((dic-list (cannaenv-get-dic-list env))) 664 (delq nil 665 (mapcar (lambda (dic) 666 (let ((dname (aref dic 0)) 667 (drw (aref dic 1))) 668 (and drw dname))) 669 dic-list)))) 670 671(defun canna-dictionary-select (env) 672 (let ((dic-list (canna-list-writable-dictionaries-byname env))) 673 (if (= 1 (length dic-list)) 674 (car dic-list) 675 (menudiag-select (list 'menu 676 (egg-get-message 'canna-register-1) 677 dic-list))))) 678 679(defun canna-hinshi-MEISHI (kanji yomi) 680 (if (y-or-n-p (concat "$B!V(B" kanji "$B$J!W$O@5$7$$$G$9$+!#(B")) "#T15" "#T35")) 681 682(defun canna-hinshi-SAHEN-MEISHI (kanji yomi) 683 (if (y-or-n-p (concat "$B!V(B" kanji "$B$J!W$O@5$7$$$G$9$+!#(B")) "#T10" "#T30")) 684 685(defmacro canna-hinshi-DOUSHI-check-gobi () 686 '(progn 687 (setq i 0) 688 (while (> 9 i) 689 (if (string-match (concat (substring gobi i (1+ i)) "$") kanji) 690 (progn 691 (setq renyou (substring re-gobi i (1+ i))) 692 (setq mizen (substring mi-gobi i (1+ i))) 693 (setq kanji-gobi (substring kanji (match-beginning 0))) 694 (setq kanji-gokan (substring kanji 0 (match-beginning 0))) 695 (setq ret (nth i hinshi)) 696 (setq i 9))) 697 (setq i (1+ i))) 698 (setq i 0) 699 (while (> 9 i) 700 (if (string-match (concat (substring gobi i (1+ i)) "$") yomi) 701 (progn 702 (setq yomi-gobi (substring yomi (match-beginning 0))) 703 (setq yomi-gokan (substring yomi 0 (match-beginning 0))) 704 (setq i 9))) 705 (setq i (1+ i))))) 706 707(defun canna-hinshi-DOUSHI (kanji yomi) 708 (let ((gobi "$B$/$0$9$D$L$V$`$k$&(B") 709 (re-gobi "$B$-$.$7$A$K$S$_$j$$(B") 710 (mi-gobi "$B$+$,$5$?$J$P$^$i$o(B") 711 (hinshi (list "#K5" "#G5" "#S5" "#T5" "#N5" "#B5" "#M5" "#R5" "#W5")) 712 kanji-gokan yomi-gokan kanji-gobi yomi-gobi mizen renyou 713 i ret1 ret2 ret) 714 (canna-hinshi-DOUSHI-check-gobi) 715 (if (not (and (> (length kanji) 1) (> (length yomi) 1) 716 (and kanji-gobi yomi-gobi (equal kanji-gobi yomi-gobi)))) 717 (if (and kanji-gobi yomi-gobi) 718 (egg-error "$BFI$_$H8uJd$N3hMQ$,0c$$$^$9!#F~NO$7$J$*$7$F$/$@$5$$!#(B") 719 (egg-error "$BFI$_$H8uJd$r=*;_7A$GF~NO$7$F$/$@$5$$!#(B"))) 720 (cond ((and (> (length kanji) 2) (> (length yomi) 2) 721 (string-match "$B$/$k(B$" kanji) (string-match "$B$/$k(B$" yomi)) 722 (setq ret "#KX") 723 (setq kanji-gokan (substring kanji 0 (- (length kanji) 2))) 724 (setq yomi-gokan (substring yomi 0 (- (length yomi) 2)))) 725 ((and (> (length kanji) 3) (> (length yomi) 3) 726 (string-match "$B$s$:$k(B$" kanji) (string-match "$B$s$:$k(B$" yomi)) 727 (setq ret "#NZX") 728 (setq kanji-gokan (substring kanji 0 (- (length kanji) 3))) 729 (setq yomi-gokan (substring yomi 0 (- (length yomi) 3)))) 730 ((and (> (length kanji) 2) (> (length yomi) 2) 731 (string-match "$B$:$k(B$" kanji) (string-match "$B$:$k(B$" yomi)) 732 (setq ret "#ZX") 733 (setq kanji-gokan (substring kanji 0 (- (length kanji) 2))) 734 (setq yomi-gokan (substring yomi 0 (- (length yomi) 2)))) 735 ((and (> (length kanji) 2) (> (length yomi) 2) 736 (string-match "$B$9$k(B$" kanji) (string-match "$B$9$k(B$" yomi)) 737 (setq ret "#SX") 738 (setq kanji-gokan (substring kanji 0 (- (length kanji) 2))) 739 (setq yomi-gokan (substring yomi 0 (- (length yomi) 2))))) 740 (if (not (string-match "5$" ret)) 741 (if (y-or-n-p (concat "$B!X(B" kanji "$B!Y$r(B (" (canna-hinshi-name ret) 742 ") $B$H$7$FEPO?$7$^$9$+(B? ")) 743 (setq ret (list kanji-gokan yomi-gokan ret)) 744 (setq ret "#R5") 745 (setq kanji-gokan (substring kanji 0 (- (length kanji) 1))) 746 (setq yomi-gokan (substring yomi 0 (- (length yomi) 1))))) 747 (if (listp ret) 748 ret 749 (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+(B? ") 750 (progn 751 (setq ret1 (y-or-n-p (concat "$B!V(B" kanji-gokan mizen 752 "$B$J$$!W$O@5$7$$$G$9$+!#(B"))) 753 (setq i 0) 754 (if (eq "#R5" ret) 755 (while (> 9 i) 756 (if (string-match (concat (substring re-gobi i (1+ i)) "$") 757 kanji-gokan) 758 (progn (setq renyou nil) 759 (setq i 9))) 760 (setq i (1+ i)))) 761 (setq ret2 (y-or-n-p (concat "$B!V(B" kanji-gokan renyou 762 "$B$,$$$$!W$O@5$7$$$G$9$+!#(B"))) 763 (setq ret (if ret1 (if ret2 (concat ret "r") ret) 764 (if ret2 "#KSr" "#KS"))))) 765 (list kanji-gokan yomi-gokan ret)))) 766 767(defun canna-hinshi-KEIYOUSHI (kanji yomi) 768 (let (ret) 769 (if (not (and (> (length kanji) 1) (> (length yomi) 1) 770 (string-match "$B$$(B$" yomi) (string-match "$B$$(B$" kanji))) 771 (egg-error "$BFI$_$H8uJd$r(B $B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc(B) $BAa$$(B")) 772 (setq kanji (substring kanji 0 (1- (length kanji)))) 773 (setq yomi (substring yomi 0 (1- (length yomi)))) 774 (setq ret 775 (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+(B? ") 776 (if (y-or-n-p (concat "$B!V(B" kanji "$B!W$O@5$7$$$G$9$+!#(B")) 777 "#KYT" "#KY") 778 "#KY")) 779 (list kanji yomi ret))) 780 781(defun canna-hinshi-KEIYOUDOUSHI (kanji yomi) 782 (let (ret1 ret2 ret) 783 (if (not (and (> (length kanji) 1) (> (length yomi) 1) 784 (string-match "$B$@(B$" yomi) (string-match "$B$@(B$" kanji))) 785 (egg-error "$BFI$_$H8uJd$r(B $B=*;_7A$GF~NO$7$F$/$@$5$$!#Nc(B) $B@E$+$@(B")) 786 (setq kanji (substring kanji 0 (1- (length kanji)))) 787 (setq yomi (substring yomi 0 (1- (length yomi)))) 788 (setq ret 789 (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+(B? ") 790 (progn 791 (setq ret1 (y-or-n-p 792 (concat "$B!V(B" kanji "$B$9$k!W$O@5$7$$$G$9$+!#(B"))) 793 (setq ret2 (y-or-n-p 794 (concat "$B!V(B" kanji "$B$,$"$k!W$O@5$7$$$G$9$+!#(B"))) 795 (if ret1 (if ret2 "#T10" "#T13") (if ret2 "#T15" "#T18"))) 796 "#T05")) 797 (list kanji yomi ret))) 798 799(defun canna-hinshi-FUKUSHI (kanji yomi) 800 (let (ret1 ret2) 801 (if (y-or-n-p "$B$5$i$K:Y$+$$IJ;lJ,$1$N$?$a$N<ALd$r$7$F$bNI$$$G$9$+(B? ") 802 (progn 803 (setq ret1 (y-or-n-p (concat "$B!V(B" kanji "$B$9$k!W$O@5$7$$$G$9$+!#(B"))) 804 (setq ret2 (y-or-n-p (concat "$B!V(B" kanji "$B$H!W$O@5$7$$$G$9$+!#(B"))) 805 (if ret1 (if ret2 "#F04" "#F12") (if ret2 "#F06" "#F14"))) 806 "#F14"))) 807 808(defun canna-hinshi-select (kanji yomi) 809 (let ((key (menudiag-select (list 'menu 810 (egg-get-message 'canna-register-2) 811 canna-hinshi-menu)))) 812 (cond ((symbolp key) (funcall 813 (intern (concat "canna-hinshi-" (symbol-name key))) 814 kanji yomi)) 815 ((stringp key) (cdr (assoc key canna-hinshi-alist)))))) 816 817(defun canna-word-registration (backend kanji yomi) 818 "Register a word KANJI with a pronunciation YOMI." 819 (if (or (null (eq (egg-get-language 0 kanji) 820 (canna-get-converted-language backend))) 821 (next-single-property-change 0 'egg-lang kanji) 822 (null (eq (egg-get-language 0 yomi) 823 (canna-get-source-language backend))) 824 (next-single-property-change 0 'egg-lang yomi)) 825 (egg-error "word registration: invalid character") 826 (let* ((env (canna-get-environment backend)) 827 (dic (canna-dictionary-select env)) 828 (hinshi-id (canna-hinshi-select kanji yomi)) 829 result) 830 (if (listp hinshi-id) 831 (progn (setq kanji (car hinshi-id)) 832 (setq yomi (nth 1 hinshi-id)) 833 (setq hinshi-id (nth 2 hinshi-id)))) 834 (setq result (cannarpc-add-word env dic yomi kanji hinshi-id)) 835 (if (>= result 0) 836 (progn 837 (cannarpc-save-dictionary env dic) 838 (list (canna-hinshi-name hinshi-id) dic)) 839 (egg-error (cannarpc-get-error-message (- result))))))) 840 841;;; word delete registration 842 843(defun canna-word-delete-regist (backend yomi) 844 "Delete a word KANJI from dictionary." 845 (if (= (length yomi) 0) 846 (egg-error "Canna word delete registration: null string")) 847 (let* ((env (canna-get-environment backend)) 848 (dic (canna-dictionary-select env)) 849 proc context envd bunsetsu bunsetsu-pos z zpos kouho-list hinshi i 850 kanji lex result) 851 (setq proc (cannaenv-get-proc env)) 852 (setq context (cannarpc-create-context proc)) 853 (setq envd (cannaenv-create proc context 854 'canna-backend-Japanese-tmp-delete-regist 855 1 t)) 856 (canna-set-dictionary envd (vector dic t)) 857 (canna-set-dictionary envd (vector "fuzokugo" nil)) 858 (setq bunsetsu (car (cannarpc-begin-conversion envd yomi))) 859 (setq bunsetsu-pos (canna-bunsetsu-get-bunsetsu-pos bunsetsu)) 860 (setq z (cannarpc-get-bunsetsu-candidates envd bunsetsu-pos yomi)) 861 (canna-bunsetsu-set-zenkouho bunsetsu z) 862 (canna-bunsetsu-set-zenkouho-pos bunsetsu 0) 863 (setq kouho-list 864 (canna-bunsetsu-set-zenkouho-converted 865 bunsetsu 866 (mapcar 'canna-bunsetsu-get-converted z))) 867 (setq yomi (car (last kouho-list))) 868 (setq kouho-list (cdr (reverse kouho-list))) 869 (setq kouho-list (reverse kouho-list)) 870 (setq i 0) 871 (setq kouho-list (mapcar #'(lambda (k) 872 (prog1 873 (cons k i) 874 (setq i (1+ i)))) 875 kouho-list)) 876 (let ((hiragana (assoc yomi kouho-list)) 877 hinshi) 878 (if hiragana 879 (setq hinshi (cannarpc-get-hinshi envd bunsetsu-pos (cdr hiragana)))) 880 (if (stringp hinshi) 881 (if (equal "#T35" hinshi) 882 (setq kouho-list (delete hiragana kouho-list))) 883 (setq kouho-list (delete hiragana kouho-list)))) 884 (cond 885 ((null kouho-list) 886 (cannarpc-close-context envd) 887 (egg-error "$BEPO?$5$l$F$$$^$;$s!#(B")) 888 ((eq 1 (length kouho-list)) 889 (setq zpos 0) 890 (setq kanji (car (car kouho-list)))) 891 (t 892 (setq kanji (menudiag-select (list 'menu "$B:o=|(B:" kouho-list) nil nil t)) 893 (setq zpos (cdr (car kanji))) 894 (setq kanji (car (car kanji))))) 895 (setq hinshi (cannarpc-get-hinshi envd bunsetsu-pos zpos)) 896 (setq lex (cannarpc-get-lex envd bunsetsu-pos zpos)) 897 (cannarpc-cancel-conversion envd) 898 (if (string-match "#[^#]+" hinshi) 899 (setq hinshi (substring hinshi 0 (match-end 0))) 900 (egg-error "$BIJ;l>pJs$,<hF@$G$-$^$;$s!#(B")) 901 (setq kanji (substring kanji 0 (nth 1 (car lex)))) 902 (setq yomi (substring yomi 0 (car (car lex)))) 903 (if (y-or-n-p (concat "$B!X(B" kanji "$B!Y(B(" yomi ": " 904 (canna-hinshi-name hinshi) ")$B$r(B " 905 dic " $B$+$i:o=|$7$^$9$+(B? ")) 906 (setq result 907 (cannarpc-delete-word envd dic yomi kanji hinshi)) 908 (setq result -1)) 909 (if (>= result 0) 910 (progn 911 (cannarpc-save-dictionary envd dic) 912 (cannarpc-close-context envd) 913 (list kanji yomi (canna-hinshi-name hinshi) dic)) 914 (cannarpc-close-context envd) 915 (egg-error "$B:o=|$5$l$^$;$s$G$7$?!#(B")) 916 )) 917 918;;; setup 919(load "egg/cannarpc") 920(run-hooks 'canna-load-hook) 921 922;;;###autoload 923(defun egg-activate-canna (&rest arg) 924 "Activate CANNA backend of Tamago 4." 925 (apply 'egg-mode (append arg canna-backend-alist))) 926 927;;; egg/canna.el ends here. 928