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