egg/sj3rpc.el

   1 ;;; egg/sj3rpc.el --- SJ3 Support (low 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 will be 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 ;; Only support SJ3 version 2.
  33
  34 (eval-when-compile
  35   (require 'egg-com)
  36
  37   ;; To get definition of sj3-make-bunsetsu and others
  38   (load-library "egg/sj3")
  39   (defmacro sj3-const (c)
  40     (cond ((eq c 'OPEN)            1)
  41           ((eq c 'CLOSE)           2)
  42           ((eq c 'DICADD)         11)
  43           ((eq c 'DICDEL)         12)
  44           ((eq c 'OPENSTDY)       21)
  45           ((eq c 'CLOSESTDY)      22)
  46           ((eq c 'STDYSIZE)       23)
  47           ((eq c 'LOCK)           31)
  48           ((eq c 'UNLOCK)         32)
  49           ((eq c 'BEGIN)          41)
  50           ((eq c 'BEGIN_EUC)     111)
  51           ((eq c 'TANCONV)        51)
  52           ((eq c 'TANCONV_EUC)   112)
  53           ((eq c 'KOUHO)          54)
  54           ((eq c 'KOUHO_EUC)     115)
  55           ((eq c 'KOUHOSU)        55)
  56           ((eq c 'KOUHOSU_EUC)   116)
  57           ((eq c 'STDY)           61)
  58           ((eq c 'CLSTDY)         62)
  59           ((eq c 'CLSTDY_EUC)    117)
  60           ((eq c 'WREG)           71)
  61           ((eq c 'WREG_EUC)      118)
  62           ((eq c 'WDEL)           72)
  63           ((eq c 'WDEL_EUC)      119)
  64           ((eq c 'MKDIC)          81)
  65           ((eq c 'MKSTDY)         82)
  66           ((eq c 'MKDIR)          83)
  67           ((eq c 'ACCESS)         84)
  68           ((eq c 'WSCH)           91)
  69           ((eq c 'WSCH_EUC)      120)
  70           ((eq c 'WNSCH)          92)
  71           ((eq c 'WNSCH_EUC)     121)
  72           ((eq c 'VERSION)       103)
  73           (t (error "No such constant")))))
  74
  75 ;; XXX
  76 (defconst sj3rpc-error-message
  77      [
  78       "Error #0 \e$B$G$9\e(B"
  79       ])
  80
  81 (defun sj3rpc-get-error-message (errno)
  82   (or (and (>= errno 0)
  83            (< errno (length sj3rpc-error-message))
  84            (aref sj3rpc-error-message errno))
  85       (format "#%d" errno)))
  86
  87 (defmacro sj3rpc-call-with-environment (e vlist send-expr &rest receive-exprs)
  88   (let ((v (append
  89             `((proc (sj3env-get-proc ,e)))
  90             vlist)))
  91     (list
  92      'let v
  93      (append
  94         `(save-excursion
  95            (set-buffer (process-buffer proc))
  96            (erase-buffer)
  97            ,send-expr
  98            (process-send-region proc (point-min) (point-max))
  99            (goto-char (prog1 (point) (accept-process-output proc))))
 100         receive-exprs))))
 101 \f
 102 (defun sj3rpc-open (proc myhostname username)
 103   "Open the session.  Return 0 on success, error code on failure."
 104   (comm-call-with-proc proc (result)
 105     (comm-format (u u s s s) (sj3-const OPEN) 2 ; Server version
 106                  myhostname username
 107                  ;; program name
 108                  (format "%d.emacs-egg" (emacs-pid)))
 109     (comm-unpack (u) result)
 110     (if (= result -2)                   ; negated version number
 111         0                               ; OK
 112       -1)))                             ; Failure (different version)
 113
 114 (defun sj3rpc-close (proc)
 115   (comm-call-with-proc proc (result)
 116     (comm-format (u) (sj3-const CLOSE))
 117     (comm-unpack (u) result)
 118     result))
 119
 120 (defun sj3rpc-get-stdy-size (proc)
 121   "Return STDYSIZE of SJ3 server.  On failure, return error code."
 122   (comm-call-with-proc proc (result)
 123     (comm-format (u) (sj3-const STDYSIZE))
 124     (comm-unpack (u) result)
 125     (if (/= result 0)
 126         (- result)                      ; failure
 127       (comm-unpack (u) result)
 128       result)))
 129
 130 (defsubst sj3rpc-get-stdy (proc)
 131   (let ((n 0)
 132         (stdy (make-vector sj3-stdy-size 0)))
 133     (while (< n sj3-stdy-size)
 134       (comm-unpack (b) r)
 135       (aset stdy n r)
 136       (setq n (1+ n)))
 137     stdy))
 138
 139 (defun sj3rpc-begin (env yomi)
 140   "Begin conversion."
 141   (let ((yomi-ext (encode-coding-string yomi 'euc-japan))
 142         (p 0)
 143         len source converted stdy bunsetsu-list bl)
 144     (sj3rpc-call-with-environment env (result)
 145       (comm-format (u s) (sj3-const BEGIN_EUC) yomi-ext)
 146       (comm-unpack (u) result)
 147       (if (/= result 0)
 148           (- result)                    ; failure
 149         (comm-unpack (u) result)        ; skip
 150         (while (progn
 151                  (comm-unpack (b) len)
 152                  (> len 0))
 153           (setq stdy (sj3rpc-get-stdy proc))
 154           (comm-unpack (E) converted)
 155           (setq source
 156                 (decode-coding-string (substring yomi-ext p (+ p len))
 157                                       'euc-japan)
 158                 p (+ p len))
 159           (let ((bl1 (cons (sj3-make-bunsetsu env
 160                                               source converted nil stdy) nil)))
 161             (if bl
 162                 (setq bl (setcdr bl bl1))
 163               (setq bunsetsu-list (setq bl bl1)))))
 164         bunsetsu-list))))
 165
 166 (defun sj3rpc-open-dictionary (proc dict-file-name password)
 167   (comm-call-with-proc proc (result)
 168     (comm-format (u s s) (sj3-const DICADD) dict-file-name password)
 169     (comm-unpack (u) result)
 170     (if (/= result 0)
 171         (- result)                      ; failure
 172       (comm-unpack (u) result)
 173       result)))
 174
 175 (defun sj3rpc-close-dictionary (proc dict-no)
 176   (comm-call-with-proc proc (result)
 177     (comm-format (u u) (sj3-const DICDEL) dict-no)
 178     (comm-unpack (u) result)
 179     result))
 180
 181 (defun sj3rpc-make-dictionary (proc dict-name)
 182   (comm-call-with-proc proc (result)
 183     (comm-format (u s u u u) (sj3-const MKDIC) dict-name
 184                  2048  ; Index length
 185                  2048  ; Length
 186                  256   ; Number
 187                  )
 188     (comm-unpack (u) result)
 189     result))
 190
 191 (defun sj3rpc-open-stdy (proc stdy-name)
 192   (comm-call-with-proc proc (result)
 193     (comm-format (u s s) (sj3-const OPENSTDY) stdy-name "")
 194     (comm-unpack (u) result)
 195     result))
 196
 197 (defun sj3rpc-close-stdy (proc)
 198   (comm-call-with-proc proc (result)
 199     (comm-format (u) (sj3-const CLOSESTDY))
 200     (comm-unpack (u) result)
 201     result))
 202
 203 (defun sj3rpc-make-stdy (proc stdy-name)
 204   (comm-call-with-proc proc (result)
 205     (comm-format (u s u u u) (sj3-const MKSTDY) stdy-name
 206                  2048  ; Number
 207                  1     ; Step
 208                  2048  ; Length
 209                  )
 210     (comm-unpack (u) result)
 211     result))
 212
 213 (defun sj3rpc-make-directory (proc name)
 214   (comm-call-with-proc proc (result)
 215     (comm-format (u s) (sj3-const MKDIR) name)
 216     (comm-unpack (u) result)
 217     result))
 218
 219 (defun sj3rpc-get-bunsetsu-candidates-sub (proc env yomi yomi-ext len n)
 220   (let ((i 0)
 221         stdy converted bunsetsu bl bunsetsu-list cylen rest)
 222     (comm-call-with-proc-1 proc (result)
 223       (comm-format (u u s) (sj3-const KOUHO_EUC) len yomi-ext)
 224       (comm-unpack (u) result)
 225       (if (/= result 0)
 226           (- result)                    ; failure
 227         (while (< i n)
 228           (comm-unpack (u) cylen)
 229           (setq stdy (sj3rpc-get-stdy proc))
 230           (comm-unpack (E) converted)
 231           (setq rest (decode-coding-string
 232                       (substring yomi-ext cylen) 'euc-japan))
 233           (setq bunsetsu (sj3-make-bunsetsu env yomi converted rest stdy))
 234           (if bl
 235               (setq bl (setcdr bl (cons bunsetsu nil)))
 236             (setq bunsetsu-list (setq bl (cons bunsetsu nil))))
 237           (setq i (1+ i)))
 238         (setq bunsetsu (sj3-make-bunsetsu env yomi yomi nil nil))
 239         (setq bl (setcdr bl (cons bunsetsu nil)))
 240         (setq bunsetsu
 241               (sj3-make-bunsetsu env yomi (japanese-katakana yomi) nil nil))
 242         (setq bl (setcdr bl (cons bunsetsu nil)))
 243         bunsetsu-list))))
 244
 245 (defun sj3rpc-get-bunsetsu-candidates (env yomi)
 246   (let* ((yomi-ext (encode-coding-string yomi 'euc-japan))
 247          (len (length yomi-ext)))
 248     (sj3rpc-call-with-environment env (result)
 249       (comm-format (u u s) (sj3-const KOUHOSU_EUC) len yomi-ext)
 250       (comm-unpack (u) result)
 251       (if (/= result 0)
 252           (- result)                    ; failure
 253         (comm-unpack (u) result)
 254         (if (= result 0)
 255             (list (sj3-make-bunsetsu env yomi yomi nil nil)) ; XXX
 256           (sj3rpc-get-bunsetsu-candidates-sub proc env
 257                                               yomi yomi-ext len result))))))
 258
 259 (defun sj3rpc-tanbunsetsu-conversion (env yomi)
 260   (let* ((yomi-ext (encode-coding-string yomi 'euc-japan))
 261          (len (length yomi-ext)) cylen stdy converted rest)
 262     (sj3rpc-call-with-environment env (result)
 263       (comm-format (u u s) (sj3-const TANCONV_EUC) len yomi-ext)
 264       (comm-unpack (u) result)
 265       (if (/= result 0)
 266           (- result)
 267         (comm-unpack (u) cylen)
 268         (setq stdy (sj3rpc-get-stdy proc))
 269         (comm-unpack (E) converted)
 270         (setq rest (decode-coding-string
 271                     (substring yomi-ext cylen) 'euc-japan))
 272         (setq bunsetsu (sj3-make-bunsetsu env yomi converted rest stdy))))))
 273
 274 (defun sj3rpc-bunsetsu-stdy (env stdy)
 275   (sj3rpc-call-with-environment env (result)
 276      (comm-format (u v) (sj3-const STDY) stdy)
 277      (comm-unpack (u) result)
 278       (if (/= result 0)
 279           (- result)
 280         0)))
 281
 282 (defun sj3rpc-kugiri-stdy (env yomi1 yomi2 stdy)
 283   (let* ((yomi1-ext (encode-coding-string yomi1 'euc-japan))
 284          (yomi2-ext (encode-coding-string yomi2 'euc-japan)))
 285     (sj3rpc-call-with-environment env (result)
 286       (comm-format (u s s v) (sj3-const CLSTDY_EUC) yomi1-ext yomi2-ext stdy)
 287       (comm-unpack (u) result)
 288       (if (/= result 0)
 289           (- result)
 290         0))))
 291
 292 ;;; egg/sj3rpc.el ends here.