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 (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 (will be set on connection)")
  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 result)
  68     (condition-case err
  69         (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
  70       (error
  71        (kill-buffer buf)
  72        (signal 'file-error (cdr err)))) ; Re-raise the signal with file-error
  73     (process-kill-without-query proc)
  74     (set-process-coding-system proc 'no-conversion 'no-conversion)
  75     (set-marker-insertion-type (process-mark proc) t)
  76     (save-excursion
  77       (set-buffer buf)
  78       (erase-buffer)
  79       (buffer-disable-undo)
  80       (set-buffer-multibyte nil))
  81     (setq result (sj3rpc-open proc (system-name) (user-login-name)))
  82     (if (< result 0)
  83         (let ((msg (sj3rpc-get-error-message (- result))))
  84           (delete-process proc)
  85           (kill-buffer buf)
  86           (signal 'file-error
  87                (list (format "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             (signal 'file-error
  94                     (list (format "Can't get SJ3 STDYSIZE: %s" msg)))))
  95       (setq sj3-stdy-size result)
  96       proc)))
  97
  98 ;; <env> ::= [ <proc> <dictionary-list> ]
  99 (defvar sj3-environment nil
 100   "Environment for SJ3 kana-kanji conversion")
 101
 102 (defsubst sj3env-get-proc (env)
 103   (aref env 0))
 104 (defsubst sj3env-get-dictionary-list (env)
 105   (aref env 1))
 106
 107 ;; <bunsetsu> ::=
 108 ;;  [ <env> <source> <converted> <rest>
 109 ;;    <stdy> <zenkouho> <zenkouho-pos> <kugiri-changed> ]
 110 (defsubst sj3-make-bunsetsu (env source converted rest stdy)
 111   (vector env source converted rest stdy nil nil nil))
 112
 113 (defsubst sj3bunsetsu-get-env (b)
 114   (aref b 0))
 115 (defsubst sj3bunsetsu-get-source (b)
 116   (aref b 1))
 117 (defsubst sj3bunsetsu-get-converted (b)
 118   (aref b 2))
 119 (defsubst sj3bunsetsu-get-rest (b)
 120   (aref b 3))
 121 (defsubst sj3bunsetsu-get-stdy (b)
 122   (aref b 4))
 123 (defsubst sj3bunsetsu-get-zenkouho (b)
 124   (aref b 5))
 125 (defsubst sj3bunsetsu-set-zenkouho (b z)
 126   (aset b 5 z))
 127 (defsubst sj3bunsetsu-get-zenkouho-pos (b)
 128   (aref b 6))
 129 (defsubst sj3bunsetsu-set-zenkouho-pos (b p)
 130   (aset b 6 p))
 131 (defsubst sj3bunsetsu-get-kugiri-changed (b)
 132   (aref b 7))
 133 (defsubst sj3bunsetsu-set-kugiri-changed (b s)
 134   (aset b 7 s))
 135
 136 (defun sj3-get-bunsetsu-source (b)
 137   (sj3bunsetsu-get-source b))
 138 (defun sj3-get-bunsetsu-converted (b)
 139   (concat (sj3bunsetsu-get-converted b)
 140           (sj3bunsetsu-get-rest b)))
 141 (defun sj3-get-bunsetsu-stdy (b)
 142   (sj3bunsetsu-get-stdy b))
 143
 144 (defvar sj3-dictionary-specification
 145   '(("study.dat")
 146     ["sj3main.dic" ""]
 147     [("private.dic") ""])
 148   "Dictionary specification of SJ3.")
 149
 150 (defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
 151   "*Directory of user dictionary for SJ3.")
 152
 153 (defun sj3-filename (p)
 154   ""
 155   (cond ((consp p) (concat sj3-usr-dic-dir "/" (car p)))
 156         (t p)))
 157
 158 (defun sj3-get-environment ()
 159   "Return the backend of SJ3 environment."
 160   (if sj3-environment
 161       sj3-environment
 162     (let* ((proc (sj3-open sj3-hostname))
 163            (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
 164            (l (cdr sj3-dictionary-specification))
 165            dict-list)
 166       (sj3-open-freq-info proc freq-info-name)
 167       (while l
 168         (let ((dic (car l))
 169               dic-id)
 170           (setq dic-id
 171                 (sj3-open-dictionary proc (sj3-filename (aref dic 0))
 172                                      (aref dic 1)))
 173           (if (< dic-id 0)
 174               (error "Dame2")           ; XXX
 175             (setq dict-list (cons dic-id dict-list)
 176                   l (cdr l)))))
 177       (setq sj3-environment (vector proc dict-list)))))
 178
 179 (defun sj3-open-freq-info (proc name)
 180   (let ((trying t)
 181         ret)
 182     (while trying
 183       (setq ret (sj3rpc-open-stdy proc name))
 184       (if (= ret 0)
 185           (setq trying nil)
 186         (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 187         (if (/= ret (SJ3-const FileNotExist))
 188             (error "Fatal1")            ; XXX
 189           (if (and (y-or-n-p
 190                     (format "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 191                             name))
 192                    (sj3rpc-make-directory proc
 193                                           (file-name-directory name))
 194                    ;; ignore error
 195                    (= (sj3rpc-make-stdy proc name) 0))
 196               (message "\e$B3X=,%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 197             (error "Fatal2")))))))      ; XXX
 198
 199 (defun sj3-open-dictionary (proc name passwd)
 200   (let ((trying t)
 201         ret)
 202     (while trying
 203       (setq ret (sj3rpc-open-dictionary proc name passwd))
 204       (if (>= ret 0)
 205           (setq trying nil)
 206         (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 207         (setq ret (- ret))              ; Get error code.
 208         (if (/= ret (SJ3-const FileNotExist))
 209             (error "Fatal3 %d" ret)             ; XXX
 210           (if (and (y-or-n-p
 211                     (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 212                             name))
 213                    (= (sj3rpc-make-dictionary proc name) 0))
 214               (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 215             (error "Fatal4")))))        ; XXX
 216     ret))
 217
 218 (defun sj3-init ()
 219   )
 220
 221 (defun sj3-start-conversion (yomi &optional lang)
 222   "Convert YOMI string to kanji, and enter conversion mode.
 223 Return the list of bunsetsu."
 224   (if (eq lang 'Japanese)
 225       (let ((env (sj3-get-environment)))
 226         (sj3rpc-begin env yomi))
 227     (signal 'lang-not-supported)))
 228
 229 (defun sj3-end-conversion (bunsetsu-list abort)
 230   (if abort
 231       ()
 232     (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
 233           (l bunsetsu-list)
 234           bunsetsu stdy kugiri-changed)
 235       (while l
 236         (setq bunsetsu (car l))
 237         (setq l (cdr l))
 238         (setq stdy (sj3bunsetsu-get-stdy bunsetsu))
 239         (if stdy
 240             (sj3rpc-bunsetsu-stdy env stdy))
 241         (if (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed bunsetsu))
 242             (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
 243                   (yomi2 (sj3bunsetsu-get-source (car l))))
 244               (if (/= kugiri-changed (length yomi1))
 245                   (sj3rpc-kugiri-stdy env yomi1 yomi2
 246                                       (sj3bunsetsu-get-stdy (car l))))))))))
 247
 248 (defun sj3-list-candidates (bunsetsu prev-bunsetsu)
 249   (let* ((env (sj3bunsetsu-get-env bunsetsu))
 250          (yomi (sj3bunsetsu-get-source bunsetsu))
 251          (z (sj3rpc-get-bunsetsu-candidates env yomi)))
 252     (sj3bunsetsu-set-zenkouho bunsetsu z)
 253     (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
 254     0))
 255
 256 (defun sj3-get-number-of-candidates (bunsetsu)
 257   (let ((l (sj3bunsetsu-get-zenkouho bunsetsu)))
 258     (if l
 259         (length l)
 260       nil)))
 261
 262 (defun sj3-decide-candidate (bunsetsu candidate-pos)
 263   (let* ((candidate-list (sj3bunsetsu-get-zenkouho bunsetsu))
 264          (candidate (nth candidate-pos candidate-list)))
 265     (sj3bunsetsu-set-zenkouho candidate candidate-list)
 266     (sj3bunsetsu-set-zenkouho-pos candidate candidate-pos)
 267     candidate))
 268
 269 (defun sj3-get-current-candidate-number (bunsetsu)
 270   (sj3bunsetsu-get-zenkouho-pos bunsetsu))
 271
 272 (defun sj3-get-all-candidates (bunsetsu)
 273   (let* ((l (sj3bunsetsu-get-zenkouho bunsetsu))
 274          (result (cons nil nil))
 275          (r result))
 276     (catch 'break
 277       (while t
 278         (let ((candidate (car l)))
 279           (setcar r (sj3bunsetsu-get-converted candidate))
 280           (if (null (setq l (cdr l)))
 281               (throw 'break nil)
 282             (setq r (setcdr r (cons nil nil)))))))
 283     result))
 284
 285 (defun sj3-change-bunsetsu-length (b0 b1 b2 len)
 286   (let ((yomi (concat
 287                (sj3bunsetsu-get-source b1)
 288                (if b2 (sj3bunsetsu-get-source b2))))
 289         (env (sj3bunsetsu-get-env b1))
 290         yomi1 yomi2
 291         bunsetsu1 bunsetsu2)
 292     (setq yomi1 (substring yomi 0 len)
 293           yomi2 (substring yomi len))
 294     (setq bunsetsu1
 295           (sj3rpc-tanbunsetsu-conversion env yomi1))
 296     ;; Only set once (memory original length of the bunsetsu).
 297     (sj3bunsetsu-set-kugiri-changed bunsetsu1
 298                                     (or (sj3bunsetsu-get-kugiri-changed b1)
 299                                         (length (sj3bunsetsu-get-source b1))))
 300     (if (< 0 (length yomi2))
 301         (setq bunsetsu2 (sj3rpc-tanbunsetsu-conversion env yomi2))
 302       (setq bunsetsu2 nil))
 303     (if bunsetsu2
 304         (list bunsetsu1 bunsetsu2)
 305       (list bunsetsu1))))
 306
 307 (defun sj3-fini ()
 308   (let ((proc (sj3env-get-proc sj3-environment))
 309         (dict-list (sj3env-get-dictionary-list sj3-environment))
 310         dict)
 311     (while dict-list
 312       (setq dict (car dict-list))
 313       (setq dict-list (cdr dict-list))
 314       (sj3rpc-close-dictionary proc dict)) ; XXX: check error
 315     (sj3rpc-close-stdy proc)
 316     (sj3rpc-close proc))
 317   (setq sj3-environment nil))
 318
 319 ;;; setup
 320 (require 'egg)
 321
 322 ;;;###autoload
 323 (defun egg-activate-sj3 (&rest arg)
 324   "Activate SJ3 backend of Tamagotchy."
 325   (setq egg-conversion-backend sj3-conversion-backend)
 326   (if (not (fboundp 'sj3rpc-open))
 327       (load-library "egg/sj3rpc"))
 328   (apply 'egg-mode arg))
 329
 330 ;;; egg/sj3.el ends here.