Revision: 6925
Author: [email protected]
Date: Sat Jan 22 10:13:48 2011
Log: * scm/predict-google-suggest.scm: New file.
* scm/generic-predict.scm (try-load, predict-make-meta-search):
- Add google suggest.
* scm/predict-custom.scm (predict-google-suggest)
(predict-custom-google-suggest-candidates-max)
(predict-custom-google-suggest-language)
(predict-custom-google-suggest-use-ssl):
- Ditto.
* scm/Makefile.am (SCM_FILES):
- Ditto.
http://code.google.com/p/uim/source/detail?r=6925
Added:
/trunk/scm/predict-google-suggest.scm
Modified:
/trunk/scm/Makefile.am
/trunk/scm/generic-predict.scm
/trunk/scm/predict-custom.scm
=======================================
--- /dev/null
+++ /trunk/scm/predict-google-suggest.scm Sat Jan 22 10:13:48 2011
@@ -0,0 +1,123 @@
+;; Copyright (c) Iwata <[email protected]>
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included
+;; in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+(require-extension (srfi 1))
+(require "http-client.scm")
+(require "util.scm")
+(require "wlos.scm")
+
+(require-dynlib "expat")
+
+(define-class predict-google-suggest predict
+ '((use-ssl #t)
+ (language 'en)
+ (internal-charset "UTF-8")
+ (limit 5))
+ '(parse
+ suggest
+ search))
+
+(define google-suggest-charset-alist
+ '((ja . "Shift-JIS")))
+
+(class-set-method! predict-google-suggest parse
+ (lambda (self xml-str)
+ (let ((parser (xml-parser-create "UTF-8"))
+ (path '())
+ (data '()))
+ (define (elem-start name atts)
+ (if (and (equal? name "suggestion")
+ (equal? path '("toplevel" "CompleteSuggestion")))
+ (set! data (append data
+ (map cdr
+ (filter (lambda (x) (equal? (car
x) "data")) atts)))))
+ (set! path (append path (list name))))
+ (define (elem-end name)
+ (set! path (drop-right path 1)))
+ (if xml-str
+ (begin
+ (xml-element-handler-set! parser elem-start elem-end)
+ (xml-parse parser xml-str 1)
+ data)
+ '()))))
+
+(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"
+ "google.com"))
+ (define (make-lang-query)
+ (if (assq (predict-google-suggest-language self)
+ google-suggest-charset-alist)
+ (format "&hl=~a" (symbol->string
(predict-google-suggest-language self)))
+ ""))
+ (define (string->lang str)
+ (if (assq (predict-google-suggest-language self)
+ google-suggest-charset-alist)
+ (iconv-convert "UTF-8"
+ (assq-cdr (predict-google-suggest-language self)
+ google-suggest-charset-alist)
+ str)
+ str))
+ (and-let* ((uri-string (predict->internal-charset self str)))
+ (let* ((proxy (make-http-proxy-from-custom))
+ (ssl (and (predict-google-suggest-use-ssl self)
+ (make-http-ssl (SSLv3-client-method) 443)))
+ (result (http:get google-suggest-server
+
(format "/complete/search?output=toolbar&q=~a~a"
+ uri-string
+ (make-lang-query))
+ 80
+ proxy
+ ssl))
+ (parsed (predict-google-suggest-parse self (string->lang
result))))
+ (map (lambda (s)
+ (predict->external-charset self s))
+ parsed)))))
+
+(class-set-method! predict-google-suggest search
+ (lambda (self str)
+ (let* ((suggest (predict-google-suggest-suggest self
+ str))
+ (ret (if (< (predict-google-suggest-limit self) (length
suggest))
+ (take suggest (predict-google-suggest-limit self))
+ suggest)))
+ (make-predict-result
+ ret
+ ret
+ (map (lambda (x) "") (iota (length ret)))))))
+
+
+(define (make-predict-google-suggest-with-custom)
+ (let ((obj (make-predict-google-suggest)))
+ (predict-google-suggest-set-limit! obj
predict-custom-google-suggest-candidates-max)
+ (predict-google-suggest-set-language! obj
predict-custom-google-suggest-language)
+ (predict-google-suggest-set-use-ssl! obj
predict-custom-google-suggest-use-ssl)
+ obj))
+
=======================================
--- /trunk/scm/Makefile.am Mon Dec 27 02:43:58 2010
+++ /trunk/scm/Makefile.am Sat Jan 22 10:13:48 2011
@@ -18,6 +18,7 @@
generic.scm generic-custom.scm generic-key-custom.scm \
generic-predict.scm predict-custom.scm \
predict-look.scm predict-look-skk.scm predict-sqlite3.scm \
+ predict-google-suggest.scm \
pyload.scm py.scm pyunihan.scm pinyin-big5.scm \
xmload.scm \
japanese.scm japanese-azik.scm japanese-kana.scm \
=======================================
--- /trunk/scm/generic-predict.scm Thu Jan 6 18:09:56 2011
+++ /trunk/scm/generic-predict.scm Sat Jan 22 10:13:48 2011
@@ -99,13 +99,12 @@
(for-each try-load
'("predict-look.scm"
"predict-look-skk.scm"
- "predict-sqlite3.scm"))
+ "predict-sqlite3.scm"
+ "predict-google-suggest.scm"))
;;
;; uim-custom specific settings
;;
-
-
(define-macro (make-predict-make-meta-search methods)
`(if predict-custom-enable?
(map-in-order (lambda (m)
@@ -122,7 +121,7 @@
(define (predict-make-meta-search)
(map-in-order (lambda (m)
(eval (list m) (interaction-environment)))
- (make-predict-make-meta-search '(look look-skk sqlite3))))
+ (make-predict-make-meta-search '(look look-skk sqlite3
google-suggest))))
(define (predict-meta-open methods im-name)
(for-each (lambda (obj)
=======================================
--- /trunk/scm/predict-custom.scm Thu Jan 6 18:09:56 2011
+++ /trunk/scm/predict-custom.scm Sat Jan 22 10:13:48 2011
@@ -56,7 +56,10 @@
(N_ "Look-SKK prediction"))
(list 'sqlite3
(N_ "Sqlite3")
- (N_ "Sqlite3 prediction")))
+ (N_ "Sqlite3 prediction"))
+ (list 'google-suggest
+ (N_ "Google Suggest")
+ (N_ "Google Suggest prediction")))
(N_ "Prediction methods")
(N_ "long description will be here."))
@@ -155,3 +158,38 @@
(find (lambda (item)
(eq? 'sqlite3 item))
predict-custom-methods))))
+
+;;
+;; predict-google-suggest
+;;
+(define-custom-group 'predict-google-suggest
+ (N_ "Google suggest prediction")
+ (N_ "long description will be here."))
+
+(define-custom 'predict-custom-google-suggest-candidates-max 5
+ '(predict predict-google-suggest)
+ '(integer 1 99)
+ (N_ "Max words of candidates for google suggest")
+ (N_ "long description will be here"))
+
+(custom-add-hook 'predict-custom-google-suggest-candidates-max
+ 'custom-activity-hooks
+ (lambda ()
+ (and predict-custom-enable?
+ (find (lambda (item)
+ (eq? 'google-suggest item))
+ predict-custom-methods))))
+
+(define-custom 'predict-custom-google-suggest-language 'en
+ '(predict predict-google-suggest)
+ (list 'choice
+ (list 'en (N_ "English") (N_ "English"))
+ (list 'ja (N_ "Japanese") (N_ "Japanese")))
+ (N_ "Language")
+ (N_ "long description will be here."))
+
+(define-custom 'predict-custom-google-suggest-use-ssl #t
+ '(predict predict-google-suggest)
+ '(boolean)
+ (N_ "Enable SSL with Google Suggest")
+ (N_ "long description will be here."))
