[graphic-forms-cvs] r255 - in trunk/src: tests/uitoolkit uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Sun Sep 10 18:59:22 2006
New Revision: 255

Modified:
   trunk/src/tests/uitoolkit/widget-tester.lisp
   trunk/src/uitoolkit/widgets/list-item.lisp
Log:
implemented select and selected-p for list-item

Modified: trunk/src/tests/uitoolkit/widget-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/widget-tester.lisp	(original)
+++ trunk/src/tests/uitoolkit/widget-tester.lisp	Sun Sep 10 18:59:22 2006
@@ -85,7 +85,9 @@
 (defun select-lb-content (lb state)
   (let ((count (gfw:item-count lb))
         (func (if state #'gfw::lb-select-item #'gfw::lb-deselect-item)))
-    (loop for index in '(0 2 4)
+    (if (> count 0)
+      (gfw:select (first (gfw:items-of lb)) state))
+    (loop for index in '(2 4)
           when (>= count (1+ index))
           do (funcall func lb index))))
 #|

Modified: trunk/src/uitoolkit/widgets/list-item.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/list-item.lisp	(original)
+++ trunk/src/uitoolkit/widgets/list-item.lisp	Sun Sep 10 18:59:22 2006
@@ -77,6 +77,16 @@
           (gfs::send-message hwnd gfs::+lb-deletestring+ (item-index owner self) 0)))))
   (call-next-method))
 
+(defmethod select ((self list-item) flag)
+  (let ((owner (owner self)))
+    (if flag
+      (lb-select-item owner (item-index owner self))
+      (lb-deselect-item owner (item-index owner self)))))
+
+(defmethod selected-p ((self list-item))
+  (let ((owner (owner self)))
+    (> (gfs::send-message (gfs:handle self) gfs::+lb-getsel+ (item-index owner self) 0) 0)))
+
 (defmethod text ((self list-item))
   (let ((hwnd (gfs:handle self)))
     (if (or (null hwnd) (cffi:null-pointer-p hwnd))