1# This file is a Tcl script to test out Tk's "tk_dialog" command. 2# It is organized in the standard fashion for Tcl tests. 3# 4# RCS: @(#) $Id$ 5# 6 7package require tcltest 2.1 8eval tcltest::configure $argv 9tcltest::loadTestedCommands 10 11test dialog-1.1 {tk_dialog command} -body { 12 list [catch {tk_dialog} msg] $msg 13} -match glob -result {1 {wrong # args: should be "tk_dialog w title text bitmap default *"}} 14test dialog-1.2 {tk_dialog command} { 15 list [catch {tk_dialog foo foo foo foo foo} msg] $msg 16} {1 {bad window path name "foo"}} 17test dialog-1.3 {tk_dialog command} { 18 set res [list [catch {tk_dialog .d foo foo fooBitmap foo} msg] $msg] 19 destroy .d 20 set res 21} {1 {bitmap "fooBitmap" not defined}} 22 23proc PressButton {btn} { 24 if {![winfo ismapped $btn]} { 25 update 26 } 27 event generate $btn <Enter> 28 event generate $btn <1> -x 5 -y 5 29 event generate $btn <ButtonRelease-1> -x 5 -y 5 30} 31 32proc HitReturn {w} { 33 event generate $w <Enter> 34 focus -force $w 35 event generate $w <KeyPress> -keysym Return 36} 37 38test dialog-2.0 {tk_dialog operation} { 39 set x [after 5000 [list set tk::Priv(button) "no response"]] 40 after 100 PressButton .d.button0 41 set res [tk_dialog .d foo foo info 0 click] 42 after cancel $x 43 set res 44} {0} 45test dialog-2.1 {tk_dialog operation} { 46 set x [after 5000 [list set tk::Priv(button) "no response"]] 47 after 100 HitReturn .d 48 set res [tk_dialog .d foo foo info 1 click default] 49 after cancel $x 50 set res 51} {1} 52test dialog-2.2 {tk_dialog operation} { 53 set x [after 5000 [list set tk::Priv(button) "no response"]] 54 after 100 destroy .d 55 set res [tk_dialog .d foo foo info 0 click] 56 after cancel $x 57 set res 58} {-1} 59 60cleanupTests 61return 62