1# This file creates a visual test for button layout.  It is part of
2# the Tk visual test suite, which is invoked via the "visual" script.
3#
4# RCS: @(#) $Id: butGeom2.tcl,v 1.3 1999/04/16 01:51:34 stanton Exp $
5
6catch {destroy .t}
7toplevel .t
8wm title .t "Visual Tests for Button Geometry"
9wm iconname .t "Button Geometry"
10wm geom .t +0+0
11wm minsize .t 1 1
12
13label .t.l -text {This screen exercises the color options for various flavors of buttons.  Select display options below, and they will be applied to the appropiate button widgets.} -wraplength 5i
14pack .t.l -side top -fill both
15
16button .t.quit -text Quit -command {destroy .t}
17pack .t.quit -side bottom -pady 2m
18
19set sepId 1
20proc sep {} {
21    global sepId
22    frame .t.sep$sepId -height 2 -bd 1 -relief sunken
23    pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x
24    incr sepId
25}
26
27# Create buttons that control configuration options.
28
29frame .t.control
30pack .t.control -side top -fill x -pady 3m
31frame .t.control.left
32frame .t.control.right
33pack .t.control.left .t.control.right -side left -expand 1 -fill x
34label .t.anchorLabel -text "Color:"
35frame .t.control.left.f -width 6c -height 3c
36pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w
37foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } {
38    #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]"
39    menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \
40        -relief raised -bd 2
41    menu .t.color-$opt.m -tearoff 0
42    .t.color-$opt.m add command -label Red -command "config -$opt red"
43    .t.color-$opt.m add command -label Green -command "config -$opt green"
44    .t.color-$opt.m add command -label Blue -command "config -$opt blue"
45    .t.color-$opt.m add command -label Other... \
46          -command "config -$opt \[tk_chooseColor]"
47    pack .t.color-$opt -in .t.control.left.f -fill x
48}
49
50set default disabled
51label .t.default -text Default:
52radiobutton .t.default-normal -text "Default normal" -relief flat \
53	-command "config-but -default normal" -variable default \
54	-value normal
55radiobutton .t.default-active -text "Default active" -relief flat \
56	-command "config-but -default active" -variable default \
57	-value active
58radiobutton .t.default-disabled -text "Default disabled" -relief flat \
59	-command "config-but -default disabled" -variable default \
60	-value disabled
61pack .t.default .t.default-normal .t.default-active .t.default-disabled \
62	-in .t.control.right -anchor w
63
64sep
65frame .t.f1
66pack .t.f1 -side top -expand 1 -fill both
67sep
68frame .t.f2
69pack .t.f2 -side top -expand 1 -fill both
70sep
71frame .t.f3
72pack .t.f3 -side top -expand 1 -fill both
73sep
74frame .t.f4
75pack .t.f4 -side top -expand 1 -fill both
76sep
77
78label .t.l1 -text Label -bd 2 -relief sunken
79label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken
80label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50
81pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \
82	-expand y -fill both
83
84button .t.b1 -text Button
85button .t.b2 -text "Explicit\nnewlines\n\nin the text"
86button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50
87pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \
88	-expand y -fill both
89
90checkbutton .t.c1 -text Checkbutton -variable a
91checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b
92checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50
93pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \
94	-expand y -fill both
95
96radiobutton .t.r1 -text Radiobutton -value a
97radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b
98radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50
99pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \
100	-expand y -fill both
101
102proc config {option value} {
103    foreach w {.t.l1 .t.l2 .t.l3 .t.b1 .t.b2 .t.b3 .t.c1 .t.c2 .t.c3
104	    .t.r1 .t.r2 .t.r3} {
105	catch {$w configure $option $value}
106    }
107}
108
109proc config-but {option value} {
110    foreach w {.t.b1 .t.b2 .t.b3} {
111	$w configure $option $value
112    }
113}
114
115
116
117
118
119
120
121
122
123
124
125
126
127