1;;; cannav3-socket.scm: Canna protocol version 3 for uim. 2;;; 3;;; Copyright (c) 2009-2013 uim Project https://github.com/uim/uim 4;;; 5;;; All rights reserved. 6;;; 7;;; Redistribution and use in source and binary forms, with or without 8;;; modification, are permitted provided that the following conditions 9;;; are met: 10;;; 1. Redistributions of source code must retain the above copyright 11;;; notice, this list of conditions and the following disclaimer. 12;;; 2. Redistributions in binary form must reproduce the above copyright 13;;; notice, this list of conditions and the following disclaimer in the 14;;; documentation and/or other materials provided with the distribution. 15;;; 3. Neither the name of authors nor the names of its contributors 16;;; may be used to endorse or promote products derived from this software 17;;; without specific prior written permission. 18;;; 19;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND 20;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 22;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE 23;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 25;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 26;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 27;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 28;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 29;;; SUCH DAMAGE. 30;;;; 31 32(use srfi-1) 33(require "socket.scm") 34(require "lolevel.scm") 35 36;; canna protocol operators 37(define canna-lib-initialize-op #x1) 38(define canna-lib-finalize-op #x2) 39(define canna-lib-create-context-op #x3) 40(define canna-lib-close-context-op #x5) 41(define canna-lib-get-dictionary-list-op #x6) 42(define canna-lib-mount-dictionary-op #x8) 43(define canna-lib-unmount-dictionary-op #x9) 44(define canna-lib-begin-convert-op #xf) 45(define canna-lib-end-convert-op #x10) 46(define canna-lib-get-candidacy-list-op #x11) 47(define canna-lib-get-yomi-op #x12) 48(define canna-lib-resize-pause-op #x1a) 49 50(define (canna-var&user-fmt user) 51 (format "3.3:~a" user)) 52 53(define (canna-lib-initialize socket user) 54 (let* ((canna-var&user (canna-var&user-fmt user)) 55 (canna-var&user-len (+ 1 (string-length canna-var&user)))) 56 (file-write socket 57 (u8list->string-buf 58 (u8list-pack '(u32 u32 s8) 59 canna-lib-initialize-op canna-var&user-len canna-var&user))) 60 (call-with-u8list-unpack 61 '(u16 u16) (string-buf->u8list (file-read socket 4)) 62 (lambda (major minor) 63 (not (and (= major 65535) (= major 65535))))))) 64 65(define (canna-lib-finalize socket) 66 (file-write socket 67 (u8list->string-buf 68 (u8list-pack '(u8 u8 u16) 69 canna-lib-finalize-op 0 0))) 70 (call-with-u8list-unpack 71 '(u32 u8) (string-buf->u8list (file-read socket 5)) 72 (lambda (dummy result) 73 (= result 0)))) 74 75(define (canna-lib-create-context socket) 76 (file-write socket 77 (u8list->string-buf 78 (u8list-pack '(u8 u8 u16) 79 canna-lib-create-context-op 0 0))) 80 (call-with-u8list-unpack 81 '(u32 u16) (string-buf->u8list (file-read socket 6)) 82 (lambda (dummy context-id) 83 (and (not (= context-id 65535)) 84 context-id)))) 85 86(define (canna-lib-close-context socket context-id) 87 (file-write socket 88 (u8list->string-buf 89 (u8list-pack '(u8 u8 u16 u16) 90 canna-lib-close-context-op 0 2 context-id))) 91 (call-with-u8list-unpack 92 '(u32 u8) (string-buf->u8list (file-read socket 5)) 93 (lambda (dummy result) 94 (not (= result 255))))) 95 96(define (canna-lib-get-dictionary-list socket context-id) 97 (file-write socket 98 (u8list->string-buf 99 (u8list-pack '(u8 u8 u16 u16 u16) 100 canna-lib-get-dictionary-list-op 0 4 context-id 1024))) 101 (call-with-u8list-unpack 102 '(u32 u16) (string-buf->u8list (file-read socket 6)) 103 (lambda (dummy result) 104 (and (not (= result 65535)) 105 (call-with-u8list-unpack 106 (make-list result 's8) (string-buf->u8list (file-read socket 1024)) 107 (lambda dict-list 108 dict-list)))))) 109 110(define (canna-lib-mount-dictionary socket context-id dict mode) 111 (file-write socket 112 (u8list->string-buf 113 (u8list-pack '(u8 u8 u16 u32 u16 s8) 114 canna-lib-mount-dictionary-op 115 0 116 (+ (string-length dict) 7) 117 mode context-id dict))) 118 (call-with-u8list-unpack 119 '(u32 u8) (string-buf->u8list (file-read socket 5)) 120 (lambda (dummy result) 121 (not (= result 255))))) 122 123(define (canna-lib-unmount-dictionary socket context-id dict mode) 124 (file-write socket 125 (u8list->string-buf 126 (u8list-pack '(u8 u8 u16 u32 u16 s8) 127 canna-lib-unmount-dictionary-op 128 0 129 (+ (string-length dict) 7) 130 mode context-id dict))) 131 (call-with-u8list-unpack 132 '(u32 u8) (string-buf->u8list (file-read socket 5)) 133 (lambda (dummy result) 134 (not (= result 255))))) 135 136(define (canna-lib-begin-convert socket context-id yomi mode) 137 (file-write socket 138 (u8list->string-buf 139 (u8list-pack '(u8 u8 u16 u32 u16 s16) 140 canna-lib-begin-convert-op 141 0 142 (+ (string-length yomi) 8) 143 mode context-id yomi))) 144 (call-with-u8list-unpack 145 '(u16 u16 u16) (string-buf->u8list (file-read socket 6)) 146 (lambda (dummy len bunsetsu) 147 (and (not (= bunsetsu 65535)) 148 (call-with-u8list-unpack 149 (make-list bunsetsu 's16) (string-buf->u8list (file-read socket len)) 150 (lambda conv 151 conv)))))) 152 153(define (canna-lib-end-convert socket context-id cands mode) 154 (file-write socket 155 (u8list->string-buf 156 (u8list-pack '(u8 u8 u16 u16 u16 u32 u16list) 157 canna-lib-end-convert-op 158 0 159 (+ (* 2 (length cands)) 8) 160 context-id (length cands) mode 161 cands))) 162 (call-with-u8list-unpack 163 '(u32 u8) (string-buf->u8list (file-read socket 5)) 164 (lambda (dummy result) 165 (not (= result 255))))) 166 167(define (canna-lib-get-candidacy-list socket context-id bunsetsu-pos) 168 (file-write socket 169 (u8list->string-buf 170 (u8list-pack '(u8 u8 u16 u16 u16 u16) 171 canna-lib-get-candidacy-list-op 172 0 173 6 174 context-id bunsetsu-pos 1024))) 175 (call-with-u8list-unpack 176 '(u16 u16 u16) (string-buf->u8list (file-read socket 6)) 177 (lambda (dummy len cands) 178 (call-with-u8list-unpack 179 (make-list cands 's16) (string-buf->u8list (file-read socket len)) 180 (lambda cand-list 181 cand-list))))) 182 183(define (canna-lib-get-yomi socket context-id bunsetsu-pos) 184 (file-write socket 185 (u8list->string-buf 186 (u8list-pack '(u8 u8 u16 u16 u16 u16) 187 canna-lib-get-yomi-op 188 0 189 6 190 context-id bunsetsu-pos 1024))) 191 (call-with-u8list-unpack 192 '(u16 u16 u16) (string-buf->u8list (file-read socket 6)) 193 (lambda (dummy len yomi-len) 194 (call-with-u8list-unpack 195 '(s16) (string-buf->u8list (file-read socket len)) 196 (lambda (conv) 197 conv))))) 198 199(define (canna-lib-resize-pause socket context-id yomi-length bunsetsu-pos) 200 (file-write socket 201 (u8list->string-buf 202 (u8list-pack '(u8 u8 u16 u16 u16 u16) 203 canna-lib-resize-pause-op 204 0 205 6 206 context-id bunsetsu-pos yomi-length))) 207 (call-with-u8list-unpack 208 '(u16 u16 u16) (string-buf->u8list (file-read socket 6)) 209 (lambda (dummy len bunsetsu) 210 (and (not (= bunsetsu 65535)) 211 (let loop ((s16list (string-buf->u8list (file-read socket len))) 212 (rest '())) 213 (if (equal? s16list '(0 0)) 214 (reverse rest) 215 (let ((s16 (u8list-unpack '(s16) s16list))) 216 (loop (drop s16list (+ 2 (string-length (car s16)))) 217 (cons (car s16) rest))))))))) 218 219;; 220;; RK compatible functions 221;; 222(define canna-lib-context-rec-spec 223 (list 224 (list 'id #f) 225 (list 'mode 0) 226 (list 'nostudy #f) 227 (list 'cands '()) 228 (list 'nth-cands '#()) 229 (list 'dic-list '()))) 230(define-record 'canna-lib-context canna-lib-context-rec-spec) 231(define canna-lib-context-new-internal canna-lib-context-new) 232 233(define *canna-lib-socket* #f) 234(define *canna-lib-context-list* '()) 235(define canna-lib-cannaserver #f) 236 237(define (canna-lib-open-with-server server) 238 (let ((server-name (if (equal? server "") 239 "localhost" 240 server))) 241 (if canna-server-name 242 (tcp-connect server-name "canna") 243 (unix-domain-socket-connect "/tmp/.iroha_unix/IROHA")))) 244 245(define (canna-lib-init server) 246 (set! canna-lib-cannaserver server) 247 (and (not *canna-lib-socket*) 248 (let ((s (canna-lib-open-with-server server))) 249 (and s 250 (begin 251 (canna-lib-initialize s canna-user-name) 252 (set! *canna-lib-socket* s) 253 #t))))) 254 255(define (canna-lib-alloc-context) 256 (if (and (not *canna-lib-socket*) 257 (not (canna-lib-init canna-lib-cannaserver))) 258 (begin 259 (uim-notify-fatal (N_ "Initialize failed.")) 260 #f) 261 (and-let* ((cic (canna-lib-context-new-internal)) 262 (id (canna-lib-create-context *canna-lib-socket*)) 263 (dic-list (canna-lib-context-set-dic-list! 264 cic 265 (canna-lib-get-dictionary-list *canna-lib-socket* id))) 266 (mode 19)) ;; XXX: (RK_XFER << RK_XFERBITS) | RK_KFER 267 (canna-lib-context-set-id! cic id) 268 (canna-lib-context-set-mode! cic mode) 269 (map (lambda (dict) 270 (canna-lib-mount-dictionary *canna-lib-socket* id dict 0)) 271 dic-list) 272 (set! *canna-lib-context-list* 273 (cons cic *canna-lib-context-list*)) 274 cic))) 275 276(define (canna-lib-release-context cic) 277 (set! *canna-lib-context-list* (delete! cic *canna-lib-context-list* equal?)) 278 (canna-lib-close-context *canna-lib-socket* 279 (canna-lib-context-id cic))) 280 281(define (canna-lib-begin-conversion cic str) 282 (let ((cands (canna-lib-begin-convert *canna-lib-socket* 283 (canna-lib-context-id cic) 284 str 285 (canna-lib-context-mode cic)))) 286 (canna-lib-context-set-cands! cic cands) 287 (canna-lib-context-set-nth-cands! cic (make-vector (length cands) 0)) 288 (length cands))) 289 290(define (canna-lib-get-nth-candidate cic seg nth) 291 (vector-set! (canna-lib-context-nth-cands cic) seg nth) 292 (list-ref (canna-lib-get-candidacy-list *canna-lib-socket* 293 (canna-lib-context-id cic) 294 seg) 295 nth)) 296 297(define (canna-lib-get-unconv-candidate cic seg) 298 (canna-lib-context-set-nth-cands! cic (vector-set! (canna-lib-context-nth-cands cic) seg 0)) 299 (canna-lib-get-yomi *canna-lib-socket* 300 (canna-lib-context-id cic) 301 seg)) 302 303(define (canna-lib-resize-segment cic seg delta) 304 (let* ((direct (if (< 0 delta) 305 -1 306 -2)) 307 (new-cands (canna-lib-resize-pause *canna-lib-socket* 308 (canna-lib-context-id cic) direct seg)) 309 (len (length new-cands)) 310 (new-nth-cands (make-vector (+ seg len) 0))) 311 ;; save unconverted segments 312 (for-each (lambda (n) 313 (vector-set! new-nth-cands 314 n 315 (vector-ref (canna-lib-context-nth-cands cic) n))) 316 (iota seg)) 317 (canna-lib-context-set-cands! cic new-cands) 318 (canna-lib-context-set-nth-cands! cic new-nth-cands) 319 #t)) 320 321(define (canna-lib-get-nr-segments cic) 322 (vector-length (canna-lib-context-nth-cands cic))) 323 324(define (canna-lib-get-nr-candidates cic seg) 325 (length (canna-lib-get-candidacy-list *canna-lib-socket* 326 (canna-lib-context-id cic) 327 seg))) 328 329(define (canna-lib-commit-segment cic seg nth) 330 (let ((nth-cands (vector->list (canna-lib-context-nth-cands cic))) 331 (learn (if (canna-lib-context-nostudy cic) 332 0 333 1))) 334 (canna-lib-end-convert *canna-lib-socket* 335 (canna-lib-context-id cic) 336 nth-cands 337 learn))) 338 339(define (canna-lib-reset-conversion cic) 340 (let ((nth-cands (vector->list (canna-lib-context-nth-cands cic)))) 341 (canna-lib-end-convert *canna-lib-socket* 342 (canna-lib-context-id cic) 343 nth-cands 344 0))) 345