# This file is a Tcl script to test out Tk's "tk_chooseDir" and
# 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: choosedir.test,v 1.3 2000/03/02 23:45:12 hobbs Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

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

proc ToPressButton {parent btn} {
    after 100 SendButtonPress $parent $btn mouse
}

proc ToEnterDirByKey {parent dir} {
    after 100 EnterDirByKey $parent [list $dir]
}

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 EnterDirByKey {parent dir} {
    if {$parent == "."} {
	set w .choosedirectory
    } else {
	set w $parent.choosedirectory
    }

    $w.e delete 0 end
    $w.e insert 0 $dir

    update
    SendButtonPress $parent ok mouse
}

proc SendButtonPress {parent btn type} {
    if {$parent == "."} {
	set w .choosedirectory
    } else {
	set w $parent.choosedirectory
    }

    set button $w.$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
#
#----------------------------------------------------------------------
catch {unset err}
append err(usage) "tk_chooseDirectory "
append err(usage) "?-initialdir directory? ?-mustexist boolean? "
append err(usage) "?-parent window? ?-title title?"

set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""

foreach opt {-initialdir -mustexist -parent -title} {
    test filebox-1.1 "tk_chooseDirectory command" {
	list [catch {tk_chooseDirectory $opt} msg] $msg
    } [list 1 [format $err(valueMissing) $opt]]
}
test filebox-1.2 "tk_chooseDirectory command" {
    list [catch {tk_chooseDirectory -foo bar} msg] $msg
} [list 1 [format $err(unknownOpt) "-foo"]]
test filebox-1.3 "tk_chooseDirectory command" {
    list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg
} {1 {bad window path name "foo.bar"}}

set parent .
set initialdir [pwd]
set pathName [pwd]
set otherdir "/tmp"

test filebox-2.1 "tk_chooseDirectory command" {unixOnly} {
    ToPressButton $parent cancel
    tk_chooseDirectory -title "Press Cancel" -parent $parent
} ""
test filebox-2.2 "tk_chooseDirectory command" {unixOnly} {
    ToPressButton $parent ok
    set choice [tk_chooseDirectory -title "Press Ok" \
	    -parent $parent -initialdir $initialdir]
} $initialdir
test filebox-2.3 "tk_chooseDirectory command" {unixOnly} {
    ToEnterDirByKey $parent $otherdir
    set choice [tk_chooseDirectory \
	    -title "Enter \"$otherdir\" and press Ok" \
	    -parent $parent -initialdir $initialdir]
} $otherdir

# cleanup
::tcltest::cleanupTests
return