[snow-cvs] r23 - in trunk: lib src/lisp/snow src/lisp/snow/showcase src/lisp/snow/swing
Alessio Stalla
astalla at common-lisp.net
Sun Nov 22 23:39:11 UTC 2009
Author: astalla
Date: Sun Nov 22 18:39:10 2009
New Revision: 23
Log:
Added split pane.
Updated miglayout to latest version.
Showcase shows code in the bottom panel.
Added "child" macro to abstract add-child and fix inconsistency with layout
constraints.
Added:
trunk/lib/miglayout-3.7.1.jar (contents, props changed)
Removed:
trunk/lib/miglayout-3.6.2.jar
Modified:
trunk/src/lisp/snow/inspector.lisp
trunk/src/lisp/snow/packages.lisp
trunk/src/lisp/snow/showcase/showcase.lisp
trunk/src/lisp/snow/snow.lisp
trunk/src/lisp/snow/swing/swing.lisp
Added: trunk/lib/miglayout-3.7.1.jar
==============================================================================
Binary file. No diff available.
Modified: trunk/src/lisp/snow/inspector.lisp
==============================================================================
--- trunk/src/lisp/snow/inspector.lisp (original)
+++ trunk/src/lisp/snow/inspector.lisp Sun Nov 22 18:39:10 2009
@@ -158,7 +158,7 @@
(let ((stack (list (ensure-object-descriptor obj))))
(with-gui ()
(frame (:id frame :layout-manager :border)
- (add-child (inspector-panel stack frame frame) frame)
+ (child (inspector-panel stack frame frame))
(pack frame)
(show frame)))))
Modified: trunk/src/lisp/snow/packages.lisp
==============================================================================
--- trunk/src/lisp/snow/packages.lisp (original)
+++ trunk/src/lisp/snow/packages.lisp Sun Nov 22 18:39:10 2009
@@ -36,6 +36,7 @@
;;Widgets
#:button
#:check-box
+ #:dialog
#:frame
#:label
#:list-widget
@@ -44,6 +45,9 @@
#:menu-item
#:panel
#:scroll
+ #:split
+ #:tab
+ #:tabs
#:text-area
#:text-field
#:tree
Modified: trunk/src/lisp/snow/showcase/showcase.lisp
==============================================================================
--- trunk/src/lisp/snow/showcase/showcase.lisp (original)
+++ trunk/src/lisp/snow/showcase/showcase.lisp Sun Nov 22 18:39:10 2009
@@ -8,6 +8,28 @@
(in-package :snow-showcase)
(in-readtable snow:syntax)
+(defvar *examples* (list))
+
+(defmacro define-example (name &body body)
+ (cl-utilities:with-unique-names (original-code)
+ `(pushnew (list ,name
+ (lambda ()
+ (let ((,original-code ',body))
+
+ (split (:orientation :vertical)
+ (panel (:layout-manager '(:mig "fill") :layout "wrap")
+ , at body)
+ (scroll ()
+ (text-area :text
+ ,(with-output-to-string (str)
+ (let ((*print-case* :downcase))
+ (dolist (form body)
+ (pprint form str)
+ (terpri str))))))))))
+ *examples*
+ :test #'equal
+ :key #'car)))
+
(defmodel my-model ()
((a :accessor aaa :initform (c-in "4"))
(b :accessor bbb :initform (c? (concatenate 'string (aaa self) "2")))))
@@ -16,57 +38,71 @@
(defvar *variable* (make-var "42"))
(defvar *cells-object* (make-instance 'my-model))
+(define-example "Lists and trees"
+ (scroll (:layout "grow")
+ (list-widget :model (make-list-model '(1 2 (c (a b)) 3))
+ :prototype-cell-value "abcdefghijklmnopq"))
+ (scroll (:layout "grow")
+ (tree :model (make-tree-model '(1 2 (c (a b)) 3)))))
+
+(define-example "Layout"
+ (label :text "BorderLayout" :layout "wrap")
+ (panel (:layout-manager :border :layout "wrap")
+ (button :text "borderlayout - center")
+ (button :text "borderlayout - east"
+ :layout (jfield "java.awt.BorderLayout" "EAST"))))
+
+(define-example "Events"
+ (button :text "push me"
+ :on-action (lambda (event)
+ (declare (ignore event))
+ (princ "Thanks for pushing me! ")
+ (finish-output))))
+
+(define-example "Data Binding"
+ (scroll ()
+ (panel ()
+ (label :text "bean binding")
+ (label :binding ${*bean*.property1}
+ :layout "wrap")
+ (label :text "EL binding")
+ (label :binding ${*bean*.nested.property1}
+ :layout "wrap")
+ (label :text "cells bindings: aaa and bbb")
+ (label :binding $(c? (aaa *cells-object*)))
+ (label :binding $(cell (c? (bbb *cells-object*)))
+ :layout "wrap")
+ (label :text "simple binding to a variable")
+ (label :binding $*variable*
+ :layout "wrap")
+ (button :text "another one" :layout "wrap")
+ (label :text "set property1")
+ (text-field :binding ${*bean*.property1}
+ :layout "growx, wrap")
+ (label :text "set nested.property1")
+ (text-field :binding ${*bean*.nested.property1}
+ :layout "growx, wrap")
+ (button :text "Test!"
+ :layout "wrap"
+ :on-action (lambda (event)
+ (declare (ignore event))
+ (setf (jproperty-value *bean* "property1")
+ "Test property")
+ (setf (jproperty-value
+ (jproperty-value *bean* "nested")
+ "property1")
+ "Nested property")
+ (setf (var *variable*) "Test var")
+ (setf (aaa *cells-object*) "Test cell"))))))
+
(defun showcase ()
(with-gui (:swing)
- (frame (:id frame :title "Sample JFrame" :visible-p t)
- (scroll (:layout "grow")
- (list-widget :model (make-list-model '(1 2 (c (a b)) 3))
- :prototype-cell-value "abcdefghijklmnopq"))
- (panel (:layout-manager :border :layout "wrap")
- (button :text "borderlayout - center")
- (button :text "borderlayout - east"
- :layout (jfield "java.awt.BorderLayout" "EAST")))
- (scroll ()
- (panel ()
- (label :text "bean binding")
- (label :binding ${*bean*.property1}
- :layout "wrap")
- (label :text "EL binding")
- (label :binding ${*bean*.nested.property1}
- :layout "wrap")
- (label :text "cells bindings: aaa and bbb")
- (label :binding $(c? (aaa *cells-object*)))
- (label :binding $(cell (c? (bbb *cells-object*)))
- :layout "wrap")
- (label :text "simple binding to a variable")
- (label :binding $*variable*
- :layout "wrap")
- (button :text "another one" :layout "wrap")
- (label :text "set property1")
- (text-field :binding ${*bean*.property1}
- :layout "growx, wrap")
- (label :text "set nested.property1")
- (text-field :binding ${*bean*.nested.property1}
- :layout "growx, wrap")
- (button :text "Test!"
- :layout "wrap"
- :on-action (lambda (event)
- (setf (jproperty-value *bean* "property1")
- "Test property")
- (setf (jproperty-value
- (jproperty-value *bean* "nested")
- "property1")
- "Nested property")
- (setf (var *variable*) "Test var")
- (setf (aaa *cells-object*) "Test cell")))))
- (panel ()
- (tree :model (make-tree-model '(1 2 (c (a b)) 3)))
- (button :text "push me"
- :on-action (lambda (event)
- (princ "Thanks for pushing me! ")
- (format t "My parent is ~A~%" frame)
- (finish-output))))
- (pack frame))))
+ (frame (:id frame :title "Sample JFrame" :visible-p t :size #C(800 600)
+ :layout-manager '(:mig "fill"))
+ (tabs (:layout "grow")
+ (dolist (x *examples*)
+ (tab (car x) (funcall (cadr x))))))))
+
#|| (let ((fr (frame (:title "pippo" :visible-p t)
(panel (:layout "wrap")
(button :text "ciao" :enabled nil)
Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp (original)
+++ trunk/src/lisp/snow/snow.lisp Sun Nov 22 18:39:10 2009
@@ -91,7 +91,8 @@
(defun setup-container-widget (self &key (layout-manager :default) &allow-other-keys)
(setf (layout-manager self)
- (apply #'make-layout-manager self (ensure-list layout-manager))))
+ (apply #'make-layout-manager self
+ (ensure-list (or layout-manager :default)))))
(defun generate-default-children-processing-code (id children)
(let ((code
@@ -168,6 +169,11 @@
,@(generate-default-children-processing-code id body)
(common-widget-setup self ,layout ,binding ,enabled-p ,location ,size)))
+(define-widget-macro child
+ (widget &rest args &key layout binding (enabled-p t) location size)
+ widget
+ `(setup-widget , at args))
+
(defmacro define-widget (name keys constructor &body body)
(with-unique-names (args)
`(define-widget-macro ,name
@@ -207,7 +213,7 @@
(definterface call-in-gui-thread *gui-backend* (fn)
"Arranges <fn> 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*)
+(defvar *dynamic-environment* nil)
(defmacro with-gui ((&optional (gui-backend '*gui-backend*)) &body body)
(with-unique-names (gui-backend-var package-var debugger-hook-var
@@ -221,13 +227,11 @@
(*package* ,package-var)
(*debugger-hook* ,debugger-hook-var))
(proceed
- (format t "OUTSIDE ~A~%" *package*)
(let ((,dynamic-environment (capture-dynamic-environment)))
(call-in-gui-thread
(lambda ()
(with-dynamic-environment (,dynamic-environment)
(let ((*dynamic-environment* ,dynamic-environment))
- (format t "INSIDE ~A~%" *package*)
, at body)))))))))))
;;Common Interfaces
@@ -317,6 +321,16 @@
`(make-scroll-panel (dont-add ,body))
`(common-widget-setup self ,layout ,binding ,enabled-p ,location ,size))
+(definterface make-split-panel *gui-backend*
+ (child1 child2 &key (orientation :horizontal) smoothp))
+
+(define-widget-macro split
+ ((&rest args &key layout binding (enabled-p t) location size orientation smoothp)
+ child1 child2)
+ `(make-split-panel (dont-add ,child1) (dont-add ,child2)
+ :orientation ,orientation :smoothp ,smoothp)
+ `(common-widget-setup self ,layout ,binding ,enabled-p ,location ,size))
+
;;Buttons and similar
(definterface make-button *gui-backend* (&key text on-action &allow-other-keys))
Modified: trunk/src/lisp/snow/swing/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing/swing.lisp (original)
+++ trunk/src/lisp/snow/swing/swing.lisp Sun Nov 22 18:39:10 2009
@@ -41,7 +41,8 @@
(defun make-action-listener (obj)
(if (or (functionp obj) (symbolp obj))
(jmake-proxy "java.awt.event.ActionListener"
- (let ((env snow::*dynamic-environment*))
+ (let ((env (or snow::*dynamic-environment*
+ (snow::capture-dynamic-environment))))
(lambda (this method-name event)
(declare (ignore this method-name))
(snow::with-dynamic-environment (env)
@@ -178,14 +179,14 @@
(let ((tabs (new "javax.swing.JTabbedPane")))
(invoke "setTabLayoutPolicy" tabs
(if wrap
- (jfield "javax.swing.JTabbedPane" "WRAP_TAB_LAYOUT")
- (jfield "javax.swing.JTabbedPane" "SCROLL_TAB_LAYOUT")))
+ #.(jfield "javax.swing.JTabbedPane" "WRAP_TAB_LAYOUT")
+ #.(jfield "javax.swing.JTabbedPane" "SCROLL_TAB_LAYOUT")))
(invoke "setTabPlacement" tabs
- (case tab-placement
- (:top (jfield "javax.swing.JTabbedPane" "TOP"))
- (:bottom (jfield "javax.swing.JTabbedPane" "BOTTOM"))
- (:left (jfield "javax.swing.JTabbedPane" "LEFT"))
- (:right (jfield "javax.swing.JTabbedPane" "RIGHT"))))
+ (ecase tab-placement
+ (:top #.(jfield "javax.swing.JTabbedPane" "TOP"))
+ (:bottom #.(jfield "javax.swing.JTabbedPane" "BOTTOM"))
+ (:left #.(jfield "javax.swing.JTabbedPane" "LEFT"))
+ (:right #.(jfield "javax.swing.JTabbedPane" "RIGHT"))))
tabs))
(defimplementation snow::make-scroll-panel (*gui-backend* :swing) (view)
@@ -199,6 +200,18 @@
(defimpl (setf snow::scroll-panel-view) (view self)
(setf (jproperty-value self "viewportView") view))
+(defimpl snow::make-split-panel (child1 child2
+ &key (orientation :horizontal) smoothp)
+ (new "javax.swing.JSplitPane"
+ (ecase orientation
+ ((or :horizontal :h nil)
+ #.(jfield "javax.swing.JSplitPane" "HORIZONTAL_SPLIT"))
+ ((or :vertical :v)
+ #.(jfield "javax.swing.JSplitPane" "VERTICAL_SPLIT")))
+ (jbool smoothp)
+ child1
+ child2))
+
;Buttons
(defimplementation snow::make-button (*gui-backend* :swing)
(&key text on-action &allow-other-keys)
More information about the snow-cvs
mailing list