[graphic-forms-cvs] r211 - in trunk: docs/manual src src/uitoolkit/graphics

[junrue at common-lisp.net]

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,
+ at 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
 
+ at 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}.
+ at table @var
+ at item image
+The new image to be prepended.
+ at item icon-bundle
+The icon-bundle to receive @var{image}.
+ at 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.
+ at end table
+ at 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 at 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
- at 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.
+ at 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
 ;;;