[graphic-forms-cvs] r452 - in branches/graphic-forms-newtypes/src: tests/uitoolkit uitoolkit/widgets

[junrue at common-lisp.net]

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)