[graphic-forms-cvs] r274 - in trunk: docs/manual src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Thu Sep 28 05:05:35 UTC 2006
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
+ at anchor{page-increment}
+ at 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
+ at ref{scrolling-event-dispatcher} class will manage this on behalf of
+ at ref{window}s with @emph{standard scrollbars}.
+ at 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
+ at anchor{step-increment}
+ at 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
+ at ref{scrolling-event-dispatcher} class will manage this on behalf of
+ at ref{window}s with @emph{standard scrollbars}.
+ at 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
+ at anchor{thumb-limits}
+ at 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}.
+ at end deffn
+
+ at anchor{thumb-position}
+ at 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}.
+ at 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 , at mixins)
((,(intern "CALLBACK-EVENT-NAME")
More information about the Graphic-forms-cvs
mailing list