[graphic-forms-cvs] r224 - in trunk: . docs/manual src/uitoolkit/graphics src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Sun Aug 20 02:13:37 UTC 2006
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}
- at deffn GenericFunction background-color self
+ at 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
- at 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
- at deffn GenericFunction depth self
+ at deffn GenericFunction depth self => integer
Returns the bits-per-pixel depth of the object.
@end deffn
@@ -521,13 +525,18 @@
@end table
@end deffn
- at deffn GenericFunction font self
-Returns the current font.
+ at 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}
- at deffn GenericFunction foreground-color self
+ at 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
+ at 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
- at deffn GenericFunction menu-bar self
+ at 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
- at deffn GenericFunction size self
+ at 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}
- at deffn GenericFunction text-modified-p self
+ at 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))
More information about the Graphic-forms-cvs
mailing list