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))