[graphic-forms-cvs] r231 - in trunk: docs/manual src/uitoolkit/graphics src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Tue Aug 22 21:26:06 UTC 2006
Author: junrue
Date: Tue Aug 22 17:26:05 2006
New Revision: 231
Modified:
trunk/docs/manual/widgets-api.texinfo
trunk/src/uitoolkit/graphics/image-data.lisp
trunk/src/uitoolkit/widgets/event.lisp
trunk/src/uitoolkit/widgets/menu-language.lisp
trunk/src/uitoolkit/widgets/widget-generics.lisp
trunk/src/uitoolkit/widgets/widget-with-items.lisp
Log:
resolved more style warnings reported by SBCL
Modified: trunk/docs/manual/widgets-api.texinfo
==============================================================================
--- trunk/docs/manual/widgets-api.texinfo (original)
+++ trunk/docs/manual/widgets-api.texinfo Tue Aug 22 17:26:05 2006
@@ -1204,6 +1204,8 @@
@end deffn
@deffn GenericFunction cancel-widget self
+(setf (@strong{cancel-widget} @var{self}) @var{widget})@*
+
Returns the @ref{widget} that responds to the @sc{esc} key or
otherwise acts to cancel the @ref{owner}. In a @ref{dialog}, this
widget must be a @ref{button} and is typically labelled @emph{Cancel}.
@@ -1285,6 +1287,8 @@
@end deffn
@deffn GenericFunction default-widget self
+(setf (@strong{default-widget} @var{self}) @var{widget})@*
+
Returns the default @ref{widget} set for a @ref{dialog}, or @sc{nil}
if none has been set. If @sc{nil} is passed to the corresponding
@sc{setf} function, then no default widget is set. The default widget
@@ -1577,6 +1581,8 @@
@anchor{resizable-p}
@deffn GenericFunction resizable-p self => boolean
+(setf (@strong{resizable-p} @var{self}) @var{boolean})@*
+
Returns T if @code{self} can be resized by the user; @sc{nil}
otherwise. The corresponding @sc{setf} function is implemented for
the @ref{top-level} class (but only has meaning when the @code{:frame}
@@ -1634,6 +1640,8 @@
@end deffn
@deffn GenericFunction text self => string
+(setf (@strong{text} @var{self}) @var{string})@*
+
For a @ref{window} or @ref{dialog}, this function returns @code{self}'s
titlebar text (which may be blank). For other @ref{widget}s that have a text
component, this function returns that text component. For anything else,
Modified: trunk/src/uitoolkit/graphics/image-data.lisp
==============================================================================
--- trunk/src/uitoolkit/graphics/image-data.lisp (original)
+++ trunk/src/uitoolkit/graphics/image-data.lisp Tue Aug 22 17:26:05 2006
@@ -210,6 +210,8 @@
;;; methods
;;;
+(defgeneric copy-pixels (self pixels-pointer))
+
(defmethod depth ((self image-data))
(depth (data-plugin-of self)))
Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp (original)
+++ trunk/src/uitoolkit/widgets/event.lisp Tue Aug 22 17:26:05 2006
@@ -411,26 +411,24 @@
(w (get-widget tc hwnd))
(info-ptr (cffi:make-pointer lparam)))
(if (typep w 'top-level)
- (cffi:with-foreign-slots ((gfs::mintracksize gfs::maxtracksize)
- info-ptr gfs::minmaxinfo)
- (let ((max-size (maximum-size w))
- (min-size (minimum-size w)))
- (if max-size
- (cffi:with-foreign-slots ((gfs::x gfs::y)
- (cffi:foreign-slot-pointer info-ptr
- 'gfs::minmaxinfo
- 'gfs::maxtracksize)
- gfs::point)
- (setf gfs::x (gfs:size-width max-size)
- gfs::y (gfs:size-height max-size))))
- (if min-size
- (cffi:with-foreign-slots ((gfs::x gfs::y)
- (cffi:foreign-slot-pointer info-ptr
- 'gfs::minmaxinfo
- 'gfs::mintracksize)
- gfs::point)
- (setf gfs::x (gfs:size-width min-size)
- gfs::y (gfs:size-height min-size))))))))
+ (let ((max-size (maximum-size w))
+ (min-size (minimum-size w)))
+ (if max-size
+ (cffi:with-foreign-slots ((gfs::x gfs::y)
+ (cffi:foreign-slot-pointer info-ptr
+ 'gfs::minmaxinfo
+ 'gfs::maxtracksize)
+ gfs::point)
+ (setf gfs::x (gfs:size-width max-size)
+ gfs::y (gfs:size-height max-size))))
+ (if min-size
+ (cffi:with-foreign-slots ((gfs::x gfs::y)
+ (cffi:foreign-slot-pointer info-ptr
+ 'gfs::minmaxinfo
+ 'gfs::mintracksize)
+ gfs::point)
+ (setf gfs::x (gfs:size-width min-size)
+ gfs::y (gfs:size-height min-size)))))))
0)
(defmethod process-message (hwnd (msg (eql gfs::+wm-size+)) wparam lparam)
@@ -479,10 +477,7 @@
;;;
(defmethod process-subclass-message (hwnd msg wparam lparam)
- (let ((wndproc (get-class-wndproc hwnd)))
- (if wndproc
- (gfs::call-window-proc (cffi:make-pointer wndproc) hwnd msg wparam lparam)
- (gfs::def-window-proc hwnd msg wparam lparam))))
+ (gfs::call-window-proc (cffi:make-pointer (get-class-wndproc hwnd)) hwnd msg wparam lparam))
(defmethod process-subclass-message (hwnd (msg (eql gfs::+wm-destroy+)) wparam lparam)
(declare (ignore wparam lparam))
Modified: trunk/src/uitoolkit/widgets/menu-language.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/menu-language.lisp (original)
+++ trunk/src/uitoolkit/widgets/menu-language.lisp Tue Aug 22 17:26:05 2006
@@ -137,28 +137,14 @@
(error 'gfs:toolkit-error
:detail (format nil "invalid menu item option: ~a" opt)))))
(when sep
- (if (or checked disabled disp image sub)
+ (if (or callback checked disabled disp image sub)
(error 'gfs:toolkit-error :detail "invalid separator options")))
- (when image
- (if (or sep sub)
- (error 'gfs:toolkit-error :detail "image cannot be set for separators or submenus"))
- (if (null image)
- (error 'gfs:toolkit-error :detail "missing image object")))
(when callback
- (if sep
- (error 'gfs:toolkit-error :detail "callbacks cannot be set for separators"))
- (if (null callback)
- (error 'gfs:toolkit-error :detail "missing callback argument"))
(if sub
(setf disp `(make-instance (define-dispatcher 'gfw:menu ,callback)))
(setf disp `(make-instance (define-dispatcher 'gfw:menu-item ,callback)))))
- (when disp
- (if sep
- (error 'gfs:toolkit-error :detail "dispatchers cannot be set for separators"))
- (if (null disp)
- (error 'gfs:toolkit-error :detail "missing dispatcher argument")))
(when sub
- (if (or checked image sep (not (listp sub)))
+ (if (or checked image (not (listp sub)))
(error 'gfs:toolkit-error :detail "invalid option for submenu")))
(cond
(sep (push `(define-separator ,generator-sym) code))
Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-generics.lisp (original)
+++ trunk/src/uitoolkit/widgets/widget-generics.lisp Tue Aug 22 17:26:05 2006
@@ -63,6 +63,12 @@
(defgeneric border-width (self)
(:documentation "Returns the object's border width."))
+(defgeneric cancel-widget (self)
+ (:documentation "Returns the widget that will be activated when the ESC key is pressed."))
+
+(defgeneric (setf cancel-widget) (widget self)
+ (:documentation "Sets the widget that will be activated when the ESC key is pressed."))
+
(defgeneric caret (self)
(:documentation "Returns the object's caret."))
@@ -118,7 +124,10 @@
(:documentation "Copies the current text selection to the clipboard and removes it from self."))
(defgeneric default-widget (self)
- (:documentation "Returns the child widget or item that has the default emphasis."))
+ (:documentation "Returns the widget or item that will be selected when self is active."))
+
+(defgeneric (setf default-widget) (self widget)
+ (:documentation "Sets the widget or item that will be selected when self is active."))
(defgeneric delete-all (self)
(:documentation "Removes all content from the object."))
@@ -241,7 +250,10 @@
(: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."))
+ (:documentation "Returns the menu object serving as the menubar self."))
+
+(defgeneric (setf menu-bar) (menu self)
+ (:documentation "Sets the menu object to serve as the menubar for self."))
(defgeneric minimum-size (self)
(:documentation "Returns a size object describing the smallest supported dimensions of self."))
@@ -300,6 +312,9 @@
(defgeneric resizable-p (self)
(:documentation "Returns T if the object is resizable; nil otherwise."))
+(defgeneric (setf resizable-p) (flag self)
+ (:documentation "Pass nil to disable user resizing of self, or non-nil to enable user resizing."))
+
(defgeneric retrieve-span (self)
(:documentation "Returns the span object indicating the range of values that are valid for the object."))
@@ -361,7 +376,10 @@
(:documentation "Return an integer representing the configured step size for the object."))
(defgeneric text (self)
- (:documentation "Returns the object's text."))
+ (:documentation "Returns self's text."))
+
+(defgeneric (setf text) (text self)
+ (:documentation "Sets self's text."))
(defgeneric text-baseline (self)
(:documentation "Returns the y coordinate of the object's text component, if any."))
Modified: trunk/src/uitoolkit/widgets/widget-with-items.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-with-items.lisp (original)
+++ trunk/src/uitoolkit/widgets/widget-with-items.lisp Tue Aug 22 17:26:05 2006
@@ -39,9 +39,10 @@
(error 'gfs:disposed-error)))
(defmethod delete-all ((self widget-with-items))
- (let ((count (length (items self))))
- (unless (zerop count)
- (delete-item-span self (gfs:make-span :start 0 :end (1- count))))))
+ (let ((items (items self)))
+ (dotimes (i (length items))
+ (gfs:dispose (aref items i))))
+ (setf (items self) (make-array 7 :fill-pointer 0 :adjustable t)))
(defmethod delete-item :before ((self widget-with-items) index)
(declare (ignore index))
@@ -51,7 +52,7 @@
(defmethod delete-item ((self widget-with-items) index)
(let* ((items (items self))
(it (elt items index)))
- (delete it (items self) :test #'items-equal-p)
+ (setf (items self) (remove it items :test #'items-equal-p))
(if (gfs:disposed-p it)
(error 'gfs:disposed-error))
(gfs:dispose it)))
More information about the Graphic-forms-cvs
mailing list