diff options
Diffstat (limited to 'tk/win/tkWinTest.c')
| -rw-r--r-- | tk/win/tkWinTest.c | 120 |
1 files changed, 108 insertions, 12 deletions
diff --git a/tk/win/tkWinTest.c b/tk/win/tkWinTest.c index dd66ce05f46..03d8984e129 100644 --- a/tk/win/tkWinTest.c +++ b/tk/win/tkWinTest.c @@ -6,6 +6,7 @@ * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 2000 by Scriptics Corporation. + * Copyright (c) 2001 by ActiveState Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -26,7 +27,7 @@ static int TestclipboardObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int TestwineventCmd(ClientData clientData, - Tcl_Interp *interp, int argc, char **argv); + Tcl_Interp *interp, int argc, CONST char **argv); /* @@ -65,6 +66,90 @@ TkplatformtestInit( /* *---------------------------------------------------------------------- * + * AppendSystemError -- + * + * This routine formats a Windows system error message and places + * it into the interpreter result. Originally from tclWinReg.c. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +AppendSystemError( + Tcl_Interp *interp, /* Current interpreter. */ + DWORD error) /* Result code from error. */ +{ + int length; + WCHAR *wMsgPtr; + char *msg; + char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; + Tcl_DString ds; + Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); + + length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr, + 0, NULL); + if (length == 0) { + char *msgPtr; + + length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM + | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, + 0, NULL); + if (length > 0) { + wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); + MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, + length + 1); + LocalFree(msgPtr); + } + } + if (length == 0) { + if (error == ERROR_CALL_NOT_IMPLEMENTED) { + msg = "function not supported under Win32s"; + } else { + sprintf(msgBuf, "unknown error: %ld", error); + msg = msgBuf; + } + } else { + Tcl_Encoding encoding; + + encoding = Tcl_GetEncoding(NULL, "unicode"); + msg = Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); + Tcl_FreeEncoding(encoding); + LocalFree(wMsgPtr); + + length = Tcl_DStringLength(&ds); + + /* + * Trim the trailing CR/LF from the system message. + */ + if (msg[length-1] == '\n') { + msg[--length] = 0; + } + if (msg[length-1] == '\r') { + msg[--length] = 0; + } + } + + sprintf(id, "%ld", error); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL); + Tcl_AppendToObj(resultPtr, msg, length); + + if (length != 0) { + Tcl_DStringFree(&ds); + } +} + +/* + *---------------------------------------------------------------------- + * * TestclipboardObjCmd -- * * This procedure implements the testclipboard command. It provides @@ -89,6 +174,7 @@ TestclipboardObjCmd(clientData, interp, objc, objv) TkWindow *winPtr = (TkWindow *) clientData; HGLOBAL handle; char *data; + int code = TCL_OK; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, (char *) NULL); @@ -108,11 +194,13 @@ TestclipboardObjCmd(clientData, interp, objc, objv) GlobalUnlock(handle); } else { Tcl_AppendResult(interp, "null clipboard handle", (char *) NULL); - return TCL_ERROR; + code = TCL_ERROR; } CloseClipboard(); + return code; } else { - Tcl_AppendResult(interp, "couldn't open clipboard", (char *) NULL); + Tcl_AppendResult(interp, "couldn't open clipboard: ", (char *) NULL); + AppendSystemError(interp, GetLastError()); return TCL_ERROR; } return TCL_OK; @@ -140,9 +228,9 @@ TestwineventCmd(clientData, interp, argc, argv) ClientData clientData; /* Main window for application. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { - HWND hwnd; + HWND hwnd = 0; int id; char *rest; UINT message; @@ -158,12 +246,12 @@ TestwineventCmd(clientData, interp, argc, argv) }; if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) { - int i; + int b; - if (Tcl_GetBoolean(interp, argv[2], &i) != TCL_OK) { + if (Tcl_GetBoolean(interp, argv[2], &b) != TCL_OK) { return TCL_ERROR; } - TkWinDialogDebug(i); + TkWinDialogDebug(b); return TCL_OK; } @@ -171,14 +259,24 @@ TestwineventCmd(clientData, interp, argc, argv) return TCL_ERROR; } +#if 0 + TkpScanWindowId(interp, argv[1], &id); + if ( +#ifdef _WIN64 + (sscanf(string, "0x%p", &number) != 1) && +#endif + Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) { + return TCL_ERROR; + } +#endif hwnd = (HWND) strtol(argv[1], &rest, 0); - if (rest == argv[2]) { + if (rest == argv[1]) { hwnd = FindWindow(NULL, argv[1]); if (hwnd == NULL) { Tcl_SetResult(interp, "no such window", TCL_STATIC); return TCL_ERROR; } - } + } UpdateWindow(hwnd); id = strtol(argv[2], &rest, 0); @@ -246,5 +344,3 @@ TestwineventCmd(clientData, interp, argc, argv) - - |