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 +@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} -@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. +@deftp Class layout-manager bottom-margin data left-margin right-margin top-margin style +Subclasses implement layout strategies to manage space within containers. +@table @var +@item bottom-margin +This slot holds a margin value in pixels for the bottom side of +the container. +@item data +This slot holds a @sc{alist} of pairs, each one associating a +@sc{plist} of layout-specific attributes with an item from a +container. +@item left-margin +This slot holds a margin value in pixels for the left side of +the container. +@item right-margin +This slot holds a margin value in pixels for the right side of +the container. +@item style +The values appropriate for this slot are subclass-specific. +@item top-margin +This slot holds a margin value in pixels for the top side of +the container. +@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 -@code{height-hint}, indicating that the container's size is -constrained. +The functions @ref{compute-layout}, @ref{compute-size}, and +@ref{perform} comprise the internal protocol for +@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 +@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} -@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 +@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. +@table @var +@item layout-manager +The layout object dictating how children of @var{container} +are to be arranged. +@item container +The @var{layout-manager} arranges the elements of @var{container}. +@item width-hint +A hypothetical width value, or negative if @var{container}'s width is +not constrained. +@item height-hint +A hypothetical height value, or negative if @var{container}'s height is +not constrained. +@end table @end deffn -@deffn GenericFunction compute-size layout container width-hint height-hint +@anchor{compute-size} +@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}. +@table @var +@item layout-manager +The layout object dictating how children of @var{container} +are to be arranged. +@item container +The @var{layout-manager} arranges the elements of @var{container}. +@item width-hint +A hypothetical width value, or negative if @var{container}'s width is +not constrained. +@item height-hint +A hypothetical height value, or negative if @var{container}'s height is +not constrained. +@end table @end deffn -@deffn GenericFunction perform layout container width-hint height-hint +@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 +from querying or setting attributes that are not supported by the +layout manager. +@table @var +@item layout-manager +The layout object dictating how children of @var{container} +are to be arranged. +@item thing +The object being managed by @var{layout-manager}. +@item symbol +A @sc{symbol} identifying an item-specific attribute supported +by @var{layout-manager}. +@item value +The data of an attribute which configures the behavior of @var{layout-manager}. +@end table +@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 -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. +@table @var +@item layout-manager +The layout object dictating how children of @var{container} +are to be arranged. +@item container +The @var{layout-manager} arranges the elements of @var{container}. +@item width-hint +A hypothetical width value, or negative if @var{container}'s width is +not constrained. +@item height-hint +A hypothetical height value, or negative if @var{container}'s height is +not constrained. +@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."