path: root/tests/macEmbed.test

# This file is a Tcl script to test out the procedures in the file 
# tkMacEmbed.c.  It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: macEmbed.test,v 1.5 2001/03/28 17:27:10 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

eval destroy [winfo children .]
wm geometry . {}
raise .


test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} {
    catch {destroy .t}
    list [catch {toplevel .t -use xyz} msg] $msg
} {1 {expected integer but got "xyz"}}
test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {macOnly} {
    catch {destroy .t}
    list [catch {toplevel .t -use 47} msg] $msg
} {1 {The window ID 47 does not correspond to a valid Tk Window.}}

if {[string compare testembed [info commands testembed]] != 0} {
    puts "This application hasn't been compiled with the testembed command,"
    puts "therefore I am skipping all of these tests."
    ::tcltest::cleanupTests
    return
}

test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    set w [winfo id .f1]
	toplevel .t -use $w
	list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w]
} {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0}
test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} {
    eval destroy [winfo child .]
    frame .f1 -container 1 -width 200 -height 50
    frame .f2 -container 1 -width 200 -height 50
    pack .f1 .f2
    set w1 [winfo id .f1]
    set w2 [winfo id .f2]
	toplevel .t1 -use $w1
	toplevel .t2 -use $w2
	testembed
} {{XXX .f2 XXX .t2} {XXX .f1 XXX .t1}}

# Can't think of any way to test the procedures TkpMakeWindow,
# TkpMakeContainer, or EmbedErrorProc.

test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	testembed
    destroy .t1
    update
	testembed
} {}
test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} {
    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 macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} {
    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
    update
    list [testembed] [winfo children .]
} {{} {}}

test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
    set x [testembed]
	toplevel .t1 -use $w1
	wm withdraw .t1
    list $x [testembed]
} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
	{macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1 -bd 2 -relief raised
	update
	wm geometry .t1 +30+40
    update
	wm geometry .t1
} {200x200+0+0}
test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
	{macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	update
	wm geometry .t1 300x100+30+40
    update
	wm geometry .t1
} {300x100+0+0}
test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    toplevel .t1 -container 1 -width 200 -height 50
    set w1 [winfo id .t1]
	toplevel .t2 -use $w1
    update
	.t1 configure -width 300 -height 80
    update
    list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
} {300 80 300x80+0+0}
test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
	set x unmapped
	bind .t1 <Map> {set x mapped}
    update
	after 100
	update
	set x
} {mapped}
test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
    bind .f1 <Destroy> {set x dead}
    set x alive
	toplevel .t1 -use $w1
    update
	destroy .t1
    update
    list $x [winfo exists .f1]
} {dead 0}

test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
    update
	.t1 configure -width 180 -height 100
    update
	winfo geometry .t1
} {180x100+0+0}
test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1
    update
    set x [testembed]
    destroy .f1
    list $x [testembed]
} {{{XXX .f1 XXX .t1}} {}}

# Can't think up any tests for TkpGetOtherWindow procedure.

test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
    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 macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} {
    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 macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} {
    foreach w [winfo child .] {
	catch {destroy $w}
    }
    frame .f1 -container 1 -width 200 -height 50
    pack .f1
    set w1 [winfo id .f1]
	toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
	set x {}
	lappend x [testembed]
	destroy .t1
	update
	lappend x [testembed]
} {{{XXX .f1 XXX .t1}} {}}

test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
    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 macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
    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}
}

# cleanup
::tcltest::cleanupTests
return