summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2019-04-02 20:33:47 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2019-04-02 20:33:47 (GMT)
commit2cf64c85fc09764112c6d2daa54f22c9b2c3b549 (patch)
treebad71bde8042ba33f09184ff350278a959a23290
parent40b76dbd4f4479294a9cd461da0400e31734ac2b (diff)
parent6d61d799f483c98a1e0aeb624fa001a7fce24af0 (diff)
downloadtk-2cf64c85fc09764112c6d2daa54f22c9b2c3b549.zip
tk-2cf64c85fc09764112c6d2daa54f22c9b2c3b549.tar.gz
tk-2cf64c85fc09764112c6d2daa54f22c9b2c3b549.tar.bz2
Merge trunk
-rw-r--r--doc/bind.n4
-rw-r--r--doc/grid.n2
-rw-r--r--doc/menu.n21
-rw-r--r--doc/scale.n4
-rw-r--r--doc/ttk_treeview.n3
-rw-r--r--doc/wm.n29
-rw-r--r--generic/tk.h2
-rw-r--r--generic/tkBind.c2
-rw-r--r--generic/tkCanvas.c29
-rw-r--r--generic/tkCmds.c58
-rw-r--r--generic/tkConfig.c6
-rw-r--r--generic/tkEntry.c20
-rw-r--r--generic/tkFileFilter.c12
-rw-r--r--generic/tkFocus.c70
-rw-r--r--generic/tkFont.c8
-rw-r--r--generic/tkGrid.c40
-rw-r--r--generic/tkImage.c4
-rw-r--r--generic/tkImgGIF.c21
-rw-r--r--generic/tkImgPhoto.c10
-rw-r--r--generic/tkInt.decls2
-rw-r--r--generic/tkIntPlatDecls.h4
-rw-r--r--generic/tkListbox.c16
-rw-r--r--generic/tkMacWinMenu.c2
-rw-r--r--generic/tkMain.c39
-rw-r--r--generic/tkMenu.c95
-rw-r--r--generic/tkMenu.h16
-rw-r--r--generic/tkMenuDraw.c75
-rw-r--r--generic/tkPack.c6
-rw-r--r--generic/tkPanedWindow.c14
-rw-r--r--generic/tkPlace.c6
-rw-r--r--generic/tkScale.c304
-rw-r--r--generic/tkScale.h15
-rw-r--r--generic/tkScrollbar.c8
-rw-r--r--generic/tkTest.c8
-rw-r--r--generic/tkText.c103
-rw-r--r--generic/tkTextDisp.c2
-rw-r--r--generic/tkWindow.c2
-rw-r--r--generic/ttk/ttkEntry.c4
-rw-r--r--generic/ttk/ttkTreeview.c12
-rw-r--r--generic/ttk/ttkWidget.c2
-rw-r--r--library/bgerror.tcl17
-rw-r--r--library/demos/puzzle.tcl2
-rw-r--r--library/menu.tcl248
-rw-r--r--library/ttk/altTheme.tcl2
-rw-r--r--library/ttk/aquaTheme.tcl2
-rw-r--r--library/ttk/clamTheme.tcl2
-rw-r--r--library/ttk/classicTheme.tcl2
-rw-r--r--library/ttk/defaults.tcl2
-rw-r--r--library/ttk/vistaTheme.tcl2
-rw-r--r--library/ttk/winTheme.tcl2
-rw-r--r--library/ttk/xpTheme.tcl2
-rw-r--r--macosx/tkMacOSXButton.c148
-rw-r--r--macosx/tkMacOSXDefault.h8
-rw-r--r--macosx/tkMacOSXDialog.c6
-rw-r--r--macosx/tkMacOSXEmbed.c146
-rw-r--r--macosx/tkMacOSXEvent.c38
-rw-r--r--macosx/tkMacOSXFont.c2
-rw-r--r--macosx/tkMacOSXInit.c10
-rw-r--r--macosx/tkMacOSXKeyEvent.c56
-rw-r--r--macosx/tkMacOSXMenu.c284
-rw-r--r--macosx/tkMacOSXMenubutton.c246
-rw-r--r--macosx/tkMacOSXMouseEvent.c166
-rw-r--r--macosx/tkMacOSXSend.c2
-rw-r--r--macosx/tkMacOSXSubwindows.c26
-rw-r--r--macosx/tkMacOSXWindowEvent.c23
-rw-r--r--macosx/tkMacOSXWm.c333
-rw-r--r--macosx/tkMacOSXWm.h20
-rw-r--r--macosx/tkMacOSXXStubs.c6
-rw-r--r--tests/imgPhoto.test33
-rw-r--r--tests/menu.test2
-rw-r--r--tests/menubut.test26
-rw-r--r--tests/scale.test59
-rw-r--r--tests/send.test18
-rw-r--r--tests/text.test15
-rw-r--r--tests/unixButton.test24
-rw-r--r--tests/unixEmbed.test636
-rw-r--r--tests/unixWm.test39
-rw-r--r--tests/wm.test14
-rw-r--r--unix/Makefile.in16
-rwxr-xr-xunix/configure229
-rw-r--r--unix/configure.ac4
-rw-r--r--unix/tcl.m4134
-rw-r--r--unix/tkUnixEmbed.c28
-rw-r--r--unix/tkUnixEvent.c6
-rw-r--r--unix/tkUnixFont.c2
-rw-r--r--unix/tkUnixMenu.c119
-rw-r--r--unix/tkUnixScale.c85
-rw-r--r--unix/tkUnixSend.c2
-rw-r--r--unix/tkUnixWm.c66
-rw-r--r--win/makefile.vc8
-rw-r--r--win/tkWinClipboard.c12
-rw-r--r--win/tkWinDialog.c11
-rw-r--r--win/tkWinDraw.c13
-rw-r--r--win/tkWinEmbed.c9
-rw-r--r--win/tkWinInit.c2
-rw-r--r--win/tkWinKey.c2
-rw-r--r--win/tkWinMenu.c150
-rw-r--r--win/tkWinWm.c74
-rw-r--r--win/tkWinX.c17
-rw-r--r--win/ttkWinXPTheme.c55
100 files changed, 3233 insertions, 1560 deletions
diff --git a/doc/bind.n b/doc/bind.n
index 009fd08..6e7f1f9 100644
--- a/doc/bind.n
+++ b/doc/bind.n
@@ -638,11 +638,11 @@ of events matched) is more specific than a shorter sequence;
.IP (c)
if the modifiers specified in one pattern are a subset of the
modifiers in another pattern, then the pattern with more modifiers
-is more specific.
+is more specific;
.IP (d)
a virtual event whose physical pattern matches the sequence is less
specific than the same physical pattern that is not associated with a
-virtual event.
+virtual event;
.IP (e)
given a sequence that matches two or more virtual events, one
of the virtual events will be chosen, but the order is undefined.
diff --git a/doc/grid.n b/doc/grid.n
index ea72db1..7f1db95 100644
--- a/doc/grid.n
+++ b/doc/grid.n
@@ -177,7 +177,7 @@ If a slave's cell is larger than its requested dimensions, this
option may be used to position (or stretch) the slave within its cell.
\fIStyle\fR is a string that contains zero or more of the characters
\fBn\fR, \fBs\fR, \fBe\fR or \fBw\fR.
-The string can optionally contains spaces or
+The string can optionally contain spaces or
commas, but they are ignored. Each letter refers to a side (north, south,
east, or west) that the slave will
.QW stick
diff --git a/doc/menu.n b/doc/menu.n
index bd6f0be..c6fcec3 100644
--- a/doc/menu.n
+++ b/doc/menu.n
@@ -470,18 +470,19 @@ a menu entry does not automatically unpost the menu; the default
bindings normally take care of this before invoking the \fBinvoke\fR
widget command.
.TP
-\fIpathName \fBpost \fIx y\fR
+\fIpathName \fBpost \fIx y\fR ?\fIindex\fR?
.
Arrange for the menu to be displayed on the screen at the root-window
-coordinates given by \fIx\fR and \fIy\fR. These coordinates are
-adjusted if necessary to guarantee that the entire menu is visible on
-the screen. This command normally returns an empty string.
-If the \fB\-postcommand\fR option has been specified, then its value is
-executed as a Tcl script before posting the menu and the result of
-that script is returned as the result of the \fBpost\fR widget
-command.
-If an error returns while executing the command, then the error is
-returned without posting the menu.
+coordinates given by \fIx\fR and \fIy\fR. If an index is specified
+the menu will be located so that the entry with that index is
+displayed at the point. These coordinates are adjusted if necessary to
+guarantee that the entire menu is visible on the screen. This command
+normally returns an empty string. If the \fB\-postcommand\fR option
+has been specified, then its value is executed as a Tcl script before
+posting the menu and the result of that script is returned as the
+result of the \fBpost\fR widget command. If an error returns while
+executing the command, then the error is returned without posting the
+menu.
.TP
\fIpathName \fBpostcascade \fIindex\fR
.
diff --git a/doc/scale.n b/doc/scale.n
index 6b960ce..d6407a0 100644
--- a/doc/scale.n
+++ b/doc/scale.n
@@ -55,7 +55,7 @@ it is the scale's width.
.OP \-resolution resolution Resolution
A real value specifying the resolution for the scale.
If this value is greater than zero then the scale's value will always be
-rounded to an even multiple of this value, as will tick marks and
+rounded to an even multiple of this value, as will
the endpoints of the scale. If the value is less than zero then no
rounding occurs. Defaults to 1 (i.e., the value will be integral).
.OP \-showvalue showValue ShowValue
@@ -78,7 +78,7 @@ specified by the \fB\-activebackground\fR option.
.OP \-tickinterval tickInterval TickInterval
Must be a real value.
Determines the spacing between numerical
-tick marks displayed below or to the left of the slider.
+tick marks displayed below or to the left of the slider. The values will all be displayed with the same number of decimal places, which will be enough to ensure they are all accurate to within 20% of a tick interval.
If 0, no tick marks will be displayed.
.OP \-to to To
Specifies a real value corresponding
diff --git a/doc/ttk_treeview.n b/doc/ttk_treeview.n
index b81bc62..96565a3 100644
--- a/doc/ttk_treeview.n
+++ b/doc/ttk_treeview.n
@@ -434,6 +434,9 @@ Specifies the font to use when drawing text.
Specifies the item image, in case the item's \fB\-image\fR option is empty.
.\" .PP
.\" \fI(@@@ TODO: sort out order of precedence for options)\fR
+.PP
+Tag priority is decided by the creation order: tags created first receive
+higher priority.
.SH "COLUMN IDENTIFIERS"
.PP
Column identifiers take any of the following forms:
diff --git a/doc/wm.n b/doc/wm.n
index 0e79306..aae68d9 100644
--- a/doc/wm.n
+++ b/doc/wm.n
@@ -710,20 +710,21 @@ specified then the command returns the current title for the
.TP
\fBwm transient \fIwindow\fR ?\fImaster\fR?
.
-If \fImaster\fR is specified, then the window manager is informed
-that \fIwindow\fR is a transient window (e.g. pull-down menu) working
-on behalf of \fImaster\fR (where \fImaster\fR is the
-path name for a top-level window). If \fImaster\fR
-is specified as an empty string then \fIwindow\fR is marked as not
-being a transient window any more. Otherwise the command
-returns the path name of \fIwindow\fR's current master, or an
-empty string if \fIwindow\fR is not currently a transient window.
-A transient window will mirror state changes in the master and
-inherit the state of the master when initially mapped. It is an
-error to attempt to make a window a transient of itself.
-The window manager may also decorate a transient window differently, removing
-some features normally present (e.g., minimize and maximize buttons) though
-this is entirely at the discretion of the window manager.
+If \fImaster\fR is specified, then the window manager is informed that
+\fIwindow\fR is a transient window (e.g. pull-down menu) working on
+behalf of \fImaster\fR (where \fImaster\fR is the path name for a
+top-level window). If \fImaster\fR is specified as an empty string
+then \fIwindow\fR is marked as not being a transient window any more.
+Otherwise the command returns the path name of \fIwindow\fR's current
+master, or an empty string if \fIwindow\fR is not currently a
+transient window. A transient window will mirror state changes in the
+master and inherit the state of the master when initially mapped. The
+directed graph with an edge from each transient to its master must be
+acyclic. In particular, it is an error to attempt to make a window a
+transient of itself. The window manager may also decorate a transient
+window differently, removing some features normally present (e.g.,
+minimize and maximize buttons) though this is entirely at the
+discretion of the window manager.
.TP
\fBwm withdraw \fIwindow\fR
.
diff --git a/generic/tk.h b/generic/tk.h
index 3213566..e00ea5c 100644
--- a/generic/tk.h
+++ b/generic/tk.h
@@ -1487,6 +1487,7 @@ typedef struct Tk_ElementSpec {
*----------------------------------------------------------------------
*/
+#if !defined(TK_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TK_READABLE TCL_READABLE
#define TK_WRITABLE TCL_WRITABLE
#define TK_EXCEPTION TCL_EXCEPTION
@@ -1520,6 +1521,7 @@ typedef struct Tk_ElementSpec {
#define Tk_FreeProc Tcl_FreeProc
#define Tk_Preserve Tcl_Preserve
#define Tk_Release Tcl_Release
+#endif
/* Removed Tk_Main, use macro instead */
#if defined(_WIN32) || defined(__CYGWIN__)
diff --git a/generic/tkBind.c b/generic/tkBind.c
index b06fbc9..953d936 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -84,7 +84,7 @@ typedef union {
*/
#ifndef TK_MAC_OSX
- #define EVENT_BUFFER_SIZE 45
+ #define EVENT_BUFFER_SIZE 90
#else
#define EVENT_BUFFER_SIZE 30
#endif
diff --git a/generic/tkCanvas.c b/generic/tkCanvas.c
index 01f2981..15a2ffb 100644
--- a/generic/tkCanvas.c
+++ b/generic/tkCanvas.c
@@ -831,10 +831,10 @@ CanvasWidgetCmd(
if (gotAny) {
Tcl_Obj *resultObjs[4];
- resultObjs[0] = Tcl_NewIntObj(x1);
- resultObjs[1] = Tcl_NewIntObj(y1);
- resultObjs[2] = Tcl_NewIntObj(x2);
- resultObjs[3] = Tcl_NewIntObj(y2);
+ resultObjs[0] = Tcl_NewWideIntObj(x1);
+ resultObjs[1] = Tcl_NewWideIntObj(y1);
+ resultObjs[2] = Tcl_NewWideIntObj(x2);
+ resultObjs[3] = Tcl_NewWideIntObj(y2);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, resultObjs));
}
break;
@@ -1239,7 +1239,7 @@ CanvasWidgetCmd(
itemPtr->redraw_flags |= FORCE_REDRAW;
EventuallyRedrawItem(canvasPtr, itemPtr);
canvasPtr->flags |= REPICK_NEEDED;
- Tcl_SetObjResult(interp, Tcl_NewIntObj(itemPtr->id));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(itemPtr->id));
break;
}
case CANV_DCHARS: {
@@ -1385,7 +1385,7 @@ CanvasWidgetCmd(
itemPtr = canvasPtr->textInfo.focusItemPtr;
if (objc == 2) {
if (itemPtr != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(itemPtr->id));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(itemPtr->id));
}
goto done;
}
@@ -1477,7 +1477,7 @@ CanvasWidgetCmd(
if (result != TCL_OK) {
goto done;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
break;
}
case CANV_INSERT: {
@@ -1924,7 +1924,7 @@ CanvasWidgetCmd(
}
if (canvasPtr->textInfo.selItemPtr != NULL) {
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(canvasPtr->textInfo.selItemPtr->id));
+ Tcl_NewWideIntObj(canvasPtr->textInfo.selItemPtr->id));
}
break;
case CANV_TO:
@@ -2769,21 +2769,10 @@ DrawCanvas(
* colours and place them in the photo block. Perhaps we could
* just not bother with the alpha byte because we are using
* TK_PHOTO_COMPOSITE_SET later?
- * ***Windows: We have to swap the red and blue values. The
- * XImage storage is B - G - R - A which becomes a 32bit ARGB
- * quad. However the visual mask is a 32bit ABGR quad. And
- * Tk_PhotoPutBlock() wants R-G-B-A which is a 32bit ABGR quad.
- * If the visual mask was correct there would be no need to
- * swap anything here.
*/
-#ifdef _WIN32
-#define R_OFFSET 2
-#define B_OFFSET 0
-#else
#define R_OFFSET 0
#define B_OFFSET 2
-#endif
blockPtr.pixelPtr[blockPtr.pitch * y + blockPtr.pixelSize * x + R_OFFSET] =
(unsigned char)((pixel & visualPtr->red_mask) >> rshift);
blockPtr.pixelPtr[blockPtr.pitch * y + blockPtr.pixelSize * x +1] =
@@ -4452,7 +4441,7 @@ DoItem(
*/
if (tag == NULL) {
- Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewIntObj(itemPtr->id));
+ Tcl_ListObjAppendElement(NULL, accumObj, Tcl_NewWideIntObj(itemPtr->id));
return;
}
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index cefd5fc..391d906 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -746,15 +746,15 @@ CaretCmd(
Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj("-height", 7));
Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewIntObj(caretPtr->height));
+ Tcl_NewWideIntObj(caretPtr->height));
Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj("-x", 2));
Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewIntObj(caretPtr->x));
+ Tcl_NewWideIntObj(caretPtr->x));
Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj("-y", 2));
Tcl_ListObjAppendElement(interp, objPtr,
- Tcl_NewIntObj(caretPtr->y));
+ Tcl_NewWideIntObj(caretPtr->y));
Tcl_SetObjResult(interp, objPtr);
} else if (objc == 3) {
int value;
@@ -774,7 +774,7 @@ CaretCmd(
} else /* if (index == TK_CARET_HEIGHT) -- last case */ {
value = caretPtr->height;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(value));
} else {
int i, value, x = 0, y = 0, height = -1;
@@ -1363,7 +1363,7 @@ Tk_WinfoObjCmd(
switch ((enum options) index) {
case WIN_CELLS:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(Tk_Visual(tkwin)->map_entries));
+ Tcl_NewWideIntObj(Tk_Visual(tkwin)->map_entries));
break;
case WIN_CHILDREN: {
Tcl_Obj *strPtr, *resultPtr = Tcl_NewObj();
@@ -1386,14 +1386,14 @@ Tk_WinfoObjCmd(
Tcl_NewBooleanObj(TkpCmapStressed(tkwin,Tk_Colormap(tkwin))));
break;
case WIN_DEPTH:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Depth(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_Depth(tkwin)));
break;
case WIN_GEOMETRY:
Tcl_SetObjResult(interp, Tcl_ObjPrintf("%dx%d+%d+%d",
Tk_Width(tkwin), Tk_Height(tkwin), Tk_X(tkwin), Tk_Y(tkwin)));
break;
case WIN_HEIGHT:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Height(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_Height(tkwin)));
break;
case WIN_ID: {
char buf[TCL_INTEGER_SPACE];
@@ -1444,28 +1444,28 @@ Tk_WinfoObjCmd(
if (useX & useY) {
Tcl_Obj *xyObj[2];
- xyObj[0] = Tcl_NewIntObj(x);
- xyObj[1] = Tcl_NewIntObj(y);
+ xyObj[0] = Tcl_NewWideIntObj(x);
+ xyObj[1] = Tcl_NewWideIntObj(y);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, xyObj));
} else if (useX) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(x));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(y));
}
break;
case WIN_REQHEIGHT:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqHeight(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_ReqHeight(tkwin)));
break;
case WIN_REQWIDTH:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_ReqWidth(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_ReqWidth(tkwin)));
break;
case WIN_ROOTX:
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(x));
break;
case WIN_ROOTY:
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(y));
break;
case WIN_SCREEN:
Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s.%d",
@@ -1473,27 +1473,27 @@ Tk_WinfoObjCmd(
break;
case WIN_SCREENCELLS:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(CellsOfScreen(Tk_Screen(tkwin))));
+ Tcl_NewWideIntObj(CellsOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENDEPTH:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin))));
+ Tcl_NewWideIntObj(DefaultDepthOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENHEIGHT:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(HeightOfScreen(Tk_Screen(tkwin))));
+ Tcl_NewWideIntObj(HeightOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENWIDTH:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(WidthOfScreen(Tk_Screen(tkwin))));
+ Tcl_NewWideIntObj(WidthOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENMMHEIGHT:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(HeightMMOfScreen(Tk_Screen(tkwin))));
+ Tcl_NewWideIntObj(HeightMMOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENMMWIDTH:
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(WidthMMOfScreen(Tk_Screen(tkwin))));
+ Tcl_NewWideIntObj(WidthMMOfScreen(Tk_Screen(tkwin))));
break;
case WIN_SCREENVISUAL:
class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
@@ -1539,28 +1539,28 @@ Tk_WinfoObjCmd(
break;
case WIN_VROOTHEIGHT:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(height));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(height));
break;
case WIN_VROOTWIDTH:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(width));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(width));
break;
case WIN_VROOTX:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(x));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(x));
break;
case WIN_VROOTY:
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(y));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(y));
break;
case WIN_WIDTH:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Width(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_Width(tkwin)));
break;
case WIN_X:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_X(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_X(tkwin)));
break;
case WIN_Y:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tk_Y(tkwin)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tk_Y(tkwin)));
break;
/*
@@ -1735,7 +1735,7 @@ Tk_WinfoObjCmd(
if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(pixels));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(pixels));
break;
}
case WIN_RGB: {
diff --git a/generic/tkConfig.c b/generic/tkConfig.c
index b9499e5..892692a 100644
--- a/generic/tkConfig.c
+++ b/generic/tkConfig.c
@@ -1874,10 +1874,10 @@ GetObjectForOption(
objPtr = NULL;
switch (optionPtr->specPtr->type) {
case TK_OPTION_BOOLEAN:
- objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ objPtr = Tcl_NewWideIntObj(*((int *) internalPtr));
break;
case TK_OPTION_INT:
- objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ objPtr = Tcl_NewWideIntObj(*((int *) internalPtr));
break;
case TK_OPTION_DOUBLE:
objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
@@ -1951,7 +1951,7 @@ GetObjectForOption(
*((Tk_Anchor *) internalPtr)), -1);
break;
case TK_OPTION_PIXELS:
- objPtr = Tcl_NewIntObj(*((int *) internalPtr));
+ objPtr = Tcl_NewWideIntObj(*((int *) internalPtr));
break;
case TK_OPTION_WINDOW: {
Tk_Window tkwin = *((Tk_Window *) internalPtr);
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index 5a39f53..fdd2ff4 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -640,10 +640,10 @@ EntryWidgetObjCmd(
index--;
}
Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);
- bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX);
- bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY);
- bbox[2] = Tcl_NewIntObj(width);
- bbox[3] = Tcl_NewIntObj(height);
+ bbox[0] = Tcl_NewWideIntObj(x + entryPtr->layoutX);
+ bbox[1] = Tcl_NewWideIntObj(y + entryPtr->layoutY);
+ bbox[2] = Tcl_NewWideIntObj(width);
+ bbox[3] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox));
break;
}
@@ -734,7 +734,7 @@ EntryWidgetObjCmd(
&index) != TCL_OK) {
goto error;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
break;
}
@@ -3840,10 +3840,10 @@ SpinboxWidgetObjCmd(
index--;
}
Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);
- bbox[0] = Tcl_NewIntObj(x + entryPtr->layoutX);
- bbox[1] = Tcl_NewIntObj(y + entryPtr->layoutY);
- bbox[2] = Tcl_NewIntObj(width);
- bbox[3] = Tcl_NewIntObj(height);
+ bbox[0] = Tcl_NewWideIntObj(x + entryPtr->layoutX);
+ bbox[1] = Tcl_NewWideIntObj(y + entryPtr->layoutY);
+ bbox[2] = Tcl_NewWideIntObj(width);
+ bbox[3] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox));
break;
}
@@ -3954,7 +3954,7 @@ SpinboxWidgetObjCmd(
&index) != TCL_OK) {
goto error;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
break;
}
diff --git a/generic/tkFileFilter.c b/generic/tkFileFilter.c
index 8588d70..6cb188b 100644
--- a/generic/tkFileFilter.c
+++ b/generic/tkFileFilter.c
@@ -262,8 +262,8 @@ AddClause(
*/
for (i=0; i<ostypeCount; i++) {
- int len;
- const char *strType = Tcl_GetStringFromObj(ostypeList[i], &len);
+ size_t len;
+ const char *strType = TkGetStringFromObj(ostypeList[i], &len);
/*
* If len is < 4, it is definitely an error. If equal or longer,
@@ -322,8 +322,8 @@ AddClause(
if (globCount > 0 && globList != NULL) {
for (i=0; i<globCount; i++) {
GlobPattern *globPtr = ckalloc(sizeof(GlobPattern));
- int len;
- const char *str = Tcl_GetStringFromObj(globList[i], &len);
+ size_t len;
+ const char *str = TkGetStringFromObj(globList[i], &len);
len = (len + 1) * sizeof(char);
if (str[0] && str[0] != '*') {
@@ -375,9 +375,9 @@ AddClause(
}
for (i=0; i<ostypeCount; i++) {
Tcl_DString osTypeDS;
- int len;
+ size_t len;
MacFileType *mfPtr = ckalloc(sizeof(MacFileType));
- const char *strType = Tcl_GetStringFromObj(ostypeList[i], &len);
+ const char *strType = TkGetStringFromObj(ostypeList[i], &len);
char *string;
/*
diff --git a/generic/tkFocus.c b/generic/tkFocus.c
index 60f631d..eae981e 100644
--- a/generic/tkFocus.c
+++ b/generic/tkFocus.c
@@ -551,12 +551,17 @@ TkSetFocusWin(
return;
}
+ /*
+ * Get the current focus window with the same display and application
+ * as winPtr.
+ */
+
displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
/*
- * If force is set, we should make sure we grab the focus regardless of
- * the current focus window since under Windows, we may need to take
- * control away from another application.
+ * Do nothing if the window already has focus and force is not set. If
+ * force is set, we need to grab the focus, since under Windows or macOS
+ * this may involve taking control away from another application.
*/
if (winPtr == displayFocusPtr->focusWinPtr && !force) {
@@ -564,14 +569,15 @@ TkSetFocusWin(
}
/*
- * Find the top-level window for winPtr, then find (or create) a record
- * for the top-level. Also see whether winPtr and all its ancestors are
+ * Find the toplevel window for winPtr, then find (or create) a record
+ * for the toplevel. Also see whether winPtr and all its ancestors are
* mapped.
*/
allMapped = 1;
for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) {
if (topLevelPtr == NULL) {
+
/*
* The window is being deleted. No point in worrying about giving
* it the focus.
@@ -588,11 +594,11 @@ TkSetFocusWin(
}
/*
- * If the new focus window isn't mapped, then we can't focus on it (X will
- * generate an error, for example). Instead, create an event handler that
- * will set the focus to this window once it gets mapped. At the same
- * time, delete any old handler that might be around; it's no longer
- * relevant.
+ * If any ancestor of the new focus window isn't mapped, then we can't set
+ * focus for it (X will generate an error, for example). Instead, create
+ * an event handler that will set the focus to this window once it gets
+ * mapped. At the same time, delete any old handler that might be around;
+ * it's no longer relevant.
*/
if (displayFocusPtr->focusOnMapPtr != NULL) {
@@ -623,28 +629,36 @@ TkSetFocusWin(
}
tlFocusPtr->focusWinPtr = winPtr;
- /*
- * Reset the window system's focus window and generate focus events, with
- * two special cases:
- *
- * 1. If the application is embedded and doesn't currently have the focus,
- * don't set the focus directly. Instead, see if the embedding code can
- * claim the focus from the enclosing container.
- * 2. Otherwise, if the application doesn't currently have the focus,
- * don't change the window system's focus unless it was already in this
- * application or "force" was specified.
- */
+ if (topLevelPtr->flags & TK_EMBEDDED) {
+
+ /*
+ * We are assigning focus to an embedded toplevel. The platform
+ * specific function TkpClaimFocus needs to handle the job of
+ * assigning focus to the container, since we have no way to find the
+ * contaiuner.
+ */
- if ((topLevelPtr->flags & TK_EMBEDDED)
- && (displayFocusPtr->focusWinPtr == NULL)) {
TkpClaimFocus(topLevelPtr, force);
} else if ((displayFocusPtr->focusWinPtr != NULL) || force) {
+
+ /*
+ * If we are forcing removal of focus from a container hosting a
+ * toplevel from a different application, clear the focus in that
+ * application.
+ */
+
+ if (force) {
+ TkWindow *focusPtr = winPtr->dispPtr->focusPtr;
+ if (focusPtr && focusPtr->mainPtr != winPtr->mainPtr) {
+ DisplayFocusInfo *displayFocusPtr2 = FindDisplayFocusInfo(
+ focusPtr->mainPtr, focusPtr->dispPtr);
+ displayFocusPtr2->focusWinPtr = NULL;
+ }
+ }
+
/*
- * Generate events to shift focus between Tk windows. We do this
- * regardless of what TkpChangeFocus does with the real X focus so
- * that Tk widgets track focus commands when there is no window
- * manager. GenerateFocusEvents will set up a serial number marker so
- * we discard focus events that are triggered by the ChangeFocus.
+ * Call the platform specific function TkpChangeFocus to move the
+ * window manager's focus to a new toplevel.
*/
serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
diff --git a/generic/tkFont.c b/generic/tkFont.c
index c0ff7d0..053524c 100644
--- a/generic/tkFont.c
+++ b/generic/tkFont.c
@@ -731,7 +731,7 @@ Tk_FontObjCmd(
return TCL_ERROR;
}
string = TkGetStringFromObj(objv[3 + skip], &length);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
Tk_TextWidth(tkfont, string, length)));
Tk_FreeFont(tkfont);
break;
@@ -778,7 +778,7 @@ Tk_FontObjCmd(
case 2: i = fmPtr->ascent + fmPtr->descent; break;
case 3: i = fmPtr->fixed; break;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
}
Tk_FreeFont(tkfont);
break;
@@ -3494,9 +3494,9 @@ GetAttributeInfoObj(
case FONT_SIZE:
if (faPtr->size >= 0.0) {
- valuePtr = Tcl_NewIntObj((int)(faPtr->size + 0.5));
+ valuePtr = Tcl_NewWideIntObj((Tcl_WideInt)(faPtr->size + 0.5));
} else {
- valuePtr = Tcl_NewIntObj(-(int)(-faPtr->size + 0.5));
+ valuePtr = Tcl_NewWideIntObj(-(Tcl_WideInt)(-faPtr->size + 0.5));
}
break;
diff --git a/generic/tkGrid.c b/generic/tkGrid.c
index c632793..436151a 100644
--- a/generic/tkGrid.c
+++ b/generic/tkGrid.c
@@ -292,8 +292,8 @@ static void GridLostSlaveProc(ClientData clientData,
Tk_Window tkwin);
static void GridReqProc(ClientData clientData, Tk_Window tkwin);
static void InitMasterData(Gridder *masterPtr);
-static Tcl_Obj * NewPairObj(int, int);
-static Tcl_Obj * NewQuadObj(int, int, int, int);
+static Tcl_Obj * NewPairObj(Tcl_WideInt, Tcl_WideInt);
+static Tcl_Obj * NewQuadObj(Tcl_WideInt, Tcl_WideInt, Tcl_WideInt, Tcl_WideInt);
static int ResolveConstraints(Gridder *gridPtr, int rowOrColumn,
int maxOffset);
static void SetGridSize(Gridder *gridPtr);
@@ -741,13 +741,13 @@ GridInfoCommand(
Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-in", -1),
TkNewWindowObj(slavePtr->masterPtr->tkwin));
Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-column", -1),
- Tcl_NewIntObj(slavePtr->column));
+ Tcl_NewWideIntObj(slavePtr->column));
Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-row", -1),
- Tcl_NewIntObj(slavePtr->row));
+ Tcl_NewWideIntObj(slavePtr->row));
Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-columnspan", -1),
- Tcl_NewIntObj(slavePtr->numCols));
+ Tcl_NewWideIntObj(slavePtr->numCols));
Tcl_DictObjPut(NULL, infoObj, Tcl_NewStringObj("-rowspan", -1),
- Tcl_NewIntObj(slavePtr->numRows));
+ Tcl_NewWideIntObj(slavePtr->numRows));
TkAppendPadAmount(infoObj, "-ipadx", slavePtr->iPadX/2, slavePtr->iPadX);
TkAppendPadAmount(infoObj, "-ipady", slavePtr->iPadY/2, slavePtr->iPadY);
TkAppendPadAmount(infoObj, "-padx", slavePtr->padLeft, slavePtr->padX);
@@ -1055,17 +1055,17 @@ GridRowColumnConfigureCommand(
Tcl_ListObjAppendElement(interp, res,
Tcl_NewStringObj("-minsize", -1));
- Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(minsize));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewWideIntObj(minsize));
Tcl_ListObjAppendElement(interp, res,
Tcl_NewStringObj("-pad", -1));
- Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(pad));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewWideIntObj(pad));
Tcl_ListObjAppendElement(interp, res,
Tcl_NewStringObj("-uniform", -1));
Tcl_ListObjAppendElement(interp, res,
Tcl_NewStringObj(uniform == NULL ? "" : uniform, -1));
Tcl_ListObjAppendElement(interp, res,
Tcl_NewStringObj("-weight", -1));
- Tcl_ListObjAppendElement(interp, res, Tcl_NewIntObj(weight));
+ Tcl_ListObjAppendElement(interp, res, Tcl_NewWideIntObj(weight));
Tcl_SetObjResult(interp, res);
Tcl_DecrRefCount(listCopy);
return TCL_OK;
@@ -1082,10 +1082,10 @@ GridRowColumnConfigureCommand(
return TCL_ERROR;
}
if (index == ROWCOL_MINSIZE) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(ok == TCL_OK) ? slotPtr[slot].minSize : 0));
} else if (index == ROWCOL_WEIGHT) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(ok == TCL_OK) ? slotPtr[slot].weight : 0));
} else if (index == ROWCOL_UNIFORM) {
Tk_Uid value = (ok == TCL_OK) ? slotPtr[slot].uniform : "";
@@ -1093,7 +1093,7 @@ GridRowColumnConfigureCommand(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
(value == NULL) ? "" : value, -1));
} else if (index == ROWCOL_PAD) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
(ok == TCL_OK) ? slotPtr[slot].pad : 0));
}
Tcl_DecrRefCount(listCopy);
@@ -3631,12 +3631,12 @@ StringToSticky(
static Tcl_Obj *
NewPairObj(
- int val1, int val2)
+ Tcl_WideInt val1, Tcl_WideInt val2)
{
Tcl_Obj *ary[2];
- ary[0] = Tcl_NewIntObj(val1);
- ary[1] = Tcl_NewIntObj(val2);
+ ary[0] = Tcl_NewWideIntObj(val1);
+ ary[1] = Tcl_NewWideIntObj(val2);
return Tcl_NewListObj(2, ary);
}
@@ -3658,14 +3658,14 @@ NewPairObj(
static Tcl_Obj *
NewQuadObj(
- int val1, int val2, int val3, int val4)
+ Tcl_WideInt val1, Tcl_WideInt val2, Tcl_WideInt val3, Tcl_WideInt val4)
{
Tcl_Obj *ary[4];
- ary[0] = Tcl_NewIntObj(val1);
- ary[1] = Tcl_NewIntObj(val2);
- ary[2] = Tcl_NewIntObj(val3);
- ary[3] = Tcl_NewIntObj(val4);
+ ary[0] = Tcl_NewWideIntObj(val1);
+ ary[1] = Tcl_NewWideIntObj(val2);
+ ary[2] = Tcl_NewWideIntObj(val3);
+ ary[3] = Tcl_NewWideIntObj(val4);
return Tcl_NewListObj(4, ary);
}
diff --git a/generic/tkImage.c b/generic/tkImage.c
index 32e09c0..3829dff 100644
--- a/generic/tkImage.c
+++ b/generic/tkImage.c
@@ -474,7 +474,7 @@ Tk_ImageObjCmd(
switch ((enum options) index) {
case IMAGE_HEIGHT:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->height));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(masterPtr->height));
break;
case IMAGE_INUSE:
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
@@ -487,7 +487,7 @@ Tk_ImageObjCmd(
}
break;
case IMAGE_WIDTH:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(masterPtr->width));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(masterPtr->width));
break;
default:
Tcl_Panic("can't happen");
diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c
index aacde56..da62d1f 100644
--- a/generic/tkImgGIF.c
+++ b/generic/tkImgGIF.c
@@ -1034,7 +1034,7 @@ ReadImage(
int transparent)
{
unsigned char initialCodeSize;
- int xpos = 0, ypos = 0, pass = 0, i;
+ int xpos = 0, ypos = 0, pass = 0, i, count;
register unsigned char *pixelPtr;
static const int interlaceStep[] = { 8, 8, 4, 2 };
static const int interlaceStart[] = { 0, 4, 2, 1 };
@@ -1252,6 +1252,25 @@ ReadImage(
}
pixelPtr = imagePtr + (ypos) * len * ((transparent>=0)?4:3);
}
+
+ /*
+ * Now read until the final zero byte.
+ * It was observed that there might be 1 length blocks
+ * (test imgPhoto-14.1) which are not read.
+ *
+ * The field "stack" is abused for temporary buffer. it has 4096 bytes
+ * and we need 256.
+ *
+ * Loop until we hit a 0 length block which is the end sign.
+ */
+ while ( 0 < (count = GetDataBlock(gifConfPtr, chan, stack)))
+ {
+ if (-1 == count ) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error reading GIF image: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ }
return TCL_OK;
}
diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c
index 8fd971d..c8825a1 100644
--- a/generic/tkImgPhoto.c
+++ b/generic/tkImgPhoto.c
@@ -849,10 +849,10 @@ ImgPhotoCmd(
*/
pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4;
- channels[0] = Tcl_NewIntObj(pixelPtr[0]);
- channels[1] = Tcl_NewIntObj(pixelPtr[1]);
- channels[2] = Tcl_NewIntObj(pixelPtr[2]);
- channels[3] = Tcl_NewIntObj(pixelPtr[3]);
+ channels[0] = Tcl_NewWideIntObj(pixelPtr[0]);
+ channels[1] = Tcl_NewWideIntObj(pixelPtr[1]);
+ channels[2] = Tcl_NewWideIntObj(pixelPtr[2]);
+ channels[3] = Tcl_NewWideIntObj(pixelPtr[3]);
Tcl_SetObjResult(interp, Tcl_NewListObj(channelCount, channels));
return TCL_OK;
}
@@ -1141,7 +1141,7 @@ ImgPhotoCmd(
if (boolMode) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj( ! pixelPtr[3]));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(pixelPtr[3]));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(pixelPtr[3]));
}
return TCL_OK;
}
diff --git a/generic/tkInt.decls b/generic/tkInt.decls
index 04eecf6..3a3cbc7 100644
--- a/generic/tkInt.decls
+++ b/generic/tkInt.decls
@@ -1016,7 +1016,7 @@ declare 47 aqua {
Tk_Window TkMacOSXGetCapture(void)
}
declare 49 aqua {
- Window TkGetTransientMaster(TkWindow *winPtr)
+ Tk_Window TkGetTransientMaster(TkWindow *winPtr)
}
declare 50 aqua {
int TkGenerateButtonEvent(int x, int y, Window window, unsigned int state)
diff --git a/generic/tkIntPlatDecls.h b/generic/tkIntPlatDecls.h
index 9bc76c0..4162396 100644
--- a/generic/tkIntPlatDecls.h
+++ b/generic/tkIntPlatDecls.h
@@ -243,7 +243,7 @@ EXTERN int TkpIsWindowFloating(void *window);
EXTERN Tk_Window TkMacOSXGetCapture(void);
/* Slot 48 is reserved */
/* 49 */
-EXTERN Window TkGetTransientMaster(TkWindow *winPtr);
+EXTERN Tk_Window TkGetTransientMaster(TkWindow *winPtr);
/* 50 */
EXTERN int TkGenerateButtonEvent(int x, int y, Window window,
unsigned int state);
@@ -392,7 +392,7 @@ typedef struct TkIntPlatStubs {
int (*tkpIsWindowFloating) (void *window); /* 46 */
Tk_Window (*tkMacOSXGetCapture) (void); /* 47 */
void (*reserved48)(void);
- Window (*tkGetTransientMaster) (TkWindow *winPtr); /* 49 */
+ Tk_Window (*tkGetTransientMaster) (TkWindow *winPtr); /* 49 */
int (*tkGenerateButtonEvent) (int x, int y, Window window, unsigned int state); /* 50 */
void (*tkGenWMDestroyEvent) (Tk_Window tkwin); /* 51 */
void (*tkMacOSXSetDrawingEnabled) (TkWindow *winPtr, int flag); /* 52 */
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index e35c6c5..f722674 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -728,7 +728,7 @@ ListboxWidgetObjCmd(
objPtr = Tcl_NewObj();
for (i = 0; i < listPtr->nElements; i++) {
if (Tcl_FindHashEntry(listPtr->selection, KEY(i))) {
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(i));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(i));
}
}
Tcl_SetObjResult(interp, objPtr);
@@ -841,7 +841,7 @@ ListboxWidgetObjCmd(
if (result != TCL_OK) {
break;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
result = TCL_OK;
break;
@@ -956,7 +956,7 @@ ListboxWidgetObjCmd(
break;
}
index = NearestListboxElement(listPtr, y);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
result = TCL_OK;
break;
}
@@ -1044,7 +1044,7 @@ ListboxWidgetObjCmd(
result = TCL_ERROR;
break;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(listPtr->nElements));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(listPtr->nElements));
result = TCL_OK;
break;
case COMMAND_XVIEW:
@@ -1130,10 +1130,10 @@ ListboxBboxSubCmd(
}
y = ((index - listPtr->topIndex)*listPtr->lineHeight)
+ listPtr->inset + listPtr->selBorderWidth;
- results[0] = Tcl_NewIntObj(x);
- results[1] = Tcl_NewIntObj(y);
- results[2] = Tcl_NewIntObj(pixelWidth);
- results[3] = Tcl_NewIntObj(fm.linespace);
+ results[0] = Tcl_NewWideIntObj(x);
+ results[1] = Tcl_NewWideIntObj(y);
+ results[2] = Tcl_NewWideIntObj(pixelWidth);
+ results[3] = Tcl_NewWideIntObj(fm.linespace);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
diff --git a/generic/tkMacWinMenu.c b/generic/tkMacWinMenu.c
index 9449838..e6b673c 100644
--- a/generic/tkMacWinMenu.c
+++ b/generic/tkMacWinMenu.c
@@ -66,7 +66,7 @@ PreprocessMenu(
do {
finished = 1;
- for (index = 0; index < menuPtr->numEntries; index++) {
+ for (index = 0; index < (int)menuPtr->numEntries; index++) {
register TkMenuEntry *entryPtr = menuPtr->entries[index];
if ((entryPtr->type == CASCADE_ENTRY)
diff --git a/generic/tkMain.c b/generic/tkMain.c
index eb311ff..007903c 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -71,22 +71,31 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#endif
/*
- * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
- * while otherwise NewNativeObj is needed (which provides proper
- * conversion from native encoding to UTF-8).
+ * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
+ * NewNativeObj is needed (which provides proper conversion from native
+ * encoding to UTF-8).
*/
+
+static inline Tcl_Obj *
+NewNativeObj(
+ TCHAR *string,
+ int length)
+{
+ Tcl_Obj *obj;
+ Tcl_DString ds;
+
#ifdef UNICODE
-# define NewNativeObj Tcl_NewUnicodeObj
-#else /* !UNICODE */
- static Tcl_Obj *NewNativeObj(char *string, int length) {
- Tcl_Obj *obj;
- Tcl_DString ds;
- Tcl_ExternalToUtfDString(NULL, string, length, &ds);
- obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- return obj;
+ if (length > 0) {
+ length *= sizeof(WCHAR);
+ }
+ Tcl_WinTCharToUtf(string, length, &ds);
+#else
+ Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
+#endif
+ obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ return obj;
}
-#endif /* !UNICODE */
/*
* Declarations for various library functions and variables (don't want to
@@ -289,7 +298,7 @@ Tk_MainEx(
argc--;
argv++;
- Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
+ Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
@@ -316,7 +325,7 @@ Tk_MainEx(
}
#endif
Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
- Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);
+ Tcl_NewWideIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
diff --git a/generic/tkMenu.c b/generic/tkMenu.c
index 0bd40a6..74fab67 100644
--- a/generic/tkMenu.c
+++ b/generic/tkMenu.c
@@ -357,7 +357,7 @@ static int MenuAddOrInsert(Tcl_Interp *interp,
TkMenu *menuPtr, Tcl_Obj *indexPtr, int objc,
Tcl_Obj *const objv[]);
static void MenuCmdDeletedProc(ClientData clientData);
-static TkMenuEntry * MenuNewEntry(TkMenu *menuPtr, int index, int type);
+static TkMenuEntry * MenuNewEntry(TkMenu *menuPtr, TkSizeT index, int type);
static char * MenuVarProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
@@ -457,7 +457,7 @@ Tk_MenuObjCmd(
menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd, menuPtr,
MenuCmdDeletedProc);
- menuPtr->active = -1;
+ menuPtr->active = (TkSizeT)-1;
menuPtr->cursorPtr = NULL;
menuPtr->masterMenuPtr = menuPtr;
menuPtr->menuType = UNKNOWN_TYPE;
@@ -648,7 +648,7 @@ MenuWidgetObjCmd(
if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
goto error;
}
- if (menuPtr->active == index) {
+ if ((int)menuPtr->active == index) {
goto done;
}
if ((index >= 0) && ((menuPtr->entries[index]->type==SEPARATOR_ENTRY)
@@ -737,7 +737,7 @@ MenuWidgetObjCmd(
if (isdigit(UCHAR(Tcl_GetString(objv[2])[0]))
&& Tcl_GetIntFromObj(NULL, objv[2], &first) == TCL_OK) {
- if (first >= menuPtr->numEntries) {
+ if (first >= (int)menuPtr->numEntries) {
goto done;
}
} else if (TkGetMenuIndex(interp,menuPtr,objv[2],0,&first) != TCL_OK){
@@ -839,10 +839,10 @@ MenuWidgetObjCmd(
if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index) != TCL_OK) {
goto error;
}
- if (index < 0) {
+ if (index == -1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
}
break;
}
@@ -873,32 +873,37 @@ MenuWidgetObjCmd(
break;
}
case MENU_POST: {
- int x, y;
+ int x, y, index = -1;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "x y");
+ if (objc != 4 && objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y ?index?");
goto error;
}
if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
goto error;
}
+ if (objc == 5) {
+ if (TkGetMenuIndex(interp, menuPtr, objv[4], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ }
/*
- * Tearoff menus are posted differently on Mac and Windows than
- * non-tearoffs. TkpPostMenu does not actually map the menu's window
- * on those platforms, and popup menus have to be handled specially.
- * Also, menubar menues are not intended to be posted (bug 1567681,
- * 2160206).
+ * Tearoff menus are the same as ordinary menus on the Mac and are
+ * posted differently on Windows than non-tearoffs. TkpPostMenu
+ * does not actually map the menu's window on those platforms, and
+ * popup menus have to be handled specially. Also, menubar menus are
+ * not intended to be posted (bug 1567681, 2160206).
*/
if (menuPtr->menuType == MENUBAR) {
Tcl_AppendResult(interp, "a menubar menu cannot be posted", NULL);
return TCL_ERROR;
} else if (menuPtr->menuType != TEAROFF_MENU) {
- result = TkpPostMenu(interp, menuPtr, x, y);
+ result = TkpPostMenu(interp, menuPtr, x, y, index);
} else {
- result = TkPostTearoffMenu(interp, menuPtr, x, y);
+ result = TkpPostTearoffMenu(interp, menuPtr, x, y, index);
}
break;
}
@@ -1484,7 +1489,7 @@ MenuWorldChanged(
ClientData instanceData) /* Information about widget. */
{
TkMenu *menuPtr = instanceData;
- int i;
+ TkSizeT i;
TkMenuConfigureDrawOptions(menuPtr);
for (i = 0; i < menuPtr->numEntries; i++) {
@@ -1625,12 +1630,11 @@ ConfigureMenu(
Tcl_EventuallyFree(menuListPtr->entries[0], (Tcl_FreeProc *) DestroyMenuEntry);
- for (i = 0; i < menuListPtr->numEntries - 1; i++) {
+ for (i = 0; i < (int)menuListPtr->numEntries - 1; i++) {
menuListPtr->entries[i] = menuListPtr->entries[i + 1];
menuListPtr->entries[i]->index = i;
}
- menuListPtr->numEntries--;
- if (menuListPtr->numEntries == 0) {
+ if (--menuListPtr->numEntries == 0) {
ckfree(menuListPtr->entries);
menuListPtr->entries = NULL;
}
@@ -1645,7 +1649,7 @@ ConfigureMenu(
* parent.
*/
- for (i = 0; i < menuListPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuListPtr->numEntries; i++) {
TkMenuEntry *mePtr;
mePtr = menuListPtr->entries[i];
@@ -2143,7 +2147,7 @@ TkGetMenuIndex(
if (isdigit(UCHAR(string[0]))) {
if (Tcl_GetInt(interp, string, &i) == TCL_OK) {
- if (i >= menuPtr->numEntries) {
+ if (i >= (int)menuPtr->numEntries) {
if (lastOK) {
i = menuPtr->numEntries;
} else {
@@ -2158,7 +2162,7 @@ TkGetMenuIndex(
Tcl_ResetResult(interp);
}
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
const char *label = (labelPtr == NULL) ? NULL : Tcl_GetString(labelPtr);
@@ -2241,13 +2245,13 @@ MenuCmdDeletedProc(
static TkMenuEntry *
MenuNewEntry(
TkMenu *menuPtr, /* Menu that will hold the new entry. */
- int index, /* Where in the menu the new entry is to
+ TkSizeT index, /* Where in the menu the new entry is to
* go. */
int type) /* The type of the new entry. */
{
TkMenuEntry *mePtr;
TkMenuEntry **newEntries;
- int i;
+ TkSizeT i;
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
@@ -2387,7 +2391,7 @@ MenuAddOrInsert(
}
if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
TkMenu *errorMenuPtr;
- int i;
+ TkSizeT i;
for (errorMenuPtr = menuPtr->masterMenuPtr;
errorMenuPtr != NULL;
@@ -2398,8 +2402,7 @@ MenuAddOrInsert(
errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1];
errorMenuPtr->entries[i]->index = i;
}
- errorMenuPtr->numEntries--;
- if (errorMenuPtr->numEntries == 0) {
+ if (--errorMenuPtr->numEntries == 0) {
ckfree(errorMenuPtr->entries);
errorMenuPtr->entries = NULL;
}
@@ -2583,13 +2586,13 @@ MenuVarProc(
int
TkActivateMenuEntry(
register TkMenu *menuPtr, /* Menu in which to activate. */
- int index) /* Index of entry to activate, or -1 to
- * deactivate all entries. */
+ TkSizeT index) /* Index of entry to activate, or
+ * TCL_INDEX_NONE to deactivate all entries. */
{
register TkMenuEntry *mePtr;
int result = TCL_OK;
- if (menuPtr->active >= 0) {
+ if (menuPtr->active != (TkSizeT)-1) {
mePtr = menuPtr->entries[menuPtr->active];
/*
@@ -2603,7 +2606,7 @@ TkActivateMenuEntry(
TkEventuallyRedrawMenu(menuPtr, menuPtr->entries[menuPtr->active]);
}
menuPtr->active = index;
- if (index >= 0) {
+ if (index != (TkSizeT)-1) {
mePtr = menuPtr->entries[index];
mePtr->state = ENTRY_ACTIVE;
TkEventuallyRedrawMenu(menuPtr, mePtr);
@@ -2794,7 +2797,7 @@ CloneMenu(
* Clone all of the cascade menus that this menu points to.
*/
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
TkMenuReferences *cascadeRefPtr;
TkMenu *oldCascadePtr;
@@ -2865,10 +2868,10 @@ MenuDoXPosition(
return TCL_ERROR;
}
Tcl_ResetResult(interp);
- if (index < 0) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ if (index == -1) {
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->x));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(menuPtr->entries[index]->x));
}
return TCL_OK;
}
@@ -2902,10 +2905,10 @@ MenuDoYPosition(
goto error;
}
Tcl_ResetResult(interp);
- if (index < 0) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ if (index == -1) {
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(menuPtr->entries[index]->y));
}
return TCL_OK;
@@ -2973,7 +2976,7 @@ GetIndexFromCoords(
? Tk_Width(menuPtr->tkwin) : Tk_ReqWidth(menuPtr->tkwin);
max -= borderwidth;
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
if (menuPtr->entries[i]->entryFlags & ENTRY_LAST_COLUMN) {
x2 = max;
} else {
@@ -3016,7 +3019,7 @@ static void
RecursivelyDeleteMenu(
TkMenu *menuPtr) /* The menubar instance we are deleting. */
{
- int i;
+ TkSizeT i;
TkMenuEntry *mePtr;
/*
@@ -3103,7 +3106,7 @@ TkNewMenuName(
Tcl_AppendToObj(resultPtr, ".", -1);
}
Tcl_AppendObjToObj(resultPtr, childPtr);
- intPtr = Tcl_NewIntObj(i);
+ intPtr = Tcl_NewWideIntObj(i);
Tcl_AppendObjToObj(resultPtr, intPtr);
Tcl_DecrRefCount(intPtr);
}
@@ -3520,7 +3523,7 @@ DeleteMenuCloneEntries(
for (i = last; i >= first; i--) {
Tcl_EventuallyFree(menuListPtr->entries[i], (Tcl_FreeProc *) DestroyMenuEntry);
}
- for (i = last + 1; i < menuListPtr->numEntries; i++) {
+ for (i = last + 1; i < (int)menuListPtr->numEntries; i++) {
j = i - numDeleted;
menuListPtr->entries[j] = menuListPtr->entries[i];
menuListPtr->entries[j]->index = j;
@@ -3530,10 +3533,10 @@ DeleteMenuCloneEntries(
ckfree(menuListPtr->entries);
menuListPtr->entries = NULL;
}
- if ((menuListPtr->active >= first)
- && (menuListPtr->active <= last)) {
+ if (((int)menuListPtr->active >= first)
+ && ((int)menuListPtr->active <= last)) {
menuListPtr->active = -1;
- } else if (menuListPtr->active > last) {
+ } else if ((int)menuListPtr->active > last) {
menuListPtr->active -= numDeleted;
}
TkEventuallyRecomputeMenu(menuListPtr);
diff --git a/generic/tkMenu.h b/generic/tkMenu.h
index 802781a..5449879 100644
--- a/generic/tkMenu.h
+++ b/generic/tkMenu.h
@@ -267,9 +267,9 @@ typedef struct TkMenu {
Tcl_Command widgetCmd; /* Token for menu's widget command. */
TkMenuEntry **entries; /* Array of pointers to all the entries in the
* menu. NULL means no entries. */
- int numEntries; /* Number of elements in entries. */
- int active; /* Index of active entry. -1 means nothing
- * active. */
+ TkSizeT numEntries; /* Number of elements in entries. */
+ TkSizeT active; /* Index of active entry. TCL_INDEX_NONE means
+ * nothing active. */
int menuType; /* MASTER_MENU, TEAROFF_MENU, or MENUBAR. See
* below for definitions. */
Tcl_Obj *menuTypePtr; /* Used to control whether created tkwin is a
@@ -482,7 +482,7 @@ typedef struct TkMenuReferences {
* the outside world:
*/
-MODULE_SCOPE int TkActivateMenuEntry(TkMenu *menuPtr, int index);
+MODULE_SCOPE int TkActivateMenuEntry(TkMenu *menuPtr, TkSizeT index);
MODULE_SCOPE void TkBindMenu(Tk_Window tkwin, TkMenu *menuPtr);
MODULE_SCOPE TkMenuReferences*TkCreateMenuReferences(Tcl_Interp *interp,
const char *name);
@@ -503,7 +503,7 @@ MODULE_SCOPE int TkInvokeMenu(Tcl_Interp *interp, TkMenu *menuPtr,
int index);
MODULE_SCOPE void TkMenuConfigureDrawOptions(TkMenu *menuPtr);
MODULE_SCOPE int TkMenuConfigureEntryDrawOptions(
- TkMenuEntry *mePtr, int index);
+ TkMenuEntry *mePtr, TkSizeT index);
MODULE_SCOPE void TkMenuFreeDrawOptions(TkMenu *menuPtr);
MODULE_SCOPE void TkMenuEntryFreeDrawOptions(TkMenuEntry *mePtr);
MODULE_SCOPE void TkMenuEventProc(ClientData clientData,
@@ -521,7 +521,7 @@ MODULE_SCOPE int TkPostCommand(TkMenu *menuPtr);
MODULE_SCOPE int TkPostSubmenu(Tcl_Interp *interp, TkMenu *menuPtr,
TkMenuEntry *mePtr);
MODULE_SCOPE int TkPostTearoffMenu(Tcl_Interp *interp, TkMenu *menuPtr,
- int x, int y);
+ int x, int y);
MODULE_SCOPE int TkPreprocessMenu(TkMenu *menuPtr);
MODULE_SCOPE void TkRecomputeMenu(TkMenu *menuPtr);
@@ -544,7 +544,9 @@ MODULE_SCOPE void TkpMenuInit(void);
MODULE_SCOPE int TkpMenuNewEntry(TkMenuEntry *mePtr);
MODULE_SCOPE int TkpNewMenu(TkMenu *menuPtr);
MODULE_SCOPE int TkpPostMenu(Tcl_Interp *interp, TkMenu *menuPtr,
- int x, int y);
+ int x, int y, int index);
+MODULE_SCOPE int TkpPostTearoffMenu(Tcl_Interp *interp, TkMenu *menuPtr,
+ int x, int y, int index);
MODULE_SCOPE void TkpSetWindowMenuBar(Tk_Window tkwin, TkMenu *menuPtr);
#endif /* _TKMENU */
diff --git a/generic/tkMenuDraw.c b/generic/tkMenuDraw.c
index 3abfc3c..e3a1ef6 100644
--- a/generic/tkMenuDraw.c
+++ b/generic/tkMenuDraw.c
@@ -298,7 +298,7 @@ TkMenuConfigureDrawOptions(
int
TkMenuConfigureEntryDrawOptions(
TkMenuEntry *mePtr,
- int index)
+ TkSizeT index)
{
XGCValues gcValues;
GC newGC, newActiveGC, newDisabledGC, newIndicatorGC;
@@ -487,7 +487,7 @@ TkEventuallyRedrawMenu(
register TkMenuEntry *mePtr)/* Entry to redraw. NULL means redraw all the
* entries in the menu. */
{
- int i;
+ TkSizeT i;
if (menuPtr->tkwin == NULL) {
return;
@@ -618,7 +618,8 @@ DisplayMenu(
register TkMenu *menuPtr = clientData;
register TkMenuEntry *mePtr;
register Tk_Window tkwin = menuPtr->tkwin;
- int index, strictMotif;
+ TkSizeT index;
+ int strictMotif;
Tk_Font tkfont;
Tk_FontMetrics menuMetrics;
int width;
@@ -807,9 +808,8 @@ TkMenuImageProc(
*
* TkPostTearoffMenu --
*
- * Posts a menu on the screen. Used to post tearoff menus. On Unix, all
- * menus are posted this way. Adjusts the menu's position so that it fits
- * on the screen, and maps and raises the menu.
+ * Posts a tearoff menu on the screen. Adjusts the menu's position so
+ * that it fits on the screen, and maps and raises the menu.
*
* Results:
* Returns a standard Tcl Error.
@@ -827,64 +827,7 @@ TkPostTearoffMenu(
int x, int y) /* The root X,Y coordinates where we are
* posting */
{
- int vRootX, vRootY, vRootWidth, vRootHeight;
- int result;
-
- TkActivateMenuEntry(menuPtr, -1);
- TkRecomputeMenu(menuPtr);
- result = TkPostCommand(menuPtr);
- if (result != TCL_OK) {
- return result;
- }
-
- /*
- * The post commands could have deleted the menu, which means we are dead
- * and should go away.
- */
-
- if (menuPtr->tkwin == NULL) {
- return TCL_OK;
- }
-
- /*
- * Adjust the position of the menu if necessary to keep it visible on the
- * screen. There are two special tricks to make this work right:
- *
- * 1. If a virtual root window manager is being used then the coordinates
- * are in the virtual root window of menuPtr's parent; since the menu
- * uses override-redirect mode it will be in the *real* root window for
- * the screen, so we have to map the coordinates from the virtual root
- * (if any) to the real root. Can't get the virtual root from the menu
- * itself (it will never be seen by the wm) so use its parent instead
- * (it would be better to have an an option that names a window to use
- * for this...).
- * 2. The menu may not have been mapped yet, so its current size might be
- * the default 1x1. To compute how much space it needs, use its
- * requested size, not its actual size.
- */
-
- Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
- &vRootWidth, &vRootHeight);
- vRootWidth -= Tk_ReqWidth(menuPtr->tkwin);
- if (x > vRootX + vRootWidth) {
- x = vRootX + vRootWidth;
- }
- if (x < vRootX) {
- x = vRootX;
- }
- vRootHeight -= Tk_ReqHeight(menuPtr->tkwin);
- if (y > vRootY + vRootHeight) {
- y = vRootY + vRootHeight;
- }
- if (y < vRootY) {
- y = vRootY;
- }
- Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
- if (!Tk_IsMapped(menuPtr->tkwin)) {
- Tk_MapWindow(menuPtr->tkwin);
- }
- TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
- return TCL_OK;
+ return TkpPostTearoffMenu(interp, menuPtr, x, y, -1);
}
/*
@@ -969,8 +912,8 @@ TkPostSubmenu(
menuPtr->postedCascade = mePtr;
subary[0] = mePtr->namePtr;
subary[1] = Tcl_NewStringObj("post", -1);
- subary[2] = Tcl_NewIntObj(x);
- subary[3] = Tcl_NewIntObj(y);
+ subary[2] = Tcl_NewWideIntObj(x);
+ subary[3] = Tcl_NewWideIntObj(y);
Tcl_IncrRefCount(subary[1]);
Tcl_IncrRefCount(subary[2]);
Tcl_IncrRefCount(subary[3]);
diff --git a/generic/tkPack.c b/generic/tkPack.c
index aabfe1f..c1b6345 100644
--- a/generic/tkPack.c
+++ b/generic/tkPack.c
@@ -163,10 +163,10 @@ TkAppendPadAmount(
if (halfSpace*2 == allSpace) {
Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1),
- Tcl_NewIntObj(halfSpace));
+ Tcl_NewWideIntObj(halfSpace));
} else {
- padding[0] = Tcl_NewIntObj(halfSpace);
- padding[1] = Tcl_NewIntObj(allSpace - halfSpace);
+ padding[0] = Tcl_NewWideIntObj(halfSpace);
+ padding[1] = Tcl_NewWideIntObj(allSpace - halfSpace);
Tcl_DictObjPut(NULL, bufferObj, Tcl_NewStringObj(switchName, -1),
Tcl_NewListObj(2, padding));
}
diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c
index d6953e7..b86df0a 100644
--- a/generic/tkPanedWindow.c
+++ b/generic/tkPanedWindow.c
@@ -1132,8 +1132,8 @@ PanedWindowSashCommand(
}
slavePtr = pwPtr->slaves[sash];
- coords[0] = Tcl_NewIntObj(slavePtr->sashx);
- coords[1] = Tcl_NewIntObj(slavePtr->sashy);
+ coords[0] = Tcl_NewWideIntObj(slavePtr->sashx);
+ coords[1] = Tcl_NewWideIntObj(slavePtr->sashy);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
break;
@@ -1166,8 +1166,8 @@ PanedWindowSashCommand(
pwPtr->slaves[sash]->markx = x;
pwPtr->slaves[sash]->marky = y;
} else {
- coords[0] = Tcl_NewIntObj(pwPtr->slaves[sash]->markx);
- coords[1] = Tcl_NewIntObj(pwPtr->slaves[sash]->marky);
+ coords[0] = Tcl_NewWideIntObj(pwPtr->slaves[sash]->markx);
+ coords[1] = Tcl_NewWideIntObj(pwPtr->slaves[sash]->marky);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
}
break;
@@ -2877,8 +2877,8 @@ PanedWindowProxyCommand(
return TCL_ERROR;
}
- coords[0] = Tcl_NewIntObj(pwPtr->proxyx);
- coords[1] = Tcl_NewIntObj(pwPtr->proxyy);
+ coords[0] = Tcl_NewWideIntObj(pwPtr->proxyx);
+ coords[1] = Tcl_NewWideIntObj(pwPtr->proxyy);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
break;
@@ -3142,7 +3142,7 @@ PanedWindowIdentifyCoords(
if (found != -1) {
Tcl_Obj *list[2];
- list[0] = Tcl_NewIntObj(found);
+ list[0] = Tcl_NewWideIntObj(found);
list[1] = Tcl_NewStringObj((isHandle ? "handle" : "sash"), -1);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, list));
}
diff --git a/generic/tkPlace.c b/generic/tkPlace.c
index 1e606be..44eac5d 100644
--- a/generic/tkPlace.c
+++ b/generic/tkPlace.c
@@ -1185,6 +1185,12 @@ PlaceRequestProc(
if ((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH))
&& (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT))) {
+ /*
+ * Send a ConfigureNotify to indicate that the size change
+ * request was rejected.
+ */
+
+ TkDoConfigureNotify((TkWindow *)(slavePtr->tkwin));
return;
}
masterPtr = slavePtr->masterPtr;
diff --git a/generic/tkScale.c b/generic/tkScale.c
index 6862ea9..b39f147 100644
--- a/generic/tkScale.c
+++ b/generic/tkScale.c
@@ -157,11 +157,13 @@ enum command {
* Forward declarations for procedures defined later in this file:
*/
-static void ComputeFormat(TkScale *scalePtr);
+static void ComputeFormat(TkScale *scalePtr, int forTicks);
static void ComputeScaleGeometry(TkScale *scalePtr);
static int ConfigureScale(Tcl_Interp *interp, TkScale *scalePtr,
int objc, Tcl_Obj *const objv[]);
static void DestroyScale(char *memPtr);
+static double MaxTickRoundingError(TkScale *scalePtr,
+ double tickResolution);
static void ScaleCmdDeletedProc(ClientData clientData);
static void ScaleEventProc(ClientData clientData,
XEvent *eventPtr);
@@ -182,13 +184,54 @@ static void ScaleSetVariable(TkScale *scalePtr);
static const Tk_ClassProcs scaleClass = {
sizeof(Tk_ClassProcs), /* size */
ScaleWorldChanged, /* worldChangedProc */
- NULL, /* createProc */
- NULL /* modalProc */
+ NULL, /* createProc */
+ NULL /* modalProc */
};
/*
*--------------------------------------------------------------
*
+ * ScaleDigit, ScaleMax, ScaleMin, ScaleRound --
+ *
+ * Simple math helper functions, designed to be automatically inlined by
+ * the compiler most of the time.
+ *
+ *--------------------------------------------------------------
+ */
+
+static inline int
+ScaleDigit(
+ double value)
+{
+ return (int) floor(log10(fabs(value)));
+}
+
+static inline double
+ScaleMax(
+ double a,
+ double b)
+{
+ return (a > b) ? a : b;
+}
+
+static inline double
+ScaleMin(
+ double a,
+ double b)
+{
+ return (a < b) ? a : b;
+}
+
+static inline int
+ScaleRound(
+ double value)
+{
+ return (int) floor(value + 0.5);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
* Tk_ScaleObjCmd --
*
* This procedure is invoked to process the "scale" Tcl command. See the
@@ -408,8 +451,8 @@ ScaleWidgetObjCmd(
y = scalePtr->horizTroughY + scalePtr->width/2
+ scalePtr->borderWidth;
}
- coords[0] = Tcl_NewIntObj(x);
- coords[1] = Tcl_NewIntObj(y);
+ coords[0] = Tcl_NewWideIntObj(x);
+ coords[1] = Tcl_NewWideIntObj(y);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
break;
}
@@ -430,7 +473,7 @@ ScaleWidgetObjCmd(
}
value = TkScalePixelToValue(scalePtr, x, y);
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->format, value));
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->valueFormat, value));
break;
}
case COMMAND_IDENTIFY: {
@@ -611,7 +654,7 @@ ConfigureScale(
TCL_GLOBAL_ONLY);
if ((valuePtr != NULL) &&
(Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {
- scalePtr->value = TkRoundToResolution(scalePtr, value);
+ scalePtr->value = TkRoundValueToResolution(scalePtr, value);
}
}
@@ -620,10 +663,10 @@ ConfigureScale(
* orientation and creating GCs.
*/
- scalePtr->fromValue = TkRoundToResolution(scalePtr,
+ scalePtr->fromValue = TkRoundValueToResolution(scalePtr,
scalePtr->fromValue);
- scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
- scalePtr->tickInterval = TkRoundToResolution(scalePtr,
+ scalePtr->toValue = TkRoundValueToResolution(scalePtr, scalePtr->toValue);
+ scalePtr->tickInterval = TkRoundIntervalToResolution(scalePtr,
scalePtr->tickInterval);
/*
@@ -636,7 +679,8 @@ ConfigureScale(
scalePtr->tickInterval = -scalePtr->tickInterval;
}
- ComputeFormat(scalePtr);
+ ComputeFormat(scalePtr, 0);
+ ComputeFormat(scalePtr, 1);
scalePtr->labelLength = scalePtr->label ? strlen(scalePtr->label) : 0;
@@ -759,27 +803,77 @@ ScaleWorldChanged(
TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
}
+ /*
+ *----------------------------------------------------------------------
+ *
+ * MaxTickRoundingError --
+ *
+ * Given the separation between values that can be displayed on ticks,
+ * this calculates the maximum magnitude of error for the displayed
+ * value. Tries to be clever by working out the increment in error
+ * between ticks rather than testing all of them, so may overestimate
+ * error if it is greater than 0.25 x the value separation.
+ *
+ * Results:
+ * Maximum error magnitude of tick numbers.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static double
+MaxTickRoundingError(
+ TkScale *scalePtr, /* Information about scale widget. */
+ double tickResolution) /* Separation between displayable values. */
+{
+ double tickPosn, firstTickError, lastTickError, intervalError;
+ int tickCount;
+
+ /*
+ * Compute the error for each tick-related measure.
+ */
+
+ tickPosn = scalePtr->fromValue / tickResolution;
+ firstTickError = tickPosn - ScaleRound(tickPosn);
+
+ tickPosn = scalePtr->tickInterval / tickResolution;
+ intervalError = tickPosn - ScaleRound(tickPosn);
+
+ tickCount = (int) ((scalePtr->toValue - scalePtr->fromValue) /
+ scalePtr->tickInterval); /* not including first */
+ lastTickError = ScaleMin(0.5,
+ fabs(firstTickError + tickCount * intervalError));
+
+ /*
+ * Compute the maximum cumulative rounding error.
+ */
+
+ return ScaleMax(fabs(firstTickError), lastTickError) * tickResolution;
+}
+
/*
*----------------------------------------------------------------------
*
* ComputeFormat --
*
- * This procedure is invoked to recompute the "format" field of a scale's
- * widget record, which determines how the value of the scale is
- * converted to a string.
+ * This procedure is invoked to recompute the "valueFormat" or
+ * "tickFormat" field of a scale's widget record, which determines how
+ * the value of the scale or one of its ticks is converted to a string.
*
* Results:
* None.
*
- * Side effects:
- * The format field of scalePtr is modified.
+ * Side effects: The valueFormat or tickFormat field of scalePtr is modified.
*
*----------------------------------------------------------------------
*/
static void
ComputeFormat(
- TkScale *scalePtr) /* Information about scale widget. */
+ TkScale *scalePtr, /* Information about scale widget. */
+ int forTicks) /* Do for ticks rather than value */
{
double maxValue, x;
int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
@@ -798,48 +892,73 @@ ComputeFormat(
if (maxValue == 0) {
maxValue = 1;
}
- mostSigDigit = (int) floor(log10(maxValue));
+ mostSigDigit = ScaleDigit(maxValue);
- /*
- * If the number of significant digits wasn't specified explicitly,
- * compute it. It's the difference between the most significant digit
- * needed to represent any number on the scale and the most significant
- * digit of the smallest difference between numbers on the scale. In other
- * words, display enough digits so that at least one digit will be
- * different between any two adjacent positions of the scale.
- */
+ if (forTicks) {
+ /*
+ * Display only enough digits to ensure adjacent ticks have different
+ * values.
+ */
- numDigits = scalePtr->digits;
- if (numDigits > TCL_MAX_PREC) {
- numDigits = 0;
- }
- if (numDigits <= 0) {
- if (scalePtr->resolution > 0) {
- /*
- * A resolution was specified for the scale, so just use it.
- */
+ if (scalePtr->tickInterval != 0) {
+ leastSigDigit = ScaleDigit(scalePtr->tickInterval);
- leastSigDigit = (int) floor(log10(scalePtr->resolution));
- } else {
/*
- * No resolution was specified, so compute the difference in value
- * between adjacent pixels and use it for the least significant
- * digit.
+ * Now add more digits until max error is less than
+ * TICK_VALUES_DISPLAY_ACCURACY intervals
*/
- x = fabs(scalePtr->fromValue - scalePtr->toValue);
- if (scalePtr->length > 0) {
- x /= scalePtr->length;
+ while (MaxTickRoundingError(scalePtr, pow(10, leastSigDigit))
+ > fabs(TICK_VALUES_DISPLAY_ACCURACY * scalePtr->tickInterval)) {
+ --leastSigDigit;
}
- if (x > 0){
- leastSigDigit = (int) floor(log10(x));
+ numDigits = 1 + mostSigDigit - leastSigDigit;
+ } else {
+ numDigits = 1;
+ }
+ } else {
+ /*
+ * If the number of significant digits wasn't specified explicitly,
+ * compute it. It's the difference between the most significant digit
+ * needed to represent any number on the scale and the most
+ * significant digit of the smallest difference between numbers on the
+ * scale. In other words, display enough digits so that at least one
+ * digit will be different between any two adjacent positions of the
+ * scale.
+ */
+
+ numDigits = scalePtr->digits;
+ if (numDigits > TCL_MAX_PREC) {
+ numDigits = 0;
+ }
+ if (numDigits <= 0) {
+ if (scalePtr->resolution > 0) {
+ /*
+ * A resolution was specified for the scale, so just use it.
+ */
+
+ leastSigDigit = ScaleDigit(scalePtr->resolution);
} else {
- leastSigDigit = 0;
+ /*
+ * No resolution was specified, so compute the difference in
+ * value between adjacent pixels and use it for the least
+ * significant digit.
+ */
+
+ x = fabs(scalePtr->fromValue - scalePtr->toValue);
+ if (scalePtr->length > 0) {
+ x /= scalePtr->length;
+ }
+ if (x > 0) {
+ leastSigDigit = ScaleDigit(x);
+ } else {
+ leastSigDigit = 0;
+ }
+ }
+ numDigits = mostSigDigit - leastSigDigit + 1;
+ if (numDigits < 1) {
+ numDigits = 1;
}
- }
- numDigits = mostSigDigit - leastSigDigit + 1;
- if (numDigits < 1) {
- numDigits = 1;
}
}
@@ -863,10 +982,19 @@ ComputeFormat(
if (mostSigDigit < 0) {
fDigits++; /* Zero to left of decimal point. */
}
- if (fDigits <= eDigits) {
- sprintf(scalePtr->format, "%%.%df", afterDecimal);
+
+ if (forTicks) {
+ if (fDigits <= eDigits) {
+ sprintf(scalePtr->tickFormat, "%%.%df", afterDecimal);
+ } else {
+ sprintf(scalePtr->tickFormat, "%%.%de", numDigits - 1);
+ }
} else {
- sprintf(scalePtr->format, "%%.%de", numDigits-1);
+ if (fDigits <= eDigits) {
+ sprintf(scalePtr->valueFormat, "%%.%df", afterDecimal);
+ } else {
+ sprintf(scalePtr->valueFormat, "%%.%de", numDigits - 1);
+ }
}
}
@@ -894,7 +1022,7 @@ ComputeScaleGeometry(
register TkScale *scalePtr) /* Information about widget. */
{
char valueString[TCL_DOUBLE_SPACE];
- int tmp, valuePixels, x, y, extraSpace;
+ int tmp, valuePixels, tickPixels, x, y, extraSpace;
Tk_FontMetrics fm;
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
@@ -940,13 +1068,13 @@ ComputeScaleGeometry(
* whichever length is longer.
*/
- if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->format,
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->valueFormat,
scalePtr->fromValue) < 0) {
valueString[TCL_DOUBLE_SPACE - 1] = '\0';
}
valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
- if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->format,
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->valueFormat,
scalePtr->toValue) < 0) {
valueString[TCL_DOUBLE_SPACE - 1] = '\0';
}
@@ -956,18 +1084,37 @@ ComputeScaleGeometry(
}
/*
+ * Now do the same thing for the tick values
+ */
+
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->tickFormat,
+ scalePtr->fromValue) < 0) {
+ valueString[TCL_DOUBLE_SPACE - 1] = '\0';
+ }
+ tickPixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->tickFormat,
+ scalePtr->toValue) < 0) {
+ valueString[TCL_DOUBLE_SPACE - 1] = '\0';
+ }
+ tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+ if (tickPixels < tmp) {
+ tickPixels = tmp;
+ }
+
+ /*
* Assign x-locations to the elements of the scale, working from left to
* right.
*/
x = scalePtr->inset;
if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) {
- scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertTickRightX = x + SPACING + tickPixels;
scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels
+ fm.ascent/2;
x = scalePtr->vertValueRightX + SPACING;
} else if (scalePtr->tickInterval != 0) {
- scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertTickRightX = x + SPACING + tickPixels;
scalePtr->vertValueRightX = scalePtr->vertTickRightX;
x = scalePtr->vertTickRightX + SPACING;
} else if (scalePtr->showValue) {
@@ -1119,10 +1266,14 @@ TkEventuallyRedrawScale(
/*
*--------------------------------------------------------------
*
- * TkRoundToResolution --
+ * TkRoundValueToResolution, TkRoundIntervalToResolution --
*
* Round a given floating-point value to the nearest multiple of the
* scale's resolution.
+ * TkRoundValueToResolution rounds an absolute value based on the from
+ * value as a reference.
+ * TkRoundIntervalToResolution rounds a relative value without
+ * reference, i.e. it rounds an interval.
*
* Results:
* The return value is the rounded result.
@@ -1134,7 +1285,16 @@ TkEventuallyRedrawScale(
*/
double
-TkRoundToResolution(
+TkRoundValueToResolution(
+ TkScale *scalePtr, /* Information about scale widget. */
+ double value) /* Value to round. */
+{
+ return TkRoundIntervalToResolution(scalePtr, value - scalePtr->fromValue)
+ + scalePtr->fromValue;
+}
+
+double
+TkRoundIntervalToResolution(
TkScale *scalePtr, /* Information about scale widget. */
double value) /* Value to round. */
{
@@ -1147,13 +1307,13 @@ TkRoundToResolution(
rounded = scalePtr->resolution * tick;
rem = value - rounded;
if (rem < 0) {
- if (rem <= -scalePtr->resolution/2) {
- rounded = (tick - 1.0) * scalePtr->resolution;
- }
+ if (rem <= -scalePtr->resolution/2) {
+ rounded = (tick - 1.0) * scalePtr->resolution;
+ }
} else {
- if (rem >= scalePtr->resolution/2) {
- rounded = (tick + 1.0) * scalePtr->resolution;
- }
+ if (rem >= scalePtr->resolution/2) {
+ rounded = (tick + 1.0) * scalePtr->resolution;
+ }
}
return rounded;
}
@@ -1238,7 +1398,7 @@ ScaleVarProc(
resultStr = "can't assign non-numeric value to scale variable";
ScaleSetVariable(scalePtr);
} else {
- scalePtr->value = TkRoundToResolution(scalePtr, value);
+ scalePtr->value = TkRoundValueToResolution(scalePtr, value);
/*
* This code is a bit tricky because it sets the scale's value before
@@ -1282,7 +1442,7 @@ TkScaleSetValue(
int invokeCommand) /* Non-zero means invoked -command option to
* notify of new value, 0 means don't. */
{
- value = TkRoundToResolution(scalePtr, value);
+ value = TkRoundValueToResolution(scalePtr, value);
if ((value < scalePtr->fromValue)
^ (scalePtr->toValue < scalePtr->fromValue)) {
value = scalePtr->fromValue;
@@ -1337,7 +1497,7 @@ ScaleSetVariable(
if (scalePtr->varNamePtr != NULL) {
char string[TCL_DOUBLE_SPACE];
- if (snprintf(string, TCL_DOUBLE_SPACE, scalePtr->format,
+ if (snprintf(string, TCL_DOUBLE_SPACE, scalePtr->valueFormat,
scalePtr->value) < 0) {
string[TCL_DOUBLE_SPACE - 1] = '\0';
}
@@ -1402,7 +1562,7 @@ TkScalePixelToValue(
}
value = scalePtr->fromValue +
value * (scalePtr->toValue - scalePtr->fromValue);
- return TkRoundToResolution(scalePtr, value);
+ return TkRoundValueToResolution(scalePtr, value);
}
/*
@@ -1439,8 +1599,8 @@ TkScaleValueToPixel(
if (valueRange == 0) {
y = 0;
} else {
- y = (int) ((value - scalePtr->fromValue) * pixelRange
- / valueRange + 0.5);
+ y = ScaleRound((value - scalePtr->fromValue) * pixelRange
+ / valueRange);
if (y < 0) {
y = 0;
} else if (y > pixelRange) {
diff --git a/generic/tkScale.h b/generic/tkScale.h
index e7e0dde..4e4a3e7 100644
--- a/generic/tkScale.h
+++ b/generic/tkScale.h
@@ -73,8 +73,10 @@ typedef struct TkScale {
* values. 0 means we get to choose the number
* based on resolution and/or the range of the
* scale. */
- char format[16]; /* Sprintf conversion specifier computed from
+ char valueFormat[16]; /* Sprintf conversion specifier computed from
* digits and other information. */
+ char tickFormat[16]; /* Sprintf conversion specifier computed from
+ * tick interval. */
double bigIncrement; /* Amount to use for large increments to scale
* value. (0 means we pick a value). */
char *command; /* Command prefix to use when invoking Tcl
@@ -215,11 +217,20 @@ typedef struct TkScale {
#define SPACING 2
/*
+ * The tick values are all displayed with the same number of decimal places.
+ * This number of decimal places is such that the displayed values are all
+ * accurate to within the following proportion of a tick interval.
+ */
+
+#define TICK_VALUES_DISPLAY_ACCURACY 0.2
+
+/*
* Declaration of procedures used in the implementation of the scale widget.
*/
MODULE_SCOPE void TkEventuallyRedrawScale(TkScale *scalePtr, int what);
-MODULE_SCOPE double TkRoundToResolution(TkScale *scalePtr, double value);
+MODULE_SCOPE double TkRoundValueToResolution(TkScale *scalePtr, double value);
+MODULE_SCOPE double TkRoundIntervalToResolution(TkScale *scalePtr, double value);
MODULE_SCOPE TkScale * TkpCreateScale(Tk_Window tkwin);
MODULE_SCOPE void TkpDestroyScale(TkScale *scalePtr);
MODULE_SCOPE void TkpDisplayScale(ClientData clientData);
diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c
index f88b37b..02daafb 100644
--- a/generic/tkScrollbar.c
+++ b/generic/tkScrollbar.c
@@ -381,10 +381,10 @@ ScrollbarWidgetObjCmd(
}
#ifndef TK_NO_DEPRECATED
if (scrollPtr->flags & OLD_STYLE_COMMANDS) {
- resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits);
- resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits);
- resObjs[2] = Tcl_NewIntObj(scrollPtr->firstUnit);
- resObjs[3] = Tcl_NewIntObj(scrollPtr->lastUnit);
+ resObjs[0] = Tcl_NewWideIntObj(scrollPtr->totalUnits);
+ resObjs[1] = Tcl_NewWideIntObj(scrollPtr->windowUnits);
+ resObjs[2] = Tcl_NewWideIntObj(scrollPtr->firstUnit);
+ resObjs[3] = Tcl_NewWideIntObj(scrollPtr->lastUnit);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs));
break;
}
diff --git a/generic/tkTest.c b/generic/tkTest.c
index cc9b54b..d7f966e 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -1212,7 +1212,7 @@ TrivialConfigObjCmd(
headerPtr->optionTable, objc - 2, objv + 2,
tkwin, NULL, &mask);
if (result == TCL_OK) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(mask));
}
}
break;
@@ -1222,7 +1222,7 @@ TrivialConfigObjCmd(
tkwin, &saved, &mask);
Tk_FreeSavedOptions(&saved);
if (result == TCL_OK) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(mask));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(mask));
}
break;
}
@@ -2167,8 +2167,8 @@ TestPhotoStringMatchCmd(
return TCL_ERROR;
}
if (TkDebugPhotoStringMatchDef(interp, objv[1], dummy, &width, &height)) {
- resultObj[0] = Tcl_NewIntObj(width);
- resultObj[1] = Tcl_NewIntObj(height);
+ resultObj[0] = Tcl_NewWideIntObj(width);
+ resultObj[1] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
return TCL_OK;
} else {
diff --git a/generic/tkText.c b/generic/tkText.c
index 3710b31..c748015 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -748,10 +748,10 @@ TextWidgetObjCmd(
NULL) == 0) {
Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(x));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(y));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(width));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(height));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(x));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(y));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(width));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(height));
Tcl_SetObjResult(interp, listObj);
}
@@ -1019,7 +1019,7 @@ TextWidgetObjCmd(
countDone:
found++;
if (found == 1) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(value));
} else {
if (found == 2) {
/*
@@ -1031,7 +1031,7 @@ TextWidgetObjCmd(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_GetObjResult(interp));
}
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(value));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(value));
}
}
@@ -1043,7 +1043,7 @@ TextWidgetObjCmd(
int value = CountIndices(textPtr, indexFromPtr, indexToPtr,
COUNT_INDICES);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(value));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(value));
} else if (found > 1) {
Tcl_SetObjResult(interp, objPtr);
}
@@ -1239,11 +1239,11 @@ TextWidgetObjCmd(
&base) == 0) {
Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(x));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(y));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(width));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(height));
- Tcl_ListObjAppendElement(interp, listObj, Tcl_NewIntObj(base));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(x));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(y));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(width));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(height));
+ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewWideIntObj(base));
Tcl_SetObjResult(interp, listObj);
}
@@ -4273,7 +4273,7 @@ TextSearchFoundMatch(
int matchLength) /* Length also in bytes/chars as per search
* type. */
{
- int numChars;
+ size_t numChars;
int leftToScan;
TkTextIndex curIndex, foundIndex;
TkTextSegment *segPtr;
@@ -4313,7 +4313,7 @@ TextSearchFoundMatch(
if (searchSpecPtr->strictLimits && lineNum == searchSpecPtr->stopLine) {
if (searchSpecPtr->backwards ^
- ((matchOffset + numChars) > searchSpecPtr->stopOffset)) {
+ ((matchOffset + numChars + 1) > (size_t) searchSpecPtr->stopOffset + 1)) {
return 0;
}
}
@@ -4466,7 +4466,7 @@ TextSearchFoundMatch(
*/
if (searchSpecPtr->varPtr != NULL) {
- Tcl_Obj *tmpPtr = Tcl_NewIntObj(numChars);
+ Tcl_Obj *tmpPtr = Tcl_NewWideIntObj(numChars);
if (searchSpecPtr->all) {
if (searchSpecPtr->countPtr == NULL) {
searchSpecPtr->countPtr = Tcl_NewObj();
@@ -5622,7 +5622,7 @@ TkTextRunAfterSyncCmd(
code = Tcl_EvalObjEx(textPtr->interp, textPtr->afterSyncCmd, TCL_EVAL_GLOBAL);
if (code == TCL_ERROR) {
Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)");
- Tcl_BackgroundError(textPtr->interp);
+ Tcl_BackgroundException(textPtr->interp, TCL_ERROR);
}
Tcl_Release((ClientData) textPtr->interp);
Tcl_DecrRefCount(textPtr->afterSyncCmd);
@@ -5759,7 +5759,8 @@ SearchCore(
* they are Unicode char offsets.
*/
- int firstOffset, lastOffset, matchOffset, matchLength;
+ int firstOffset, lastOffset;
+ size_t matchOffset, matchLength;
int passes;
int lineNum = searchSpecPtr->startLine;
int code = TCL_OK;
@@ -5780,9 +5781,9 @@ SearchCore(
#define LOTS_OF_MATCHES 20
int matchNum = LOTS_OF_MATCHES;
- int smArray[2 * LOTS_OF_MATCHES];
- int *storeMatch = smArray;
- int *storeLength = smArray + LOTS_OF_MATCHES;
+ size_t smArray[2 * LOTS_OF_MATCHES];
+ size_t *storeMatch = smArray;
+ size_t *storeLength = smArray + LOTS_OF_MATCHES;
int lastBackwardsLineMatch = -1;
int lastBackwardsMatchOffset = -1;
@@ -5832,7 +5833,7 @@ SearchCore(
* it has dual purpose.
*/
- pattern = Tcl_GetStringFromObj(patObj, &matchLength);
+ pattern = TkGetStringFromObj(patObj, &matchLength);
nl = strchr(pattern, '\n');
/*
@@ -5967,11 +5968,11 @@ SearchCore(
do {
int ch;
const char *p;
- int lastFullLine = lastOffset;
+ size_t lastFullLine = lastOffset;
if (firstNewLine == -1) {
if (searchSpecPtr->strictLimits
- && (firstOffset + matchLength > lastOffset)) {
+ && (firstOffset + matchLength + 1 > (size_t)lastOffset + 1)) {
/*
* Not enough characters to match.
*/
@@ -6001,7 +6002,7 @@ SearchCore(
}
while (p >= startOfLine + firstOffset) {
if (matchLength == 0 || (p[0] == c && !strncmp(
- p, pattern, (size_t) matchLength))) {
+ p, pattern, matchLength))) {
goto backwardsMatch;
}
p--;
@@ -6089,14 +6090,14 @@ SearchCore(
* exact searches.
*/
- if ((lastTotal - skipFirst) >= matchLength) {
+ if ((size_t)lastTotal - skipFirst + 1 >= matchLength + 1) {
/*
* We now have enough text to match, so we
* make a final test and break whatever the
* result.
*/
- if (strncmp(p,pattern,(size_t)matchLength)) {
+ if (strncmp(p, pattern, matchLength)) {
p = NULL;
}
break;
@@ -6171,7 +6172,7 @@ SearchCore(
}
} else {
firstOffset = matchLength ? p - startOfLine + matchLength
- : p - startOfLine + 1;
+ : p - startOfLine + (size_t)1;
if (firstOffset >= lastOffset) {
/*
* Now, we have to be careful not to find
@@ -6211,7 +6212,7 @@ SearchCore(
do {
Tcl_RegExpInfo info;
int match;
- int lastFullLine = lastOffset;
+ size_t lastFullLine = lastOffset;
match = Tcl_RegExpExecObj(interp, regexp, theLine,
firstOffset, 1, (firstOffset>0 ? TCL_REG_NOTBOL : 0));
@@ -6229,9 +6230,9 @@ SearchCore(
if (!match ||
((info.extendStart == info.matches[0].start)
- && (info.matches[0].end == lastOffset-firstOffset))) {
+ && ((size_t) info.matches[0].end == (size_t) lastOffset - firstOffset))) {
int extraLines = 0;
- int prevFullLine;
+ size_t prevFullLine;
/*
* If we find a match that overlaps more than one line, we
@@ -6247,7 +6248,7 @@ SearchCore(
lastNonOverlap = lastTotal;
}
- if (info.extendStart < 0) {
+ if ((size_t) info.extendStart == (size_t) -1) {
/*
* No multi-line match is possible.
*/
@@ -6344,9 +6345,9 @@ SearchCore(
*/
if ((match &&
- firstOffset+info.matches[0].end != lastTotal &&
- firstOffset+info.matches[0].end < prevFullLine)
- || info.extendStart < 0) {
+ firstOffset+(size_t) info.matches[0].end != (size_t) lastTotal &&
+ firstOffset+(size_t) info.matches[0].end + 1 < prevFullLine + 1)
+ || (size_t) info.extendStart == (size_t) -1) {
break;
}
@@ -6357,10 +6358,10 @@ SearchCore(
* that line.
*/
- if (match && (info.matches[0].start >= lastOffset)) {
+ if (match && ((size_t) info.matches[0].start + 1 >= (size_t) lastOffset + 1)) {
break;
}
- if (match && ((firstOffset + info.matches[0].end)
+ if (match && ((firstOffset + (size_t) info.matches[0].end)
>= prevFullLine)) {
if (extraLines > 0) {
extraLinesSearched = extraLines - 1;
@@ -6414,8 +6415,8 @@ SearchCore(
* Possible overlap or enclosure.
*/
- if (thisOffset-lastNonOverlap >=
- lastBackwardsMatchOffset+matchLength){
+ if ((size_t)thisOffset - lastNonOverlap >=
+ lastBackwardsMatchOffset + matchLength + 1){
/*
* Totally encloses previous match, so
* forget the previous match.
@@ -6496,12 +6497,12 @@ SearchCore(
* previous match.
*/
- if (matchOffset == -1 ||
+ if (matchOffset == (size_t)-1 ||
((searchSpecPtr->all || searchSpecPtr->backwards)
- && ((firstOffset < matchOffset)
- || ((firstOffset + info.matches[0].end
- - info.matches[0].start)
- > (matchOffset + matchLength))))) {
+ && (((size_t)firstOffset + 1< matchOffset + 1)
+ || ((firstOffset + (size_t) info.matches[0].end
+ - (size_t) info.matches[0].start)
+ > matchOffset + matchLength)))) {
matchOffset = firstOffset;
matchLength = info.matches[0].end - info.matches[0].start;
@@ -6519,9 +6520,9 @@ SearchCore(
* matches on the heap.
*/
- int *newArray =
- ckalloc(4 * matchNum * sizeof(int));
- memcpy(newArray, storeMatch, matchNum*sizeof(int));
+ size_t *newArray =
+ ckalloc(4 * matchNum * sizeof(size_t));
+ memcpy(newArray, storeMatch, matchNum*sizeof(size_t));
memcpy(newArray + 2*matchNum, storeLength,
matchNum * sizeof(int));
if (storeMatch != smArray) {
@@ -6558,7 +6559,7 @@ SearchCore(
* explicitly disallow overlapping matches.
*/
- if (matchLength > 0 && !searchSpecPtr->overlap
+ if (matchLength + 1 > 1 && !searchSpecPtr->overlap
&& !searchSpecPtr->backwards) {
firstOffset += matchLength;
if (firstOffset >= lastOffset) {
@@ -6615,8 +6616,8 @@ SearchCore(
* found which would exercise such a problem.
*/
}
- if (storeMatch[matches] + storeLength[matches]
- >= matchOffset + matchLength) {
+ if (storeMatch[matches] + storeLength[matches] + 1
+ >= matchOffset + matchLength + 1) {
/*
* The new match totally encloses the previous one, so
* we overwrite the previous one.
@@ -6664,7 +6665,7 @@ SearchCore(
* we are done.
*/
- if ((lastBackwardsLineMatch == -1) && (matchOffset >= 0)
+ if ((lastBackwardsLineMatch == -1) && (matchOffset != (size_t) -1)
&& !searchSpecPtr->all) {
searchSpecPtr->foundMatchProc(lineNum, searchSpecPtr, lineInfo,
theLine, matchOffset, matchLength);
@@ -6791,7 +6792,7 @@ GetLineStartEnd(
if (linePtr == NULL) {
return Tcl_NewObj();
}
- return Tcl_NewIntObj(1 + TkBTreeLinesTo(NULL, linePtr));
+ return Tcl_NewWideIntObj(1 + TkBTreeLinesTo(NULL, linePtr));
}
/*
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
index cb22646..1f44d37 100644
--- a/generic/tkTextDisp.c
+++ b/generic/tkTextDisp.c
@@ -3077,7 +3077,7 @@ AsyncUpdateLineMetrics(
TCL_EVAL_GLOBAL);
if (code == TCL_ERROR) {
Tcl_AddErrorInfo(textPtr->interp, "\n (text sync)");
- Tcl_BackgroundError(textPtr->interp);
+ Tcl_BackgroundException(textPtr->interp, TCL_ERROR);
}
Tcl_Release((ClientData) textPtr->interp);
Tcl_DecrRefCount(textPtr->afterSyncCmd);
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 3d91927..d8c2068 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -3170,7 +3170,7 @@ Initialize(
Tcl_SetVar2Ex(interp, "argv", NULL,
Tcl_NewListObj(objc-1, rest+1), TCL_GLOBAL_ONLY);
Tcl_SetVar2Ex(interp, "argc", NULL,
- Tcl_NewIntObj(objc-1), TCL_GLOBAL_ONLY);
+ Tcl_NewWideIntObj(objc-1), TCL_GLOBAL_ONLY);
ckfree(rest);
}
Tcl_DecrRefCount(parseList);
diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c
index b46b2fb..444bc83 100644
--- a/generic/ttk/ttkEntry.c
+++ b/generic/ttk/ttkEntry.c
@@ -1605,7 +1605,7 @@ static int EntrySelectionPresentCommand(
return TCL_ERROR;
}
Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(entryPtr->entry.selectFirst >= 0));
+ Tcl_NewWideIntObj(entryPtr->entry.selectFirst >= 0));
return TCL_OK;
}
@@ -1682,7 +1682,7 @@ static int EntryValidateCommand(
if (code == TCL_ERROR)
return code;
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(code == TCL_OK));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(code == TCL_OK));
return TCL_OK;
}
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
index 0c91938..0f720d1 100644
--- a/generic/ttk/ttkTreeview.c
+++ b/generic/ttk/ttkTreeview.c
@@ -2144,7 +2144,7 @@ static int TreeviewExistsCommand(
}
entryPtr = Tcl_FindHashEntry(&tv->tree.items, Tcl_GetString(objv[2]));
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(entryPtr != 0));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(entryPtr != 0));
return TCL_OK;
}
@@ -2231,7 +2231,9 @@ static int TreeviewHorribleIdentify(
Ttk_Element element;
BoundingBox(tv, item, NULL, &itemBox);
- PrepareItem(tv, item, &displayItem); /*@@@ FIX: -text, etc*/
+ PrepareItem(tv, item, &displayItem);
+ if (item->textObj) { displayItem.textObj = item->textObj; }
+ if (item->imageObj) { displayItem.imageObj = item->imageObj; }
Ttk_RebindSublayout(layout, &displayItem);
Ttk_PlaceLayout(layout, ItemState(tv,item), itemBox);
element = Ttk_IdentifyElement(layout, x, y);
@@ -2343,7 +2345,9 @@ static int TreeviewIdentifyCommand(
return TCL_OK;
}
- PrepareItem(tv, item, &displayItem); /*@@@ FIX: fill in -text,etc */
+ PrepareItem(tv, item, &displayItem);
+ if (item->textObj) { displayItem.textObj = item->textObj; }
+ if (item->imageObj) { displayItem.imageObj = item->imageObj; }
Ttk_RebindSublayout(layout, &displayItem);
Ttk_PlaceLayout(layout, ItemState(tv,item), bbox);
element = Ttk_IdentifyElement(layout, x, y);
@@ -3110,7 +3114,7 @@ static int TreeviewTagHasCommand(
return TCL_ERROR;
}
Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(Ttk_TagSetContains(item->tagset, tag)));
+ Tcl_NewWideIntObj(Ttk_TagSetContains(item->tagset, tag)));
return TCL_OK;
} else {
Tcl_WrongNumArgs(interp, 3, objv, "tagName ?item?");
diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c
index 1cae8fb..a7f7e55 100644
--- a/generic/ttk/ttkWidget.c
+++ b/generic/ttk/ttkWidget.c
@@ -738,7 +738,7 @@ int TtkWidgetInstateCommand(
if (objc == 3) {
Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(Ttk_StateMatches(state,&spec)));
+ Tcl_NewWideIntObj(Ttk_StateMatches(state,&spec)));
} else if (objc == 4) {
if (Ttk_StateMatches(state,&spec)) {
status = Tcl_EvalObjEx(interp, objv[3], 0);
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index b15387e..574ad8b 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -97,7 +97,7 @@ proc ::tk::dialog::error::ReturnInDetails w {
# Arguments:
# err - The error message.
#
-proc ::tk::dialog::error::bgerror err {
+proc ::tk::dialog::error::bgerror {err {flag 1}} {
global errorInfo
variable button
@@ -106,15 +106,20 @@ proc ::tk::dialog::error::bgerror err {
set ret [catch {::tkerror $err} msg];
if {$ret != 1} {return -code $ret $msg}
- # Ok the application's tkerror either failed or was not found
- # we use the default dialog then :
+ # The application's tkerror either failed or was not found
+ # so we use the default dialog. But on Aqua we cannot display
+ # the dialog if the background error occurs in an idle task
+ # being processed inside of [NSView drawRect]. In that case
+ # we post the dialog as an after task instead.
set windowingsystem [tk windowingsystem]
if {$windowingsystem eq "aqua"} {
- set ok [mc Ok]
- } else {
- set ok [mc OK]
+ if $flag {
+ after 500 [list bgerror "$err" 0]
+ return
+ }
}
+ set ok [mc OK]
# Truncate the message if it is too wide (>maxLine characters) or
# too tall (>4 lines). Truncation occurs at the first point at
# which one of those conditions is met.
diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl
index 4f7f955..eebe87a 100644
--- a/library/demos/puzzle.tcl
+++ b/library/demos/puzzle.tcl
@@ -73,7 +73,7 @@ for {set i 0} {$i < 15} {set i [expr {$i+1}]} {
set num [lindex $order $i]
set xpos($num) [expr {($i%4)*.25}]
set ypos($num) [expr {($i/4)*.25}]
- button $w.frame.$num -relief raised -text $num -highlightthickness 0 \
+ button $w.frame.$num -relief raised -text $num -bd 0 -highlightthickness 0 \
-command "puzzleSwitch $w $num"
place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
-relwidth .25 -relheight .25
diff --git a/library/menu.tcl b/library/menu.tcl
index ba66b92..8d06868 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -234,6 +234,7 @@ proc ::tk::MbLeave w {
}
}
+
# ::tk::MbPost --
# Given a menubutton, this procedure does all the work of posting
# its associated menu and unposting any other menu that is currently
@@ -282,101 +283,17 @@ proc ::tk::MbPost {w {x {}} {y {}}} {
set Priv(focus) [focus]
$menu activate none
GenerateMenuSelect $menu
-
- # If this looks like an option menubutton then post the menu so
- # that the current entry is on top of the mouse. Otherwise post
- # the menu just below the menubutton, as for a pull-down.
-
update idletasks
- if {[catch {
- switch [$w cget -direction] {
- above {
- set x [winfo rootx $w]
- set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
- # if we go offscreen to the top, show as 'below'
- if {$y < [winfo vrooty $w]} {
- set y [expr {[winfo vrooty $w] + [winfo rooty $w] + [winfo reqheight $w]}]
- }
- PostOverPoint $menu $x $y
- }
- below {
- set x [winfo rootx $w]
- set y [expr {[winfo rooty $w] + [winfo height $w]}]
- # if we go offscreen to the bottom, show as 'above'
- set mh [winfo reqheight $menu]
- if {($y + $mh) > ([winfo vrooty $w] + [winfo vrootheight $w])} {
- set y [expr {[winfo vrooty $w] + [winfo vrootheight $w] + [winfo rooty $w] - $mh}]
- }
- PostOverPoint $menu $x $y
- }
- left {
- set x [expr {[winfo rootx $w] - [winfo reqwidth $menu]}]
- set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
- set entry [MenuFindName $menu [$w cget -text]]
- if {$entry eq ""} {
- set entry 0
- }
- if {[$w cget -indicatoron]} {
- if {$entry == [$menu index last]} {
- incr y [expr {-([$menu yposition $entry] \
- + [winfo reqheight $menu])/2}]
- } else {
- incr y [expr {-([$menu yposition $entry] \
- + [$menu yposition [expr {$entry+1}]])/2}]
- }
- }
- PostOverPoint $menu $x $y
- if {$entry ne "" \
- && [$menu entrycget $entry -state] ne "disabled"} {
- $menu activate $entry
- GenerateMenuSelect $menu
- }
- }
- right {
- set x [expr {[winfo rootx $w] + [winfo width $w]}]
- set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}]
- set entry [MenuFindName $menu [$w cget -text]]
- if {$entry eq ""} {
- set entry 0
- }
- if {[$w cget -indicatoron]} {
- if {$entry == [$menu index last]} {
- incr y [expr {-([$menu yposition $entry] \
- + [winfo reqheight $menu])/2}]
- } else {
- incr y [expr {-([$menu yposition $entry] \
- + [$menu yposition [expr {$entry+1}]])/2}]
- }
- }
- PostOverPoint $menu $x $y
- if {$entry ne "" \
- && [$menu entrycget $entry -state] ne "disabled"} {
- $menu activate $entry
- GenerateMenuSelect $menu
- }
- }
- default {
- if {[$w cget -indicatoron]} {
- if {$y eq ""} {
- set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
- set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
- }
- PostOverPoint $menu $x $y [MenuFindName $menu [$w cget -text]]
- } else {
- PostOverPoint $menu [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
- }
- }
- }
- } msg opt]} {
+
+ if {[catch {PostMenubuttonMenu $w $menu} msg opt]} {
# Error posting menu (e.g. bogus -postcommand). Unpost it and
# reflect the error.
-
MenuUnpost {}
return -options $opt $msg
}
set Priv(tearoff) $tearoff
- if {$tearoff != 0} {
+ if {$tearoff != 0 && [tk windowingsystem] ne "aqua"} {
focus $menu
if {[winfo viewable $w]} {
SaveGrabInfo $w
@@ -576,11 +493,13 @@ proc ::tk::MenuMotion {menu x y state} {
if {[string is false $mode]} {
set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}]
if {[$menu type $index] eq "cascade"} {
+ # Catch these postcascade commands since the menu could be
+ # destroyed before they run.
set Priv(menuActivatedTimer) \
- [after $delay [list $menu postcascade active]]
+ [after $delay "catch {$menu postcascade active}"]
} else {
set Priv(menuDeactivatedTimer) \
- [after $delay [list $menu postcascade none]]
+ [after $delay "catch {$menu postcascade none}"]
}
}
}
@@ -1208,10 +1127,118 @@ proc ::tk::MenuFindName {menu s} {
return ""
}
+# ::tk::PostMenubuttonMenu --
+#
+# Given a menubutton and a menu, this procedure posts the menu at the
+# appropriate location. If the menubutton looks like an option
+# menubutton, meaning that the indicator is on and the direction is
+# neither above nor below, then the menu is posted so that the current
+# entry is vertically aligned with the menubutton. On the Mac this
+# will expose a small amount of the blue indicator on the right hand
+# side. On other platforms the entry is centered over the button.
+
+if {[tk windowingsystem] eq "aqua"} {
+ proc ::tk::PostMenubuttonMenu {button menu} {
+ set entry ""
+ if {[$button cget -indicatoron]} {
+ set entry [MenuFindName $menu [$button cget -text]]
+ if {$entry eq ""} {
+ set entry 0
+ }
+ }
+ set x [winfo rootx $button]
+ set y [expr {2 + [winfo rooty $button]}]
+ switch [$button cget -direction] {
+ above {
+ set entry ""
+ incr y [expr {4 - [winfo reqheight $menu]}]
+ }
+ below {
+ set entry ""
+ incr y [expr {2 + [winfo height $button]}]
+ }
+ left {
+ incr x [expr {-[winfo reqwidth $menu]}]
+ }
+ right {
+ incr x [winfo width $button]
+ }
+ default {
+ incr x [expr {[winfo width $button] - [winfo reqwidth $menu] - 5}]
+ }
+ }
+ PostOverPoint $menu $x $y $entry
+ }
+} else {
+ proc ::tk::PostMenubuttonMenu {button menu} {
+ set entry ""
+ if {[$button cget -indicatoron]} {
+ set entry [MenuFindName $menu [$button cget -text]]
+ if {$entry eq ""} {
+ set entry 0
+ }
+ }
+ if {$entry ne ""} {
+ if {$entry == [$menu index last]} {
+ set entryHeight [expr {[winfo reqheight $menu] \
+ - [$menu yposition $entry]}]
+ } else {
+ set entryHeight [expr {[$menu yposition [expr {$entry+1}]] \
+ - [$menu yposition $entry]}]
+ }
+ }
+ set x [winfo rootx $button]
+ set y [winfo rooty $button]
+ switch [$button cget -direction] {
+ above {
+ incr y [expr {-[winfo reqheight $menu]}]
+ # if we go offscreen to the top, show as 'below'
+ if {$y < [winfo vrooty $button]} {
+ set y [expr {[winfo vrooty $button] + [winfo rooty $button]\
+ + [winfo reqheight $button]}]
+ }
+ set entry {}
+ }
+ below {
+ incr y [winfo height $button]
+ # if we go offscreen to the bottom, show as 'above'
+ set mh [winfo reqheight $menu]
+ if {($y + $mh) > ([winfo vrooty $button] + [winfo vrootheight $button])} {
+ set y [expr {[winfo vrooty $button] + [winfo vrootheight $button] \
+ + [winfo rooty $button] - $mh}]
+ }
+ set entry {}
+ }
+ left {
+ # It is not clear why this is needed.
+ if {[tk windowingsystem] eq "win32"} {
+ incr x [expr {-4 - [winfo reqwidth $button] / 2}]
+ }
+ incr x [expr {- [winfo reqwidth $menu]}]
+ }
+ right {
+ incr x [expr {[winfo width $button]}]
+ }
+ default {
+ if {[$button cget -indicatoron]} {
+ incr x [expr {([winfo width $button] - \
+ [winfo reqwidth $menu])/ 2}]
+ } else {
+ incr y [winfo height $button]
+ }
+ }
+ }
+ PostOverPoint $menu $x $y $entry
+ }
+}
+
# ::tk::PostOverPoint --
-# This procedure posts a given menu such that a given entry in the
-# menu is centered over a given point in the root window. It also
-# activates the given entry.
+#
+# This procedure posts a menu on the screen so that a given entry in
+# the menu is positioned with its upper left corner at a given point
+# in the root window. The procedure also activates that entry. If no
+# entry is specified the upper left corner of the entire menu is
+# placed at the point.
#
# Arguments:
# menu - Menu to post.
@@ -1220,19 +1247,24 @@ proc ::tk::MenuFindName {menu s} {
# If omitted or specified as {}, then the menu's
# upper-left corner goes at (x,y).
-proc ::tk::PostOverPoint {menu x y {entry {}}} {
- if {$entry ne ""} {
- if {$entry == [$menu index last]} {
- incr y [expr {-([$menu yposition $entry] \
- + [winfo reqheight $menu])/2}]
+if {[tk windowingsystem] ne "win32"} {
+ proc ::tk::PostOverPoint {menu x y {entry {}}} {
+ if {$entry ne ""} {
+ $menu post $x $y $entry
+ if {[$menu entrycget $entry -state] ne "disabled"} {
+ $menu activate $entry
+ GenerateMenuSelect $menu
+ }
} else {
- incr y [expr {-([$menu yposition $entry] \
- + [$menu yposition [expr {$entry+1}]])/2}]
+ $menu post $x $y
}
- incr x [expr {-[winfo reqwidth $menu]/2}]
+ return
}
-
- if {[tk windowingsystem] eq "win32"} {
+} else {
+ proc ::tk::PostOverPoint {menu x y {entry {}}} {
+ if {$entry ne ""} {
+ incr y [expr {-[$menu yposition $entry]}]
+ }
# osVersion is not available in safe interps
set ver 5
if {[info exists ::tcl_platform(osVersion)]} {
@@ -1248,7 +1280,7 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} {
# manager provided with Vista and Windows 7.
if {$ver < 6} {
set yoffset [expr {[winfo screenheight $menu] \
- - $y - [winfo reqheight $menu] - 10}]
+ - $y - [winfo reqheight $menu] - 10}]
if {$yoffset < [winfo vrooty $menu]} {
# The bottom of the menu is offscreen, so adjust upwards
incr y [expr {$yoffset - [winfo vrooty $menu]}]
@@ -1260,11 +1292,11 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} {
set y [winfo vrooty $menu]
}
}
- }
- $menu post $x $y
- if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
- $menu activate $entry
- GenerateMenuSelect $menu
+ $menu post $x $y
+ if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
+ $menu activate $entry
+ GenerateMenuSelect $menu
+ }
}
}
diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl
index 6fc76f8..80ef415 100644
--- a/library/ttk/altTheme.tcl
+++ b/library/ttk/altTheme.tcl
@@ -96,10 +96,8 @@ namespace eval ttk::theme::alt {
ttk::style configure Treeview -background $colors(-window)
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
- {!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
- {!disabled !selected} black \
selected $colors(-selectfg)]
ttk::style configure TScale \
diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl
index d6be5a3..a548d65 100644
--- a/library/ttk/aquaTheme.tcl
+++ b/library/ttk/aquaTheme.tcl
@@ -42,11 +42,9 @@ namespace eval ttk::theme::aqua {
ttk::style configure Treeview -rowheight 18 -background White
ttk::style map Treeview \
-background [list disabled systemDialogBackgroundInactive \
- {!disabled !selected} systemWindowBody \
{selected background} systemHighlightSecondary \
selected systemHighlight] \
-foreground [list disabled systemModelessDialogInactiveText \
- {!disabled !selected} black \
selected systemModelessDialogActiveText]
# Enable animation for ttk::progressbar widget:
diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl
index 67e89e6..bfcb194 100644
--- a/library/ttk/clamTheme.tcl
+++ b/library/ttk/clamTheme.tcl
@@ -132,10 +132,8 @@ namespace eval ttk::theme::clam {
ttk::style configure Treeview -background $colors(-window)
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
- {!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
- {!disabled !selected} black \
selected $colors(-selectfg)]
ttk::style configure TLabelframe \
diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl
index fefdb99..f237fba 100644
--- a/library/ttk/classicTheme.tcl
+++ b/library/ttk/classicTheme.tcl
@@ -99,10 +99,8 @@ namespace eval ttk::theme::classic {
ttk::style configure Treeview -background $colors(-window)
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
- {!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
- {!disabled !selected} black \
selected $colors(-selectfg)]
#
diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl
index 5018bf2..2db9a37 100644
--- a/library/ttk/defaults.tcl
+++ b/library/ttk/defaults.tcl
@@ -111,10 +111,8 @@ namespace eval ttk::theme::default {
-foreground $colors(-text) ;
ttk::style map Treeview \
-background [list disabled $colors(-frame)\
- {!disabled !selected} $colors(-window) \
selected $colors(-selectbg)] \
-foreground [list disabled $colors(-disabledfg) \
- {!disabled !selected} black \
selected $colors(-selectfg)]
# Combobox popdown frame
diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl
index e92345a..165b496 100644
--- a/library/ttk/vistaTheme.tcl
+++ b/library/ttk/vistaTheme.tcl
@@ -48,10 +48,8 @@ namespace eval ttk::theme::vista {
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list disabled SystemButtonFace \
- {!disabled !selected} SystemWindow \
selected SystemHighlight] \
-foreground [list disabled SystemGrayText \
- {!disabled !selected} SystemWindowText \
selected SystemHighlightText]
# Label and Toolbutton
diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl
index a7a2c79..db05b45 100644
--- a/library/ttk/winTheme.tcl
+++ b/library/ttk/winTheme.tcl
@@ -74,10 +74,8 @@ namespace eval ttk::theme::winnative {
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list disabled SystemButtonFace \
- {!disabled !selected} SystemWindow \
selected SystemHighlight] \
-foreground [list disabled SystemGrayText \
- {!disabled !selected} SystemWindowText \
selected SystemHighlightText]
ttk::style configure TProgressbar \
diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl
index 5d8d09b..4c4f680 100644
--- a/library/ttk/xpTheme.tcl
+++ b/library/ttk/xpTheme.tcl
@@ -67,10 +67,8 @@ namespace eval ttk::theme::xpnative {
ttk::style configure Treeview -background SystemWindow
ttk::style map Treeview \
-background [list disabled SystemButtonFace \
- {!disabled !selected} SystemWindow \
selected SystemHighlight] \
-foreground [list disabled SystemGrayText \
- {!disabled !selected} SystemWindowText \
selected SystemHighlightText];
}
}
diff --git a/macosx/tkMacOSXButton.c b/macosx/tkMacOSXButton.c
index ea78d43..484dcf2 100644
--- a/macosx/tkMacOSXButton.c
+++ b/macosx/tkMacOSXButton.c
@@ -29,19 +29,10 @@
* be allowed when drawing the HITheme button.
*/
-#define HI_PADX 2
+#define HI_PADX 14
#define HI_PADY 1
/*
- * Some defines used to control what type of control is drawn.
- */
-
-#define DRAW_LABEL 0 /* Labels are treated genericly. */
-#define DRAW_CONTROL 1 /* Draw using the Native control. */
-#define DRAW_CUSTOM 2 /* Make our own button drawing. */
-#define DRAW_BEVEL 3
-
-/*
* The delay in milliseconds between pulsing default button redraws.
*/
#define PULSE_TIMER_MSECS 62 /* Largest value that didn't look stuttery */
@@ -52,7 +43,6 @@
typedef struct {
- int drawType;
Tk_3DBorder border;
int relief;
int offset; /* 0 means this is a normal widget. 1 means
@@ -271,11 +261,7 @@ TkpComputeButtonGeometry(
int txtWidth = 0, txtHeight = 0;
MacButton *mbPtr = (MacButton*)butPtr;
Tk_FontMetrics fm;
- DrawParams drawParams;
-
- /*
- * First figure out the size of the contents of the button.
- */
+ char *text = Tcl_GetString(butPtr->textPtr);
TkMacOSXComputeButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo);
@@ -283,7 +269,7 @@ TkpComputeButtonGeometry(
* If the indicator is on, get its size.
*/
- if ( butPtr->indicatorOn ) {
+ if (butPtr->indicatorOn) {
switch (butPtr->type) {
case TYPE_RADIO_BUTTON:
GetThemeMetric(kThemeMetricRadioButtonWidth, (SInt32 *)&butPtr->indicatorDiameter);
@@ -312,20 +298,19 @@ TkpComputeButtonGeometry(
if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) {
Tk_FreeTextLayout(butPtr->textLayout);
butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
- Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
- butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
-
- txtWidth = butPtr->textWidth;
- txtHeight = butPtr->textHeight;
- charWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
- Tk_GetFontMetrics(butPtr->tkfont, &fm);
- haveText = (txtWidth != 0 && txtHeight != 0);
+ text, -1, butPtr->wrapLength, butPtr->justify, 0,
+ &butPtr->textWidth, &butPtr->textHeight);
+
+ txtWidth = butPtr->textWidth + 2*butPtr->padX;
+ txtHeight = butPtr->textHeight + 2*butPtr->padY;
+ haveText = 1;
}
if (haveImage && haveText) { /* Image and Text */
switch ((enum compound) butPtr->compound) {
case COMPOUND_TOP:
case COMPOUND_BOTTOM:
+
/*
* Image is above or below text.
*/
@@ -335,14 +320,16 @@ TkpComputeButtonGeometry(
break;
case COMPOUND_LEFT:
case COMPOUND_RIGHT:
+
/*
* Image is left or right of text.
*/
- width += txtWidth + butPtr->padX;
+ width += txtWidth + 2*butPtr->padX;
height = (height > txtHeight ? height : txtHeight);
break;
case COMPOUND_CENTER:
+
/*
* Image and text are superimposed.
*/
@@ -354,26 +341,27 @@ TkpComputeButtonGeometry(
break;
}
width += butPtr->indicatorSpace;
-
} else if (haveImage) { /* Image only */
- width = butPtr->width > 0 ? butPtr->width : width + butPtr->indicatorSpace;
- height = butPtr->height > 0 ? butPtr->height : height;
-
+ width = butPtr->width > 0 ? butPtr->width : width + butPtr->indicatorSpace;
+ height = butPtr->height > 0 ? butPtr->height : height;
+ if (butPtr->type == TYPE_BUTTON) {
+ /* Allow room to shift the image. */
+ width += 2;
+ height += 2;
+ }
} else { /* Text only */
width = txtWidth + butPtr->indicatorSpace;
height = txtHeight;
if (butPtr->width > 0) {
- width = butPtr->width * charWidth;
+ charWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
+ width = butPtr->width * charWidth + 2*butPtr->padX;
}
if (butPtr->height > 0) {
- height = butPtr->height * fm.linespace;
+ Tk_GetFontMetrics(butPtr->tkfont, &fm);
+ height = butPtr->height * fm.linespace + 2*butPtr->padY;
}
}
- /* Add padding */
- width += 2 * butPtr->padX;
- height += 2 * butPtr->padY;
-
/*
* Now figure out the size of the border decorations for the button.
*/
@@ -382,48 +370,35 @@ TkpComputeButtonGeometry(
butPtr->highlightWidth = 0;
}
- butPtr->inset = 0;
- butPtr->inset += butPtr->highlightWidth;
+ butPtr->inset = butPtr->borderWidth + butPtr->highlightWidth;
- if (TkMacOSXComputeButtonDrawParams(butPtr,&drawParams)) {
+ width += butPtr->inset*2;
+ height += butPtr->inset*2;
+ if ([NSApp macMinorVersion] == 6) {
+ width += 12;
+ }
+ if (mbPtr->btnkind == kThemePushButton) {
HIRect tmpRect;
HIRect contBounds;
- int paddingx = 0;
- int paddingy = 0;
+ /*
+ * A PushButton has a minimum size. We make sure that we
+ * are not underestimating the size by requesting the content
+ * size of a Pushbutton whose overall size is our content size
+ * expanded by the standard padding.
+ */
+
tmpRect = CGRectMake(0, 0, width + 2*HI_PADX, height + 2*HI_PADY);
-
HIThemeGetButtonContentBounds(&tmpRect, &mbPtr->drawinfo, &contBounds);
- /* If the content region has a minimum height, match it. */
if (height < contBounds.size.height) {
- height = contBounds.size.height;
+ height = contBounds.size.height;
}
-
- /* If the content region has a minimum width, match it. */
if (width < contBounds.size.width) {
- width = contBounds.size.width;
+ width = contBounds.size.width;
}
-
- /* Pad to fill difference between content bounds and button bounds. */
- paddingx = contBounds.origin.x;
- paddingy = contBounds.origin.y;
-
- if (height < paddingx - 4) {
- /* can't have buttons much shorter than button side diameter. */
- height = paddingx - 4;
- }
-
- } else {
- height += butPtr->borderWidth*2;
- width += butPtr->borderWidth*2;
- }
-
- width += butPtr->inset*2;
- height += butPtr->inset*2;
- if ([NSApp macMinorVersion] == 6) {
- width += 12;
+ height += 2*HI_PADY;
+ width += 2*HI_PADX;
}
-
Tk_GeometryRequest(butPtr->tkwin, width, height);
Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
}
@@ -570,7 +545,6 @@ DrawButtonImageAndText(
}
imageXOffset += x;
imageYOffset += y;
- textYOffset -= 1;
if (butPtr->image != NULL) {
if ((butPtr->selectImage != NULL) &&
@@ -594,6 +568,7 @@ DrawButtonImageAndText(
XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0);
}
+ y += 1; /* Tweak to match native buttons. */
Tk_DrawTextLayout(butPtr->display, pixmap,
dpPtr->gc, butPtr->textLayout,
x + textXOffset, y + textYOffset, 0, -1);
@@ -646,6 +621,7 @@ DrawButtonImageAndText(
butPtr->textWidth + butPtr->indicatorSpace,
butPtr->textHeight, &x, &y);
x += butPtr->indicatorSpace;
+ y += 1; /* Tweak to match native buttons */
Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc, butPtr->textLayout,
x, y, 0, -1);
}
@@ -1119,7 +1095,6 @@ TkMacOSXComputeButtonDrawParams(
}
}
-
dpPtr->border = butPtr->normalBorder;
if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
dpPtr->gc = butPtr->disabledGC;
@@ -1149,29 +1124,22 @@ TkMacOSXComputeButtonDrawParams(
}
}
- /*
- * Determine the draw type
- */
-
- if (butPtr->type == TYPE_LABEL) {
- dpPtr->drawType = DRAW_LABEL;
- } else if (butPtr->type == TYPE_BUTTON) {
- if (!dpPtr->hasImageOrBitmap) {
- dpPtr->drawType = DRAW_CONTROL;
- } else {
- dpPtr->drawType = DRAW_BEVEL;
- }
- } else if (butPtr->indicatorOn) {
- dpPtr->drawType = DRAW_CONTROL;
- } else if (dpPtr->hasImageOrBitmap) {
- dpPtr->drawType = DRAW_BEVEL;
- } else {
- dpPtr->drawType = DRAW_CUSTOM;
- }
-
- if ((dpPtr->drawType == DRAW_CONTROL) || (dpPtr->drawType == DRAW_BEVEL)) {
+ if (butPtr->type != TYPE_LABEL &&
+ (butPtr->type == TYPE_BUTTON ||
+ butPtr->indicatorOn ||
+ dpPtr->hasImageOrBitmap)) {
+
+ /*
+ * Draw this widget as a native control.
+ */
+
return 1;
} else {
+
+ /*
+ * Draw this widget from scratch.
+ */
+
return 0;
}
}
diff --git a/macosx/tkMacOSXDefault.h b/macosx/tkMacOSXDefault.h
index c85fcdb..f5ffbbf 100644
--- a/macosx/tkMacOSXDefault.h
+++ b/macosx/tkMacOSXDefault.h
@@ -337,7 +337,7 @@
* Defaults for menubuttons:
*/
-#define DEF_MENUBUTTON_ANCHOR "center"
+#define DEF_MENUBUTTON_ANCHOR "w"
#define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG
#define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK
#define DEF_MENUBUTTON_ACTIVE_FG_COLOR ACTIVE_FG
@@ -345,7 +345,7 @@
#define DEF_MENUBUTTON_BG_COLOR NORMAL_BG
#define DEF_MENUBUTTON_BG_MONO WHITE
#define DEF_MENUBUTTON_BITMAP ""
-#define DEF_MENUBUTTON_BORDER_WIDTH "2"
+#define DEF_MENUBUTTON_BORDER_WIDTH "0"
#define DEF_MENUBUTTON_CURSOR ""
#define DEF_MENUBUTTON_DIRECTION "below"
#define DEF_MENUBUTTON_DISABLED_FG_COLOR DISABLED
@@ -361,8 +361,8 @@
#define DEF_MENUBUTTON_INDICATOR "1"
#define DEF_MENUBUTTON_JUSTIFY "left"
#define DEF_MENUBUTTON_MENU ""
-#define DEF_MENUBUTTON_PADX "4"
-#define DEF_MENUBUTTON_PADY "3"
+#define DEF_MENUBUTTON_PADX "0"
+#define DEF_MENUBUTTON_PADY "0"
#define DEF_MENUBUTTON_RELIEF "flat"
#define DEF_MENUBUTTON_STATE "normal"
#define DEF_MENUBUTTON_TAKE_FOCUS "0"
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index c3778f1..a7e10b4 100644
--- a/macosx/tkMacOSXDialog.c
+++ b/macosx/tkMacOSXDialog.c
@@ -1674,8 +1674,8 @@ FontchooserCget(
}
break;
case FontchooserVisible:
- resObj = Tcl_NewBooleanObj([[[NSFontManager sharedFontManager]
- fontPanel:NO] isVisible]);
+ resObj = Tcl_NewWideIntObj([[[NSFontManager sharedFontManager]
+ fontPanel:NO] isVisible] != 0);
break;
default:
resObj = Tcl_NewObj();
@@ -1950,7 +1950,7 @@ FontchooserParentEventHandler(
if (eventPtr->type == DestroyNotify) {
Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask,
FontchooserParentEventHandler, fcdPtr);
- fcdPtr->parent = None;
+ fcdPtr->parent = NULL;
FontchooserHideCmd(NULL, NULL, 0, NULL);
}
}
diff --git a/macosx/tkMacOSXEmbed.c b/macosx/tkMacOSXEmbed.c
index f093c96..b23f33b 100644
--- a/macosx/tkMacOSXEmbed.c
+++ b/macosx/tkMacOSXEmbed.c
@@ -272,7 +272,14 @@ TkpUseWindow(
}
usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, (Window) parent);
- if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) {
+ if (usePtr == NULL) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't create child of window \"%s\"", string));
+ Tcl_SetErrorCode(interp, "TK", "EMBED", "NO_TARGET", NULL);
+ }
+ return TCL_ERROR;
+ } else if (!(usePtr->flags & TK_CONTAINER)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"window \"%s\" doesn't have -container option set",
usePtr->pathName));
@@ -281,15 +288,9 @@ TkpUseWindow(
}
/*
- * The code below can probably be simplified given we have already
- * discovered 'usePtr' above.
- */
-
- /*
- * Save information about the container and the embedded window in a
- * Container structure. Currently, there must already be an existing
- * Container structure, since we only allow the case where both container
- * and embedded app. are in the same process.
+ * Since we do not allow embedding into windows belonging to a different
+ * process, we know that a container will exist showing the parent window
+ * as the parent. This loop finds that container.
*/
for (containerPtr = firstContainerPtr; containerPtr != NULL;
@@ -312,16 +313,6 @@ TkpUseWindow(
}
macWin->winPtr = winPtr;
- winPtr->privatePtr = macWin;
-
- /*
- * The grafPtr will be NULL for a Tk in Tk embedded window. It is none of
- * our business what it is for a Tk not in Tk embedded window, but we will
- * initialize it to NULL, and let the registerWinProc set it. In any case,
- * you must always use TkMacOSXGetDrawablePort to get the portPtr. It will
- * correctly find the container's port.
- */
-
macWin->view = nil;
macWin->context = NULL;
macWin->size = CGSizeZero;
@@ -333,6 +324,7 @@ TkpUseWindow(
macWin->toplevel = macWin;
macWin->toplevel->referenceCount++;
+ winPtr->privatePtr = macWin;
winPtr->flags |= TK_EMBEDDED;
/*
@@ -341,64 +333,28 @@ TkpUseWindow(
*/
macWin->flags |= TK_EMBEDDED;
+ macWin->xOff = parent->winPtr->privatePtr->xOff +
+ parent->winPtr->changes.border_width +
+ winPtr->changes.x;
+ macWin->yOff = parent->winPtr->privatePtr->yOff +
+ parent->winPtr->changes.border_width +
+ winPtr->changes.y;
/*
- * Now check whether it is embedded in another Tk widget. If not (the
- * first case below) we see if there is an in-process embedding handler
- * registered, and if so, let that fill in the rest of the macWin.
+ * Finish filling up the container structure with the embedded
+ * window's information.
*/
- if (containerPtr == NULL) {
- /*
- * If someone has registered an in-process embedding handler, then
- * see if it can handle this window...
- */
-
- if (tkMacOSXEmbedHandler == NULL ||
- tkMacOSXEmbedHandler->registerWinProc((long) parent,
- (Tk_Window) winPtr) != TCL_OK) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "The window ID %s does not correspond to a valid Tk Window",
- string));
- Tcl_SetErrorCode(interp, "TK", "EMBED", "HANDLE", NULL);
- return TCL_ERROR;
- }
-
- containerPtr = ckalloc(sizeof(Container));
+ containerPtr->embedded = (Window) macWin;
+ containerPtr->embeddedPtr = macWin->winPtr;
- containerPtr->parentPtr = NULL;
- containerPtr->embedded = (Window) macWin;
- containerPtr->embeddedPtr = macWin->winPtr;
- containerPtr->nextPtr = firstContainerPtr;
- firstContainerPtr = containerPtr;
- } else {
- /*
- * The window is embedded in another Tk window.
- */
-
- macWin->xOff = parent->winPtr->privatePtr->xOff +
- parent->winPtr->changes.border_width +
- winPtr->changes.x;
- macWin->yOff = parent->winPtr->privatePtr->yOff +
- parent->winPtr->changes.border_width +
- winPtr->changes.y;
-
- /*
- * Finish filling up the container structure with the embedded
- * window's information.
- */
-
- containerPtr->embedded = (Window) macWin;
- containerPtr->embeddedPtr = macWin->winPtr;
-
- /*
- * Create an event handler to clean up the Container structure when
- * tkwin is eventually deleted.
- */
+ /*
+ * Create an event handler to clean up the Container structure when
+ * tkwin is eventually deleted.
+ */
- Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
- winPtr);
- }
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
+ winPtr);
return TCL_OK;
}
@@ -542,9 +498,7 @@ TkMacOSXGetHostToplevel(
* TkpClaimFocus --
*
* This procedure is invoked when someone asks for the input focus to be
- * put on a window in an embedded application, but the application
- * doesn't currently have the focus. It requests the input focus from the
- * container application.
+ * put on a window in an embedded application.
*
* Results:
* None.
@@ -583,7 +537,7 @@ TkpClaimFocus(
event.xfocus.window = containerPtr->parent;
event.xfocus.mode = EMBEDDED_APP_WANTS_FOCUS;
event.xfocus.detail = force;
- Tk_QueueWindowEvent(&event,TCL_QUEUE_TAIL);
+ Tk_HandleEvent(&event);
}
/*
@@ -614,6 +568,7 @@ TkpTestembedCmd(
Container *containerPtr;
Tcl_DString dString;
char buffer[50];
+ Tcl_Interp *embeddedInterp = NULL, *parentInterp = NULL;
if ((objc > 1) && (strcmp(Tcl_GetString(objv[1]), "all") == 0)) {
all = 1;
@@ -623,7 +578,17 @@ TkpTestembedCmd(
Tcl_DStringInit(&dString);
for (containerPtr = firstContainerPtr; containerPtr != NULL;
containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr != NULL) {
+ embeddedInterp = containerPtr->embeddedPtr->mainPtr->interp;
+ }
+ if (containerPtr->parentPtr != NULL) {
+ parentInterp = containerPtr->parentPtr->mainPtr->interp;
+ }
+ if (embeddedInterp != interp && parentInterp != interp) {
+ continue;
+ }
Tcl_DStringStartSublist(&dString);
+ /* Parent id */
if (containerPtr->parent == None) {
Tcl_DStringAppendElement(&dString, "");
} else if (all) {
@@ -632,21 +597,21 @@ TkpTestembedCmd(
} else {
Tcl_DStringAppendElement(&dString, "XXX");
}
- if (containerPtr->parentPtr == NULL) {
+ /* Parent pathName */
+ if (containerPtr->parentPtr == NULL ||
+ parentInterp != interp) {
Tcl_DStringAppendElement(&dString, "");
} else {
Tcl_DStringAppendElement(&dString,
containerPtr->parentPtr->pathName);
}
- if (containerPtr->embedded == None) {
- Tcl_DStringAppendElement(&dString, "");
- } else if (all) {
- sprintf(buffer, "0x%" TCL_Z_MODIFIER "x", (size_t) containerPtr->embedded);
- Tcl_DStringAppendElement(&dString, buffer);
- } else {
- Tcl_DStringAppendElement(&dString, "XXX");
- }
- if (containerPtr->embeddedPtr == NULL) {
+ /*
+ * On X11 embedded is a wrapper, which does not exist on macOS.
+ */
+ Tcl_DStringAppendElement(&dString, "");
+ /* Embedded window pathName */
+ if (containerPtr->embeddedPtr == NULL ||
+ embeddedInterp != interp) {
Tcl_DStringAppendElement(&dString, "");
} else {
Tcl_DStringAppendElement(&dString,
@@ -904,6 +869,14 @@ EmbedStructureProc(
Tk_ErrorHandler errHandler;
if (eventPtr->type == ConfigureNotify) {
+
+ /*
+ * Send a ConfigureNotify to the embedded application.
+ */
+
+ if (containerPtr->embeddedPtr != None) {
+ TkDoConfigureNotify(containerPtr->embeddedPtr);
+ }
if (containerPtr->embedded != None) {
/*
* Ignore errors, since the embedded application could have
@@ -947,7 +920,6 @@ EmbedActivateProc(
XEvent *eventPtr) /* ResizeRequest event. */
{
Container *containerPtr = clientData;
-
if (containerPtr->embeddedPtr != NULL) {
if (eventPtr->type == ActivateNotify) {
TkGenerateActivateEvents(containerPtr->embeddedPtr,1);
diff --git a/macosx/tkMacOSXEvent.c b/macosx/tkMacOSXEvent.c
index d866b02..b9c9b6a 100644
--- a/macosx/tkMacOSXEvent.c
+++ b/macosx/tkMacOSXEvent.c
@@ -114,21 +114,16 @@ enum {
*
* This routine is a stub called by XSync, which is called during the Tk
* update command. The language specification does not require that the
- * update command be synchronous but many of the tests assume that is the
- * case. It is not naturally the case on macOS since many idle tasks are
- * run inside of the drawRect method of a window's contentView, and that
- * method will not be called until after this function returns. To make
- * the tests work, we attempt to force this to be synchronous by waiting
- * until drawRect has been called for each window. The mechanism we use
- * for this is to have drawRect post an ApplicationDefined NSEvent on the
- * AppKit event queue when it finishes drawing, and wait for it here.
+ * update command be synchronous but many of the tests implicitly assume
+ * that it is. It is definitely asynchronous on macOS since many idle
+ * tasks are run inside of the drawRect method of a window's contentView,
+ * which will not be called until after this function returns.
*
* Results:
* None.
*
- * Side effects:
- * Calls the drawRect method of the contentView of each visible
- * window.
+ * Side effects: Processes all pending idle events then calls the display
+ * method of each visible window.
*
*----------------------------------------------------------------------
*/
@@ -136,23 +131,12 @@ enum {
MODULE_SCOPE void
TkMacOSXFlushWindows(void)
{
- NSArray *macWindows = [NSApp orderedWindows];
-
- if ([macWindows count] > 0) {
- while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)){}
+ if (Tk_GetNumMainWindows() == 0) {
+ return;
}
- if ([NSApp isDrawing]) {
- for (NSWindow *w in macWindows) {
- if (TkMacOSXGetXWindow(w)) {
- [w setViewsNeedDisplay:YES];
- }
- }
- } else {
- for (NSWindow *w in macWindows) {
- if (TkMacOSXGetXWindow(w)) {
- [w display];
- }
- }
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)){}
+ for (NSWindow *w in [NSApp orderedWindows]) {
+ [w display];
}
}
diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c
index 353ad6b..deaab20 100644
--- a/macosx/tkMacOSXFont.c
+++ b/macosx/tkMacOSXFont.c
@@ -1242,7 +1242,7 @@ TkMacOSXFontDescriptionForNSFontAndNSFontAttributes(
id strikethrough = [nsAttributes objectForKey:
NSStrikethroughStyleAttributeName];
objv[i++] = Tcl_NewStringObj(familyName, -1);
- objv[i++] = Tcl_NewIntObj([nsFont pointSize]);
+ objv[i++] = Tcl_NewWideIntObj([nsFont pointSize]);
#define S(s) Tcl_NewStringObj(STRINGIFY(s),(int)(sizeof(STRINGIFY(s))-1))
objv[i++] = (traits & NSBoldFontMask) ? S(bold) : S(normal);
objv[i++] = (traits & NSItalicFontMask) ? S(italic) : S(roman);
diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c
index 5f64a4a..3c02d92 100644
--- a/macosx/tkMacOSXInit.c
+++ b/macosx/tkMacOSXInit.c
@@ -121,7 +121,17 @@ static char scriptPath[PATH_MAX + 1] = "";
* method is called. Activating too early can cause the menu
* bar to be unresponsive.
*/
+
[NSApp activateIgnoringOtherApps: YES];
+
+ /*
+ * Process events to ensure that the root window is fully
+ * initialized. See ticket 56a1823c73.
+ */
+
+ [NSApp _lockAutoreleasePool];
+ while (Tcl_DoOneEvent(TCL_WINDOW_EVENTS| TCL_DONT_WAIT)) {}
+ [NSApp _unlockAutoreleasePool];
}
- (void) _setup: (Tcl_Interp *) interp
diff --git a/macosx/tkMacOSXKeyEvent.c b/macosx/tkMacOSXKeyEvent.c
index 3327f0a..543e7ab 100644
--- a/macosx/tkMacOSXKeyEvent.c
+++ b/macosx/tkMacOSXKeyEvent.c
@@ -24,9 +24,6 @@
*/
#define NS_KEYLOG 0
-
-static Tk_Window grabWinPtr = NULL;
- /* Current grab window, NULL if no grab. */
static Tk_Window keyboardGrabWinPtr = NULL;
/* Current keyboard grab window. */
static NSWindow *keyboardGrabNSWindow = nil;
@@ -500,11 +497,12 @@ XGrabKeyboard(
Time time)
{
keyboardGrabWinPtr = Tk_IdToWindow(display, grab_window);
- if (keyboardGrabWinPtr && grabWinPtr) {
+ TkWindow *captureWinPtr = (TkWindow *)TkMacOSXGetCapture();
+ if (keyboardGrabWinPtr && captureWinPtr) {
NSWindow *w = TkMacOSXDrawableWindow(grab_window);
MacDrawable *macWin = (MacDrawable *) grab_window;
- if (w && macWin->toplevel->winPtr == (TkWindow*) grabWinPtr) {
+ if (w && macWin->toplevel->winPtr == (TkWindow*) captureWinPtr) {
if (modalSession) {
Tcl_Panic("XGrabKeyboard: already grabbed");
}
@@ -551,26 +549,6 @@ XUngrabKeyboard(
/*
*----------------------------------------------------------------------
*
- * TkMacOSXGetCapture --
- *
- * Results:
- * Returns the current grab window
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tk_Window
-TkMacOSXGetCapture(void)
-{
- return grabWinPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TkMacOSXGetModalSession --
*
* Results:
@@ -591,34 +569,6 @@ TkMacOSXGetModalSession(void)
/*
*----------------------------------------------------------------------
*
- * TkpSetCapture --
- *
- * This function captures the mouse so that all future events will be
- * reported to this window, even if the mouse is outside the window. If
- * the specified window is NULL, then the mouse is released.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sets the capture flag and captures the mouse.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TkpSetCapture(
- TkWindow *winPtr) /* Capture window, or NULL. */
-{
- while (winPtr && !Tk_IsTopLevel(winPtr)) {
- winPtr = winPtr->parentPtr;
- }
- grabWinPtr = (Tk_Window) winPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tk_SetCaretPos --
*
* This enables correct placement of the XIM caret. This is called by
diff --git a/macosx/tkMacOSXMenu.c b/macosx/tkMacOSXMenu.c
index 8f3be9f..3d7cdaf 100644
--- a/macosx/tkMacOSXMenu.c
+++ b/macosx/tkMacOSXMenu.c
@@ -699,7 +699,7 @@ TkpConfigureMenuEntry(
TkMenuEntry *submePtr = menuRefPtr->menuPtr->entries[i];
/* Work around an apparent bug where itemArray can have
more items than the menu's entries[] array. */
- if (i >= menuRefPtr->menuPtr->numEntries) break;
+ if (i >= (int)menuRefPtr->menuPtr->numEntries) break;
[item setEnabled: !(submePtr->state == ENTRY_DISABLED)];
i++;
}
@@ -755,10 +755,13 @@ TkpDestroyMenuEntry(
*
* TkpPostMenu --
*
- * Posts a menu on the screen
+ * Posts a menu on the screen. If entry is < 0 then the menu is
+ * drawn so its top left corner is located at the point with
+ * screen coordinates (x, y). Otherwise the top left corner of
+ * the specified entry is located at that point.
*
* Results:
- * None.
+ * Returns a standard Tcl result.
*
* Side effects:
* The menu is posted and handled.
@@ -770,50 +773,52 @@ int
TkpPostMenu(
Tcl_Interp *interp, /* The interpreter this menu lives in */
TkMenu *menuPtr, /* The menu we are posting */
- int x, /* The global x-coordinate of the top, left-
- * hand corner of where the menu is supposed
- * to be posted. */
- int y) /* The global y-coordinate */
+ int x, int y, /* The screen coordinates where the top left
+ * corner of the menu, or of the specified
+ * entry, will be located. */
+ int index)
{
+ int result;
+ Tk_Window root = Tk_MainWindow(interp);
-
- /* Get the object that holds this Tk Window.*/
- Tk_Window root;
- root = Tk_MainWindow(interp);
if (root == NULL) {
return TCL_ERROR;
}
-
Drawable d = Tk_WindowId(root);
NSView *rootview = TkMacOSXGetRootControl(d);
NSWindow *win = [rootview window];
- int result;
+ NSView *view = [win contentView];
+ NSMenu *menu = (NSMenu *) menuPtr->platformData;
+ NSInteger itemIndex = index;
+ NSInteger numItems = [menu numberOfItems];
+ NSMenuItem *item = nil;
+ NSPoint location = NSMakePoint(x, tkMacOSXZeroScreenHeight - y);
inPostMenu = 1;
-
result = TkPreprocessMenu(menuPtr);
if (result != TCL_OK) {
inPostMenu = 0;
return result;
}
+ if (itemIndex >= numItems) {
+ itemIndex = numItems - 1;
+ }
+ if (itemIndex >= 0) {
+ item = [menu itemAtIndex:itemIndex];
+ }
- int oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
- NSView *view = [win contentView];
- NSRect frame = NSMakeRect(x + 9, tkMacOSXZeroScreenHeight - y - 9, 1, 1);
+ /*
+ * The post commands could have deleted the menu, which means we are dead
+ * and should go away.
+ */
- frame.origin = [view convertPoint:
- [win tkConvertPointFromScreen:frame.origin] fromView:nil];
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
- NSMenu *menu = (NSMenu *) menuPtr->platformData;
- NSPopUpButtonCell *popUpButtonCell = [[NSPopUpButtonCell alloc]
- initTextCell:@"" pullsDown:NO];
-
- [popUpButtonCell setAltersStateOfSelectedItem:NO];
- [popUpButtonCell setMenu:menu];
- [popUpButtonCell selectItem:nil];
- [popUpButtonCell performClickWithFrame:frame inView:view];
- [popUpButtonCell release];
- Tcl_SetServiceMode(oldMode);
+ [menu popUpMenuPositioningItem:item
+ atLocation:[win tkConvertPointFromScreen:location]
+ inView:view];
inPostMenu = 0;
return TCL_OK;
}
@@ -821,6 +826,109 @@ TkpPostMenu(
/*
*----------------------------------------------------------------------
*
+ * TkpPostTearoffMenu --
+ *
+ * Tearoff menus are not supported on the Mac. This placeholder
+ * function, which is simply a copy of the unix function, posts a
+ * completely useless window with a black background on the screen. If
+ * entry is < 0 then the window is positioned so that its top left corner
+ * is located at the point with screen coordinates (x, y). Otherwise the
+ * window position is offset so that top left corner of the specified
+ * entry would be located at that point, if there actually were a menu.
+ *
+ * Mac menus steal all mouse or keyboard input from the application until
+ * the menu is dismissed, with or without a selection, by a mouse or key
+ * event. Posting a Mac menu in a regression test will cause the test to
+ * halt waiting for user input. This is why the TkpPostMenu function is
+ * not being used as the placeholder.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A useless window is posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostTearoffMenu(
+ Tcl_Interp *interp, /* The interpreter this menu lives in */
+ TkMenu *menuPtr, /* The menu we are posting */
+ int x, int y, int index) /* The screen coordinates where the top left
+ * corner of the menu, or of the specified
+ * entry, will be located. */
+{
+ int vRootX, vRootY, vRootWidth, vRootHeight;
+ int result;
+
+ if (index >= (int)menuPtr->numEntries) {
+ index = menuPtr->numEntries - 1;
+ }
+ if (index >= 0) {
+ y -= menuPtr->entries[index]->y;
+ }
+
+ TkActivateMenuEntry(menuPtr, -1);
+ TkRecomputeMenu(menuPtr);
+ result = TkPostCommand(menuPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means we are dead
+ * and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Adjust the position of the menu if necessary to keep it visible on the
+ * screen. There are two special tricks to make this work right:
+ *
+ * 1. If a virtual root window manager is being used then the coordinates
+ * are in the virtual root window of menuPtr's parent; since the menu
+ * uses override-redirect mode it will be in the *real* root window for
+ * the screen, so we have to map the coordinates from the virtual root
+ * (if any) to the real root. Can't get the virtual root from the menu
+ * itself (it will never be seen by the wm) so use its parent instead
+ * (it would be better to have an an option that names a window to use
+ * for this...).
+ * 2. The menu may not have been mapped yet, so its current size might be
+ * the default 1x1. To compute how much space it needs, use its
+ * requested size, not its actual size.
+ */
+
+ Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ vRootWidth -= Tk_ReqWidth(menuPtr->tkwin);
+ if (x > vRootX + vRootWidth) {
+ x = vRootX + vRootWidth;
+ }
+ if (x < vRootX) {
+ x = vRootX;
+ }
+ vRootHeight -= Tk_ReqHeight(menuPtr->tkwin);
+ if (y > vRootY + vRootHeight) {
+ y = vRootY + vRootHeight;
+ }
+ if (y < vRootY) {
+ y = vRootY;
+ }
+ Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
+ if (!Tk_IsMapped(menuPtr->tkwin)) {
+ Tk_MapWindow(menuPtr->tkwin);
+ }
+ TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TkpSetWindowMenuBar --
*
* Associates a given menu with a window.
@@ -877,26 +985,47 @@ TkpSetMainMenubar(
{
static Tcl_Interp *currentInterp = NULL;
TKMenu *menu = nil;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * We will be called when an embedded window receives an ActivationNotify
+ * event, but we should not change the menubar in that case.
+ */
+
+ if (Tk_IsEmbedded(winPtr)) {
+ return;
+ }
if (menuName) {
- TkWindow *winPtr = (TkWindow *) tkwin;
+ Tk_Window menubar = NULL;
+ if (winPtr->wmInfoPtr &&
+ winPtr->wmInfoPtr->menuPtr &&
+ winPtr->wmInfoPtr->menuPtr->masterMenuPtr) {
+ menubar = winPtr->wmInfoPtr->menuPtr->masterMenuPtr->tkwin;
+ }
+
+ /*
+ * Attempt to find the NSMenu directly. If that fails, ask Tk to find it.
+ */
- if (winPtr->wmInfoPtr && winPtr->wmInfoPtr->menuPtr &&
- winPtr->wmInfoPtr->menuPtr->masterMenuPtr &&
- winPtr->wmInfoPtr->menuPtr->masterMenuPtr->tkwin &&
- !strcmp(menuName, Tk_PathName(
- winPtr->wmInfoPtr->menuPtr->masterMenuPtr->tkwin))) {
+ if (menubar != NULL && strcmp(menuName, Tk_PathName(menubar)) == 0) {
menu = (TKMenu *) winPtr->wmInfoPtr->menuPtr->platformData;
} else {
TkMenuReferences *menuRefPtr = TkFindMenuReferences(interp,
menuName);
-
if (menuRefPtr && menuRefPtr->menuPtr &&
menuRefPtr->menuPtr->platformData) {
menu = (TKMenu *) menuRefPtr->menuPtr->platformData;
}
}
}
+
+ /*
+ * If we couldn't find a menu, do nothing unless the window belongs
+ * to a different application. In that case, install the default
+ * menubar.
+ */
+
if (menu || interp != currentInterp) {
[NSApp tkSetMainMenu:menu];
}
@@ -909,8 +1038,8 @@ TkpSetMainMenubar(
* CheckForSpecialMenu --
*
* Given a menu, check to see whether or not it is a cascade in a menubar
- * with one of the special names .apple, .help or .window If it is, the
- * entry that points to this menu will be marked.
+ * with one of the special names ".apple", ".help" or ".window". If it
+ * is, the entry that points to this menu will be marked.
*
* Results:
* None.
@@ -1087,26 +1216,31 @@ void
TkpComputeStandardMenuGeometry(
TkMenu *menuPtr) /* Structure describing menu. */
{
+ NSSize menuSize;
Tk_Font tkfont, menuFont;
Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
int modifierCharWidth, menuModifierCharWidth;
int x, y, modifierWidth, labelWidth, indicatorSpace;
int windowWidth, windowHeight, accelWidth;
- int i, j, lastColumnBreak, maxWidth;
+ int i, maxWidth;
int entryWidth, maxIndicatorSpace, borderWidth, activeBorderWidth;
- TkMenuEntry *mePtr, *columnEntryPtr;
+ TkMenuEntry *mePtr;
int haveAccel = 0;
- if (menuPtr->tkwin == NULL) {
+ /*
+ * Do nothing if this menu is a clone.
+ */
+ if (menuPtr->tkwin == NULL || menuPtr->masterMenuPtr != menuPtr) {
return;
}
+ menuSize = [(NSMenu *)menuPtr->platformData size];
Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
&borderWidth);
Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
&activeBorderWidth);
x = y = borderWidth;
- windowHeight = maxWidth = lastColumnBreak = 0;
+ windowHeight = maxWidth = 0;
maxIndicatorSpace = 0;
/*
@@ -1123,7 +1257,7 @@ TkpComputeStandardMenuGeometry(
Tk_GetFontMetrics(menuFont, &menuMetrics);
menuModifierCharWidth = ModifierCharWidth(menuFont);
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
mePtr = menuPtr->entries[i];
if (mePtr->type == CASCADE_ENTRY || mePtr->accelLength > 0) {
haveAccel = 1;
@@ -1131,8 +1265,11 @@ TkpComputeStandardMenuGeometry(
}
}
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
mePtr = menuPtr->entries[i];
+ if (mePtr->type == TEAROFF_ENTRY) {
+ continue;
+ }
if (mePtr->fontPtr == NULL) {
tkfont = menuFont;
fmPtr = &menuMetrics;
@@ -1143,26 +1280,8 @@ TkpComputeStandardMenuGeometry(
fmPtr = &entryMetrics;
modifierCharWidth = ModifierCharWidth(tkfont);
}
-
- if ((i > 0) && mePtr->columnBreak) {
- if (maxIndicatorSpace != 0) {
- maxIndicatorSpace += 2;
- }
- for (j = lastColumnBreak; j < i; j++) {
- columnEntryPtr = menuPtr->entries[j];
- columnEntryPtr->indicatorSpace = maxIndicatorSpace;
- columnEntryPtr->width = maxIndicatorSpace + maxWidth
- + 2 * activeBorderWidth;
- columnEntryPtr->x = x;
- columnEntryPtr->entryFlags &= ~ENTRY_LAST_COLUMN;
- }
- x += maxIndicatorSpace + maxWidth + 2 * activeBorderWidth;
- maxWidth = maxIndicatorSpace = 0;
- lastColumnBreak = i;
- y = borderWidth;
- }
accelWidth = modifierWidth = indicatorSpace = 0;
- if (mePtr->type == SEPARATOR_ENTRY || mePtr->type == TEAROFF_ENTRY) {
+ if (mePtr->type == SEPARATOR_ENTRY) {
mePtr->height = menuSeparatorHeight;
} else {
/*
@@ -1176,16 +1295,16 @@ TkpComputeStandardMenuGeometry(
NSMenuItem *menuItem = (NSMenuItem *) mePtr->platformEntryData;
int haveImage = 0, width = 0, height = 0;
-
if (mePtr->image) {
Tk_SizeOfImage(mePtr->image, &width, &height);
haveImage = 1;
+ height += 2; /* tweak */
} else if (mePtr->bitmapPtr) {
Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin,
mePtr->bitmapPtr);
-
Tk_SizeOfBitmap(menuPtr->display, bitmap, &width, &height);
haveImage = 1;
+ height += 2; /* tweak */
}
if (!haveImage || (mePtr->compound != COMPOUND_NONE)) {
NSAttributedString *attrTitle = [menuItem attributedTitle];
@@ -1197,11 +1316,8 @@ TkpComputeStandardMenuGeometry(
size = [[menuItem title] sizeWithAttributes:
TkMacOSXNSFontAttributesForFont(tkfont)];
}
- size.width += menuTextLeadingEdgeMargin +
- menuTextTrailingEdgeMargin;
- if (size.height < fmPtr->linespace) {
- size.height = fmPtr->linespace;
- }
+ size.width += menuTextLeadingEdgeMargin + menuTextTrailingEdgeMargin;
+ size.height -= 1; /* tweak */
if (haveImage && (mePtr->compound != COMPOUND_NONE)) {
int margin = width + menuIconTrailingEdgeMargin;
@@ -1217,9 +1333,11 @@ TkpComputeStandardMenuGeometry(
height = size.height;
}
}
+ else {
+ /* image only. */
+ }
labelWidth = width + menuItemExtraWidth;
mePtr->height = height + menuItemExtraHeight;
-
if (mePtr->type == CASCADE_ENTRY) {
modifierWidth = modifierCharWidth;
} else if (mePtr->accelLength == 0) {
@@ -1250,30 +1368,18 @@ TkpComputeStandardMenuGeometry(
if (entryWidth > maxWidth) {
maxWidth = entryWidth;
}
+ menuPtr->entries[i]->width = entryWidth;
mePtr->height += 2 * activeBorderWidth;
}
+ mePtr->x = x;
mePtr->y = y;
y += menuPtr->entries[i]->height + borderWidth;
- if (y > windowHeight) {
- windowHeight = y;
- }
}
-
- for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
- columnEntryPtr = menuPtr->entries[j];
- columnEntryPtr->indicatorSpace = maxIndicatorSpace;
- columnEntryPtr->width = maxIndicatorSpace + maxWidth
- + 2 * activeBorderWidth;
- columnEntryPtr->x = x;
- columnEntryPtr->entryFlags |= ENTRY_LAST_COLUMN;
- }
- windowWidth = x + maxIndicatorSpace + maxWidth
- + 2 * activeBorderWidth + borderWidth;
- windowHeight += borderWidth;
-
+ windowWidth = menuSize.width;
if (windowWidth <= 0) {
windowWidth = 1;
}
+ windowHeight = menuSize.height;
if (windowHeight <= 0) {
windowHeight = 1;
}
@@ -1307,7 +1413,7 @@ GenerateMenuSelectEvent(
if (menuPtr) {
int index = [menu tkIndexOfItem:menuItem];
- if (index < 0 || index >= menuPtr->numEntries ||
+ if (index < 0 || index >= (int)menuPtr->numEntries ||
(menuPtr->entries[index])->state == ENTRY_DISABLED) {
TkActivateMenuEntry(menuPtr, -1);
} else {
@@ -1386,7 +1492,7 @@ RecursivelyClearActiveMenu(
int i;
TkActivateMenuEntry(menuPtr, -1);
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
TkMenuEntry *mePtr = menuPtr->entries[i];
if (mePtr->type == CASCADE_ENTRY
diff --git a/macosx/tkMacOSXMenubutton.c b/macosx/tkMacOSXMenubutton.c
index 1acefe5..b2b4b76 100644
--- a/macosx/tkMacOSXMenubutton.c
+++ b/macosx/tkMacOSXMenubutton.c
@@ -47,17 +47,23 @@ typedef struct MacMenuButton {
} MacMenuButton;
/*
- * Forward declarations for procedures defined later in this file:
+ * Forward declarations for static functions defined later in this file:
*/
static void MenuButtonEventProc(ClientData clientData, XEvent *eventPtr);
-static void MenuButtonBackgroundDrawCB ( MacMenuButton *ptr, SInt16 depth, Boolean isColorDev);
-static void MenuButtonContentDrawCB ( ThemeButtonKind kind, const HIThemeButtonDrawInfo * info, MacMenuButton *ptr, SInt16 depth, Boolean isColorDev);
+static void MenuButtonBackgroundDrawCB (MacMenuButton *ptr, SInt16 depth,
+ Boolean isColorDev);
+static void MenuButtonContentDrawCB (ThemeButtonKind kind,
+ const HIThemeButtonDrawInfo * info,
+ MacMenuButton *ptr, SInt16 depth,
+ Boolean isColorDev);
static void MenuButtonEventProc ( ClientData clientData, XEvent *eventPtr);
-static void TkMacOSXComputeMenuButtonParams (TkMenuButton * butPtr, ThemeButtonKind* btnkind, HIThemeButtonDrawInfo* drawinfo);
-static int TkMacOSXComputeMenuButtonDrawParams (TkMenuButton * butPtr, DrawParams * dpPtr);
-static void TkMacOSXDrawMenuButton (MacMenuButton *butPtr,
- GC gc, Pixmap pixmap);
+static void TkMacOSXComputeMenuButtonParams (TkMenuButton * butPtr,
+ ThemeButtonKind* btnkind,
+ HIThemeButtonDrawInfo* drawinfo);
+static void TkMacOSXComputeMenuButtonDrawParams (TkMenuButton * butPtr,
+ DrawParams * dpPtr);
+static void TkMacOSXDrawMenuButton (MacMenuButton *butPtr, GC gc, Pixmap pixmap);
static void DrawMenuButtonImageAndText(TkMenuButton* butPtr);
/*
@@ -70,11 +76,45 @@ Tk_ClassProcs tkpMenubuttonClass = {
TkMenuButtonWorldChanged, /* worldChangedProc */
};
+/*
+ * We use Apple's Pop-Up Button widget to represent the Tk Menubutton.
+ * However, we do not use the NSPopUpButton class for this control. Instead we
+ * render the Pop-Up Button using the HITheme library. This imposes some
+ * constraints on what can be done. The HITheme renderer allows only specific
+ * dimensions for the button.
+ *
+ * The HITheme library allows drawing a Pop-Up Button with an arbitrary bounds
+ * rectangle. However the button is always drawn as a rounded box which is 22
+ * pixels high. If the bounds rectangle is less than 22 pixels high, the
+ * button is drawn at the top of the rectangle and the bottom of the button is
+ * clipped away. So we set a minimum height of 22 pixels for a Menubutton. If
+ * the bounds rectangle is more than 22 pixels high, then the button is drawn
+ * centered vertically in the bounds rectangle.
+ *
+ * The content rectangle of the button is inset by 14 pixels on the left and 28
+ * pixels on the right. The rightmost part of the button contains the blue
+ * double-arrow symbol which is 28 pixels wide.
+ *
+ * To maintain compatibility with code that runs on multiple operating systems,
+ * the width and height of the content rectangle includes the borderWidth, the
+ * highlightWidth and the padX and padY dimensions of the Menubutton. However,
+ * to be consistent with the standard Apple appearance, the content is always
+ * be drawn at the left side of the content rectangle. All of the excess space
+ * appears on the right side of the content, and the anchor property is
+ * ignored. The easiest way to comply with Apple's Human Interface Guidelines
+ * would be to set bd = highlightthickness = padx = 0 and to specify an
+ * explicit width for the button. Apple also recommends using the same width
+ * for all Pop-Up Buttons in a given window.
+ */
+
+#define LEFT_INSET 8
+#define RIGHT_INSET 28
+#define MIN_HEIGHT 22
/*
*----------------------------------------------------------------------
*
- * TkpCreateMenuButton --
+ * TkpCreateMenuButton --
*
* Allocate a new TkMenuButton structure.
*
@@ -93,13 +133,12 @@ TkpCreateMenuButton(
{
MacMenuButton *mbPtr = (MacMenuButton *) ckalloc(sizeof(MacMenuButton));
- Tk_CreateEventHandler(tkwin, ActivateMask,
- MenuButtonEventProc, (ClientData) mbPtr);
+ Tk_CreateEventHandler(tkwin, ActivateMask, MenuButtonEventProc,
+ (ClientData) mbPtr);
mbPtr->flags = FIRST_DRAW;
mbPtr->btnkind = kThemePopupButton;
bzero(&mbPtr->drawinfo, sizeof(mbPtr->drawinfo));
bzero(&mbPtr->lastdrawinfo, sizeof(mbPtr->lastdrawinfo));
-
return (TkMenuButton *) mbPtr;
}
@@ -165,12 +204,13 @@ TkpDisplayMenuButton(
* TkpDestroyMenuButton --
*
* Free data structures associated with the menubutton control.
+ * This is a no-op on the Mac.
*
* Results:
* None.
*
* Side effects:
- * Restores the default control state.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -204,15 +244,12 @@ TkpComputeMenuButtonGeometry(butPtr)
register TkMenuButton *butPtr; /* Widget record for menu button. */
{
int width, height, avgWidth, haveImage = 0, haveText = 0;
- MacMenuButton *mbPtr = (MacMenuButton*)butPtr;
int txtWidth, txtHeight;
Tk_FontMetrics fm;
- DrawParams drawParams;
- int paddingx = 0;
- int paddingy = 0;
+ int highlightWidth = butPtr->highlightWidth > 0 ? butPtr->highlightWidth : 0;
/*
- * First figure out the size of the contents of the button.
+ * First compute the size of the contents of the button.
*/
width = 0;
@@ -221,8 +258,6 @@ TkpComputeMenuButtonGeometry(butPtr)
txtHeight = 0;
avgWidth = 0;
- TkMacOSXComputeMenuButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo);
-
if (butPtr->image != NULL) {
Tk_SizeOfImage(butPtr->image, &width, &height);
haveImage = 1;
@@ -231,17 +266,16 @@ TkpComputeMenuButtonGeometry(butPtr)
haveImage = 1;
}
- if (haveImage == 0 || butPtr->compound != COMPOUND_NONE) {
+ if (butPtr->text && strlen(butPtr->text) > 0) {
+ haveText = 1;
Tk_FreeTextLayout(butPtr->textLayout);
butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
butPtr->text, -1, butPtr->wrapLength,
butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
-
txtWidth = butPtr->textWidth;
txtHeight = butPtr->textHeight;
avgWidth = Tk_TextWidth(butPtr->tkfont, "0", 1);
Tk_GetFontMetrics(butPtr->tkfont, &fm);
- haveText = (txtWidth != 0 && txtHeight != 0);
}
/*
@@ -251,7 +285,7 @@ TkpComputeMenuButtonGeometry(butPtr)
* image, because otherwise it is not really a compound button.
*/
- if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ if (haveImage && haveText) {
switch ((enum compound) butPtr->compound) {
case COMPOUND_TOP:
case COMPOUND_BOTTOM: {
@@ -293,76 +327,29 @@ TkpComputeMenuButtonGeometry(butPtr)
}
} else {
- if (haveImage) {
+ if (haveImage) { /* Image only */
if (butPtr->width > 0) {
width = butPtr->width;
}
if (butPtr->height > 0) {
height = butPtr->height;
}
- } else {
+ } else { /* Text only */
width = txtWidth;
height = txtHeight;
if (butPtr->width > 0) {
- width = butPtr->width * avgWidth;
+ width = butPtr->width * avgWidth + 2*butPtr->padX;
}
if (butPtr->height > 0) {
- height = butPtr->height * fm.linespace;
+ height = butPtr->height * fm.linespace + 2*butPtr->padY;
}
}
}
- width += 2 * butPtr->padX - 2;
- height += 2 * butPtr->padY - 2;
-
- /*Add padding for button arrows.*/
- width += 22;
-
- /*
- * Now figure out the size of the border decorations for the button.
- */
-
- if (butPtr->highlightWidth < 0) {
- butPtr->highlightWidth = 0;
- }
- butPtr->inset = 0;
- butPtr->inset += butPtr->highlightWidth;
-
- TkMacOSXComputeMenuButtonDrawParams(butPtr,&drawParams);
-
- HIRect tmpRect;
- HIRect contBounds;
-
- tmpRect = CGRectMake(0, 0, width, height);
-
- HIThemeGetButtonContentBounds(&tmpRect, &mbPtr->drawinfo, &contBounds);
-
-
-
- /* If the content region has a minimum height, match it. */
- if (height < contBounds.size.height) {
- height = contBounds.size.height;
- }
-
- /* If the content region has a minimum width, match it. */
- if (width < contBounds.size.width) {
- width = contBounds.size.width;
- }
-
- /* Pad to fill difference between content bounds and button bounds. */
- paddingx = tmpRect.origin.x - contBounds.origin.x;
- paddingy = tmpRect.origin.y - contBounds.origin.y;
-
- if (paddingx > 0) {
- width += paddingx;
- }
- if (paddingy > 0) {
- height += paddingy;
- }
-
- width += butPtr->inset*2;
- height += butPtr->inset*2;
-
-
+
+ butPtr->inset = highlightWidth + butPtr->borderWidth;
+ width += LEFT_INSET + RIGHT_INSET + 2*butPtr->inset;
+ height += 2*butPtr->inset;
+ height = height < MIN_HEIGHT ? MIN_HEIGHT : height;
Tk_GeometryRequest(butPtr->tkwin, width, height);
Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
}
@@ -427,8 +414,8 @@ DrawMenuButtonImageAndText(
pressed = 1;
}
- haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
- if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
+ haveText = (butPtr->textWidth != 0 && butPtr->textHeight != 0);
+ if (butPtr->compound != COMPOUND_NONE && haveImage && haveText) {
int x = 0;
int y = 0;
textXOffset = 0;
@@ -446,8 +433,8 @@ DrawMenuButtonImageAndText(
imageYOffset = butPtr->textHeight + butPtr->padY;
}
fullHeight = height + butPtr->textHeight + butPtr->padY;
- fullWidth = (width > butPtr->textWidth ? width :
- butPtr->textWidth);
+ fullWidth = (width > butPtr->textWidth ?
+ width : butPtr->textWidth);
textXOffset = (fullWidth - butPtr->textWidth)/2;
imageXOffset = (fullWidth - width)/2;
break;
@@ -489,10 +476,10 @@ DrawMenuButtonImageAndText(
}
TkComputeAnchor(butPtr->anchor, tkwin,
- butPtr->padX + butPtr->borderWidth,
- butPtr->padY + butPtr->borderWidth,
+ butPtr->padX + butPtr->inset,
+ butPtr->padY + butPtr->inset,
fullWidth, fullHeight, &x, &y);
- imageXOffset += x;
+ imageXOffset = LEFT_INSET;
imageYOffset += y;
textYOffset -= 1;
@@ -517,36 +504,32 @@ DrawMenuButtonImageAndText(
butPtr->underline);
} else {
if (haveImage) {
- int x = 0;
- int y;
+ int x, y;
TkComputeAnchor(butPtr->anchor, tkwin,
butPtr->padX + butPtr->borderWidth,
butPtr->padY + butPtr->borderWidth,
width, height, &x, &y);
- imageXOffset += x;
- imageYOffset += y;
-
- if (butPtr->image != NULL) {
- Tk_RedrawImage(butPtr->image, 0, 0, width, height,
- pixmap, imageXOffset, imageYOffset);
+ imageXOffset = LEFT_INSET;
+ imageYOffset += y;
+ if (butPtr->image != NULL) {
+ Tk_RedrawImage(butPtr->image, 0, 0, width, height,
+ pixmap, imageXOffset, imageYOffset);
} else {
XSetClipOrigin(butPtr->display, dpPtr->gc, x, y);
XCopyPlane(butPtr->display, butPtr->bitmap,
- pixmap, dpPtr->gc,
- 0, 0, (unsigned int) width,
- (unsigned int) height,
- imageXOffset, imageYOffset, 1);
+ pixmap, dpPtr->gc,
+ 0, 0, (unsigned int) width,
+ (unsigned int) height,
+ imageXOffset, imageYOffset, 1);
XSetClipOrigin(butPtr->display, dpPtr->gc, 0, 0);
}
} else {
- /*Move x back by eight pixels to give the menubutton arrows room.*/
- int x = 0;
- int y;
- textXOffset = 8;
+ int x, y;
+ textXOffset = LEFT_INSET;
TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
butPtr->textWidth, butPtr->textHeight, &x, &y);
Tk_DrawTextLayout(butPtr->display, pixmap, dpPtr->gc,
- butPtr->textLayout, x - textXOffset, y, 0, -1);
+ butPtr->textLayout, textXOffset, y, 0, -1);
y += butPtr->textHeight/2;
}
}
@@ -578,7 +561,6 @@ TkMacOSXDrawMenuButton(
* the bevel button */
Pixmap pixmap) /* The pixmap we are drawing into - needed
* for the bevel button */
-
{
TkMenuButton * butPtr = ( TkMenuButton *)mbPtr;
TkWindow * winPtr;
@@ -591,10 +573,9 @@ TkMacOSXDrawMenuButton(
TkMacOSXComputeMenuButtonParams(butPtr, &mbPtr->btnkind, &mbPtr->drawinfo);
- cntrRect = CGRectMake(winPtr->privatePtr->xOff, winPtr->privatePtr->yOff, Tk_Width(butPtr->tkwin),Tk_Height(butPtr->tkwin));
-
- cntrRect = CGRectInset(cntrRect, butPtr->inset, butPtr->inset);
-
+ cntrRect = CGRectMake(winPtr->privatePtr->xOff, winPtr->privatePtr->yOff,
+ Tk_Width(butPtr->tkwin),
+ Tk_Height(butPtr->tkwin));
if (useNewerHITools == 1) {
HIRect contHIRec;
@@ -617,17 +598,15 @@ TkMacOSXDrawMenuButton(
hiinfo.animation.time.start = hiinfo.animation.time.current;
}
- HIThemeDrawButton(&cntrRect, &hiinfo, dc.context, kHIThemeOrientationNormal, &contHIRec);
-
+ HIThemeDrawButton(&cntrRect, &hiinfo, dc.context,
+ kHIThemeOrientationNormal, &contHIRec);
TkMacOSXRestoreDrawingContext(&dc);
-
- MenuButtonContentDrawCB( mbPtr->btnkind, &mbPtr->drawinfo, (MacMenuButton *)mbPtr, 32, true);
+ MenuButtonContentDrawCB( mbPtr->btnkind, &mbPtr->drawinfo,
+ (MacMenuButton *)mbPtr, 32, true);
} else {
if (!TkMacOSXSetupDrawingContext(pixmap, dpPtr->gc, 1, &dc)) {
return;
}
-
-
TkMacOSXRestoreDrawingContext(&dc);
}
mbPtr->lastdrawinfo = mbPtr->drawinfo;
@@ -696,8 +675,7 @@ MenuButtonContentDrawCB (
if (tkwin == NULL || !Tk_IsMapped(tkwin)) {
return;
}
-
- DrawMenuButtonImageAndText( butPtr);
+ DrawMenuButtonImageAndText(butPtr);
}
/*
@@ -761,19 +739,18 @@ MenuButtonEventProc(
*/
static void
-TkMacOSXComputeMenuButtonParams(TkMenuButton * butPtr, ThemeButtonKind* btnkind, HIThemeButtonDrawInfo *drawinfo)
+TkMacOSXComputeMenuButtonParams(
+ TkMenuButton * butPtr,
+ ThemeButtonKind* btnkind,
+ HIThemeButtonDrawInfo *drawinfo)
{
MacMenuButton *mbPtr = (MacMenuButton *)butPtr;
- if (butPtr->image || butPtr->bitmap) {
+ if (butPtr->image || butPtr->bitmap || butPtr->text) {
/* TODO: allow for Small and Mini menubuttons. */
*btnkind = kThemePopupButton;
- } else {
- if (!butPtr->text || !*butPtr->text) {
- *btnkind = kThemeArrowButton;
- } else {
- *btnkind = kThemePopupButton;
- }
+ } else { /* This should never happen. */
+ *btnkind = kThemeArrowButton;
}
drawinfo->value = kThemeButtonOff;
@@ -812,24 +789,25 @@ TkMacOSXComputeMenuButtonParams(TkMenuButton * butPtr, ThemeButtonKind* btnkind,
*
* TkMacOSXComputeMenuButtonDrawParams --
*
- * This procedure computes the various parameters used
- * when drawing a button
- * These are determined by the various tk button parameters
+ * This procedure selects an appropriate drawing context for
+ * drawing a menubutton.
*
* Results:
- * 1 if control will be used, 0 otherwise.
+ * None.
*
* Side effects:
- * Sets the button draw parameters
+ * Sets the button draw parameters.
*
*----------------------------------------------------------------------
*/
-static int
-TkMacOSXComputeMenuButtonDrawParams(TkMenuButton * butPtr, DrawParams * dpPtr)
+static void
+TkMacOSXComputeMenuButtonDrawParams(
+ TkMenuButton * butPtr,
+ DrawParams * dpPtr)
{
- dpPtr->hasImageOrBitmap = ((butPtr->image != NULL)
- || (butPtr->bitmap != None));
+ dpPtr->hasImageOrBitmap = ((butPtr->image != NULL) ||
+ (butPtr->bitmap != None));
dpPtr->border = butPtr->normalBorder;
if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
dpPtr->gc = butPtr->disabledGC;
@@ -839,8 +817,6 @@ TkMacOSXComputeMenuButtonDrawParams(TkMenuButton * butPtr, DrawParams * dpPtr)
} else {
dpPtr->gc = butPtr->normalTextGC;
}
-
- return 1;
}
/*
diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c
index 7b83679..ec713d4 100644
--- a/macosx/tkMacOSXMouseEvent.c
+++ b/macosx/tkMacOSXMouseEvent.c
@@ -24,6 +24,7 @@ typedef struct {
Point global;
Point local;
} MouseEventData;
+static Tk_Window captureWinPtr = NULL; /* Current capture window; may be NULL. */
static int GenerateButtonEvent(MouseEventData *medPtr);
static unsigned int ButtonModifiers2State(UInt32 buttonState,
@@ -47,15 +48,17 @@ enum {
@implementation TKApplication(TKMouseEvent)
- (NSEvent *) tkProcessMouseEvent: (NSEvent *) theEvent
{
-#ifdef TK_MAC_DEBUG_EVENTS
- TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent);
-#endif
NSWindow* eventWindow = [theEvent window];
NSEventType eventType = [theEvent type];
+ TkWindow *winPtr, *grabWinPtr;
+ Tk_Window tkwin;
#if 0
NSTrackingArea *trackingArea = nil;
NSInteger eventNumber, clickCount, buttonNumber;
#endif
+#ifdef TK_MAC_DEBUG_EVENTS
+ TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, theEvent);
+#endif
switch (eventType) {
case NSMouseEntered:
case NSMouseExited:
@@ -87,51 +90,94 @@ enum {
[_windowWithMouse retain];
}
- /* Create an Xevent to add to the Tk queue. */
+ /*
+ * Compute the mouse position in Tk screen coordinates (global) and in
+ * the Tk coordinates of its containing Tk Window.
+ */
+
NSPoint global, local = [theEvent locationInWindow];
- if (eventWindow) { /* local will be in window coordinates. */
+
+ /*
+ * If the event has no NSWindow, try using the cached NSWindow from the
+ * last mouse event.
+ */
+
+ if (eventWindow == NULL) {
+ eventWindow = _windowWithMouse;
+ }
+ if (eventWindow) {
+
+ /*
+ * Set the local mouse position to its NSWindow flipped coordinates,
+ * with the origin at top left, and the global mouse position to the
+ * flipped screen coordinates.
+ */
+
global = [eventWindow tkConvertPointToScreen: local];
local.y = [eventWindow frame].size.height - local.y;
global.y = tkMacOSXZeroScreenHeight - global.y;
- } else { /* local will be in screen coordinates. */
- if (_windowWithMouse ) {
- eventWindow = _windowWithMouse;
- global = local;
- local = [eventWindow tkConvertPointFromScreen: local];
- local.y = [eventWindow frame].size.height - local.y;
- global.y = tkMacOSXZeroScreenHeight - global.y;
- } else { /* We have no window. Use the screen???*/
- local.y = tkMacOSXZeroScreenHeight - local.y;
- global = local;
- }
+
+ } else {
+
+ /*
+ * As a last resort, with no NSWindow to work with, set both local and
+ * global to the screen coordinates.
+ */
+
+ local.y = tkMacOSXZeroScreenHeight - local.y;
+ global = local;
}
- TkWindow *winPtr = TkMacOSXGetTkWindow(eventWindow);
- Tk_Window tkwin = (Tk_Window) winPtr;
+ /*
+ * Find the toplevel which corresponds to the event NSWindow.
+ */
- if (tkwin) {
- TkWindow *grabWinPtr = winPtr->dispPtr->grabWinPtr;
- if (grabWinPtr &&
- grabWinPtr != winPtr &&
- !winPtr->dispPtr->grabFlags && /* this means the grab is local. */
- grabWinPtr->mainPtr == winPtr->mainPtr) {
- return theEvent;
- }
- } else {
+ winPtr = TkMacOSXGetTkWindow(eventWindow);
+ if (winPtr == NULL) {
tkwin = TkMacOSXGetCapture();
+ winPtr = (TkWindow *)tkwin;
+ } else {
+ tkwin = (Tk_Window) winPtr;
}
if (!tkwin) {
TkMacOSXDbgMsg("tkwin == NULL");
return theEvent; /* Give up. No window for this event. */
- } else {
- winPtr = (TkWindow *)tkwin;
}
+ /*
+ * If another toplevel has a grab, we ignore the event.
+ */
+
+ grabWinPtr = winPtr->dispPtr->grabWinPtr;
+ if (grabWinPtr &&
+ grabWinPtr != winPtr &&
+ !winPtr->dispPtr->grabFlags && /* this means the grab is local. */
+ grabWinPtr->mainPtr == winPtr->mainPtr) {
+ return theEvent;
+ }
+
+ /*
+ * Convert local from NSWindow flipped coordinates to the toplevel's
+ * coordinates.
+ */
+
local.x -= winPtr->wmInfoPtr->xInParent;
local.y -= winPtr->wmInfoPtr->yInParent;
+ /*
+ * Find the containing Tk window, and convert local into the coordinates
+ * of the Tk window. (The converted local coordinates are only needed
+ * for scrollwheel events.)
+ */
+
int win_x, win_y;
tkwin = Tk_TopCoordsToWindow(tkwin, local.x, local.y, &win_x, &win_y);
+ local.x = win_x;
+ local.y = win_y;
+
+ /*
+ * Generate an XEvent for this mouse event.
+ */
unsigned int state = 0;
NSInteger button = [theEvent buttonNumber];
@@ -181,11 +227,21 @@ enum {
}
if (eventType != NSScrollWheel) {
+
+ /*
+ * For normal mouse events, Tk_UpdatePointer will send the XEvent.
+ */
+
#ifdef TK_MAC_DEBUG_EVENTS
TKLog(@"UpdatePointer %p x %f.0 y %f.0 %d", tkwin, global.x, global.y, state);
#endif
Tk_UpdatePointer(tkwin, global.x, global.y, state);
- } else { /* handle scroll wheel event */
+ } else {
+
+ /*
+ * For scroll wheel events we need to send the XEvent here.
+ */
+
CGFloat delta;
int coarseDelta;
XEvent xEvent;
@@ -581,6 +637,56 @@ TkpWarpPointer(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetCapture --
+ *
+ * This function captures the mouse so that all future events will be
+ * reported to this window, even if the mouse is outside the window. If
+ * the specified window is NULL, then the mouse is released.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the capture flag and captures the mouse.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetCapture(
+ TkWindow *winPtr) /* Capture window, or NULL. */
+{
+ while (winPtr && !Tk_IsTopLevel(winPtr)) {
+ winPtr = winPtr->parentPtr;
+ }
+ captureWinPtr = (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXGetCapture --
+ *
+ * Results:
+ * Returns the current grab window
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+TkMacOSXGetCapture(void)
+{
+ return captureWinPtr;
+}
+
+
+
+/*
* Local Variables:
* mode: objc
* c-basic-offset: 4
diff --git a/macosx/tkMacOSXSend.c b/macosx/tkMacOSXSend.c
index 3b24a56..1fdf048 100644
--- a/macosx/tkMacOSXSend.c
+++ b/macosx/tkMacOSXSend.c
@@ -325,7 +325,7 @@ Tk_SendObjCmd(
int objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* The arguments */
{
- const char *const sendOptions[] = {"-async", "-displayof", "-", NULL};
+ const char *const sendOptions[] = {"-async", "-displayof", "--", NULL};
char *stringRep, *destName;
/*int async = 0;*/
int i, index, firstArg;
diff --git a/macosx/tkMacOSXSubwindows.c b/macosx/tkMacOSXSubwindows.c
index 7bc807a..805d58f 100644
--- a/macosx/tkMacOSXSubwindows.c
+++ b/macosx/tkMacOSXSubwindows.c
@@ -149,6 +149,7 @@ XMapWindow(
if (Tk_IsTopLevel(macWin->winPtr)) {
if (!Tk_IsEmbedded(macWin->winPtr)) {
NSWindow *win = TkMacOSXDrawableWindow(window);
+
/*
* We want to activate Tk when a toplevel is mapped
* but we must not supply YES here. This is because
@@ -157,6 +158,7 @@ XMapWindow(
* the app to activate too early can make the menu bar
* unresponsive.
*/
+
TkMacOSXApplyWindowAttributes(macWin->winPtr, win);
[win setExcludedFromWindowsMenu:NO];
[NSApp activateIgnoringOtherApps:NO];
@@ -166,11 +168,22 @@ XMapWindow(
} else {
[win orderFrontRegardless];
}
+
+ /*
+ * In some cases the toplevel will not be drawn unless we process
+ * all pending events now. See ticket 56a1823c73.
+ */
+
+ [NSApp _lockAutoreleasePool];
+ while (Tcl_DoOneEvent(TCL_WINDOW_EVENTS| TCL_DONT_WAIT)) {}
+ [NSApp _unlockAutoreleasePool];
} else {
+
/*
* Rebuild the container's clipping region and display
* the window.
*/
+
TkWindow *contWinPtr = TkpGetOtherWindow(macWin->winPtr);
TkMacOSXInvalClipRgns((Tk_Window)contWinPtr);
TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW);
@@ -190,7 +203,9 @@ XMapWindow(
event.xmap.event = window;
event.xmap.override_redirect = macWin->winPtr->atts.override_redirect;
Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+
} else {
+
/*
* Rebuild the parent's clipping region and display the window.
*
@@ -211,11 +226,10 @@ XMapWindow(
NotifyVisibility(macWin->winPtr, &event);
/*
- * Make sure that subwindows get displayed.
+ * This seems to be needed to ensure that all subwindows get displayed.
*/
GenerateConfigureNotify(macWin->winPtr, 1);
-
}
/*
@@ -284,11 +298,7 @@ XUnmapWindow(
if (!Tk_IsEmbedded(winPtr) &&
winPtr->wmInfoPtr->hints.initial_state!=IconicState) {
NSWindow *win = TkMacOSXDrawableWindow(window);
-
- if ([win isVisible]) {
- [[win parentWindow] removeChildWindow:win];
- [win orderOut:NSApp];
- }
+ [win orderOut:nil];
}
TkMacOSXInvalClipRgns((Tk_Window) winPtr);
@@ -1314,7 +1324,7 @@ TkMacOSXWinCGBounds(
* UpdateOffsets --
*
* Updates the X & Y offsets of the given TkWindow from the TopLevel it is
- * a decendant of.
+ * a descendant of.
*
* Results:
* None.
diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c
index ad6af30..212381e 100644
--- a/macosx/tkMacOSXWindowEvent.c
+++ b/macosx/tkMacOSXWindowEvent.c
@@ -75,12 +75,10 @@ extern NSString *NSWindowDidOrderOffScreenNotification;
if (winPtr) {
WmInfo *wmPtr = winPtr->wmInfoPtr;
NSRect bounds = [w frame];
- NSRect screenRect = [[w screen] frame];
int x, y, width = -1, height = -1, flags = 0;
- int minY = 1 + [[NSApp mainMenu] menuBarHeight];
x = bounds.origin.x;
- y = screenRect.size.height - (bounds.origin.y + bounds.size.height);
+ y = tkMacOSXZeroScreenHeight - (bounds.origin.y + bounds.size.height);
if (winPtr->changes.x != x || winPtr->changes.y != y) {
flags |= TK_LOCATION_CHANGED;
} else {
@@ -101,20 +99,6 @@ extern NSString *NSWindowDidOrderOffScreenNotification;
flags |= TK_MACOSX_HANDLE_EVENT_IMMEDIATELY;
}
- /*
- * Mac windows cannot go higher than the bottom of the menu bar. The
- * Tk window manager can request that a window be drawn so that it
- * overlaps the menu bar, but it will actually be drawn immediately
- * below the menu bar. In such a case it saves a lot of trouble and
- * causes no harm if we let Tk think that the window is located at the
- * requested point. (Many of the the tests assume that this is the
- * case, especially for windows with upper left corner at (0,0).) So
- * we just tell a harmless white lie here.
- */
-
- if (y == minY && wmPtr->y < minY) {
- y = wmPtr->y;
- }
TkGenWMConfigureEvent((Tk_Window) winPtr, x, y, width, height, flags);
}
@@ -523,7 +507,9 @@ GenerateActivateEvents(
int activeFlag)
{
TkGenerateActivateEvents(winPtr, activeFlag);
- TkMacOSXGenerateFocusEvent(winPtr, activeFlag);
+ if (activeFlag || ![NSApp isActive]) {
+ TkMacOSXGenerateFocusEvent(winPtr, activeFlag);
+ }
return true;
}
@@ -680,7 +666,6 @@ TkGenWMConfigureEvent(
if (flags & TK_LOCATION_CHANGED) {
wmPtr->x = x;
wmPtr->y = y;
- //wmPtr->flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
}
if ((flags & TK_SIZE_CHANGED) && !(wmPtr->flags & WM_SYNC_PENDING) &&
((width != Tk_Width(tkwin)) || (height != Tk_Height(tkwin)))) {
diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c
index a839ab2..2a91822 100644
--- a/macosx/tkMacOSXWm.c
+++ b/macosx/tkMacOSXWm.c
@@ -322,6 +322,7 @@ static void GetMaxSize(TkWindow *winPtr, int *maxWidthPtr,
int *maxHeightPtr);
static void RemapWindows(TkWindow *winPtr,
MacDrawable *parentWin);
+static void RemoveTransient(TkWindow *winPtr);
#pragma mark NSWindow(TKWm)
@@ -668,7 +669,7 @@ TkWmNewWindow(
wmPtr->reparent = None;
wmPtr->titleUid = NULL;
wmPtr->iconName = NULL;
- wmPtr->master = None;
+ wmPtr->master = NULL;
wmPtr->hints.flags = InputHint | StateHint;
wmPtr->hints.input = True;
wmPtr->hints.initial_state = NormalState;
@@ -678,9 +679,9 @@ TkWmNewWindow(
wmPtr->hints.icon_mask = None;
wmPtr->hints.window_group = None;
wmPtr->leaderName = NULL;
- wmPtr->masterWindowName = NULL;
wmPtr->icon = NULL;
wmPtr->iconFor = NULL;
+ wmPtr->transientPtr = NULL;
wmPtr->sizeHintsFlags = 0;
wmPtr->minWidth = wmPtr->minHeight = 1;
wmPtr->maxWidth = 0;
@@ -886,6 +887,12 @@ TkWmDeadWindow(
if (wmPtr == NULL) {
return;
}
+
+ /*
+ *If the dead window is a transient, remove it from the master's list.
+ */
+
+ RemoveTransient(winPtr);
Tk_ManageGeometry((Tk_Window) winPtr, NULL, NULL);
Tk_DeleteEventHandler((Tk_Window) winPtr, StructureNotifyMask,
TopLevelEventProc, winPtr);
@@ -901,9 +908,6 @@ TkWmDeadWindow(
if (wmPtr->leaderName != NULL) {
ckfree(wmPtr->leaderName);
}
- if (wmPtr->masterWindowName != NULL) {
- ckfree(wmPtr->masterWindowName);
- }
if (wmPtr->icon != NULL) {
wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
wmPtr2->iconFor = NULL;
@@ -915,7 +919,6 @@ TkWmDeadWindow(
}
while (wmPtr->protPtr != NULL) {
ProtocolHandler *protPtr = wmPtr->protPtr;
-
wmPtr->protPtr = protPtr->nextPtr;
Tcl_EventuallyFree(protPtr, TCL_DYNAMIC);
}
@@ -930,6 +933,27 @@ TkWmDeadWindow(
}
/*
+ * If the dead window has a transient, remove references to it from
+ * the transient.
+ */
+
+ for (Transient *transientPtr = wmPtr->transientPtr;
+ transientPtr != NULL; transientPtr = transientPtr->nextPtr) {
+ TkWindow *winPtr2 = transientPtr->winPtr;
+ TkWindow *masterPtr = (TkWindow *)TkGetTransientMaster(winPtr2);
+ if (masterPtr == winPtr) {
+ wmPtr2 = winPtr2->wmInfoPtr;
+ wmPtr2->master = NULL;
+ }
+ }
+
+ while (wmPtr->transientPtr != NULL) {
+ Transient *transientPtr = wmPtr->transientPtr;
+ wmPtr->transientPtr = transientPtr->nextPtr;
+ ckfree(transientPtr);
+ }
+
+ /*
* Delete the Mac window and remove it from the windowTable. The window
* could be nil if the window was never mapped. However, we don't do this
* for embedded windows, they don't go in the window list, and they do not
@@ -1090,7 +1114,7 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(wmTracing));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wmTracing != 0));
return TCL_OK;
}
return Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing);
@@ -1226,10 +1250,10 @@ WmAspectCmd(
if (wmPtr->sizeHintsFlags & PAspect) {
Tcl_Obj *results[4];
- results[0] = Tcl_NewIntObj(wmPtr->minAspect.x);
- results[1] = Tcl_NewIntObj(wmPtr->minAspect.y);
- results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x);
- results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y);
+ results[0] = Tcl_NewWideIntObj(wmPtr->minAspect.x);
+ results[1] = Tcl_NewWideIntObj(wmPtr->minAspect.y);
+ results[2] = Tcl_NewWideIntObj(wmPtr->maxAspect.x);
+ results[3] = Tcl_NewWideIntObj(wmPtr->maxAspect.y);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
@@ -1429,23 +1453,23 @@ WmGetAttribute(
result = Tcl_NewDoubleObj([macWindow alphaValue]);
break;
case WMATT_FULLSCREEN:
- result = Tcl_NewBooleanObj(wmPtr->flags & WM_FULLSCREEN);
+ result = Tcl_NewWideIntObj((wmPtr->flags & WM_FULLSCREEN) != 0);
break;
case WMATT_MODIFIED:
- result = Tcl_NewBooleanObj([macWindow isDocumentEdited]);
+ result = Tcl_NewWideIntObj([macWindow isDocumentEdited] != 0);
break;
case WMATT_NOTIFY:
- result = Tcl_NewBooleanObj(tkMacOSXWmAttrNotifyVal);
+ result = Tcl_NewWideIntObj(tkMacOSXWmAttrNotifyVal != 0);
break;
case WMATT_TITLEPATH:
result = Tcl_NewStringObj([[macWindow representedFilename] UTF8String],
-1);
break;
case WMATT_TOPMOST:
- result = Tcl_NewBooleanObj(wmPtr->flags & WM_TOPMOST);
+ result = Tcl_NewWideIntObj((wmPtr->flags & WM_TOPMOST) != 0);
break;
case WMATT_TRANSPARENT:
- result = Tcl_NewBooleanObj(wmPtr->flags & WM_TRANSPARENT);
+ result = Tcl_NewWideIntObj((wmPtr->flags & WM_TRANSPARENT) != 0);
break;
case WMATT_TYPE:
result = Tcl_NewStringObj("unsupported", -1);
@@ -1786,6 +1810,26 @@ WmDeiconifyCmd(
if (wmPtr->icon) {
Tk_UnmapWindow((Tk_Window)wmPtr->icon);
}
+
+ /*
+ * If this window has a transient, the transient must also be deiconified if
+ * it was withdrawn by the master.
+ */
+
+ for (Transient *transientPtr = wmPtr->transientPtr;
+ transientPtr != NULL; transientPtr = transientPtr->nextPtr) {
+ TkWindow *winPtr2 = transientPtr->winPtr;
+ WmInfo *wmPtr2 = winPtr2->wmInfoPtr;
+ TkWindow *masterPtr = (TkWindow *)TkGetTransientMaster(winPtr2);
+ if (masterPtr == winPtr) {
+ if ((wmPtr2->hints.initial_state == WithdrawnState &&
+ (transientPtr->flags & WITHDRAWN_BY_MASTER) != 0)) {
+ TkpWmSetState(winPtr2, NormalState);
+ transientPtr->flags &= ~WITHDRAWN_BY_MASTER;
+ }
+ }
+ }
+
return TCL_OK;
}
@@ -2058,10 +2102,10 @@ WmGridCmd(
if (wmPtr->sizeHintsFlags & PBaseSize) {
Tcl_Obj *results[4];
- results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth);
- results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight);
- results[2] = Tcl_NewIntObj(wmPtr->widthInc);
- results[3] = Tcl_NewIntObj(wmPtr->heightInc);
+ results[0] = Tcl_NewWideIntObj(wmPtr->reqGridWidth);
+ results[1] = Tcl_NewWideIntObj(wmPtr->reqGridHeight);
+ results[2] = Tcl_NewWideIntObj(wmPtr->widthInc);
+ results[3] = Tcl_NewWideIntObj(wmPtr->heightInc);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
@@ -2285,7 +2329,7 @@ WmIconifyCmd(
Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "OVERRIDE_REDIRECT",
NULL);
return TCL_ERROR;
- } else if (wmPtr->master != None) {
+ } else if (wmPtr->master != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't iconify \"%s\": it is a transient", winPtr->pathName));
Tcl_SetErrorCode(interp, "TK", "WM", "ICONIFY", "TRANSIENT", NULL);
@@ -2308,6 +2352,23 @@ WmIconifyCmd(
if (wmPtr->icon) {
Tk_MapWindow((Tk_Window)wmPtr->icon);
}
+
+ /*
+ * If this window has a transient the transient must be withdrawn when
+ * the master is iconified.
+ */
+
+ for (Transient *transientPtr = wmPtr->transientPtr;
+ transientPtr != NULL; transientPtr = transientPtr->nextPtr) {
+ TkWindow *winPtr2 = transientPtr->winPtr;
+ TkWindow *masterPtr = (TkWindow *)TkGetTransientMaster(winPtr2);
+ if (masterPtr == winPtr &&
+ winPtr2->wmInfoPtr->hints.initial_state != WithdrawnState) {
+ TkpWmSetState(winPtr2, WithdrawnState);
+ transientPtr->flags |= WITHDRAWN_BY_MASTER;
+ }
+ }
+
return TCL_OK;
}
@@ -2535,8 +2596,8 @@ WmIconpositionCmd(
if (wmPtr->hints.flags & IconPositionHint) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x);
- results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y);
+ results[0] = Tcl_NewWideIntObj(wmPtr->hints.icon_x);
+ results[1] = Tcl_NewWideIntObj(wmPtr->hints.icon_y);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
}
return TCL_OK;
@@ -2762,8 +2823,8 @@ WmMaxsizeCmd(
Tcl_Obj *results[2];
GetMaxSize(winPtr, &width, &height);
- results[0] = Tcl_NewIntObj(width);
- results[1] = Tcl_NewIntObj(height);
+ results[0] = Tcl_NewWideIntObj(width);
+ results[1] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -2816,8 +2877,8 @@ WmMinsizeCmd(
Tcl_Obj *results[2];
GetMinSize(winPtr, &width, &height);
- results[0] = Tcl_NewIntObj(width);
- results[1] = Tcl_NewIntObj(height);
+ results[0] = Tcl_NewWideIntObj(width);
+ results[1] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -2868,8 +2929,8 @@ WmOverrideredirectCmd(
}
if (objc == 3) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- Tk_Attributes((Tk_Window) winPtr)->override_redirect));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ Tk_Attributes((Tk_Window) winPtr)->override_redirect != 0));
return TCL_OK;
}
@@ -3087,8 +3148,8 @@ WmResizableCmd(
if (objc == 3) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE));
- results[1] = Tcl_NewBooleanObj(!(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE));
+ results[0] = Tcl_NewWideIntObj((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) == 0);
+ results[1] = Tcl_NewWideIntObj((wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) == 0);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -3313,7 +3374,7 @@ WmStackorderCmd(
} else { /* OPT_ISBELOW */
result = index1 < index2;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result != 0));
return TCL_OK;
}
}
@@ -3392,7 +3453,7 @@ WmStateCmd(
"OVERRIDE_REDIRECT", NULL);
return TCL_ERROR;
}
- if (wmPtr->master != None) {
+ if (wmPtr->master != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't iconify \"%s\": it is a transient",
winPtr->pathName));
@@ -3507,32 +3568,29 @@ WmTransientCmd(
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
Tk_Window master;
+ TkWindow *masterPtr, *w;
WmInfo *wmPtr2;
- char *masterWindowName;
- int length;
+ Transient *transient;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "window ?master?");
return TCL_ERROR;
}
if (objc == 3) {
- if (wmPtr->master != None) {
+ if (wmPtr->master != NULL) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj(wmPtr->masterWindowName, -1));
+ Tcl_NewStringObj(Tk_PathName(wmPtr->master), -1));
}
return TCL_OK;
}
if (Tcl_GetString(objv[3])[0] == '\0') {
- wmPtr->master = None;
- if (wmPtr->masterWindowName != NULL) {
- ckfree(wmPtr->masterWindowName);
- }
- wmPtr->masterWindowName = NULL;
+ RemoveTransient(winPtr);
+
} else {
if (TkGetWindowFromObj(interp, tkwin, objv[3], &master) != TCL_OK) {
return TCL_ERROR;
}
- TkWindow* masterPtr = (TkWindow*) master;
+ masterPtr = (TkWindow*) master;
while (!Tk_TopWinHierarchy(masterPtr)) {
/*
@@ -3561,25 +3619,105 @@ WmTransientCmd(
return TCL_ERROR;
}
- if (masterPtr == winPtr) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't make \"%s\" its own master", Tk_PathName(winPtr)));
- Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
- return TCL_ERROR;
+ for (w = masterPtr; w != NULL && w->wmInfoPtr != NULL;
+ w = (TkWindow *)w->wmInfoPtr->master) {
+ if (w == winPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "setting \"%s\" as master creates a transient/master cycle",
+ Tk_PathName(masterPtr)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
+ return TCL_ERROR;
+ }
}
- wmPtr->master = Tk_WindowId(masterPtr);
- masterWindowName = masterPtr->pathName;
- length = strlen(masterWindowName);
- if (wmPtr->masterWindowName != NULL) {
- ckfree(wmPtr->masterWindowName);
+ /*
+ * Add the transient to the master's list, if it not already there.
+ */
+
+ for (transient = wmPtr2->transientPtr;
+ transient != NULL && transient->winPtr != winPtr;
+ transient = transient->nextPtr) {}
+ if (transient == NULL) {
+ transient = ckalloc(sizeof(Transient));
+ transient->winPtr = winPtr;
+ transient->flags = 0;
+ transient->nextPtr = wmPtr2->transientPtr;
+ wmPtr2->transientPtr = transient;
+ }
+
+ /*
+ * If the master is withdrawn or iconic then withdraw the transient.
+ */
+
+ if ((wmPtr2->hints.initial_state == WithdrawnState ||
+ wmPtr2->hints.initial_state == IconicState) &&
+ wmPtr->hints.initial_state != WithdrawnState){
+ TkpWmSetState(winPtr, WithdrawnState);
+ transient->flags |= WITHDRAWN_BY_MASTER;
}
- wmPtr->masterWindowName = ckalloc(length+1);
- strcpy(wmPtr->masterWindowName, masterWindowName);
+
+ wmPtr->master = (Tk_Window)masterPtr;
}
ApplyMasterOverrideChanges(winPtr, NULL);
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RemoveTransient --
+ *
+ * Clears the transient's master record and removes the transient
+ * from the master's list.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * References to a master are removed from the transient's wmInfo
+ * structure and references to the transient are removed from its
+ * master's wmInfo.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RemoveTransient(
+ TkWindow *winPtr)
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr, *wmPtr2;
+ TkWindow *masterPtr;
+ Transient *T, *temp;
+
+ if (wmPtr == NULL || wmPtr->master == NULL) {
+ return;
+ }
+ masterPtr = (TkWindow*)wmPtr->master;
+ wmPtr2 = masterPtr->wmInfoPtr;
+ if (wmPtr2 == NULL) {
+ return;
+ }
+ wmPtr->master = NULL;
+ T = wmPtr2->transientPtr;
+ while (T != NULL) {
+ if (T->winPtr != winPtr) {
+ break;
+ }
+ temp = T->nextPtr;
+ ckfree(T);
+ T = temp;
+ }
+ wmPtr2->transientPtr = T;
+ while (T != NULL) {
+ if (T->nextPtr && T->nextPtr->winPtr == winPtr) {
+ temp = T->nextPtr;
+ T->nextPtr = temp->nextPtr;
+ ckfree(temp);
+ } else {
+ T = T->nextPtr;
+ }
+ }
+}
/*
*----------------------------------------------------------------------
@@ -3620,11 +3758,27 @@ WmWithdrawCmd(
Tcl_SetErrorCode(interp, "TK", "WM", "WITHDRAW", "ICON", NULL);
return TCL_ERROR;
}
+
TkpWmSetState(winPtr, WithdrawnState);
+
NSWindow *win = TkMacOSXDrawableWindow(winPtr->window);
[win orderOut:nil];
[win setExcludedFromWindowsMenu:YES];
+ /*
+ * If this window has a transient, the transient must also be withdrawn.
+ */
+ for (Transient *transientPtr = wmPtr->transientPtr;
+ transientPtr != NULL; transientPtr = transientPtr->nextPtr) {
+ TkWindow *winPtr2 = transientPtr->winPtr;
+ TkWindow *masterPtr = (TkWindow *)TkGetTransientMaster(winPtr2);
+ if (masterPtr == winPtr &&
+ winPtr2->wmInfoPtr->hints.initial_state != WithdrawnState) {
+ TkpWmSetState(winPtr2, WithdrawnState);
+ transientPtr->flags |= WITHDRAWN_BY_MASTER;
+ }
+ }
+
return TCL_OK;
}
@@ -4734,7 +4888,6 @@ Tk_MoveToplevelWindow(
wmPtr->x = x;
wmPtr->y = y;
wmPtr->flags |= WM_MOVE_PENDING;
- // wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
if (!(wmPtr->sizeHintsFlags & (USPosition|PPosition))) {
wmPtr->sizeHintsFlags |= USPosition;
wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
@@ -5171,14 +5324,14 @@ TkSetWMName(
*----------------------------------------------------------------------
*/
-Window
+Tk_Window
TkGetTransientMaster(
TkWindow *winPtr)
{
if (winPtr->wmInfoPtr != NULL) {
- return winPtr->wmInfoPtr->master;
+ return (Tk_Window)winPtr->wmInfoPtr->master;
}
- return None;
+ return NULL;
}
/*
@@ -6221,8 +6374,10 @@ XSetInputFocus(
*
* TkpChangeFocus --
*
- * This procedure is a stub on the Mac because we always own the focus if
- * we are a front most application.
+ * This function is called when Tk moves focus from one window to another.
+ * It should be passed a non-embedded TopLevel. That toplevel gets raised
+ * to the top of the Tk stacking order and the associated NSWindow is
+ * ordered Front.
*
* Results:
* The return value is the serial number of the command that changed the
@@ -6413,7 +6568,7 @@ TkMacOSXApplyWindowAttributes(
{
WmInfo *wmPtr = winPtr->wmInfoPtr;
ApplyWindowAttributeFlagChanges(winPtr, macWindow, 0, 0, 0, 1);
- if (wmPtr->master != None || winPtr->atts.override_redirect) {
+ if (wmPtr->master != NULL || winPtr->atts.override_redirect) {
ApplyMasterOverrideChanges(winPtr, macWindow);
}
}
@@ -6550,7 +6705,7 @@ ApplyWindowAttributeFlagChanges(
*/
if ((winPtr->atts.override_redirect) ||
- (wmPtr->master != None) ||
+ (wmPtr->master != NULL) ||
(winPtr->wmInfoPtr->macClass == kHelpWindowClass)) {
b |= (NSWindowCollectionBehaviorCanJoinAllSpaces |
NSWindowCollectionBehaviorFullScreenAuxiliary);
@@ -6627,6 +6782,7 @@ ApplyMasterOverrideChanges(
int oldFlags = wmPtr->flags;
unsigned long styleMask;
NSRect structureRect;
+ NSWindow *parentWindow;
if (!macWindow && winPtr->window != None &&
TkMacOSXHostToplevelExists(winPtr)) {
@@ -6667,7 +6823,6 @@ ApplyMasterOverrideChanges(
}
}
if (macWindow) {
- NSWindow *parentWindow = [macWindow parentWindow];
structureRect = [NSWindow frameRectForContentRect:NSZeroRect
styleMask:styleMask];
@@ -6686,7 +6841,7 @@ ApplyMasterOverrideChanges(
if (wmPtr->hints.initial_state == NormalState) {
[macWindow orderFront:nil];
}
- if (wmPtr->master != None) {
+ if (wmPtr->master != NULL) {
wmPtr->flags |= WM_TOPMOST;
} else {
wmPtr->flags &= ~WM_TOPMOST;
@@ -6702,29 +6857,47 @@ ApplyMasterOverrideChanges(
wmPtr->flags &= ~WM_TOPMOST;
}
if (wmPtr->master != None) {
- TkDisplay *dispPtr = TkGetDisplayList();
- TkWindow *masterWinPtr = (TkWindow *)
- Tk_IdToWindow(dispPtr->display, wmPtr->master);
-
+ TkWindow *masterWinPtr = (TkWindow *)wmPtr->master;
if (masterWinPtr && masterWinPtr->window != None &&
TkMacOSXHostToplevelExists(masterWinPtr)) {
- NSWindow *masterMacWin =
- TkMacOSXDrawableWindow(masterWinPtr->window);
+ NSWindow *masterMacWin = TkMacOSXDrawableWindow(
+ masterWinPtr->window);
- if (masterMacWin && masterMacWin != parentWindow &&
- (winPtr->flags & TK_MAPPED)) {
- if (parentWindow) {
+ /*
+ * Try to add the transient window as a child window of the
+ * master. A child NSWindow retains its relative position with
+ * respect to the parent when the parent is moved. This is
+ * pointless if the parent is offscreen, and adding a child to
+ * an offscreen window causes the parent to be displayed as a
+ * zombie. So we only do this if the parent is visible.
+ */
+
+ if (masterMacWin &&
+ [masterMacWin isVisible] &&
+ (winPtr->flags & TK_MAPPED)) {
+
+ /*
+ * If the transient is already a child of some other window,
+ * remove it.
+ */
+
+ parentWindow = [macWindow parentWindow];
+ if (parentWindow && parentWindow != masterMacWin) {
[parentWindow removeChildWindow:macWindow];
}
+
[masterMacWin addChildWindow:macWindow
- ordered:NSWindowAbove];
- if (wmPtr->flags & WM_TOPMOST) {
- [macWindow setLevel:kCGUtilityWindowLevel];
+ ordered:NSWindowAbove];
}
- }
}
- } else if (parentWindow) {
- [parentWindow removeChildWindow:macWindow];
+ } else {
+ parentWindow = [macWindow parentWindow];
+ if (parentWindow) {
+ [parentWindow removeChildWindow:macWindow];
+ }
+ }
+ if (wmPtr->flags & WM_TOPMOST) {
+ [macWindow setLevel:kCGUtilityWindowLevel];
}
ApplyWindowAttributeFlagChanges(winPtr, macWindow, oldAttributes,
oldFlags, 0, 0);
diff --git a/macosx/tkMacOSXWm.h b/macosx/tkMacOSXWm.h
index 43f1a7a..20bbb6d 100644
--- a/macosx/tkMacOSXWm.h
+++ b/macosx/tkMacOSXWm.h
@@ -36,6 +36,17 @@ typedef struct ProtocolHandler {
* THE LAST FIELD OF THE STRUCTURE. */
} ProtocolHandler;
+/* The following data structure is used in the TkWmInfo to maintain a list of all of the
+ * transient windows belonging to a given master.
+ */
+
+typedef struct Transient {
+ TkWindow *winPtr;
+ int flags;
+ struct Transient *nextPtr;
+} Transient;
+
+#define WITHDRAWN_BY_MASTER 0x1
/*
* A data structure of the following type holds window-manager-related
@@ -54,7 +65,7 @@ typedef struct TkWmInfo {
Tk_Uid titleUid; /* Title to display in window caption. If NULL,
* use name of widget. */
char *iconName; /* Name to display in icon. */
- Window master; /* Master window for TRANSIENT_FOR property, or
+ Tk_Window master; /* Master window for TRANSIENT_FOR property, or
* None. */
XWMHints hints; /* Various pieces of information for window
* manager. */
@@ -62,14 +73,13 @@ typedef struct TkWmInfo {
* (corresponds to hints.window_group).
* Malloc-ed. Note: this field doesn't get
* updated if leader is destroyed. */
- char *masterWindowName; /* Path name of window specified as master in
- * "wm transient" command, or NULL. Malloc-ed.
- * Note: this field doesn't get updated if
- * masterWindowName is destroyed. */
Tk_Window icon; /* Window to use as icon for this window, or
* NULL. */
Tk_Window iconFor; /* Window for which this window is icon, or
* NULL if this isn't an icon for anyone. */
+ Transient *transientPtr; /* First item in a list of all transient windows
+ * belonging to this window, or NULL if there
+ * are no transients. */
/*
* Information used to construct an XSizeHints structure for the window
diff --git a/macosx/tkMacOSXXStubs.c b/macosx/tkMacOSXXStubs.c
index 9c8ea68..bd9efa7 100644
--- a/macosx/tkMacOSXXStubs.c
+++ b/macosx/tkMacOSXXStubs.c
@@ -225,6 +225,12 @@ TkpOpenDisplay(
bzero(gMacDisplay, sizeof(TkDisplay));
gMacDisplay->display = display;
[pool drain];
+
+ /*
+ * Key map info must be available immediately, because of "send event".
+ */
+ TkpInitKeymapInfo(gMacDisplay);
+
return gMacDisplay;
}
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 4b2e3cf..eba3355 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1754,6 +1754,39 @@ test imgPhoto-14.5 {Bug [fbaed1f66b] - GIF decoder with deferred clear code} -se
image create photo -file $fileName -format "gif -index 2"
} -returnCodes error -result {no image data for this index}
+test imgPhoto-14.6 {Access Subimage after Subimage with buffer overflow. Ticket 4da2191b} -setup {
+ set data {
+ R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM
+ hASs3MTcjAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMDAwP8AAAD/
+ AP//AAAA//8A/wD//////ywAAAAAYwA5AAAI/wAZCBxIsKDBgwgTKlzIsKHD
+ hxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJsqXLlzBjypxJs6bN
+ mzhz6tzJs6fPn0CDCh1KtKhRiwoSKEXAtGlTpUqPGkyagOmCq1edNsWalWkC
+ BUSXIuDqFepBqFWtZv3KU+zYrkrBSqT6dgECtjOTbu16NwFHvV3lshRLti/J
+ qlgRCE6ZuO9ik4Dt+k0ZVyZiyVIvXr77ODPEy5g9T4zMWfTEzXdNz1VbWvXn
+ uqldP1TAOrbshqBb314Y2W7n3Qdpv7UNPCHpycUVbv6dnODy5sqzQldIe8H0
+ hciva9/Ovbv37+BzBgE7ACH5BAFkAAMALAAAAAAEAAQAAAMEKLrckgA7
+ }
+} -body {
+ image create photo photo1 -data $data -format "GIF -index 1"
+} -cleanup {
+ catch {image delete photo1}
+} -result photo1
+
test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constraints {
nonPortable
} -body {
diff --git a/tests/menu.test b/tests/menu.test
index 7101e21..87d8a9e 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -1614,7 +1614,7 @@ test menu-3.47 {MenuWidgetCmd procedure, "post" option} -setup {
.m1 post
} -cleanup {
destroy .m1
-} -returnCodes error -result {wrong # args: should be ".m1 post x y"}
+} -returnCodes error -result {wrong # args: should be ".m1 post x y ?index?"}
test menu-3.48 {MenuWidgetCmd procedure, "post" option} -setup {
destroy .m1
} -body {
diff --git a/tests/menubut.test b/tests/menubut.test
index d7ff2e3..a9d0656 100644
--- a/tests/menubut.test
+++ b/tests/menubut.test
@@ -542,7 +542,11 @@ test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} -setup {
deleteWindows
} -result {{} {}}
-
+if {[tk windowingsystem] == "aqua"} {
+ set extraWidth 36
+} else {
+ set extraWidth 0
+}
test menubutton-7.1 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
} -setup {
@@ -555,33 +559,33 @@ test menubutton-7.1 {ComputeMenuButtonGeometry procedure} -constraints {
} -cleanup {
deleteWindows
imageCleanup
-} -result {38 23}
+} -result [list [expr {38 + $extraWidth}] 23]
test menubutton-7.2 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
} -setup {
deleteWindows
image create test image1
} -body {
- menubutton .mb -image image1 -bd 1 -highlightthickness 2
+ menubutton .mb -image image1 -bd 3 -highlightthickness 1
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
imageCleanup
-} -result {36 21}
+} -result [list [expr {38 + $extraWidth}] 23]
test menubutton-7.3 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
} -setup {
deleteWindows
image create test image1
} -body {
- menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5
+ menubutton .mb -image image1 -bd 1 -highlightthickness 3 -padx 5 -pady 5
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
imageCleanup
-} -result {34 19}
+} -result [list [expr {38 + $extraWidth}] 23]
test menubutton-7.4 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
} -setup {
@@ -595,7 +599,7 @@ test menubutton-7.4 {ComputeMenuButtonGeometry procedure} -constraints {
} -cleanup {
deleteWindows
imageCleanup
-} -result {48 23}
+} -result [list [expr {48 + $extraWidth}] 23]
test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints {
testImageType
} -setup {
@@ -609,7 +613,7 @@ test menubutton-7.5 {ComputeMenuButtonGeometry procedure} -constraints {
} -cleanup {
deleteWindows
imageCleanup
-} -result {38 38}
+} -result [list [expr {38 + $extraWidth}] 38]
test menubutton-7.6 {ComputeMenuButtonGeometry procedure} -setup {
deleteWindows
} -body {
@@ -619,7 +623,7 @@ test menubutton-7.6 {ComputeMenuButtonGeometry procedure} -setup {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
-} -result {25 35}
+} -result [list [expr {25 + $extraWidth}] 35]
test menubutton-7.7 {ComputeMenuButtonGeometry procedure} -setup {
deleteWindows
} -body {
@@ -629,7 +633,7 @@ test menubutton-7.7 {ComputeMenuButtonGeometry procedure} -setup {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
-} -result {46 33}
+} -result [list [expr {46 + $extraWidth}] 33]
test menubutton-7.8 {ComputeMenuButtonGeometry procedure} -setup {
deleteWindows
} -body {
@@ -639,7 +643,7 @@ test menubutton-7.8 {ComputeMenuButtonGeometry procedure} -setup {
list [winfo reqwidth .mb] [winfo reqheight .mb]
} -cleanup {
deleteWindows
-} -result {23 56}
+} -result [list [expr {23 + $extraWidth}] 56]
test menubutton-7.9 {ComputeMenuButtonGeometry procedure} -constraints {
fonts
} -setup {
diff --git a/tests/scale.test b/tests/scale.test
index d22c4c3..e9dbc65 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -1104,78 +1104,78 @@ test scale-13.6 {SetScaleValue procedure} -body {
destroy .s
pack [scale .s]
update
-test scale-14.1 {RoundToResolution procedure} -body {
+test scale-14.1 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 84 152
} -result 72
-test scale-14.2 {RoundToResolution procedure} -body {
+test scale-14.2 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 86 152
} -result 76
-test scale-14.3 {RoundToResolution procedure} -body {
+test scale-14.3 {RoundValueToResolution procedure} -body {
.s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 84 152
} -result 28
-test scale-14.4 {RoundToResolution procedure} -body {
+test scale-14.4 {RoundValueToResolution procedure} -body {
.s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 86 152
} -result 24
-test scale-14.5 {RoundToResolution procedure} -body {
+test scale-14.5 {RoundValueToResolution procedure} -body {
.s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 84 152
} -result {-28}
-test scale-14.6 {RoundToResolution procedure} -body {
+test scale-14.6 {RoundValueToResolution procedure} -body {
.s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 86 152
} -result {-24}
-test scale-14.7 {RoundToResolution procedure} -body {
+test scale-14.7 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 84 152
} -result {-72}
-test scale-14.8 {RoundToResolution procedure} -body {
+test scale-14.8 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 4.0
update
.s get 86 152
} -result {-76}
-test scale-14.9 {RoundToResolution procedure} -body {
+test scale-14.9 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 0
update
.s get 84 152
} -result {1.64}
-test scale-14.10 {RoundToResolution procedure} -body {
+test scale-14.10 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 0
update
.s get 86 152
} -result {1.69}
-test scale-14.11 {RoundToResolution procedure} -body {
+test scale-14.11 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 0 -digits 5
update
.s get 84 152
} -result {164.25}
-test scale-14.12 {RoundToResolution procedure} -body {
+test scale-14.12 {RoundValueToResolution procedure} -body {
.s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
-orient horizontal -resolution 0 -digits 5
update
@@ -1183,6 +1183,41 @@ test scale-14.12 {RoundToResolution procedure} -body {
} -result {168.75}
destroy .s
+test scale-14.13 {RoundValueToResolution procedure, round-off errors} -setup {
+ # see [220665ffff], and duplicates [220265ffff] and [779559ffff]
+ set x NotSet
+ pack [scale .s -orient horizontal -resolution .1 -from -180 -to 180 -command "set x"]
+ update
+} -body {
+ .s configure -background red
+ update
+ set x
+} -cleanup {
+ destroy .s
+} -result {NotSet}
+
+test scale-14a.1 {RoundValueToResolution, RoundIntervalToResolution procedures} -setup {
+ pack [scale .s -orient horizontal]
+ update
+} -body {
+ .s configure -length 400 -bd 0 -from 1 -to 9 -resolution 2 -tickinterval 1
+ update
+ .s get 200 0
+} -cleanup {
+ destroy .s
+} -result {5}
+test scale-14a.2 {RoundValueToResolution, RoundIntervalToResolution procedures} -setup {
+ pack [scale .s -orient horizontal]
+ update
+} -body {
+ .s configure -length 400 -bd 0 -from -1.5 -to 1.5 -resolution 1 \
+ -tickinterval 1 -digits 2
+ update
+ .s get 250 0
+} -cleanup {
+ destroy .s
+} -result {0.5}
+
test scale-15.1 {ScaleVarProc procedure} -setup {
deleteWindows
diff --git a/tests/send.test b/tests/send.test
index 945d4d0..403a207 100644
--- a/tests/send.test
+++ b/tests/send.test
@@ -197,7 +197,8 @@ test send-7.4 {Tk_SetAppName procedure, name in use} {secureserver testsend} {
list [tk appname foo] [testsend prop root InterpRegistry]
} "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}"
-test send-8.1 {Tk_SendCmd procedure, options} {secureserver} {
+#macOS does not send to other processes
+test send-8.1 {Tk_SendCmd procedure, options} {secureserver notAqua} {
setupbg
set app [dobg {tk appname}]
set a 66
@@ -222,10 +223,11 @@ test send-8.2 {Tk_SendCmd procedure, options} {secureserver altDisplay} {
cleanupbg
set result
} {altDisplay homeDisplay}
-test send-8.3 {Tk_SendCmd procedure, options} {secureserver} {
+# Since macOS has no registry of interpreters, 8.3, 8.4 and 8.10 will fail.
+test send-8.3 {Tk_SendCmd procedure, options} {secureserver notAqua} {
list [catch {send -- -async foo bar baz} msg] $msg
} {1 {no application named "-async"}}
-test send-8.4 {Tk_SendCmd procedure, options} {secureserver} {
+test send-8.4 {Tk_SendCmd procedure, options} {secureserver notAqua} {
list [catch {send -gorp foo bar baz} msg] $msg
} {1 {no application named "-gorp"}}
test send-8.5 {Tk_SendCmd procedure, options} {secureserver} {
@@ -253,7 +255,7 @@ test send-8.9 {Tk_SendCmd procedure, local execution} {secureserver} {
"open bad_file"
invoked from within
"send [tk appname] open bad_file"} {posix enoent {no such file or directory}}}
-test send-8.10 {Tk_SendCmd procedure, no such interpreter} {secureserver} {
+test send-8.10 {Tk_SendCmd procedure, no such interpreter} {secureserver notAqua} {
list [catch {send bogus_name bogus_command} msg] $msg
} {1 {no application named "bogus_name"}}
@@ -542,7 +544,8 @@ test send-12.1 {TimeoutProc procedure} {secureserver testsend} {
catch {testsend prop root InterpRegistry ""}
-test send-12.2 {TimeoutProc procedure} {secureserver} {
+#macOS does not send to other processes
+test send-12.2 {TimeoutProc procedure} {secureserver notAqua} {
winfo interps
tk appname tktest
update
@@ -557,16 +560,17 @@ test send-12.2 {TimeoutProc procedure} {secureserver} {
set result
} {1 {target application died}}
+#macOS does not send to other processes
winfo interps
tk appname tktest
-test send-13.1 {DeleteProc procedure} {secureserver} {
+test send-13.1 {DeleteProc procedure} {secureserver notAqua} {
setupbg
set app [dobg {rename send {}; tk appname}]
set result [list [catch {send $app foo} msg] $msg [winfo interps]]
cleanupbg
set result
} {1 {no application named "tktest #2"} tktest}
-test send-13.2 {DeleteProc procedure} {secureserver} {
+test send-13.2 {DeleteProc procedure} {secureserver notAqua} {
winfo interps
tk appname tktest
rename send {}
diff --git a/tests/text.test b/tests/text.test
index 5359407..3314fc9 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -3486,6 +3486,12 @@ test text-14.18 {ConfigureText procedure} -constraints fonts -setup {
# minimum size and it was interfering with the size requested by the -setgrid.
# The "overrideredirect" gets rid of the titlebar so the toplevel can shrink
# to the appropriate size.
+# On macOS, however, there is no way to make the window overlap the menubar.
+if {[tk windowingsystem] == "aqua"} {
+ set minY 23
+} else {
+ set minY 0
+}
test text-14.19 {ConfigureText procedure} -setup {
toplevel .top
text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2
@@ -3493,16 +3499,17 @@ test text-14.19 {ConfigureText procedure} -setup {
.top.t configure -width 20 -height 10 -setgrid 1
wm overrideredirect .top 1
pack .top.t
- wm geometry .top +0+0
+ wm geometry .top +0+$minY
update
wm geometry .top
} -cleanup {
destroy .top
-} -result {20x10+0+0}
+} -result "20x10+0+$minY"
# This test was failing on Windows because the title bar on .t was a certain
# minimum size and it was interfering with the size requested by the -setgrid.
# The "overrideredirect" gets rid of the titlebar so the toplevel can shrink
# to the appropriate size.
+# On macOS we again use minY as a workaround.
test text-14.20 {ConfigureText procedure} -setup {
toplevel .top
text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2
@@ -3510,7 +3517,7 @@ test text-14.20 {ConfigureText procedure} -setup {
.top.t configure -width 20 -height 10 -setgrid 1
wm overrideredirect .top 1
pack .top.t
- wm geometry .top +0+0
+ wm geometry .top +0+$minY
update
set result [wm geometry .top]
wm geometry .top 15x8
@@ -3521,7 +3528,7 @@ test text-14.20 {ConfigureText procedure} -setup {
lappend result [wm geometry .top]
} -cleanup {
destroy .top
-} -result {20x10+0+0 15x8+0+0 15x8+0+0}
+} -result "20x10+0+$minY 15x8+0+$minY 15x8+0+$minY"
test text-15.1 {TextWorldChanged procedure, spacing options} -constraints {
diff --git a/tests/unixButton.test b/tests/unixButton.test
index 36064f9..f0dcde5 100644
--- a/tests/unixButton.test
+++ b/tests/unixButton.test
@@ -35,7 +35,15 @@ proc bogusTrace args {
error "trace aborted"
}
-
+if {[tk windowingsystem] eq "aqua"} {
+ set smallIndicator 20
+ set bigIndicator 20
+ set defaultBorder 10
+} else {
+ set smallIndicator 27
+ set bigIndicator 40
+ set defaultBorder 20
+}
test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints {
unix testImageType
} -setup {
@@ -57,7 +65,10 @@ test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints {
} -cleanup {
deleteWindows
image delete image1
-} -result {68 48 74 54 112 52 112 52}
+} -result [list 68 48 \
+ 74 54 \
+ [expr {72 + $bigIndicator}] 52 \
+ [expr {72 + $bigIndicator}] 52]
test unixbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
@@ -75,7 +86,10 @@ test unixbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints {
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
-} -result {23 33 29 39 54 37 54 37}
+} -result [list 23 33 \
+ 29 39 \
+ [expr {27 + $smallIndicator}] 37 \
+ [expr {27 + $smallIndicator}] 37]
test unixbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
@@ -186,7 +200,7 @@ test unixbutton-1.9 {TkpComputeButtonGeometry procedure} -constraints {
list [winfo reqwidth .b2] [winfo reqheight .b2]
} -cleanup {
deleteWindows
-} -result {37 47}
+} -result [list [expr {17 + $defaultBorder}] [expr {27 + $defaultBorder}]]
test unixbutton-1.10 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
@@ -196,7 +210,7 @@ test unixbutton-1.10 {TkpComputeButtonGeometry procedure} -constraints {
list [winfo reqwidth .b2] [winfo reqheight .b2]
} -cleanup {
deleteWindows
-} -result {37 47}
+} -result [list [expr {17 + $defaultBorder}] [expr {27 + $defaultBorder}]]
test unixbutton-1.11 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
index 9916df2..99f7265 100644
--- a/tests/unixEmbed.test
+++ b/tests/unixEmbed.test
@@ -11,6 +11,37 @@ eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
+namespace eval ::_test_tmp {}
+
+# ------------------------------------------------------------------------------
+# Proc ::_test_tmp::testInterp
+# ------------------------------------------------------------------------------
+# Command that creates an unsafe child interpreter and tries to load Tk.
+# This code is borrowed from safePrimarySelection.test
+# This is necessary for loading Tktest if the tests are done in the build
+# directory without installing Tk. In that case the usual auto_path loading
+# mechanism cannot work because the tk binary is not where pkgIndex.tcl says
+# it is.
+# ------------------------------------------------------------------------------
+
+namespace eval ::_test_tmp {
+ variable TkLoadCmd
+}
+
+foreach pkg [info loaded] {
+ if {[lindex $pkg 1] eq "Tk"} {
+ set ::_test_tmp::TkLoadCmd [list load {*}$pkg]
+ break
+ }
+}
+
+proc ::_test_tmp::testInterp {name} {
+ variable TkLoadCmd
+ interp create $name
+ $name eval [list set argv [list -name $name]]
+ catch {{*}$TkLoadCmd $name}
+}
+
setupbg
dobg {wm withdraw .}
@@ -97,7 +128,7 @@ test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} -constraints {
} -result {1}
test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
@@ -113,8 +144,29 @@ test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} -constra
} -cleanup {
deleteWindows
} -result {{{XXX {} {} .t}} 0}
+test unixEmbed-1.5a {TkpUseWindow procedure, creating Container records} -constraints {
+ unix testembed
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ pack .f1 .f2
+ slave alias w winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t -use [w]
+ list [testembed] [expr {[lindex [lindex [testembed all] 0] 0] - [w]}]
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{{XXX {} {} .t}} 0}
test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
@@ -132,6 +184,29 @@ test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} -constra
} -cleanup {
deleteWindows
} -result {{XXX {} {} .t2} {XXX {} {} .t1}}
+test unixEmbed-1.6a {TkpUseWindow procedure, creating Container records} -constraints {
+ unix testembed
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ pack .f1 .f2
+ slave alias w1 winfo id .f1
+ slave alias w2 winfo id .f2
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ toplevel .t2 -use [w2]
+ testembed
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{XXX {} {} .t2} {XXX {} {} .t1}}
test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} -constraints {
unix testembed
} -setup {
@@ -152,7 +227,7 @@ test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app}
test unixEmbed-2.1 {EmbeddedEventProc procedure} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
@@ -172,8 +247,32 @@ test unixEmbed-2.1 {EmbeddedEventProc procedure} -constraints {
} -cleanup {
deleteWindows
} -result {}
+test unixEmbed-2.1a {EmbeddedEventProc procedure} -constraints {
+ unix testembed
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ testembed
+ }
+ destroy .f1
+ update
+ slave eval {
+ testembed
+ }
+} -cleanup {
+ deleteWindows
+} -result {}
test unixEmbed-2.2 {EmbeddedEventProc procedure} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
@@ -190,8 +289,30 @@ test unixEmbed-2.2 {EmbeddedEventProc procedure} -constraints {
} -cleanup {
deleteWindows
} -result {}
+test unixEmbed-2.2a {EmbeddedEventProc procedure} -constraints {
+ unix testembed
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ testembed
+ destroy .t1
+ testembed
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {}
test unixEmbed-2.3 {EmbeddedEventProc procedure} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
@@ -207,21 +328,20 @@ test unixEmbed-2.4 {EmbeddedEventProc procedure} -constraints {
} -setup {
deleteWindows
} -body {
- frame .f1 -container 1 -width 200 -height 50
- pack .f1
+ pack [frame .f1 -container 1 -width 200 -height 50]
toplevel .t1 -use [winfo id .f1]
+ set x [testembed]
update
destroy .t1
- set x [testembed]
update
- list $x [testembed]
+ list $x [winfo exists .t1] [winfo exists .f1] [testembed]
} -cleanup {
deleteWindows
-} -result {{{XXX .f1 {} {}}} {}}
+} -result "{{XXX .f1 {} .t1}} 0 0 {}"
test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} -constraints {
- unix testembed nonPortable
+ unix testembed notPortable
} -body {
frame .f1 -container 1 -width 200 -height 50
pack .f1
@@ -236,10 +356,32 @@ test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} -constraints
} -cleanup {
deleteWindows
} -result {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}}
+test unixEmbed-3.1a {ContainerEventProc procedure, detect creation} -constraints {
+ unix testembed
+} -setup {
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ set x [testembed]
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ wm withdraw .t1
+ }
+ list $x [testembed]
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{{XXX .f1 {} {}}} {{XXX .f1 {} {}}}}
test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} -constraints {
unix
} -setup {
deleteWindows
+ update
} -body {
toplevel .t1 -container 1
wm geometry .t1 +0+0
@@ -250,7 +392,7 @@ test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} -constra
deleteWindows
} -result {200x200+0+0}
test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -270,8 +412,31 @@ test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} -co
} -cleanup {
deleteWindows
} -result {200x200+0+0}
+test unixEmbed-3.3a {ContainerEventProc procedure, disallow position changes} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1] -bd 2 -relief raised
+ update
+ wm geometry .t1 +30+40
+ update
+ wm geometry .t1
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {200x200+0+0}
test unixEmbed-3.4 {ContainerEventProc procedure, disallow position changes} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -291,8 +456,31 @@ test unixEmbed-3.4 {ContainerEventProc procedure, disallow position changes} -co
} -cleanup {
deleteWindows
} -result {300x100+0+0}
+test unixEmbed-3.4a {ContainerEventProc procedure, disallow position changes} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ update
+ wm geometry .t1 300x100+30+40
+ update
+ wm geometry .t1
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {300x100+0+0}
test unixEmbed-3.5 {ContainerEventProc procedure, geometry requests} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -312,8 +500,30 @@ test unixEmbed-3.5 {ContainerEventProc procedure, geometry requests} -constraint
} -cleanup {
deleteWindows
} -result {300 80 300x80+0+0}
+test unixEmbed-3.5a {ContainerEventProc procedure, geometry requests} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ .t1 configure -width 300 -height 80
+ update
+ }
+ list [winfo width .f1] [winfo height .f1] [slave eval {wm geometry .t1}]
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {300 80 300x80+0+0}
test unixEmbed-3.6 {ContainerEventProc procedure, map requests} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -335,8 +545,33 @@ test unixEmbed-3.6 {ContainerEventProc procedure, map requests} -constraints {
} -cleanup {
deleteWindows
} -result {mapped}
+test unixEmbed-3.6a {ContainerEventProc procedure, map requests} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ set x unmapped
+ bind .t1 <Map> {set x mapped}
+ update
+ after 100
+ update
+ set x
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {mapped}
test unixEmbed-3.7 {ContainerEventProc procedure, destroy events} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -358,10 +593,34 @@ test unixEmbed-3.7 {ContainerEventProc procedure, destroy events} -constraints {
} -cleanup {
deleteWindows
} -result {dead 0}
-
+test unixEmbed-3.7a {ContainerEventProc procedure, destroy events} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ bind .f1 <Destroy> {set x dead}
+ set x alive
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ update
+ destroy .t1
+ }
+ update
+ list $x [winfo exists .f1]
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {dead 0}
test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -383,8 +642,31 @@ test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} -constraints
} -cleanup {
deleteWindows
} -result {180x100+0+0}
+test unixEmbed-4.1a {EmbedStructureProc procedure, configure events} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ update
+ .t1 configure -width 180 -height 100
+ update
+ winfo geometry .t1
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {180x100+0+0}
test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
@@ -398,14 +680,38 @@ test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} -constraints {
update
set x [testembed]
destroy .f1
+ update
list $x [testembed]
} -cleanup {
deleteWindows
} -result {{{XXX .f1 XXX {}}} {}}
+test unixEmbed-4.2a {EmbedStructureProc procedure, destroy events} -constraints {
+ unix testembed
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ update
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ }
+ set x [testembed]
+ destroy .f1
+ list $x [testembed]
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result "{{XXX .f1 {} {}}} {}"
test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -425,8 +731,34 @@ test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} -constraints {
} -cleanup {
deleteWindows
} -result {{focus in .t1}}
+test unixEmbed-5.1a {EmbedFocusProc procedure, FocusIn events} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ bind .t1 <FocusIn> {lappend x "focus in %W"}
+ bind .t1 <FocusOut> {lappend x "focus out %W"}
+ update
+ set x {}
+ }
+ focus -force .f1
+ update
+ slave eval {set x}
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{focus in .t1}}
test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -447,8 +779,32 @@ test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} -constrai
} -cleanup {
deleteWindows
} -result {}
+test unixEmbed-5.2a {EmbedFocusProc procedure, focusing on dead window} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ update
+ after 200 {destroy .t1}
+ }
+ after 400
+ focus -force .f1
+ update
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {}
test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -471,10 +827,39 @@ test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} -constraints {
} -cleanup {
deleteWindows
} -result {{{focus in .t1}} {{focus in .t1} {focus out .t1}}}
+test unixEmbed-5.3a {EmbedFocusProc procedure, FocusOut events} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ set x {}
+ bind .t1 <FocusIn> {lappend x "focus in %W"}
+ bind .t1 <FocusOut> {lappend x "focus out %W"}
+ update
+ }
+ focus -force .f1
+ update
+ set x [slave eval {update; set x }]
+ focus .
+ update
+ list $x [slave eval {update; set x}]
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{{focus in .t1}} {{focus in .t1} {focus out .t1}}}
test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -484,9 +869,7 @@ test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} -constr
dobg {
eval destroy [winfo child .]
toplevel .t1 -use $w1
- }
- update
- dobg {
+ update
bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
set x {}
.t1 configure -width 300 -height 120
@@ -496,8 +879,33 @@ test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} -constr
} -cleanup {
deleteWindows
} -result {{{configure .t1 300 120}} 300x120+0+0}
+test unixEmbed-6.1a {EmbedGeometryRequest procedure, window changes size} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ update
+ bind .t1 <Configure> {set x {configure .t1 %w %h}}
+ set x {}
+ .t1 configure -width 300 -height 120
+ update
+ list $x [winfo geom .t1]
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{configure .t1 300 120} 300x120+0+0}
test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -507,25 +915,47 @@ test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} -constr
dobg {
eval destroy [winfo child .]
toplevel .t1 -use $w1
- }
- after 300 {set x done}
- vwait x
- dobg {
+ update
bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
set x {}
.t1 configure -width 300 -height 120
- update
+ update
list $x [winfo geom .t1]
}
} -cleanup {
deleteWindows
} -result {{{configure .t1 200 200}} 200x200+0+0}
+test unixEmbed-6.2a {EmbedGeometryRequest procedure, window changes size} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ place .f1 -width 200 -height 200
+ update
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ update
+ bind .t1 <Configure> {set x {configure .t1 %w %h}}
+ set x {}
+ .t1 configure -width 300 -height 120
+ update
+ list $x [winfo geom .t1]
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{configure .t1 200 200} 200x200+0+0}
# Can't think up any tests for TkpGetOtherWindow procedure.
-
test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -553,8 +983,41 @@ test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} -constrain
deleteWindows
bind . <KeyPress> {}
} -result {{{key a 1}} {}}
+test unixEmbed-7.1a {TkpRedirectKeyEvent procedure, forward keystroke} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ deleteWindows
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ }
+ focus -force .
+ bind . <KeyPress> {lappend x {key %A %E}}
+ set x {}
+ set y [slave eval {
+ update
+ bind .t1 <KeyPress> {lappend y {key %A}}
+ set y {}
+ event generate .t1 <KeyPress> -keysym a
+ set y
+ }]
+ update
+ list $x $y
+} -cleanup {
+ interp delete slave
+ deleteWindows
+ bind . <KeyPress> {}
+} -result {{{key a 1}} {}}
test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} -constraints {
- unix
+ unix notAqua
} -setup {
deleteWindows
} -body {
@@ -583,9 +1046,44 @@ test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width
deleteWindows
bind . <KeyPress> {}
} -result {{} {{key b}}}
+test unixEmbed-7.2a {TkpRedirectKeyEvent procedure, don't forward keystroke width} -constraints {
+ unix
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1]
+ }
+ update
+ focus -force .f1
+ update
+ bind . <KeyPress> {lappend x {key %A}}
+ set x {}
+ set y [slave eval {
+ update
+ bind .t1 <KeyPress> {lappend y {key %A}}
+ set y {}
+ event generate .t1 <KeyPress> -keysym b
+ set y
+ }]
+ update
+ list $x $y
+} -cleanup {
+ interp delete slave
+ deleteWindows
+ bind . <KeyPress> {}
+} -result {{} {{key b}}}
-
-test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints unix -setup {
+test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints {
+ unix notAqua
+} -setup {
deleteWindows
} -body {
frame .f1 -container 1 -width 200 -height 50
@@ -609,15 +1107,44 @@ test unixEmbed-8.1 {TkpClaimFocus procedure} -constraints unix -setup {
} -cleanup {
deleteWindows
} -result {{{} .t1} .f1}
-test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup {
- deleteWindows
- catch {interp delete child}
+test unixEmbed-8.1a {TkpClaimFocus procedure} -constraints unix -setup {
deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
} -body {
frame .f1 -container 1 -width 200 -height 50
frame .f2 -width 200 -height 50
pack .f1 .f2
+ update
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1] -highlightthickness 2 -bd 2 -relief sunken
+ }
+ # This should clear focus from the application embedded in .f1
+ focus -force .f2
+ update
+ list [slave eval {
+ set x [list [focus]]
+ focus .t1
+ update
+ lappend x [focus]
+ }] [focus]
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{{} .t1} .f1}
+test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup {
+ deleteWindows
+ catch {interp delete child}
interp create child
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -width 200 -height 50
+ pack .f1 .f2
+ update
+ set w1 [winfo id .f1]
child eval "set argv {-use [winfo id .f1]}"
load {} Tk child
child eval {
@@ -636,7 +1163,6 @@ test unixEmbed-8.2 {TkpClaimFocus procedure} -constraints unix -setup {
} -result {{{} .} .f1}
catch {interp delete child}
-
test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} -constraints {
unix testembed
} -setup {
@@ -658,12 +1184,13 @@ test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} -constraints
deleteWindows
} -result {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} -constraints {
- unix testembed
+ unix testembed notAqua
} -setup {
deleteWindows
} -body {
frame .f1 -container 1 -width 200 -height 50
pack .f1
+ update
dobg "set w1 [winfo id .f1]"
dobg {
eval destroy [winfo child .]
@@ -676,6 +1203,29 @@ test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} -constraint
} -cleanup {
deleteWindows
} -result {{{XXX {} {} .t1}} {}}
+test unixEmbed-9.2a {EmbedWindowDeleted procedure, check embeddedPtr} -constraints {
+ unix testembed
+} -setup {
+ deleteWindows
+ catch {interp delete slave}
+ ::_test_tmp::testInterp slave
+ load {} Tktest slave
+} -body {
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ slave alias w1 winfo id .f1
+ slave eval {
+ destroy [winfo child .]
+ toplevel .t1 -use [w1] -highlightthickness 2 -bd 2 -relief sunken
+ set x {}
+ lappend x [testembed]
+ destroy .t1
+ lappend x [testembed]
+ }
+} -cleanup {
+ interp delete slave
+ deleteWindows
+} -result {{{XXX {} {} .t1}} {}}
test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -constraints {
@@ -685,6 +1235,7 @@ test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} -con
} -body {
frame .f1 -container 1 -width 200 -height 50
pack .f1
+ update
toplevel .t1 -use [winfo id .f1] -width 150 -height 80
update
wm geometry .t1 +40+50
@@ -714,4 +1265,3 @@ deleteWindows
cleanupbg
cleanupTests
return
-
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 826cd72..28c8159 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -40,8 +40,23 @@ proc makeToplevels {} {
}
}
+# On macOS windows are not allowed to overlap the menubar at the top
+# of the screen. So tests which move a window and then check whether
+# it got moved to the requested location should use a y coordinate
+# larger than the height of the menubar (normally 23 pixels).
+
+if {[tk windowingsystem] eq "aqua"} {
+ set Y0 23
+ set Y2 25
+ set Y5 28
+} else {
+ set Y0 0
+ set Y2 2
+ set Y5 5
+}
+
set i 1
-foreach geom {+20+80 +80+20 +0+0} {
+foreach geom "+23+80 +80+23 +0+$Y0" {
destroy .t
test unixWm-1.$i {initial window position} unix {
toplevel .t -width 200 -height 150
@@ -67,7 +82,7 @@ update
scan [wm geom .t] %dx%d+%d+%d width height x y
set xerr [expr 150-$x]
set yerr [expr 150-$y]
-foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
+foreach geom "+20+80 +80+23 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" {
test unixWm-2.$i {moving window while mapped} unix {
wm geom .t $geom
update
@@ -79,7 +94,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
}
set i 1
-foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
+foreach geom "+20+80 +80+23 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" {
test unixWm-3.$i {moving window while iconified} unix {
wm iconify .t
sleep 200
@@ -95,7 +110,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
}
set i 1
-foreach geom {+20+80 +100+40 +0+0} {
+foreach geom "+20+80 +100+40 +0+$Y0" {
test unixWm-4.$i {moving window while withdrawn} unix {
wm withdraw .t
sleep 200
@@ -179,27 +194,27 @@ test unixWm-5.7 {compounded state changes} {unix nonPortable} {
destroy .t
toplevel .t -width 200 -height 100
-wm geom .t +10+10
+wm geom .t +10+23
wm minsize .t 1 1
update
test unixWm-6.1 {size changes} unix {
.t config -width 180 -height 150
update
wm geom .t
-} 180x150+10+10
+} 180x150+10+23
test unixWm-6.2 {size changes} unix {
wm geom .t 250x60
.t config -width 170 -height 140
update
wm geom .t
-} 250x60+10+10
+} 250x60+10+23
test unixWm-6.3 {size changes} unix {
wm geom .t 250x60
.t config -width 170 -height 140
wm geom .t {}
update
wm geom .t
-} 170x140+10+10
+} 170x140+10+23
test unixWm-6.4 {size changes} {unix nonPortable userInteraction} {
wm minsize .t 1 1
update
@@ -1357,14 +1372,14 @@ test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on gr
test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix {
destroy .t
toplevel .t
- wm geometry .t 200x100+0+0
+ wm geometry .t 200x100+0+$Y0
listbox .t.l -height 20 -width 20
pack .t.l -fill both -expand 1
update
.t.l configure -setgrid 1
update
wm geometry .t
-} {20x20+0+0}
+} "20x20+0+$Y0"
test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} unix {
destroy .t
@@ -1559,10 +1574,10 @@ test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} unix {
tkwait visibility .t
wm overrideredirect .t 1
update
- wm geometry .t -30+2
+ wm geometry .t -30+$Y2
update
list [winfo x .t] [winfo y .t]
-} [list [expr [winfo screenwidth .t] - 110] 2]
+} [list [expr [winfo screenwidth .t] - 110] $Y2]
destroy .t
test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} {
diff --git a/tests/wm.test b/tests/wm.test
index af37c80..df8d325 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -1640,14 +1640,24 @@ test wm-transient-1.7 {usage} -returnCodes error -body {
wm transient .master .master
} -cleanup {
deleteWindows
-} -result {can't make ".master" its own master}
+} -result {setting ".master" as master creates a transient/master cycle}
test wm-transient-1.8 {usage} -returnCodes error -body {
+ toplevel .t1
+ toplevel .t2
+ toplevel .t3
+ wm transient .t2 .t1
+ wm transient .t3 .t2
+ wm transient .t1 .t3
+} -cleanup {
+ deleteWindows
+} -result {setting ".t3" as master creates a transient/master cycle}
+test wm-transient-1.9 {usage} -returnCodes error -body {
toplevel .master
frame .master.f
wm transient .master .master.f
} -cleanup {
deleteWindows
-} -result {can't make ".master" its own master}
+} -result {setting ".master" as master creates a transient/master cycle}
test wm-transient-2.1 {basic get/set of master} -setup {
set results [list]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 86a8a61..56c343b 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -100,11 +100,11 @@ DEMO_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)/demos
# The directory containing the Tcl sources and headers appropriate
# for this version of Tk ("srcdir" will be replaced or has already
# been replaced by the configure script):
-TCL_GENERIC_DIR = @TCL_SRC_DIR@/generic
+TCL_GENERIC_DIR = @TCL_ACTUAL_SRC_DIR@/generic
# The directory containing the platform specific Tcl sources and headers
# appropriate for this version of Tk:
-TCL_PLATFORM_DIR = @TCL_SRC_DIR@/unix
+TCL_PLATFORM_DIR = @TCL_ACTUAL_SRC_DIR@/unix
# The directory containing the Tcl library archive file appropriate
# for this version of Tk:
@@ -310,7 +310,7 @@ GENERIC_DIR = $(TOP_DIR)/generic
TTK_DIR = $(GENERIC_DIR)/ttk
UNIX_DIR = $(TOP_DIR)/unix
BMAP_DIR = $(TOP_DIR)/bitmaps
-TOOL_DIR = @TCL_SRC_DIR@/tools
+TOOL_DIR = @TCL_ACTUAL_SRC_DIR@/tools
TEST_DIR = $(TOP_DIR)/tests
MAC_OSX_DIR = $(TOP_DIR)/macosx
XLIB_DIR = $(TOP_DIR)/xlib
@@ -566,7 +566,7 @@ DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
SHELL_ENV = \
@LD_LIBRARY_PATH_VAR@="`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}"; \
export @LD_LIBRARY_PATH_VAR@; \
- TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
+ TCL_LIBRARY=@TCL_ACTUAL_SRC_DIR@/library; export TCL_LIBRARY; \
TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY;
all: binaries libraries doc
@@ -576,7 +576,7 @@ binaries: ${LIB_FILE} ${WISH_EXE}
libraries:
$(TOP_DIR)/doc/man.macros:
- $(INSTALL_DATA) @TCL_SRC_DIR@/doc/man.macros $(TOP_DIR)/doc/man.macros
+ $(INSTALL_DATA) $(TCLDIR)/doc/man.macros $(TOP_DIR)/doc/man.macros
doc: $(TOP_DIR)/doc/man.macros
@@ -682,7 +682,7 @@ demo:
# This target can be used to run wish inside either gdb or insight
gdb: ${WISH_EXE}
@echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:${TCL_BIN_DIR}:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run
- @echo "set env TCL_LIBRARY=@TCL_SRC_DIR@/library" >> gdb.run
+ @echo "set env TCL_LIBRARY=@TCL_ACTUAL_SRC_DIR@/library" >> gdb.run
@echo "set env TK_LIBRARY=@TK_SRC_DIR@/library" >> gdb.run
gdb ./${WISH_EXE} --command=gdb.run
rm gdb.run
@@ -1534,7 +1534,7 @@ DISTROOT = /tmp/dist
DISTNAME = tk${VERSION}${PATCH_LEVEL}
ZIPNAME = tk${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip
DISTDIR = $(DISTROOT)/$(DISTNAME)
-TCLDIR = @TCL_SRC_DIR@
+TCLDIR = @TCL_ACTUAL_SRC_DIR@
DIST_INSTALL_DATA = CPPROG='cp -p' $(INSTALL) -m 644
DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755
@@ -1691,7 +1691,7 @@ BUILD_HTML = \
$(SHELL_ENV) TCLSH="$(BUILD_TCLSH)"; else \
TCLSH="$(TCL_EXE)"; fi ;\
"$${TCLSH}" $(TOOL_DIR)/tcltk-man2html.tcl --htmldir="$(HTML_INSTALL_DIR)" \
- --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS)
+ --tk --srcdir=$(TOP_DIR) $(BUILD_HTML_FLAGS)
#
# The list of all the targets that do not correspond to real files. This stops
diff --git a/unix/configure b/unix/configure
index cf5ce30..d7408c4 100755
--- a/unix/configure
+++ b/unix/configure
@@ -707,8 +707,6 @@ LDFLAGS
CFLAGS
CC
MAN_FLAGS
-BUILD_TCLSH
-TCLSH_PROG
TCL_STUB_LIB_SPEC
TCL_STUB_LIB_FLAG
TCL_STUB_LIB_FILE
@@ -719,6 +717,11 @@ TCL_SRC_DIR
TCL_BIN_DIR
TCL_PATCH_LEVEL
TCL_VERSION
+TCL_ACTUAL_SRC_DIR
+TCL_SOURCE_MINOR_VERSION
+TCL_SOURCE_MAJOR_VERSION
+BUILD_TCLSH
+TCLSH_PROG
target_alias
host_alias
build_alias
@@ -2288,6 +2291,47 @@ LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv"
# Find and load the tclConfig.sh file
#--------------------------------------------------------------------
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
+$as_echo_n "checking for tclsh... " >&6; }
+ if ${ac_cv_path_tclsh+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \
+ `ls -r $dir/tclsh* 2> /dev/null` ; do
+ if test x"$ac_cv_path_tclsh" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_tclsh=$j
+ break
+ fi
+ fi
+ done
+ done
+
+fi
+
+
+ if test -f "$ac_cv_path_tclsh" ; then
+ TCLSH_PROG="$ac_cv_path_tclsh"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
+$as_echo "$TCLSH_PROG" >&6; }
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh avaliable" >&5
+$as_echo "No tclsh avaliable" >&6; }
+ fi
+
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh in Tcl build directory" >&5
+$as_echo_n "checking for tclsh in Tcl build directory... " >&6; }
+ BUILD_TCLSH="${TCL_BIN_DIR}"/tclsh
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $BUILD_TCLSH" >&5
+$as_echo "$BUILD_TCLSH" >&6; }
+
+
+
#
# Ok, lets find the tcl configuration
@@ -2469,6 +2513,144 @@ $as_echo "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; }
eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
+ TCL_ACTUAL_SRC_DIR=` <<-'EOF' "$TCLSH_PROG" - "$srcdir" "$TCL_SRC_DIR" \
+ "$TCL_MAJOR_VERSION" "$TCL_MINOR_VERSION"
+
+ proc cat fname {
+ set chan [open $fname]
+ try {
+ read $chan
+ } finally {
+ close $chan
+ }
+ }
+
+ proc main {argv0 argv} {
+ try {
+ lassign $argv -> srcdir tcl_src_dir majortarget minortarget
+ lappend candidates $tcl_src_dir
+ set srcdir [file dirname [file normalize $srcdir/...]]
+ set topsrcdir [file dirname $srcdir]
+ set sources [file dirname $topsrcdir]
+ foreach dirname [glob -nocomplain -directory $sources *] {
+ if {$dirname ni $candidates} {
+ lappend candidates $dirname
+ }
+ }
+ foreach candidate $candidates {
+ set res [check $candidate $majortarget $minortarget]
+ if {$res eq {}} continue else {
+ puts -nonewline $res
+ break
+ }
+ }
+ set status 0
+ } on error {tres topts} {
+ puts stderr [dict get $topts -errorinfo]
+ set status 1
+ }
+ exit $status
+ }
+
+ proc check {candidate majortarget minortarget} {
+ set tclh $candidate/generic/tcl.h
+
+ if {![file exists $tclh]} {
+ return {}
+ }
+
+ set version [tclhversion [cat $tclh]]
+ if {[llength $version]} {
+ lassign $version major minor
+ if {[package vcompare $major.$minor \
+ $majortarget.$minortarget] >= 0} {
+ return [list $candidate $major $minor]
+ }
+ }
+
+ return {}
+ }
+
+ proc tclhversion data {
+ if {[regexp -line {^#define\s+_TCL} $data]} {
+ if {[
+ regexp -line {^#define\s+TCL_VERSION\s+\"([^.])+\.([^.\"]+)} \
+ $data -> major minor
+ ]} {
+ return [list $major $minor]
+ }
+ }
+ return {}
+ }
+ main $argv0 $argv
+ EOF
+
+ `
+
+ if test "x${TCL_ACTUAL_SRC_DIR}" = x; then
+ as_fn_error $? "could not find Tcl sources" "$LINENO" 5
+ else
+ TCL_SOURCE_MAJOR_VERSION=` <<-'EOF' "$TCLSH_PROG" - "$TCL_ACTUAL_SRC_DIR " "1"
+ proc main {argv0 argv} {
+ try {
+ lassign $argv -> list index
+ puts -nonewline [lindex $list $index]
+ set status 0
+ } on error {tres topts} {
+ puts stderr [dict get $topts -errorinfo]
+ set status 1
+ }
+ exit $status
+ }
+ main $argv0 $argv
+ EOF
+ `
+
+
+
+
+ TCL_SOURCE_MINOR_VERSION=` <<-'EOF' "$TCLSH_PROG" - "$TCL_ACTUAL_SRC_DIR " "2"
+ proc main {argv0 argv} {
+ try {
+ lassign $argv -> list index
+ puts -nonewline [lindex $list $index]
+ set status 0
+ } on error {tres topts} {
+ puts stderr [dict get $topts -errorinfo]
+ set status 1
+ }
+ exit $status
+ }
+ main $argv0 $argv
+ EOF
+ `
+
+
+
+
+ TCL_ACTUAL_SRC_DIR=` <<-'EOF' "$TCLSH_PROG" - "$TCL_ACTUAL_SRC_DIR " "0"
+ proc main {argv0 argv} {
+ try {
+ lassign $argv -> list index
+ puts -nonewline [lindex $list $index]
+ set status 0
+ } on error {tres topts} {
+ puts stderr [dict get $topts -errorinfo]
+ set status 1
+ }
+ exit $status
+ }
+ main $argv0 $argv
+ EOF
+ `
+
+
+
+
+ fi
+
+
+
@@ -2494,49 +2676,6 @@ fi
fi
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
-$as_echo_n "checking for tclsh... " >&6; }
- if ${ac_cv_path_tclsh+:} false; then :
- $as_echo_n "(cached) " >&6
-else
-
- search_path=`echo ${PATH} | sed -e 's/:/ /g'`
- for dir in $search_path ; do
- for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \
- `ls -r $dir/tclsh* 2> /dev/null` ; do
- if test x"$ac_cv_path_tclsh" = x ; then
- if test -f "$j" ; then
- ac_cv_path_tclsh=$j
- break
- fi
- fi
- done
- done
-
-fi
-
-
- if test -f "$ac_cv_path_tclsh" ; then
- TCLSH_PROG="$ac_cv_path_tclsh"
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
-$as_echo "$TCLSH_PROG" >&6; }
- else
- # It is not an error if an installed version of Tcl can't be located.
- TCLSH_PROG=""
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
-$as_echo "No tclsh found on PATH" >&6; }
- fi
-
-
-
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh in Tcl build directory" >&5
-$as_echo_n "checking for tclsh in Tcl build directory... " >&6; }
- BUILD_TCLSH="${TCL_BIN_DIR}"/tclsh
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $BUILD_TCLSH" >&5
-$as_echo "$BUILD_TCLSH" >&6; }
-
-
-
#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------
diff --git a/unix/configure.ac b/unix/configure.ac
index 5f5213d..a8c403b 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -32,6 +32,8 @@ LOCALES="cs da de el en en_gb eo es fr hu it nl pl pt ru sv"
#--------------------------------------------------------------------
# Find and load the tclConfig.sh file
#--------------------------------------------------------------------
+SC_PROG_TCLSH
+SC_BUILD_TCLSH
SC_PATH_TCLCONFIG
SC_LOAD_TCLCONFIG
@@ -47,8 +49,6 @@ Found config for Tcl ${TCL_VERSION}])
fi
fi
-SC_PROG_TCLSH
-SC_BUILD_TCLSH
#------------------------------------------------------------------------
# Handle the --prefix=... option
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 2f114d7..99f5d29 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -336,6 +336,8 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""
+ SC_TCL_FIND_SOURCES()
+
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_BIN_DIR)
@@ -432,6 +434,134 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [
AC_SUBST(TK_STUB_LIB_SPEC)
])
+
+#------------------------------------------------------------------------
+# SC_TCL_FIND_SOURCES
+# Find a directory containing Tcl sources that match the version required by
+# tclConfig.sh. The sources indicated by tclConfig.sh are preferred.
+#
+# Arguments:
+# none
+#
+# Results:
+# Substitutes the following vars:
+# TCL_SOURCE_MAJOR_VERSION
+# TCL_SOURCE_MINOR_VERSION
+# TCL_ACTUAL_SRC_DIR
+#------------------------------------------------------------------------
+
+AC_DEFUN([SC_TCL_FIND_SOURCES],[
+ [TCL_ACTUAL_SRC_DIR=` <<-'EOF' "$TCLSH_PROG" - "$srcdir" "$TCL_SRC_DIR" \
+ "$TCL_MAJOR_VERSION" "$TCL_MINOR_VERSION"
+
+ proc cat fname {
+ set chan [open $fname]
+ try {
+ read $chan
+ } finally {
+ close $chan
+ }
+ }
+
+ proc main {argv0 argv} {
+ try {
+ lassign $argv -> srcdir tcl_src_dir majortarget minortarget
+ lappend candidates $tcl_src_dir
+ set srcdir [file dirname [file normalize $srcdir/...]]
+ set topsrcdir [file dirname $srcdir]
+ set sources [file dirname $topsrcdir]
+ foreach dirname [glob -nocomplain -directory $sources *] {
+ if {$dirname ni $candidates} {
+ lappend candidates $dirname
+ }
+ }
+ foreach candidate $candidates {
+ set res [check $candidate $majortarget $minortarget]
+ if {$res eq {}} continue else {
+ puts -nonewline $res
+ break
+ }
+ }
+ set status 0
+ } on error {tres topts} {
+ puts stderr [dict get $topts -errorinfo]
+ set status 1
+ }
+ exit $status
+ }
+
+ proc check {candidate majortarget minortarget} {
+ set tclh $candidate/generic/tcl.h
+
+ if {![file exists $tclh]} {
+ return {}
+ }
+
+ set version [tclhversion [cat $tclh]]
+ if {[llength $version]} {
+ lassign $version major minor
+ if {[package vcompare $major.$minor \
+ $majortarget.$minortarget] >= 0} {
+ return [list $candidate $major $minor]
+ }
+ }
+
+ return {}
+ }
+
+ proc tclhversion data {
+ if {[regexp -line {^#define\s+_TCL} $data]} {
+ if {[
+ regexp -line {^#define\s+TCL_VERSION\s+\"([^.])+\.([^.\"]+)} \
+ $data -> major minor
+ ]} {
+ return [list $major $minor]
+ }
+ }
+ return {}
+ }
+ main $argv0 $argv
+ EOF
+ ]
+ `
+
+ if test "x${TCL_ACTUAL_SRC_DIR}" = x; then
+ AC_MSG_ERROR([could not find Tcl sources])
+ else
+ TCL_SOURCE_MAJOR_VERSION=SC_TCL_LINDEX([$TCL_ACTUAL_SRC_DIR] ,1)
+ AC_SUBST(TCL_SOURCE_MAJOR_VERSION)
+ TCL_SOURCE_MINOR_VERSION=SC_TCL_LINDEX([$TCL_ACTUAL_SRC_DIR] ,2)
+ AC_SUBST(TCL_SOURCE_MINOR_VERSION)
+ TCL_ACTUAL_SRC_DIR=SC_TCL_LINDEX([$TCL_ACTUAL_SRC_DIR] ,0)
+ AC_SUBST(TCL_ACTUAL_SRC_DIR)
+ fi
+])
+
+
+#------------------------------------------------------------------------
+# SC_TCL_LINDEX
+#------------------------------------------------------------------------
+
+AC_DEFUN([SC_TCL_LINDEX],
+ [[` <<-'EOF' "$TCLSH_PROG" - "$1" "$2"
+ proc main {argv0 argv} {
+ try {
+ lassign $argv -> list index
+ puts -nonewline [lindex $list $index]
+ set status 0
+ } on error {tres topts} {
+ puts stderr [dict get $topts -errorinfo]
+ set status 1
+ }
+ exit $status
+ }
+ main $argv0 $argv
+ EOF
+ `
+ ]]
+
+)
+
#------------------------------------------------------------------------
# SC_PROG_TCLSH
# Locate a tclsh shell installed on the system path. This macro
@@ -473,9 +603,7 @@ AC_DEFUN([SC_PROG_TCLSH], [
TCLSH_PROG="$ac_cv_path_tclsh"
AC_MSG_RESULT([$TCLSH_PROG])
else
- # It is not an error if an installed version of Tcl can't be located.
- TCLSH_PROG=""
- AC_MSG_RESULT([No tclsh found on PATH])
+ AC_MSG_RESULT([No tclsh avaliable])
fi
AC_SUBST(TCLSH_PROG)
])
diff --git a/unix/tkUnixEmbed.c b/unix/tkUnixEmbed.c
index 3cb5d26..2ac3013 100644
--- a/unix/tkUnixEmbed.c
+++ b/unix/tkUnixEmbed.c
@@ -503,7 +503,15 @@ EmbedStructureProc(
Tk_ErrorHandler errHandler;
if (eventPtr->type == ConfigureNotify) {
+ /*
+ * Send a ConfigureNotify to the embedded application.
+ */
+
+ if (containerPtr->embeddedPtr != None) {
+ TkDoConfigureNotify(containerPtr->embeddedPtr);
+ }
if (containerPtr->wrapper != None) {
+
/*
* Ignore errors, since the embedded application could have
* deleted its window.
@@ -873,6 +881,7 @@ TkpTestembedCmd(
Container *containerPtr;
Tcl_DString dString;
char buffer[50];
+ Tcl_Interp *embeddedInterp = NULL, *parentInterp = NULL;
ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
@@ -884,7 +893,17 @@ TkpTestembedCmd(
Tcl_DStringInit(&dString);
for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr != NULL) {
+ embeddedInterp = containerPtr->embeddedPtr->mainPtr->interp;
+ }
+ if (containerPtr->parentPtr != NULL) {
+ parentInterp = containerPtr->parentPtr->mainPtr->interp;
+ }
+ if (embeddedInterp != interp && parentInterp != interp) {
+ continue;
+ }
Tcl_DStringStartSublist(&dString);
+ /* Parent id */
if (containerPtr->parent == None) {
Tcl_DStringAppendElement(&dString, "");
} else if (all) {
@@ -893,12 +912,15 @@ TkpTestembedCmd(
} else {
Tcl_DStringAppendElement(&dString, "XXX");
}
- if (containerPtr->parentPtr == NULL) {
+ /* Parent pathName */
+ if (containerPtr->parentPtr == NULL ||
+ parentInterp != interp) {
Tcl_DStringAppendElement(&dString, "");
} else {
Tcl_DStringAppendElement(&dString,
containerPtr->parentPtr->pathName);
}
+ /* Wrapper */
if (containerPtr->wrapper == None) {
Tcl_DStringAppendElement(&dString, "");
} else if (all) {
@@ -907,7 +929,9 @@ TkpTestembedCmd(
} else {
Tcl_DStringAppendElement(&dString, "XXX");
}
- if (containerPtr->embeddedPtr == NULL) {
+ /* Embedded window pathName */
+ if (containerPtr->embeddedPtr == NULL ||
+ embeddedInterp != interp) {
Tcl_DStringAppendElement(&dString, "");
} else {
Tcl_DStringAppendElement(&dString,
diff --git a/unix/tkUnixEvent.c b/unix/tkUnixEvent.c
index a3867a4..a83923d 100644
--- a/unix/tkUnixEvent.c
+++ b/unix/tkUnixEvent.c
@@ -186,6 +186,12 @@ TkpOpenDisplay(
#endif
Tcl_CreateFileHandler(ConnectionNumber(display), TCL_READABLE,
DisplayFileProc, dispPtr);
+
+ /*
+ * Key map info must be available immediately, because of "send event".
+ */
+ TkpInitKeymapInfo(dispPtr);
+
return dispPtr;
}
diff --git a/unix/tkUnixFont.c b/unix/tkUnixFont.c
index 168e8c9..c94aff2 100644
--- a/unix/tkUnixFont.c
+++ b/unix/tkUnixFont.c
@@ -3017,7 +3017,7 @@ GetEncodingAlias(
const EncodingAlias *aliasPtr;
for (aliasPtr = encodingAliases; aliasPtr->aliasPattern != NULL; ) {
- if (Tcl_StringMatch(name, aliasPtr->aliasPattern)) {
+ if (Tcl_StringCaseMatch(name, aliasPtr->aliasPattern, 0)) {
return aliasPtr->realName;
}
aliasPtr++;
diff --git a/unix/tkUnixMenu.c b/unix/tkUnixMenu.c
index 2703412..296523c 100644
--- a/unix/tkUnixMenu.c
+++ b/unix/tkUnixMenu.c
@@ -856,11 +856,7 @@ DrawMenuUnderline(
if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
int len;
- /*
- * Do the unicode call just to prevent overruns.
- */
-
- Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len);
+ len = Tcl_GetCharLength(mePtr->labelPtr);
if (mePtr->underline < len) {
int activeBorderWidth, leftEdge;
const char *label, *start, *end;
@@ -888,7 +884,10 @@ DrawMenuUnderline(
*
* TkpPostMenu --
*
- * Posts a menu on the screen
+ * Posts a menu on the screen so that the top left corner of the
+ * specified entry is located at the point (x, y) in screen coordinates.
+ * If the entry parameter is negative, the upper left corner of the
+ * menu itself is placed at the point.
*
* Results:
* None.
@@ -903,9 +902,104 @@ int
TkpPostMenu(
Tcl_Interp *interp,
TkMenu *menuPtr,
- int x, int y)
+ int x, int y, int index)
{
- return TkPostTearoffMenu(interp, menuPtr, x, y);
+ return TkpPostTearoffMenu(interp, menuPtr, x, y, index);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPostTearoffMenu --
+ *
+ * Posts a tearoff menu on the screen so that the top left corner of the
+ * specified entry is located at the point (x, y) in screen coordinates.
+ * If the index parameter is negative, the upper left corner of the menu
+ * itself is placed at the point. On unix this is called when posting
+ * any menu. Adjusts the menu's position so that it fits on the screen,
+ * and maps and raises the menu.
+ *
+ * Results:
+ * Returns a standard Tcl Error.
+ *
+ * Side effects:
+ * The menu is posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostTearoffMenu(
+ Tcl_Interp *interp, /* The interpreter of the menu */
+ TkMenu *menuPtr, /* The menu we are posting */
+ int x, int y, int index) /* The root X,Y coordinates where the
+ * specified entry will be posted */
+{
+ int vRootX, vRootY, vRootWidth, vRootHeight;
+ int result;
+
+ if (index >= (int)menuPtr->numEntries) {
+ index = menuPtr->numEntries - 1;
+ }
+ if (index >= 0) {
+ y -= menuPtr->entries[index]->y;
+ }
+
+ TkActivateMenuEntry(menuPtr, -1);
+ TkRecomputeMenu(menuPtr);
+ result = TkPostCommand(menuPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means we are dead
+ * and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Adjust the position of the menu if necessary to keep it visible on the
+ * screen. There are two special tricks to make this work right:
+ *
+ * 1. If a virtual root window manager is being used then the coordinates
+ * are in the virtual root window of menuPtr's parent; since the menu
+ * uses override-redirect mode it will be in the *real* root window for
+ * the screen, so we have to map the coordinates from the virtual root
+ * (if any) to the real root. Can't get the virtual root from the menu
+ * itself (it will never be seen by the wm) so use its parent instead
+ * (it would be better to have an an option that names a window to use
+ * for this...).
+ * 2. The menu may not have been mapped yet, so its current size might be
+ * the default 1x1. To compute how much space it needs, use its
+ * requested size, not its actual size.
+ */
+
+ Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ vRootWidth -= Tk_ReqWidth(menuPtr->tkwin);
+ if (x > vRootX + vRootWidth) {
+ x = vRootX + vRootWidth;
+ }
+ if (x < vRootX) {
+ x = vRootX;
+ }
+ vRootHeight -= Tk_ReqHeight(menuPtr->tkwin);
+ if (y > vRootY + vRootHeight) {
+ y = vRootY + vRootHeight;
+ }
+ if (y < vRootY) {
+ y = vRootY;
+ }
+ Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
+ if (!Tk_IsMapped(menuPtr->tkwin)) {
+ Tk_MapWindow(menuPtr->tkwin);
+ }
+ TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
+ return TCL_OK;
}
/*
@@ -1036,7 +1130,7 @@ TkpComputeMenubarGeometry(
menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
Tk_GetFontMetrics(menuFont, &menuMetrics);
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
mePtr = menuPtr->entries[i];
mePtr->entryFlags &= ~ENTRY_LAST_COLUMN;
if (mePtr->fontPtr != NULL) {
@@ -1113,7 +1207,7 @@ TkpComputeMenubarGeometry(
maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth;
}
x = borderWidth;
- for (j = lastRowBreak; j < menuPtr->numEntries; j++) {
+ for (j = lastRowBreak; j < (int)menuPtr->numEntries; j++) {
if (j == helpMenuIndex) {
continue;
}
@@ -1615,7 +1709,7 @@ TkpComputeStandardMenuGeometry(
Tk_GetFontMetrics(menuFont, &menuMetrics);
accelSpace = Tk_TextWidth(menuFont, "M", 1);
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
mePtr = menuPtr->entries[i];
if (mePtr->fontPtr == NULL) {
tkfont = menuFont;
@@ -1710,7 +1804,7 @@ TkpComputeStandardMenuGeometry(
if (accelWidth != 0) {
labelWidth += accelSpace;
}
- for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ for (j = lastColumnBreak; j < (int)menuPtr->numEntries; j++) {
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
@@ -1720,7 +1814,6 @@ TkpComputeStandardMenuGeometry(
}
windowWidth = x + indicatorSpace + labelWidth + accelWidth
+ 2 * activeBorderWidth + borderWidth;
-
windowHeight += borderWidth;
/*
diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c
index d0208b7..d26b139 100644
--- a/unix/tkUnixScale.c
+++ b/unix/tkUnixScale.c
@@ -24,11 +24,13 @@
static void DisplayHorizontalScale(TkScale *scalePtr,
Drawable drawable, XRectangle *drawnAreaPtr);
static void DisplayHorizontalValue(TkScale *scalePtr,
- Drawable drawable, double value, int top);
+ Drawable drawable, double value, int top,
+ const char *format);
static void DisplayVerticalScale(TkScale *scalePtr,
Drawable drawable, XRectangle *drawnAreaPtr);
static void DisplayVerticalValue(TkScale *scalePtr,
- Drawable drawable, double value, int rightEdge);
+ Drawable drawable, double value, int rightEdge,
+ const char *format);
/*
*----------------------------------------------------------------------
@@ -150,11 +152,11 @@ DisplayVerticalScale(
for (tickValue = scalePtr->fromValue; ;
tickValue += tickInterval) {
/*
- * The TkRoundToResolution call gets rid of accumulated
+ * The TkRoundValueToResolution call gets rid of accumulated
* round-off errors, if any.
*/
- tickValue = TkRoundToResolution(scalePtr, tickValue);
+ tickValue = TkRoundValueToResolution(scalePtr, tickValue);
if (scalePtr->toValue >= scalePtr->fromValue) {
if (tickValue > scalePtr->toValue) {
break;
@@ -165,7 +167,7 @@ DisplayVerticalScale(
}
}
DisplayVerticalValue(scalePtr, drawable, tickValue,
- scalePtr->vertTickRightX);
+ scalePtr->vertTickRightX, scalePtr->tickFormat);
}
}
}
@@ -176,7 +178,7 @@ DisplayVerticalScale(
if (scalePtr->showValue) {
DisplayVerticalValue(scalePtr, drawable, scalePtr->value,
- scalePtr->vertValueRightX);
+ scalePtr->vertValueRightX, scalePtr->valueFormat);
}
/*
@@ -228,8 +230,8 @@ DisplayVerticalScale(
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
scalePtr->tkfont, scalePtr->label,
- scalePtr->labelLength, scalePtr->vertLabelX,
- scalePtr->inset + (3*fm.ascent)/2);
+ scalePtr->labelLength, scalePtr->vertLabelX,
+ scalePtr->inset + (3 * fm.ascent) / 2);
}
}
@@ -261,8 +263,9 @@ DisplayVerticalValue(
double value, /* Y-coordinate of number to display,
* specified in application coords, not in
* pixels (we'll compute pixels). */
- int rightEdge) /* X-coordinate of right edge of text,
+ int rightEdge, /* X-coordinate of right edge of text,
* specified in pixels. */
+ const char *format) /* Format string to use for the value */
{
register Tk_Window tkwin = scalePtr->tkwin;
int y, width, length;
@@ -271,8 +274,8 @@ DisplayVerticalValue(
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
y = TkScaleValueToPixel(scalePtr, value) + fm.ascent/2;
- if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->format, value) < 0) {
- valueString[TCL_DOUBLE_SPACE - 1] = '\0';
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, format, value) < 0) {
+ valueString[TCL_DOUBLE_SPACE - 1] = '\0';
}
length = (int) strlen(valueString);
width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
@@ -282,10 +285,10 @@ DisplayVerticalValue(
* the window.
*/
- if ((y - fm.ascent) < (scalePtr->inset + SPACING)) {
+ if (y - fm.ascent < scalePtr->inset + SPACING) {
y = scalePtr->inset + SPACING + fm.ascent;
}
- if ((y + fm.descent) > (Tk_Height(tkwin) - scalePtr->inset - SPACING)) {
+ if (y + fm.descent > Tk_Height(tkwin) - scalePtr->inset - SPACING) {
y = Tk_Height(tkwin) - scalePtr->inset - SPACING - fm.descent;
}
Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
@@ -324,7 +327,7 @@ DisplayHorizontalScale(
{
register Tk_Window tkwin = scalePtr->tkwin;
int x, y, width, height, shadowWidth;
- double tickValue, tickInterval = scalePtr->tickInterval;
+ double tickInterval = scalePtr->tickInterval;
Tk_3DBorder sliderBorder;
/*
@@ -348,7 +351,7 @@ DisplayHorizontalScale(
if (tickInterval != 0) {
char valueString[TCL_DOUBLE_SPACE];
- double ticks, maxTicks;
+ double ticks, maxTicks, tickValue;
/*
* Ensure that we will only draw enough of the tick values such
@@ -358,23 +361,23 @@ DisplayHorizontalScale(
ticks = fabs((scalePtr->toValue - scalePtr->fromValue)
/ tickInterval);
- if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->format,
- scalePtr->fromValue) < 0) {
- valueString[TCL_DOUBLE_SPACE - 1] = '\0';
- }
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->tickFormat,
+ scalePtr->fromValue) < 0) {
+ valueString[TCL_DOUBLE_SPACE - 1] = '\0';
+ }
maxTicks = (double) Tk_Width(tkwin)
/ (double) Tk_TextWidth(scalePtr->tkfont, valueString, -1);
if (ticks > maxTicks) {
- tickInterval *= (ticks / maxTicks);
+ tickInterval *= ticks / maxTicks;
}
- for (tickValue = scalePtr->fromValue; ;
- tickValue += tickInterval) {
+ tickValue = scalePtr->fromValue;
+ while (1) {
/*
- * The TkRoundToResolution call gets rid of accumulated
+ * The TkRoundValueToResolution call gets rid of accumulated
* round-off errors, if any.
*/
- tickValue = TkRoundToResolution(scalePtr, tickValue);
+ tickValue = TkRoundValueToResolution(scalePtr, tickValue);
if (scalePtr->toValue >= scalePtr->fromValue) {
if (tickValue > scalePtr->toValue) {
break;
@@ -385,7 +388,8 @@ DisplayHorizontalScale(
}
}
DisplayHorizontalValue(scalePtr, drawable, tickValue,
- scalePtr->horizTickY);
+ scalePtr->horizTickY, scalePtr->tickFormat);
+ tickValue += tickInterval;
}
}
}
@@ -396,7 +400,7 @@ DisplayHorizontalScale(
if (scalePtr->showValue) {
DisplayHorizontalValue(scalePtr, drawable, scalePtr->value,
- scalePtr->horizValueY);
+ scalePtr->horizValueY, scalePtr->valueFormat);
}
/*
@@ -449,8 +453,8 @@ DisplayHorizontalScale(
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
scalePtr->tkfont, scalePtr->label,
- scalePtr->labelLength, scalePtr->inset + fm.ascent/2,
- scalePtr->horizLabelY + fm.ascent);
+ scalePtr->labelLength, scalePtr->inset + fm.ascent/2,
+ scalePtr->horizLabelY + fm.ascent);
}
}
@@ -482,8 +486,9 @@ DisplayHorizontalValue(
double value, /* X-coordinate of number to display,
* specified in application coords, not in
* pixels (we'll compute pixels). */
- int top) /* Y-coordinate of top edge of text, specified
+ int top, /* Y-coordinate of top edge of text, specified
* in pixels. */
+ const char *format) /* Format string to use for the value */
{
register Tk_Window tkwin = scalePtr->tkwin;
int x, y, length, width;
@@ -493,8 +498,8 @@ DisplayHorizontalValue(
x = TkScaleValueToPixel(scalePtr, value);
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
y = top + fm.ascent;
- if (snprintf(valueString, TCL_DOUBLE_SPACE, scalePtr->format, value) < 0) {
- valueString[TCL_DOUBLE_SPACE - 1] = '\0';
+ if (snprintf(valueString, TCL_DOUBLE_SPACE, format, value) < 0) {
+ valueString[TCL_DOUBLE_SPACE - 1] = '\0';
}
length = (int) strlen(valueString);
width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
@@ -504,8 +509,8 @@ DisplayHorizontalValue(
* the window.
*/
- x -= (width)/2;
- if (x < (scalePtr->inset + SPACING)) {
+ x -= width / 2;
+ if (x < scalePtr->inset + SPACING) {
x = scalePtr->inset + SPACING;
}
@@ -562,10 +567,10 @@ TkpDisplayScale(
Tcl_Preserve(scalePtr);
if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
Tcl_Preserve(interp);
- if (snprintf(string, TCL_DOUBLE_SPACE, scalePtr->format,
- scalePtr->value) < 0) {
- string[TCL_DOUBLE_SPACE - 1] = '\0';
- }
+ if (snprintf(string, TCL_DOUBLE_SPACE, scalePtr->valueFormat,
+ scalePtr->value) < 0) {
+ string[TCL_DOUBLE_SPACE - 1] = '\0';
+ }
Tcl_DStringInit(&buf);
Tcl_DStringAppend(&buf, scalePtr->command, -1);
Tcl_DStringAppend(&buf, " ", -1);
@@ -634,7 +639,7 @@ TkpDisplayScale(
gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
} else {
gc = Tk_GCForColor(
- Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
+ Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
}
Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
}
@@ -696,7 +701,7 @@ TkpScaleElement(
if (y < sliderFirst) {
return TROUGH1;
}
- if (y < (sliderFirst+scalePtr->sliderLength)) {
+ if (y < sliderFirst + scalePtr->sliderLength) {
return SLIDER;
}
return TROUGH2;
@@ -716,7 +721,7 @@ TkpScaleElement(
if (x < sliderFirst) {
return TROUGH1;
}
- if (x < (sliderFirst+scalePtr->sliderLength)) {
+ if (x < sliderFirst + scalePtr->sliderLength) {
return SLIDER;
}
return TROUGH2;
diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c
index 0b4f05d..9b6e79f 100644
--- a/unix/tkUnixSend.c
+++ b/unix/tkUnixSend.c
@@ -2052,7 +2052,7 @@ TkpTestsendCmd(
Tcl_DStringFree(&tmp);
}
} else if (index == TESTSEND_SERIAL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(localData.sendSerial+1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(localData.sendSerial+1));
}
return TCL_OK;
}
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index b84791b..3afa011 100644
--- a/unix/tkUnixWm.c
+++ b/unix/tkUnixWm.c
@@ -1055,8 +1055,8 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- dispPtr->flags & TK_DISPLAY_WM_TRACING));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ (dispPtr->flags & TK_DISPLAY_WM_TRACING) != 0));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
@@ -1200,10 +1200,10 @@ WmAspectCmd(
if (wmPtr->sizeHintsFlags & PAspect) {
Tcl_Obj *results[4];
- results[0] = Tcl_NewIntObj(wmPtr->minAspect.x);
- results[1] = Tcl_NewIntObj(wmPtr->minAspect.y);
- results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x);
- results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y);
+ results[0] = Tcl_NewWideIntObj(wmPtr->minAspect.x);
+ results[1] = Tcl_NewWideIntObj(wmPtr->minAspect.y);
+ results[2] = Tcl_NewWideIntObj(wmPtr->maxAspect.x);
+ results[3] = Tcl_NewWideIntObj(wmPtr->maxAspect.y);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
@@ -1345,11 +1345,11 @@ WmGetAttribute(
case WMATT_ALPHA:
return Tcl_NewDoubleObj(wmPtr->attributes.alpha);
case WMATT_TOPMOST:
- return Tcl_NewBooleanObj(wmPtr->attributes.topmost);
+ return Tcl_NewWideIntObj(wmPtr->attributes.topmost != 0);
case WMATT_ZOOMED:
- return Tcl_NewBooleanObj(wmPtr->attributes.zoomed);
+ return Tcl_NewWideIntObj(wmPtr->attributes.zoomed != 0);
case WMATT_FULLSCREEN:
- return Tcl_NewBooleanObj(wmPtr->attributes.fullscreen);
+ return Tcl_NewWideIntObj(wmPtr->attributes.fullscreen != 0);
case WMATT_TYPE:
return GetNetWmType(winPtr);
case _WMATT_LAST_ATTRIBUTE: /*NOTREACHED*/
@@ -1980,10 +1980,10 @@ WmGridCmd(
if (wmPtr->sizeHintsFlags & PBaseSize) {
Tcl_Obj *results[4];
- results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth);
- results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight);
- results[2] = Tcl_NewIntObj(wmPtr->widthInc);
- results[3] = Tcl_NewIntObj(wmPtr->heightInc);
+ results[0] = Tcl_NewWideIntObj(wmPtr->reqGridWidth);
+ results[1] = Tcl_NewWideIntObj(wmPtr->reqGridHeight);
+ results[2] = Tcl_NewWideIntObj(wmPtr->widthInc);
+ results[3] = Tcl_NewWideIntObj(wmPtr->heightInc);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
@@ -2538,8 +2538,8 @@ WmIconpositionCmd(
if (wmPtr->hints.flags & IconPositionHint) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x);
- results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y);
+ results[0] = Tcl_NewWideIntObj(wmPtr->hints.icon_x);
+ results[1] = Tcl_NewWideIntObj(wmPtr->hints.icon_y);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
}
return TCL_OK;
@@ -2777,8 +2777,8 @@ WmMaxsizeCmd(
Tcl_Obj *results[2];
GetMaxSize(wmPtr, &width, &height);
- results[0] = Tcl_NewIntObj(width);
- results[1] = Tcl_NewIntObj(height);
+ results[0] = Tcl_NewWideIntObj(width);
+ results[1] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -2835,8 +2835,8 @@ WmMinsizeCmd(
if (objc == 3) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewIntObj(wmPtr->minWidth);
- results[1] = Tcl_NewIntObj(wmPtr->minHeight);
+ results[0] = Tcl_NewWideIntObj(wmPtr->minWidth);
+ results[1] = Tcl_NewWideIntObj(wmPtr->minHeight);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -2885,7 +2885,7 @@ WmOverrideredirectCmd(
}
curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
if (objc == 3) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(curValue));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(curValue != 0));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
@@ -3121,8 +3121,8 @@ WmResizableCmd(
if (objc == 3) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE));
- results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE));
+ results[0] = Tcl_NewWideIntObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE));
+ results[1] = Tcl_NewWideIntObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE));
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -3329,7 +3329,7 @@ WmStackorderCmd(
} else { /* OPT_ISBELOW */
result = index1 < index2;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
}
return TCL_OK;
@@ -3520,7 +3520,7 @@ WmTransientCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- TkWindow *masterPtr = wmPtr->masterPtr;
+ TkWindow *masterPtr = wmPtr->masterPtr, *w;
WmInfo *wmPtr2;
if ((objc != 3) && (objc != 4)) {
@@ -3589,12 +3589,18 @@ WmTransientCmd(
return TCL_ERROR;
}
- if (masterPtr == winPtr) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't make \"%s\" its own master", Tk_PathName(winPtr)));
- Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
- return TCL_ERROR;
- } else if (masterPtr != wmPtr->masterPtr) {
+ for (w = masterPtr; w != NULL && w->wmInfoPtr != NULL;
+ w = (TkWindow *)w->wmInfoPtr->masterPtr) {
+ if (w == winPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "setting \"%s\" as master creates a transient/master cycle",
+ Tk_PathName(masterPtr)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (masterPtr != wmPtr->masterPtr) {
/*
* Remove old master map/unmap binding before setting the new
* master. The event handler will ensure that transient states
diff --git a/win/makefile.vc b/win/makefile.vc
index a216b2f..d02a94f 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -347,6 +347,9 @@ all: release $(CAT32)
core: setup $(TKSTUBLIB) $(TKLIB)
cwish: $(WISHC)
install: install-binaries install-libraries install-docs
+!if $(SYMBOLS)
+install: install-pdbs
+!endif
tktest: setup $(TKTEST) $(CAT32)
setup: default-setup
@@ -527,6 +530,11 @@ install-docs:
!endif
# "emacs font-lock highlighting fix
+install-pdbs:
+ @echo Installing debug symbols
+ @$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\"
+# "emacs font-lock highlighting fix
+
#---------------------------------------------------------------------
# Special case object file targets
#---------------------------------------------------------------------
diff --git a/win/tkWinClipboard.c b/win/tkWinClipboard.c
index 877eed4..8c6a4a4 100644
--- a/win/tkWinClipboard.c
+++ b/win/tkWinClipboard.c
@@ -79,9 +79,7 @@ TkSelGetSelection(
goto error;
}
data = GlobalLock(handle);
- Tcl_DStringInit(&ds);
- Tcl_UniCharToUtfDString((Tcl_UniChar *)data,
- Tcl_UniCharLen((Tcl_UniChar *)data), &ds);
+ Tcl_WinTCharToUtf((TCHAR *)data, -1, &ds);
GlobalUnlock(handle);
} else if (IsClipboardFormatAvailable(CF_TEXT)) {
/*
@@ -151,15 +149,15 @@ TkSelGetSelection(
if (drop->fWide) {
WCHAR *fname = (WCHAR *) ((char *) drop + drop->pFiles);
Tcl_DString dsTmp;
- int count = 0, len;
+ int count = 0;
+ size_t len;
while (*fname != 0) {
if (count) {
Tcl_DStringAppend(&ds, "\n", 1);
}
- len = Tcl_UniCharLen((Tcl_UniChar *) fname);
- Tcl_DStringInit(&dsTmp);
- Tcl_UniCharToUtfDString((Tcl_UniChar *) fname, len, &dsTmp);
+ len = wcslen(fname);
+ Tcl_WinTCharToUtf(fname, len * sizeof(WCHAR), &dsTmp);
Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsTmp),
Tcl_DStringLength(&dsTmp));
Tcl_DStringFree(&dsTmp);
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 11b556a..506247c 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -2911,13 +2911,10 @@ Tk_MessageBoxObjCmd(
flags |= icon | type | MB_TASKMODAL | MB_SETFOREGROUND;
- tmpObj = messageObj ? Tcl_DuplicateObj(messageObj)
- : Tcl_NewUnicodeObj(NULL, 0);
+ tmpObj = messageObj ? Tcl_DuplicateObj(messageObj) : Tcl_NewObj();
Tcl_IncrRefCount(tmpObj);
if (detailObj) {
- const Tcl_UniChar twoNL[] = { '\n', '\n' };
-
- Tcl_AppendUnicodeToObj(tmpObj, twoNL, 2);
+ Tcl_AppendStringsToObj(tmpObj, "\n\n", NULL);
Tcl_AppendObjToObj(tmpObj, detailObj);
}
@@ -3079,7 +3076,7 @@ GetFontObj(
Tcl_NewStringObj(Tcl_DStringValue(&ds), -1));
Tcl_DStringFree(&ds);
pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY));
- Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt));
+ Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewWideIntObj(pt));
if (plf->lfWeight >= 700) {
Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewStringObj("bold", -1));
}
@@ -3257,7 +3254,7 @@ FontchooserCget(
}
break;
case FontchooserVisible:
- resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd));
+ resObj = Tcl_NewWideIntObj((hdPtr->hwnd != NULL) && IsWindow(hdPtr->hwnd));
break;
default:
resObj = Tcl_NewStringObj("", 0);
diff --git a/win/tkWinDraw.c b/win/tkWinDraw.c
index e13a5e5..7a6e7bc 100644
--- a/win/tkWinDraw.c
+++ b/win/tkWinDraw.c
@@ -519,6 +519,7 @@ TkPutImage(
BITMAPINFO *infoPtr;
HBITMAP bitmap;
char *data;
+ Visual *visual;
display->request++;
@@ -556,7 +557,7 @@ TkPutImage(
infoPtr = ckalloc(sizeof(BITMAPINFOHEADER)
+ sizeof(RGBQUAD)*ncolors);
} else {
- infoPtr = ckalloc(sizeof(BITMAPINFOHEADER));
+ infoPtr = ckalloc(sizeof(BITMAPINFOHEADER) + sizeof(DWORD)*4);
}
infoPtr->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
@@ -564,13 +565,13 @@ TkPutImage(
infoPtr->bmiHeader.biHeight = -image->height; /* Top-down order */
infoPtr->bmiHeader.biPlanes = 1;
infoPtr->bmiHeader.biBitCount = image->bits_per_pixel;
- infoPtr->bmiHeader.biCompression = BI_RGB;
infoPtr->bmiHeader.biSizeImage = 0;
infoPtr->bmiHeader.biXPelsPerMeter = 0;
infoPtr->bmiHeader.biYPelsPerMeter = 0;
infoPtr->bmiHeader.biClrImportant = 0;
if (usePalette) {
+ infoPtr->bmiHeader.biCompression = BI_RGB;
infoPtr->bmiHeader.biClrUsed = ncolors;
for (i = 0; i < ncolors; i++) {
infoPtr->bmiColors[i].rgbBlue = GetBValue(colors[i]);
@@ -579,7 +580,13 @@ TkPutImage(
infoPtr->bmiColors[i].rgbReserved = 0;
}
} else {
- infoPtr->bmiHeader.biClrUsed = 0;
+ infoPtr->bmiHeader.biCompression = BI_BITFIELDS;
+ /* Modelled on XGetVisualInfo() in xutil.c.
+ * We want to get the rgb masks for the default visual for the given display. */
+ visual = DefaultVisual(display,0);
+ *((DWORD *)((unsigned char *)infoPtr + sizeof(BITMAPINFOHEADER))) = visual->blue_mask;
+ *((DWORD *)((unsigned char *)infoPtr + sizeof(BITMAPINFOHEADER))+1) = visual->green_mask;
+ *((DWORD *)((unsigned char *)infoPtr + sizeof(BITMAPINFOHEADER))+2) = visual->red_mask;
}
bitmap = CreateDIBitmap(dc, &infoPtr->bmiHeader, CBM_INIT,
image->data, infoPtr, DIB_RGB_COLORS);
diff --git a/win/tkWinEmbed.c b/win/tkWinEmbed.c
index daffb94..c45f088 100644
--- a/win/tkWinEmbed.c
+++ b/win/tkWinEmbed.c
@@ -856,6 +856,15 @@ ContainerEventProc(
Tk_Window tkwin = (Tk_Window)containerPtr->parentPtr;
if (eventPtr->type == ConfigureNotify) {
+
+ /*
+ * Send a ConfigureNotify to the embedded application.
+ */
+
+ if (containerPtr->embeddedPtr != NULL) {
+ TkDoConfigureNotify(containerPtr->embeddedPtr);
+ }
+
/*
* Resize the embedded window, if there is any.
*/
diff --git a/win/tkWinInit.c b/win/tkWinInit.c
index 4c18399..780888a 100644
--- a/win/tkWinInit.c
+++ b/win/tkWinInit.c
@@ -199,7 +199,7 @@ TkWin32ErrorObj(
}
#ifdef _UNICODE
- Tcl_WinTCharToUtf(lpBuffer, (int)wcslen(lpBuffer) * sizeof (WCHAR), &ds);
+ Tcl_WinTCharToUtf(lpBuffer, wcslen(lpBuffer) * sizeof (WCHAR), &ds);
errPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
#else
diff --git a/win/tkWinKey.c b/win/tkWinKey.c
index 357a804..8db34af 100644
--- a/win/tkWinKey.c
+++ b/win/tkWinKey.c
@@ -122,7 +122,7 @@ TkpGetString(
if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
|| (keysym == XK_Return) || (keysym == XK_Tab)) {
- len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf);
+ len = Tcl_UniCharToUtf(keysym & 255, buf);
Tcl_DStringAppend(dsPtr, buf, len);
}
}
diff --git a/win/tkWinMenu.c b/win/tkWinMenu.c
index b172db2..18a1260 100644
--- a/win/tkWinMenu.c
+++ b/win/tkWinMenu.c
@@ -743,7 +743,10 @@ ReconfigureWindowsMenu(
*
* TkpPostMenu --
*
- * Posts a menu on the screen
+ * Posts a menu on the screen so that the top left corner of the
+ * specified entry is located at the point (x, y) in screen coordinates.
+ * If the entry parameter is negative, the upper left corner of the
+ * menu itself is placed at the point.
*
* Results:
* None.
@@ -758,7 +761,7 @@ int
TkpPostMenu(
Tcl_Interp *interp,
TkMenu *menuPtr,
- int x, int y)
+ int x, int y, int index)
{
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
int result, flags;
@@ -770,7 +773,6 @@ TkpPostMenu(
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
tsdPtr->inPostMenu++;
-
CallPendingReconfigureImmediately(menuPtr);
result = TkPreprocessMenu(menuPtr);
@@ -779,6 +781,13 @@ TkpPostMenu(
return result;
}
+ if (index >= (int)menuPtr->numEntries) {
+ index = menuPtr->numEntries - 1;
+ }
+ if (index >= 0) {
+ y -= menuPtr->entries[index]->y;
+ }
+
/*
* The post commands could have deleted the menu, which means
* we are dead and should go away.
@@ -841,6 +850,100 @@ TkpPostMenu(
/*
*----------------------------------------------------------------------
*
+ * TkpPostTearoffMenu --
+ *
+ * Posts a tearoff menu on the screen so that the top left corner of the
+ * specified entry is located at the point (x, y) in screen coordinates.
+ * If the index parameter is negative, the upper left corner of the menu
+ * itself is placed at the point. Adjusts the menu's position so that it
+ * fits on the screen, and maps and raises the menu.
+ *
+ * Results:
+ * Returns a standard Tcl Error.
+ *
+ * Side effects:
+ * The menu is posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostTearoffMenu(
+ Tcl_Interp *interp, /* The interpreter of the menu */
+ TkMenu *menuPtr, /* The menu we are posting */
+ int x, int y, int index) /* The root X,Y coordinates where we are
+ * posting */
+{
+ int vRootX, vRootY, vRootWidth, vRootHeight;
+ int result;
+
+ if (index >= (int)menuPtr->numEntries) {
+ index = menuPtr->numEntries - 1;
+ }
+ if (index >= 0) {
+ y -= menuPtr->entries[index]->y;
+ }
+
+ TkActivateMenuEntry(menuPtr, -1);
+ TkRecomputeMenu(menuPtr);
+ result = TkPostCommand(menuPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means we are dead
+ * and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Adjust the position of the menu if necessary to keep it visible on the
+ * screen. There are two special tricks to make this work right:
+ *
+ * 1. If a virtual root window manager is being used then the coordinates
+ * are in the virtual root window of menuPtr's parent; since the menu
+ * uses override-redirect mode it will be in the *real* root window for
+ * the screen, so we have to map the coordinates from the virtual root
+ * (if any) to the real root. Can't get the virtual root from the menu
+ * itself (it will never be seen by the wm) so use its parent instead
+ * (it would be better to have an an option that names a window to use
+ * for this...).
+ * 2. The menu may not have been mapped yet, so its current size might be
+ * the default 1x1. To compute how much space it needs, use its
+ * requested size, not its actual size.
+ */
+
+ Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ vRootWidth -= Tk_ReqWidth(menuPtr->tkwin);
+ if (x > vRootX + vRootWidth) {
+ x = vRootX + vRootWidth;
+ }
+ if (x < vRootX) {
+ x = vRootX;
+ }
+ vRootHeight -= Tk_ReqHeight(menuPtr->tkwin);
+ if (y > vRootY + vRootHeight) {
+ y = vRootY + vRootHeight;
+ }
+ if (y < vRootY) {
+ y = vRootY;
+ }
+ Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
+ if (!Tk_IsMapped(menuPtr->tkwin)) {
+ Tk_MapWindow(menuPtr->tkwin);
+ }
+ TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TkpMenuNewEntry --
*
* Adds a pointer to a new menu entry structure with the platform-
@@ -1144,9 +1247,11 @@ TkWinHandleMenuEvent(
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
*plParam);
if (hashEntryPtr != NULL) {
- int i, len, underline;
+ size_t i, len, underline;
Tcl_Obj *labelPtr;
- Tcl_UniChar *wlabel, menuChar;
+ WCHAR *wlabel;
+ int menuChar;
+ Tcl_DString ds;
*plResult = 0;
menuPtr = Tcl_GetHashValue(hashEntryPtr);
@@ -1154,17 +1259,21 @@ TkWinHandleMenuEvent(
* Assume we have something directly convertable to Tcl_UniChar.
* True at least for wide systems.
*/
- menuChar = Tcl_UniCharToUpper((Tcl_UniChar) LOWORD(*pwParam));
+ menuChar = Tcl_UniCharToUpper(LOWORD(*pwParam));
- for (i = 0; i < menuPtr->numEntries; i++) {
+ Tcl_DStringInit(&ds);
+ for (i = 0; i < (size_t)menuPtr->numEntries; i++) {
underline = menuPtr->entries[i]->underline;
labelPtr = menuPtr->entries[i]->labelPtr;
- if ((underline >= 0) && (labelPtr != NULL)) {
+ if ((underline != (size_t)-1) && (labelPtr != NULL)) {
/*
* Ensure we don't exceed the label length, then check
*/
- wlabel = Tcl_GetUnicodeFromObj(labelPtr, &len);
- if ((underline < len) && (menuChar ==
+ const char *src = TkGetStringFromObj(labelPtr, &len);
+
+ Tcl_DStringFree(&ds);
+ wlabel = (WCHAR *) Tcl_WinUtfToTChar(src, len, &ds);
+ if ((underline + 1 < len + 1) && (menuChar ==
Tcl_UniCharToUpper(wlabel[underline]))) {
*plResult = (2 << 16) | i;
returnResult = 1;
@@ -1172,6 +1281,7 @@ TkWinHandleMenuEvent(
}
}
}
+ Tcl_DStringFree(&ds);
}
break;
}
@@ -1300,7 +1410,7 @@ TkWinHandleMenuEvent(
}
mePtr = NULL;
if (flags != 0xFFFF) {
- if ((flags&MF_POPUP) && (entryIndex<menuPtr->numEntries)) {
+ if ((flags&MF_POPUP) && (entryIndex < (int)menuPtr->numEntries)) {
mePtr = menuPtr->entries[entryIndex];
} else {
hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
@@ -1314,7 +1424,7 @@ TkWinHandleMenuEvent(
if ((mePtr == NULL) || (mePtr->state == ENTRY_DISABLED)) {
TkActivateMenuEntry(menuPtr, -1);
} else {
- if (mePtr->index >= menuPtr->numEntries) {
+ if (mePtr->index >= (int)menuPtr->numEntries) {
Tcl_Panic("Trying to activate an entry which doesn't exist");
}
TkActivateMenuEntry(menuPtr, mePtr->index);
@@ -1351,7 +1461,7 @@ void
RecursivelyClearActiveMenu(
TkMenu *menuPtr) /* The menu to reset. */
{
- int i;
+ TkSizeT i;
TkMenuEntry *mePtr;
TkActivateMenuEntry(menuPtr, -1);
@@ -1967,8 +2077,7 @@ DrawMenuUnderline(
if ((mePtr->underline >= 0) && (mePtr->labelPtr != NULL)) {
int len;
- /* do the unicode call just to prevent overruns */
- Tcl_GetUnicodeFromObj(mePtr->labelPtr, &len);
+ len = Tcl_GetCharLength(mePtr->labelPtr);
if (mePtr->underline < len) {
const char *label, *start, *end;
@@ -2363,7 +2472,7 @@ DrawMenuEntryLabel(
XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
(unsigned) width, (unsigned) height);
} else if ((mePtr->image != NULL)
- && (menuPtr->disabledImageGC != NULL)) {
+ && menuPtr->disabledImageGC) {
XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
leftEdge + imageXOffset,
(int) (y + (mePtr->height - imageHeight)/2 + imageYOffset),
@@ -2875,7 +2984,7 @@ TkpComputeStandardMenuGeometry(
Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
menuPtr->activeBorderWidthPtr, &activeBorderWidth);
- for (i = 0; i < menuPtr->numEntries; i++) {
+ for (i = 0; i < (int)menuPtr->numEntries; i++) {
if (menuPtr->entries[i]->fontPtr == NULL) {
tkfont = menuFont;
fmPtr = &menuMetrics;
@@ -2912,7 +3021,6 @@ TkpComputeStandardMenuGeometry(
GetTearoffEntryGeometry(menuPtr, menuPtr->entries[i], tkfont,
fmPtr, &width, &height);
menuPtr->entries[i]->height = height;
-
} else {
/*
* For each entry, compute the height required by that particular
@@ -2960,7 +3068,7 @@ TkpComputeStandardMenuGeometry(
if (accelWidth != 0) {
labelWidth += accelSpace;
}
- for (j = lastColumnBreak; j < menuPtr->numEntries; j++) {
+ for (j = lastColumnBreak; j < (int)menuPtr->numEntries; j++) {
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
@@ -2970,8 +3078,6 @@ TkpComputeStandardMenuGeometry(
}
windowWidth = x + indicatorSpace + labelWidth + accelWidth
+ 2 * activeBorderWidth + borderWidth;
-
-
windowHeight += borderWidth;
/*
@@ -3188,7 +3294,7 @@ TkWinGetMenuSystemDefault(
if ((strcmp(dbName, "activeBorderWidth") == 0) ||
(strcmp(dbName, "borderWidth") == 0)) {
- valuePtr = Tcl_NewIntObj(defaultBorderWidth);
+ valuePtr = Tcl_NewWideIntObj(defaultBorderWidth);
} else if (strcmp(dbName, "font") == 0) {
valuePtr = Tcl_NewStringObj(Tcl_DStringValue(&menuFontDString), -1);
}
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index 81ae667..bd57ceb 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.c
@@ -2823,8 +2823,8 @@ Tk_WmObjCmd(
return TCL_ERROR;
}
if (objc == 2) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- dispPtr->flags & TK_DISPLAY_WM_TRACING));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ (dispPtr->flags & TK_DISPLAY_WM_TRACING) != 0));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
@@ -2968,10 +2968,10 @@ WmAspectCmd(
if (wmPtr->sizeHintsFlags & PAspect) {
Tcl_Obj *results[4];
- results[0] = Tcl_NewIntObj(wmPtr->minAspect.x);
- results[1] = Tcl_NewIntObj(wmPtr->minAspect.y);
- results[2] = Tcl_NewIntObj(wmPtr->maxAspect.x);
- results[3] = Tcl_NewIntObj(wmPtr->maxAspect.y);
+ results[0] = Tcl_NewWideIntObj(wmPtr->minAspect.x);
+ results[1] = Tcl_NewWideIntObj(wmPtr->minAspect.y);
+ results[2] = Tcl_NewWideIntObj(wmPtr->maxAspect.x);
+ results[3] = Tcl_NewWideIntObj(wmPtr->maxAspect.y);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
@@ -3060,19 +3060,19 @@ WmAttributesCmd(
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj("-disabled", -1));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewBooleanObj((style & WS_DISABLED)));
+ Tcl_NewWideIntObj((style & WS_DISABLED) != 0));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj("-fullscreen", -1));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewBooleanObj((wmPtr->flags & WM_FULLSCREEN)));
+ Tcl_NewWideIntObj((wmPtr->flags & WM_FULLSCREEN) != 0));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj("-toolwindow", -1));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewBooleanObj((exStyle & WS_EX_TOOLWINDOW)));
+ Tcl_NewWideIntObj((exStyle & WS_EX_TOOLWINDOW) != 0));
Tcl_ListObjAppendElement(NULL, objPtr,
Tcl_NewStringObj("-topmost", -1));
Tcl_ListObjAppendElement(NULL, objPtr,
- Tcl_NewBooleanObj((exStyle & WS_EX_TOPMOST)));
+ Tcl_NewWideIntObj((exStyle & WS_EX_TOPMOST) != 0));
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
@@ -3210,8 +3210,8 @@ WmAttributesCmd(
}
if (config_fullscreen) {
if (objc == 4) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
- wmPtr->flags & WM_FULLSCREEN));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+ (wmPtr->flags & WM_FULLSCREEN) != 0));
} else {
fullscreen_attr_changed = 1;
fullscreen_attr = boolean;
@@ -3219,7 +3219,7 @@ WmAttributesCmd(
config_fullscreen = 0;
} else if (objc == 4) {
Tcl_SetObjResult(interp,
- Tcl_NewBooleanObj(*stylePtr & styleBit));
+ Tcl_NewWideIntObj((*stylePtr & styleBit) != 0));
} else if (boolean) {
*stylePtr |= styleBit;
} else {
@@ -3837,10 +3837,10 @@ WmGridCmd(
if (wmPtr->sizeHintsFlags & PBaseSize) {
Tcl_Obj *results[4];
- results[0] = Tcl_NewIntObj(wmPtr->reqGridWidth);
- results[1] = Tcl_NewIntObj(wmPtr->reqGridHeight);
- results[2] = Tcl_NewIntObj(wmPtr->widthInc);
- results[3] = Tcl_NewIntObj(wmPtr->heightInc);
+ results[0] = Tcl_NewWideIntObj(wmPtr->reqGridWidth);
+ results[1] = Tcl_NewWideIntObj(wmPtr->reqGridHeight);
+ results[2] = Tcl_NewWideIntObj(wmPtr->widthInc);
+ results[3] = Tcl_NewWideIntObj(wmPtr->heightInc);
Tcl_SetObjResult(interp, Tcl_NewListObj(4, results));
}
return TCL_OK;
@@ -4502,8 +4502,8 @@ WmIconpositionCmd(
if (wmPtr->hints.flags & IconPositionHint) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewIntObj(wmPtr->hints.icon_x);
- results[1] = Tcl_NewIntObj(wmPtr->hints.icon_y);
+ results[0] = Tcl_NewWideIntObj(wmPtr->hints.icon_x);
+ results[1] = Tcl_NewWideIntObj(wmPtr->hints.icon_y);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
}
return TCL_OK;
@@ -4722,8 +4722,8 @@ WmMaxsizeCmd(
Tcl_Obj *results[2];
GetMaxSize(wmPtr, &width, &height);
- results[0] = Tcl_NewIntObj(width);
- results[1] = Tcl_NewIntObj(height);
+ results[0] = Tcl_NewWideIntObj(width);
+ results[1] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -4773,8 +4773,8 @@ WmMinsizeCmd(
Tcl_Obj *results[2];
GetMinSize(wmPtr, &width, &height);
- results[0] = Tcl_NewIntObj(width);
- results[1] = Tcl_NewIntObj(height);
+ results[0] = Tcl_NewWideIntObj(width);
+ results[1] = Tcl_NewWideIntObj(height);
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -4833,7 +4833,7 @@ WmOverrideredirectCmd(
curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
}
if (objc == 3) {
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(curValue));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(curValue != 0));
return TCL_OK;
}
if (Tcl_GetBooleanFromObj(interp, objv[3], &boolean) != TCL_OK) {
@@ -5060,8 +5060,8 @@ WmResizableCmd(
if (objc == 3) {
Tcl_Obj *results[2];
- results[0] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE));
- results[1] = Tcl_NewBooleanObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE));
+ results[0] = Tcl_NewWideIntObj(!(wmPtr->flags&WM_WIDTH_NOT_RESIZABLE));
+ results[1] = Tcl_NewWideIntObj(!(wmPtr->flags&WM_HEIGHT_NOT_RESIZABLE));
Tcl_SetObjResult(interp, Tcl_NewListObj(2, results));
return TCL_OK;
}
@@ -5279,7 +5279,7 @@ WmStackorderCmd(
} else { /* OPT_ISBELOW */
result = index1 < index2;
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
}
}
@@ -5526,7 +5526,7 @@ WmTransientCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
- TkWindow *masterPtr = wmPtr->masterPtr, **masterPtrPtr = &masterPtr;
+ TkWindow *masterPtr = wmPtr->masterPtr, **masterPtrPtr = &masterPtr, *w;
WmInfo *wmPtr2;
if ((objc != 3) && (objc != 4)) {
@@ -5584,13 +5584,17 @@ WmTransientCmd(
Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "ICON", NULL);
return TCL_ERROR;
}
-
- if (masterPtr == winPtr) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't make \"%s\" its own master", Tk_PathName(winPtr)));
- Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
- return TCL_ERROR;
- } else if (masterPtr != wmPtr->masterPtr) {
+ for (w = masterPtr; w != NULL && w->wmInfoPtr != NULL;
+ w = (TkWindow *)w->wmInfoPtr->masterPtr) {
+ if (w == winPtr) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "setting \"%s\" as master creates a transient/master cycle",
+ Tk_PathName(masterPtr)));
+ Tcl_SetErrorCode(interp, "TK", "WM", "TRANSIENT", "SELF", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (masterPtr != wmPtr->masterPtr) {
/*
* Remove old master map/unmap binding before setting the new
* master. The event handler will ensure that transient states
diff --git a/win/tkWinX.c b/win/tkWinX.c
index 7b91596..3ba341d 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -457,21 +457,21 @@ TkWinDisplayChanged(
} else if (screen->root_depth == 12) {
screen->root_visual->class = TrueColor;
screen->root_visual->map_entries = 32;
- screen->root_visual->red_mask = 0xf0;
+ screen->root_visual->red_mask = 0xf00000;
screen->root_visual->green_mask = 0xf000;
- screen->root_visual->blue_mask = 0xf00000;
+ screen->root_visual->blue_mask = 0xf0;
} else if (screen->root_depth == 16) {
screen->root_visual->class = TrueColor;
screen->root_visual->map_entries = 64;
- screen->root_visual->red_mask = 0xf8;
+ screen->root_visual->red_mask = 0xf80000;
screen->root_visual->green_mask = 0xfc00;
- screen->root_visual->blue_mask = 0xf80000;
+ screen->root_visual->blue_mask = 0xf8;
} else if (screen->root_depth >= 24) {
screen->root_visual->class = TrueColor;
screen->root_visual->map_entries = 256;
- screen->root_visual->red_mask = 0xff;
+ screen->root_visual->red_mask = 0xff0000;
screen->root_visual->green_mask = 0xff00;
- screen->root_visual->blue_mask = 0xff0000;
+ screen->root_visual->blue_mask = 0xff;
}
screen->root_visual->bits_per_rgb = screen->root_depth;
ReleaseDC(NULL, dc);
@@ -567,6 +567,11 @@ TkpOpenDisplay(
tsdPtr->wheelTickPrev = GetTickCount();
tsdPtr->wheelAcc = 0;
+ /*
+ * Key map info must be available immediately, because of "send event".
+ */
+ TkpInitKeymapInfo(tsdPtr->winDisplay);
+
return tsdPtr->winDisplay;
}
diff --git a/win/ttkWinXPTheme.c b/win/ttkWinXPTheme.c
index 3fad20c..0a5ac30 100644
--- a/win/ttkWinXPTheme.c
+++ b/win/ttkWinXPTheme.c
@@ -451,7 +451,7 @@ InitElementData(ElementData *elementData, Tk_Window tkwin, Drawable d)
{
Window win = Tk_WindowId(tkwin);
- if (win != None) {
+ if (win) {
elementData->hwnd = Tk_GetHWND(win);
} else {
elementData->hwnd = elementData->procs->stubWindow;
@@ -825,16 +825,21 @@ static void TextElementSize(
ElementData *elementData = clientData;
RECT rc = {0, 0};
HRESULT hr = S_OK;
+ const char *src;
+ size_t len;
+ Tcl_DString ds;
if (!InitElementData(elementData, tkwin, 0))
return;
+ src = TkGetStringFromObj(element->textObj, &len);
+ Tcl_WinUtfToTChar(src, len, &ds);
hr = elementData->procs->GetThemeTextExtent(
elementData->hTheme,
elementData->hDC,
elementData->info->partId,
Ttk_StateTableLookup(elementData->info->statemap, 0),
- Tcl_GetUnicode(element->textObj),
+ (WCHAR *) Tcl_DStringValue(&ds),
-1,
DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
NULL,
@@ -847,6 +852,7 @@ static void TextElementSize(
if (*widthPtr < 80) *widthPtr = 80;
if (*heightPtr < 20) *heightPtr = 20;
+ Tcl_DStringFree(&ds);
FreeElementData(elementData);
}
@@ -858,20 +864,27 @@ static void TextElementDraw(
ElementData *elementData = clientData;
RECT rc = BoxToRect(b);
HRESULT hr = S_OK;
+ const char *src;
+ size_t len;
+ Tcl_DString ds;
if (!InitElementData(elementData, tkwin, d))
return;
+ src = TkGetStringFromObj(element->textObj, &len);
+ Tcl_WinUtfToTChar(src, len, &ds);
hr = elementData->procs->DrawThemeText(
elementData->hTheme,
elementData->hDC,
elementData->info->partId,
Ttk_StateTableLookup(elementData->info->statemap, state),
- Tcl_GetUnicode(element->textObj),
+ (WCHAR *) Tcl_DStringValue(&ds),
-1,
DT_LEFT,// | DT_BOTTOM | DT_NOPREFIX,
(state & TTK_STATE_DISABLED) ? DTT_GRAYED : 0,
&rc);
+
+ Tcl_DStringFree(&ds);
FreeElementData(elementData);
}
@@ -1098,15 +1111,16 @@ Ttk_CreateVsapiElement(
XPThemeData *themeData = clientData;
ElementInfo *elementPtr = NULL;
ClientData elementData;
- Tcl_UniChar *className;
+ WCHAR *className;
int partId = 0;
Ttk_StateTable *stateTable;
Ttk_Padding pad = {0, 0, 0, 0};
int flags = 0;
- int length = 0;
+ size_t length = 0;
char *name;
LPWSTR wname;
Ttk_ElementSpec *elementSpec = &GenericElementSpec;
+ Tcl_DString classBuf;
static const char *const optionStrings[] =
{ "-padding","-width","-height","-margins", "-syssize",
@@ -1124,7 +1138,8 @@ Ttk_CreateVsapiElement(
if (Tcl_GetIntFromObj(interp, objv[1], &partId) != TCL_OK) {
return TCL_ERROR;
}
- className = Tcl_GetUnicodeFromObj(objv[0], &length);
+ name = TkGetStringFromObj(objv[0], &length);
+ className = (WCHAR *) Tcl_WinUtfToTChar(name, length, &classBuf);
/* flags or padding */
if (objc > 3) {
@@ -1136,54 +1151,54 @@ Ttk_CreateVsapiElement(
"Missing value for \"%s\".",
Tcl_GetString(objv[i])));
Tcl_SetErrorCode(interp, "TTK", "VSAPI", "MISSING", NULL);
- return TCL_ERROR;
+ goto retErr;
}
if (Tcl_GetIndexFromObjStruct(interp, objv[i], optionStrings,
sizeof(char *), "option", 0, &option) != TCL_OK)
- return TCL_ERROR;
+ goto retErr;
switch (option) {
case O_PADDING:
if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
break;
case O_MARGINS:
if (Ttk_GetBorderFromObj(interp, objv[i+1], &pad) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
flags |= PAD_MARGINS;
break;
case O_WIDTH:
if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
pad.left = pad.right = tmp;
flags |= IGNORE_THEMESIZE;
break;
case O_HEIGHT:
if (Tcl_GetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
pad.top = pad.bottom = tmp;
flags |= IGNORE_THEMESIZE;
break;
case O_SYSSIZE:
if (GetSysFlagFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
elementSpec = &GenericSizedElementSpec;
flags |= (tmp & 0xFFFF);
break;
case O_HALFHEIGHT:
if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
if (tmp)
flags |= HALF_HEIGHT;
break;
case O_HALFWIDTH:
if (Tcl_GetBooleanFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
- return TCL_ERROR;
+ goto retErr;
}
if (tmp)
flags |= HALF_WIDTH;
@@ -1197,7 +1212,7 @@ Ttk_CreateVsapiElement(
Tcl_Obj **specs;
int n,j,count, status = TCL_OK;
if (Tcl_ListObjGetElements(interp, objv[2], &count, &specs) != TCL_OK)
- return TCL_ERROR;
+ goto retErr;
/* we over-allocate to ensure there is a terminating entry */
stateTable = ckalloc(sizeof(Ttk_StateTable) * (count + 1));
memset(stateTable, 0, sizeof(Ttk_StateTable) * (count + 1));
@@ -1213,6 +1228,7 @@ Ttk_CreateVsapiElement(
}
if (status != TCL_OK) {
ckfree(stateTable);
+ Tcl_DStringFree(&classBuf);
return status;
}
} else {
@@ -1233,7 +1249,7 @@ Ttk_CreateVsapiElement(
elementPtr->elementName = name;
/* set the class name to an allocated copy */
- wname = ckalloc(sizeof(WCHAR) * (length + 1));
+ wname = ckalloc(Tcl_DStringLength(&classBuf) + sizeof(WCHAR));
wcscpy(wname, className);
elementPtr->className = wname;
@@ -1243,7 +1259,12 @@ Ttk_CreateVsapiElement(
Ttk_RegisterCleanup(interp, elementData, DestroyElementData);
Tcl_SetObjResult(interp, Tcl_NewStringObj(elementName, -1));
+ Tcl_DStringFree(&classBuf);
return TCL_OK;
+
+retErr:
+ Tcl_DStringFree(&classBuf);
+ return TCL_ERROR;
}
/*----------------------------------------------------------------------