;homegrown Lisp <-> Java/CLI bridge library
(load "/dev/foil/foil")
(use-package :foil) 
;generated wrappers for java libs
(load "/foil/java-lang")
(load "/foil/java-util")
(load "/foil/swt")
(load "/foil/commons-httpclient")
;Miles Egan's XML parser for Lisp - thanks Miles!
(load "/dev/xmls-1.2/xmls")

(require "comm") ;Lispworks socket stuff

(defpackage :bloglines-demo
 (:use :cl :foil "org.eclipse.swt" "org.eclipse.swt.widgets" "org.eclipse.swt.events"
  "org.eclipse.swt.layout" "org.eclipse.swt.custom" "org.eclipse.swt.browser"
  "org.apache.commons.httpclient" "org.apache.commons.httpclient.methods" :xmls)
 (:export  :*display*  :init-display  :run-ui  :swt-bloglines))

(in-package :bloglines-demo)

;;;;;;;;;;;;;;;;; SWT Boilerplate ;;;;;;;;;;;;;;;;;;;;;;;
;included here for completeness, will be the same for any Foil/SWT app

;presumes Foil java server running on these 2 ports, first will be for ui
(defvar *ui-stream* (comm:open-tcp-stream "localhost" 13578))
(defvar *non-ui-stream* (comm:open-tcp-stream "localhost" 13579))
(defvar *display*) ;hang onto the display for use in the listener thread

;create the Foil foreign VM
(setf *fvm* (make-instance 'foreign-vm :stream *non-ui-stream*))

;a helper class that comes with Foil that runs the SWT message pump
(def-foil-class "com.richhickey.foil.SWTHelper")

(defun run-ui (fn)
  "Sets up a separate thread to run the GUI, and binds to a ui-dedicated Foil socket"
  (let ((mp:*process-initial-bindings*
         (append '((*display* . *display*)
                   (*standard-output* . *standard-output*)
                   (*fvm* . *fvm*)
                   (*thread-fvm-stream* . *ui-stream*)
                   (*thread-fvm* . *fvm*))
                 mp:*process-initial-bindings*)))
    (mp:process-run-function "ui-proc" '() fn )))
;;;;;;;;;;;;;;;;; end SWT Boilerplate ;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;; Bloglines Demo ;;;;;;;;;;;;;;;
#|
inspired by Marc Hedlund's Article on using Bloglines web service from Groovy
http://www.oreillynet.com/pub/a/network/2004/09/28/bloglines.html

Here is a version in Lisp, using my Foil library

A typical use of Foil, it leverages Java libs to interface with the outside world (SWT for UI,
Jakarta Commons for HTTP client), and Lisp for the data model/logic

I've mimicked the Groovy code to some extent to allow for comparison by those who know only Lisp or Groovy
|#

;I don't have a wrapper for swing, but need to use its InputDialog (why doesn't SWT have this?)
;so create one on the fly
(def-foil-class "javax.swing.JOptionPane")
(use-package "javax.swing")

(defparameter +SERVER+ "rpc.bloglines.com")

(defun find-child (node name)
  (find name (node-children node) :key #'node-name :test #'equal))

(defun find-attr (node attr)
  (second (find attr (node-attrs node) :key #'first :test #'equal)))

(defun api-url (method)
  (format nil "http://~A/~A" +SERVER+ method))

(defun add-nodes (nodes parent node-map)
  (dolist (node nodes)
    (let* ((is-folder (not (find-attr node "xmlUrl")))
           (title (find-attr node "title"))
           (tree-item
            (treeitem.new parent *SWT.NONE*
                          :text (if is-folder
                                    title
                                  (format nil "~A (~A)" title (find-attr node "BloglinesUnread"))))))
      (setf (gethash tree-item node-map) node)
      (when is-folder
        (add-nodes (node-children node) tree-item node-map)))))

(defun list-items (client node list)
  (let ((rss-text (call-bloglines client
                                  (api-url (format nil "getitems?s=~A&n=0"
                                                   (find-attr node "BloglinesSubId")))))
        (descriptions nil))
    (when rss-text
      (let* ((rss (parse rss-text))
             (items (remove "item" (node-children (find-child rss "channel"))
                            :key #'first :test-not #'equal)))
        (list.removeall list)
        (dolist (item items)
          (list.add list (third (find-child item "title")))
          (push (third (find-child item "description")) descriptions))
        (nreverse descriptions)))))

(defun call-bloglines (client url)
  (let ((get (new getmethod. (url) :doauthentication t)))
    (httpclient.executemethod client get)
    (httpmethod.getresponsebodyasstring get)))

(defun swt-bloglines ()
  (let* ((email (joptionpane.showinputdialog nil "Email address:" "Log in to Bloglines"
			      *joptionpane.question_message*))
         (password (joptionpane.showinputdialog nil "Password:" "Log in to Bloglines"
			      *joptionpane.question_message*))
         (client (httpclient.new))
         (credentials (usernamepasswordcredentials.new email password))
         (node-map (make-hash-table)))
    (httpstate.setcredentials (httpclient.state client) "Bloglines RPC" +SERVER+ credentials)
    (let* ((*display* (display.getdefault))
           (shell (new shell. (*display* :text "SWT Bloglines Client" :layout (gridlayout.new 1 t ))
                  (.setsize 800 600)
                  (.setlocation 100 100)))
           (base-pane (sashform.new shell *SWT.HORIZONTAL*
                                    :layoutdata (griddata.new *GRIDDATA.FILL_BOTH*)))
           (feed-tree (tree.new base-pane (logior *SWT.SINGLE* *SWT.BORDER*)
                                :layoutdata (griddata.new *GRIDDATA.FILL_BOTH*)))
           (item-pane (sashform.new base-pane *SWT.VERTICAL*
                                    :layoutdata (griddata.new *GRIDDATA.FILL_BOTH*)))
           (item-list (list.new item-pane (logior *SWT.SINGLE* *SWT.BORDER*)
                                :layoutdata (griddata.new *GRIDDATA.FILL_BOTH*)))
           (item-text (browser.new item-pane *SWT.BORDER*))
           (opml (parse (call-bloglines client (api-url "listsubs"))))
           (subs (node-children (find-child opml "body")))
           (descriptions nil))
      (add-nodes subs feed-tree node-map)
      (tree.addselectionlistener feed-tree
           (new-proxy p +MARSHALL-ID+ 0
                      (selectionlistener.
                       (widgetselected (event)
                         (let* ((item (selectionevent.item event))
                                (node (gethash item node-map)))
                           ;if it's a subscription, update list
                           (when (find-attr node "xmlUrl")
                             (setf descriptions (list-items client node item-list)))
                           nil)))))
      (list.addselectionlistener item-list
           (new-proxy p +MARSHALL-ID+ 0
                      (selectionlistener.
                       (widgetselected (event)
                         (declare (ignore event))
                         (browser.settext item-text (nth (list.selectionindex item-list) descriptions))
                         nil))))
      (|com.richhickey.foil|::swthelper.rundispatchloop *display* shell))))

;yes, you can treat Lisp like a scripting language
(run-ui #'swt-bloglines)