Initial revision

1 files changed, 182 insertions, 0 deletions

diff --git a/tests/unixButton.test b/tests/unixButton.test
new file mode 100644
index 0000000..a4c67d5
--- /dev/null
+++ b/tests/unixButton.test
@@ -0,0 +1,182 @@
+# 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 (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) unixButton.test 1.6 97/07/01 18:11:30
+
+if {$tcl_platform(platform)!="unix"} {
+    return
+}
+
+if {[lsearch [image types] test] < 0} {
+    puts "This application hasn't been compiled with the \"test\""
+    puts "image, so I can't run this test.  Are you sure you're using"
+    puts "tktest instead of wish?"
+    return
+}
+
+if {[info procs test] != "test"} {
+    source defs
+}
+
+foreach i [winfo children .] {
+    destroy $i
+}
+wm geometry . {}
+raise .
+
+# 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"
+}
+catch {unset value}
+catch {unset value2}
+
+eval image delete [image names]
+image create test image1
+label .l -text Label
+button .b -text Button
+checkbutton .c -text Checkbutton
+radiobutton .r -text Radiobutton
+pack .l .b .c .r
+update
+
+test unixbutton-1.1 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    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]
+} {68 48 74 54 112 52 112 52}
+test unixbutton-1.2 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    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]
+} {23 33 29 39 54 37 54 37}
+test unixbutton-1.3 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    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]
+} {31 41 25 35 25 35 25 35}
+test unixbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+    eval destroy [winfo children .]
+    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]
+} {82 29 88 35 114 31 121 29}
+test unixbutton-1.5 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+    eval destroy [winfo children .]
+    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]
+} {136 88}
+test unixbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+    eval destroy [winfo children .]
+    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]
+} {231 46}
+test unixbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+    eval destroy [winfo children .]
+    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]
+} {74 22 60 84 168 38 61 22}
+test unixbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+    eval destroy [winfo children .]
+    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]
+} {62 30 56 24 58 22 62 22}
+test unixbutton-1.9 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    button .b2 -bitmap question -default active
+    list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {37 47}
+test unixbutton-1.10 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    button .b2 -bitmap question -default normal
+    list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {37 47}
+test unixbutton-1.11 {TkpComputeButtonGeometry procedure} {
+    eval destroy [winfo children .]
+    button .b2 -bitmap question -default disabled
+    list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {27 37}
+
+eval destroy [winfo children .]