Author: junrue Date: Thu Sep 28 01:05:33 2006 New Revision: 274

Modified: trunk/docs/manual/widget-functions.texinfo trunk/src/uitoolkit/widgets/scrollbar.lisp trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp Log: fixed step-size bug in compute-scrolling-delta; implemented step-increment for standard scrollbars

Modified: trunk/docs/manual/widget-functions.texinfo ============================================================================== --- trunk/docs/manual/widget-functions.texinfo (original) +++ trunk/docs/manual/widget-functions.texinfo Thu Sep 28 01:05:33 2006 @@ -446,6 +446,21 @@ by @ref{preferred-size}. @end deffn

+@anchor{page-increment} +@deffn GenericFunction page-increment self => integer +(setf (@strong{page-increment} @var{self}) @var{integer})@* + +This function returns the amount by which the viewport origin +is incremented forward (or backward) when a user gesture causes +a scroll event of type @code{:page-forward} (or @code{:page-back}); +see @ref{event-scroll}. This value determines the size of a +proportional scrollbar's thumb. + +The @sc{setf} function sets this value. The +@ref{scrolling-event-dispatcher} class will manage this on behalf of +@ref{window}s with @emph{standard scrollbars}. +@end deffn + @anchor{parent} @deffn GenericFunction parent self => @ref{window} Returns the @code{parent} of @var{self}. In the case of @ref{panel}s @@ -602,6 +617,20 @@ parent's coordinate system. @end deffn

+@anchor{step-increment} +@deffn GenericFunction step-increment self => integer +(setf (@strong{step-increment} @var{self}) @var{integer})@* + +This function returns the amount by which the viewport origin +is incremented forward (or backward) when a user gesture causes +a scroll event of type @code{:step-forward} (or @code{:step-back}); +see @ref{event-scroll}. + +The @sc{setf} function sets this value. The +@ref{scrolling-event-dispatcher} class will manage this on behalf of +@ref{window}s with @emph{standard scrollbars}. +@end deffn + @deffn GenericFunction text self => string (setf (@strong{text} @var{self}) @var{string})@*

@@ -634,7 +663,8 @@

@anchor{text-modified-p} @deffn GenericFunction text-modified-p self => boolean -(setf (@strong{text-modified-p} @var{self}) @var{boolean})@*@* +(setf (@strong{text-modified-p} @var{self}) @var{boolean})@* + Returns T if the text component of @var{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 @@ -642,6 +672,28 @@ other cases there is no text component at all. @end deffn

+@anchor{thumb-limits} +@deffn GenericFunction thumb-limits self => @ref{span} +(setf (@strong{thumb-limits} @var{self}) @var{span})@* + +Returns a span representing the start and end positions to which the +scrollbar @var{self} may be set. The @sc{setf} function allows this +span to be modified. Application code is responsible for managing the +thumb limits in relation to the content model that will be scrolled +within a @ref{window}. @xref{thumb-position}. +@end deffn + +@anchor{thumb-position} +@deffn GenericFunction thumb-position self => integer +(setf (@strong{thumb-position} @var{self}) @var{integer})@* + +Returns an integer value representing the position of the +scroll thumb for @var{self}. The @sc{setf} function allows +the position to be modified. A @ref{scrolling-event-dispatcher} +instance will manage the thumb position for the @ref{window} +to which it is assigned. @xref{thumb-limits}. +@end deffn + @anchor{undo-available-p} @deffn GenericFunction undo-available-p self => boolean Returns T if @var{self} has @sc{undo} capability and has an

Modified: trunk/src/uitoolkit/widgets/scrollbar.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/scrollbar.lisp (original) +++ trunk/src/uitoolkit/widgets/scrollbar.lisp Thu Sep 28 01:05:33 2006 @@ -133,34 +133,86 @@ (error 'gfs:toolkit-error :detail "invalid standard scrollbar orientation"))) (setf (slot-value self 'dispatcher) nil)) ; standard scrollbars don't use dispatchers

+(defmethod owner ((self standard-scrollbar)) + (parent self)) + (defmethod page-increment ((self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (destructuring-bind (limits pagesize pos trackpos) (sb-get-info self (orientation-of self)) (declare (ignore limits pos trackpos)) pagesize))

(defmethod (setf page-increment) (amount (self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (sb-set-page-increment self (orientation-of self) amount))

+(defmethod parent ((self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) + (let ((parent (get-widget (thread-context) (gfs:handle self)))) + (unless parent + (error 'gfs:toolkit-error :detail "missing parent for standard scrollbar")) + parent)) + +(defmethod step-increment ((self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) + (let ((disp (dispatcher (parent self)))) + (cond + ((typep disp 'scrolling-event-dispatcher) + (if (eql (orientation-of self) :horizontal) + (gfs:size-width (step-increments self)) + (gfs:size-height (step-increments self)))) + (t + (warn 'gfs:toolkit-warning :detail "parent dispatcher is wrong type") + 0)))) + +(defmethod (setf step-increment) (amount (self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) + (uness (>= amount 0) + (warn 'gfs:toolkit-warning :detail "negative step increment")) + (let ((disp (dispatcher (parent self)))) + (cond + ((typep disp 'scrolling-event-dispatcher) + (if (eql (orientation-of self) :horizontal) + (setf (gfs:size-width (step-increments self)) amount) + (setf (gfs:size-height (step-increments self)) amount))) + (t + (warn 'gfs:toolkit-warning :detail "parent dispatcher is wrong type"))))) + (defmethod thumb-limits ((self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (destructuring-bind (limits pagesize pos trackpos) (sb-get-info self (orientation-of self)) (declare (ignore pagesize pos trackpos)) limits))

(defmethod (setf thumb-limits) (span (self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (sb-set-thumb-limits self (orientation-of self) span))

(defmethod thumb-position ((self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (destructuring-bind (limits pagesize pos trackpos) (sb-get-info self (orientation-of self)) (declare (ignore limits pagesize trackpos)) pos))

(defmethod (setf thumb-position) (position (self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (sb-set-thumb-position self (orientation-of self) position))

(defmethod thumb-track-position ((self standard-scrollbar)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) (destructuring-bind (limits pagesize pos trackpos) (sb-get-info self (orientation-of self)) (declare (ignore limits pagesize pos))

Modified: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp (original) +++ trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Thu Sep 28 01:05:33 2006 @@ -48,8 +48,8 @@ (let ((new-pos (case detail (:start (gfs:span-start limits)) (:end (gfs:span-end limits)) - (:step-back (1- curr-pos)) - (:step-forward (1+ curr-pos)) + (:step-back (- curr-pos step-size)) + (:step-forward (+ curr-pos step-size)) (:page-back (- curr-pos page-size)) (:page-forward (+ curr-pos page-size)) (:thumb-position curr-pos) @@ -59,7 +59,7 @@ (- (gfs:span-end limits) (gfs:span-start limits)) page-size)) (setf (thumb-position scrollbar) new-pos) - (* (- curr-pos new-pos) step-size)))) + (- curr-pos new-pos))))

(defun update-scrolling-state (window &optional axis detail) (unless axis

Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Thu Sep 28 01:05:33 2006 @@ -174,12 +174,6 @@ :initform nil)) (:documentation "The base class for widgets having pre-defined native behavior."))

-(defmacro define-callback-slot (callback-event-name) - `(,(intern "CALLBACK-EVENT-NAME") - :accessor ,(intern "CALLBACK-EVENT-NAME-OF") - :initform ,callback-event-name - :allocation :class)) - (defmacro define-control-class (classname callback-event-name &optional docstring mixins) `(defclass ,classname `,(control ,@mixins) ((,(intern "CALLBACK-EVENT-NAME")