Author: junrue Date: Mon Apr 2 22:37:50 2007 New Revision: 457
Modified: trunk/docs/manual/gfw-symbols.xml trunk/src/demos/unblocked/unblocked-window.lisp trunk/src/uitoolkit/widgets/control.lisp trunk/src/uitoolkit/widgets/status-bar.lisp trunk/src/uitoolkit/widgets/top-level.lisp Log: implemented new top-level style :fixed-size and modified gfw:pack to set min and max sizes when :fixed-size has been set; added another optional parameter to CREATE-CONTROL convenience function to allow control initializers to pass params to their implementations of COMPUTE-STYLE-FLAGS
Modified: trunk/docs/manual/gfw-symbols.xml ============================================================================== --- trunk/docs/manual/gfw-symbols.xml (original) +++ trunk/docs/manual/gfw-symbols.xml Mon Apr 2 22:37:50 2007 @@ -1419,6 +1419,12 @@ </enum> One or more of the following optional styles: <enum> + <argument name=":fixed-size"> + <description> + The resulting window cannot be dragged to a new size, but a layout + manager can still resize it programmatically. + </description> + </argument> <argument name=":horizontal-scrollbar"/> <argument name=":status-bar"/> <argument name=":vertical-scrollbar"/>
Modified: trunk/src/demos/unblocked/unblocked-window.lisp ============================================================================== --- trunk/src/demos/unblocked/unblocked-window.lisp (original) +++ trunk/src/demos/unblocked/unblocked-window.lisp Mon Apr 2 22:37:50 2007 @@ -112,7 +112,7 @@ :style :vertical :spacing +spacing+ :margins +margin+) - :style '(:workspace :status-bar))) + :style '(:fixed-size :workspace :status-bar))) (setf (gfw:menu-bar *unblocked-win*) menubar) (setf *scoreboard-panel* (make-instance 'scoreboard-panel :parent *unblocked-win* @@ -126,10 +126,7 @@ :buffer-size tile-buffer-size))) (setf (gfw:text *unblocked-win*) "UnBlocked")
- (setf (gfw:resizable-p *unblocked-win*) nil) - (let ((size (gfw:preferred-size *unblocked-win* -1 -1))) - (setf (gfw:minimum-size *unblocked-win*) size - (gfw:maximum-size *unblocked-win*) size)) + (gfw:pack *unblocked-win*)
(new-unblocked nil nil) (let ((*default-pathname-defaults* (parse-namestring gfsys::*unblocked-dir*)))
Modified: trunk/src/uitoolkit/widgets/control.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/control.lisp (original) +++ trunk/src/uitoolkit/widgets/control.lisp Mon Apr 2 22:37:50 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; control.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 @@ -45,10 +45,10 @@ (if (and (zerop (gfs::init-common-controls ic-ptr)) (/= (gfs::get-last-error) 0)) (warn 'gfs:win32-warning :detail "init-common-controls failed"))))
-(defun create-control (ctrl parent text icc-flags &optional id) +(defun create-control (ctrl parent text icc-flags &optional id extra-data) (initialize-comctl-classes icc-flags) (multiple-value-bind (std-style ex-style) - (compute-style-flags ctrl) + (compute-style-flags ctrl extra-data) (let ((hwnd (create-window (system-classname-of ctrl) (or text " ") (gfs:handle parent)
Modified: trunk/src/uitoolkit/widgets/status-bar.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/status-bar.lisp (original) +++ trunk/src/uitoolkit/widgets/status-bar.lisp Mon Apr 2 22:37:50 2007 @@ -104,11 +104,16 @@ (max (first widths) (second widths))))
(defmethod compute-style-flags ((self status-bar) &rest extra-data) - (declare (ignore extra-data)) - (values (logior gfs::+ws-child+ gfs::+ws-visible+ gfs::+sbars-sizegrip+) 0)) + (let ((extra-bits (if (first extra-data) 0 gfs::+sbars-sizegrip+))) + (values (logior gfs::+ws-child+ gfs::+ws-visible+ extra-bits) 0)))
(defmethod initialize-instance :after ((self status-bar) &key parent &allow-other-keys) - (let ((hctl (create-control self parent "" gfs::+icc-win95-classes+))) + (let ((hctl (create-control self + parent + "" + gfs::+icc-win95-classes+ + nil + (find :fixed-size (style-of parent))))) (gfs::send-message hctl gfs::+sb-simple+ 1 0)) (let ((widths (stb-get-border-widths self))) (setf (layout-of self) (make-instance 'flow-layout :spacing (third widths)))))
Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Mon Apr 2 22:37:50 2007 @@ -111,13 +111,10 @@
;; styles that can be combined ;; -#| - (:max (setf std-flags (logior std-flags gfs::+ws-maximizebox+))) - (:min (setf std-flags (logior std-flags gfs::+ws-minimizebox+))) - (:sysmenu (setf std-flags (logior std-flags gfs::+ws-sysmenu+))) - (:title (setf std-flags (logior std-flags gfs::+ws-caption+))) - (:top (setf ex-flags (logior ex-flags gfs::+ws-ex-topmost+))) -|# + (:fixed-size + (setf std-flags (logand std-flags + (lognot (logior gfs::+ws-maximizebox+ + gfs::+ws-thickframe+))))) (:horizontal-scrollbar (setf std-flags (logior std-flags gfs::+ws-hscroll+))) (:status-bar) ;; nothing to do, but need to allow this style symbol @@ -198,6 +195,13 @@ (when (and (maximum-size self) min-size) (update-top-level-resizability self (gfs:equal-size-p min-size (maximum-size self)))))
+(defmethod pack ((win window)) + (if (find :fixed-size (style-of win)) + (let ((size (gfw:preferred-size win -1 -1))) + (setf (gfw:minimum-size win) size + (gfw:maximum-size win) size))) + (call-next-method)) + (defmethod preferred-size ((self top-level) width-hint height-hint) (declare (ignore width-hint height-hint)) (let ((size (call-next-method))