Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;; 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)
Add Comment
Please, Sign In to add comment