Tk Source Code

 */

static UINT APIENTRY	ChooseDirectoryValidateProc(HWND hdlg, UINT uMsg,
			    LPARAM wParam, LPARAM lParam);
static UINT CALLBACK	ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
			    LPARAM lParam);
static void             CleanupOFNOptions(OFNOpts *optsPtr);
static int              ParseOFNOptions(ClientData clientData,
                            Tcl_Interp *interp, int objc,
                            Tcl_Obj *const objv[], enum OFNOper oper, OFNOpts *optsPtr);
static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr,
                         enum OFNOper oper);
static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
                            enum OFNOper oper);
static int 		GetFileName(ClientData clientData,
                                    Tcl_Interp *interp, int objc,
                                    Tcl_Obj *const objv[], enum OFNOper oper);
static int MakeFilterVista(Tcl_Interp *interp, OFNOpts *optsPtr,
               DWORD *countPtr, TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr,
               DWORD *defaultFilterIndexPtr);
static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr);
static int 		MakeFilter(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_DString *dsPtr, Tcl_Obj *initialPtr,
			    int *indexPtr);
static UINT APIENTRY	OFNHookProc(HWND hdlg, UINT uMsg, WPARAM wParam,
			    LPARAM lParam);
static LRESULT CALLBACK MsgBoxCBTProc(int nCode, WPARAM wParam, LPARAM lParam);
static void		SetTkDialog(ClientData clientData);
static const char *ConvertExternalFilename(LPCWSTR, Tcl_DString *);
static void             LoadShellProcs(void);


/* Definitions of dynamically loaded Win32 calls */
typedef HRESULT (STDAPICALLTYPE SHCreateItemFromParsingNameProc)(
    PCWSTR pszPath, IBindCtx *pbc, REFIID riid, void **ppv);

 *	application invokes the "tk_chooseColor" command.
 *
 *-------------------------------------------------------------------------
 */

int
Tk_ChooseColorObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tk_Window tkwin = (Tk_Window)clientData, parent;
    HWND hWnd;
    int i, oldMode, winCode, result;

 *	A dialog window is created the first this function is called.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetOpenFileObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return GetFileName(clientData, interp, objc, objv, OFN_FILE_OPEN);
}


 *	Same as Tk_GetOpenFileObjCmd.
 *
 *----------------------------------------------------------------------
 */

int
Tk_GetSaveFileObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return GetFileName(clientData, interp, objc, objv, OFN_FILE_SAVE);
}


 *	Returns option values in *optsPtr. Note these may include string
 *      pointers into objv[]
 *----------------------------------------------------------------------
 */

static int
ParseOFNOptions(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    enum OFNOper oper,			/* 1 for Open, 0 for Save */
    OFNOpts *optsPtr)           /* Output, uninitialized on entry */
{
    int i;

                                      &optsPtr->utfDirString) == NULL)
		goto error_return;
	    break;
	case FILE_INITFILE:
	    if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
		goto error_return;
	    Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
                              Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
                              (char *) &optsPtr->file[0], sizeof(optsPtr->file),
                              NULL, NULL, NULL);
	    Tcl_DStringFree(&ds);
	    break;
	case FILE_PARENT:
	    optsPtr->tkwin = Tk_NameToWindow(interp, string, (Tk_Window)clientData);
	    if (optsPtr->tkwin == NULL)
		goto error_return;
	    break;

 *	See user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
GetFileName(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    enum OFNOper oper)  	/* 1 to call GetOpenFileName(), 0 to call
				 * GetSaveFileName(). */
{
    OFNOpts ofnOpts;

    } else if (uMsg == WM_WINDOWPOSCHANGED) {
	/*
	 * This message is delivered at the right time to enable Tk to set the
	 * debug information. Unhooks itself so it won't set the debug
	 * information every time it gets a WM_WINDOWPOSCHANGED message.
	 */

	ofnPtr = (OPENFILENAME *) TkWinGetUserData(hdlg);
	if (ofnPtr != NULL) {
	    ofnData = (OFNData *) ofnPtr->lCustData;
	    if (ofnData->interp != NULL) {
		hdlg = GetParent(hdlg);
		tsdPtr->debugInterp = ofnData->interp;
		Tcl_DoWhenIdle(SetTkDialog, hdlg);
	    }

	 * characters.
	 */

	*p++ = '\0';
	*p = '\0';
    }

    Tcl_DStringAppend(dsPtr, filterStr, (int) (p - filterStr));
    ckfree(filterStr);

    TkFreeFileFilters(&flist);
    return TCL_OK;
}

/*

 * - -title is really -message.
 *
 *----------------------------------------------------------------------
 */

int
Tk_ChooseDirectoryObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    WCHAR path[MAX_PATH];
    int oldMode, result;
    LPCITEMIDLIST pidl;		/* Returned by browser */

 *	returns.
 *
 *----------------------------------------------------------------------
 */

int
Tk_MessageBoxObjCmd(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tk_Window tkwin = (Tk_Window)clientData, parent;
    HWND hWnd;
    Tcl_Obj *messageObj, *titleObj, *detailObj, *tmpObj;

 *	the test command 'tkwinevent debug 1'.
 *
 * ----------------------------------------------------------------------
 */

static void
SetTkDialog(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    char buf[32];

    snprintf(buf, sizeof(buf), "0x%" TCL_Z_MODIFIER "x", (size_t)clientData);
    Tcl_SetVar2(tsdPtr->debugInterp, "tk_dialog", NULL, buf, TCL_GLOBAL_ONLY);

 *	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 *const optionStrings[] = {
	"-parent", "-title", "-font", "-command", "-visible", NULL
    };

    hdPtr = (HookData *)Tcl_GetAssocData(interp, "::tk::fontchooser", NULL);

    /*

 *	additional state.
 *
 * ----------------------------------------------------------------------
 */

static int
FontchooserShowCmd(
    ClientData clientData,	/* Main window */
    Tcl_Interp *interp,
    TCL_UNUSED(int),
    TCL_UNUSED(Tcl_Obj *const *))
{
    Tcl_DString ds;
    Tk_Window tkwin = (Tk_Window)clientData, parent;
    CHOOSEFONTW cf;