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