tix/tests/itcl/scope1.tcl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

proc About {} {
    return "Testing creation of Tix widgets inside ITCL classes"
}

proc Test {} {
    class foo {
        inherit itk::Widget

        constructor {args} {
	    itk_component add lab {
		label $itk_interior.lab \
		    -textvariable [code choice($this)]
	    }

	    itk_component add le {
		tixOptionMenu $itk_interior.le \
		    -label "File format" \
		    -variable [code choice($this)] \
		    -command "$this foocmd"
	    }

	    foreach cmd {HTML PostScript ASCII} {
		$itk_component(le) add command $cmd
	    }

	    pack $itk_component(lab) $itk_component(le) \
		-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
        }
    }
    usual TixOptionMenu {
    }

    foo .xy
    pack .xy
    .xy set_format ASCII
    update
    .xy component le config -value  PostScript
    update
    .xy component le config -value  HTML
}