Author: junrue Date: Tue Mar 14 01:20:02 2006 New Revision: 40

Modified: trunk/src/packages.lisp trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/tests/uitoolkit/layout-unit-tests.lisp trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/flow-layout.lisp trunk/src/uitoolkit/widgets/layout-classes.lisp trunk/src/uitoolkit/widgets/menu-item.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: implemented widget and menu item enabling/disabling; implemented flow layout spacing

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Tue Mar 14 01:20:02 2006 @@ -448,6 +448,7 @@ #:show-selection #:shutdown #:size + #:spacing-of #:startup #:step-increment #:style-of

Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Tue Mar 14 01:20:02 2006 @@ -36,6 +36,7 @@ (defconstant +btn-text-before+ "Push Me") (defconstant +btn-text-after+ "Again!") (defconstant +label-text+ "Test Label") +(defconstant +spacing-delta+ 3)

(defvar *widget-counter* 0)

@@ -157,7 +158,7 @@ (gfw:show victim (not (gfw:visible-p victim))) (gfw:layout *layout-tester-win*))))

-(defun check-flow-orient-item (disp menu time) +(defun check-flow-orient-items (disp menu time) (declare (ignore disp time)) (let ((layout (gfw:layout-of *layout-tester-win*))) (gfw:check (gfw:item-at menu 0) (find :horizontal (gfw:style-of layout))) @@ -190,6 +191,26 @@ (setf (gfw:style-of layout) (push :wrap style))) (gfw:layout *layout-tester-win*)))

+(defun enable-flow-spacing-items (disp menu time) + (declare (ignore disp time)) + (let ((spacing (gfw:spacing-of (gfw:layout-of *layout-tester-win*)))) + (gfw:enable (gfw:item-at menu 0) (> spacing 0)))) + +(defun decrease-flow-spacing (disp item time rect) + (declare (ignore disp item time rect)) + (let* ((layout (gfw:layout-of *layout-tester-win*)) + (spacing (gfw:spacing-of layout))) + (unless (zerop spacing) + (decf spacing +spacing-delta+) + (setf (gfw:spacing-of layout) spacing) + (gfw:layout *layout-tester-win*)))) + +(defun increase-flow-spacing (disp item time rect) + (declare (ignore disp item time rect)) + (let ((layout (gfw:layout-of *layout-tester-win*))) + (incf (gfw:spacing-of layout) +spacing-delta+) + (gfw:layout *layout-tester-win*))) + (defun flow-mod-callback (disp menu time) (declare (ignore disp time)) (gfw:clear-all menu) @@ -210,11 +231,13 @@ :callback #'set-flow-horizontal) (:item "Vertical" :callback #'set-flow-vertical)))) - (spacing-menu (gfw:defmenusystem ((:item "Decrease") - (:item "Increase"))))) + (spacing-menu (gfw:defmenusystem ((:item "Decrease" + :callback #'decrease-flow-spacing) + (:item "Increase" + :callback #'increase-flow-spacing))))) (gfw:append-submenu menu "Margin" margin-menu nil) - (gfw:append-submenu menu "Orientation" orient-menu #'check-flow-orient-item) - (gfw:append-submenu menu "Spacing" spacing-menu nil) + (gfw:append-submenu menu "Orientation" orient-menu #'check-flow-orient-items) + (gfw:append-submenu menu "Spacing" spacing-menu #'enable-flow-spacing-items) (setf it (gfw:append-item menu "Wrap" nil #'set-flow-layout-wrap)) (gfw:check it (find :wrap (gfw:style-of (gfw:layout-of *layout-tester-win*))))))

@@ -233,7 +256,8 @@ (vis-menu-disp (make-instance 'child-menu-dispatcher :sub-disp-class 'visibility-child-dispatcher :check-test-fn #'gfw:visible-p))) (setf *layout-tester-win* (make-instance 'gfw:window :dispatcher (make-instance 'layout-tester-events) - :layout (make-instance 'gfw:flow-layout))) + :layout (make-instance 'gfw:flow-layout + :spacing +spacing-delta+))) (gfw:realize *layout-tester-win* nil :style-workspace) (setf menubar (gfw:defmenusystem ((:item "&File" :submenu ((:item "E&xit"

Modified: trunk/src/tests/uitoolkit/layout-unit-tests.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-unit-tests.lisp (original) +++ trunk/src/tests/uitoolkit/layout-unit-tests.lisp Tue Mar 14 01:20:02 2006 @@ -53,6 +53,8 @@ (define-test flow-layout-test1 ;; orient: horizontal ;; wrap: disabled + ;; spacing: 0 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 ;; container: unrestricted width and height ;; kids: uniform ;; @@ -67,6 +69,8 @@ (define-test flow-layout-test2 ;; orient: vertical ;; wrap: disabled + ;; spacing: 0 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 ;; container: unrestricted width and height ;; kids: uniform ;; @@ -81,6 +85,8 @@ (define-test flow-layout-test3 ;; orient: horizontal ;; wrap: enabled + ;; spacing: 0 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 ;; container: restricted width, unrestricted height ;; kids: uniform ;; @@ -92,6 +98,8 @@ (define-test flow-layout-test4 ;; orient: vertical ;; wrap: enabled + ;; spacing: 0 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 ;; container: unrestricted width, restricted height ;; kids: uniform ;; @@ -103,6 +111,8 @@ (define-test flow-layout-test5 ;; orient: horizontal ;; wrap: enabled + ;; spacing: 0 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 ;; container: restricted width and height ;; kids: uniform ;; @@ -114,6 +124,8 @@ (define-test flow-layout-test6 ;; orient: vertical ;; wrap: enabled + ;; spacing: 0 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 ;; container: restricted width and height ;; kids: uniform ;; @@ -121,3 +133,61 @@ (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 30 25)) (expected-rects '((0 0 20 10) (0 10 20 10) (20 0 20 10)))) (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test7 + ;; orient: horizontal + ;; wrap: disabled + ;; spacing: 4 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 + ;; container: unrestricted width and height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :spacing 4 :style '(:horizontal))) + (size (gfw::flow-container-size layout t *flow-layout-uniform-kids* -1 -1)) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* -1 -1)) + (expected-rects '((0 0 20 10) (24 0 20 10) (48 0 20 10)))) + (assert-equal 68 (gfi:size-width size)) + (assert-equal 10 (gfi:size-height size)) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test8 + ;; orient: vertical + ;; wrap: disabled + ;; spacing: 4 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 + ;; container: unrestricted width and height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :spacing 4 :style '(:vertical))) + (size (gfw::flow-container-size layout t *flow-layout-uniform-kids* -1 -1)) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* -1 -1)) + (expected-rects '((0 0 20 10) (0 14 20 10) (0 28 20 10)))) + (assert-equal 20 (gfi:size-width size)) + (assert-equal 38 (gfi:size-height size)) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test9 + ;; orient: horizontal + ;; wrap: enabled + ;; spacing: 4 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 + ;; container: restricted width and height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :spacing 4 :style '(:horizontal :wrap))) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 45 18)) + (expected-rects '((0 0 20 10) (24 0 20 10) (0 14 20 10)))) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test10 + ;; orient: vertical + ;; wrap: enabled + ;; spacing: 4 + ;; left-margin: 0, top-margin: 0, right-margin: 0, bottom-margin: 0 + ;; container: restricted width and height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :spacing 4 :style '(:vertical :wrap))) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 30 25)) + (expected-rects '((0 0 20 10) (0 14 20 10) (24 0 20 10)))) + (validate-layout-rects data expected-rects)))

Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Tue Mar 14 01:20:02 2006 @@ -128,6 +128,19 @@ (hwnd HANDLE))

(defcfun + ("EnableMenuItem" enable-menu-item) + BOOL + (hmenu HANDLE) + (id UINT) + (flag UINT)) + +(defcfun + ("EnableWindow" enable-window) + BOOL + (hwnd HANDLE) + (enable BOOL)) + +(defcfun ("EndDeferWindowPos" end-defer-window-pos) BOOL (posinfo HANDLE)) @@ -303,6 +316,11 @@ (erase BOOL))

(defcfun + ("IsWindowEnabled" is-window-enabled) + BOOL + (hwnd HANDLE)) + +(defcfun ("IsWindowVisible" is-window-visible) BOOL (hwnd HANDLE))

Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/flow-layout.lisp (original) +++ trunk/src/uitoolkit/widgets/flow-layout.lisp Tue Mar 14 01:20:02 2006 @@ -55,6 +55,10 @@ (incf total (gfi:size-width size)) (if (< max (gfi:size-height size)) (setf max (gfi:size-height size)))))))) + (if (< (spacing-of layout) 0) + (error 'gfs:toolkit-error :detail "layout spacing must be non-negative")) + (unless (null kids) + (incf total (* (spacing-of layout) (1- (length kids))))) (if vert-orient (gfi:make-size :width max :height total) (gfi:make-size :width total :height max)))) @@ -65,9 +69,12 @@ (max-size -1) (next-coord 0) (wrap-coord 0) + (spacing (spacing-of layout)) (style (style-of layout)) (vert-orient (find :vertical style)) (wrap (find :wrap style))) + (if (< spacing 0) + (error 'gfs:toolkit-error :detail "layout spacing must be non-negative")) (loop for kid in kids do (let ((size (preferred-size kid -1 -1)) (pnt (gfi:make-point))) @@ -80,13 +87,13 @@ (push (reverse curr-flow) flows) (setf curr-flow nil) (setf next-coord 0) - (incf wrap-coord max-size) + (incf wrap-coord (+ max-size spacing)) (setf max-size -1)) (setf (gfi:point-x pnt) wrap-coord) (setf (gfi:point-y pnt) next-coord) (if (< max-size (gfi:size-width size)) (setf max-size (gfi:size-width size))) - (incf next-coord (gfi:size-height size))) + (incf next-coord (+ (gfi:size-height size) spacing))) (progn (when (and wrap (>= width-hint 0) @@ -94,13 +101,13 @@ (push (reverse curr-flow) flows) (setf curr-flow nil) (setf next-coord 0) - (incf wrap-coord max-size) + (incf wrap-coord (+ max-size spacing)) (setf max-size -1)) (setf (gfi:point-x pnt) next-coord) (setf (gfi:point-y pnt) wrap-coord) (if (< max-size (gfi:size-height size)) (setf max-size (gfi:size-height size))) - (incf next-coord (gfi:size-width size)))) + (incf next-coord (+ (gfi:size-width size) spacing)))) (push (cons kid (make-instance 'gfi:rectangle :size size :location pnt)) curr-flow)))) (unless (null curr-flow) (push (reverse curr-flow) flows))

Modified: trunk/src/uitoolkit/widgets/layout-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layout-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/layout-classes.lisp Tue Mar 14 01:20:02 2006 @@ -40,5 +40,9 @@ :initform nil)) (:documentation "Subclasses implement layout strategies on behalf of window objects."))

-(defclass flow-layout (layout-manager) () +(defclass flow-layout (layout-manager) + ((spacing + :accessor spacing-of + :initarg :spacing + :initform 0)) (:documentation "Window children are arranged in a row or column."))

Modified: trunk/src/uitoolkit/widgets/menu-item.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/menu-item.lisp (original) +++ trunk/src/uitoolkit/widgets/menu-item.lisp Tue Mar 14 01:20:02 2006 @@ -37,6 +37,30 @@ ;;; helper functions ;;;

+(defun get-menuitem-state (hmenu mid) + (cffi:with-foreign-object (mii-ptr 'gfs::menuiteminfo) + (cffi:with-foreign-slots ((gfs::cbsize gfs::mask gfs::type + gfs::state gfs::id gfs::hsubmenu + gfs::hbmpchecked gfs::hbmpunchecked + gfs::idata gfs::tdata gfs::cch + gfs::hbmpitem) + mii-ptr gfs::menuiteminfo) + (setf gfs::cbsize (cffi:foreign-type-size 'gfs::menuiteminfo)) + (setf gfs::mask (logior gfs::+miim-id+ gfs::+miim-state+)) + (setf gfs::type 0) + (setf gfs::state 0) + (setf gfs::id mid) + (setf gfs::hsubmenu (cffi:null-pointer)) + (setf gfs::hbmpchecked (cffi:null-pointer)) + (setf gfs::hbmpunchecked (cffi:null-pointer)) + (setf gfs::idata 0) + (setf gfs::tdata (cffi:null-pointer)) + (setf gfs::cch 0) + (setf gfs::hbmpitem (cffi:null-pointer)) + (if (zerop (gfs::get-menu-item-info hmenu mid 0 mii-ptr)) + (error 'gfs:win32-error :detail "get-menu-item-info failed")) + gfs::state))) + (defun get-menuitem-text (hmenu mid) (cffi:with-foreign-object (mii-ptr 'gfs::menuiteminfo) (cffi:with-foreign-slots ((gfs::cbsize gfs::mask gfs::type @@ -58,7 +82,7 @@ (setf gfs::cch 0) (setf gfs::hbmpitem (cffi:null-pointer)) (if (zerop (gfs::get-menu-item-info hmenu mid 0 mii-ptr)) - (error 'gfs::win32-error :detail "get-menu-item-info failed")) + (error 'gfs:win32-error :detail "get-menu-item-info failed")) (incf gfs::cch) (let ((str-ptr (cffi:foreign-alloc :char :count gfs::cch)) (result "")) @@ -66,7 +90,7 @@ (progn (setf gfs::tdata str-ptr) (if (zerop (gfs::get-menu-item-info hmenu mid 0 mii-ptr)) - (error 'gfs::win32-error :detail "get-menu-item-info failed")) + (error 'gfs:win32-error :detail "get-menu-item-info failed")) (setf result (cffi:foreign-string-to-lisp str-ptr)) (cffi:foreign-free str-ptr))) result)))) @@ -184,9 +208,17 @@ (setf (item-id it) 0) (setf (slot-value it 'gfi:handle) nil)))

-(defmethod enable ((item menu-item) flag) - ;; FIXME: need to implement -) +(defmethod enable ((it menu-item) flag) + (let ((bits 0)) + (if flag + (setf bits (logior gfs::+mf-bycommand+ gfs::+mfs-enabled+)) + (setf bits (logior gfs::+mf-bycommand+ gfs::+mfs-grayed+))) + (gfs::enable-menu-item (gfi:handle it) (item-id it) bits))) + +(defmethod enabled-p ((it menu-item)) + (= (logand (get-menuitem-state (gfi:handle it) (item-id it)) + gfs::+mfs-enabled+) + gfs::+mfs-enabled+))

(defmethod item-owner ((it menu-item)) (let ((hmenu (gfi:handle it)))

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Tue Mar 14 01:20:02 2006 @@ -105,6 +105,21 @@ (error 'gfs:win32-error :detail "destroy-window failed")))) (setf (slot-value w 'gfi:handle) nil))

+(defmethod enable :before ((w widget) flag) + (declare (ignore flag)) + (if (gfi:disposed-p w) + (error 'gfi:disposed-error))) + +(defmethod enable ((w widget) flag) + (gfs::enable-window (gfi:handle w) (if (null flag) 0 1))) + +(defmethod enabled-p :before ((w widget)) + (if (gfi:disposed-p w) + (error 'gfi:disposed-error))) + +(defmethod enabled-p ((w widget)) + (not (zerop (gfs::is-window-enabled (gfi:handle w))))) + (defmethod location :before ((w widget)) (if (gfi:disposed-p w) (error 'gfi:disposed-error)))