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