Author: iratqq Date: Tue Feb 3 04:48:03 2009 New Revision: 5812
Modified: trunk/scm/ajax-ime.scm Log: * scm/ajax-ime.scm (ajax-ime:parse): - New function. - Switch to input-parse parser. Modified: trunk/scm/ajax-ime.scm ============================================================================== --- trunk/scm/ajax-ime.scm (original) +++ trunk/scm/ajax-ime.scm Tue Feb 3 04:48:03 2009 @@ -35,6 +35,7 @@ (require "japanese.scm") (require "japanese-kana.scm") (require "japanese-azik.scm") +(require "input-parse.scm") (require-custom "generic-key-custom.scm") (require-custom "ajax-ime-custom.scm") (require-custom "ajax-ime-key-custom.scm") @@ -61,6 +62,37 @@ '((ajax-ime . "http://api.chasen.org/ajaxime/";) (cha-ime . "http://cl.naist.jp/~mamoru-k/chaime/api.cgi";))) +(define (ajax-ime-parse str) + (define (ajax-ime:parse-quoted-word1 port) + (skip-while '(#\' #\space #\tab *eof*) port) + (let ((w (next-token '(#\') '(#\' *eof*) "reading word" port))) + (if (eof-object? (read-char port)) + #f + w))) + (define (ajax-ime:parse-quoted-word2 port) + (let ((parsed #f)) + (and + (skip-while '(#\' #\, #\space #\tab *eof*) port) + (set! parsed (next-token '(#\') '(#\' *eof*) "reading word" port)) + (skip-while '(#\' #\space #\tab *eof*) port)) + parsed)) + (define (ajax-ime:parse-quoted-word2* port) + (let loop ((parsed (ajax-ime:parse-quoted-word2 port)) + (rest '())) + (if (or (not parsed) (eof-object? (read-char port))) + (reverse rest) + (loop (ajax-ime:parse-quoted-word2 port) (cons parsed rest))))) + + (call-with-input-string + str + (lambda (port) + (find-string-from-port? "ImeRequestCallback([" port) + (let ((w1 (ajax-ime:parse-quoted-word1 port)) + (w2 (ajax-ime:parse-quoted-word2* port))) + (if (and (string? w1) (list? w2)) + (list (append (list w1) w2)) + '("")))))) + (define (ajax-ime-conversion str opts) (define (icovn-convert to-code from-code from-str) (and-let* ((ic (iconv-open to-code from-code)) @@ -81,21 +113,7 @@ (and-let* ((utf8-str (curl-fetch-simple (make-query))) (euc-str (icovn-convert "EUC-JP" "UTF-8" utf8-str))) euc-str)) - (define (parse str) - (and-let* ((ret1 (if (string? str) - (string-split str "ImeRequestCallback(['") - '("" ""))) - (ret2 (if (= (length ret1) 1) - '("") - (string-split - (cadr ret1) - "']);\n"))) - (ret3 (string-split (car ret2) "','"))) - ret3)) - (let ((ret (parse (fetch (make-query))))) - (if (equal? '("") ret) - (list (list str)) - (list ret)))) + (ajax-ime-parse (fetch (make-query)))) (define (ajax-ime-lib-init) #t)
