Author: junrue Date: Fri Oct 20 00:28:30 2006 New Revision: 364 Added: trunk/src/uitoolkit/widgets/scrolling-helper.lisp - copied, changed from r346, trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Removed: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Modified: trunk/graphic-forms-uitoolkit.asd trunk/src/packages.lisp trunk/src/tests/uitoolkit/scroll-tester.lisp trunk/src/uitoolkit/widgets/event.lisp trunk/src/uitoolkit/widgets/scrollbar.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp Log: renamed scrolling-event-dispatcher to scrolling-helper Modified: trunk/graphic-forms-uitoolkit.asd ============================================================================== --- trunk/graphic-forms-uitoolkit.asd (original) +++ trunk/graphic-forms-uitoolkit.asd Fri Oct 20 00:28:30 2006 @@ -138,7 +138,7 @@ (:file "menu-item") (:file "menu-language") (:file "event") - (:file "scrolling-event-dispatcher") + (:file "scrolling-helper") (:file "scrollbar") (:file "slider") (:file "window") Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Fri Oct 20 00:28:30 2006 @@ -265,7 +265,7 @@ #:panel #:root-window #:scrollbar - #:scrolling-event-dispatcher + #:scrolling-helper #:slider #:timer #:top-level Modified: trunk/src/tests/uitoolkit/scroll-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/scroll-tester.lisp (original) +++ trunk/src/tests/uitoolkit/scroll-tester.lisp Fri Oct 20 00:28:30 2006 @@ -41,7 +41,7 @@ (setf *scroll-tester-win* nil) (gfw:shutdown 0)) -(defclass scroll-tester-events (gfw:scrolling-event-dispatcher) ()) +(defclass scroll-tester-events (gfw:scrolling-helper) ()) (defmethod gfw:event-close ((disp scroll-tester-events) window) (declare (ignore window)) Modified: trunk/src/uitoolkit/widgets/event.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/event.lisp (original) +++ trunk/src/uitoolkit/widgets/event.lisp Fri Oct 20 00:28:30 2006 @@ -391,7 +391,7 @@ (disp (dispatcher widget))) (unwind-protect (let ((parent (gfw:parent widget))) - (when (and parent (typep (dispatcher parent) 'scrolling-event-dispatcher)) + (when (and parent (typep (dispatcher parent) 'scrolling-helper)) (let ((origin (slot-value (dispatcher parent) 'viewport-origin))) (set-window-origin gc origin) (incf (gfs:point-x pnt) (gfs:point-x origin)) Modified: trunk/src/uitoolkit/widgets/scrollbar.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/scrollbar.lisp (original) +++ trunk/src/uitoolkit/widgets/scrollbar.lisp Fri Oct 20 00:28:30 2006 @@ -181,7 +181,7 @@ (error 'gfs:disposed-error)) (let ((disp (dispatcher (parent self)))) (cond - ((typep disp 'scrolling-event-dispatcher) + ((typep disp 'scrolling-helper) (if (eql (orientation-of self) :horizontal) (gfs:size-width (step-increments self)) (gfs:size-height (step-increments self)))) @@ -196,7 +196,7 @@ (warn 'gfs:toolkit-warning :detail "negative step increment")) (let ((disp (dispatcher (parent self)))) (cond - ((typep disp 'scrolling-event-dispatcher) + ((typep disp 'scrolling-helper) (if (eql (orientation-of self) :horizontal) (setf (gfs:size-width (step-increments self)) amount) (setf (gfs:size-height (step-increments self)) amount))) Copied: trunk/src/uitoolkit/widgets/scrolling-helper.lisp (from r346, trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp) ============================================================================== --- trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp (original) +++ trunk/src/uitoolkit/widgets/scrolling-helper.lisp Fri Oct 20 00:28:30 2006 @@ -1,5 +1,5 @@ ;;;; -;;;; scrolling-event-dispatcher.lisp +;;;; scrolling-helper.lisp ;;;; ;;;; Copyright (C) 2006, Jack D. Unrue ;;;; All rights reserved. @@ -130,7 +130,7 @@ ;;; methods ;;; -(defmethod event-pre-resize ((disp scrolling-event-dispatcher) (window window) rect type) +(defmethod event-pre-resize ((disp scrolling-helper) (window window) rect type) (let ((h-step (gfs:size-width (step-increments disp))) (v-step (gfs:size-height (step-increments disp))) (outer-size (gfw:size window)) @@ -153,27 +153,27 @@ (setf (gfs:size-height size) amount))) (setf (gfs:size rect) size))) -(defmethod event-resize ((disp scrolling-event-dispatcher) (window window) size type) +(defmethod event-resize ((disp scrolling-helper) (window window) size type) (declare (ignore size type)) (call-next-method) (when (typep (layout-of window) 'heap-layout) (update-scrollbar-page-sizes window) (update-viewport-origin-for-resize window))) -(defmethod event-scroll ((disp scrolling-event-dispatcher) (window window) axis detail) +(defmethod event-scroll ((disp scrolling-helper) (window window) axis detail) (declare (ignore disp)) (when (typep (layout-of window) 'heap-layout) (update-scrolling-state window axis detail))) -(defmethod initialize-instance :after ((self scrolling-event-dispatcher) &key) +(defmethod initialize-instance :after ((self scrolling-helper) &key) (validate-step-values (step-increments self))) -(defmethod print-object ((self scrolling-event-dispatcher) stream) +(defmethod print-object ((self scrolling-helper) stream) (print-unreadable-object (self stream :type t) (format stream "horizontal policy: ~a " (horizontal-policy-of self)) (format stream "vertical policy: ~a " (vertical-policy-of self)) (format stream "step increments: ~a" (step-increments self)))) -(defmethod (setf step-increment) :after (amounts (self scrolling-event-dispatcher)) +(defmethod (setf step-increment) :after (amounts (self scrolling-helper)) (validate-step-values amounts) (setf (slot-value self 'step-increment) (gfs:copy-size amounts))) Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Fri Oct 20 00:28:30 2006 @@ -39,7 +39,7 @@ (defclass event-dispatcher () () (:documentation "Instances of this class receive events on behalf of user interface objects.")) -(defclass scrolling-event-dispatcher (event-dispatcher) +(defclass scrolling-helper (event-dispatcher) ((horizontal-policy :accessor horizontal-policy-of :initarg :horizontal-policy