Author: junrue Date: Thu Aug 17 18:53:32 2006 New Revision: 219

Modified: trunk/docs/manual/widgets-api.texinfo trunk/src/uitoolkit/widgets/heap-layout.lisp trunk/src/uitoolkit/widgets/layout.lisp Log: refactored gfw:perform implementations

Modified: trunk/docs/manual/widgets-api.texinfo ============================================================================== --- trunk/docs/manual/widgets-api.texinfo (original) +++ trunk/docs/manual/widgets-api.texinfo Thu Aug 17 18:53:32 2006 @@ -694,14 +694,16 @@ @node layout types @subsection layout types

-@strong{NOTE:} A future release will provide additional layout -manager classes. - @anchor{flow-layout} @deftp Class flow-layout spacing -This @ref{layout-manager} subclass arranges dialog or window children -in a row or column, with optional spacing (specified in pixels) -between children. +This @ref{layout-manager} subclass arranges container children +in a row or column. There are no child-specific layout attributes +defined for this class. +@table @var +@item spacing +A pixel value specifying how far apart each child should be from +the next. +@end table @deffn Initarg :style This initarg accepts a list containing one of the following style keywords: @@ -725,13 +727,15 @@ @anchor{heap-layout} @deftp Class heap-layout top-child This @ref{layout-manager} subclass resizes all children to the same -size and stacks them on top of each other. -@deffn Initarg :top-child +size and stacks them on top of each other. There are no child-specific +layout attributes defined for this class. +@table @var +@item top-child Use this initarg to specify the child widget that should be visible. The corresponding accessor @code{top-child-of} can be set subsequently, followed by calling @ref{layout} on the container, in order to make a different child visible. -@end deffn +@end table @end deftp

@anchor{layout-manager} @@ -1741,11 +1745,12 @@ @anchor{layout-attribute} @defun layout-attribute @ref{layout-manager} thing symbol => value (setf (@strong{layout-attribute} @var{layout-manager} @var{thing} @var{symbol}) @var{value})@*@* -This function returns @var{value} if the attribute named by @var{symbol} -is set in @var{layout-manager}; @sc{nil} otherwise. The corresponding -@sc{setf} function allows the attribute to be set. Each layout-manager -subclass supports 0 or more attributes that apply to each @var{thing}. -This function does not restrict application code +Each layout-manager subclass supports 0 or more attributes that apply +to each @var{thing}. This function returns @var{value} if the attribute +named by @var{symbol} is set for @var{thing} in @var{layout-manager}; +it returns @sc{nil} otherwise. The corresponding @sc{setf} function +allows the attribute to be set (note: call @ref{layout} on @var{container} +after doing so). This function does not restrict application code from querying or setting attributes that are not supported by the layout manager. @table @var @@ -1763,22 +1768,22 @@ @end defun

@anchor{perform} -@deffn GenericFunction perform @var{layout-manager} container width-hint height-hint -Calls @ref{compute-layout} for @code{container} and then moves and -resizes @code{container}'s children. Layout subclasses may override +@deffn GenericFunction perform @ref{layout-manager} @ref{layout-managed} width-hint height-hint +Calls @ref{compute-layout} for @var{layout-managed} and then moves and +resizes @var{layout-managed}'s children. Subclasses may override this method -- however, most derivations should call @sc{CALL-NEXT-METHOD} to allow the base implementation to execute. @table @var @item layout-manager -The layout object dictating how children of @var{container} +The layout object dictating how children of @var{layout-managed} are to be arranged. @item container -The @var{layout-manager} arranges the elements of @var{container}. +The @var{layout-manager} arranges the elements of @var{layout-managed}. @item width-hint -A hypothetical width value, or negative if @var{container}'s width is +A hypothetical width value, or negative if @var{layout-managed}'s width is not constrained. @item height-hint -A hypothetical height value, or negative if @var{container}'s height is +A hypothetical height value, or negative if @var{layout-managed}'s height is not constrained. @end table @end deffn

Modified: trunk/src/uitoolkit/widgets/heap-layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/heap-layout.lisp (original) +++ trunk/src/uitoolkit/widgets/heap-layout.lisp Thu Aug 17 18:53:32 2006 @@ -69,38 +69,11 @@ (cons kid bounds)))))

(defmethod perform ((self heap-layout) (container layout-managed) width-hint height-hint) - (let ((kids nil) - (hdwp (cffi:null-pointer)) - (top (top-child-of self))) - (when (layout-p container) - (setf kids (compute-layout self container width-hint height-hint)) - (unless top - (setf top (car (first kids)))) - (setf hdwp (gfs::begin-defer-window-pos (length kids))) - (loop for k in kids - do (let* ((rect (cdr k)) - (sz (gfs:size rect)) - (pnt (gfs:location rect)) - (kid-win (car k)) - (hwnd-after (cffi:null-pointer)) - (flags (logior +window-pos-flags+ gfs::+swp-hidewindow+))) - (when (cffi:pointer-eq (gfs:handle kid-win) (gfs:handle top)) - (setf flags (logior +window-pos-flags+ gfs::+swp-showwindow+))) - (if (gfs:null-handle-p hdwp) - (gfs::set-window-pos (gfs:handle kid-win) - hwnd-after - (gfs:point-x pnt) - (gfs:point-y pnt) - (gfs:size-width sz) - (gfs:size-height sz) - flags) - (setf hdwp (gfs::defer-window-pos hdwp - (gfs:handle kid-win) - hwnd-after - (gfs:point-x pnt) - (gfs:point-y pnt) - (gfs:size-width sz) - (gfs:size-height sz) - flags))))) - (unless (gfs:null-handle-p hdwp) - (gfs::end-defer-window-pos hdwp))))) + (let ((top (top-child-of self)) + (kid-specs (compute-layout self container width-hint height-hint))) + (unless top + (setf top (car (first kid-specs)))) + (arrange-children kid-specs (lambda (item) + (if (cffi:pointer-eq (gfs:handle top) (gfs:handle item)) + (logior +window-pos-flags+ gfs::+swp-showwindow+) + (logior +window-pos-flags+ gfs::+swp-hidewindow+))))))

Modified: trunk/src/uitoolkit/widgets/layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layout.lisp (original) +++ trunk/src/uitoolkit/widgets/layout.lisp Thu Aug 17 18:53:32 2006 @@ -63,6 +63,32 @@

(defsetf layout-attribute set-layout-attribute)

+(defun arrange-children (kid-specs flags-func) + (let ((hdwp (gfs::begin-defer-window-pos (length kid-specs)))) + (loop for k in kid-specs + for rect = (cdr k) + for size = (gfs:size rect) + for pnt = (gfs:location rect) + do (progn + (if (gfs:null-handle-p hdwp) + (gfs::set-window-pos (gfs:handle (car k)) + (cffi:null-pointer) + (gfs:point-x pnt) + (gfs:point-y pnt) + (gfs:size-width size) + (gfs:size-height size) + (funcall flags-func (car k))) + (gfs::defer-window-pos hdwp + (gfs:handle (car k)) + (cffi:null-pointer) + (gfs:point-x pnt) + (gfs:point-y pnt) + (gfs:size-width size) + (gfs:size-height size) + (funcall flags-func (car k)))))) + (unless (gfs:null-handle-p hdwp) + (gfs::end-defer-window-pos hdwp)))) + ;;; ;;; methods ;;; @@ -84,31 +110,8 @@ (bottom-margin-of layout) vertical-margins)))

(defmethod perform ((self layout-manager) (container layout-managed) width-hint height-hint) - "Calls compute-layout for a container and then handles the actual moving and resizing of its children." - (let ((kids nil) - (hdwp (cffi:null-pointer))) - (when (layout-p container) - (setf kids (compute-layout self container width-hint height-hint)) - (setf hdwp (gfs::begin-defer-window-pos (length kids))) - (loop for k in kids - do (let* ((rect (cdr k)) - (sz (gfs:size rect)) - (pnt (gfs:location rect))) - (if (gfs:null-handle-p hdwp) - (gfs::set-window-pos (gfs:handle (car k)) - (cffi:null-pointer) - (gfs:point-x pnt) - (gfs:point-y pnt) - (gfs:size-width sz) - (gfs:size-height sz) - +window-pos-flags+) - (setf hdwp (gfs::defer-window-pos hdwp - (gfs:handle (car k)) - (cffi:null-pointer) - (gfs:point-x pnt) - (gfs:point-y pnt) - (gfs:size-width sz) - (gfs:size-height sz) - +window-pos-flags+))))) - (unless (gfs:null-handle-p hdwp) - (gfs::end-defer-window-pos hdwp))))) + (when (layout-p container) + (arrange-children (compute-layout self container width-hint height-hint) + (lambda (item) + (declare (ignore item)) + +window-pos-flags+))))