Merge 8.7

12 files changed, 120 insertions, 60 deletions

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;