← Back to branch summary

~ubuntu-branches/ubuntu/precise/uim/precise

« back to all changes in this revision

Viewing changes to scm/predict-google-suggest.scm

  • Committer: Package Import Robot
  • Author(s): Ilya Barygin
  • Date: 2011-12-18 16:35:38 UTC
  • mfrom: (1.1.13) (15.1.7 sid)
  • Revision ID: package-import@ubuntu.com-20111218163538-8ktir39z2mjpii8z
Tags: 1:1.7.1-3ubuntu1
https://launchpad.net/bugs/818199
* Merge from Debian testing (LP: #818199).
* Remaining changes:
  - debian/uim-qt.install: Fix plugin path for multiarch location.
* Dropped changes:
  - uim-applet-gnome removal (GNOME 3 applet is available)
  - 19_as-needed_compile_fix.dpatch (accepted into Debian package)
* translations.patch: add several files to POTFILE.in to prevent
  intltool-update failure.

Show diffs side-by-side

added added

removed removed

Lines of Context:
scm/predict-google-suggest.scm
 
1
;;; predict-google-suggest.scm: google suggest prediction module
 
2
;;;
 
3
;;; Copyright (c) 2011- uim Project http://code.google.com/p/uim/
 
4
;;;
 
5
;;; All rights reserved.
 
6
;;;
 
7
;;; Redistribution and use in source and binary forms, with or without
 
8
;;; modification, are permitted provided that the following conditions
 
9
;;; are met:
 
10
;;; 1. Redistributions of source code must retain the above copyright
 
11
;;;    notice, this list of conditions and the following disclaimer.
 
12
;;; 2. Redistributions in binary form must reproduce the above copyright
 
13
;;;    notice, this list of conditions and the following disclaimer in the
 
14
;;;    documentation and/or other materials provided with the distribution.
 
15
;;; 3. Neither the name of authors nor the names of its contributors
 
16
;;;    may be used to endorse or promote products derived from this software
 
17
;;;    without specific prior written permission.
 
18
;;;
 
19
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
 
20
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 
21
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 
22
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
 
23
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 
24
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 
25
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 
26
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 
27
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 
28
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 
29
;;; SUCH DAMAGE.
 
30
;;;;
 
31
 
 
32
(require-extension (srfi 1))
 
33
(require "http-client.scm")
 
34
(require "util.scm")
 
35
(require "wlos.scm")
 
36
 
 
37
(require-dynlib "expat")
 
38
 
 
39
(define-class predict-google-suggest predict
 
40
  '((use-ssl #t)
 
41
    (language 'en)
 
42
    (internal-charset "UTF-8")
 
43
    (limit 5))
 
44
  '(parse
 
45
    suggest
 
46
    search))
 
47
 
 
48
(define google-suggest-charset-alist
 
49
  '((ja . "Shift-JIS")))
 
50
 
 
51
(class-set-method! predict-google-suggest parse
 
52
  (lambda (self xml-str)
 
53
    (let ((parser (xml-parser-create "UTF-8"))
 
54
          (path '())
 
55
          (data '()))
 
56
      (define (elem-start name atts)
 
57
        (if (and (equal? name "suggestion")
 
58
                 (equal? path '("toplevel" "CompleteSuggestion")))
 
59
            (set! data (append data
 
60
                               (map cdr
 
61
                                    (filter (lambda (x) (equal? (car x) "data")) atts)))))
 
62
        (set! path (append path (list name))))
 
63
      (define (elem-end name)
 
64
      (set! path (drop-right path 1)))
 
65
      (if xml-str
 
66
          (begin
 
67
            (xml-element-handler-set! parser elem-start elem-end)
 
68
            (xml-parse parser xml-str 1)
 
69
            data)
 
70
          '()))))
 
71
 
 
72
(class-set-method! predict-google-suggest suggest
 
73
  (lambda (self str)
 
74
    (define (iconv-convert to-code from-code from-str)
 
75
      (if (equal? to-code from-code)
 
76
          from-str
 
77
          (and-let* ((ic (iconv-open to-code from-code))
 
78
                     (to-str (iconv-code-conv ic from-str)))
 
79
                    (iconv-release ic)
 
80
                    to-str)))
 
81
    (define google-suggest-server
 
82
      (if (predict-google-suggest-use-ssl self)
 
83
          "encrypted.google.com"
 
84
          "google.com"))
 
85
    (define lang-query
 
86
      (if (assq (predict-google-suggest-language self)
 
87
                google-suggest-charset-alist)
 
88
          (format "&hl=~a" (symbol->string (predict-google-suggest-language self)))
 
89
          ""))
 
90
    (define (string->lang str)
 
91
      (if (assq (predict-google-suggest-language self)
 
92
                google-suggest-charset-alist)
 
93
          (iconv-convert "UTF-8"
 
94
                         (assq-cdr (predict-google-suggest-language self)
 
95
                                   google-suggest-charset-alist)
 
96
                         str)
 
97
          str))
 
98
    (and-let* ((uri-string (predict->internal-charset self str)))
 
99
      (let* ((proxy (make-http-proxy-from-custom))
 
100
             (ssl (and (predict-google-suggest-use-ssl self)
 
101
                       (make-http-ssl (SSLv3-client-method) 443)))
 
102
             (result (http:get google-suggest-server
 
103
                               (format "/complete/search?output=toolbar&q=~a~a"
 
104
                                       uri-string
 
105
                                       lang-query)
 
106
                               80
 
107
                               proxy
 
108
                               ssl))
 
109
             (parsed (predict-google-suggest-parse self (string->lang result))))
 
110
        (map (lambda (s)
 
111
               (predict->external-charset self s))
 
112
             parsed)))))
 
113
 
 
114
(class-set-method! predict-google-suggest search
 
115
  (lambda (self str)
 
116
    (let* ((suggest (predict-google-suggest-suggest self
 
117
                                                    str))
 
118
           (ret (if (< (predict-google-suggest-limit self) (length suggest))
 
119
                    (take suggest (predict-google-suggest-limit self))
 
120
                    suggest)))
 
121
      (make-predict-result
 
122
       ret
 
123
       ret
 
124
       (map (lambda (x) "") (iota (length ret)))))))
 
125
 
 
126
 
 
127
(define (make-predict-google-suggest-with-custom)
 
128
  (let ((obj (make-predict-google-suggest)))
 
129
    (predict-google-suggest-set-limit! obj predict-custom-google-suggest-candidates-max)
 
130
    (predict-google-suggest-set-language! obj predict-custom-google-suggest-language)
 
131
    (predict-google-suggest-set-use-ssl! obj predict-custom-google-suggest-use-ssl)
 
132
    obj))
 
133