1# This file is a Tcl script to test the Windows specific behavior of 2# labels, buttons, checkbuttons, and radiobuttons in Tk (i.e., all the 3# widgets defined in tkWinButton.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# RCS: @(#) $Id: winButton.test,v 1.9 2002/10/08 20:21:23 hobbs Exp $ 12 13package require tcltest 2.1 14namespace import -force tcltest::configure 15namespace import -force tcltest::testsDirectory 16configure -testdir [file join [pwd] [file dirname [info script]]] 17configure -loadfile [file join [testsDirectory] constraints.tcl] 18tcltest::loadTestedCommands 19 20proc bogusTrace args { 21 error "trace aborted" 22} 23catch {unset value} 24catch {unset value2} 25option clear 26eval image delete [image names] 27if {[testConstraint testImageType]} { 28 image create test image1 29} 30label .l -text Label 31button .b -text Button 32checkbutton .c -text Checkbutton 33radiobutton .r -text Radiobutton 34pack .l .b .c .r 35update 36 37test winbutton-1.1 {TkpComputeButtonGeometry procedure} {testImageType pcOnly} { 38 deleteWindows 39 image create test image1 40 image1 changed 0 0 0 0 60 40 41 label .b1 -image image1 -bd 4 -padx 0 -pady 2 42 button .b2 -image image1 -bd 4 -padx 0 -pady 2 43 checkbutton .b3 -image image1 -bd 4 -padx 1 -pady 1 44 radiobutton .b4 -image image1 -bd 4 -padx 2 -pady 0 45 pack .b1 .b2 .b3 .b4 46 update 47 # with patch 463234 with native L&F enabled, this returns: 48 # {68 48 70 50 88 50 88 50} 49 list [winfo reqwidth .b1] [winfo reqheight .b1] \ 50 [winfo reqwidth .b2] [winfo reqheight .b2] \ 51 [winfo reqwidth .b3] [winfo reqheight .b3] \ 52 [winfo reqwidth .b4] [winfo reqheight .b4] 53} {68 48 70 50 90 52 90 52} 54test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} { 55 deleteWindows 56 label .b1 -bitmap question -bd 3 -padx 0 -pady 2 57 button .b2 -bitmap question -bd 3 -padx 0 -pady 2 58 checkbutton .b3 -bitmap question -bd 3 -padx 1 -pady 1 59 radiobutton .b4 -bitmap question -bd 3 -padx 2 -pady 0 60 pack .b1 .b2 .b3 .b4 61 update 62 # with patch 463234 with native L&F enabled, this returns: 63 # {23 33 25 35 43 35 43 35} 64 list [winfo reqwidth .b1] [winfo reqheight .b1] \ 65 [winfo reqwidth .b2] [winfo reqheight .b2] \ 66 [winfo reqwidth .b3] [winfo reqheight .b3] \ 67 [winfo reqwidth .b4] [winfo reqheight .b4] 68} {23 33 25 35 45 37 45 37} 69test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} { 70 deleteWindows 71 label .b1 -bitmap question -bd 3 -highlightthickness 4 72 button .b2 -bitmap question -bd 3 -highlightthickness 0 73 checkbutton .b3 -bitmap question -bd 3 -highlightthickness 1 \ 74 -indicatoron 0 75 radiobutton .b4 -bitmap question -bd 3 -indicatoron false 76 pack .b1 .b2 .b3 .b4 77 update 78 # with patch 463234 with native L&F enabled, this returns: 79 # {31 41 23 33 25 35 25 35} 80 list [winfo reqwidth .b1] [winfo reqheight .b1] \ 81 [winfo reqwidth .b2] [winfo reqheight .b2] \ 82 [winfo reqwidth .b3] [winfo reqheight .b3] \ 83 [winfo reqwidth .b4] [winfo reqheight .b4] 84} {31 41 23 33 27 37 27 37} 85test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { 86 deleteWindows 87 label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} 88 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8} 89 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -font {{MS Sans Serif} 8} 90 radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -font {{MS Sans Serif} 8} 91 pack .b1 .b2 .b3 .b4 92 update 93 list [winfo reqwidth .b1] [winfo reqheight .b1] \ 94 [winfo reqwidth .b2] [winfo reqheight .b2] \ 95 [winfo reqwidth .b3] [winfo reqheight .b3] \ 96 [winfo reqwidth .b4] [winfo reqheight .b4] 97} {58 24 67 33 88 30 90 28} 98test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { 99 deleteWindows 100 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 101 pack .l1 102 update 103 list [winfo reqwidth .l1] [winfo reqheight .l1] 104} {178 84} 105test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { 106 deleteWindows 107 label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0 108 pack .l1 109 update 110 list [winfo reqwidth .l1] [winfo reqheight .l1] 111} {222 52} 112test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { 113 deleteWindows 114 label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10 115 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5 116 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 -width 20 -height 2 117 radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -width 4 118 pack .b1 .b2 .b3 .b4 119 update 120 list [winfo reqwidth .b1] [winfo reqheight .b1] \ 121 [winfo reqwidth .b2] [winfo reqheight .b2] \ 122 [winfo reqwidth .b3] [winfo reqheight .b3] \ 123 [winfo reqwidth .b4] [winfo reqheight .b4] 124} {74 24 67 97 174 46 64 28} 125test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} { 126 deleteWindows 127 label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \ 128 -highlightthickness 4 129 button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 \ 130 -highlightthickness 0 131 checkbutton .b3 -text Xagqpim -bd 2 -padx 1 -pady 1 \ 132 -highlightthickness 1 -indicatoron no 133 radiobutton .b4 -text Xagqpim -bd 2 -padx 2 -pady 0 -indicatoron 0 134 pack .b1 .b2 .b3 .b4 135 update 136 list [winfo reqwidth .b1] [winfo reqheight .b1] \ 137 [winfo reqwidth .b2] [winfo reqheight .b2] \ 138 [winfo reqwidth .b3] [winfo reqheight .b3] \ 139 [winfo reqwidth .b4] [winfo reqheight .b4] 140} {66 32 65 31 69 31 71 29} 141test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} { 142 deleteWindows 143 button .b2 -bitmap question -default normal 144 list [winfo reqwidth .b2] [winfo reqheight .b2] 145} {23 33} 146 147# cleanup 148deleteWindows 149::tcltest::cleanupTests 150return 151