[snow-cvs] r66 - in trunk: . examples/swixml src/lisp/snow

[Alessio Stalla]

Author: astalla
Date: Tue Mar  2 13:59:55 2010
New Revision: 66

Log:
Added :label pseudo-property for all widgets


Added:
   trunk/CHANGELOG
      - copied unchanged from r64, /trunk/changelog
   trunk/TODO
Removed:
   trunk/changelog
Modified:
   trunk/examples/swixml/helloworld.lisp
   trunk/examples/swixml/helloworld_j.lisp
   trunk/src/lisp/snow/snow.lisp
   trunk/src/lisp/snow/widgets.lisp

Added: trunk/TODO
==============================================================================
--- (empty file)
+++ trunk/TODO	Tue Mar  2 13:59:55 2010
@@ -0,0 +1,2 @@
+* improve error handling and reporting
+* validation (JGoodies?)

Modified: trunk/examples/swixml/helloworld.lisp
==============================================================================
--- trunk/examples/swixml/helloworld.lisp	(original)
+++ trunk/examples/swixml/helloworld.lisp	Tue Mar  2 13:59:55 2010
@@ -8,9 +8,11 @@
     (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"
+           ;;labelfor="tf"
+	  (text-field :id tf :text "Snow"
+		      :label (label :text "Hello World!"
+				    :font (font "Georgia" 12 :bold)
+				    :foreground :blue));;columns="20"
 	  (button :text "Click Here" :on-action #'submit))
 	(panel (:layout "dock south")
           (label :text "Clicks:" :font (font "Georgia" 36 :bold))

Modified: trunk/examples/swixml/helloworld_j.lisp
==============================================================================
--- trunk/examples/swixml/helloworld_j.lisp	(original)
+++ trunk/examples/swixml/helloworld_j.lisp	Tue Mar  2 13:59:55 2010
@@ -4,9 +4,10 @@
 (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"
+      (text-field :id tf :text "Snow"
+		  :label (label :text "Hello World!"
+				:font (font "Georgia" 12 :bold)
+				:foreground :blue));;columns="20"
       (button :text "Click Here" :on-action "submit"))
     (panel (:layout "dock south")
       (label :text "Clicks:" :font (font "Georgia" 36 :bold))

Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp	(original)
+++ trunk/src/lisp/snow/snow.lisp	Tue Mar  2 13:59:55 2010
@@ -151,7 +151,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun common-widget-args ()
     '(id layout binding (enabled-p t) (visible-p t) location size border font
-      background foreground
+      background foreground label
       on-mouse-click on-mouse-press on-mouse-release
       on-mouse-enter on-mouse-exit
       on-mouse-drag on-mouse-move))
@@ -174,6 +174,7 @@
 
 (defun setup-widget (self &key layout binding (enabled-p t) (visible-p t)
 		     location size border font background foreground
+		     label
 		     ;;mouse event handling
 		     on-mouse-click on-mouse-press on-mouse-release
 		     on-mouse-enter on-mouse-exit
@@ -213,7 +214,9 @@
 	  (setf (widget-foreground self) (color foreground))
 	  (setf (widget-foreground self) foreground)))
     (when border
-      (setf (widget-border self) border))))
+      (setf (widget-border self) border))
+    (when label
+      (setf (label-for label) self))))
 
 #+emacs (put 'define-widget-macro 'lisp-indent-function 3)
 #+emacs (put 'define-widget 'lisp-indent-function 3)

Modified: trunk/src/lisp/snow/widgets.lisp
==============================================================================
--- trunk/src/lisp/snow/widgets.lisp	(original)
+++ trunk/src/lisp/snow/widgets.lisp	Tue Mar  2 13:59:55 2010
@@ -208,6 +208,12 @@
 
 (defwidget label text)
 
+(defun (setf label-for) (component label)
+  (setf (widget-property label "labelFor") component))
+
+(defun label-for (label)
+  (widget-property label "labelFor"))
+
 (defun make-text-field (&key text &allow-other-keys)
   (let ((field (new "javax.swing.JTextField")))
     (when text