egg/canna.el

   1 ;;; egg/canna.el --- Canna Support (high level interface) in
   2 ;;;                  Egg Input Method Architecture
   3
   4 ;; Copyright (C) 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 canna-support-languages '(Japanese))
  35
  36 (eval-when-compile
  37   (defmacro CANNA-const (c)
  38     (cond ((eq c 'FileNotExist) xxxxxxxxxxxxxx)
  39           )))
  40
  41 (defconst canna-conversion-backend
  42   [ canna-init
  43
  44     canna-start-conversion
  45       canna-get-bunsetsu-converted
  46       canna-get-bunsetsu-source
  47       canna-list-candidates
  48           canna-get-number-of-candidates
  49           canna-get-current-candidate-number
  50           canna-get-all-candidates
  51           canna-decide-candidate
  52       canna-change-bunsetsu-length
  53     canna-end-conversion
  54     nil
  55
  56     canna-fini
  57  ])
  58
  59 (defconst canna-server-port 5680 "Port number of Canna server")
  60 (defvar canna-hostname "localhost"
  61   "Hostname of Canna server")
  62
  63 (defun canna-open (hostname)
  64   "Establish the connection to CANNA server.  Return environment object."
  65   (let* ((buf (generate-new-buffer " *CANNA*"))
  66          (proc (open-network-stream "CANNA" buf hostname canna-server-port))
  67          result)
  68     (process-kill-without-query proc)
  69     (set-process-coding-system proc 'no-conversion 'no-conversion)
  70     (set-marker-insertion-type (process-mark proc) t)
  71     (save-excursion
  72       (set-buffer buf)
  73       (erase-buffer)
  74       (buffer-disable-undo)
  75       (set-buffer-multibyte nil))
  76     (setq result (cannarpc-open proc (user-login-name)))
  77     (if (< result 0)
  78         (let ((msg (cannarpc-get-error-message (- result))))
  79           (delete-process proc)
  80           (kill-buffer buf)
  81           (error "Can't open CANNA session (%s): %s" hostname msg)))
  82     (vector proc result)))
  83
  84 ;; XXX: Should support multiple outstanding context
  85 ;; <env> ::= [ <proc> <context> ]
  86 (defvar canna-environment nil
  87   "Environment for CANNA kana-kanji conversion")
  88
  89 (defsubst cannaenv-get-proc (env)
  90   (aref env 0))
  91 (defsubst cannaenv-get-context (env)
  92   (aref env 1))
  93
  94 ;; <bunsetsu> ::=
  95 ;;  [ <env> <converted> <bunsetsu-pos>
  96 ;;    <source> <zenkouho-pos> <zenkouho> ]
  97 (defsubst canna-make-bunsetsu (env converted bunsetsu-pos)
  98   (vector env converted bunsetsu-pos nil nil nil))
  99
 100 (defsubst cannabunsetsu-get-env (b)
 101   (aref b 0))
 102 (defsubst cannabunsetsu-get-converted (b)
 103   (aref b 1))
 104 (defsubst cannabunsetsu-get-bunsetsu-pos (b)
 105   (aref b 2))
 106 (defsubst cannabunsetsu-get-source (b)
 107   (aref b 3))
 108 (defsubst cannabunsetsu-set-source (b s)
 109   (aset b 3 s))
 110 (defsubst cannabunsetsu-get-zenkouho-pos (b)
 111   (aref b 4))
 112 (defsubst cannabunsetsu-set-zenkouho-pos (b p)
 113   (aset b 4 p))
 114 (defsubst cannabunsetsu-get-zenkouho (b)
 115   (aref b 5))
 116 (defsubst cannabunsetsu-set-zenkouho (b z)
 117   (aset b 5 z))
 118
 119 (defun canna-get-bunsetsu-source (b)
 120   (let ((s (cannabunsetsu-get-source b)))
 121     (or s
 122         (let* ((env (cannabunsetsu-get-env b))
 123                (bp (cannabunsetsu-get-bunsetsu-pos b))
 124                (s (cannarpc-get-bunsetsu-source env bp)))
 125           (cannabunsetsu-set-source b s)))))
 126
 127 (defun canna-get-bunsetsu-converted (b)
 128   (cannabunsetsu-get-converted b))
 129
 130 (defconst canna-dictionary-specification
 131   '("iroha"
 132     "fuzokugo"
 133     "hojomwd"
 134     "hojoswd"
 135     "bushu"
 136     ("user")
 137     )
 138   "Dictionary specification of CANNA.")
 139
 140 (defun canna-filename (p)
 141   ""
 142   (cond ((consp p) (concat (car p) "/" (user-login-name)))
 143         (t p)))
 144
 145 (defun canna-get-environment ()
 146   "Return the backend of CANNA environment."
 147   (if canna-environment
 148       canna-environment
 149     (let* ((env (canna-open canna-hostname))
 150            (l canna-dictionary-specification)
 151            dict-list)
 152       (while l
 153         (let ((dic (car l))
 154               result)
 155           (setq result
 156                 (canna-open-dictionary env (canna-filename dic)))
 157           (if (= result 255)
 158               (error "Damedamedame")            ; XXX
 159             (setq l (cdr l)))))
 160       (setq canna-environment env))))
 161
 162 (defun canna-open-dictionary (env name)
 163   (let ((trying t)
 164         ret)
 165     (while trying
 166       (setq ret (cannarpc-open-dictionary env name 0)) ; XXX MODE=0
 167       (if (= ret 0)
 168           (setq trying nil)
 169         (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s\e(B" name)
 170         (setq ret (- ret))              ; Get error code.
 171         (if (and (y-or-n-p
 172                   (format "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$,$"$j$^$;$s!#:n$j$^$9$+\e(B? "
 173                           name))
 174                  (= (cannarpc-make-dictionary env name) 0))
 175             (message "\e$B<-=q%U%!%$%k\e(B(%s)\e$B$r:n$j$^$7$?\e(B" name)
 176           (error "Fatal"))))
 177     ret))
 178
 179 (defun canna-init ()
 180   )
 181
 182 (defun canna-start-conversion (yomi lang)
 183   "Convert YOMI string to kanji, and enter conversion mode.
 184 Return the list of bunsetsu."
 185   (let ((env (canna-get-environment)))
 186     (cannarpc-begin-conversion env yomi)))
 187
 188 (defun canna-end-conversion (bunsetsu-list abort)
 189   (let* ((env (cannabunsetsu-get-env (car bunsetsu-list)))
 190          (l bunsetsu-list)
 191          (len (length bunsetsu-list))
 192          (zenkouho-pos-vector (make-vector (* 2 len) 0))
 193          (i 0)
 194          (mode 1) ;XXX MODE=1 attru?
 195          bunsetsu zenkouho-pos)
 196     (if abort
 197         (setq mode 0))
 198     (while l
 199       (setq bunsetsu (car l))
 200       (setq l (cdr l))
 201       (setq zenkouho-pos (cannabunsetsu-get-zenkouho-pos bunsetsu))
 202       (if (null zenkouho-pos)
 203           () ; XXX: NIL--> 0 atteru???
 204         (aset zenkouho-pos-vector i 0)  ; XXX Don't support >=256
 205         (aset zenkouho-pos-vector (1+ i) zenkouho-pos))
 206       (setq i (+ i 2)))
 207     (cannarpc-end-conversion env len zenkouho-pos-vector 0)))
 208
 209 (defun canna-list-candidates (bunsetsu prev-bunsetsu)
 210   (let* ((env (cannabunsetsu-get-env bunsetsu))
 211          (bunsetsu-pos (cannabunsetsu-get-bunsetsu-pos bunsetsu))
 212          (z (cannarpc-get-bunsetsu-candidates env bunsetsu-pos)))
 213     (cannabunsetsu-set-zenkouho bunsetsu z)
 214     (cannabunsetsu-set-zenkouho-pos bunsetsu 0)
 215     0))
 216
 217 (defun canna-get-number-of-candidates (bunsetsu)
 218   (let ((l (cannabunsetsu-get-zenkouho bunsetsu)))
 219     (if l
 220         (length l)
 221       nil)))
 222
 223 (defun canna-decide-candidate (bunsetsu candidate-pos)
 224   (let* ((candidate-list (cannabunsetsu-get-zenkouho bunsetsu))
 225          (candidate (nth candidate-pos candidate-list)))
 226     (cannabunsetsu-set-zenkouho candidate candidate-list)
 227     (cannabunsetsu-set-zenkouho-pos candidate candidate-pos)
 228     candidate))
 229
 230 (defun canna-get-current-candidate-number (bunsetsu)
 231   (cannabunsetsu-get-zenkouho-pos bunsetsu))
 232
 233 (defun canna-get-all-candidates (bunsetsu)
 234   (let* ((l (cannabunsetsu-get-zenkouho bunsetsu))
 235          (result (cons nil nil))
 236          (r result))
 237     (catch 'break
 238       (while t
 239         (let ((candidate (car l)))
 240           (setcar r (cannabunsetsu-get-converted candidate))
 241           (if (null (setq l (cdr l)))
 242               (throw 'break nil)
 243             (setq r (setcdr r (cons nil nil)))))))
 244     result))
 245
 246 ;;;;;;;;;;;;;;;;;;;;;;; MADAMADA zenzendame, just copy from SJ3
 247 (defun canna-change-bunsetsu-length (b0 b1 b2 len)
 248   (let ((yomi (concat
 249                (cannabunsetsu-get-source b1)
 250                (if b2 (cannabunsetsu-get-source b2))))
 251         (env (cannabunsetsu-get-env b1))
 252         yomi1 yomi2
 253         bunsetsu1 bunsetsu2)
 254     (setq yomi1 (substring yomi 0 len)
 255           yomi2 (substring yomi len))
 256     (setq bunsetsu1
 257           (cannarpc-tanbunsetsu-conversion env yomi1))
 258     ;; Only set once (memory original length of the bunsetsu).
 259     (cannabunsetsu-set-kugiri-changed bunsetsu1
 260                                     (or (cannabunsetsu-get-kugiri-changed b1)
 261                                         (length (cannabunsetsu-get-source b1))))
 262     (if (< 0 (length yomi2))
 263         (setq bunsetsu2 (cannarpc-tanbunsetsu-conversion env yomi2))
 264       (setq bunsetsu2 nil))
 265     (if bunsetsu2
 266         (list bunsetsu1 bunsetsu2)
 267       (list bunsetsu1))))
 268
 269 ;;;;;;;;;;;;;; MADAMADA
 270 (defun canna-fini (lang)
 271 )
 272
 273 ;;; setup
 274
 275 (require 'egg)
 276 (load "egg/cannarpc")
 277
 278 ;;;###autoload
 279 (defun egg-activate-canna (&rest arg)
 280   "Activate CANNA backend of Tamagotchy."
 281   (egg-set-support-languages canna-support-languages)
 282   (egg-set-conversion-backend canna-conversion-backend
 283                               canna-support-languages
 284                               nil)
 285   (apply 'egg-mode arg))
 286
 287 ;;; egg/canna.el ends here.