Author: junrue Date: Sat Sep 9 00:39:19 2006 New Revision: 253 Modified: trunk/src/tests/uitoolkit/widget-tester.lisp trunk/src/uitoolkit/widgets/item-manager.lisp trunk/src/uitoolkit/widgets/list-box.lisp Log: implemented select-all for list-box Modified: trunk/src/tests/uitoolkit/widget-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/widget-tester.lisp (original) +++ trunk/src/tests/uitoolkit/widget-tester.lisp Sat Sep 9 00:39:19 2006 @@ -66,13 +66,13 @@ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window)))) (defun manage-lb-button-states (lb move-btn all-btn none-btn) - (let ((count (gfw:selected-count lb)) - (items (gfw:items-of lb))) - (gfw:enable move-btn (> count 0)) + (let ((sel-count (gfw:selected-count lb)) + (item-count (length (gfw:items-of lb)))) + (gfw:enable move-btn (> sel-count 0)) (if all-btn - (gfw:enable all-btn (< count (length items)))) + (gfw:enable all-btn (and (> item-count 0) (< sel-count item-count)))) (if none-btn - (gfw:enable none-btn (> count 0))))) + (gfw:enable none-btn (> sel-count 0))))) (defun move-lb-content (orig-lb dest-lb) (let ((sel-items (gfw:selected-items orig-lb))) @@ -99,16 +99,20 @@ (declare (ignore disp btn)) (move-lb-content lb2 lb1) (manage-lb-button-states lb1 btn-right btn-all btn-none) - (manage-lb-button-states lb2 btn-left btn-all btn-none))) + (manage-lb-button-states lb2 btn-left nil nil))) (btn-right-callback (lambda (disp btn) (declare (ignore disp btn)) (move-lb-content lb1 lb2) (manage-lb-button-states lb1 btn-right btn-all btn-none) - (manage-lb-button-states lb2 btn-left btn-all btn-none))) + (manage-lb-button-states lb2 btn-left nil nil))) (btn-all-callback (lambda (disp btn) - (declare (ignore disp btn)))) + (declare (ignore disp btn)) + (gfw:select-all lb1 t) + (manage-lb-button-states lb1 btn-right btn-all btn-none))) (btn-none-callback (lambda (disp btn) - (declare (ignore disp btn)))) + (declare (ignore disp btn)) + (gfw:select-all lb1 nil) + (manage-lb-button-states lb1 btn-right btn-all btn-none))) (outer-panel (make-instance 'gfw:panel :dispatcher panel-disp :parent *widget-tester-win* Modified: trunk/src/uitoolkit/widgets/item-manager.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/item-manager.lisp (original) +++ trunk/src/uitoolkit/widgets/item-manager.lisp Sat Sep 9 00:39:19 2006 @@ -102,6 +102,8 @@ (error 'gfs:disposed-error))) (defmethod delete-item ((self item-manager) index) + (if (or (< index 0) (>= index (length (slot-value self 'items)))) + (error 'gfs:toolkit-error :detail "invalid item index")) (multiple-value-bind (new-items victim) (gfs::remove-element (slot-value self 'items) index #'make-items-array) (setf (slot-value self 'items) new-items) @@ -116,10 +118,6 @@ (if (gfs:disposed-p self) (error 'gfs:disposed-error))) -(defmethod delete-span ((self item-manager) (sp gfs:span)) - (dotimes (i (1+ (- (gfs:span-end sp) (gfs:span-start sp)))) - (delete-item self (gfs:span-start sp)))) - (defmethod gfs:dispose ((self item-manager)) (let ((items (slot-value self 'items)) (tc (thread-context))) Modified: trunk/src/uitoolkit/widgets/list-box.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/list-box.lisp (original) +++ trunk/src/uitoolkit/widgets/list-box.lisp Sat Sep 9 00:39:19 2006 @@ -123,6 +123,13 @@ do (gfs:dispose item)) (enable-redraw self t))) +(defmethod delete-span ((self list-box) (span gfs:span)) + (enable-redraw self nil) + (unwind-protect + (dotimes (i (1+ (- (gfs:span-end span) (gfs:span-start span)))) + (delete-item self (gfs:span-start span))) + (enable-redraw self t))) + (defmethod initialize-instance :after ((self list-box) &key estimated-count items parent &allow-other-keys) (initialize-comctl-classes gfs::+icc-standard-classes+) (multiple-value-bind (std-style ex-style) @@ -194,6 +201,11 @@ (incf (gfs:size-width size) (vertical-scrollbar-width))) size)) +(defmethod select-all ((self list-box) flag) + (when (or (test-native-style self gfs::+lbs-extendedsel+) + (test-native-style self gfs::+lbs-multiplesel+)) + (gfs::send-message (gfs:handle self) gfs::+lb-setsel+ (if flag 1 0) #xFFFFFFFF))) + (defmethod selected-count ((self list-box)) (let ((hwnd (gfs:handle self))) (if (test-native-style self gfs::+lbs-nosel+)