Author: junrue Date: Thu Apr 13 15:14:13 2006 New Revision: 95
Modified: trunk/docs/manual/api.texinfo trunk/src/demos/unblocked/unblocked-window.lisp trunk/src/packages.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/system/system-types.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/top-level.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp Log: implemented maximum-size and minimum-size slots for top-level windows so apps can constrain resizing by the user
Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Thu Apr 13 15:14:13 2006 @@ -301,7 +301,15 @@ @deftp Class top-level Base class for @ref{window}s that are self-contained and parented to the @ref{root-window}. Except for the @code{:palette} style, they are -normally resizable have title bars (also called 'captions'). +normally resizable and have title bars (also called 'captions'). +@deffn Initarg :maximum-size +Sets the maximum @ref{size} to which the user may adjust the +boundaries of the window. +@end deffn +@deffn Initarg :minimum-size +Sets the minimum @ref{size} to which the user may adjust the +boundaries of the window. +@end deffn @deffn Initarg :style The :style initarg is a list of keywords that define the overall look-and-feel of the window being created. Applications may choose @@ -553,14 +561,35 @@ @end deffn
@deffn GenericFunction location self -Returns a point object describing the coordinates of the top-left -corner of the object in its parent's coordinate system. @xref{parent}. +Returns a @ref{point} object describing the coordinates of the +top-left corner of the object in its parent's coordinate +system. @xref{parent}. +@end deffn + +@anchor{maximum-size} +@deffn GenericFunction maximum-size self +Returns a @ref{size} object describing the largest dimensions to which +the user may resize this widget; by default returns @code{nil}, +indicating that there is effectively no constraint. The corresponding +@code{setf} function sets this value; if the new maximum size is +smaller than the current size, the widget is resized to the new +maximum. @xref{minimum-size}. @end deffn
@deffn GenericFunction menu-bar self Returns the menu object serving as the menubar for this object. @end deffn
+@anchor{minimum-size} +@deffn GenericFunction minimum-size self +Returns a @ref{size} object describing the smallest dimensions to +which the user may resize this widget; by default returns @code{nil}, +indicating that the minimum constraint is determined by the windowing +system's configuration. The corresponding @code{setf} function sets +this value; if the new minimum size is larger than the current size, +the widget is resized to the new minimum. @xref{maximum-size}. +@end deffn + @deffn GenericFunction object-to-display self pnt Return a point that is the result of transforming the specified point from this object's coordinate system to display-relative coordinates. @@ -625,6 +654,7 @@ @end quotation @end deffn
+@anchor{preferred-size} @deffn GenericFunction preferred-size self width-hint height-hint Implement this function to return @code{self}'s preferred @ref{size}; that is, the dimensions that @code{self} computes as being the best
Modified: trunk/src/demos/unblocked/unblocked-window.lisp ============================================================================== --- trunk/src/demos/unblocked/unblocked-window.lisp (original) +++ trunk/src/demos/unblocked/unblocked-window.lisp Thu Apr 13 15:14:13 2006 @@ -108,7 +108,9 @@ :dispatcher (make-instance 'tiles-panel-events :buffer-size tile-buffer-size))) (setf (gfw:text *unblocked-win*) "Graphic-Forms UnBlocked") - (gfw:pack *unblocked-win*) + (let ((size (gfw:preferred-size *unblocked-win* -1 -1))) + (setf (gfw:minimum-size *unblocked-win*) size) + (setf (gfw:maximum-size *unblocked-win*) size)) (gfw:show *unblocked-win* t)))
(defun unblocked ()
Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Thu Apr 13 15:14:13 2006 @@ -232,9 +232,6 @@ #:window
;; constants - #:maximized ;; FIXME: should be a keyword - #:minimized ;; FIXME: should be a keyword - #:restored ;; FIXME: should be a keyword #:+vk-break+ #:+vk-backspace+ #:+vk-tab+
Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Thu Apr 13 15:14:13 2006 @@ -661,6 +661,7 @@ (defconstant +wm-activate+ #x0006) (defconstant +wm-paint+ #x000F) (defconstant +wm-close+ #x0010) +(defconstant +wm-getminmaxinfo+ #x0024) (defconstant +wm-setfont+ #x0030) (defconstant +wm-getfont+ #x0031) (defconstant +wm-ncmousemove+ #x00A0)
Modified: trunk/src/uitoolkit/system/system-types.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-types.lisp (original) +++ trunk/src/uitoolkit/system/system-types.lisp Thu Apr 13 15:14:13 2006 @@ -169,6 +169,13 @@ (x LONG) (y LONG))
+(defcstruct minmaxinfo + (reserved point) + (maxsize point) + (maxposition point) + (mintracksize point) + (maxtracksize point)) + (defcstruct msg (hwnd HANDLE) (message UINT)
Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Thu Apr 13 15:14:13 2006 @@ -298,7 +298,7 @@ :y gfs::rcpaint-y)) (setf (gfs:size rct) (gfs:make-size :width gfs::rcpaint-width :height gfs::rcpaint-height)) - (let* ((gc (make-instance 'gfg:graphics-context :handle (gfs::begin-paint hwnd ps-ptr)))) + (let ((gc (make-instance 'gfg:graphics-context :handle (gfs::begin-paint hwnd ps-ptr)))) (unwind-protect (event-paint (dispatcher widget) widget (event-time tc) gc rct) (gfs:dispose gc) @@ -318,14 +318,42 @@ (declare (ignore wparam)) (process-mouse-message #'event-mouse-up hwnd lparam :right-button))
+(defmethod process-message (hwnd (msg (eql gfs::+wm-getminmaxinfo+)) wparam lparam) + (declare (ignore wparam)) + (let* ((tc (thread-context)) + (w (get-widget tc hwnd)) + (info-ptr (cffi:make-pointer lparam))) + (if (typep w 'top-level) + (cffi:with-foreign-slots ((gfs::mintracksize gfs::maxtracksize) + info-ptr gfs::minmaxinfo) + (let ((max-size (maximum-size w)) + (min-size (minimum-size w))) + (if max-size + (cffi:with-foreign-slots ((gfs::x gfs::y) + (cffi:foreign-slot-pointer info-ptr + 'gfs::minmaxinfo + 'gfs::maxtracksize) + gfs::point) + (setf gfs::x (gfs:size-width max-size) + gfs::y (gfs:size-height max-size)))) + (if min-size + (cffi:with-foreign-slots ((gfs::x gfs::y) + (cffi:foreign-slot-pointer info-ptr + 'gfs::minmaxinfo + 'gfs::mintracksize) + gfs::point) + (setf gfs::x (gfs:size-width min-size) + gfs::y (gfs:size-height min-size)))))))) + 0) + (defmethod process-message (hwnd (msg (eql gfs::+wm-size+)) wparam lparam) (declare (ignore lparam)) (let* ((tc (thread-context)) (w (get-widget tc hwnd)) (type (cond - ((= wparam gfs::+size-maximized+) 'maximized) - ((= wparam gfs::+size-minimized+) 'minimized) - ((= wparam gfs::+size-restored+) 'restored) + ((= wparam gfs::+size-maximized+) :maximized) + ((= wparam gfs::+size-minimized+) :minimized) + ((= wparam gfs::+size-restored+) :restored) (t nil)))) (when w (outer-size w (size-event-size tc))
Modified: trunk/src/uitoolkit/widgets/top-level.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/top-level.lisp (original) +++ trunk/src/uitoolkit/widgets/top-level.lisp Thu Apr 13 15:14:13 2006 @@ -54,6 +54,11 @@ gfs::+cs-dblclks+ -1))
+(defun constrain-new-size (new-size current-size compare-fn) + (let ((new-width (funcall compare-fn (gfs:size-width new-size) (gfs:size-width current-size))) + (new-height (funcall compare-fn (gfs:size-height new-size) (gfs:size-height current-size)))) + (gfs:make-size :width new-width :height new-height))) + ;;; ;;; methods ;;; @@ -73,8 +78,6 @@ (setf std-flags (logior std-flags gfs::+ws-maximizebox+))) ((eq sym :min) (setf std-flags (logior std-flags gfs::+ws-minimizebox+))) - ((eq sym :resize) - (setf std-flags (logior std-flags gfs::+ws-thickframe+))) ((eq sym :sysmenu) (setf std-flags (logior std-flags gfs::+ws-sysmenu+))) ((eq sym :title) @@ -152,6 +155,12 @@ (error 'gfs:toolkit-error :detail "no object for menu handle")) m)))
+(defmethod (setf maximum-size) :after (max-size (win top-level)) + (unless (gfs:disposed-p win) + (let ((size (constrain-new-size max-size (size win) #'min))) + (setf (size win) size) + (perform-layout win (gfs:size-width size) (gfs:size-height size))))) + (defmethod (setf menu-bar) :before ((m menu) (win top-level)) (declare (ignore m)) (if (gfs:disposed-p win) @@ -168,6 +177,12 @@ (gfs::set-menu hwnd (gfs:handle m)) (gfs::draw-menu-bar hwnd)))
+(defmethod (setf minimum-size) :after (min-size (win top-level)) + (unless (gfs:disposed-p win) + (let ((size (constrain-new-size min-size (size win) #'max))) + (setf (size win) size) + (perform-layout win (gfs:size-width size) (gfs:size-height size))))) + (defmethod text :before ((win top-level)) (if (gfs:disposed-p win) (error 'gfs:disposed-error)))
Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Thu Apr 13 15:14:13 2006 @@ -100,7 +100,15 @@ (defclass root-window (window) () (:documentation "This class encapsulates the root of the desktop window hierarchy."))
-(defclass top-level (window) () +(defclass top-level (window) + ((maximum-size + :accessor maximum-size + :initarg :maximum-size + :initform nil) + (minimum-size + :accessor minimum-size + :initarg :minimum-size + :initform nil)) (:documentation "Base class for windows that can be moved and resized by the user, and which normally have title bars."))
(defclass timer (event-source)
Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Thu Apr 13 15:14:13 2006 @@ -217,7 +217,7 @@ (:documentation "Returns T if the object is in its maximized state (not necessarily the same as the maximum size); nil otherwise."))
(defgeneric maximum-size (self) - (:documentation "Returns a size object describing the largest size this object can exist.")) + (:documentation "Returns a size object describing the largest dimensions to which the user may resize the widget."))
(defgeneric menu-bar (self) (:documentation "Returns the menu object serving as the menubar for this object."))