summaryrefslogtreecommitdiffstats
path: root/generic/tkPointer.c
Commit message (Expand)AuthorAgeFilesLines
* * Merged 8.1 branch into the main trunkstanton1999-04-161-74/+94
* integrated stubs into 8.0 main branchstanton1999-03-101-1/+5
* Replaced SCCS strings, fixed binary filesstanton1998-09-141-1/+1
* Initial revisionrjohnson1998-04-011-0/+623
generated by cgit v0.12 at 2024-09-20 12:25:01 (GMT)
51.6%;'/> -rw-r--r--tests/bitmap.test15
-rw-r--r--tests/border.test15
-rw-r--r--tests/button.test52
-rw-r--r--tests/canvImg.test62
-rw-r--r--tests/canvPs.test15
-rw-r--r--tests/canvRect.test46
-rw-r--r--tests/canvText.test31
-rw-r--r--tests/canvWind.test15
-rw-r--r--tests/canvas.test45
-rw-r--r--tests/choosedir.test4
-rw-r--r--tests/clipboard.test15
-rw-r--r--tests/clrpick.test16
-rw-r--r--tests/cmds.test15
-rw-r--r--tests/cursor.test228
-rw-r--r--tests/entry.test16
-rw-r--r--tests/filebox.test227
-rw-r--r--tests/focus.test15
-rw-r--r--tests/focusTcl.test15
-rw-r--r--tests/font.test155
-rw-r--r--tests/frame.test349
-rw-r--r--tests/geometry.test15
-rw-r--r--tests/get.test15
-rw-r--r--tests/id.test15
-rw-r--r--tests/imgBmap.test15
-rw-r--r--tests/imgPPM.test15
-rw-r--r--tests/imgPhoto.test4
-rw-r--r--tests/main.test15
-rw-r--r--tests/menu.test16
-rw-r--r--tests/menuDraw.test15
-rw-r--r--tests/menubut.test15
-rw-r--r--tests/msgbox.test34
-rw-r--r--tests/obj.test16
-rw-r--r--tests/oldpack.test15
-rw-r--r--tests/option.test21
-rw-r--r--tests/panedwindow.test6
-rw-r--r--tests/raise.test15
-rw-r--r--tests/scale.test4
-rw-r--r--tests/scrollbar.test17
-rw-r--r--tests/select.test64
-rw-r--r--tests/textBTree.test15
-rw-r--r--tests/textDisp.test14
-rw-r--r--tests/textImage.test15
-rw-r--r--tests/textIndex.test15
-rw-r--r--tests/textMark.test15
-rw-r--r--tests/textTag.test15
-rw-r--r--tests/textWind.test27
-rw-r--r--tests/unixEmbed.test15
-rw-r--r--tests/unixFont.test15
-rw-r--r--tests/util.test15
-rw-r--r--tests/visual.test258
-rw-r--r--tests/winMenu.test14
-rw-r--r--tests/winSend.test48
-rw-r--r--tests/window.test14
-rw-r--r--tests/wm.test5
-rw-r--r--tests/xmfbox.test14
58 files changed, 1147 insertions, 1657 deletions
diff --git a/tests/bell.test b/tests/bell.test
index 59bfca6..455eb76 100644
--- a/tests/bell.test
+++ b/tests/bell.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-2000 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: bell.test,v 1.7 2003/04/01 21:06:15 dgp Exp $
+# RCS: @(#) $Id: bell.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -46,16 +46,3 @@ test bell-1.8 {bell command} {
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/bgerror.test b/tests/bgerror.test
index e104980..7d35862 100644
--- a/tests/bgerror.test
+++ b/tests/bgerror.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: bgerror.test,v 1.5 2003/04/01 21:06:15 dgp Exp $
+# RCS: @(#) $Id: bgerror.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -58,16 +58,3 @@ catch {rename tkerror {}}
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/bind.test b/tests/bind.test
index 9ecee81..9117204 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: bind.test,v 1.12 2003/04/01 21:06:16 dgp Exp $
+# RCS: @(#) $Id: bind.test,v 1.13 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -2051,189 +2051,187 @@ test bind-22.18 {HandleEventGenerate} {
# Bug 411307
list [catch {event gen . <a> -root 98765} msg] $msg
} {1 {bad window name/identifier "98765"}}
-set i 19
foreach check {
- {<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
- {<Configure> %a {-above .b} {[winfo id .b]}}
- {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
- {<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
- {<Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}}
-
- {<Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}
- {<Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
- {<Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}
-
- {<Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}}
- {<Button> %b {-button 1} 1}
- {<ButtonRelease> %b {-button 1} 1}
- {<Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}}
-
- {<Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}}
- {<Expose> %c {-count 20} 20}
- {<Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}}
-
- {<Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}}
- {<FocusIn> %d {-detail NotifyVirtual} {{}}}
- {<Enter> %d {-detail NotifyVirtual} NotifyVirtual}
- {<Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}}
-
- {<Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
- {<Enter> %f {-focus 1} 1}
- {<Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}}
-
- {<Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}}
- {<Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}}
- {<Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
- {<Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}}
-
- {<Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
- {<Key> %k {-keycode 20} 20}
- {<Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}}
-
- {<Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
- {<Key> %K {-keysym a} a}
- {<Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}}
-
- {<Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}}
- {<Enter> %m {-mode NotifyNormal} NotifyNormal}
- {<FocusIn> %m {-mode NotifyNormal} {{}}}
- {<Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}}
-
- {<Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
- {<Map> %o {-override 1} 1}
- {<Reparent> %o {-override 1} 1}
- {<Configure> %o {-override 1} 1}
- {<Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
-
- {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
- {<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
- {<Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}}
-
- {<Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}}
- {<Key> %R {-root .b} {[winfo id .b]}}
- {<Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}}
- {<Key> %R {-root [winfo id .b]} {[winfo id .b]}}
- {<Button> %R {-root .b} {[winfo id .b]}}
- {<ButtonRelease> %R {-root .b} {[winfo id .b]}}
- {<Motion> %R {-root .b} {[winfo id .b]}}
- {<<Paste>> %R {-root .b} {[winfo id .b]}}
- {<Enter> %R {-root .b} {[winfo id .b]}}
- {<Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}}
-
- {<Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
- {<Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
- {<Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
- {<ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
- {<Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
- {<<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
- {<Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
- {<Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}}
-
- {<Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
- {<Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
- {<Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
- {<ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
- {<Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
- {<<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
- {<Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
- {<Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}}
-
- {<Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
- {<Key> %E {-sendevent 1} 1}
- {<Key> %E {-sendevent yes} 1}
- {<Key> %E {-sendevent 43} 43}
-
- {<Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}}
- {<Key> %# {-serial 100} 100}
-
- {<Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}}
- {<Key> %s {-state 1} 1}
- {<Button> %s {-state 1025} 1025}
- {<ButtonRelease> %s {-state 1025} 1025}
- {<Motion> %s {-state 1} 1}
- {<<Paste>> %s {-state 1} 1}
- {<Enter> %s {-state 1} 1}
- {<Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}}
- {<Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
- {<Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}}
-
- {<Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
- {<Key> %S {-subwindow .b} {[winfo id .b]}}
- {<Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}}
- {<Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}}
- {<Button> %S {-subwindow .b} {[winfo id .b]}}
- {<ButtonRelease> %S {-subwindow .b} {[winfo id .b]}}
- {<Motion> %S {-subwindow .b} {[winfo id .b]}}
- {<<Paste>> %S {-subwindow .b} {[winfo id .b]}}
- {<Enter> %S {-subwindow .b} {[winfo id .b]}}
- {<Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}}
-
- {<Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}}
- {<Key> %t {-time 100} 100}
- {<Button> %t {-time 100} 100}
- {<ButtonRelease> %t {-time 100} 100}
- {<Motion> %t {-time 100} 100}
- {<<Paste>> %t {-time 100} 100}
- {<Enter> %t {-time 100} 100}
- {<Property> %t {-time 100} 100}
- {<Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}}
-
- {<Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}}
- {<Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}}
- {<Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
- {<Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}}
-
- {<Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}}
- {<Unmap> %W {-window .b.f} .b.f}
- {<Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}}
- {<Unmap> %W {-window [winfo id .b.f]} .b.f}
- {<Unmap> %W {-window .b.f} .b.f}
- {<Map> %W {-window .b.f} .b.f}
- {<Reparent> %W {-window .b.f} .b.f}
- {<Configure> %W {-window .b.f} .b.f}
- {<Gravity> %W {-window .b.f} .b.f}
- {<Circulate> %W {-window .b.f} .b.f}
- {<Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}}
-
- {<Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}}
- {<Key> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Button> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}}
-
- {<Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}}
- {<Key> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Button> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
-
- {<Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}}
+ {bind-22.19 <Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
+ {bind-22.20 <Configure> %a {-above .b} {[winfo id .b]}}
+ {bind-22.21 <Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {bind-22.22 <Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
+ {bind-22.23 <Key> %b {-above .} {{1 {<Key> event doesn't accept "-above" option}}}}
+
+ {bind-22.24 <Configure> %B {-borderwidth xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.25 <Configure> %B {-borderwidth 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.26 <Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}
+
+ {bind-22.27 <Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}}
+ {bind-22.28 <Button> %b {-button 1} 1}
+ {bind-22.29 <ButtonRelease> %b {-button 1} 1}
+ {bind-22.30 <Key> %k {-button 1} {{1 {<Key> event doesn't accept "-button" option}}}}
+
+ {bind-22.31 <Expose> %c {-count xyz} {{1 {expected integer but got "xyz"}}}}
+ {bind-22.32 <Expose> %c {-count 20} 20}
+ {bind-22.33 <Key> %b {-count 20} {{1 {<Key> event doesn't accept "-count" option}}}}
+
+ {bind-22.34 <Enter> %d {-detail xyz} {{1 {bad -detail value "xyz": must be NotifyAncestor, NotifyVirtual, NotifyInferior, NotifyNonlinear, NotifyNonlinearVirtual, NotifyPointer, NotifyPointerRoot, or NotifyDetailNone}}}}
+ {bind-22.35 <FocusIn> %d {-detail NotifyVirtual} {{}}}
+ {bind-22.36 <Enter> %d {-detail NotifyVirtual} NotifyVirtual}
+ {bind-22.37 <Key> %k {-detail NotifyVirtual} {{1 {<Key> event doesn't accept "-detail" option}}}}
+
+ {bind-22.38 <Enter> %f {-focus xyz} {{1 {expected boolean value but got "xyz"}}}}
+ {bind-22.39 <Enter> %f {-focus 1} 1}
+ {bind-22.40 <Key> %k {-focus 1} {{1 {<Key> event doesn't accept "-focus" option}}}}
+
+ {bind-22.41 <Expose> %h {-height xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.42 <Expose> %h {-height 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.43 <Configure> %h {-height 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.44 <Key> %k {-height 2i} {{1 {<Key> event doesn't accept "-height" option}}}}
+
+ {bind-22.45 <Key> %k {-keycode xyz} {{1 {expected integer but got "xyz"}}}}
+ {bind-22.46 <Key> %k {-keycode 20} 20}
+ {bind-22.47 <Button> %b {-keycode 20} {{1 {<Button> event doesn't accept "-keycode" option}}}}
+
+ {bind-22.48 <Key> %K {-keysym xyz} {{1 {unknown keysym "xyz"}}}}
+ {bind-22.49 <Key> %K {-keysym a} a}
+ {bind-22.50 <Button> %b {-keysym a} {{1 {<Button> event doesn't accept "-keysym" option}}}}
+
+ {bind-22.51 <Enter> %m {-mode xyz} {{1 {bad -mode value "xyz": must be NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed}}}}
+ {bind-22.52 <Enter> %m {-mode NotifyNormal} NotifyNormal}
+ {bind-22.53 <FocusIn> %m {-mode NotifyNormal} {{}}}
+ {bind-22.54 <Key> %k {-mode NotifyNormal} {{1 {<Key> event doesn't accept "-mode" option}}}}
+
+ {bind-22.55 <Map> %o {-override xyz} {{1 {expected boolean value but got "xyz"}}}}
+ {bind-22.56 <Map> %o {-override 1} 1}
+ {bind-22.57 <Reparent> %o {-override 1} 1}
+ {bind-22.58 <Configure> %o {-override 1} 1}
+ {bind-22.59 <Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
+
+ {bind-22.60 <Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
+ {bind-22.61 <Circulate> %p {-place PlaceOnTop} PlaceOnTop}
+ {bind-22.62 <Key> %k {-place PlaceOnTop} {{1 {<Key> event doesn't accept "-place" option}}}}
+
+ {bind-22.63 <Key> %R {-root .xyz} {{1 {bad window path name ".xyz"}}}}
+ {bind-22.64 <Key> %R {-root .b} {[winfo id .b]}}
+ {bind-22.65 <Key> %R {-root xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {bind-22.66 <Key> %R {-root [winfo id .b]} {[winfo id .b]}}
+ {bind-22.67 <Button> %R {-root .b} {[winfo id .b]}}
+ {bind-22.68 <ButtonRelease> %R {-root .b} {[winfo id .b]}}
+ {bind-22.69 <Motion> %R {-root .b} {[winfo id .b]}}
+ {bind-22.70 <<Paste>> %R {-root .b} {[winfo id .b]}}
+ {bind-22.71 <Enter> %R {-root .b} {[winfo id .b]}}
+ {bind-22.72 <Configure> %R {-root .b} {{1 {<Configure> event doesn't accept "-root" option}}}}
+
+ {bind-22.73 <Key> %X {-rootx xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.74 <Key> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.75 <Button> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.76 <ButtonRelease> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.77 <Motion> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.78 <<Paste>> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.79 <Enter> %X {-rootx 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.80 <Configure> %X {-rootx 2i} {{1 {<Configure> event doesn't accept "-rootx" option}}}}
+
+ {bind-22.81 <Key> %Y {-rooty xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.82 <Key> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.83 <Button> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.84 <ButtonRelease> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.85 <Motion> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.86 <<Paste>> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.87 <Enter> %Y {-rooty 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.88 <Configure> %Y {-rooty 2i} {{1 {<Configure> event doesn't accept "-rooty" option}}}}
+
+ {bind-22.89 <Key> %E {-sendevent xyz} {{1 {expected boolean value but got "xyz"}}}}
+ {bind-22.90 <Key> %E {-sendevent 1} 1}
+ {bind-22.91 <Key> %E {-sendevent yes} 1}
+ {bind-22.92 <Key> %E {-sendevent 43} 43}
+
+ {bind-22.93 <Key> %# {-serial xyz} {{1 {expected integer but got "xyz"}}}}
+ {bind-22.94 <Key> %# {-serial 100} 100}
+
+ {bind-22.95 <Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}}
+ {bind-22.96 <Key> %s {-state 1} 1}
+ {bind-22.97 <Button> %s {-state 1025} 1025}
+ {bind-22.98 <ButtonRelease> %s {-state 1025} 1025}
+ {bind-22.99 <Motion> %s {-state 1} 1}
+ {bind-22.100 <<Paste>> %s {-state 1} 1}
+ {bind-22.101 <Enter> %s {-state 1} 1}
+ {bind-22.102 <Visibility> %s {-state xyz} {{1 {bad -state value "xyz": must be VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured}}}}
+ {bind-22.103 <Visibility> %s {-state VisibilityUnobscured} VisibilityUnobscured}
+ {bind-22.104 <Configure> %s {-state xyz} {{1 {<Configure> event doesn't accept "-state" option}}}}
+
+ {bind-22.105 <Key> %S {-subwindow .xyz} {{1 {bad window path name ".xyz"}}}}
+ {bind-22.106 <Key> %S {-subwindow .b} {[winfo id .b]}}
+ {bind-22.107 <Key> %S {-subwindow xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {bind-22.108 <Key> %S {-subwindow [winfo id .b]} {[winfo id .b]}}
+ {bind-22.109 <Button> %S {-subwindow .b} {[winfo id .b]}}
+ {bind-22.110 <ButtonRelease> %S {-subwindow .b} {[winfo id .b]}}
+ {bind-22.111 <Motion> %S {-subwindow .b} {[winfo id .b]}}
+ {bind-22.112 <<Paste>> %S {-subwindow .b} {[winfo id .b]}}
+ {bind-22.113 <Enter> %S {-subwindow .b} {[winfo id .b]}}
+ {bind-22.114 <Configure> %S {-subwindow .b} {{1 {<Configure> event doesn't accept "-subwindow" option}}}}
+
+ {bind-22.115 <Key> %t {-time xyz} {{1 {expected integer but got "xyz"}}}}
+ {bind-22.116 <Key> %t {-time 100} 100}
+ {bind-22.117 <Button> %t {-time 100} 100}
+ {bind-22.118 <ButtonRelease> %t {-time 100} 100}
+ {bind-22.119 <Motion> %t {-time 100} 100}
+ {bind-22.120 <<Paste>> %t {-time 100} 100}
+ {bind-22.121 <Enter> %t {-time 100} 100}
+ {bind-22.122 <Property> %t {-time 100} 100}
+ {bind-22.123 <Configure> %t {-time 100} {{1 {<Configure> event doesn't accept "-time" option}}}}
+
+ {bind-22.124 <Expose> %w {-width xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.125 <Expose> %w {-width 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.126 <Configure> %w {-width 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.127 <Key> %k {-width 2i} {{1 {<Key> event doesn't accept "-width" option}}}}
+
+ {bind-22.128 <Unmap> %W {-window .xyz} {{1 {bad window path name ".xyz"}}}}
+ {bind-22.129 <Unmap> %W {-window .b.f} .b.f}
+ {bind-22.130 <Unmap> %W {-window xyz} {{1 {bad window name/identifier "xyz"}}}}
+ {bind-22.131 <Unmap> %W {-window [winfo id .b.f]} .b.f}
+ {bind-22.132 <Unmap> %W {-window .b.f} .b.f}
+ {bind-22.133 <Map> %W {-window .b.f} .b.f}
+ {bind-22.134 <Reparent> %W {-window .b.f} .b.f}
+ {bind-22.135 <Configure> %W {-window .b.f} .b.f}
+ {bind-22.136 <Gravity> %W {-window .b.f} .b.f}
+ {bind-22.137 <Circulate> %W {-window .b.f} .b.f}
+ {bind-22.138 <Key> %W {-window .b.f} {{1 {<Key> event doesn't accept "-window" option}}}}
+
+ {bind-22.139 <Key> %x {-x xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.140 <Key> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.141 <Button> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.142 <ButtonRelease> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.143 <Motion> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.144 <<Paste>> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.145 <Enter> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.146 <Expose> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.147 <Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.148 <Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.149 <Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.150 <Map> %x {-x 2i} {{1 {<Map> event doesn't accept "-x" option}}}}
+
+ {bind-22.151 <Key> %y {-y xyz} {{1 {bad screen distance "xyz"}}}}
+ {bind-22.152 <Key> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.153 <Button> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.154 <ButtonRelease> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.155 <Motion> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.156 <<Paste>> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.157 <Enter> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.158 <Expose> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.159 <Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.160 <Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.161 <Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}}
+ {bind-22.162 <Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
+
+ {bind-22.163 <Key> %k {-xyz 1} {{1 {bad option "-xyz": must be -when, -above, -borderwidth, -button, -count, -delta, -detail, -focus, -height, -keycode, -keysym, -mode, -override, -place, -root, -rootx, -rooty, -sendevent, -serial, -state, -subwindow, -time, -warp, -width, -window, -x, or -y}}}}
} {
- set event [lindex $check 0]
- test bind-22.$i "HandleEventGenerate: options $event [lindex $check 2]" {
+ lassign $check name event substitution generator result
+ test $name "HandleEventGenerate: options $event $generator" {
setup
- bind .b.f $event "lappend x [lindex $check 1]"
+ bind .b.f $event "lappend x $substitution"
set x {}
- if [catch {eval event gen .b.f $event [lindex $check 2]} msg] {
+ if [catch {eval event gen .b.f $event $generator} msg] {
set x [list 1 $msg]
}
set x
- } [eval set x [lindex $check 3]]
- incr i
+ } [eval set x $result]
}
test bind-23.1 {GetVirtualEventUid procedure} {
list [catch {event info <<asd} msg] $msg
@@ -2432,48 +2430,49 @@ test bind-25.17 {ParseEventDescription} {
setup
list [catch {event add <<xyz>> <<abc>>} msg] $msg
} {1 {virtual event not allowed in definition of another virtual event}}
-set i 1
foreach check {
- {{<Control- a>} <Control-Key-a>}
- {<Shift-a> <Shift-Key-a>}
- {<Lock-a> <Lock-Key-a>}
- {<Meta---a> <Meta-Key-a>}
- {<M-a> <Meta-Key-a>}
- {<Alt-a> <Alt-Key-a>}
- {<B1-a> <B1-Key-a>}
- {<B2-a> <B2-Key-a>}
- {<B3-a> <B3-Key-a>}
- {<B4-a> <B4-Key-a>}
- {<B5-a> <B5-Key-a>}
- {<Button1-a> <B1-Key-a>}
- {<Button2-a> <B2-Key-a>}
- {<Button3-a> <B3-Key-a>}
- {<Button4-a> <B4-Key-a>}
- {<Button5-a> <B5-Key-a>}
- {<M1-a> <Mod1-Key-a>}
- {<M2-a> <Mod2-Key-a>}
- {<M3-a> <Mod3-Key-a>}
- {<M4-a> <Mod4-Key-a>}
- {<M5-a> <Mod5-Key-a>}
- {<Mod1-a> <Mod1-Key-a>}
- {<Mod2-a> <Mod2-Key-a>}
- {<Mod3-a> <Mod3-Key-a>}
- {<Mod4-a> <Mod4-Key-a>}
- {<Mod5-a> <Mod5-Key-a>}
- {<Double-a> <Double-Key-a>}
- {<Triple-a> <Triple-Key-a>}
- {{<Double 1>} <Double-Button-1>}
- {<Triple-1> <Triple-Button-1>}
- {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
+ {bind-25.1 {<Control- a>} <Control-Key-a>}
+ {bind-25.2 <Shift-a> <Shift-Key-a>}
+ {bind-25.3 <Lock-a> <Lock-Key-a>}
+ {bind-25.4 <Meta---a> <Meta-Key-a>}
+ {bind-25.5 <M-a> <Meta-Key-a>}
+ {bind-25.6 <Alt-a> <Alt-Key-a>}
+ {bind-25.7 <B1-a> <B1-Key-a>}
+ {bind-25.8 <B2-a> <B2-Key-a>}
+ {bind-25.9 <B3-a> <B3-Key-a>}
+ {bind-25.10 <B4-a> <B4-Key-a>}
+ {bind-25.11 <B5-a> <B5-Key-a>}
+ {bind-25.12 <Button1-a> <B1-Key-a>}
+ {bind-25.13 <Button2-a> <B2-Key-a>}
+ {bind-25.14 <Button3-a> <B3-Key-a>}
+ {bind-25.15 <Button4-a> <B4-Key-a>}
+ {bind-25.16 <Button5-a> <B5-Key-a>}
+ {bind-25.17 <M1-a> <Mod1-Key-a>}
+ {bind-25.18 <M2-a> <Mod2-Key-a>}
+ {bind-25.19 <M3-a> <Mod3-Key-a>}
+ {bind-25.20 <M4-a> <Mod4-Key-a>}
+ {bind-25.21 <M5-a> <Mod5-Key-a>}
+ {bind-25.22 <Mod1-a> <Mod1-Key-a>}
+ {bind-25.23 <Mod2-a> <Mod2-Key-a>}
+ {bind-25.24 <Mod3-a> <Mod3-Key-a>}
+ {bind-25.25 <Mod4-a> <Mod4-Key-a>}
+ {bind-25.26 <Mod5-a> <Mod5-Key-a>}
+ {bind-25.27 <Double-a> <Double-Key-a>}
+ {bind-25.28 <Triple-a> <Triple-Key-a>}
+ {bind-25.29 {<Double 1>} <Double-Button-1>}
+ {bind-25.30 <Triple-1> <Triple-Button-1>}
+ {bind-25.31 {<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
} {
- test bind-25.$i {modifier names} {
+ lassign $check name shortBind longBind
+ test $name {modifier names} -setup {
catch {destroy .b.f}
frame .b.f -class Test -width 150 -height 100
- bind .b.f [lindex $check 0] foo
+ } -body {
+ bind .b.f $shortBind foo
bind .b.f
- } [lindex $check 1]
- bind .b.f [lindex $check 1] {}
- incr i
+ } -result $longBind -cleanup {
+ bind .b.f [lindex $check 1] {}
+ }
}
foreach event [bind Test] {
@@ -2501,72 +2500,97 @@ test bind-26.3 {event names} {
destroy .b.f
set x
} {<Destroy> destroyed}
-set i 4
foreach check {
- {Motion Motion}
- {Button Button}
- {ButtonPress Button}
- {ButtonRelease ButtonRelease}
- {Colormap Colormap}
- {Enter Enter}
- {Leave Leave}
- {Expose Expose}
- {Key Key}
- {KeyPress Key}
- {KeyRelease KeyRelease}
- {Property Property}
- {Visibility Visibility}
- {Activate Activate}
- {Deactivate Deactivate}
+ {bind-26.4 Motion Motion}
+ {bind-26.5 Button Button}
+ {bind-26.6 ButtonPress Button}
+ {bind-26.7 ButtonRelease ButtonRelease}
+ {bind-26.8 Colormap Colormap}
+ {bind-26.9 Enter Enter}
+ {bind-26.10 Leave Leave}
+ {bind-26.11 Expose Expose}
+ {bind-26.12 Key Key}
+ {bind-26.13 KeyPress Key}
+ {bind-26.14 KeyRelease KeyRelease}
+ {bind-26.15 Property Property}
+ {bind-26.16 Visibility Visibility}
+ {bind-26.17 Activate Activate}
+ {bind-26.18 Deactivate Deactivate}
} {
- set event [lindex $check 0]
- test bind-26.$i {event names} {
+ lassign $check name event canonicalEvent
+ test $name "event names: $event" {
setup
bind .b.f <$event> "set x {event $event}"
set x xyzzy
event gen .b.f <$event>
list $x [bind .b.f]
- } [list "event $event" <[lindex $check 1]>]
- incr i
+ } [list "event $event" <$canonicalEvent>]
}
+# These events require an extra argument to [event generate]
foreach check {
- {Circulate Circulate}
- {Configure Configure}
- {Gravity Gravity}
- {Map Map}
- {Reparent Reparent}
- {Unmap Unmap}
+ {bind-26.19 Circulate Circulate}
+ {bind-26.20 Configure Configure}
+ {bind-26.21 Gravity Gravity}
+ {bind-26.22 Map Map}
+ {bind-26.23 Reparent Reparent}
+ {bind-26.24 Unmap Unmap}
} {
- set event [lindex $check 0]
- test bind-26.$i {event names} {
+ lassign $check name event canonicalEvent
+ test $name "event names: $event" {
setup
bind .b.f <$event> "set x {event $event}"
set x xyzzy
event gen .b.f <$event> -window .b.f
list $x [bind .b.f]
- } [list "event $event" <[lindex $check 1]>]
- incr i
+ } [list "event $event" <$canonicalEvent>]
}
-
test bind-27.1 {button names} {
list [catch {bind .b <Expose-1> foo} msg] $msg
} {1 {specified button "1" for non-button event}}
test bind-27.2 {button names} {
list [catch {bind .b <Button-6> foo} msg] $msg
} {1 {specified keysym "6" for non-key event}}
-set i 3
-foreach button {1 2 3 4 5} {
- test bind-27.$i {button names} {
- setup
- bind .b.f <Button-$button> "lappend x \"button $button\""
- set x [bind .b.f]
- event gen .b.f <Button-$button>
- event gen .b.f <ButtonRelease-$button>
- set x
- } [list <Button-$button> "button $button"]
- incr i
-}
+test bind-27.3 {button names} {
+ setup
+ bind .b.f <Button-1> {lappend x "button 1"}
+ set x [bind .b.f]
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ set x
+} {<Button-1> {button 1}}
+test bind-27.4 {button names} {
+ setup
+ bind .b.f <Button-2> {lappend x "button 2"}
+ set x [bind .b.f]
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ set x
+} {<Button-2> {button 2}}
+test bind-27.5 {button names} {
+ setup
+ bind .b.f <Button-3> {lappend x "button 3"}
+ set x [bind .b.f]
+ event gen .b.f <Button-3>
+ event gen .b.f <ButtonRelease-3>
+ set x
+} {<Button-3> {button 3}}
+test bind-27.6 {button names} {
+ setup
+ bind .b.f <Button-4> {lappend x "button 4"}
+ set x [bind .b.f]
+ event gen .b.f <Button-4>
+ event gen .b.f <ButtonRelease-4>
+ set x
+} {<Button-4> {button 4}}
+test bind-27.7 {button names} {
+ setup
+ bind .b.f <Button-5> {lappend x "button 5"}
+ set x [bind .b.f]
+ event gen .b.f <Button-5>
+ event gen .b.f <ButtonRelease-5>
+ set x
+} {<Button-5> {button 5}}
test bind-28.1 {keysym names} {
list [catch {bind .b <Expose-a> foo} msg] $msg
@@ -2583,46 +2607,41 @@ test bind-28.4 {keysym names} {
bind .b.f <a> foo
bind .b.f
} a
-set i 5
foreach check {
- {a 0 a}
- {space 0 <Key-space>}
- {Return 0 <Key-Return>}
- {X 1 X}
+ {bind-28.5 a 0 a}
+ {bind-28.6 space 0 <Key-space>}
+ {bind-28.7 Return 0 <Key-Return>}
+ {bind-28.8 X 1 X}
} {
- set keysym [lindex $check 0]
- test bind-28.$i {keysym names} {
+ lassign $check name keysym state result
+ test $name {keysym names} {
setup
bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\""
bind .b.f <Key-x> "lappend x {bad binding match}"
set x [lsort [bind .b.f]]
- event gen .b.f <Key-$keysym> -state [lindex $check 1]
+ event gen .b.f <Key-$keysym> -state $state
set x
- } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
- incr i
+ } [concat [lsort "x $result"] "{keysym $keysym}"]
}
test bind-29.1 {dummy test to help ensure proper numbering} {} {}
setup
bind .b.f <KeyPress> {set x %K}
-set i 2
foreach check {
- {a 0 a}
- {x 1 X}
- {x 2 X}
- {space 0 space}
- {F1 1 F1}
+ {bind-29.2 a 0 a}
+ {bind-29.3 x 1 X}
+ {bind-29.4 x 2 X}
+ {bind-29.5 space 0 space}
+ {bind-29.6 F1 1 F1}
} {
- test bind-29.$i {GetKeySym procedure} {nonPortable} {
+ lassign $check name keysym state result
+ test $name {GetKeySym procedure} nonPortable {
set x nothing
- event gen .b.f <KeyPress> -keysym [lindex $check 0] \
- -state [lindex $check 1]
+ event gen .b.f <KeyPress> -keysym $keysym -state $state
set x
- } [lindex $check 2]
- incr i
+ } $result
}
-
proc bgerror msg {
global x errorInfo
set x [list $msg $errorInfo]
diff --git a/tests/bitmap.test b/tests/bitmap.test
index f81613d..95d04a9 100644
--- a/tests/bitmap.test
+++ b/tests/bitmap.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: bitmap.test,v 1.4 2003/04/01 21:06:17 dgp Exp $
+# RCS: @(#) $Id: bitmap.test,v 1.5 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -93,16 +93,3 @@ destroy .t
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/border.test b/tests/border.test
index 0bf08b8..81cea0b 100644
--- a/tests/border.test
+++ b/tests/border.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: border.test,v 1.4 2003/04/01 21:06:17 dgp Exp $
+# RCS: @(#) $Id: border.test,v 1.5 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -163,16 +163,3 @@ if {[testConstraint pseudocolor8]} {
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/button.test b/tests/button.test
index bc81d9a..b536078 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: button.test,v 1.15 2004/02/18 00:40:24 hobbs Exp $
+# RCS: @(#) $Id: button.test,v 1.16 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -42,7 +42,9 @@ foreach test {
{unknown color name "non-existent"} {1 1 1 1}}
{-activeforeground #ff0000 #ff0000 non-existent
{unknown color name "non-existent"} {1 1 1 1}}
- {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}}
+ {-anchor nw nw bogus
+ {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}
+ {1 1 1 1}}
{-background #ff0000 #ff0000 non-existent
{unknown color name "non-existent"} {1 1 1 1}}
{-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
@@ -52,7 +54,9 @@ foreach test {
{1 1 1 1}}
{-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
{-command "set x" {set x} {} {} {0 1 1 1}}
- {-compound left left bogus {bad compound "bogus": must be bottom, center, left, none, right, or top} {1 1 1 1}}
+ {-compound left left bogus
+ {bad compound "bogus": must be bottom, center, left, none, right, or top}
+ {1 1 1 1}}
{-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
{-default active active huh?
{bad default "huh?": must be active, disabled, or normal}
@@ -72,47 +76,57 @@ foreach test {
{-image image1 image1 bogus {image "bogus" doesn't exist} {1 1 1 1}}
{-indicatoron yes 1 no_way {expected boolean value but got "no_way"}
{0 0 1 1}}
- {-justify right right bogus {bad justification "bogus": must be left, right, or center} {1 1 1 1}}
- {-offrelief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 0 1 1}}
+ {-justify right right bogus
+ {bad justification "bogus": must be left, right, or center}
+ {1 1 1 1}}
+ {-offrelief flat flat 1.5
+ {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+ {0 0 1 1}}
{-offvalue lousy lousy {} {} {0 0 1 0}}
{-onvalue fantastic fantastic {} {} {0 0 1 0}}
- {-overrelief "" "" 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {0 1 1 1}}
+ {-overrelief "" "" 1.5
+ {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+ {0 1 1 1}}
{-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
{-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
{-repeatdelay 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
{-repeatinterval 100 100 foo {expected integer but got "foo"} {0 1 0 0}}
- {-relief flat flat 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
+ {-relief flat flat 1.5
+ {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}
+ {1 1 1 1}}
{-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
{-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
- {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {1 1 1 1}}
+ {-state normal normal bogus
+ {bad state "bogus": must be active, disabled, or normal}
+ {1 1 1 1}}
{-takefocus "any string" "any string" {} {} {1 1 1 1}}
{-text "Sample text" {Sample text} {} {} {1 1 1 1}}
{-textvariable i i {} {} {1 1 1 1}}
- {-tristateimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
+ {-tristateimage image1 image1 bogus {image "bogus" doesn't exist}
+ {0 0 1 1}}
{-tristatevalue unknowable unknowable {} {} {0 0 1 1}}
{-underline 5 5 3p {expected integer but got "3p"} {1 1 1 1}}
{-value anyString anyString {} {} {0 0 0 1}}
{-width 402 402 3p {expected integer but got "3p"} {1 1 1 1}}
{-wraplength 100 100 6x {bad screen distance "6x"} {1 1 1 1}}
} {
- set name [lindex $test 0]
- set classes [lindex $test 5]
- foreach w {.l .b .c .r} hasOption [lindex $test 5] {
- if $hasOption {
+ lassign $test name value okResult badValue badResult classes
+ foreach w {.l .b .c .r} hasOption $classes {
+ if {$hasOption} {
test button-1.$i {configuration options} testImageType {
- $w configure $name [lindex $test 1]
+ $w configure $name $value
lindex [$w configure $name] 4
- } [lindex $test 2]
+ } $okResult
incr i
- if {[lindex $test 3] != ""} {
+ if {$badValue ne ""} {
test button-1.$i {configuration options} testImageType {
- list [catch {$w configure $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ list [catch {$w configure $name $badValue} msg] $msg
+ } [list 1 $badResult]
}
$w configure $name [lindex [$w configure $name] 3]
} else {
test button-1.$i {configuration options} testImageType {
- list [catch {$w configure $name [lindex $test 1]} msg] $msg
+ list [catch {$w configure $name $value} msg] $msg
} "1 {unknown option \"$name\"}"
}
}
diff --git a/tests/canvImg.test b/tests/canvImg.test
index ec6fb6b..5a7cd71 100644
--- a/tests/canvImg.test
+++ b/tests/canvImg.test
@@ -7,7 +7,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvImg.test,v 1.7 2003/05/08 09:35:41 dkf Exp $
+# RCS: @(#) $Id: canvImg.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -225,37 +225,36 @@ test canvImg-7.2 {DisplayImage procedure, no image} {
update
} {}
-set i 1
.c delete all
if {[testConstraint testImageType]} {
.c create image 50 100 -image foo -tags image -anchor nw
}
.c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {}
foreach check {
- {{50 70 80 81} {70 90} {rect}}
- {{50 70 80 79} {70 90} {image}}
- {{99 70 110 81} {90 90} {rect}}
- {{101 70 110 79} {90 90} {image}}
- {{99 100 110 115} {90 110} {rect}}
- {{101 100 110 115} {90 110} {image}}
- {{99 134 110 145} {90 125} {rect}}
- {{101 136 110 145} {90 125} {image}}
- {{50 134 80 145} {70 125} {rect}}
- {{50 136 80 145} {70 125} {image}}
- {{20 134 31 145} {40 125} {rect}}
- {{20 136 29 145} {40 125} {image}}
- {{20 100 31 115} {40 110} {rect}}
- {{20 100 29 115} {40 110} {image}}
- {{20 70 31 80} {40 90} {rect}}
- {{20 70 29 79} {40 90} {image}}
- {{60 70 69 109} {70 110} {image}}
- {{60 70 71 111} {70 110} {rect}}
+ {canvImg-8.1 {50 70 80 81} {70 90} rect}
+ {canvImg-8.2 {50 70 80 79} {70 90} image}
+ {canvImg-8.3 {99 70 110 81} {90 90} rect}
+ {canvImg-8.4 {101 70 110 79} {90 90} image}
+ {canvImg-8.5 {99 100 110 115} {90 110} rect}
+ {canvImg-8.6 {101 100 110 115} {90 110} image}
+ {canvImg-8.7 {99 134 110 145} {90 125} rect}
+ {canvImg-8.8 {101 136 110 145} {90 125} image}
+ {canvImg-8.9 {50 134 80 145} {70 125} rect}
+ {canvImg-8.10 {50 136 80 145} {70 125} image}
+ {canvImg-8.11 {20 134 31 145} {40 125} rect}
+ {canvImg-8.12 {20 136 29 145} {40 125} image}
+ {canvImg-8.13 {20 100 31 115} {40 110} rect}
+ {canvImg-8.14 {20 100 29 115} {40 110} image}
+ {canvImg-8.15 {20 70 31 80} {40 90} rect}
+ {canvImg-8.16 {20 70 29 79} {40 90} image}
+ {canvImg-8.17 {60 70 69 109} {70 110} image}
+ {canvImg-8.18 {60 70 71 111} {70 110} rect}
} {
- test canvImg-8.$i {ImageToPoint procedure} testImageType {
- eval .c coords rect [lindex $check 0]
- .c gettags [eval .c find closest [lindex $check 1]]
- } [lindex $check 2]
- incr i
+ lassign $check name rectCoords testPoint result
+ test $name {ImageToPoint procedure} testImageType {
+ .c coords rect {expand}$rectCoords
+ .c gettags [.c find closest {expand}$testPoint]
+ } $result
}
.c delete all
@@ -392,16 +391,3 @@ test canvImg-11.3 {ImageChangedProc procedure} testImageType {
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvPs.test b/tests/canvPs.test
index d065d53..e57b9b9 100644
--- a/tests/canvPs.test
+++ b/tests/canvPs.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvPs.test,v 1.7 2003/05/11 00:52:41 hobbs Exp $
+# RCS: @(#) $Id: canvPs.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -131,16 +131,3 @@ removeFile bar.ps
deleteWindows
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvRect.test b/tests/canvRect.test
index a9918e1..07f3e91 100644
--- a/tests/canvRect.test
+++ b/tests/canvRect.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvRect.test,v 1.7 2003/04/01 21:06:18 dgp Exp $
+# RCS: @(#) $Id: canvRect.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -22,22 +22,27 @@ update
set i 1
.c create rectangle 20 20 80 80 -tag test
foreach test {
- {-fill #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
- {-outline #123456 #123456 bad_color {unknown color name "bad_color"}}
- {-stipple gray50 gray50 bogus {bitmap "bogus" not defined}}
- {-tags {test a b c} {test a b c} {} {}}
- {-width 6.0 6.0 abc {bad screen distance "abc"}}
+ {-fill #ff0000 #ff0000
+ non-existent {unknown color name "non-existent"}}
+ {-outline #123456 #123456
+ bad_color {unknown color name "bad_color"}}
+ {-stipple gray50 gray50
+ bogus {bitmap "bogus" not defined}}
+ {-tags {test a b c} {test a b c}
+ {} {}}
+ {-width 6.0 6.0
+ abc {bad screen distance "abc"}}
} {
- set name [lindex $test 0]
- test canvRect-1.$i {configuration options} {
- .c itemconfigure test $name [lindex $test 1]
+ lassign $test name goodValue goodResult badValue badResult
+ test canvRect-1.$i "configuration options: good value for $name" {
+ .c itemconfigure test $name $goodValue
list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
- } [list [lindex $test 2] [lindex $test 2]]
+ } [list $goodResult $goodResult]
incr i
- if {[lindex $test 3] != ""} {
- test canvRect-1.$i {configuration options} {
- list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ if {$badValue ne ""} {
+ test canvRect-1.$i "configuration options: bad value for $name" -body {
+ .c itemconfigure test $name $badValue
+ } -returnCodes error -result $badResult
}
incr i
}
@@ -323,16 +328,3 @@ end
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvText.test b/tests/canvText.test
index 5d5acb9..4578ff0 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvText.test,v 1.13 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: canvText.test,v 1.14 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -35,16 +35,16 @@ foreach test {
{-text xyz xyz {} {}}
{-width 6 6 xyz {bad screen distance "xyz"}}
} {
- set name [lindex $test 0]
- test canvText-1.$i {configuration options} {
- .c itemconfigure test $name [lindex $test 1]
+ lassign $test name goodValue goodResult badValue badResult
+ test canvText-1.$i "configuration options: good value for $name" {
+ .c itemconfigure test $name $goodValue
list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
- } [list [lindex $test 2] [lindex $test 2]]
+ } [list $goodResult $goodResult]
incr i
- if {[lindex $test 3] != ""} {
- test canvText-1.$i {configuration options} {
- list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ if {$badValue ne ""} {
+ test canvText-1.$i "configuration options: bad value for $name" -body {
+ .c itemconfigure test $name $badValue
+ } -returnCodes error -result $badResult
}
incr i
}
@@ -516,16 +516,3 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvWind.test b/tests/canvWind.test
index 37e6e34..1b07e3f 100644
--- a/tests/canvWind.test
+++ b/tests/canvWind.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: canvWind.test,v 1.5 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: canvWind.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -129,16 +129,3 @@ catch {destroy .t}
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/canvas.test b/tests/canvas.test
index 5a2b5d3..3a7daff 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-2000 Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: canvas.test,v 1.17 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: canvas.test,v 1.18 2004/05/23 17:34:48 dkf Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -20,12 +20,13 @@ pack .c
update
set i 1
foreach test {
- {-background #ff0000 #ff0000 non-existent
- {unknown color name "non-existent"}}
+ {-background #ff0000 #ff0000
+ non-existent {unknown color name "non-existent"}}
{-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
{-bd 4 4 badValue {bad screen distance "badValue"}}
{-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
- {-closeenough 24 24.0 bogus {expected floating-point number but got "bogus"}}
+ {-closeenough 24 24.0
+ bogus {expected floating-point number but got "bogus"}}
{-confine true 1 silly {expected boolean value but got "silly"}}
{-cursor arrow arrow badValue {bad cursor spec "badValue"}}
{-height 2.1 2 x42 {bad screen distance "x42"}}
@@ -37,7 +38,8 @@ foreach test {
{-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
{-insertontime 100 100 3.2 {expected integer but got "3.2"}}
{-insertwidth 1.3 1 6x {bad screen distance "6x"}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-relief groove groove
+ 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
{-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
{-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
{-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
@@ -46,16 +48,16 @@ foreach test {
{-xscrollcommand {Some command} {Some command} {} {}}
{-yscrollcommand {Another command} {Another command} {} {}}
} {
- set name [lindex $test 0]
- test canvas-1.$i {configuration options} {
- .c configure $name [lindex $test 1]
+ lassign $test name goodValue goodResult badValue badResult
+ test canvas-1.$i "configuration options: good value for $name" {
+ .c configure $name $goodValue
lindex [.c configure $name] 4
- } [lindex $test 2]
+ } $goodResult
incr i
- if {[lindex $test 3] != ""} {
- test canvas-1.$i {configuration options} {
- list [catch {.c configure $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ if {$badValue ne ""} {
+ test canvas-1.$i "configuration options: bad value for $name" -body {
+ .c configure $name $badValue
+ } -returnCodes error -result $badResult
}
.c configure $name [lindex [.c configure $name] 3]
incr i
@@ -454,15 +456,18 @@ proc create {w type args} {
eval [list $w create $type] $args
}
foreach type {arc bitmap image line oval polygon rect text window} {
- test canvas-15.[incr i] "basic types check: $type" {
+ incr i
+ test canvas-15.$i "basic types check: $type requires coords" -setup {
destroy .c; canvas .c
- list [catch {.c create $type} msg] $msg
- } [format {1 {wrong # args: should be ".c create %s coords ?arg arg ...?"}} $type]
- test canvas-15.[incr i] "basic coords check: $type" {
+ } -body {
+ .c create $type
+ } -returnCodes error -result [format {wrong # args: should be ".c create %s coords ?arg arg ...?"} $type]
+ incr i
+ test canvas-15.$i "basic coords check: $type coords are paired" -setup {
destroy .c; canvas .c
- list [catch {.c create $type 0} msg] \
- [string match "wrong # coordinates: expected*" $msg]
- } {1 1}
+ } -match glob -body {
+ .c create $type 0
+ } -returnCodes error -result "wrong # coordinates: expected*"
}
test canvas-16.1 {arc coords check} {
diff --git a/tests/choosedir.test b/tests/choosedir.test
index 98831df..d72dbcd 100644
--- a/tests/choosedir.test
+++ b/tests/choosedir.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: choosedir.test,v 1.11 2003/04/01 21:06:19 dgp Exp $
+# RCS: @(#) $Id: choosedir.test,v 1.12 2004/05/23 17:34:48 dkf Exp $
#
package require tcltest 2.1
@@ -89,7 +89,7 @@ set real [file join $dir choosedirTest]
set parent .
foreach opt {-initialdir -mustexist -parent -title} {
- test choosedir-1.1 "tk_chooseDirectory command" unixOnly {
+ test choosedir-1.1$opt "tk_chooseDirectory command" unixOnly {
list [catch {tk_chooseDirectory $opt} msg] $msg
} [list 1 "value for \"$opt\" missing"]
}
diff --git a/tests/clipboard.test b/tests/clipboard.test
index 2793aaf..b8530a6 100644
--- a/tests/clipboard.test
+++ b/tests/clipboard.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: clipboard.test,v 1.7 2003/04/01 21:06:20 dgp Exp $
+# RCS: @(#) $Id: clipboard.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
#
# Note: Multiple display clipboard handling will only be tested if the
@@ -244,16 +244,3 @@ test clipboard-7.16 {Tk_ClipboardCmd procedure} {
# cleanup
cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/clrpick.test b/tests/clrpick.test
index 5e19770..70f1a52 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -5,7 +5,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: clrpick.test,v 1.9 2004/03/17 18:15:49 das Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.10 2004/05/23 17:34:48 dkf Exp $
#
package require tcltest 2.1
@@ -21,10 +21,10 @@ regsub -all , $msg "" options
regsub \"-foo\" $options "" options
foreach option $options {
- if {[string index $option 0] == "-"} {
- test clrpick-1.2 {tk_chooseColor command} {
- list [catch {tk_chooseColor $option} msg] $msg
- } [list 1 "value for \"$option\" missing"]
+ if {[string index $option 0] eq "-"} {
+ test clrpick-1.2$option {tk_chooseColor command} -body {
+ tk_chooseColor $option
+ } -returnCodes error -result "value for \"$option\" missing"
}
}
@@ -48,11 +48,7 @@ test clrpick-1.7 {tk_chooseColor command} {
list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg
} {1 {invalid color name "##badbadbaadcolor"}}
-if {[info commands tk::dialog::color::] == ""} {
- set isNative 1
-} else {
- set isNative 0
-}
+set isNative [expr {[info commands tk::dialog::color::] eq ""}]
proc ToPressButton {parent btn} {
global isNative
diff --git a/tests/cmds.test b/tests/cmds.test