summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-10-23 08:28:46 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-10-23 08:28:46 (GMT)
commitdf9e8c6911d5e9a6e00e8e9c09d145e609b8db74 (patch)
tree87b8f74d1c58d6616569725e34cdadbea6eaf0ae
parent5a7aa650e450b240ab33b7d9f74e08c60854a64c (diff)
parent5164db768ac805564630f25daae0357dad688b0c (diff)
downloadtk-df9e8c6911d5e9a6e00e8e9c09d145e609b8db74.zip
tk-df9e8c6911d5e9a6e00e8e9c09d145e609b8db74.tar.gz
tk-df9e8c6911d5e9a6e00e8e9c09d145e609b8db74.tar.bz2
Merge 8.7
-rw-r--r--doc/GetScroll.33
-rw-r--r--doc/bind.n6
-rw-r--r--doc/canvas.n3
-rw-r--r--doc/entry.n3
-rw-r--r--doc/listbox.n3
-rw-r--r--doc/scrollbar.n7
-rw-r--r--doc/spinbox.n3
-rw-r--r--doc/ttk_widget.n3
-rw-r--r--generic/tkBind.c13
-rw-r--r--generic/tkEvent.c26
-rw-r--r--generic/tkInt.h5
-rw-r--r--generic/tkMain.c3
-rw-r--r--generic/tkTextDisp.c33
-rw-r--r--generic/tkUtil.c11
-rw-r--r--generic/ttk/ttkLabel.c19
-rw-r--r--generic/ttk/ttkProgress.c29
-rw-r--r--generic/ttk/ttkScale.c11
-rw-r--r--generic/ttk/ttkScrollbar.c5
-rw-r--r--generic/ttk/ttkSquare.c19
-rw-r--r--generic/ttk/ttkTrace.c6
-rw-r--r--library/bgerror.tcl8
-rw-r--r--library/button.tcl6
-rw-r--r--library/choosedir.tcl2
-rw-r--r--library/clrpick.tcl2
-rw-r--r--library/comdlg.tcl2
-rw-r--r--library/console.tcl6
-rw-r--r--library/demos/bind.tcl12
-rw-r--r--library/demos/cscroll.tcl40
-rw-r--r--library/demos/ctext.tcl2
-rw-r--r--library/demos/floor.tcl2
-rw-r--r--library/demos/goldberg.tcl8
-rw-r--r--library/demos/items.tcl2
-rw-r--r--library/demos/knightstour.tcl6
-rw-r--r--library/demos/pendulum.tcl4
-rw-r--r--library/demos/tclIndex118
-rw-r--r--library/demos/toolbar.tcl2
-rw-r--r--library/demos/ttkbut.tcl2
-rw-r--r--library/demos/ttkprogress.tcl2
-rw-r--r--library/demos/unicodeout.tcl50
-rw-r--r--library/demos/widget8
-rw-r--r--library/dialog.tcl4
-rw-r--r--library/entry.tcl29
-rw-r--r--library/focus.tcl2
-rw-r--r--library/iconlist.tcl33
-rw-r--r--library/icons.tcl2
-rw-r--r--library/listbox.tcl90
-rw-r--r--library/megawidget.tcl2
-rw-r--r--library/menu.tcl8
-rw-r--r--library/msgbox.tcl2
-rw-r--r--library/obsolete.tcl4
-rw-r--r--library/optMenu.tcl4
-rw-r--r--library/palette.tcl2
-rw-r--r--library/safetk.tcl2
-rw-r--r--library/scale.tcl12
-rw-r--r--library/scrlbar.tcl41
-rw-r--r--library/spinbox.tcl35
-rw-r--r--library/tclIndex1
-rw-r--r--library/tearoff.tcl4
-rw-r--r--library/text.tcl118
-rw-r--r--library/tk.tcl22
-rw-r--r--library/tkfbox.tcl2
-rw-r--r--library/ttk/combobox.tcl8
-rw-r--r--library/ttk/entry.tcl22
-rw-r--r--library/ttk/scrollbar.tcl17
-rw-r--r--library/ttk/spinbox.tcl48
-rw-r--r--library/ttk/utils.tcl81
-rw-r--r--library/xmfbox.tcl4
-rw-r--r--macosx/GNUmakefile32
-rw-r--r--macosx/README14
-rw-r--r--macosx/tkMacOSXDialog.c24
-rw-r--r--macosx/tkMacOSXHLEvents.c40
-rw-r--r--macosx/tkMacOSXInit.c102
-rw-r--r--macosx/tkMacOSXKeyboard.c2
-rw-r--r--macosx/tkMacOSXMouseEvent.c27
-rw-r--r--macosx/tkMacOSXPort.h8
-rw-r--r--macosx/tkMacOSXPrivate.h1
-rw-r--r--macosx/tkMacOSXWindowEvent.c3
-rw-r--r--tests/bell.test4
-rw-r--r--tests/bgerror.test4
-rw-r--r--tests/bind.test6
-rw-r--r--tests/bitmap.test4
-rw-r--r--tests/border.test4
-rw-r--r--tests/busy.test2
-rw-r--r--tests/button.test6
-rw-r--r--tests/canvImg.test6
-rw-r--r--tests/canvMoveto.test6
-rw-r--r--tests/canvPs.test4
-rw-r--r--tests/canvRect.test4
-rw-r--r--tests/canvText.test4
-rw-r--r--tests/canvWind.test4
-rw-r--r--tests/canvas.test6
-rw-r--r--tests/choosedir.test4
-rw-r--r--tests/clipboard.test4
-rw-r--r--tests/clrpick.test4
-rw-r--r--tests/cmds.test4
-rw-r--r--tests/color.test4
-rw-r--r--tests/config.test4
-rw-r--r--tests/cursor.test4
-rw-r--r--tests/embed.test4
-rw-r--r--tests/entry.test26
-rw-r--r--tests/event.test6
-rw-r--r--tests/filebox.test4
-rw-r--r--tests/focus.test4
-rw-r--r--tests/focusTcl.test4
-rw-r--r--tests/font.test10
-rw-r--r--tests/fontchooser.test6
-rw-r--r--tests/frame.test6
-rw-r--r--tests/geometry.test6
-rw-r--r--tests/get.test4
-rw-r--r--tests/grab.test2
-rw-r--r--tests/grid.test4
-rw-r--r--tests/image.test6
-rw-r--r--tests/imgBmap.test6
-rw-r--r--tests/imgListFormat.test2
-rw-r--r--tests/imgPNG.test8
-rw-r--r--tests/imgPPM.test4
-rw-r--r--tests/imgPhoto.test8
-rw-r--r--tests/imgSVGnano.test2
-rw-r--r--tests/listbox.test6
-rw-r--r--tests/main.test11
-rw-r--r--tests/menu.test4
-rw-r--r--tests/menuDraw.test4
-rw-r--r--tests/menubut.test6
-rw-r--r--tests/message.test6
-rw-r--r--tests/msgbox.test4
-rw-r--r--tests/obj.test4
-rw-r--r--tests/oldpack.test6
-rw-r--r--tests/option.test8
-rw-r--r--tests/pack.test6
-rw-r--r--tests/packgrid.test2
-rw-r--r--tests/panedwindow.test6
-rw-r--r--tests/pkgconfig.test8
-rw-r--r--tests/place.test4
-rw-r--r--tests/raise.test6
-rw-r--r--tests/safe.test6
-rw-r--r--tests/safePrimarySelection.test6
-rw-r--r--tests/scale.test6
-rw-r--r--tests/scrollbar.test54
-rw-r--r--tests/select.test6
-rw-r--r--tests/send.test8
-rw-r--r--tests/spinbox.test26
-rw-r--r--tests/text.test30
-rw-r--r--tests/textBTree.test6
-rw-r--r--tests/textDisp.test14
-rw-r--r--tests/textImage.test2
-rw-r--r--tests/textIndex.test36
-rw-r--r--tests/textMark.test6
-rw-r--r--tests/textTag.test6
-rw-r--r--tests/textWind.test6
-rw-r--r--tests/tk.test6
-rw-r--r--tests/ttk/entry.test2
-rw-r--r--tests/ttk/scrollbar.test48
-rw-r--r--tests/unixButton.test6
-rw-r--r--tests/unixEmbed.test4
-rw-r--r--tests/unixFont.test6
-rw-r--r--tests/unixMenu.test4
-rw-r--r--tests/unixSelect.test68
-rw-r--r--tests/unixWm.test6
-rw-r--r--tests/util.test8
-rw-r--r--tests/visual.test6
-rw-r--r--tests/winButton.test6
-rw-r--r--tests/winClipboard.test13
-rwxr-xr-xtests/winDialog.test20
-rw-r--r--tests/winFont.test4
-rw-r--r--tests/winMenu.test4
-rw-r--r--tests/winMsgbox.test12
-rw-r--r--tests/winSend.test6
-rw-r--r--tests/winWm.test4
-rw-r--r--tests/window.test4
-rw-r--r--tests/winfo.test6
-rw-r--r--tests/wm.test6
-rw-r--r--tests/xmfbox.test4
-rwxr-xr-xunix/install-sh412
-rw-r--r--unix/tkAppInit.c8
-rw-r--r--win/rules.vc9
-rw-r--r--win/tkWinX.c4
176 files changed, 1185 insertions, 1371 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.
diff --git a/doc/bind.n b/doc/bind.n
index f307436..9210357 100644
--- a/doc/bind.n
+++ b/doc/bind.n
@@ -214,11 +214,7 @@ values should scroll up and negative values should scroll down.
Horizontal scrolling uses \fBShift-MouseWheel\fR events, with positive
\fB%D\fR \fIdelta\fR substitution indicating left scrolling and negative
right scrolling.
-Only Windows and macOS Aqua typically fire \fBMouseWheel\fR and
-\fBShift-MouseWheel\fR events. On
-X11 vertical scrolling is rather supported through \fBButton-4\fR and
-\fBButton-5\fR events, and horizontal scrolling through \fBShift-Button-4\fR
-and \fBShift-Button-5\fR events. Horizontal scrolling events may fire from
+Horizontal scrolling events may fire from
many different hardware units such as tilt wheels or touchpads. Horizontal
scrolling can also be emulated by holding Shift and scrolling vertically.
.RE
diff --git a/doc/canvas.n b/doc/canvas.n
index 1b43983..2367e2e 100644
--- a/doc/canvas.n
+++ b/doc/canvas.n
@@ -1147,7 +1147,8 @@ total width of the canvas is off-screen to the left.
.
This command shifts the view in the window left or right according to
\fInumber\fR and \fIwhat\fR.
-\fINumber\fR must be an integer.
+\fINumber\fR must be an integer or a float, but if it is a float then
+it is converted to an integer, rounded away from 0.
\fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation
of one of these.
If \fIwhat is \fBpages\fR then the view
diff --git a/doc/entry.n b/doc/entry.n
index 99ebbf4..23b8cab 100644
--- a/doc/entry.n
+++ b/doc/entry.n
@@ -403,7 +403,8 @@ way through the text appears at the left edge of the window.
\fIpathName \fBxview scroll \fInumber what\fR
This command shifts the view in the window left or right according to
\fInumber\fR and \fIwhat\fR.
-\fINumber\fR must be an integer.
+\fINumber\fR must be an integer or a float, but if it is a float then
+it is converted to an integer, rounded away from 0.
\fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation
of one of these.
If \fIwhat\fR is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls.
diff --git a/doc/listbox.n b/doc/listbox.n
index 9e4a459..02bd169 100644
--- a/doc/listbox.n
+++ b/doc/listbox.n
@@ -383,7 +383,8 @@ total width of the listbox text is off-screen to the left.
.
This command shifts the view in the window left or right according to
\fInumber\fR and \fIwhat\fR.
-\fINumber\fR must be an integer.
+\fINumber\fR must be an integer or a float, but if it is a float then
+it is converted to an integer, rounded away from 0.
\fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation
of one of these.
If \fIwhat\fR is \fBpages\fR then the view adjusts by
diff --git a/doc/scrollbar.n b/doc/scrollbar.n
index ba11f5c..4f808f4 100644
--- a/doc/scrollbar.n
+++ b/doc/scrollbar.n
@@ -223,7 +223,8 @@ it is slightly less than what fits in the window, so that there
is a slight overlap between the old and new views.
\fINumber\fR is either 1, which means the next page should
become visible, or \-1, which means that the previous page should
-become visible.
+become visible. Fractional number are rounded away from 0, so
+scrolling 0.001 pages has the same effect as scrolling 1 page.
.TP
\fIprefix \fBscroll \fInumber \fBunits\fR
.
@@ -232,7 +233,9 @@ The units are defined in whatever way makes sense for the widget,
such as characters or lines in a text widget.
\fINumber\fR is either 1, which means one unit should scroll off
the top or left of the window, or \-1, which means that one unit
-should scroll off the bottom or right of the window.
+should scroll off the bottom or right of the window. Fractional
+numbers are rounded away from 0, so scrolling 0.001 units has
+the same effect as scrolling 1 unit.
.SH "OLD COMMAND SYNTAX"
.PP
In versions of Tk before 4.0, the \fBset\fR and \fBget\fR widget
diff --git a/doc/spinbox.n b/doc/spinbox.n
index 1f556ba..6c8801d 100644
--- a/doc/spinbox.n
+++ b/doc/spinbox.n
@@ -470,7 +470,8 @@ way through the text appears at the left edge of the window.
\fIpathName \fBxview scroll \fInumber what\fR
This command shifts the view in the window left or right according to
\fInumber\fR and \fIwhat\fR.
-\fINumber\fR must be an integer.
+\fINumber\fR must be an integer or a float, but if it is a float then
+it is converted to an integer, rounded away from 0.
\fIWhat\fR must be either \fBpages\fR or \fBunits\fR or an abbreviation
of one of these.
If \fIwhat\fR is \fBpages\fR then the view adjusts by \fInumber\fR
diff --git a/doc/ttk_widget.n b/doc/ttk_widget.n
index 17f1d88..7bab661 100644
--- a/doc/ttk_widget.n
+++ b/doc/ttk_widget.n
@@ -257,7 +257,8 @@ way through the content appears at the left edge of the window.
\fIpathName \fBxview scroll \fInumber what\fR
This command shifts the view in the window left or right according to
\fInumber\fR and \fIwhat\fR.
-\fINumber\fR must be an integer.
+\fINumber\fR must be an integer or a float, but if it is a float then
+it is converted to an integer, rounded away from 0.
\fIWhat\fR must be either \fBpages\fR or \fBunits\fR.
'\" or an abbreviation of one of these, but we don't document that.
If \fIwhat\fR is
diff --git a/generic/tkBind.c b/generic/tkBind.c
index 4ab98f5..3776c95 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -792,8 +792,10 @@ static unsigned
GetButtonNumber(
const char *field)
{
+ unsigned button;
assert(field);
- return (field[0] >= '1' && field[0] <= '9' && field[1] == '\0') ? field[0] - '0' : 0;
+ button = (field[0] >= '1' && field[0] <= '9' && field[1] == '\0') ? field[0] - '0' : 0;
+ return (button > 3) ? (button + 4) : button;
}
static Time
@@ -4038,6 +4040,9 @@ HandleEventGenerate(
return TCL_ERROR;
}
if (flags & BUTTON) {
+ if (number >= Button4) {
+ number += (Button8 - Button4);
+ }
event.general.xbutton.button = number;
} else {
badOpt = 1;
@@ -5189,15 +5194,15 @@ GetPatternObj(
}
case ButtonPress:
case ButtonRelease:
- assert(patPtr->info <= Button9);
- Tcl_AppendPrintfToObj(patternObj, "-%u", (unsigned)patPtr->info);
+ assert(patPtr->info <= 13);
+ Tcl_AppendPrintfToObj(patternObj, "-%u", (unsigned) ((patPtr->info > 7) ? (patPtr->info - 4) : patPtr->info));
break;
#if PRINT_SHORT_MOTION_SYNTAX
case MotionNotify: {
unsigned mask = patPtr->modMask;
while (mask & ALL_BUTTONS) {
unsigned button = ButtonNumberFromState(mask);
- Tcl_AppendPrintfToObj(patternObj, "-%u", button);
+ Tcl_AppendPrintfToObj(patternObj, "-%u", (button > 7) ? (button - 4) : button);
mask &= ~Tk_GetButtonMask(button);
}
break;
diff --git a/generic/tkEvent.c b/generic/tkEvent.c
index 07ce8e7..ea7b282 100644
--- a/generic/tkEvent.c
+++ b/generic/tkEvent.c
@@ -515,7 +515,10 @@ RefreshKeyboardMappingIfNeeded(
*
* Tk_GetButtonMask --
*
- * Return the proper Button${n}Mask for the button.
+ * Return the proper Button${n}Mask for the button. Don't care about
+ * Button4 - Button7, because those are not actually buttons: Those
+ * are used for the horizontal or vertical mouse wheels. Button4Mask
+ * and higher is actually used for Button 8 and higher.
*
* Results:
* A button mask.
@@ -527,8 +530,8 @@ RefreshKeyboardMappingIfNeeded(
*/
static const unsigned buttonMasks[] = {
- 0, Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask,
- Button6Mask, Button7Mask, Button8Mask, Button9Mask
+ 0, Button1Mask, Button2Mask, Button3Mask, 0, 0, 0, 0, Button4Mask, \
+ Button5Mask, Button6Mask, Button7Mask, Button8Mask, Button9Mask
};
unsigned
@@ -1137,6 +1140,23 @@ Tk_HandleEvent(
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+#if !defined(_WIN32) && !defined(MAC_OSX_TK)
+ if ((eventPtr->xbutton.button >= Button4) && (eventPtr->xbutton.button < Button8)) {
+ if (eventPtr->type == ButtonRelease) {
+ return;
+ } else if (eventPtr->type == ButtonPress) {
+ int but = eventPtr->xbutton.button;
+ eventPtr->type = MouseWheelEvent;
+ eventPtr->xany.send_event = -1;
+ eventPtr->xkey.keycode = (but & 1) ? -120 : 120;
+ if (but > Button5) {
+ eventPtr->xkey.state ^= ShiftMask;
+ }
+ }
+ }
+#endif
+
/*
* If the generic handler processed this event we are done and can return.
*/
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 61f348d..59e1bf5 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -1014,6 +1014,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 fdf7802..1c50c2f 100644
--- a/generic/ttk/ttkLabel.c
+++ b/generic/ttk/ttkLabel.c
@@ -582,13 +582,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);
@@ -641,12 +643,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/bgerror.tcl b/library/bgerror.tcl
index fe8dfe0..526d791 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -6,10 +6,10 @@
# trace (like save it to a log). This is adapted from work done by
# Donal K. Fellows.
#
-# Copyright (c) 1998-2000 by Ajuba Solutions.
-# Copyright (c) 2007 by ActiveState Software Inc.
-# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
-# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 1998-2000 by Ajuba Solutions.
+# Copyright © 2007 by ActiveState Software Inc.
+# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
diff --git a/library/button.tcl b/library/button.tcl
index d824009..39431e8 100644
--- a/library/button.tcl
+++ b/library/button.tcl
@@ -4,9 +4,9 @@
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 2002 ActiveState Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 2002 ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/choosedir.tcl b/library/choosedir.tcl
index 68dd9b0..ef90468 100644
--- a/library/choosedir.tcl
+++ b/library/choosedir.tcl
@@ -2,7 +2,7 @@
#
# Choose directory dialog implementation for Unix/Mac.
#
-# Copyright (c) 1998-2000 by Scriptics Corporation.
+# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.
# Make sure the tk::dialog namespace, in which all dialogs should live, exists
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index d67c67f..8bdb7a7 100644
--- a/library/clrpick.tcl
+++ b/library/clrpick.tcl
@@ -3,7 +3,7 @@
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/comdlg.tcl b/library/comdlg.tcl
index 18df8a6..3dd03dc 100644
--- a/library/comdlg.tcl
+++ b/library/comdlg.tcl
@@ -3,7 +3,7 @@
# Some functions needed for the common dialog boxes. Probably need to go
# in a different file.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright © 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/console.tcl b/library/console.tcl
index 7ef1eb8..1763584 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,9 +4,9 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
-# Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright © 1995-1997 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Ajuba Solutions.
+# Copyright © 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl
index 9146362..8b56639 100644
--- a/library/demos/bind.tcl
+++ b/library/demos/bind.tcl
@@ -67,12 +67,12 @@ foreach tag {d1 d2 d3 d4 d5 d6} {
$w.text tag bind $tag <Leave> "$w.text tag configure $tag $normal"
}
# Main widget program sets variable tk_demoDirectory
-$w.text tag bind d1 <Button-1> {source [file join $tk_demoDirectory items.tcl]}
-$w.text tag bind d2 <Button-1> {source [file join $tk_demoDirectory plot.tcl]}
-$w.text tag bind d3 <Button-1> {source [file join $tk_demoDirectory ctext.tcl]}
-$w.text tag bind d4 <Button-1> {source [file join $tk_demoDirectory arrow.tcl]}
-$w.text tag bind d5 <Button-1> {source [file join $tk_demoDirectory ruler.tcl]}
-$w.text tag bind d6 <Button-1> {source [file join $tk_demoDirectory cscroll.tcl]}
+$w.text tag bind d1 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory items.tcl]}
+$w.text tag bind d2 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory plot.tcl]}
+$w.text tag bind d3 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ctext.tcl]}
+$w.text tag bind d4 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory arrow.tcl]}
+$w.text tag bind d5 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory ruler.tcl]}
+$w.text tag bind d6 <Button-1> {source -encoding utf-8 [file join $tk_demoDirectory cscroll.tcl]}
$w.text mark set insert 0.0
$w.text configure -state disabled
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/goldberg.tcl b/library/demos/goldberg.tcl
index 1cc52c6..14ddb0b 100644
--- a/library/demos/goldberg.tcl
+++ b/library/demos/goldberg.tcl
@@ -113,9 +113,9 @@ proc DoDisplay {w} {
DoCtrlFrame $w
DoDetailFrame $w
if {[tk windowingsystem] ne "aqua"} {
- ttk::button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2
+ ttk::button $w.show -text "»" -command [list ShowCtrl $w] -width 2
} else {
- button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
+ button $w.show -text "»" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg)
}
place $w.show -in $w.c -relx 1 -rely 0 -anchor ne
update
@@ -204,10 +204,10 @@ proc DoDetailFrame {w} {
proc ShowCtrl {w} {
if {[winfo ismapped $w.ctrl]} {
pack forget $w.ctrl
- $w.show config -text "\u00bb"
+ $w.show config -text "»"
} else {
pack $w.ctrl -side right -fill both -ipady 5
- $w.show config -text "\u00ab"
+ $w.show config -text "»"
}
}
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/knightstour.tcl b/library/demos/knightstour.tcl
index 11b3b5c..09ceff0 100644
--- a/library/demos/knightstour.tcl
+++ b/library/demos/knightstour.tcl
@@ -1,4 +1,4 @@
-# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 2008 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# Calculate a Knight's tour of a chessboard.
#
@@ -205,10 +205,10 @@ proc CreateGUI {} {
}
if {[tk windowingsystem] ne "x11"} {
catch {eval font create KnightFont -size -24}
- $c create text 0 0 -font KnightFont -text "\u265e" \
+ $c create text 0 0 -font KnightFont -text "♞" \
-anchor nw -tags knight -fill black -activefill "#600000"
} else {
- # On X11 we cannot reliably tell if the \u265e glyph is available
+ # On X11 we cannot reliably tell if the ♞ glyph is available
# so just use a polygon
set pts {
2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16
diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl
index 9833e8f..04f276b 100644
--- a/library/demos/pendulum.tcl
+++ b/library/demos/pendulum.tcl
@@ -50,8 +50,8 @@ for {set i 90} {$i>=0} {incr i -10} {
$w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i
}
-$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta
-$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta
+$w.k create text 0 0 -anchor ne -text "θ" -tags label_theta
+$w.k create text 0 0 -anchor ne -text "δθ" -tags label_dtheta
pack $w.k -in $w.p.l2 -fill both -expand true
# Initialize some variables
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/demos/toolbar.tcl b/library/demos/toolbar.tcl
index cb2a495..a53e390 100644
--- a/library/demos/toolbar.tcl
+++ b/library/demos/toolbar.tcl
@@ -17,7 +17,7 @@ positionWindow $w
ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\
a toolbar that is styled correctly and which can be torn off. The\
- buttons are configured to be \u201Ctoolbar style\u201D buttons by\
+ buttons are configured to be “toolbar style” buttons by\
telling them that they are to use the Toolbutton style. At the left\
end of the toolbar is a simple marker that the cursor changes to a\
movement icon over; drag that away from the toolbar to tear off the\
diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl
index ab49cf4..f6d94ac 100644
--- a/library/demos/ttkbut.tcl
+++ b/library/demos/ttkbut.tcl
@@ -17,7 +17,7 @@ wm title $w "Simple Ttk Widgets"
wm iconname $w "ttkbut"
positionWindow $w
-ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
+ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the “Enabled” button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons."
pack $w.msg -side top -fill x
## See Code / Dismiss
diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl
index 8a72cf9..29ac508 100644
--- a/library/demos/ttkprogress.tcl
+++ b/library/demos/ttkprogress.tcl
@@ -15,7 +15,7 @@ wm title $w "Progress Bar Demonstration"
wm iconname $w "ttkprogress"
positionWindow $w
-ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
+ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a “determinate” progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an “indeterminate” progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath."
pack $w.msg -side top -fill x
## See Code / Dismiss buttons
diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl
index ca325a4..1ecc064 100644
--- a/library/demos/unicodeout.tcl
+++ b/library/demos/unicodeout.tcl
@@ -21,9 +21,7 @@ label $w.msg -font $font -wraplength 4i -anchor w -justify left \
non-Western character sets. However, what you will actually see\
below depends largely on what character sets you have installed,\
and what you see for characters that are not present varies greatly\
- between platforms as well. The strings are written in Tcl using\
- UNICODE characters using the \\uXXXX (or \\UXXXXXX) escape so as to\
- do so in a portable fashion."
+ between platforms as well."
pack $w.msg -side top
## See Code / Dismiss buttons
@@ -98,47 +96,29 @@ update
## Add the samples...
if {[usePresentationFormsFor Arabic]} {
# Using presentation forms (pre-layouted)
- addSample $w Arabic \
- "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
- "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
+ addSample $w Arabic "ﺔﻴﺑﺮﻌﻟﺍ ﺔﻤﻠﻜﻟﺍ"
} else {
# Using standard text characters
- addSample $w Arabic \
- "\u0627\u0644\u0643\u0644\u0645\u0629 " \
- "\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
+ addSample $w Arabic "الكلمة العربية"
}
-addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57"
-addSample $w "Simpl. Chinese" "\u6C49\u8BED"
-addSample $w French "Langue fran\xE7aise"
-addSample $w Greek \
- "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
- "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
+addSample $w "Trad. Chinese" "中國的漢字"
+addSample $w "Simpl. Chinese" "汉语"
+addSample $w French "Langue française"
+addSample $w Greek "Ελληνική γλώσσα"
if {[usePresentationFormsFor Hebrew]} {
# Visual order (pre-layouted)
- addSample $w Hebrew \
- "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB"
+ addSample $w Hebrew "תירבע בתכ"
} else {
# Standard logical order
- addSample $w Hebrew \
- "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA"
+ addSample $w Hebrew "כתב עברית"
}
-addSample $w Hindi \
- "\u0939\u093F\u0928\u094D\u0926\u0940 \u092D\u093E\u0937\u093E"
-addSample $w Icelandic "\xCDslenska"
-addSample $w Japanese \
- "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
- "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
-addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
-addSample $w Russian \
- "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
+addSample $w Hindi "हिन्दी भाषा"
+addSample $w Icelandic "Íslenska"
+addSample $w Japanese "日本語のひらがな, 漢字とカタカナ"
+addSample $w Korean "대한민국의 한글"
+addSample $w Russian "Русский язык"
if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} {
- if {[package vsatisfies [package provide Tcl] 8.7-]} {
- addSample $w Emoji \
- "\U1F600\U1F4A9\U1F44D\U1F1F3\U1F1F1"
- } else {
- addSample $w Emoji \
- "\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1"
- }
+ addSample $w Emoji "😀💩👍🇳🇱"
}
## We're done processing, so change things back to normal running...
diff --git a/library/demos/widget b/library/demos/widget
index 58da12f..4f7f715 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -723,10 +723,10 @@ proc PrintTextWin32 {filename} {
proc tkAboutDialog {} {
tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
-message [mc "Tk widget demonstration application"] -detail \
-"[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}]
-[mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}]
-[mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}]
-[mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]"
+"[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}]
+[mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}]
+[mc "Copyright © %s" {2001-2009 Donal K. Fellows}]
+[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}]"
}
# Local Variables:
diff --git a/library/dialog.tcl b/library/dialog.tcl
index a099d90..ffbd8e4 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -3,8 +3,8 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# Copyright (c) 1992-1993 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1992-1993 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/entry.tcl b/library/entry.tcl
index 6539af7..bdd9fcc 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -3,8 +3,8 @@
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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/focus.tcl b/library/focus.tcl
index 640406e..2cf5ad7 100644
--- a/library/focus.tcl
+++ b/library/focus.tcl
@@ -3,7 +3,7 @@
# This file defines several procedures for managing the input
# focus.
#
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/iconlist.tcl b/library/iconlist.tcl
index a19dbeb..0dddebc 100644
--- a/library/iconlist.tcl
+++ b/library/iconlist.tcl
@@ -3,8 +3,8 @@
# Implements the icon-list megawidget used in the "Tk" standard file
# selection dialog boxes.
#
-# Copyright (c) 1994-1998 Sun Microsystems, Inc.
-# Copyright (c) 2009 Donal K. Fellows
+# Copyright © 1994-1998 Sun Microsystems, Inc.
+# Copyright © 2009 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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/icons.tcl b/library/icons.tcl
index e53a1bd..d98e461 100644
--- a/library/icons.tcl
+++ b/library/icons.tcl
@@ -8,7 +8,7 @@
#
# See http://tango.freedesktop.org/Tango_Desktop_Project
#
-# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
namespace eval ::tk::icons {}
diff --git a/library/listbox.tcl b/library/listbox.tcl
index bf40a39..9038890 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,9 +3,9 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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/megawidget.tcl b/library/megawidget.tcl
index ec9f469..c09d0da 100644
--- a/library/megawidget.tcl
+++ b/library/megawidget.tcl
@@ -4,7 +4,7 @@
# the ::tk::IconList megawdget, which is itself only designed for use in
# the Unix file dialogs.
#
-# Copyright (c) 2009-2010 Donal K. Fellows
+# Copyright © 2009-2010 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/menu.tcl b/library/menu.tcl
index c2653aa..e35ea73 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -4,10 +4,10 @@
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 646c143..b401ad1 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/obsolete.tcl b/library/obsolete.tcl
index e66c48d..a31884d 100644
--- a/library/obsolete.tcl
+++ b/library/obsolete.tcl
@@ -3,8 +3,8 @@
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/optMenu.tcl b/library/optMenu.tcl
index 7cfdaa0..4beb3c7 100644
--- a/library/optMenu.tcl
+++ b/library/optMenu.tcl
@@ -3,8 +3,8 @@
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/palette.tcl b/library/palette.tcl
index 42c6a90..e658067 100644
--- a/library/palette.tcl
+++ b/library/palette.tcl
@@ -3,7 +3,7 @@
# This file contains procedures that change the color palette used
# by Tk.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# Copyright © 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/safetk.tcl b/library/safetk.tcl
index 9e71cc6..0eb1220 100644
--- a/library/safetk.tcl
+++ b/library/safetk.tcl
@@ -2,7 +2,7 @@
#
# Support procs to use Tk in safe interpreters.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright © 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/scale.tcl b/library/scale.tcl
index cc0de20..0da5472 100644
--- a/library/scale.tcl
+++ b/library/scale.tcl
@@ -3,8 +3,8 @@
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -60,14 +60,6 @@ bind Scale <ButtonRelease-2> {
tk::ScaleEndDrag %W
tk::ScaleActivate %W %x %y
}
-if {[tk windowingsystem] eq "win32"} {
- # On Windows do the same with button 3, as that is the right mouse button
- bind Scale <Button-3> [bind Scale <Button-2>]
- bind Scale <B3-Motion> [bind Scale <B2-Motion>]
- bind Scale <B3-Leave> [bind Scale <B2-Leave>]
- bind Scale <B3-Enter> [bind Scale <B2-Enter>]
- bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
-}
bind Scale <Control-Button-1> {
tk::ScaleControlPress %W %x %y
}
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index 8106b3d..effae11 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -3,8 +3,8 @@
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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 65c8191..8308c2c 100644
--- a/library/spinbox.tcl
+++ b/library/spinbox.tcl
@@ -4,10 +4,10 @@
# procedures that help in implementing those bindings. The spinbox builds
# off the entry widget, so it can reuse Entry bindings and procedures.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1999-2000 Jeffrey Hobbs
-# Copyright (c) 2000 Ajuba Solutions
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1999-2000 Jeffrey Hobbs
+# Copyright © 2000 Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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/tearoff.tcl b/library/tearoff.tcl
index 329796f..605074f 100644
--- a/library/tearoff.tcl
+++ b/library/tearoff.tcl
@@ -2,8 +2,8 @@
#
# This file contains procedures that implement tear-off menus.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/text.tcl b/library/text.tcl
index a84ea05..5d41dc3 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,9 +3,9 @@
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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 %W 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 %W y %D -0.3 pixels
+}
+bind Text <Shift-MouseWheel> {
+ tk::MouseWheel %W x %D -3.0 pixels
+}
+bind Text <Shift-Option-MouseWheel> {
+ tk::MouseWheel %W x %D -0.3 pixels
}
# ::tk::TextClosestGap --
diff --git a/library/tk.tcl b/library/tk.tcl
index 85421ef..2475da6 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,9 +3,9 @@
# Initialization script normally executed in the interpreter for each Tk-based
# application. Arranges class bindings for widgets.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -366,15 +366,16 @@ if {![llength [info command tk_chooseDirectory]]} {
# Define the set of common virtual events.
#----------------------------------------------------------------------
+event add <<ContextMenu>> <Button-3>
+event add <<PasteSelection>> <ButtonRelease-2>
+
switch -exact -- [tk windowingsystem] {
"x11" {
event add <<Cut>> <Control-x> <F20> <Control-Lock-X>
event add <<Copy>> <Control-c> <F16> <Control-Lock-C>
event add <<Paste>> <Control-v> <F18> <Control-Lock-V>
- event add <<PasteSelection>> <ButtonRelease-2>
event add <<Undo>> <Control-z> <Control-Lock-Z>
event add <<Redo>> <Control-Z> <Control-Lock-z>
- event add <<ContextMenu>> <Button-3>
# On Darwin/Aqua, buttons from left to right are 1,3,2. On Darwin/X11 with recent
# XQuartz as the X server, they are 1,2,3; other X servers may differ.
@@ -422,10 +423,8 @@ switch -exact -- [tk windowingsystem] {
event add <<Cut>> <Control-x> <Shift-Delete> <Control-Lock-X>
event add <<Copy>> <Control-c> <Control-Insert> <Control-Lock-C>
event add <<Paste>> <Control-v> <Shift-Insert> <Control-Lock-V>
- event add <<PasteSelection>> <ButtonRelease-2>
event add <<Undo>> <Control-z> <Control-Lock-Z>
event add <<Redo>> <Control-y> <Control-Lock-Y>
- event add <<ContextMenu>> <Button-3>
event add <<SelectAll>> <Control-slash> <Control-a> <Control-Lock-A>
event add <<SelectNone>> <Control-backslash>
@@ -455,9 +454,7 @@ switch -exact -- [tk windowingsystem] {
event add <<Cut>> <Command-x> <F2> <Command-Lock-X>
event add <<Copy>> <Command-c> <F3> <Command-Lock-C>
event add <<Paste>> <Command-v> <F4> <Command-Lock-V>
- event add <<PasteSelection>> <ButtonRelease-3>
event add <<Clear>> <Clear>
- event add <<ContextMenu>> <Button-2>
# Official bindings
# See http://support.apple.com/kb/HT1343
@@ -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/tkfbox.tcl b/library/tkfbox.tcl
index cf89287..af40a12 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -10,7 +10,7 @@
# "Directory" option menu. The user can select files by clicking on the
# file icons or by entering a filename in the "Filename:" entry.
#
-# Copyright (c) 1994-1998 Sun Microsystems, Inc.
+# Copyright © 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
index 0a7e519..58df760 100644
--- a/library/ttk/combobox.tcl
+++ b/library/ttk/combobox.tcl
@@ -182,11 +182,15 @@ proc ttk::combobox::SelectEntry {cb index} {
## Scroll -- Mousewheel binding
#
-proc ttk::combobox::Scroll {cb dir} {
+proc ttk::combobox::Scroll {cb dir {factor 1.0}} {
$cb instate disabled { return }
set max [llength [$cb cget -values]]
set current [$cb current]
- incr current $dir
+ set d [expr {round($dir/factor)}]
+ if {$d == 0 && $dir != 0} {
+ if {$dir > 0} {set d 1} else {set d -1}
+ }
+ incr current $d
if {$max != 0 && $current == $current % $max} {
SelectEntry $cb $current
}
diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl
index 2f3c1a6..8c89435 100644
--- a/library/ttk/entry.tcl
+++ b/library/ttk/entry.tcl
@@ -1,9 +1,9 @@
#
# DERIVED FROM: tk/library/entry.tcl r1.22
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 2004, Joe English
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 2004, Joe English
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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 2c45cac..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,26 +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 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)
+ }
+ 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]
}
@@ -177,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/library/xmfbox.tcl b/library/xmfbox.tcl
index 0aaae38..71f3f1a 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,8 +4,8 @@
# Unix platform. This implementation is used only if the
# "::tk_strictMotif" flag is set.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Scriptics Corporation
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile
index e753c29..2451e5c 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" && \
@@ -272,9 +291,10 @@ else
fix_install_name MacOS/Wish Tcl && fix_install_name MacOS/Wish Tk
ifeq (${INSTALL_BUILD},1)
@cd "${TOP_DIR}" && rm -rf "./${FMWK_DIR}"/T{cl,k}.framework && rmdir -p "./${FMWK_DIR}" 2>&- || true
-endif
-endif
-endif
+endif # install 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/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index 8575b10..d9f098c 100644
--- a/macosx/tkMacOSXDialog.c
+++ b/macosx/tkMacOSXDialog.c
@@ -346,23 +346,25 @@ static NSInteger showOpenSavePanel(
NSWindow *parent,
FilePanelCallbackInfo *callbackInfo)
{
- NSInteger modalReturnCode;
+ __block NSInteger modalReturnCode = modalOther;
if (parent && ![parent attachedSheet]) {
[panel beginSheetModalForWindow:parent
- completionHandler:^(NSModalResponse returnCode) {
- [NSApp tkFilePanelDidEnd:panel
- returnCode:returnCode
- contextInfo:callbackInfo ];
+ completionHandler:^(NSModalResponse result) {
+ [NSApp tkFilePanelDidEnd:panel
+ returnCode:result
+ contextInfo:callbackInfo ];
+ modalReturnCode = result;
}];
-
- modalReturnCode = callbackInfo->cmdObj ? modalOther :
- [panel runModal];
} else {
- modalReturnCode = [panel runModal];
- [NSApp tkFilePanelDidEnd:panel returnCode:modalReturnCode
- contextInfo:callbackInfo];
+ [panel beginWithCompletionHandler:^(NSModalResponse result) {
+ [NSApp tkFilePanelDidEnd:panel
+ returnCode:result
+ contextInfo:callbackInfo ];
+ modalReturnCode = result;
+ }];
}
+ [panel runModal];
return modalReturnCode;
}
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 c585fa2..30a2d57 100644
--- a/macosx/tkMacOSXWindowEvent.c
+++ b/macosx/tkMacOSXWindowEvent.c
@@ -1236,7 +1236,8 @@ static const char *const accentNames[] = {
- (void) keyDown: (NSEvent *) theEvent
{
- (void)theEvent;
+ (void)theEvent;
+
#ifdef TK_MAC_DEBUG_EVENTS
TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent);
#endif
diff --git a/tests/bell.test b/tests/bell.test
index bbafeac..da264d7 100644
--- a/tests/bell.test
+++ b/tests/bell.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out Tk's "bell" command.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1998-2000 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/bgerror.test b/tests/bgerror.test
index fd9594a..a69fceb 100644
--- a/tests/bgerror.test
+++ b/tests/bgerror.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test the bgerror command.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/bind.test b/tests/bind.test
index 2685946..b84f777 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -2,9 +2,9 @@
# commands plus the procedures in tkBind.c. It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/bitmap.test b/tests/bitmap.test
index 6996f88..6ad0213 100644
--- a/tests/bitmap.test
+++ b/tests/bitmap.test
@@ -2,8 +2,8 @@
# tkBitmap.c. It is organized in the standard white-box fashion for
# Tcl tests.
#
-# Copyright (c) 1998 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/border.test b/tests/border.test
index d6ff5c7..f0d0efd 100644
--- a/tests/border.test
+++ b/tests/border.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out the procedures in the file
# tkBorder.c. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1998 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/busy.test b/tests/busy.test
index 52bd4e6..6c110a9 100644
--- a/tests/busy.test
+++ b/tests/busy.test
@@ -4,7 +4,7 @@
# commands. Sourcing this file runs the tests and generates output for errors.
# No output means no errors were found.
#
-# Copyright (c) 1998-2000 by Jos Decoster. All rights reserved.
+# Copyright © 1998-2000 by Jos Decoster. All rights reserved.
package require tcltest 2.2
tcltest::configure {*}$argv
diff --git a/tests/button.test b/tests/button.test
index 36ff79d..57f4021 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -2,9 +2,9 @@
# radiobuttons in Tk (i.e., all the widgets defined in tkButton.c). It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvImg.test b/tests/canvImg.test
index 27c00d6..0e4acd7 100644
--- a/tests/canvImg.test
+++ b/tests/canvImg.test
@@ -2,9 +2,9 @@
# which implement canvas "image" items. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvMoveto.test b/tests/canvMoveto.test
index a6cf849..0344db7 100644
--- a/tests/canvMoveto.test
+++ b/tests/canvMoveto.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the canvas "moveto" command. It is
# derived from canvRect.test.
#
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2004 Neil McKay.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2004 Neil McKay.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvPs.test b/tests/canvPs.test
index aa69336..1c90b12 100644
--- a/tests/canvPs.test
+++ b/tests/canvPs.test
@@ -2,8 +2,8 @@
# for canvases to files and channels. It exercises the procedure
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
-# Copyright (c) 1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvRect.test b/tests/canvRect.test
index ec59e8b..0b59230 100644
--- a/tests/canvRect.test
+++ b/tests/canvRect.test
@@ -2,8 +2,8 @@
# which implement canvas "rectangle" and "oval" items. It is organized
# in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvText.test b/tests/canvText.test
index 02bca47..fba9807 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -2,8 +2,8 @@
# which implement canvas "text" items. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvWind.test b/tests/canvWind.test
index 436ee2c..2d7a470 100644
--- a/tests/canvWind.test
+++ b/tests/canvWind.test
@@ -2,8 +2,8 @@
# which implement canvas "window" items. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/canvas.test b/tests/canvas.test
index ffdc775..5e4f851 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -2,9 +2,9 @@
# implements generic code for canvases. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 Ajuba Solutions.
-# Copyright (c) 2008 Donal K. Fellows
+# Copyright © 1995-1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 Ajuba Solutions.
+# Copyright © 2008 Donal K. Fellows
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/choosedir.test b/tests/choosedir.test
index c6cc632..b90cea8 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out Tk's "tk_chooseDir" and
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/clipboard.test b/tests/clipboard.test
index 7c1a506..1b6b4ca 100644
--- a/tests/clipboard.test
+++ b/tests/clipboard.test
@@ -2,8 +2,8 @@
# especially the "clipboard" command. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 0900962..1aeb18b 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out Tk's "tk_chooseColor" command.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/cmds.test b/tests/cmds.test
index caf5afe..88cf0c0 100644
--- a/tests/cmds.test
+++ b/tests/cmds.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test the procedures in the file
# tkCmds.c. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/color.test b/tests/color.test
index 1e99a7d..fa43765 100644
--- a/tests/color.test
+++ b/tests/color.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out the procedures in the file
# tkColor.c. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1995-1998 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995-1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/config.test b/tests/config.test
index 9f1c7e3..2128020 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -2,8 +2,8 @@
# which comprise the new new option configuration system. It is
# organized in the standard "white-box" fashion for Tcl tests.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/cursor.test b/tests/cursor.test
index 8d7ebb0..eb4f168 100644
--- a/tests/cursor.test
+++ b/tests/cursor.test
@@ -2,8 +2,8 @@
# tkCursor.c. It is organized in the standard white-box fashion for
# Tcl tests.
#
-# Copyright (c) 1998 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/embed.test b/tests/embed.test
index 1fe73ef..ed1abdd 100644
--- a/tests/embed.test
+++ b/tests/embed.test
@@ -1,7 +1,7 @@
# This file is a Tcl script to test out embedded Windows.
#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/entry.test b/tests/entry.test
index 6be21e6..4017227 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test entry widgets in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -753,7 +753,7 @@ test entry-3.7 {EntryWidgetCmd procedure, "bbox" widget command} -constraints {
update
} -body {
# Tcl_UtfAtIndex(): utf at end
- .e insert 0 "ab\u4e4e"
+ .e insert 0 "ab乎"
.e bbox end
} -cleanup {
destroy .e
@@ -766,7 +766,7 @@ test entry-3.8 {EntryWidgetCmd procedure, "bbox" widget command} -constraints {
update
} -body {
# Tcl_UtfAtIndex(): utf before index
- .e insert 0 "ab\u4e4ec"
+ .e insert 0 "ab乎c"
.e bbox 3
} -cleanup {
destroy .e
@@ -788,7 +788,7 @@ test entry-3.10 {EntryWidgetCmd procedure, "bbox" widget command} -constraints {
pack .e
update
} -body {
- .e insert 0 "abcdefghij\u4e4eklmnop"
+ .e insert 0 "abcdefghij乎klmnop"
list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
} -cleanup {
destroy .e
@@ -902,20 +902,20 @@ test entry-3.24 {EntryWidgetCmd procedure, "delete" widget command} -setup {
set x {}
} -body {
# UTF
- .e insert end "01234\u4e4e67890"
+ .e insert end "01234乎67890"
.e delete 6
lappend x [.e get]
.e delete 0 end
- .e insert end "012345\u4e4e7890"
+ .e insert end "012345乎7890"
.e delete 6
lappend x [.e get]
.e delete 0 end
- .e insert end "0123456\u4e4e890"
+ .e insert end "0123456乎890"
.e delete 6
lappend x [.e get]
} -cleanup {
destroy .e
-} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
+} -result [list "01234乎7890" "0123457890" "012345乎890"]
test entry-3.25 {EntryWidgetCmd procedure, "delete" widget command} -setup {
entry .e
pack .e
@@ -1019,7 +1019,7 @@ test entry-3.35 {EntryWidgetCmd procedure, "index" widget command} -setup {
update
} -body {
# UTF
- .e insert 0 abc\u4e4e\u0153def
+ .e insert 0 abc乎œdef
list [.e index 3] [.e index 4] [.e index end]
} -cleanup {
destroy .e
@@ -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
@@ -1561,7 +1561,7 @@ test entry-3.86 {EntryWidgetCmd procedure, "xview" widget command} -setup {
} -body {
.e insert end "This is quite a long text string, so long that it "
.e insert end "runs off the end of the window quite a bit."
- .e insert 10 \u4e4e
+ .e insert 10 乎
update
# UTF
# If Tcl_NumUtfChars wasn't used, wrong answer would be:
diff --git a/tests/event.test b/tests/event.test
index 2e53196..68cbe9d 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in tkEvent.c. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/filebox.test b/tests/filebox.test
index 514cbc7..c6cc69b 100644
--- a/tests/filebox.test
+++ b/tests/filebox.test
@@ -2,8 +2,8 @@
# "tk_getSaveFile" commands. It is organized in the standard fashion
# for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/focus.test b/tests/focus.test
index f60d120..626576d 100644
--- a/tests/focus.test
+++ b/tests/focus.test
@@ -2,8 +2,8 @@
# other procedures in the file tkFocus.c. It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/focusTcl.test b/tests/focusTcl.test
index 0e457a6..e1a36a3 100644
--- a/tests/focusTcl.test
+++ b/tests/focusTcl.test
@@ -3,8 +3,8 @@
# tk_focusPrev, among other things. This file is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/font.test b/tests/font.test
index df4046e..1aa3a21 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -2,8 +2,8 @@
# plus the procedures in tkFont.c. It is organized in the
# standard white-box fashion for Tcl tests.
#
-# Copyright (c) 1996-1998 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996-1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -151,16 +151,16 @@ test font-4.11 {font command: bad option} -body {
font actual xyz -style
} -returnCodes error -result {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}
test font-4.12 {font command: actual} -body {
- font actual {-family times} -- \ud800
+ font actual {-family times} -- \uD800
} -match glob -result {*}
test font-4.13 {font command: actual} -body {
- font actual {-family times} -- \udc00
+ font actual {-family times} -- \uDC00
} -match glob -result {*}
test font-4.14 {font command: actual} -constraints {utfcompat win} -body {
font actual {-family times} -family -- \uD800\uDC00
} -result {times}
test font-4.15 {font command: actual} -body {
- font actual {-family times} -- \udc00\ud800
+ font actual {-family times} -- \uDC00\uD800
} -returnCodes 1 -match glob -result {expected a single character but got "*"}
test font-4.16 {font command: actual} -constraints {fullutf win} -body {
font actual {-family times} -family -- \U10000
diff --git a/tests/fontchooser.test b/tests/fontchooser.test
index a9f914d..f36ddf2 100644
--- a/tests/fontchooser.test
+++ b/tests/fontchooser.test
@@ -1,6 +1,6 @@
# Test the "tk::fontchooser" command
#
-# Copyright (c) 2008 Pat Thoyts
+# Copyright © 2008 Pat Thoyts
package require tcltest 2.2
eval tcltest::configure $argv
@@ -112,7 +112,7 @@ test fontchooser-2.0 {fontchooser -title} -constraints scriptImpl -body {
test fontchooser-2.1 {fontchooser -title (cyrillic)} -constraints scriptImpl -body {
start {
tk::fontchooser::Configure \
- -title "\u041f\u0440\u0438\u0432\u0435\u0442"
+ -title "Привет"
tk::fontchooser::Show
}
then {
@@ -120,7 +120,7 @@ test fontchooser-2.1 {fontchooser -title (cyrillic)} -constraints scriptImpl -bo
Click cancel
}
set x
-} -result "\u041f\u0440\u0438\u0432\u0435\u0442"
+} -result "Привет"
test fontchooser-3.0 {fontchooser -parent} -constraints scriptImpl -body {
start {
diff --git a/tests/frame.test b/tests/frame.test
index 3dbdef6..7d8dce2 100644
--- a/tests/frame.test
+++ b/tests/frame.test
@@ -2,9 +2,9 @@
# "toplevel" commands of Tk. It is organized in the standard fashion for Tcl
# tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/geometry.test b/tests/geometry.test
index d3bb0c5..da9e77b 100644
--- a/tests/geometry.test
+++ b/tests/geometry.test
@@ -2,9 +2,9 @@
# tkGeometry.c (generic support for geometry managers). It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
proc getsize w {
diff --git a/tests/get.test b/tests/get.test
index ea08c8c..5ea2af3 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -2,8 +2,8 @@
# tkGet.c. It is organized in the standard fashion for Tcl
# white-box tests.
#
-# Copyright (c) 1998 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1998 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/grab.test b/tests/grab.test
index 0be5b61..ae53673 100644
--- a/tests/grab.test
+++ b/tests/grab.test
@@ -4,7 +4,7 @@
# built-in commands. Sourcing this file runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1998-2000 by Ajuba Solutions.
+# Copyright © 1998-2000 by Ajuba Solutions.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/grid.test b/tests/grid.test
index b033311..62f6ff6 100644
--- a/tests/grid.test
+++ b/tests/grid.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out the *NEW* "grid" command of Tk. It is
# (almost) organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/image.test b/tests/image.test
index 2203b6a..aa3bab8 100644
--- a/tests/image.test
+++ b/tests/image.test
@@ -2,9 +2,9 @@
# other procedures in the file tkImage.c. It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/imgBmap.test b/tests/imgBmap.test
index 4678bac..975210b 100644
--- a/tests/imgBmap.test
+++ b/tests/imgBmap.test
@@ -2,9 +2,9 @@
# the procedures in the file tkImgBmap.c). It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/imgListFormat.test b/tests/imgListFormat.test
index be92a07..4877645 100644
--- a/tests/imgListFormat.test
+++ b/tests/imgListFormat.test
@@ -2,7 +2,7 @@
# ("list format") implementend in the file tkImgListFormat.c.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 2017 Simon Bachmann
+# Copyright © 2017 Simon Bachmann
# All rights reserved.
#
# Author: Simon Bachmann (simonbachmann@bluewin.ch)
diff --git a/tests/imgPNG.test b/tests/imgPNG.test
index 927725c..1f3c8e8 100644
--- a/tests/imgPNG.test
+++ b/tests/imgPNG.test
@@ -2,10 +2,10 @@
# and write PNG-format image files for photo widgets. The files is organized
# in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 1998 Willem van Schaik (images only)
-# Copyright (c) 2008 Donal K. Fellows
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 1998 Willem van Schaik (images only)
+# Copyright © 2008 Donal K. Fellows
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/imgPPM.test b/tests/imgPPM.test
index e3a738a..b9dfe12 100644
--- a/tests/imgPPM.test
+++ b/tests/imgPPM.test
@@ -2,8 +2,8 @@
# which reads and write PPM-format image files for photo widgets.
# The files is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 2e7ca4c..8acf2bc 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -2,10 +2,10 @@
# procedures in the file tkImgPhoto.c. It is organized in the standard fashion
# for Tcl tests.
#
-# Copyright (c) 1994 The Australian National University
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2002-2008 Donal K. Fellows
+# Copyright © 1994 The Australian National University
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2002-2008 Donal K. Fellows
# All rights reserved.
#
# Author: Paul Mackerras (paulus@cs.anu.edu.au)
diff --git a/tests/imgSVGnano.test b/tests/imgSVGnano.test
index 3bee035..e2789c2 100644
--- a/tests/imgSVGnano.test
+++ b/tests/imgSVGnano.test
@@ -2,7 +2,7 @@
# and write SVG-format image files for photo widgets. The files is organized
# in the standard fashion for Tcl tests.
#
-# Copyright (c) 2018 Rene Zaumseil
+# Copyright © 2018 Rene Zaumseil
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/listbox.test b/tests/listbox.test
index df7536d..e56a12a 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the "listbox" command
# of Tk. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1993-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1993-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/main.test b/tests/main.test
index deb0783..19bbf5a 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -4,7 +4,7 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1997 by Sun Microsystems, Inc.
+# Copyright © 1997 by Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
@@ -27,8 +27,7 @@ test main-2.1 {Tk_MainEx: -encoding option} -constraints stdio -setup {
set f [open $script w]
fconfigure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
- puts -nonewline $f {puts [string equal \u20ac }
- puts $f "\u20ac]; exit"
+ puts $f {puts [string equal \u20AC €]; exit}
close $f
catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]}
} -body {
@@ -44,8 +43,7 @@ test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup {
set f [open $script w]
fconfigure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
- puts -nonewline $f {puts [string equal \u20ac }
- puts $f "\u20ac]; exit"
+ puts $f {puts [string equal \u20AC €]; exit}
close $f
catch {set f [open "|[list [interpreter] -encoding ascii script]" r]}
} -body {
@@ -76,8 +74,7 @@ test main-2.3 {Tk_MainEx: -encoding option} -constraints stdio -setup {
set f [open $script w]
fconfigure $f -encoding utf-8
puts $f {puts [list $argv0 $argv $tcl_interactive]}
- puts -nonewline $f {puts [string equal \u20ac }
- puts $f "\u20ac]"
+ puts $f {puts [string equal \u20AC €]}
close $f
catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]}
} -body {
diff --git a/tests/menu.test b/tests/menu.test
index 58c29d5..7de5a68 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test menus in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1995-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/menuDraw.test b/tests/menuDraw.test
index f7c6faa..8d20ce9 100644
--- a/tests/menuDraw.test
+++ b/tests/menuDraw.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test drawing of menus in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/menubut.test b/tests/menubut.test
index 535eafb..a97904f 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test menubuttons in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
# XXX This test file is woefully incomplete right now. If any part
diff --git a/tests/message.test b/tests/message.test
index 02c04f4..a547e4e 100644
--- a/tests/message.test
+++ b/tests/message.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the "message" command
# of Tk. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 by Ajuba Solutions.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-2000 by Ajuba Solutions.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/msgbox.test b/tests/msgbox.test
index 8fd0dae..465df05 100644
--- a/tests/msgbox.test
+++ b/tests/msgbox.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out Tk's "tk_messageBox" command.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/obj.test b/tests/obj.test
index eece58e..a2a9148 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test new object types in Tk.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/oldpack.test b/tests/oldpack.test
index c3676ec..68a56a0 100644
--- a/tests/oldpack.test
+++ b/tests/oldpack.test
@@ -2,9 +2,9 @@
# "pack" command (before release 3.3). It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1991-1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/option.test b/tests/option.test
index 5e1568e..ba5f38c 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the option-handling facilities
# of Tk. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1991-1993 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -401,7 +401,7 @@ test option-15.10 {database files} -body {
} -returnCodes error -result {missing colon on line 2}
set option3 [file join [testsDirectory] option.file3]
option read $option3
-test option-15.11 {database files} {option get . {x 4} color} br\xf3wn
+test option-15.11 {database files} {option get . {x 4} color} brówn
test option-16.1 {ReadOptionFile} -body {
set option4 [makeFile {} option.file3]
diff --git a/tests/pack.test b/tests/pack.test
index ba50d78..e69dd69 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the "pack" command of Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1993 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1993 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/packgrid.test b/tests/packgrid.test
index d0ad855..db49f60 100644
--- a/tests/packgrid.test
+++ b/tests/packgrid.test
@@ -2,7 +2,7 @@
# "grid" commands.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 2008 Peter Spjuth
+# Copyright © 2008 Peter Spjuth
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/panedwindow.test b/tests/panedwindow.test
index 3e834e9..7e07762 100644
--- a/tests/panedwindow.test
+++ b/tests/panedwindow.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test entry widgets in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/pkgconfig.test b/tests/pkgconfig.test
index f07ca0f..47a9c0e 100644
--- a/tests/pkgconfig.test
+++ b/tests/pkgconfig.test
@@ -5,10 +5,10 @@
# built-in commands. Sourcing this file into Tk runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1991-1993 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2017 Stuart Cassoff <stwo@users.sourceforge.net>
+# Copyright © 1991-1993 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2017 Stuart Cassoff <stwo@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/tests/place.test b/tests/place.test
index 4bf9689..e60b706 100644
--- a/tests/place.test
+++ b/tests/place.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test out the "place" command. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/raise.test b/tests/raise.test
index f8674fc..56a41eb 100644
--- a/tests/raise.test
+++ b/tests/raise.test
@@ -3,9 +3,9 @@
# stacking order. It is organized in the standard fashion
# for Tcl tests.
#
-# Copyright (c) 1993-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1993-1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/safe.test b/tests/safe.test
index 31cb1b7..627d242 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the Safe Tk facility. It is organized in
# the standard fashion for Tk tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/safePrimarySelection.test b/tests/safePrimarySelection.test
index 30d8fe1..713eedc 100644
--- a/tests/safePrimarySelection.test
+++ b/tests/safePrimarySelection.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test entry widgets in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/scale.test b/tests/scale.test
index 18b78f8..055762f 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the "scale" command
# of Tk. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# 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 6601099..e366c40 100644
--- a/tests/scrollbar.test
+++ b/tests/scrollbar.test
@@ -2,9 +2,9 @@
# the "scrollbar" command of Tk. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -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 31d6494..b1d5d56 100644
--- a/tests/select.test
+++ b/tests/select.test
@@ -2,8 +2,8 @@
# especially the "selection" command. It is organized in the standard fashion
# for Tcl tests.
#
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
@@ -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/send.test b/tests/send.test
index d3322e5..33d3d7c 100644
--- a/tests/send.test
+++ b/tests/send.test
@@ -2,10 +2,10 @@
# other procedures in the file tkSend.c. It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2001 by ActiveState Corporation.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2001 by ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/tests/spinbox.test b/tests/spinbox.test
index b858988..044b59c 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test spinbox widgets in Tk. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -1090,7 +1090,7 @@ test spinbox-3.7 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraint
update
} -body {
# Tcl_UtfAtIndex(): utf at end
- .e insert 0 "ab\u4e4e"
+ .e insert 0 "ab乎"
.e bbox end
} -cleanup {
destroy .e
@@ -1103,7 +1103,7 @@ test spinbox-3.8 {SpinboxWidgetCmd procedure, "bbox" widget command} -constraint
update
} -body {
# Tcl_UtfAtIndex(): utf before index
- .e insert 0 "ab\u4e4ec"
+ .e insert 0 "ab乎c"
.e bbox 3
} -cleanup {
destroy .e
@@ -1125,7 +1125,7 @@ test spinbox-3.10 {SpinboxWidgetCmd procedure, "bbox" widget command} -constrain
pack .e
update
} -body {
- .e insert 0 "abcdefghij\u4e4eklmnop"
+ .e insert 0 "abcdefghij乎klmnop"
list [.e bbox 0] [.e bbox 1] [.e bbox 10] [.e bbox end]
} -cleanup {
destroy .e
@@ -1239,20 +1239,20 @@ test spinbox-3.24 {SpinboxWidgetCmd procedure, "delete" widget command} -setup {
set x {}
} -body {
# UTF
- .e insert end "01234\u4e4e67890"
+ .e insert end "01234乎67890"
.e delete 6
lappend x [.e get]
.e delete 0 end
- .e insert end "012345\u4e4e7890"
+ .e insert end "012345乎7890"
.e delete 6
lappend x [.e get]
.e delete 0 end
- .e insert end "0123456\u4e4e890"
+ .e insert end "0123456乎890"
.e delete 6
lappend x [.e get]
} -cleanup {
destroy .e
-} -result [list "01234\u4e4e7890" "0123457890" "012345\u4e4e890"]
+} -result [list "01234乎7890" "0123457890" "012345乎890"]
test spinbox-3.25 {SpinboxWidgetCmd procedure, "delete" widget command} -setup {
spinbox .e
pack .e
@@ -1356,7 +1356,7 @@ test spinbox-3.35 {SpinboxWidgetCmd procedure, "index" widget command} -setup {
update
} -body {
# UTF
- .e insert 0 abc\u4e4e\u0153def
+ .e insert 0 abc乎œdef
list [.e index 3] [.e index 4] [.e index end]
} -cleanup {
destroy .e
@@ -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
@@ -1898,7 +1898,7 @@ test spinbox-3.81 {SpinboxWidgetCmd procedure, "xview" widget command} -setup {
} -body {
.e insert end "This is quite a long text string, so long that it "
.e insert end "runs off the end of the window quite a bit."
- .e insert 10 \u4e4e
+ .e insert 10 乎
update
# UTF
# If Tcl_NumUtfChars wasn't used, wrong answer would be:
diff --git a/tests/text.test b/tests/text.test
index df2769e..19b19a9 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in the file tkText.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -4581,25 +4581,25 @@ test text-22.68 {TextSearchCmd, freeing copy of pattern} -body {
} -result {}
test text-22.69 {TextSearchCmd, unicode} -body {
text .t
- .t insert end "foo\u30c9\u30cabar"
- .t search \u30c9\u30ca 1.0
+ .t insert end "fooドナbar"
+ .t search ドナ 1.0
} -cleanup {
destroy .t
} -result {1.3}
test text-22.70 {TextSearchCmd, unicode} -body {
text .t
- .t insert end "foo\u30c9\u30cabar"
- list [.t search -count n \u30c9\u30ca 1.0] $n
+ .t insert end "fooドナbar"
+ list [.t search -count n ドナ 1.0] $n
} -cleanup {
destroy .t
} -result {1.3 2}
test text-22.71 {TextSearchCmd, unicode with non-text segments} -body {
text .t
button .b1 -text baz
- .t insert end "foo\u30c9"
+ .t insert end "fooド"
.t window create end -window .b1
- .t insert end "\u30cabar"
- list [.t search -count n \u30c9\u30ca 1.0] $n
+ .t insert end "ナbar"
+ list [.t search -count n ドナ 1.0] $n
} -cleanup {
destroy .t .b1
} -result {1.3 3}
@@ -5824,7 +5824,7 @@ test text-22.217.1 {elide up to match, with UTF-8 chars before the match} -setup
} -body {
.t tag configure e -elide 0
.t insert end A {} xyz e bb\n
- .t insert end \xC4 {} xyz e bb
+ .t insert end Ä {} xyz e bb
set res {}
lappend res [.t search bb 1.0 "1.0 lineend"]
lappend res [.t search bb 2.0 "2.0 lineend"]
@@ -6431,19 +6431,19 @@ test text-24.24 {TextDumpCmd procedure, command script} -setup {
} -result {mark 1.0 current mark 1.0 insert mark 2.4 m}
test text-24.25 {TextDumpCmd procedure, unicode characters} -body {
text .t
- .t insert 1.0 \xb1\xb1\xb1
+ .t insert 1.0 ±±±
.t dump -all 1.0 2.0
} -cleanup {
destroy .t
-} -result "text \xb1\xb1\xb1 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
+} -result "text ±±± 1.0 mark insert 1.3 mark current 1.3 text {\n} 1.3"
test text-24.26 {TextDumpCmd procedure, unicode characters} -body {
text .t
.t delete 1.0 end
- .t insert 1.0 abc\xb1\xb1\xb1
+ .t insert 1.0 abc±±±
.t dump -all 1.0 2.0
} -cleanup {
destroy .t
-} -result "text abc\xb1\xb1\xb1 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
+} -result "text abc±±± 1.0 mark insert 1.6 mark current 1.6 text {\n} 1.6"
test text-24.27 {TextDumpCmd procedure, peer present} -body {
text .t
.t peer create .t.t
diff --git a/tests/textBTree.test b/tests/textBTree.test
index fd97afa..fa69f48 100644
--- a/tests/textBTree.test
+++ b/tests/textBTree.test
@@ -3,9 +3,9 @@
# several file with additional tests for other features of text widgets.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 69c53b2..c1cae00 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in the file tkTextDisp.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -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/textImage.test b/tests/textImage.test
index 2666ec5..b4f80d7 100644
--- a/tests/textImage.test
+++ b/tests/textImage.test
@@ -4,7 +4,7 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# 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/textIndex.test b/tests/textIndex.test
index 656542c..195c1e1 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in the file tkTextIndex.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -30,7 +30,7 @@ wm deiconify .
abcdefghijklm
12345
Line 4
-b\u4e4fy GIrl .#@? x_yz
+b乏y GIrl .#@? x_yz
!@#$%
Line 7"
@@ -118,7 +118,7 @@ test textIndex-1.16 {TkTextMakeByteIndex: UTF-8 characters} {testtext} {
test textIndex-1.17 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
{testtext} {
# ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType))
- # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
+ # Wrong answer would be ¹ (the 2nd byte of UTF rep of 0x4e4f).
set x [testtext .t byteindex 5 2]
list $x [.t get insert]
@@ -128,7 +128,7 @@ test textIndex-1.18 {TkTextMakeByteIndex: prevent splitting UTF-8 character} \
# ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType))
testtext .t byteindex 5 1
.t get insert
-} "\u4e4f"
+} "乏"
test textIndex-2.1 {TkTextMakeCharIndex} {
# (lineIndex < 0)
@@ -183,7 +183,7 @@ test textIndex-2.11 {TkTextMakeCharIndex: verify index is in range} {
} 3.4
test textIndex-2.12 {TkTextMakeCharIndex: verify index is in range} {
# (segPtr->typePtr == &tkTextCharType)
- # Wrong answer would be \xb9 (the 2nd byte of UTF rep of 0x4e4f).
+ # Wrong answer would be ¹ (the 2nd byte of UTF rep of 0x4e4f).
.t mark set insert 5.2
.t get insert
@@ -608,7 +608,7 @@ test textIndex-14.15 {TkTextIndexBackChars: UTF} {
} y
test textIndex-14.16 {TkTextIndexBackChars: UTF} {
.t get {5.3 - 2 chars}
-} \u4e4f
+} 乏
test textIndex-14.17 {TkTextIndexBackChars: UTF} {
.t get {5.3 - 3 chars}
} b
@@ -871,19 +871,19 @@ test textIndex-21.9 {text index wordend} {
text_test_word worde "x.y" end-1
} 2
test textIndex-21.10 {text index wordend, unicode} {
- text_test_word wordend "xyz\xC7de fg" 0
+ text_test_word wordend "xyzÇde fg" 0
} 6
test textIndex-21.11 {text index wordend, unicode} {
- text_test_word wordend "xyz\uc700de fg" 0
+ text_test_word wordend "xyz윀de fg" 0
} 6
test textIndex-21.12 {text index wordend, unicode} {
- text_test_word wordend "xyz\u203fde fg" 0
+ text_test_word wordend "xyz‿de fg" 0
} 6
test textIndex-21.13 {text index wordend, unicode} {
- text_test_word wordend "xyz\u2045de fg" 0
+ text_test_word wordend "xyz⁅de fg" 0
} 3
test textIndex-21.14 {text index wordend, unicode} {
- text_test_word wordend "\uc700\uc700 abc" 8
+ text_test_word wordend "윀윀 abc" 8
} 6
test textIndex-22.5 {text index wordstart} {
@@ -905,19 +905,19 @@ test textIndex-22.10 {text index wordstart} {
text_test_word wordstart "one two three" end-5
} 7
test textIndex-22.11 {text index wordstart, unicode} {
- text_test_word wordstart "one tw\xC7o three" 7
+ text_test_word wordstart "one twÇo three" 7
} 4
test textIndex-22.12 {text index wordstart, unicode} {
- text_test_word wordstart "ab\uc700\uc700 cdef ghi" 12
+ text_test_word wordstart "ab윀윀 cdef ghi" 12
} 10
test textIndex-22.13 {text index wordstart, unicode} {
- text_test_word wordstart "\uc700\uc700 abc" 8
+ text_test_word wordstart "윀윀 abc" 8
} 3
test textIndex-22.14 {text index wordstart, unicode, start index at internal segment start} {
catch {destroy .t}
text .t
- .t insert end "C'est du texte en fran\xE7ais\n"
- .t insert end "\u042D\u0442\u043E \u0442\u0435\u043A\u0441\u0442 \u043D\u0430 \u0440\u0443\u0441\u0441\u043A\u043E\u043C"
+ .t insert end "C'est du texte en français\n"
+ .t insert end "Это текст на русском"
.t mark set insert 1.23
set res [.t index "1.23 wordstart"]
.t mark set insert 2.16
diff --git a/tests/textMark.test b/tests/textMark.test
index 2fa13b8..3046f67 100644
--- a/tests/textMark.test
+++ b/tests/textMark.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in the file tkTextMark.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/textTag.test b/tests/textTag.test
index e923611..1edfcb2 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in the file tkTextTag.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/textWind.test b/tests/textWind.test
index 03793a4..ee634af 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in the file tkTextWind.c.
# This file is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/tk.test b/tests/tk.test
index 45690ce..1f5ade9 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the tk command.
# It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2002 ActiveState Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2002 ActiveState Corporation.
package require tcltest 2.2
eval tcltest::configure $argv
diff --git a/tests/ttk/entry.test b/tests/ttk/entry.test
index a958d90..501bad6 100644
--- a/tests/ttk/entry.test
+++ b/tests/ttk/entry.test
@@ -109,7 +109,7 @@ test entry-3.0 "Series 3 setup" -body {
variable cw [font measure $fixed a]
variable ch [font metrics $fixed -linespace]
variable bd 2 ;# border + padding
- variable ux [font measure $fixed \u4e4e]
+ variable ux [font measure $fixed 乎]
pack [ttk::entry .e -font $fixed -width 20]
update
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/unixButton.test b/tests/unixButton.test
index f0dcde5..5a55c5e 100644
--- a/tests/unixButton.test
+++ b/tests/unixButton.test
@@ -3,9 +3,9 @@
# widgets defined in tkUnixButton.c). It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 151ecf2..8315ae3 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -2,8 +2,8 @@
# tkUnixEmbed.c. It is organized in the standard fashion for Tcl
# tests.
#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/unixFont.test b/tests/unixFont.test
index dacfd03..0684bc5 100644
--- a/tests/unixFont.test
+++ b/tests/unixFont.test
@@ -8,8 +8,8 @@
# fonts having or not having certain properties, which may not be valid
# at all sites.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -259,7 +259,7 @@ test unixfont-8.3 {AllocFont procedure: can't parse info from name} x11 {
} {-family -overstrike -size -slant -underline -weight}
test unixfont-8.4 {AllocFont procedure: classify characters} {x11 failsOnUbuntu failsOnXQuarz} {
set x 0
- incr x [font measure $courier "\u4000"] ;# 6
+ incr x [font measure $courier "䀀"] ;# 6
incr x [font measure $courier "\002"] ;# 4
incr x [font measure $courier "\012"] ;# 2
incr x [font measure $courier "\101"] ;# 1
diff --git a/tests/unixMenu.test b/tests/unixMenu.test
index 63e4849..3acffcc 100644
--- a/tests/unixMenu.test
+++ b/tests/unixMenu.test
@@ -3,8 +3,8 @@
# file tests the Macintosh-specific features of the menu
# system.
#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/unixSelect.test b/tests/unixSelect.test
index 9bb90cb..75e16e4 100644
--- a/tests/unixSelect.test
+++ b/tests/unixSelect.test
@@ -4,7 +4,7 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1999 by Scriptics Corporation.
+# Copyright © 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -115,7 +115,7 @@ test unixSelect-1.1 {TkSelGetSelection procedure: simple i18n text} -constraints
} -body {
pack [entry .e]
update
- .e insert 0 \xFCber
+ .e insert 0 über
.e selection range 0 end
dobg {string length [selection get]}
} -cleanup {
@@ -131,13 +131,13 @@ test unixSelect-1.2 {TkSelGetSelection procedure: simple i18n text, iso8859-1} -
dobg {
pack [entry .e]
update
- .e insert 0 \xFC\u0444
+ .e insert 0 üф
.e selection range 0 end
}
selection get
} -cleanup {
cleanupbg
-} -result \xFC?
+} -result ü?
test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -constraints {
x11
@@ -148,11 +148,11 @@ test unixSelect-1.3 {TkSelGetSelection procedure: simple i18n text, iso2022} -co
selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
{handler COMPOUND_TEXT}
selection own .
- set selValue \xFC\u0444
+ set selValue üф
set selInfo {}
set result [dobg {
set x [selection get -type COMPOUND_TEXT]
- list [string equal \xFC\u0444 $x] [string length $x]
+ list [string equal üф $x] [string length $x]
}]
lappend result $selInfo
} -cleanup {
@@ -172,12 +172,12 @@ test unixSelect-1.4 {TkSelGetSelection procedure: INCR i18n text, iso2022} -cons
selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
{handler COMPOUND_TEXT}
selection own .
- set selValue [string repeat x 3999]\xFC\u0444[string repeat x 3999]
+ set selValue [string repeat x 3999]üф[string repeat x 3999]
set selInfo {}
set result [dobg {
set x [selection get -type COMPOUND_TEXT]
list [string equal \
- [string repeat x 3999]\xFC\u0444[string repeat x 3999] $x] \
+ [string repeat x 3999]üф[string repeat x 3999] $x] \
[string length $x]
}]
lappend result $selInfo
@@ -194,11 +194,11 @@ test unixSelect-1.5 {TkSelGetSelection procedure: simple i18n text, iso2022} -co
selection handle -type COMPOUND_TEXT -format COMPOUND_TEXT . \
{handler COMPOUND_TEXT}
selection own .
- set selValue \xFC\u0444
+ set selValue üф
set selInfo {}
set result [dobg {
set x [selection get -type COMPOUND_TEXT]
- list [string equal \xFC\u0444 $x] [string length $x]
+ list [string equal üф $x] [string length $x]
}]
lappend result $selInfo
} -cleanup {
@@ -211,7 +211,7 @@ test unixSelect-1.6 {TkSelGetSelection procedure: INCR i18n text} -constraints {
setupbg
} -body {
dobg [subst -nobackslashes {entry .e; pack .e; update
- .e insert 0 \xFCber$longValue
+ .e insert 0 über$longValue
.e selection range 0 end}]
string length [selection get]
} -cleanup {
@@ -226,13 +226,13 @@ test unixSelect-1.7 {TkSelGetSelection procedure: INCR i18n text} -constraints {
dobg {
pack [entry .e]
update
- .e insert 0 [string repeat x 3999]\xFC
+ .e insert 0 [string repeat x 3999]ü
.e selection range 0 end
}
selection get
} -cleanup {
cleanupbg
-} -result [string repeat x 3999]\xFC
+} -result [string repeat x 3999]ü
test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints {
x11
@@ -242,13 +242,13 @@ test unixSelect-1.8 {TkSelGetSelection procedure: INCR i18n text} -constraints {
dobg {
pack [entry .e]
update
- .e insert 0 \xFC[string repeat x 3999]
+ .e insert 0 ü[string repeat x 3999]
.e selection range 0 end
}
selection get
} -cleanup {
cleanupbg
-} -result \xFC[string repeat x 3999]
+} -result ü[string repeat x 3999]
test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
x11
@@ -258,13 +258,13 @@ test unixSelect-1.9 {TkSelGetSelection procedure: INCR i18n text} -constraints {
dobg {
pack [entry .e]
update
- .e insert 0 [string repeat x 3999]\xFC[string repeat x 4000]
+ .e insert 0 [string repeat x 3999]ü[string repeat x 4000]
.e selection range 0 end
}
selection get
} -cleanup {
cleanupbg
-} -result [string repeat x 3999]\xFC[string repeat x 4000]
+} -result [string repeat x 3999]ü[string repeat x 4000]
# Now some tests to make sure that the right thing is done when
# transferring UTF8 selections, to prevent [Bug 614650] and its ilk
# from rearing its ugly head again.
@@ -277,13 +277,13 @@ test unixSelect-1.10 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [entry .e]
update
- .e insert 0 [string repeat x 3999]\xFC
+ .e insert 0 [string repeat x 3999]ü
.e selection range 0 end
}
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result [string repeat x 3999]\xFC
+} -result [string repeat x 3999]ü
test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
x11
@@ -293,13 +293,13 @@ test unixSelect-1.11 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [entry .e]
update
- .e insert 0 \xFC[string repeat x 3999]
+ .e insert 0 ü[string repeat x 3999]
.e selection range 0 end
}
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result \xFC[string repeat x 3999]
+} -result ü[string repeat x 3999]
test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
x11
@@ -309,13 +309,13 @@ test unixSelect-1.12 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [entry .e]
update
- .e insert 0 [string repeat x 3999]\xFC[string repeat x 4000]
+ .e insert 0 [string repeat x 3999]ü[string repeat x 4000]
.e selection range 0 end
}
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result [string repeat x 3999]\xFC[string repeat x 4000]
+} -result [string repeat x 3999]ü[string repeat x 4000]
test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -constraints {
x11
@@ -325,7 +325,7 @@ test unixSelect-1.13 {TkSelGetSelection procedure: simple i18n text, utf-8} -con
} -body {
pack [entry .e]
update
- .e insert 0 \xFCber\u0444
+ .e insert 0 überф
.e selection range 0 end
dobg {string length [selection get -type UTF8_STRING]}
} -cleanup {
@@ -341,13 +341,13 @@ test unixSelect-1.14 {TkSelGetSelection procedure: simple i18n text, utf-8} -con
dobg {
pack [entry .e]
update
- .e insert 0 \xFC\u0444
+ .e insert 0 üф
.e selection range 0 end
}
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result \xFC\u0444
+} -result üф
test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
x11
@@ -357,13 +357,13 @@ test unixSelect-1.15 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [entry .e]
update
- .e insert 0 [string repeat [string repeat \xC4\xE4 50]\n 21]
+ .e insert 0 [string repeat [string repeat Ää 50]\n 21]
.e selection range 0 end
}
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result [string repeat [string repeat \xC4\xE4 50]\n 21]
+} -result [string repeat [string repeat Ää 50]\n 21]
test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
x11
@@ -373,13 +373,13 @@ test unixSelect-1.16 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [entry .e]
update
- .e insert 0 i[string repeat [string repeat \xC4\xE4 50]\n 21]
+ .e insert 0 i[string repeat [string repeat Ää 50]\n 21]
.e selection range 0 end
}
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result i[string repeat [string repeat \xC4\xE4 50]\n 21]
+} -result i[string repeat [string repeat Ää 50]\n 21]
test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
x11
@@ -389,7 +389,7 @@ test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [text .t]
update
- .t insert 1.0 [string repeat [string repeat \xC4\xE4 50]\n 21]
+ .t insert 1.0 [string repeat [string repeat Ää 50]\n 21]
# Has to be selected in a separate stage
.t tag add sel 1.0 21.end+1c
}
@@ -397,7 +397,7 @@ test unixSelect-1.17 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result [string repeat [string repeat \xC4\xE4 50]\n 21]
+} -result [string repeat [string repeat Ää 50]\n 21]
test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -constraints {
x11
@@ -407,7 +407,7 @@ test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
dobg {
pack [text .t]
update
- .t insert 1.0 i[string repeat [string repeat \xC4\xE4 50]\n 21]
+ .t insert 1.0 i[string repeat [string repeat Ää 50]\n 21]
# Has to be selected in a separate stage
.t tag add sel 1.0 21.end+1c
}
@@ -415,7 +415,7 @@ test unixSelect-1.18 {TkSelGetSelection procedure: INCR i18n text, utf-8} -const
selection get -type UTF8_STRING
} -cleanup {
cleanupbg
-} -result i[string repeat [string repeat \xC4\xE4 50]\n 21]
+} -result i[string repeat [string repeat Ää 50]\n 21]
test unixSelect-1.19 {Automatic UTF8_STRING support for selection handle} -constraints {
unix
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 028c5be..dd1aa22 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -2,9 +2,9 @@
# the window manager, including the "wm" command. It is organized
# in the standard fashion for Tcl tests.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/util.test b/tests/util.test
index ed4a276..d88ee57 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the procedures in the file
# tkUtil.c. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -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/tests/visual.test b/tests/visual.test
index 8d63097..f6ad376 100644
--- a/tests/visual.test
+++ b/tests/visual.test
@@ -2,9 +2,9 @@
# procedures in the file tkVisual.c. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/winButton.test b/tests/winButton.test
index 88b4345..50906c8 100644
--- a/tests/winButton.test
+++ b/tests/winButton.test
@@ -3,9 +3,9 @@
# widgets defined in tkWinButton.c). It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/winClipboard.test b/tests/winClipboard.test
index 45bf484..7240fa6 100644
--- a/tests/winClipboard.test
+++ b/tests/winClipboard.test
@@ -6,8 +6,8 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1997 by Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 by Scriptics Corporation.
+# Copyright © 1997 by Sun Microsystems, Inc.
+# Copyright © 1998-2000 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -70,24 +70,23 @@ test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} -constraints {
clipboard clear
} -body {
set map [list "\r" "\\r" "\n" "\\n"]
- clipboard append "line 1\xC7\nline 2"
+ clipboard append "line 1Ç\nline 2"
list [string map $map [selection get -selection CLIPBOARD]]\
[string map $map [testclipboard]]
} -cleanup {
clipboard clear
-} -result [list "line 1\xC7\\nline 2" "line 1\xC7\\nline 2"]
+} -result [list "line 1Ç\\nline 2" "line 1Ç\\nline 2"]
test winClipboard-1.6 {TkSelGetSelection & TkWinClipboardRender} -constraints {
win testclipboard
} -setup {
clipboard clear
} -body {
- clipboard append "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"
+ clipboard append "привет миф"
list [selection get -selection CLIPBOARD] [testclipboard]
} -cleanup {
clipboard clear
-} -result [list "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"\
- "\u043f\u0440\u0438\u0432\u0435\u0442 \u043c\u0438\u0444"]
+} -result [list "привет миф" "привет миф"]
test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} -constraints {
win testclipboard
diff --git a/tests/winDialog.test b/tests/winDialog.test
index abb3a8e..e0daf24 100755
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -3,9 +3,9 @@
# the common dialog boxes. It is organized in the standard
# fashion for Tcl tests.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 1998-1999 ActiveState Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 1998-1999 ActiveState Corporation.
package require tcltest 2.2
namespace import ::tcltest::*
@@ -161,7 +161,7 @@ test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints {
set x {}
start {
set clr [tk_chooseColor -initialcolor "#ff9933" \
- -title "\u041f\u0440\u0438\u0432\u0435\u0442"]
+ -title "Привет"]
}
then {
if {[catch {
@@ -171,7 +171,7 @@ test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints {
lappend x [Click ok]
}
lappend x $clr
-} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"]
+} -result [list "Привет" 0 "#ff9933"]
test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
testwinevent
} -setup {
@@ -545,7 +545,7 @@ test winDialog-5.12.3 {tk_getSaveFile: initial directory: .} -constraints {
test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints {
nt testwinevent
} -body {
- set dir [tcltest::makeDirectory "\u0167\xE9\u015d\u0167"]
+ set dir [tcltest::makeDirectory "ŧéŝŧ"]
unset -nocomplain x
start {set x [tk_getSaveFile \
-initialdir $dir \
@@ -631,7 +631,7 @@ test winDialog-5.12.8 {tk_getOpenFile: initial directory: .} -constraints {
test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints {
nt testwinevent
} -body {
- set dir [tcltest::makeDirectory "\u0167\xE9\u015d\u0167"]
+ set dir [tcltest::makeDirectory "ŧéŝŧ"]
set path [tcltest::makeFile "" testfile $dir]
unset -nocomplain x
start {set x [tk_getOpenFile \
@@ -847,7 +847,7 @@ test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraint
} -body {
# MacOS type that is correct, but has embedded high-bit chars.
- start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]}
+ start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {••••}}}}]}
then {
Click cancel
}
@@ -1033,7 +1033,7 @@ test winDialog-10.9 {Tk_FontchooserObjCmd: -title} -constraints {
} -body {
start {
tk fontchooser configure -command ApplyFont \
- -title "\u041f\u0440\u0438\u0432\u0435\u0442"
+ -title "Привет"
tk fontchooser show
}
then {
@@ -1041,7 +1041,7 @@ test winDialog-10.9 {Tk_FontchooserObjCmd: -title} -constraints {
Click cancel
}
set a(text)
-} -result "\u041f\u0440\u0438\u0432\u0435\u0442"
+} -result "Привет"
if {[testConstraint testwinevent]} {
catch {testwinevent debug 0}
diff --git a/tests/winFont.test b/tests/winFont.test
index 599b091..1a8c115 100644
--- a/tests/winFont.test
+++ b/tests/winFont.test
@@ -6,8 +6,8 @@
# underlined?"); these tests attempt to exercise the code in question,
# but there are no results that can be checked.
#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/winMenu.test b/tests/winMenu.test
index b77e9a9..d3e7f83 100644
--- a/tests/winMenu.test
+++ b/tests/winMenu.test
@@ -3,8 +3,8 @@
# file tests the Macintosh-specific features of the menu
# system.
#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/winMsgbox.test b/tests/winMsgbox.test
index 447a2f6..cf7a05f 100644
--- a/tests/winMsgbox.test
+++ b/tests/winMsgbox.test
@@ -1,6 +1,6 @@
# This file is a Tcl script to test the Windows specific message box
#
-# Copyright (c) 2007 Pat Thoyts <patthoyts@users.sourceforge.net>
+# Copyright © 2007 Pat Thoyts <patthoyts@users.sourceforge.net>
package require tcltest 2.2
namespace import ::tcltest::*
@@ -224,14 +224,14 @@ test winMsgbox-2.3 {tk_messageBox message (unicode)} -constraints {
} -body {
global windowInfo
set title "winMsgbox-2.2 [pid]"
- set message "\u041f\u043e\u0438\u0441\u043a \u0441\u0442\u0440\u0430\u043d\u0438\u0446"
+ set message "Поиск страниц"
after 100 [list GetWindowInfo $title 2]
set r [tk_messageBox -type ok -title $title -message $message]
array set info $windowInfo
lappend r $info(childtext)
} -cleanup {
wm deiconify .
-} -result [list ok "\u041f\u043e\u0438\u0441\u043a \u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
+} -result [list ok "Поиск страниц"]
test winMsgbox-2.4 {tk_messageBox message (empty)} -constraints {
win getwindowinfo
@@ -276,15 +276,15 @@ test winMsgbox-3.2 {tk_messageBox detail (unicode)} -constraints {
} -body {
global windowInfo
set title "winMsgbox-3.1 [pid]"
- set message "\u041f\u043e\u0438\u0441\u043a"
- set detail "\u0441\u0442\u0440\u0430\u043d\u0438\u0446"
+ set message "Поиск"
+ set detail "страниц"
after 100 [list GetWindowInfo $title 2]
set r [tk_messageBox -type ok -title $title -message $message -detail $detail]
array set info $windowInfo
lappend r $info(childtext)
} -cleanup {
wm deiconify .
-} -result [list ok "\u041f\u043e\u0438\u0441\u043a\n\n\u0441\u0442\u0440\u0430\u043d\u0438\u0446"]
+} -result [list ok "Поиск\n\nстраниц"]
# -------------------------------------------------------------------------
diff --git a/tests/winSend.test b/tests/winSend.test
index a72589f..e8186df 100644
--- a/tests/winSend.test
+++ b/tests/winSend.test
@@ -2,9 +2,9 @@
# other procedures in the file tkSend.c. It is organized in the
# standard fashion for Tcl tests.
#
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 Sun Microsystems, Inc.
+# Copyright © 1994-1996 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/winWm.test b/tests/winWm.test
index baf8e3d..f4183cd 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -5,8 +5,8 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1996 by Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1996 by Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/window.test b/tests/window.test
index fea695a..44f0b2a 100644
--- a/tests/window.test
+++ b/tests/window.test
@@ -1,8 +1,8 @@
# This file is a Tcl script to test the procedures in the file
# tkWindow.c. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1995 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/winfo.test b/tests/winfo.test
index a247346..ff3d6b5 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test out the "winfo" command. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
diff --git a/tests/wm.test b/tests/wm.test
index c1e6cba..5fd5ee1 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -2,9 +2,9 @@
# manager, including the "wm" command. It is organized in the standard fashion
# for Tcl tests.
#
-# Copyright (c) 1992-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1992-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
# This file tests window manager interactions that work across platforms.
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
index f50329c..8d6dbeb 100644
--- a/tests/xmfbox.test
+++ b/tests/xmfbox.test
@@ -5,8 +5,8 @@
# runs in a modal loop, the only way to test it sufficiently is
# to call the internal Tcl procedures in xmfbox.tcl directly.
#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright © 1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
# Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
# All rights reserved.
diff --git a/unix/install-sh b/unix/install-sh
index 7c34c3f..21b733a 100755
--- a/unix/install-sh
+++ b/unix/install-sh
@@ -1,7 +1,7 @@
#!/bin/sh
# install - install a program, script, or datafile
-scriptversion=2011-04-20.01; # UTC
+scriptversion=2020-07-26.22; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
@@ -35,25 +35,21 @@ scriptversion=2011-04-20.01; # UTC
# FSF changes to this file are in the public domain.
#
# Calling this script install-sh is preferred over install.sh, to prevent
-# `make' implicit rules from creating a file called install from it
+# 'make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.
+tab=' '
nl='
'
-IFS=" "" $nl"
+IFS=" $tab$nl"
-# set DOITPROG to echo to test this script
+# Set DOITPROG to "echo" to test this script.
-# Don't use :- since 4.3BSD and earlier shells don't like it.
doit=${DOITPROG-}
-if test -z "$doit"; then
- doit_exec=exec
-else
- doit_exec=$doit
-fi
+doit_exec=${doit:-exec}
# Put in absolute file names if you don't have them in your path;
# or use environment vars.
@@ -68,22 +64,15 @@ mvprog=${MVPROG-mv}
rmprog=${RMPROG-rm}
stripprog=${STRIPPROG-strip}
-posix_glob='?'
-initialize_posix_glob='
- test "$posix_glob" != "?" || {
- if (set -f) 2>/dev/null; then
- posix_glob=
- else
- posix_glob=:
- fi
- }
-'
-
posix_mkdir=
# Desired mode of installed file.
mode=0755
+# Create dirs (including intermediate dirs) using mode 755.
+# This is like GNU 'install' as of coreutils 8.32 (2020).
+mkdir_umask=22
+
chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
@@ -97,7 +86,7 @@ dir_arg=
dst_arg=
copy_on_change=false
-no_target_directory=
+is_target_a_directory=possibly
usage="\
Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
@@ -120,7 +109,7 @@ Options:
-m MODE $chmodprog installed files to MODE.
-o USER $chownprog installed files to USER.
-s $stripprog installed files.
- -S $stripprog installed files.
+ -S OPTION $stripprog installed files using OPTION.
-t DIRECTORY install into DIRECTORY.
-T report an error if DSTFILE is a directory.
@@ -138,45 +127,60 @@ while test $# -ne 0; do
-d) dir_arg=true;;
-g) chgrpcmd="$chgrpprog $2"
- shift;;
+ shift;;
--help) echo "$usage"; exit $?;;
-m) mode=$2
- case $mode in
- *' '* | *' '* | *'
-'* | *'*'* | *'?'* | *'['*)
- echo "$0: invalid mode: $mode" >&2
- exit 1;;
- esac
- shift;;
+ case $mode in
+ *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
+ echo "$0: invalid mode: $mode" >&2
+ exit 1;;
+ esac
+ shift;;
-o) chowncmd="$chownprog $2"
- shift;;
+ shift;;
-s) stripcmd=$stripprog;;
-S) stripcmd="$stripprog $2"
- shift;;
+ shift;;
- -t) dst_arg=$2
- shift;;
+ -t)
+ is_target_a_directory=always
+ dst_arg=$2
+ # Protect names problematic for 'test' and other utilities.
+ case $dst_arg in
+ -* | [=\(\)!]) dst_arg=./$dst_arg;;
+ esac
+ shift;;
- -T) no_target_directory=true;;
+ -T) is_target_a_directory=never;;
--version) echo "$0 $scriptversion"; exit $?;;
- --) shift
- break;;
+ --) shift
+ break;;
- -*) echo "$0: invalid option: $1" >&2
- exit 1;;
+ -*) echo "$0: invalid option: $1" >&2
+ exit 1;;
*) break;;
esac
shift
done
+# We allow the use of options -d and -T together, by making -d
+# take the precedence; this is for compatibility with GNU install.
+
+if test -n "$dir_arg"; then
+ if test -n "$dst_arg"; then
+ echo "$0: target directory not allowed when installing a directory." >&2
+ exit 1
+ fi
+fi
+
if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
# When -d is used, all remaining arguments are directories to create.
# When -t is used, the destination is already specified.
@@ -190,6 +194,10 @@ if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
fi
shift # arg
dst_arg=$arg
+ # Protect names problematic for 'test' and other utilities.
+ case $dst_arg in
+ -* | [=\(\)!]) dst_arg=./$dst_arg;;
+ esac
done
fi
@@ -198,12 +206,21 @@ if test $# -eq 0; then
echo "$0: no input file specified." >&2
exit 1
fi
- # It's OK to call `install-sh -d' without argument.
+ # It's OK to call 'install-sh -d' without argument.
# This can happen when creating conditional directories.
exit 0
fi
if test -z "$dir_arg"; then
+ if test $# -gt 1 || test "$is_target_a_directory" = always; then
+ if test ! -d "$dst_arg"; then
+ echo "$0: $dst_arg: Is not a directory." >&2
+ exit 1
+ fi
+ fi
+fi
+
+if test -z "$dir_arg"; then
do_exit='(exit $ret); exit $ret'
trap "ret=129; $do_exit" 1
trap "ret=130; $do_exit" 2
@@ -219,16 +236,16 @@ if test -z "$dir_arg"; then
*[0-7])
if test -z "$stripcmd"; then
- u_plus_rw=
+ u_plus_rw=
else
- u_plus_rw='% 200'
+ u_plus_rw='% 200'
fi
cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
*)
if test -z "$stripcmd"; then
- u_plus_rw=
+ u_plus_rw=
else
- u_plus_rw=,u+rw
+ u_plus_rw=,u+rw
fi
cp_umask=$mode$u_plus_rw;;
esac
@@ -236,9 +253,9 @@ fi
for src
do
- # Protect names starting with `-'.
+ # Protect names problematic for 'test' and other utilities.
case $src in
- -*) src=./$src;;
+ -* | [=\(\)!]) src=./$src;;
esac
if test -n "$dir_arg"; then
@@ -260,185 +277,150 @@ do
echo "$0: no destination specified." >&2
exit 1
fi
-
dst=$dst_arg
- # Protect names starting with `-'.
- case $dst in
- -*) dst=./$dst;;
- esac
- # If destination is a directory, append the input filename; won't work
- # if double slashes aren't ignored.
+ # If destination is a directory, append the input filename.
if test -d "$dst"; then
- if test -n "$no_target_directory"; then
- echo "$0: $dst_arg: Is a directory" >&2
- exit 1
+ if test "$is_target_a_directory" = never; then
+ echo "$0: $dst_arg: Is a directory" >&2
+ exit 1
fi
dstdir=$dst
- dst=$dstdir/`basename "$src"`
+ dstbase=`basename "$src"`
+ case $dst in
+ */) dst=$dst$dstbase;;
+ *) dst=$dst/$dstbase;;
+ esac
dstdir_status=0
else
- # Prefer dirname, but fall back on a substitute if dirname fails.
- dstdir=`
- (dirname "$dst") 2>/dev/null ||
- expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$dst" : 'X\(//\)[^/]' \| \
- X"$dst" : 'X\(//\)$' \| \
- X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
- echo X"$dst" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'
- `
-
+ dstdir=`dirname "$dst"`
test -d "$dstdir"
dstdir_status=$?
fi
fi
+ case $dstdir in
+ */) dstdirslash=$dstdir;;
+ *) dstdirslash=$dstdir/;;
+ esac
+
obsolete_mkdir_used=false
if test $dstdir_status != 0; then
case $posix_mkdir in
'')
- # Create intermediate dirs using mode 755 as modified by the umask.
- # This is like FreeBSD 'install' as of 1997-10-28.
- umask=`umask`
- case $stripcmd.$umask in
- # Optimize common cases.
- *[2367][2367]) mkdir_umask=$umask;;
- .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
-
- *[0-7])
- mkdir_umask=`expr $umask + 22 \
- - $umask % 100 % 40 + $umask % 20 \
- - $umask % 10 % 4 + $umask % 2
- `;;
- *) mkdir_umask=$umask,go-w;;
- esac
-
- # With -d, create the new directory with the user-specified mode.
- # Otherwise, rely on $mkdir_umask.
- if test -n "$dir_arg"; then
- mkdir_mode=-m$mode
+ # With -d, create the new directory with the user-specified mode.
+ # Otherwise, rely on $mkdir_umask.
+ if test -n "$dir_arg"; then
+ mkdir_mode=-m$mode
+ else
+ mkdir_mode=
+ fi
+
+ posix_mkdir=false
+ # The $RANDOM variable is not portable (e.g., dash). Use it
+ # here however when possible just to lower collision chance.
+ tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
+
+ trap '
+ ret=$?
+ rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
+ exit $ret
+ ' 0
+
+ # Because "mkdir -p" follows existing symlinks and we likely work
+ # directly in world-writeable /tmp, make sure that the '$tmpdir'
+ # directory is successfully created first before we actually test
+ # 'mkdir -p'.
+ if (umask $mkdir_umask &&
+ $mkdirprog $mkdir_mode "$tmpdir" &&
+ exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
+ then
+ if test -z "$dir_arg" || {
+ # Check for POSIX incompatibilities with -m.
+ # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
+ # other-writable bit of parent directory when it shouldn't.
+ # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
+ test_tmpdir="$tmpdir/a"
+ ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
+ case $ls_ld_tmpdir in
+ d????-?r-*) different_mode=700;;
+ d????-?--*) different_mode=755;;
+ *) false;;
+ esac &&
+ $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
+ ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
+ test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
+ }
+ }
+ then posix_mkdir=:
+ fi
+ rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
else
- mkdir_mode=
+ # Remove any dirs left behind by ancient mkdir implementations.
+ rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
fi
-
- posix_mkdir=false
- case $umask in
- *[123567][0-7][0-7])
- # POSIX mkdir -p sets u+wx bits regardless of umask, which
- # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
- ;;
- *)
- tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
- trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
-
- if (umask $mkdir_umask &&
- exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
- then
- if test -z "$dir_arg" || {
- # Check for POSIX incompatibilities with -m.
- # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
- # other-writeable bit of parent directory when it shouldn't.
- # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
- ls_ld_tmpdir=`ls -ld "$tmpdir"`
- case $ls_ld_tmpdir in
- d????-?r-*) different_mode=700;;
- d????-?--*) different_mode=755;;
- *) false;;
- esac &&
- $mkdirprog -m$different_mode -p -- "$tmpdir" && {
- ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
- test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
- }
- }
- then posix_mkdir=:
- fi
- rmdir "$tmpdir/d" "$tmpdir"
- else
- # Remove any dirs left behind by ancient mkdir implementations.
- rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
- fi
- trap '' 0;;
- esac;;
+ trap '' 0;;
esac
if
$posix_mkdir && (
- umask $mkdir_umask &&
- $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
+ umask $mkdir_umask &&
+ $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
)
then :
else
- # The umask is ridiculous, or mkdir does not conform to POSIX,
+ # mkdir does not conform to POSIX,
# or it failed possibly due to a race condition. Create the
# directory the slow way, step by step, checking for races as we go.
case $dstdir in
- /*) prefix='/';;
- -*) prefix='./';;
- *) prefix='';;
+ /*) prefix='/';;
+ [-=\(\)!]*) prefix='./';;
+ *) prefix='';;
esac
- eval "$initialize_posix_glob"
-
oIFS=$IFS
IFS=/
- $posix_glob set -f
+ set -f
set fnord $dstdir
shift
- $posix_glob set +f
+ set +f
IFS=$oIFS
prefixes=
for d
do
- test -z "$d" && continue
-
- prefix=$prefix$d
- if test -d "$prefix"; then
- prefixes=
- else
- if $posix_mkdir; then
- (umask=$mkdir_umask &&
- $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
- # Don't fail if two instances are running concurrently.
- test -d "$prefix" || exit 1
- else
- case $prefix in
- *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
- *) qprefix=$prefix;;
- esac
- prefixes="$prefixes '$qprefix'"
- fi
- fi
- prefix=$prefix/
+ test X"$d" = X && continue
+
+ prefix=$prefix$d
+ if test -d "$prefix"; then
+ prefixes=
+ else
+ if $posix_mkdir; then
+ (umask $mkdir_umask &&
+ $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
+ # Don't fail if two instances are running concurrently.
+ test -d "$prefix" || exit 1
+ else
+ case $prefix in
+ *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) qprefix=$prefix;;
+ esac
+ prefixes="$prefixes '$qprefix'"
+ fi
+ fi
+ prefix=$prefix/
done
if test -n "$prefixes"; then
- # Don't fail if two instances are running concurrently.
- (umask $mkdir_umask &&
- eval "\$doit_exec \$mkdirprog $prefixes") ||
- test -d "$dstdir" || exit 1
- obsolete_mkdir_used=true
+ # Don't fail if two instances are running concurrently.
+ (umask $mkdir_umask &&
+ eval "\$doit_exec \$mkdirprog $prefixes") ||
+ test -d "$dstdir" || exit 1
+ obsolete_mkdir_used=true
fi
fi
fi
@@ -451,14 +433,25 @@ do
else
# Make a couple of temp file names in the proper directory.
- dsttmp=$dstdir/_inst.$$_
- rmtmp=$dstdir/_rm.$$_
+ dsttmp=${dstdirslash}_inst.$$_
+ rmtmp=${dstdirslash}_rm.$$_
# Trap to clean up those temp files at exit.
trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
# Copy the file name to the temp name.
- (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
+ (umask $cp_umask &&
+ { test -z "$stripcmd" || {
+ # Create $dsttmp read-write so that cp doesn't create it read-only,
+ # which would cause strip to fail.
+ if test -z "$doit"; then
+ : >"$dsttmp" # No need to fork-exec 'touch'.
+ else
+ $doit touch "$dsttmp"
+ fi
+ }
+ } &&
+ $doit_exec $cpprog "$src" "$dsttmp") &&
# and set any options; do chmod last to preserve setuid bits.
#
@@ -473,15 +466,12 @@ do
# If -C, don't bother to copy if it wouldn't change the file.
if $copy_on_change &&
- old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
- new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
-
- eval "$initialize_posix_glob" &&
- $posix_glob set -f &&
+ old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
+ new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
+ set -f &&
set X $old && old=:$2:$4:$5:$6 &&
set X $new && new=:$2:$4:$5:$6 &&
- $posix_glob set +f &&
-
+ set +f &&
test "$old" = "$new" &&
$cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
then
@@ -494,24 +484,24 @@ do
# to itself, or perhaps because mv is so ancient that it does not
# support -f.
{
- # Now remove or move aside any old file at destination location.
- # We try this two ways since rm can't unlink itself on some
- # systems and the destination file might be busy for other
- # reasons. In this case, the final cleanup might fail but the new
- # file should still install successfully.
- {
- test ! -f "$dst" ||
- $doit $rmcmd -f "$dst" 2>/dev/null ||
- { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
- { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
- } ||
- { echo "$0: cannot unlink or rename $dst" >&2
- (exit 1); exit 1
- }
- } &&
-
- # Now rename the file to the real destination.
- $doit $mvcmd "$dsttmp" "$dst"
+ # Now remove or move aside any old file at destination location.
+ # We try this two ways since rm can't unlink itself on some
+ # systems and the destination file might be busy for other
+ # reasons. In this case, the final cleanup might fail but the new
+ # file should still install successfully.
+ {
+ test ! -f "$dst" ||
+ $doit $rmcmd -f "$dst" 2>/dev/null ||
+ { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
+ { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
+ } ||
+ { echo "$0: cannot unlink or rename $dst" >&2
+ (exit 1); exit 1
+ }
+ } &&
+
+ # Now rename the file to the real destination.
+ $doit $mvcmd "$dsttmp" "$dst"
}
fi || exit 1
@@ -520,9 +510,9 @@ do
done
# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
+# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
-# time-stamp-time-zone: "UTC"
+# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
-# End:
+# End: \ No newline at end of file
diff --git a/unix/tkAppInit.c b/unix/tkAppInit.c
index 9e6c112..db44bb7 100644
--- a/unix/tkAppInit.c
+++ b/unix/tkAppInit.c
@@ -15,6 +15,7 @@
#undef BUILD_tk
#undef STATIC_BUILD
#include "tk.h"
+#include "tkPort.h"
#ifdef TK_TEST
#ifdef __cplusplus
@@ -120,6 +121,13 @@ Tcl_AppInit(
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+#if defined(USE_CUSTOM_EXIT_PROC)
+ if (TkpWantsExitProc()) {
+ /* The cast below avoids warnings from old gcc compilers. */
+ Tcl_SetExitProc((void *)TkpExitProc);
+ }
+#endif
+
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
diff --git a/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;