summaryrefslogtreecommitdiffstats
path: root/win/tkWinTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tkWinTest.c')
-rw-r--r--win/tkWinTest.c222
1 files changed, 124 insertions, 98 deletions
diff --git a/win/tkWinTest.c b/win/tkWinTest.c
index 69d5a11..4a6b4f0 100644
--- a/win/tkWinTest.c
+++ b/win/tkWinTest.c
@@ -11,9 +11,13 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkWinTest.c,v 1.14.2.3 2010/03/12 13:02:36 nijtmans Exp $
+ * RCS: @(#) $Id: tkWinTest.c,v 1.34 2010/10/06 14:33:30 nijtmans Exp $
*/
+#undef USE_TCL_STUBS
+#define USE_TCL_STUBS
+#undef USE_TK_STUBS
+#define USE_TK_STUBS
#include "tkWinInt.h"
HWND tkWinCurrentDialog;
@@ -24,21 +28,38 @@ HWND tkWinCurrentDialog;
static int TestclipboardObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
static int TestwineventCmd(ClientData clientData,
- Tcl_Interp *interp, int argc, CONST char **argv);
+ Tcl_Interp *interp, int argc, const char **argv);
static int TestfindwindowObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
static int TestgetwindowinfoObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
+ Tcl_Obj *const objv[]);
static int TestwinlocaleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int TkplatformtestInit(Tcl_Interp *interp);
+static Tk_GetSelProc SetSelectionResult;
+static const TkWinProcs unicodeProcs = {
+ 1,
+ (LRESULT (WINAPI *)(WNDPROC, HWND, UINT, WPARAM, LPARAM)) CallWindowProcW,
+ (LRESULT (WINAPI *)(HWND, UINT, WPARAM, LPARAM)) DefWindowProcW,
+ (ATOM (WINAPI *)(const WNDCLASS *)) RegisterClassW,
+ (BOOL (WINAPI *)(HWND, LPCTSTR)) SetWindowTextW,
+ (HWND (WINAPI *)(DWORD, LPCTSTR, LPCTSTR, DWORD, int, int, int, int,
+ HWND, HMENU, HINSTANCE, LPVOID)) CreateWindowExW,
+ (BOOL (WINAPI *)(HMENU, UINT, UINT, UINT, LPCTSTR)) InsertMenuW,
+ (int (WINAPI *)(HWND, LPCTSTR, int)) GetWindowTextW,
+ (HWND (WINAPI *)(LPCTSTR, LPCTSTR)) FindWindowW,
+ (int (WINAPI *)(HWND, LPTSTR, int)) GetClassNameW,
+};
+
+static const TkWinProcs *const tkTestWinProcs = &unicodeProcs;
+
+
/*
*----------------------------------------------------------------------
*
@@ -101,12 +122,16 @@ AppendSystemError(
{
int length;
WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
- char *msg;
+ const char *msg;
char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
Tcl_DString ds;
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ if (Tcl_IsShared(resultPtr)) {
+ resultPtr = Tcl_DuplicateObj(resultPtr);
+ }
length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_IGNORE_INSERTS
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
0, NULL);
@@ -114,6 +139,7 @@ AppendSystemError(
char *msgPtr;
length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_IGNORE_INSERTS
| FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr,
0, NULL);
@@ -126,36 +152,41 @@ AppendSystemError(
}
if (length == 0) {
if (error == ERROR_CALL_NOT_IMPLEMENTED) {
- msg = "function not supported under Win32s";
+ strcpy(msgBuf, "function not supported under Win32s");
} else {
sprintf(msgBuf, "unknown error: %ld", error);
- msg = msgBuf;
}
+ msg = msgBuf;
} else {
Tcl_Encoding encoding;
+ char *msgPtr;
encoding = Tcl_GetEncoding(NULL, "unicode");
- msg = Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
+ Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds);
Tcl_FreeEncoding(encoding);
LocalFree(wMsgPtr);
+ msgPtr = Tcl_DStringValue(&ds);
length = Tcl_DStringLength(&ds);
/*
* Trim the trailing CR/LF from the system message.
*/
- if (msg[length-1] == '\n') {
- msg[--length] = 0;
+ if (msgPtr[length-1] == '\n') {
+ --length;
}
- if (msg[length-1] == '\r') {
- msg[--length] = 0;
+ if (msgPtr[length-1] == '\r') {
+ --length;
}
+ msgPtr[length] = 0;
+ msg = msgPtr;
}
sprintf(id, "%ld", error);
Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
Tcl_AppendToObj(resultPtr, msg, length);
+ Tcl_SetObjResult(interp, resultPtr);
if (length != 0) {
Tcl_DStringFree(&ds);
@@ -180,44 +211,30 @@ AppendSystemError(
*/
static int
+SetSelectionResult(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ const char *selection)
+{
+ Tcl_AppendResult(interp, selection, NULL);
+ return TCL_OK;
+}
+
+static int
TestclipboardObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument values. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
- HGLOBAL handle;
- char *data;
- int code = TCL_OK;
+ Tk_Window tkwin = (Tk_Window) clientData;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- if (OpenClipboard(NULL)) {
- /*
- * We could consider using CF_UNICODETEXT on NT, but then we would
- * have to convert it from External. Instead we'll just take this and
- * do "bytestring" at the Tcl level for Unicode inclusive text
- */
-
- handle = GetClipboardData(CF_TEXT);
- if (handle != NULL) {
- data = GlobalLock(handle);
- Tcl_AppendResult(interp, data, NULL);
- GlobalUnlock(handle);
- } else {
- Tcl_AppendResult(interp, "null clipboard handle", NULL);
- code = TCL_ERROR;
- }
- CloseClipboard();
- return code;
- } else {
- Tcl_AppendResult(interp, "couldn't open clipboard: ", NULL);
- AppendSystemError(interp, GetLastError());
- return TCL_ERROR;
- }
- return TCL_OK;
+ return TkSelGetSelection(interp, tkwin, Tk_InternAtom(tkwin, "CLIPBOARD"),
+ XA_STRING, SetSelectionResult, NULL);
}
/*
@@ -242,7 +259,7 @@ TestwineventCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
- CONST char **argv) /* Argument strings. */
+ const char **argv) /* Argument strings. */
{
HWND hwnd = 0;
HWND child = 0;
@@ -275,9 +292,19 @@ TestwineventCmd(
return TCL_ERROR;
}
+#if 0
+ TkpScanWindowId(interp, argv[1], &id);
+ if (
+#ifdef _WIN64
+ (sscanf(string, "0x%p", &number) != 1) &&
+#endif /* _WIN64 */
+ Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+#endif
hwnd = (HWND) strtol(argv[1], &rest, 0);
if (rest == argv[1]) {
- hwnd = FindWindow(NULL, argv[1]);
+ hwnd = FindWindowA(NULL, argv[1]);
if (hwnd == NULL) {
Tcl_SetResult(interp, "no such window", TCL_STATIC);
return TCL_ERROR;
@@ -291,7 +318,7 @@ TestwineventCmd(
child = GetWindow(hwnd, GW_CHILD);
while (child != NULL) {
- SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
+ SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
if (strcasecmp(buf, argv[2]) == 0) {
id = GetDlgCtrlID(child);
break;
@@ -305,9 +332,6 @@ TestwineventCmd(
}
}
message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
- if (message < 0) {
- message = strtol(argv[3], NULL, 0);
- }
wParam = 0;
lParam = 0;
@@ -323,7 +347,7 @@ TestwineventCmd(
Tcl_DString ds;
char buf[256];
- GetDlgItemText(hwnd, id, buf, 256);
+ GetDlgItemTextA(hwnd, id, buf, 256);
Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
Tcl_DStringFree(&ds);
@@ -333,7 +357,7 @@ TestwineventCmd(
Tcl_DString ds;
Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
- SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
+ SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
break;
}
@@ -343,7 +367,7 @@ TestwineventCmd(
wParam = MAKEWPARAM(id, 0);
lParam = (LPARAM)child;
}
- sprintf(buf, "%d", (int) SendMessage(hwnd, message, wParam, lParam));
+ sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
break;
}
@@ -351,7 +375,7 @@ TestwineventCmd(
char buf[TCL_INTEGER_SPACE];
sprintf(buf, "%d",
- (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam));
+ (int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
break;
}
@@ -362,7 +386,7 @@ TestwineventCmd(
/*
* testfindwindow title ?class?
* Find a Windows window using the FindWindow API call. This takes the window
- * title and optionally the window class and if found returns the HWND and
+ * title and optionally the window class and if found returns the HWND and
* raises an error if the window is not found.
* eg: testfindwindow Console TkTopLevel
* Can find the console window if it is visible.
@@ -375,20 +399,27 @@ TestfindwindowObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *CONST objv[]) /* Argument values. */
+ Tcl_Obj *const objv[]) /* Argument values. */
{
- const char *title = NULL, *class = NULL;
+ const TCHAR *title = NULL, *class = NULL;
+ Tcl_DString titleString, classString;
HWND hwnd = NULL;
int r = TCL_OK;
+ Tcl_DStringInit(&classString);
+ Tcl_DStringInit(&titleString);
+
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
return TCL_ERROR;
}
- title = Tcl_GetString(objv[1]);
- if (objc == 3)
- class = Tcl_GetString(objv[2]);
- hwnd = FindWindowA(class, title);
+
+ title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString);
+ if (objc == 3) {
+ class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString);
+ }
+
+ hwnd = tkTestWinProcs->findWindow(class, title);
if (hwnd == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
@@ -397,15 +428,21 @@ TestfindwindowObjCmd(
} else {
Tcl_SetObjResult(interp, Tcl_NewLongObj((long)hwnd));
}
+
+ Tcl_DStringFree(&titleString);
+ Tcl_DStringFree(&classString);
return r;
-
+
}
static BOOL CALLBACK
-EnumChildrenProc(HWND hwnd, LPARAM lParam)
+EnumChildrenProc(
+ HWND hwnd,
+ LPARAM lParam)
{
- Tcl_Obj *listObj = (Tcl_Obj *)lParam;
- Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj((long)hwnd));
+ Tcl_Obj *listObj = (Tcl_Obj *) lParam;
+
+ Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewLongObj((long) hwnd));
return TRUE;
}
@@ -414,13 +451,13 @@ TestgetwindowinfoObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST objv[])
+ Tcl_Obj *const objv[])
{
long hwnd;
- Tcl_Obj *resObj = NULL, *classObj = NULL, *textObj = NULL;
+ Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL;
Tcl_Obj *childrenObj = NULL;
- char buf[512];
- int cch, cchBuf = tkWinProcs->useWide ? 256 : 512;
+ TCHAR buf[512];
+ int cch, cchBuf = 256;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "hwnd");
@@ -429,49 +466,38 @@ TestgetwindowinfoObjCmd(
if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK)
return TCL_ERROR;
-
- if (tkWinProcs->useWide) {
- cch = GetClassNameW((HWND)hwnd, (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR));
- classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch);
- } else {
- cch = GetClassNameA((HWND)hwnd, (LPSTR)buf, sizeof(buf));
- classObj = Tcl_NewStringObj((LPSTR)buf, cch);
- }
+
+ cch = tkTestWinProcs->getClassName((HWND)hwnd, buf, cchBuf);
if (cch == 0) {
Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC);
AppendSystemError(interp, GetLastError());
return TCL_ERROR;
- }
-
- resObj = Tcl_NewListObj(0, NULL);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("class", -1));
- Tcl_ListObjAppendElement(interp, resObj, classObj);
-
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -1));
- Tcl_ListObjAppendElement(interp, resObj,
- Tcl_NewLongObj(GetWindowLong((HWND)hwnd, GWL_ID)));
-
- cch = tkWinProcs->getWindowText((HWND)hwnd, (LPTSTR)buf, cchBuf);
- if (tkWinProcs->useWide) {
- textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
} else {
- textObj = Tcl_NewStringObj((LPCSTR)buf, cch);
+ Tcl_DString ds;
+ Tcl_WinTCharToUtf(buf, -1, &ds);
+ classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
}
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("text", -1));
- Tcl_ListObjAppendElement(interp, resObj, textObj);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("parent", -1));
- Tcl_ListObjAppendElement(interp, resObj,
+ dictObj = Tcl_NewDictObj();
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj);
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2),
+ Tcl_NewLongObj(GetWindowLongA((HWND)hwnd, GWL_ID)));
+
+ cch = tkTestWinProcs->getWindowText((HWND)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((long)GetParent((HWND)hwnd)));
childrenObj = Tcl_NewListObj(0, NULL);
EnumChildWindows((HWND)hwnd, EnumChildrenProc, (LPARAM)childrenObj);
- Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("children", -1));
- Tcl_ListObjAppendElement(interp, resObj, childrenObj);
+ Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj);
- Tcl_SetObjResult(interp, resObj);
+ Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
-}
+}
static int
TestwinlocaleObjCmd(
@@ -484,7 +510,7 @@ TestwinlocaleObjCmd(
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetSystemDefaultLCID()));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj((int)GetThreadLocale()));
return TCL_OK;
}
generated by cgit v0.12 at 2024-07-16 04:25:27 (GMT)