Index: doc/GetScroll.3 ================================================================== --- doc/GetScroll.3 +++ doc/GetScroll.3 @@ -60,11 +60,12 @@ is returned as result and \fI*fractionPtr\fR is filled in with the \fIfraction\fR argument to the command, which must be a proper real value. If \fIobjv\fR has the \fBscroll\fR form, \fBTK_SCROLL_PAGES\fR or \fBTK_SCROLL_UNITS\fR is returned and \fI*stepsPtr\fR is filled -in with the \fInumber\fR value, which must be a proper integer. +in with the \fInumber\fR value, which must be a integer or a float, +but if it is a float then it is converted to an integer, rounded away from 0. If an error occurs in parsing the arguments, \fBTK_SCROLL_ERROR\fR is returned and an error message is left in interpreter \fIinterp\fR's result. .PP \fBTk_GetScrollInfo\fR is identical in function to Index: doc/bind.n ================================================================== --- doc/bind.n +++ doc/bind.n @@ -212,15 +212,11 @@ .RS .PP Horizontal scrolling uses \fBShift-MouseWheel\fR events, with positive \fB%D\fR \fIdelta\fR substitution indicating left scrolling and negative right scrolling. -Only Windows and macOS Aqua typically fire \fBMouseWheel\fR and -\fBShift-MouseWheel\fR events. On -X11 vertical scrolling is rather supported through \fBButton-4\fR and -\fBButton-5\fR events, and horizontal scrolling through \fBShift-Button-4\fR -and \fBShift-Button-5\fR events. Horizontal scrolling events may fire from +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. .RE .IP "\fBKeyPress\fR, \fBKeyRelease\fR" 5 The \fBKeyPress\fR and \fBKeyRelease\fR events are generated Index: doc/canvas.n ================================================================== --- doc/canvas.n +++ doc/canvas.n @@ -1145,11 +1145,12 @@ .TP \fIpathName \fBxview scroll \fInumber what\fR . This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. -\fINumber\fR must be an integer. +\fINumber\fR must be an integer or a float, but if it is a float then +it is converted to an integer, rounded away from 0. \fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation of one of these. If \fIwhat is \fBpages\fR then the view adjusts in units of nine-tenths the window's width. If \fInumber\fR is negative then information farther to the left Index: doc/entry.n ================================================================== --- doc/entry.n +++ doc/entry.n @@ -401,11 +401,12 @@ \fIFraction\fR must be a fraction between 0 and 1. .TP \fIpathName \fBxview scroll \fInumber what\fR This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. -\fINumber\fR must be an integer. +\fINumber\fR must be an integer or a float, but if it is a float then +it is converted to an integer, rounded away from 0. \fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation of one of these. If \fIwhat\fR is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative then characters farther to the left become visible; if it is positive then characters farther to the right Index: doc/listbox.n ================================================================== --- doc/listbox.n +++ doc/listbox.n @@ -381,11 +381,12 @@ .TP \fIpathName \fBxview scroll \fInumber what\fR . This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. -\fINumber\fR must be an integer. +\fINumber\fR must be an integer or a float, but if it is a float then +it is converted to an integer, rounded away from 0. \fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation of one of these. If \fIwhat\fR is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative then characters farther to the left Index: doc/scrollbar.n ================================================================== --- doc/scrollbar.n +++ doc/scrollbar.n @@ -221,20 +221,23 @@ It is up to the widget to define the meaning of a page; typically it is slightly less than what fits in the window, so that there is a slight overlap between the old and new views. \fINumber\fR is either 1, which means the next page should become visible, or \-1, which means that the previous page should -become visible. +become visible. Fractional number are rounded away from 0, so +scrolling 0.001 pages has the same effect as scrolling 1 page. .TP \fIprefix \fBscroll \fInumber \fBunits\fR . The widget should adjust its view by \fInumber\fR units. The units are defined in whatever way makes sense for the widget, such as characters or lines in a text widget. \fINumber\fR is either 1, which means one unit should scroll off the top or left of the window, or \-1, which means that one unit -should scroll off the bottom or right of the window. +should scroll off the bottom or right of the window. Fractional +numbers are rounded away from 0, so scrolling 0.001 units has +the same effect as scrolling 1 unit. .SH "OLD COMMAND SYNTAX" .PP In versions of Tk before 4.0, the \fBset\fR and \fBget\fR widget commands used a different form. This form is still supported for backward compatibility, but it Index: doc/spinbox.n ================================================================== --- doc/spinbox.n +++ doc/spinbox.n @@ -468,11 +468,12 @@ \fIFraction\fR must be a fraction between 0 and 1. .TP \fIpathName \fBxview scroll \fInumber what\fR This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. -\fINumber\fR must be an integer. +\fINumber\fR must be an integer or a float, but if it is a float then +it is converted to an integer, rounded away from 0. \fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation of one of these. If \fIwhat\fR is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative then characters farther to the left become visible; if it is positive then characters farther to the right Index: doc/ttk_widget.n ================================================================== --- doc/ttk_widget.n +++ doc/ttk_widget.n @@ -255,11 +255,12 @@ \fIFraction\fR must be a fraction between 0 and 1. .TP \fIpathName \fBxview scroll \fInumber what\fR This command shifts the view in the window left or right according to \fInumber\fR and \fIwhat\fR. -\fINumber\fR must be an integer. +\fINumber\fR must be an integer or a float, but if it is a float then +it is converted to an integer, rounded away from 0. \fIWhat\fR must be either \fBpages\fR or \fBunits\fR. '\" or an abbreviation of one of these, but we don't document that. If \fIwhat\fR is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative then characters farther to the left Index: generic/tkBind.c ================================================================== --- generic/tkBind.c +++ generic/tkBind.c @@ -790,12 +790,14 @@ static unsigned GetButtonNumber( const char *field) { + unsigned button; assert(field); - return (field[0] >= '1' && field[0] <= '9' && field[1] == '\0') ? field[0] - '0' : 0; + button = (field[0] >= '1' && field[0] <= '9' && field[1] == '\0') ? field[0] - '0' : 0; + return (button > 3) ? (button + 4) : button; } static Time CurrentTimeInMilliSecs(void) { @@ -4036,10 +4038,13 @@ case EVENT_BUTTON: if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) { return TCL_ERROR; } if (flags & BUTTON) { + if (number >= Button4) { + number += (Button8 - Button4); + } event.general.xbutton.button = number; } else { badOpt = 1; } break; @@ -5187,19 +5192,19 @@ } break; } case ButtonPress: case ButtonRelease: - assert(patPtr->info <= Button9); - Tcl_AppendPrintfToObj(patternObj, "-%u", (unsigned)patPtr->info); + assert(patPtr->info <= 13); + Tcl_AppendPrintfToObj(patternObj, "-%u", (unsigned) ((patPtr->info > 7) ? (patPtr->info - 4) : patPtr->info)); break; #if PRINT_SHORT_MOTION_SYNTAX case MotionNotify: { unsigned mask = patPtr->modMask; while (mask & ALL_BUTTONS) { unsigned button = ButtonNumberFromState(mask); - Tcl_AppendPrintfToObj(patternObj, "-%u", button); + Tcl_AppendPrintfToObj(patternObj, "-%u", (button > 7) ? (button - 4) : button); mask &= ~Tk_GetButtonMask(button); } break; } #endif Index: generic/tkEvent.c ================================================================== --- generic/tkEvent.c +++ generic/tkEvent.c @@ -513,11 +513,14 @@ /* *---------------------------------------------------------------------- * * Tk_GetButtonMask -- * - * Return the proper Button${n}Mask for the button. + * Return the proper Button${n}Mask for the button. Don't care about + * Button4 - Button7, because those are not actually buttons: Those + * are used for the horizontal or vertical mouse wheels. Button4Mask + * and higher is actually used for Button 8 and higher. * * Results: * A button mask. * * Side effects: @@ -525,12 +528,12 @@ * *---------------------------------------------------------------------- */ static const unsigned buttonMasks[] = { - 0, Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask, - Button6Mask, Button7Mask, Button8Mask, Button9Mask + 0, Button1Mask, Button2Mask, Button3Mask, 0, 0, 0, 0, Button4Mask, \ + Button5Mask, Button6Mask, Button7Mask, Button8Mask, Button9Mask }; unsigned Tk_GetButtonMask( unsigned button) @@ -1135,10 +1138,27 @@ InProgress ip; Tcl_Interp *interp = NULL; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + +#if !defined(_WIN32) && !defined(MAC_OSX_TK) + if ((eventPtr->xbutton.button >= Button4) && (eventPtr->xbutton.button < Button8)) { + if (eventPtr->type == ButtonRelease) { + return; + } else if (eventPtr->type == ButtonPress) { + int but = eventPtr->xbutton.button; + eventPtr->type = MouseWheelEvent; + eventPtr->xany.send_event = -1; + eventPtr->xkey.keycode = (but & 1) ? -120 : 120; + if (but > Button5) { + eventPtr->xkey.state ^= ShiftMask; + } + } + } +#endif + /* * If the generic handler processed this event we are done and can return. */ if (InvokeGenericHandlers(tsdPtr, eventPtr)) { Index: generic/tkInt.h ================================================================== --- generic/tkInt.h +++ generic/tkInt.h @@ -1009,10 +1009,15 @@ #define META_MASK (AnyModifier<<1) #define ALT_MASK (AnyModifier<<2) #define EXTENDED_MASK (AnyModifier<<3) +/* + * Buttons 8 and 9 are the Xbuttons (left and right side-buttons). On Windows/Mac, those + * are known as Buttons 4 and 5. At script level, they also get the numbers 4 and 5. + */ + #ifndef Button8 # define Button8 8 #endif #ifndef Button9 # define Button9 9 Index: generic/tkTextDisp.c ================================================================== --- generic/tkTextDisp.c +++ generic/tkTextDisp.c @@ -8785,10 +8785,11 @@ }; enum viewUnits { VIEW_SCROLL_PAGES, VIEW_SCROLL_PIXELS, VIEW_SCROLL_UNITS }; int index; + double d; if (Tcl_GetIndexFromObjStruct(interp, objv[2], subcommands, sizeof(char *), "option", 0, &index) != TCL_OK) { return TKTEXT_SCROLL_ERROR; } @@ -8812,29 +8813,39 @@ sizeof(char *), "argument", 0, &index) != TCL_OK) { return TKTEXT_SCROLL_ERROR; } switch ((enum viewUnits) index) { case VIEW_SCROLL_PAGES: - if (Tcl_GetIntFromObj(interp, objv[3], intPtr) == TCL_OK) { - return TKTEXT_SCROLL_PAGES; + if (Tcl_GetDoubleFromObj(interp, objv[3], &d) != TCL_OK) { + return TKTEXT_SCROLL_ERROR; + } + *intPtr = (d > 0) ? ceil(d) : floor(d); + if (dblPtr) { + *dblPtr = d; } - break; + return TKTEXT_SCROLL_PAGES; case VIEW_SCROLL_PIXELS: if (Tk_GetPixelsFromObj(interp, textPtr->tkwin, objv[3], - intPtr) == TCL_OK) { - return TKTEXT_SCROLL_PIXELS; + intPtr) != TCL_OK) { + return TKTEXT_SCROLL_ERROR; + } + if (dblPtr) { + *dblPtr = (double)*intPtr; } - break; + return TKTEXT_SCROLL_PIXELS; case VIEW_SCROLL_UNITS: - if (Tcl_GetIntFromObj(interp, objv[3], intPtr) == TCL_OK) { - return TKTEXT_SCROLL_UNITS; + if (Tcl_GetDoubleFromObj(interp, objv[3], &d) != TCL_OK) { + return TKTEXT_SCROLL_ERROR; + } + *intPtr = (d > 0) ? ceil(d) : floor(d); + if (dblPtr) { + *dblPtr = d; } - break; - default: - Tcl_Panic("unexpected switch fallthrough"); + return TKTEXT_SCROLL_UNITS; } } + Tcl_Panic("unexpected switch fallthrough"); return TKTEXT_SCROLL_ERROR; } #if TK_LAYOUT_WITH_BASE_CHUNKS /* Index: generic/tkUtil.c ================================================================== --- generic/tkUtil.c +++ generic/tkUtil.c @@ -662,20 +662,22 @@ return TK_SCROLL_ERROR; } return TK_SCROLL_MOVETO; } else if ((c == 's') && (strncmp(argv[2], "scroll", length) == 0)) { + double d; if (argc != 5) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # args: should be \"%s %s %s\"", argv[0], argv[1], "scroll number pages|units")); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TK_SCROLL_ERROR; } - if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) { + if (Tcl_GetDouble(interp, argv[3], &d) != TCL_OK) { return TK_SCROLL_ERROR; } + *intPtr = (d > 0) ? ceil(d) : floor(d); length = strlen(argv[4]); c = argv[4][0]; if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) { return TK_SCROLL_PAGES; } else if ((c == 'u') && (strncmp(argv[4], "units", length) == 0)) { @@ -742,16 +744,21 @@ if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) { return TK_SCROLL_ERROR; } return TK_SCROLL_MOVETO; } else if (ArgPfxEq("scroll")) { + double d; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "scroll number pages|units"); return TK_SCROLL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[3], intPtr) != TCL_OK) { + if (Tcl_GetDoubleFromObj(interp, objv[3], &d) != TCL_OK) { return TK_SCROLL_ERROR; + } + *intPtr = (d >= 0) ? ceil(d) : floor(d); + if (dblPtr) { + *dblPtr = d; } arg = TkGetStringFromObj(objv[4], &length); if (ArgPfxEq("pages")) { return TK_SCROLL_PAGES; Index: library/demos/cscroll.tcl ================================================================== --- library/demos/cscroll.tcl +++ library/demos/cscroll.tcl @@ -54,57 +54,65 @@ } $c bind all "scrollEnter $c" $c bind all "scrollLeave $c" $c bind all "scrollButton $c" -if {[tk windowingsystem] eq "aqua"} { +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 { - %W yview scroll [expr {-(%D)}] units + %W yview scroll [expr {-%D}] units } bind $c { - %W yview scroll [expr {-10 * (%D)}] units + %W yview scroll [expr {-10*%D}] units } bind $c { - %W xview scroll [expr {-(%D)}] units + %W xview scroll [expr {-%D}] units } bind $c { - %W xview scroll [expr {-10 * (%D)}] units + %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 = 0, + # (int)1/-30 = -1, # but - # (int)-1/30 = -1 + # (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 } } bind $c { - %W yview scroll [expr {%D/-3}] units + if {%D >= 0} { + %W yview scroll [expr {%D/-3}] units + } else { + %W yview scroll [expr {(%D-2)/-3}] units + } } bind $c { 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 {%D/-3}] 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"} { +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: # http://linuxreviews.org/howtos/xfree/mouse/ bind $c { @@ -124,22 +132,10 @@ } bind $c { if {!$tk_strictMotif} { %W xview scroll 5 units } - } - if {[package vsatisfies [package provide Tk] 8.7]} { - bind $c { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind $c { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } } } proc scrollEnter canvas { Index: library/demos/ctext.tcl ================================================================== --- library/demos/ctext.tcl +++ library/demos/ctext.tcl @@ -48,11 +48,11 @@ $c bind text "textInsert $c %A" $c bind text "textInsert $c \\n" $c bind text "textBs $c" $c bind text "textBs $c" $c bind text "textDel $c" -if {[tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} { $c bind text "textPaste $c @%x,%y" } else { $c bind text "textPaste $c @%x,%y" } Index: library/demos/floor.tcl ================================================================== --- library/demos/floor.tcl +++ library/demos/floor.tcl @@ -1357,11 +1357,11 @@ $c bind floor1 "floorDisplay $c 1" $c bind floor2 "floorDisplay $c 2" $c bind floor3 "floorDisplay $c 3" $c bind room "newRoom $c" $c bind room {set currentRoom ""} -if {[tk windowingsystem] eq "aqua"} { +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" } else { bind $c "$c scan mark %x %y" bind $c "$c scan dragto %x %y" Index: library/demos/items.tcl ================================================================== --- library/demos/items.tcl +++ library/demos/items.tcl @@ -171,11 +171,11 @@ # Set up event bindings for canvas: $c bind item "itemEnter $c" $c bind item "itemLeave $c" -if {[tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} { bind $c "itemMark $c %x %y" bind $c "itemStroke $c %x %y" bind $c "$c scan mark %x %y" bind $c "$c scan dragto %x %y" } else { Index: library/entry.tcl ================================================================== --- library/entry.tcl +++ library/entry.tcl @@ -291,32 +291,19 @@ tk::EntryBackspace %W } # A few additional bindings of my own. -if {[tk windowingsystem] ne "aqua"} { - bind Entry { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Entry { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } - } -} else { - bind Entry { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Entry { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } - } +bind Entry { + if {!$tk_strictMotif} { + ::tk::EntryScanMark %W %x + } +} +bind Entry { + if {!$tk_strictMotif} { + ::tk::EntryScanDrag %W %x + } } # ::tk::EntryClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary # between characters to the given coordinates and returns the index Index: library/iconlist.tcl ================================================================== --- library/iconlist.tcl +++ library/iconlist.tcl @@ -444,22 +444,13 @@ [namespace code {my Double1 %x %y}] bind $canvas {;} bind $canvas [namespace code {my ShiftMotion1 %x %y}] - if {[tk windowingsystem] eq "aqua"} { - bind $canvas [namespace code {my MouseWheel [expr {40 * (%D)}]}] - bind $canvas [namespace code {my MouseWheel [expr {400 * (%D)}]}] - } else { - bind $canvas [namespace code {my MouseWheel %D}] - } - if {[tk windowingsystem] eq "x11"} { - bind $canvas [namespace code {my MouseWheel 120}] - bind $canvas [namespace code {my MouseWheel -120}] - bind $canvas [namespace code {my MouseWheel 120}] - bind $canvas [namespace code {my MouseWheel -120}] - } + bind $canvas [namespace code {my MouseWheel %D}] + bind $canvas [namespace code {my MouseWheel %D -12}] + bind $canvas <> [namespace code {my UpDown -1}] bind $canvas <> [namespace code {my UpDown 1}] bind $canvas <> [namespace code {my LeftRight -1}] bind $canvas <> [namespace code {my LeftRight 1}] @@ -503,25 +494,15 @@ } # ---------------------------------------------------------------------- # Event handlers - method MouseWheel {amount} { + method MouseWheel {amount {factor -120.0}} { if {$noScroll || $::tk_strictMotif} { return } - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/120 = 0, - # but - # (int)-1/120 = -1 - # The following code ensure equal +/- behaviour. - if {$amount > 0} { - $canvas xview scroll [expr {(-119-$amount) / 120}] units - } else { - $canvas xview scroll [expr {-($amount / 120)}] units - } + $canvas xview scroll [expr {$amount/$factor}] units } method Btn1 {x y} { focus $canvas set i [$w index @$x,$y] if {$i eq ""} { Index: library/listbox.tcl ================================================================== --- library/listbox.tcl +++ library/listbox.tcl @@ -174,85 +174,21 @@ } bind Listbox { %W scan dragto %x %y } -# The MouseWheel will typically only fire on Windows and Mac OS X. -# However, someone could use the "event generate" command to produce -# one on other platforms. - -if {[tk windowingsystem] eq "aqua"} { - bind Listbox { - %W yview scroll [expr {-(%D)}] units - } - bind Listbox { - %W yview scroll [expr {-10 * (%D)}] units - } - bind Listbox { - %W xview scroll [expr {-(%D)}] units - } - bind Listbox { - %W xview scroll [expr {-10 * (%D)}] units - } -} else { - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/30 = 0, - # but - # (int)-1/30 = -1 - # The following code ensure equal +/- behaviour. - bind Listbox { - if {%D >= 0} { - %W yview scroll [expr {-%D/30}] units - } else { - %W yview scroll [expr {(29-%D)/30}] units - } - } - bind Listbox { - if {%D >= 0} { - %W xview scroll [expr {-%D/30}] units - } else { - %W xview scroll [expr {(29-%D)/30}] units - } - } -} - -if {[tk windowingsystem] eq "x11"} { - # 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: - # http://linuxreviews.org/howtos/xfree/mouse/ - bind Listbox { - if {!$tk_strictMotif} { - %W yview scroll -5 units - } - } - bind Listbox { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind Listbox { - if {!$tk_strictMotif} { - %W yview scroll 5 units - } - } - bind Listbox { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } - bind Listbox { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind Listbox { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } +bind Listbox { + tk::MouseWheel %W y %D -30.0 +} +bind Listbox { + tk::MouseWheel %W y %D -3.0 +} +bind Listbox { + tk::MouseWheel %W x %D -30.0 +} +bind Listbox { + tk::MouseWheel %W x %D -3.0 } # ::tk::ListboxBeginSelect -- # # This procedure is typically invoked on button-1 presses. It begins Index: library/scale.tcl ================================================================== --- library/scale.tcl +++ library/scale.tcl @@ -58,18 +58,10 @@ bind Scale { tk::CancelRepeat tk::ScaleEndDrag %W tk::ScaleActivate %W %x %y } -if {[tk windowingsystem] eq "win32"} { - # On Windows do the same with button 3, as that is the right mouse button - bind Scale [bind Scale ] - bind Scale [bind Scale ] - bind Scale [bind Scale ] - bind Scale [bind Scale ] - bind Scale [bind Scale ] -} bind Scale { tk::ScaleControlPress %W %x %y } bind Scale <> { tk::ScaleIncrement %W up little noRepeat Index: library/scrlbar.tcl ================================================================== --- library/scrlbar.tcl +++ library/scrlbar.tcl @@ -127,38 +127,15 @@ bind Scrollbar <> { tk::ScrollToPos %W 1 } } -if {[tk windowingsystem] eq "aqua"} { - bind Scrollbar { - tk::ScrollByUnits %W hv [expr {-(%D)}] - } - bind Scrollbar { - tk::ScrollByUnits %W hv [expr {-10 * (%D)}] - } -} else { - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/30 = 0, - # but - # (int)-1/30 = -1 - # The following code ensure equal +/- behaviour. - bind Scrollbar { - if {%D >= 0} { - tk::ScrollByUnits %W hv [expr {-%D/30}] - } else { - tk::ScrollByUnits %W hv [expr {(29-%D)/30}] - } - } -} - -if {[tk windowingsystem] eq "x11"} { - bind Scrollbar {tk::ScrollByUnits %W hv -5} - bind Scrollbar {tk::ScrollByUnits %W hv 5} - bind Scrollbar {tk::ScrollByUnits %W hv -5} - bind Scrollbar {tk::ScrollByUnits %W hv 5} +bind Scrollbar { + tk::ScrollByUnits %W hv %D -30.0 +} +bind Scrollbar { + tk::ScrollByUnits %W hv %D -3.0 } # 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 @@ -327,21 +304,21 @@ # w - The scrollbar widget. # orient - Which kinds of scrollbars this applies to: "h" for # horizontal, "v" for vertical, "hv" for both. # amount - How many units to scroll: typically 1 or -1. -proc ::tk::ScrollByUnits {w orient amount} { +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)} { return } set info [$w get] if {[llength $info] == 2} { - uplevel #0 $cmd scroll $amount units + uplevel #0 $cmd scroll [expr {$amount/$factor}] units } else { - uplevel #0 $cmd [expr {[lindex $info 2] + $amount}] + uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}] } } # ::tk::ScrollByPages -- # This procedure tells the scrollbar's associated widget to scroll up Index: library/spinbox.tcl ================================================================== --- library/spinbox.tcl +++ library/spinbox.tcl @@ -278,31 +278,18 @@ } } # A few additional bindings of my own. -if {[tk windowingsystem] ne "aqua"} { - bind Spinbox { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Spinbox { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } - } -} else { - bind Spinbox { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Spinbox { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } +bind Spinbox { + if {!$tk_strictMotif} { + ::tk::EntryScanMark %W %x + } +} +bind Spinbox { + if {!$tk_strictMotif} { + ::tk::EntryScanDrag %W %x } } # ::tk::spinbox::Invoke -- # Invoke an element of the spinbox Index: library/tclIndex ================================================================== --- library/tclIndex +++ library/tclIndex @@ -197,10 +197,11 @@ set auto_index(::tk::SetFocusGrab) [list source [file join $dir tk.tcl]] set auto_index(::tk::RestoreFocusGrab) [list source [file join $dir tk.tcl]] set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]] set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]] set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]] +set auto_index(::tk::MouseWheel) [list source [file join $dir tk.tcl]] set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]] set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::SetSelectMode) [list source [file join $dir tkfbox.tcl]] Index: library/text.tcl ================================================================== --- library/text.tcl +++ library/text.tcl @@ -427,111 +427,33 @@ if {!$tk_strictMotif && [%W compare insert != 1.0]} { %W delete insert-1c %W see insert } } -if {[tk windowingsystem] ne "aqua"} { - bind Text { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } - } - bind Text { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } - } -} else { - bind Text { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } - } - bind Text { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } +bind Text { + if {!$tk_strictMotif} { + tk::TextScanMark %W %x %y + } +} +bind Text { + if {!$tk_strictMotif} { + tk::TextScanDrag %W %x %y } } set ::tk::Priv(prevPos) {} -# The MouseWheel will typically only fire on Windows and MacOS X. -# However, someone could use the "event generate" command to produce one -# on other platforms. We must be careful not to round -ve values of %D -# down to zero. - -if {[tk windowingsystem] eq "aqua"} { - bind Text { - %W yview scroll [expr {-15 * (%D)}] pixels - } - bind Text { - %W yview scroll [expr {-150 * (%D)}] pixels - } - bind Text { - %W xview scroll [expr {-15 * (%D)}] pixels - } - bind Text { - %W xview scroll [expr {-150 * (%D)}] pixels - } -} else { - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/3 = 0, - # but - # (int)-1/3 = -1 - # The following code ensure equal +/- behaviour. - bind Text { - if {%D >= 0} { - %W yview scroll [expr {-%D/3}] pixels - } else { - %W yview scroll [expr {(2-%D)/3}] pixels - } - } - bind Text { - if {%D >= 0} { - %W xview scroll [expr {-%D/3}] pixels - } else { - %W xview scroll [expr {(2-%D)/3}] pixels - } - } -} - -if {[tk windowingsystem] eq "x11"} { - # 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: - # http://linuxreviews.org/howtos/xfree/mouse/ - bind Text { - if {!$tk_strictMotif} { - %W yview scroll -50 pixels - } - } - bind Text { - if {!$tk_strictMotif} { - %W yview scroll 50 pixels - } - } - bind Text { - if {!$tk_strictMotif} { - %W xview scroll -50 pixels - } - } - bind Text { - if {!$tk_strictMotif} { - %W xview scroll 50 pixels - } - } - bind Text { - if {!$tk_strictMotif} { - %W xview scroll -50 pixels - } - } - bind Text { - if {!$tk_strictMotif} { - %W xview scroll 50 pixels - } - } +bind Text { + tk::MouseWheel y %D -3.0 pixels +} +bind Text { + tk::MouseWheel y %D -0.3 pixels +} +bind Text { + tk::MouseWheel x %D -3.0 pixels +} +bind Text { + tk::MouseWheel x %D -0.3 pixels } # ::tk::TextClosestGap -- # Given x and y coordinates, this procedure finds the closest boundary # between characters to the given coordinates and returns the index Index: library/tk.tcl ================================================================== --- library/tk.tcl +++ library/tk.tcl @@ -364,19 +364,20 @@ #---------------------------------------------------------------------- # Define the set of common virtual events. #---------------------------------------------------------------------- +event add <> +event add <> + switch -exact -- [tk windowingsystem] { "x11" { event add <> event add <> event add <> - event add <> event add <> event add <> - event add <> # On Darwin/Aqua, buttons from left to right are 1,3,2. On Darwin/X11 with recent # XQuartz as the X server, they are 1,2,3; other X servers may differ. event add <> event add <> @@ -420,14 +421,12 @@ } "win32" { event add <> event add <> event add <> - event add <> event add <> event add <> - event add <> event add <> event add <> event add <> event add <> @@ -453,13 +452,11 @@ } "aqua" { event add <> event add <> event add <> - event add <> event add <> - event add <> # Official bindings # See http://support.apple.com/kb/HT1343 event add <> event add <> @@ -534,10 +531,17 @@ variable ::tk::Priv after cancel $Priv(afterId) set Priv(afterId) {} } +## ::tk::MouseWheel $w $dir $amount $factor $units + +proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} { + $w ${dir}view scroll [expr {$amount/$factor}] $units +} + + # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. # It sends a <> virtual event to the previous focus window, # if any, before changing the focus, and a <> event # to the new focus window afterwards. Index: library/ttk/combobox.tcl ================================================================== --- library/ttk/combobox.tcl +++ library/ttk/combobox.tcl @@ -180,15 +180,19 @@ event generate $cb <> -when mark } ## Scroll -- Mousewheel binding # -proc ttk::combobox::Scroll {cb dir} { +proc ttk::combobox::Scroll {cb dir {factor 1.0}} { $cb instate disabled { return } set max [llength [$cb cget -values]] set current [$cb current] - incr current $dir + set d [expr {round($dir/factor)}] + if {$d == 0 && $dir != 0} { + if {$dir > 0} {set d 1} else {set d -1} + } + incr current $d if {$max != 0 && $current == $current % $max} { SelectEntry $cb $current } } Index: library/ttk/entry.tcl ================================================================== --- library/ttk/entry.tcl +++ library/ttk/entry.tcl @@ -80,24 +80,18 @@ bind TEntry <> { %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } } -## Button2 (Button3 on Aqua) bindings: +## Button2 bindings: # Used for scanning and primary transfer. -# Note: ButtonRelease-2 (ButtonRelease-3 on Aqua) +# Note: ButtonRelease-2 # is mapped to <> in tk.tcl. # -if {[tk windowingsystem] ne "aqua"} { - bind TEntry { ttk::entry::ScanMark %W %x } - bind TEntry { ttk::entry::ScanDrag %W %x } - bind TEntry { ttk::entry::ScanRelease %W %x } -} else { - bind TEntry { ttk::entry::ScanMark %W %x } - bind TEntry { ttk::entry::ScanDrag %W %x } - bind TEntry { ttk::entry::ScanRelease %W %x } -} +bind TEntry { ttk::entry::ScanMark %W %x } +bind TEntry { ttk::entry::ScanDrag %W %x } +bind TEntry { ttk::entry::ScanRelease %W %x } bind TEntry <> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: # bind TEntry <> { ttk::entry::Move %W prevchar } Index: library/ttk/scrollbar.tcl ================================================================== --- library/ttk/scrollbar.tcl +++ library/ttk/scrollbar.tcl @@ -17,25 +17,12 @@ bind TScrollbar { ttk::scrollbar::Drag %W %x %y } bind TScrollbar { ttk::scrollbar::Release %W %x %y } # Redirect scrollwheel bindings to the scrollbar widget # -# The shift-bindings scroll left/right (not up/down) -# if a widget has both possibilities -set eventList [list ] -switch [tk windowingsystem] { - aqua { - lappend eventList - } - x11 { - lappend eventList - } -} -foreach event $eventList { - bind TScrollbar $event [bind Scrollbar $event] -} -unset eventList event +bind TScrollbar [bind Scrollbar ] +bind TScrollbar [bind Scrollbar ] proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] if {$cmd ne ""} { uplevel #0 $cmd scroll $n $units Index: library/ttk/spinbox.tcl ================================================================== --- library/ttk/spinbox.tcl +++ library/ttk/spinbox.tcl @@ -80,15 +80,15 @@ ## MouseWheel -- # Mousewheel callback. Turn these into <> (-1, up) # or < (+1, down) events. # -proc ttk::spinbox::MouseWheel {w dir} { +proc ttk::spinbox::MouseWheel {w dir {factor 1}} { if {[$w instate disabled]} { return } - if {$dir < 0} { + if {($dir < 0) ^ ($factor < 0)} { event generate $w <> - } else { + } elseif {$dir > 0} { event generate $w <> } } ## SelectAll -- Index: library/ttk/utils.tcl ================================================================== --- library/ttk/utils.tcl +++ library/ttk/utils.tcl @@ -271,22 +271,10 @@ ### Mousewheel bindings. # # Platform inconsistencies: # -# On X11, the server typically maps the mouse wheel to Button4 and Button5. -# -# On OSX, Tk generates sensible values for the %D field in events. -# -# On Windows, %D must be scaled by a factor of 120. -# -# OSX conventionally uses Shift+MouseWheel for horizontal scrolling, -# and Option+MouseWheel for accelerated scrolling. -# -# The Shift+MouseWheel behavior is not conventional on Windows or most -# X11 toolkits, but it's useful. -# # MouseWheel scrolling is accelerated on X11, which is conventional # for Tk and appears to be conventional for other toolkits (although # Gtk+ and Qt do not appear to use as large a factor). # @@ -295,28 +283,12 @@ # $command will be passed one additional argument # specifying the mousewheel direction (-1: up, +1: down). # proc ttk::bindMouseWheel {bindtag callback} { - if {[tk windowingsystem] eq "x11"} { - bind $bindtag "$callback -1" - bind $bindtag "$callback +1" - } - if {[tk windowingsystem] eq "aqua"} { - bind $bindtag [append callback { [expr {-(%D)}]} ] - bind $bindtag [append callback { [expr {-10 *(%D)}]} ] - } else { - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/120 = 0, - # but - # (int)-1/120 = -1 - # The following code ensure equal +/- behaviour. - bind $bindtag [append callback { [ - expr {%D>=0 ? (-%D/120) : ((119-%D)/120)} - ]}] - } + bind $bindtag [append callback { %D -120.0}] + bind $bindtag [append callback { %D -12.0}] } ## Mousewheel bindings for standard scrollable widgets. # # Usage: [ttk::copyBindings TtkScrollable $bindtag] @@ -323,48 +295,15 @@ # # $bindtag should be for a widget that supports the # standard scrollbar protocol. # -if {[tk windowingsystem] eq "x11"} { - bind TtkScrollable { %W yview scroll -5 units } - bind TtkScrollable { %W yview scroll 5 units } - bind TtkScrollable { %W xview scroll -5 units } - bind TtkScrollable { %W xview scroll 5 units } -} -if {[tk windowingsystem] eq "aqua"} { - bind TtkScrollable { - %W yview scroll [expr {-(%D)}] units - } - bind TtkScrollable { - %W xview scroll [expr {-(%D)}] units - } - bind TtkScrollable { - %W yview scroll [expr {-10 * (%D)}] units - } - bind TtkScrollable { - %W xview scroll [expr {-10 * (%D)}] units - } -} else { - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/120 = 0, - # but - # (int)-1/120 = -1 - # The following code ensure equal +/- behaviour. - bind TtkScrollable { - if {%D >= 0} { - %W yview scroll [expr {-%D/120}] units - } else { - %W yview scroll [expr {(119-%D)/120}] units - } - } - bind TtkScrollable { - if {%D >= 0} { - %W xview scroll [expr {-%D/120}] units - } else { - %W xview scroll [expr {(119-%D)/120}] units - } - } -} +bind TtkScrollable \ + { tk::MouseWheel %W y %D } +bind TtkScrollable \ + { tk::MouseWheel %W y %D -12.0 } +bind TtkScrollable \ + { tk::MouseWheel %W x %D } +bind TtkScrollable \ + { tk::MouseWheel %W x %D -12.0 } #*EOF* Index: macosx/tkMacOSXMouseEvent.c ================================================================== --- macosx/tkMacOSXMouseEvent.c +++ macosx/tkMacOSXMouseEvent.c @@ -87,10 +87,13 @@ if (eventWindow) { inTitleBar = viewFrame.size.height < location.y; } button = [theEvent buttonNumber] + Button1; + if ((button & -2) == Button2) { + button ^= 1; /* Swap buttons 2/3 */ + } switch (eventType) { case NSRightMouseUp: case NSOtherMouseUp: buttonState &= ~Tk_GetButtonMask(button); break; @@ -303,11 +306,10 @@ #endif Tk_UpdatePointer(target, global.x, global.y, state); } else { CGFloat delta; - int coarseDelta; XEvent xEvent; /* * For scroll wheel events we need to send the XEvent here. */ @@ -319,25 +321,21 @@ xEvent.xbutton.y_root = global.y; xEvent.xany.send_event = false; xEvent.xany.display = Tk_Display(target); xEvent.xany.window = Tk_WindowId(target); - delta = [theEvent deltaY]; + delta = [theEvent deltaY] * 120; if (delta != 0.0) { - coarseDelta = (delta > -1.0 && delta < 1.0) ? - (signbit(delta) ? -1 : 1) : lround(delta); xEvent.xbutton.state = state; - xEvent.xkey.keycode = coarseDelta; + xEvent.xkey.keycode = (delta > 0) ? ceil(delta) : floor(delta); xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } - delta = [theEvent deltaX]; + delta = [theEvent deltaX] * 120; if (delta != 0.0) { - coarseDelta = (delta > -1.0 && delta < 1.0) ? - (signbit(delta) ? -1 : 1) : lround(delta); xEvent.xbutton.state = state | ShiftMask; - xEvent.xkey.keycode = coarseDelta; + xEvent.xkey.keycode = (delta > 0) ? ceil(delta) : floor(delta); xEvent.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin)); Tk_QueueWindowEvent(&xEvent, TCL_QUEUE_TAIL); } } return theEvent; @@ -403,12 +401,19 @@ /* * Tk on OSX supports at most 9 buttons. */ - state = (buttonState & 0x7F) * Button1Mask; - /* Handle buttons 8/9 */ + state = (buttonState & 0x079) * Button1Mask; + /* Handle swapped buttons 2/3 */ + if (buttonState & 0x02) { + state |= Button3Mask; + } + if (buttonState & 0x04) { + state |= Button2Mask; + } + /* Handle buttons 8/9 */ state |= (buttonState & 0x180) * (Button8Mask >> 7); if (keyModifiers & alphaLock) { state |= LockMask; } Index: tests/entry.test ================================================================== --- tests/entry.test +++ tests/entry.test @@ -1448,11 +1448,11 @@ .e insert end "runs off the end of the window quite a bit." update .e xview scroll gorp units } -cleanup { destroy .e -} -returnCodes error -result {expected integer but got "gorp"} +} -returnCodes error -result {expected floating-point number but got "gorp"} test entry-3.73 {EntryWidgetCmd procedure, "xview" widget command} -setup { entry .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e } -body { .e insert end "This is quite a long text string, so long that it " Index: tests/imgPhoto.test ================================================================== --- tests/imgPhoto.test +++ tests/imgPhoto.test @@ -1336,11 +1336,11 @@ photo1 data -format {default -colorformat list} } -result {{{255 0 0 170} {0 128 0 255}} {{0 0 255 204} {255 255 255 221}}} # This testcase fails with Tcl < 8.6.7, due to [25842c] test imgPhoto-4.118 {ImgPhotoCmd data: using data for new image results in same image as orignial } -constraints { - hasTeapotPhoto hasTranspTeapotPhoto needsTcl867 + hasTeapotPhoto hasTranspTeapotPhoto needsTcl867 } -setup { image create photo teapot -file $teapotPhotoFile teapot copy teapot -from 50 60 70 80 -shrink image create photo teapotTransp -file $transpTeapotPhotoFile teapotTransp copy teapotTransp -from 100 110 120 130 -shrink Index: tests/scrollbar.test ================================================================== --- tests/scrollbar.test +++ tests/scrollbar.test @@ -686,11 +686,11 @@ interp hide {} .s destroy .s list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1.1 { event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.1 { event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left @@ -700,26 +700,12 @@ after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s } -result {5.0} -test scrollbar-10.1.2 { event on scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -yscrollcommand {.s set}] -side left - for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} - pack [scrollbar .s -command {.t yview}] -fill y -expand 1 -side left - update - focus -force .s - event generate .s -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {5.0} - -test scrollbar-10.2.1 { event on horizontal scrollbar} -constraints {notAqua} -setup { + +test scrollbar-10.2 { event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top @@ -729,47 +715,19 @@ after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.2 { event on horizontal scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -xscrollcommand {.s set} -wrap none] -side top - for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} - pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top - update - focus -force .s - event generate .s -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {1.4} -test scrollbar-10.2.3 { event on horizontal scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2.3 { event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s event generate .s -delta -120 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {1.4} -test scrollbar-10.2.4 { event on horizontal scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -xscrollcommand {.s set} -wrap none] -side top - for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} - pack [scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top - update - focus -force .s - event generate .s -delta -4 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s } -result {1.4} Index: tests/spinbox.test ================================================================== --- tests/spinbox.test +++ tests/spinbox.test @@ -1786,11 +1786,11 @@ .e insert end "runs off the end of the window quite a bit." update .e xview scroll gorp units } -cleanup { destroy .e -} -returnCodes error -result {expected integer but got "gorp"} +} -returnCodes error -result {expected floating-point number but got "gorp"} test spinbox-3.73 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { spinbox .e -font {Courier -12} -borderwidth 2 -highlightthickness 2 pack .e } -body { .e insert end "This is quite a long text string, so long that it " Index: tests/textDisp.test ================================================================== --- tests/textDisp.test +++ tests/textDisp.test @@ -1900,11 +1900,11 @@ test textDisp-14.11 {TkTextXviewCmd procedure} { list [catch {.t xview scroll a b c} msg] $msg } {1 {wrong # args: should be ".t xview scroll number pages|pixels|units"}} test textDisp-14.12 {TkTextXviewCmd procedure} { list [catch {.t xview scroll gorp units} msg] $msg -} {1 {expected integer but got "gorp"}} +} {1 {expected floating-point number but got "gorp"}} test textDisp-14.13 {TkTextXviewCmd procedure} { .t delete 1.0 end .t insert end xxxxxxxxx\n .t insert end "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9\n" .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx" @@ -2119,15 +2119,15 @@ } {1 {wrong # args: should be ".t yview scroll number pages|pixels|units"}} test textDisp-16.20 {TkTextYviewCmd procedure, "scroll" option} { list [catch {.t yview scroll a b c} msg] $msg } {1 {wrong # args: should be ".t yview scroll number pages|pixels|units"}} test textDisp-16.21 {TkTextYviewCmd procedure, "scroll" option} { - list [catch {.t yview scroll badInt bogus} msg] $msg + list [catch {.t yview scroll bogus bogus} msg] $msg } {1 {bad argument "bogus": must be pages, pixels, or units}} test textDisp-16.21.2 {TkTextYviewCmd procedure, "scroll" option} { - list [catch {.t yview scroll badInt units} msg] $msg -} {1 {expected integer but got "badInt"}} + list [catch {.t yview scroll bogus units} msg] $msg +} {1 {expected floating-point number but got "bogus"}} test textDisp-16.22 {TkTextYviewCmd procedure, "scroll" option, back pages} { .t yview 50.0 updateText .t yview scroll -1 pages .t index @0,0 Index: tests/ttk/scrollbar.test ================================================================== --- tests/ttk/scrollbar.test +++ tests/ttk/scrollbar.test @@ -69,11 +69,11 @@ update set w [winfo width .tsb] ; set h [winfo height .tsb] expr {$h < $w} } -result 1 -test scrollbar-10.1.1 { event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.1.1 { event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left @@ -83,26 +83,12 @@ after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s } -result {5.0} -test scrollbar-10.1.2 { event on scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -yscrollcommand {.s set}] -side left - for {set i 1} {$i < 100} {incr i} {.t insert end "Line $i\n"} - pack [ttk::scrollbar .s -command {.t yview}] -fill y -expand 1 -side left - update - focus -force .s - event generate .s -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {5.0} - -test scrollbar-10.2.1 { event on horizontal scrollbar} -constraints {notAqua} -setup { + +test scrollbar-10.2.1 { event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top @@ -112,47 +98,19 @@ after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.2 { event on horizontal scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -xscrollcommand {.s set} -wrap none] -side top - for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} - pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top - update - focus -force .s - event generate .s -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {1.4} -test scrollbar-10.2.3 { event on horizontal scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2.2 { event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top update focus -force .s event generate .s -delta -120 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {1.4} -test scrollbar-10.2.4 { event on horizontal scrollbar} -constraints {aqua} -setup { - destroy .t .s -} -body { - pack [text .t -xscrollcommand {.s set} -wrap none] -side top - for {set i 1} {$i < 100} {incr i} {.t insert end "Char $i "} - pack [ttk::scrollbar .s -command {.t xview} -orient horizontal] -fill x -expand 1 -side top - update - focus -force .s - event generate .s -delta -4 after 200 {set eventprocessed 1} ; vwait eventprocessed .t index @0,0 } -cleanup { destroy .t .s } -result {1.4} Index: tests/util.test ================================================================== --- tests/util.test +++ tests/util.test @@ -32,11 +32,11 @@ test util-1.5 {Tk_GetScrollInfo procedure} -body { .l yview scroll a b c } -returnCodes error -result {wrong # args: should be ".l yview scroll number pages|units"} test util-1.6 {Tk_GetScrollInfo procedure} -body { .l yview scroll xyz units -} -returnCodes error -result {expected integer but got "xyz"} +} -returnCodes error -result {expected floating-point number but got "xyz"} test util-1.7 {Tk_GetScrollInfo procedure} -body { .l yview 0 .l yview scroll 2 pages .l nearest 0 } -result 6 Index: win/tkWinX.c ================================================================== --- win/tkWinX.c +++ win/tkWinX.c @@ -1744,15 +1744,15 @@ break; case Button3: msg = WM_RBUTTONDOWN; wparam = MK_RBUTTON; break; - case Button4: + case Button8: msg = WM_XBUTTONDOWN; wparam = MAKEWPARAM(MK_XBUTTON1, XBUTTON1); break; - case Button5: + case Button9: msg = WM_XBUTTONDOWN; wparam = MAKEWPARAM(MK_XBUTTON2, XBUTTON2); break; default: return 0;