head	1.22;
access;
symbols
	core-8-5-9:1.21.2.1
	core-8-5-8:1.21.2.1
	macosx-cocoa-merge:1.22
	macosx-cocoa-premerge:1.22
	macosx-carbon-freeze:1.22
	core-8-5-7:1.21.2.1
	core-8-5-6:1.21
	core-8-6-b1:1.21
	core-8-6-a3:1.21
	core-8-5-5:1.21
	core-8-6-a2:1.21
	core-8-5-4:1.21
	core-8-5-3:1.21
	core-8-6-a1:1.21
	core-8-4-19:1.13
	core-8-5-branch:1.21.0.2
	core-8-5-2:1.21
	core-8-4-18:1.13
	core-8-5-1:1.21
	core-8-4-17:1.13
	core-8-5-0:1.21
	core-8-5-b3:1.19
	core-8-5-b2:1.19
	core-8-4-16:1.13
	core-8-5-b1:1.18
	core-stablilizer-merge:1.18
	core-stabilizer-branch:1.18.0.2
	core-stabilizer-merge:1.21
	core-8-4-15:1.13
	core-8-5-a6:1.18
	core-8-5-a5:1.18
	core-8-4-14:1.13
	core-8-5-a4:1.18
	core-8-4-13:1.13
	core-8-4-12:1.13
	core-8-4-11:1.13
	core-8-5-a3:1.18
	core-8-4-10:1.13
	core-8-4-9-branch:1.13.0.4
	core-8-5-a2:1.16
	core-8-4-9:1.13
	core-8-4-8:1.13
	core-8-4-7:1.13
	core-8-5-a1:1.14
	core-8-4-6:1.13
	core-8-4-5:1.13
	mistachkin-dev-branch:1.14.0.2
	core-8-4-4:1.13
	core-8-4-3:1.13
	core-8-4-branch:1.13.0.2
	core-8-4-2:1.13
	core-8-4-1:1.13
	core-8-3-5:1.9
	core-8-4-0:1.13
	macosx-8-4-merge-2002-08-31-trunk:1.13
	macosx-8-4-premerge-2002-08-31-branch:1.11.2.2
	macosx-8-4-premerge-2002-08-31-trunk:1.13
	macosx-8-4-merge-2002-08-30-branch:1.11.2.2
	macosx-8-4-merge-2002-08-30-trunk:1.13
	macosx-8-4-merge-2002-08-20-branch:1.11.2.2
	macosx-8-4-merge-2002-08-20-trunk:1.13
	core-8-4-b2:1.13
	core-8-4-b1:1.12
	macosx-premerge-6-9-02:1.11
	core-8-4-a4:1.12
	core-8-3-4:1.9
	macosx-8-4-branch:1.11.0.2
	macosx-8-4-branchpoint:1.11
	core-8-4-a3:1.11
	core-8-3-3:1.9
	dgp-privates-into-namespace:1.10.0.4
	tclpro-1-5-0:1.9
	core-8-4-win-speedup:1.10.0.2
	core-8-4-a2:1.10
	tclpro-1-4-1:1.9
	tclpro-1-4-0:1.9
	core-8-3-2:1.9
	ajuba-ajuba2-2-1-base:1.9
	ajuba-ajuba2-2-0:1.9
	core-8-4-a1:1.9
	core-8-3-1-branch:1.9.0.2
	core-8-3-1:1.9
	scriptics-sc-2-0-b5:1.9
	scriptics-sc-2-0-fixed:1.9
	scriptics-sc-2-0-b2:1.8
	scriptics-sc-2-0-b1:1.8
	core-8-3-0:1.8
	core-8-3-b2:1.8
	core-8-3-b1:1.8
	scriptics-sc-1-1:1.6
	scriptics-sc-1-1-b1:1.6
	core-8-2-3:1.6
	scriptics-sc-1-1-branch:1.6.0.10
	scriptics-sc-1-1-base:1.6
	scriptics-sc-1-0:1.6
	scriptics-sc-1-0-branch:1.6.0.8
	scriptics-sc-1-0-base:1.6
	core-8-2-2:1.6
	core-8-2-1:1.6
	scriptics-bc-1-0-b1:1.6
	core-8-2-1-branch:1.6.0.6
	scriptics-tclpro-1-3-0:1.6
	core-8-2-0:1.6
	core-8-2-b3-branch:1.6.0.4
	core-8-2-b3-base:1.6
	scriptics-tclpro-1-3-b4:1.6
	core-8-2-b2:1.6
	scriptics-tclpro-1-3-b3:1.6
	core-8-2-b1:1.6
	scriptics-tclpro-1-3-b2:1.6
	merge-to-mainline-5/21/99:1.6
	scriptics-tclpro-1-3-b2-branch:1.6.0.2
	core-8-1-1:1.6
	scriptics-tclpro-1-3-b1:1.6
	core-8-1-1-base:1.6
	core-8-1-0:1.6
	merge-to-mainline-4-29-99:1.6
	merge-to-mainline-4-23-99:1.6
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.5.0.6
	core-8-0-6-base:1.5
	core-8-0-5:1.5
	core-8-1-b3:1.1.4.8
	core-8-1-b2:1.1.4.5
	dev-8-1-stubs-branch:1.1.4.3.0.2
	dev-stubs-branch:1.5.0.4
	scriptics-tclpro-1-2:1.5
	scriptics-tclpro-1-2-b2:1.5
	core-8-1-merge-2/10/99:1.5
	core-8-0-5-branch:1.5.0.2
	core-8-0-5-base:1.5
	scriptics-tclpro-1-2-b1:1.5
	scriptics-tclpro-1-2-a1:1.5
	core-8-1-b1:1.1.4.3
	core-8-0-4:1.4
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.4;
locks; strict;
comment	@# @;


1.22
date	2008.12.29.16.28.57;	author das;	state Exp;
branches;
next	1.21;

1.21
date	2007.12.13.15.27.54;	author dgp;	state Exp;
branches
	1.21.2.1;
next	1.20;

1.20
date	2007.11.26.20.00.53;	author kennykb;	state Exp;
branches;
next	1.19;

1.19
date	2007.10.25.21.44.23;	author hobbs;	state Exp;
branches;
next	1.18;

1.18
date	2004.12.20.10.34.20;	author vincentdarley;	state Exp;
branches
	1.18.2.1;
next	1.17;

1.17
date	2004.12.08.03.02.53;	author dgp;	state Exp;
branches;
next	1.16;

1.16
date	2004.06.04.19.55.31;	author dgp;	state Exp;
branches;
next	1.15;

1.15
date	2004.05.23.17.34.48;	author dkf;	state Exp;
branches;
next	1.14;

1.14
date	2003.04.01.21.06.23;	author dgp;	state Exp;
branches;
next	1.13;

1.13
date	2002.07.14.05.48.46;	author dgp;	state Exp;
branches;
next	1.12;

1.12
date	2002.02.25.15.26.20;	author dkf;	state Exp;
branches;
next	1.11;

1.11
date	2001.08.01.16.21.12;	author dgp;	state Exp;
branches
	1.11.2.1;
next	1.10;

1.10
date	2000.06.30.20.19.07;	author ericm;	state Exp;
branches
	1.10.2.1
	1.10.4.1;
next	1.9;

1.9
date	2000.03.24.19.38.57;	author ericm;	state Exp;
branches;
next	1.8;

1.8
date	99.11.30.00.02.20;	author hobbs;	state Exp;
branches;
next	1.7;

1.7
date	99.11.12.23.55.16;	author wart;	state Exp;
branches;
next	1.6;

1.6
date	99.04.16.01.51.37;	author stanton;	state Exp;
branches;
next	1.5;

1.5
date	98.12.07.23.29.00;	author hershey;	state Exp;
branches;
next	1.4;

1.4
date	98.09.14.18.23.46;	author stanton;	state Exp;
branches;
next	1.3;

1.3
date	98.06.25.17.21.01;	author stanton;	state Exp;
branches;
next	1.2;

1.2
date	98.06.24.16.05.51;	author stanton;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.58.09;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.49;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.18.35;	author stanton;	state Exp;
branches;
next	1.1.4.3;

1.1.4.3
date	98.12.10.03.43.54;	author stanton;	state Exp;
branches;
next	1.1.4.4;

1.1.4.4
date	99.03.11.18.50.48;	author hershey;	state Exp;
branches;
next	1.1.4.5;

1.1.4.5
date	99.03.11.23.51.26;	author hershey;	state Exp;
branches;
next	1.1.4.6;

1.1.4.6
date	99.03.24.01.16.45;	author hershey;	state Exp;
branches;
next	1.1.4.7;

1.1.4.7
date	99.03.24.02.54.39;	author hershey;	state Exp;
branches;
next	1.1.4.8;

1.1.4.8
date	99.03.26.00.07.56;	author hershey;	state Exp;
branches;
next	;

1.10.2.1
date	2002.04.02.20.57.57;	author hobbs;	state Exp;
branches;
next	;

1.10.4.1
date	2001.02.28.23.29.56;	author dgp;	state Exp;
branches;
next	;

1.11.2.1
date	2002.06.10.05.38.26;	author wolfsuit;	state Exp;
branches;
next	1.11.2.2;

1.11.2.2
date	2002.08.20.20.27.13;	author das;	state Exp;
branches;
next	;

1.18.2.1
date	2007.10.27.04.23.17;	author dgp;	state Exp;
branches;
next	1.18.2.2;

1.18.2.2
date	2007.11.28.20.33.15;	author dgp;	state Exp;
branches;
next	;

1.21.2.1
date	2008.12.29.16.28.59;	author das;	state Exp;
branches;
next	;


desc
@@


1.22
log
@fixes for [temporaryDirectory] != [pwd]
@
text
@# This file is a Tcl script to test out Tk's "tk_getOpenFile" and
# "tk_getSaveFile" commands. It is organized in the standard fashion
# for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @@(#) $Id: filebox.test,v 1.21 2007/12/13 15:27:54 dgp Exp $
#

package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands

test fileDialog-0.1 {GetFileName: file types: MakeFilter() fails} {
    # MacOS type that is too long

    set res [list [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0\0}}}} msg] $msg]
    regsub -all "\0" $res {\\0}
} {1 {bad Macintosh file type "\0\0\0\0\0"}}
test fileDialog-0.2 {GetFileName: file types: MakeFilter() fails} {
    # MacOS type that is too short, but looks ok in utf (4 bytes).

    set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0}}}} msg]
    regsub -all "\0" $msg {\\0} msg
    list $x $msg
} {1 {bad Macintosh file type "\0\0"}}

set tk_strictMotif_old $tk_strictMotif

#----------------------------------------------------------------------
#
# Procedures needed by this test file
#
#----------------------------------------------------------------------

proc ToPressButton {parent btn} {
    global isNative
    if {!$isNative} {
	after 100 SendButtonPress $parent $btn mouse
    }
}

proc ToEnterFileByKey {parent fileName fileDir} {
    global isNative
    if {!$isNative} {
	after 100 EnterFileByKey $parent [list $fileName] [list $fileDir]
    }
}

proc PressButton {btn} {
    event generate $btn <Enter>
    event generate $btn <1> -x 5 -y 5
    event generate $btn <ButtonRelease-1> -x 5 -y 5
}

proc EnterFileByKey {parent fileName fileDir} {
    global tk_strictMotif
    if {$parent == "."} {
	set w .__tk_filedialog
    } else {
	set w $parent.__tk_filedialog
    }
    upvar ::tk::dialog::file::__tk_filedialog data

    if {$tk_strictMotif} {
	$data(sEnt) delete 0 end
	$data(sEnt) insert 0 [file join $fileDir $fileName]
    } else {
	$data(ent) delete 0 end
	$data(ent) insert 0 $fileName
    }

    update
    SendButtonPress $parent ok mouse
}

proc SendButtonPress {parent btn type} {
    global tk_strictMotif
    if {$parent == "."} {
	set w .__tk_filedialog
    } else {
	set w $parent.__tk_filedialog
    }
    upvar ::tk::dialog::file::__tk_filedialog data

    set button $data($btn\Btn)
    if ![winfo ismapped $button] {
	update
    }

    if {$type == "mouse"} {
	PressButton $button
    } else {
	event generate $w <Enter>
	focus $w
	event generate $button <Enter>
	event generate $w <KeyPress> -keysym Return
    }
}


#----------------------------------------------------------------------
#
# The test suite proper
#
#----------------------------------------------------------------------

if {$tcl_platform(platform) == "unix"} {
    set modes "0 1"
} else {
    set modes 1
}

set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable}

set tmpFile "filebox.tmp"
makeFile {
    # this file can be empty!
} $tmpFile

array set filters {
    1 {}
    2 {
	{"Text files"		{.txt .doc}	}
	{"Text files"		{}		TEXT}
	{"Tcl Scripts"		{.tcl}		TEXT}
	{"C Source Files"	{.c .h}		}
	{"All Source Files"	{.tcl .c .h}	}
	{"Image Files"		{.gif}		}
	{"Image Files"		{.jpeg .jpg}	}
	{"Image Files"		""		{GIFF JPEG}}
	{"All files"		*}
    }
    3 {
	{"Text files"		{.txt .doc}	TEXT}
	{"Foo"			{""}		TEXT}
    }
}

foreach mode $modes {
    #
    # Test both the motif version and the "tk" version of the file dialog
    # box on Unix.
    #
    # Note that this means that test names are unusually complex.
    #

    set addedExtensions {}
    if {$tcl_platform(platform) == "unix"} {
	set tk_strictMotif $mode
	# Extension adding is only done when using the non-motif file
	# box with an extension-less filename
	if {!$mode} {
	    set addedExtensions {NONE {} .txt .txt}
	}
    }

    test filebox-1.1-$mode "tk_getOpenFile command" -body {
	tk_getOpenFile -foo
    } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile)

    catch {tk_getOpenFile -foo 1} msg
    regsub -all ,      $msg "" options
    regsub \"-foo\" $options "" options
    
    foreach option $options {
        if {[string index $option 0] eq "-"} {
	    test filebox-1.2-$mode$option "tk_getOpenFile command" -body {
		tk_getOpenFile $option
	    } -returnCodes error -result "value for \"$option\" missing"
        }
    }

    test filebox-1.3-$mode "tk_getOpenFile command" -body {
        tk_getOpenFile -foo bar
    } -returnCodes error -result $unknownOptionsMsg(tk_getOpenFile)
    test filebox-1.4-$mode "tk_getOpenFile command" -body {
        tk_getOpenFile -initialdir
    } -returnCodes error -result {value for "-initialdir" missing}
    test filebox-1.5-$mode "tk_getOpenFile command" -body {
        tk_getOpenFile -parent foo.bar
    } -returnCodes error -result {bad window path name "foo.bar"}
    test filebox-1.6-$mode "tk_getOpenFile command" -body {
        tk_getOpenFile -filetypes {Foo}
    } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}

    set isNative [expr {
	[info commands ::tk::MotifFDialog] eq ""   &&
	[info commands ::tk::dialog::file::] eq ""
    }]

    set parent .

    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring

    set color #404040
    test filebox-2.1-$mode "tk_getOpenFile command" nonUnixUserInteraction {
        ToPressButton $parent cancel
        tk_getOpenFile -title "Press Cancel ($verylongstring)" -parent $parent
    } ""

    set fileName $tmpFile
    set fileDir [tcltest::temporaryDirectory]
    set pathName [file join $fileDir $fileName]

    test filebox-2.2-$mode "tk_getOpenFile command" nonUnixUserInteraction {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Press Ok" \
		-parent $parent -initialfile $fileName -initialdir $fileDir]
    } $pathName
    test filebox-2.3-$mode "tk_getOpenFile command" nonUnixUserInteraction {
        ToEnterFileByKey $parent $fileName $fileDir
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir $fileDir]
    } $pathName
    test filebox-2.4-$mode "tk_getOpenFile command" nonUnixUserInteraction {
        cd $fileDir
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir . -initialfile $fileName]
    } $pathName
    test filebox-2.5-$mode "tk_getOpenFile command" nonUnixUserInteraction {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir /badpath -initialfile $fileName]
    } $pathName
    test filebox-2.6-$mode "tk_getOpenFile command" -setup {
        toplevel .t1; toplevel .t2
        wm geometry .t1 +0+0
        wm geometry .t2 +0+0
    } -constraints nonUnixUserInteraction -body {
        set choice {}
        ToPressButton .t1 ok
        lappend choice [tk_getOpenFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
        ToPressButton .t2 ok
        lappend choice [tk_getOpenFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t2 -initialdir $fileDir \
		-initialfile $fileName]
        ToPressButton .t1 ok
        lappend choice [tk_getOpenFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
    } -result [list $pathName $pathName $pathName] -cleanup {
        destroy .t1
        destroy .t2
    }

    foreach x [lsort -integer [array names filters]] {
        test filebox-3.$x-$mode "tk_getOpenFile command" nonUnixUserInteraction {
	    ToPressButton $parent ok
	    set choice [tk_getOpenFile -title "Press Ok" \
		    -filetypes $filters($x) -parent $parent \
		    -initialfile $fileName -initialdir $fileDir]
        } $pathName
    }
    foreach {x res} [list 1 "-unset-" 2 "Text files"] {
	set t [expr {$x + [llength [array names filters]]}]
        test filebox-3.$t-$mode "tk_getOpenFile command" nonUnixUserInteraction {
	    catch {unset tv}
	    catch {unset typeName}
	    ToPressButton $parent ok
	    if {[info exists tv]} {
	    } else {
	    }
	    set choice [tk_getOpenFile -title "Press Ok" \
		    -filetypes $filters($x) -parent $parent \
		    -initialfile $fileName -initialdir $fileDir \
		    -typevariable tv]
	    if {[info exists tv]} {
		regexp {^(.*) \(.*\)$} $tv dummy typeName
	    } else {
		set typeName "-unset-"
	    }
	    set typeName
        } $res
    }

    test filebox-4.1-$mode "tk_getSaveFile command" -body {
	tk_getSaveFile -foo
    } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile)

    catch {tk_getSaveFile -foo 1} msg
    regsub -all ,      $msg "" options
    regsub \"-foo\" $options "" options

    foreach option $options {
	if {[string index $option 0] eq "-"} {
	    test filebox-4.2-$mode$option "tk_getSaveFile command" -body {
		tk_getSaveFile $option
	    } -returnCodes error -result "value for \"$option\" missing"
	}
    }

    test filebox-4.3-$mode "tk_getSaveFile command" -body {
	tk_getSaveFile -foo bar
    } -returnCodes error -result $unknownOptionsMsg(tk_getSaveFile)
    test filebox-4.4-$mode "tk_getSaveFile command" -body {
	tk_getSaveFile -initialdir
    } -returnCodes error -result {value for "-initialdir" missing}
    test filebox-4.5-$mode "tk_getSaveFile command" -body {
	tk_getSaveFile -parent foo.bar
    } -returnCodes error -result {bad window path name "foo.bar"}
    test filebox-4.6-$mode "tk_getSaveFile command" -body {
	tk_getSaveFile -filetypes {Foo}
    } -returnCodes error -result {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}

    set isNative [expr {
	[info commands ::tk::MotifFDialog] eq "" &&
	[info commands ::tk::dialog::file::] eq ""
    }]

    set parent .

    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring

    set color #404040
    test filebox-5.1-$mode "tk_getSaveFile command" nonUnixUserInteraction {
	ToPressButton $parent cancel
	tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent
    } ""

    set fileName "12x 455"
    set fileDir [pwd]
    set pathName [file join [pwd] $fileName]

    test filebox-5.2-$mode "tk_getSaveFile command" nonUnixUserInteraction {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Press Ok" \
		-parent $parent -initialfile $fileName -initialdir $fileDir]
    } $pathName
    test filebox-5.3-$mode "tk_getSaveFile command" nonUnixUserInteraction {
	ToEnterFileByKey $parent $fileName $fileDir
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir $fileDir]
    } $pathName
    test filebox-5.4-$mode "tk_getSaveFile command" nonUnixUserInteraction {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir . -initialfile $fileName]
    } $pathName
    test filebox-5.5-$mode "tk_getSaveFile command" nonUnixUserInteraction {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir /badpath -initialfile $fileName]
    } $pathName

    test filebox-5.6-$mode "tk_getSaveFile command" -setup {
	toplevel .t1; toplevel .t2
	wm geometry .t1 +0+0
	wm geometry .t2 +0+0
    } -constraints nonUnixUserInteraction -body {
	set choice {}
	ToPressButton .t1 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir -initialfile $fileName]
	ToPressButton .t2 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t2 -initialdir $fileDir -initialfile $fileName]
	ToPressButton .t1 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir -initialfile $fileName]
    } -result [list $pathName $pathName $pathName] -cleanup {
	destroy .t1
	destroy .t2
    }

    foreach x [lsort -integer [array names filters]] {
	test filebox-6.$x-$mode "tk_getSaveFile command" nonUnixUserInteraction {
	    ToPressButton $parent ok
	    set choice [tk_getSaveFile -title "Press Ok" \
		    -filetypes $filters($x) -parent $parent \
		    -initialfile $fileName -initialdir $fileDir]
	} $pathName[lindex $addedExtensions $x]
    }

    if {!$mode} {

	test filebox-7.1-$mode "tk_getOpenFile - directory not readable" \
	    -constraints nonUnixUserInteraction \
	    -setup {
		rename ::tk_messageBox ::saved_messageBox
		set ::gotmessage {}
		proc tk_messageBox args {
		    set ::gotmessage $args
		}
		toplevel .t1
		file mkdir [file join $fileDir NOTREADABLE]
		file attributes [file join $fileDir NOTREADABLE] \
		    -permissions 300
	    } \
	    -cleanup {
		rename ::tk_messageBox {}
		rename ::saved_messageBox ::tk_messageBox
		unset ::gotmessage
		destroy .t1
		file delete -force [file join $fileDir NOTREADABLE]
	    } \
	    -body {
		ToEnterFileByKey .t1 NOTREADABLE $fileDir
		ToPressButton .t1 ok
		ToPressButton .t1 cancel
		tk_getOpenFile -parent .t1 \
		    -title "Please select the NOTREADABLE directory" \
		    -initialdir $fileDir
		set gotmessage
	    } \
	    -match glob \
	    -result "*NOTREADABLE*"

	test filebox-7.2-$mode "tk_getOpenFile - bad file name" \
	    -constraints nonUnixUserInteraction \
	    -setup {
		rename ::tk_messageBox ::saved_messageBox
		set ::gotmessage {}
		proc tk_messageBox args {
		    set ::gotmessage $args
		}
		toplevel .t1
	    } \
	    -cleanup {
		rename ::tk_messageBox {}
		rename ::saved_messageBox ::tk_messageBox
		unset ::gotmessage
		destroy .t1
	    } \
	    -body {
		ToEnterFileByKey .t1 RUBBISH $fileDir
		ToPressButton .t1 ok
		ToPressButton .t1 cancel
		tk_getOpenFile -parent .t1 \
		    -title "Please enter RUBBISH as a file name" \
		    -initialdir $fileDir
		set gotmessage
	    } \
	    -match glob \
	    -result "*RUBBISH*"
    }

    # The rest of the tests need to be executed on Unix only.
    # The test whether the dialog box widgets were implemented correctly.
    # These tests are not
    # needed on the other platforms because they use native file dialogs.
}

set tk_strictMotif $tk_strictMotif_old

# cleanup
removeFile filebox.tmp
cleanupTests
return
@


1.21
log
@merge stable branch onto HEAD
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.18.2.2 2007/11/28 20:33:15 dgp Exp $
d215 1
a215 1
    set fileDir [pwd]
d229 1
@


1.21.2.1
log
@fixes for [temporaryDirectory] != [pwd]
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.21 2007/12/13 15:27:54 dgp Exp $
d215 1
a215 1
    set fileDir [tcltest::temporaryDirectory]
a228 1
        cd $fileDir
@


1.20
log
@* library/tkfbox.tcl (VerifyFileName): Corrected a couple
of typos in handling of bad file names. [Bug #1822076]
* tests/filebox.test (filebox-7.1, filebox-7.2): Added
test cases that exercise the above bug.
Thanks to Christoph Bauer (fridolin@@users.sf.net) for the
patch.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.19 2007/10/25 21:44:23 hobbs Exp $
@


1.19
log
@	* doc/getOpenFile.n:  TIP#242 implementation of -typevariable to
	* library/tkfbox.tcl: return type of selected file in file dialogs.
	* library/xmfbox.tcl: [Bug #1156388]
	* macosx/tkMacOSXDialog.c:
	* tests/filebox.test:
	* tests/winDialog.test:
	* win/tkWinDialog.c:
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.18 2004/12/20 10:34:20 vincentdarley Exp $
d404 63
@


1.18
log
@Corrected handling of MacOS filetypes in tk_*file dialogs
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.17 2004/12/08 03:02:53 dgp Exp $
d116 2
a117 2
set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}
set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}
d272 21
@


1.18.2.1
log
@merge updates from HEAD
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.18 2004/12/20 10:34:20 vincentdarley Exp $
d116 2
a117 2
set unknownOptionsMsg(tk_getOpenFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
set unknownOptionsMsg(tk_getSaveFile) {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, -title, or -typevariable}
a271 21
    foreach {x res} [list 1 "-unset-" 2 "Text files"] {
	set t [expr {$x + [llength [array names filters]]}]
        test filebox-3.$t-$mode "tk_getOpenFile command" nonUnixUserInteraction {
	    catch {unset tv}
	    catch {unset typeName}
	    ToPressButton $parent ok
	    if {[info exists tv]} {
	    } else {
	    }
	    set choice [tk_getOpenFile -title "Press Ok" \
		    -filetypes $filters($x) -parent $parent \
		    -initialfile $fileName -initialdir $fileDir \
		    -typevariable tv]
	    if {[info exists tv]} {
		regexp {^(.*) \(.*\)$} $tv dummy typeName
	    } else {
		set typeName "-unset-"
	    }
	    set typeName
        } $res
    }
@


1.18.2.2
log
@merge updates from HEAD
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.18.2.1 2007/10/27 04:23:17 dgp Exp $
a403 63
    if {!$mode} {

	test filebox-7.1-$mode "tk_getOpenFile - directory not readable" \
	    -constraints nonUnixUserInteraction \
	    -setup {
		rename ::tk_messageBox ::saved_messageBox
		set ::gotmessage {}
		proc tk_messageBox args {
		    set ::gotmessage $args
		}
		toplevel .t1
		file mkdir [file join $fileDir NOTREADABLE]
		file attributes [file join $fileDir NOTREADABLE] \
		    -permissions 300
	    } \
	    -cleanup {
		rename ::tk_messageBox {}
		rename ::saved_messageBox ::tk_messageBox
		unset ::gotmessage
		destroy .t1
		file delete -force [file join $fileDir NOTREADABLE]
	    } \
	    -body {
		ToEnterFileByKey .t1 NOTREADABLE $fileDir
		ToPressButton .t1 ok
		ToPressButton .t1 cancel
		tk_getOpenFile -parent .t1 \
		    -title "Please select the NOTREADABLE directory" \
		    -initialdir $fileDir
		set gotmessage
	    } \
	    -match glob \
	    -result "*NOTREADABLE*"

	test filebox-7.2-$mode "tk_getOpenFile - bad file name" \
	    -constraints nonUnixUserInteraction \
	    -setup {
		rename ::tk_messageBox ::saved_messageBox
		set ::gotmessage {}
		proc tk_messageBox args {
		    set ::gotmessage $args
		}
		toplevel .t1
	    } \
	    -cleanup {
		rename ::tk_messageBox {}
		rename ::saved_messageBox ::tk_messageBox
		unset ::gotmessage
		destroy .t1
	    } \
	    -body {
		ToEnterFileByKey .t1 RUBBISH $fileDir
		ToPressButton .t1 ok
		ToPressButton .t1 cancel
		tk_getOpenFile -parent .t1 \
		    -title "Please enter RUBBISH as a file name" \
		    -initialdir $fileDir
		set gotmessage
	    } \
	    -match glob \
	    -result "*RUBBISH*"
    }

@


1.17
log
@        * tests/canvPs.test:    Cleaned up the matching of [makeFile] and
        * tests/choosedir.test: [removeFile] commands as indicated by the
        * tests/filebox.test:   results of a -debug 1 run of the test suite.
        * tests/imgPPM.test:    Tk test suite is now -debug 1 clean.  This
        * tests/imgPhoto.test:  completes fixing [1078648].
        * tests/listbox.test:
        * tests/main.test:
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.16 2004/06/04 19:55:31 dgp Exp $
d16 14
@


1.16
log
@        * tests/filebox.test:   A few typo corrections in dkf's recent
        * tests/frame.test:     style upgrade for the test suite.
        * tests/select.test:
        * tests/visual.test:
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.15 2004/05/23 17:34:48 dkf Exp $
d378 1
@


1.15
log
@First step towards improving test style.  Also start using Tcl 8.5 features.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.14 2003/04/01 21:06:23 dgp Exp $
d159 1
a159 1
	    } -returnCode error -result "value for \"$option\" missing"
@


1.14
log
@        * tests/all.tcl:                Made better use of a common
        * tests/constraints.tcl:        -loadfile to hold definitions
        * tests/*.test:                 common to all test files.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.13 2002/07/14 05:48:46 dgp Exp $
d102 2
a103 2
set unknownOptionsMsg(tk_getOpenFile) {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
set unknownOptionsMsg(tk_getSaveFile) {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
a129 1

d134 1
a134 1
    # Note that this can use the same test number twice!
d147 3
a149 3
    test filebox-1.1 "tk_getOpenFile command" {
	list [catch {tk_getOpenFile -foo} msg] $msg
    } $unknownOptionsMsg(tk_getOpenFile)
d156 4
a159 4
        if {[string index $option 0] == "-"} {
    	test filebox-1.2 "tk_getOpenFile command" {
    	    list [catch {tk_getOpenFile $option} msg] $msg
    	} [list 1 "value for \"$option\" missing"]
d162 19
a180 23
    
    test filebox-1.3 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -foo bar} msg] $msg
    } $unknownOptionsMsg(tk_getOpenFile)
    
    test filebox-1.4 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -initialdir} msg] $msg
    } {1 {value for "-initialdir" missing}}
    
    test filebox-1.5 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -parent foo.bar} msg] $msg
    } {1 {bad window path name "foo.bar"}}
    
    test filebox-1.6 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -filetypes {Foo}} msg] $msg
    } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
    
    if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
        set isNative 1
    } else {
        set isNative 0
    }
    
d182 1
a182 1
    
d195 1
a195 1
    test filebox-2.1 "tk_getOpenFile command" {nonUnixUserInteraction} {
d199 1
a199 1
    
d203 2
a204 2
    
    test filebox-2.2 "tk_getOpenFile command" {nonUnixUserInteraction} {
d207 1
a207 1
    		    -parent $parent -initialfile $fileName -initialdir $fileDir]
d209 1
a209 2
    
    test filebox-2.3 "tk_getOpenFile command" {nonUnixUserInteraction} {
d212 1
a212 1
    		    -parent $parent -initialdir $fileDir]
d214 1
a214 2
    
    test filebox-2.4 "tk_getOpenFile command" {nonUnixUserInteraction} {
d217 1
a217 2
    		    -parent $parent -initialdir . \
    		    -initialfile $fileName]
d219 1
a219 2
    
    test filebox-2.5 "tk_getOpenFile command" {nonUnixUserInteraction} {
d222 1
a222 2
    		    -parent $parent -initialdir /badpath \
    		    -initialfile $fileName]
d224 1
a224 2
    
    test filebox-2.6 "tk_getOpenFile command" {nonUnixUserInteraction} {
d228 2
a230 1
        set choice {}
d232 3
a234 3
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t1 -initialdir $fileDir \
    	    -initialfile $fileName]
d237 3
a239 3
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t2 -initialdir $fileDir \
    	    -initialfile $fileName]
d242 4
a245 3
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t1 -initialdir $fileDir \
    	    -initialfile $fileName]
d248 1
a248 2
        set choice
    } [list $pathName $pathName $pathName]
d251 5
a255 4
        test filebox-3.$x "tk_getOpenFile command" {nonUnixUserInteraction} {
    	ToPressButton $parent ok
    	set choice [tk_getOpenFile -title "Press Ok" -filetypes $filters($x)\
    			-parent $parent -initialfile $fileName -initialdir $fileDir]
d259 3
a261 3
    test filebox-4.1 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -foo} msg] $msg
    } $unknownOptionsMsg(tk_getSaveFile)
d268 4
a271 4
	if {[string index $option 0] == "-"} {
	    test filebox-4.2 "tk_getSaveFile command" {
		list [catch {tk_getSaveFile $option} msg] $msg
	    } [list 1 "value for \"$option\" missing"]
d275 17
a291 21
    test filebox-4.3 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -foo bar} msg] $msg
    } $unknownOptionsMsg(tk_getSaveFile)

    test filebox-4.4 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -initialdir} msg] $msg
    } {1 {value for "-initialdir" missing}}

    test filebox-4.5 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -parent foo.bar} msg] $msg
    } {1 {bad window path name "foo.bar"}}

    test filebox-4.6 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -filetypes {Foo}} msg] $msg
    } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}

    if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
	set isNative 1
    } else {
	set isNative 0
    }
d307 1
a307 1
    test filebox-5.1 "tk_getSaveFile command" {nonUnixUserInteraction} {
d316 1
a316 1
    test filebox-5.2 "tk_getSaveFile command" {nonUnixUserInteraction} {
d321 1
a321 2

    test filebox-5.3 "tk_getSaveFile command" {nonUnixUserInteraction} {
d326 1
a326 2

    test filebox-5.4 "tk_getSaveFile command" {nonUnixUserInteraction} {
d329 1
a329 2
		-parent $parent -initialdir . \
		-initialfile $fileName]
d331 1
a331 2

    test filebox-5.5 "tk_getSaveFile command" {nonUnixUserInteraction} {
d334 1
a334 2
		-parent $parent -initialdir /badpath \
		-initialfile $fileName]
d337 1
a337 1
    test filebox-5.6 "tk_getSaveFile command" {nonUnixUserInteraction} {
d341 2
a343 1
	set choice {}
d346 1
a346 2
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
d350 1
a350 2
		-parent .t2 -initialdir $fileDir \
		-initialfile $fileName]
d354 2
a355 2
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
d358 1
a358 2
	set choice
    } [list $pathName $pathName $pathName]
d361 1
a361 1
	test filebox-6.$x "tk_getSaveFile command" {nonUnixUserInteraction} {
d363 3
a365 2
	    set choice [tk_getSaveFile -title "Press Ok" -filetypes $filters($x)\
		    -parent $parent -initialfile $fileName -initialdir $fileDir]
@


1.13
log
@	* Completed conversion of Tk test suite to use tcltest.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.12 2002/02/25 15:26:20 dkf Exp $
d13 1
a13 4
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
a15 3
namespace import -force tcltest::makeFile
namespace import -force tcltest::removeFile

d397 1
a397 1
::tcltest::cleanupTests
@


1.12
log
@Improvements to filebox tests (including two fixes due to changed behaviour dating from 2001-12-14)
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.11 2001/08/01 16:21:12 dgp Exp $
d12 9
a20 3
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
a22 6

# Some tests require user interaction on non-unix platform

set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]
@


1.11
log
@	Merged changes from feature branch dgp-privates-into-namespace,
	implementing TIP 44.  All Tk commands and variables matching
	tk[A-Z]* are now in the ::tk namespace.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.10 2000/06/30 20:19:07 ericm Exp $
d116 19
d141 2
d144 1
d147 5
d154 119
a272 3
    #
    # Test both the "open" and the "save" dialogs
    #
d274 13
a286 15
    foreach command "tk_getOpenFile tk_getSaveFile" {
	test filebox-1.1 "$command command" {
	    list [catch {$command -foo} msg] $msg
	} $unknownOptionsMsg($command)

	catch {$command -foo 1} msg
	regsub -all ,      $msg "" options
	regsub \"-foo\" $options "" options

	foreach option $options {
	    if {[string index $option 0] == "-"} {
		test filebox-1.2 "$command command" {
		    list [catch {$command $option} msg] $msg
		} [list 1 "value for \"$option\" missing"]
	    }
d288 1
d290 15
a304 21
	test filebox-1.3 "$command command" {
	    list [catch {$command -foo bar} msg] $msg
	} $unknownOptionsMsg($command)

	test filebox-1.4 "$command command" {
	    list [catch {$command -initialdir} msg] $msg
	} {1 {value for "-initialdir" missing}}

	test filebox-1.5 "$command command" {
	    list [catch {$command -parent foo.bar} msg] $msg
	} {1 {bad window path name "foo.bar"}}

	test filebox-1.6 "$command command" {
	    list [catch {$command -filetypes {Foo}} msg] $msg
	} {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}

	if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
	    set isNative 1
	} else {
	    set isNative 0
	}
d306 5
a310 1
	set parent .
d312 1
a312 26
	set verylongstring longstring:
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring
#	set verylongstring $verylongstring$verylongstring

	set color #404040
	test filebox-2.1 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent cancel
	    $command -title "Press Cancel ($verylongstring)" -parent $parent
	} ""

	if {$command == "tk_getSaveFile"} {
	    set fileName "12x 455"
	    set fileDir [pwd]
	    set pathName [file join [pwd] $fileName]
	} else {
	    set fileName $tmpFile
	    set fileDir [pwd]
	    set pathName [file join $fileDir $fileName]
	}
d314 71
a384 11
	test filebox-2.2 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent ok
	    set choice [$command -title "Press Ok" \
			    -parent $parent -initialfile $fileName -initialdir $fileDir]
	} $pathName

	test filebox-2.3 "$command command" {nonUnixUserInteraction} {
	    ToEnterFileByKey $parent $fileName $fileDir
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir $fileDir]
	} $pathName
d386 2
a387 1
	test filebox-2.4 "$command command" {nonUnixUserInteraction} {
d389 3
a391 72
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir . \
			    -initialfile $fileName]
	} $pathName

	test filebox-2.5 "$command command" {nonUnixUserInteraction} {
	    ToPressButton $parent ok
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir /badpath \
			    -initialfile $fileName]
	} $pathName

	test filebox-2.6 "$command command" {nonUnixUserInteraction} {
	    toplevel .t1; toplevel .t2
	    wm geometry .t1 +0+0
	    wm geometry .t2 +0+0
	    ToPressButton .t1 ok
	    set choice {}
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t1 -initialdir $fileDir \
		    -initialfile $fileName]
	    ToPressButton .t2 ok
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t2 -initialdir $fileDir \
		    -initialfile $fileName]
	    ToPressButton .t1 ok
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t1 -initialdir $fileDir \
		    -initialfile $fileName]
	    destroy .t1
	    destroy .t2
	    set choice
	} [list $pathName $pathName $pathName]
 


	set filters(1) {}

	set filters(2) {
	    {"Text files"	{.txt .doc}	}
	    {"Text files"	{}		TEXT}
	    {"Tcl Scripts"	{.tcl}		TEXT}
	    {"C Source Files"	{.c .h}		}
	    {"All Source Files"	{.tcl .c .h}	}
	    {"Image Files"	{.gif}		}
	    {"Image Files"	{.jpeg .jpg}	}
	    {"Image Files"	""		{GIFF JPEG}}
	    {"All files"	*}
	}

	set filters(3) {
	    {"Text files"	{.txt .doc}	TEXT}
	    {"Foo"		{""}		TEXT}
	}

	foreach x [lsort -integer [array names filters]] {
	    test filebox-3.$x "$command command" {nonUnixUserInteraction} {
		ToPressButton $parent ok
		set choice [$command -title "Press Ok" -filetypes $filters($x)\
				-parent $parent -initialfile $fileName -initialdir $fileDir]
	    } $pathName
	}

	# The rest of the tests need to be executed on Unix only.
	# The test whether the dialog box widgets were implemented correctly.
	# These tests are not
	# needed on the other platforms because they use native file dialogs.

	# end inner if
d394 4
a397 1
    # end outer if
@


1.11.2.1
log
@Merging with TOT as of 06/09/2002.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id$
a115 19
array set filters {
    1 {}
    2 {
	{"Text files"		{.txt .doc}	}
	{"Text files"		{}		TEXT}
	{"Tcl Scripts"		{.tcl}		TEXT}
	{"C Source Files"	{.c .h}		}
	{"All Source Files"	{.tcl .c .h}	}
	{"Image Files"		{.gif}		}
	{"Image Files"		{.jpeg .jpg}	}
	{"Image Files"		""		{GIFF JPEG}}
	{"All files"		*}
    }
    3 {
	{"Text files"		{.txt .doc}	TEXT}
	{"Foo"			{""}		TEXT}
    }
}

a121 2
    # Note that this can use the same test number twice!
    #
a122 1
    set addedExtensions {}
a124 5
	# Extension adding is only done when using the non-motif file
	# box with an extension-less filename
	if {!$mode} {
	    set addedExtensions {NONE {} .txt .txt}
	}
d127 20
a146 119
    test filebox-1.1 "tk_getOpenFile command" {
	list [catch {tk_getOpenFile -foo} msg] $msg
    } $unknownOptionsMsg(tk_getOpenFile)

    catch {tk_getOpenFile -foo 1} msg
    regsub -all ,      $msg "" options
    regsub \"-foo\" $options "" options
    
    foreach option $options {
        if {[string index $option 0] == "-"} {
    	test filebox-1.2 "tk_getOpenFile command" {
    	    list [catch {tk_getOpenFile $option} msg] $msg
    	} [list 1 "value for \"$option\" missing"]
        }
    }
    
    test filebox-1.3 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -foo bar} msg] $msg
    } $unknownOptionsMsg(tk_getOpenFile)
    
    test filebox-1.4 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -initialdir} msg] $msg
    } {1 {value for "-initialdir" missing}}
    
    test filebox-1.5 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -parent foo.bar} msg] $msg
    } {1 {bad window path name "foo.bar"}}
    
    test filebox-1.6 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -filetypes {Foo}} msg] $msg
    } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
    
    if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
        set isNative 1
    } else {
        set isNative 0
    }
    
    set parent .
    
    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring

    set color #404040
    test filebox-2.1 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent cancel
        tk_getOpenFile -title "Press Cancel ($verylongstring)" -parent $parent
    } ""
    
    set fileName $tmpFile
    set fileDir [pwd]
    set pathName [file join $fileDir $fileName]
    
    test filebox-2.2 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Press Ok" \
    		    -parent $parent -initialfile $fileName -initialdir $fileDir]
    } $pathName
    
    test filebox-2.3 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToEnterFileByKey $parent $fileName $fileDir
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
    		    -parent $parent -initialdir $fileDir]
    } $pathName
    
    test filebox-2.4 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
    		    -parent $parent -initialdir . \
    		    -initialfile $fileName]
    } $pathName
    
    test filebox-2.5 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
    		    -parent $parent -initialdir /badpath \
    		    -initialfile $fileName]
    } $pathName
    
    test filebox-2.6 "tk_getOpenFile command" {nonUnixUserInteraction} {
        toplevel .t1; toplevel .t2
        wm geometry .t1 +0+0
        wm geometry .t2 +0+0
        ToPressButton .t1 ok
        set choice {}
        lappend choice [tk_getOpenFile \
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t1 -initialdir $fileDir \
    	    -initialfile $fileName]
        ToPressButton .t2 ok
        lappend choice [tk_getOpenFile \
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t2 -initialdir $fileDir \
    	    -initialfile $fileName]
        ToPressButton .t1 ok
        lappend choice [tk_getOpenFile \
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t1 -initialdir $fileDir \
    	    -initialfile $fileName]
        destroy .t1
        destroy .t2
        set choice
    } [list $pathName $pathName $pathName]

    foreach x [lsort -integer [array names filters]] {
        test filebox-3.$x "tk_getOpenFile command" {nonUnixUserInteraction} {
    	ToPressButton $parent ok
    	set choice [tk_getOpenFile -title "Press Ok" -filetypes $filters($x)\
    			-parent $parent -initialfile $fileName -initialdir $fileDir]
        } $pathName
    }
d148 20
a167 13
    test filebox-4.1 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -foo} msg] $msg
    } $unknownOptionsMsg(tk_getSaveFile)

    catch {tk_getSaveFile -foo 1} msg
    regsub -all ,      $msg "" options
    regsub \"-foo\" $options "" options

    foreach option $options {
	if {[string index $option 0] == "-"} {
	    test filebox-4.2 "tk_getSaveFile command" {
		list [catch {tk_getSaveFile $option} msg] $msg
	    } [list 1 "value for \"$option\" missing"]
a168 1
    }
d170 1
a170 15
    test filebox-4.3 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -foo bar} msg] $msg
    } $unknownOptionsMsg(tk_getSaveFile)

    test filebox-4.4 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -initialdir} msg] $msg
    } {1 {value for "-initialdir" missing}}

    test filebox-4.5 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -parent foo.bar} msg] $msg
    } {1 {bad window path name "foo.bar"}}

    test filebox-4.6 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -filetypes {Foo}} msg] $msg
    } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
d172 26
a197 5
    if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
	set isNative 1
    } else {
	set isNative 0
    }
d199 11
a209 1
    set parent .
d211 6
a216 71
    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring

    set color #404040
    test filebox-5.1 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent cancel
	tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent
    } ""

    set fileName "12x 455"
    set fileDir [pwd]
    set pathName [file join [pwd] $fileName]

    test filebox-5.2 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Press Ok" \
		-parent $parent -initialfile $fileName -initialdir $fileDir]
    } $pathName

    test filebox-5.3 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToEnterFileByKey $parent $fileName $fileDir
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir $fileDir]
    } $pathName

    test filebox-5.4 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir . \
		-initialfile $fileName]
    } $pathName

    test filebox-5.5 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir /badpath \
		-initialfile $fileName]
    } $pathName

    test filebox-5.6 "tk_getSaveFile command" {nonUnixUserInteraction} {
	toplevel .t1; toplevel .t2
	wm geometry .t1 +0+0
	wm geometry .t2 +0+0
	ToPressButton .t1 ok
	set choice {}
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
	ToPressButton .t2 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t2 -initialdir $fileDir \
		-initialfile $fileName]
	ToPressButton .t1 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
	destroy .t1
	destroy .t2
	set choice
    } [list $pathName $pathName $pathName]
d218 1
a218 2
    foreach x [lsort -integer [array names filters]] {
	test filebox-6.$x "tk_getSaveFile command" {nonUnixUserInteraction} {
d220 65
a284 3
	    set choice [tk_getSaveFile -title "Press Ok" -filetypes $filters($x)\
		    -parent $parent -initialfile $fileName -initialdir $fileDir]
	} $pathName[lindex $addedExtensions $x]
d287 1
a287 4
    # The rest of the tests need to be executed on Unix only.
    # The test whether the dialog box widgets were implemented correctly.
    # These tests are not
    # needed on the other platforms because they use native file dialogs.
@


1.11.2.2
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d12 3
a14 6
package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
d16 3
a18 2
namespace import -force tcltest::makeFile
namespace import -force tcltest::removeFile
d20 3
a22 1
set tk_strictMotif_old $tk_strictMotif
@


1.10
log
@* tests/filebox.test: Adjusted tests to accomodate -multiple.

* library/xmfbox.tcl: Adjusted arguments list construction such
that -multiple is not presented as an option for tk_getSaveFile.

* library/tk.tcl: Added test for safe interpreter status before
attempting to load message catalogs (which is impossible in a
standard safe interpreter).  This means that SafeTk will not have
localized dialogs, unless a means is found for loading the message
catalog files.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.9 2000/03/24 19:38:57 ericm Exp $
d164 1
a164 1
	if {[info commands tkMotifFDialog] == "" && [info commands ::tk::dialog::file::tkFDialog] == ""} {
@


1.10.2.1
log
@sync with head
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.12 2002/02/25 15:26:20 dkf Exp $
a115 19
array set filters {
    1 {}
    2 {
	{"Text files"		{.txt .doc}	}
	{"Text files"		{}		TEXT}
	{"Tcl Scripts"		{.tcl}		TEXT}
	{"C Source Files"	{.c .h}		}
	{"All Source Files"	{.tcl .c .h}	}
	{"Image Files"		{.gif}		}
	{"Image Files"		{.jpeg .jpg}	}
	{"Image Files"		""		{GIFF JPEG}}
	{"All files"		*}
    }
    3 {
	{"Text files"		{.txt .doc}	TEXT}
	{"Foo"			{""}		TEXT}
    }
}

a121 2
    # Note that this can use the same test number twice!
    #
a122 1
    set addedExtensions {}
a124 5
	# Extension adding is only done when using the non-motif file
	# box with an extension-less filename
	if {!$mode} {
	    set addedExtensions {NONE {} .txt .txt}
	}
d127 20
a146 119
    test filebox-1.1 "tk_getOpenFile command" {
	list [catch {tk_getOpenFile -foo} msg] $msg
    } $unknownOptionsMsg(tk_getOpenFile)

    catch {tk_getOpenFile -foo 1} msg
    regsub -all ,      $msg "" options
    regsub \"-foo\" $options "" options
    
    foreach option $options {
        if {[string index $option 0] == "-"} {
    	test filebox-1.2 "tk_getOpenFile command" {
    	    list [catch {tk_getOpenFile $option} msg] $msg
    	} [list 1 "value for \"$option\" missing"]
        }
    }
    
    test filebox-1.3 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -foo bar} msg] $msg
    } $unknownOptionsMsg(tk_getOpenFile)
    
    test filebox-1.4 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -initialdir} msg] $msg
    } {1 {value for "-initialdir" missing}}
    
    test filebox-1.5 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -parent foo.bar} msg] $msg
    } {1 {bad window path name "foo.bar"}}
    
    test filebox-1.6 "tk_getOpenFile command" {
        list [catch {tk_getOpenFile -filetypes {Foo}} msg] $msg
    } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
    
    if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
        set isNative 1
    } else {
        set isNative 0
    }
    
    set parent .
    
    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring

    set color #404040
    test filebox-2.1 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent cancel
        tk_getOpenFile -title "Press Cancel ($verylongstring)" -parent $parent
    } ""
    
    set fileName $tmpFile
    set fileDir [pwd]
    set pathName [file join $fileDir $fileName]
    
    test filebox-2.2 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Press Ok" \
    		    -parent $parent -initialfile $fileName -initialdir $fileDir]
    } $pathName
    
    test filebox-2.3 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToEnterFileByKey $parent $fileName $fileDir
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
    		    -parent $parent -initialdir $fileDir]
    } $pathName
    
    test filebox-2.4 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
    		    -parent $parent -initialdir . \
    		    -initialfile $fileName]
    } $pathName
    
    test filebox-2.5 "tk_getOpenFile command" {nonUnixUserInteraction} {
        ToPressButton $parent ok
        set choice [tk_getOpenFile -title "Enter \"$fileName\" and press Ok" \
    		    -parent $parent -initialdir /badpath \
    		    -initialfile $fileName]
    } $pathName
    
    test filebox-2.6 "tk_getOpenFile command" {nonUnixUserInteraction} {
        toplevel .t1; toplevel .t2
        wm geometry .t1 +0+0
        wm geometry .t2 +0+0
        ToPressButton .t1 ok
        set choice {}
        lappend choice [tk_getOpenFile \
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t1 -initialdir $fileDir \
    	    -initialfile $fileName]
        ToPressButton .t2 ok
        lappend choice [tk_getOpenFile \
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t2 -initialdir $fileDir \
    	    -initialfile $fileName]
        ToPressButton .t1 ok
        lappend choice [tk_getOpenFile \
    	    -title "Enter \"$fileName\" and press Ok" \
    	    -parent .t1 -initialdir $fileDir \
    	    -initialfile $fileName]
        destroy .t1
        destroy .t2
        set choice
    } [list $pathName $pathName $pathName]

    foreach x [lsort -integer [array names filters]] {
        test filebox-3.$x "tk_getOpenFile command" {nonUnixUserInteraction} {
    	ToPressButton $parent ok
    	set choice [tk_getOpenFile -title "Press Ok" -filetypes $filters($x)\
    			-parent $parent -initialfile $fileName -initialdir $fileDir]
        } $pathName
    }
d148 20
a167 13
    test filebox-4.1 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -foo} msg] $msg
    } $unknownOptionsMsg(tk_getSaveFile)

    catch {tk_getSaveFile -foo 1} msg
    regsub -all ,      $msg "" options
    regsub \"-foo\" $options "" options

    foreach option $options {
	if {[string index $option 0] == "-"} {
	    test filebox-4.2 "tk_getSaveFile command" {
		list [catch {tk_getSaveFile $option} msg] $msg
	    } [list 1 "value for \"$option\" missing"]
a168 1
    }
d170 1
a170 15
    test filebox-4.3 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -foo bar} msg] $msg
    } $unknownOptionsMsg(tk_getSaveFile)

    test filebox-4.4 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -initialdir} msg] $msg
    } {1 {value for "-initialdir" missing}}

    test filebox-4.5 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -parent foo.bar} msg] $msg
    } {1 {bad window path name "foo.bar"}}

    test filebox-4.6 "tk_getSaveFile command" {
	list [catch {tk_getSaveFile -filetypes {Foo}} msg] $msg
    } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
d172 26
a197 5
    if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
	set isNative 1
    } else {
	set isNative 0
    }
d199 11
a209 1
    set parent .
d211 6
a216 71
    set verylongstring longstring:
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring
    # set verylongstring $verylongstring$verylongstring

    set color #404040
    test filebox-5.1 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent cancel
	tk_getSaveFile -title "Press Cancel ($verylongstring)" -parent $parent
    } ""

    set fileName "12x 455"
    set fileDir [pwd]
    set pathName [file join [pwd] $fileName]

    test filebox-5.2 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Press Ok" \
		-parent $parent -initialfile $fileName -initialdir $fileDir]
    } $pathName

    test filebox-5.3 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToEnterFileByKey $parent $fileName $fileDir
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir $fileDir]
    } $pathName

    test filebox-5.4 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir . \
		-initialfile $fileName]
    } $pathName

    test filebox-5.5 "tk_getSaveFile command" {nonUnixUserInteraction} {
	ToPressButton $parent ok
	set choice [tk_getSaveFile -title "Enter \"$fileName\" and press Ok" \
		-parent $parent -initialdir /badpath \
		-initialfile $fileName]
    } $pathName

    test filebox-5.6 "tk_getSaveFile command" {nonUnixUserInteraction} {
	toplevel .t1; toplevel .t2
	wm geometry .t1 +0+0
	wm geometry .t2 +0+0
	ToPressButton .t1 ok
	set choice {}
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
	ToPressButton .t2 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t2 -initialdir $fileDir \
		-initialfile $fileName]
	ToPressButton .t1 ok
	lappend choice [tk_getSaveFile \
		-title "Enter \"$fileName\" and press Ok" \
		-parent .t1 -initialdir $fileDir \
		-initialfile $fileName]
	destroy .t1
	destroy .t2
	set choice
    } [list $pathName $pathName $pathName]
d218 1
a218 2
    foreach x [lsort -integer [array names filters]] {
	test filebox-6.$x "tk_getSaveFile command" {nonUnixUserInteraction} {
d220 65
a284 3
	    set choice [tk_getSaveFile -title "Press Ok" -filetypes $filters($x)\
		    -parent $parent -initialfile $fileName -initialdir $fileDir]
	} $pathName[lindex $addedExtensions $x]
d287 1
a287 4
    # The rest of the tests need to be executed on Unix only.
    # The test whether the dialog box widgets were implemented correctly.
    # These tests are not
    # needed on the other platforms because they use native file dialogs.
@


1.10.4.1
log
@2001-02-28  Don Porter  <dgp@@users.sourceforge.net>

        BRANCH dgp-privates-into-namespace:  Feature branch to move all
        of Tk's private commands and variable into the ::tk namespace
        and its children.

        * doc/tkvars.n:  Documented private variable tkPriv renamed tk::Priv.

        * generic/tkBind.c:
        * generic/tkMenu.c:
        * generic/tkTextDisp.c:
        * library/bgerror.tcl:
        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/optMenu.tcl:
        * library/palette.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tclIndex:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
        * mac/tkMacMenu.c:
        * tests/clrpick.test:
        * tests/filebox.test:
        * tests/macMenu.test:
        * tests/menu.test:
        * tests/menuDraw.test:
        * tests/msgbox.test:
        * tests/text.test:
        * tests/textDisp.test:
        * tests/unixMenu.test:
        * tests/winMenu.test:
        * tests/xmfbox.test:
        * unix/tkUnixDialog.c:  All Tk commands matching ::tk[A-Z]* and
        all Tk private variables in the global namespace were renamed to
        live in the namespace ::tk or one of its children.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.10 2000/06/30 20:19:07 ericm Exp $
d164 1
a164 1
	if {[info commands tk::MotifFDialog] == "" && [info commands ::tk::dialog::file::] == ""} {
@


1.9
log
@* tests/filebox.test:
* tests/choosedir.test: Updated tests.

* library/xmfbox.tcl: Updated to stash data array in
::tk::dialog::file namespace instead of in global namespace.

* library/tkfbox.tcl: Extended some functions to support creation
of a choosedir dialog, to allow greater code reuse between the two
dialogs.  Moved tkFDialog* functions into a namespace
(::tk::dialog::file).  Because these are private Tk functions (and
should thus not be used directly by users), this should not impact
anybody (the tk_getOpenFile and tk_getSaveFile commands still
exist at the global scope).

* library/tk.tcl:
* library/tclIndex: Updated function names for tkFDialog*
functions and choosedir functions.

* library/choosedir.tcl: New and improved implementation of
tk_chooseDirectory dialog.  Based on tk_getOpenFile dialog.

* library/listbox.tcl: (tkListboxCancel) Added a check for empty
string value for tkPriv(listboxPrev).  Without this check, it's
possible to get a stack trace under certain conditions. [Bug: 4373].
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.8 1999/11/30 00:02:20 hobbs Exp $
d108 2
a109 1
set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
d134 1
a134 1
	} $unknownOptionsMsg
d150 1
a150 1
	} $unknownOptionsMsg
@


1.8
log
@minor whitespace cleanup
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.7 1999/11/12 23:55:16 wart Exp $
d57 1
a57 1
    upvar #0 [winfo name $w] data
d78 1
a78 1
    upvar #0 [winfo name $w] data
d163 1
a163 1
	if {[info commands tkMotifFDialog] == "" && [info commands tkFDialog] == ""} {
@


1.7
log
@Added "wm geometry" calls in some tests that were waiting for the user to
place a window manually.  The Tk test suite can now run on twm with no user
intervention.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.6 1999/04/16 01:51:37 stanton Exp $
d278 3
a280 3
	#
	# The rest of the tests need to be executed on Unix only. The test whether
	# the dialog box widgets were implemented correctly. These tests are not
a281 4
	#



a293 13













@


1.6
log
@* Merged 8.1 branch into the main trunk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id$
d226 2
@


1.5
log
@- updated filebox test to work regardless of current working dir.
- updated imgPhoto to check for teapot.ppm before running the tests.
  exits gracefully if file cannot be found.
- lint in "all" file
@
text
@d6 2
d9 1
a9 4
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @@(#) $Id: filebox.test,v 1.4 1998/09/14 18:23:46 stanton Exp $
d11 4
d18 6
a101 4
if {[string compare test [info procs test]] == 1} {
    source defs
}

d108 6
a113 1
set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}}
a130 1

d135 1
a168 4
	if {$isNative && ![info exists INTERACTIVE]} {
	    continue
	}

d183 1
a183 1
	test filebox-2.1 "$command command" {
a187 1

d193 1
a193 4
	    set thisFile [info script]
	    set fileName [file tail $thisFile]

	    # this file should be in the current working dir
d198 1
a198 1
	test filebox-2.2 "$command command" {
d204 1
a204 1
	test filebox-2.3 "$command command" {
d210 1
a210 1
	test filebox-2.4 "$command command" {
d217 1
a217 1
	test filebox-2.5 "$command command" {
d224 1
a224 1
	test filebox-2.6 "$command command" {
d269 1
a269 1
	    test filebox-3.$x "$command command" {
d293 16
a308 7
if {$isNative && ![info exists INTERACTIVE]} {
    puts " Some tests were skipped because they could not be performed"
    puts " automatically on this platform. If you wish to execute them"
    puts " interactively, set the TCL variable INTERACTIVE and re-run"
    puts " the test."
    return
}
@


1.4
log
@Replaced SCCS strings, fixed binary files
@
text
@d10 1
a10 1
# RCS: @@(#) $Id$
d190 2
a191 2
	    set appPWD [pwd]
	    cd [file dirname $thisFile]
a192 1
	    cd $appPWD
@


1.3
log
@*** empty log message ***
@
text
@d10 1
a10 1
# SCCS: @@(#) filebox.test 1.5 97/10/10 11:03:21
@


1.2
log
@added test for unusual initialdir
@
text
@d43 5
a47 1
    set w .__tk_filedialog
d64 5
a68 1
    set w .__tk_filedialog
d216 6
d223 25
@


1.1
log
@Initial revision
@
text
@d201 8
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d10 1
a10 1
# SCCS: @@(#) filebox.test 1.7 97/10/20 14:49:37
d95 1
a95 1
set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
d113 1
a117 1
	catch {$command -foo 1} msg
d173 1
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: filebox.test,v 1.4 1998/09/14 18:23:46 stanton Exp $
d43 1
a43 5
    if {$parent == "."} {
	set w .__tk_filedialog
    } else {
	set w $parent.__tk_filedialog
    }
d60 1
a60 5
    if {$parent == "."} {
	set w .__tk_filedialog
    } else {
	set w $parent.__tk_filedialog
    }
a198 39

	test filebox-2.4 "$command command" {
	    ToPressButton $parent ok
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir . \
			    -initialfile $fileName]
	} $pathName

	test filebox-2.5 "$command command" {
	    ToPressButton $parent ok
	    set choice [$command -title "Enter \"$fileName\" and press Ok" \
			    -parent $parent -initialdir /badpath \
			    -initialfile $fileName]
	} $pathName

	test filebox-2.6 "$command command" {
	    toplevel .t1; toplevel .t2
	    ToPressButton .t1 ok
	    set choice {}
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t1 -initialdir $fileDir \
		    -initialfile $fileName]
	    ToPressButton .t2 ok
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t2 -initialdir $fileDir \
		    -initialfile $fileName]
	    ToPressButton .t1 ok
	    lappend choice [$command \
		    -title "Enter \"$fileName\" and press Ok" \
		    -parent .t1 -initialdir $fileDir \
		    -initialfile $fileName]
	    destroy .t1
	    destroy .t2
	    set choice
	} [list $pathName $pathName $pathName]
 

@


1.1.4.3
log
@merge 8.0 changes
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: filebox.test,v 1.1.4.2 1998/09/30 02:18:35 stanton Exp $
d189 2
a190 2

	    # this file should be in the current working dir
d192 1
@


1.1.4.4
log
@Updated the testsuite to use "test" namespace and commandline args
to control verbose  level and which tests get run.  Tests now work from
any working dir.
@
text
@a5 2
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
d7 4
a10 1
# RCS: @@(#) $Id: filebox.test,v 1.1.4.3 1998/12/10 03:43:54 stanton Exp $
a12 3
puts "skipping these tests: TEMPORARILY under construction"
return

d93 2
a94 2
if {[lsearch [namespace children] ::test] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
d295 1
a296 4

# cleanup
::test::cleanupTests
return
@


1.1.4.5
log
@fixed tests' depency on working dir = tests
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.1.4.4 1999/03/11 18:50:48 hershey Exp $
d12 3
a106 5
set tmpFile "filebox.tmp"
makeFile {
    # this file can be empty!
} $tmpFile

d189 4
a192 1
	    set fileName $tmpFile
@


1.1.4.6
log
@- changed ::test to ::tcltest
- made many tests more atomic (still more work to do here)
- defs.tcl is now identicle for tcl and tk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.1.4.5 1999/03/11 23:51:26 hershey Exp $
d92 1
a92 1
if {[lsearch [namespace children] ::tcltest] == -1} {
d163 1
a163 1
	if {$isNative && ![info exists tcl_interactive]} {
d291 1
a291 1
if {$isNative && ![info exists tcl_interactive]} {
d294 2
a295 1
    puts " run them in an interactive shell."
d299 1
a299 1
::tcltest::cleanupTests
a300 12












@


1.1.4.7
log
@lint:  changed a tcltest namespace variable name from tmpDir to
       workingDir.
changes:  made more tests atomic.
README is now updated to match new test suite features.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.1.4.6 1999/03/24 01:16:45 hershey Exp $
a299 1

@


1.1.4.8
log
@Now all test files that skip tests by returning early (which ideally they
shouldn't do) call ::tcltest::cleanupTests before returning.  The defs.tcl
file has one hew constraint:  userInteraction, used by tests that require
user interaction.  The next putback will include an updated version of the
"visual" test file to use this mechanism.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: filebox.test,v 1.1.4.7 1999/03/24 02:54:39 hershey Exp $
a11 4
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

a13 6
# Some tests require user interaction on non-unix platform

set ::tcltest::testConfig(nonUnixUserInteraction) \
    [expr {$::tcltest::testConfig(userInteraction) || \
	$::tcltest::testConfig(unixOnly)}]

d92 4
d163 4
d181 1
a181 1
	test filebox-2.1 "$command command" {nonUnixUserInteraction} {
d196 1
a196 1
	test filebox-2.2 "$command command" {nonUnixUserInteraction} {
d202 1
a202 1
	test filebox-2.3 "$command command" {nonUnixUserInteraction} {
d208 1
a208 1
	test filebox-2.4 "$command command" {nonUnixUserInteraction} {
d215 1
a215 1
	test filebox-2.5 "$command command" {nonUnixUserInteraction} {
d222 1
a222 1
	test filebox-2.6 "$command command" {nonUnixUserInteraction} {
d267 1
a267 1
	    test filebox-3.$x "$command command" {nonUnixUserInteraction} {
d290 6
@


