Author: junrue Date: Sat Mar 31 23:01:47 2007 New Revision: 452
Modified: branches/graphic-forms-newtypes/src/tests/uitoolkit/widget-tester.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/flow-layout.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp Log: stop double-counting status-bar height; add additional testcase
Modified: branches/graphic-forms-newtypes/src/tests/uitoolkit/widget-tester.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/tests/uitoolkit/widget-tester.lisp (original) +++ branches/graphic-forms-newtypes/src/tests/uitoolkit/widget-tester.lisp Sat Mar 31 23:01:47 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; widget-tester.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -275,7 +275,7 @@ (setf *default-pathname-defaults* (parse-namestring gfsys::*gf-tests-dir*)) (setf *widget-tester-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'widget-tester-events) :layout (make-instance 'gfw:heap-layout) - :style '(:frame))) + :style '(:frame :status-bar))) (let* ((layout (gfw:layout-of *widget-tester-win*)) (test-panels (list (populate-list-box-test-panel) (populate-slider-test-panel)))
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/flow-layout.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/flow-layout.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/flow-layout.lisp Sat Mar 31 23:01:47 2007 @@ -122,9 +122,6 @@ (let ((kid-count (length (data-of self))) (horz-margin-total (+ (left-margin-of self) (right-margin-of self))) (vert-margin-total (+ (top-margin-of self) (bottom-margin-of self))) - (sbar-height (if (status-bar-of container) - (gfs:size-height (preferred-size (status-bar-of container) -1 -1)) - 0)) (vertical (find :vertical (style-of self))) (horizontal (find :horizontal (style-of self)))) (let ((spacing-total (* (spacing-of self) (1- kid-count))) @@ -140,16 +137,14 @@ (gfs:make-size :width (+ (flow-data-distance-total state) horz-margin-total spacing-total) - :height (- (+ (flow-data-max-extent state) - vert-margin-total) - sbar-height))) + :height (+ (flow-data-max-extent state) + vert-margin-total))) (vertical (gfs:make-size :width (+ (flow-data-max-extent state) horz-margin-total) - :height (- (+ (flow-data-distance-total state) - vert-margin-total - spacing-total) - sbar-height))) + :height (+ (flow-data-distance-total state) + vert-margin-total + spacing-total))) (t (error 'gfs:toolkit-error :detail (format nil "unrecognized flow layout style: ~a" (style-of self))))))))
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/top-level.lisp Sat Mar 31 23:01:47 2007 @@ -68,14 +68,6 @@ ;;; methods ;;;
-(defmethod compute-outer-size ((self top-level) desired-client-size) - (declare (ignore desired-client-size)) - (let ((size (call-next-method)) - (sbar (status-bar-of self))) - (if sbar - (incf (gfs:size-height size) (gfs:size-height (preferred-size sbar -1 -1)))) - size)) - (defmethod compute-style-flags ((self top-level) &rest extra-data) (declare (ignore extra-data)) (let ((std-flags 0)
Modified: branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp ============================================================================== --- branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp (original) +++ branches/graphic-forms-newtypes/src/uitoolkit/widgets/window.lisp Sat Mar 31 23:01:47 2007 @@ -75,7 +75,7 @@ (let* ((tc (thread-context)) (child (get-widget tc hwnd)) (parent (get-widget tc (cffi:make-pointer lparam)))) - (unless (or (null parent) (null child)) + (unless (or (null parent) (null child) (typep child 'status-bar)) (let ((ancestor-hwnd (gfs::get-ancestor (gfs:handle child) gfs::+ga-parent+)) (tmp-list (child-visitor-results tc))) (if (cffi:pointer-eq (gfs:handle parent) ancestor-hwnd)