egg/cannarpc.el

   1 ;;; egg/cannarpc.el --- Canna Support (low level interface) in
   2 ;;;                     Egg Input Method Architecture
   3
   4 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc
   5
   6 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
   7
   8 ;; Keywords: mule, multilingual, input method
   9
  10 ;; This file is part of EGG.
  11
  12 ;; EGG is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; EGG is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc.,
  25 ;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  26
  27 ;;; Commentary:
  28
  29
  30 ;;; Code:
  31
  32
  33
  34 (eval-when-compile
  35   (require 'egg-com)
  36 ;;  (load-library "egg/canna")
  37   (defmacro canna-const (c)
  38     (cond ((eq c 'Initialize)            1)
  39           ((eq c 'Finalize)              2)
  40           ((eq c 'CreateContext)         3)
  41           ((eq c 'CloseContext)          5)
  42           ((eq c 'GetDictionaryList)     6)
  43           ((eq c 'GetDirectoryList)      7)
  44           ((eq c 'MountDictionary)       8)
  45           ((eq c 'UnmountDictionary)       9)
  46           ((eq c 'GetMountDictionaryList) 11)
  47           ((eq c 'DefineWord)             13)
  48           ((eq c 'DeleteWord)             14)
  49           ((eq c 'BeginConvert)         15)
  50           ((eq c 'EndConvert)           16)
  51           ((eq c 'GetCandidacyList)     17)
  52           ((eq c 'GetYomi)              18)
  53           ((eq c 'ResizePause)          26)
  54           ((eq c 'GetHinshi)              27)
  55           ((eq c 'GetLex)                 28)
  56           ((eq c 'SetApplicationName)     33)
  57           ((eq c 'NoticeGroupName)        34)
  58
  59           ((eq c 'CreateDictionary)      3)
  60           ((eq c 'Sync)                    8)
  61           (t (error "No such constant")))))
  62
  63 ;; XXX
  64 (defconst cannarpc-error-message (vector ))
  65
  66 (defun cannarpc-get-error-message (errno)
  67   (or (and (>= errno 0)
  68            (< errno (length cannarpc-error-message))
  69            (aref cannarpc-error-message errno))
  70       (format "#%d" errno)))
  71
  72 (defmacro cannarpc-call-with-environment (e vlist send-expr &rest receive-exprs)
  73   (let ((v (append
  74             `((proc (cannaenv-get-proc ,e))
  75               (context (cannaenv-get-context ,e)))
  76             vlist)))
  77     (list
  78      'let v
  79      (append
  80         `(save-excursion
  81            (set-buffer (process-buffer proc))
  82            (erase-buffer)
  83            ,send-expr
  84            (process-send-region proc (point-min) (point-max))
  85            (goto-char (prog1 (point) (accept-process-output proc))))
  86         receive-exprs))))
  87 \f
  88 (defconst canna-version-fmt "3.3:%s")
  89
  90 (defun cannarpc-open (proc username)
  91   "Open the session.  Return 0 on success, error code on failure."
  92   (let ((verusr (format canna-version-fmt username)))
  93     (comm-call-with-proc proc (minor context)
  94       (comm-format (u u s) (canna-const Initialize) (+ (length verusr) 1)
  95                    verusr)
  96       (comm-unpack (w w) minor context)
  97       (cond ((and (= minor 65535) (= context 65535))
  98              -1)                        ; failure
  99             ((and (= minor 65535) (= context 65534))
 100              -1)                        ; version miss match
 101             (t context)))))
 102
 103 (defun cannarpc-close (proc)
 104   (comm-call-with-proc proc (dummy result)
 105     (comm-format (b b w) (canna-const Finalize) 0 0)
 106     (comm-unpack (u b) dummy result)
 107     (if (= result 255)
 108         -1                              ; failure
 109       result)))
 110
 111 (defun cannarpc-create-context (proc)
 112   (comm-call-with-proc proc (dummy result)
 113     (comm-format (b b w) (canna-const CreateContext) 0 0)
 114     (comm-unpack (u w) dummy result)
 115     (if (= result 65535)
 116         -1                              ; failure
 117       result)))
 118
 119 (defun cannarpc-close-context (env)
 120   (cannarpc-call-with-environment env (dummy result)
 121     (comm-format (b b w w) (canna-const CloseContext) 0 2 context)
 122     (comm-unpack (u b) dummy result)
 123     (if (= result 255)
 124         -1                              ; failure
 125       result)))
 126
 127 (defun cannarpc-get-dictionary-list (env)
 128   (let ((i 0)
 129         dic dl dic-list)
 130     (cannarpc-call-with-environment env (dummy result)
 131     (comm-format (b b w w w) (canna-const GetDictionaryList) 0 4
 132                  context 1024)
 133     (comm-unpack (u w) dummy result)
 134     ;; follow list of dictionaries
 135       (if (= result 65535)
 136           -1                            ; failure
 137         (while (< i result)
 138           (comm-unpack (s) dic)
 139           (if dl
 140               (setq dl (setcdr dl (cons dic nil)))
 141             (setq dic-list (setq dl (cons dic nil))))
 142           (setq i (1+ i)))
 143         dic-list))))
 144
 145 (defun cannarpc-get-directory-list (env)
 146   (let ((i 0)
 147         dir dl dir-list)
 148     (cannarpc-call-with-environment env (dummy result)
 149     (comm-format (b b w w w) (canna-const GetDirectoryList) 0 4
 150                  context 1024)
 151     (comm-unpack (u w) dummy result)
 152     ;; follow list of directories
 153       (if (= result 65535)
 154           -1                            ; failure
 155         (while (< i result)
 156           (comm-unpack (s) dir)
 157           (if dl
 158               (setq dl (setcdr dl (cons dir nil)))
 159             (setq dir-list (setq dl (cons dir nil))))
 160           (setq i (1+ i)))
 161         dir-list))))
 162
 163 (defun cannarpc-get-mount-dictionary-list (env)
 164   (let ((i 0)
 165         dic dl dic-list)
 166     (cannarpc-call-with-environment env (dummy result)
 167       (comm-format (b b w w w) (canna-const GetMountDictionaryList) 0 4
 168                    context 1024)
 169       (comm-unpack (u w) dummy result)
 170       ;; follow list of dictionaries
 171       (if (= result 65535)
 172           -1                            ; failure
 173         (while (< i result)
 174           (comm-unpack (s) dic)
 175           (if dl
 176               (setq dl (setcdr dl (cons dic nil)))
 177             (setq dic-list (setq dl (cons dic nil))))
 178           (setq i (1+ i)))
 179         dic-list))))
 180
 181 (defun cannarpc-open-dictionary (env dict-file-name mode)
 182   (cannarpc-call-with-environment env (dummy result)
 183     (comm-format (b b w u w s) (canna-const MountDictionary) 0
 184                  (+ (length dict-file-name) 7)
 185                  mode context dict-file-name)
 186     (comm-unpack (u b) dummy result)
 187     result))
 188
 189 (defun cannarpc-close-dictionary (env dict-file-name mode)
 190   (cannarpc-call-with-environment env (dummy result)
 191     (comm-format (b b w u w s) (canna-const UnmountDictionary) 0
 192                  (+ (length dict-file-name) 7)
 193                  mode context dict-file-name)
 194     (comm-unpack (u b) dummy result)
 195     result))
 196
 197 (defun cannarpc-begin-conversion (env yomi)
 198   "Begin conversion."
 199   (let ((yomi-ext (encode-coding-string yomi 'fixed-euc-jp))
 200         (mode (or (cannaenv-get-mode env) 19)) ; 19 kana hiragana
 201         (i 0)
 202         converted bunsetsu-list bl)
 203     (cannarpc-call-with-environment env (dummy result)
 204       (comm-format (b b w i w S) (canna-const BeginConvert) 0
 205                    (+ (length yomi-ext) 8) mode context yomi)
 206       (comm-unpack (u w) dummy result)
 207       (if (= result 65535)
 208           -1                            ; failure
 209         (while (< i result)
 210           (comm-unpack (S) converted)
 211           (let ((bl1 (cons (canna-make-bunsetsu env converted i nil)
 212                            nil)))
 213             (if bl
 214                 (setq bl (setcdr bl bl1))
 215               (setq bunsetsu-list (setq bl bl1))))
 216           (setq i (1+ i)))
 217         bunsetsu-list))))
 218
 219 (defun cannarpc-cancel-conversion (env)
 220   "Cancel conversion."
 221   (cannarpc-call-with-environment env (dummy result)
 222     (comm-format (b b w w w u) (canna-const EndConvert) 0 8 context 0 0)
 223     (comm-unpack (u b) dummy result)
 224     (if (= result 255)
 225         -1                              ; failure
 226       result)))
 227
 228 (defun cannarpc-end-conversion (env len zenkouho-pos-vector mode)
 229   "End conversion."
 230   (cannarpc-call-with-environment env (dummy result)
 231     (comm-format (b b w w w u v) (canna-const EndConvert) 0
 232                  (+ (* len 2) 8) context len mode zenkouho-pos-vector
 233                  (length zenkouho-pos-vector))
 234     (comm-unpack (u b) dummy result)
 235     (if (= result 255)
 236         -1                              ; failure
 237       result)))
 238
 239 (defun cannarpc-make-dictionary (env dict-name)
 240   (cannarpc-call-with-environment env (dummy result)
 241     (comm-format (b b w u w s) (canna-const CreateDictionary) 1
 242                  (+ (length dict-name) 7) 0 context dict-name)
 243     (comm-unpack (u b) dummy result)
 244     result))
 245
 246 (defun cannarpc-save-dictionary (env dict-name)
 247   (cannarpc-call-with-environment env (dummy result)
 248     (comm-format (b b w u w s) (canna-const Sync) 1
 249                  (+ (length dict-name) 7) 0 context dict-name)
 250     (comm-unpack (u b) dummy result)
 251     result))
 252
 253 ;;; XXX not used
 254 (defun cannarpc-get-dictionary-data (env dir dic)
 255   (cannarpc-call-with-environment env (dummy result)
 256     (comm-format (b b w w s s w) 6 1
 257                  (+ (length dir) (length dic) 6) context dir dic 4096)
 258     (comm-unpack (u w) dummy result)
 259     (if (= result 65535)
 260         -1
 261 ;;      (comm-unpack (S) result)
 262       result)))
 263
 264 (defun cannarpc-get-bunsetsu-source (env bunsetsu-pos)
 265   (cannarpc-call-with-environment env (dummy result)
 266     (comm-format (b b w w w w) (canna-const GetYomi) 0 6 context
 267                  bunsetsu-pos 1024)
 268     (comm-unpack (u w) dummy result)
 269     (if (= result 65535)
 270         -1
 271       (comm-unpack (S) result)
 272       result)))
 273
 274 (defun cannarpc-get-bunsetsu-candidates (env bunsetsu-pos yomi)
 275   (let ((i 0)
 276         converted bunsetsu-list bl)
 277     (cannarpc-call-with-environment env (dummy result)
 278       (comm-format (b b w w w w) (canna-const GetCandidacyList) 0 6 context
 279                    bunsetsu-pos 1024)
 280       (comm-unpack (u w) dummy result)
 281       (if (= result 65535)
 282           -1                            ; failure
 283         (while (< i result)
 284           (comm-unpack (S) converted)
 285           (let ((bl1 (cons (canna-make-bunsetsu env converted
 286                                                 bunsetsu-pos yomi)
 287                            nil)))
 288             (if bl
 289                 (setq bl (setcdr bl bl1))
 290               (setq bunsetsu-list (setq bl bl1))))
 291           (setq i (1+ i)))
 292         bunsetsu-list))))
 293
 294 (defun cannarpc-set-kugiri-changed (env yomi-length bunsetsu-pos)
 295   ;; yomi-length -2\e$B!DJ8@a=L$a\e(B -1\e$B!DJ8@a?-$P$7\e(B
 296   (let* ((i bunsetsu-pos)
 297          converted bunsetsu-list bl)
 298     (cannarpc-call-with-environment env (dummy result)
 299       (comm-format (b b w w w w) (canna-const ResizePause) 0 6 context
 300                    bunsetsu-pos yomi-length)
 301       (comm-unpack (u w) dummy result)
 302       (if (= result 65535)
 303           -1                            ; failure
 304         (while (< i result)
 305           (comm-unpack (S) converted)
 306           (let ((bl1 (cons (canna-make-bunsetsu env converted i nil) nil)))
 307             (if bl
 308                 (setq bl (setcdr bl bl1))
 309               (setq bunsetsu-list (setq bl bl1))))
 310           (setq i (1+ i)))
 311         bunsetsu-list))))
 312
 313 (defun cannarpc-get-hinshi (env bunsetsu-pos kouho-pos)
 314   (let (b hinshi)
 315     (cannarpc-call-with-environment env (dummy result)
 316       (comm-format (b b w w w w w) (canna-const GetHinshi) 0 8 context
 317                    bunsetsu-pos kouho-pos 1024)
 318       (comm-unpack (u w) dummy result)
 319       (if (= result 65535)
 320           -1
 321         (while (> result 0)
 322           (comm-unpack (w) b)
 323           (setq hinshi (concat hinshi (char-to-string b)))
 324           (setq result (1- result)))
 325         hinshi))))
 326
 327 (defun cannarpc-get-lex (env bunsetsu-pos kouho-pos)
 328   (let ((i 0)
 329         ylen klen rownum coldnum dicnum lex-list ll)
 330     (cannarpc-call-with-environment env (dummy result)
 331       (comm-format (b b w w w w w) (canna-const GetLex) 0 8 context
 332                    bunsetsu-pos kouho-pos 1024)
 333       (comm-unpack (u w) dummy result)
 334       (if (= result 65535)
 335           -1
 336         (while (< i result)
 337           (comm-unpack (i i i i i) ylen klen rownum coldnum dicnum)
 338           (let ((ll1 (cons (list ylen klen rownum coldnum dicnum) nil)))
 339             (if ll
 340                 (setq ll (setcdr ll ll1))
 341               (setq lex-list (setq ll ll1))))
 342           (setq i (1+ i)))
 343         lex-list))))
 344
 345 (defun cannarpc-add-word (env dictionary yomi kanji hinshi)
 346   "Register a word KANJI into DICTIONARY with a pronunciation YOMI and
 347 a part of speech HINSHI.  Where DICTIONARY should be an integer."
 348   (let* ((word-info (concat yomi " " hinshi " " kanji))
 349          (word-info-ext (encode-coding-string word-info 'fixed-euc-jp))
 350          (length (+ (length word-info-ext) (length dictionary) 5)))
 351     (cannarpc-call-with-environment env (dummy result)
 352       (comm-format (b b w w S s) (canna-const DefineWord) 0 length context
 353                    word-info dictionary)
 354       (comm-unpack (u b) dummy result)
 355       (if (= result 255)
 356           -1            ; failure
 357         result))))
 358
 359 (defun cannarpc-delete-word (env dictionary yomi kanji hinshi)
 360   "Delete the registered word KANJI from DICTIONARY with a
 361 pronunciation YOMI and a part of speech HINSHI.  Where DICTIONARY
 362 should be an integer."
 363   (let* ((word-info (concat yomi " " hinshi " " kanji))
 364          (word-info-ext (encode-coding-string word-info 'fixed-euc-jp))
 365          (length (+ (length word-info-ext) (length dictionary) 5)))
 366     (cannarpc-call-with-environment env (dummy result)
 367       (comm-format (b b w w S s) (canna-const DeleteWord) 0 length context
 368                    word-info dictionary)
 369       (comm-unpack (u b) dummy result)
 370       (if (= result 255)
 371           -1            ; failure
 372         result))))
 373
 374 (defun cannarpc-notice-group-name (proc context group)
 375   (comm-call-with-proc proc (dummy result)
 376     (comm-format (b b w u w s) (canna-const NoticeGroupName) 0
 377                  (+ (length group) 7) 0 ;; mode = 0
 378                  context group)
 379     (comm-unpack (u b) dummy result)
 380     (if (= result 255)
 381         -1
 382       result)))
 383
 384 (defun cannarpc-set-app-name (proc context name)
 385   (comm-call-with-proc proc (dummy result)
 386     (comm-format (b b w u w s) (canna-const SetApplicationName) 0
 387                  (+ (length name) 7) 0 context name)
 388     (comm-unpack (u b) dummy result)
 389     (if (= result 255)
 390         -1
 391       result)))
 392
 393 ;;; egg/cannarpc.el ends here.