summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-01-20 14:37:27 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-01-20 14:37:27 (GMT)
commitb8a68d0c335e5b303b12e9fd8194e27be780a219 (patch)
tree17fd1a08d397cdc6fc894f06d6de1d3c2eb7c142
parent0c33edcbe038707fa9ad175f159140800fc6c621 (diff)
downloadtk-b8a68d0c335e5b303b12e9fd8194e27be780a219.zip
tk-b8a68d0c335e5b303b12e9fd8194e27be780a219.tar.gz
tk-b8a68d0c335e5b303b12e9fd8194e27be780a219.tar.bz2
Smarter initialization of doubleTypePtr/intTypePtr without hash-table lookup or creating complete Tcl_Obj's.
In Windows tests, allow up to 64 bits for HWND. Check stubs for "8.6-" in stead of "8.6", for better interoperability with "novem".
-rw-r--r--generic/tkConsole.c2
-rw-r--r--generic/tkIntXlibDecls.h4
-rw-r--r--generic/tkMain.c2
-rw-r--r--generic/tkObj.c15
-rw-r--r--generic/tkTest.c2
-rw-r--r--generic/tkWindow.c2
-rw-r--r--win/tkWinTest.c18
7 files changed, 30 insertions, 15 deletions
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index fc60d5f..57e8364 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.c
@@ -223,7 +223,7 @@ Tk_InitConsoleChannels(
* Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
return;
}
diff --git a/generic/tkIntXlibDecls.h b/generic/tkIntXlibDecls.h
index de44068..ce9752f 100644
--- a/generic/tkIntXlibDecls.h
+++ b/generic/tkIntXlibDecls.h
@@ -23,6 +23,10 @@
# include <tcl.h>
#endif
+#ifndef EXTERN
+# define EXTERN extern TCL_STORAGE_CLASS
+#endif
+
/* Some (older) versions of X11/Xutil.h have a wrong signature of those
two functions, so move them out of the way temporarly. */
#define XOffsetRegion _XOffsetRegion
diff --git a/generic/tkMain.c b/generic/tkMain.c
index 1b21223..87a3cf7 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -196,7 +196,7 @@ Tk_MainEx(
* Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
abort();
} else {
diff --git a/generic/tkObj.c b/generic/tkObj.c
index 7c09656..90fedbc 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.c
@@ -153,8 +153,19 @@ GetTypeCache(void)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (tsdPtr->doubleTypePtr == NULL) {
- tsdPtr->doubleTypePtr = Tcl_GetObjType("double");
- tsdPtr->intTypePtr = Tcl_GetObjType("int");
+ /* Smart initialization of doubleTypePtr/intTypePtr without
+ * hash-table lookup or creating complete Tcl_Obj's */
+ Tcl_Obj obj;
+ obj.length = 3;
+ obj.bytes = (char *)"0.0";
+ obj.typePtr = NULL;
+ Tcl_GetDoubleFromObj(NULL, &obj, &obj.internalRep.doubleValue);
+ tsdPtr->doubleTypePtr = obj.typePtr;
+ obj.bytes += 2;
+ obj.length = 1;
+ obj.typePtr = NULL;
+ Tcl_GetLongFromObj(NULL, &obj, &obj.internalRep.longValue);
+ tsdPtr->intTypePtr = obj.typePtr;
}
return tsdPtr;
}
diff --git a/generic/tkTest.c b/generic/tkTest.c
index faba89d..e23be36 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -227,7 +227,7 @@ Tktest_Init(
{
static int initialized = 0;
- if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
return TCL_ERROR;
}
if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 20b4f20..f02db35 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -3040,7 +3040,7 @@ Initialize(
* Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
return TCL_ERROR;
}
diff --git a/win/tkWinTest.c b/win/tkWinTest.c
index d824ee4..095358d 100644
--- a/win/tkWinTest.c
+++ b/win/tkWinTest.c
@@ -483,7 +483,7 @@ TestfindwindowObjCmd(
AppendSystemError(interp, GetLastError());
r = TCL_ERROR;
} else {
- Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((size_t)hwnd));
}
Tcl_DStringFree(&titleString);
@@ -499,7 +499,7 @@ EnumChildrenProc(
{
Tcl_Obj *listObj = (Tcl_Obj *) lParam;
- Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj(PTR2INT(hwnd)));
+ Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewWideIntObj((size_t)hwnd));
return TRUE;
}
@@ -510,7 +510,7 @@ TestgetwindowinfoObjCmd(
int objc,
Tcl_Obj *const objv[])
{
- long hwnd;
+ Tcl_WideInt hwnd;
Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL;
Tcl_Obj *childrenObj = NULL;
TCHAR buf[512];
@@ -521,10 +521,10 @@ TestgetwindowinfoObjCmd(
return TCL_ERROR;
}
- if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK)
+ if (Tcl_GetWideIntFromObj(interp, objv[1], &hwnd) != TCL_OK)
return TCL_ERROR;
- cch = GetClassName(INT2PTR(hwnd), buf, cchBuf);
+ cch = GetClassName((HWND)(size_t)hwnd, buf, cchBuf);
if (cch == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1));
AppendSystemError(interp, GetLastError());
@@ -539,17 +539,17 @@ TestgetwindowinfoObjCmd(
dictObj = Tcl_NewDictObj();
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2),
- Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID)));
+ Tcl_NewWideIntObj(GetWindowLongPtr((HWND)(size_t)hwnd, GWL_ID)));
- cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf);
+ cch = GetWindowText((HWND)(size_t)hwnd, (LPTSTR)buf, cchBuf);
textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6),
- Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd))))));
+ Tcl_NewWideIntObj((size_t)(GetParent((HWND)(size_t)hwnd))));
childrenObj = Tcl_NewListObj(0, NULL);
- EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj);
+ EnumChildWindows((HWND)(size_t)hwnd, EnumChildrenProc, (LPARAM)childrenObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj);
Tcl_SetObjResult(interp, dictObj);