egg/sj3.el

   1 ;;; egg/sj3.el --- SJ3 Support (high level interface) in Egg
   2 ;;;                Input Method Architecture
   3
   4 ;; Copyright (C) 1997, 1998 Mule Project,
   5 ;; Powered by Electrotechnical Laboratory, JAPAN.
   6 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
   7
   8 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
   9 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
  10
  11 ;; This file is part of EGG.
  12
  13 ;; EGG is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; EGG is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;;; Code:
  31
  32 (defconst sj3-support-languages '("Japanese"))
  33
  34 (eval-when-compile
  35   (defmacro SJ3-const (c)
  36     (cond ((eq c 'FileNotExist) 35)
  37           )))
  38
  39 (defconst sj3-conversion-backend
  40   [ sj3-init
  41
  42     sj3-start-conversion
  43       sj3-get-bunsetsu-converted
  44       sj3-get-bunsetsu-source
  45       sj3-list-candidates
  46           sj3-get-number-of-candidates
  47           sj3-get-current-candidate-number
  48           sj3-get-all-candidates
  49           sj3-decide-candidate
  50       sj3-change-bunsetsu-length
  51     sj3-end-conversion
  52     nil
  53
  54     sj3-fini
  55  ])
  56
  57 (defvar sj3-server-port 3000 "Port number of SJ3 server")
  58 (defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
  59 (defvar sj3-hostname "localhost"
  60   "Hostname of SJ3 server")
  61
  62 (defvar sj3-open-message)
  63
  64 (defun sj3-open (hostname)
  65   "Establish the connection to SJ3 server.  Return process object."
  66   (let* ((buf (generate-new-buffer " *SJ3*"))
  67          (proc (open-network-stream "SJ3" buf hostname sj3-server-port))
  68          result)
  69     (process-kill-without-query proc)
  70     (set-process-coding-system proc 'no-conversion 'no-conversion)
  71     (set-marker-insertion-type (process-mark proc) t)
  72     (save-excursion
  73       (set-buffer buf)
  74       (erase-buffer)
  75       (buffer-disable-undo)
  76       (setq enable-multibyte-characters nil))
  77     ;; Initialize dictionaries
  78     (setq sj3-sys-dict-list nil)
  79     (setq sj3-user-dict-list nil)
  80     (setq result (sj3rpc-open proc (system-name) (user-login-name)))
  81     (if (< result 0)
  82         (let ((msg (sj3rpc-get-error-message (- result))))
  83           (delete-process proc)
  84           (kill-buffer buf)
  85           (error "Can't open SJ3 session (%s): %s" hostname msg)))
  86     (setq result (sj3rpc-get-stdy-size proc))
  87     (if (< result 0)
  88         (let ((msg (sj3rpc-get-error-message (- result))))
  89           (delete-process proc)
  90           (kill-buffer buf)
  91           (error "Can't get SJ3 STDYSIZE: %s"msg)))
  92     (setq sj3-stdy-size result)
  93     proc))
  94
  95 ;; (defun sj3-open (hostname-list)
  96 ;;   "Establish the connection to SJ3 server.  Return process object."
  97 ;;   (let* ((buf (generate-new-buffer " *SJ3*"))
  98 ;;       (msg-form "SJ3: connecting to sj3serv at %s...")
  99 ;;       hostname proc result msg)
 100 ;;     (save-excursion
 101 ;;       (set-buffer buf)
 102 ;;       (erase-buffer)
 103 ;;       (buffer-disable-undo)
 104 ;;       (setq enable-multibyte-characters nil))
 105 ;;     (cond
 106 ;;      ((null hostname-list)
 107 ;;       (setq hostname-list '("localhost")))
 108 ;;      ((null (listp hostname-list))
 109 ;;       (setq hostname-list (list hostname-list))))
 110 ;;     (while (and hostname-list (null proc))
 111 ;;       (setq hostname (car hostname-list)
 112 ;;          hostname-list (cdr hostname-list))
 113 ;;       (message msg-form hostname)
 114 ;;       (sit-for 0)
 115 ;;       (condition-case result
 116 ;;        (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 117 ;;      (error nil))
 118 ;;       (if proc
 119 ;;        (progn
 120 ;;          (process-kill-without-query proc)
 121 ;;          (set-process-coding-system proc 'no-conversion 'no-conversion)
 122 ;;          (set-marker-insertion-type (process-mark proc) t)
 123 ;;          ;; Initialize dictionaries
 124 ;;          (setq sj3-sys-dict-list nil)
 125 ;;          (setq sj3-user-dict-list nil)
 126 ;;          (setq result (sj3rpc-open proc (system-name) (user-login-name)))
 127 ;;          (if (< result 0)
 128 ;;              (progn
 129 ;;                (delete-process proc)
 130 ;;                (setq proc nil
 131 ;;                      msg (format "Can't open SJ3 session (%s): %s"
 132 ;;                                  hostname msg)))
 133 ;;            (setq result (sj3rpc-get-stdy-size proc))
 134 ;;            (if (< result 0)
 135 ;;                (progn
 136 ;;                  (delete-process proc)
 137 ;;                  (setq proc nil
 138 ;;                        msg (format "Can't get SJ3 STDYSIZE: %s"
 139 ;;                                    (sj3rpc-get-error-message (- result)))))
 140 ;;              (setq sj3-stdy-size result))))))
 141 ;;     (if proc
 142 ;;      (progn
 143 ;;        (setq sj3-open-message (format (concat msg-form "done") hostname))
 144 ;;        proc)
 145 ;;       (kill-buffer buf)
 146 ;;       (error "%s" (or msg "no sj3serv available")))))
 147
 148 ;; <env> ::= [ <proc> <dictionary-list> ]
 149 (defvar sj3-environment nil
 150   "Environment for SJ3 kana-kanji conversion")
 151
 152 (defsubst sj3env-get-proc (env)
 153   (aref env 0))
 154 (defsubst sj3env-get-dictionary-list (env)
 155   (aref env 1))
 156
 157 ;; <bunsetsu> ::=
 158 ;;  [ <env> <source> <converted> <rest>
 159 ;;    <stdy> <zenkouho> <zenkouho-pos> <kugiri-changed> ]
 160 (defsubst sj3-make-bunsetsu (env source converted rest stdy)
 161   (vector env source converted rest stdy nil nil nil))
 162
 163 (defsubst sj3bunsetsu-get-env (b)
 164   (aref b 0))
 165 (defsubst sj3bunsetsu-get-source (b)
 166   (aref b 1))
 167 (defsubst sj3bunsetsu-get-converted (b)
 168   (aref b 2))
 169 (defsubst sj3bunsetsu-get-rest (b)
 170   (aref b 3))
 171 (defsubst sj3bunsetsu-get-stdy (b)
 172   (aref b 4))
 173 (defsubst sj3bunsetsu-get-zenkouho (b)
 174   (aref b 5))
 175 (defsubst sj3bunsetsu-set-zenkouho (b z)
 176   (aset b 5 z))
 177 (defsubst sj3bunsetsu-get-zenkouho-pos (b)
 178   (aref b 6))
 179 (defsubst sj3bunsetsu-set-zenkouho-pos (b p)
 180   (aset b 6 p))
 181 (defsubst sj3bunsetsu-get-kugiri-changed (b)
 182   (aref b 7))
 183 (defsubst sj3bunsetsu-set-kugiri-changed (b s)
 184   (aset b 7 s))
 185
 186 (defun sj3-get-bunsetsu-source (b)
 187   (sj3bunsetsu-get-source b))
 188 (defun sj3-get-bunsetsu-converted (b)
 189   (concat (sj3bunsetsu-get-converted b)
 190           (sj3bunsetsu-get-rest b)))
 191 (defun sj3-get-bunsetsu-stdy (b)
 192   (sj3bunsetsu-get-stdy b))
 193
 194 (defvar sj3-dictionary-specification
 195   '(("study.dat")
 196     ["sj3main.dic" ""]
 197     [("private.dic") ""])
 198   "Dictionary specification of SJ3.")
 199
 200 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
 201   "*Directory of user dictionary for SJ3.")
 202
 203 (defun sj3-filename (p)
 204   ""
 205   (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
 206         (t p)))
 207
 208 (defun sj3-get-environment ()
 209   "Return the backend of SJ3 environment."
 210   (if sj3-environment
 211       sj3-environment
 212     (let* ((proc (sj3-open sj3-hostname))
 213            (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
 214            (l (cdr sj3-dictionary-specification))
 215            dict-list)
 216       (sj3-open-freq-info proc freq-info-name)
 217       (while l
 218         (let ((dic (car l))
 219               dic-id)
 220           (setq dic-id
 221                 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
 222                                      (aref dic 1)))
 223           (if (< dic-id 0)
 224               (error "Dame2")           ; XXX
 225             (setq dict-list (cons dic-id dict-list)
 226                   l (cdr l)))))
 227       (setq sj3-environment (vector proc dict-list)))))
 228
 229 (defun sj3-open-freq-info (proc name)
 230   (let ((trying t)
 231         ret)
 232     (while trying
 233       (setq ret (sj3rpc-open-stdy proc name))
 234       (if (= ret 0)
 235           (setq trying nil)
 236         (message "\92\81³Ø\92\81½¬\92\81¥Õ\92\81¥¡\92\81¥¤\92\81¥ë(%s)\92\81¤¬\92\81¤¢\92\81¤ê\92\81¤Þ\92\81¤»\92\81¤ó" name)
 237         (if (/= ret (SJ3-const FileNotExist))
 238             (error "Fatal1")            ; XXX
 239           (if (and (y-or-n-p
 240                     (format "\92\81³Ø\92\81½¬\92\81¥Õ\92\81¥¡\92\81¥¤\92\81¥ë(%s)\92\81¤¬\92\81¤¢\92\81¤ê\92\81¤Þ\92\81¤»\92\81¤ó\92\81¡£\92\81ºî\92\81¤ê\92\81¤Þ\92\81¤¹\92\81¤«? "
 241                             name))
 242                    (sj3rpc-make-directory proc
 243                                           (file-name-directory name))
 244                    ;; ignore error
 245                    (= (sj3rpc-make-stdy proc name) 0))
 246               (message "\92\81³Ø\92\81½¬\92\81¥Õ\92\81¥¡\92\81¥¤\92\81¥ë(%s)\92\81¤ò\92\81ºî\92\81¤ê\92\81¤Þ\92\81¤·\92\81¤¿" name)
 247             (error "Fatal2")))))))      ; XXX
 248
 249 (defun sj3-open-dictionary (proc name passwd)
 250   (let ((trying t)
 251         ret)
 252     (while trying
 253       (setq ret (sj3rpc-open-dictionary proc name passwd))
 254       (if (>= ret 0)
 255           (setq trying nil)
 256         (message "\92\81¼\92\81½ñ\92\81¥Õ\92\81¥¡\92\81¥¤\92\81¥ë(%s)\92\81¤¬\92\81¤¢\92\81¤ê\92\81¤Þ\92\81¤»\92\81¤ó" name)
 257         (setq ret (- ret))              ; Get error code.
 258         (if (/= ret (SJ3-const FileNotExist))
 259             (error "Fatal3 %d" ret)             ; XXX
 260           (if (and (y-or-n-p
 261                     (format "\92\81¼\92\81½ñ\92\81¥Õ\92\81¥¡\92\81¥¤\92\81¥ë(%s)\92\81¤¬\92\81¤¢\92\81¤ê\92\81¤Þ\92\81¤»\92\81¤ó\92\81¡£\92\81ºî\92\81¤ê\92\81¤Þ\92\81¤¹\92\81¤«? "
 262                             name))
 263                    (= (sj3rpc-make-dictionary proc name) 0))
 264               (message "\92\81¼\92\81½ñ\92\81¥Õ\92\81¥¡\92\81¥¤\92\81¥ë(%s)\92\81¤ò\92\81ºî\92\81¤ê\92\81¤Þ\92\81¤·\92\81¤¿" name)
 265             (error "Fatal4")))))        ; XXX
 266     ret))
 267
 268 (defun sj3-init ()
 269   )
 270
 271 (defun sj3-start-conversion (yomi &optional lang)
 272   "Convert YOMI string to kanji, and enter conversion mode.
 273 Return the list of bunsetsu."
 274   (let ((env (sj3-get-environment)))
 275     (sj3rpc-begin env yomi)))
 276
 277 (defun sj3-end-conversion (bunsetsu-list abort)
 278   (if abort
 279       ()
 280     (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
 281           (l bunsetsu-list)
 282           bunsetsu stdy kugiri-changed)
 283       (while l
 284         (setq bunsetsu (car l))
 285         (setq l (cdr l))
 286         (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
 287         (if stdy
 288             (sj3rpc-bunsetsu-stdy env stdy))
 289         (if (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed bunsetsu))
 290             (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
 291                   (yomi2 (sj3bunsetsu-get-source (car l))))
 292               (if (/= kugiri-changed (length yomi1))
 293                   (sj3rpc-kugiri-stdy env yomi1 yomi2
 294                                       (sj3bunsetsu-get-stdy (car l))))))))))
 295
 296 (defun sj3-list-candidates (bunsetsu prev-bunsetsu)
 297   (let* ((env (sj3bunsetsu-get-env bunsetsu))
 298          (yomi (sj3bunsetsu-get-source bunsetsu))
 299          (z (sj3rpc-get-bunsetsu-candidates env yomi)))
 300     (sj3bunsetsu-set-zenkouho bunsetsu z)
 301     (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
 302     0))
 303
 304 (defun sj3-get-number-of-candidates (bunsetsu)
 305   (let ((l (sj3bunsetsu-get-zenkouho bunsetsu)))
 306     (if l
 307         (length l)
 308       nil)))
 309
 310 (defun sj3-decide-candidate (bunsetsu candidate-pos)
 311   (let* ((candidate-list (sj3bunsetsu-get-zenkouho bunsetsu))
 312          (candidate (nth candidate-pos candidate-list)))
 313     (sj3bunsetsu-set-zenkouho candidate candidate-list)
 314     (sj3bunsetsu-set-zenkouho-pos candidate candidate-pos)
 315     candidate))
 316
 317 (defun sj3-get-current-candidate-number (bunsetsu)
 318   (sj3bunsetsu-get-zenkouho-pos bunsetsu))
 319
 320 (defun sj3-get-all-candidates (bunsetsu)
 321   (let* ((l (sj3bunsetsu-get-zenkouho bunsetsu))
 322          (result (cons nil nil))
 323          (r result))
 324     (catch 'break
 325       (while t
 326         (let ((candidate (car l)))
 327           (setcar r (sj3bunsetsu-get-converted candidate))
 328           (if (null (setq l (cdr l)))
 329               (throw 'break nil)
 330             (setq r (setcdr r (cons nil nil)))))))
 331     result))
 332
 333 (defun sj3-change-bunsetsu-length (b0 b1 b2 len)
 334   (let ((yomi (concat
 335                (sj3bunsetsu-get-source b1)
 336                (if b2 (sj3bunsetsu-get-source b2))))
 337         (env (sj3bunsetsu-get-env b1))
 338         yomi1 yomi2
 339         bunsetsu1 bunsetsu2)
 340     (setq yomi1 (substring yomi 0 len)
 341           yomi2 (substring yomi len))
 342     (setq bunsetsu1
 343           (sj3rpc-tanbunsetsu-conversion env yomi1))
 344     ;; Only set once (memory original length of the bunsetsu).
 345     (sj3bunsetsu-set-kugiri-changed bunsetsu1
 346                                     (or (sj3bunsetsu-get-kugiri-changed b1)
 347                                         (length (sj3bunsetsu-get-source b1))))
 348     (if (< 0 (length yomi2))
 349         (setq bunsetsu2 (sj3rpc-tanbunsetsu-conversion env yomi2))
 350       (setq bunsetsu2 nil))
 351     (if bunsetsu2
 352         (list bunsetsu1 bunsetsu2)
 353       (list bunsetsu1))))
 354
 355 (defun sj3-fini (lang)
 356   (let ((proc (sj3env-get-proc sj3-environment))
 357         (dict-list (sj3env-get-dictionary-list sj3-environment))
 358         dict)
 359     (while dict-list
 360       (setq dict (car dict-list))
 361       (setq dict-list (cdr dict-list))
 362       (sj3rpc-close-dictionary proc dict)) ; XXX: check error
 363     (sj3rpc-close-stdy proc)
 364     (sj3rpc-close proc))
 365   (setq sj3-environment nil))
 366
 367 ;;; setup
 368
 369 (require 'egg)
 370 (load "egg/sj3rpc")
 371
 372 ;;;###autoload
 373 (defun egg-activate-sj3 (&rest arg)
 374   "Activate SJ3 backend of Tamagotchy."
 375   (egg-set-support-languages sj3-support-languages)
 376   (egg-set-conversion-backend sj3-conversion-backend
 377                               sj3-support-languages)
 378   (apply 'egg-mode arg))
 379
 380 ;;; egg/sj3.el ends here.