[snow-cvs] r25 - in trunk/src/lisp/snow: . swing

[Nikita Mamardashvili]

Author: nmamardashvili
Date: Thu Nov 26 14:33:09 2009
New Revision: 25

Log:
A helper macro (thanks to Michael Raskin) and minimal support for progress bars.

Modified:
   trunk/src/lisp/snow/packages.lisp
   trunk/src/lisp/snow/snow.lisp
   trunk/src/lisp/snow/swing/swing.lisp

Modified: trunk/src/lisp/snow/packages.lisp
==============================================================================
--- trunk/src/lisp/snow/packages.lisp	(original)
+++ trunk/src/lisp/snow/packages.lisp	Thu Nov 26 14:33:09 2009
@@ -35,7 +35,8 @@
   (:export
     ;;Widgets
     #:button
-    #:check-box
+    #:check-box
+    #:progress-bar
     #:dialog
     #:frame
     #:label

Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp	(original)
+++ trunk/src/lisp/snow/snow.lisp	Thu Nov 26 14:33:09 2009
@@ -342,6 +342,15 @@
 		       :orientation ,orientation :smoothp ,smoothp)
   `(common-widget-setup self ,layout ,binding ,enabled-p ,visible-p ,location ,size))
 
+(defmacro defwidget (name &rest args)
+  (let* (
+          (maker-sym (intern (concatenate 'string "MAKE-" (symbol-name name))))
+          )
+          `(progn
+          (definterface ,maker-sym *gui-backend* (&key , at args &allow-other-keys))
+          (define-widget ,name (, at args &allow-other-keys) ,maker-sym)
+          )))
+
 ;;Buttons and similar
 (definterface make-button *gui-backend* (&key text on-action &allow-other-keys))
 
@@ -350,11 +359,18 @@
 (definterface make-check-box *gui-backend* (&key text selected-p &allow-other-keys))
 
 (define-widget check-box (text selected-p &allow-other-keys) make-check-box)
+
+;;Misc
+
+(def-widget progress-bar value orientation (paint-border t) progress-string)
+
+;;Text
+
+(def-widget label text)
 
-;;Text
-(definterface make-label *gui-backend* (&key text &allow-other-keys))
+; (definterface make-label *gui-backend* (&key text &allow-other-keys))
 
-(define-widget label (text &allow-other-keys) make-label)
+; (define-widget label (text &allow-other-keys) make-label)
 
 (definterface make-text-field *gui-backend* (&key text &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	Thu Nov 26 14:33:09 2009
@@ -232,6 +232,21 @@
 	  (if selected-p selected-p (jbool nil)))
     btn))
 
+;Misc
+(defconstant +swingconstant-vertical+ 1) ; it should be something like (jmethod "javax.swing.SwingConstants" "VERTICAL")
+(defimpl snow::make-progress-bar (&key value orientation (paint-border t) progress-string &allow-other-keys)
+  (let ((pbar (new "javax.swing.JProgressBar")))
+    (when value
+      (setf (widget-property pbar :value) value))
+   (when orientation
+     (setf (widget-property pbar :orientation) +swingconstant-vertical+))
+   (when (not paint-border)
+     (setf (widget-property pbar :border-painted) (jbool nil)))
+   (when progress-string
+     (setf (widget-property pbar :string-painted) (jbool t))
+     (setf (widget-property pbar :string) progress-string)
+     )
+    pbar))
 ;Text
 (defimpl snow::make-label (&key text &allow-other-keys)
   (let ((lbl (new "javax.swing.JLabel")))