egg/sj3.el

   1 ;;; egg/sj3.el --- SJ3 Support (high level interface) in Egg
   2 ;;;                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
  32 ;;; Code:
  33
  34 (require 'egg)
  35 (require 'egg-edep)
  36
  37 (defgroup sj3 nil
  38   "SJ3 interface for Tamago 4."
  39   :group 'egg)
  40
  41 (defcustom sj3-hostname "localhost"
  42   "Hostname of SJ3 server"
  43   :group 'sj3 :type 'string)
  44
  45 (defcustom sj3-server-port 3086
  46   "Port number of SJ3 server"
  47   :group 'sj3 :type 'integer)
  48
  49
  50 (eval-when-compile
  51   (defmacro SJ3-const (c)
  52     (cond ((eq c 'FileNotExist) 35)
  53           )))
  54
  55 (egg-add-message
  56  '((Japanese
  57     (sj3-register-1 "\e$BEPO?<-=qL>\e(B:")
  58     (sj3-register-2 "\e$BIJ;lL>\e(B"))))
  59
  60 (defvar sj3-hinshi-menu
  61   '(("\e$BL>;l\e(B"       .
  62      (menu "\e$BIJ;l\e(B:\e$BL>;l\e(B:"
  63            (("\e$BL>;l\e(B"               . 1)
  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)
  75     ("\e$BID;z\e(B"       . 21)
  76     ("\e$BL>A0\e(B"       . 22)
  77     ("\e$BCOL>\e(B"       . 24)
  78     ("\e$B8)\e(B/\e$B6hL>\e(B"      . 25)
  79     ("\e$BF0;l\e(B"       .
  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)
  96     ("\e$B?t;l\e(B"               . 30)
  97     ("\e$B@\F,8l\e(B"             . 31)
  98     ("\e$B@\Hx8l\e(B"             . 36)
  99     ("\e$BI{;l\e(B"               . 45)
 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.")
 105
 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)))
 111     (if (consp menu)
 112         (if (consp (cdr menu))
 113             (mapcar (lambda (elem)
 114                       (setq alist (sj3-hinshi-name nil elem alist)))
 115                     menu)
 116           (setq alist (nconc alist (list (cons (cdr menu) (car menu)))))))
 117     (if id
 118         (cdr (assq id alist))
 119       alist)))
 120
 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))
 132
 133 (defconst sj3-backend-alist '((Japanese ((sj3-conversion-backend)))))
 134
 135 (egg-set-finalize-backend '(sj3-finalize-backend))
 136
 137 (defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
 138
 139 (defvar sj3-open-message)
 140
 141 (defun sj3-open (hostname)
 142   "Establish the connection to SJ3 server.  Return process object."
 143   (let* ((buf (generate-new-buffer " *SJ3*"))
 144          proc result)
 145     (condition-case err
 146         (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 147       ((error quit)
 148        (egg-error "failed to connect sj3 server")))
 149     (process-kill-without-query proc)
 150     (set-process-coding-system proc 'no-conversion 'no-conversion)
 151     (set-marker-insertion-type (process-mark proc) t)
 152     (save-excursion
 153       (set-buffer buf)
 154       (erase-buffer)
 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)))
 161     (if (< result 0)
 162         (let ((msg (sj3rpc-get-error-message (- result))))
 163           (delete-process proc)
 164           (kill-buffer buf)
 165           (egg-error "Can't open SJ3 session (%s): %s" hostname msg)))
 166     (setq result (sj3rpc-get-stdy-size proc))
 167     (if (< result 0)
 168         (let ((msg (sj3rpc-get-error-message (- result))))
 169           (delete-process proc)
 170           (kill-buffer buf)
 171           (egg-error "Can't get SJ3 STDYSIZE: %s"msg)))
 172     (setq sj3-stdy-size result)
 173     proc))
 174
 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)
 180 ;;     (save-excursion
 181 ;;       (set-buffer buf)
 182 ;;       (erase-buffer)
 183 ;;       (buffer-disable-undo)
 184 ;;       (setq enable-multibyte-characters nil))
 185 ;;     (cond
 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)
 194 ;;       (sit-for 0)
 195 ;;       (condition-case result
 196 ;;        (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 197 ;;      (error nil))
 198 ;;       (if proc
 199 ;;        (progn
 200 ;;          (process-kill-without-query proc)
 201 ;;          (set-process-coding-system proc 'no-conversion 'no-conversion)
 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)))
 207 ;;          (if (< result 0)
 208 ;;              (progn
 209 ;;                (delete-process proc)
 210 ;;                (setq proc nil
 211 ;;                      msg (format "Can't open SJ3 session (%s): %s"
 212 ;;                                  hostname msg)))
 213 ;;            (setq result (sj3rpc-get-stdy-size proc))
 214 ;;            (if (< result 0)
 215 ;;                (progn
 216 ;;                  (delete-process proc)
 217 ;;                  (setq proc nil
 218 ;;                        msg (format "Can't get SJ3 STDYSIZE: %s"
 219 ;;                                    (sj3rpc-get-error-message (- result)))))
 220 ;;              (setq sj3-stdy-size result))))))
 221 ;;     (if proc
 222 ;;      (progn
 223 ;;        (setq sj3-open-message (format (concat msg-form "done") hostname))
 224 ;;        proc)
 225 ;;       (kill-buffer buf)
 226 ;;       (error "%s" (or msg "no sj3serv available")))))
 227
 228 ;; <env> ::= [ <proc> <dictionary-list> ]
 229 (defvar sj3-environment nil
 230   "Environment for SJ3 kana-kanji conversion")
 231
 232 (defsubst sj3env-get-proc (env)
 233   (aref env 0))
 234 (defsubst sj3env-get-dictionary-list (env)
 235   (aref env 1))
 236
 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)
 242   (egg-bunsetsu-create
 243    'sj3-conversion-backend
 244    (vector env source converted rest stdy nil nil nil nil nil)))
 245
 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))
 256
 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))
 261
 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))
 266
 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))
 271
 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))
 276
 277 (defun sj3-get-bunsetsu-source (b)
 278   (sj3bunsetsu-get-source b))
 279
 280 (defun sj3-get-bunsetsu-converted (b)
 281   (concat (sj3bunsetsu-get-converted b) (sj3bunsetsu-get-rest b)))
 282
 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))
 286
 287 (defvar sj3-dictionary-specification
 288   '(("study.dat")
 289     ["sj3main.dic" ""]
 290     [("private.dic") ""])
 291   "Dictionary specification of SJ3.")
 292
 293 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
 294   "*Directory of user dictionary for SJ3.")
 295
 296 (defun sj3-filename (p)
 297   ""
 298   (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
 299         (t p)))
 300
 301 (defun sj3-get-environment ()
 302   "Return the backend of SJ3 environment."
 303   (if sj3-environment
 304       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))
 308            dict-list)
 309       (sj3-open-freq-info proc freq-info-name)
 310       (while l
 311         (let ((dic (car l))
 312               dic-id)
 313           (setq dic-id
 314                 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
 315                                      (aref dic 1)))
 316           (if (< dic-id 0)
 317               (egg-error "Dame2")       ; XXX
 318             (setq dict-list (cons dic-id dict-list)
 319                   l (cdr l)))))
 320       (setq sj3-environment (vector proc dict-list)))))
 321
 322 (defun sj3-open-freq-info (proc name)
 323   (let ((trying t)
 324         ret)
 325     (while trying
 326       (setq ret (sj3rpc-open-stdy proc name))
 327       (if (= ret 0)
 328           (setq trying nil)
 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
 332           (if (and (y-or-n-p
 333                     (format "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 334                             name))
 335                    (sj3rpc-make-directory proc
 336                                           (file-name-directory name))
 337                    ;; ignore error
 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
 341
 342 (defun sj3-open-dictionary (proc name passwd)
 343   (let ((trying t)
 344         ret)
 345     (while trying
 346       (setq ret (sj3rpc-open-dictionary proc name passwd))
 347       (if (>= ret 0)
 348           (setq trying nil)
 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
 353           (if (and (y-or-n-p
 354                     (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 355                             name))
 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
 359     ret))
 360
 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)))
 366
 367 (defun sj3-end-conversion (bunsetsu-list abort)
 368   (if abort
 369       ()
 370     (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
 371           (l bunsetsu-list)
 372           bunsetsu stdy kugiri-changed)
 373       (while l
 374         (setq bunsetsu (car l))
 375         (setq l (cdr l))
 376         (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
 377         (if stdy
 378             (sj3rpc-bunsetsu-stdy env stdy))
 379         (if (and l
 380                  (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed
 381                                        bunsetsu)))
 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))))))))))
 387
 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
 399              bunsetsu
 400              (mapcar 'sj3bunsetsu-get-converted z))))))
 401
 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))))
 411
 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)))
 415         (old (car bunsetsu))
 416         new yomi1 yomi2)
 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)))
 426       (list (list new)))))
 427
 428 (defun sj3-finalize-backend ()
 429   (if sj3-environment
 430       (let ((proc (sj3env-get-proc sj3-environment))
 431             (dict-list (sj3env-get-dictionary-list sj3-environment))
 432             dict)
 433         (while dict-list
 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)
 438         (sj3rpc-close proc)
 439         (setq sj3-environment nil))))
 440
 441 ;;; word registration
 442
 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))))
 447
 448 (defun sj3-hinshi-select ()
 449   (menudiag-select (list 'menu
 450                          (egg-get-message 'sj3-register-2)
 451                          sj3-hinshi-menu)))
 452
 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
 466                                     (car (aref env 1))
 467                                     yomi kanji hinshi-id)))
 468       (if (>= result 0)
 469           (list (sj3-hinshi-name hinshi-id) dic)
 470         (egg-error (sj3rpc-get-error-message (- result)))))))
 471
 472 ;;; setup
 473
 474 (load "egg/sj3rpc")
 475 (run-hooks 'sj3-load-hook)
 476
 477 ;;;###autoload
 478 (defun egg-activate-sj3 (&rest arg)
 479   "Activate SJ3 backend of Tamago 4."
 480   (apply 'egg-mode (append arg sj3-backend-alist)))
 481
 482 ;;; egg/sj3.el ends here.