2 new revisions:
Revision: 391e01172581
Author: iratqq <[email protected]>
Date: Tue May 1 01:46:53 2012
Log: * scm/util.scm (read-line):...
http://code.google.com/p/uim/source/detail?r=391e01172581
Revision: 777ce02ba982
Author: iratqq <[email protected]>
Date: Tue May 1 02:30:13 2012
Log: * scm/util.scm (iconv-convert):...
http://code.google.com/p/uim/source/detail?r=777ce02ba982
==============================================================================
Revision: 391e01172581
Author: iratqq <[email protected]>
Date: Tue May 1 01:46:53 2012
Log: * scm/util.scm (read-line):
- New function.
* scm/tutcode-bushu.scm (tutcode-bushu-help-load):
- x2 speedup by using read-char (bufferd vs nonubuffered).
- Drop fileio.scm.
http://code.google.com/p/uim/source/detail?r=391e01172581
Modified:
/scm/tutcode-bushu.scm
/scm/util.scm
=======================================
--- /scm/tutcode-bushu.scm Wed Jan 11 00:17:24 2012
+++ /scm/tutcode-bushu.scm Tue May 1 01:46:53 2012
@@ -34,7 +34,7 @@
;;; (»²¹Í:Éô¼ó¹çÀ®¥¢¥ë¥´¥ê¥º¥à¤Ï[tcode-ml:1942]¤¢¤¿¤ê)
(require-extension (srfi 1 2 8 69 95))
-(require "fileio.scm")
+(require "util.scm")
(require-dynlib "look")
;;; #t¤Î¾ì¹ç¡¢Éô¼ó¤ÎʤÙÊý¤Ë¤è¤Ã¤Æ¹çÀ®¤µ¤ì¤ëʸ»ú¤ÎÍ¥ÀèÅÙ¤¬ÊѤï¤ë
@@ -585,50 +585,46 @@
;;; bushu.help¥Õ¥¡¥¤¥ë¤òÆɤó¤Çtutcode-bushudic·Á¼°¤Î¥ê¥¹¥È¤òÀ¸À®¤¹¤ë
;;; @return tutcode-bushudic·Á¼°¤Î¥ê¥¹¥È¡£Æɤ߹þ¤á¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
(define (tutcode-bushu-help-load)
- (let*
- ((fd (file-open tutcode-bushu-help-filename
- (file-open-flags-number '($O_RDONLY)) 0))
- (parse
- (lambda (line)
- ;; Îã: "Ñ£¥¤Àì* ÅÁ¡¦"
- ;; ¢ª(((("¥¤" "Àì"))("Ñ£"))((("Àì" "¥¤"))("Ñ£"))((("ÅÁ" "¡¦"))("Ñ£")))
- (let*
+ (define parse
+ (lambda (line)
+ ;; Îã: "Ñ£¥¤Àì* ÅÁ¡¦"
+ ;; ¢ª(((("¥¤" "Àì"))("Ñ£"))((("Àì" "¥¤"))("Ñ£"))((("ÅÁ" "¡¦"))("Ñ£")))
+ (let*
((comps (string-split line " "))
(kanji-lcomps (map tutcode-bushu-parse-entry comps))
(kanji (and (pair? (car kanji-lcomps)) (caar kanji-lcomps)))
;;
¹ÔƬ¤Î¹çÀ®¸å¤Î´Á»ú¤ò½ü¤¤¤¿¥ê¥¹¥È¡£Îã:(("¥¤" "Àì" "*")("ÅÁ" "¡¦"))
(lcomps
(if kanji
- (cons (cdar kanji-lcomps) (cdr kanji-lcomps))
- ())))
- (append-map!
- (lambda (elem)
- (let ((len (length elem)))
- (if (< len 2)
- ()
- (let*
- ((bushu1 (list-ref elem 0))
- (bushu2 (list-ref elem 1))
- (rule (list (list (list bushu1 bushu2)) (list kanji)))
- (rev
- (and
+ (cons (cdar kanji-lcomps) (cdr kanji-lcomps))
+ ())))
+ (append-map!
+ (lambda (elem)
+ (let ((len (length elem)))
+ (if (< len 2)
+ ()
+ (let*
+ ((bushu1 (list-ref elem 0))
+ (bushu2 (list-ref elem 1))
+ (rule (list (list (list bushu1 bushu2)) (list
kanji)))
+ (rev
+ (and
(and (>= len 3) (string=? (list-ref elem 2) "*"))
(list (list (list bushu2 bushu1)) (list kanji)))))
- (if rev
- (list rule rev)
- (list rule))))))
- lcomps))))
- (res
- (call-with-open-file-port fd
- (lambda (port)
- (let loop ((line (file-read-line port))
- (rules ()))
- (if (or (not line)
- (eof-object? line))
- rules
- (loop (file-read-line port)
- (append! rules (parse line)))))))))
- res))
+ (if rev
+ (list rule rev)
+ (list rule))))))
+ lcomps))))
+ (call-with-input-file tutcode-bushu-help-filename
+ (lambda (port)
+ (let loop ((line (read-line port))
+ (rules ()))
+ (if (or (not line)
+ (eof-object? line))
+ rules
+ (loop (read-line port)
+ (append! rules (parse line))))))))
+
;;; bushu.help¥Õ¥¡¥¤¥ë¤Ë´ð¤Å¤¯Éô¼ó¹çÀ®¤ò¹Ô¤¦
(define (tutcode-bushu-compose-explicitly char-list)
=======================================
--- /scm/util.scm Wed Jan 11 00:17:24 2012
+++ /scm/util.scm Tue May 1 01:46:53 2012
@@ -187,6 +187,21 @@
(lambda (port)
(read port)))))
+(define (read-line . args)
+ (let-optionals* args ((port (current-input-port)))
+ (let loop ((c (read-char port))
+ (rest '()))
+ (cond ((eq? #\newline c)
+ (list->string (reverse rest)))
+ ((or (eof-object? c)
+ (not c))
+ (if (null? rest)
+ c
+ (list->string (reverse rest))))
+ (else
+ (loop (read-char port) (cons c rest)))))))
+
+
;; only accepts single-arg functions
;; (define caddr (compose car cdr cdr))
;; FIXME: remove the closure overhead
==============================================================================
Revision: 777ce02ba982
Author: iratqq <[email protected]>
Date: Tue May 1 02:30:13 2012
Log: * scm/util.scm (iconv-convert):
- New function.
* scm/ajax-ime.scm (ajax-ime-conversion):
* scm/predict-google-suggest.scm (predict-google-suggest):
- Remove local iconv-convert.
* scm/baidu-olime-jp.scm (baidu-olime-jp-conversion):
* scm/generic-predict.scm (convert-charset):
* scm/google-cgiapi-jp.scm (google-cgiapi-jp-conversion):
* scm/japanese.scm (ja-kanji-code-input-ucs):
* scm/japanese-custom.scm (ja-rk-rule-rule->table):
* scm/yahoo-jp.scm (yahoo-jp-conversion):
- Use iconv-convert.
http://code.google.com/p/uim/source/detail?r=777ce02ba982
Modified:
/scm/ajax-ime.scm
/scm/baidu-olime-jp.scm
/scm/generic-predict.scm
/scm/google-cgiapi-jp.scm
/scm/japanese-custom.scm
/scm/japanese.scm
/scm/predict-google-suggest.scm
/scm/util.scm
/scm/yahoo-jp.scm
=======================================
--- /scm/ajax-ime.scm Wed Jan 11 00:17:24 2012
+++ /scm/ajax-ime.scm Tue May 1 02:30:13 2012
@@ -36,6 +36,7 @@
(require "generic-predict.scm")
(require "input-parse.scm")
(require "http-client.scm")
+(require "util.scm")
(require-custom "generic-key-custom.scm")
(require-custom "ajax-ime-custom.scm")
(require-custom "ajax-ime-key-custom.scm")
@@ -93,12 +94,6 @@
#f)))))
(define (ajax-ime-conversion str opts)
- (define (iconv-convert to-code from-code from-str)
- (and-let* ((ic (iconv-open to-code from-code))
- (to-str (iconv-code-conv ic from-str)))
- (if ic
- (iconv-release ic))
- to-str))
(define (make-query)
(let ((utf8-str (iconv-convert "UTF-8" "EUC-JP" str)))
(if utf8-str
=======================================
--- /scm/baidu-olime-jp.scm Sun Mar 11 00:36:19 2012
+++ /scm/baidu-olime-jp.scm Tue May 1 02:30:13 2012
@@ -62,15 +62,9 @@
(define (baidu-olime-jp-conversion str opts)
(define (fromconv str)
- (let* ((cd (iconv-open "UTF-8" "EUC-JP"))
- (ret (iconv-code-conv cd str)))
- (iconv-release cd)
- ret))
+ (iconv-convert "UTF-8" "EUC-JP" str))
(define (toconv str)
- (let* ((cd (iconv-open "EUC-JP" "UTF-8"))
- (ret (iconv-code-conv cd str)))
- (iconv-release cd)
- ret))
+ (iconv-convert "EUC-JP" "UTF-8" str))
(define (make-query)
(format "/py?ol=1&web=1&py=~a~a"
(http:encode-uri-string (fromconv str)) opts))
=======================================
--- /scm/generic-predict.scm Wed Jan 11 00:17:24 2012
+++ /scm/generic-predict.scm Tue May 1 02:30:13 2012
@@ -73,13 +73,7 @@
(class-set-method! predict convert-charset
(lambda (self str tocode fromcode)
- (let ((cd (iconv-open tocode fromcode)))
- (if cd
- (let ((ret (iconv-code-conv cd str)))
- (iconv-release cd)
- (or ret
- str))
- str))))
+ (iconv-convert tocode fromcode str)))
(class-set-method! predict >internal-charset
(lambda (self str)
=======================================
--- /scm/google-cgiapi-jp.scm Wed Jan 11 00:17:24 2012
+++ /scm/google-cgiapi-jp.scm Tue May 1 02:30:13 2012
@@ -36,6 +36,7 @@
(require "http-client.scm")
(require "json.scm")
(require "generic-predict.scm")
+(require "util.scm")
(require-custom "generic-key-custom.scm")
(require-custom "google-cgiapi-jp-custom.scm")
(require-custom "google-cgiapi-jp-key-custom.scm")
@@ -62,15 +63,9 @@
(define (google-cgiapi-jp-conversion str opts)
(define (fromconv str)
- (let* ((cd (iconv-open "UTF-8" "EUC-JP"))
- (ret (iconv-code-conv cd str)))
- (iconv-release cd)
- ret))
+ (iconv-convert "UTF-8" "EUC-JP" str))
(define (toconv str)
- (let* ((cd (iconv-open "EUC-JP" "UTF-8"))
- (ret (iconv-code-conv cd str)))
- (iconv-release cd)
- ret))
+ (iconv-convert "EUC-JP" "UTF-8" str))
(define (make-query)
(format "/transliterate?langpair=ja-Hira|ja&text=~a~a"
(http:encode-uri-string (fromconv str)) opts))
=======================================
--- /scm/japanese-custom.scm Wed Jan 11 00:17:24 2012
+++ /scm/japanese-custom.scm Tue May 1 02:30:13 2012
@@ -28,6 +28,8 @@
;;; SUCH DAMAGE.
;;;;
+(require "util.scm")
+
(define ja-rk-rule-basic
'(
((("-"). ())("¡¼" "¡¼" "°"))
@@ -408,11 +410,7 @@
((output (cadr item))
(single-output (car output))
(eucjp->utf8 (lambda (str)
- (and-let* ((ic (iconv-open "UTF-8" "EUC-JP"))
- (converted-str (iconv-code-conv ic str)))
- (and ic
- (iconv-release ic))
- converted-str))))
+ (iconv-convert "UTF-8" "EUC-JP" str))))
(or
(and
; ((("k" "a")) ("¤«" "¥«" "¶")) -> "¤«"
=======================================
--- /scm/japanese.scm Wed Jan 11 00:17:24 2012
+++ /scm/japanese.scm Tue May 1 02:30:13 2012
@@ -32,6 +32,7 @@
(require-extension (srfi 1 2))
(require-custom "japanese-custom.scm")
+(require "util.scm")
(define ja-rk-rule-additional
'(
@@ -655,11 +656,8 @@
(or
(<= 0 ucs #xd7ff)
(<= #xe000 ucs #x10ffff)))
- (utf8-str (ucs->utf8-string ucs))
- (ic (iconv-open "EUC-JP" "UTF-8")))
- (let ((eucj-str (iconv-code-conv ic utf8-str)))
- (iconv-release ic)
- eucj-str)))
+ (utf8-str (ucs->utf8-string ucs)))
+ (iconv-convert "EUC-JP" "UTF-8" utf8-str)))
;;; Convert reverse string list to one EUC-JP kanji string
(define (ja-kanji-code-input str-list)
=======================================
--- /scm/predict-google-suggest.scm Sat Jan 22 10:45:59 2011
+++ /scm/predict-google-suggest.scm Tue May 1 02:30:13 2012
@@ -71,13 +71,6 @@
(class-set-method! predict-google-suggest suggest
(lambda (self str)
- (define (iconv-convert to-code from-code from-str)
- (if (equal? to-code from-code)
- from-str
- (and-let* ((ic (iconv-open to-code from-code))
- (to-str (iconv-code-conv ic from-str)))
- (iconv-release ic)
- to-str)))
(define google-suggest-server
(if (predict-google-suggest-use-ssl self)
"encrypted.google.com"
=======================================
--- /scm/util.scm Tue May 1 01:46:53 2012
+++ /scm/util.scm Tue May 1 02:30:13 2012
@@ -201,6 +201,16 @@
(else
(loop (read-char port) (cons c rest)))))))
+(define (iconv-convert to-code from-code from-str)
+ (if (equal? to-code from-code)
+ from-str
+ (or
+ (and-let* ((ic (iconv-open to-code from-code))
+ (to-str (iconv-code-conv ic from-str)))
+ (iconv-release ic)
+ to-str)
+ ;; XXX
+ from-str)))
;; only accepts single-arg functions
;; (define caddr (compose car cdr cdr))
=======================================
--- /scm/yahoo-jp.scm Sun Mar 11 01:53:01 2012
+++ /scm/yahoo-jp.scm Tue May 1 02:30:13 2012
@@ -35,6 +35,7 @@
(require "japanese.scm")
(require "http-client.scm")
(require "generic-predict.scm")
+(require "util.scm")
(require-custom "generic-key-custom.scm")
(require-custom "yahoo-jp-custom.scm")
(require-custom "yahoo-jp-key-custom.scm")
@@ -63,15 +64,9 @@
(define (yahoo-jp-conversion str opts)
(define (fromconv str)
- (let* ((cd (iconv-open "UTF-8" "EUC-JP"))
- (ret (iconv-code-conv cd str)))
- (iconv-release cd)
- ret))
+ (iconv-convert "UTF-8" "EUC-JP" str))
(define (toconv str)
- (let* ((cd (iconv-open "EUC-JP" "UTF-8"))
- (ret (iconv-code-conv cd str)))
- (iconv-release cd)
- ret))
+ (iconv-convert "EUC-JP" "UTF-8"))
(define (make-query appid)
(format "~aconversion?appid=~a&sentence=~a~a"
yahoo-jp-path
