Tk Source Code

.PP
The procedure \fBtk_chooseDirectory\fR pops up a dialog box for the
user to select a directory. The following \fIoption\-value\fR pairs are
possible as command line arguments:
.TP
\fB\-initialdir\fR \fIdirname\fR
Specifies that the directories in \fIdirectory\fR should be displayed
when the dialog pops up. If this parameter is not specified, then
the directories in the current working directory are displayed. If the
when the dialog pops up. If this parameter is not specified,
the initial directory defaults to the current working directory 
on non-Windows systems and on Windows systems prior to Vista.
On Vista and later systems, the initial directory defaults to the last
user-selected directory for the application. If the
parameter specifies a relative path, the return value will convert the
relative path to an absolute path.
.TP
\fB\-mustexist\fR \fIboolean\fR
Specifies whether the user may specify non-existent directories.  If
this parameter is true, then the user may only select directories that
already exist.  The default value is \fIfalse\fR.

particular platform then all files are listed regardless of their
types. See the section \fBSPECIFYING FILE PATTERNS\fR below for a
discussion on the contents of \fIfilePatternList\fR.
.TP
\fB\-initialdir\fR \fIdirectory\fR
.
Specifies that the files in \fIdirectory\fR should be displayed
when the dialog pops up. If this parameter is not specified, then
the files in the current working directory are displayed. If the
when the dialog pops up. If this parameter is not specified, 
the initial directory defaults to the current working directory 
on non-Windows systems and on Windows systems prior to Vista.
On Vista and later systems, the initial directory defaults to the last
user-selected directory for the application. If the
parameter specifies a relative path, the return value will convert the
relative path to an absolute path.
.TP
\fB\-initialfile\fR \fIfilename\fR
.
Specifies a filename to be displayed in the dialog when it pops up.
.TP

}

# Locale identifier LANG_ENGLISH is 0x09
testConstraint english [expr {
    [llength [info commands testwinlocale]]
    && (([testwinlocale] & 0xff) == 9)
}]

proc vista? {{prevista 0} {postvista 1}} {
    lassign [split $::tcl_platform(osVersion) .] major
    return [expr {$major >= 6 ? $postvista : $prevista}]
}

# What directory to use in initialdir tests. Old code used to use
# c:/. However, on Vista/later that is a protected directory if you
# are not running privileged. Moreover, not everyone has a drive c:
# but not having a TEMP would break a lot Windows programs
proc initialdir {} {
    # file join to return in Tcl canonical format (/ separator, not \)
    return [file join $::env(TEMP)]
}


proc start {arg} {
    set ::tk_dialog 0
    set ::iter_after 0
    set ::dialogclass "#32770"

    after 1 $arg
}

proc then {cmd} {
    set ::command $cmd
    set ::dialogresult {}
    set ::testfont {}

    # Do not make the delay too short. The newer Vista dialogs take
    # time to come up. Even if the testforwindow returns true, the
    # controls are not ready to accept messages
    afterbody
    after 500 afterbody
    vwait ::dialogresult
    return $::dialogresult
}

proc afterbody {} {
    # On Vista and later, using the new file dialogs we have to find
    # the window using its title as tk_dialog will not be set at the C level
    if {[vista?]} {
        if {[catch {testfindwindow "" $::dialogclass} ::tk_dialog]} {
            if {[incr ::iter_after] > 30} {
                set ::dialogresult ">30 iterations waiting on tk_dialog"
                return
            }
            after 150 {afterbody}
            return
        }
    } else {
    if {$::tk_dialog == 0} {
        if {[incr ::iter_after] > 30} {
            set ::dialogresult ">30 iterations waiting on tk_dialog"
            return
        }
        after 150 {afterbody}
        return
        if {$::tk_dialog == 0} {
            if {[incr ::iter_after] > 30} {
                set ::dialogresult ">30 iterations waiting on tk_dialog"
                return
            }
            after 150 {afterbody}
            return
        }
    }
    uplevel #0 {set dialogresult [eval $command]}
}

proc Click {button} {
    switch -exact -- $button {
        ok     { set button 1 }

    nt
} -body {
    tk_getOpenFile -foo
} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
test winDialog-5.3 {GetFileName: many arguments} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
    start {tk_getOpenFile -initialdir [initialdir] -parent . -title test -initialfile foo}
    then {
        Click cancel
    }
} -result {0}
test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
    nt
} -body {

#    if (string[0] == '.') {
#    string++;
#    }

    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
    set msg {}
    then {
	if {[catch {SetText 0x47C bar} msg]} {
	if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    string totitle $x$msg
} -cleanup {
    unset msg
} -result [string totitle [file join [pwd] bar.foo]]
test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    set msg {}
    then {
	if {[catch {SetText 0x47C bar} msg]} {
	if {[catch {SetText [vista? 0x47C 0x3e9] bar} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    string totitle $x$msg
} -cleanup {
    unset msg
} -result [string totitle [file join [pwd] bar.foo]]
if {![vista?]} {
    # XXX - currently disabled for vista style dialogs because the file
    # types control has no control ID and we don't have a mechanism to
    # locate it.
test winDialog-5.9 {GetFileName: file types} -constraints {
    nt testwinevent
} -body {
#        case FILE_TYPES:

    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
    then {
        set x [GetText 0x470]
        Click cancel
    }
    return $x
} -result {foo files (*.foo)}
    test winDialog-5.9 {GetFileName: file types} -constraints {
        nt testwinevent
    } -body {
        #        case FILE_TYPES:
        
        start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
        then {
            set x [GetText 0x470]
            Click cancel
        }
        return $x
    } -result {foo files (*.foo)}
}
test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints {
    nt
} -body {
#        if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)

    tk_getSaveFile -filetypes {{"foo" .foo FOO}}
} -returnCodes error -result {bad Macintosh file type "FOO"}
if {[info exists ::env(TEMP)]} {
test winDialog-5.11 {GetFileName: initial directory} -constraints {
    nt testwinevent
} -body {
#        case FILE_INITDIR:

    unset -nocomplain x
    start {set x [tk_getSaveFile \
                      -initialdir [file normalize $::env(TEMP)] \
                      -initialfile "12x 455" -title Foo]}
    then {
        Click ok
    }
    return $x

} -result [string totitle [file join [pwd] "12x 456"]]
test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints {
    nt
} -body {
#        if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
    tk_getOpenFile -initialfile ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}
if {![vista?]} {
    # XXX - disabled for Vista because the new dialogs allow long file
    # names to be specified but force the user to change it.
test winDialog-5.15 {GetFileName: initial file: long name} -constraints {
    nt testwinevent
} -body {
    start {
        set dialogresult [catch {
            tk_getSaveFile -initialfile [string repeat a 1024] -title Long
        } x]
    }
    then {
        Click ok
    }
    list $dialogresult [string match "invalid filename *" $x]
} -result {1 1}
    test winDialog-5.15 {GetFileName: initial file: long name} -constraints {
        nt testwinevent
    } -body {
        start {
            set dialogresult [catch {
                tk_getSaveFile -initialfile [string repeat a 1024] -title Long
            } x]
        }
        then {
            Click ok
        }
        list $dialogresult [string match "invalid filename *" $x]
    } -result {1 1}
}
test winDialog-5.16 {GetFileName: parent} -constraints {
    nt
} -body {
#        case FILE_PARENT:

    toplevel .t
    set x 0

#        case FILE_TITLE:
   
    start {tk_getOpenFile -title Narf}
    then {
        Click cancel
    }
} -result {0}
if {[vista?]} {
    # In the newer file dialogs, the file type widget does not even exist
    # if no file types specified
test winDialog-5.18 {GetFileName: no filter specified} -constraints {
    nt testwinevent
} -body {
#    if (ofn.lpstrFilter == NULL)

    start {tk_getOpenFile -title Filter}
    then {
    set x [GetText 0x470]
        Click cancel
    }
    return $x
} -result {All Files (*.*)}
    test winDialog-5.18 {GetFileName: no filter specified} -constraints {
        nt testwinevent
    } -body {
        #    if (ofn.lpstrFilter == NULL)
        start {tk_getOpenFile -title Filter}
        then {
            catch {set x [GetText 0x470]} y
            Click cancel
        }
        return $y
    } -result {Could not find control with id 1136}
} else {
    test winDialog-5.18 {GetFileName: no filter specified} -constraints {
        nt testwinevent
    } -body {
        #    if (ofn.lpstrFilter == NULL)

        start {tk_getOpenFile -title Filter}
        then {
            set x [GetText 0x470]
            Click cancel
        }
        return $x
    } -result {All Files (*.*)}
}
test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints {
    nt
} -setup {
    destroy .t
} -body {
#    if (Tk_WindowId(parent) == None)

if {[info exists ::env(TEMP)]} {
test winDialog-5.23 {GetFileName: convert \ to /} -constraints {
    nt testwinevent
} -body {
    set msg {}
    start {set x [tk_getSaveFile -title Back]}
    then {
	if {[catch {SetText 0x47C [file nativename \
	if {[catch {SetText [vista? 0x47C 0x3e9] [file nativename \
		[file join [file normalize $::env(TEMP)] "12x 457"]]} msg]} {
	    Click cancel
	} else {
	    Click ok
	}
    }
    return $x$msg

} -body {
    tk_chooseDirectory -foo
} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints {
    nt testwinevent
} -body {
    start {
    tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
        tk_chooseDirectory -initialdir [initialdir] -mustexist 1 -parent . -title test
    }
    then {
        Click cancel
    }
} -result {0}
test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
    nt

    tk_chooseDirectory -initialdir bar -title
} -returnCodes error -result {value for "-title" missing}
test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints {
    nt testwinevent
} -body {
#        case DIR_INITIAL:

    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
    start {set x [tk_chooseDirectory -initialdir [initialdir] -title Foo]}
    then {
        Click ok
    }
    string tolower [set x]
} -result {c:/}
} -result [initialdir]
test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints {
    nt
} -body {
#        if (Tcl_TranslateFileName(interp, string,
#            &utfDirString) == NULL)
   
    tk_chooseDirectory -initialdir ~12x/455

#ifdef _MSC_VER
#   pragma comment (lib, "comdlg32.lib")
#endif
#include <dlgs.h>		/* includes common dialog template defines */
#include <cderr.h>		/* includes the common dialog error codes */

#include <shlobj.h>		/* includes SHBrowseForFolder */
#include <shobjidl.h>

#ifdef _MSC_VER
#   pragma comment (lib, "shell32.lib")
#endif

/* These needed for compilation with VC++ 5.2 */
/* XXX - remove these since need at least VC 6 */
#ifndef BIF_EDITBOX
#define BIF_EDITBOX 0x10
#endif

#ifndef BIF_VALIDATE
#define BIF_VALIDATE 0x0020
#endif

/* This "new" dialog style is now actually the "old" dialog style post-Vista */
#ifndef BIF_NEWDIALOGSTYLE
#define BIF_NEWDIALOGSTYLE 0x0040
#endif

#ifndef BFFM_VALIDATEFAILED
#ifdef UNICODE
#define BFFM_VALIDATEFAILED 4

    Tcl_Interp *debugInterp;	/* Interpreter to used for debugging. */
    UINT WM_LBSELCHANGED;	/* Holds a registered windows event used for
				 * communicating between the Directory Chooser
				 * dialog and its hook proc. */
    HHOOK hMsgBoxHook;		/* Hook proc for tk_messageBox and the */
    HICON hSmallIcon;		/* icons used by a parent to be used in */
    HICON hBigIcon;		/* the message box */
    int   newFileDialogsState;
#define FDLG_STATE_INIT 0       /* Uninitialized */
#define FDLG_STATE_USE_NEW 1    /* Use the new dialogs */
#define FDLG_STATE_USE_OLD 2    /* Use the old dialogs */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following structures are used by Tk_MessageBoxCmd() to parse arguments
 * and return results.
 */

				 * for setting the "tk_dialog" variable. */
    int dynFileBufferSize;	/* Dynamic filename buffer size, stored to
				 * avoid shrinking and expanding the buffer
				 * when selection changes */
    TCHAR *dynFileBuffer;	/* Dynamic filename buffer */
} OFNData;

/*
 * The following structure is used to gather options used by various
 * file dialogs
 */
typedef struct OFNOpts {
    Tk_Window tkwin;            /* Owner window for dialog */
    Tcl_Obj *extObj;            /* Default extension */
    Tcl_Obj *titleObj;          /* Title for dialog */
    Tcl_Obj *filterObj;         /* File type filter list */
    Tcl_Obj *typeVariableObj;   /* Variable in which to store type selected */
    Tcl_Obj *initialTypeObj;    /* Initial value of above, or NULL */
    Tcl_DString utfDirString;   /* Initial dir */
    int multi;                  /* Multiple selection enabled */
    int confirmOverwrite;       /* Confirm before overwriting */
    int mustExist;              /* Used only for  */
    int forceXPStyle;          /* XXX - Force XP style even on newer systems */
    TCHAR file[TK_MULTI_MAX_PATH]; /* File name
                                      XXX - fixed size because it was so
                                      historically. Why not malloc'ed ?
                                      XXX - also, TCHAR should really be WCHAR
                                      because TkWinGetUnicodeEncoding is always
                                      UCS2.
                                   */
} OFNOpts;

/* Define the operation for which option parsing is to be done. */
enum OFNOper {
    OFN_FILE_SAVE,              /* tk_getOpenFile */
    OFN_FILE_OPEN,              /* tk_getSaveFile */
    OFN_DIR_CHOOSE              /* tk_chooseDirectory */
};


/*
 * The following definitions are required when using older versions of
 * Visual C++ (like 6.0) and possibly MingW. Those headers do not contain
 * required definitions for interfaces new to Vista that we need for
 * the new file dialogs. Duplicating definitions is OK because they
 * should forever remain unchanged.
 *
 * XXX - is there a better/easier way to use new data definitions with
 * older compilers? Should we prefix definitions with Tcl_ instead
 * of using the same names as in the SDK?
 */
#ifndef __IShellItemArray_INTERFACE_DEFINED__
#define __IShellItemArray_INTERFACE_DEFINED__

typedef enum SIATTRIBFLAGS {
    SIATTRIBFLAGS_AND	= 0x1,
    SIATTRIBFLAGS_OR	= 0x2,
    SIATTRIBFLAGS_APPCOMPAT	= 0x3,
    SIATTRIBFLAGS_MASK	= 0x3,
    SIATTRIBFLAGS_ALLITEMS	= 0x4000
} SIATTRIBFLAGS;
typedef struct IShellItemArray IShellItemArray;
typedef struct IShellItemArrayVtbl
{
    BEGIN_INTERFACE
        
    HRESULT ( STDMETHODCALLTYPE *QueryInterface )( 
        IShellItemArray * this, REFIID riid,void **ppvObject);
    ULONG ( STDMETHODCALLTYPE *AddRef )(IShellItemArray * this);
    ULONG ( STDMETHODCALLTYPE *Release )(IShellItemArray * this);
    HRESULT ( STDMETHODCALLTYPE *BindToHandler )(IShellItemArray * this,
        IBindCtx *pbc, REFGUID bhid, REFIID riid, void **ppvOut);
    /* flags is actually is enum GETPROPERTYSTOREFLAGS */
    HRESULT ( STDMETHODCALLTYPE *GetPropertyStore )(
        IShellItemArray * this, int flags,  REFIID riid, void **ppv);
    /* keyType actually REFPROPERTYKEY */
    HRESULT ( STDMETHODCALLTYPE *GetPropertyDescriptionList )( 
         IShellItemArray * this, void* keyType, REFIID riid, void **ppv);
    HRESULT ( STDMETHODCALLTYPE *GetAttributes )(IShellItemArray * this,
        SIATTRIBFLAGS AttribFlags, SFGAOF sfgaoMask, SFGAOF *psfgaoAttribs);
    HRESULT ( STDMETHODCALLTYPE *GetCount )(
        IShellItemArray * this, DWORD *pdwNumItems);
    HRESULT ( STDMETHODCALLTYPE *GetItemAt )( 
        IShellItemArray * this, DWORD dwIndex, IShellItem **ppsi);
    /* ppenumShellItems actually (IEnumShellItems **) */
    HRESULT ( STDMETHODCALLTYPE *EnumItems )(
        IShellItemArray * this, void **ppenumShellItems);
        
    END_INTERFACE
} IShellItemArrayVtbl;

struct IShellItemArray {
    CONST_VTBL struct IShellItemArrayVtbl *lpVtbl;
};

#endif /* __IShellItemArray_INTERFACE_DEFINED__ */

/* 
 * Older compilers do not define these CLSIDs so we do so here under
 * a slightly different name so as to not clash with the definitions
 * in new compilers
 */
static const CLSID ClsidFileOpenDialog = {
    0xDC1C5A9C, 0xE88A, 0X4DDE, {0xA5, 0xA1, 0x60, 0xF8, 0x2A, 0x20, 0xAE, 0xF7}
};
static const CLSID ClsidFileSaveDialog = {
    0xC0B4E2F3, 0xBA21, 0x4773, {0x8D, 0xBA, 0x33, 0x5E, 0xC9, 0x46, 0xEB, 0x8B}
};
static const IID IIDIFileOpenDialog = {
    0xD57C7288, 0xD4AD, 0x4768, {0xBE, 0x02, 0x9D, 0x96, 0x95, 0x32, 0xD9, 0x60}
};
static const IID IIDIFileSaveDialog = {
    0x84BCCD23, 0x5FDE, 0x4CDB, {0xAE, 0xA4, 0xAF, 0x64, 0xB8, 0x3D, 0x78, 0xAB}
};

#ifdef __IFileDialog_INTERFACE_DEFINED__
# define TCLCOMDLG_FILTERSPEC COMDLG_FILTERSPEC
#else

/* Forward declarations for structs that are referenced but not used */
typedef struct IPropertyStore IPropertyStore;
typedef struct IPropertyDescriptionList IPropertyDescriptionList;
typedef struct IFileOperationProgressSink IFileOperationProgressSink;
typedef enum FDAP {
    FDAP_BOTTOM	= 0,
    FDAP_TOP	= 1
} FDAP;

typedef struct {
    LPCWSTR pszName;
    LPCWSTR pszSpec;
} TCLCOMDLG_FILTERSPEC;

enum _FILEOPENDIALOGOPTIONS {
    FOS_OVERWRITEPROMPT	= 0x2,
    FOS_STRICTFILETYPES	= 0x4,
    FOS_NOCHANGEDIR	= 0x8,
    FOS_PICKFOLDERS	= 0x20,
    FOS_FORCEFILESYSTEM	= 0x40,
    FOS_ALLNONSTORAGEITEMS	= 0x80,
    FOS_NOVALIDATE	= 0x100,
    FOS_ALLOWMULTISELECT	= 0x200,
    FOS_PATHMUSTEXIST	= 0x800,
    FOS_FILEMUSTEXIST	= 0x1000,
    FOS_CREATEPROMPT	= 0x2000,
    FOS_SHAREAWARE	= 0x4000,
    FOS_NOREADONLYRETURN	= 0x8000,
    FOS_NOTESTFILECREATE	= 0x10000,
    FOS_HIDEMRUPLACES	= 0x20000,
    FOS_HIDEPINNEDPLACES	= 0x40000,
    FOS_NODEREFERENCELINKS	= 0x100000,
    FOS_DONTADDTORECENT	= 0x2000000,
    FOS_FORCESHOWHIDDEN	= 0x10000000,
    FOS_DEFAULTNOMINIMODE	= 0x20000000,
    FOS_FORCEPREVIEWPANEON	= 0x40000000
} ;
typedef DWORD FILEOPENDIALOGOPTIONS;

typedef struct IFileDialog IFileDialog;
typedef struct IFileDialogVtbl
{
    BEGIN_INTERFACE
        
    HRESULT ( STDMETHODCALLTYPE *QueryInterface )( 
         IFileDialog * this, REFIID riid, void **ppvObject);
    ULONG ( STDMETHODCALLTYPE *AddRef )( IFileDialog * this);
    ULONG ( STDMETHODCALLTYPE *Release )( IFileDialog * this);
    HRESULT ( STDMETHODCALLTYPE *Show )( IFileDialog * this, HWND hwndOwner);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileDialog * this,
        UINT cFileTypes, const TCLCOMDLG_FILTERSPEC *rgFilterSpec);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(IFileDialog * this, UINT);
    HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )(IFileDialog * this, UINT *);
    /* XXX - Actually pfde is IFileDialogEvents* but we do not use
       this call and do not want to define IFileDialogEvents as that
       pulls in a whole bunch of other stuff. */
    HRESULT ( STDMETHODCALLTYPE *Advise )( 
        IFileDialog * this, void *pfde, DWORD *pdwCookie);
    HRESULT ( STDMETHODCALLTYPE *Unadvise )(IFileDialog * this, DWORD dwCookie);
    HRESULT ( STDMETHODCALLTYPE *SetOptions )( 
        IFileDialog * this, FILEOPENDIALOGOPTIONS fos);
    HRESULT ( STDMETHODCALLTYPE *GetOptions )( 
        IFileDialog * this, FILEOPENDIALOGOPTIONS *pfos);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )(
        IFileDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *SetFolder )(
        IFileDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *GetFolder )( 
        IFileDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( 
        IFileDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *SetFileName )( 
        IFileDialog * this,  LPCWSTR pszName);
    HRESULT ( STDMETHODCALLTYPE *GetFileName )( 
        IFileDialog * this,  LPWSTR *pszName);
    HRESULT ( STDMETHODCALLTYPE *SetTitle )(
        IFileDialog * this, LPCWSTR pszTitle);
    HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( 
        IFileDialog * this, LPCWSTR pszText);
    HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( 
        IFileDialog * this,  LPCWSTR pszLabel);
    HRESULT ( STDMETHODCALLTYPE *GetResult )(
        IFileDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *AddPlace )( 
        IFileDialog * this, IShellItem *psi, FDAP fdap);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( 
         IFileDialog * this, LPCWSTR pszDefaultExtension);
    HRESULT ( STDMETHODCALLTYPE *Close )( IFileDialog * this, HRESULT hr);
    HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
        IFileDialog * this, REFGUID guid);
    HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileDialog * this);
    /* pFilter actually IShellItemFilter. But deprecated in Win7 AND we do
       not use it anyways. So define as void* */
    HRESULT ( STDMETHODCALLTYPE *SetFilter )( 
         IFileDialog * this, void *pFilter);
        
    END_INTERFACE
} IFileDialogVtbl;

struct IFileDialog {
    CONST_VTBL struct IFileDialogVtbl *lpVtbl;
};


typedef struct IFileSaveDialog IFileSaveDialog;
typedef struct IFileSaveDialogVtbl {
    BEGIN_INTERFACE
        
    HRESULT ( STDMETHODCALLTYPE *QueryInterface )( 
        IFileSaveDialog * this, REFIID riid, void **ppvObject);
    ULONG ( STDMETHODCALLTYPE *AddRef )( IFileSaveDialog * this);
    ULONG ( STDMETHODCALLTYPE *Release )( IFileSaveDialog * this);
    HRESULT ( STDMETHODCALLTYPE *Show )( 
        IFileSaveDialog * this, HWND hwndOwner);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileSaveDialog * this,
        UINT cFileTypes, const TCLCOMDLG_FILTERSPEC *rgFilterSpec);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )(
        IFileSaveDialog * this, UINT iFileType);
    HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( 
         IFileSaveDialog * this, UINT *piFileType);
    /* Actually pfde is IFileSaveDialogEvents* */
    HRESULT ( STDMETHODCALLTYPE *Advise )( 
         IFileSaveDialog * this, void *pfde, DWORD *pdwCookie);
    HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileSaveDialog * this, DWORD);
    HRESULT ( STDMETHODCALLTYPE *SetOptions )( 
         IFileSaveDialog * this, FILEOPENDIALOGOPTIONS fos);
    HRESULT ( STDMETHODCALLTYPE *GetOptions )( 
         IFileSaveDialog * this, FILEOPENDIALOGOPTIONS *pfos);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( 
         IFileSaveDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *SetFolder )(
        IFileSaveDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *GetFolder )( 
         IFileSaveDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( 
         IFileSaveDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *SetFileName )( 
         IFileSaveDialog * this,  LPCWSTR pszName);
    HRESULT ( STDMETHODCALLTYPE *GetFileName )( 
         IFileSaveDialog * this,  LPWSTR *pszName);
    HRESULT ( STDMETHODCALLTYPE *SetTitle )( 
         IFileSaveDialog * this, LPCWSTR pszTitle);
    HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( 
         IFileSaveDialog * this,  LPCWSTR pszText);
    HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( 
         IFileSaveDialog * this,  LPCWSTR pszLabel);
    HRESULT ( STDMETHODCALLTYPE *GetResult )( 
         IFileSaveDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *AddPlace )( 
         IFileSaveDialog * this, IShellItem *psi, FDAP fdap);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( 
         IFileSaveDialog * this, LPCWSTR pszDefaultExtension);
    HRESULT ( STDMETHODCALLTYPE *Close )( IFileSaveDialog * this, HRESULT hr);
    HRESULT ( STDMETHODCALLTYPE *SetClientGuid )(
        IFileSaveDialog * this, REFGUID guid);
    HRESULT ( STDMETHODCALLTYPE *ClearClientData )( IFileSaveDialog * this);
    /* pFilter Actually IShellItemFilter* */
    HRESULT ( STDMETHODCALLTYPE *SetFilter )( 
        IFileSaveDialog * this, void *pFilter);
    HRESULT ( STDMETHODCALLTYPE *SetSaveAsItem )( 
        IFileSaveDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *SetProperties )( 
        IFileSaveDialog * this, IPropertyStore *pStore);
    HRESULT ( STDMETHODCALLTYPE *SetCollectedProperties )( 
        IFileSaveDialog * this, IPropertyDescriptionList *pList,
        BOOL fAppendDefault);
    HRESULT ( STDMETHODCALLTYPE *GetProperties )( 
        IFileSaveDialog * this, IPropertyStore **ppStore);
    HRESULT ( STDMETHODCALLTYPE *ApplyProperties )( 
        IFileSaveDialog * this, IShellItem *psi, IPropertyStore *pStore,
        HWND hwnd, IFileOperationProgressSink *pSink);

    END_INTERFACE

} IFileSaveDialogVtbl;

struct IFileSaveDialog {
    CONST_VTBL struct IFileSaveDialogVtbl *lpVtbl;
};

typedef struct IFileOpenDialog IFileOpenDialog;
typedef struct IFileOpenDialogVtbl {
    BEGIN_INTERFACE
        
    HRESULT ( STDMETHODCALLTYPE *QueryInterface )( 
        IFileOpenDialog * this, REFIID riid, void **ppvObject);
    ULONG ( STDMETHODCALLTYPE *AddRef )( IFileOpenDialog * this);
    ULONG ( STDMETHODCALLTYPE *Release )( IFileOpenDialog * this);
    HRESULT ( STDMETHODCALLTYPE *Show )( IFileOpenDialog * this, HWND);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypes )( IFileOpenDialog * this,
        UINT cFileTypes, const TCLCOMDLG_FILTERSPEC *rgFilterSpec);
    HRESULT ( STDMETHODCALLTYPE *SetFileTypeIndex )( 
        IFileOpenDialog * this, UINT iFileType);
    HRESULT ( STDMETHODCALLTYPE *GetFileTypeIndex )( 
        IFileOpenDialog * this, UINT *piFileType);
    /* Actually pfde is IFileDialogEvents* */
    HRESULT ( STDMETHODCALLTYPE *Advise )( 
        IFileOpenDialog * this, void *pfde, DWORD *pdwCookie);
    HRESULT ( STDMETHODCALLTYPE *Unadvise )( IFileOpenDialog * this, DWORD);
    HRESULT ( STDMETHODCALLTYPE *SetOptions )( 
        IFileOpenDialog * this, FILEOPENDIALOGOPTIONS fos);
    HRESULT ( STDMETHODCALLTYPE *GetOptions )( 
        IFileOpenDialog * this, FILEOPENDIALOGOPTIONS *pfos);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultFolder )( 
        IFileOpenDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *SetFolder )( 
        IFileOpenDialog * this, IShellItem *psi);
    HRESULT ( STDMETHODCALLTYPE *GetFolder )( 
        IFileOpenDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *GetCurrentSelection )( 
        IFileOpenDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *SetFileName )( 
        IFileOpenDialog * this,  LPCWSTR pszName);
    HRESULT ( STDMETHODCALLTYPE *GetFileName )( 
        IFileOpenDialog * this, LPWSTR *pszName);
    HRESULT ( STDMETHODCALLTYPE *SetTitle )( 
        IFileOpenDialog * this, LPCWSTR pszTitle);
    HRESULT ( STDMETHODCALLTYPE *SetOkButtonLabel )( 
        IFileOpenDialog * this, LPCWSTR pszText);
    HRESULT ( STDMETHODCALLTYPE *SetFileNameLabel )( 
        IFileOpenDialog * this, LPCWSTR pszLabel);
    HRESULT ( STDMETHODCALLTYPE *GetResult )( 
        IFileOpenDialog * this, IShellItem **ppsi);
    HRESULT ( STDMETHODCALLTYPE *AddPlace )( 
        IFileOpenDialog * this, IShellItem *psi, FDAP fdap);
    HRESULT ( STDMETHODCALLTYPE *SetDefaultExtension )( 
        IFileOpenDialog * this, LPCWSTR pszDefaultExtension);
    HRESULT ( STDMETHODCALLTYPE *Close )( IFileOpenDialog * this, HRESULT hr);
    HRESULT ( STDMETHODCALLTYPE *SetClientGuid )( 
        IFileOpenDialog * this, REFGUID guid);
    HRESULT ( STDMETHODCALLTYPE *ClearClientData )( 
        IFileOpenDialog * this);
    HRESULT ( STDMETHODCALLTYPE *SetFilter )( 
        IFileOpenDialog * this,
        /* pFilter is actually IShellItemFilter */
        void *pFilter);
    HRESULT ( STDMETHODCALLTYPE *GetResults )( 
        IFileOpenDialog * this, IShellItemArray **ppenum);
    HRESULT ( STDMETHODCALLTYPE *GetSelectedItems )( 
        IFileOpenDialog * this, IShellItemArray **ppsai);

    END_INTERFACE
} IFileOpenDialogVtbl;

struct IFileOpenDialog
{
    CONST_VTBL struct IFileOpenDialogVtbl *lpVtbl;
};

#endif /* __IFileDialog_INTERFACE_DEFINED__ */

/*
 * Definitions of functions used only in this file.
 */

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[], int isOpen);
                                    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(TCHAR *filename,
			    Tcl_DString *dsPtr);
static void             LoadShellProcs(void);


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


/*
 *-------------------------------------------------------------------------
 *
 * LoadShellProcs --
 *
 *     Some shell functions are not available on older versions of
 *     Windows. This function dynamically loads them and stores pointers
 *     to them in ShellProcs. Any function that is not available has
 *     the corresponding pointer set to NULL.
 *
 *     Note this call never fails. Unavailability of a function is not
 *     a reason for failure. Caller should check whether a particular
 *     function pointer is NULL or not. Once loaded a function stays
 *     forever loaded.
 *
 *     XXX - we load the function pointers into global memory. This implies
 *     there is a potential (however small) for race conditions between
 *     threads. However, Tk is in any case meant to be loaded in exactly
 *     one thread so this should not be an issue and saves us from
 *     unnecessary bookkeeping.
 *
 * Return value:
 *     None. 
 *
 * Side effects:
 *     ShellProcs is populated.
 *-------------------------------------------------------------------------
 */
static void LoadShellProcs()
{
    static HMODULE shell32_handle = NULL;

    if (shell32_handle != NULL)
        return; /* We have already been through here. */

    /*
     * XXX - Note we never call FreeLibrary. There is no point because
     * shell32.dll is loaded at startup anyways and stays for the duration
     * of the process so why bother with keeping track of when to unload
     */
    shell32_handle = LoadLibrary(TEXT("shell32.dll"));
    if (shell32_handle == NULL) /* Should never happen but check anyways. */
        return;

    ShellProcs.SHCreateItemFromParsingName =
        (SHCreateItemFromParsingNameProc*) GetProcAddress(shell32_handle,
                                                         "SHCreateItemFromParsingName");
}


/*
 *-------------------------------------------------------------------------
 *
 * EatSpuriousMessageBugFix --
 *
 *	In the file open/save dialog, double clicking on a list item causes

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, 1);
    return GetFileName(clientData, interp, objc, objv, OFN_FILE_OPEN);
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetSaveFileCmd --
 *

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, 0);
    return GetFileName(clientData, interp, objc, objv, OFN_FILE_SAVE);
}

/*
 *----------------------------------------------------------------------
 *
 * CleanupOFNOptions --
 *
 *	Cleans up any storage allocated by ParseOFNOptions
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Releases resources held by *optsPtr
 *----------------------------------------------------------------------
 */
static void CleanupOFNOptions(OFNOpts *optsPtr)
{
    Tcl_DStringFree(&optsPtr->utfDirString);
}



/*
 *----------------------------------------------------------------------
 *
 * GetFileName --
 * ParseOFNOptions --
 *
 *	Calls GetOpenFileName() or GetSaveFileName().
 *	Option parsing for tk_get{Open,Save}File
 *
 * Results:
 *	See user documentation.
 *	TCL_OK on success, TCL_ERROR otherwise
 *
 * Side effects:
 *	See user documentation.
 *
 *	Returns option values in *optsPtr. Note these may include string
 *      pointers into objv[]
 *----------------------------------------------------------------------
 */

static int
GetFileName(
ParseOFNOptions(
    ClientData clientData,	/* Main window associated with interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int open)			/* 1 to call GetOpenFileName(), 0 to call
				 * GetSaveFileName(). */
    enum OFNOper oper,			/* 1 for Open, 0 for Save */
    OFNOpts *optsPtr)           /* Output, uninitialized on entry */
{
    OPENFILENAME ofn;
    TCHAR file[TK_MULTI_MAX_PATH];
    OFNData ofnData;
    int cdlgerr;
    int i;
    int filterIndex = 0, result = TCL_ERROR, winCode, oldMode, i, multi = 0;
    int confirmOverwrite = 1;
    const char *extension = NULL, *title = NULL;
    Tk_Window tkwin = clientData;
    HWND hWnd;
    Tcl_Obj *filterObj = NULL, *initialTypeObj = NULL, *typeVariableObj = NULL;
    Tcl_DString utfFilterString, utfDirString, ds;
    Tcl_DString ds;
    Tcl_DString extString, filterString, dirString, titleString;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    enum options {
	FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE, FILE_PARENT,
	FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW
	FILE_TITLE, FILE_TYPEVARIABLE, FILE_MULTIPLE, FILE_CONFIRMOW,
        FILE_MUSTEXIST,
    };
    struct Options {
	const char *name;
	enum options value;
    };
    static const struct Options saveOptions[] = {
	{"-confirmoverwrite",	FILE_CONFIRMOW},

	{"-initialfile",	FILE_INITFILE},
	{"-multiple",		FILE_MULTIPLE},
	{"-parent",		FILE_PARENT},
	{"-title",		FILE_TITLE},
	{"-typevariable",	FILE_TYPEVARIABLE},
	{NULL,			FILE_DEFAULT/*ignored*/ }
    };
    const struct Options *const options = open ? openOptions : saveOptions;
    static const struct Options dirOptions[] = {
	{"-initialdir", FILE_INITDIR},
        {"-mustexist",  FILE_MUSTEXIST},
	{"-parent",	FILE_PARENT},
	{"-title",	FILE_TITLE},
	{NULL,		FILE_DEFAULT/*ignored*/ }
    };

    file[0] = '\0';
    ZeroMemory(&ofnData, sizeof(OFNData));
    const struct Options *options = NULL;

    Tcl_DStringInit(&utfFilterString);
    Tcl_DStringInit(&utfDirString);

    /*
     * Parse the arguments.
    switch (oper) {
    case OFN_FILE_SAVE: options = saveOptions; break;
    case OFN_DIR_CHOOSE: options = dirOptions; break;
    case OFN_FILE_OPEN: options = openOptions; break;
    }        
        
    ZeroMemory(optsPtr, sizeof(*optsPtr));
    // optsPtr->forceXPStyle = 1;
    optsPtr->tkwin = clientData;
     */
    optsPtr->confirmOverwrite = 1; /* By default we ask for confirmation */
    Tcl_DStringInit(&optsPtr->utfDirString);
    optsPtr->file[0] = 0;

    for (i = 1; i < objc; i += 2) {
	int index;
	const char *string;
	Tcl_Obj *valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
		sizeof(struct Options), "option", 0, &index) != TCL_OK) {
            /*
             * XXX -xpstyle is explicitly checked for as it is undocumented
             * and we do not want it to show in option error messages.
             */
            if (strcmp(Tcl_GetString(objv[i]), "-xpstyle"))
	    goto end;
                goto error_return;
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
                                      &optsPtr->forceXPStyle) != TCL_OK)
                goto error_return;

            continue;

	} else if (i + 1 == objc) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "value for \"%s\" missing", options[index].name));
	    Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
	    goto end;
	    goto error_return;
	}

	string = Tcl_GetString(valuePtr);
	switch (options[index].value) {
	case FILE_DEFAULT:
	    if (string[0] == '.') {
		string++;
	    }
	    extension = string;
	    optsPtr->extObj = valuePtr;
	    break;
	case FILE_TYPES:
	    filterObj = valuePtr;
	    optsPtr->filterObj = valuePtr;
	    break;
	case FILE_INITDIR:
	    Tcl_DStringFree(&utfDirString);
	    Tcl_DStringFree(&optsPtr->utfDirString);
	    if (Tcl_TranslateFileName(interp, string,
		    &utfDirString) == NULL) {
		goto end;
                                      &optsPtr->utfDirString) == NULL)
		goto error_return;
	    }
	    break;
	case FILE_INITFILE:
	    if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
		goto end;
	    if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
		goto error_return;
	    }
	    Tcl_UtfToExternal(NULL, TkWinGetUnicodeEncoding(),
		    Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), 0, NULL,
		    (char *) file, sizeof(file), NULL, NULL, NULL);
                              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:
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		goto end;
	    optsPtr->tkwin = Tk_NameToWindow(interp, string, clientData);
	    if (optsPtr->tkwin == NULL)
		goto error_return;
	    }
	    break;
	case FILE_TITLE:
	    title = string;
	    optsPtr->titleObj = valuePtr;
	    break;
	case FILE_TYPEVARIABLE:
	    typeVariableObj = valuePtr;
	    initialTypeObj = Tcl_ObjGetVar2(interp, typeVariableObj, NULL,
		    TCL_GLOBAL_ONLY);
	    optsPtr->typeVariableObj = valuePtr;
	    optsPtr->initialTypeObj = Tcl_ObjGetVar2(interp, valuePtr,
                                                     NULL, TCL_GLOBAL_ONLY);
	    break;
	case FILE_MULTIPLE:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr, &multi) != TCL_OK) {
		return TCL_ERROR;
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
                                      &optsPtr->multi) != TCL_OK)
                goto error_return;
	    }
	    break;
	case FILE_CONFIRMOW:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
		    &confirmOverwrite) != TCL_OK) {
		return TCL_ERROR;
                                      &optsPtr->confirmOverwrite) != TCL_OK)
                goto error_return;
	    }
	    break;
        case FILE_MUSTEXIST:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
                                      &optsPtr->mustExist) != TCL_OK)
                goto error_return;
            break;
	}
    }

    return TCL_OK;
    if (MakeFilter(interp, filterObj, &utfFilterString, initialTypeObj,
	    &filterIndex) != TCL_OK) {

error_return:                   /* interp should already hold error */
    /* On error, we need to clean up anything we might have allocated */
    CleanupOFNOptions(optsPtr);
    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 * VistaFileDialogsAvailable
 *
 *      Checks whether the new (Vista) file dialogs can be used on
 *      the system.
 * 
 * Returns:
 *      1 if new dialogs are available, 0 otherwise
 *
 * Side effects:
 *      Loads required procedures dynamically if available.
 *      If new dialogs are available, COM is also initialized.
 *----------------------------------------------------------------------
 */
static int VistaFileDialogsAvailable()
{
    HRESULT hr;
    IFileDialog *fdlgPtr = NULL;
    ThreadSpecificData *tsdPtr =
        Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (tsdPtr->newFileDialogsState == FDLG_STATE_INIT) {
        tsdPtr->newFileDialogsState = FDLG_STATE_USE_OLD;
        LoadShellProcs();
        if (ShellProcs.SHCreateItemFromParsingName != NULL) {
            hr = CoInitialize(0);
            /* XXX - need we schedule CoUninitialize at thread shutdown ? */

            /* Ensure all COM interfaces we use are available */
            if (SUCCEEDED(hr)) {
                hr = CoCreateInstance(&ClsidFileOpenDialog, NULL,
                                      CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgPtr);
                if (SUCCEEDED(hr)) {
                    fdlgPtr->lpVtbl->Release(fdlgPtr);
                    hr = CoCreateInstance(&ClsidFileSaveDialog, NULL,
                             CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog,
                                          (void **) &fdlgPtr);
                    if (SUCCEEDED(hr)) {
                        fdlgPtr->lpVtbl->Release(fdlgPtr);

                        /* Looks like we have all we need */
                        tsdPtr->newFileDialogsState = FDLG_STATE_USE_NEW;
                    }
                }
            }
        }        
    }

    return (tsdPtr->newFileDialogsState == FDLG_STATE_USE_NEW);
}

/*
 *----------------------------------------------------------------------
 *
 * GetFileNameVista --
 *
 *	Displays the new file dialogs on Vista and later.
 *      This function must generally not be called unless the 
 *      tsdPtr->newFileDialogsState is FDLG_STATE_USE_NEW but if
 *      it is, it will just pass the call to the older GetFileNameXP
 *
 * Results:
 *	TCL_OK - dialog was successfully displayed, results returned in interp
 *      TCL_ERROR - error return
 *
 * Side effects:
 *      Dialogs is displayed
 *----------------------------------------------------------------------
 */
static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
                            enum OFNOper oper)
{
    HRESULT hr;
    HWND hWnd;
    DWORD flags, nfilters, defaultFilterIndex;
    TCLCOMDLG_FILTERSPEC *filterPtr = NULL;
    IFileDialog *fdlgIf = NULL;
    IShellItem *dirIf = NULL;
    LPWSTR wstr;
    Tcl_Obj *resultObj = NULL;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    int oldMode;

    if (tsdPtr->newFileDialogsState != FDLG_STATE_USE_NEW) {
        /* XXX - should be an assert but Tcl does not seem to have one? */
        Tcl_SetResult(interp, "Internal error: GetFileNameVista: IFileDialog API not available", TCL_STATIC);
        return TCL_ERROR;
    }

    /*
     * At this point new interfaces are supposed to be available.
     * fdlgIf is actually a IFileOpenDialog or IFileSaveDialog
     * both of which inherit from IFileDialog. We use the common
     * IFileDialog interface for the most part, casting only for
     * type-specific calls.
     */
    Tk_MakeWindowExist(optsPtr->tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin));

    /*
     * The only validation we need to do w.r.t caller supplied data
     * is the filter specification so do that before creating 
     */
    if (MakeFilterVista(interp, optsPtr, &nfilters, &filterPtr,
                        &defaultFilterIndex) != TCL_OK)
        return TCL_ERROR;

    /*
     * Beyond this point, do not just return on error as there will be
     * resources that need to be released/freed.
     */

    if (oper == OFN_FILE_OPEN || oper == OFN_DIR_CHOOSE)
        hr = CoCreateInstance(&ClsidFileOpenDialog, NULL,
                              CLSCTX_INPROC_SERVER, &IIDIFileOpenDialog, (void **) &fdlgIf);
    else
        hr = CoCreateInstance(&ClsidFileSaveDialog, NULL,
                              CLSCTX_INPROC_SERVER, &IIDIFileSaveDialog, (void **) &fdlgIf);

    if (FAILED(hr))
        goto vamoose;

    /*
     * Get current settings first because we want to preserve existing
     * settings like whether to show hidden files etc. based on the
     * user's existing preference
     */
    hr = fdlgIf->lpVtbl->GetOptions(fdlgIf, &flags);
    if (FAILED(hr))
        goto vamoose;

    if (filterPtr) {
        flags |= FOS_STRICTFILETYPES;
        hr = fdlgIf->lpVtbl->SetFileTypes(fdlgIf, nfilters, filterPtr);
        if (FAILED(hr))
            goto vamoose;
        hr = fdlgIf->lpVtbl->SetFileTypeIndex(fdlgIf, defaultFilterIndex);
        if (FAILED(hr))
            goto vamoose;
    }        
        
    /* Flags are equivalent to those we used in the older API */

    /*
     * Following flags must be set irrespective of original setting
     * XXX - should FOS_NOVALIDATE be there ? Note FOS_NOVALIDATE has different
     * semantics than OFN_NOVALIDATE in the old API.
     */
    flags |=
        FOS_FORCEFILESYSTEM | /* Only want files, not other shell items */
        FOS_NOVALIDATE |           /* Don't check for access denied etc. */
        FOS_PATHMUSTEXIST;           /* The *directory* path must exist */


    if (oper == OFN_DIR_CHOOSE) {
        flags |= FOS_PICKFOLDERS;
        if (optsPtr->mustExist)
            flags |= FOS_FILEMUSTEXIST; /* XXX - check working */
    } else
        flags &= ~ FOS_PICKFOLDERS;

    if (optsPtr->multi)
        flags |= FOS_ALLOWMULTISELECT;
    else
        flags &= ~FOS_ALLOWMULTISELECT;

    if (optsPtr->confirmOverwrite)
        flags |= FOS_OVERWRITEPROMPT;
    else
        flags &= ~FOS_OVERWRITEPROMPT;

    hr = fdlgIf->lpVtbl->SetOptions(fdlgIf, flags);
    if (FAILED(hr))
        goto vamoose;

    if (optsPtr->extObj != NULL) {
        wstr = Tcl_GetUnicode(optsPtr->extObj);
        if (wstr[0] == L'.')
            ++wstr;
        hr = fdlgIf->lpVtbl->SetDefaultExtension(fdlgIf, wstr);
        if (FAILED(hr))
            goto vamoose;
    }

    if (optsPtr->titleObj != NULL) {
        hr = fdlgIf->lpVtbl->SetTitle(fdlgIf,
                                       Tcl_GetUnicode(optsPtr->titleObj));
        if (FAILED(hr))
            goto vamoose;
    }        

    if (optsPtr->file[0]) {
        hr = fdlgIf->lpVtbl->SetFileName(fdlgIf, optsPtr->file);
        if (FAILED(hr))
            goto vamoose;
    }

    if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') {
        Tcl_DString dirString;
	Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString),
               Tcl_DStringLength(&optsPtr->utfDirString), &dirString);
        hr = ShellProcs.SHCreateItemFromParsingName(
            (TCHAR *) Tcl_DStringValue(&dirString), NULL,
            &IID_IShellItem, (void **) &dirIf);
        /* XXX - Note on failure we do not raise error, simply ignore ini dir */
        if (SUCCEEDED(hr)) {
            /* Note we use SetFolder, not SetDefaultFolder - see MSDN docs */
            fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */
        }
        Tcl_DStringFree(&dirString);
    }    

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    hr = fdlgIf->lpVtbl->Show(fdlgIf, hWnd);
    Tcl_SetServiceMode(oldMode);

    if (SUCCEEDED(hr)) {
        if ((oper == OFN_FILE_OPEN) && optsPtr->multi) {
            IShellItemArray *multiIf;
            DWORD dw, count;
            IFileOpenDialog *fodIf = (IFileOpenDialog *) fdlgIf;
            hr = fodIf->lpVtbl->GetResults(fodIf, &multiIf);
            if (SUCCEEDED(hr)) {
                Tcl_Obj *multiObj;
                hr = multiIf->lpVtbl->GetCount(multiIf, &count);
                multiObj = Tcl_NewListObj(count, NULL);
                if (SUCCEEDED(hr)) {
                    IShellItem *itemIf;
                    for (dw = 0; dw < count; ++dw) {
                        hr = multiIf->lpVtbl->GetItemAt(multiIf, dw, &itemIf);
                        if (FAILED(hr))
                            break;
                        hr = itemIf->lpVtbl->GetDisplayName(itemIf,
                                        SIGDN_FILESYSPATH, &wstr);
                        if (SUCCEEDED(hr)) {
                            Tcl_DString fnds;
                            ConvertExternalFilename(wstr, &fnds);
                            CoTaskMemFree(wstr);
                            Tcl_ListObjAppendElement(
                                interp, multiObj,
                                Tcl_NewStringObj(Tcl_DStringValue(&fnds),
                                                 Tcl_DStringLength(&fnds)));
                        }
                        itemIf->lpVtbl->Release(itemIf);
                        if (FAILED(hr))
                            break;
                    }
                }
                multiIf->lpVtbl->Release(multiIf);
                if (SUCCEEDED(hr))
                    resultObj = multiObj;
                else
                    Tcl_DecrRefCount(multiObj);
            }
        } else {
            IShellItem *resultIf;
            hr = fdlgIf->lpVtbl->GetResult(fdlgIf, &resultIf);
            if (SUCCEEDED(hr)) {
                hr = resultIf->lpVtbl->GetDisplayName(resultIf, SIGDN_FILESYSPATH,
                                                      &wstr);
                if (SUCCEEDED(hr)) {
                    Tcl_DString fnds;
                    ConvertExternalFilename(wstr, &fnds);
                    resultObj = Tcl_NewStringObj(Tcl_DStringValue(&fnds),
                                                 Tcl_DStringLength(&fnds));
                    CoTaskMemFree(wstr);
                }
                resultIf->lpVtbl->Release(resultIf);
            }
        }
        if (SUCCEEDED(hr)) {
            if (filterPtr && optsPtr->typeVariableObj) {
                UINT ftix;
                hr = fdlgIf->lpVtbl->GetFileTypeIndex(fdlgIf, &ftix);
                if (SUCCEEDED(hr)) {
                    /* Note ftix is a 1-based index */
                    if (ftix > 0 && ftix <= nfilters) {
                        Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
                               Tcl_NewUnicodeObj(filterPtr[ftix-1].pszName, -1),
                               TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
                    }
                }
            }
        }
    } else {
        if (hr == HRESULT_FROM_WIN32(ERROR_CANCELLED))
            hr = 0;             /* User cancelled, return empty string */
    }

vamoose: /* (hr != 0) => error */
    if (dirIf)
        dirIf->lpVtbl->Release(dirIf);
    if (fdlgIf)
        fdlgIf->lpVtbl->Release(fdlgIf);

    if (filterPtr)
        FreeFilterVista(nfilters, filterPtr);

    if (hr == 0) {
        if (resultObj)          /* May be NULL if user cancelled */
            Tcl_SetObjResult(interp, resultObj);
        return TCL_OK;
    } else {
        if (resultObj)
            Tcl_DecrRefCount(resultObj);
        Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
        return TCL_ERROR;
    }
}


/*
 *----------------------------------------------------------------------
 *
 * GetFileNameXP --
 *
 *	Displays the old pre-Vista file dialogs.
 *
 * Results:
 *	TCL_OK - if dialog was successfully displayed
 *      TCL_ERROR - error return
 *
 * Side effects:
 *      See user documentation.
 *----------------------------------------------------------------------
 */
static int GetFileNameXP(Tcl_Interp *interp, OFNOpts *optsPtr, enum OFNOper oper)
{
    OPENFILENAME ofn;
    OFNData ofnData;
    int cdlgerr;
    int filterIndex = 0, result = TCL_ERROR, winCode, oldMode;
    HWND hWnd;
    Tcl_DString utfFilterString, ds;
    Tcl_DString extString, filterString, dirString, titleString;
    const char *str;
    ThreadSpecificData *tsdPtr =
        Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    ZeroMemory(&ofnData, sizeof(OFNData));
    Tcl_DStringInit(&utfFilterString);
    Tcl_DStringInit(&dirString); /* XXX - original code was missing this
                                    leaving dirString uninitialized for
                                    the unlikely code path where cwd failed */

    if (MakeFilter(interp, optsPtr->filterObj, &utfFilterString,
                   optsPtr->initialTypeObj, &filterIndex) != TCL_OK) {
	goto end;
    }

    Tk_MakeWindowExist(tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
    Tk_MakeWindowExist(optsPtr->tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(optsPtr->tkwin));

    ZeroMemory(&ofn, sizeof(OPENFILENAME));
    ofn.lStructSize = sizeof(OPENFILENAME);
    ofn.hwndOwner = hWnd;
    ofn.hInstance = TkWinGetHInstance(ofn.hwndOwner);
    ofn.lpstrFile = file;
    ofn.lpstrFile = optsPtr->file;
    ofn.nMaxFile = TK_MULTI_MAX_PATH;
    ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST | OFN_NOCHANGEDIR
	    | OFN_EXPLORER | OFN_ENABLEHOOK| OFN_ENABLESIZING;
	    | OFN_EXPLORER| OFN_ENABLEHOOK| OFN_ENABLESIZING;
    ofn.lpfnHook = (LPOFNHOOKPROC) OFNHookProc;
    ofn.lCustData = (LPARAM) &ofnData;

    if (open != 0) {
    if (oper != OFN_FILE_SAVE) {
	ofn.Flags |= OFN_FILEMUSTEXIST;
    } else if (confirmOverwrite) {
    } else if (optsPtr->confirmOverwrite) {
	ofn.Flags |= OFN_OVERWRITEPROMPT;
    }
    if (tsdPtr->debugFlag != 0) {
	ofnData.interp = interp;
    }
    if (multi != 0) {
    if (optsPtr->multi != 0) {
	ofn.Flags |= OFN_ALLOWMULTISELECT;

	/*
	 * Starting buffer size. The buffer will be expanded by the OFN dialog
	 * procedure when necessary
	 */

	ofnData.dynFileBufferSize = 512;
	ofnData.dynFileBuffer = ckalloc(512 * sizeof(TCHAR));
    }

    if (extension != NULL) {
	Tcl_WinUtfToTChar(extension, -1, &extString);
    if (optsPtr->extObj != NULL) {
        str = Tcl_GetString(optsPtr->extObj);
        if (str[0] == '.')
            ++str;
	Tcl_WinUtfToTChar(str, -1, &extString);
	ofn.lpstrDefExt = (TCHAR *) Tcl_DStringValue(&extString);
    }

    Tcl_WinUtfToTChar(Tcl_DStringValue(&utfFilterString),
	    Tcl_DStringLength(&utfFilterString), &filterString);
    ofn.lpstrFilter = (TCHAR *) Tcl_DStringValue(&filterString);
    ofn.nFilterIndex = filterIndex;

    if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
	Tcl_WinUtfToTChar(Tcl_DStringValue(&utfDirString),
		Tcl_DStringLength(&utfDirString), &dirString);
    if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') {
	Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString),
		Tcl_DStringLength(&optsPtr->utfDirString), &dirString);
    } else {
	/*
	 * NT 5.0 changed the meaning of lpstrInitialDir, so we have to ensure
	 * that we set the [pwd] if the user didn't specify anything else.
	 */

	Tcl_DString cwd;

	Tcl_DStringFree(&utfDirString);
	if ((Tcl_GetCwd(interp, &utfDirString) == NULL) ||
	Tcl_DStringFree(&optsPtr->utfDirString);
	if ((Tcl_GetCwd(interp, &optsPtr->utfDirString) == NULL) ||
		(Tcl_TranslateFileName(interp,
			Tcl_DStringValue(&utfDirString), &cwd) == NULL)) {
                     Tcl_DStringValue(&optsPtr->utfDirString), &cwd) == NULL)) {
	    Tcl_ResetResult(interp);
	} else {
	    Tcl_WinUtfToTChar(Tcl_DStringValue(&cwd),
		    Tcl_DStringLength(&cwd), &dirString);
	}
	Tcl_DStringFree(&cwd);
    }
    ofn.lpstrInitialDir = (TCHAR *) Tcl_DStringValue(&dirString);

    if (title != NULL) {
	Tcl_WinUtfToTChar(title, -1, &titleString);
    if (optsPtr->titleObj != NULL) {
	Tcl_WinUtfToTChar(Tcl_GetString(optsPtr->titleObj), -1, &titleString);
	ofn.lpstrTitle = (TCHAR *) Tcl_DStringValue(&titleString);
    }

    /*
     * Popup the dialog.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    if (open != 0) {
    if (oper != OFN_FILE_SAVE) {
	winCode = GetOpenFileName(&ofn);
    } else {
	winCode = GetSaveFileName(&ofn);
    }
    Tcl_SetServiceMode(oldMode);
    EatSpuriousMessageBugFix();

	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    ConvertExternalFilename(ofn.lpstrFile, &ds), -1));
	    gotFilename = (Tcl_DStringLength(&ds) > 0);
	    Tcl_DStringFree(&ds);
	}
	result = TCL_OK;
	if ((ofn.nFilterIndex > 0) && gotFilename && typeVariableObj
		&& filterObj) {
	if ((ofn.nFilterIndex > 0) && gotFilename && optsPtr->typeVariableObj
		&& optsPtr->filterObj) {
	    int listObjc, count;
	    Tcl_Obj **listObjv = NULL;
	    Tcl_Obj **typeInfo = NULL;

	    if (Tcl_ListObjGetElements(interp, filterObj,
	    if (Tcl_ListObjGetElements(interp, optsPtr->filterObj,
		    &listObjc, &listObjv) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (Tcl_ListObjGetElements(interp,
		    listObjv[ofn.nFilterIndex - 1], &count,
		    &typeInfo) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (Tcl_ObjSetVar2(interp, typeVariableObj, NULL,
		    typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	    } else if (Tcl_ObjSetVar2(interp, optsPtr->typeVariableObj, NULL,
                   typeInfo[0], TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
		result = TCL_ERROR;
	    }
	}
    } else if (cdlgerr == FNERR_INVALIDFILENAME) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid filename \"%s\"",
		ConvertExternalFilename(ofn.lpstrFile, &ds)));
	Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "INVALID_FILENAME",
		NULL);
	Tcl_DStringFree(&ds);
    } else {
	result = TCL_OK;
    }

    if (ofn.lpstrTitle != NULL) {
	Tcl_DStringFree(&titleString);
    }
    if (ofn.lpstrInitialDir != NULL) {
        /* XXX - huh? lpstrInitialDir is set from Tcl_DStringValue which
           can never return NULL */
	Tcl_DStringFree(&dirString);
    }
    Tcl_DStringFree(&filterString);
    if (ofn.lpstrDefExt != NULL) {
	Tcl_DStringFree(&extString);
    }

  end:
end:
    Tcl_DStringFree(&utfDirString);
    Tcl_DStringFree(&utfFilterString);
    if (ofnData.dynFileBuffer != NULL) {
	ckfree(ofnData.dynFileBuffer);
	ofnData.dynFileBuffer = NULL;
    }

    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * GetFileName --
 *
 *	Calls GetOpenFileName() or GetSaveFileName().
 *
 * Results:
 *	See user documentation.
 *
 * Side effects:
 *	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;
    int result;

    result = ParseOFNOptions(clientData, interp, objc, objv, oper, &ofnOpts);
    if (result != TCL_OK)
        return result;

    if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle)
        result = GetFileNameVista(interp, &ofnOpts, oper);
    else
        result = GetFileNameXP(interp, &ofnOpts, oper);

    CleanupOFNOptions(&ofnOpts);
    return result;
}


/*
 *-------------------------------------------------------------------------
 *
 * OFNHookProc --
 *
 *	Dialog box hook function. This is used to sets the "tk_dialog"

	     */

	    ofnPtr = notifyPtr->lpOFN;
	    ofnData = (OFNData *) ofnPtr->lCustData;
	    buffer = ofnData->dynFileBuffer;
	    hdlg = GetParent(hdlg);

	    selsize = SendMessage(hdlg, CDM_GETSPEC, 0, 0);
	    dirsize = SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0);
	    selsize = (int) SendMessage(hdlg, CDM_GETSPEC, 0, 0);
	    dirsize = (int) SendMessage(hdlg, CDM_GETFOLDERPATH, 0, 0);
	    buffersize = (selsize + dirsize + 1);

	    /*
	     * Just empty the buffer if dirsize indicates an error. [Bug
	     * 3071836]
	     */

    TkFreeFileFilters(&flist);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeFilterVista
 *
 *      Frees storage previously allocated by MakeFilterVista.
 *      count is the number of elements in dlgFilterPtr[]
 */
static void FreeFilterVista(DWORD count, TCLCOMDLG_FILTERSPEC *dlgFilterPtr)
{
    if (dlgFilterPtr != NULL) {
        DWORD dw;
        for (dw = 0; dw < count; ++dw) {
            if (dlgFilterPtr[dw].pszName != NULL)
                ckfree(dlgFilterPtr[dw].pszName);
            if (dlgFilterPtr[dw].pszSpec != NULL)
                ckfree(dlgFilterPtr[dw].pszSpec);
        }
        ckfree(dlgFilterPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * MakeFilterVista --
 *
 *	Returns file type filters in a format required
 *	by the Vista file dialogs.
 *
 * Results:
 *	A standard TCL return value.
 *
 * Side effects:
 *      Various values are returned through the parameters as
 *      described in the comments below.
 *----------------------------------------------------------------------
 */
static int MakeFilterVista(
    Tcl_Interp *interp,		/* Current interpreter. */
    OFNOpts *optsPtr,           /* Caller specified options */
    DWORD *countPtr,            /* Will hold number of filters */
    TCLCOMDLG_FILTERSPEC **dlgFilterPtrPtr, /* Will hold pointer to filter array.
                                         Set to NULL if no filters specified.
                                         Must be freed by calling
                                         FreeFilterVista */
    DWORD *initialIndexPtr)     /* Will hold index of default type */
{
    TCLCOMDLG_FILTERSPEC *dlgFilterPtr;
    const char *initial = NULL;
    FileFilterList flist;
    FileFilter *filterPtr;
    DWORD initialIndex = 0;
    Tcl_DString ds, patterns;
    int       i;

    if (optsPtr->filterObj == NULL) {
        *dlgFilterPtrPtr = NULL;
        *countPtr = 0;
        return TCL_OK;
    }

    if (optsPtr->initialTypeObj)
	initial = Tcl_GetString(optsPtr->initialTypeObj);

    TkInitFileFilters(&flist);
    if (TkGetFileFilters(interp, &flist, optsPtr->filterObj, 1) != TCL_OK)
	return TCL_ERROR;

    if (flist.filters == NULL) {
        *dlgFilterPtrPtr = NULL;
        *countPtr = 0;
        return TCL_OK;
    }

    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&patterns);
    dlgFilterPtr = ckalloc(flist.numFilters * sizeof(*dlgFilterPtr));

    for (i = 0, filterPtr = flist.filters;
         filterPtr;
         filterPtr = filterPtr->next, ++i) {
        const char *sep;
        FileFilterClause *clausePtr;
        int nbytes;
    
        /* Check if this entry should be shown as the default */
        if (initial && strcmp(initial, filterPtr->name) == 0)
            initialIndex = i+1; /* Windows filter indices are 1-based */

        /* First stash away the text description of the pattern */
	Tcl_WinUtfToTChar(filterPtr->name, -1, &ds);
        nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */
        nbytes += sizeof(WCHAR);         /* Terminating \0 */
        dlgFilterPtr[i].pszName = ckalloc(nbytes);
        memmove((void *) dlgFilterPtr[i].pszName, Tcl_DStringValue(&ds), nbytes);
        Tcl_DStringFree(&ds);

        /*
         * Loop through and join patterns with a ";" Each "clause"
         * corresponds to a single textual description (called typename)
         * in the tk_getOpenFile docs. Each such typename may occur
         * multiple times and all these form a single filter entry
         * with one clause per occurence. Further each clause may specify
         * multiple patterns. Hence the nested loop here.
         */
        sep = "";
        for (clausePtr=filterPtr->clauses ; clausePtr;
             clausePtr=clausePtr->next) {
            GlobPattern *globPtr;
            for (globPtr = clausePtr->patterns; globPtr;
                 globPtr = globPtr->next) {
                Tcl_DStringAppend(&patterns, sep, -1);
                Tcl_DStringAppend(&patterns, globPtr->pattern, -1);
                sep = ";";
            }
        }
        
        /* Again we need a Unicode form of the string */
	Tcl_WinUtfToTChar(Tcl_DStringValue(&patterns), -1, &ds);
        nbytes = Tcl_DStringLength(&ds); /* # bytes, not Unicode chars */
        nbytes += sizeof(WCHAR);         /* Terminating \0 */
        dlgFilterPtr[i].pszSpec = ckalloc(nbytes);
        memmove((void *)dlgFilterPtr[i].pszSpec, Tcl_DStringValue(&ds), nbytes);
        Tcl_DStringFree(&ds);
        Tcl_DStringFree(&patterns);
    }

    if (initialIndex == 0)
        initialIndex = 1;       /* If no default, show first entry */
    *initialIndexPtr = initialIndex;
    *dlgFilterPtrPtr = dlgFilterPtr;
    *countPtr = flist.numFilters;

    TkFreeFileFilters(&flist);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * Tk_ChooseDirectoryObjCmd --
 *
 *	This function implements the "tk_chooseDirectory" dialog box for the
 *	Windows platform. See the user documentation for details on what it
 *	does. Uses the newer SHBrowseForFolder explorer type interface.
 *
 * Results:

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. */
{
    TCHAR path[MAX_PATH];
    int oldMode, result = TCL_ERROR, i;
    int oldMode, result;
    LPCITEMIDLIST pidl;		/* Returned by browser */
    BROWSEINFO bInfo;		/* Used by browser */
    ChooseDir cdCBData;	    /* Structure to pass back and forth */
    LPMALLOC pMalloc;		/* Used by shell */
    Tk_Window tkwin = clientData;
    HWND hWnd;
    const char *utfTitle = NULL;/* Title for window */
    TCHAR saveDir[MAX_PATH];
    Tcl_DString titleString;	/* Title */
    Tcl_DString initDirString;	/* Initial directory */
    Tcl_DString tempString;	/* temporary */
    Tcl_Obj *objPtr;
    OFNOpts ofnOpts;
    static const char *const optionStrings[] = {
	"-initialdir", "-mustexist",  "-parent",  "-title", NULL
    const char *utfDir;

    };
    enum options {
	DIR_INITIAL,   DIR_EXIST,  DIR_PARENT, FILE_TITLE
    };

    /*
     * Initialize
    result = ParseOFNOptions(clientData, interp, objc, objv, 
                 OFN_DIR_CHOOSE, &ofnOpts);
    if (result != TCL_OK)
        return result;

    /* Use new dialogs if available */
    if (VistaFileDialogsAvailable() && ! ofnOpts.forceXPStyle) {
        result = GetFileNameVista(interp, &ofnOpts, OFN_DIR_CHOOSE);
        CleanupOFNOptions(&ofnOpts);
        return result;
    }

    /* Older dialogs */
     */

    path[0] = '\0';
    ZeroMemory(&cdCBData, sizeof(ChooseDir));
    cdCBData.interp = interp;

    cdCBData.mustExist = ofnOpts.mustExist;
    /*
     * Process the command line options
     */

    for (i = 1; i < objc; i += 2) {
	int index;
    utfDir = Tcl_DStringValue(&ofnOpts.utfDirString);
    if (utfDir[0] != '\0') {
	const char *string;
	const TCHAR *uniStr;
	Tcl_Obj *optionPtr, *valuePtr;

	optionPtr = objv[i];
	valuePtr = objv[i + 1];

	if (Tcl_GetIndexFromObjStruct(interp, optionPtr, optionStrings,
		sizeof(char *), "option", 0, &index) != TCL_OK) {
	    goto cleanup;
	}
	if (i + 1 == objc) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "value for \"%s\" missing", Tcl_GetString(optionPtr)));
	    Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL);
	    goto cleanup;
	}

	string = Tcl_GetString(valuePtr);
	switch ((enum options) index) {
	case DIR_INITIAL:
	    if (Tcl_TranslateFileName(interp,string,&initDirString) == NULL) {
		goto cleanup;
	    }
	    Tcl_WinUtfToTChar(Tcl_DStringValue(&initDirString), -1,
		    &tempString);
	    uniStr = (TCHAR *) Tcl_DStringValue(&tempString);
        Tcl_WinUtfToTChar(Tcl_DStringValue(&ofnOpts.utfDirString), -1,
                          &tempString);
        uniStr = (TCHAR *) Tcl_DStringValue(&tempString);

	    /*
	     * Convert possible relative path to full path to keep dialog
        /* Convert possible relative path to full path to keep dialog happy. */
	     * happy.
	     */

	    GetFullPathName(uniStr, MAX_PATH, saveDir, NULL);
	    _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
        GetFullPathName(uniStr, MAX_PATH, saveDir, NULL);
        _tcsncpy(cdCBData.initDir, saveDir, MAX_PATH);
	    Tcl_DStringFree(&initDirString);
	    Tcl_DStringFree(&tempString);
	    break;
	case DIR_EXIST:
	    if (Tcl_GetBooleanFromObj(interp, valuePtr,
		    &cdCBData.mustExist) != TCL_OK) {
		goto cleanup;
	    }
    }
	    break;
	case DIR_PARENT:
	    tkwin = Tk_NameToWindow(interp, string, tkwin);
	    if (tkwin == NULL) {
		goto cleanup;
	    }

	    break;
	case FILE_TITLE:
	    utfTitle = string;
	    break;
	}
    /* XXX - rest of this (original) code has no error checks at all. */

    }

    /*
     * Get ready to call the browser
     */

    Tk_MakeWindowExist(tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
    Tk_MakeWindowExist(ofnOpts.tkwin);
    hWnd = Tk_GetHWND(Tk_WindowId(ofnOpts.tkwin));

    /*
     * Setup the parameters used by SHBrowseForFolder
     */

    bInfo.hwndOwner = hWnd;
    bInfo.pszDisplayName = path;
    bInfo.pidlRoot = NULL;
    if (_tcslen(cdCBData.initDir) == 0) {
	GetCurrentDirectory(MAX_PATH, cdCBData.initDir);
    }
    bInfo.lParam = (LPARAM) &cdCBData;

    if (utfTitle != NULL) {
	Tcl_WinUtfToTChar(utfTitle, -1, &titleString);
    if (ofnOpts.titleObj != NULL) {
	Tcl_WinUtfToTChar(Tcl_GetString(ofnOpts.titleObj), -1, &titleString);
	bInfo.lpszTitle = (LPTSTR) Tcl_DStringValue(&titleString);
    } else {
	bInfo.lpszTitle = TEXT("Please choose a directory, then select OK.");
    }

    /*
     * Set flags to add edit box, status text line and use the new ui. Allow

     * user a chance to change their mind on an invalid folder if mustexist is
     * 0.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
    GetCurrentDirectory(MAX_PATH, saveDir);
    if (SHGetMalloc(&pMalloc) == NOERROR) {
        /*
         * XXX - MSDN says CoInitialize must have been called before
         * SHBrowseForFolder can be used but don't see that called anywhere.
         */
	pidl = SHBrowseForFolder(&bInfo);

	/*
	 * This is a fix for Windows 2000, which seems to modify the folder
	 * name buffer even when the dialog is canceled (in this case the
	 * buffer contains garbage). See [Bug #3002230]
	 */

	Tcl_DString ds;

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		ConvertExternalFilename(path, &ds), -1));
	Tcl_DStringFree(&ds);
    }

    result = TCL_OK;

    CleanupOFNOptions(&ofnOpts);
    if (utfTitle != NULL) {
	Tcl_DStringFree(&titleString);
    }

  cleanup:
    return result;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChooseDirectoryValidateProc --
 *

    } else {
	titleString[len - 1] = L'\0';
	MessageBoxW(NULL, msgString, titleString,
		MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
		| MB_SETFOREGROUND | MB_TOPMOST);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * Win32ErrorObj --
 *
 *	Returns a string object containing text from a COM or Win32 error code
 *
 * Results:
 *	A Tcl_Obj containing the Win32 error message.
 *
 * Side effects:
 *	Removed the error message from the COM threads error object.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj*
TkWin32ErrorObj(
    HRESULT hrError)
{
    LPTSTR lpBuffer = NULL, p = NULL;
    TCHAR  sBuffer[30];
    Tcl_Obj* errPtr = NULL;

    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM
	    | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError,
	    LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL);

    if (lpBuffer == NULL) {
	lpBuffer = sBuffer;
	wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError);
    }

    if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
	*p = TEXT('\0');
    }

#ifdef _UNICODE
    errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer));
#else
    errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
#endif /* _UNICODE */

    if (lpBuffer != sBuffer) {
	LocalFree((HLOCAL)lpBuffer);
    }

    return errPtr;
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:

MODULE_SCOPE void		TkpWinToplevelDeiconify(TkWindow *winPtr);
MODULE_SCOPE long		TkpWinToplevelIsControlledByWm(TkWindow *winPtr);
MODULE_SCOPE long		TkpWinToplevelMove(TkWindow *winPtr, int x, int y);
MODULE_SCOPE long		TkpWinToplevelOverrideRedirect(TkWindow *winPtr,
			    int reqValue);
MODULE_SCOPE void		TkpWinToplevelDetachWindow(TkWindow *winPtr);
MODULE_SCOPE int		TkpWmGetState(TkWindow *winPtr);

/*
 * Common routines used in Windows implementation
 */
MODULE_SCOPE Tcl_Obj *	        TkWin32ErrorObj(HRESULT hrError);


/*
 * The following functions are not present in old versions of Windows
 * API headers but are used in the Tk source to ensure 64bit
 * compatibility.
 */

			    RegisteredInterp *riPtr);
#endif /* TK_SEND_ENABLED_ON_WINDOWS */
static int		FindInterpreterObject(Tcl_Interp *interp,
			    const char *name, LPDISPATCH *ppdisp);
static int		Send(LPDISPATCH pdispInterp, Tcl_Interp *interp,
			    int async, ClientData clientData, int objc,
			    Tcl_Obj *const objv[]);
static Tcl_Obj *	Win32ErrorObj(HRESULT hrError);
static void		SendTrace(const char *format, ...);
static Tcl_EventProc	SendEventProc;

#if defined(DEBUG) || defined(_DEBUG)
#define TRACE SendTrace
#else
#define TRACE 1 ? ((void)0) : SendTrace

	/*
	 * Expire the list if set.
	 */

	if (objList != NULL) {
	    Tcl_DecrRefCount(objList);
	}
	Tcl_SetObjResult(interp, Win32ErrorObj(hr));
	Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
	result = TCL_ERROR;
    }

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, objList);
    }

		pmk->lpVtbl->Release(pmk);
	    }
	    pBindCtx->lpVtbl->Release(pBindCtx);
	}
	pROT->lpVtbl->Release(pROT);
    }
    if (FAILED(hr) && result == TCL_OK) {
	Tcl_SetObjResult(interp, Win32ErrorObj(hr));
	Tcl_SetObjResult(interp, TkWin32ErrorObj(hr));
	result = TCL_ERROR;
    }
    return result;
}

/*
 *--------------------------------------------------------------

    SysFreeString(ei.bstrDescription);
    SysFreeString(ei.bstrSource);
    SysFreeString(ei.bstrHelpFile);
    VariantClear(&vCmd);

    return (SUCCEEDED(hr) ? TCL_OK : TCL_ERROR);
}

/*
 * ----------------------------------------------------------------------
 *
 * Win32ErrorObj --
 *
 *	Returns a string object containing text from a COM or Win32 error code
 *
 * Results:
 *	A Tcl_Obj containing the Win32 error message.
 *
 * Side effects:
 *	Removed the error message from the COM threads error object.
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj*
Win32ErrorObj(
    HRESULT hrError)
{
    LPTSTR lpBuffer = NULL, p = NULL;
    TCHAR  sBuffer[30];
    Tcl_Obj* errPtr = NULL;

    FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM
	    | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, (DWORD)hrError,
	    LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL);

    if (lpBuffer == NULL) {
	lpBuffer = sBuffer;
	wsprintf(sBuffer, TEXT("Error Code: %08lX"), hrError);
    }

    if ((p = _tcsrchr(lpBuffer, TEXT('\r'))) != NULL) {
	*p = TEXT('\0');
    }

#ifdef _UNICODE
    errPtr = Tcl_NewUnicodeObj(lpBuffer, (int)wcslen(lpBuffer));
#else
    errPtr = Tcl_NewStringObj(lpBuffer, (int)strlen(lpBuffer));
#endif /* _UNICODE */

    if (lpBuffer != sBuffer) {
	LocalFree((HLOCAL)lpBuffer);
    }

    return errPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * TkWinSend_SetExcepInfo --
 *
 *	Convert the error information from a Tcl interpreter into a COM

	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testgetwindowinfo", TestgetwindowinfoObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testwinlocale", TestwinlocaleObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    return TCL_OK;
}

struct TestFindControlState {
    int  id;
    HWND control;
};    

/* Callback for window enumeration - used for TestFindControl */
BOOL CALLBACK TestFindControlCallback(
    HWND hwnd,
    LPARAM lParam
)
{
    struct TestFindControlState *fcsPtr = (struct TestFindControlState *)lParam;
    fcsPtr->control = GetDlgItem(hwnd, fcsPtr->id);
    /* If we have found the control, return FALSE to stop the enumeration */
    return fcsPtr->control == NULL ? TRUE : FALSE;
}

/*
 * Finds the descendent control window with the specified ID and returns
 * its HWND.
 */
HWND TestFindControl(HWND root, int id)
{
    struct TestFindControlState fcs;

    fcs.control = GetDlgItem(root, id);
    if (fcs.control == NULL) {
        /* Control is not a direct child. Look in descendents */
        fcs.id = id;
        fcs.control = NULL;
        EnumChildWindows(root, TestFindControlCallback, (LPARAM) &fcs);
    }
    return fcs.control;
}


/*
 *----------------------------------------------------------------------
 *
 * AppendSystemError --
 *
 *	This routine formats a Windows system error message and places it into

    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    HWND hwnd = 0;
    HWND child = 0;
    HWND control;
    int id;
    char *rest;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
    LRESULT result;
    static const TkStateMap messageMap[] = {
	{WM_LBUTTONDOWN,	"WM_LBUTTONDOWN"},
	{WM_LBUTTONUP,		"WM_LBUTTONUP"},
	{WM_CHAR,		"WM_CHAR"},
	{WM_GETTEXT,		"WM_GETTEXT"},
	{WM_SETTEXT,		"WM_SETTEXT"},
	{WM_COMMAND,            "WM_COMMAND"},

	}
	if (child == NULL) {
	    Tcl_AppendResult(interp, "could not find a control matching \"",
		Tcl_GetString(objv[2]), "\"", NULL);
	    return TCL_ERROR;
	}
    }

    message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3]));
    wParam = 0;
    lParam = 0;

    if (objc > 4) {
	wParam = strtol(Tcl_GetString(objv[4]), NULL, 0);
    }
    if (objc > 5) {
	lParam = strtol(Tcl_GetString(objv[5]), NULL, 0);
    }

    switch (message) {
    case WM_GETTEXT: {
	Tcl_DString ds;
	char buf[256];

#if 0
	GetDlgItemTextA(hwnd, id, buf, 256);
#else
        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }
        buf[0] = 0;
        SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf),
                     (LPARAM) buf);
#endif
	Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
	Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	Tcl_DStringFree(&ds);
	break;
    }
    case WM_SETTEXT: {
	Tcl_DString ds;
	BOOL result;


        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }
	Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds);
        result = SendMessageA(control, WM_SETTEXT, 0,
	result = SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds));
                                  (LPARAM) Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
	if (result == 0) {
    	Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
    	AppendSystemError(interp, GetLastError());
		return TCL_ERROR;
            Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
            AppendSystemError(interp, GetLastError());
            return TCL_ERROR;
	}
	break;
    }
    case WM_COMMAND: {
	char buf[TCL_INTEGER_SPACE];
	if (objc < 5) {
	    wParam = MAKEWPARAM(id, 0);

    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const TCHAR  *title = NULL, *class = NULL;
    Tcl_DString titleString, classString;
    HWND hwnd = NULL;
    int r = TCL_OK;
    DWORD myPid;

    Tcl_DStringInit(&classString);
    Tcl_DStringInit(&titleString);

    if (objc < 2 || objc > 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "title ?class?");
        return TCL_ERROR;
    }

    title = Tcl_WinUtfToTChar(Tcl_GetString(objv[1]), -1, &titleString);
    if (objc == 3) {
        class = Tcl_WinUtfToTChar(Tcl_GetString(objv[2]), -1, &classString);
    }

    if (title[0] == 0)
        title = NULL;
#if 0
    hwnd  = FindWindow(class, title);
#else
    /* We want find a window the belongs to us and not some other process */
    hwnd = NULL;
    myPid = GetCurrentProcessId();
    while (1) {
        DWORD pid, tid;
        hwnd = FindWindowEx(NULL, hwnd, class, title);
        if (hwnd == NULL)
            break;
        tid = GetWindowThreadProcessId(hwnd, &pid);
        if (tid == 0) {
            /* Window has gone */
            hwnd = NULL;
            break;
        }
        if (pid == myPid)
            break;              /* Found it */
    }

#endif

    if (hwnd == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to find window: ", -1));
	AppendSystemError(interp, GetLastError());
	r = TCL_ERROR;
    } else {
        Tcl_SetObjResult(interp, Tcl_NewLongObj(PTR2INT(hwnd)));