path: root/tests/winDialog.test

# This file is a Tcl script to test the Windows specific behavior of
# the common dialog boxes.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @(#) winDialog.test 1.4 97/08/06 18:19:56

if {$tcl_platform(os) != "Windows NT"} {
    return 
}

if {[info procs test] != "test"} {
    source defs
}

set testConfig(interactive)	[info exists INTERACTIVE]

testwinevent debug 1

eval destroy [winfo children .] 
wm geometry . {}
raise .

proc start {arg} {
    set ::tk_dialog 0

    after 1 "$arg"
}

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

    afterbody
    vwait ::dialogresult
    return $::dialogresult
}

proc afterbody {} {
    if {$::tk_dialog == 0} {
	after 100 {afterbody}
	return
    }
    uplevel #0 {set dialogresult [eval $command]}
}    

proc Click {button} {
    testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
    testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
}	    

proc GetText {button} {
    return [testwinevent $::tk_dialog $button WM_GETTEXT]
}

proc SetText {button text} {
    return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
}

test winDialog-1.1 {Tk_ChooseColorObjCmd} {
} {}

test winDialog-2.1 {ColorDlgHookProc} {
} {}

test winDialog-3.1 {Tk_GetOpenFileObjCmd} {
    start {tk_getOpenFile}
    then {
	set x [GetText 2]
	Click 2
    }
    set x	
} {Cancel}

test winDialog-4.1 {Tk_GetSaveFileObjCmd} {
    start {tk_getSaveFile}
    then {
	set x [GetText 2]
	Click 2
    }
    set x	
} {Cancel}

test winDialog-5.1 {GetFileName: no arguments} {
    start {tk_getOpenFile -title Open}
    then {
	Click cancel
    }
} {0}
test winDialog-5.2 {GetFileName: one argument} {
    list [catch {tk_getOpenFile -foo} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
test winDialog-5.4 {GetFileName: many arguments} {
    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
    then {
	Click cancel
    }
} {0}
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {
    list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {
    start {tk_getOpenFile -title bar}
    then {
	Click cancel
    }
} {0}
test winDialog-5.7 {GetFileName: valid option, but missing value} {
    list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.8 {GetFileName: extension begins with .} {
#    if (string[0] == '.') {
#	string++;
#    }

    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
    then {
	SetText 0x480 bar
	Click 1
    }
    set x
} [file join [pwd] bar.foo]
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    then {
	SetText 0x480 bar
	Click 1
    }
    set x
} [file join [pwd] bar.foo]
test winDialog-5.10 {GetFileName: file types} {
#	    case FILE_TYPES: 

    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
    then {
	set x [GetText 0x470]
	Click cancel
    }
    set x
} {foo files (*.foo)}
test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {
#		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) 

    list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
} {1 {bad Macintosh file type "FOO"}}
test winDialog-5.12 {GetFileName: initial directory} {
#	    case FILE_INITDIR: 

    start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
    then {
	Click 1
    }
    set x
} {C:/12x 455}
test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    
    list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
test winDialog-5.14 {GetFileName: initial file} {
#	    case FILE_INITFILE: 

    start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
    then {
	Click 1
    }
    set x
} [file join [pwd] "12x 456"]
test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
append a $a
append a $a
append a $a
append a $a
test winDialog-5.16 {GetFileName: initial file: long name} {
    start {set x [tk_getSaveFile -initialfile $a -title Long]}
    then {
	Click 1
    }
    set x
} [string range [file join [pwd] $a] 0 257]
test winDialog-5.17 {GetFileName: parent} {
#	    case FILE_PARENT: 

    toplevel .t
    set x 0
    start {tk_getOpenFile -parent .t -title Parent; set x 1}
    then {
	destroy .t
    }
    set x
} {1}
test winDialog-5.18 {GetFileName: title} {
#	    case FILE_TITLE: 
    
    start {tk_getOpenFile -title Narf}
    then {
	Click 2
    }
} {0}
test winDialog-5.19 {GetFileName: no filter specified} {
#    if (ofn.lpstrFilter == NULL) 

    start {tk_getOpenFile -title Filter} 
    then {
	set x [GetText 0x470]
	Click 2
    }
    set x
} {All Files (*.*)}
test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {
#    if (Tk_WindowId(parent) == None) 

    toplevel .t
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} {}
test winDialog-5.21 {GetFileName: parent HWND already exists} {
    toplevel .t
    update
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} {}
test winDialog-5.22 {GetFileName: call GetOpenFileName} {
#	    winCode = GetOpenFileName(&ofn);
    
    start {tk_getOpenFile -title Open}
    then {
	set x [GetText 1]
	Click 2
    }
    set x
} {&Open}
test winDialog-5.22 {GetFileName: call GetSaveFileName} {
#	    winCode = GetSaveFileName(&ofn);

    start {tk_getSaveFile -title Save}
    then {
	set x [GetText 1]
	Click 2
    }
    set x
} {&Save}
test winDialog-5.22 {GetFileName: convert \ to /} {
    start {set x [tk_getSaveFile -title Back]}
    then {
	SetText 0x480 "c:\\12x 457"
	Click 1
    }
    set x
} {c:/12x 457}

test winDialog-8.1 {OFNHookProc} {
} {}

test winDialog-6.1 {MakeFilter} {
} {}

test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {
    start {tk_chooseDirectory}
    then {
	Click cancel
    }
} {0}
test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {
    list [catch {tk_chooseDirectory -foo} msg] $msg
} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {
    start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test}
    then {
	Click cancel
    }
} {0}
test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} {
    list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg
} {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}}
test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} {
    start {tk_chooseDirectory -title bar}
    then {
	Click cancel
    }
} {0}
test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} {
    list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {
#	    case DIR_INITIAL: 

    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
    then {
	Click 1
    }
    string tolower [set x]
} {c:/}
test winDialog-5.13 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} {
#		if (Tcl_TranslateFileName(interp, string, 
#			&utfDirString) == NULL) 
    
    list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}

test winDialog-7.1 {Tk_MessageBoxObjCmd} {
} {}

testwinevent debug 0