[Erbot-cvs] erbot erbc.el contrib/google.el

[Vivek Dasmohapatra]

CVSROOT:        /sources/erbot
Module name:    erbot
Changes by:     Vivek Dasmohapatra <fledermaus> 12/06/19 13:14:06

Modified files:
        .              : erbc.el 
        contrib        : google.el 

Log message:
        Move to AJAX google search API from deprecated SOAP service

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/erbot/erbc.el?cvsroot=erbot&r1=1.131&r2=1.132
http://cvs.savannah.gnu.org/viewcvs/erbot/contrib/google.el?cvsroot=erbot&r1=1.2&r2=1.3

Patches:
Index: erbc.el
===================================================================
RCS file: /sources/erbot/erbot/erbc.el,v
retrieving revision 1.131
retrieving revision 1.132
diff -u -b -r1.131 -r1.132
--- erbc.el     26 Sep 2009 21:26:39 -0000      1.131
+++ erbc.el     19 Jun 2012 13:14:04 -0000      1.132
@@ -2116,6 +2116,16 @@
                             (> N 0)))
             )
 
+       (ignore-errors
+         (when (eq 1 (length result))
+           ;;(message "result: %d %S" (length result) result)
+           (when (string-match 
+                  "\\<\\(http://\\(?:www\\.\\)emacswiki.org/\\S-+\\)" 
+                  (car result))
+             ;;(message "result: wiki regexp matched [%s]" (car result))
+             (setq result (list (car result)
+                                (summarise-emacswiki 
+                                 (match-string 1 (car result))) )) )))
 
        (cond
         ;; in cond0
@@ -3238,7 +3248,9 @@
 (defun fsi-apropos-function (&optional regexp n m &rest ignored)
   (fs-apropos-basic 'erbn-apropos-function regexp n m ))
 (defun fsi-apropos-value (&optional regexp n m &rest ignored)
-  (fs-apropos-basic 'apropos-value regexp n m ))
+  ;;(fs-apropos-basic 'apropos-value regexp n m )
+  "This function has been disabled as it is too resource-intensive.")
+
 (defun fsi-apropos-documentation (&optional regexp n m &rest ignored)
   (fs-apropos-basic 'erbn-apropos-documentation  regexp n m ))
 
@@ -3509,6 +3521,8 @@
     (with-timeout
         (fs-internal-google-time
          (list concatted (list "google---TimedOut")))
+      (message "(google-search %S %S %S)"
+              concatted 0 "web")
       (let ((results
              ;; this ignore-errors is very important.
              ;; since the google stuff currently gives weird errors
@@ -3522,7 +3536,6 @@
 
 (defvar fs-internal-google-redirect-p nil)
 
-
 (defun fsi-googlen (n &rest args)
   "Format the first n results in a nice format. "
   (let* ((rawres (apply 'fs-google-raw args))
@@ -3586,7 +3599,7 @@
 
 (defun fsi-google-emacswiki(&rest args)
   "Google on the emacswiki site."
-  (fs-google-with-options "site:emacswiki.org" args))
+  (fs-google-with-options "2" (cons "site:emacswiki.org" args)))
 
 (defun fsi-google-sl4 (&rest args)
   "Google on the sl4 site."
@@ -3618,11 +3631,11 @@
 
 (defun fs-google-imdb (&rest args)
   "Google on IMDB"
-  (fs-google-with-options "site:imdb.com" "1" args))
+  (fs-google-with-options "2" (cons "imdb title" args)))
 
 (defun fs-google-gnufans-org (&rest args)
   "Google on gnufans.org"
-  (fs-google-with-options "site:gnufans.org" args))
+  (fs-google-with-options "2" (cons "site:gnufans.org" args)))
 
 (defun fs-google-hurdwiki(&rest args)
   "Google on the emacswiki site."

Index: contrib/google.el
===================================================================
RCS file: /sources/erbot/erbot/contrib/google.el,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- contrib/google.el   30 Sep 2009 22:23:04 -0000      1.2
+++ contrib/google.el   19 Jun 2012 13:14:06 -0000      1.3
@@ -1,27 +1,13 @@
-;;; Debugging info for self: Saved through ges-version 1.5dev
-;;; ;;; From: Edward O'Connor <address@hidden>
-;;; ;;; Subject: google.el
-;;; ;;; Newsgroups: gnu.emacs.sources
-;;; ;;; Date: Sat, 14 Sep 2002 10:37:56 GMT
-;;; ;;; Organization: RoadRunner - West
-
-;;; > google.el --- Emacs interface to the Google API
-
-;;; Virtually unchanged; just fixed a remarkably embarassing bug.
-
-;;; 
-
 ;;; google.el --- Emacs interface to the Google API
 
-;; Copyright (C) 2002  Edward O'Connor <address@hidden>
+;; Copyright (C) 2002, 2008  Edward O'Connor <address@hidden>
 
 ;; Author: Edward O'Connor <address@hidden>
 ;; Keywords: comm, processes, tools
-;; Version: 0.1
 
 ;; This file is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; This file is distributed in the hope that it will be useful,
@@ -36,236 +22,154 @@
 
 ;;; Commentary:
 
+;; You should always be able to find the latest version here:
+
+;;           <URL:http://github.com/hober/google-el/>
+
 ;; A really bare-bones first hack at Google API support for Emacs.
 ;; Note that you need a Google license key to use this; you can
 ;; get one by following the instructions here:
 
-;;                <URL:http://www.google.com/apis/>
+;;      <URL:http://code.google.com/apis/ajaxsearch/signup.html>
 
 ;; Usage:
 
 ;; (require 'google)
-;; (setq google-license-key "my license key")
-;; Then M-x google-search RET
-;; or M-x google-search-region RET
-
-;; To use this in a program, see the functions `google-search' and
-;; `google-display-response' for example usage.
+;; (setq google-license-key "my license key" ; optional
+;;       google-referer "my url")            ; required!
+;; (google-search-video "rickroll")
+
+;;; History:
+;; 2002 or thereabouts: Initial version, which used the SOAP API.
+;; 2008-04-24: Use the AJAX Search API instead of the SOAP API.
+;;             N.B., incompatible API changes galore!
+;; 2008-05-01: Some convenience functions for parsing search result
+;;             blobs. Passes checkdoc now.
 
 ;;; Code:
 
-(require 'soap)
-(require 'xml)
+(require 'json)
+(require 'url)
+
+(defvar url-http-end-of-headers)
 
 (defgroup google nil
-  ""
+  "Emacs interface to Google's AJAX Search API."
   :group 'tools)
 
 (defcustom google-license-key nil
-  "*Your Google license key."
+  "*Your Google license key.
+This is optional. However, if you do specify it, it should correspond to
+your `google-referer'."
   :type '(string)
   :group 'google)
 
-(defcustom google-search-result-callback nil
-  "*The function to be called with the search result."
-  :type '(function)
-  :group 'google)
-
-(defcustom google-start 0
-  "*Which result to start with."
-  :type 'integer
-  :group 'google)
-
-(defcustom google-max-results 10
-  "*Maximum number of results to return."
-  :type 'integer
-  :group 'google)
-
-(defcustom google-filter-p t
-  "*Whether or not to filter results."
-  :type 'boolean
-  :group 'google)
-
-(defcustom google-safe-p nil
-  "*Safe or not?"
-  :type 'boolean
-  :group 'google)
-
-(defcustom google-linkify-links-p t
-  "*Whether or not we should linkify links in the response buffer."
-  :type 'boolean
+(defcustom google-referer nil
+  "*The referer to send when performing Google searches.
+Note that this is required by Google's terms of service."
+  :type '(string)
   :group 'google)
 
-(defun google-xml-sexp-attr-to-xml (attr-cons)
-  (let ((attr-name (car attr-cons))
-        (attr-val (cdr attr-cons)))
-    (unless (stringp attr-val)
-      (setq attr-val (format "%s" attr-val)))
-    (concat (format " %s=" attr-name)
-            (if (string-match "[\"]" attr-val)
-                (format "'%s'" attr-val)
-              (format "\"%s\"" attr-val)))))
-
-(defun google-xml-sexp-to-xml (xml-sexp)
-  "Return a string containing an XML representation of XML-SEXP."
-  (cond ((null xml-sexp)
-         "")
-        ((stringp xml-sexp)
-         xml-sexp)
-        ((listp xml-sexp)
-         (let ((tag (xml-node-name xml-sexp))
-               (attrs (xml-node-attributes xml-sexp))
-               (children (xml-node-children xml-sexp)))
-           (concat (format "<%s" tag)
-                   (if attrs
-                       (mapconcat 'google-xml-sexp-attr-to-xml
-                                  attrs
-                                  "")
-                     "")
-                   (if children
-                       (concat ">"
-                               (mapconcat 'google-xml-sexp-to-xml
-                                          children
-                                          "")
-                               (format "</%s>" tag))
-                     "/>"))))
-
-        (t (google-xml-sexp-to-xml (format "%s" xml-sexp)))))
-
-(defun google-request (xml-sexp)
-  "Send XML-SEXP to Google as a request."
-  (soap-request "http://api.google.com/search/beta2";
-                (google-xml-sexp-to-xml xml-sexp)))
-
-(defun google-search-internal (terms start max-results filter-p safe-p)
-  "Search for TERMS."
-  (google-request
-   `(SOAP-ENV:Envelope ((xmlns:SOAP-ENV
-                         . "http://schemas.xmlsoap.org/soap/envelope/";)
-                        (xmlns:xsi
-                         . "http://www.w3.org/1999/XMLSchema-instance";)
-                        (xmlns:xsd . "http://www.w3.org/1999/XMLSchema";))
-      (SOAP-ENV:Body ()
-        (ns1:doGoogleSearch ((xmlns:ns1 . "urn:GoogleSearch")
-                             (SOAP-ENV:encodingStyle .
-                              "http://schemas.xmlsoap.org/soap/encoding/";))
-          (key ((xsi:type . "xsd:string"))
-            ,google-license-key)
-          (q ((xsi:type . "xsd:string"))
-            ,terms)
-          (start ((xsi:type . "xsd:int"))
-            ,(format "%d" start))
-          (maxResults ((xsi:type . "xsd:int"))
-            ,(format "%d" max-results))
-          (filter ((xsi:type . "xsd:boolean"))
-            ,(if filter-p "true" "false"))
-          (restrict ((xsi:type . "xsd:string")))
-          (safeSearch ((xsi:type . "xsd:boolean"))
-            ,(if safe-p "true" "false"))
-          (lr ((xsi:type . "xsd:string")))
-          (ie ((xsi:type . "xsd:string"))
-            "latin1")
-          (oe ((xsi:type . "xsd:string"))
-            "latin1"))))))
-
-(defvar google-result-mode-map (make-sparse-keymap)
-  "Map to be used in `google-result-mode'.")
-
-(define-key google-result-mode-map "q" 'google-result-quit)
-
-(defun google-result-quit ()
-  (interactive)
-  (kill-buffer (get-buffer-create "*google-response*")))
-
-(defun google-result-mode ()
-  (kill-all-local-variables)
-  (setq major-mode 'google-result-mode
-        mode-name "Google Result")
-  (set (make-local-variable 'font-lock-defaults)
-       '(message-font-lock-keywords t))
-  (use-local-map google-result-mode-map))
-
-(defun google-display-response (processed-response)
-  (with-current-buffer (get-buffer-create "*google-response*")
-    (delete-region (point-min)
-                   (point-max))
-    (google-result-mode)
-    (insert (format "Google search results for %S\n" (car processed-response))
-            "-------------------------------------------------\n\n")
-    (setq processed-response (cdr processed-response))
-    (while processed-response
-      (let* ((item (car processed-response))
-             (url (nth 0 item))
-             (title (nth 1 item))
-             (hostname (nth 2 item))
-             (cached-size (nth 3 item))
-             (snippet (nth 4 item)))
-
-        (when title
-          (insert (format "Title: %s\n" title)))
-
-        (when url
-          (insert (format "URL: %s\n" url)))
-
-        (when hostname
-          (insert (format "Hostname: %s\n" hostname)))
-
-        (when cached-size
-          (insert (format "Size: %s\n" cached-size)))
-
-        (when snippet
-          (insert (format "Snippet: %s\n" snippet)))
-
-        (insert "\n"))
-
-      (setq processed-response (cdr processed-response)))
-    (when google-linkify-links-p
-      (goto-address))
-    (switch-to-buffer (current-buffer))))
-
-(defun google-process-response (response)
-  (let* ((body (car (xml-get-children (car response) 'SOAP-ENV:Body)))
-         (g-s-r (car (xml-get-children body 'ns1:doGoogleSearchResponse)))
-         (return (car (xml-get-children g-s-r 'return)))
-         (search-query (nth 2 (car (xml-get-children return 'searchQuery))))
-         (r-e (car (xml-get-children return 'resultElements)))
-         (items (xml-get-children r-e 'item))
-         (retval '()))
-
-    (while items
-      (let* ((item (car items))
-             (hostname (nth 2 (car (xml-get-children item 'hostName))))
-             (url (nth 2 (car (xml-get-children item 'URL))))
-             (title (nth 2 (car (xml-get-children item 'title))))
-             (snippet (nth 2 (car (xml-get-children item 'snippet))))
-             (cached-size (nth 2 (car (xml-get-children item 'cachedSize))))
-             (retval-item '()))
-
-        (add-to-list 'retval-item url t)
-        (add-to-list 'retval-item title t)
-        (add-to-list 'retval-item hostname t)
-        (add-to-list 'retval-item cached-size t)
-        (add-to-list 'retval-item snippet t)
-
-        (add-to-list 'retval retval-item)
-
-        (setq items (cdr items))))
-
-    (cons search-query retval)))
-
-(defun google-search (terms)
-  "Search for TERMS."
-  (interactive "sGoogle search: ")
-  (google-display-response
-   (google-process-response
-    (google-search-internal terms google-start google-max-results
-                            google-filter-p google-safe-p))))
-
-(defun google-search-region (beg end)
-  "Perform a Google search on the words from BEG to END."
-  (interactive "r")
-  (google-search (buffer-substring-no-properties beg end)))
+(defun google-response (buf)
+  "Extract the JSON response from BUF."
+  (with-current-buffer buf
+    (goto-char url-http-end-of-headers)
+    (prog1 (json-read)
+      (kill-buffer buf))))
+
+(defun google-search (terms &optional start search-domain)
+  "Search for TERMS.
+START, if non-null, is the search result number to start at.
+SEARCH-DOMAIN can be one of \"web\", \"local\", \"video\",
+\"blogs\", \"news\", \"books\", or \"images\"."
+  (let ((url-package-name "google.el")
+        (url-request-extra-headers
+         `(("Accept" . "application/json")
+           ("Referer" . ,google-referer)))
+        (args `(("q" . ,terms)
+                ("v" . "1.0"))))
+    (unless search-domain
+      (setq search-domain "web"))
+    (when google-license-key
+      (add-to-list 'args (cons "key" google-license-key)))
+    (when start
+      (add-to-list 'args (cons "start" start)))
+    (google-response
+     (url-retrieve-synchronously
+      (format
+       "http://ajax.googleapis.com/ajax/services/search/%s?%s";
+       search-domain
+       (mapconcat (lambda (cons)
+                    (format "%s=%s"
+                            (url-hexify-string (car cons))
+                            (url-hexify-string (cdr cons))))
+                  args
+                  "&"))))))
+
+(defmacro define-google-search-domain (domain)
+  "Define a google search function for DOMAIN, a keyword."
+  (setq domain (substring (symbol-name domain) 1))
+  (let ((func (intern (concat "google-search-" domain))))
+    `(defun ,func (terms &optional start)
+       ,(format "Search %s with Google!
+
+Results look like so:
+
+\((responseStatus . N)
+ (responseDetails)
+ (responseData
+  (cursor
+   (moreResultsUrl . URL)
+   (currentPageIndex . N)
+   (estimatedResultCount . N)
+   (pages .
+          [((label . N)
+            (start . N))
+           ..]))
+  (results .
+           [((content . STR)
+             (titleNoFormatting . STR)
+             (title . STR)
+             (cacheUrl . URL)
+             (visibleUrl . URL)
+             (url . URL)
+             (unescapedUrl . URL)
+             (GsearchResultClass . STR))
+            ..])))
+
+There are several utilities for extracting data from this structure; see
+`google-result-field', `google-result-urls', and
+`google-result-more-results-url'."
+                (if (string= domain "web") "the web" domain))
+       (google-search terms start ,domain))))
+
+(define-google-search-domain :web)
+(define-google-search-domain :local)
+(define-google-search-domain :video)
+(define-google-search-domain :blogs)
+(define-google-search-domain :news)
+(define-google-search-domain :books)
+(define-google-search-domain :images)
+
+;;; Parsing google search results
+
+(defsubst google-result-field (key json)
+  "Fetch KEY's value from JSON, a parsed JSON structure."
+  (cdr (assoc key json)))
+
+(defun google-result-urls (results)
+  "Extract a list of search result URLs from RESULTS."
+  (let* ((responseData (google-result-field 'responseData results))
+         (records (google-result-field 'results responseData)))
+    (mapcar (lambda (record)
+              (google-result-field 'url record))
+            records)))
+
+(defun google-result-more-results-url (results)
+  "Extract the URL for more search RESULTS."
+  (let* ((responseData (google-result-field 'responseData results))
+         (cursor (google-result-field 'cursor responseData)))
+    (google-result-field 'moreResultsUrl cursor)))
 
 (provide 'google)
 ;;; google.el ends here
-