diff options
61 files changed, 762 insertions, 928 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 330e707..d224bd9 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/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 e5927f2..6935402 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -798,8 +798,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 @@ -4044,6 +4046,9 @@ HandleEventGenerate( return TCL_ERROR; } if (flags & BUTTON) { + if (number >= Button4) { + number += (Button8 - Button4); + } event.general.xbutton.button = number; } else { badOpt = 1; @@ -5195,15 +5200,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/tkMain.c b/generic/tkMain.c index eae10cf..2a445e2 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -403,7 +403,7 @@ Tk_MainEx( static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ - int mask) /* Not used. */ + TCL_UNUSED(int)) { char *cmd; int code; @@ -411,7 +411,6 @@ StdinProc( InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Interp *interp = isPtr->interp; - (void)mask; count = Tcl_Gets(chan, &isPtr->line); 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/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index a4dbf96..6d254e8 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -569,13 +569,15 @@ static void LabelCleanup(LabelElement *c) } static void LabelElementSize( - void *dummy, void *elementRecord, Tk_Window tkwin, - int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr) + TCL_UNUSED(void *), + void *elementRecord, + Tk_Window tkwin, + int *widthPtr, + int *heightPtr, + TCL_UNUSED(Ttk_Padding *)) { LabelElement *label = (LabelElement *)elementRecord; int textReqWidth = 0; - (void)dummy; - (void)paddingPtr; LabelSetup(label, tkwin, 0); @@ -628,12 +630,15 @@ static void DrawCompound( } static void LabelElementDraw( - void *dummy, void *elementRecord, Tk_Window tkwin, - Drawable d, Ttk_Box b, Ttk_State state) + TCL_UNUSED(void *), + void *elementRecord, + Tk_Window tkwin, + Drawable d, + Ttk_Box b, + Ttk_State state) { LabelElement *l = (LabelElement *)elementRecord; Tk_Anchor anchor = TK_ANCHOR_CENTER; - (void)dummy; LabelSetup(l, tkwin, state); diff --git a/generic/ttk/ttkProgress.c b/generic/ttk/ttkProgress.c index a025885..97109dc 100644 --- a/generic/ttk/ttkProgress.c +++ b/generic/ttk/ttkProgress.c @@ -208,10 +208,11 @@ static void VariableChanged(void *recordPtr, const char *value) * +++ Widget class methods: */ -static void ProgressbarInitialize(Tcl_Interp *dummy, void *recordPtr) +static void ProgressbarInitialize( + TCL_UNUSED(Tcl_Interp *), + void *recordPtr) { Progressbar *pb = (Progressbar *)recordPtr; - (void)dummy; pb->progress.variableTrace = 0; pb->progress.timer = 0; @@ -259,12 +260,12 @@ static int ProgressbarConfigure(Tcl_Interp *interp, void *recordPtr, int mask) * Post-configuration hook: */ static int ProgressbarPostConfigure( - Tcl_Interp *dummy, void *recordPtr, int mask) + TCL_UNUSED(Tcl_Interp *), + void *recordPtr, + TCL_UNUSED(int)) { Progressbar *pb = (Progressbar *)recordPtr; int status = TCL_OK; - (void)dummy; - (void)mask; if (pb->progress.variableTrace) { status = Ttk_FireTrace(pb->progress.variableTrace); @@ -497,21 +498,23 @@ static int ProgressbarStartStopCommand( } static int ProgressbarStartCommand( - void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { - (void)recordPtr; - return ProgressbarStartStopCommand( - interp, "::ttk::progressbar::start", objc, objv); + interp, "::ttk::progressbar::start", objc, objv); } static int ProgressbarStopCommand( - void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { - (void)recordPtr; - return ProgressbarStartStopCommand( - interp, "::ttk::progressbar::stop", objc, objv); + interp, "::ttk::progressbar::stop", objc, objv); } static const Ttk_Ensemble ProgressbarCommands[] = { diff --git a/generic/ttk/ttkScale.c b/generic/ttk/ttkScale.c index 9f27245..8c2999f 100644 --- a/generic/ttk/ttkScale.c +++ b/generic/ttk/ttkScale.c @@ -111,10 +111,11 @@ static void ScaleVariableChanged(void *recordPtr, const char *value) /* ScaleInitialize -- * Scale widget initialization hook. */ -static void ScaleInitialize(Tcl_Interp *dummy, void *recordPtr) +static void ScaleInitialize( + TCL_UNUSED(Tcl_Interp *), + void *recordPtr) { Scale *scalePtr = (Scale *)recordPtr; - (void)dummy; TtkTrackElementState(&scalePtr->core); } @@ -164,12 +165,12 @@ static int ScaleConfigure(Tcl_Interp *interp, void *recordPtr, int mask) * Post-configuration hook. */ static int ScalePostConfigure( - Tcl_Interp *dummy, void *recordPtr, int mask) + TCL_UNUSED(Tcl_Interp *), + void *recordPtr, + TCL_UNUSED(int)) { Scale *scale = (Scale *)recordPtr; int status = TCL_OK; - (void)dummy; - (void)mask; if (scale->scale.variableTrace) { status = Ttk_FireTrace(scale->scale.variableTrace); diff --git a/generic/ttk/ttkScrollbar.c b/generic/ttk/ttkScrollbar.c index 54923ff..4670832 100644 --- a/generic/ttk/ttkScrollbar.c +++ b/generic/ttk/ttkScrollbar.c @@ -50,10 +50,11 @@ static const Tk_OptionSpec ScrollbarOptionSpecs[] = */ static void -ScrollbarInitialize(Tcl_Interp *dummy, void *recordPtr) +ScrollbarInitialize( + TCL_UNUSED(Tcl_Interp *), + void *recordPtr) { Scrollbar *sb = (Scrollbar *)recordPtr; - (void)dummy; sb->scrollbar.first = 0.0; sb->scrollbar.last = 1.0; diff --git a/generic/ttk/ttkSquare.c b/generic/ttk/ttkSquare.c index 422afc3..ba5df57 100644 --- a/generic/ttk/ttkSquare.c +++ b/generic/ttk/ttkSquare.c @@ -198,12 +198,15 @@ static const Ttk_ElementOptionSpec SquareElementOptions[] = */ static void SquareElementSize( - void *dummy, void *elementRecord, Tk_Window tkwin, - int *widthPtr, int *heightPtr, Ttk_Padding *paddingPtr) + TCL_UNUSED(void *), + void *elementRecord, + Tk_Window tkwin, + int *widthPtr, + int *heightPtr, + Ttk_Padding *paddingPtr) { SquareElement *square = (SquareElement *)elementRecord; int borderWidth = 0; - (void)dummy; Tcl_GetIntFromObj(NULL, square->borderWidthObj, &borderWidth); *paddingPtr = Ttk_UniformPadding((short)borderWidth); @@ -216,14 +219,16 @@ static void SquareElementSize( */ static void SquareElementDraw( - void *dummy, void *elementRecord, Tk_Window tkwin, - Drawable d, Ttk_Box b, unsigned int state) + TCL_UNUSED(void *), + void *elementRecord, + Tk_Window tkwin, + Drawable d, + Ttk_Box b, + TCL_UNUSED(unsigned int)) { SquareElement *square = (SquareElement *)elementRecord; Tk_3DBorder foreground = NULL; int borderWidth = 1, relief = TK_RELIEF_FLAT; - (void)dummy; - (void)state; foreground = Tk_Get3DBorderFromObj(tkwin, square->foregroundObj); Tcl_GetIntFromObj(NULL, square->borderWidthObj, &borderWidth); diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c index d086c02..1019ffa 100644 --- a/generic/ttk/ttkTrace.c +++ b/generic/ttk/ttkTrace.c @@ -26,15 +26,13 @@ static char * VarTraceProc( ClientData clientData, /* Widget record pointer */ Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *name1, /* (unused) */ - const char *name2, /* (unused) */ + TCL_UNUSED(const char *), /* name1 */ + TCL_UNUSED(const char *), /* name2 */ int flags) /* Information about what happened. */ { Ttk_TraceHandle *tracePtr = (Ttk_TraceHandle *)clientData; const char *name, *value; Tcl_Obj *valuePtr; - (void)name1; - (void)name2; if (Tcl_InterpDeleted(interp)) { return NULL; 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/demos/tclIndex b/library/demos/tclIndex index 86a72e2..cdb2f2c 100644 --- a/library/demos/tclIndex +++ b/library/demos/tclIndex @@ -6,62 +6,62 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(arrowSetup) [list source [file join $dir arrow.tcl]] -set auto_index(arrowMove1) [list source [file join $dir arrow.tcl]] -set auto_index(arrowMove2) [list source [file join $dir arrow.tcl]] -set auto_index(arrowMove3) [list source [file join $dir arrow.tcl]] -set auto_index(textLoadFile) [list source [file join $dir search.tcl]] -set auto_index(textSearch) [list source [file join $dir search.tcl]] -set auto_index(textToggle) [list source [file join $dir search.tcl]] -set auto_index(itemEnter) [list source [file join $dir items.tcl]] -set auto_index(itemLeave) [list source [file join $dir items.tcl]] -set auto_index(itemMark) [list source [file join $dir items.tcl]] -set auto_index(itemStroke) [list source [file join $dir items.tcl]] -set auto_index(itemsUnderArea) [list source [file join $dir items.tcl]] -set auto_index(itemStartDrag) [list source [file join $dir items.tcl]] -set auto_index(itemDrag) [list source [file join $dir items.tcl]] -set auto_index(butPress) [list source [file join $dir items.tcl]] -set auto_index(loadDir) [list source [file join $dir image2.tcl]] -set auto_index(loadImage) [list source [file join $dir image2.tcl]] -set auto_index(rulerMkTab) [list source [file join $dir ruler.tcl]] -set auto_index(rulerNewTab) [list source [file join $dir ruler.tcl]] -set auto_index(rulerSelectTab) [list source [file join $dir ruler.tcl]] -set auto_index(rulerMoveTab) [list source [file join $dir ruler.tcl]] -set auto_index(rulerReleaseTab) [list source [file join $dir ruler.tcl]] -set auto_index(mkTextConfig) [list source [file join $dir ctext.tcl]] -set auto_index(textEnter) [list source [file join $dir ctext.tcl]] -set auto_index(textInsert) [list source [file join $dir ctext.tcl]] -set auto_index(textPaste) [list source [file join $dir ctext.tcl]] -set auto_index(textB1Press) [list source [file join $dir ctext.tcl]] -set auto_index(textB1Move) [list source [file join $dir ctext.tcl]] -set auto_index(textBs) [list source [file join $dir ctext.tcl]] -set auto_index(textDel) [list source [file join $dir ctext.tcl]] -set auto_index(bitmapRow) [list source [file join $dir bitmap.tcl]] -set auto_index(scrollEnter) [list source [file join $dir cscroll.tcl]] -set auto_index(scrollLeave) [list source [file join $dir cscroll.tcl]] -set auto_index(scrollButton) [list source [file join $dir cscroll.tcl]] -set auto_index(textWindOn) [list source [file join $dir twind.tcl]] -set auto_index(textWindOff) [list source [file join $dir twind.tcl]] -set auto_index(textWindPlot) [list source [file join $dir twind.tcl]] -set auto_index(embPlotDown) [list source [file join $dir twind.tcl]] -set auto_index(embPlotMove) [list source [file join $dir twind.tcl]] -set auto_index(textWindDel) [list source [file join $dir twind.tcl]] -set auto_index(embDefBg) [list source [file join $dir twind.tcl]] -set auto_index(floorDisplay) [list source [file join $dir floor.tcl]] -set auto_index(newRoom) [list source [file join $dir floor.tcl]] -set auto_index(roomChanged) [list source [file join $dir floor.tcl]] -set auto_index(bg1) [list source [file join $dir floor.tcl]] -set auto_index(bg2) [list source [file join $dir floor.tcl]] -set auto_index(bg3) [list source [file join $dir floor.tcl]] -set auto_index(fg1) [list source [file join $dir floor.tcl]] -set auto_index(fg2) [list source [file join $dir floor.tcl]] -set auto_index(fg3) [list source [file join $dir floor.tcl]] -set auto_index(setWidth) [list source [file join $dir hscale.tcl]] -set auto_index(plotDown) [list source [file join $dir plot.tcl]] -set auto_index(plotMove) [list source [file join $dir plot.tcl]] -set auto_index(puzzleSwitch) [list source [file join $dir puzzle.tcl]] -set auto_index(setHeight) [list source [file join $dir vscale.tcl]] -set auto_index(showMessageBox) [list source [file join $dir msgbox.tcl]] -set auto_index(setColor) [list source [file join $dir clrpick.tcl]] -set auto_index(setColor_helper) [list source [file join $dir clrpick.tcl]] -set auto_index(fileDialog) [list source [file join $dir filebox.tcl]] +set auto_index(arrowSetup) [list source -encoding utf-8 [file join $dir arrow.tcl]] +set auto_index(arrowMove1) [list source -encoding utf-8 [file join $dir arrow.tcl]] +set auto_index(arrowMove2) [list source -encoding utf-8 [file join $dir arrow.tcl]] +set auto_index(arrowMove3) [list source -encoding utf-8 [file join $dir arrow.tcl]] +set auto_index(textLoadFile) [list source -encoding utf-8 [file join $dir search.tcl]] +set auto_index(textSearch) [list source -encoding utf-8 [file join $dir search.tcl]] +set auto_index(textToggle) [list source -encoding utf-8 [file join $dir search.tcl]] +set auto_index(itemEnter) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(itemLeave) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(itemMark) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(itemStroke) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(itemsUnderArea) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(itemStartDrag) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(itemDrag) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(butPress) [list source -encoding utf-8 [file join $dir items.tcl]] +set auto_index(loadDir) [list source -encoding utf-8 [file join $dir image2.tcl]] +set auto_index(loadImage) [list source -encoding utf-8 [file join $dir image2.tcl]] +set auto_index(rulerMkTab) [list source -encoding utf-8 [file join $dir ruler.tcl]] +set auto_index(rulerNewTab) [list source -encoding utf-8 [file join $dir ruler.tcl]] +set auto_index(rulerSelectTab) [list source -encoding utf-8 [file join $dir ruler.tcl]] +set auto_index(rulerMoveTab) [list source -encoding utf-8 [file join $dir ruler.tcl]] +set auto_index(rulerReleaseTab) [list source -encoding utf-8 [file join $dir ruler.tcl]] +set auto_index(mkTextConfig) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textEnter) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textInsert) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textPaste) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textB1Press) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textB1Move) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textBs) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(textDel) [list source -encoding utf-8 [file join $dir ctext.tcl]] +set auto_index(bitmapRow) [list source -encoding utf-8 [file join $dir bitmap.tcl]] +set auto_index(scrollEnter) [list source -encoding utf-8 [file join $dir cscroll.tcl]] +set auto_index(scrollLeave) [list source -encoding utf-8 [file join $dir cscroll.tcl]] +set auto_index(scrollButton) [list source -encoding utf-8 [file join $dir cscroll.tcl]] +set auto_index(textWindOn) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(textWindOff) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(textWindPlot) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(embPlotDown) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(embPlotMove) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(textWindDel) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(embDefBg) [list source -encoding utf-8 [file join $dir twind.tcl]] +set auto_index(floorDisplay) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(newRoom) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(roomChanged) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(bg1) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(bg2) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(bg3) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(fg1) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(fg2) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(fg3) [list source -encoding utf-8 [file join $dir floor.tcl]] +set auto_index(setWidth) [list source -encoding utf-8 [file join $dir hscale.tcl]] +set auto_index(plotDown) [list source -encoding utf-8 [file join $dir plot.tcl]] +set auto_index(plotMove) [list source -encoding utf-8 [file join $dir plot.tcl]] +set auto_index(puzzleSwitch) [list source -encoding utf-8 [file join $dir puzzle.tcl]] +set auto_index(setHeight) [list source -encoding utf-8 [file join $dir vscale.tcl]] +set auto_index(showMessageBox) [list source -encoding utf-8 [file join $dir msgbox.tcl]] +set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tcl]] +set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]] +set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]] diff --git a/library/entry.tcl b/library/entry.tcl index 8acddf9..bdd9fcc 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 65b1b48..0dddebc 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 302d101..9038890 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 afa72ce..0da5472 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 99ce322..effae11 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 a067edd..3d479ef 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/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 d9cdfb5..e7c6827 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 849030b..eedbc66 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-/> <Control-a> <Control-Lock-A> event add <<SelectNone>> <Control-\\> @@ -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 @@ -536,6 +533,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 7d06688..8c89435 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 33936d9..f580a21 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -32,7 +32,7 @@ proc ttk::spinbox::Motion {w x y} { variable State ttk::saveCursor $w State(userConfCursor) [ttk::cursor text] if { [$w identify $x $y] eq "textarea" - && [$w instate {!readonly !disabled}] + && [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { @@ -46,16 +46,16 @@ proc ttk::spinbox::Press {w x y} { if {[$w instate disabled]} { return } focus $w switch -glob -- [$w identify $x $y] { - *textarea { ttk::entry::Press $w $x } + *textarea { ttk::entry::Press $w $x } *rightarrow - - *uparrow { ttk::Repeatedly event generate $w <<Increment>> } + *uparrow { ttk::Repeatedly event generate $w <<Increment>> } *leftarrow - - *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } + *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } *spinbutton { if {$y * 2 >= [winfo height $w]} { - set event <<Decrement>> + set event <<Decrement>> } else { - set event <<Increment>> + set event <<Increment>> } ttk::Repeatedly event generate $w $event } @@ -69,7 +69,7 @@ proc ttk::spinbox::DoubleClick {w x y} { if {[$w instate disabled]} { return } switch -glob -- [$w identify $x $y] { - *textarea { SelectAll $w } + *textarea { SelectAll $w } * { Press $w $x $y } } } @@ -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>> } } @@ -140,25 +140,26 @@ proc ttk::spinbox::Spin {w dir} { if {[$w instate disabled]} { return } if {![info exists State($w,values.length)]} { - set State($w,values.index) -1 - set State($w,values.last) {} + set State($w,values.index) -1 + set State($w,values.last) {} } set State($w,values) [$w cget -values] set State($w,values.length) [llength $State($w,values)] if {$State($w,values.length) > 0} { - set value [$w get] - set current $State($w,values.index) - if {$value ne $State($w,values.last)} { - set current [lsearch -exact $State($w,values) $value] - } - set State($w,values.index) [Adjust $w [expr {$current + $dir}] 0 \ - [expr {$State($w,values.length) - 1}]] - set State($w,values.last) [lindex $State($w,values) $State($w,values.index)] - $w set $State($w,values.last) + set value [$w get] + set current $State($w,values.index) + if {$value ne $State($w,values.last)} { + set current [lsearch -exact $State($w,values) $value] + if {$current < 0} {set current -1} + } + set State($w,values.index) [Adjust $w [expr {$current + $dir}] 0 \ + [expr {$State($w,values.length) - 1}]] + set State($w,values.last) [lindex $State($w,values) $State($w,values.index)] + $w set $State($w,values.last) } else { - if {[catch { - set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] + if {[catch { + set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] }]} { set v [$w cget -from] } @@ -176,7 +177,7 @@ proc ttk::spinbox::FormatValue {w val} { if {$fmt eq ""} { # Try to guess a suitable -format based on -increment. set delta [expr {abs([$w cget -increment])}] - if {0 < $delta && $delta < 1} { + if {0 < $delta && $delta < 1} { # NB: This guesses wrong if -increment has more than 1 # significant digit itself, e.g., -increment 0.25 set nsd [expr {int(ceil(-log10($delta)))}] 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..733ce8c 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -44,6 +44,18 @@ INSTALL_MANPAGES ?= # set to non-empty value to build TkX11 instead of TkAqua: TK_X11 ?= +# Checks and overrides for subframework builds +ifeq (${SUBFRAMEWORK}_${TK_X11},1_) +ifeq (${DYLIB_INSTALL_DIR},) + @echo "Cannot install subframework with empty DYLIB_INSTALL_DIR !" && false +endif +ifeq (${DESTDIR},) + @echo "Cannot install subframework with empty DESTDIR !" && false +endif +override BUILD_DIR = ${DESTDIR}/build +override INSTALL_PATH = /Frameworks +endif + #------------------------------------------------------------------------------------------------------- # meta targets @@ -211,9 +223,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 +246,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 +255,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" && \ @@ -271,10 +290,12 @@ else fix_install_id Frameworks/Tcl.framework/Tcl Tcl && fix_install_id Frameworks/Tk.framework/Tk Tk && \ fix_install_name MacOS/Wish Tcl && fix_install_name MacOS/Wish Tk ifeq (${INSTALL_BUILD},1) + echo removing frameworks @cd "${TOP_DIR}" && rm -rf "./${FMWK_DIR}"/T{cl,k}.framework && rmdir -p "./${FMWK_DIR}" 2>&- || true -endif -endif -endif +endif # install not subframework +endif # embedded +endif # not subframework +endif # not X11 clean-${PROJECT}: %-${PROJECT}: ${DO_MAKE} diff --git a/macosx/README b/macosx/README index 1c603df..ac641b1 100644 --- a/macosx/README +++ b/macosx/README @@ -459,6 +459,20 @@ 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. The Tcl framework must be +built first. +For example, running the commands: + make -C ../tcl8.6/macosx install-embedded SUBFRAMEWORK=1 DESTDIR=/tmp/tcltk \ + DYLIB_INSTALL_DIR=/Library/Frameworks/Some.framework/Versions/X.Y/Frameworks/Tcl.framework + make -C macosx install-embedded SUBFRAMEWORK=1 DESTDIR=/tmp/tcltk \ + DYLIB_INSTALL_DIR=/Library/Frameworks/Some.framework/Versions/X.Y/Frameworks/Tk.framework +will produce a Tcl.framework and a Tk.framework usable as subframeworks of +Some.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 4fe315e..f405a53 100644 --- a/macosx/tkMacOSXHLEvents.c +++ b/macosx/tkMacOSXHLEvents.c @@ -54,11 +54,11 @@ static void ProcessAppleEvent(ClientData clientData); * Names of the procedures which can be used to process AppleEvents. */ -static const char* openDocumentProc = "::tk::mac::OpenDocument"; -static const char* launchURLProc = "::tk::mac::LaunchURL"; -static const char* printDocProc = "::tk::mac::PrintDocument"; -static const char* scriptFileProc = "::tk::mac::DoScriptFile"; -static const char* scriptTextProc = "::tk::mac::DoScriptText"; +static const char openDocumentProc[] = "::tk::mac::OpenDocument"; +static const char launchURLProc[] = "::tk::mac::LaunchURL"; +static const char printDocProc[] = "::tk::mac::PrintDocument"; +static const char scriptFileProc[] = "::tk::mac::DoScriptFile"; +static const char scriptTextProc[] = "::tk::mac::DoScriptText"; #pragma mark TKApplication(TKHLEvents) @@ -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; @@ -338,10 +343,10 @@ static const char* scriptTextProc = "::tk::mac::DoScriptText"; typeUTF8Text, &type, data, actual, NULL)) { data[actual] = '\0'; - AppleEventInfo *AEInfo = (AppleEventInfo *)ckalloc(sizeof(AppleEventInfo)); - Tcl_DString *scriptTextCommand = &AEInfo->command; - Tcl_DStringInit(scriptTextCommand); - Tcl_DStringAppend(scriptTextCommand, scriptTextProc, -1); + AppleEventInfo *AEInfo = (AppleEventInfo *)ckalloc(sizeof(AppleEventInfo)); + Tcl_DString *scriptTextCommand = &AEInfo->command; + Tcl_DStringInit(scriptTextCommand); + Tcl_DStringAppend(scriptTextCommand, scriptTextProc, -1); Tcl_DStringAppendElement(scriptTextCommand, data); AEInfo->interp = _eventInterp; AEInfo->procedure = scriptTextProc; @@ -351,8 +356,8 @@ static const char* scriptTextProc = "::tk::mac::DoScriptText"; ProcessAppleEvent(AEInfo); } else { AEInfo->replyEvent = nil; - Tcl_DoWhenIdle(ProcessAppleEvent, (ClientData)AEInfo); - ProcessAppleEvent((ClientData)AEInfo); + Tcl_DoWhenIdle(ProcessAppleEvent, AEInfo); + ProcessAppleEvent(AEInfo); } } } @@ -477,11 +482,10 @@ static void ProcessAppleEvent( void TkMacOSXInitAppleEvents( - Tcl_Interp *dummy) /* not used */ + TCL_UNUSED(Tcl_Interp *)) { NSAppleEventManager *aeManager = [NSAppleEventManager sharedAppleEventManager]; static Boolean initialized = FALSE; - (void)dummy; if (!initialized) { initialized = TRUE; @@ -588,14 +592,18 @@ TkMacOSXDoHLEvent( static int ReallyKillMe( Tcl_Event *eventPtr, - int flags) + TCL_UNUSED(int)) { 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); - (void)flags; + 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 bda5f46..06ff367 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/tkMacOSXKeyboard.c b/macosx/tkMacOSXKeyboard.c index 236ebbc..60d1d0d 100644 --- a/macosx/tkMacOSXKeyboard.c +++ b/macosx/tkMacOSXKeyboard.c @@ -154,8 +154,6 @@ static int KeyDataToUnicode(UniChar *uniChars, int maxChars, (void)notification; #ifdef TK_MAC_DEBUG_NOTIFICATIONS TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); -#else - (void)notification; #endif keyboardChanged = YES; UpdateKeymaps(); 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 701c81f..8149860 100644 --- a/macosx/tkMacOSXPrivate.h +++ b/macosx/tkMacOSXPrivate.h @@ -382,6 +382,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/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c index f60eb75..30a2d57 100644 --- a/macosx/tkMacOSXWindowEvent.c +++ b/macosx/tkMacOSXWindowEvent.c @@ -970,14 +970,6 @@ ConfigureRestrictProc( TkWindow *winPtr = TkMacOSXGetTkWindow(w); Tk_Window tkwin = (Tk_Window)winPtr; - /* - * See ticket [1fa8c3ed8d]. This may not be needed for macOSX 11. - */ - - if(![NSApp isDrawing]) { - return; - } - if (![self inLiveResize] && [w respondsToSelector: @selector (tkLayoutChanged)]) { [(TKWindow *)w tkLayoutChanged]; @@ -1021,10 +1013,14 @@ ConfigureRestrictProc( TkMacOSXUpdateClipRgn(winPtr); /* - * Generate and process expose events to redraw the window. + * Generate and process expose events to redraw the window. To avoid + * crashes, only do this if we are being called from drawRect. See + * ticket [1fa8c3ed8d]. */ - [self generateExposeEvents: [self bounds]]; + if([NSApp isDrawing] || [self inLiveResize]) { + [self generateExposeEvents: [self bounds]]; + } /* * Finally, unlock the main autoreleasePool. @@ -1240,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/bind.test b/tests/bind.test index cad22b9..db25870 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -388,13 +388,13 @@ test bind-10.2 {Tk_GetBinding procedure} -body { test bind-11.1 {Tk_GetAllBindings procedure} -body { frame .t.f - foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <Key-<> <Meta-a> <\xC2>" { + foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <Key-<> <Meta-a> <Â>" { bind .t.f $i Test } lsort [bind .t.f] } -cleanup { destroy .t.f -} -result "! <<Paste>> <Key-<> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-space> <Key-\xC2> <Meta-Key-a> a \\\{ ~" +} -result "! <<Paste>> <Key-<> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-space> <Key-Â> <Meta-Key-a> a \\\{ ~" test bind-11.2 {Tk_GetAllBindings procedure} -body { frame .t.f foreach i "<Double-Button-1> <Triple-Button-1> <Meta-Control-a> <Double-Alt-Enter> <Button-1>" { @@ -2052,7 +2052,7 @@ test bind-16.35 {ExpandPercents procedure} -constraints { set x } -cleanup { destroy .t.f -} -result {a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \xE9} +} -result {a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} é} test bind-16.36 {ExpandPercents procedure} -setup { frame .t.f -class Test -width 150 -height 100 pack .t.f diff --git a/tests/entry.test b/tests/entry.test index 7761590..cb6dda4 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/main.test b/tests/main.test index 19bbf5a..ef97338 100644 --- a/tests/main.test +++ b/tests/main.test @@ -5,7 +5,7 @@ # generates output for errors. No output means no errors were found. # # Copyright © 1997 by Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.2 diff --git a/tests/scrollbar.test b/tests/scrollbar.test index b08f310..e366c40 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/select.test b/tests/select.test index e6b9523..b1d5d56 100644 --- a/tests/select.test +++ b/tests/select.test @@ -896,7 +896,7 @@ test select-9.1 {SelCvtToX and SelCvtFromX procedures} -setup { test select-9.2 {SelCvtToX and SelCvtFromX procedures} -setup { setup setupbg -} -constraints x11 -body { +} -constraints {x11 failsOnUbuntu} -body { set selValue "1024 0xffff 2048 -2 " set selInfo "" selection handle -selection PRIMARY -format INTEGER -type TEST \ @@ -1022,7 +1022,7 @@ test select-10.4 {ConvertSelection procedure} -constraints { lappend result $selInfo } -result {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}} test select-10.5 {ConvertSelection procedure, reentrancy issues} -constraints { - x11 + x11 failsOnUbuntu } -setup { setup setupbg @@ -1060,7 +1060,7 @@ test select-10.6 {ConvertSelection procedure, reentrancy issues} -constraints { ############################################################################## # testing reentrancy -test select-11.1 {TkSelPropProc procedure} -constraints x11 -setup { +test select-11.1 {TkSelPropProc procedure} -constraints {x11 failsOnUbuntu} -setup { setup setupbg } -body { @@ -1132,7 +1132,7 @@ test select-12.6 {DefaultSelection procedure} -body { } -result {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} test select-13.1 {SelectionSize procedure, handler deleted} -constraints { - x11 + x11 failsOnUbuntu } -setup { setup setupbg diff --git a/tests/spinbox.test b/tests/spinbox.test index ff98f53..9267360 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 669fde6..c1cae00 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 2fc2437..d88ee57 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 100644 --- 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/win/rules.vc b/win/rules.vc index 61df910..f3e5439 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -415,9 +415,6 @@ _INSTALLDIR=$(_INSTALLDIR)\lib # NATIVE_ARCH - set to IX86 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed
-# CFG_ENCODING - set to an character encoding.
-# TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
-# see where it is used
cc32 = $(CC) # built-in default.
link32 = link
@@ -503,10 +500,6 @@ _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -ou _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
!endif
-!ifndef CFG_ENCODING
-CFG_ENCODING = \"cp1252\"
-!endif
-
################################################################
# 4. Build the nmakehlp program
# This is a helper app we need to overcome nmake's limiting
@@ -1292,7 +1285,7 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include # baselibs - minimum Windows libraries required. Parent makefile can
# define PRJ_LIBS before including rules.rc if additional libs are needed
-OPTDEFINES = /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS
+OPTDEFINES = /DSTDC_HEADERS
!if $(VCVERSION) >= 1600
OPTDEFINES = $(OPTDEFINES) /DHAVE_STDINT_H=1
!else
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; |