[graphic-forms-cvs] r218 - in trunk: docs/manual src src/tests/uitoolkit src/uitoolkit/graphics/plugins/default src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Thu Aug 17 21:55:52 UTC 2006
Author: junrue
Date: Thu Aug 17 17:55:50 2006
New Revision: 218
Modified:
trunk/docs/manual/graphics-api.texinfo
trunk/docs/manual/widgets-api.texinfo
trunk/src/packages.lisp
trunk/src/tests/uitoolkit/layout-unit-tests.lisp
trunk/src/tests/uitoolkit/mock-objects.lisp
trunk/src/uitoolkit/graphics/plugins/default/default-data-plugin.lisp
trunk/src/uitoolkit/widgets/layout-classes.lisp
trunk/src/uitoolkit/widgets/layout-generics.lisp
trunk/src/uitoolkit/widgets/layout.lisp
Log:
implemented and documented gfw:layout-attribute function
Modified: trunk/docs/manual/graphics-api.texinfo
==============================================================================
--- trunk/docs/manual/graphics-api.texinfo (original)
+++ trunk/docs/manual/graphics-api.texinfo Thu Aug 17 17:55:50 2006
@@ -551,8 +551,12 @@
@item :large
Identifies the largest image of the @var{icon-bundle}.
@item :small
-Identifies the smallest image of the @var{icon-bundle}.
+Identifies the smallest image of the @var{icon-bundle}.@*@*
@end table
+ at strong{Note:} there are actually four icon sizes that Windows
+defines for various contexts. A future release will add keywords to
+better distinguish amongst all four, and to help ensure the correct
+sizes are chosen when an icon-bundle is passed to @sc{(setf gfw:image)}.
@end table
To find out how many images are stored in @var{icon-bundle}, and hence
what constitutes a valid range of subscripts for this function,
Modified: trunk/docs/manual/widgets-api.texinfo
==============================================================================
--- trunk/docs/manual/widgets-api.texinfo (original)
+++ trunk/docs/manual/widgets-api.texinfo Thu Aug 17 17:55:50 2006
@@ -735,12 +735,28 @@
@end deftp
@anchor{layout-manager}
- at deftp Class layout-manager style left-margin top-margin right-margin bottom-margin
-Subclasses implement layout strategies on behalf of window
-objects. Every layout manager allows optional margins (specified in
-pixels) within the perimeter of the container being managed.@*@* The
-values accepted by the @code{:style} initarg vary depending on the
-actual @code{layout-manager} subclass being used.
+ at deftp Class layout-manager bottom-margin data left-margin right-margin top-margin style
+Subclasses implement layout strategies to manage space within containers.
+ at table @var
+ at item bottom-margin
+This slot holds a margin value in pixels for the bottom side of
+the container.
+ at item data
+This slot holds a @sc{alist} of pairs, each one associating a
+ at sc{plist} of layout-specific attributes with an item from a
+container.
+ at item left-margin
+This slot holds a margin value in pixels for the left side of
+the container.
+ at item right-margin
+This slot holds a margin value in pixels for the right side of
+the container.
+ at item style
+The values appropriate for this slot are subclass-specific.
+ at item top-margin
+This slot holds a margin value in pixels for the top side of
+the container.
+ at end table
@deffn Initarg :horizontal-margins
This initarg accepts a horizontal margin value that is applied to both
the left and right sides of the container.
@@ -1665,40 +1681,104 @@
@node layout functions
@subsection layout functions
-These functions comprise the protocol for @ref{layout-manager}s. As
-such, they are not normally called by application code, but instead
-are the concern of layout-manager implementers.
-
-The @code{width-hint} and @code{height-hint} parameters are a
-mechanism to express the @emph{what-if} scenario where the total width
-or height of the container is fixed; the proper response is to
-calculate the container's desired dimension on the opposite
-axis. While this behavior is primarily the concern of child windows
-and/or controls, layout manager implementations should look for
-non-negative values for either @code{width-hint} or
- at code{height-hint}, indicating that the container's size is
-constrained.
+The functions @ref{compute-layout}, @ref{compute-size}, and
+ at ref{perform} comprise the internal protocol for
+ at ref{layout-manager}s. As such, they are not normally called by
+application code, being instead the concern of layout-manager
+implementations. The @var{width-hint} and @var{height-hint} parameters
+passed to the following functions are a mechanism to express the
+ at emph{what-if} scenario where the total width or height of the
+container is fixed; the proper response is to calculate the
+container's desired dimension on the opposite axis. While this
+behavior is primarily the concern of child windows and/or controls,
+layout manager implementations should look for non-negative values for
+either @var{width-hint} or @var{height-hint}, indicating that the
+container's size is constrained.
@anchor{compute-layout}
- at deffn GenericFunction compute-layout layout container width-hint height-hint
-Returns a list of conses @code{(child . rectangle)} describing the
-new bounds of each child window or control. A @ref{layout-manager} subclass
+ at deffn GenericFunction compute-layout @ref{layout-manager} container width-hint height-hint
+Returns a list of pairs @code{(item rectangle)} describing the
+new bounds of each child within @var{container}. A layout-manager subclass
implements this method based on its particular layout strategy, taking
-into account attributes set by the user. Certain Graphic-Forms functions
-call this method to accomplish layout within a container.
+into account attributes set by the user via @ref{layout-attribute}. Certain
+Graphic-Forms functions call this method to accomplish layout within a container.
+ at table @var
+ at item layout-manager
+The layout object dictating how children of @var{container}
+are to be arranged.
+ at item container
+The @var{layout-manager} arranges the elements of @var{container}.
+ at item width-hint
+A hypothetical width value, or negative if @var{container}'s width is
+not constrained.
+ at item height-hint
+A hypothetical height value, or negative if @var{container}'s height is
+not constrained.
+ at end table
@end deffn
- at deffn GenericFunction compute-size layout container width-hint height-hint
+ at anchor{compute-size}
+ at deffn GenericFunction compute-size @ref{layout-manager} container width-hint height-hint
Computes and returns the new @ref{size} of the @code{container}'s
-client area. A @ref{layout-manager} subclass implements this method
+client area. A layout-manager subclass implements this method
based on its particular layout strategy, taking into account
-attributes set by the user. The @ref{pack} function ultimately calls
-this method.
+attributes set by the user via @ref{layout-attribute}.
+ at table @var
+ at item layout-manager
+The layout object dictating how children of @var{container}
+are to be arranged.
+ at item container
+The @var{layout-manager} arranges the elements of @var{container}.
+ at item width-hint
+A hypothetical width value, or negative if @var{container}'s width is
+not constrained.
+ at item height-hint
+A hypothetical height value, or negative if @var{container}'s height is
+not constrained.
+ at end table
@end deffn
- at deffn GenericFunction perform layout container width-hint height-hint
+ at anchor{layout-attribute}
+ at 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
+from querying or setting attributes that are not supported by the
+layout manager.
+ at table @var
+ at item layout-manager
+The layout object dictating how children of @var{container}
+are to be arranged.
+ at item thing
+The object being managed by @var{layout-manager}.
+ at item symbol
+A @sc{symbol} identifying an item-specific attribute supported
+by @var{layout-manager}.
+ at item value
+The data of an attribute which configures the behavior of @var{layout-manager}.
+ at end table
+ at end defun
+
+ at 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
-this method -- most derivations should call @sc{CALL-NEXT-METHOD} to
-allow the base implementation to execute.
+this method -- however, most derivations should call @sc{CALL-NEXT-METHOD}
+to allow the base implementation to execute.
+ at table @var
+ at item layout-manager
+The layout object dictating how children of @var{container}
+are to be arranged.
+ at item container
+The @var{layout-manager} arranges the elements of @var{container}.
+ at item width-hint
+A hypothetical width value, or negative if @var{container}'s width is
+not constrained.
+ at item height-hint
+A hypothetical height value, or negative if @var{container}'s height is
+not constrained.
+ at end table
@end deffn
Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp (original)
+++ trunk/src/packages.lisp Thu Aug 17 17:55:50 2006
@@ -440,6 +440,7 @@
#:key-toggled-p
#:label
#:layout
+ #:layout-attribute
#:layout-of
#:layout-p
#:left-margin-of
Modified: trunk/src/tests/uitoolkit/layout-unit-tests.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/layout-unit-tests.lisp (original)
+++ trunk/src/tests/uitoolkit/layout-unit-tests.lisp Thu Aug 17 17:55:50 2006
@@ -54,6 +54,25 @@
expected-rects
actual-rects)))
+(define-test layout-attributes-test
+ (let ((widget1 (make-instance 'mock-widget :handle 1234))
+ (widget2 (make-instance 'mock-widget :handle 5678)))
+ (let ((data1 `(,(cffi:make-pointer 1234) (a 1 b 2)))
+ (data2 `(,(cffi:make-pointer 5678) (a 10 c 30)))
+ (layout (make-instance 'gfw:layout-manager)))
+ (setf (slot-value layout 'gfw::data) (list data1 data2))
+ (assert-equal 1 (gfw:layout-attribute layout widget1 'a))
+ (assert-equal 2 (gfw:layout-attribute layout widget1 'b))
+ (assert-equal 10 (gfw:layout-attribute layout widget2 'a))
+ (assert-equal 30 (gfw:layout-attribute layout widget2 'c))
+ (setf (gfw:layout-attribute layout widget1 'b) 66
+ (gfw:layout-attribute layout widget2 'd) 100)
+ (assert-equal 1 (gfw:layout-attribute layout widget1 'a))
+ (assert-equal 66 (gfw:layout-attribute layout widget1 'b))
+ (assert-equal 10 (gfw:layout-attribute layout widget2 'a))
+ (assert-equal 30 (gfw:layout-attribute layout widget2 'c))
+ (assert-equal 100 (gfw:layout-attribute layout widget2 'd)))))
+
(define-test flow-layout-test1
;; orient: horizontal
;; normalize: disabled
Modified: trunk/src/tests/uitoolkit/mock-objects.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/mock-objects.lisp (original)
+++ trunk/src/tests/uitoolkit/mock-objects.lisp Thu Aug 17 17:55:50 2006
@@ -57,8 +57,8 @@
:initarg :min-size
:initform (gfs:make-size))))
-(defmethod initialize-instance :after ((widget mock-widget) &key)
- (setf (slot-value widget 'gfs:handle) (cffi:make-pointer #xFFFFFFFF)))
+(defmethod initialize-instance :after ((widget mock-widget) &key handle &allow-other-keys)
+ (setf (slot-value widget 'gfs:handle) (cffi:make-pointer (or handle #xFFFFFFFF))))
(defmethod gfw:location ((widget mock-widget))
(gfs:make-point))
Modified: trunk/src/uitoolkit/graphics/plugins/default/default-data-plugin.lisp
==============================================================================
--- trunk/src/uitoolkit/graphics/plugins/default/default-data-plugin.lisp (original)
+++ trunk/src/uitoolkit/graphics/plugins/default/default-data-plugin.lisp Thu Aug 17 17:55:50 2006
@@ -104,7 +104,7 @@
(load-bmp-data stream t t)))))
(defun loader (path)
- (let* ((file-type (string-downcase (pathname-type path)))
+ (let* ((file-type (pathname-type path))
(helper (cond
((string-equal file-type "bmp") #'load-bmp-data)
((string-equal file-type "ico") #'load-icon-data)
Modified: trunk/src/uitoolkit/widgets/layout-classes.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/layout-classes.lisp (original)
+++ trunk/src/uitoolkit/widgets/layout-classes.lisp Thu Aug 17 17:55:50 2006
@@ -53,8 +53,11 @@
(bottom-margin
:accessor bottom-margin-of
:initarg :bottom-margin
- :initform 0))
- (:documentation "Subclasses implement layout strategies on behalf of window objects."))
+ :initform 0)
+ (data
+ :accessor data-of
+ :initform nil))
+ (:documentation "Subclasses implement layout strategies to manage space within windows."))
(defclass flow-layout (layout-manager)
((spacing
Modified: trunk/src/uitoolkit/widgets/layout-generics.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/layout-generics.lisp (original)
+++ trunk/src/uitoolkit/widgets/layout-generics.lisp Thu Aug 17 17:55:50 2006
@@ -33,11 +33,16 @@
(in-package :graphic-forms.uitoolkit.widgets)
-(defgeneric compute-size (layout win width-hint height-hint)
+(defgeneric compute-size (self win width-hint height-hint)
(:documentation "Computes and returns the size of the window's client area based on the layout's strategy."))
-(defgeneric compute-layout (layout win width-hint height-hint)
+(defgeneric compute-layout (self win width-hint height-hint)
(:documentation "Returns a list of conses (window . rectangle) describing the new bounds of each child window."))
-(defgeneric perform (layout window widget-hint height-hint)
+(defgeneric obtain-default (self)
+ (:documentation "Returns an instance representing default values to be used when none is supplied by the application.")
+ (:method (self)
+ (declare (ignorable self))))
+
+(defgeneric perform (self window widget-hint height-hint)
(:documentation "Moves and resizes window children based on layout strategy."))
Modified: trunk/src/uitoolkit/widgets/layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/layout.lisp (original)
+++ trunk/src/uitoolkit/widgets/layout.lisp Thu Aug 17 17:55:50 2006
@@ -40,6 +40,30 @@
gfs::+swp-nocopybits+)))
;;;
+;;; helper functions
+;;;
+
+(defun layout-attribute (layout widget name)
+ "Return the value associated with name for widget; or NIL if no value is set."
+ (if (gfs:disposed-p widget)
+ (error 'gfs:disposed-error))
+ (let ((attrs (assoc (gfs:handle widget) (data-of layout) :test #'cffi:pointer-eq)))
+ (unless attrs
+ (error 'gfs:toolkit-error :detail (format nil "~a is not managed ~a" widget layout)))
+ (getf (first (rest attrs)) name)))
+
+(defun set-layout-attribute (layout widget name value)
+ "Sets a value associated with name for widget in the specified layout."
+ (if (gfs:disposed-p widget)
+ (error 'gfs:disposed-error))
+ (let ((attrs (assoc (gfs:handle widget) (data-of layout) :test #'cffi:pointer-eq)))
+ (unless attrs
+ (error 'gfs:toolkit-error :detail (format nil "~a is not managed ~a" widget layout)))
+ (setf (getf (first (rest attrs)) name) value)))
+
+(defsetf layout-attribute set-layout-attribute)
+
+;;;
;;; methods
;;;
@@ -48,16 +72,16 @@
&allow-other-keys)
(setf (style-of layout) (if (listp style) style (list style)))
(unless (null margins)
- (setf (left-margin-of layout) margins)
- (setf (right-margin-of layout) margins)
- (setf (top-margin-of layout) margins)
- (setf (bottom-margin-of layout) margins))
+ (setf (left-margin-of layout) margins
+ (right-margin-of layout) margins
+ (top-margin-of layout) margins
+ (bottom-margin-of layout) margins))
(unless (null horizontal-margins)
- (setf (left-margin-of layout) horizontal-margins)
- (setf (right-margin-of layout) horizontal-margins))
+ (setf (left-margin-of layout) horizontal-margins
+ (right-margin-of layout) horizontal-margins))
(unless (null vertical-margins)
- (setf (top-margin-of layout) vertical-margins)
- (setf (bottom-margin-of layout) vertical-margins)))
+ (setf (top-margin-of layout) vertical-margins
+ (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."
More information about the Graphic-forms-cvs
mailing list