summaryrefslogtreecommitdiffstats
path: root/tests/unixEmbed.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/unixEmbed.test')
-rw-r--r--tests/unixEmbed.test620
1 files changed, 620 insertions, 0 deletions
diff --git a/tests/unixEmbed.test b/tests/unixEmbed.test
new file mode 100644
index 0000000..ef8ecb9
--- /dev/null
+++ b/tests/unixEmbed.test
@@ -0,0 +1,620 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkUnixEmbed.c. It is organized in the standard fashion for Tcl
+# tests.
+#
+# Copyright (c) 1996-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: @(#) unixEmbed.test 1.7 97/08/13 11:13:21
+
+if {$tcl_platform(platform) != "unix"} {
+ return
+}
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+setupbg
+dobg {wm withdraw .}
+
+# eatColors --
+# Creates a toplevel window and allocates enough colors in it to
+# use up all the slots in the colormap.
+#
+# Arguments:
+# w - Name of toplevel window to create.
+
+proc eatColors {w} {
+ catch {destroy $w}
+ toplevel $w
+ wm geom $w +0+0
+ canvas $w.c -width 400 -height 200 -bd 0
+ pack $w.c
+ for {set y 0} {$y < 8} {incr y} {
+ for {set x 0} {$x < 40} {incr x} {
+ set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
+ $w.c create rectangle [expr 10*$x] [expr 20*$y] \
+ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
+ -fill $color
+ }
+ }
+ update
+}
+
+# colorsFree --
+#
+# Returns 1 if there appear to be free colormap entries in a window,
+# 0 otherwise.
+#
+# Arguments:
+# w - Name of window in which to check.
+# red, green, blue - Intensities to use in a trial color allocation
+# to see if there are colormap entries free.
+
+proc colorsFree {w {red 31} {green 245} {blue 192}} {
+ set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
+ expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
+ && ([lindex $vals 2]/256 == $blue)
+}
+
+test unixEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {
+ catch {destroy .t}
+ list [catch {toplevel .t -use xyz} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
+ catch {destroy .t}
+ list [catch {toplevel .t -use 47} msg] $msg
+} {1 {couldn't create child of window "47"}}
+test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {
+ catch {destroy .t}
+ catch {destroy .x}
+ toplevel .t -colormap new
+ wm geometry .t +0+0
+ eatColors .t.t
+ frame .t.f -container 1
+ toplevel .x -use [winfo id .t.f]
+ set result [colorsFree .x]
+ destroy .t
+ set result
+} {0}
+test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {
+ catch {destroy .t}
+ catch {destroy .t2}
+ catch {destroy .x}
+ toplevel .t -container 1 -colormap new
+ wm geometry .t +0+0
+ eatColors .t2
+ toplevel .x -use [winfo id .t]
+ set result [colorsFree .x]
+ destroy .t
+ set result
+} {1}
+test unixEmbed-1.5 {TkpUseWindow procedure, creating Container records} {
+ eval destroy [winfo child .]
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ pack .f1 .f2
+ dobg "set w [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t -use $w
+ list [testembed] [expr [lindex [lindex [testembed all] 0] 0] - $w]
+ }
+} {{{XXX {} {} .t}} 0}
+test unixEmbed-1.6 {TkpUseWindow procedure, creating Container records} {
+ eval destroy [winfo child .]
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ pack .f1 .f2
+ dobg "set w1 [winfo id .f1]"
+ dobg "set w2 [winfo id .f2]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ toplevel .t2 -use $w2
+ testembed
+ }
+} {{XXX {} {} .t2} {XXX {} {} .t1}}
+test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} {
+ eval destroy [winfo child .]
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ pack .f1 .f2
+ toplevel .t1 -use [winfo id .f1]
+ toplevel .t2 -use [winfo id .f2]
+ testembed
+} {{XXX .f2 {} .t2} {XXX .f1 {} .t1}}
+
+# Can't think of any way to test the procedures TkpMakeWindow,
+# TkpMakeContainer, or EmbedErrorProc.
+
+test unixEmbed-2.1 {EmbeddedEventProc procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ testembed
+ }
+ destroy .f1
+ update
+ dobg {
+ testembed
+ }
+} {}
+test unixEmbed-2.2 {EmbeddedEventProc procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ testembed
+ destroy .t1
+ testembed
+ }
+} {}
+test unixEmbed-2.3 {EmbeddedEventProc procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ toplevel .t1 -use [winfo id .f1]
+ update
+ destroy .f1
+ testembed
+} {}
+test unixEmbed-2.4 {EmbeddedEventProc procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ toplevel .t1 -use [winfo id .f1]
+ update
+ destroy .t1
+ set x [testembed]
+ update
+ list $x [testembed]
+} {{{XXX .f1 {} {}}} {}}
+
+test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ set x [testembed]
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ wm withdraw .t1
+ }
+ list $x [testembed]
+} {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}}
+test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ toplevel .t1 -container 1
+ wm geometry .t1 +0+0
+ toplevel .t2 -use [winfo id .t1] -bg red
+ update
+ wm geometry .t2
+} {200x200+0+0}
+test unixEmbed-3.2 {ContainerEventProc procedure, disallow position changes} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1 -bd 2 -relief raised
+ update
+ wm geometry .t1 +30+40
+ }
+ update
+ dobg {
+ wm geometry .t1
+ }
+} {200x200+0+0}
+test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ update
+ wm geometry .t1 300x100+30+40
+ }
+ update
+ dobg {
+ wm geometry .t1
+ }
+} {300x100+0+0}
+test unixEmbed-3.4 {ContainerEventProc procedure, geometry requests} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ .t1 configure -width 300 -height 80
+ }
+ update
+ list [winfo width .f1] [winfo height .f1] [dobg {wm geometry .t1}]
+} {300 80 300x80+0+0}
+test unixEmbed-3.5 {ContainerEventProc procedure, map requests} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ set x unmapped
+ bind .t1 <Map> {set x mapped}
+ }
+ update
+ dobg {
+ after 100
+ update
+ set x
+ }
+} {mapped}
+test unixEmbed-3.6 {ContainerEventProc procedure, destroy events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ bind .f1 <Destroy> {set x dead}
+ set x alive
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ destroy .t1
+ }
+ update
+ list $x [winfo exists .f1]
+} {dead 0}
+
+test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ .t1 configure -width 180 -height 100
+ }
+ update
+ dobg {
+ winfo geometry .t1
+ }
+} {180x100+0+0}
+test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ set x [testembed]
+ destroy .f1
+ list $x [testembed]
+} {{{XXX .f1 XXX {}}} {}}
+
+test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ bind .t1 <FocusIn> {lappend x "focus in %W"}
+ bind .t1 <FocusOut> {lappend x "focus out %W"}
+ set x {}
+ }
+ focus -force .f1
+ update
+ dobg {set x}
+} {{focus in .t1}}
+test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ after 200 {destroy .t1}
+ }
+ after 400
+ focus -force .f1
+ update
+} {}
+test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ bind .t1 <FocusIn> {lappend x "focus in %W"}
+ bind .t1 <FocusOut> {lappend x "focus out %W"}
+ set x {}
+ }
+ focus -force .f1
+ update
+ set x [dobg {update; set x}]
+ focus .
+ update
+ list $x [dobg {update; set x}]
+} {{{focus in .t1}} {{focus in .t1} {focus out .t1}}}
+
+test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
+ set x {}
+ .t1 configure -width 300 -height 120
+ update
+ list $x [winfo geom .t1]
+ }
+} {{{configure .t1 300 120}} 300x120+0+0}
+test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ place .f1 -width 200 -height 200
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ after 300 {set x done}
+ vwait x
+ dobg {
+ bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
+ set x {}
+ .t1 configure -width 300 -height 120
+ update
+ list $x [winfo geom .t1]
+ }
+} {{{configure .t1 200 200}} 200x200+0+0}
+
+# Can't think up any tests for TkpGetOtherWindow procedure.
+
+test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ focus -force .
+ bind . <KeyPress> {lappend x {key %A %E}}
+ set x {}
+ set y [dobg {
+ update
+ bind .t1 <KeyPress> {lappend y {key %A}}
+ set y {}
+ event generate .t1 <KeyPress> -keysym a
+ set y
+ }]
+ update
+ bind . <KeyPress> {}
+ list $x $y
+} {{{key a 1}} {}}
+test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ focus -force .f1
+ update
+ bind . <KeyPress> {lappend x {key %A}}
+ set x {}
+ set y [dobg {
+ update
+ bind .t1 <KeyPress> {lappend y {key %A}}
+ set y {}
+ event generate .t1 <KeyPress> -keysym b
+ set y
+ }]
+ update
+ bind . <KeyPress> {}
+ list $x $y
+} {{} {{key b}}}
+
+test unixEmbed-8.1 {TkpClaimFocus procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -width 200 -height 50
+ pack .f1 .f2
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
+ }
+ focus -force .f2
+ update
+ list [dobg {
+ focus .t1
+ set x [list [focus]]
+ update
+ after 500
+ update
+ lappend x [focus]
+ }] [focus]
+} {{{} .t1} .f1}
+test unixEmbed-8.2 {TkpClaimFocus procedure} {
+ catch {interp delete child}
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -width 200 -height 50
+ pack .f1 .f2
+ interp create child
+ child eval "set argv {-use [winfo id .f1]}"
+ load {} tk child
+ child eval {
+ . configure -bd 2 -highlightthickness 2 -relief sunken
+ }
+ focus -force .f2
+ update
+ list [child eval {
+ focus .
+ set x [list [focus]]
+ update
+ lappend x [focus]
+ }] [focus]
+} {{{} .} .f1}
+catch {interp delete child}
+
+test unixEmbed-9.1 {EmbedWindowDeleted procedure, check parentPtr} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ frame .f3 -container 1 -width 200 -height 50
+ frame .f4 -container 1 -width 200 -height 50
+ pack .f1 .f2 .f3 .f4
+ set x {}
+ lappend x [testembed]
+ foreach w {.f3 .f4 .f1 .f2} {
+ destroy $w
+ lappend x [testembed]
+ }
+ set x
+} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}}
+test unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
+ set x {}
+ lappend x [testembed]
+ destroy .t1
+ lappend x [testembed]
+ }
+} {{{XXX {} {} .t1}} {}}
+
+test unixEmbed-10.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ toplevel .t1 -use [winfo id .f1] -width 150 -height 80
+ update
+ wm geometry .t1 +40+50
+ update
+ wm geometry .t1
+} {150x80+0+0}
+test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ toplevel .t1 -use [winfo id .f1] -width 150 -height 80
+ update
+ wm geometry .t1 70x300+10+20
+ update
+ wm geometry .t1
+} {70x300+0+0}
+
+
+foreach w [winfo child .] {
+ catch {destroy $w}
+}
+cleanupbg