From astalla at common-lisp.net Thu Feb 4 19:03:49 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Thu, 04 Feb 2010 14:03:49 -0500 Subject: [snow-cvs] r51 - in trunk: examples/swixml src/lisp/snow src/lisp/snow/showcase Message-ID: Author: astalla Date: Thu Feb 4 14:03:48 2010 New Revision: 51 Log: *event* passed as a special variable rather than as a function parameter. Modified: trunk/examples/swixml/helloworld.lisp trunk/src/lisp/snow/debugger.lisp trunk/src/lisp/snow/inspector.lisp trunk/src/lisp/snow/packages.lisp trunk/src/lisp/snow/repl.lisp trunk/src/lisp/snow/showcase/showcase.lisp trunk/src/lisp/snow/snow.lisp trunk/src/lisp/snow/start.lisp trunk/src/lisp/snow/swing.lisp Modified: trunk/examples/swixml/helloworld.lisp ============================================================================== --- trunk/examples/swixml/helloworld.lisp (original) +++ trunk/examples/swixml/helloworld.lisp Thu Feb 4 14:03:48 2010 @@ -2,8 +2,7 @@ (in-readtable snow:syntax) (let ((clicks (make-var 0)) tf) - (flet ((submit (event) - (declare (ignore event)) + (flet ((submit () (setf (widget-text tf) (str (widget-text tf) "#")) (incf (var clicks)))) (with-gui () Modified: trunk/src/lisp/snow/debugger.lisp ============================================================================== --- trunk/src/lisp/snow/debugger.lisp (original) +++ trunk/src/lisp/snow/debugger.lisp Thu Feb 4 14:03:48 2010 @@ -55,35 +55,28 @@ (scroll (:layout "grow, wrap") list) (panel () (button :text "Ok" - :on-action (lambda (evt) - (declare (ignore evt)) + :on-action (lambda () (when (>= (widget-property list :selected-index) 0) (dispose dlg)))) (button :text "Backtrace" :on-action - (lambda (evt) - (declare (ignore evt)) + (lambda () (dialog (:id dlg :title "Backtrace" :modal-p t) (scroll (:layout "wrap") (list-widget :model (make-list-model backtrace))) (button :text "Ok" - :on-action (lambda (evt) - (declare (ignore evt)) - (dispose dlg))) + :on-action (lambda () (dispose dlg))) (pack dlg) (show dlg)))) (button :text "Condition" :on-action - (lambda (evt) - (declare (ignore evt)) + (lambda () (dialog (:id dlg :title "Condition" :modal-p t) (scroll (:layout "wrap") (text-area :text (sys::%format nil "~A" condition))) (button :text "Ok" - :on-action (lambda (evt) - (declare (ignore evt)) - (dispose dlg))) + :on-action (lambda () (dispose dlg))) (pack dlg) (show dlg))))) (pack dlg) Modified: trunk/src/lisp/snow/inspector.lisp ============================================================================== --- trunk/src/lisp/snow/inspector.lisp (original) +++ trunk/src/lisp/snow/inspector.lisp Thu Feb 4 14:03:48 2010 @@ -120,8 +120,7 @@ (button :text "Inspect" :layout "wrap" - :on-action (lambda (evt) - (declare (ignore evt)) + :on-action (lambda () (update-inspector panel (inspector-panel (cons (part-descriptor part) @@ -129,15 +128,13 @@ container window) container))) (button :text "Inspect (new window)" - :on-action (lambda (evt) - (declare (ignore evt)) + :on-action (lambda () (inspect-object (part-descriptor part))))))))))) (scroll (:layout "grow, wrap") (gui-repl :dispose-on-close window)) (panel () (button :text "Back" :enabled-p (cdr stack) - :on-action (lambda (evt) - (declare (ignore evt)) + :on-action (lambda () (update-inspector panel (inspector-panel (cdr stack) container window) Modified: trunk/src/lisp/snow/packages.lisp ============================================================================== --- trunk/src/lisp/snow/packages.lisp (original) +++ trunk/src/lisp/snow/packages.lisp Thu Feb 4 14:03:48 2010 @@ -97,8 +97,8 @@ #:&common-widget-args #:defimplementation #:definterface + #:*event* #:font - #:*gui-backend* #:jbool #:layout-manager #:make-dialog-prompt-stream @@ -117,4 +117,4 @@ (defpackage :snow-user (:use :common-lisp :snow :java :ext :named-readtables :cells) (:shadowing-import-from :snow - #:make-dialog-prompt-stream #:*gui-backend* #:self)) \ No newline at end of file + #:make-dialog-prompt-stream #:self)) \ No newline at end of file Modified: trunk/src/lisp/snow/repl.lisp ============================================================================== --- trunk/src/lisp/snow/repl.lisp (original) +++ trunk/src/lisp/snow/repl.lisp Thu Feb 4 14:03:48 2010 @@ -38,7 +38,7 @@ (repl-doc (new "snow.swing.ConsoleDocument" (compile nil `(lambda () - (snow::with-snow-dynamic-environment + (with-snow-dynamic-environment (let (, at environment) (top-level::top-level-loop)))))))) (setf (widget-property text-area :document) repl-doc) Modified: trunk/src/lisp/snow/showcase/showcase.lisp ============================================================================== --- trunk/src/lisp/snow/showcase/showcase.lisp (original) +++ trunk/src/lisp/snow/showcase/showcase.lisp Thu Feb 4 14:03:48 2010 @@ -1,7 +1,6 @@ (defpackage :snow-showcase (:use :common-lisp :snow :java :ext :named-readtables :cells) - (:shadowing-import-from :snow #:make-dialog-prompt-stream #:*gui-backend* - #:self)) + (:shadowing-import-from :snow #:make-dialog-prompt-stream #:self)) (in-package :snow-showcase) (in-readtable snow:syntax) @@ -23,8 +22,7 @@ , at body) (button :text "Show source" :layout "dock south" - :on-action (lambda (evt) - (declare (ignore evt)) + :on-action (lambda () (setf (var ,show-source-p) t)))) (panel (:layout "dock south, hidemode 3" :visible-p $(c? (jbool (var ,show-source-p)))) @@ -37,8 +35,7 @@ (terpri str)))))) (button :text "Hide source" :layout "dock south" - :on-action (lambda (evt) - (declare (ignore evt)) + :on-action (lambda () (setf (var ,show-source-p) nil)))))))) *examples* :test #'equal @@ -76,8 +73,7 @@ :layout "growx, wrap") (button :text "Test!" :layout "wrap" - :on-action (lambda (event) - (declare (ignore event)) + :on-action (lambda () (setf (jproperty-value *bean* "property1") "Test property") (setf (jproperty-value @@ -89,7 +85,7 @@ (define-example "Mouse Events" (panel (:layout "grow" - :on-mouse-click (lambda (evt) (format t "Click! ~A~%" evt))) + :on-mouse-click (lambda () (format t "Click! ~A~%" *event*))) (label :text "Click here!"))) (define-example "Lists and trees" @@ -108,8 +104,7 @@ (define-example "Events" (button :text "push me" - :on-action (lambda (event) - (declare (ignore event)) + :on-action (lambda () (princ "Thanks for pushing me! ") (finish-output)))) Modified: trunk/src/lisp/snow/snow.lisp ============================================================================== --- trunk/src/lisp/snow/snow.lisp (original) +++ trunk/src/lisp/snow/snow.lisp Thu Feb 4 14:03:48 2010 @@ -30,74 +30,22 @@ (in-package :snow) -;;Common Interfaces (much to do here!) -(defvar *gui-backend* :swing "Variable used to determine the GUI backend, and thus interface implementation, to use. Defaults to :swing.") - -(definterface add-child *gui-backend* (child &optional (parent *parent*) layout-constraints)) - -(definterface (setf widget-background) *gui-backend* (value widget)) - -(definterface (setf widget-border) *gui-backend* (value widget)) - -(definterface widget-enabled-p *gui-backend* (widget)) - -(definterface (setf widget-enabled-p) *gui-backend* (value widget)) - -(definterface (setf widget-font) *gui-backend* (value widget)) - -(definterface (setf widget-foreground) *gui-backend* (value widget)) - -(definterface (setf widget-location) *gui-backend* (value widget)) - -(definterface (setf widget-size) *gui-backend* (value widget)) - -(definterface widget-text *gui-backend* (widget)) - -(definterface (setf widget-text) *gui-backend* (value widget)) - -(definterface widget-visible-p *gui-backend* (widget)) - -(definterface (setf widget-visible-p) *gui-backend* (value widget)) - -(definterface dispose *gui-backend* (obj)) - -(definterface color *gui-backend* (color-spec) - "Constructs an object representing a color. The color can be specified the 24-bit RGB number, or by symbolic constants such as :black, :red or :green.") - -(definterface font *gui-backend* (name size &optional style) - "Constructs an object representing a font. Parameters: - name the name of the font family - size the size in points - style if provided, one of :plain, :bold, :italic or :bold-italic") - -(definterface show *gui-backend* (obj)) - -(definterface hide *gui-backend* (obj)) - -(definterface pack *gui-backend* (window)) - -(defvar *parent* nil) - -(definterface call-in-gui-thread *gui-backend* (fn) - "Arranges to be called from a thread in which it is safe to create GUI components (for example, the Event Dispatching Thread in Swing).") - (defvar *dynamic-environment* nil) +(defvar *event* nil "Dynamic variable holding an object that represents the event currently being handled.") (defmacro with-snow-dynamic-environment (&body body) - (with-unique-names (gui-backend-var package-var terminal-io-var + (with-unique-names (package-var terminal-io-var standard-input-var standard-output-var error-output-var) `(if *dynamic-environment* (with-dynamic-environment (*dynamic-environment*) , at body) - (let ((,gui-backend-var *gui-backend*) - (,package-var *package*) + (let ((,package-var *package*) (,terminal-io-var *terminal-io*) (,standard-input-var *standard-input*) (,standard-output-var *standard-output*) (,error-output-var *error-output*)) ;;Etc... (dynamic-wind - (let ((*gui-backend* ,gui-backend-var) - (*package* ,package-var) + (let ((*package* ,package-var) (*debugger-hook* *graphical-debugger-hook*) (*terminal-io* ,terminal-io-var) (*standard-input* ,standard-input-var) @@ -116,8 +64,8 @@ (let ((*dynamic-environment* ,dynamic-environment)) , at body))))))) -(defmacro with-gui ((&optional (gui-backend '*gui-backend*)) &body body) - (declare (ignore gui-backend)) +(defmacro with-gui ((&rest args) &body body) + (declare (ignore args)) `(call-in-gui-thread (lambda/dynamic-environment () , at body))) @@ -176,12 +124,6 @@ (defgeneric bind-widget (widget binding) (:documentation "Connects a widget to a data binding. The framework automatically chooses which property of the widget to connect.")) -(definterface make-layout-manager *gui-backend* (widget type &rest args) - "Creates a backed-specific object used to layout components.") - -(definterface (setf layout-manager) *gui-backend* (lm widget) - "Sets the layout manager for a given (container) widget.") - (defun setup-container-widget (self &key (layout-manager :default) &allow-other-keys) "Common setup for all container widgets." (setf (layout-manager self) @@ -225,11 +167,6 @@ (defun filter-unevaluated-widget-args (args) (filter-arglist args '(:id)))) -(definterface setup-mouse-listeners *gui-backend* - (widget on-mouse-click on-mouse-press on-mouse-release - on-mouse-enter on-mouse-exit on-mouse-drag on-mouse-move) - "Sets mouse listener(s) on a widget.") - (defun setup-widget (self &key layout binding (enabled-p t) (visible-p t) location size border font background foreground ;;mouse event handling @@ -241,7 +178,8 @@ (macrolet ((wrap-event-callback (fn) ;;Pay attention to double evaluation `(when ,fn (lambda/dynamic-environment (evt) - (funcall ,fn evt))))) + (let ((*event* evt)) + (funcall ,fn)))))) (when *parent* (add-child self *parent* layout)) (setf (widget-enabled-p self) enabled-p) (setf (widget-visible-p self) visible-p) @@ -293,6 +231,7 @@ '&common-widget-args arglist) `(&environment ,env)) + ,@(common-widget-args-declarations) `(let ((self ,,constructor)) ;;The lexical variable self is always bound to the current widget. ,(if id ;;id is one of the common args @@ -331,6 +270,10 @@ self)) ,@(filter-unevaluated-widget-args ,args)) `(progn +;TODO - declare keys ignorable to reduce the number of warnings. +; (declare (ignorable ,@(mapcar (lambda (k) +; (if (atom k) k (car k))) +; keys))) ,, at body)))) (defmacro define-container-widget (name keys constructor &body body) Modified: trunk/src/lisp/snow/start.lisp ============================================================================== --- trunk/src/lisp/snow/start.lisp (original) +++ trunk/src/lisp/snow/start.lisp Thu Feb 4 14:03:48 2010 @@ -42,9 +42,7 @@ :text "Many thanks to these people for contributing to Snow:") (label :layout "wrap" :text "Nikita \"Shviller\" Mamardashvili") - (button :text "Ok" :on-action (lambda (evt) - (declare (ignore evt)) - (dispose dlg))) + (button :text "Ok" :on-action (lambda () (dispose dlg))) (pack self))) (defun snow-showcase () @@ -62,18 +60,12 @@ :menu-bar (menu-bar () (menu (:text "File") (menu-item :text "Quit" - :on-action (lambda (evt) - (declare (ignore evt)) - (ext:quit)))) + :on-action (lambda () (ext:quit)))) (menu (:text "Help") (menu-item :text "Showcase" - :on-action (lambda (evt) - (declare (ignore evt)) - (snow-showcase))) + :on-action (lambda () (snow-showcase))) (menu-item :text "About" - :on-action (lambda (evt) - (declare (ignore evt)) - (snow-about)))))) + :on-action (lambda () (snow-about)))))) (scroll (:layout "grow") (gui-repl :dispose-on-close frame :environment `((*package* ,(find-package :snow-user)) Modified: trunk/src/lisp/snow/swing.lisp ============================================================================== --- trunk/src/lisp/snow/swing.lisp (original) +++ trunk/src/lisp/snow/swing.lisp Thu Feb 4 14:03:48 2010 @@ -43,7 +43,9 @@ ((or (functionp obj) (symbolp obj)) (jmake-proxy "java.awt.event.ActionListener" (lambda/dynamic-environment (this method-name event) - (funcall obj event)))) + (declare (ignore this method-name)) + (let ((*event* event)) + (funcall obj))))) ((stringp obj) (unless *backing-bean* (error "No backing bean specified while action listener is a method name: ~A~%" obj)) @@ -58,6 +60,7 @@ (t obj))) ;This allows to use a native Java action listener (defun make-layout-manager (widget layout &rest args) + "Creates an object used to layout components." (if (typep layout 'java-object) layout (ecase layout @@ -74,11 +77,13 @@ ((nil) nil)))) (defun (setf layout-manager) (lm widget) + "Sets the layout manager for a given (container) widget." (setf (widget-property widget :layout) lm)) (defun setup-mouse-listeners (widget on-mouse-click on-mouse-press on-mouse-release on-mouse-enter on-mouse-exit on-mouse-drag on-mouse-move) + "Sets mouse listener(s) on a widget." (let ((mouse-input-listener (new "snow.swing.MouseInputListener" on-mouse-click on-mouse-press on-mouse-release @@ -95,6 +100,7 @@ (defconstant +add-to-container-with-constraints+ (jmethod "java.awt.Container" "add" "java.lang.String" "java.awt.Component")) (defun call-in-gui-thread (fn) + "Arranges to be called from a thread in which it is safe to create GUI components (for example, the Event Dispatching Thread in Swing)." (jstatic "invokeLater" "javax.swing.SwingUtilities" (new "snow.FunctionRunnable" fn))) @@ -189,6 +195,7 @@ (invoke "hide" obj)) (defun color (color-spec) + "Constructs an object representing a color. The color can be specified the 24-bit RGB number, or by symbolic constants such as :black, :red or :green." (cond ((integerp color-spec) (new "java.awt.Color" color-spec)) ((keywordp color-spec) (case color-spec @@ -200,6 +207,10 @@ (t (error "Invalid color: ~A" color-spec)))) (defun font (name size &optional style) + "Constructs an object representing a font. Parameters: + name the name of the font family + size the size in points + style if provided, one of :plain, :bold, :italic or :bold-italic" (let ((style-int (case style ((or :plain nil) (jfield "java.awt.Font" "PLAIN")) (:bold (jfield "java.awt.Font" "BOLD")) From astalla at common-lisp.net Mon Feb 8 21:21:26 2010 From: astalla at common-lisp.net (Alessio Stalla) Date: Mon, 08 Feb 2010 16:21:26 -0500 Subject: [snow-cvs] r52 - in trunk: . examples/swixml src/lisp/snow Message-ID: Author: astalla Date: Mon Feb 8 16:21:26 2010 New Revision: 52 Log: changelog for 0.3 fixed non-propagation of *gui-backend* and *presentation-model* to GUI thread. fixed helloworld/j example. Added: trunk/examples/swixml/HelloWorld.java trunk/examples/swixml/helloworld_j.lisp Modified: trunk/changelog trunk/src/lisp/snow/snow.lisp trunk/src/lisp/snow/swing.lisp Modified: trunk/changelog ============================================================================== --- trunk/changelog (original) +++ trunk/changelog Mon Feb 8 16:21:26 2010 @@ -1,3 +1,28 @@ +Snow version 0.3 (..........) + +This is an alpha release, focused on refactoring and simplifying the core +engine, providing better Java integration and cleaner API, and supporting +more widgets and properties. + +Main improvements: +- Refactoring and simplification of core Snow. It's no longer possible to + theoretically change the GUI backend at runtime, among other things. + This was impossible anyway because macros would have needed to be changed too + for different enough backends (e.g. SWT, because it requires a component to + be added to its container at creation time and not later, for example). + When SWT will be supported, it'll have to be enabled at read-time + with *features*. This makes Snow simpler and more efficient. +- :id foo expands to (setf foo self) for all components if foo is a declared + lexical variable. +- Better Java integration. The snow.Snow API has been made simpler and richer. + Introduced the concept of a "backing bean" for the GUI: if provided from + Java, this bean will have all the widget with an :id injected into the + corresponding property, if any, and event callbacks specified as strings + (as opposed to function designators) will be delegated to bean methods with + the correct signature. +- A few more event listeners are now supported, including mouse events on + arbitrary components. + Snow version 0.2 (2009-11-28) This is an alpha release, focused on stabilizing the core engine, providing Added: trunk/examples/swixml/HelloWorld.java ============================================================================== --- (empty file) +++ trunk/examples/swixml/HelloWorld.java Mon Feb 8 16:21:26 2010 @@ -0,0 +1,54 @@ +import javax.swing.*; +import java.awt.event.ActionEvent; + +import snow.*; + +public class HelloWorld { + /** submit counter */ + private int clicks; + + /** JTextField member gets instantiated through Swixml (look for id="tf" in xml descriptor) */ + private JTextField tf; + + /** Jlabel to display number of button clicks */ + private JLabel cnt; + + /** + * Event handler. + * Appends a '#' to the textfields content and increments the number of + * clicks displayed by the label. + */ + public void submit(ActionEvent e) { + tf.setText(tf.getText() + '#'); + cnt.setText(String.valueOf( ++clicks )); + } + + /** Renders UI at construction */ + private HelloWorld() throws Exception { + Snowlet s = Snow.getInterpretedSnowlet(getClass().getResource("helloworld_j.lisp")); + s.setBackingBean(this); + s.eval(); + } + + /** Makes the class bootable */ + public static void main( String[] args ) throws Exception { + new HelloWorld(); + } + + public JTextField getTf() { + return tf; + } + + public void setTf(JTextField tf) { + this.tf = tf; + } + + public JLabel getCnt() { + return cnt; + } + + public void setCnt(JLabel cnt) { + this.cnt = cnt; + } + +} Added: trunk/examples/swixml/helloworld_j.lisp ============================================================================== --- (empty file) +++ trunk/examples/swixml/helloworld_j.lisp Mon Feb 8 16:21:26 2010 @@ -0,0 +1,45 @@ +(in-package :snow-user) +(in-readtable snow:syntax) + +(with-gui () + (frame (:size #C(640 280) :title "Hello Snow World" :on-close :exit) + (panel (:layout "grow, wrap") + (label :text "Hello World!" :font (font "Georgia" 12 :bold) + :foreground :blue) ;;labelfor="tf" + (text-field :id tf :text "Snow");;columns="20" + (button :text "Click Here" :on-action "submit")) + (panel (:layout "dock south") + (label :text "Clicks:" :font (font "Georgia" 36 :bold)) + (label :id cnt :font (font "Georgia" 36 :bold))) + (show self))) + +#|| +The original example used the SwiXml idiom of coding a Java class to handle +the events; an instance of this class gets injected the components with an +ID into its JavaBean properties. +The Snow version does not rely on a Java class; instead it handles events in +Lisp and uses data binding to update the GUI. It is of course possible to +handle the events in Java, but Snow does not currently support automatic +injection of widgets into the properties of a Java object. +||# + +#|| Original example: + + + + + +