* configure.ac: Generate lisp/riece-package-info.el.
[riece] / lisp / riece-google.el
1 ;;; riece-google.el --- search keywords by Google
2 ;; Copyright (C) 2005 OHASHI Akira
3
4 ;; Author: OHASHI Akira <bg66@koka-in.org>
5 ;;         SASADA Koichi <ko1 at atdot.net>
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Commentary:
26
27 ;; NOTE: This is an add-on module for Riece.
28
29 ;; Ruby code was stolen (and modified) from nadoka.
30
31 ;;; Code:
32
33 (require 'riece-message)
34
35 (defgroup riece-google nil
36   "Search keywords by Google."
37   :prefix "riece-"
38   :group 'riece)
39
40 (defcustom riece-google-ruby-command "ruby"
41   "Command name for Ruby interpreter."
42   :type 'string
43   :group 'riece-google)
44
45 (defcustom riece-google-program
46   '("\
47 # Copyright (c) 2004 SASADA Koichi <ko1 at atdot.net>
48 #
49 # This program is free software with ABSOLUTELY NO WARRANTY.
50 # You can re-distribute and/or modify this program under
51 # the same terms of the Ruby's lisence.
52
53 require 'soap/wsdlDriver'
54 require 'iconv'
55 require 'kconv'
56 require 'cgi'
57
58 keywords            = '" keywords "'
59 max_results         = " max-results "
60 license_key         = '" license-key "'
61 default_lang        = '" lang "'
62 google_wsdl         = 'http://api.google.com/GoogleSearch.wsdl'
63 google              = SOAP::WSDLDriverFactory.new(google_wsdl).create_driver
64
65 def erace_tag str
66   CGI.unescapeHTML(str.gsub(/\\<.+?\\>/, ''))
67 end
68
69 def lang_check lang
70   if lang.empty? || /^lang_/ =~ lang
71     lang
72   else
73     'lang_' + lang
74   end
75 end
76
77 def show_char_code_and_erace_tag str
78   case $KCODE
79   when 'EUC', 'SJIS'
80     CGI.unescapeHTML(str.gsub(/\\<.+?\\>/, '')).tojis
81   when 'NONE', 'UTF-8'
82     begin
83       str = Iconv.conv(\"EUC-JP\", \"UTF-8\", str)
84       CGI.unescapeHTML(str.gsub(/\\<.+?\\>/, '')).tojis
85     rescue => e
86       \"(char code problem: #{e.class}[#{e.message.dump}])\"
87     end
88   else
89     str
90   end
91 end
92
93 def search_char_code str
94   case $KCODE
95   when 'EUC', 'SJIS'
96     str.toeuc
97   when 'NONE'
98     begin
99       Iconv.conv(\"UTF-8\", \"EUC-JP\", str.toeuc)
100     rescue => e
101       \"(char code problem: #{e.class})\"
102     end
103   when 'UTF-8'
104     str
105   else
106     raise
107   end
108 end
109
110 begin
111   lang = lang_check(default_lang)
112   word = search_char_code(keywords)
113   result = google.doGoogleSearch(
114     license_key, word, 0, max_results, false, \"\",
115     false, lang, 'utf-8', 'utf-8'
116   )
117
118   count = result.estimatedTotalResultsCount
119   if count > 0
120     word = show_char_code_and_erace_tag(keywords)
121     count = count.to_s.gsub(/(\\d)(?=\\d{3}+$)/, '\\\\1,')
122     time = result.searchTime.to_s
123     print \"Search results for #{word} (Hits: #{count}: Time: #{time}):\\n\"
124
125     result.resultElements.each_with_index{|e, i|
126       title = show_char_code_and_erace_tag(e.title)
127       url   = e.URL
128       print \"#{title} - #{url}\\n\"
129     }
130   else
131     print \"no match\\n\"
132   end
133
134 rescue Exception => e
135   print \"#{e.class}(#{e.message})\"
136 end
137 ")
138   "Ruby program for searching by Google."
139   :type 'list
140   :group 'riece-google)
141
142 (defcustom riece-google-license-key nil
143   "*License key for Google API."
144   :type 'string
145   :group 'riece-google)
146
147 (defcustom riece-google-default-lang '("lang_en" "lang_ja")
148   "*Default language for searching keywords."
149   :type '(repeat (choice (const "lang_en" :tag "English")
150                          (const "lang_ja" :tag "Japanese")
151                          (string :tag "The other language")))
152   :group 'riece-google)
153
154 (defconst riece-google-regexp
155   "^go\\(o+\\)gle\\(:\\([a-z]+\\)\\)?>\\s-*\\(.*\\)")
156
157 (defconst riece-google-description
158   "Search keywords by Google.")
159
160 (defvar riece-google-target nil)
161
162 (defun riece-google-display-message-function (message)
163   (when (and (get 'riece-google 'riece-addon-enabled)
164              (stringp riece-google-license-key)
165              (string-match riece-google-regexp (riece-message-text message)))
166     (let ((keywords (match-string 4 (riece-message-text message)))
167           (max-results (number-to-string
168                         (length
169                          (match-string 1 (riece-message-text message)))))
170           (lang (or (match-string 3 (riece-message-text message))
171                     riece-google-default-lang))
172           (process-connection-type nil)
173           selective-display
174           (coding-system-for-read 'binary)
175           (coding-system-for-write 'binary)
176           (process (start-process "Google" (generate-new-buffer " *Google*")
177                                   riece-google-ruby-command)))
178       (when (listp lang)
179         (setq lang (mapconcat #'identity lang " ")))
180       (setq riece-google-target (riece-message-target message))
181       (process-send-string process
182                            (apply #'concat
183                                   (riece-google-substitute-variables
184                                    (riece-google-substitute-variables
185                                     (riece-google-substitute-variables
186                                      (riece-google-substitute-variables
187                                       riece-google-program
188                                       'keywords keywords)
189                                      'max-results max-results)
190                                      'license-key riece-google-license-key)
191                                    'lang lang)))
192       (process-send-eof process)
193       (with-current-buffer (process-buffer process)
194         (set-buffer-multibyte t)
195         (erase-buffer)
196       (set-buffer-modified-p nil))
197       (set-process-filter process #'riece-google-filter)
198       (set-process-sentinel process #'riece-google-sentinel))))
199
200 (defun riece-google-filter (process output)
201   (when (buffer-live-p (process-buffer process))
202     (with-current-buffer (process-buffer process)
203       (goto-char (point-max))
204       (insert output)
205       (goto-char (point-min))
206       (while (progn (end-of-line) (and (not (eobp)) (eq (char-after) ?\n)))
207         (if (eq (char-after (1- (point))) ?\r) ; cut off preceding LF
208             (delete-region (1- (point)) (point)))
209         (riece-google-send-string riece-google-target
210                                   (buffer-substring (point-min) (point)))
211         (delete-region (point-min) (progn (beginning-of-line 2) (point)))))))
212
213 (defun riece-google-sentinel (process string)
214   (delete-process process))
215
216 (defun riece-google-send-string (target message)
217   (riece-send-string
218    (format "NOTICE %s :%s\r\n" (riece-identity-prefix target) message))
219   (riece-display-message
220    (riece-make-message (riece-current-nickname) target message 'notice)))
221
222 (defun riece-google-substitute-variables (program variable value)
223   (setq program (copy-sequence program))
224   (let ((pointer program))
225     (while pointer
226       (setq pointer (memq variable program))
227       (if pointer
228           (setcar pointer value)))
229     program))
230
231 (defun riece-google-insinuate ()
232   (add-hook 'riece-after-display-message-functions
233             'riece-google-display-message-function))
234
235 (defun riece-google-uninstall ()
236   (remove-hook 'riece-after-display-message-functions
237                'riece-google-display-message-function))
238
239 (provide 'riece-google)
240
241 ;;; riece-google.el ends here