5914 richhickey ;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) 3317774372 None Common Lisp