diff options
Diffstat (limited to 'win/tkWinTest.c')
| -rw-r--r-- | win/tkWinTest.c | 156 |
1 files changed, 79 insertions, 77 deletions
diff --git a/win/tkWinTest.c b/win/tkWinTest.c index 2498864..6036995 100644 --- a/win/tkWinTest.c +++ b/win/tkWinTest.c @@ -12,6 +12,10 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#undef USE_TCL_STUBS +#define USE_TCL_STUBS +#undef USE_TK_STUBS +#define USE_TK_STUBS #include "tkWinInt.h" HWND tkWinCurrentDialog; @@ -34,7 +38,7 @@ static int TestgetwindowinfoObjCmd(ClientData clientData, 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; /* *---------------------------------------------------------------------- @@ -106,7 +110,8 @@ AppendSystemError( if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM + length = FormatMessage(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 +119,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); @@ -185,44 +191,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. */ { - 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); } /* @@ -280,11 +272,21 @@ 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 = INT2PTR(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); + Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1)); return TCL_ERROR; } } @@ -296,7 +298,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; @@ -325,7 +327,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); @@ -336,10 +338,10 @@ TestwineventCmd( BOOL result; Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds); - result = SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds)); + result = SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds)); Tcl_DStringFree(&ds); if (result == 0) { - Tcl_SetResult(interp, "failed to send text to dialog: ", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1)); AppendSystemError(interp, GetLastError()); return TCL_ERROR; } @@ -351,16 +353,16 @@ TestwineventCmd( wParam = MAKEWPARAM(id, 0); lParam = (LPARAM)child; } - sprintf(buf, "%d", (int) SendMessage(hwnd, message, wParam, lParam)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); break; } default: { char buf[TCL_INTEGER_SPACE]; sprintf(buf, "%d", - (int) SendDlgItemMessage(hwnd, id, message, wParam, lParam)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + (int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); break; } } @@ -385,18 +387,25 @@ TestfindwindowObjCmd( int objc, /* Number of arguments. */ 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 = FindWindow(class, title); if (hwnd == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1)); @@ -405,7 +414,11 @@ TestfindwindowObjCmd( } else { Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd))); } + + Tcl_DStringFree(&titleString); + Tcl_DStringFree(&classString); return r; + } static BOOL CALLBACK @@ -427,10 +440,10 @@ TestgetwindowinfoObjCmd( 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"); @@ -440,46 +453,35 @@ TestgetwindowinfoObjCmd( if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK) return TCL_ERROR; - if (tkWinProcs->useWide) { - cch = GetClassNameW(INT2PTR(hwnd), (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR)); - classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch); - } else { - cch = GetClassNameA(INT2PTR(hwnd), (LPSTR)buf, sizeof(buf)); - classObj = Tcl_NewStringObj((LPSTR)buf, cch); - } + cch = GetClassName(INT2PTR(hwnd), buf, cchBuf); if (cch == 0) { - Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1)); AppendSystemError(interp, GetLastError()); return TCL_ERROR; + } else { + Tcl_DString ds; + Tcl_WinTCharToUtf(buf, -1, &ds); + classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); } - resObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("class", -1)); - Tcl_ListObjAppendElement(interp, resObj, classObj); + 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_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -1)); - Tcl_ListObjAppendElement(interp, resObj, - Tcl_NewLongObj(GetWindowLong(INT2PTR(hwnd), GWL_ID))); - - cch = tkWinProcs->getWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); - if (tkWinProcs->useWide) { - textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); - } else { - textObj = Tcl_NewStringObj((LPCSTR)buf, cch); - } + cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf); + textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch); - 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, - Tcl_NewLongObj(PTR2INT(GetParent(INT2PTR(hwnd))))); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj); + Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6), + Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd)))))); childrenObj = Tcl_NewListObj(0, NULL); EnumChildWindows(INT2PTR(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; } @@ -494,7 +496,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; } |