Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
;; 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 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))))
(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)
;; not found
(file-write s '(#\4 #\space))
(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)
(recv-string (string-join (apply append recv-cand) "/")))
;;(print recv-string)
(if (string=? recv-string "")
(file-write s '(#\4 #\space))
(file-write s '(#\1 #\/))
(file-write s (string->list recv-string))
(file-write s '(#\/ #\newline))))
(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" ""))))
(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)))
(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)))
(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
You can’t perform that action at this time.