From 8bdb67bc12553a955cef31caaf01f0f41a09f354 Mon Sep 17 00:00:00 2001 From: culler Date: Tue, 7 Nov 2023 20:08:38 +0000 Subject: Implement touchpad events. See [de3bbbcb68]: macOS NSScrollWheel events not handled correctly by 8.7. --- macosx/tkMacOSXMouseEvent.c | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index d4ed5ad..0cfa7d3 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -566,13 +566,18 @@ enum { #define WHEEL_DELTA 120 #define WHEEL_DELAY 300000000 +#define WHEEL_INCREMENT 0.100006103515625 + uint64_t wheelTick = clock_gettime_nsec_np(CLOCK_MONOTONIC_RAW); Bool timeout = (wheelTick - tsdPtr->wheelTickPrev) >= WHEEL_DELAY; if (timeout) { tsdPtr->vWheelAcc = tsdPtr->hWheelAcc = 0; } tsdPtr->wheelTickPrev = wheelTick; - delta = [theEvent deltaY]; + delta = [theEvent scrollingDeltaY]; + if (![theEvent hasPreciseScrollingDeltas]) { + delta /= WHEEL_INCREMENT; + } if (delta != 0.0) { delta = (tsdPtr->vWheelAcc += delta); if (timeout && fabs(delta) < 1.0) { @@ -587,7 +592,10 @@ enum { Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } - delta = [theEvent deltaX]; + delta = [theEvent scrollingDeltaX]; + if (![theEvent hasPreciseScrollingDeltas]) { + delta /= WHEEL_INCREMENT; + } if (delta != 0.0) { delta = (tsdPtr->hWheelAcc += delta); if (timeout && fabs(delta) < 1.0) { -- cgit v0.12 From e6018fcddfed44488ca47e5008ca7ad0a31d9e74 Mon Sep 17 00:00:00 2001 From: culler Date: Tue, 7 Nov 2023 21:17:55 +0000 Subject: Some small adjustments. --- macosx/tkMacOSXMouseEvent.c | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 0cfa7d3..bac7a30 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -550,6 +550,7 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } } else { + Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; CGFloat delta; XEvent xEvent = {0}; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) @@ -566,7 +567,6 @@ enum { #define WHEEL_DELTA 120 #define WHEEL_DELAY 300000000 -#define WHEEL_INCREMENT 0.100006103515625 uint64_t wheelTick = clock_gettime_nsec_np(CLOCK_MONOTONIC_RAW); Bool timeout = (wheelTick - tsdPtr->wheelTickPrev) >= WHEEL_DELAY; @@ -575,10 +575,8 @@ enum { } tsdPtr->wheelTickPrev = wheelTick; delta = [theEvent scrollingDeltaY]; - if (![theEvent hasPreciseScrollingDeltas]) { - delta /= WHEEL_INCREMENT; - } if (delta != 0.0) { + delta = deltaIsPrecise ? delta / 2 : 10 * delta; delta = (tsdPtr->vWheelAcc += delta); if (timeout && fabs(delta) < 1.0) { delta = ((delta < 0.0) ? -1.0 : 1.0); @@ -593,10 +591,8 @@ enum { } } delta = [theEvent scrollingDeltaX]; - if (![theEvent hasPreciseScrollingDeltas]) { - delta /= WHEEL_INCREMENT; - } if (delta != 0.0) { + delta = deltaIsPrecise ? delta / 2 : 10 * delta; delta = (tsdPtr->hWheelAcc += delta); if (timeout && fabs(delta) < 1.0) { delta = ((delta < 0.0) ? -1.0 : 1.0); -- cgit v0.12 From 2fda4b1460a44e8d143882fc8fa3162f7ebe4c1d Mon Sep 17 00:00:00 2001 From: culler Date: Thu, 9 Nov 2023 17:46:56 +0000 Subject: Remove the delta accumulator; allow a Text to scroll at pixel resolution; use scrollingDelta correctly. --- library/text.tcl | 11 +++++++-- macosx/tkMacOSXMouseEvent.c | 60 +++++++++++---------------------------------- 2 files changed, 23 insertions(+), 48 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index e5a4c11..c827232 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -456,9 +456,16 @@ bind Text { } set ::tk::Priv(prevPos) {} -bind Text { - tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels +if {[tk windowingsystem] eq "aqua"} { + bind Text { + tk::MouseWheel %W y [tk::ScaleNum %D] -1.0 pixels + } +} else { + bind Text { + tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels + } } + bind Text { tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels } diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index bac7a30..2adeb3c 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -25,13 +25,6 @@ typedef struct { Point local; } MouseEventData; -typedef struct { - uint64_t wheelTickPrev; /* For high resolution wheels. */ - double vWheelAcc; /* For high resolution wheels (vertical). */ - double hWheelAcc; /* For high resolution wheels (horizontal). */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; - static Tk_Window captureWinPtr = NULL; /* Current capture window; may be * NULL. */ @@ -553,9 +546,6 @@ enum { Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; CGFloat delta; XEvent xEvent = {0}; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) - Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); - xEvent.type = MouseWheelEvent; xEvent.xbutton.x = win_x; xEvent.xbutton.y = win_y; @@ -564,47 +554,25 @@ enum { xEvent.xany.send_event = false; xEvent.xany.display = Tk_Display(target); xEvent.xany.window = Tk_WindowId(target); - -#define WHEEL_DELTA 120 -#define WHEEL_DELAY 300000000 - - uint64_t wheelTick = clock_gettime_nsec_np(CLOCK_MONOTONIC_RAW); - Bool timeout = (wheelTick - tsdPtr->wheelTickPrev) >= WHEEL_DELAY; - if (timeout) { - tsdPtr->vWheelAcc = tsdPtr->hWheelAcc = 0; - } - tsdPtr->wheelTickPrev = wheelTick; delta = [theEvent scrollingDeltaY]; + if (! deltaIsPrecise) { + delta = delta > 0 ? ceil(10.0 * delta) : - ceil(-10.0 * delta); + } if (delta != 0.0) { - delta = deltaIsPrecise ? delta / 2 : 10 * delta; - delta = (tsdPtr->vWheelAcc += delta); - if (timeout && fabs(delta) < 1.0) { - delta = ((delta < 0.0) ? -1.0 : 1.0); - } - if (fabs(delta) >= 0.6) { - int intDelta = round(delta); - xEvent.xbutton.state = state; - xEvent.xkey.keycode = WHEEL_DELTA * intDelta; - tsdPtr->vWheelAcc -= intDelta; - xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); - Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); - } + xEvent.xbutton.state = state; + xEvent.xkey.keycode = delta; + xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } delta = [theEvent scrollingDeltaX]; + if (! deltaIsPrecise) { + delta = delta > 0 ? ceil(10.0 * delta) : - ceil(-10.0 * delta); + } if (delta != 0.0) { - delta = deltaIsPrecise ? delta / 2 : 10 * delta; - delta = (tsdPtr->hWheelAcc += delta); - if (timeout && fabs(delta) < 1.0) { - delta = ((delta < 0.0) ? -1.0 : 1.0); - } - if (fabs(delta) >= 0.6) { - int intDelta = round(delta); - xEvent.xbutton.state = state | ShiftMask; - xEvent.xkey.keycode = WHEEL_DELTA * intDelta; - tsdPtr->hWheelAcc -= intDelta; - xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); - Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); - } + xEvent.xbutton.state = state | ShiftMask; + xEvent.xkey.keycode = delta; + xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } -- cgit v0.12 From 521d6174ca0c4f1927555fa7713c89fef1c843e1 Mon Sep 17 00:00:00 2001 From: culler Date: Thu, 9 Nov 2023 23:18:32 +0000 Subject: Revert text.tcl, compensate by using the MSteryFactor. --- library/text.tcl | 11 ++--------- macosx/tkMacOSXMouseEvent.c | 20 ++++++++++++++++++-- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index c827232..e5a4c11 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -456,16 +456,9 @@ bind Text { } set ::tk::Priv(prevPos) {} -if {[tk windowingsystem] eq "aqua"} { - bind Text { - tk::MouseWheel %W y [tk::ScaleNum %D] -1.0 pixels - } -} else { - bind Text { - tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels - } +bind Text { + tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } - bind Text { tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels } diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 2adeb3c..f0bcddf 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -543,6 +543,22 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } } else { + + /* + * For consistency with Windows behavior we are supposed to + * multiply the number of pixels to scroll by times 120.0. + * Then ::tk::MouseWheel will divide the scroll size by 120.0 + * unless another factor is specified. The Text widget uses + * a factor of 4.0 in the proc which it binds to the MouseWheel + * event. This has the effect of making the minimum scroll + * size for the Text widget be 30 px. For smooth scrolling + * we want to scroll the Text widget by the number of pixels + * specified in the scrollingDelta properties of the + * NSScrollWheel event, not that number times 30. So + * instead of multiplying by 120.0 we multiply by 4.0. + */ +#define MSteryFactor 4.0 + Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; CGFloat delta; XEvent xEvent = {0}; @@ -560,7 +576,7 @@ enum { } if (delta != 0.0) { xEvent.xbutton.state = state; - xEvent.xkey.keycode = delta; + xEvent.xkey.keycode = delta * MSteryFactor; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } @@ -570,7 +586,7 @@ enum { } if (delta != 0.0) { xEvent.xbutton.state = state | ShiftMask; - xEvent.xkey.keycode = delta; + xEvent.xkey.keycode = delta * MSteryFactor; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } -- cgit v0.12 From a9341a2df78f4af62fd48cbecb50023e34e2e760 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sat, 11 Nov 2023 14:14:20 +0000 Subject: Avoid casting a negative float as an unsigned int. --- macosx/tkMacOSXMouseEvent.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index f0bcddf..274e8a6 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -576,7 +576,7 @@ enum { } if (delta != 0.0) { xEvent.xbutton.state = state; - xEvent.xkey.keycode = delta * MSteryFactor; + xEvent.xkey.keycode = (unsigned int)(int)(delta * MSteryFactor); xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } @@ -586,7 +586,7 @@ enum { } if (delta != 0.0) { xEvent.xbutton.state = state | ShiftMask; - xEvent.xkey.keycode = delta * MSteryFactor; + xEvent.xkey.keycode = (unsigned int)(int)(delta * MSteryFactor); xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } -- cgit v0.12 From b2a0dd551db91af30c2bcfb822c975503190e77b Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sat, 11 Nov 2023 18:37:19 +0000 Subject: Implement smooth scrolling for macOS in a way which can be adapted to other platforms. --- library/text.tcl | 24 ++++++++++++++++++++---- macosx/tkMacOSXMouseEvent.c | 27 ++++++++++----------------- 2 files changed, 30 insertions(+), 21 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index e5a4c11..eeb20fd 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -457,16 +457,32 @@ bind Text { set ::tk::Priv(prevPos) {} bind Text { - tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels + if {[ expr %s & 512 ]} { + tk::MouseWheel %W y %D -1.0 pixels + } else { + tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels + } } bind Text { - tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels + if {[ expr %s & 512 ]} { + tk::MouseWheel %W y %D pixels + } else { + tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels + } } bind Text { - tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels + if {[ expr %s & 512 ]} { + tk::MouseWheel %W x %D -1.0 pixels + } else { + tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels + } } bind Text { - tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels + if {[ expr %s & 512 ]} { + tk::MouseWheel %W x %D -1.0 pixels + } else { + tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels + } } # ::tk::TextClosestGap -- diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 274e8a6..3d1b9d9 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -544,21 +544,14 @@ enum { } } else { - /* - * For consistency with Windows behavior we are supposed to - * multiply the number of pixels to scroll by times 120.0. - * Then ::tk::MouseWheel will divide the scroll size by 120.0 - * unless another factor is specified. The Text widget uses - * a factor of 4.0 in the proc which it binds to the MouseWheel - * event. This has the effect of making the minimum scroll - * size for the Text widget be 30 px. For smooth scrolling - * we want to scroll the Text widget by the number of pixels - * specified in the scrollingDelta properties of the - * NSScrollWheel event, not that number times 30. So - * instead of multiplying by 120.0 we multiply by 4.0. + /* + * This state bit means that the delta should be interpreted + * as a number of pixels. It is chosen to not conflict with + * any modifier bits. */ -#define MSteryFactor 4.0 + #define HiresScrollMask 1 << 9 + Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; CGFloat delta; XEvent xEvent = {0}; @@ -575,8 +568,8 @@ enum { delta = delta > 0 ? ceil(10.0 * delta) : - ceil(-10.0 * delta); } if (delta != 0.0) { - xEvent.xbutton.state = state; - xEvent.xkey.keycode = (unsigned int)(int)(delta * MSteryFactor); + xEvent.xbutton.state = state | HiresScrollMask; + xEvent.xkey.keycode = (unsigned int)(int)delta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } @@ -585,8 +578,8 @@ enum { delta = delta > 0 ? ceil(10.0 * delta) : - ceil(-10.0 * delta); } if (delta != 0.0) { - xEvent.xbutton.state = state | ShiftMask; - xEvent.xkey.keycode = (unsigned int)(int)(delta * MSteryFactor); + xEvent.xbutton.state = state | ShiftMask | HiresScrollMask; + xEvent.xkey.keycode = (unsigned int)(int)delta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } -- cgit v0.12 From b7c0646739693134b8a50bfdbea4c111fcb023ec Mon Sep 17 00:00:00 2001 From: marcc Date: Sat, 11 Nov 2023 19:53:40 +0000 Subject: Implement smooth scrolling for Windows. --- win/tkWinX.c | 56 ++++++++++---------------------------------------------- 1 file changed, 10 insertions(+), 46 deletions(-) diff --git a/win/tkWinX.c b/win/tkWinX.c index a705bcf..4b34a1c 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -81,9 +81,6 @@ typedef struct { * screen. */ int updatingClipboard; /* If 1, we are updating the clipboard. */ int surrogateBuffer; /* Buffer for first of surrogate pair. */ - DWORD wheelTickPrev; /* For high resolution wheels. */ - int vWheelAcc; /* For high resolution wheels (vertical). */ - int hWheelAcc; /* For high resolution wheels (horizontal). */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -534,9 +531,6 @@ TkpOpenDisplay( memset(tsdPtr->winDisplay, 0, sizeof(TkDisplay)); tsdPtr->winDisplay->display = display; tsdPtr->updatingClipboard = FALSE; - tsdPtr->wheelTickPrev = GetTickCount(); - tsdPtr->vWheelAcc = 0; - tsdPtr->hWheelAcc = 0; /* * Key map info must be available immediately, because of "send event". @@ -1130,18 +1124,7 @@ GenerateXEvent( * Support for high resolution wheels (vertical). */ - DWORD wheelTick = GetTickCount(); - BOOL timeout = wheelTick - tsdPtr->wheelTickPrev >= 300; - int intDelta; - - tsdPtr->wheelTickPrev = wheelTick; - if (timeout) { - tsdPtr->vWheelAcc = tsdPtr->hWheelAcc = 0; - } - tsdPtr->vWheelAcc += (short) HIWORD(wParam); - if (!tsdPtr->vWheelAcc || (!timeout && abs(tsdPtr->vWheelAcc) < WHEEL_DELTA * 6 / 10)) { - return; - } + int delta = (short) HIWORD(wParam); /* * We have invented a new X event type to handle this event. It @@ -1151,17 +1134,13 @@ GenerateXEvent( * TkpGetString. [Bug 1118340]. */ - intDelta = (abs(tsdPtr->vWheelAcc) + WHEEL_DELTA/2) / WHEEL_DELTA * WHEEL_DELTA; - if (intDelta == 0) { - intDelta = (tsdPtr->vWheelAcc < 0) ? -WHEEL_DELTA : WHEEL_DELTA; - } else if (tsdPtr->vWheelAcc < 0) { - intDelta = -intDelta; - } event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; event.key.nbytes = 0; - event.x.xkey.keycode = intDelta; - tsdPtr->vWheelAcc -= intDelta; + event.x.xkey.keycode = (unsigned int)delta; + if ( delta % 120 != 0) { + event.x.xkey.state |= (1 << 9); + } break; } case WM_MOUSEHWHEEL: { @@ -1169,18 +1148,7 @@ GenerateXEvent( * Support for high resolution wheels (horizontal). */ - DWORD wheelTick = GetTickCount(); - BOOL timeout = wheelTick - tsdPtr->wheelTickPrev >= 300; - int intDelta; - - tsdPtr->wheelTickPrev = wheelTick; - if (timeout) { - tsdPtr->vWheelAcc = tsdPtr->hWheelAcc = 0; - } - tsdPtr->hWheelAcc -= (short) HIWORD(wParam); - if (!tsdPtr->hWheelAcc || (!timeout && abs(tsdPtr->hWheelAcc) < WHEEL_DELTA * 6 / 10)) { - return; - } + int delta = (short) HIWORD(wParam); /* * We have invented a new X event type to handle this event. It @@ -1190,18 +1158,14 @@ GenerateXEvent( * TkpGetString. [Bug 1118340]. */ - intDelta = (abs(tsdPtr->hWheelAcc) + WHEEL_DELTA/2) / WHEEL_DELTA * WHEEL_DELTA; - if (intDelta == 0) { - intDelta = (tsdPtr->hWheelAcc < 0) ? -WHEEL_DELTA : WHEEL_DELTA; - } else if (tsdPtr->hWheelAcc < 0) { - intDelta = -intDelta; - } event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; event.key.nbytes = 0; event.x.xkey.state |= ShiftMask; - event.x.xkey.keycode = intDelta; - tsdPtr->hWheelAcc -= intDelta; + event.x.xkey.keycode = delta; + if ( delta % 120 != 0) { + event.x.xkey.state |= (1 << 9); + } break; } case WM_SYSKEYDOWN: -- cgit v0.12 From ef6e4da40e621eefc7b7b943a534529a0cb1a907 Mon Sep 17 00:00:00 2001 From: marcc Date: Sat, 11 Nov 2023 20:17:17 +0000 Subject: Clean up. --- macosx/tkMacOSXMouseEvent.c | 2 +- win/tkWinX.c | 19 +++++++++++++++++-- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 3d1b9d9..bb6e1a8 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -550,7 +550,7 @@ enum { * any modifier bits. */ - #define HiresScrollMask 1 << 9 +#define HiresScrollMask (1 << 9) Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; CGFloat delta; diff --git a/win/tkWinX.c b/win/tkWinX.c index 4b34a1c..9583335 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -20,6 +20,7 @@ # pragma comment (lib, "advapi32.lib") #endif + /* * The zmouse.h file includes the definition for WM_MOUSEWHEEL. */ @@ -35,6 +36,20 @@ #define WM_MOUSEHWHEEL 0x020E #endif +/* This flag is set in the state of the MouseWheelEvent to indicate + * that the value stored in the keycode field should be interpreted + * as the number of pixels to scroll. A WM_MOUSEWHEEL message sent + * by a trackpad contains the number of pixels as the delta value, + * while low precision scrollwheels always send an integer multiple + * of WHEELDELTA (= 120) as the delta value. We set this flag + * whenever the WM_MOUSEWHEEL delta is not a multiple of 120. This + * ignores the (rare) possibility that a trackpad might generate + * a message with delta a multiple of 120, intended to be interpreted + * as pixels. If that proves annoying it will need to be addressed. + */ + +#define HiresScrollMask (1 << 9) + /* * imm.h is needed by HandleIMEComposition */ @@ -1139,7 +1154,7 @@ GenerateXEvent( event.key.nbytes = 0; event.x.xkey.keycode = (unsigned int)delta; if ( delta % 120 != 0) { - event.x.xkey.state |= (1 << 9); + event.x.xkey.state |= HiresScrollMask; } break; } @@ -1164,7 +1179,7 @@ GenerateXEvent( event.x.xkey.state |= ShiftMask; event.x.xkey.keycode = delta; if ( delta % 120 != 0) { - event.x.xkey.state |= (1 << 9); + event.x.xkey.state |= HiresScrollMask; } break; } -- cgit v0.12 From 7aab45dcbe2f7f30ddd45a4793082a44f2cb325d Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sun, 12 Nov 2023 14:35:04 +0000 Subject: Use a more robust heuristic for deciding whether a WM_MOUSEWHEEL message is high resolution. --- win/tkWinX.c | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/win/tkWinX.c b/win/tkWinX.c index 9583335..c1c6815 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -48,9 +48,21 @@ * as pixels. If that proves annoying it will need to be addressed. */ +#define WHEELDELTA 120 #define HiresScrollMask (1 << 9) /* + * Our heuristic for deciding whether a WM_MOUSEWHEEL message + * comes from a high resolution scrolling device is that we + * assume it is high resolution unless there are two consecutive + * delta values that are both multiples of 120. This is static, + * rather than thread-specific, since input devices are shared + * by all threads. + */ + +static int lastMod = 0; + +/* * imm.h is needed by HandleIMEComposition */ @@ -1140,6 +1152,7 @@ GenerateXEvent( */ int delta = (short) HIWORD(wParam); + int mod = delta % WHEELDELTA; /* * We have invented a new X event type to handle this event. It @@ -1153,9 +1166,10 @@ GenerateXEvent( event.x.xany.send_event = -1; event.key.nbytes = 0; event.x.xkey.keycode = (unsigned int)delta; - if ( delta % 120 != 0) { + if ( mod != 0 || lastMod != 0) { event.x.xkey.state |= HiresScrollMask; } + lastMod = mod; break; } case WM_MOUSEHWHEEL: { @@ -1164,6 +1178,7 @@ GenerateXEvent( */ int delta = (short) HIWORD(wParam); + int mod = delta % WHEELDELTA; /* * We have invented a new X event type to handle this event. It @@ -1178,9 +1193,10 @@ GenerateXEvent( event.key.nbytes = 0; event.x.xkey.state |= ShiftMask; event.x.xkey.keycode = delta; - if ( delta % 120 != 0) { + if ( mod != 0 || lastMod != 0) { event.x.xkey.state |= HiresScrollMask; } + lastMod = mod; break; } case WM_SYSKEYDOWN: -- cgit v0.12 From d31dfdbe331a357ed76d8962597577f45c984a24 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sun, 12 Nov 2023 14:58:54 +0000 Subject: Give the new flag a name in text.tcl. --- library/text.tcl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index eeb20fd..3fca1f0 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -455,30 +455,30 @@ bind Text { } } set ::tk::Priv(prevPos) {} - +set HiresScrollMask 512 bind Text { - if {[ expr %s & 512 ]} { + if {[ expr %s & $HiresScrollMask ]} { tk::MouseWheel %W y %D -1.0 pixels } else { tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } } bind Text { - if {[ expr %s & 512 ]} { + if {[ expr %s & $HiresScrollMask ]} { tk::MouseWheel %W y %D pixels } else { tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels } } bind Text { - if {[ expr %s & 512 ]} { + if {[ expr %s & $HiresScrollMask ]} { tk::MouseWheel %W x %D -1.0 pixels } else { tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels } } bind Text { - if {[ expr %s & 512 ]} { + if {[ expr %s & $HiresScrollMask ]} { tk::MouseWheel %W x %D -1.0 pixels } else { tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels -- cgit v0.12 From 1ad003ace03d05e0d972253186e5837f3fd2d2ed Mon Sep 17 00:00:00 2001 From: marc_culler Date: Mon, 13 Nov 2023 02:33:31 +0000 Subject: Fix errors in text.tcl. Thanks Csaba! --- library/text.tcl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index 3fca1f0..73ec714 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -457,29 +457,29 @@ bind Text { set ::tk::Priv(prevPos) {} set HiresScrollMask 512 bind Text { - if {[ expr %s & $HiresScrollMask ]} { + if {[expr {%s & $HiresScrollMask}]} { tk::MouseWheel %W y %D -1.0 pixels } else { tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } } bind Text { - if {[ expr %s & $HiresScrollMask ]} { - tk::MouseWheel %W y %D pixels + if {[expr {%s & $HiresScrollMask}]} { + tk::MouseWheel %W y %D -0.3 pixels } else { tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels } } bind Text { - if {[ expr %s & $HiresScrollMask ]} { + if {[expr {%s & $HiresScrollMask}]} { tk::MouseWheel %W x %D -1.0 pixels } else { tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels } } bind Text { - if {[ expr %s & $HiresScrollMask ]} { - tk::MouseWheel %W x %D -1.0 pixels + if {[expr {%s & $HiresScrollMask}]} { + tk::MouseWheel %W x %D -0.3 pixels } else { tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels } -- cgit v0.12 From 6985b2c91a0a68e768f0c27a7e21e38fcb657fba Mon Sep 17 00:00:00 2001 From: culler Date: Mon, 13 Nov 2023 17:34:43 +0000 Subject: Update cscroll.tcl --- library/demos/cscroll.tcl | 63 ++++++++++++++++------------------------------- 1 file changed, 21 insertions(+), 42 deletions(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index eea0e2e..41f6d5d 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -17,7 +17,7 @@ wm iconname $w "cscroll" positionWindow $w set c $w.c -label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." +label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with either shift-button 1 or button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." pack $w.msg -side top ## See Code / Dismiss buttons @@ -56,61 +56,40 @@ for {set i 0} {$i < 20} {incr i} { $c bind all "scrollEnter $c" $c bind all "scrollLeave $c" $c bind all "scrollButton $c" -if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} { - bind $c "$c scan mark %x %y" - bind $c "$c scan dragto %x %y" + +bind $c "$c scan mark %x %y" +bind $c "$c scan dragto %x %y" +bind $c "$c scan mark %x %y" +bind $c "$c scan dragto %x %y" + +if {[package vsatisfies [package provide Tk] 8.7-]} { + # Bindings for 8.7 and up + $c configure -yscrollincrement 1 -xscrollincrement 1 bind $c { - %W yview scroll [expr {-%D}] units - } - bind $c { - %W yview scroll [expr {-10*%D}] units + tk::MouseWheel %W y %D -1.0 } bind $c { - %W xview scroll [expr {-%D}] units + tk::MouseWheel %W x %D -1.0 } - bind $c { - %W xview scroll [expr {-10*%D}] units + bind $c { + tk::MouseWheel %W y %D -0.3 + } + bind $c { + tk::MouseWheel %W x %D -0.3 } } else { - bind $c "$c scan mark %x %y" - bind $c "$c scan dragto %x %y" - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/-30 = -1, - # but - # (int)-1/-30 = 0 - # The following code ensure equal +/- behaviour. bind $c { - if {%D >= 0} { - %W yview scroll [expr {%D/-30}] units - } else { - %W yview scroll [expr {(%D-29)/-30}] units - } + %W yview scroll [expr {-%D}] units } bind $c { - if {%D >= 0} { - %W yview scroll [expr {%D/-3}] units - } else { - %W yview scroll [expr {(%D-2)/-3}] units - } + %W yview scroll [expr {-10*%D}] units } bind $c { - if {%D >= 0} { - %W xview scroll [expr {%D/-30}] units - } else { - %W xview scroll [expr {(%D-29)/-30}] units - } + %W xview scroll [expr {-%D}] units } bind $c { - if {%D >= 0} { - %W xview scroll [expr {%D/-3}] units - } else { - %W xview scroll [expr {(%D-2)/-3}] units - } + %W xview scroll [expr {-10*%D}] units } -} - -if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} { # Support for mousewheels on Linux/Unix commonly comes through mapping # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: -- cgit v0.12 From 295a4dd3fc0ace2082cfc84d80601b6efb7c56c8 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sun, 19 Nov 2023 14:21:41 +0000 Subject: Fix Scrollbar bindings --- library/demos/cscroll.tcl | 19 +++++++++++++++++++ library/scrlbar.tcl | 46 +++++++++++++++++++++++++++++++++++++--------- 2 files changed, 56 insertions(+), 9 deletions(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 41f6d5d..54d98e0 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -27,6 +27,25 @@ pack $btns -side bottom -fill x frame $w.grid ttk::scrollbar $w.hscroll -orient horizontal -command "$c xview" ttk::scrollbar $w.vscroll -command "$c yview" +# Override the scrollbar's mousewheel binding to speed it up: +set fastwheel { + set HiresScrollMask 512 + set ShiftMask 1 + if {[expr {%s & $ShiftMask}]} { + set orientation "h"; + } else { + set orientation "v"; + } + if {[expr {%s & $HiresScrollMask}]} { + tk::ScrollByUnits %W $orientation %D -1.0 + } else { + tk::ScrollByUnits %W $orientation %D -30.0 + } + break +} +bind $w.vscroll $fastwheel +bind $w.hscroll $fastwheel + canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \ -xscrollcommand "$w.hscroll set" \ -yscrollcommand "$w.vscroll set" diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index c18d4a8..c54e880 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -129,11 +129,31 @@ bind Scrollbar <> { } } +set HiresScrollMask 512 +set ShiftMask 1 bind Scrollbar { - tk::ScrollByUnits %W hv %D -40.0 + if {[expr {%s & $ShiftMask}]} { + set orientation "h"; + } else { + set orientation "v"; + } + if {[expr {%s & $HiresScrollMask}]} { + tk::ScrollByUnits %W $orientation %D -10.0 + } else { + tk::ScrollByUnits %W $orientation [tk::ScaleNum %D] -30.0 + } } bind Scrollbar { - tk::ScrollByUnits %W hv %D -12.0 + if {[expr {%s & $ShiftMask}]} { + set orientation "h"; + } else { + set orientation "v"; + } + if {[expr {%s & $HiresScrollMask}]} { + tk::ScrollByUnits %W $orientation %D -1.0 + } else { + tk::ScrollByUnits %W $orientation [tk::ScaleNum %D] -3.0 + } } # tk::ScrollButtonDown -- @@ -308,16 +328,24 @@ proc ::tk::ScrollEndDrag {w x y} { proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { set cmd [$w cget -command] - if {$cmd eq "" || ([string first \ - [string index [$w cget -orient] 0] $orient] < 0)} { + if {$cmd eq ""} { return } - set info [$w get] - if {[llength $info] == 2} { - uplevel #0 $cmd scroll [expr {$amount/$factor}] units - } else { - uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}] + set xyview [lindex [split $cmd] end] + if {$orient eq "v"} { + if {$xyview eq "xview"} { + return + } + set size [winfo height $w] + } + if {$orient eq "h"} { + if {$xyview eq "yview"} { + return + } + set size [winfo width $w] } + set scale [expr {[$w delta 1.0 1.0] * $size}] + uplevel #0 $cmd scroll [expr {$amount * $scale / $factor}] units } # ::tk::ScrollByPages -- -- cgit v0.12 From f28d954bfec94579d39e5a1f71363e42066b49c4 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sun, 19 Nov 2023 16:11:05 +0000 Subject: Fix the MouseWheel bindings for the Listbox. --- library/listbox.tcl | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/library/listbox.tcl b/library/listbox.tcl index f0009bf..6ef5096 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -175,18 +175,34 @@ bind Listbox { bind Listbox { %W scan dragto %x %y } - +set HiresScrollMask 512 bind Listbox { - tk::MouseWheel %W y %D -40.0 + if {[expr {%s & $HiresScrollMask}]} { + tk::MouseWheel %W y %D -1.0 units + } else { + tk::MouseWheel %W y [tk::ScaleNum %D] -30.0 units + } } bind Listbox { - tk::MouseWheel %W y %D -12.0 + if {[expr {%s & $HiresScrollMask}]} { + tk::MouseWheel %W y %D -0.3 units + } else { + tk::MouseWheel %W y [tk::ScaleNum %D] -10.0 units + } } bind Listbox { - tk::MouseWheel %W x %D -40.0 + if {[expr {%s & $HiresScrollMask}]} { + tk::MouseWheel %W x %D -12.0 units + } else { + tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 units + } } bind Listbox { - tk::MouseWheel %W x %D -12.0 + if {[expr {%s & $HiresScrollMask}]} { + tk::MouseWheel %W x %D -4.0 units + } else { + tk::MouseWheel %W x [tk::ScaleNum %D] -0.3 units + } } # ::tk::ListboxBeginSelect -- -- cgit v0.12 From 404383577459f5d77a42386134835beaaa62f164 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sun, 19 Nov 2023 19:17:33 +0000 Subject: Add helper functions to avoid multiple occurrences of hard-wired constants. --- library/scrlbar.tcl | 26 ++++++++------------------ library/text.tcl | 9 ++++----- library/tk.tcl | 24 ++++++++++++++++++++++++ 3 files changed, 36 insertions(+), 23 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index c54e880..0a0c2c6 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -129,30 +129,20 @@ bind Scrollbar <> { } } -set HiresScrollMask 512 -set ShiftMask 1 bind Scrollbar { - if {[expr {%s & $ShiftMask}]} { - set orientation "h"; + set direction [tk::ScrollDirection %s] + if {[tk::IsHiResScroll %s]} { + tk::ScrollByUnits %W $direction %D -10.0 } else { - set orientation "v"; - } - if {[expr {%s & $HiresScrollMask}]} { - tk::ScrollByUnits %W $orientation %D -10.0 - } else { - tk::ScrollByUnits %W $orientation [tk::ScaleNum %D] -30.0 + tk::ScrollByUnits %W $direction [tk::ScaleNum %D] -30.0 } } bind Scrollbar { - if {[expr {%s & $ShiftMask}]} { - set orientation "h"; - } else { - set orientation "v"; - } - if {[expr {%s & $HiresScrollMask}]} { - tk::ScrollByUnits %W $orientation %D -1.0 + set direction [tk::ScrollDirection %s] + if {[tk::IsHiResScroll %s]} { + tk::ScrollByUnits %W $direction %D -1.0 } else { - tk::ScrollByUnits %W $orientation [tk::ScaleNum %D] -3.0 + tk::ScrollByUnits %W $direction [tk::ScaleNum %D] -3.0 } } diff --git a/library/text.tcl b/library/text.tcl index 73ec714..631759d 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -455,30 +455,29 @@ bind Text { } } set ::tk::Priv(prevPos) {} -set HiresScrollMask 512 bind Text { - if {[expr {%s & $HiresScrollMask}]} { + if {[tk::IsHiResScroll %s]} { tk::MouseWheel %W y %D -1.0 pixels } else { tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } } bind Text { - if {[expr {%s & $HiresScrollMask}]} { + if {[tk::IsHiResScroll %s]} { tk::MouseWheel %W y %D -0.3 pixels } else { tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels } } bind Text { - if {[expr {%s & $HiresScrollMask}]} { + if {[tk::IsHiResScroll %s]} { tk::MouseWheel %W x %D -1.0 pixels } else { tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels } } bind Text { - if {[expr {%s & $HiresScrollMask}]} { + if {[tk::IsHiResScroll %s]} { tk::MouseWheel %W x %D -0.3 pixels } else { tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels diff --git a/library/tk.tcl b/library/tk.tcl index a6dc37c..74942cb 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -543,6 +543,30 @@ proc ::tk::CancelRepeat {} { set Priv(afterId) {} } + +# ::tk::IsHiResScroll $state -- +# Checks whether the HiResScrollMask bit is set in the state. + +proc ::tk::IsHiResScroll state { + if {[expr {$state & 512}]} { + return 1 + } else { + return 0 + } +} + +# ::tk::ScrollDirection $state -- +# Checks if ShiftMask is set in the MouseWheelEvent state. +# Returns h for a horizontal scroll, v for a vertical scroll + +proc ::tk::ScrollDirection state { + if {[expr {$state & 1}]} { + return "h" + } else { + return "v" + } +} + ## ::tk::MouseWheel $w $dir $amount $factor $units proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} { -- cgit v0.12 From 50ca6a3d2a0242016747053b1f08ce4c0ddaee3c Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sun, 19 Nov 2023 23:02:15 +0000 Subject: Restore low-res scrollwheel behavior; insert a placeholder for sending touchpad events. --- library/demos/cscroll.tcl | 86 +++++++++++++++++++++++---------------------- library/scrlbar.tcl | 36 +++++-------------- library/text.tcl | 25 +++---------- library/tk.tcl | 24 ------------- macosx/tkMacOSXMouseEvent.c | 48 ++++++++++--------------- win/tkWinX.c | 70 +++++++++++++++++------------------- 6 files changed, 109 insertions(+), 180 deletions(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 54d98e0..98a4be2 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -17,7 +17,7 @@ wm iconname $w "cscroll" positionWindow $w set c $w.c -label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with either shift-button 1 or button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." +label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." pack $w.msg -side top ## See Code / Dismiss buttons @@ -25,27 +25,8 @@ set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x frame $w.grid -ttk::scrollbar $w.hscroll -orient horizontal -command "$c xview" -ttk::scrollbar $w.vscroll -command "$c yview" -# Override the scrollbar's mousewheel binding to speed it up: -set fastwheel { - set HiresScrollMask 512 - set ShiftMask 1 - if {[expr {%s & $ShiftMask}]} { - set orientation "h"; - } else { - set orientation "v"; - } - if {[expr {%s & $HiresScrollMask}]} { - tk::ScrollByUnits %W $orientation %D -1.0 - } else { - tk::ScrollByUnits %W $orientation %D -30.0 - } - break -} -bind $w.vscroll $fastwheel -bind $w.hscroll $fastwheel - +scrollbar $w.hscroll -orient horizontal -command "$c xview" +scrollbar $w.vscroll -command "$c yview" canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \ -xscrollcommand "$w.hscroll set" \ -yscrollcommand "$w.vscroll set" @@ -75,40 +56,61 @@ for {set i 0} {$i < 20} {incr i} { $c bind all "scrollEnter $c" $c bind all "scrollLeave $c" $c bind all "scrollButton $c" - -bind $c "$c scan mark %x %y" -bind $c "$c scan dragto %x %y" -bind $c "$c scan mark %x %y" -bind $c "$c scan dragto %x %y" - -if {[package vsatisfies [package provide Tk] 8.7-]} { - # Bindings for 8.7 and up - $c configure -yscrollincrement 1 -xscrollincrement 1 +if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} { + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" bind $c { - tk::MouseWheel %W y %D -1.0 - } - bind $c { - tk::MouseWheel %W x %D -1.0 + %W yview scroll [expr {-%D}] units } bind $c { - tk::MouseWheel %W y %D -0.3 + %W yview scroll [expr {-10*%D}] units } - bind $c { - tk::MouseWheel %W x %D -0.3 + bind $c { + %W xview scroll [expr {-%D}] units + } + bind $c { + %W xview scroll [expr {-10*%D}] units } } else { + bind $c "$c scan mark %x %y" + bind $c "$c scan dragto %x %y" + # We must make sure that positive and negative movements are rounded + # equally to integers, avoiding the problem that + # (int)1/-30 = -1, + # but + # (int)-1/-30 = 0 + # The following code ensure equal +/- behaviour. bind $c { - %W yview scroll [expr {-%D}] units + if {%D >= 0} { + %W yview scroll [expr {%D/-30}] units + } else { + %W yview scroll [expr {(%D-29)/-30}] units + } } bind $c { - %W yview scroll [expr {-10*%D}] units + if {%D >= 0} { + %W yview scroll [expr {%D/-3}] units + } else { + %W yview scroll [expr {(%D-2)/-3}] units + } } bind $c { - %W xview scroll [expr {-%D}] units + if {%D >= 0} { + %W xview scroll [expr {%D/-30}] units + } else { + %W xview scroll [expr {(%D-29)/-30}] units + } } bind $c { - %W xview scroll [expr {-10*%D}] units + if {%D >= 0} { + %W xview scroll [expr {%D/-3}] units + } else { + %W xview scroll [expr {(%D-2)/-3}] units + } } +} + +if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} { # Support for mousewheels on Linux/Unix commonly comes through mapping # the wheel to the extended buttons. If you have a mousewheel, find # Linux configuration info at: diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 0a0c2c6..c18d4a8 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -130,20 +130,10 @@ bind Scrollbar <> { } bind Scrollbar { - set direction [tk::ScrollDirection %s] - if {[tk::IsHiResScroll %s]} { - tk::ScrollByUnits %W $direction %D -10.0 - } else { - tk::ScrollByUnits %W $direction [tk::ScaleNum %D] -30.0 - } + tk::ScrollByUnits %W hv %D -40.0 } bind Scrollbar { - set direction [tk::ScrollDirection %s] - if {[tk::IsHiResScroll %s]} { - tk::ScrollByUnits %W $direction %D -1.0 - } else { - tk::ScrollByUnits %W $direction [tk::ScaleNum %D] -3.0 - } + tk::ScrollByUnits %W hv %D -12.0 } # tk::ScrollButtonDown -- @@ -318,24 +308,16 @@ proc ::tk::ScrollEndDrag {w x y} { proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { set cmd [$w cget -command] - if {$cmd eq ""} { + if {$cmd eq "" || ([string first \ + [string index [$w cget -orient] 0] $orient] < 0)} { return } - set xyview [lindex [split $cmd] end] - if {$orient eq "v"} { - if {$xyview eq "xview"} { - return - } - set size [winfo height $w] - } - if {$orient eq "h"} { - if {$xyview eq "yview"} { - return - } - set size [winfo width $w] + set info [$w get] + if {[llength $info] == 2} { + uplevel #0 $cmd scroll [expr {$amount/$factor}] units + } else { + uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}] } - set scale [expr {[$w delta 1.0 1.0] * $size}] - uplevel #0 $cmd scroll [expr {$amount * $scale / $factor}] units } # ::tk::ScrollByPages -- diff --git a/library/text.tcl b/library/text.tcl index 631759d..eb73db0 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -455,33 +455,18 @@ bind Text { } } set ::tk::Priv(prevPos) {} + bind Text { - if {[tk::IsHiResScroll %s]} { - tk::MouseWheel %W y %D -1.0 pixels - } else { - tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels - } + tk::MouseWheel %W y %D -4.0 pixels } bind Text { - if {[tk::IsHiResScroll %s]} { - tk::MouseWheel %W y %D -0.3 pixels - } else { - tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels - } + tk::MouseWheel %W y %D -1.2 pixels } bind Text { - if {[tk::IsHiResScroll %s]} { - tk::MouseWheel %W x %D -1.0 pixels - } else { - tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels - } + tk::MouseWheel %W x %D -4.0 pixels } bind Text { - if {[tk::IsHiResScroll %s]} { - tk::MouseWheel %W x %D -0.3 pixels - } else { - tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels - } + tk::MouseWheel %W x %D -1.2 pixels } # ::tk::TextClosestGap -- diff --git a/library/tk.tcl b/library/tk.tcl index 74942cb..a6dc37c 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -543,30 +543,6 @@ proc ::tk::CancelRepeat {} { set Priv(afterId) {} } - -# ::tk::IsHiResScroll $state -- -# Checks whether the HiResScrollMask bit is set in the state. - -proc ::tk::IsHiResScroll state { - if {[expr {$state & 512}]} { - return 1 - } else { - return 0 - } -} - -# ::tk::ScrollDirection $state -- -# Checks if ShiftMask is set in the MouseWheelEvent state. -# Returns h for a horizontal scroll, v for a vertical scroll - -proc ::tk::ScrollDirection state { - if {[expr {$state & 1}]} { - return "h" - } else { - return "v" - } -} - ## ::tk::MouseWheel $w $dir $amount $factor $units proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} { diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index bb6e1a8..2d4432b 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -543,17 +543,8 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } } else { - - /* - * This state bit means that the delta should be interpreted - * as a number of pixels. It is chosen to not conflict with - * any modifier bits. - */ - -#define HiresScrollMask (1 << 9) - - Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; CGFloat delta; + Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; XEvent xEvent = {0}; xEvent.type = MouseWheelEvent; xEvent.xbutton.x = win_x; @@ -563,25 +554,24 @@ enum { xEvent.xany.send_event = false; xEvent.xany.display = Tk_Display(target); xEvent.xany.window = Tk_WindowId(target); - delta = [theEvent scrollingDeltaY]; - if (! deltaIsPrecise) { - delta = delta > 0 ? ceil(10.0 * delta) : - ceil(-10.0 * delta); - } - if (delta != 0.0) { - xEvent.xbutton.state = state | HiresScrollMask; - xEvent.xkey.keycode = (unsigned int)(int)delta; - xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); - Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); - } - delta = [theEvent scrollingDeltaX]; - if (! deltaIsPrecise) { - delta = delta > 0 ? ceil(10.0 * delta) : - ceil(-10.0 * delta); - } - if (delta != 0.0) { - xEvent.xbutton.state = state | ShiftMask | HiresScrollMask; - xEvent.xkey.keycode = (unsigned int)(int)delta; - xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); - Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); + if (!deltaIsPrecise) { + delta = [theEvent scrollingDeltaY]; + if (delta != 0.0) { + xEvent.xbutton.state = state; + xEvent.xkey.keycode = delta > 0 ? 120 : -120; + xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); + } + delta = [theEvent scrollingDeltaX]; + if (delta != 0.0) { + xEvent.xbutton.state = state | ShiftMask; + xEvent.xkey.keycode = delta > 0 ? 120 : -120; + xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); + } + } + else { + printf("Touchpad scroll.\n"); } } diff --git a/win/tkWinX.c b/win/tkWinX.c index c1c6815..f73c739 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -36,20 +36,12 @@ #define WM_MOUSEHWHEEL 0x020E #endif -/* This flag is set in the state of the MouseWheelEvent to indicate - * that the value stored in the keycode field should be interpreted - * as the number of pixels to scroll. A WM_MOUSEWHEEL message sent - * by a trackpad contains the number of pixels as the delta value, - * while low precision scrollwheels always send an integer multiple - * of WHEELDELTA (= 120) as the delta value. We set this flag - * whenever the WM_MOUSEWHEEL delta is not a multiple of 120. This - * ignores the (rare) possibility that a trackpad might generate - * a message with delta a multiple of 120, intended to be interpreted - * as pixels. If that proves annoying it will need to be addressed. +/* A WM_MOUSEWHEEL message sent by a trackpad contains the number of pixels as + * the delta value, while low precision scrollwheels always send an integer + * multiple of WHEELDELTA (= 120) as the delta value. */ #define WHEELDELTA 120 -#define HiresScrollMask (1 << 9) /* * Our heuristic for deciding whether a WM_MOUSEWHEEL message @@ -1153,21 +1145,22 @@ GenerateXEvent( int delta = (short) HIWORD(wParam); int mod = delta % WHEELDELTA; + if ( mod != 0 || lastMod != 0) { + printf("Trackpad scroll\n"); + } else { - /* - * We have invented a new X event type to handle this event. It - * still uses the KeyPress struct. However, the keycode field has - * been overloaded to hold the zDelta of the wheel. Set nbytes to - * 0 to prevent conversion of the keycode to a keysym in - * TkpGetString. [Bug 1118340]. - */ + /* + * We have invented a new X event type to handle this + * event. It still uses the KeyPress struct. However, the + * keycode field has been overloaded to hold the zDelta of the + * wheel. Set nbytes to 0 to prevent conversion of the keycode + * to a keysym in TkpGetString. [Bug 1118340]. + */ - event.x.type = MouseWheelEvent; - event.x.xany.send_event = -1; - event.key.nbytes = 0; - event.x.xkey.keycode = (unsigned int)delta; - if ( mod != 0 || lastMod != 0) { - event.x.xkey.state |= HiresScrollMask; + event.x.type = MouseWheelEvent; + event.x.xany.send_event = -1; + event.key.nbytes = 0; + event.x.xkey.keycode = (unsigned int)delta; } lastMod = mod; break; @@ -1179,22 +1172,23 @@ GenerateXEvent( int delta = (short) HIWORD(wParam); int mod = delta % WHEELDELTA; + if ( mod != 0 || lastMod != 0) { + printf("Trackpad scroll\n"); + } else { - /* - * We have invented a new X event type to handle this event. It - * still uses the KeyPress struct. However, the keycode field has - * been overloaded to hold the zDelta of the wheel. Set nbytes to - * 0 to prevent conversion of the keycode to a keysym in - * TkpGetString. [Bug 1118340]. - */ + /* + * We have invented a new X event type to handle this event. It + * still uses the KeyPress struct. However, the keycode field has + * been overloaded to hold the zDelta of the wheel. Set nbytes to + * 0 to prevent conversion of the keycode to a keysym in + * TkpGetString. [Bug 1118340]. + */ - event.x.type = MouseWheelEvent; - event.x.xany.send_event = -1; - event.key.nbytes = 0; - event.x.xkey.state |= ShiftMask; - event.x.xkey.keycode = delta; - if ( mod != 0 || lastMod != 0) { - event.x.xkey.state |= HiresScrollMask; + event.x.type = MouseWheelEvent; + event.x.xany.send_event = -1; + event.key.nbytes = 0; + event.x.xkey.state |= ShiftMask; + event.x.xkey.keycode = delta; } lastMod = mod; break; -- cgit v0.12 From edaf075b9b0ff023177a8167a0ad159d56336fe3 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Mon, 20 Nov 2023 21:45:27 +0000 Subject: Add smooth scrolling for Text widgets on macOS. --- library/text.tcl | 9 +++++++++ library/tk.tcl | 7 +++++++ macosx/tkMacOSXMouseEvent.c | 24 ++++++++++++++++-------- 3 files changed, 32 insertions(+), 8 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index eb73db0..c582fe3 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -456,6 +456,15 @@ bind Text { } set ::tk::Priv(prevPos) {} +bind Text { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0} { + %W xview scroll $deltaX pixels + } + if {$deltaY != 0} { + %W yview scroll $deltaY pixels + } +} bind Text { tk::MouseWheel %W y %D -4.0 pixels } diff --git a/library/tk.tcl b/library/tk.tcl index a6dc37c..0bb49eb 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -549,6 +549,13 @@ proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} { $w ${dir}view scroll [expr {$amount/$factor}] $units } +## ::tk::PreciseScrollDeltas $dxdy +proc ::tk::PreciseScrollDeltas {dxdy} { + set deltaX [expr {$dxdy >> 16}] + set low [expr {$dxdy & 0xffff}] + set deltaY [expr {$low < 0x8000 ? $low : $low - 0x10000}] + return [list $deltaX $deltaY] +} # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 2d4432b..899ec02 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -543,10 +543,9 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } } else { - CGFloat delta; + unsigned int delta; Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; XEvent xEvent = {0}; - xEvent.type = MouseWheelEvent; xEvent.xbutton.x = win_x; xEvent.xbutton.y = win_y; xEvent.xbutton.x_root = global.x; @@ -554,15 +553,27 @@ enum { xEvent.xany.send_event = false; xEvent.xany.display = Tk_Display(target); xEvent.xany.window = Tk_WindowId(target); - if (!deltaIsPrecise) { - delta = [theEvent scrollingDeltaY]; + if (deltaIsPrecise) { + int deltaX = [theEvent scrollingDeltaX]; + int deltaY = [theEvent scrollingDeltaY]; + delta = (deltaX << 16) | (deltaY & 0xffff); + if (delta != 0) { + xEvent.type = MouseWheelEvent; + xEvent.xbutton.state = state | ControlMask ; + xEvent.xkey.keycode = delta; + xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); + } + } else { + delta = (unsigned int)(int)[theEvent scrollingDeltaY]; if (delta != 0.0) { + xEvent.type = MouseWheelEvent; xEvent.xbutton.state = state; xEvent.xkey.keycode = delta > 0 ? 120 : -120; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } - delta = [theEvent scrollingDeltaX]; + delta = (unsigned int)(int)[theEvent scrollingDeltaX]; if (delta != 0.0) { xEvent.xbutton.state = state | ShiftMask; xEvent.xkey.keycode = delta > 0 ? 120 : -120; @@ -570,9 +581,6 @@ enum { Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } - else { - printf("Touchpad scroll.\n"); - } } /* -- cgit v0.12 From e248b31dcf690c7e53152483247d999679106ca5 Mon Sep 17 00:00:00 2001 From: culler Date: Tue, 21 Nov 2023 03:05:03 +0000 Subject: Make touchpad scrolling work for Text widgets on Windows. --- win/tkWinX.c | 53 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 30 insertions(+), 23 deletions(-) diff --git a/win/tkWinX.c b/win/tkWinX.c index f73c739..67411f0 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -1139,51 +1139,58 @@ GenerateXEvent( switch (message) { case WM_MOUSEWHEEL: { + /* - * Support for high resolution wheels (vertical). + * Send an Xevent using a KeyPress struct, but with the type field + * set to MouseWheelEventq and the keypress field set to the value + * of the MouseWheel delta. For high resolution events the + * ControlMask bit is set and delta is stored in the high word of + * the keycode. For low resolution scrolls the delta is in the + * low word of the keycode. Set nbytes to 0 to prevent conversion + * of the keycode to a keysym in TkpGetString. [Bug 1118340]. */ int delta = (short) HIWORD(wParam); int mod = delta % WHEELDELTA; if ( mod != 0 || lastMod != 0) { - printf("Trackpad scroll\n"); + /* High resolution. */ + event.x.type = MouseWheelEvent; + event.x.xany.send_event = -1; + event.key.nbytes = 0; + event.x.xkey.state = state | ControlMask ; + event.x.xkey.keycode = (unsigned int) delta; } else { - - /* - * We have invented a new X event type to handle this - * event. It still uses the KeyPress struct. However, the - * keycode field has been overloaded to hold the zDelta of the - * wheel. Set nbytes to 0 to prevent conversion of the keycode - * to a keysym in TkpGetString. [Bug 1118340]. - */ - event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; event.key.nbytes = 0; - event.x.xkey.keycode = (unsigned int)delta; + event.x.xkey.keycode = (unsigned int) delta; } lastMod = mod; break; } case WM_MOUSEHWHEEL: { + /* - * Support for high resolution wheels (horizontal). + * Send an Xevent using a KeyPress struct, but with the type field + * set to MouseWheelEventq and the keypress field set to the value + * of the MouseWheel delta. For high resolution scrolls the + * ControlMask bit is set and deltaX is stored in the high word of + * the keycode. For low resolution scrolls the delta is in the + * low word of the keycode and the ShiftMask bit is set. Set + * nbytes to 0 to prevent conversion of the keycode to a keysym in + * TkpGetString. [Bug 1118340]. */ int delta = (short) HIWORD(wParam); int mod = delta % WHEELDELTA; if ( mod != 0 || lastMod != 0) { - printf("Trackpad scroll\n"); + /* High resolution. */ + event.x.type = MouseWheelEvent; + event.x.xany.send_event = -1; + event.key.nbytes = 0; + event.x.xkey.state = state | ControlMask ; + event.x.xkey.keycode = delta << 16; } else { - - /* - * We have invented a new X event type to handle this event. It - * still uses the KeyPress struct. However, the keycode field has - * been overloaded to hold the zDelta of the wheel. Set nbytes to - * 0 to prevent conversion of the keycode to a keysym in - * TkpGetString. [Bug 1118340]. - */ - event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; event.key.nbytes = 0; -- cgit v0.12 From b0d31264c787b4be2ebc7c76087cab702a2a5aed Mon Sep 17 00:00:00 2001 From: marc_culler Date: Tue, 21 Nov 2023 23:16:52 +0000 Subject: Add bindings for Scrollbar and Listbox. Fix bindings for Text. --- library/listbox.tcl | 32 +++++++++--------------- library/scrlbar.tcl | 61 +++++++++++++++++++++++++++++++++++++++++++-- library/text.tcl | 4 +-- library/ttk/scrollbar.tcl | 1 + macosx/tkMacOSXMouseEvent.c | 3 ++- 5 files changed, 76 insertions(+), 25 deletions(-) diff --git a/library/listbox.tcl b/library/listbox.tcl index 6ef5096..c92d41d 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -175,33 +175,25 @@ bind Listbox { bind Listbox { %W scan dragto %x %y } -set HiresScrollMask 512 bind Listbox { - if {[expr {%s & $HiresScrollMask}]} { - tk::MouseWheel %W y %D -1.0 units - } else { - tk::MouseWheel %W y [tk::ScaleNum %D] -30.0 units - } + tk::MouseWheel %W y [tk::ScaleNum %D] -30.0 units } bind Listbox { - if {[expr {%s & $HiresScrollMask}]} { - tk::MouseWheel %W y %D -0.3 units - } else { - tk::MouseWheel %W y [tk::ScaleNum %D] -10.0 units - } + tk::MouseWheel %W y [tk::ScaleNum %D] -10.0 units } bind Listbox { - if {[expr {%s & $HiresScrollMask}]} { - tk::MouseWheel %W x %D -12.0 units - } else { - tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 units - } + tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 units } bind Listbox { - if {[expr {%s & $HiresScrollMask}]} { - tk::MouseWheel %W x %D -4.0 units - } else { - tk::MouseWheel %W x [tk::ScaleNum %D] -0.3 units + tk::MouseWheel %W x [tk::ScaleNum %D] -0.3 units +} +bind Listbox { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0} { + %W xview scroll [expr {-$deltaX}] units + } + if {$deltaY != 0} { + %W yview scroll [expr {-$deltaY / 2.0}] units } } diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index c18d4a8..4038e15 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -129,13 +129,25 @@ bind Scrollbar <> { } } +bind Scrollbar { + tk::ScrollByUnits %W hv %D -12.0 +} + bind Scrollbar { tk::ScrollByUnits %W hv %D -40.0 } -bind Scrollbar { - tk::ScrollByUnits %W hv %D -12.0 + +bind Scrollbar { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0} { + tk::ScrollByPixels %W h $deltaX + } + if {$deltaY != 0} { + tk::ScrollByPixels %W v $deltaY + } } + # tk::ScrollButtonDown -- # This procedure is invoked when a button is pressed in a scrollbar. # It changes the way the scrollbar is displayed and takes actions @@ -295,6 +307,51 @@ proc ::tk::ScrollEndDrag {w x y} { set Priv(initPos) "" } +# ::tk::ScrollByPixels -- +# This procedure tells the scrollbar's associated widget to scroll up +# or down by a given number of pixels. It notifies the associated widget +# in different ways for old and new command syntaxes. +# +# Arguments: +# w - The scrollbar widget. +# orient - Which kind of scrollbar this applies to: "h" for +# horizontal, "v" for vertical. +# amount - How many pixels to scroll. + +proc ::tk::ScrollByPixels {w orient amount} { + set cmd [$w cget -command] + if {$cmd eq ""} { + return + } + set xyview [lindex [split $cmd] end] + if {$orient eq "v"} { + if {$xyview eq "xview"} { + return + } + set size [winfo height $w] + } + if {$orient eq "h"} { + if {$xyview eq "yview"} { + return + } + set size [winfo width $w] + } + + # The moveto command allows scrolling by pixel deltas even for + # widgets which only support scrolling by units or pages. The + # code below works with both the current and old syntax for the + # scrollbar get command. + + set info [$w get] + if {[llength $info] == 2} { + set first [lindex $info 0] + } else { + set first [lindex $info 2] + } + set pixels [expr {-$amount}] + uplevel #0 $cmd moveto [expr $first + [$w delta $pixels $pixels]] +} + # ::tk::ScrollByUnits -- # This procedure tells the scrollbar's associated widget to scroll up # or down by a given number of units. It notifies the associated widget diff --git a/library/text.tcl b/library/text.tcl index c582fe3..0467df5 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -459,10 +459,10 @@ set ::tk::Priv(prevPos) {} bind Text { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { - %W xview scroll $deltaX pixels + %W xview scroll [expr {-$deltaX}] pixels } if {$deltaY != 0} { - %W yview scroll $deltaY pixels + %W yview scroll [expr {-$deltaY}] pixels } } bind Text { diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 6ad6e15..c488833 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -21,6 +21,7 @@ bind TScrollbar { ttk::scrollbar::Release %W %x %y } # bind TScrollbar [bind Scrollbar ] bind TScrollbar [bind Scrollbar ] +bind TScrollbar [bind Scrollbar ] proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 899ec02..36ed501 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -559,7 +559,7 @@ enum { delta = (deltaX << 16) | (deltaY & 0xffff); if (delta != 0) { xEvent.type = MouseWheelEvent; - xEvent.xbutton.state = state | ControlMask ; + xEvent.xbutton.state = state | ControlMask; xEvent.xkey.keycode = delta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); @@ -575,6 +575,7 @@ enum { } delta = (unsigned int)(int)[theEvent scrollingDeltaX]; if (delta != 0.0) { + xEvent.type = MouseWheelEvent; xEvent.xbutton.state = state | ShiftMask; xEvent.xkey.keycode = delta > 0 ? 120 : -120; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); -- cgit v0.12 From 35f3b55d406eb50ce5da2d70ff50cba959f1f139 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Wed, 22 Nov 2023 03:31:45 +0000 Subject: Fix the low resolution events. --- library/listbox.tcl | 8 ++++---- macosx/tkMacOSXMouseEvent.c | 19 ++++++++++++------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/library/listbox.tcl b/library/listbox.tcl index c92d41d..43ba088 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -176,16 +176,16 @@ bind Listbox { %W scan dragto %x %y } bind Listbox { - tk::MouseWheel %W y [tk::ScaleNum %D] -30.0 units + tk::MouseWheel %W y [tk::ScaleNum %D] -40.0 units } bind Listbox { - tk::MouseWheel %W y [tk::ScaleNum %D] -10.0 units + tk::MouseWheel %W y [tk::ScaleNum %D] -12.0 units } bind Listbox { - tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 units + tk::MouseWheel %W x [tk::ScaleNum %D] -40.0 units } bind Listbox { - tk::MouseWheel %W x [tk::ScaleNum %D] -0.3 units + tk::MouseWheel %W x [tk::ScaleNum %D] -12.0 units } bind Listbox { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 36ed501..b6e55eb 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -543,7 +543,8 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } } else { - unsigned int delta; + int delta; + CGFloat Delta; Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; XEvent xEvent = {0}; xEvent.xbutton.x = win_x; @@ -565,19 +566,23 @@ enum { Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } else { - delta = (unsigned int)(int)[theEvent scrollingDeltaY]; - if (delta != 0.0) { + /* + * A low precision scroll is 120 or -120 wheel units per click. + * Each click generates one event. + */ + Delta = [theEvent scrollingDeltaY]; + if (Delta != 0.0) { xEvent.type = MouseWheelEvent; xEvent.xbutton.state = state; - xEvent.xkey.keycode = delta > 0 ? 120 : -120; + xEvent.xkey.keycode = Delta > 0.0 ? 120 : -120; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } - delta = (unsigned int)(int)[theEvent scrollingDeltaX]; - if (delta != 0.0) { + Delta = [theEvent scrollingDeltaX]; + if (Delta != 0.0) { xEvent.type = MouseWheelEvent; xEvent.xbutton.state = state | ShiftMask; - xEvent.xkey.keycode = delta > 0 ? 120 : -120; + xEvent.xkey.keycode = Delta > 0 ? 120 : -120; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } -- cgit v0.12 From 014459077ba67c7477c4392ceb0f3525311b79d8 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Thu, 23 Nov 2023 20:25:06 +0000 Subject: Support smooth scrolling of Canvas widgets and demonstrate it in the simple scrollable canvas demo. --- library/demos/cscroll.tcl | 7 +++++++ library/scrlbar.tcl | 38 ++++++++++++-------------------------- library/tk.tcl | 13 +++++++++++++ 3 files changed, 32 insertions(+), 26 deletions(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 98a4be2..a72a08b 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -108,6 +108,13 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk %W xview scroll [expr {(%D-2)/-3}] units } } + #Touchpad scrolling + bind $c { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0 || $deltaY != 0} { + tk::CanvasScrollByPixels %W $deltaX $deltaY + } + } } if {[tk windowingsystem] eq "x11" && ![package vsatisfies [package provide Tk] 8.7-]} { diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 4038e15..3ef9deb 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -140,10 +140,10 @@ bind Scrollbar { bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { - tk::ScrollByPixels %W h $deltaX + ScrollbarScrollByPixels %W h $deltaX } if {$deltaY != 0} { - tk::ScrollByPixels %W v $deltaY + ScrollbarScrollByPixels %W v $deltaY } } @@ -307,10 +307,10 @@ proc ::tk::ScrollEndDrag {w x y} { set Priv(initPos) "" } -# ::tk::ScrollByPixels -- +# ScrollbarScrollByPixels -- # This procedure tells the scrollbar's associated widget to scroll up -# or down by a given number of pixels. It notifies the associated widget -# in different ways for old and new command syntaxes. +# or down by a given number of pixels. It only works with scrollbars +# because it uses the delta command. # # Arguments: # w - The scrollbar widget. @@ -318,38 +318,24 @@ proc ::tk::ScrollEndDrag {w x y} { # horizontal, "v" for vertical. # amount - How many pixels to scroll. -proc ::tk::ScrollByPixels {w orient amount} { - set cmd [$w cget -command] +proc ScrollbarScrollByPixels {sb orient amount} { + set cmd [$sb cget -command] if {$cmd eq ""} { return } set xyview [lindex [split $cmd] end] - if {$orient eq "v"} { - if {$xyview eq "xview"} { - return - } - set size [winfo height $w] - } - if {$orient eq "h"} { - if {$xyview eq "yview"} { - return - } - set size [winfo width $w] + if {$orient eq "v" && $xyview eq "xview" || \ + $orient eq "h" && $xyview eq "yview"} { + return } - - # The moveto command allows scrolling by pixel deltas even for - # widgets which only support scrolling by units or pages. The - # code below works with both the current and old syntax for the - # scrollbar get command. - - set info [$w get] + set info [$sb get] if {[llength $info] == 2} { set first [lindex $info 0] } else { set first [lindex $info 2] } set pixels [expr {-$amount}] - uplevel #0 $cmd moveto [expr $first + [$w delta $pixels $pixels]] + uplevel #0 $cmd moveto [expr $first + [$sb delta $pixels $pixels]] } # ::tk::ScrollByUnits -- diff --git a/library/tk.tcl b/library/tk.tcl index 0bb49eb..1345fbf 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -844,6 +844,19 @@ if {[tk windowingsystem] eq "x11"} { if {$::ttk::library ne ""} { uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl] } + +# Helper for smooth scrolling of Canvas widgets +proc ::tk::CanvasScrollByPixels {canvas deltaX deltaY} { + set width [expr {1.0 * [$canvas cget -width]}] + set height [expr {1.0 * [$canvas cget -height]}] + set X [lindex [$canvas xview] 0] + set Y [lindex [$canvas yview] 0] + set x [expr {$X - $deltaX / $width}] + set y [expr {$Y - $deltaY / $height}] + $canvas xview moveto $x + $canvas yview moveto $y +} + # Local Variables: # mode: tcl -- cgit v0.12 From 28aff698b1b05951f9d5e29f7bbccc4eaeb91af0 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Thu, 23 Nov 2023 21:27:34 +0000 Subject: Update the text in the scrollable canvas demo --- library/demos/cscroll.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index a72a08b..844d334 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -17,7 +17,7 @@ wm iconname $w "cscroll" positionWindow $w set c $w.c -label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout." +label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled by using the scrollbars, by dragging with button 2 in the canvas, by using a mouse wheel, or with the two-finger gesture on a touchpad. If you click button 1 on one of the rectangles, its indices will be printed on stdout." pack $w.msg -side top ## See Code / Dismiss buttons -- cgit v0.12 From aeab7d5c4d1f242492acb6e29416f03bffb7dbf8 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 03:26:01 +0000 Subject: Fix the regression in scrlbar.tcl --- library/scrlbar.tcl | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 3ef9deb..32e02f2 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -140,10 +140,10 @@ bind Scrollbar { bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { - ScrollbarScrollByPixels %W h $deltaX + ScrollByPixels %W h $deltaX } if {$deltaY != 0} { - ScrollbarScrollByPixels %W v $deltaY + ScrollByPixels %W v $deltaY } } @@ -307,7 +307,7 @@ proc ::tk::ScrollEndDrag {w x y} { set Priv(initPos) "" } -# ScrollbarScrollByPixels -- +# ScrollByPixels -- # This procedure tells the scrollbar's associated widget to scroll up # or down by a given number of pixels. It only works with scrollbars # because it uses the delta command. @@ -318,24 +318,36 @@ proc ::tk::ScrollEndDrag {w x y} { # horizontal, "v" for vertical. # amount - How many pixels to scroll. -proc ScrollbarScrollByPixels {sb orient amount} { - set cmd [$sb cget -command] +proc ScrollByPixels {w orient amount} { + set cmd [$w cget -command] if {$cmd eq ""} { return } set xyview [lindex [split $cmd] end] - if {$orient eq "v" && $xyview eq "xview" || \ - $orient eq "h" && $xyview eq "yview"} { - return + if {$orient eq "v"} { + if {$xyview eq "xview"} { + return + } + set size [winfo height $w] + } + if {$orient eq "h"} { + if {$xyview eq "yview"} { + return + } + set size [winfo width $w] } - set info [$sb get] + + # The code below works with both the current and old syntax for + # the scrollbar get command. + + set info [$w get] if {[llength $info] == 2} { set first [lindex $info 0] } else { set first [lindex $info 2] } set pixels [expr {-$amount}] - uplevel #0 $cmd moveto [expr $first + [$sb delta $pixels $pixels]] + uplevel #0 $cmd moveto [expr $first + [$w delta $pixels $pixels]] } # ::tk::ScrollByUnits -- -- cgit v0.12 From 037024d2e3f28c239d71fe93bdb82ad816965663 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 04:55:34 +0000 Subject: Put ScrollByPixels back in the tk namespace, but named ScrollbarScrollByPixels. --- library/scrlbar.tcl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 32e02f2..19ff33a 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -140,10 +140,10 @@ bind Scrollbar { bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { - ScrollByPixels %W h $deltaX + tk::ScrollbarScrollByPixels %W h $deltaX } if {$deltaY != 0} { - ScrollByPixels %W v $deltaY + tk::ScrollbarScrollByPixels %W v $deltaY } } @@ -307,7 +307,7 @@ proc ::tk::ScrollEndDrag {w x y} { set Priv(initPos) "" } -# ScrollByPixels -- +# ::tk::ScrollbarScrollByPixels -- # This procedure tells the scrollbar's associated widget to scroll up # or down by a given number of pixels. It only works with scrollbars # because it uses the delta command. @@ -318,7 +318,7 @@ proc ::tk::ScrollEndDrag {w x y} { # horizontal, "v" for vertical. # amount - How many pixels to scroll. -proc ScrollByPixels {w orient amount} { +proc ::tk::ScrollbarScrollByPixels {w orient amount} { set cmd [$w cget -command] if {$cmd eq ""} { return -- cgit v0.12 From 8030d9c4da197f2f726b52ea0904170abdec3c89 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 19:38:52 +0000 Subject: Restore the ScaleNum invocations in the Text MouseWheel binding. --- library/text.tcl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/library/text.tcl b/library/text.tcl index 0467df5..7cf1091 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -466,16 +466,16 @@ bind Text { } } bind Text { - tk::MouseWheel %W y %D -4.0 pixels + tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } bind Text { - tk::MouseWheel %W y %D -1.2 pixels + tk::MouseWheel %W y [tk::ScaleNum %D] -1.2 pixels } bind Text { - tk::MouseWheel %W x %D -4.0 pixels + tk::MouseWheel %W x [tk::ScaleNum %D] -4.0 pixels } bind Text { - tk::MouseWheel %W x %D -1.2 pixels + tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels } # ::tk::TextClosestGap -- -- cgit v0.12 From c2966d199dcef759fb9bbab08c06116b080e7f7c Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 19:41:37 +0000 Subject: Remove the ScaleNum invocations from the listbox MouseWheel bindings. --- library/listbox.tcl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/library/listbox.tcl b/library/listbox.tcl index 43ba088..731ef33 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -176,16 +176,16 @@ bind Listbox { %W scan dragto %x %y } bind Listbox { - tk::MouseWheel %W y [tk::ScaleNum %D] -40.0 units + tk::MouseWheel %W y %D -40.0 units } bind Listbox { - tk::MouseWheel %W y [tk::ScaleNum %D] -12.0 units + tk::MouseWheel %W y %D -12.0 units } bind Listbox { - tk::MouseWheel %W x [tk::ScaleNum %D] -40.0 units + tk::MouseWheel %W x %D -40.0 units } bind Listbox { - tk::MouseWheel %W x [tk::ScaleNum %D] -12.0 units + tk::MouseWheel %W x %D -12.0 units } bind Listbox { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY -- cgit v0.12 From 882e2f294e951a18ea24b7a5f1d6628bc5a4ae90 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 20:12:04 +0000 Subject: Fix scrollbar bindings toto ensure that horizontal gestures do not produce vertical motion and vice versa. --- library/scrlbar.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 19ff33a..d992d92 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -139,10 +139,10 @@ bind Scrollbar { bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { + if {$deltaX != 0 && [%W cget -orient] eq "horizontal"} { tk::ScrollbarScrollByPixels %W h $deltaX } - if {$deltaY != 0} { + if {$deltaY != 0 && [%W cget -orient] eq "vertical"} { tk::ScrollbarScrollByPixels %W v $deltaY } } -- cgit v0.12 From 1e3a4e7a0607ab4e6f8af6717eed1792fd38fab3 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 20:32:20 +0000 Subject: Add touchpad bindings to the canvas items demo. --- library/demos/items.tcl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 5f51a90..bdd2cc2 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -34,6 +34,14 @@ canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ ttk::scrollbar $w.frame.vscroll -command "$c yview" ttk::scrollbar $w.frame.hscroll -orient horizontal -command "$c xview" +#Touchpad scrolling +bind $c { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0 || $deltaY != 0} { + tk::CanvasScrollByPixels %W $deltaX $deltaY + } +} + grid $c -in $w.frame \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news grid $w.frame.vscroll \ -- cgit v0.12 From d934fbfe389ed3f79b9b4de6c94e01a928f716ec Mon Sep 17 00:00:00 2001 From: marc_culler Date: Fri, 24 Nov 2023 22:52:12 +0000 Subject: Switch from Control-MouseWheel to Extended-MouseWheel. --- library/demos/cscroll.tcl | 2 +- library/demos/items.tcl | 2 +- library/listbox.tcl | 2 +- library/scrlbar.tcl | 2 +- library/text.tcl | 2 +- library/ttk/scrollbar.tcl | 2 +- macosx/tkMacOSXMouseEvent.c | 2 +- win/tkWinX.c | 10 +++++----- 8 files changed, 12 insertions(+), 12 deletions(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 844d334..bb5e121 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -109,7 +109,7 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk } } #Touchpad scrolling - bind $c { + bind $c { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 || $deltaY != 0} { tk::CanvasScrollByPixels %W $deltaX $deltaY diff --git a/library/demos/items.tcl b/library/demos/items.tcl index bdd2cc2..90eb027 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -35,7 +35,7 @@ ttk::scrollbar $w.frame.vscroll -command "$c yview" ttk::scrollbar $w.frame.hscroll -orient horizontal -command "$c xview" #Touchpad scrolling -bind $c { +bind $c { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 || $deltaY != 0} { tk::CanvasScrollByPixels %W $deltaX $deltaY diff --git a/library/listbox.tcl b/library/listbox.tcl index 731ef33..c79be3a 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -187,7 +187,7 @@ bind Listbox { bind Listbox { tk::MouseWheel %W x %D -12.0 units } -bind Listbox { +bind Listbox { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { %W xview scroll [expr {-$deltaX}] units diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index d992d92..909d93d 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -137,7 +137,7 @@ bind Scrollbar { tk::ScrollByUnits %W hv %D -40.0 } -bind Scrollbar { +bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 && [%W cget -orient] eq "horizontal"} { tk::ScrollbarScrollByPixels %W h $deltaX diff --git a/library/text.tcl b/library/text.tcl index 7cf1091..4e0476d 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -456,7 +456,7 @@ bind Text { } set ::tk::Priv(prevPos) {} -bind Text { +bind Text { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { %W xview scroll [expr {-$deltaX}] pixels diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index c488833..0fd4c6a 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -21,7 +21,7 @@ bind TScrollbar { ttk::scrollbar::Release %W %x %y } # bind TScrollbar [bind Scrollbar ] bind TScrollbar [bind Scrollbar ] -bind TScrollbar [bind Scrollbar ] +bind TScrollbar [bind Scrollbar ] proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index b6e55eb..e80c4a7 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -560,7 +560,7 @@ enum { delta = (deltaX << 16) | (deltaY & 0xffff); if (delta != 0) { xEvent.type = MouseWheelEvent; - xEvent.xbutton.state = state | ControlMask; + xEvent.xbutton.state = state | EXTENDED_MASK; xEvent.xkey.keycode = delta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); diff --git a/win/tkWinX.c b/win/tkWinX.c index 67411f0..54f5d67 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -1144,7 +1144,7 @@ GenerateXEvent( * Send an Xevent using a KeyPress struct, but with the type field * set to MouseWheelEventq and the keypress field set to the value * of the MouseWheel delta. For high resolution events the - * ControlMask bit is set and delta is stored in the high word of + * EXTENDED_MASK bit is set and delta is stored in the high word of * the keycode. For low resolution scrolls the delta is in the * low word of the keycode. Set nbytes to 0 to prevent conversion * of the keycode to a keysym in TkpGetString. [Bug 1118340]. @@ -1157,7 +1157,7 @@ GenerateXEvent( event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; event.key.nbytes = 0; - event.x.xkey.state = state | ControlMask ; + event.x.xkey.state = state | EXTENDED_MASK ; event.x.xkey.keycode = (unsigned int) delta; } else { event.x.type = MouseWheelEvent; @@ -1174,8 +1174,8 @@ GenerateXEvent( * Send an Xevent using a KeyPress struct, but with the type field * set to MouseWheelEventq and the keypress field set to the value * of the MouseWheel delta. For high resolution scrolls the - * ControlMask bit is set and deltaX is stored in the high word of - * the keycode. For low resolution scrolls the delta is in the + * EXTENDEDMASK bit is set and deltaX is stored in the high word + * of the keycode. For low resolution scrolls the delta is in the * low word of the keycode and the ShiftMask bit is set. Set * nbytes to 0 to prevent conversion of the keycode to a keysym in * TkpGetString. [Bug 1118340]. @@ -1188,7 +1188,7 @@ GenerateXEvent( event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; event.key.nbytes = 0; - event.x.xkey.state = state | ControlMask ; + event.x.xkey.state = state | EXTENDED_MASK ; event.x.xkey.keycode = delta << 16; } else { event.x.type = MouseWheelEvent; -- cgit v0.12 From 51bf0d373837b488efe77b5d185cd470bc94d8e3 Mon Sep 17 00:00:00 2001 From: culler Date: Sat, 25 Nov 2023 01:45:00 +0000 Subject: Fix backwards horizontal scrolling on Windows. --- win/tkWinX.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tkWinX.c b/win/tkWinX.c index 54f5d67..d3a2d55 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -1189,7 +1189,7 @@ GenerateXEvent( event.x.xany.send_event = -1; event.key.nbytes = 0; event.x.xkey.state = state | EXTENDED_MASK ; - event.x.xkey.keycode = delta << 16; + event.x.xkey.keycode = (unsigned int)(-(delta << 16)); } else { event.x.type = MouseWheelEvent; event.x.xany.send_event = -1; -- cgit v0.12 From 86bb88b4cfed28625b8dfadb202c7f86d2531ec3 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Sat, 25 Nov 2023 14:47:01 +0000 Subject: Update bind.n; resolve unintended fork --- doc/bind.n | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/doc/bind.n b/doc/bind.n index 6e47637..72129d8 100644 --- a/doc/bind.n +++ b/doc/bind.n @@ -212,11 +212,22 @@ values should scroll up and negative values should scroll down. .RS .PP Horizontal scrolling uses \fBShift-MouseWheel\fR events, with positive -\fB%D\fR \fIdelta\fR substitution indicating left scrolling and negative -right scrolling. -Horizontal scrolling events may fire from -many different hardware units such as tilt wheels or touchpads. Horizontal -scrolling can also be emulated by holding Shift and scrolling vertically. +\fB%D\fR \fIdelta\fR substitution indicating left scrolling and +negative right scrolling. Horizontal scrolling events are generated +tilt wheels on some mice. Horizontal scrolling can also be emulated +by holding Shift and scrolling vertically. +.PP +On some platforms (currently Windows and macOS) there is support for +high-resolution scrolling devices, such as touchpads. This is +provided via \fBExtended-MouseWheel\fR events. These events store two +16 bit delta values in the integer provided by the \fB%D\fR +subsstitution. The \fIX\fR delta is in the high order 16 bits and the +\fIY\fR delta is in the low order 16 bits. These values can be +unpacked by using the tk::PreciseScrollDeltas utility procedure. For +example: +.CS +lassign [tk::PreciseScrollDeltas %D] deltaX deltaY +.CE .RE .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 The \fBKeyPress\fR and \fBKeyRelease\fR events are generated -- cgit v0.12 From c60d0f8978d1ebd2ec490caa1464b450c70b9d9f Mon Sep 17 00:00:00 2001 From: marc_culler Date: Mon, 27 Nov 2023 15:31:55 +0000 Subject: Introduce a separate TouchpadScroll event. Avoids Extended-MouseWheel events being handled by MouseWheel bindings. --- doc/bind.n | 20 ++++++++++---------- generic/tk.h | 4 +++- generic/tkBind.c | 6 +++--- generic/tkEvent.c | 3 ++- library/demos/cscroll.tcl | 3 +-- library/demos/items.tcl | 3 +-- library/listbox.tcl | 2 +- library/scrlbar.tcl | 2 +- library/text.tcl | 2 +- library/ttk/scrollbar.tcl | 2 +- macosx/tkMacOSXMouseEvent.c | 4 ++-- 11 files changed, 26 insertions(+), 25 deletions(-) diff --git a/doc/bind.n b/doc/bind.n index 72129d8..518d522 100644 --- a/doc/bind.n +++ b/doc/bind.n @@ -173,11 +173,11 @@ types; where two names appear together, they are synonyms. \fBButton\fR, \fBButtonPress\fR \fBEnter\fR \fBMapRequest\fR \fBButtonRelease\fR \fBExpose\fR \fBMotion\fR \fBCirculate\fR \fBFocusIn\fR \fBMouseWheel\fR -\fBCirculateRequest\fR \fBFocusOut\fR \fBProperty\fR -\fBColormap\fR \fBGravity\fR \fBReparent\fR -\fBConfigure\fR \fBKey\fR, \fBKeyPress\fR \fBResizeRequest\fR -\fBConfigureRequest\fR \fBKeyRelease\fR \fBUnmap\fR -\fBCreate\fR \fBLeave\fR \fBVisibility\fR +\fBTouchpadScroll\fR \fBCirculateRequest\fR \fBFocusOut\fR +\fBProperty\fR \fBColormap\fR \fBGravity\fR +\fBReparent\fR \fBConfigure\fR \fBKey\fR, \fBKeyPress\fR +\fBResizeRequest\fR \fBConfigureRequest\fR \fBKeyRelease\fR +\fBUnmap\fR \fBCreate\fR \fBLeave\fR \fBVisibility\fR \fBDeactivate\fR .DE Most of the above events have the same fields and behaviors as events @@ -198,7 +198,7 @@ active. Likewise, the \fBDeactive\fR event is sent when the window's state changes from active to deactive. There are no useful percent substitutions you would make when binding to these events. .IP \fBMouseWheel\fR 5 -Many contemporary mice support a mouse wheel, which is used +Many contemporary mice include a mouse wheel, which is used for scrolling documents without using the scrollbars. By rolling the wheel, the system will generate \fBMouseWheel\fR events that the application can use to scroll. The event is routed to the @@ -216,19 +216,19 @@ Horizontal scrolling uses \fBShift-MouseWheel\fR events, with positive negative right scrolling. Horizontal scrolling events are generated tilt wheels on some mice. Horizontal scrolling can also be emulated by holding Shift and scrolling vertically. -.PP +.RE +.IP "\fBTouchpadScroll\fR" 5 On some platforms (currently Windows and macOS) there is support for high-resolution scrolling devices, such as touchpads. This is -provided via \fBExtended-MouseWheel\fR events. These events store two +provided via \fBTouchpadScroll\fR events. These events store two 16 bit delta values in the integer provided by the \fB%D\fR -subsstitution. The \fIX\fR delta is in the high order 16 bits and the +substitution. The \fIX\fR delta is in the high order 16 bits and the \fIY\fR delta is in the low order 16 bits. These values can be unpacked by using the tk::PreciseScrollDeltas utility procedure. For example: .CS lassign [tk::PreciseScrollDeltas %D] deltaX deltaY .CE -.RE .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 The \fBKeyPress\fR and \fBKeyRelease\fR events are generated whenever a key is pressed or released. \fBKeyPress\fR and \fBKeyRelease\fR diff --git a/generic/tk.h b/generic/tk.h index 481714a..6f59f2c 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -669,8 +669,10 @@ typedef struct Tk_GeomMgr { #define ActivateNotify (MappingNotify + 2) #define DeactivateNotify (MappingNotify + 3) #define MouseWheelEvent (MappingNotify + 4) -#define TK_LASTEVENT (MappingNotify + 5) +#define TouchpadScroll (MappingNotify + 5) +#define TK_LASTEVENT (MappingNotify + 6) +#define TouchpadScrollMask (1L << 27) #define MouseWheelMask (1L << 28) #define ActivateMask (1L << 29) #define VirtualEventMask (1L << 30) diff --git a/generic/tkBind.c b/generic/tkBind.c index acd982b..6c83dd0 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -528,6 +528,7 @@ static const EventInfo eventArray[] = { {"Activate", ActivateNotify, ActivateMask}, {"Deactivate", DeactivateNotify, ActivateMask}, {"MouseWheel", MouseWheelEvent, MouseWheelMask}, + {"TouchpadScroll", TouchpadScroll, TouchpadScrollMask}, {"CirculateRequest", CirculateRequest, SubstructureRedirectMask}, {"ConfigureRequest", ConfigureRequest, SubstructureRedirectMask}, {"Create", CreateNotify, SubstructureNotifyMask}, @@ -632,7 +633,8 @@ static const int flagArray[TK_LASTEVENT] = { /* VirtualEvent */ VIRTUAL, /* Activate */ ACTIVATE, /* Deactivate */ ACTIVATE, - /* MouseWheel */ WHEEL + /* MouseWheel */ WHEEL, + /* TouchpadScroll */ WHEEL }; /* @@ -5016,7 +5018,6 @@ ParseEventDescription( eventFlags = 0; if ((hPtr = Tcl_FindHashEntry(&eventTable, field))) { const EventInfo *eiPtr = (const EventInfo *)Tcl_GetHashValue(hPtr); - patPtr->eventType = eiPtr->type; eventFlags = flagArray[eiPtr->type]; eventMask = eiPtr->eventMask; @@ -5091,7 +5092,6 @@ ParseEventDescription( } else if (patPtr->eventType == MotionNotify) { patPtr->info = ButtonNumberFromState(patPtr->modMask); } - p = SkipFieldDelims(p); if (*p != '>') { diff --git a/generic/tkEvent.c b/generic/tkEvent.c index b6ee204..59b4e49 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -123,7 +123,8 @@ static const unsigned long eventMasks[TK_LASTEVENT] = { VirtualEventMask, /* VirtualEvents */ ActivateMask, /* ActivateNotify */ ActivateMask, /* DeactivateNotify */ - MouseWheelMask /* MouseWheelEvent */ + MouseWheelMask, /* MouseWheelEvent */ + TouchpadScrollMask /* TouchpadScroll */ }; /* diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index bb5e121..9b7f394 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -108,8 +108,7 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk %W xview scroll [expr {(%D-2)/-3}] units } } - #Touchpad scrolling - bind $c { + bind $c { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 || $deltaY != 0} { tk::CanvasScrollByPixels %W $deltaX $deltaY diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 90eb027..be07916 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -34,8 +34,7 @@ canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ ttk::scrollbar $w.frame.vscroll -command "$c yview" ttk::scrollbar $w.frame.hscroll -orient horizontal -command "$c xview" -#Touchpad scrolling -bind $c { +bind $c { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 || $deltaY != 0} { tk::CanvasScrollByPixels %W $deltaX $deltaY diff --git a/library/listbox.tcl b/library/listbox.tcl index c79be3a..32eea4b 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -187,7 +187,7 @@ bind Listbox { bind Listbox { tk::MouseWheel %W x %D -12.0 units } -bind Listbox { +bind Listbox { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { %W xview scroll [expr {-$deltaX}] units diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 909d93d..5c4ba72 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -137,7 +137,7 @@ bind Scrollbar { tk::ScrollByUnits %W hv %D -40.0 } -bind Scrollbar { +bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 && [%W cget -orient] eq "horizontal"} { tk::ScrollbarScrollByPixels %W h $deltaX diff --git a/library/text.tcl b/library/text.tcl index 4e0476d..f2ef83a 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -456,7 +456,7 @@ bind Text { } set ::tk::Priv(prevPos) {} -bind Text { +bind Text { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0} { %W xview scroll [expr {-$deltaX}] pixels diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 0fd4c6a..28c6a84 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -21,7 +21,7 @@ bind TScrollbar { ttk::scrollbar::Release %W %x %y } # bind TScrollbar [bind Scrollbar ] bind TScrollbar [bind Scrollbar ] -bind TScrollbar [bind Scrollbar ] +bind TScrollbar [bind Scrollbar ] proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index e80c4a7..22ae11f 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -559,8 +559,8 @@ enum { int deltaY = [theEvent scrollingDeltaY]; delta = (deltaX << 16) | (deltaY & 0xffff); if (delta != 0) { - xEvent.type = MouseWheelEvent; - xEvent.xbutton.state = state | EXTENDED_MASK; + xEvent.type = TouchpadScroll; + xEvent.xbutton.state = state; xEvent.xkey.keycode = delta; xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); -- cgit v0.12 From 4cd583363c4980aacbd905f39eb33a7db39ae56b Mon Sep 17 00:00:00 2001 From: marc_culler Date: Mon, 27 Nov 2023 17:02:20 +0000 Subject: Use the serial field of TouchpadScroll events as a counter. --- library/ttk/combobox.tcl | 13 +++++++++++-- macosx/tkMacOSXMouseEvent.c | 3 ++- win/tkWinX.c | 45 ++++++++++++++++++++++++++------------------- 3 files changed, 39 insertions(+), 22 deletions(-) diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 653102e..449d0a2 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -52,8 +52,17 @@ bind TCombobox { ttk::combobox::Press "3" %W %x %y } bind TCombobox { ttk::combobox::Drag %W %x } bind TCombobox { ttk::combobox::Motion %W %x %y } -ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W] - +ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W] +bind TCombobox { + # Ignore the event +} +bind TCombobox { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + # TouchpadScroll events fire about 60 times per second. + if {$deltaY != 0 && [expr {%# %% 15}] == 0} { + ttk::combobox::Scroll %W [expr {$deltaY > 0 ? -1 : 1}] + } +} bind TCombobox <> { ttk::combobox::TraverseIn %W } ### Combobox listbox bindings. diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 22ae11f..59fb00d 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -543,6 +543,7 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } } else { + static int scrollCounter = 0; int delta; CGFloat Delta; Bool deltaIsPrecise = [theEvent hasPreciseScrollingDeltas]; @@ -562,7 +563,7 @@ enum { xEvent.type = TouchpadScroll; xEvent.xbutton.state = state; xEvent.xkey.keycode = delta; - xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); + xEvent.xany.serial = scrollCounter++; Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } else { diff --git a/win/tkWinX.c b/win/tkWinX.c index d3a2d55..2d6fe1b 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -53,7 +53,14 @@ */ static int lastMod = 0; - + +/* + * The serial field of TouchpadScroll events is a counter for + * events of this type only. + */ + +static int scrollCounter = 0; + /* * imm.h is needed by HandleIMEComposition */ @@ -1142,22 +1149,22 @@ GenerateXEvent( /* * Send an Xevent using a KeyPress struct, but with the type field - * set to MouseWheelEventq and the keypress field set to the value - * of the MouseWheel delta. For high resolution events the - * EXTENDED_MASK bit is set and delta is stored in the high word of - * the keycode. For low resolution scrolls the delta is in the - * low word of the keycode. Set nbytes to 0 to prevent conversion - * of the keycode to a keysym in TkpGetString. [Bug 1118340]. + * set to MouseWheelEvent for low resolution scrolls and to + * TouchpadScroll for high resolution scroll events. The Y delta + * is stored in the low order 16 bits of the keycode field. Set + * nbytes to 0 to prevent conversion of the keycode to a keysym in + * TkpGetString. [Bug 1118340]. */ int delta = (short) HIWORD(wParam); int mod = delta % WHEELDELTA; if ( mod != 0 || lastMod != 0) { /* High resolution. */ - event.x.type = MouseWheelEvent; + event.x.type = TouchpadScroll; event.x.xany.send_event = -1; event.key.nbytes = 0; - event.x.xkey.state = state | EXTENDED_MASK ; + event.x.xkey.state = state; + event.xany.serial = scrollCounter++; event.x.xkey.keycode = (unsigned int) delta; } else { event.x.type = MouseWheelEvent; @@ -1169,26 +1176,26 @@ GenerateXEvent( break; } case WM_MOUSEHWHEEL: { - + /* * Send an Xevent using a KeyPress struct, but with the type field - * set to MouseWheelEventq and the keypress field set to the value - * of the MouseWheel delta. For high resolution scrolls the - * EXTENDEDMASK bit is set and deltaX is stored in the high word - * of the keycode. For low resolution scrolls the delta is in the - * low word of the keycode and the ShiftMask bit is set. Set - * nbytes to 0 to prevent conversion of the keycode to a keysym in - * TkpGetString. [Bug 1118340]. + * set to MouseWheelEvent for low resolution scrolls and to + * TouchpadScroll for high resolution scroll events. For low + * resolution scrolls the X delta is stored in the keycode field + * and For high resolution scrolls the X delta is in the high word + * of the keycode. Set nbytes to 0 to prevent conversion of the + * keycode to a keysym in TkpGetString. [Bug 1118340]. */ int delta = (short) HIWORD(wParam); int mod = delta % WHEELDELTA; if ( mod != 0 || lastMod != 0) { /* High resolution. */ - event.x.type = MouseWheelEvent; + event.x.type = TouchpadScroll; event.x.xany.send_event = -1; event.key.nbytes = 0; - event.x.xkey.state = state | EXTENDED_MASK ; + event.x.xkey.state = state; + event.xany.serial = scrollCounter++; event.x.xkey.keycode = (unsigned int)(-(delta << 16)); } else { event.x.type = MouseWheelEvent; -- cgit v0.12 From 365c1aa8200f8ca770202b571eee7cc324531c77 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Mon, 27 Nov 2023 19:35:43 +0000 Subject: Adapt Csaba's ttk::combobox and ttk::spinbox bindings to this setup. --- library/ttk/spinbox.tcl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 9f002cd..252521a 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -24,6 +24,15 @@ bind TSpinbox <> { ttk::spinbox::Spin %W +1 } bind TSpinbox <> { ttk::spinbox::Spin %W -1 } ttk::bindMouseWheel TSpinbox [list ttk::spinbox::Spin %W] +bind TSpinbox { + # Ignore the event +} +bind TSpinbox { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaY != 0 && [expr {%# %% 12}] == 0} { + ttk::spinbox::Spin %W [expr {$deltaY > 0 ? -1 : 1}] + } +} ## Motion -- # Sets cursor. -- cgit v0.12 From 1b1276420e9016d6eddf1cfc49642a0ffcf3535f Mon Sep 17 00:00:00 2001 From: marc_culler Date: Mon, 27 Nov 2023 20:21:17 +0000 Subject: Adapt Csaba's notebook bindings to the new setup. --- library/ttk/notebook.tcl | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 7097c45..21a33b8 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -17,6 +17,16 @@ bind TNotebook { ttk::notebook::CycleTab %W -1; break } bind TNotebook { ttk::notebook::Cleanup %W } ttk::bindMouseWheel TNotebook [list ttk::notebook::CycleTab %W] +bind TNotebook { + # Ignore the event +} +bind TNotebook { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + # TouchpadScroll events fire about 60 times per second. + if {$deltaX != 0 && [expr {%# %% 30}] == 0} { + ttk::notebook::CondCycleTab %W %D + } +} # ActivateTab $nb $tab -- # Select the specified tab and set focus. @@ -75,6 +85,24 @@ proc ttk::notebook::CycleTab {w dir {factor 1.0}} { } } +# CondCycleTab -- +# Conditionally invoke the ttk::notebook::CycleTab proc. +# +proc ttk::notebook::CondCycleTab {w dxdy} { + if {[set style [$w cget -style]] eq ""} { + set style TNotebook + } + set tabSide [string index [ttk::style lookup $style -tabposition {} nw] 0] + + lassign [tk::PreciseScrollDeltas $dxdy] deltaX deltaY + if {$tabSide in {n s} && $deltaX != 0} { + CycleTab $w [expr {$deltaX > 0 ? -1 : 1}] + } + if {$tabSide in {w e} && $deltaY != 0} { + CycleTab $w [expr {$deltaY > 0 ? -1 : 1}] + } +} + # MnemonicTab $nb $key -- # Scan all tabs in the specified notebook for one with the # specified mnemonic. If found, returns path name of tab; -- cgit v0.12 From 9c14936e2980f87eafc2b80694de4f73abf9ebc0 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Tue, 28 Nov 2023 03:38:54 +0000 Subject: Add bindings for listbox and treeview. Some code clean up. --- library/demos/cscroll.tcl | 2 +- library/demos/items.tcl | 2 +- library/listbox.tcl | 10 ++++------ library/tk.tcl | 18 ++++++++++-------- library/ttk/utils.tcl | 14 ++++++++++++++ 5 files changed, 30 insertions(+), 16 deletions(-) diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index 9b7f394..ed21310 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -111,7 +111,7 @@ if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk bind $c { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 || $deltaY != 0} { - tk::CanvasScrollByPixels %W $deltaX $deltaY + tk::ScrollByPixels %W $deltaX $deltaY } } } diff --git a/library/demos/items.tcl b/library/demos/items.tcl index be07916..335971b 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -37,7 +37,7 @@ ttk::scrollbar $w.frame.hscroll -orient horizontal -command "$c xview" bind $c { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 || $deltaY != 0} { - tk::CanvasScrollByPixels %W $deltaX $deltaY + tk::ScrollByPixels %W $deltaX $deltaY } } diff --git a/library/listbox.tcl b/library/listbox.tcl index 32eea4b..ff3025f 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -188,13 +188,11 @@ bind Listbox { tk::MouseWheel %W x %D -12.0 units } bind Listbox { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { - %W xview scroll [expr {-$deltaX}] units - } - if {$deltaY != 0} { - %W yview scroll [expr {-$deltaY / 2.0}] units + if {[expr {%# %% 10}] != 0} { + return } + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + ::tk::ScrollByPixels %W $deltaX $deltaY } # ::tk::ListboxBeginSelect -- diff --git a/library/tk.tcl b/library/tk.tcl index 1345fbf..656ad00 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -845,16 +845,18 @@ if {$::ttk::library ne ""} { uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl] } -# Helper for smooth scrolling of Canvas widgets -proc ::tk::CanvasScrollByPixels {canvas deltaX deltaY} { - set width [expr {1.0 * [$canvas cget -width]}] - set height [expr {1.0 * [$canvas cget -height]}] - set X [lindex [$canvas xview] 0] - set Y [lindex [$canvas yview] 0] +# Helper for smooth scrolling of widgets that support xview moveto, +# yview moveto, height and width. + +proc ::tk::ScrollByPixels {w deltaX deltaY} { + set width [expr {1.0 * [$w cget -width]}] + set height [expr {1.0 * [$w cget -height]}] + set X [lindex [$w xview] 0] + set Y [lindex [$w yview] 0] set x [expr {$X - $deltaX / $width}] set y [expr {$Y - $deltaY / $height}] - $canvas xview moveto $x - $canvas yview moveto $y + $w xview moveto $x + $w yview moveto $y } diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index c2c7e8f..32c119d 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -301,4 +301,18 @@ bind TtkScrollable \ bind TtkScrollable \ { tk::MouseWheel %W x %D -12.0 } +## Touchpad scrolling +# +bind TtkScrollable { + if {[expr {%# %% 4}] != 0} { + return + } + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0} { + %W xview scroll [expr {-$deltaX}] units + } + if {$deltaY != 0} { + %W yview scroll [expr {-$deltaY}] units + } +} #*EOF* -- cgit v0.12 From 727b9a7be6238a5093d0faf6b05cbb8927712658 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Tue, 28 Nov 2023 03:53:24 +0000 Subject: Update bind.n --- doc/bind.n | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/bind.n b/doc/bind.n index 518d522..d299f66 100644 --- a/doc/bind.n +++ b/doc/bind.n @@ -229,6 +229,9 @@ example: .CS lassign [tk::PreciseScrollDeltas %D] deltaX deltaY .CE +The \fB$#\fR substitution is a counter for \fBToucpadScroll\fR events +which can be used by widgets that only support scrolling by units to +ignore some portion of the events. .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 The \fBKeyPress\fR and \fBKeyRelease\fR events are generated whenever a key is pressed or released. \fBKeyPress\fR and \fBKeyRelease\fR -- cgit v0.12 From ef62d951ba85f8be5b99310f1ba378403eeda260 Mon Sep 17 00:00:00 2001 From: culler Date: Tue, 28 Nov 2023 13:51:13 +0000 Subject: Fix Windows build --- win/tkWinX.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tkWinX.c b/win/tkWinX.c index 2d6fe1b..1841481 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -1164,7 +1164,7 @@ GenerateXEvent( event.x.xany.send_event = -1; event.key.nbytes = 0; event.x.xkey.state = state; - event.xany.serial = scrollCounter++; + event.x.xany.serial = scrollCounter++; event.x.xkey.keycode = (unsigned int) delta; } else { event.x.type = MouseWheelEvent; @@ -1195,7 +1195,7 @@ GenerateXEvent( event.x.xany.send_event = -1; event.key.nbytes = 0; event.x.xkey.state = state; - event.xany.serial = scrollCounter++; + event.x.xany.serial = scrollCounter++; event.x.xkey.keycode = (unsigned int)(-(delta << 16)); } else { event.x.type = MouseWheelEvent; -- cgit v0.12 From 9c4da3172b95045d82551cbc983894bd8cc4ce98 Mon Sep 17 00:00:00 2001 From: marc_culler Date: Tue, 28 Nov 2023 20:38:27 +0000 Subject: Include changes suggested by Csaba Nemethi. --- library/listbox.tcl | 9 +++++++-- library/ttk/notebook.tcl | 3 +-- library/ttk/utils.tcl | 2 +- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/library/listbox.tcl b/library/listbox.tcl index ff3025f..a27ae1e 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -188,11 +188,16 @@ bind Listbox { tk::MouseWheel %W x %D -12.0 units } bind Listbox { - if {[expr {%# %% 10}] != 0} { + if {[expr {%# %% 15}] != 0} { return } lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - ::tk::ScrollByPixels %W $deltaX $deltaY + if {$deltaX != 0} { + %W xview scroll [expr {-$deltaX}] units + } + if {$deltaY != 0} { + %W yview scroll [expr {-$deltaY}] units + } } # ::tk::ListboxBeginSelect -- diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 21a33b8..b3acf3f 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -21,9 +21,8 @@ bind TNotebook { # Ignore the event } bind TNotebook { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY # TouchpadScroll events fire about 60 times per second. - if {$deltaX != 0 && [expr {%# %% 30}] == 0} { + if {[expr {%# %% 30}] == 0} { ttk::notebook::CondCycleTab %W %D } } diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 32c119d..ea7dc72 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -304,7 +304,7 @@ bind TtkScrollable \ ## Touchpad scrolling # bind TtkScrollable { - if {[expr {%# %% 4}] != 0} { + if {[expr {%# %% 15}] != 0} { return } lassign [tk::PreciseScrollDeltas %D] deltaX deltaY -- cgit v0.12 From 04772f4b2d2d872ff63c509b26f63bb72e18749b Mon Sep 17 00:00:00 2001 From: Kevin Walzer Date: Thu, 30 Nov 2023 15:58:11 +0000 Subject: Correct typo on bind man page --- doc/bind.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/bind.n b/doc/bind.n index d299f66..9fb5c07 100644 --- a/doc/bind.n +++ b/doc/bind.n @@ -229,7 +229,7 @@ example: .CS lassign [tk::PreciseScrollDeltas %D] deltaX deltaY .CE -The \fB$#\fR substitution is a counter for \fBToucpadScroll\fR events +The \fB$#\fR substitution is a counter for \fBTouchpadScroll\fR events which can be used by widgets that only support scrolling by units to ignore some portion of the events. .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 -- cgit v0.12 From 39ed53bbb13ea433f0663adea0ab5b1c3613acdd Mon Sep 17 00:00:00 2001 From: csaba Date: Fri, 1 Dec 2023 12:26:57 +0000 Subject: For X11 only: Minimize the number of artifacts caused by intermixed and events triggered by two-finger gestures. --- library/scrlbar.tcl | 33 +++++++++++++++++++++++++++------ library/text.tcl | 18 +++++++++--------- library/ttk/combobox.tcl | 2 +- library/ttk/notebook.tcl | 46 +++++++++++++++++++++++++++++++++++++--------- library/ttk/scrollbar.tcl | 14 ++++++++++---- library/ttk/spinbox.tcl | 3 ++- tests/scrollbar.test | 3 +++ 7 files changed, 89 insertions(+), 30 deletions(-) diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 5c4ba72..3d3f204 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -129,14 +129,21 @@ bind Scrollbar <> { } } -bind Scrollbar { - tk::ScrollByUnits %W hv %D -12.0 +bind Scrollbar {+ + set tk::Priv(xEvents) 0; set tk::Priv(yEvents) 0 } - bind Scrollbar { + tk::ScrollByUnits %W vh %D -40.0 +} +bind Scrollbar { + tk::ScrollByUnits %W vh %D -12.0 +} +bind Scrollbar { tk::ScrollByUnits %W hv %D -40.0 } - +bind Scrollbar { + tk::ScrollByUnits %W hv %D -12.0 +} bind Scrollbar { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY if {$deltaX != 0 && [%W cget -orient] eq "horizontal"} { @@ -147,7 +154,6 @@ bind Scrollbar { } } - # tk::ScrollButtonDown -- # This procedure is invoked when a button is pressed in a scrollbar. # It changes the way the scrollbar is displayed and takes actions @@ -358,7 +364,7 @@ proc ::tk::ScrollbarScrollByPixels {w orient amount} { # Arguments: # w - The scrollbar widget. # orient - Which kinds of scrollbars this applies to: "h" for -# horizontal, "v" for vertical, "hv" for both. +# horizontal, "v" for vertical, "hv" or "vh" for both. # amount - How many units to scroll: typically 1 or -1. proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { @@ -367,6 +373,21 @@ proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { [string index [$w cget -orient] 0] $orient] < 0)} { return } + + if {[string length $orient] == 2 && $factor != 1.0} { + # Count both the and + # events, and ignore the non-dominant ones + + variable ::tk::Priv + set axis [expr {[string index $orient 0] eq "h" ? "x" : "y"}] + incr Priv(${axis}Events) + if {($Priv(xEvents) + $Priv(yEvents) > 10) && + ($axis eq "x" && $Priv(xEvents) < $Priv(yEvents) || + $axis eq "y" && $Priv(yEvents) < $Priv(xEvents))} { + return + } + } + set info [$w get] if {[llength $info] == 2} { uplevel #0 $cmd scroll [expr {$amount/$factor}] units diff --git a/library/text.tcl b/library/text.tcl index f2ef83a..caa2844 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -456,15 +456,6 @@ bind Text { } set ::tk::Priv(prevPos) {} -bind Text { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { - %W xview scroll [expr {-$deltaX}] pixels - } - if {$deltaY != 0} { - %W yview scroll [expr {-$deltaY}] pixels - } -} bind Text { tk::MouseWheel %W y [tk::ScaleNum %D] -4.0 pixels } @@ -477,6 +468,15 @@ bind Text { bind Text { tk::MouseWheel %W x [tk::ScaleNum %D] -1.2 pixels } +bind Text { + lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + if {$deltaX != 0} { + %W xview scroll [tk::ScaleNum [expr {-$deltaX}]] pixels + } + if {$deltaY != 0} { + %W yview scroll [tk::ScaleNum [expr {-$deltaY}]] pixels + } +} # ::tk::TextClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 449d0a2..c253eb0 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -52,7 +52,7 @@ bind TCombobox { ttk::combobox::Press "3" %W %x %y } bind TCombobox { ttk::combobox::Drag %W %x } bind TCombobox { ttk::combobox::Motion %W %x %y } -ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W] +ttk::bindMouseWheel TCombobox { ttk::combobox::Scroll %W } bind TCombobox { # Ignore the event } diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index b3acf3f..7fb0ad5 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -16,14 +16,25 @@ bind TNotebook { ttk::notebook::CycleTab %W -1; break } } bind TNotebook { ttk::notebook::Cleanup %W } -ttk::bindMouseWheel TNotebook [list ttk::notebook::CycleTab %W] +bind TNotebook { + set tk::Priv(xEvents) 0; set tk::Priv(yEvents) 0 +} +bind TNotebook { + ttk::notebook::CondCycleTab1 %W y %D -120.0 +} +bind TNotebook { + ttk::notebook::CondCycleTab1 %W y %D -12.0 +} bind TNotebook { - # Ignore the event + ttk::notebook::CondCycleTab1 %W x %D -120.0 +} +bind TNotebook { + ttk::notebook::CondCycleTab1 %W x %D -12.0 } bind TNotebook { # TouchpadScroll events fire about 60 times per second. if {[expr {%# %% 30}] == 0} { - ttk::notebook::CondCycleTab %W %D + ttk::notebook::CondCycleTab2 %W %D } } @@ -84,10 +95,28 @@ proc ttk::notebook::CycleTab {w dir {factor 1.0}} { } } -# CondCycleTab -- +# CondCycleTab1 -- +# Conditionally invoke the ttk::notebook::CycleTab proc. +# +proc ttk::notebook::CondCycleTab1 {w axis dir {factor 1.0}} { + # Count both the and + # events, and ignore the non-dominant ones + + variable ::tk::Priv + incr Priv(${axis}Events) + if {($Priv(xEvents) + $Priv(yEvents) > 10) && + ($axis eq "x" && $Priv(xEvents) < $Priv(yEvents) || + $axis eq "y" && $Priv(yEvents) < $Priv(xEvents))} { + return + } + + CycleTab $w $dir $factor +} + +# CondCycleTab2 -- # Conditionally invoke the ttk::notebook::CycleTab proc. # -proc ttk::notebook::CondCycleTab {w dxdy} { +proc ttk::notebook::CondCycleTab2 {w dxdy} { if {[set style [$w cget -style]] eq ""} { set style TNotebook } @@ -95,10 +124,9 @@ proc ttk::notebook::CondCycleTab {w dxdy} { lassign [tk::PreciseScrollDeltas $dxdy] deltaX deltaY if {$tabSide in {n s} && $deltaX != 0} { - CycleTab $w [expr {$deltaX > 0 ? -1 : 1}] - } - if {$tabSide in {w e} && $deltaY != 0} { - CycleTab $w [expr {$deltaY > 0 ? -1 : 1}] + CycleTab $w [expr {$deltaX < 0 ? -1 : 1}] + } elseif {$tabSide in {w e} && $deltaY != 0} { + CycleTab $w [expr {$deltaY < 0 ? -1 : 1}] } } diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 28c6a84..7c31511 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -17,11 +17,17 @@ bind TScrollbar { ttk::scrollbar::Jump %W %x %y } bind TScrollbar { ttk::scrollbar::Drag %W %x %y } bind TScrollbar { ttk::scrollbar::Release %W %x %y } -# Redirect scrollwheel bindings to the scrollbar widget +# Copy the mouse wheel event bindings from Scrollbar to TScrollbar # -bind TScrollbar [bind Scrollbar ] -bind TScrollbar [bind Scrollbar ] -bind TScrollbar [bind Scrollbar ] +bind TScrollbar { + set tk::Priv(xEvents) 0; set tk::Priv(yEvents) 0 +} +foreach event { + + } { + bind TScrollbar $event [bind Scrollbar $event] +} +unset event proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 252521a..0160d35 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -23,12 +23,13 @@ bind TSpinbox { event generate %W <> } bind TSpinbox <> { ttk::spinbox::Spin %W +1 } bind TSpinbox <> { ttk::spinbox::Spin %W -1 } -ttk::bindMouseWheel TSpinbox [list ttk::spinbox::Spin %W] +ttk::bindMouseWheel TSpinbox { ttk::spinbox::Spin %W } bind TSpinbox { # Ignore the event } bind TSpinbox { lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + # TouchpadScroll events fire about 60 times per second. if {$deltaY != 0 && [expr {%# %% 12}] == 0} { ttk::spinbox::Spin %W [expr {$deltaY > 0 ? -1 : 1}] } diff --git a/tests/scrollbar.test b/tests/scrollbar.test index edf263c..aac01e5 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -705,6 +705,7 @@ test scrollbar-10.1 { event on scrollbar} -setup { pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left update focus -force .s + event generate .s event generate .s -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 @@ -720,6 +721,7 @@ test scrollbar-10.2 { event on scrollbar} -setup { pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s + event generate .s event generate .s -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 @@ -734,6 +736,7 @@ test scrollbar-10.3 { event on horizontal scrollbar} -setup { pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s + event generate .s event generate .s -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 -- cgit v0.12 From fa30d6e92c313f3f6cfb3d1a9f99da4c04fe4022 Mon Sep 17 00:00:00 2001 From: csaba Date: Sat, 2 Dec 2023 09:39:37 +0000 Subject: Updated the ttk::scrollbar test. --- tests/ttk/scrollbar.test | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test index c65bb4a..9b6abee 100644 --- a/tests/ttk/scrollbar.test +++ b/tests/ttk/scrollbar.test @@ -79,6 +79,7 @@ test scrollbar-10.1.1 { event on scrollbar} -setup { pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left update focus -force .s + event generate .s event generate .s -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 @@ -94,6 +95,7 @@ test scrollbar-10.2.1 { event on horizontal scrollbar} -setup pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s + event generate .s event generate .s -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 @@ -108,6 +110,7 @@ test scrollbar-10.2.2 { event on horizontal scrollbar} -setup { pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s + event generate .s event generate .s -delta -120 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 -- cgit v0.12