Source

net-utils / google-query.el

Diff from to

google-query.el

 ;; google-query.el --- Query Google from within XEmacs.   -*- Emacs-Lisp -*-
 
-;; Copyright (C) 2003 Steve Youngs
+;; Copyright (C) 2003, 2004 Steve Youngs
 
 ;; RCS: $Id$
 ;; Author:        Steve Youngs <sryoungs@bigpond.net.au>
 ;; Maintainer:    Steve Youngs <sryoungs@bigpond.net.au>
 ;; Created:       <2003-12-16>
-;; Last-Modified: <2004-01-05 09:45:21 (steve)>
-;; Homepage:      None
+;; Last-Modified: <2004-01-07 11:45:33 (steve)>
 ;; Keywords:      web google search query
 
 ;; This file is part of google-query.
 
 ;;; Todo:
 ;;
-;;   o Make the number of results returned customisable.
+;;   
 
 ;;; ChangeLog:
 ;;
       ver)))
 
 (eval-and-compile
-  (autoload 'url-hexify-string "url-util")
   (autoload 'with-electric-help "ehelp")
   (require 'browse-url))
 
   :type 'number
   :group 'google)
 
+(defcustom google-query-result-count 10
+  "Max number of results to return from a `google-query'."
+  :type 'number
+  :group 'google)
+
 (defcustom google-query-mirror "www.google.com"
   "*Your favourite Google mirror.
 
 	 (buffer-string (current-buffer)))))
    "*Google-query Copyright Notice*"))
 
-;; A bit of eye candy.  Kudos to Zappo for this.
-(eval-and-compile
-  (condition-case nil
-      (require 'working)
-    (error
-     (progn
-       (let (msg ref1)
-	 (unless (fboundp 'working-status-forms)
-	   (defmacro working-status-forms (message donestr &rest forms)
-	     "Contain a block of code during which a working status is shown."
-	     (list 'let (list (list 'msg message) (list 'dstr donestr)
-			      '(ref1 0))
-		   (cons 'progn forms))))
-	 (unless (fboundp 'working-dynamic-status)
-	   (defun working-dynamic-status (&optional number &rest args)
-	     "Called within the macro `working-status-forms', show the status."
-	     (message "%s%s" (apply 'format msg args)
-		      (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% ref1 4))))
-	     (setq ref1 (1+ ref1)))))
-       (put 'working-status-forms 'lisp-indent-function 2)))))
-
 ;; Ripped from thingatpt.el
 (defconst google-query-url-regexp
   (concat
     map)
   "A keymap for the extents in google query results buffer.")
 
+;; Unashamedly stolen from Bill Perry's URL package.
+(defconst google-query-unreserved-chars
+  '(?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
+       ?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
+       ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+       ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
+  "A list of characters that are _NOT_ reserved in the URL spec.
+This is taken from RFC 2396.")
+
+;; Unashamedly stolen from Bill Perry's URL package.
+(defun google-query-hexify-string (str)
+  "Escape characters STR so STR can be used in a URL."
+  (mapconcat
+   (lambda (char)
+     ;; Fixme: use a char table instead.
+     (if (not (memq char google-query-unreserved-chars))
+	 (if (< char 16)
+	     (format "%%0%X" char)
+	   (if (> char 255)
+	       (error "Hexifying multibyte character %s" str))
+	   (format "%%%X" char))
+       (char-to-string char)))
+   str ""))
+
 (defun google-query-make-url-extents ()
   "Create extent objects for all the URLs in the buffer."
   (goto-char (point-min))
   (interactive "sQuery Google for: ")
   (let* ((host google-query-mirror)
 	 (user-agent (concat "XEmacs-" emacs-program-version))
-	 (str (url-hexify-string 
+	 (str (google-query-hexify-string 
 	       (truncate-string-to-width string google-query-maxlen)))
-	 (query (concat "search?&q=" str))
+	 (query (concat "search?&q=" str 
+			"&num=" (format "%d" google-query-result-count)))
 	 (coding-system-for-read 'binary)
 	 (coding-system-for-write 'binary)
 	 (google (open-network-stream
 	     "Host: " host "\r\n"
 	     "Accept: */*\r\n"
 	     "User-Agent: " user-agent "\r\n\r\n"))
-    (working-status-forms "Talking to Google: " "Done!"
-      (while (eq (process-status google) 'open)
-	(working-dynamic-status nil)
-	(sleep-for 0.05))
-      (working-dynamic-status t))
+    (message "Talking to Google, please wait...")
+    (while (eq (process-status google) 'open)
+      (sleep-for 0.05))
     (google-query-process-results (buffer-string pbuf))
     (unless google-query-debug
       (kill-buffer pbuf))))