# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
# itcl.test --
#
# This file tests interaction between Tix and [incr tcl]/[incr tk].
# It is organized in the standard fashion for Tcl
# tests.
#
# Copyright (c) 2000-2001 Tix Project Group.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: itcl.test,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
package require Tix
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
}
if {[catch {package require Itcl} msg] || [catch {package require Itk} msg]} {
puts "itcl/itk not installed on your system: $msg"
puts "tests in [info script] skipped"
::tcltest::cleanupTests
return
}
test itcl-1.1 {variable scope} {
# Tests:
# - Creating a tix widget inside the scope of an itcl method
# - Sharing global variable with itcl
itcl::class ::foo {
inherit itk::Widget
constructor {args} {
itk_component add lab {
label $itk_interior.lab \
-textvariable ::choice($this)
}
itk_component add tixwidget {
tixOptionMenu $itk_interior.tixwidget \
-label "File format" \
-variable ::choice($this) \
-command "$this foocmd"
}
foreach cmd {HTML PostScript ASCII} {
$itk_component(tixwidget) add command $cmd
}
pack $itk_component(lab) $itk_component(tixwidget) \
-anchor e \
-padx 10 \
-pady 10 \
-fill x
eval itk_initialize $args
}
common choice
method foocmd {args} {
#puts $args
}
method set_format {format} {
set ::choice($this) $format
}
}
itk::usual TixOptionMenu {
}
foo .xy
pack .xy
.xy set_format ASCII
lappend list $choice(::.xy)
.xy component tixwidget config -value PostScript
lappend list $choice(::.xy)
.xy component tixwidget config -value HTML
lappend list $choice(::.xy)
set list
} {ASCII PostScript HTML}
# cleanup
::tcltest::cleanupTests
return