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 ;; Keywords: mule, multilingual, input method
   9
  10 ;; This file is part of EGG.
  11
  12 ;; EGG is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; EGG is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc.,
  25 ;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  26
  27 ;;; Commentary:
  28
  29
  30 ;;; Code:
  31
  32 (require 'egg)
  33 (require 'egg-edep)
  34
  35 (defgroup sj3 nil
  36   "SJ3 interface for Tamago-tsunagi."
  37   :group 'egg)
  38
  39 (defcustom sj3-hostname "localhost"
  40   "Hostname of SJ3 server"
  41   :group 'sj3 :type 'string)
  42
  43 (defcustom sj3-server-port 3086
  44   "Port number of SJ3 server"
  45   :group 'sj3 :type 'integer)
  46
  47
  48 (eval-when-compile
  49   (defmacro SJ3-const (c)
  50     (cond ((eq c 'FileNotExist) 35)
  51           )))
  52
  53 (egg-add-message
  54  '((Japanese
  55     (sj3-register-1 "\e$BEPO?<-=qL>\e(B:")
  56     (sj3-register-2 "\e$BIJ;lL>\e(B"))))
  57
  58 (defvar sj3-hinshi-menu
  59   '(("\e$BL>;l\e(B"       .
  60      (menu "\e$BIJ;l\e(B:\e$BL>;l\e(B:"
  61            (("\e$BL>;l\e(B"               . 1)
  62             ("\e$BL>;l\e(B(\e$B$*!D\e(B)"   . 2)
  63             ("\e$BL>;l\e(B(\e$B$4!D\e(B)"   . 3)
  64             ("\e$BL>;l\e(B(\e$B!DE*\e(B/\e$B2=\e(B)"  . 4)
  65             ("\e$BL>;l\e(B(\e$B$*!D$9$k\e(B)"       . 5)
  66             ("\e$BL>;l\e(B(\e$B!D$9$k\e(B)" . 6)
  67             ("\e$BL>;l\e(B(\e$B$4!D$9$k\e(B)"       . 7)
  68             ("\e$BL>;l\e(B(\e$B!D$J\e(B/\e$B$K\e(B)"  . 8)
  69             ("\e$BL>;l\e(B(\e$B$*!D$J\e(B/\e$B$K\e(B)"        . 9)
  70             ("\e$BL>;l\e(B(\e$B$4!D$J\e(B/\e$B$K\e(B)"        . 10)
  71             ("\e$BL>;l\e(B(\e$BI{;l\e(B)"   . 11))))
  72     ("\e$BBeL>;l\e(B"     . 12)
  73     ("\e$BID;z\e(B"       . 21)
  74     ("\e$BL>A0\e(B"       . 22)
  75     ("\e$BCOL>\e(B"       . 24)
  76     ("\e$B8)\e(B/\e$B6hL>\e(B"      . 25)
  77     ("\e$BF0;l\e(B"       .
  78      (menu "\e$BIJ;l\e(B:\e$BF0;l\e(B:"
  79            (("\e$B%5JQ8l44\e(B"           . 80)
  80             ("\e$B%6JQ8l44\e(B"           . 81)
  81             ("\e$B0lCJITJQ2=It\e(B"       . 90)
  82             ("\e$B%+9T8^CJ8l44\e(B"       . 91)
  83             ("\e$B%,9T8^CJ8l44\e(B"       . 92)
  84             ("\e$B%59T8^CJ8l44\e(B"       . 93)
  85             ("\e$B%?9T8^CJ8l44\e(B"       . 94)
  86             ("\e$B%J9T8^CJ8l44\e(B"       . 95)
  87             ("\e$B%P9T8^CJ8l44\e(B"       . 96)
  88             ("\e$B%^9T8^CJ8l44\e(B"       . 97)
  89             ("\e$B%i9T8^CJ8l44\e(B"       . 98)
  90             ("\e$B%o9T8^CJ8l44\e(B"       . 99))))
  91     ("\e$BO"BN;l\e(B"             . 26)
  92     ("\e$B@\B3;l\e(B"             . 27)
  93     ("\e$B=u?t;l\e(B"             . 29)
  94     ("\e$B?t;l\e(B"               . 30)
  95     ("\e$B@\F,8l\e(B"             . 31)
  96     ("\e$B@\Hx8l\e(B"             . 36)
  97     ("\e$BI{;l\e(B"               . 45)
  98     ("\e$BI{;l\e(B2"              . 46)
  99     ("\e$B7AMF;l8l44\e(B" . 60)
 100     ("\e$B7AMFF0;l8l44\e(B"       . 71)
 101     ("\e$BC14A;z\e(B"             . 189))
 102   "Menu data for a hinshi (a part of speech) selection.")
 103
 104 (defun sj3-hinshi-name (id &optional menu alist)
 105   "Return a hinshi (a part of speech) name corresponding to ID.
 106 If ID is nil, return a flattened alist from `sj3-hinshi-menu'.
 107 Don't specify the optional arguments in normal use."
 108   (let ((menu (or menu sj3-hinshi-menu)))
 109     (if (consp menu)
 110         (if (consp (cdr menu))
 111             (mapcar (lambda (elem)
 112                       (setq alist (sj3-hinshi-name nil elem alist)))
 113                     menu)
 114           (setq alist (nconc alist (list (cons (cdr menu) (car menu)))))))
 115     (if id
 116         (cdr (assq id alist))
 117       alist)))
 118
 119 (setplist 'sj3-conversion-backend
 120           '(egg-start-conversion          sj3-start-conversion
 121             egg-get-bunsetsu-source       sj3-get-bunsetsu-source
 122             egg-get-bunsetsu-converted    sj3-get-bunsetsu-converted
 123             egg-get-source-language       sj3-get-source-language
 124             egg-get-converted-language    sj3-get-converted-language
 125             egg-list-candidates           sj3-list-candidates
 126             egg-decide-candidate          sj3-decide-candidate
 127             egg-change-bunsetsu-length    sj3-change-bunsetsu-length
 128             egg-end-conversion            sj3-end-conversion
 129             egg-word-registration         sj3-word-registration))
 130
 131 (defconst sj3-backend-alist '((Japanese ((sj3-conversion-backend)))))
 132
 133 (egg-set-finalize-backend '(sj3-finalize-backend))
 134
 135 (defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
 136
 137 (defvar sj3-open-message)
 138
 139 (defun sj3-open (hostname)
 140   "Establish the connection to SJ3 server.  Return process object."
 141   (let* ((buf (generate-new-buffer " *SJ3*"))
 142          proc result)
 143     (condition-case err
 144         (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 145       ((error quit)
 146        (egg-error "failed to connect sj3 server")))
 147     (set-process-query-on-exit-flag proc nil)
 148     (set-process-coding-system proc 'binary 'binary)
 149     (set-marker-insertion-type (process-mark proc) t)
 150     (save-excursion
 151       (set-buffer buf)
 152       (erase-buffer)
 153       (buffer-disable-undo)
 154       (set-buffer-multibyte nil))
 155     ;; Initialize dictionaries
 156     (setq sj3-sys-dict-list nil)
 157     (setq sj3-user-dict-list nil)
 158     (setq result (sj3rpc-open proc (system-name) (user-login-name)))
 159     (if (< result 0)
 160         (let ((msg (sj3rpc-get-error-message (- result))))
 161           (delete-process proc)
 162           (kill-buffer buf)
 163           (egg-error "Can't open SJ3 session (%s): %s" hostname msg)))
 164     (setq result (sj3rpc-get-stdy-size proc))
 165     (if (< result 0)
 166         (let ((msg (sj3rpc-get-error-message (- result))))
 167           (delete-process proc)
 168           (kill-buffer buf)
 169           (egg-error "Can't get SJ3 STDYSIZE: %s"msg)))
 170     (setq sj3-stdy-size result)
 171     proc))
 172
 173 ;; (defun sj3-open (hostname-list)
 174 ;;   "Establish the connection to SJ3 server.  Return process object."
 175 ;;   (let* ((buf (generate-new-buffer " *SJ3*"))
 176 ;;       (msg-form "SJ3: connecting to sj3serv at %s...")
 177 ;;       hostname proc result msg)
 178 ;;     (save-excursion
 179 ;;       (set-buffer buf)
 180 ;;       (erase-buffer)
 181 ;;       (buffer-disable-undo)
 182 ;;       (setq enable-multibyte-characters nil))
 183 ;;     (cond
 184 ;;      ((null hostname-list)
 185 ;;       (setq hostname-list '("localhost")))
 186 ;;      ((null (listp hostname-list))
 187 ;;       (setq hostname-list (list hostname-list))))
 188 ;;     (while (and hostname-list (null proc))
 189 ;;       (setq hostname (car hostname-list)
 190 ;;          hostname-list (cdr hostname-list))
 191 ;;       (message msg-form hostname)
 192 ;;       (sit-for 0)
 193 ;;       (condition-case result
 194 ;;        (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 195 ;;      (error nil))
 196 ;;       (if proc
 197 ;;        (progn
 198 ;;          (process-kill-without-query proc)
 199 ;;          (set-process-coding-system proc 'binary 'binary)
 200 ;;          (set-marker-insertion-type (process-mark proc) t)
 201 ;;          ;; Initialize dictionaries
 202 ;;          (setq sj3-sys-dict-list nil)
 203 ;;          (setq sj3-user-dict-list nil)
 204 ;;          (setq result (sj3rpc-open proc (system-name) (user-login-name)))
 205 ;;          (if (< result 0)
 206 ;;              (progn
 207 ;;                (delete-process proc)
 208 ;;                (setq proc nil
 209 ;;                      msg (format "Can't open SJ3 session (%s): %s"
 210 ;;                                  hostname msg)))
 211 ;;            (setq result (sj3rpc-get-stdy-size proc))
 212 ;;            (if (< result 0)
 213 ;;                (progn
 214 ;;                  (delete-process proc)
 215 ;;                  (setq proc nil
 216 ;;                        msg (format "Can't get SJ3 STDYSIZE: %s"
 217 ;;                                    (sj3rpc-get-error-message (- result)))))
 218 ;;              (setq sj3-stdy-size result))))))
 219 ;;     (if proc
 220 ;;      (progn
 221 ;;        (setq sj3-open-message (format (concat msg-form "done") hostname))
 222 ;;        proc)
 223 ;;       (kill-buffer buf)
 224 ;;       (error "%s" (or msg "no sj3serv available")))))
 225
 226 ;; <env> ::= [ <proc> <dictionary-list> ]
 227 (defvar sj3-environment nil
 228   "Environment for SJ3 kana-kanji conversion")
 229
 230 (defsubst sj3env-get-proc (env)
 231   (aref env 0))
 232 (defsubst sj3env-get-dictionary-list (env)
 233   (aref env 1))
 234
 235 ;; <sj3-bunsetsu> ::=
 236 ;;  [ <env> <source> <converted> <rest> <stdy>
 237 ;;    <zenkouho> <zenkouho-pos> <zenkouho-converted>
 238 ;;    <kugiri-changed> ]
 239 (defsubst sj3-make-bunsetsu (env source converted rest stdy)
 240   (egg-bunsetsu-create
 241    'sj3-conversion-backend
 242    (vector env source converted rest stdy nil nil nil nil nil)))
 243
 244 (defsubst sj3bunsetsu-get-env (b)
 245   (aref (egg-bunsetsu-get-info b) 0))
 246 (defsubst sj3bunsetsu-get-source (b)
 247   (aref (egg-bunsetsu-get-info b) 1))
 248 (defsubst sj3bunsetsu-get-converted (b)
 249   (aref (egg-bunsetsu-get-info b) 2))
 250 (defsubst sj3bunsetsu-get-rest (b)
 251   (aref (egg-bunsetsu-get-info b) 3))
 252 (defsubst sj3bunsetsu-get-stdy (b)
 253   (aref (egg-bunsetsu-get-info b) 4))
 254
 255 (defsubst sj3bunsetsu-get-zenkouho (b)
 256   (aref (egg-bunsetsu-get-info b) 5))
 257 (defsubst sj3bunsetsu-set-zenkouho (b z)
 258   (aset (egg-bunsetsu-get-info b) 5 z))
 259
 260 (defsubst sj3bunsetsu-get-zenkouho-pos (b)
 261   (aref (egg-bunsetsu-get-info b) 6))
 262 (defsubst sj3bunsetsu-set-zenkouho-pos (b zp)
 263   (aset (egg-bunsetsu-get-info b) 6 zp))
 264
 265 (defsubst sj3bunsetsu-get-zenkouho-converted (b)
 266   (aref (egg-bunsetsu-get-info b) 7))
 267 (defsubst sj3bunsetsu-set-zenkouho-converted (b zc)
 268   (aset (egg-bunsetsu-get-info b) 7 zc))
 269
 270 (defsubst sj3bunsetsu-get-kugiri-changed (b)
 271   (aref (egg-bunsetsu-get-info b) 8))
 272 (defsubst sj3bunsetsu-set-kugiri-changed (b s)
 273   (aset (egg-bunsetsu-get-info b) 8 s))
 274
 275 (defun sj3-get-bunsetsu-source (b)
 276   (sj3bunsetsu-get-source b))
 277
 278 (defun sj3-get-bunsetsu-converted (b)
 279   (concat (sj3bunsetsu-get-converted b) (sj3bunsetsu-get-rest b)))
 280
 281 (defun sj3-get-source-language (b) 'Japanese)
 282 (defun sj3-get-converted-language (b) 'Japanese)
 283 (defun sj3-get-bunsetsu-stdy (b) (sj3bunsetsu-get-stdy b))
 284
 285 (defvar sj3-dictionary-specification
 286   '(("study.dat")
 287     ["sj3main.dic" ""]
 288     [("private.dic") ""])
 289   "Dictionary specification of SJ3.")
 290
 291 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
 292   "*Directory of user dictionary for SJ3.")
 293
 294 (defun sj3-filename (p)
 295   ""
 296   (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
 297         (t p)))
 298
 299 (defun sj3-get-environment ()
 300   "Return the backend of SJ3 environment."
 301   (if sj3-environment
 302       sj3-environment
 303     (let* ((proc (sj3-open sj3-hostname))
 304            (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
 305            (l (cdr sj3-dictionary-specification))
 306            dict-list)
 307       (sj3-open-freq-info proc freq-info-name)
 308       (while l
 309         (let ((dic (car l))
 310               dic-id)
 311           (setq dic-id
 312                 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
 313                                      (aref dic 1)))
 314           (if (< dic-id 0)
 315               (egg-error "Dame2")       ; XXX
 316             (setq dict-list (cons dic-id dict-list)
 317                   l (cdr l)))))
 318       (setq sj3-environment (vector proc dict-list)))))
 319
 320 (defun sj3-open-freq-info (proc name)
 321   (let ((trying t)
 322         ret)
 323     (while trying
 324       (setq ret (sj3rpc-open-stdy proc name))
 325       (if (= ret 0)
 326           (setq trying nil)
 327         (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 328         (if (/= ret (SJ3-const FileNotExist))
 329             (egg-error "Fatal1")        ; XXX
 330           (if (and (y-or-n-p
 331                     (format "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 332                             name))
 333                    (sj3rpc-make-directory proc
 334                                           (file-name-directory name))
 335                    ;; ignore error
 336                    (= (sj3rpc-make-stdy proc name) 0))
 337               (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 338             (egg-error "Fatal2")))))))  ; XXX
 339
 340 (defun sj3-open-dictionary (proc name passwd)
 341   (let ((trying t)
 342         ret)
 343     (while trying
 344       (setq ret (sj3rpc-open-dictionary proc name passwd))
 345       (if (>= ret 0)
 346           (setq trying nil)
 347         (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 348         (setq ret (- ret))              ; Get error code.
 349         (if (/= ret (SJ3-const FileNotExist))
 350             (egg-error "Fatal3 %d" ret) ; XXX
 351           (if (and (y-or-n-p
 352                     (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 353                             name))
 354                    (= (sj3rpc-make-dictionary proc name) 0))
 355               (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 356             (egg-error "Fatal4")))))    ; XXX
 357     ret))
 358
 359 (defun sj3-start-conversion (backend yomi &optional context)
 360   "Convert YOMI string to kanji, and enter conversion mode.
 361 Return the list of bunsetsu."
 362   (let ((env (sj3-get-environment)))
 363     (sj3rpc-begin env yomi)))
 364
 365 (defun sj3-end-conversion (bunsetsu-list abort)
 366   (if abort
 367       ()
 368     (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
 369           (l bunsetsu-list)
 370           bunsetsu stdy kugiri-changed)
 371       (while l
 372         (setq bunsetsu (car l))
 373         (setq l (cdr l))
 374         (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
 375         (if stdy
 376             (sj3rpc-bunsetsu-stdy env stdy))
 377         (if (and l
 378                  (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed
 379                                        bunsetsu)))
 380             (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
 381                   (yomi2 (sj3bunsetsu-get-source (car l))))
 382               (if (/= kugiri-changed (length yomi1))
 383                   (sj3rpc-kugiri-stdy env yomi1 yomi2
 384                                       (sj3bunsetsu-get-stdy (car l))))))))))
 385
 386 (defun sj3-list-candidates (bunsetsu prev-bunsetsu next-bunsetsu major)
 387   (setq bunsetsu (car bunsetsu))
 388   (if (sj3bunsetsu-get-zenkouho bunsetsu)
 389       (cons (sj3bunsetsu-get-zenkouho-pos bunsetsu)
 390             (sj3bunsetsu-get-zenkouho-converted bunsetsu))
 391     (let* ((env (sj3bunsetsu-get-env bunsetsu))
 392            (yomi (sj3bunsetsu-get-source bunsetsu))
 393            (z (sj3rpc-get-bunsetsu-candidates env yomi)))
 394       (sj3bunsetsu-set-zenkouho bunsetsu z)
 395       (cons (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
 396             (sj3bunsetsu-set-zenkouho-converted
 397              bunsetsu
 398              (mapcar 'sj3bunsetsu-get-converted z))))))
 399
 400 (defun sj3-decide-candidate (bunsetsu candidate-pos prev-b next-b)
 401   (setq bunsetsu (car bunsetsu))
 402   (let* ((candidate-list (sj3bunsetsu-get-zenkouho bunsetsu))
 403          (candidate (nth candidate-pos candidate-list)))
 404     (sj3bunsetsu-set-zenkouho candidate candidate-list)
 405     (sj3bunsetsu-set-zenkouho-pos candidate candidate-pos)
 406     (sj3bunsetsu-set-zenkouho-converted
 407      candidate (sj3bunsetsu-get-zenkouho-converted bunsetsu))
 408     (list (list candidate))))
 409
 410 (defun sj3-change-bunsetsu-length (bunsetsu prev-b next-b len major)
 411   (let ((yomi (mapconcat 'sj3bunsetsu-get-source bunsetsu nil))
 412         (env (sj3bunsetsu-get-env (car bunsetsu)))
 413         (old (car bunsetsu))
 414         new yomi1 yomi2)
 415     (setq yomi1 (substring yomi 0 len)
 416           yomi2 (substring yomi len))
 417     (setq new (sj3rpc-tanbunsetsu-conversion env yomi1))
 418     ;; Only set once (memory original length of the bunsetsu).
 419     (sj3bunsetsu-set-kugiri-changed new
 420                                     (or (sj3bunsetsu-get-kugiri-changed old)
 421                                         (length (sj3bunsetsu-get-source old))))
 422     (if (> (length yomi2) 0)
 423         (list (list new (sj3rpc-tanbunsetsu-conversion env yomi2)))
 424       (list (list new)))))
 425
 426 (defun sj3-finalize-backend ()
 427   (if sj3-environment
 428       (let ((proc (sj3env-get-proc sj3-environment))
 429             (dict-list (sj3env-get-dictionary-list sj3-environment))
 430             dict)
 431         (while dict-list
 432           (setq dict (car dict-list))
 433           (setq dict-list (cdr dict-list))
 434           (sj3rpc-close-dictionary proc dict)) ; XXX: check error
 435         (sj3rpc-close-stdy proc)
 436         (sj3rpc-close proc)
 437         (setq sj3-environment nil))))
 438
 439 ;;; word registration
 440
 441 (defun sj3-dictionary-select ()
 442   (menudiag-select (list 'menu
 443                          (egg-get-message 'sj3-register-1)
 444                          (aref (nth 2 sj3-dictionary-specification) 0))))
 445
 446 (defun sj3-hinshi-select ()
 447   (menudiag-select (list 'menu
 448                          (egg-get-message 'sj3-register-2)
 449                          sj3-hinshi-menu)))
 450
 451 (defun sj3-word-registration (backend kanji yomi)
 452   "Register a word KANJI with a pronunciation YOMI."
 453   (if (or (null (eq (egg-get-language 0 kanji)
 454                     (sj3-get-converted-language backend)))
 455           (next-single-property-change 0 'egg-lang kanji)
 456           (null (eq (egg-get-language 0 yomi)
 457                     (sj3-get-source-language backend)))
 458           (next-single-property-change 0 'egg-lang yomi))
 459       (egg-error "word registration: invalid character")
 460     (let* ((env (sj3-get-environment))
 461            (dic (sj3-dictionary-select))
 462            (hinshi-id (sj3-hinshi-select))
 463            (result (sj3rpc-add-word env
 464                                     (car (aref env 1))
 465                                     yomi kanji hinshi-id)))
 466       (if (>= result 0)
 467           (list (sj3-hinshi-name hinshi-id) dic)
 468         (egg-error (sj3rpc-get-error-message (- result)))))))
 469
 470 ;;; setup
 471
 472 (load "egg/sj3rpc")
 473 (run-hooks 'sj3-load-hook)
 474
 475 ;;;###autoload
 476 (defun egg-activate-sj3 (&rest arg)
 477   "Activate SJ3 backend of Tamago-tsunagi."
 478   (apply 'egg-mode (append arg sj3-backend-alist)))
 479
 480 ;;; egg/sj3.el ends here.