;;; 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