cgit.sxemacs.org Git - slh/blob - google-query.el

   1 ;; google-query.el --- Query Google from within XEmacs.   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2003, 2004 Steve Youngs
   4
   5 ;; Author:        Steve Youngs <sryoungs@bigpond.net.au>
   6 ;; Maintainer:    Steve Youngs <sryoungs@bigpond.net.au>
   7 ;; Created:       <2003-12-16>
   8 ;; Keywords:      web google search query
   9
  10 ;; This file is part of google-query.
  11
  12 ;; Redistribution and use in source and binary forms, with or without
  13 ;; modification, are permitted provided that the following conditions
  14 ;; are met:
  15 ;;
  16 ;; 1. Redistributions of source code must retain the above copyright
  17 ;;    notice, this list of conditions and the following disclaimer.
  18 ;;
  19 ;; 2. Redistributions in binary form must reproduce the above copyright
  20 ;;    notice, this list of conditions and the following disclaimer in the
  21 ;;    documentation and/or other materials provided with the distribution.
  22 ;;
  23 ;; 3. Neither the name of the author nor the names of any contributors
  24 ;;    may be used to endorse or promote products derived from this
  25 ;;    software without specific prior written permission.
  26 ;;
  27 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  28 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  29 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  30 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  31 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  32 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  33 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  34 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  35 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  36 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  37 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  38
  39 ;;; Commentary:
  40 ;;
  41 ;;   I got the idea for this from Erik Arneson's `google-search.el'
  42 ;;   which you can get from <http://erik.arneson.org/google-search.el>
  43 ;;
  44 ;;   There are 2 entry points here, `google-query' and
  45 ;;   `google-query-region'.  The former will prompt for a string to
  46 ;;   query Google for, and the latter will query Google for whatever
  47 ;;   text is in the active region in the current buffer.  Bind these
  48 ;;   functions to some global keys for convenience.
  49 ;;
  50 ;;   Once the query completes XEmacs pops up a buffer containing
  51 ;;   the query results, sans all the cruft an advertising you get
  52 ;;   from Google.  Hitting button2 or RET on a URL will fire up your
  53 ;;   default browser with that URL.
  54
  55 ;;; Todo:
  56 ;;
  57 ;;
  58
  59 ;;; ChangeLog:
  60 ;;
  61 ;;  From this point on, `google-query.el' is in the XEmacs packages
  62 ;;  CVS repository.  For further changes please consult
  63 ;;  ./xemacs-packages/net-utils/ChangeLog.
  64 ;;
  65 ;;  Revision 1.4  2003-12-16 23:15:46+10  steve
  66 ;;  Deactivate the region after sending the query from
  67 ;;  `google-query-region' because processing the results works on
  68 ;;  regions.
  69 ;;
  70 ;;  Revision 1.3  2003-12-16 18:38:10+10  steve
  71 ;;  Rename `google-search-version' to `google-query-version'.
  72 ;;
  73 ;;  Revision 1.2  2003-12-16 18:24:50+10  steve
  74 ;;  Fix a couple of byte-compiler warnings.
  75 ;;
  76 ;;  Revision 1.1  2003-12-16 17:10:03+10  steve
  77 ;;  Initial revision
  78 ;;
  79
  80 ;;; Code:
  81 (defconst google-query-version 2.0
  82   "Version number of google-query.el.")
  83
  84 (defun google-query-version (&optional arg)
  85   "Return the current version info for google-query.
  86
  87 With optional argument ARG, insert version info at point in the current
  88 buffer."
  89   (interactive "P")
  90   (let ((ver google-query-version))
  91     (if (interactive-p)
  92         (if arg
  93             (insert (format "Google Query v%.1f" ver))
  94           (message "Google Query v%.1f" ver))
  95       ver)))
  96
  97 (eval-and-compile
  98   (autoload 'with-electric-help "ehelp")
  99   (autoload 'browse-url "browse-url" nil t))
 100
 101 (defgroup google nil
 102   "Why leave XEmacs just to search Google..."
 103   :prefix "google-"
 104   :group 'hypermedia)
 105
 106 (defcustom google-query-maxlen 1024
 107   "Maximum string length of query string.
 108
 109 This prevents you from accidentally sending a five megabyte query
 110 string to Google.
 111
 112 You can set this reasonably high, all the same.  I think the maximum
 113 length that Google can take is 2048 characters."
 114   :type 'number
 115   :group 'google)
 116
 117 (defcustom google-query-result-count 10
 118   "Max number of results to return from a `google-query'."
 119   :type 'number
 120   :group 'google)
 121
 122 (defcustom google-query-mirror "https://www.google.com"
 123   "*Your favourite Google mirror."
 124   :type 'string
 125   :group 'google)
 126
 127 (defun google-query-commentary ()
 128   "*Display the commentary section of google-query.el."
 129   (interactive)
 130   (with-electric-help
 131    '(lambda ()
 132       (insert
 133        (with-temp-buffer
 134          (erase-buffer)
 135          (insert (lm-commentary (locate-library "google-query.el")))
 136          (goto-char (point-min))
 137          (while (re-search-forward "^;+ ?" nil t)
 138            (replace-match "" nil nil))
 139          (buffer-string (current-buffer)))))
 140    "*Google-query Commentary*"))
 141
 142 (defun google-query-copyright ()
 143   "*Display the copyright notice for google-query."
 144   (interactive)
 145   (with-electric-help
 146    '(lambda ()
 147       (insert
 148        (with-temp-buffer
 149          (erase-buffer)
 150          (insert-file-contents (locate-library "google-query.el"))
 151          (goto-char (point-min))
 152          (re-search-forward ";;; Commentary" nil t)
 153          (beginning-of-line)
 154          (narrow-to-region (point-min) (point))
 155          (while (re-search-backward "^;+ ?" nil t)
 156            (replace-match "" nil nil))
 157          (buffer-string (current-buffer)))))
 158    "*Google-query Copyright Notice*"))
 159
 160 ;; Unashamedly stolen from Bill Perry's URL package.
 161 (defconst google-query-unreserved-chars
 162   '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
 163        ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
 164        ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
 165        ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
 166   "A list of characters that are _NOT_ reserved in the URL spec.
 167 This is taken from RFC 2396.")
 168
 169 ;; Unashamedly stolen from Bill Perry's URL package.
 170 (defun google-query-hexify-string (str)
 171   "Escape characters STR so STR can be used in a URL."
 172   (mapconcat
 173    (lambda (char)
 174      ;; Fixme: use a char table instead.
 175      (if (not (memq char google-query-unreserved-chars))
 176          (if (< char 16)
 177              (format "%%0%X" char)
 178            (if (> char 255)
 179                (error "Hexifying multibyte character %s" str))
 180            (format "%%%X" char))
 181        (char-to-string char)))
 182    str ""))
 183
 184 ;;;###autoload
 185 (defun google-query (string)
 186   "Query google for STRING."
 187   (interactive "sQuery Google for: ")
 188   (let* ((host google-query-mirror)
 189          (str (google-query-hexify-string
 190                (truncate-string-to-width string google-query-maxlen)))
 191          (query (concat "/search?&q=" str
 192                         "&num=" (format "%d" google-query-result-count))))
 193     (browse-url (concat host query))))
 194
 195 ;;;###autoload
 196 (defun google-query-region (beg end)
 197   "Query google for the string BEG END."
 198   (interactive "r")
 199   (let ((str (buffer-substring-no-properties beg end)))
 200     (zmacs-deactivate-region)
 201     (google-query str)))
 202
 203 (provide 'google-query)
 204 ;;; google-query.el ends here