92 lines
2.1 KiB
Tcl
92 lines
2.1 KiB
Tcl
# -*- 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
|
|
|