Skip to content

Instantly share code, notes, and snippets.

@iratqq
Created December 22, 2010 16:21
Show Gist options
  • Save iratqq/751706 to your computer and use it in GitHub Desktop.
Save iratqq/751706 to your computer and use it in GitHub Desktop.
;; skkserv
(require-extension (srfi 1 48))
(require "util.scm")
(require "socket.scm")
(require "i18n.scm")
(require "input-parse.scm")
(require-dynlib "look")
(define socks (tcp-listen "localhost" 1178))
(define dict (string-append (home-directory (user-name)) "/.uim.d/dict/SKK-JISYO"))
(define cand-max 1000)
;; XXX: srfi-13
(define (string-concatenate-reverse strs final end)
(define (string-xcopy! target tstart s sfrom sto)
(do ((i sfrom (inc i)) (j tstart (inc j)))
((>= i sto))
(string-set! target j (string-ref s i))))
(if (null? strs) (substring final 0 end)
(let*
((total-len
(let loop ((len end) (lst strs))
(if (null? lst) len
(loop (+ len (string-length (car lst))) (cdr lst)))))
(result (make-string total-len)))
(let loop ((len end) (j total-len) (str final) (lst strs))
(string-xcopy! result (- j len) str 0 len)
(if (null? lst) result
(loop (string-length (car lst)) (- j len)
(car lst) (cdr lst)))))))
(define (skk-parse-line line)
(define (skk-key-state port)
(next-token '(#\space #\tab) '(#\space *eof*) (N_ "Invalid skk entry") port))
(define (skk-entry-state port)
(and (eq? #\/ (skip-while '(#\space #\tab) port))
(let loop ((val (next-token '(#\/) '(#\/ *eof*) (N_ "Invalid skk value") port))
(rest '()))
(if (or (eof-object? val)
(string=? val ""))
(reverse rest)
(loop (next-token '(#\/) '(#\/ *eof*) (N_ "Invalid skk value") port)
(cons val rest))))))
(call-with-input-string line
(lambda (port)
(and-let* ((key (skk-key-state port))
(value (skk-entry-state port)))
(values key value)))))
(define (skkserv:receive-search s exact-match?)
(define (read-word c rest)
(cond ((eof-object? c)
(values #f (list->string (reverse rest))))
((eq? (car c) #\space)
(values #t (list->string (reverse rest))))
(else
(read-word (file-read s 1) (cons (car c) rest)))))
(define (normalize sl) ;; drop noise
(let ((ent (find-tail (lambda (c) (eq? c #\/))
(reverse (string->list sl)))))
(if ent
(list->string (reverse ent))
"")))
(receive (cont? ret)
(read-word (file-read s 1) '())
(let ((look (look-lib-look #f #f cand-max dict ret))) ;; return raw text (text1 text2 ...)
(if (null? look)
(begin
;; not found
(file-write s '(#\4 #\space))
#t)
(let* ((recv-cand (filter-map (lambda (ent)
(receive (key value)
(skk-parse-line (string-append ret (normalize ent)))
(if exact-match?
(if (string=? key ret)
value
#f)
value)))
look))
(recv-string (string-join (apply append recv-cand) "/")))
;;(print recv-string)
(if (string=? recv-string "")
(file-write s '(#\4 #\space))
(begin
(file-write s '(#\1 #\/))
(file-write s (string->list recv-string))
(file-write s '(#\/ #\newline))))
#t)))))
(define (skkserv:receive-version s)
;;(file-write s (string->list (uim-version))))
(file-write s '(#\1 #\. #\0 #\space)))
(define (skkserv:receive-hostname s)
;; XXX
(file-write s (string->list (format "~a:~a: " "localhost" "0.0.0.0"))))
(define (read-req s)
(define (reqno? c)
(find (lambda (x) (eq? c x)) '(#\0 #\1 #\2 #\3 #\4)))
(let loop ((c (file-read s 1)))
(if (or (eof-object? c)
(reqno? (car c)))
c
(loop (file-read s 1)))))
(define server (make-tcp-server
(lambda (s)
;;(display "connected.\n")
(let loop ((req (read-req s)))
(if (eof-object? req)
(file-close s)
(let ((reqno (car req)))
;;(write `(reqno ,reqno))(newline)
(cond ((eq? reqno #\0)
(file-close s))
((eq? reqno #\1)
(if (skkserv:receive-search s #t)
(loop (read-req s))
(file-close s)))
((eq? reqno #\2)
(skkserv:receive-version s)
(loop (read-req s)))
((eq? reqno #\3)
(skkserv:receive-hostname s)
(loop (read-req s)))
((eq? reqno #\4)
(if (skkserv:receive-search s #f)
(loop (read-req s))
(file-close s)))
(else
(loop (read-req s))))))))))
;;(display "skkserver starting.\n")
(server socks)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment