egg/anthyipc.el

   1 ;;; egg/anthyipc.el --- ANTHY IPC Support (low level interface) in Egg
   2 ;;;                Input Method Architecture
   3
   4 ;; Copyright (C) 2002 The Free Software Initiative of Japan
   5
   6 ;; Author: NIIBE Yutaka <gniibe@m17n.org>
   7
   8 ;; Maintainer: NIIBE Yutaka <gniibe@m17n.org>
   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 (defmacro anthyipc-call-with-proc (proc vlist send-expr &rest receive-exprs)
  35   `(let* ((proc ,proc)
  36           (buffer (process-buffer proc))
  37           ,@vlist)
  38      (if (and (eq (process-status proc) 'run)
  39               (buffer-live-p buffer))
  40          (save-excursion
  41            (set-buffer buffer)
  42            (erase-buffer)
  43            ,send-expr
  44            (goto-char (point-max))
  45            (process-send-region proc (point-min) (point-max))
  46            ,@receive-exprs)
  47        (egg-error "process %s was killed" proc))))
  48
  49 (defun anthyipc-wait-line ()
  50   (let ((start (point)))
  51     (while (not (search-forward "\n" nil 1))
  52       (accept-process-output proc 1000)
  53       (goto-char start))
  54     (goto-char start)))
  55
  56 (defun anthyipc-accept-ok ()
  57   (anthyipc-wait-line)
  58   (if (eq (char-after) ?+)
  59       ;; "+OK"
  60       (goto-char (point-max))
  61     (egg-error "protocol error: %s" (buffer-substring (point) (point-max)))))
  62
  63 (defun anthyipc-accept-number ()
  64   (anthyipc-wait-line)
  65   (if (eq (char-after)  ?+)
  66       ;; "+OK <number>"
  67       (progn
  68         (forward-char 4)
  69         (prog1
  70             (read (current-buffer))
  71           (goto-char (point-max))))
  72     (egg-error "protocol error: %s" (buffer-substring (point) (point-max)))))
  73
  74 (defun anthyipc-read-string ()
  75   (if (eq (char-after) ?\ )
  76     (forward-char 1))
  77   (let ((start (point)))
  78     (while (and (char-after)
  79                 (not (eq (char-after) ?\ ))
  80                 (not (eq (char-after) ?\n)))
  81       (forward-char 1))
  82     (buffer-substring start (point))))
  83
  84 (defun anthyipc-accept-segments (env seg-no-orig)
  85   (anthyipc-wait-line)
  86   (if (eq (char-after) ?+)
  87       (progn
  88         (forward-char 1)
  89         (if (eq (char-after) ?O)
  90             ;; "+OK"
  91             (progn
  92               (goto-char (point-max))
  93               t)
  94           ;; "+DATA <seg-no> <num-segments-removed> <num-segments-inserted>"
  95           ;; "<num-candidates> <converted> <yomi>"*N
  96           ;; ""
  97           ;;
  98           (forward-char 5)
  99           (let* ((seg-no (read (current-buffer)))
 100                  (num-segments-removed (read (current-buffer)))
 101                  (num-segments-inserted (read (current-buffer)))
 102                  (segment-list nil)
 103                  (in-loop t)
 104                  (i seg-no))
 105             (while in-loop
 106               (forward-char 1)
 107               (anthyipc-wait-line)
 108               (if (eq (char-after) ?\n)
 109                   (setq in-loop nil)
 110                 (let* ((num-candidates (read (current-buffer)))
 111                        (converted (anthyipc-read-string))
 112                        (source (anthyipc-read-string))
 113                        (segment (anthy-make-bunsetsu env source converted i)))
 114                   (setq i (1+ i))
 115                   (setq segment-list (cons segment segment-list)))))
 116             ;; XXX check if seg-no == seg-no-orig
 117             ;; XXX check inserted and length of segment-list???
 118             (forward-char 1)
 119             (cons seg-no (cons num-segments-removed (reverse segment-list))))))
 120     (egg-error "protocol error: %s" (buffer-substring (point) (point-max)))))
 121
 122 (defun anthyipc-accept-candidates ()
 123   (anthyipc-wait-line)
 124   (if (eq (char-after) ?+)
 125       (progn
 126         ;; "+DATA <offset> <num-candidates>"
 127         ;; "<converted>"*N
 128         ;; ""
 129         (forward-char 6)
 130         (let* ((offset (read (current-buffer)))
 131                (num-candidates (read (current-buffer)))
 132                (candidate-list nil)
 133                (in-loop t))
 134           (while in-loop
 135             (forward-char 1)
 136             (anthyipc-wait-line)
 137             (if (eq (char-after) ?\n)
 138                 (setq in-loop nil)
 139               (let ((candidate (anthyipc-read-string)))
 140                 (setq candidate-list (cons candidate candidate-list)))))
 141           ;; XXX check num-candidates and length of candidate-list???
 142           (forward-char 1)
 143           (cons offset (reverse candidate-list))))
 144     (egg-error "protocol error: %s" (buffer-substring (point) (point-max)))))
 145 \f
 146 (defun anthyipc-get-greeting (proc)
 147   (anthyipc-call-with-proc proc ()
 148     nil
 149     (anthyipc-wait-line)
 150     (message (buffer-substring (point-min) (1- (point-max))))))
 151
 152 (defun anthyipc-new-context (proc)
 153   (anthyipc-call-with-proc proc ()
 154     (insert "NEW-CONTEXT INPUT=#18 OUTPUT=#18\n")
 155     (anthyipc-accept-number)))
 156
 157 (defun anthyipc-release-context (proc cont)
 158   (anthyipc-call-with-proc proc ()
 159     (insert (format "RELEASE-CONTEXT %d\n" cont))
 160     (anthyipc-accept-ok)))
 161
 162 ;; Returns list of bunsetsu
 163 (defun anthyipc-convert (proc cont yomi)
 164   (anthyipc-call-with-proc proc ()
 165     (insert (format "CONVERT %d %s\n" cont yomi))
 166     (let ((r (anthyipc-accept-segments cont 0)))
 167       (cdr (cdr r)))))
 168
 169 (defun anthyipc-commit (proc cont cancel)
 170   (anthyipc-call-with-proc proc ()
 171     (insert (format "COMMIT %d %d\n" cont cancel))
 172     (anthyipc-accept-ok)))
 173
 174 ;;; Returns list of candidate
 175 (defconst anthy-max-candidates 9999)
 176 (defun anthyipc-get-candidates (proc cont seg-no)
 177   (anthyipc-call-with-proc proc ()
 178     (insert
 179      (format "GET-CANDIDATES %d %d %d %d\n" cont seg-no 0 anthy-max-candidates))
 180     (let ((r (anthyipc-accept-candidates)))
 181       (cdr r))))
 182
 183 ;;; Returns segments
 184 (defun anthyipc-select-candidate (proc cont seg-no candidate-no)
 185   (anthyipc-call-with-proc proc ()
 186     (insert (format "SELECT-CANDIDATE %d %d %d\n" cont seg-no candidate-no))
 187     (anthyipc-accept-segments cont seg-no)))
 188
 189 ;;; Returns segments
 190 (defun anthyipc-resize-segment (proc cont seg-no inc-dec)
 191   (anthyipc-call-with-proc proc ()
 192     (insert (format "RESIZE-SEGMENT %d %d %d\n" cont seg-no inc-dec))
 193     (cddr (anthyipc-accept-segments cont seg-no))))
 194
 195 ;;; egg/anthyipc.el ends here.