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 (require 'egg-edep)
  33
  34 (defconst sj3-support-languages '(Japanese))
  35
  36 (eval-when-compile
  37   (defmacro SJ3-const (c)
  38     (cond ((eq c 'FileNotExist) 35)
  39           )))
  40
  41 (defconst sj3-conversion-backend
  42   [ sj3-init
  43
  44     sj3-start-conversion
  45       sj3-get-bunsetsu-converted
  46       sj3-get-bunsetsu-source
  47       sj3-list-candidates
  48           sj3-get-number-of-candidates
  49           sj3-get-current-candidate-number
  50           sj3-get-all-candidates
  51           sj3-decide-candidate
  52       sj3-change-bunsetsu-length
  53     sj3-end-conversion
  54     nil
  55
  56     sj3-fini
  57  ])
  58
  59 (defvar sj3-server-port 3000 "Port number of SJ3 server")
  60 (defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
  61 (defvar sj3-hostname "localhost"
  62   "Hostname of SJ3 server")
  63
  64 (defvar sj3-open-message)
  65
  66 (defun sj3-open (hostname)
  67   "Establish the connection to SJ3 server.  Return process object."
  68   (let* ((buf (generate-new-buffer " *SJ3*"))
  69          (proc (open-network-stream "SJ3" buf hostname sj3-server-port))
  70          result)
  71     (process-kill-without-query proc)
  72     (set-process-coding-system proc 'no-conversion 'no-conversion)
  73     (set-marker-insertion-type (process-mark proc) t)
  74     (save-excursion
  75       (set-buffer buf)
  76       (erase-buffer)
  77       (buffer-disable-undo)
  78       (set-buffer-multibyte nil))
  79     ;; Initialize dictionaries
  80     (setq sj3-sys-dict-list nil)
  81     (setq sj3-user-dict-list nil)
  82     (setq result (sj3rpc-open proc (system-name) (user-login-name)))
  83     (if (< result 0)
  84         (let ((msg (sj3rpc-get-error-message (- result))))
  85           (delete-process proc)
  86           (kill-buffer buf)
  87           (error "Can't open SJ3 session (%s): %s" hostname msg)))
  88     (setq result (sj3rpc-get-stdy-size proc))
  89     (if (< result 0)
  90         (let ((msg (sj3rpc-get-error-message (- result))))
  91           (delete-process proc)
  92           (kill-buffer buf)
  93           (error "Can't get SJ3 STDYSIZE: %s"msg)))
  94     (setq sj3-stdy-size result)
  95     proc))
  96
  97 ;; (defun sj3-open (hostname-list)
  98 ;;   "Establish the connection to SJ3 server.  Return process object."
  99 ;;   (let* ((buf (generate-new-buffer " *SJ3*"))
 100 ;;       (msg-form "SJ3: connecting to sj3serv at %s...")
 101 ;;       hostname proc result msg)
 102 ;;     (save-excursion
 103 ;;       (set-buffer buf)
 104 ;;       (erase-buffer)
 105 ;;       (buffer-disable-undo)
 106 ;;       (setq enable-multibyte-characters nil))
 107 ;;     (cond
 108 ;;      ((null hostname-list)
 109 ;;       (setq hostname-list '("localhost")))
 110 ;;      ((null (listp hostname-list))
 111 ;;       (setq hostname-list (list hostname-list))))
 112 ;;     (while (and hostname-list (null proc))
 113 ;;       (setq hostname (car hostname-list)
 114 ;;          hostname-list (cdr hostname-list))
 115 ;;       (message msg-form hostname)
 116 ;;       (sit-for 0)
 117 ;;       (condition-case result
 118 ;;        (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
 119 ;;      (error nil))
 120 ;;       (if proc
 121 ;;        (progn
 122 ;;          (process-kill-without-query proc)
 123 ;;          (set-process-coding-system proc 'no-conversion 'no-conversion)
 124 ;;          (set-marker-insertion-type (process-mark proc) t)
 125 ;;          ;; Initialize dictionaries
 126 ;;          (setq sj3-sys-dict-list nil)
 127 ;;          (setq sj3-user-dict-list nil)
 128 ;;          (setq result (sj3rpc-open proc (system-name) (user-login-name)))
 129 ;;          (if (< result 0)
 130 ;;              (progn
 131 ;;                (delete-process proc)
 132 ;;                (setq proc nil
 133 ;;                      msg (format "Can't open SJ3 session (%s): %s"
 134 ;;                                  hostname msg)))
 135 ;;            (setq result (sj3rpc-get-stdy-size proc))
 136 ;;            (if (< result 0)
 137 ;;                (progn
 138 ;;                  (delete-process proc)
 139 ;;                  (setq proc nil
 140 ;;                        msg (format "Can't get SJ3 STDYSIZE: %s"
 141 ;;                                    (sj3rpc-get-error-message (- result)))))
 142 ;;              (setq sj3-stdy-size result))))))
 143 ;;     (if proc
 144 ;;      (progn
 145 ;;        (setq sj3-open-message (format (concat msg-form "done") hostname))
 146 ;;        proc)
 147 ;;       (kill-buffer buf)
 148 ;;       (error "%s" (or msg "no sj3serv available")))))
 149
 150 ;; <env> ::= [ <proc> <dictionary-list> ]
 151 (defvar sj3-environment nil
 152   "Environment for SJ3 kana-kanji conversion")
 153
 154 (defsubst sj3env-get-proc (env)
 155   (aref env 0))
 156 (defsubst sj3env-get-dictionary-list (env)
 157   (aref env 1))
 158
 159 ;; <bunsetsu> ::=
 160 ;;  [ <env> <source> <converted> <rest>
 161 ;;    <stdy> <zenkouho> <zenkouho-pos> <kugiri-changed> ]
 162 (defsubst sj3-make-bunsetsu (env source converted rest stdy)
 163   (vector env source converted rest stdy nil nil nil))
 164
 165 (defsubst sj3bunsetsu-get-env (b)
 166   (aref b 0))
 167 (defsubst sj3bunsetsu-get-source (b)
 168   (aref b 1))
 169 (defsubst sj3bunsetsu-get-converted (b)
 170   (aref b 2))
 171 (defsubst sj3bunsetsu-get-rest (b)
 172   (aref b 3))
 173 (defsubst sj3bunsetsu-get-stdy (b)
 174   (aref b 4))
 175 (defsubst sj3bunsetsu-get-zenkouho (b)
 176   (aref b 5))
 177 (defsubst sj3bunsetsu-set-zenkouho (b z)
 178   (aset b 5 z))
 179 (defsubst sj3bunsetsu-get-zenkouho-pos (b)
 180   (aref b 6))
 181 (defsubst sj3bunsetsu-set-zenkouho-pos (b p)
 182   (aset b 6 p))
 183 (defsubst sj3bunsetsu-get-kugiri-changed (b)
 184   (aref b 7))
 185 (defsubst sj3bunsetsu-set-kugiri-changed (b s)
 186   (aset b 7 s))
 187
 188 (defun sj3-get-bunsetsu-source (b)
 189   (sj3bunsetsu-get-source b))
 190 (defun sj3-get-bunsetsu-converted (b)
 191   (concat (sj3bunsetsu-get-converted b)
 192           (sj3bunsetsu-get-rest b)))
 193 (defun sj3-get-bunsetsu-stdy (b)
 194   (sj3bunsetsu-get-stdy b))
 195
 196 (defvar sj3-dictionary-specification
 197   '(("study.dat")
 198     ["sj3main.dic" ""]
 199     [("private.dic") ""])
 200   "Dictionary specification of SJ3.")
 201
 202 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
 203   "*Directory of user dictionary for SJ3.")
 204
 205 (defun sj3-filename (p)
 206   ""
 207   (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
 208         (t p)))
 209
 210 (defun sj3-get-environment ()
 211   "Return the backend of SJ3 environment."
 212   (if sj3-environment
 213       sj3-environment
 214     (let* ((proc (sj3-open sj3-hostname))
 215            (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
 216            (l (cdr sj3-dictionary-specification))
 217            dict-list)
 218       (sj3-open-freq-info proc freq-info-name)
 219       (while l
 220         (let ((dic (car l))
 221               dic-id)
 222           (setq dic-id
 223                 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
 224                                      (aref dic 1)))
 225           (if (< dic-id 0)
 226               (error "Dame2")           ; XXX
 227             (setq dict-list (cons dic-id dict-list)
 228                   l (cdr l)))))
 229       (setq sj3-environment (vector proc dict-list)))))
 230
 231 (defun sj3-open-freq-info (proc name)
 232   (let ((trying t)
 233         ret)
 234     (while trying
 235       (setq ret (sj3rpc-open-stdy proc name))
 236       (if (= ret 0)
 237           (setq trying nil)
 238         (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 239         (if (/= ret (SJ3-const FileNotExist))
 240             (error "Fatal1")            ; XXX
 241           (if (and (y-or-n-p
 242                     (format "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 243                             name))
 244                    (sj3rpc-make-directory proc
 245                                           (file-name-directory name))
 246                    ;; ignore error
 247                    (= (sj3rpc-make-stdy proc name) 0))
 248               (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 249             (error "Fatal2")))))))      ; XXX
 250
 251 (defun sj3-open-dictionary (proc name passwd)
 252   (let ((trying t)
 253         ret)
 254     (while trying
 255       (setq ret (sj3rpc-open-dictionary proc name passwd))
 256       (if (>= ret 0)
 257           (setq trying nil)
 258         (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 259         (setq ret (- ret))              ; Get error code.
 260         (if (/= ret (SJ3-const FileNotExist))
 261             (error "Fatal3 %d" ret)             ; XXX
 262           (if (and (y-or-n-p
 263                     (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 264                             name))
 265                    (= (sj3rpc-make-dictionary proc name) 0))
 266               (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 267             (error "Fatal4")))))        ; XXX
 268     ret))
 269
 270 (defun sj3-init ()
 271   )
 272
 273 (defun sj3-start-conversion (yomi &optional lang)
 274   "Convert YOMI string to kanji, and enter conversion mode.
 275 Return the list of bunsetsu."
 276   (let ((env (sj3-get-environment)))
 277     (sj3rpc-begin env yomi)))
 278
 279 (defun sj3-end-conversion (bunsetsu-list abort)
 280   (if abort
 281       ()
 282     (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
 283           (l bunsetsu-list)
 284           bunsetsu stdy kugiri-changed)
 285       (while l
 286         (setq bunsetsu (car l))
 287         (setq l (cdr l))
 288         (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
 289         (if stdy
 290             (sj3rpc-bunsetsu-stdy env stdy))
 291         (if (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed bunsetsu))
 292             (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
 293                   (yomi2 (sj3bunsetsu-get-source (car l))))
 294               (if (/= kugiri-changed (length yomi1))
 295                   (sj3rpc-kugiri-stdy env yomi1 yomi2
 296                                       (sj3bunsetsu-get-stdy (car l))))))))))
 297
 298 (defun sj3-list-candidates (bunsetsu prev-bunsetsu)
 299   (let* ((env (sj3bunsetsu-get-env bunsetsu))
 300          (yomi (sj3bunsetsu-get-source bunsetsu))
 301          (z (sj3rpc-get-bunsetsu-candidates env yomi)))
 302     (sj3bunsetsu-set-zenkouho bunsetsu z)
 303     (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
 304     0))
 305
 306 (defun sj3-get-number-of-candidates (bunsetsu)
 307   (let ((l (sj3bunsetsu-get-zenkouho bunsetsu)))
 308     (if l
 309         (length l)
 310       nil)))
 311
 312 (defun sj3-decide-candidate (bunsetsu candidate-pos)
 313   (let* ((candidate-list (sj3bunsetsu-get-zenkouho bunsetsu))
 314          (candidate (nth candidate-pos candidate-list)))
 315     (sj3bunsetsu-set-zenkouho candidate candidate-list)
 316     (sj3bunsetsu-set-zenkouho-pos candidate candidate-pos)
 317     candidate))
 318
 319 (defun sj3-get-current-candidate-number (bunsetsu)
 320   (sj3bunsetsu-get-zenkouho-pos bunsetsu))
 321
 322 (defun sj3-get-all-candidates (bunsetsu)
 323   (let* ((l (sj3bunsetsu-get-zenkouho bunsetsu))
 324          (result (cons nil nil))
 325          (r result))
 326     (catch 'break
 327       (while t
 328         (let ((candidate (car l)))
 329           (setcar r (sj3bunsetsu-get-converted candidate))
 330           (if (null (setq l (cdr l)))
 331               (throw 'break nil)
 332             (setq r (setcdr r (cons nil nil)))))))
 333     result))
 334
 335 (defun sj3-change-bunsetsu-length (b0 b1 b2 len)
 336   (let ((yomi (concat
 337                (sj3bunsetsu-get-source b1)
 338                (if b2 (sj3bunsetsu-get-source b2))))
 339         (env (sj3bunsetsu-get-env b1))
 340         yomi1 yomi2
 341         bunsetsu1 bunsetsu2)
 342     (setq yomi1 (substring yomi 0 len)
 343           yomi2 (substring yomi len))
 344     (setq bunsetsu1
 345           (sj3rpc-tanbunsetsu-conversion env yomi1))
 346     ;; Only set once (memory original length of the bunsetsu).
 347     (sj3bunsetsu-set-kugiri-changed bunsetsu1
 348                                     (or (sj3bunsetsu-get-kugiri-changed b1)
 349                                         (length (sj3bunsetsu-get-source b1))))
 350     (if (< 0 (length yomi2))
 351         (setq bunsetsu2 (sj3rpc-tanbunsetsu-conversion env yomi2))
 352       (setq bunsetsu2 nil))
 353     (if bunsetsu2
 354         (list bunsetsu1 bunsetsu2)
 355       (list bunsetsu1))))
 356
 357 (defun sj3-fini (lang)
 358   (let ((proc (sj3env-get-proc sj3-environment))
 359         (dict-list (sj3env-get-dictionary-list sj3-environment))
 360         dict)
 361     (while dict-list
 362       (setq dict (car dict-list))
 363       (setq dict-list (cdr dict-list))
 364       (sj3rpc-close-dictionary proc dict)) ; XXX: check error
 365     (sj3rpc-close-stdy proc)
 366     (sj3rpc-close proc))
 367   (setq sj3-environment nil))
 368
 369 ;;; setup
 370
 371 (require 'egg)
 372 (load "egg/sj3rpc")
 373
 374 ;;;###autoload
 375 (defun egg-activate-sj3 (&rest arg)
 376   "Activate SJ3 backend of Tamagotchy."
 377   (egg-set-support-languages sj3-support-languages)
 378   (egg-set-conversion-backend sj3-conversion-backend
 379                               sj3-support-languages)
 380   (apply 'egg-mode arg))
 381
 382 ;;; egg/sj3.el ends here.