[graphic-forms-cvs] r219 - in trunk: docs/manual src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Thu Aug 17 22:53:33 UTC 2006
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
- at 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.
+ at table @var
+ at item spacing
+A pixel value specifying how far apart each child should be from
+the next.
+ at 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.
- at deffn Initarg :top-child
+size and stacks them on top of each other. There are no child-specific
+layout attributes defined for this class.
+ at table @var
+ at 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.
- at end deffn
+ at 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
- at 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}
- at 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
+ at 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+))))
More information about the Graphic-forms-cvs
mailing list