Author: junrue Date: Sat Aug 12 23:55:37 2006 New Revision: 211 Modified: trunk/docs/manual/graphics-api.texinfo trunk/docs/manual/widgets-api.texinfo trunk/src/packages.lisp trunk/src/uitoolkit/graphics/icon-bundle.lisp Log: fixed icon-handle-ref to not re-order handles, removed doc language about load order preservation, implemented and documented push-icon-image Modified: trunk/docs/manual/graphics-api.texinfo ============================================================================== --- trunk/docs/manual/graphics-api.texinfo (original) +++ trunk/docs/manual/graphics-api.texinfo Sat Aug 12 23:55:37 2006 @@ -539,25 +539,20 @@ @defun icon-image-ref @ref{icon-bundle} subscript => @ref{image} (setf (@strong{icon-image-ref} @var{icon-bundle} @var{subscript}) @var{image})@*@* This function uses an integer or keyword -based @var{subscript} to address -the images comprising @var{icon-bundle}, either to retrieve an image -or add/replace an image via @sc{setf}. +the images comprising @var{icon-bundle}. @table @var @item icon-bundle Contains images to be used for frame decorations. @item subscript This argument can be zero-based, in which case @var{icon-bundle} -is treated as though it were an array of images. Add a new image -by specifying @var{subscript} 0.@*@* -Alternatively, @var{subscript} -can be one of the following keywords:@*@* +is treated as though it were an array of images. Alternatively, +@var{subscript} can be one of the following keywords:@*@* @table @code @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 -Note that adding an image addressed by one of these -keywords will succeed, but the result may be counter-intuitive. @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, @@ -588,6 +583,21 @@ where @var{self} is a @ref{graphics-context}. @end deffn +@defun push-icon-image @ref{image} @ref{icon-bundle} &optional transparency-pixel => icon-bundle +Use this function to prepend a new image to an existing icon-bundle. +Note that @var{icon-bundle} takes ownership of @var{image}. +@table @var +@item image +The new image to be prepended. +@item icon-bundle +The icon-bundle to receive @var{image}. +@item transparency-pixel +A @ref{point} object identifying a pixel in @var{image} with the color to +be used for transparency. If not specified, the pixel at @code{(0, 0)} will +be used. +@end table +@end defun + @deffn GenericFunction size self => @ref{size} Returns a size object describing the dimensions of @var{self}. @end deffn Modified: trunk/docs/manual/widgets-api.texinfo ============================================================================== --- trunk/docs/manual/widgets-api.texinfo (original) +++ trunk/docs/manual/widgets-api.texinfo Sat Aug 12 23:55:37 2006 @@ -265,7 +265,7 @@ This is the base class for user interface objects that generate events@footnote{Actually, events are generated by underlying native window objects, which are represented in the class hierarchy by -the event-source class}. It derives from @ref{native-object}. +the event-source class.}. It derives from @ref{native-object}. @table @var @item callback-event-name This is an (@code{:allocation :class}) slot that holds a symbol @@ -792,10 +792,10 @@ Implement this method to respond to @var{widget} being activated. For a @ref{top-level} @ref{window} or @ref{dialog}, this means that @var{widget} was brought to the foreground and its trim (titlebar and -border) was highlighted to indicate that it is now the active -window. For a @ref{menu}, it means that the user has clicked on the -@ref{item} invoking @ref{widget} and it is about to be shown; this is -an opportunity to update the menu's contents. @xref{event-deactivate}. +border) became highlighted. For a @ref{menu}, it means that the user +has clicked on the @ref{item} invoking @ref{widget} and it is about +to be shown; this is an opportunity to update the menu's contents. +@xref{event-deactivate}. @table @var @event-dispatcher-arg @item widget @@ -841,8 +841,8 @@ @deffn GenericFunction event-dispose dispatcher widget Implement this method to respond to @var{widget} being disposed (explicitly -via @ref{dispose}, not collected via the garbage collector). This -event function is called while the contents of @var{widget} are still +via @ref{dispose}; this event is not associated with garbage collection). +This event function is called while the contents of @var{widget} are still valid. @table @var @event-dispatcher-arg Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Sat Aug 12 23:55:37 2006 @@ -208,6 +208,7 @@ #:multiply #:pen-style #:pen-width + #:push-icon-image #:rgb->color #:red-mask #:red-shift Modified: trunk/src/uitoolkit/graphics/icon-bundle.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/icon-bundle.lisp (original) +++ trunk/src/uitoolkit/graphics/icon-bundle.lisp Sat Aug 12 23:55:37 2006 @@ -71,10 +71,6 @@ (gfs:dispose im)) extent)) -;;; Note: this function needs to return a place not -;;; just a handle, to facilitate a defsetf further -;;; on below -;;; (defun icon-handle-ref (bundle index) (let ((handles (gfs:handle bundle))) (unless handles @@ -86,16 +82,16 @@ (elt handles index) (error 'gfs:toolkit-error :detail "invalid image index")) (if (zerop index) - (gfs:handle bundle) + handles (error 'gfs:toolkit-error :detail "invalid image index")))) ((eql index :small) (if (listp handles) - (first (stable-sort handles #'< :key #'icon-extent)) - (gfs:handle bundle))) + (first (sort (copy-list handles) #'< :key #'icon-extent)) + handles)) ((eql index :large) (if (listp handles) - (first (last (stable-sort handles #'< :key #'icon-extent))) - (gfs:handle bundle))) + (first (sort (copy-list handles) #'> :key #'icon-extent)) + handles)) (t (error 'gfs:toolkit-error :detail "an integer index, or one of :small or :large, is required"))))) @@ -129,6 +125,13 @@ (length handles) 1))) +(defun push-icon-image (image bundle &optional transparency-pixel) + (if (gfs:disposed-p image) + (error 'gfs:disposed-error)) + (let ((tmp (gfs:handle bundle))) + (push (image->hicon image transparency-pixel) tmp) + (setf (slot-value bundle 'gfs:handle) tmp))) + ;;; ;;; methods ;;;