diff options
54 files changed, 634 insertions, 798 deletions
diff --git a/doc/GetScroll.3 b/doc/GetScroll.3 index 0df159b..91a2585 100644 --- a/doc/GetScroll.3 +++ b/doc/GetScroll.3 @@ -62,7 +62,8 @@ is returned as result and \fI*fractionPtr\fR is filled in with the 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. @@ -214,11 +214,7 @@ values should scroll up and negative values should scroll down. 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 diff --git a/doc/canvas.n b/doc/canvas.n index 1b43983..2367e2e 100644 --- a/doc/canvas.n +++ b/doc/canvas.n @@ -1147,7 +1147,8 @@ total width of the canvas is off-screen to the left. . 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 diff --git a/doc/entry.n b/doc/entry.n index 99ebbf4..23b8cab 100644 --- a/doc/entry.n +++ b/doc/entry.n @@ -403,7 +403,8 @@ way through the text appears at the left edge of the window. \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. diff --git a/doc/listbox.n b/doc/listbox.n index 9e4a459..02bd169 100644 --- a/doc/listbox.n +++ b/doc/listbox.n @@ -383,7 +383,8 @@ total width of the listbox text is off-screen to the left. . 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 diff --git a/doc/scrollbar.n b/doc/scrollbar.n index ba11f5c..4f808f4 100644 --- a/doc/scrollbar.n +++ b/doc/scrollbar.n @@ -223,7 +223,8 @@ 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 . @@ -232,7 +233,9 @@ 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 diff --git a/doc/spinbox.n b/doc/spinbox.n index 1f556ba..6c8801d 100644 --- a/doc/spinbox.n +++ b/doc/spinbox.n @@ -470,7 +470,8 @@ way through the text appears at the left edge of the window. \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 diff --git a/doc/sysnotify.n b/doc/sysnotify.n index 7a68998..b3f4fe4 100644 --- a/doc/sysnotify.n +++ b/doc/sysnotify.n @@ -23,10 +23,10 @@ Here is an example of the \fBtk sysnotify\fP code: .CE .SH PLATFORM NOTES .PP -The macOS and Windows versions are native implmentations using system -API's. The X11 version has a conditional dependency on libnotify, and -falls back to a Tcl-only implementation if libnotify is not installed. On -each platform the notification includes a platform-specific default to -accompany the text. +The macOS and Windows versions are native implmentations using system +API's. The X11 version has a conditional dependency on libnotify, and +falls back to a Tcl-only implementation if libnotify is not installed. On +each platform the notification includes a platform-specific default to +accompany the text. .SH KEYWORDS notify, alert
\ No newline at end of file diff --git a/doc/systray.n b/doc/systray.n index 00371cd..534f5bb 100644 --- a/doc/systray.n +++ b/doc/systray.n @@ -42,18 +42,18 @@ Here is an example of modifying the \fBtk systray\fP icon: tk systray modify callback {puts "Different output from the tk systray"} .CE .PP - The \fBtk systray\fP destroy command removes the icon from display and + The \fBtk systray\fP destroy command removes the icon from display and deallocates it. .PP -From a user-interface standpoint, only one icon per interpreter is -supported; attempts to create additional icons will return an error. The +From a user-interface standpoint, only one icon per interpreter is +supported; attempts to create additional icons will return an error. The existing tray icon can be modified with different images and -strings to indicate app state. Loading additional interpreters into a +strings to indicate app state. Loading additional interpreters into a running instance of Wish will allow additional icons to be displayed. .SH PLATFORM NOTES .PP -The X11 implementation is dependent on the window manager. The "text" -flag, which is implemented as a tooltip, does not always display if the WM -does not support such features. +The X11 implementation is dependent on the window manager. The "text" +flag, which is implemented as a tooltip, does not always display if the WM +does not support such features. .SH KEYWORDS image, callback @@ -113,14 +113,14 @@ accommodate the new scaling factor. .TP \fBtk sysnotify \fP \fItitle\fP? \fImessage\fP? . -The \fBtk sysnotify\fP command creates a platform-specific system -notification alert. Its intent is to provide a brief, unobtrusive -notification to the user by popping up a window that briefly appears in a +The \fBtk sysnotify\fP command creates a platform-specific system +notification alert. Its intent is to provide a brief, unobtrusive +notification to the user by popping up a window that briefly appears in a corner of the screen. For more details see the see the \fBsysnotify\fR manual page. .TP \fBtk systray create\fP \fIsubcommand...\fP . -The \fBtk systray\fP command creates an icon in the platform-specific +The \fBtk systray\fP command creates an icon in the platform-specific tray. For more details see the see the \fBsystray\fR manual page. .TP \fBtk useinputmethods \fR?\fB\-displayof \fIwindow\fR? ?\fIboolean\fR? diff --git a/doc/ttk_widget.n b/doc/ttk_widget.n index 17f1d88..7bab661 100644 --- a/doc/ttk_widget.n +++ b/doc/ttk_widget.n @@ -257,7 +257,8 @@ way through the content appears at the left edge of the window. \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 diff --git a/generic/tkBind.c b/generic/tkBind.c index 4ab98f5..3776c95 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -792,8 +792,10 @@ 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 @@ -4038,6 +4040,9 @@ HandleEventGenerate( return TCL_ERROR; } if (flags & BUTTON) { + if (number >= Button4) { + number += (Button8 - Button4); + } event.general.xbutton.button = number; } else { badOpt = 1; @@ -5189,15 +5194,15 @@ GetPatternObj( } 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; diff --git a/generic/tkEvent.c b/generic/tkEvent.c index 07ce8e7..ea7b282 100644 --- a/generic/tkEvent.c +++ b/generic/tkEvent.c @@ -515,7 +515,10 @@ RefreshKeyboardMappingIfNeeded( * * 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. @@ -527,8 +530,8 @@ RefreshKeyboardMappingIfNeeded( */ 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 @@ -1137,6 +1140,23 @@ Tk_HandleEvent( 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. */ diff --git a/generic/tkInt.h b/generic/tkInt.h index 10fa4e2..ac3667b 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -1011,6 +1011,11 @@ typedef struct TkpClipMask { #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 diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 6e96127..2454665 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -8787,6 +8787,7 @@ TextGetScrollInfoObj( 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) { @@ -8814,25 +8815,35 @@ TextGetScrollInfoObj( } 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; } - break; + *intPtr = (d > 0) ? ceil(d) : floor(d); + if (dblPtr) { + *dblPtr = d; + } + 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; } - break; + if (dblPtr) { + *dblPtr = (double)*intPtr; + } + 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; } - break; - default: - Tcl_Panic("unexpected switch fallthrough"); + *intPtr = (d > 0) ? ceil(d) : floor(d); + if (dblPtr) { + *dblPtr = d; + } + return TKTEXT_SCROLL_UNITS; } } + Tcl_Panic("unexpected switch fallthrough"); return TKTEXT_SCROLL_ERROR; } diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 0541830..9377cf2 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -664,6 +664,7 @@ Tk_GetScrollInfo( 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\"", @@ -671,9 +672,10 @@ Tk_GetScrollInfo( 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)) { @@ -744,13 +746,18 @@ Tk_GetScrollInfoObj( } 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")) { diff --git a/library/demos/cscroll.tcl b/library/demos/cscroll.tcl index f906c7d..d210c7d 100644 --- a/library/demos/cscroll.tcl +++ b/library/demos/cscroll.tcl @@ -56,29 +56,29 @@ for {set i 0} {$i < 20} {incr i} { $c bind all <Enter> "scrollEnter $c" $c bind all <Leave> "scrollLeave $c" $c bind all <Button-1> "scrollButton $c" -if {[tk windowingsystem] eq "aqua"} { +if {([tk windowingsystem] eq "aqua") && ![package vsatisfies [package provide Tk] 8.7-]} { bind $c <Button-3> "$c scan mark %x %y" bind $c <B3-Motion> "$c scan dragto %x %y" bind $c <MouseWheel> { - %W yview scroll [expr {-(%D)}] units + %W yview scroll [expr {-%D}] units } bind $c <Option-MouseWheel> { - %W yview scroll [expr {-10 * (%D)}] units + %W yview scroll [expr {-10*%D}] units } bind $c <Shift-MouseWheel> { - %W xview scroll [expr {-(%D)}] units + %W xview scroll [expr {-%D}] units } bind $c <Shift-Option-MouseWheel> { - %W xview scroll [expr {-10 * (%D)}] units + %W xview scroll [expr {-10*%D}] units } } else { bind $c <Button-2> "$c scan mark %x %y" bind $c <B2-Motion> "$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 <MouseWheel> { if {%D >= 0} { @@ -88,7 +88,11 @@ if {[tk windowingsystem] eq "aqua"} { } } bind $c <Option-MouseWheel> { - %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 <Shift-MouseWheel> { if {%D >= 0} { @@ -98,11 +102,15 @@ if {[tk windowingsystem] eq "aqua"} { } } bind $c <Shift-Option-MouseWheel> { - %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: @@ -127,18 +135,6 @@ if {[tk windowingsystem] eq "x11"} { %W xview scroll 5 units } } - if {[package vsatisfies [package provide Tk] 8.7]} { - bind $c <Button-6> { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind $c <Button-7> { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } - } } diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index 5acc82f..d3fec33 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -50,7 +50,7 @@ $c bind text <Return> "textInsert $c \\n" $c bind text <Control-h> "textBs $c" $c bind text <BackSpace> "textBs $c" $c bind text <Delete> "textDel $c" -if {[tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} { $c bind text <Button-3> "textPaste $c @%x,%y" } else { $c bind text <Button-2> "textPaste $c @%x,%y" diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 37e1b95..eb2ea7f 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -1359,7 +1359,7 @@ $c bind floor2 <Button-1> "floorDisplay $c 2" $c bind floor3 <Button-1> "floorDisplay $c 3" $c bind room <Enter> "newRoom $c" $c bind room <Leave> {set currentRoom ""} -if {[tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} { bind $c <Button-3> "$c scan mark %x %y" bind $c <B3-Motion> "$c scan dragto %x %y" } else { diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 545877c..1297046 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -173,7 +173,7 @@ $c create text 28.5c 17.4c -text Scale: -anchor s $c bind item <Enter> "itemEnter $c" $c bind item <Leave> "itemLeave $c" -if {[tk windowingsystem] eq "aqua"} { +if {[tk windowingsystem] eq "aqua" && ![package vsatisfies [package provide Tk] 8.7-]} { bind $c <Button-2> "itemMark $c %x %y" bind $c <B2-Motion> "itemStroke $c %x %y" bind $c <Button-3> "$c scan mark %x %y" diff --git a/library/entry.tcl b/library/entry.tcl index 6539af7..f95d6bd 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -293,28 +293,15 @@ bind Entry <<TkAccentBackspace>> { # A few additional bindings of my own. -if {[tk windowingsystem] ne "aqua"} { - bind Entry <Button-2> { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Entry <B2-Motion> { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } - } -} else { - bind Entry <Button-3> { - if {!$tk_strictMotif} { +bind Entry <Button-2> { + if {!$tk_strictMotif} { ::tk::EntryScanMark %W %x - } } - bind Entry <B3-Motion> { - if {!$tk_strictMotif} { +} +bind Entry <B2-Motion> { + if {!$tk_strictMotif} { ::tk::EntryScanDrag %W %x - } - } + } } # ::tk::EntryClosestGap -- diff --git a/library/iconlist.tcl b/library/iconlist.tcl index a19dbeb..c052efb 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -446,18 +446,9 @@ package require Tk bind $canvas <Control-B1-Motion> {;} bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}] - if {[tk windowingsystem] eq "aqua"} { - bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel [expr {40 * (%D)}]}] - bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel [expr {400 * (%D)}]}] - } else { - bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}] - } - if {[tk windowingsystem] eq "x11"} { - bind $canvas <Shift-Button-4> [namespace code {my MouseWheel 120}] - bind $canvas <Shift-Button-5> [namespace code {my MouseWheel -120}] - bind $canvas <Button-6> [namespace code {my MouseWheel 120}] - bind $canvas <Button-7> [namespace code {my MouseWheel -120}] - } + bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}] + bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel %D -12}] + bind $canvas <<PrevLine>> [namespace code {my UpDown -1}] bind $canvas <<NextLine>> [namespace code {my UpDown 1}] @@ -505,21 +496,11 @@ package require Tk # ---------------------------------------------------------------------- # 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 diff --git a/library/listbox.tcl b/library/listbox.tcl index bf40a39..ffedee6 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -176,81 +176,17 @@ bind Listbox <B2-Motion> { %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 <MouseWheel> { - %W yview scroll [expr {-(%D)}] units - } - bind Listbox <Option-MouseWheel> { - %W yview scroll [expr {-10 * (%D)}] units - } - bind Listbox <Shift-MouseWheel> { - %W xview scroll [expr {-(%D)}] units - } - bind Listbox <Shift-Option-MouseWheel> { - %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 <MouseWheel> { - if {%D >= 0} { - %W yview scroll [expr {-%D/30}] units - } else { - %W yview scroll [expr {(29-%D)/30}] units - } - } - bind Listbox <Shift-MouseWheel> { - if {%D >= 0} { - %W xview scroll [expr {-%D/30}] units - } else { - %W xview scroll [expr {(29-%D)/30}] units - } - } +bind Listbox <MouseWheel> { + tk::MouseWheel %W y %D -30.0 } - -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 <Button-4> { - if {!$tk_strictMotif} { - %W yview scroll -5 units - } - } - bind Listbox <Shift-Button-4> { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind Listbox <Button-5> { - if {!$tk_strictMotif} { - %W yview scroll 5 units - } - } - bind Listbox <Shift-Button-5> { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } - bind Listbox <Button-6> { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind Listbox <Button-7> { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } +bind Listbox <Option-MouseWheel> { + tk::MouseWheel %W y %D -3.0 +} +bind Listbox <Shift-MouseWheel> { + tk::MouseWheel %W x %D -30.0 +} +bind Listbox <Shift-Option-MouseWheel> { + tk::MouseWheel %W x %D -3.0 } # ::tk::ListboxBeginSelect -- diff --git a/library/scale.tcl b/library/scale.tcl index cc0de20..130c491 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -60,14 +60,6 @@ bind Scale <ButtonRelease-2> { 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 <Button-3> [bind Scale <Button-2>] - bind Scale <B3-Motion> [bind Scale <B2-Motion>] - bind Scale <B3-Leave> [bind Scale <B2-Leave>] - bind Scale <B3-Enter> [bind Scale <B2-Enter>] - bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>] -} bind Scale <Control-Button-1> { tk::ScaleControlPress %W %x %y } diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 8106b3d..f545785 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -129,34 +129,11 @@ bind Scrollbar <<LineEnd>> { } } -if {[tk windowingsystem] eq "aqua"} { - bind Scrollbar <MouseWheel> { - tk::ScrollByUnits %W hv [expr {-(%D)}] - } - bind Scrollbar <Option-MouseWheel> { - 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 <MouseWheel> { - if {%D >= 0} { - tk::ScrollByUnits %W hv [expr {-%D/30}] - } else { - tk::ScrollByUnits %W hv [expr {(29-%D)/30}] - } - } +bind Scrollbar <MouseWheel> { + tk::ScrollByUnits %W hv %D -30.0 } - -if {[tk windowingsystem] eq "x11"} { - bind Scrollbar <Button-4> {tk::ScrollByUnits %W hv -5} - bind Scrollbar <Button-5> {tk::ScrollByUnits %W hv 5} - bind Scrollbar <Button-6> {tk::ScrollByUnits %W hv -5} - bind Scrollbar <Button-7> {tk::ScrollByUnits %W hv 5} +bind Scrollbar <Option-MouseWheel> { + tk::ScrollByUnits %W hv %D -3.0 } # tk::ScrollButtonDown -- @@ -329,7 +306,7 @@ proc ::tk::ScrollEndDrag {w x y} { # 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)} { @@ -337,9 +314,9 @@ proc ::tk::ScrollByUnits {w orient amount} { } 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}]}] } } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 6ba7842..938e409 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -280,27 +280,14 @@ bind Spinbox <Meta-Delete> { # A few additional bindings of my own. -if {[tk windowingsystem] ne "aqua"} { - bind Spinbox <Button-2> { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Spinbox <B2-Motion> { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } - } -} else { - bind Spinbox <Button-3> { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } +bind Spinbox <Button-2> { + if {!$tk_strictMotif} { + ::tk::EntryScanMark %W %x } - bind Spinbox <B3-Motion> { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } +} +bind Spinbox <B2-Motion> { + if {!$tk_strictMotif} { + ::tk::EntryScanDrag %W %x } } diff --git a/library/systray.tcl b/library/systray.tcl index 8306194..fb21d2d 100644 --- a/library/systray.tcl +++ b/library/systray.tcl @@ -56,7 +56,7 @@ namespace eval ::winicoprops { } proc _win_callback {msg icn} { - + switch -exact -- $msg { WM_LBUTTONDOWN { eval $::winicoprops::cb1 @@ -168,7 +168,7 @@ proc ::tk::systray {args} { #Set variables for icon properties. global _iconlist - + #Remove the systray icon. if {[lindex $args 0] eq "destroy" && [llength $args] == 1} { @@ -199,11 +199,11 @@ proc ::tk::systray {args} { set _txt [lindex $args 2] set _cb_1 [lindex $args 3] set _cb_3 [lindex $args 4] - + set ::winicoprops::img $_img set ::winicoprops::txt $_txt set ::winicoprops::cb1 $_cb_1 - set ::winicoprops::cb3 $_cb_3 + set ::winicoprops::cb3 $_cb_3 switch -- [tk windowingsystem] { "win32" { if {[llength $_iconlist] > 0} { @@ -257,7 +257,7 @@ proc ::tk::systray {args} { set ::winicoprops::cb3 $_cb_3 _systray taskbar modify $::winicoprops::ico -callback [list _win_callback %m %i] } - + } "x11" { if {[lindex $args 1] eq "image"} { @@ -335,7 +335,7 @@ proc ::tk::sysnotify {title message} { } #Add these commands to the tk command ensemble: tk systray, tk sysnotify -#Thanks to Christian Gollwitzer for the guidance here +#Thanks to Christian Gollwitzer for the guidance here set map [namespace ensemble configure tk -map] dict set map systray ::tk::systray dict set map sysnotify ::tk::sysnotify diff --git a/library/tclIndex b/library/tclIndex index 919fa8a..06006cd 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -199,6 +199,7 @@ 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]] diff --git a/library/text.tcl b/library/text.tcl index a84ea05..00806f7 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -429,107 +429,29 @@ bind Text <Control-h> { %W see insert } } -if {[tk windowingsystem] ne "aqua"} { - bind Text <Button-2> { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } - } - bind Text <B2-Motion> { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } - } -} else { - bind Text <Button-3> { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } +bind Text <Button-2> { + if {!$tk_strictMotif} { + tk::TextScanMark %W %x %y } - bind Text <B3-Motion> { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } +} +bind Text <B2-Motion> { + 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 <MouseWheel> { - %W yview scroll [expr {-15 * (%D)}] pixels - } - bind Text <Option-MouseWheel> { - %W yview scroll [expr {-150 * (%D)}] pixels - } - bind Text <Shift-MouseWheel> { - %W xview scroll [expr {-15 * (%D)}] pixels - } - bind Text <Shift-Option-MouseWheel> { - %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 <MouseWheel> { - if {%D >= 0} { - %W yview scroll [expr {-%D/3}] pixels - } else { - %W yview scroll [expr {(2-%D)/3}] pixels - } - } - bind Text <Shift-MouseWheel> { - if {%D >= 0} { - %W xview scroll [expr {-%D/3}] pixels - } else { - %W xview scroll [expr {(2-%D)/3}] pixels - } - } +bind Text <MouseWheel> { + tk::MouseWheel y %D -3.0 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 <Button-4> { - if {!$tk_strictMotif} { - %W yview scroll -50 pixels - } - } - bind Text <Button-5> { - if {!$tk_strictMotif} { - %W yview scroll 50 pixels - } - } - bind Text <Shift-Button-4> { - if {!$tk_strictMotif} { - %W xview scroll -50 pixels - } - } - bind Text <Shift-Button-5> { - if {!$tk_strictMotif} { - %W xview scroll 50 pixels - } - } - bind Text <Button-6> { - if {!$tk_strictMotif} { - %W xview scroll -50 pixels - } - } - bind Text <Button-7> { - if {!$tk_strictMotif} { - %W xview scroll 50 pixels - } - } +bind Text <Option-MouseWheel> { + tk::MouseWheel y %D -0.3 pixels +} +bind Text <Shift-MouseWheel> { + tk::MouseWheel x %D -3.0 pixels +} +bind Text <Shift-Option-MouseWheel> { + tk::MouseWheel x %D -0.3 pixels } # ::tk::TextClosestGap -- diff --git a/library/tk.tcl b/library/tk.tcl index 07ca5be..9328820 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -366,15 +366,16 @@ if {![llength [info command tk_chooseDirectory]]} { # Define the set of common virtual events. #---------------------------------------------------------------------- +event add <<ContextMenu>> <Button-3> +event add <<PasteSelection>> <ButtonRelease-2> + switch -exact -- [tk windowingsystem] { "x11" { event add <<Cut>> <Control-x> <F20> <Control-Lock-X> event add <<Copy>> <Control-c> <F16> <Control-Lock-C> event add <<Paste>> <Control-v> <F18> <Control-Lock-V> - event add <<PasteSelection>> <ButtonRelease-2> event add <<Undo>> <Control-z> <Control-Lock-Z> event add <<Redo>> <Control-Z> <Control-Lock-z> - event add <<ContextMenu>> <Button-3> # 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. @@ -422,10 +423,8 @@ switch -exact -- [tk windowingsystem] { event add <<Cut>> <Control-x> <Shift-Delete> <Control-Lock-X> event add <<Copy>> <Control-c> <Control-Insert> <Control-Lock-C> event add <<Paste>> <Control-v> <Shift-Insert> <Control-Lock-V> - event add <<PasteSelection>> <ButtonRelease-2> event add <<Undo>> <Control-z> <Control-Lock-Z> event add <<Redo>> <Control-y> <Control-Lock-Y> - event add <<ContextMenu>> <Button-3> event add <<SelectAll>> <Control-slash> <Control-a> <Control-Lock-A> event add <<SelectNone>> <Control-backslash> @@ -455,9 +454,7 @@ switch -exact -- [tk windowingsystem] { event add <<Cut>> <Command-x> <F2> <Command-Lock-X> event add <<Copy>> <Command-c> <F3> <Command-Lock-C> event add <<Paste>> <Command-v> <F4> <Command-Lock-V> - event add <<PasteSelection>> <ButtonRelease-3> event add <<Clear>> <Clear> - event add <<ContextMenu>> <Button-2> # Official bindings # See http://support.apple.com/kb/HT1343 @@ -537,6 +534,13 @@ proc ::tk::CancelRepeat {} { 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 <<TraverseOut>> virtual event to the previous focus window, diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 0a7e519..58df760 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -182,11 +182,15 @@ proc ttk::combobox::SelectEntry {cb index} { ## 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 } diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 2f3c1a6..a4528fa 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -82,20 +82,14 @@ bind TEntry <<ToggleSelection>> { %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 <<PasteSelection>> in tk.tcl. # -if {[tk windowingsystem] ne "aqua"} { - bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } - bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } - bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } -} else { - bind TEntry <Button-3> { ttk::entry::ScanMark %W %x } - bind TEntry <B3-Motion> { ttk::entry::ScanDrag %W %x } - bind TEntry <ButtonRelease-3> { ttk::entry::ScanRelease %W %x } -} +bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } +bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } +bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index fdba265..8f6cf64 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -19,21 +19,8 @@ bind TScrollbar <ButtonRelease-2> { 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 <MouseWheel>] -switch [tk windowingsystem] { - aqua { - lappend eventList <Option-MouseWheel> - } - x11 { - lappend eventList <Button-4> <Button-5> <Button-6> <Button-7> - } -} -foreach event $eventList { - bind TScrollbar $event [bind Scrollbar $event] -} -unset eventList event +bind TScrollbar <MouseWheel> [bind Scrollbar <MouseWheel>] +bind TScrollbar <Option-MouseWheel> [bind Scrollbar <Option-MouseWheel>] 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 8aba5e1..f580a21 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -82,11 +82,11 @@ proc ttk::spinbox::Release {w} { # Mousewheel callback. Turn these into <<Increment>> (-1, up) # or <<Decrement> (+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 <<Increment>> - } else { + } elseif {$dir > 0} { event generate $w <<Decrement>> } } diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 79e6ce2..181c208 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -273,18 +273,6 @@ proc ttk::copyBindings {from to} { # # 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 <MouseWheel> 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). @@ -297,24 +285,8 @@ proc ttk::copyBindings {from to} { # proc ttk::bindMouseWheel {bindtag callback} { - if {[tk windowingsystem] eq "x11"} { - bind $bindtag <Button-4> "$callback -1" - bind $bindtag <Button-5> "$callback +1" - } - if {[tk windowingsystem] eq "aqua"} { - bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ] - bind $bindtag <Option-MouseWheel> [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 <MouseWheel> [append callback { [ - expr {%D>=0 ? (-%D/120) : ((119-%D)/120)} - ]}] - } + bind $bindtag <MouseWheel> [append callback { %D -120.0}] + bind $bindtag <Option-MouseWheel> [append callback { %D -12.0}] } ## Mousewheel bindings for standard scrollable widgets. @@ -325,46 +297,13 @@ proc ttk::bindMouseWheel {bindtag callback} { # standard scrollbar protocol. # -if {[tk windowingsystem] eq "x11"} { - bind TtkScrollable <Button-4> { %W yview scroll -5 units } - bind TtkScrollable <Button-5> { %W yview scroll 5 units } - bind TtkScrollable <Shift-Button-4> { %W xview scroll -5 units } - bind TtkScrollable <Shift-Button-5> { %W xview scroll 5 units } -} -if {[tk windowingsystem] eq "aqua"} { - bind TtkScrollable <MouseWheel> { - %W yview scroll [expr {-(%D)}] units - } - bind TtkScrollable <Shift-MouseWheel> { - %W xview scroll [expr {-(%D)}] units - } - bind TtkScrollable <Option-MouseWheel> { - %W yview scroll [expr {-10 * (%D)}] units - } - bind TtkScrollable <Shift-Option-MouseWheel> { - %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 <MouseWheel> { - if {%D >= 0} { - %W yview scroll [expr {-%D/120}] units - } else { - %W yview scroll [expr {(119-%D)/120}] units - } - } - bind TtkScrollable <Shift-MouseWheel> { - if {%D >= 0} { - %W xview scroll [expr {-%D/120}] units - } else { - %W xview scroll [expr {(119-%D)/120}] units - } - } -} +bind TtkScrollable <MouseWheel> \ + { tk::MouseWheel %W y %D } +bind TtkScrollable <Option-MouseWheel> \ + { tk::MouseWheel %W y %D -12.0 } +bind TtkScrollable <Shift-MouseWheel> \ + { tk::MouseWheel %W x %D } +bind TtkScrollable <Shift-Option-MouseWheel> \ + { tk::MouseWheel %W x %D -12.0 } #*EOF* diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index e753c29..243d33a 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -211,9 +211,15 @@ install-${PROJECT}: build-${PROJECT} ifeq (${EMBEDDED_BUILD}_${INSTALL_ROOT},1_) @echo "Cannot install-embedded with empty INSTALL_ROOT !" && false endif +ifeq (${SUBFRAMEWORK}_${DYLIB_INSTALL_DIR},1_) + @echo "Cannot install subframework with empty DYLIB_INSTALL_DIR !" && false +endif ifeq (${EMBEDDED_BUILD},1) @rm -rf "${INSTALL_ROOT}/${LIBDIR}/Tk.framework" endif +ifeq (${SUBFRAMEWORK},1) + @rm -rf "${INSTALL_ROOT}/Frameworks/Tk.framework" +endif ${DO_MAKE} ifeq (${EMBEDDED_BUILD}_${TK_X11},1_) # workaround bug with 'cp -pRH' on Darwin 6 and earlier @@ -228,8 +234,8 @@ ifeq (${EMBEDDED_BUILD},1) else # install wish symbolic link @ln -fs ${WISH} "${INSTALL_ROOT}${BINDIR}/${wish}" -endif -endif +endif # embedded +endif # install ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_) # keep copy of debug library around, so that # Deployment build can be installed on top @@ -237,8 +243,9 @@ ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_) # the debug library @cd "${INSTALL_ROOT}${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}" && \ ln -f "${PRODUCT_NAME}" "${PRODUCT_NAME}_debug" -endif +endif # Development, not embedded ifeq (${TK_X11},) +ifeq (${SUBFRAMEWORK},) ifeq (${EMBEDDED_BUILD},) # install Wish.app link in APPLICATION_INSTALL_PATH and setup 'Wish Shell' compatibility links @cd "${TOP_DIR}" && if [ -n "${APP_DIR}" ]; then mkdir -p "./${APP_DIR}" && rm -rf "./${APP_DIR}/Wish.app" && \ @@ -272,9 +279,15 @@ else fix_install_name MacOS/Wish Tcl && fix_install_name MacOS/Wish Tk ifeq (${INSTALL_BUILD},1) @cd "${TOP_DIR}" && rm -rf "./${FMWK_DIR}"/T{cl,k}.framework && rmdir -p "./${FMWK_DIR}" 2>&- || true -endif -endif -endif +endif # install +endif # embedded +else +# Clean up the destination directory if this is a subframework + @rm -rf ${INSTALL_ROOT}/Frameworks + @mv "${INSTALL_ROOT}/Library/Frameworks" "${INSTALL_ROOT}" + @rm -rf ${INSTALL_ROOT}/Library +endif # not subframework +endif # not X11 clean-${PROJECT}: %-${PROJECT}: ${DO_MAKE} diff --git a/macosx/README b/macosx/README index 1c603df..30f9a8f 100644 --- a/macosx/README +++ b/macosx/README @@ -459,6 +459,28 @@ make overrides to the tk/macosx GNUmakefile, e.g. TCL_FRAMEWORK_DIR=$HOME/Library/Frameworks TCLSH_DIR=$HOME/usr/bin The Makefile variables TCL_FRAMEWORK_DIR and TCLSH_DIR were added with Tk 8.4.3. +- To build a Tcl.framework and Tk.framework for use as subframeworks in another +framework, use the install-embedded target and set SUBFRAMEWORK=1. Set the +DYLIB_INSTALL_DIR variable to the path which should be the install_name path of +the shared library and set the DESTDIR variable to the pathname of a staging +directory where the frameworks will be written. Since the install_name is written +at compile time, this build requires starting with an empty build directory. +Also, the build will leave frameworks in the build directory that cannot be +installed in the standard /Library/Frameworks directory. To avoid surprises, +delete the build directory after the frameworks are built. +For example, running the commands: + rm -rf build + cd Tcl_src + make -C macosx install-embedded SUBFRAMEWORK=1 DESTDIR=/tmp/tcltk \ + DYLIB_INSTALL_DIR=/Library/Frameworks/Python.framework/Versions/3.9/Frameworks/Tcl + cd ../Tk_src + make -C macosx install-embedded SUBFRAMEWORK=1 DESTDIR=/tmp/tcltk \ + DYLIB_INSTALL_DIR=/Library/Frameworks/Python.framework/Versions/3.9/Frameworks/Tk + cd .. + rm -rf build +will produce a Tcl.framework and a Tk.framework usable as subframeworks of the +Python.framework. The frameworks will be found in /tmp/tcltk/Frameworks/ + 5. Details regarding the macOS port of Tk. ------------------------------------------- diff --git a/macosx/tkMacOSXHLEvents.c b/macosx/tkMacOSXHLEvents.c index 9439302..f405a53 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -69,6 +69,11 @@ static const char scriptTextProc[] = "::tk::mac::DoScriptText"; [self handleQuitApplicationEvent:Nil withReplyEvent:Nil]; } +- (void) superTerminate: (id) sender +{ + [super terminate:nil]; +} + - (void) preferences: (id) sender { (void)sender; @@ -591,9 +596,14 @@ ReallyKillMe( { Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp; int quit = Tcl_FindCommand(interp, "::tk::mac::Quit", NULL, 0)!=NULL; - int code = Tcl_EvalEx(interp, quit ? "::tk::mac::Quit" : "exit", -1, TCL_EVAL_GLOBAL); + if (!quit) { + Tcl_Exit(0); + } + + int code = Tcl_EvalEx(interp, "::tk::mac::Quit", -1, TCL_EVAL_GLOBAL); if (code != TCL_OK) { + /* * Should be never reached... */ diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c index f41cda7..11ebea1 100644 --- a/macosx/tkMacOSXInit.c +++ b/macosx/tkMacOSXInit.c @@ -113,6 +113,7 @@ static int TkMacOSXGetAppPathCmd(ClientData cd, Tcl_Interp *ip, /* * Initialize event processing. */ + TkMacOSXInitAppleEvents(_eventInterp); /* @@ -270,6 +271,80 @@ static int TkMacOSXGetAppPathCmd(ClientData cd, Tcl_Interp *ip, *---------------------------------------------------------------------- */ +/* + * Helper function which closes the shared NSFontPanel and NSColorPanel. + */ + +static void closePanels( + void) +{ + if ([NSFontPanel sharedFontPanelExists]) { + [[NSFontPanel sharedFontPanel] orderOut:nil]; + } + if ([NSColorPanel sharedColorPanelExists]) { + [[NSColorPanel sharedColorPanel] orderOut:nil]; + } +} + +/* + * This custom exit procedure is called by Tcl_Exit in place of the exit + * function from the C runtime. It calls the terminate method of the + * NSApplication class (superTerminate for a TKApplication). The purpose of + * doing this is to ensure that the NSFontPanel and the NSColorPanel are closed + * before the process exits, and that the application state is recorded + * correctly for all termination scenarios. + * + * TkpWantsExitProc tells Tcl_AppInit whether to install our custom exit proc, + * which terminates the process by calling [NSApplication terminate]. This + * does not work correctly if the process is part of an exec pipeline, so it is + * only done if the process was launched by the launcher or if both stdin and + * stdout are ttys. To disable using the custom exit proc altogether, undefine + * USE_CUSTOM_EXIT_PROC. + */ + +#if defined(USE_CUSTOM_EXIT_PROC) +static Bool doCleanupFromExit = NO; + +int TkpWantsExitProc(void) { + return doCleanupFromExit == YES; +} + +TCL_NORETURN void TkpExitProc( + void *clientdata) +{ + Bool doCleanup = doCleanupFromExit; + if (doCleanupFromExit) { + doCleanupFromExit = NO; /* prevent possible recursive call. */ + closePanels(); + } + + /* + * Tcl_Exit does not call Tcl_Finalize if there is an exit proc installed. + */ + + Tcl_Finalize(); + if (doCleanup == YES) { + [(TKApplication *)NSApp superTerminate:nil]; /* Should not return. */ + } + exit((long)clientdata); /* Convince the compiler that we don't return. */ +} +#endif + +/* + * This signal handler is installed for the SIGINT, SIGHUP and SIGTERM signals + * so that normal finalization occurs when a Tk app is killed by one of these + * signals (e.g when ^C is pressed while running Wish in the shell). It calls + * Tcl_Exit instead of the C runtime exit function called by the default handler. + * This is consistent with the Tcl_Exit manual page, which says that Tcl_Exit + * should always be called instead of exit. When Tk is killed by a signal we + * return exit status 1. + */ + +static void TkMacOSXSignalHandler(TCL_UNUSED(int)) { + + Tcl_Exit(1); +} + int TkpInit( Tcl_Interp *interp) @@ -298,6 +373,7 @@ TkpInit( initialized = 1; #ifdef TK_FRAMEWORK + /* * When Tk is in a framework, force tcl_findLibrary to look in the * framework scripts directory. @@ -382,6 +458,11 @@ TkpInit( Tcl_SetVar2(interp, "tcl_interactive", NULL, "1", TCL_GLOBAL_ONLY); } + +#if defined(USE_CUSTOM_EXIT_PROC) + doCleanupFromExit = YES; +#endif + shouldOpenConsole = YES; } if (shouldOpenConsole) { @@ -404,6 +485,9 @@ TkpInit( FILE *null = fopen("/dev/null", "w"); dup2(fileno(null), STDOUT_FILENO); dup2(fileno(null), STDERR_FILENO); +#if defined(USE_CUSTOM_EXIT_PROC) + doCleanupFromExit = YES; +#endif } /* @@ -439,6 +523,24 @@ TkpInit( break; } } + +# if defined(USE_CUSTOM_EXIT_PROC) + + if ((isatty(0) && isatty(1))) { + doCleanupFromExit = YES; + } + +# endif + + /* + * Install a signal handler for SIGINT, SIGHUP and SIGTERM which uses + * Tcl_Exit instead of exit so that normal cleanup takes place if a TK + * application is killed with one of these signals. + */ + + signal(SIGINT, TkMacOSXSignalHandler); + signal(SIGHUP, TkMacOSXSignalHandler); + signal(SIGTERM, TkMacOSXSignalHandler); } /* diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c index 359f164..83eef3d 100644 --- a/macosx/tkMacOSXMouseEvent.c +++ b/macosx/tkMacOSXMouseEvent.c @@ -89,6 +89,9 @@ enum { } button = [theEvent buttonNumber] + Button1; + if ((button & -2) == Button2) { + button ^= 1; /* Swap buttons 2/3 */ + } switch (eventType) { case NSRightMouseUp: case NSOtherMouseUp: @@ -305,7 +308,6 @@ enum { Tk_UpdatePointer(target, global.x, global.y, state); } else { CGFloat delta; - int coarseDelta; XEvent xEvent; /* @@ -321,21 +323,17 @@ enum { 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); } @@ -405,8 +403,15 @@ ButtonModifiers2State( * 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) { diff --git a/macosx/tkMacOSXPort.h b/macosx/tkMacOSXPort.h index 61c0d0d..d875873 100644 --- a/macosx/tkMacOSXPort.h +++ b/macosx/tkMacOSXPort.h @@ -157,4 +157,12 @@ MODULE_SCOPE void TkMacOSXHandleMapOrUnmap(Tk_Window tkwin, XEvent *event); #define TkpHandleMapOrUnmap(tkwin, event) TkMacOSXHandleMapOrUnmap(tkwin, event) +/* + * Used by tkAppInit + */ + +#define USE_CUSTOM_EXIT_PROC +EXTERN int TkpWantsExitProc(void); +EXTERN TCL_NORETURN void TkpExitProc(void *); + #endif /* _TKMACPORT */ diff --git a/macosx/tkMacOSXPrivate.h b/macosx/tkMacOSXPrivate.h index 23b7871..955b773 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -384,6 +384,7 @@ VISIBILITY_HIDDEN @end @interface TKApplication(TKHLEvents) - (void) terminate: (id) sender; +- (void) superTerminate: (id) sender; - (void) preferences: (id) sender; - (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event withReplyEvent: (NSAppleEventDescriptor *)replyEvent; diff --git a/macosx/tkMacOSXSysTray.c b/macosx/tkMacOSXSysTray.c index 1bb6a8c..919085f 100644 --- a/macosx/tkMacOSXSysTray.c +++ b/macosx/tkMacOSXSysTray.c @@ -1,8 +1,8 @@ /* * tkMacOSXSysTray.c -- * - * tkMacOSXSysTray.c implements a "systray" Tcl command which allows - * one to change the system tray/taskbar icon of a Tk toplevel + * tkMacOSXSysTray.c implements a "systray" Tcl command which allows + * one to change the system tray/taskbar icon of a Tk toplevel * window and a "sysnotify" command to post system notifications. * * Copyright (c) 2020 Kevin Walzer/WordTech Communications LLC. @@ -108,14 +108,14 @@ static const char ASSOC_KEY[] = "tk::tktray"; if (result != TCL_OK) { Tcl_BackgroundException(interp, result); } - } + } } } - (void) dealloc { /* * We are only doing the minimal amount of deallocation that - * the superclass cannot handle when it is deallocated, per + * the superclass cannot handle when it is deallocated, per * https://developer.apple.com/documentation/objectivec/nsobject/ * 1571947-dealloc. The compiler may offer warnings, but disregard. * Putting too much here can cause unpredictable crashes, especially @@ -170,15 +170,15 @@ static const char ASSOC_KEY[] = "tk::tktray"; tk_notification.soundName = NSUserNotificationDefaultSoundName; NSUserNotificationCenter *center = [NSUserNotificationCenter defaultUserNotificationCenter]; - + /* - * This API requires an app delegate to function correctly. - * The compiler may complain that setting TkNotificationItem is an + * This API requires an app delegate to function correctly. + * The compiler may complain that setting TkNotificationItem is an * incompatible type, but disregard. Setting to something else will * either cause Wish not to build, or the notification not to display. */ [center setDelegate: self]; - + [center deliverNotification:tk_notification]; } @@ -192,7 +192,7 @@ static const char ASSOC_KEY[] = "tk::tktray"; { /* * We are only doing the minimal amount of deallocation that - * the superclass cannot handle when it is deallocated, per + * the superclass cannot handle when it is deallocated, per * https://developer.apple.com/documentation/objectivec/nsobject/ * 1571947-dealloc. The compiler may offer warnings, but disregard. * Putting too much here can cause unpredictable crashes, especially @@ -382,7 +382,7 @@ MacSystrayObjCmd( } case TRAY_B3_CALLBACK: { [info->tk_item setB3Callback : objv[3]]; - break; + break; } } break; diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index c585fa2..30a2d57 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -1236,7 +1236,8 @@ static const char *const accentNames[] = { - (void) keyDown: (NSEvent *) theEvent { - (void)theEvent; + (void)theEvent; + #ifdef TK_MAC_DEBUG_EVENTS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent); #endif diff --git a/tests/entry.test b/tests/entry.test index 4a431f3..6fb16d0 100644 --- a/tests/entry.test +++ b/tests/entry.test @@ -1451,7 +1451,7 @@ test entry-3.72 {EntryWidgetCmd procedure, "xview" widget command} -setup { .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 diff --git a/tests/scrollbar.test b/tests/scrollbar.test index 6601099..4d38073 100644 --- a/tests/scrollbar.test +++ b/tests/scrollbar.test @@ -689,7 +689,7 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} { list [winfo children .] [interp hidden] } [list {} $l] -test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.1 {<MouseWheel> event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -703,22 +703,8 @@ test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} - } -cleanup { destroy .t .s } -result {5.0} -test scrollbar-10.1.2 {<MouseWheel> 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 <MouseWheel> -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 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2 {<MouseWheel> event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -732,21 +718,7 @@ test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constr } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.2 {<Shift-MouseWheel> 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 <Shift-MouseWheel> -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 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -760,20 +732,6 @@ test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.4 {<MouseWheel> 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 <MouseWheel> -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {1.4} test scrollbar-11.1 {bug fix: [011706ec42] Scrollbar unsafe wrt widget destruction} -body { proc destroy_scrollbar {} { diff --git a/tests/spinbox.test b/tests/spinbox.test index 3f6ac15..b51235a 100644 --- a/tests/spinbox.test +++ b/tests/spinbox.test @@ -1788,7 +1788,7 @@ test spinbox-3.72 {SpinboxWidgetCmd procedure, "xview" widget command} -setup { .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 diff --git a/tests/textDisp.test b/tests/textDisp.test index 69c53b2..3ec8e65 100644 --- a/tests/textDisp.test +++ b/tests/textDisp.test @@ -1903,7 +1903,7 @@ test textDisp-14.11 {TkTextXviewCmd procedure} { } {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 @@ -2122,11 +2122,11 @@ 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 diff --git a/tests/ttk/scrollbar.test b/tests/ttk/scrollbar.test index 3af03d5..75d11e7 100644 --- a/tests/ttk/scrollbar.test +++ b/tests/ttk/scrollbar.test @@ -71,7 +71,7 @@ test scrollbar-1.3 "Change orientation" -body { expr {$h < $w} } -result 1 -test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -setup { destroy .t .s } -body { pack [text .t -yscrollcommand {.s set}] -side left @@ -85,22 +85,8 @@ test scrollbar-10.1.1 {<MouseWheel> event on scrollbar} -constraints {notAqua} - } -cleanup { destroy .t .s } -result {5.0} -test scrollbar-10.1.2 {<MouseWheel> 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 <MouseWheel> -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 {<Shift-MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -114,21 +100,7 @@ test scrollbar-10.2.1 {<Shift-MouseWheel> event on horizontal scrollbar} -constr } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.2 {<Shift-MouseWheel> 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 <Shift-MouseWheel> -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 {<MouseWheel> event on horizontal scrollbar} -constraints {notAqua} -setup { +test scrollbar-10.2.2 {<MouseWheel> event on horizontal scrollbar} -setup { destroy .t .s } -body { pack [text .t -xscrollcommand {.s set} -wrap none] -side top @@ -142,20 +114,6 @@ test scrollbar-10.2.3 {<MouseWheel> event on horizontal scrollbar} -constraints } -cleanup { destroy .t .s } -result {1.4} -test scrollbar-10.2.4 {<MouseWheel> 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 <MouseWheel> -delta -4 - after 200 {set eventprocessed 1} ; vwait eventprocessed - .t index @0,0 -} -cleanup { - destroy .t .s -} -result {1.4} # # Scale tests: diff --git a/tests/util.test b/tests/util.test index ed4a276..45da8bb 100644 --- a/tests/util.test +++ b/tests/util.test @@ -34,7 +34,7 @@ test util-1.5 {Tk_GetScrollInfo procedure} -body { } -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 diff --git a/unix/install-sh b/unix/install-sh index 7c34c3f..21b733a 100755 --- a/unix/install-sh +++ b/unix/install-sh @@ -1,7 +1,7 @@ #!/bin/sh # install - install a program, script, or datafile -scriptversion=2011-04-20.01; # UTC +scriptversion=2020-07-26.22; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the @@ -35,25 +35,21 @@ scriptversion=2011-04-20.01; # UTC # FSF changes to this file are in the public domain. # # Calling this script install-sh is preferred over install.sh, to prevent -# `make' implicit rules from creating a file called install from it +# 'make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. +tab=' ' nl=' ' -IFS=" "" $nl" +IFS=" $tab$nl" -# set DOITPROG to echo to test this script +# Set DOITPROG to "echo" to test this script. -# Don't use :- since 4.3BSD and earlier shells don't like it. doit=${DOITPROG-} -if test -z "$doit"; then - doit_exec=exec -else - doit_exec=$doit -fi +doit_exec=${doit:-exec} # Put in absolute file names if you don't have them in your path; # or use environment vars. @@ -68,22 +64,15 @@ mvprog=${MVPROG-mv} rmprog=${RMPROG-rm} stripprog=${STRIPPROG-strip} -posix_glob='?' -initialize_posix_glob=' - test "$posix_glob" != "?" || { - if (set -f) 2>/dev/null; then - posix_glob= - else - posix_glob=: - fi - } -' - posix_mkdir= # Desired mode of installed file. mode=0755 +# Create dirs (including intermediate dirs) using mode 755. +# This is like GNU 'install' as of coreutils 8.32 (2020). +mkdir_umask=22 + chgrpcmd= chmodcmd=$chmodprog chowncmd= @@ -97,7 +86,7 @@ dir_arg= dst_arg= copy_on_change=false -no_target_directory= +is_target_a_directory=possibly usage="\ Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE @@ -120,7 +109,7 @@ Options: -m MODE $chmodprog installed files to MODE. -o USER $chownprog installed files to USER. -s $stripprog installed files. - -S $stripprog installed files. + -S OPTION $stripprog installed files using OPTION. -t DIRECTORY install into DIRECTORY. -T report an error if DSTFILE is a directory. @@ -138,45 +127,60 @@ while test $# -ne 0; do -d) dir_arg=true;; -g) chgrpcmd="$chgrpprog $2" - shift;; + shift;; --help) echo "$usage"; exit $?;; -m) mode=$2 - case $mode in - *' '* | *' '* | *' -'* | *'*'* | *'?'* | *'['*) - echo "$0: invalid mode: $mode" >&2 - exit 1;; - esac - shift;; + case $mode in + *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; -o) chowncmd="$chownprog $2" - shift;; + shift;; -s) stripcmd=$stripprog;; -S) stripcmd="$stripprog $2" - shift;; + shift;; - -t) dst_arg=$2 - shift;; + -t) + is_target_a_directory=always + dst_arg=$2 + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + shift;; - -T) no_target_directory=true;; + -T) is_target_a_directory=never;; --version) echo "$0 $scriptversion"; exit $?;; - --) shift - break;; + --) shift + break;; - -*) echo "$0: invalid option: $1" >&2 - exit 1;; + -*) echo "$0: invalid option: $1" >&2 + exit 1;; *) break;; esac shift done +# We allow the use of options -d and -T together, by making -d +# take the precedence; this is for compatibility with GNU install. + +if test -n "$dir_arg"; then + if test -n "$dst_arg"; then + echo "$0: target directory not allowed when installing a directory." >&2 + exit 1 + fi +fi + if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then # When -d is used, all remaining arguments are directories to create. # When -t is used, the destination is already specified. @@ -190,6 +194,10 @@ if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then fi shift # arg dst_arg=$arg + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac done fi @@ -198,12 +206,21 @@ if test $# -eq 0; then echo "$0: no input file specified." >&2 exit 1 fi - # It's OK to call `install-sh -d' without argument. + # It's OK to call 'install-sh -d' without argument. # This can happen when creating conditional directories. exit 0 fi if test -z "$dir_arg"; then + if test $# -gt 1 || test "$is_target_a_directory" = always; then + if test ! -d "$dst_arg"; then + echo "$0: $dst_arg: Is not a directory." >&2 + exit 1 + fi + fi +fi + +if test -z "$dir_arg"; then do_exit='(exit $ret); exit $ret' trap "ret=129; $do_exit" 1 trap "ret=130; $do_exit" 2 @@ -219,16 +236,16 @@ if test -z "$dir_arg"; then *[0-7]) if test -z "$stripcmd"; then - u_plus_rw= + u_plus_rw= else - u_plus_rw='% 200' + u_plus_rw='% 200' fi cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; *) if test -z "$stripcmd"; then - u_plus_rw= + u_plus_rw= else - u_plus_rw=,u+rw + u_plus_rw=,u+rw fi cp_umask=$mode$u_plus_rw;; esac @@ -236,9 +253,9 @@ fi for src do - # Protect names starting with `-'. + # Protect names problematic for 'test' and other utilities. case $src in - -*) src=./$src;; + -* | [=\(\)!]) src=./$src;; esac if test -n "$dir_arg"; then @@ -260,185 +277,150 @@ do echo "$0: no destination specified." >&2 exit 1 fi - dst=$dst_arg - # Protect names starting with `-'. - case $dst in - -*) dst=./$dst;; - esac - # If destination is a directory, append the input filename; won't work - # if double slashes aren't ignored. + # If destination is a directory, append the input filename. if test -d "$dst"; then - if test -n "$no_target_directory"; then - echo "$0: $dst_arg: Is a directory" >&2 - exit 1 + if test "$is_target_a_directory" = never; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 fi dstdir=$dst - dst=$dstdir/`basename "$src"` + dstbase=`basename "$src"` + case $dst in + */) dst=$dst$dstbase;; + *) dst=$dst/$dstbase;; + esac dstdir_status=0 else - # Prefer dirname, but fall back on a substitute if dirname fails. - dstdir=` - (dirname "$dst") 2>/dev/null || - expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$dst" : 'X\(//\)[^/]' \| \ - X"$dst" : 'X\(//\)$' \| \ - X"$dst" : 'X\(/\)' \| . 2>/dev/null || - echo X"$dst" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q' - ` - + dstdir=`dirname "$dst"` test -d "$dstdir" dstdir_status=$? fi fi + case $dstdir in + */) dstdirslash=$dstdir;; + *) dstdirslash=$dstdir/;; + esac + obsolete_mkdir_used=false if test $dstdir_status != 0; then case $posix_mkdir in '') - # Create intermediate dirs using mode 755 as modified by the umask. - # This is like FreeBSD 'install' as of 1997-10-28. - umask=`umask` - case $stripcmd.$umask in - # Optimize common cases. - *[2367][2367]) mkdir_umask=$umask;; - .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; - - *[0-7]) - mkdir_umask=`expr $umask + 22 \ - - $umask % 100 % 40 + $umask % 20 \ - - $umask % 10 % 4 + $umask % 2 - `;; - *) mkdir_umask=$umask,go-w;; - esac - - # With -d, create the new directory with the user-specified mode. - # Otherwise, rely on $mkdir_umask. - if test -n "$dir_arg"; then - mkdir_mode=-m$mode + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + # The $RANDOM variable is not portable (e.g., dash). Use it + # here however when possible just to lower collision chance. + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + + trap ' + ret=$? + rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null + exit $ret + ' 0 + + # Because "mkdir -p" follows existing symlinks and we likely work + # directly in world-writeable /tmp, make sure that the '$tmpdir' + # directory is successfully created first before we actually test + # 'mkdir -p'. + if (umask $mkdir_umask && + $mkdirprog $mkdir_mode "$tmpdir" && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + test_tmpdir="$tmpdir/a" + ls_ld_tmpdir=`ls -ld "$test_tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$test_tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" else - mkdir_mode= + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null fi - - posix_mkdir=false - case $umask in - *[123567][0-7][0-7]) - # POSIX mkdir -p sets u+wx bits regardless of umask, which - # is incompatible with FreeBSD 'install' when (umask & 300) != 0. - ;; - *) - tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ - trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 - - if (umask $mkdir_umask && - exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 - then - if test -z "$dir_arg" || { - # Check for POSIX incompatibilities with -m. - # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or - # other-writeable bit of parent directory when it shouldn't. - # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. - ls_ld_tmpdir=`ls -ld "$tmpdir"` - case $ls_ld_tmpdir in - d????-?r-*) different_mode=700;; - d????-?--*) different_mode=755;; - *) false;; - esac && - $mkdirprog -m$different_mode -p -- "$tmpdir" && { - ls_ld_tmpdir_1=`ls -ld "$tmpdir"` - test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" - } - } - then posix_mkdir=: - fi - rmdir "$tmpdir/d" "$tmpdir" - else - # Remove any dirs left behind by ancient mkdir implementations. - rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null - fi - trap '' 0;; - esac;; + trap '' 0;; esac if $posix_mkdir && ( - umask $mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" ) then : else - # The umask is ridiculous, or mkdir does not conform to POSIX, + # mkdir does not conform to POSIX, # or it failed possibly due to a race condition. Create the # directory the slow way, step by step, checking for races as we go. case $dstdir in - /*) prefix='/';; - -*) prefix='./';; - *) prefix='';; + /*) prefix='/';; + [-=\(\)!]*) prefix='./';; + *) prefix='';; esac - eval "$initialize_posix_glob" - oIFS=$IFS IFS=/ - $posix_glob set -f + set -f set fnord $dstdir shift - $posix_glob set +f + set +f IFS=$oIFS prefixes= for d do - test -z "$d" && continue - - prefix=$prefix$d - if test -d "$prefix"; then - prefixes= - else - if $posix_mkdir; then - (umask=$mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break - # Don't fail if two instances are running concurrently. - test -d "$prefix" || exit 1 - else - case $prefix in - *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; - *) qprefix=$prefix;; - esac - prefixes="$prefixes '$qprefix'" - fi - fi - prefix=$prefix/ + test X"$d" = X && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ done if test -n "$prefixes"; then - # Don't fail if two instances are running concurrently. - (umask $mkdir_umask && - eval "\$doit_exec \$mkdirprog $prefixes") || - test -d "$dstdir" || exit 1 - obsolete_mkdir_used=true + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true fi fi fi @@ -451,14 +433,25 @@ do else # Make a couple of temp file names in the proper directory. - dsttmp=$dstdir/_inst.$$_ - rmtmp=$dstdir/_rm.$$_ + dsttmp=${dstdirslash}_inst.$$_ + rmtmp=${dstdirslash}_rm.$$_ # Trap to clean up those temp files at exit. trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 # Copy the file name to the temp name. - (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + (umask $cp_umask && + { test -z "$stripcmd" || { + # Create $dsttmp read-write so that cp doesn't create it read-only, + # which would cause strip to fail. + if test -z "$doit"; then + : >"$dsttmp" # No need to fork-exec 'touch'. + else + $doit touch "$dsttmp" + fi + } + } && + $doit_exec $cpprog "$src" "$dsttmp") && # and set any options; do chmod last to preserve setuid bits. # @@ -473,15 +466,12 @@ do # If -C, don't bother to copy if it wouldn't change the file. if $copy_on_change && - old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && - new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && - - eval "$initialize_posix_glob" && - $posix_glob set -f && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + set -f && set X $old && old=:$2:$4:$5:$6 && set X $new && new=:$2:$4:$5:$6 && - $posix_glob set +f && - + set +f && test "$old" = "$new" && $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 then @@ -494,24 +484,24 @@ do # to itself, or perhaps because mv is so ancient that it does not # support -f. { - # Now remove or move aside any old file at destination location. - # We try this two ways since rm can't unlink itself on some - # systems and the destination file might be busy for other - # reasons. In this case, the final cleanup might fail but the new - # file should still install successfully. - { - test ! -f "$dst" || - $doit $rmcmd -f "$dst" 2>/dev/null || - { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && - { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } - } || - { echo "$0: cannot unlink or rename $dst" >&2 - (exit 1); exit 1 - } - } && - - # Now rename the file to the real destination. - $doit $mvcmd "$dsttmp" "$dst" + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" } fi || exit 1 @@ -520,9 +510,9 @@ do done # Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) +# eval: (add-hook 'before-save-hook 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" +# time-stamp-time-zone: "UTC0" # time-stamp-end: "; # UTC" -# End: +# End:
\ No newline at end of file diff --git a/unix/tkAppInit.c b/unix/tkAppInit.c index 9e6c112..db44bb7 100644 --- a/unix/tkAppInit.c +++ b/unix/tkAppInit.c @@ -15,6 +15,7 @@ #undef BUILD_tk #undef STATIC_BUILD #include "tk.h" +#include "tkPort.h" #ifdef TK_TEST #ifdef __cplusplus @@ -120,6 +121,13 @@ Tcl_AppInit( } Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit); +#if defined(USE_CUSTOM_EXIT_PROC) + if (TkpWantsExitProc()) { + /* The cast below avoids warnings from old gcc compilers. */ + Tcl_SetExitProc((void *)TkpExitProc); + } +#endif + #ifdef TK_TEST if (Tktest_Init(interp) == TCL_ERROR) { return TCL_ERROR; diff --git a/unix/tkUnixSysNotify.c b/unix/tkUnixSysNotify.c index bc64906..dbf802b 100755 --- a/unix/tkUnixSysNotify.c +++ b/unix/tkUnixSysNotify.c @@ -89,7 +89,7 @@ static int SysNotifyCmd( title = Tcl_GetString(objv[1]); message = Tcl_GetString(objv[2]); icon = "dialog-information"; - + notif = notify_notification_new(title, message, icon); notify_notification_show(notif, NULL); diff --git a/win/tkWinX.c b/win/tkWinX.c index f60823b..de1e0ee 100644 --- a/win/tkWinX.c +++ b/win/tkWinX.c @@ -1746,11 +1746,11 @@ TkWinResendEvent( 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; |