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

Nikita Mamardashvili nmamardashvili at common-lisp.net
Fri Nov 27 13:58:50 UTC 2009


Author: nmamardashvili
Date: Fri Nov 27 08:58:49 2009
New Revision: 28

Log:
A little cleanup (making use of defwidget and defimpl macros).

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

Modified: trunk/src/lisp/snow/snow.lisp
==============================================================================
--- trunk/src/lisp/snow/snow.lisp	(original)
+++ trunk/src/lisp/snow/snow.lisp	Fri Nov 27 08:58:49 2009
@@ -368,13 +368,10 @@
        (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))
+
+(defwidget button text on-action)
 
-(define-widget button (text on-action &allow-other-keys) make-button)
-
-(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)
+(defwidget check-box text selected-p)
 
 ;;Misc
 
@@ -384,25 +381,14 @@
 
 (defwidget label text)
 
-; (definterface make-label *gui-backend* (&key text &allow-other-keys))
-
-; (define-widget label (text &allow-other-keys) make-label)
-
-(definterface make-text-field *gui-backend* (&key text &allow-other-keys))
+(defwidget text-field text)
 
-(define-widget text-field (text &allow-other-keys) make-text-field)
-
-(definterface make-text-area *gui-backend* (&key text &allow-other-keys))
-
-(define-widget text-area (text &allow-other-keys) make-text-area)
+(defwidget text-area text)
 
 ;;Lists
-(definterface make-list-widget *gui-backend* (&key model selected-index &allow-other-keys))
-
-(define-widget list-widget (model selected-index &allow-other-keys)
-  make-list-widget)
+
+(defwidget list-widget model selected-index)
 
 ;;Trees
-(definterface make-tree-widget *gui-backend* (&key model &allow-other-keys))
-
-(define-widget tree (model &allow-other-keys) make-tree-widget)
\ No newline at end of file
+
+(defwidget tree model)
\ No newline at end of file

Modified: trunk/src/lisp/snow/swing/swing.lisp
==============================================================================
--- trunk/src/lisp/snow/swing/swing.lisp	(original)
+++ trunk/src/lisp/snow/swing/swing.lisp	Fri Nov 27 08:58:49 2009
@@ -78,8 +78,7 @@
 	   (new "snow.FunctionRunnable" fn)))
 
 ;;Base API implementation
-(defimplementation add-child (*gui-backend* :swing)
-    (child &optional (parent *parent*) layout-constraints)
+(defimpl add-child (child &optional (parent *parent*) layout-constraints)
   (if layout-constraints
       (jcall +add-to-container-with-constraints+
 	     parent
@@ -105,13 +104,13 @@
 (defimpl (setf widget-size) (value widget)
   (invoke "setSize" widget (realpart value) (imagpart value)))
 
-(defimplementation dispose (*gui-backend* :swing) (obj)
+(defimpl dispose (obj)
   (invoke "dispose" obj))
 
-(defimplementation show (*gui-backend* :swing) (obj)
+(defimpl show (obj)
   (invoke "show" obj))
 
-(defimplementation hide (*gui-backend* :swing) (obj)
+(defimpl hide (obj)
   (invoke "hide" obj))
 
 ;;; --- Widgets --- ;;;
@@ -137,8 +136,7 @@
 					   nil nil on-close nil nil nil nil))))
     f))
 
-(defimplementation snow::make-dialog (*gui-backend* :swing)
-    (&key parent title modal-p visible-p &allow-other-keys)
+(defimpl snow::make-dialog (&key parent title modal-p visible-p &allow-other-keys)
   (let ((d (new "javax.swing.JDialog"
 		parent
 		(if modal-p
@@ -148,7 +146,7 @@
       :title title)
     d))
 
-(defimplementation pack (*gui-backend* :swing) (window)
+(defimpl pack (window)
   (jcall (jmethod "java.awt.Window" "pack") window)
   window)
 
@@ -178,8 +176,7 @@
 (defimpl snow::make-panel (&key &allow-other-keys)
   (new "javax.swing.JPanel"))
 
-(defimplementation snow::make-tabs (*gui-backend* :swing)
-    (&key (wrap t) (tab-placement :top) &allow-other-keys)
+(defimpl snow::make-tabs (&key (wrap t) (tab-placement :top) &allow-other-keys)
   (let ((tabs (new "javax.swing.JTabbedPane")))
     (invoke "setTabLayoutPolicy" tabs
 	    (if wrap
@@ -193,12 +190,12 @@
 	      (:right #.(jfield "javax.swing.JTabbedPane" "RIGHT"))))
     tabs))
 
-(defimplementation snow::make-scroll-panel (*gui-backend* :swing) (view)
+(defimpl snow::make-scroll-panel (view)
   (let ((p (new "javax.swing.JScrollPane")))
     (setf (scroll-panel-view p) view)
     p))
 
-(defimplementation snow::scroll-panel-view (*gui-backend* :swing) (self)
+(defimpl snow::scroll-panel-view (self)
   (jproperty-value self "viewportView"))
 
 (defimpl (setf snow::scroll-panel-view) (view self)
@@ -217,8 +214,7 @@
        child2))
 
 ;Buttons
-(defimplementation snow::make-button (*gui-backend* :swing)
-    (&key text on-action &allow-other-keys)
+(defimpl snow::make-button (&key text on-action &allow-other-keys)
   (let ((btn (new "javax.swing.JButton")))
     (setup-button btn text on-action)
     btn))
@@ -287,7 +283,7 @@
 (defun make-tree-model (list)
   (new "snow.tree.ConsTreeModel" list))
 
-(defimpl snow::make-tree-widget (&key model (cell-renderer (new "snow.tree.ConsTreeCellRenderer"))
+(defimpl snow::make-tree (&key model (cell-renderer (new "snow.tree.ConsTreeCellRenderer"))
 				 &allow-other-keys)
   (let ((tree (new "javax.swing.JTree")))
     (when model (setf (widget-property tree :model) model))




More information about the snow-cvs mailing list