TIP #324 IMPLEMENTATION

4 files changed, 578 insertions, 30 deletions

diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index 8f41788..0f03f1d 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -8,12 +8,13 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinDialog.c,v 1.55 2008/11/08 18:44:40 dkf Exp $
+ * RCS: @(#) $Id: tkWinDialog.c,v 1.56 2008/12/10 05:02:52 das Exp $
  *
  */
 
 #include "tkWinInt.h"
 #include "tkFileFilter.h"
+#include "tkFont.h"
 
 #include <commdlg.h>		/* includes common dialog functionality */
 #ifdef _MSC_VER
@@ -2258,6 +2259,19 @@ MsgBoxCBTProc(
     return CallNextHookEx(tsdPtr->hMsgBoxHook, nCode, wParam, lParam);
 }
 
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SetTkDialog --
+ *
+ *	Records the HWND for a native dialog in the 'tk_dialog' variable
+ *	so that the test-suite can operate on the correct dialog window.
+ *	Use of this is enabled when a test program calls TkWinDialogDebug
+ *	by calling the test command 'tkwinevent debug 1'
+ *
+ * ----------------------------------------------------------------------
+ */
+
 static void
 SetTkDialog(
     ClientData clientData)
@@ -2296,6 +2310,531 @@ ConvertExternalFilename(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * GetFontObj --
+ *
+ *	Convert a windows LOGFONT into a Tk font description.
+ *
+ * Result:
+ *	A list containing a Tk font description.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetFontObj(HDC hdc, LOGFONT *plf)
+{
+    Tcl_Obj *resObj;
+    int len = 0, pt = 0;
+
+    resObj = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(NULL, resObj,
+	Tcl_NewStringObj(plf->lfFaceName, -1));
+    pt = -MulDiv(plf->lfHeight, 72, GetDeviceCaps(hdc, LOGPIXELSY));
+    Tcl_ListObjAppendElement(NULL, resObj, Tcl_NewIntObj(pt));
+    if (plf->lfWeight >= 700) {
+	Tcl_ListObjAppendElement(NULL, resObj,
+	    Tcl_NewStringObj("bold", -1));
+    }
+    if (plf->lfItalic) {
+	Tcl_ListObjAppendElement(NULL, resObj,
+	    Tcl_NewStringObj("italic", -1));
+    }
+    if (plf->lfUnderline) {
+	Tcl_ListObjAppendElement(NULL, resObj,
+	    Tcl_NewStringObj("underline", -1));
+    }
+    if (plf->lfStrikeOut) {
+	Tcl_ListObjAppendElement(NULL, resObj,
+	    Tcl_NewStringObj("overstrike", -1));
+    }
+    return resObj;
+}
+
+static void
+ApplyLogfont(Tcl_Interp *interp, Tcl_Obj *cmdObj, HDC hdc, LOGFONT *logfontPtr)
+{
+    int objc;
+    Tcl_Obj **objv, **tmpv;
+    Tcl_ListObjGetElements(NULL, cmdObj, &objc, &objv);
+    tmpv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
+    memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
+    tmpv[objc] = GetFontObj(hdc, logfontPtr);
+    TkBackgroundEvalObjv(interp, objc+1, tmpv, TCL_EVAL_GLOBAL);
+    ckfree((char *)tmpv);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * HookProc --
+ *
+ *	Font selection hook. If the user selects Apply on the dialog, we
+ *	call the applyProc script with the currently selected font as
+ *	arguments.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+typedef struct HookData {
+    Tcl_Interp *interp;
+    Tcl_Obj *titleObj;
+    Tcl_Obj *cmdObj;
+    Tcl_Obj *parentObj;
+    Tcl_Obj *fontObj;
+    HWND hwnd;
+    Tk_Window parent;
+} HookData;
+
+static UINT_PTR CALLBACK
+HookProc(HWND hwndDlg, UINT msg, WPARAM wParam, LPARAM lParam)
+{
+    CHOOSEFONT *pcf = (CHOOSEFONT *)lParam;
+    HWND hwndCtrl;
+    static HookData *phd = NULL;
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+    if (WM_INITDIALOG == msg && lParam != 0) {
+	phd = (HookData *)pcf->lCustData;
+	phd->hwnd = hwndDlg;
+	if (tsdPtr->debugFlag) {
+	    tsdPtr->debugInterp = (Tcl_Interp *) phd->interp;
+	    Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwndDlg);
+	}
+	if (phd->titleObj != NULL) {
+	    Tcl_DString title;
+	    Tcl_WinUtfToTChar(Tcl_GetString(phd->titleObj), -1, &title);
+	    if (Tcl_DStringLength(&title) > 0) {
+		tkWinProcs->setWindowText(hwndDlg,
+		    (LPCTSTR)Tcl_DStringValue(&title));
+	    }
+	    Tcl_DStringFree(&title);
+	}
+
+	/*
+	 * Disable the colour combobox (0x473) and its label (0x443).
+	 */
+
+	hwndCtrl = GetDlgItem(hwndDlg, 0x443);
+	if (IsWindow(hwndCtrl)) {
+	    EnableWindow(hwndCtrl, FALSE);
+	}
+	hwndCtrl = GetDlgItem(hwndDlg, 0x473);
+	if (IsWindow(hwndCtrl)) {
+	    EnableWindow(hwndCtrl, FALSE);
+	}
+	TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+	return 1; /* we handled the message */
+    }
+
+    if (WM_DESTROY == msg) {
+	phd->hwnd = NULL;
+	TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+	return 0;
+    }
+
+    /*
+     * Handle apply button by calling the provided command script as
+     * a background evaluation (ie: errors dont come back here).
+     */
+    if (WM_COMMAND == msg && LOWORD(wParam) == 1026) {
+	LOGFONT lf = {0};
+	int iPt = 0;
+	HDC hdc = GetDC(hwndDlg);
+	SendMessage(hwndDlg, WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM)&lf);
+	if (phd && phd->cmdObj) {
+	    ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
+	}
+	if (phd && phd->parent) {
+	    TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
+	}
+	return 1;
+    }
+    return 0; /* pass on for default processing */
+}
+
+/*
+ * Helper for the FontchooserConfigure command to return the
+ * current value of any of the options (which may be NULL in
+ * the structure)
+ */
+
+enum FontchooserOption {
+    FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
+    FontchooserVisible
+};
+
+static Tcl_Obj *
+FontchooserCget(HookData *hdPtr, int optionIndex)
+{
+    Tcl_Obj *resObj = NULL;
+    switch(optionIndex) {
+	case FontchooserParent: {
+	    if (hdPtr->parentObj) {
+		resObj = hdPtr->parentObj;
+	    } else {
+		resObj = Tcl_NewStringObj(".", 1);
+	    }
+	    break;
+	}
+	case FontchooserTitle: {
+	    if (hdPtr->titleObj) {
+		resObj = hdPtr->titleObj;
+	    } else {
+		resObj =  Tcl_NewStringObj("", 0);
+	    }
+	    break;
+	}
+	case FontchooserFont: {
+	    if (hdPtr->fontObj) {
+		resObj = hdPtr->fontObj;
+	    } else {
+		resObj = Tcl_NewStringObj("", 0);
+	    }
+	    break;
+	}
+	case FontchooserCmd: {
+	    if (hdPtr->cmdObj) {
+		resObj = hdPtr->cmdObj;
+	    } else {
+		resObj = Tcl_NewStringObj("", 0);
+	    }
+	    break;
+	}
+	case FontchooserVisible: {
+	    resObj = Tcl_NewBooleanObj(hdPtr->hwnd && IsWindow(hdPtr->hwnd));
+	    break;
+	}
+	default: {
+	    resObj = Tcl_NewStringObj("", 0);
+	}
+    }
+    return resObj;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserConfigureCmd --
+ *
+ *	Implementation of the 'tk fontchooser configure' ensemble command.
+ *	See the user documentation for what it does.
+ *
+ * Results:
+ *	See the user documentation.
+ *
+ * Side effects:
+ *	Per-interp data structure may be modified
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserConfigureCmd(
+    ClientData clientData,	/* Main window */
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tk_Window tkwin = (Tk_Window)clientData;
+    HookData *hdPtr = NULL;
+    int i, r = TCL_OK;
+    static const char *optionStrings[] = {
+	"-parent", "-title", "-font", "-command", "-visible", NULL
+    };
+
+    hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+    /*
+     * with no arguments we return all the options in a dict
+     */
+
+    if (objc == 1) {
+	Tcl_Obj *keyObj, *valueObj;
+	Tcl_Obj *dictObj = Tcl_NewDictObj();
+	for (i = 0; r == TCL_OK && optionStrings[i] != NULL; ++i) {
+	    keyObj = Tcl_NewStringObj(optionStrings[i], -1);
+	    valueObj = FontchooserCget(hdPtr, i);
+	    r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
+	}
+	if (r == TCL_OK) {
+	    Tcl_SetObjResult(interp, dictObj);
+	}
+	return r;
+    }
+
+    for (i = 1; i < objc; i += 2) {
+	int optionIndex;
+	if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings,
+		"option", 0, &optionIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (objc == 2) {
+	    /* if one option and no arg - return the current value */
+	    Tcl_SetObjResult(interp, FontchooserCget(hdPtr, optionIndex));
+	    return TCL_OK;
+	}
+	if (i + 1 == objc) {
+	    Tcl_AppendResult(interp, "value for \"",
+		Tcl_GetString(objv[i]), "\" missing", NULL);
+	    return TCL_ERROR;
+	}
+	switch (optionIndex) {
+	    case FontchooserVisible: {
+		const char *msg = "cannot change read-only option "
+		    "\"-visible\": use the show or hide command";
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
+		return TCL_ERROR;
+	    }
+	    case FontchooserParent: {
+		Tk_Window parent = Tk_NameToWindow(interp,
+		    Tcl_GetString(objv[i+1]), tkwin);
+		if (parent == None) {
+		    return TCL_ERROR;
+		}
+		if (hdPtr->parentObj) {
+		    Tcl_DecrRefCount(hdPtr->parentObj);
+		}
+		hdPtr->parentObj = objv[i+1];
+		if (Tcl_IsShared(hdPtr->parentObj)) {
+		    hdPtr->parentObj = Tcl_DuplicateObj(hdPtr->parentObj);
+		}
+		Tcl_IncrRefCount(hdPtr->parentObj);
+		break;
+	    }
+	    case FontchooserTitle: {
+		if (hdPtr->titleObj) {
+		    Tcl_DecrRefCount(hdPtr->titleObj);
+		}
+		hdPtr->titleObj = objv[i+1];
+		if (Tcl_IsShared(hdPtr->titleObj)) {
+		    hdPtr->titleObj = Tcl_DuplicateObj(hdPtr->titleObj);
+		}
+		Tcl_IncrRefCount(hdPtr->titleObj);
+		break;
+	    }
+	    case FontchooserFont: {
+		if (hdPtr->fontObj) {
+		    Tcl_DecrRefCount(hdPtr->fontObj);
+		}
+		Tcl_GetStringFromObj(objv[i+1], &len);
+		if (len) {
+		    hdPtr->fontObj = objv[i+1];
+		    if (Tcl_IsShared(hdPtr->fontObj)) {
+			hdPtr->fontObj = Tcl_DuplicateObj(hdPtr->fontObj);
+		    }
+		    Tcl_IncrRefCount(hdPtr->fontObj);
+		} else {
+		    hdPtr->fontObj = NULL;
+		}
+		break;
+	    }
+	    case FontchooserCmd: {
+		if (hdPtr->cmdObj) {
+		    Tcl_DecrRefCount(hdPtr->cmdObj);
+		}
+		Tcl_GetStringFromObj(objv[i+1], &len);
+		if (len) {
+		    hdPtr->cmdObj = objv[i+1];
+		    if (Tcl_IsShared(hdPtr->cmdObj)) {
+			hdPtr->cmdObj = Tcl_DuplicateObj(hdPtr->cmdObj);
+		    }
+		    Tcl_IncrRefCount(hdPtr->cmdObj);
+		} else {
+		    hdPtr->cmdObj = NULL;
+		}
+		break;
+	    }
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserShowCmd --
+ *
+ *	Implements the 'tk fontchooser show' ensemble command. The
+ *	per-interp configuration data for the dialog is held in an interp
+ *	associated structure.
+ *	Calls the Win32 FontChooser API which provides a modal dialog.
+ *	See HookProc where we make a few changes to the dialog and set
+ *	some additional state.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserShowCmd(
+    ClientData clientData,	/* Main window */
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tk_Window tkwin, parent;
+    CHOOSEFONT cf;
+    LOGFONT lf;
+    HDC hdc;
+    HookData *hdPtr;
+    int r = TCL_OK, oldMode = 0;
+    Tcl_Obj *resObj = NULL;
+
+    hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+
+    tkwin = parent = (Tk_Window) clientData;
+    if (hdPtr->parentObj) {
+	parent = Tk_NameToWindow(interp, Tcl_GetString(hdPtr->parentObj), tkwin);
+	if (parent == None) {
+	    return TCL_ERROR;
+	}
+    }
+
+    Tk_MakeWindowExist(parent);
+
+    ZeroMemory(&cf, sizeof(CHOOSEFONT));
+    ZeroMemory(&lf, sizeof(LOGFONT));
+    lf.lfCharSet = DEFAULT_CHARSET;
+    cf.lStructSize = sizeof(CHOOSEFONT);
+    cf.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+    cf.lpLogFont = &lf;
+    cf.nFontType = SCREEN_FONTTYPE;
+    cf.Flags = CF_SCREENFONTS | CF_EFFECTS | CF_ENABLEHOOK;
+    cf.rgbColors = RGB(0,0,0);
+    cf.lpfnHook = HookProc;
+    cf.lCustData = (INT_PTR)hdPtr;
+    hdPtr->interp = interp;
+    hdPtr->parent = parent;
+    hdc = GetDC(cf.hwndOwner);
+
+    if (hdPtr->fontObj != NULL) {
+	TkFont *fontPtr;
+	Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, hdPtr->fontObj);
+	if (f == NULL) {
+	    return TCL_ERROR;
+	}
+	fontPtr = (TkFont *)f;
+	cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+	strncpy(lf.lfFaceName, Tk_GetUid(fontPtr->fa.family), LF_FACESIZE-1);
+	lf.lfFaceName[LF_FACESIZE-1] = 0;
+	lf.lfHeight = -MulDiv(TkFontGetPoints(tkwin, fontPtr->fa.size),
+	    GetDeviceCaps(hdc, LOGPIXELSY), 72);
+	if (fontPtr->fa.weight == TK_FW_BOLD) lf.lfWeight = FW_BOLD;
+	if (fontPtr->fa.slant != TK_FS_ROMAN) lf.lfItalic = TRUE;
+	if (fontPtr->fa.underline) lf.lfUnderline = TRUE;
+	if (fontPtr->fa.overstrike) lf.lfStrikeOut = TRUE;
+	Tk_FreeFont(f);
+    }
+
+    if (TCL_OK == r && hdPtr->cmdObj != NULL) {
+	int len = 0;
+	r = Tcl_ListObjLength(interp, hdPtr->cmdObj, &len);
+	if (len > 0) cf.Flags |= CF_APPLY;
+    }
+
+    if (TCL_OK == r) {
+	oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+	if (FontChooser(&cf)) {
+	    if (hdPtr->cmdObj) {
+		ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
+	    }
+	    if (hdPtr->parent) {
+		TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
+	    }
+	}
+	Tcl_SetServiceMode(oldMode);
+	EnableWindow(cf.hwndOwner, 1);
+    }
+
+    ReleaseDC(cf.hwndOwner, hdc);
+
+    return r;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserHideCmd --
+ *
+ *	Implementation of the 'tk fontchooser hide' ensemble. See the
+ *	user documentation for details.
+ *	As the Win32 FontChooser function is always modal all we do here
+ *	is destroy the dialog
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserHideCmd(
+    ClientData clientData,	/* Main window */
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    HookData *hdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);
+    if (hdPtr->hwnd && IsWindow(hdPtr->hwnd)) {
+	EndDialog(hdPtr->hwnd, 0);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteHookData --
+ *
+ *	Clean up the font chooser configuration data when the interp
+ *	is destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteHookData(ClientData clientData, Tcl_Interp *interp)
+{
+    HookData *hdPtr = clientData;
+    if (hdPtr->parentObj)
+	Tcl_DecrRefCount(hdPtr->parentObj);
+    if (hdPtr->fontObj)
+	Tcl_DecrRefCount(hdPtr->fontObj);
+    if (hdPtr->titleObj)
+	Tcl_DecrRefCount(hdPtr->titleObj);
+    if (hdPtr->cmdObj)
+	Tcl_DecrRefCount(hdPtr->cmdObj);
+    ckfree((char *)hdPtr);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitFontchooser --
+ *
+ *	Associate the font chooser configuration data with the Tcl
+ *	interpreter. There is one font chooser per interp.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+const TkEnsemble tkFontchooserEnsemble[] = {
+    { "configure", FontchooserConfigureCmd, NULL },
+    { "show", FontchooserShowCmd, NULL },
+    { "hide", FontchooserHideCmd, NULL },
+};
+
+int
+TkInitFontchooser(Tcl_Interp *interp, ClientData clientData)
+{
+    HookData *hdPtr = NULL;
+    hdPtr = (HookData *)ckalloc(sizeof(HookData));
+    memset(hdPtr, 0, sizeof(HookData));
+    Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteHookData, hdPtr);
+    return TCL_OK;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/win/tkWinInt.h b/win/tkWinInt.h
index aa35ed0..469d6e9 100644
--- a/win/tkWinInt.h
+++ b/win/tkWinInt.h
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinInt.h,v 1.31 2007/12/14 15:56:09 patthoyts Exp $
+ * RCS: @(#) $Id: tkWinInt.h,v 1.32 2008/12/10 05:02:52 das Exp $
  */
 
 #ifndef _TKWININT
@@ -211,6 +211,8 @@ typedef struct TkWinProcs {
     BOOL (WINAPI *insertMenu)(HMENU hMenu, UINT uPosition, UINT uFlags,
 	    UINT uIDNewItem, LPCTSTR lpNewItem);
     int (WINAPI *getWindowText)(HWND hWnd, LPCTSTR lpString, int nMaxCount);
+    HWND (WINAPI *findWindow)(LPCTSTR lpClassName, LPCTSTR lpWindowName);
+    int (WINAPI *getClassName)(HWND hwnd, LPTSTR lpClassName, int nMaxCount);
 } TkWinProcs;
 
 EXTERN TkWinProcs *tkWinProcs;
diff --git a/win/tkWinTest.c b/win/tkWinTest.c
index c48dba5..3060dda 100644
--- a/win/tkWinTest.c
+++ b/win/tkWinTest.c
@@ -11,7 +11,7 @@
  * 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.23 2008/11/27 23:26:05 nijtmans Exp $
+ * RCS: @(#) $Id: tkWinTest.c,v 1.24 2008/12/10 05:02:52 das Exp $
  */
 
 #include "tkWinInt.h"
@@ -373,18 +373,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  = tkWinProcs->findWindow(class, title);
 
     if (hwnd == NULL) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
@@ -393,6 +400,9 @@ TestfindwindowObjCmd(
     } else {
         Tcl_SetObjResult(interp, Tcl_NewLongObj((long)hwnd));
     }
+
+    Tcl_DStringFree(&titleString);
+    Tcl_DStringFree(&classString);
     return r;
 
 }
@@ -416,7 +426,7 @@ TestgetwindowinfoObjCmd(
     Tcl_Obj *const objv[])
 {
     HWND hwnd = NULL;
-    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;
@@ -429,25 +439,21 @@ TestgetwindowinfoObjCmd(
     if (Tcl_GetLongFromObj(interp, objv[1], (long *)&hwnd) != TCL_OK)
 	return TCL_ERROR;
 
-    if (tkWinProcs->useWide) {
-	cch = GetClassNameW(hwnd, (LPWSTR)buf, sizeof(buf)/sizeof(WCHAR));
-	classObj = Tcl_NewUnicodeObj((LPWSTR)buf, cch);
-    } else {
-	cch = GetClassNameA(hwnd, (LPSTR)buf, sizeof(buf));
-	classObj = Tcl_NewStringObj((LPSTR)buf, cch);
-    }
+    cch = tkWinProcs->getClassName(hwnd, buf, cchBuf);
     if (cch == 0) {
     	Tcl_SetResult(interp, "failed to get class name: ", TCL_STATIC);
     	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);
-
-    Tcl_ListObjAppendElement(interp, resObj, Tcl_NewStringObj("id", -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(GetWindowLong(hwnd, GWL_ID)));
 
     cch = tkWinProcs->getWindowText(hwnd, (LPTSTR)buf, cchBuf);
@@ -457,18 +463,15 @@ TestgetwindowinfoObjCmd(
 	textObj = Tcl_NewStringObj((LPCSTR)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_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj);
+    Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6),
 	Tcl_NewLongObj((long)GetParent(hwnd)));
 
     childrenObj = Tcl_NewListObj(0, NULL);
     EnumChildWindows(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;
 }
 
diff --git a/win/tkWinX.c b/win/tkWinX.c
index 9632bd2..160e141 100644
--- a/win/tkWinX.c
+++ b/win/tkWinX.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWinX.c,v 1.58 2008/04/27 22:39:17 dkf Exp $
+ * RCS: @(#) $Id: tkWinX.c,v 1.59 2008/12/10 05:02:52 das Exp $
  */
 
 /*
@@ -79,6 +79,8 @@ static TkWinProcs asciiProcs = {
     (BOOL (WINAPI *)(HMENU hMenu, UINT uPosition, UINT uFlags,
 	    UINT uIDNewItem, LPCTSTR lpNewItem)) InsertMenuA,
     (int (WINAPI *)(HWND hWnd, LPCTSTR lpString, int nMaxCount)) GetWindowTextA,
+    (HWND (WINAPI *)(LPCTSTR lpClassName, LPCTSTR lpWindowName)) FindWindowA,
+    (int (WINAPI *)(HWND hwnd, LPTSTR lpClassName, int nMaxCount)) GetClassNameA,
 };
 
 static TkWinProcs unicodeProcs = {
@@ -97,6 +99,8 @@ static TkWinProcs unicodeProcs = {
     (BOOL (WINAPI *)(HMENU hMenu, UINT uPosition, UINT uFlags,
 	    UINT uIDNewItem, LPCTSTR lpNewItem)) InsertMenuW,
     (int (WINAPI *)(HWND hWnd, LPCTSTR lpString, int nMaxCount)) GetWindowTextW,
+    (HWND (WINAPI *)(LPCTSTR lpClassName, LPCTSTR lpWindowName)) FindWindowW,
+    (int (WINAPI *)(HWND hwnd, LPTSTR lpClassName, int nMaxCount)) GetClassNameW,
 };
 
 TkWinProcs *tkWinProcs;