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)))