* Merged 8.1 branch into the main trunk

FossilOrigin-Name: 1120dc4257448ed1955333e682de48e2940cc741

1 files changed, 230 insertions, 0 deletions

diff --git a/win/tkWinTest.c b/win/tkWinTest.c
new file mode 100644
index 0000000..00553eb
--- /dev/null
+++ b/win/tkWinTest.c
@@ -0,0 +1,230 @@
+/* 
+ * tkWinTest.c --
+ *
+ *	Contains commands for platform specific tests for
+ *	the Windows platform.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ *
+ * 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.2 1999/04/16 01:51:53 stanton Exp $
+ */
+
+#include "tkWinInt.h"
+
+HWND tkWinCurrentDialog;
+ 
+/*
+ * Forward declarations of procedures defined later in this file:
+ */
+
+int			TkplatformtestInit(Tcl_Interp *interp);
+static int		TestclipboardCmd(ClientData clientData,
+			    Tcl_Interp *interp, int argc, char **argv);
+static int		TestwineventCmd(ClientData clientData, 
+			    Tcl_Interp *interp, int argc, char **argv);
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkplatformtestInit --
+ *
+ *	Defines commands that test platform specific functionality for
+ *	Unix platforms.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Defines new commands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkplatformtestInit(
+    Tcl_Interp *interp)		/* Interpreter to add commands to. */
+{
+    /*
+     * Add commands for platform specific tests on MacOS here.
+     */
+    
+    Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
+	    (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testwinevent", TestwineventCmd,
+            (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestclipboardCmd --
+ *
+ *	This procedure implements the testclipboard command. It provides
+ *	a way to determine the actual contents of the Windows clipboard.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestclipboardCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Main window for application. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    char **argv;			/* Argument strings. */
+{
+    TkWindow *winPtr = (TkWindow *) clientData;
+    HGLOBAL handle;
+    char *data;
+
+    if (OpenClipboard(NULL)) {
+	handle = GetClipboardData(CF_TEXT);
+	if (handle != NULL) {
+	    data = GlobalLock(handle);
+	    Tcl_AppendResult(interp, data, (char *) NULL);
+	    GlobalUnlock(handle);
+	}
+	CloseClipboard();
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwineventCmd --
+ *
+ *	This procedure implements the testwinevent command. It provides
+ *	a way to send messages to windows dialogs.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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. */
+{
+    HWND hwnd;
+    int id;
+    char *rest;
+    UINT message;
+    WPARAM wParam;
+    LPARAM lParam;
+    static TkStateMap messageMap[] = {
+	{WM_LBUTTONDOWN,	"WM_LBUTTONDOWN"},
+	{WM_LBUTTONUP,		"WM_LBUTTONUP"},
+	{WM_CHAR,		"WM_CHAR"},
+	{WM_GETTEXT,		"WM_GETTEXT"},
+	{WM_SETTEXT,		"WM_SETTEXT"},
+	{-1,			NULL}
+    };
+
+    if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
+	int i;
+
+	if (Tcl_GetBoolean(interp, argv[2], &i) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	TkWinDialogDebug(i);
+	return TCL_OK;
+    }
+
+    if (argc < 4) {
+	return TCL_ERROR;
+    }
+
+    hwnd = (HWND) strtol(argv[1], &rest, 0);
+    if (rest == argv[2]) {
+	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);
+    if (rest == argv[2]) {
+	HWND child;
+	char buf[256];
+
+	child = GetWindow(hwnd, GW_CHILD);
+	while (child != NULL) {
+	    SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
+	    if (strcasecmp(buf, argv[2]) == 0) {
+		id = GetDlgCtrlID(child);
+		break;
+	    }
+	    child = GetWindow(child, GW_HWNDNEXT);
+	}
+	if (child == NULL) {
+	    return TCL_ERROR;
+	}
+    }
+    message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
+    if (message < 0) {
+	message = strtol(argv[3], NULL, 0);
+    }
+    wParam = 0;
+    lParam = 0;
+
+    if (argc > 4) {
+	wParam = strtol(argv[4], NULL, 0);
+    }
+    if (argc > 5) {
+	lParam = strtol(argv[5], NULL, 0);
+    }
+
+    switch (message) {
+	case WM_GETTEXT: {
+	    Tcl_DString ds;
+	    char buf[256];
+
+	    GetDlgItemText(hwnd, id, buf, 256);
+	    Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
+	    Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+	    Tcl_DStringFree(&ds);
+	    break;
+	}
+	case WM_SETTEXT: {
+	    Tcl_DString ds;
+
+	    Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
+	    SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
+	    Tcl_DStringFree(&ds);
+	    break;
+	}
+	default: {
+	    char buf[TCL_INTEGER_SPACE];
+	    
+	    sprintf(buf, "%d", 
+		    SendDlgItemMessage(hwnd, id, message, wParam, lParam));
+	    Tcl_SetResult(interp, buf, TCL_VOLATILE);
+	    break;
+	}
+    }
+    return TCL_OK;
+}
+    
+
+