[graphic-forms-cvs] r429 - in trunk/src: demos uitoolkit/widgets

[junrue at common-lisp.net]

Author: junrue
Date: Sat Jan 27 17:13:08 2007
New Revision: 429

Modified:
   trunk/src/demos/demo-utils.lisp
   trunk/src/uitoolkit/widgets/dialog.lisp
   trunk/src/uitoolkit/widgets/flow-layout.lisp
   trunk/src/uitoolkit/widgets/heap-layout.lisp
   trunk/src/uitoolkit/widgets/top-level.lisp
Log:
further work on coordination betweeen layout managers and status bar

Modified: trunk/src/demos/demo-utils.lisp
==============================================================================
--- trunk/src/demos/demo-utils.lisp	(original)
+++ trunk/src/demos/demo-utils.lisp	Sat Jan 27 17:13:08 2007
@@ -1,7 +1,7 @@
 ;;;;
 ;;;; demo-utils.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
@@ -63,7 +63,7 @@
                                :text " "))
          (line3 (make-instance 'gfw:label
                                :parent text-panel
-                               :text (format nil "Copyright ~c 2006 by Jack D. Unrue" (code-char 169))))
+                               :text (format nil "Copyright ~c 2006-2007 by Jack D. Unrue" (code-char 169))))
          (line4 (make-instance 'gfw:label
                                :parent text-panel
                                :text "All Rights Reserved."))

Modified: trunk/src/uitoolkit/widgets/dialog.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/dialog.lisp	(original)
+++ trunk/src/uitoolkit/widgets/dialog.lisp	Sat Jan 27 17:13:08 2007
@@ -121,12 +121,13 @@
     (gfs::set-window-long hwnd gfs::+gwlp-id+ gfs::+idcancel+)
     (update-native-style cancel-widget style)))
 
-(defmethod client-size ((self dialog))
-  (let ((sbar (status-bar-of self))
-        (client-size (call-next-method)))
+(defmethod compute-outer-size ((self dialog) desired-client-size)
+  (declare (ignore desired-client-size))
+  (let ((size (call-next-method))
+        (sbar (status-bar-of self)))
     (if sbar
-      (decf (gfs:size-height client-size) (gfs:size-height (preferred-size sbar -1 -1))))
-    client-size))
+      (incf (gfs:size-height size) (gfs:size-height (preferred-size sbar -1 -1))))
+    size))
 
 (defmethod default-widget :before ((self dialog))
   (if (gfs:disposed-p self)
@@ -208,6 +209,14 @@
   ;;
   (init-window self *dialog-classname* #'register-dialog-class owner text))
 
+(defmethod preferred-size ((self dialog) width-hint height-hint)
+  (declare (ignore width-hint height-hint))
+  (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 show ((self dialog) flag)
   (let ((app-modal (find :application-modal (style-of self)))
         (owner-modal (find :owner-modal (style-of self)))

Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/flow-layout.lisp	(original)
+++ trunk/src/uitoolkit/widgets/flow-layout.lisp	Sat Jan 27 17:13:08 2007
@@ -1,7 +1,7 @@
 ;;;;
 ;;;; flow-layout.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

Modified: trunk/src/uitoolkit/widgets/heap-layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/heap-layout.lisp	(original)
+++ trunk/src/uitoolkit/widgets/heap-layout.lisp	Sat Jan 27 17:13:08 2007
@@ -1,7 +1,7 @@
 ;;;;
 ;;;; heap-layout.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
@@ -63,21 +63,22 @@
     size))
 
 (defmethod compute-layout ((self heap-layout) (container layout-managed) width-hint height-hint)
+  (declare (ignore width-hint height-hint))
   (cleanup-disposed-items self)
-  (let* ((size (client-size container))
-         (horz-margin (+ (left-margin-of self) (right-margin-of self)))
-         (vert-margin (+ (top-margin-of self) (bottom-margin-of self)))
-         (bounds (gfs:create-rectangle :x (left-margin-of self)
-                                       :y (top-margin-of self)
-                                       :width (- (if (> width-hint horz-margin)
-                                                   width-hint
-                                                   (gfs:size-width size))
-                                                 horz-margin)
-                                       :height (- (if (> height-hint vert-margin)
-                                                    height-hint
-                                                    (gfs:size-height size))
-                                                  vert-margin))))
-    (mapcar (lambda (item) (cons (first item) bounds)) (data-of self))))
+  (let ((size (client-size container))
+        (sbar (if (or (typep container 'top-level) (typep container 'dialog))
+                (status-bar-of container))))
+    (if sbar
+      (decf (gfs:size-height size) (gfs:size-height (preferred-size sbar -1 -1))))
+    (let* ((horz-margin (+ (left-margin-of self) (right-margin-of self)))
+           (vert-margin (+ (top-margin-of self) (bottom-margin-of self)))
+           (bounds (gfs:create-rectangle :x (left-margin-of self)
+                                         :y (top-margin-of self)
+                                         :width (- (gfs:size-width size)
+                                                   horz-margin)
+                                         :height (- (gfs:size-height size)
+                                                    vert-margin))))
+      (mapcar (lambda (item) (cons (first item) bounds)) (data-of self)))))
 
 (defmethod perform ((self heap-layout) (container layout-managed) width-hint height-hint)
   (if (layout-p container)

Modified: trunk/src/uitoolkit/widgets/top-level.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/top-level.lisp	(original)
+++ trunk/src/uitoolkit/widgets/top-level.lisp	Sat Jan 27 17:13:08 2007
@@ -68,12 +68,13 @@
 ;;; methods
 ;;;
 
-(defmethod client-size ((self top-level))
-  (let ((sbar (status-bar-of self))
-        (client-size (call-next-method)))
+(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
-      (decf (gfs:size-height client-size) (gfs:size-height (preferred-size sbar -1 -1))))
-    client-size))
+      (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))
@@ -204,6 +205,14 @@
   (when (and (maximum-size self) min-size)
     (update-top-level-resizability self (gfs:equal-size-p min-size (maximum-size self)))))
 
+(defmethod preferred-size ((self top-level) width-hint height-hint)
+  (declare (ignore width-hint height-hint))
+  (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 print-object ((self top-level) stream)
   (print-unreadable-object (self stream :type t)
     (format stream "handle: ~x " (gfs:handle self))