Author: junrue Date: Sat Aug 19 22:13:35 2006 New Revision: 224 Modified: trunk/docs/manual/graphics-api.texinfo trunk/docs/manual/widgets-api.texinfo trunk/graphic-forms-uitoolkit.asd trunk/src/uitoolkit/graphics/graphics-generics.lisp trunk/src/uitoolkit/widgets/control.lisp trunk/src/uitoolkit/widgets/item.lisp trunk/src/uitoolkit/widgets/thread-context.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/window.lisp Log: cleaned up some SBCL style warnings Modified: trunk/docs/manual/graphics-api.texinfo ============================================================================== --- trunk/docs/manual/graphics-api.texinfo (original) +++ trunk/docs/manual/graphics-api.texinfo Sat Aug 19 22:13:35 2006 @@ -317,19 +317,23 @@ this time. @anchor{background-color} -@deffn GenericFunction background-color self +@deffn GenericFunction background-color self => @ref{color} +(setf (@strong{background-color} @var{self}) @var{color})@*@* Returns a color object corresponding to the current background color. +The corresponding @sc{setf} function allows the background color to +be set. @end deffn @anchor{data-object} @deffn GenericFunction data-object self &optional gc => object +(setf (@strong{data-object} @var{self}) @var{object})@*@* Returns the data structure representing the raw data form of the object. The @code{gc} argument must be supplied when calling this -function on a @ref{font}, and the value must be a -@ref{graphics-context}. +function on a @ref{font}, and the value must be a @ref{graphics-context}. +The corresponding @sc{setf} function updates this representation. @end deffn -@deffn GenericFunction depth self +@deffn GenericFunction depth self => integer Returns the bits-per-pixel depth of the object. @end deffn @@ -521,13 +525,18 @@ @end table @end deffn -@deffn GenericFunction font self -Returns the current font. +@deffn GenericFunction font self => @ref{font} +(setf (@strong{font} @var{self}) @var{font})@*@* +Returns the current font. The corresponding @sc{setf} function +allows the font to be set. @end deffn @anchor{foreground-color} -@deffn GenericFunction foreground-color self +@deffn GenericFunction foreground-color self => @ref{color} +(setf (@strong{foreground-color} @var{self}) @var{color})@*@* Returns a color object corresponding to the current foreground color. +The corresponding @sc{setf} function allows the foreground color +to be set. @end deffn @anchor{icon-bundle-length} @@ -603,7 +612,10 @@ @end defun @deffn GenericFunction size self => @ref{size} +(setf (@strong{size} @var{self}) @var{size})@*@* Returns a size object describing the dimensions of @var{self}. +The corresponding @sc{setf} function allows the size to be +set. @end deffn @deffn GenericFunction text-extent self text &optional style tab-width @@ -632,5 +644,6 @@ @defmac with-image-transparency (image point) &body body This macro wraps @var{body} in an @sc{unwind-protect} form with @var{point} set as the @ref{transparency-pixel} for @var{image}. -Any existing point set in @var{image} is restored. +The original point set in @var{image}, if any, is restored after +@var{body} completes. @end defmac Modified: trunk/docs/manual/widgets-api.texinfo ============================================================================== --- trunk/docs/manual/widgets-api.texinfo (original) +++ trunk/docs/manual/widgets-api.texinfo Sat Aug 19 22:13:35 2006 @@ -1395,9 +1395,7 @@ @end deffn @deffn GenericFunction image self => @ref{image} - -(setf (@strong{image} @var{self}) @var{image})@* - +(setf (@strong{image} @var{self}) @var{image})@*@* Returns the image currently associated with @var{self}. The @sc{setf} function changes the image. If @var{self} is a @ref{window}, then this function returns an @ref{icon-bundle}. And in that case, the @sc{setf} function accepts either @@ -1419,6 +1417,7 @@ @end deffn @deffn GenericFunction location self => @ref{point} +(setf (@strong{location} @var{self}) @var{point})@*@* Returns a point object describing the coordinates of the top-left corner of the object in its parent's coordinate system. @xref{parent}. @@ -1433,6 +1432,7 @@ @anchor{maximum-size} @deffn GenericFunction maximum-size self => size +(setf (@strong{maximum-size} @var{self}) @var{size})@*@* Returns a @ref{size} object describing the largest dimensions to which the user may resize this widget. By default, @ref{window}s and @ref{control}s return @sc{nil} indicating that there is effectively no @@ -1442,12 +1442,14 @@ is resized to the new maximum. @xref{minimum-size}. @end deffn -@deffn GenericFunction menu-bar self +@deffn GenericFunction menu-bar self => @ref{menu} +(setf (@strong{menu-bar} @var{self}) @var{menu})@*@* Returns the menu object serving as the menubar for this object. @end deffn @anchor{minimum-size} @deffn GenericFunction minimum-size self => size +(setf (@strong{minimum-size} @var{self}) @var{size})@*@* Returns a @ref{size} object describing the smallest dimensions to which the user may resize this widget. By default, @ref{window} objects return @sc{nil} indicating that the minimum constraint is @@ -1625,7 +1627,8 @@ necessarily top-most in the display z-order. @end deffn -@deffn GenericFunction size self +@deffn GenericFunction size self => @ref{size} +(setf (@strong{size} @var{self}) @var{size})@*@* Returns a size object describing the size of the object in its parent's coordinate system. @end deffn @@ -1659,7 +1662,8 @@ @end deffn @anchor{text-modified-p} -@deffn GenericFunction text-modified-p self +@deffn GenericFunction text-modified-p self => boolean +(setf (@strong{text-modified-p} @var{self}) @var{boolean})@*@* Returns T if the text component of @code{self} has been modified by the user; @sc{nil} otherwise. The corresponding @sc{setf} function updates the dirty state flag. This function is not implemented for all Modified: trunk/graphic-forms-uitoolkit.asd ============================================================================== --- trunk/graphic-forms-uitoolkit.asd (original) +++ trunk/graphic-forms-uitoolkit.asd Sat Aug 19 22:13:35 2006 @@ -78,12 +78,14 @@ ((:file "graphics-constants") (:file "graphics-classes") (:file "graphics-generics") - (:file "color") - (:file "palette") + (:file "color" + :depends-on ("graphics-classes")) + (:file "palette" + :depends-on ("graphics-classes")) (:file "image-data" :depends-on ("graphics-classes")) (:file "image" - :depends-on ("graphics-classes")) + :depends-on ("graphics-classes" "graphics-generics")) (:file "icon-bundle" :depends-on ("graphics-constants" "image")) (:file "font-data") Modified: trunk/src/uitoolkit/graphics/graphics-generics.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/graphics-generics.lisp (original) +++ trunk/src/uitoolkit/graphics/graphics-generics.lisp Sat Aug 19 22:13:35 2006 @@ -36,11 +36,17 @@ (defgeneric background-color (self) (:documentation "Returns a color object corresponding to the current background color.")) +(defgeneric (setf background-color) (color self) + (:documentation "Sets the current background color.")) + (defgeneric data->image (self) (:documentation "Plugins implement this to translate from a data structure to an HGDIOBJ.")) (defgeneric data-object (self &optional gc) - (:documentation "Returns the data structure representing the raw form of the object.")) + (:documentation "Returns the data structure representing the raw form of self.")) + +(defgeneric (setf data-object) (data self) + (:documentation "Sets a data structure representing the raw form of self.")) (defgeneric depth (self) (:documentation "Returns the bits-per-pixel depth of the object.")) @@ -111,9 +117,15 @@ (defgeneric font (self) (:documentation "Returns the current font.")) +(defgeneric (setf font) (font self) + (:documentation "Sets the current font.")) + (defgeneric foreground-color (self) (:documentation "Returns a color object corresponding to the current foreground color.")) +(defgeneric (setf foreground-color) (color self) + (:documentation "Sets the current foreground color.")) + (defgeneric load (self path) (:documentation "Loads the object from filesystem data identified by the specified pathname or string.")) @@ -121,7 +133,10 @@ (:documentation "Returns a font-metrics object describing key attributes of the specified font.")) (defgeneric size (self) - (:documentation "Returns a size object describing the size of the object.")) + (:documentation "Returns a size object describing the dimensions of self.")) + +(defgeneric (setf size) (size self) + (:documentation "Sets the dimensions of self.")) (defgeneric text-extent (self str &optional style tab-width) (:documentation "Returns the size of the rectangular area that would be covered by the string if drawn in the current font.")) Modified: trunk/src/uitoolkit/widgets/control.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/control.lisp (original) +++ trunk/src/uitoolkit/widgets/control.lisp Sat Aug 19 22:13:35 2006 @@ -117,7 +117,6 @@ font)) (defmethod (setf gfg:font) :before (font (self control)) - (declare (ignore color)) (if (or (gfs:disposed-p self) (gfs:disposed-p font)) (error 'gfs:disposed-error))) @@ -161,19 +160,24 @@ (let ((class (define-dispatcher (class-name (class-of self)) callback))) (setf (dispatcher self) (make-instance (class-name class)))))) -(defmethod (setf maximum-size) :after (max-size (self control)) +(defmethod maximum-size ((self control)) + (max-size-of self)) + +(defmethod (setf maximum-size) (max-size (self control)) (unless (gfs:disposed-p self) + (setf (max-size-of self) max-size) (let ((size (constrain-new-size max-size (size self) #'min))) (setf (size self) size)))) -(defmethod minimum-size :after ((self control)) - (let ((size (slot-value self 'minimum-size))) +(defmethod minimum-size ((self control)) + (let ((size (min-size-of self))) (if (null size) (preferred-size self -1 -1) size))) -(defmethod (setf minimum-size) :after (min-size (self control)) +(defmethod (setf minimum-size) (min-size (self control)) (unless (gfs:disposed-p self) + (setf (min-size-of self) min-size) (let ((size (constrain-new-size min-size (size self) #'max))) (setf (size self) size)))) Modified: trunk/src/uitoolkit/widgets/item.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/item.lisp (original) +++ trunk/src/uitoolkit/widgets/item.lisp Sat Aug 19 22:13:35 2006 @@ -42,6 +42,5 @@ (error 'gfs:toolkit-error :detail "null owner handle"))) (defmethod checked-p :before ((self item)) - (declare (ignore flag)) (if (gfs:null-handle-p (gfs:handle self)) (error 'gfs:toolkit-error :detail "null owner handle"))) Modified: trunk/src/uitoolkit/widgets/thread-context.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/thread-context.lisp (original) +++ trunk/src/uitoolkit/widgets/thread-context.lisp Sat Aug 19 22:13:35 2006 @@ -95,6 +95,28 @@ (gfs::destroy-window hwnd))))) (setf (getf (mp:process-plist mp:*current-process*) 'thread-context) nil)) +(defgeneric init-utility-hwnd (self)) +(defgeneric call-child-visitor-func (self parent child)) +(defgeneric call-display-visitor-func (self hmonitor data)) +(defgeneric call-top-level-visitor-func (self window)) +(defgeneric get-widget (self hwnd)) +(defgeneric put-widget (self widget)) +(defgeneric delete-widget (self hwnd)) +(defgeneric widget-in-progress (self)) +(defgeneric (setf widget-in-progress) (widget self)) +(defgeneric clear-widget-in-progress (self)) +(defgeneric put-kbdnav-widget (self widget)) +(defgeneric delete-kbdnav-widget (self widget)) +(defgeneric intercept-kbdnav-message (self msg-ptr)) +(defgeneric get-menuitem (self id)) +(defgeneric put-menuitem (self item)) +(defgeneric delete-menuitem (self item)) +(defgeneric increment-menuitem-id (self)) +(defgeneric get-timer (self id)) +(defgeneric put-timer (self timer)) +(defgeneric delete-timer (self timer)) +(defgeneric increment-widget-id (self)) + (defmethod init-utility-hwnd ((tc thread-context)) (register-toplevel-noerasebkgnd-window-class) (let ((hwnd (create-window "GraphicFormsTopLevelNoEraseBkgnd" ; can't use constant here Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Sat Aug 19 22:13:35 2006 @@ -115,12 +115,12 @@ (pixel-point :accessor pixel-point-of :initform nil) - (maximum-size - :accessor maximum-size + (max-size + :accessor max-size-of :initarg :maximum-size :initform nil) - (minimum-size - :accessor minimum-size + (min-size + :accessor min-size-of :initarg :minimum-size :initform nil)) (:documentation "The base class for widgets having pre-defined native behavior.")) @@ -169,12 +169,12 @@ (:documentation "The menu class represents a container for menu items (and submenus).")) (defclass window (widget layout-managed) - ((maximum-size - :accessor maximum-size + ((max-size + :accessor max-size-of :initarg :maximum-size :initform nil) - (minimum-size - :accessor minimum-size + (min-size + :accessor min-size-of :initarg :minimum-size :initform nil)) (:documentation "Base class for user-defined widgets that serve as containers.")) Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Sat Aug 19 22:13:35 2006 @@ -193,7 +193,10 @@ (:documentation "Returns T if the object is in its iconified state.")) (defgeneric image (self) - (:documentation "Returns the object's image object if it has one, or nil otherwise.")) + (:documentation "Returns self's image object if it has one, or nil otherwise.")) + +(defgeneric (setf image) (image self) + (:documentation "Sets self's image object.")) (defgeneric item-height (self) (:documentation "Return the height of the area if one of the object's items were displayed.")) @@ -211,7 +214,10 @@ (:documentation "Returns T if the object's lines are visible; nil otherwise.")) (defgeneric location (self) - (:documentation "Returns a point object describing the coordinates of the top-left corner of the object in its parent's coordinate system.")) + (:documentation "Returns a point object describing the coordinates of the top-left corner of self in its parent's coordinate system.")) + +(defgeneric (setf location) (point self) + (:documentation "Sets a point describing the coordinates of self in its parent's coordinate system.")) (defgeneric lock (self flag) (:documentation "Prevents or enables modification of the object's contents.")) @@ -229,13 +235,19 @@ (:documentation "Returns T if the object is in its maximized state (not necessarily the same as the maximum size); nil otherwise.")) (defgeneric maximum-size (self) - (:documentation "Returns a size object describing the largest dimensions to which the user may resize the widget.")) + (:documentation "Returns a size object describing the largest dimensions to which the user may resize self.")) + +(defgeneric (setf maximum-size) (size self) + (:documentation "Sets the largest dimensions to which the user may resize self.")) (defgeneric menu-bar (self) (:documentation "Returns the menu object serving as the menubar for this object.")) (defgeneric minimum-size (self) - (:documentation "Returns a size object describing the smallest size this object can exist.")) + (:documentation "Returns a size object describing the smallest supported dimensions of self.")) + +(defgeneric (setf minimum-size) (size self) + (:documentation "Sets the smallest supported dimensions of self.")) (defgeneric mouse-over-image (self) (:documentation "Returns the image displayed when the mouse is hovering over this object.")) @@ -340,7 +352,10 @@ (:documentation "This object's items are scrolled until the selection is visible.")) (defgeneric size (self) - (:documentation "Returns a size object describing the size of the object in its parent's coordinate system.")) + (:documentation "Returns the size of self in its parent's coordinate system.")) + +(defgeneric (setf size) (size self) + (:documentation "Sets the size of self in its parent's coordinate system.")) (defgeneric step-increment (self) (:documentation "Return an integer representing the configured step size for the object.")) @@ -363,6 +378,9 @@ (defgeneric text-modified-p (self) (:documentation "Returns true if the text component has been modified; nil otherwise.")) +(defgeneric (setf text-modified-p) (modified self) + (:documentation "Sets self's modified flag.")) + (defgeneric thumb-size (self) (:documentation "Returns an integer representing the width (or height) of this object's thumb.")) Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Sat Aug 19 22:13:35 2006 @@ -259,15 +259,23 @@ (setf (child-visitor-results tc) nil) tmp))) -(defmethod (setf maximum-size) :after (max-size (self window)) +(defmethod maximum-size ((self window)) + (max-size-of self)) + +(defmethod (setf maximum-size) (max-size (self window)) (unless (or (gfs:disposed-p self) (null (layout-of self))) + (setf (max-size-of self) max-size) (let ((size (constrain-new-size max-size (size self) #'min))) (setf (size self) size) (perform (layout-of self) self (gfs:size-width size) (gfs:size-height size)) size))) -(defmethod (setf minimum-size) :after (min-size (self window)) +(defmethod minimum-size ((self window)) + (min-size-of self)) + +(defmethod (setf minimum-size) (min-size (self window)) (unless (or (gfs:disposed-p self) (null (layout-of self))) + (setf (min-size-of self) min-size) (let ((size (constrain-new-size min-size (size self) #'max))) (setf (size self) size) (perform (layout-of self) self (gfs:size-width size) (gfs:size-height size))