1# This file is a Tcl script to test out the procedures in the file 2# tkMacEmbed.c. It is organized in the standard fashion for Tcl 3# tests. 4# 5# Copyright (c) 1997 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# All rights reserved. 8# 9# RCS: @(#) $Id: macEmbed.test,v 1.8 2002/07/14 05:48:46 dgp Exp $ 10 11package require tcltest 2.1 12namespace import -force tcltest::configure 13namespace import -force tcltest::testsDirectory 14configure -testdir [file join [pwd] [file dirname [info script]]] 15configure -loadfile [file join [testsDirectory] constraints.tcl] 16tcltest::loadTestedCommands 17 18test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} { 19 catch {destroy .t} 20 list [catch {toplevel .t -use xyz} msg] $msg 21} {1 {expected integer but got "xyz"}} 22test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} { 23 catch {destroy .t} 24 list [catch {toplevel .t -use 47} msg] $msg 25} {1 {The window ID 47 does not correspond to a valid Tk Window.}} 26 27test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {testembed macOnly} { 28 deleteWindows 29 frame .f1 -container 1 -width 200 -height 50 30 frame .f2 -container 1 -width 200 -height 50 31 pack .f1 .f2 32 set w [winfo id .f1] 33 toplevel .t -use $w 34 list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w] 35} {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0} 36test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {testembed macOnly} { 37 deleteWindows 38 frame .f1 -container 1 -width 200 -height 50 39 frame .f2 -container 1 -width 200 -height 50 40 pack .f1 .f2 41 set w1 [winfo id .f1] 42 set w2 [winfo id .f2] 43 toplevel .t1 -use $w1 44 toplevel .t2 -use $w2 45 testembed 46} {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}} 47 48# Can't think of any way to test the procedures TkpMakeWindow, 49# TkpMakeContainer, or EmbedErrorProc. 50 51test macEmbed-2.1 {EmbeddedEventProc procedure} {testembed macOnly} { 52 deleteWindows 53 frame .f1 -container 1 -width 200 -height 50 54 pack .f1 55 set w1 [winfo id .f1] 56 toplevel .t1 -use $w1 57 testembed 58 destroy .t1 59 update 60 testembed 61} {} 62test macEmbed-2.2 {EmbeddedEventProc procedure} {testembed macOnly} { 63 deleteWindows 64 frame .f1 -container 1 -width 200 -height 50 65 pack .f1 66 toplevel .t1 -use [winfo id .f1] 67 update 68 destroy .f1 69 testembed 70} {} 71test macEmbed-2.3 {EmbeddedEventProc procedure} {testembed macOnly} { 72 deleteWindows 73 frame .f1 -container 1 -width 200 -height 50 74 pack .f1 75 toplevel .t1 -use [winfo id .f1] 76 update 77 destroy .t1 78 update 79 list [testembed] [winfo children .] 80} {{} {}} 81 82test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {testembed macOnly} { 83 deleteWindows 84 frame .f1 -container 1 -width 200 -height 50 85 pack .f1 86 set w1 [winfo id .f1] 87 set x [testembed] 88 toplevel .t1 -use $w1 89 wm withdraw .t1 90 list $x [testembed] 91} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}} 92test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \ 93 {macOnly} { 94 deleteWindows 95 frame .f1 -container 1 -width 200 -height 50 96 pack .f1 97 set w1 [winfo id .f1] 98 toplevel .t1 -use $w1 -bd 2 -relief raised 99 update 100 wm geometry .t1 +30+40 101 update 102 wm geometry .t1 103} {200x200+0+0} 104test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \ 105 {macOnly} { 106 deleteWindows 107 frame .f1 -container 1 -width 200 -height 50 108 pack .f1 109 set w1 [winfo id .f1] 110 toplevel .t1 -use $w1 111 update 112 wm geometry .t1 300x100+30+40 113 update 114 wm geometry .t1 115} {300x100+0+0} 116test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} { 117 deleteWindows 118 toplevel .t1 -container 1 -width 200 -height 50 119 set w1 [winfo id .t1] 120 toplevel .t2 -use $w1 121 update 122 .t1 configure -width 300 -height 80 123 update 124 list [winfo width .t1] [winfo height .t1] [wm geometry .t2] 125} {300 80 300x80+0+0} 126test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} { 127 deleteWindows 128 frame .f1 -container 1 -width 200 -height 50 129 pack .f1 130 set w1 [winfo id .f1] 131 toplevel .t1 -use $w1 132 set x unmapped 133 bind .t1 <Map> {set x mapped} 134 update 135 after 100 136 update 137 set x 138} {mapped} 139test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} { 140 deleteWindows 141 frame .f1 -container 1 -width 200 -height 50 142 pack .f1 143 set w1 [winfo id .f1] 144 bind .f1 <Destroy> {set x dead} 145 set x alive 146 toplevel .t1 -use $w1 147 update 148 destroy .t1 149 update 150 list $x [winfo exists .f1] 151} {dead 0} 152 153test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} { 154 deleteWindows 155 frame .f1 -container 1 -width 200 -height 50 156 pack .f1 157 set w1 [winfo id .f1] 158 toplevel .t1 -use $w1 159 update 160 .t1 configure -width 180 -height 100 161 update 162 winfo geometry .t1 163} {180x100+0+0} 164test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {testembed macOnly} { 165 deleteWindows 166 frame .f1 -container 1 -width 200 -height 50 167 pack .f1 168 set w1 [winfo id .f1] 169 toplevel .t1 -use $w1 170 update 171 set x [testembed] 172 destroy .f1 173 list $x [testembed] 174} {{{XXX .f1 XXX .t1}} {}} 175 176# Can't think up any tests for TkpGetOtherWindow procedure. 177 178test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} { 179 catch {interp delete child} 180 deleteWindows 181 frame .f1 -container 1 -width 200 -height 50 182 frame .f2 -width 200 -height 50 183 pack .f1 .f2 184 interp create child 185 child eval "set argv {-use [winfo id .f1]}" 186 load {} Tk child 187 child eval { 188 . configure -bd 2 -highlightthickness 2 -relief sunken 189 } 190 focus -force .f2 191 update 192 list [child eval { 193 focus . 194 set x [list [focus]] 195 update 196 lappend x [focus] 197 }] [focus] 198} {{{} .} .f1} 199catch {interp delete child} 200 201test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {testembed macOnly} { 202 deleteWindows 203 frame .f1 -container 1 -width 200 -height 50 204 frame .f2 -container 1 -width 200 -height 50 205 frame .f3 -container 1 -width 200 -height 50 206 frame .f4 -container 1 -width 200 -height 50 207 pack .f1 .f2 .f3 .f4 208 set x {} 209 lappend x [testembed] 210 foreach w {.f3 .f4 .f1 .f2} { 211 destroy $w 212 lappend x [testembed] 213 } 214 set x 215} {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}} 216test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {testembed macOnly} { 217 deleteWindows 218 frame .f1 -container 1 -width 200 -height 50 219 pack .f1 220 set w1 [winfo id .f1] 221 toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken 222 set x {} 223 lappend x [testembed] 224 destroy .t1 225 update 226 lappend x [testembed] 227} {{{XXX .f1 XXX .t1}} {}} 228 229test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} { 230 deleteWindows 231 frame .f1 -container 1 -width 200 -height 50 232 pack .f1 233 toplevel .t1 -use [winfo id .f1] -width 150 -height 80 234 update 235 wm geometry .t1 +40+50 236 update 237 wm geometry .t1 238} {150x80+0+0} 239test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} { 240 deleteWindows 241 frame .f1 -container 1 -width 200 -height 50 242 pack .f1 243 toplevel .t1 -use [winfo id .f1] -width 150 -height 80 244 update 245 wm geometry .t1 70x300+10+20 246 update 247 wm geometry .t1 248} {70x300+0+0} 249 250 251 252deleteWindows 253 254# cleanup 255::tcltest::cleanupTests 256return 257 258 259 260 261 262 263 264 265 266 267 268 269 270