[closure-devel] Extension: query Yahoo search's API and present results

[Eric Marsden]

Hi,

The attached file illustrates how to query Yahoo's REST search API,
extract the interesting information from the resulting XML stream
using CXML's DOM interface, and display the results as HTML within
Closure.

The results as presented are currently ugly, but look at how few lines
of code are required to implement this extension!

-------------- next part --------------
;;; closure-extra.lisp
;;;
;;; Time-stamp: <2006-12-30 emarsden>


(in-package :clim-user)

;; emarsden2006-12-30 experimental
;; http://developer.yahoo.com/search/rest.html
(defun make-yahoo-search-url (string)
  (url:merge-url
   (url:make-url :query (list
                         (cons "appid" "Closure")
                         (cons "results" "15")
                         (cons "query" string)))
   (url:parse-url "http://search.yahooapis.com/WebSearchService/V1/webSearch")))

(defun yahoo-search-results (string)
  (multiple-value-bind (body status-code headers uri stream must-close)
      (drakma:http-request (url:unparse-url (make-yahoo-search-url string))
                           :method :get
                           :force-binary t
                           :want-stream t)
    (declare (ignore body status-code headers uri must-close))
    (flet ((node-child-data (node)
             (let ((data (list)))
               (dom:do-node-list (child (dom:child-nodes node))
                 (when (eql :text (dom:node-type child))
                   (push (dom:node-value child) data)))
               data)))
      (let ((document (cxml:parse-stream stream (cxml-dom:make-dom-builder)))
            (search-results (list)))
        (dom:do-node-list (result-node (dom:get-elements-by-tag-name document "Result"))
          (let ((result (list)))
            (dom:do-node-list (child (dom:child-nodes result-node))
              (when (eql :element (dom:node-type child))
                (when (member (dom:node-name child) '("Title" "Url" "Summary") :test #'string=)
                  (push (cons (dom:node-name child)
                              (node-child-data child))
                        result))))
            (push result search-results)))
        (values (nreverse search-results))))))

(defun yahoo-search/lhtml (what)
  `(:html
    (:head
     (:title "Yahoo search results"))
    (:body
     (:h1 ,(format nil "Yahoo search results for ~S" what))
     (:p
      (:ul
       ,@(loop :for res :in (yahoo-search-results what)
               :collect `(:li
                          (:dl
                           ,@(loop :for (a b) :in res
                                   :collect (list :dt a)
                                   :collect (list :dd b))))))))))

(defun render-lhtml (location lhtml)
  (with-simple-restart (forget "Just forget rendering this page.")
    (let* ((pt (sgml:lhtml->pt lhtml))
           (*package* (find-package :r2))
           (*pane* (find-pane-named *frame* 'canvas))
           (*medium* (sheet-medium *pane*))
           (device (make-instance 'closure/clim-device::clim-device :medium *pane*))
           (doc (make-instance 'r2::document
                               :processes-hooks nil
                               :location location
                               :http-header nil
                               :pt pt))
           (*current-document* doc)
           (closure-protocol:*user-agent* nil)
           (closure-protocol:*document-language* (make-instance 'r2::html-4.0-document-language))
           (r2::*canvas-width* (bounding-rectangle-width (sheet-parent *pane*))))
      (window-clear *pane*)
      (closure-protocol:render closure-protocol:*document-language*
                               doc
                               device
                               (setf *current-pt* (r2::document-pt doc))
                               600 t 0)
      (xlib:display-finish-output (clim-clx::clx-port-display (find-port)))
      (reflow))))

(define-closure-command (com-search-yahoo :name t) ((what 'string))
  (render-lhtml "http://www.yahoo.com/" (yahoo-search/lhtml what)))

;; EOF
-------------- next part --------------
-- 
Eric Marsden