From 1a403e858b44dbf3d3a12d896877397894fe3e36 Mon Sep 17 00:00:00 2001 From: ashok Date: Tue, 6 Oct 2015 06:14:34 +0000 Subject: Fix for [46c83f60] (relative paths ignored in tk_getOpenFile/tk_getSaveFile on Vista+). Added tests for -initialdir option. --- tests/winDialog.test | 193 +++++++++++++++++++++++++++++++++++++++++++++++++++ win/tkWinDialog.c | 31 ++++++--- 2 files changed, 213 insertions(+), 11 deletions(-) diff --git a/tests/winDialog.test b/tests/winDialog.test index b7847a5..6b8af59 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -339,6 +339,7 @@ test winDialog-5.11 {GetFileName: initial directory} -constraints { } return $x } -result [file join [initialdir] "12x 455"] + test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints { nt } -body { @@ -346,6 +347,198 @@ test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -c tk_getOpenFile -initialdir ~12x/455 } -returnCodes error -result {user "12x" doesn't exist} + +test winDialog-5.12.1 {tk_getSaveFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~ \ + -initialfile "5 12 1" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~ "5 12 1"]] + +test winDialog-5.12.2 {tk_getSaveFile: initial directory: ~user} -constraints { + nt testwinevent DISABLED +} -body { + # Note: this test is currently disabled because of a bug in file normalize + # for names of the form ~xxx that returns the wrong dir on Windows. + # In particular (in Win8 at least) it returns /users/Default instead + # of /users/USERNAME... + + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir ~$::env(USERNAME) \ + -initialfile "5 12 2" -title Foo]} + then { + Click ok + } + return $x +} -result [file normalize [file join ~$::env(USERNAME) "5 12 2"]] + +test winDialog-5.12.3 {tk_getSaveFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 3"] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $newdir testfile] +} -result 1 + +test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.5 {tk_getSaveFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 5" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 5"] + +test winDialog-5.12.6 {tk_getSaveFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 6"] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getSaveFile \ + -initialdir "5 12 6" \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x [file join $dir testfile] +} -result 1 + +test winDialog-5.12.7 {tk_getOpenFile: initial directory: ~} -constraints { + nt testwinevent +} -body { + set fn [file tail [lindex [glob ~/*] 0]] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir ~ \ + -initialfile $fn -title Foo]} + then { + Click ok + } + string equal $x [file normalize [file join ~ $fn]] +} -result 1 + +test winDialog-5.12.8 {tk_getOpenFile: initial directory: .} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set newdir [tcltest::makeDirectory "5 12 8"] + set path [tcltest::makeFile "" "testfile" $newdir] + set cur [pwd] + try { + cd $newdir + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir . \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + +test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints { + nt testwinevent +} -body { + set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"] + set path [tcltest::makeFile "" testfile $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir $dir \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + string equal $x $path +} -result 1 + +test winDialog-5.12.10 {tk_getOpenFile: initial directory: nativename} -constraints { + nt testwinevent +} -body { + unset -nocomplain x + tcltest::makeFile "" "5 12 10" [initialdir] + start {set x [tk_getOpenFile \ + -initialdir [file nativename [initialdir]] \ + -initialfile "5 12 10" -title Foo]} + then { + Click ok + } + return $x +} -result [file join [initialdir] "5 12 10"] + +test winDialog-5.12.11 {tk_getOpenFile: initial directory: relative} -constraints { + nt testwinevent +} -body { + # Windows remembers dirs from previous selections so use + # a subdir for this test, not [initialdir] itself + set dir [tcltest::makeDirectory "5 12 11"] + set path [tcltest::makeFile "" testfile $dir] + set cur [pwd] + try { + cd [file dirname $dir] + unset -nocomplain x + start {set x [tk_getOpenFile \ + -initialdir [file tail $dir] \ + -initialfile "testfile" -title Foo]} + then { + Click ok + } + } finally { + cd $cur + } + string equal $x $path +} -result 1 + test winDialog-5.13 {GetFileName: initial file} -constraints { nt testwinevent } -body { diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index dc385e3..0188296 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -1388,18 +1388,27 @@ static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr, } 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, - &IIDIShellItem, (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_Obj *normPath, *iniDirPath; + iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), -1); + Tcl_IncrRefCount(iniDirPath); + normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath); + /* XXX - Note on failures do not raise error, simply ignore ini dir */ + if (normPath) { + const WCHAR *nativePath; + Tcl_IncrRefCount(normPath); + nativePath = Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/ + if (nativePath) { + hr = ShellProcs.SHCreateItemFromParsingName( + nativePath, NULL, + &IIDIShellItem, (void **) &dirIf); + if (SUCCEEDED(hr)) { + /* Note we use SetFolder, not SetDefaultFolder - see MSDN */ + fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */ + } + } + Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */ } - Tcl_DStringFree(&dirString); + Tcl_DecrRefCount(iniDirPath); } oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); -- cgit v0.12