util/src/TclTk/tk8.6.12/tests/unixButton.test

   1 # This file is a Tcl script to test the Unix specific behavior of
   2 # labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the
   3 # widgets defined in tkUnixButton.c).  It is organized in the standard
   4 # fashion for Tcl tests.
   5 #
   6 # Copyright (c) 1994 The Regents of the University of California.
   7 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
   8 # Copyright (c) 1998-1999 by Scriptics Corporation.
   9 # All rights reserved.
  10
  11 package require tcltest 2.2
  12 eval tcltest::configure $argv
  13 tcltest::loadTestedCommands
  14 namespace import -force tcltest::test
  15 imageInit
  16
  17 # Create entries in the option database to be sure that geometry options
  18 # like border width have predictable values.
  19
  20 option add *Label.borderWidth 2
  21 option add *Label.highlightThickness 0
  22 option add *Label.font {Helvetica -12 bold}
  23 option add *Button.borderWidth 2
  24 option add *Button.highlightThickness 2
  25 option add *Button.font {Helvetica -12 bold}
  26 option add *Checkbutton.borderWidth 2
  27 option add *Checkbutton.highlightThickness 2
  28 option add *Checkbutton.font {Helvetica -12 bold}
  29 option add *Radiobutton.borderWidth 2
  30 option add *Radiobutton.highlightThickness 2
  31 option add *Radiobutton.font {Helvetica -12 bold}
  32
  33
  34 proc bogusTrace args {
  35     error "trace aborted"
  36 }
  37
  38 if {[tk windowingsystem] eq "aqua"} {
  39     set smallIndicator 20
  40     set bigIndicator 20
  41     set defaultBorder 10
  42 } else {
  43     set smallIndicator 27
  44     set bigIndicator 40
  45     set defaultBorder 20
  46 }
  47 test unixbutton-1.1 {TkpComputeButtonGeometry procedure} -constraints {
  48     unix testImageType
  49 } -setup {
  50     deleteWindows
  51     imageCleanup
  52 } -body {
  53     image create test image1
  54     image1 changed 0 0 0 0 60 40
  55     label .b1 -image image1 -bd 4 -padx 0 -pady 2
  56     button .b2 -image image1 -bd 4 -padx 0 -pady 2
  57     checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1
  58     radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0
  59     pack .b1 .b2 .b3 .b4
  60     update
  61     list [winfo reqwidth .b1] [winfo reqheight .b1] \
  62         [winfo reqwidth .b2] [winfo reqheight .b2] \
  63         [winfo reqwidth .b3] [winfo reqheight .b3] \
  64         [winfo reqwidth .b4] [winfo reqheight .b4]
  65 } -cleanup {
  66     deleteWindows
  67     image delete image1
  68 } -result [list 68 48 \
  69                 74 54 \
  70                 [expr {72 + $bigIndicator}] 52 \
  71                 [expr {72 + $bigIndicator}] 52]
  72 test unixbutton-1.2 {TkpComputeButtonGeometry procedure} -constraints {
  73     unix
  74 } -setup {
  75     deleteWindows
  76 } -body {
  77     label .b1 -bitmap question -bd 3 -padx 0 -pady 2
  78     button .b2 -bitmap question -bd 3 -padx 0 -pady 2
  79     checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1
  80     radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0
  81     pack .b1 .b2 .b3 .b4
  82     update
  83     list [winfo reqwidth .b1] [winfo reqheight .b1] \
  84         [winfo reqwidth .b2] [winfo reqheight .b2] \
  85         [winfo reqwidth .b3] [winfo reqheight .b3] \
  86         [winfo reqwidth .b4] [winfo reqheight .b4]
  87 } -cleanup {
  88     deleteWindows
  89 } -result [list 23 33 \
  90                 29 39 \
  91                 [expr {27 + $smallIndicator}] 37 \
  92                 [expr {27 + $smallIndicator}] 37]
  93 test unixbutton-1.3 {TkpComputeButtonGeometry procedure} -constraints {
  94     unix
  95 } -setup {
  96     deleteWindows
  97 } -body {
  98     label .b1 -bitmap question -bd 3 -highlightthickness 4
  99     button .b2 -bitmap question -bd 3 -highlightthickness 0
 100     checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \
 101         -indicatoron 0
 102     radiobutton .b4 -bitmap question -bd 3 -highlightthickness 1 \
 103     -indicatoron false
 104     pack .b1 .b2 .b3 .b4
 105     update
 106     list [winfo reqwidth .b1] [winfo reqheight .b1] \
 107         [winfo reqwidth .b2] [winfo reqheight .b2] \
 108         [winfo reqwidth .b3] [winfo reqheight .b3] \
 109         [winfo reqwidth .b4] [winfo reqheight .b4]
 110 } -cleanup {
 111     deleteWindows
 112 } -result {31 41 25 35 25 35 25 35}
 113 test unixbutton-1.4 {TkpComputeButtonGeometry procedure} -constraints {
 114     unix nonPortable fonts
 115 } -setup {
 116     deleteWindows
 117 } -body {
 118     label .b1 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
 119     button .b2 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
 120     checkbutton .b3 -text Xagqpim -padx 1 -pady 1 -font {Helvetica -18 bold}
 121     radiobutton .b4 -text Xagqpim -padx 2 -pady 0 -font {Helvetica -18 bold}
 122     pack .b1 .b2 .b3 .b4
 123     update
 124     list [winfo reqwidth .b1] [winfo reqheight .b1] \
 125         [winfo reqwidth .b2] [winfo reqheight .b2] \
 126         [winfo reqwidth .b3] [winfo reqheight .b3] \
 127         [winfo reqwidth .b4] [winfo reqheight .b4]
 128 } -cleanup {
 129     deleteWindows
 130 } -result {82 29 88 35 114 31 121 29}
 131 test unixbutton-1.5 {TkpComputeButtonGeometry procedure} -constraints {
 132     unix nonPortable fonts
 133 } -setup {
 134     deleteWindows
 135 } -body {
 136     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
 137     pack .l1
 138     update
 139     list [winfo reqwidth .l1] [winfo reqheight .l1]
 140 } -cleanup {
 141     deleteWindows
 142 } -result {136 88}
 143 test unixbutton-1.6 {TkpComputeButtonGeometry procedure} -constraints {
 144     unix nonPortable fonts
 145 } -setup {
 146     deleteWindows
 147 } -body {
 148     label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
 149     pack .l1
 150     update
 151     list [winfo reqwidth .l1] [winfo reqheight .l1]
 152 } -cleanup {
 153     deleteWindows
 154 } -result {231 46}
 155 test unixbutton-1.7 {TkpComputeButtonGeometry procedure} -constraints {
 156     unix nonPortable fonts
 157 } -setup {
 158     deleteWindows
 159 } -body {
 160     label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
 161     button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
 162     checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2
 163     radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4
 164     pack .b1 .b2 .b3 .b4
 165     update
 166     list [winfo reqwidth .b1] [winfo reqheight .b1] \
 167         [winfo reqwidth .b2] [winfo reqheight .b2] \
 168         [winfo reqwidth .b3] [winfo reqheight .b3] \
 169         [winfo reqwidth .b4] [winfo reqheight .b4]
 170 } -cleanup {
 171     deleteWindows
 172 } -result {74 22 60 84 168 38 61 22}
 173 test unixbutton-1.8 {TkpComputeButtonGeometry procedure} -constraints {
 174     unix nonPortable fonts
 175 } -setup {
 176     deleteWindows
 177 } -body {
 178     label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
 179     -highlightthickness 4
 180     button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \
 181     -highlightthickness 0
 182     checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1  \
 183     -highlightthickness 1 -indicatoron no
 184     radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0
 185     pack .b1 .b2 .b3 .b4
 186     update
 187     list [winfo reqwidth .b1] [winfo reqheight .b1] \
 188         [winfo reqwidth .b2] [winfo reqheight .b2] \
 189         [winfo reqwidth .b3] [winfo reqheight .b3] \
 190         [winfo reqwidth .b4] [winfo reqheight .b4]
 191 } -cleanup {
 192     deleteWindows
 193 } -result {62 30 56 24 58 22 62 22}
 194 test unixbutton-1.9 {TkpComputeButtonGeometry procedure} -constraints {
 195     unix
 196 } -setup {
 197     deleteWindows
 198 } -body {
 199     button .b2 -bitmap question -default active
 200     list [winfo reqwidth .b2] [winfo reqheight .b2]
 201 } -cleanup {
 202     deleteWindows
 203 } -result [list [expr {17 + $defaultBorder}] [expr {27 + $defaultBorder}]]
 204 test unixbutton-1.10 {TkpComputeButtonGeometry procedure} -constraints {
 205     unix
 206 } -setup {
 207     deleteWindows
 208 } -body {
 209     button .b2 -bitmap question -default normal
 210     list [winfo reqwidth .b2] [winfo reqheight .b2]
 211 } -cleanup {
 212     deleteWindows
 213 } -result [list [expr {17 + $defaultBorder}] [expr {27 + $defaultBorder}]]
 214 test unixbutton-1.11 {TkpComputeButtonGeometry procedure} -constraints {
 215     unix
 216 } -setup {
 217     deleteWindows
 218 } -body {
 219     button .b2 -bitmap question -default disabled
 220     list [winfo reqwidth .b2] [winfo reqheight .b2]
 221 } -cleanup {
 222     deleteWindows
 223 } -result {27 37}
 224
 225
 226 test unixbutton-2.1 {disabled coloring check, bug 669595} -constraints {
 227     unix
 228 } -setup {
 229     deleteWindows
 230     catch {unset value}
 231 } -body {
 232     # this was just a visual bug, but at least this shows the visual
 233     set on 1
 234     set off 0
 235     label .l -text "The following widgets should\
 236         \nshow significant visible diffs\
 237         \nfor selected vs unselected."
 238     checkbutton .cb0 -anchor w -state disabled \
 239         -text Unselected -variable off
 240     checkbutton .cb1 -anchor w -state disabled \
 241         -text Selected -variable on
 242     checkbutton .cb2 -anchor w -state disabled \
 243         -text Unselected -variable off -disabledforeground ""
 244     checkbutton .cb3 -anchor w -state disabled \
 245         -text Selected -variable on -disabledforeground ""
 246     radiobutton .rb0 -anchor w -state disabled \
 247         -text Unselected -variable off
 248     radiobutton .rb1 -anchor w -state disabled \
 249         -text Selected -variable on -value 1
 250     radiobutton .rb2 -anchor w -state disabled \
 251         -text Unselected -variable off -disabledforeground ""
 252     radiobutton .rb3 -anchor w -state disabled \
 253         -text Selected -variable on -value 1 -disabledforeground ""
 254     pack .l .cb0 .cb1 .cb2 .cb3 .rb0 .rb1 .rb2 .rb3 -side top -fill x
 255     after 400
 256     set on
 257 } -cleanup {
 258     deleteWindows
 259 } -result 1
 260
 261
 262 # cleanup
 263 imageFinish
 264 cleanupTests
 265 return
 266
 267 # Local variables:
 268 # mode: tcl
 269 # End: