# This file is a Tcl script to test the Unix specific behavior of
# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
# widgets defined in tkUnixButton.c). It is organized in the standard
# fashion for Tcl tests.
#
# Copyright © 1994 The Regents of the University of California.
# Copyright © 1994-1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test
imageInit
# Create entries in the option database to be sure that geometry options
# like border width have predictable values.
option add *Label.borderWidth 2
option add *Label.highlightThickness 0
option add *Label.font {Helvetica -12 bold}
option add *Button.borderWidth 2
option add *Button.highlightThickness 2
option add *Button.font {Helvetica -12 bold}
option add *Checkbutton.borderWidth 2
option add *Checkbutton.highlightThickness 2
option add *Checkbutton.font {Helvetica -12 bold}
option add *Radiobutton.borderWidth 2
option add *Radiobutton.highlightThickness 2
option add *Radiobutton.font {Helvetica -12 bold}
proc bogusTrace args {
error "trace aborted"
}
if {[tk windowingsystem] eq "aqua"} {
set smallIndicator 20
set bigIndicator 20
set defaultBorder 10
} else {
set smallIndicator 27
set bigIndicator 40
set defaultBorder 20
}
test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints {
unix testImageType
} -setup {
deleteWindows
imageCleanup
} -body {
image create test image1
image1 changed 0 0 0 0 60 40
label .b1 -image image1 -bd 4 -padx 0 -pady 2
button .b2 -image image1 -bd 4 -padx 0 -pady 2
checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1
radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0
pack .b1 .b2 .b3 .b4
update
list [winfo reqwidth .b1] [winfo reqheight .b1] \
[winfo reqwidth .b2] [winfo reqheight .b2] \
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
image delete image1
} -result [list 68 48 \
74 54 \
[expr {72 + $bigIndicator}] 52 \
[expr {72 + $bigIndicator}] 52]
test unixbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
deleteWindows
} -body {
label .b1 -bitmap question -bd 3 -padx 0 -pady 2
button .b2 -bitmap question -bd 3 -padx 0 -pady 2
checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0
pack .b1 .b2 .b3 .b4
update
list [winfo reqwidth .b1] [winfo reqheight .b1] \
[winfo reqwidth .b2] [winfo reqheight .b2] \
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
} -result [list 23 33 \
29 39 \
[expr {27 + $smallIndicator}] 37 \
[expr {27 + $smallIndicator}] 37]
test unixbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
deleteWindows
} -body {
label .b1 -bitmap question -bd 3 -highlightthickness 4
button .b2 -bitmap question -bd 3 -highlightthickness 0
checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
-indicatoron 0
radiobutton .b4 -bitmap question -bd 3 -highlightthickness 1 \
-indicatoron false
pack .b1 .b2 .b3 .b4
update
list [winfo reqwidth .b1] [winfo reqheight .b1] \
[winfo reqwidth .b2] [winfo reqheight .b2] \
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
} -result {31 41 25 35 25 35 25 35}
test unixbutton-1.4 {TkpComputeButtonGeometry procedure} -constraints {
unix nonPortable fonts
} -setup {
deleteWindows
} -body {
label .b1 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
button .b2 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
checkbutton .b3 -text Xagqpim -padx 1 -pady 1 -font {Helvetica -18 bold}
radiobutton .b4 -text Xagqpim -padx 2 -pady 0 -font {Helvetica -18 bold}
pack .b1 .b2 .b3 .b4
update
list [winfo reqwidth .b1] [winfo reqheight .b1] \
[winfo reqwidth .b2] [winfo reqheight .b2] \
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
} -result {82 29 88 35 114 31 121 29}
test unixbutton-1.5 {TkpComputeButtonGeometry procedure} -constraints {
unix nonPortable fonts
} -setup {
deleteWindows
} -body {
label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
pack .l1
update
list [winfo reqwidth .l1] [winfo reqheight .l1]
} -cleanup {
deleteWindows
} -result {136 88}
test unixbutton-1.6 {TkpComputeButtonGeometry procedure} -constraints {
unix nonPortable fonts
} -setup {
deleteWindows
} -body {
label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
pack .l1
update
list [winfo reqwidth .l1] [winfo reqheight .l1]
} -cleanup {
deleteWindows
} -result {231 46}
test unixbutton-1.7 {TkpComputeButtonGeometry procedure} -constraints {
unix nonPortable fonts
} -setup {
deleteWindows
} -body {
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4
pack .b1 .b2 .b3 .b4
update
list [winfo reqwidth .b1] [winfo reqheight .b1] \
[winfo reqwidth .b2] [winfo reqheight .b2] \
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
} -result {74 22 60 84 168 38 61 22}
test unixbutton-1.8 {TkpComputeButtonGeometry procedure} -constraints {
unix nonPortable fonts
} -setup {
deleteWindows
} -body {
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
-highlightthickness 4
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
-highlightthickness 0
checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \
-highlightthickness 1 -indicatoron no
radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0
pack .b1 .b2 .b3 .b4
update
list [winfo reqwidth .b1] [winfo reqheight .b1] \
[winfo reqwidth .b2] [winfo reqheight .b2] \
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} -cleanup {
deleteWindows
} -result {62 30 56 24 58 22 62 22}
test unixbutton-1.9 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
deleteWindows
} -body {
button .b2 -bitmap question -default active
list [winfo reqwidth .b2] [winfo reqheight .b2]
} -cleanup {
deleteWindows
} -result [list [expr {17 + $defaultBorder}] [expr {27 + $defaultBorder}]]
test unixbutton-1.10 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
deleteWindows
} -body {
button .b2 -bitmap question -default normal
list [winfo reqwidth .b2] [winfo reqheight .b2]
} -cleanup {
deleteWindows
} -result [list [expr {17 + $defaultBorder}] [expr {27 + $defaultBorder}]]
test unixbutton-1.11 {TkpComputeButtonGeometry procedure} -constraints {
unix
} -setup {
deleteWindows
} -body {
button .b2 -bitmap question -default disabled
list [winfo reqwidth .b2] [winfo reqheight .b2]
} -cleanup {
deleteWindows
} -result {27 37}
test unixbutton-2.1 {disabled coloring check, bug 669595} -constraints {
unix
} -setup {
deleteWindows
catch {unset value}
} -body {
# this was just a visual bug, but at least this shows the visual
set on 1
set off 0
label .l -text "The following widgets should\
\nshow significant visible diffs\
\nfor selected vs unselected."
checkbutton .cb0 -anchor w -state disabled \
-text Unselected -variable off
checkbutton .cb1 -anchor w -state disabled \
-text Selected -variable on
checkbutton .cb2 -anchor w -state disabled \
-text Unselected -variable off -disabledforeground ""
checkbutton .cb3 -anchor w -state disabled \
-text Selected -variable on -disabledforeground ""
radiobutton .rb0 -anchor w -state disabled \
-text Unselected -variable off
radiobutton .rb1 -anchor w -state disabled \
-text Selected -variable on -value 1
radiobutton .rb2 -anchor w -state disabled \
-text Unselected -variable off -disabledforeground ""
radiobutton .rb3 -anchor w -state disabled \
-text Selected -variable on -value 1 -disabledforeground ""
pack .l .cb0 .cb1 .cb2 .cb3 .rb0 .rb1 .rb2 .rb3 -side top -fill x
after 400
set on
} -cleanup {
deleteWindows
} -result 1
# cleanup
imageFinish
cleanupTests
return
# Local variables:
# mode: tcl
# End:
