blob: d1220b9501e98bb7620072a58e28f942524b685b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
# This file is a Tcl script to test out the procedures in tkCanvWind.c,
# which implement canvas "window" items. It is organized in the standard
# fashion for Tcl tests.
#
# Copyright © 1997 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
test canvWind-1.1 {DisplayWinItem, windows off-screen vertically} -setup {
destroy .t
} -body {
toplevel .t
canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
-relief sunken -xscrollincrement 1 -yscrollincrement 1 \
-highlightthickness 1
pack .t.c -fill both -expand 1 -padx 20 -pady 20
wm geometry .t +0+0
set f .t.f
frame $f -width 80 -height 50 -bg red
.t.c create window 300 400 -window $f -anchor nw
.t.c xview moveto .3
.t.c yview moveto .50
update
set x [list [list [winfo ismapped $f] [winfo y $f]]]
.t.c yview scroll 52 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
.t.c yview scroll 1 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
.t.c yview scroll -255 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
.t.c yview scroll -1 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
} -cleanup {
destroy .t
} -result {{1 23} {1 -29} {0 -29} {1 225} {0 225}}
test canvWind-1.2 {DisplayWinItem, windows off-screen vertically} -setup {
destroy .t
} -body {
toplevel .t
canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
-relief sunken -xscrollincrement 1 -yscrollincrement 1 \
-highlightthickness 1
pack .t.c -fill both -expand 1 -padx 20 -pady 20
wm geometry .t +0+0
set f .t.c.f
frame $f -width 80 -height 50 -bg red
.t.c create window 300 400 -window $f -anchor nw
.t.c xview moveto .3
.t.c yview moveto .50
update
set x [list [list [winfo ismapped $f] [winfo y $f]]]
.t.c yview scroll 52 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
.t.c yview scroll 1 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
.t.c yview scroll -255 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
.t.c yview scroll -1 units
update
lappend x [list [winfo ismapped $f] [winfo y $f]]
} -cleanup {
destroy .t
} -result {{1 3} {1 -49} {0 -49} {1 205} {0 205}}
test canvWind-1.3 {DisplayWinItem, windows off-screen horizontally} -setup {
destroy .t
} -body {
toplevel .t
canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
-relief sunken -xscrollincrement 1 -yscrollincrement 1 \
-highlightthickness 1
pack .t.c -fill both -expand 1 -padx 20 -pady 20
wm geometry .t +0+0
set f .t.f
frame $f -width 80 -height 50 -bg red
.t.c create window 300 400 -window $f -anchor nw
.t.c xview moveto .3
.t.c yview moveto .50
update
set x [list [list [winfo ismapped $f] [winfo x $f]]]
.t.c xview scroll 82 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
.t.c xview scroll 1 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
.t.c xview scroll -335 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
.t.c xview scroll -1 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
} -cleanup {
destroy .t
} -result {{1 23} {1 -59} {0 -59} {1 275} {0 275}}
test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} -setup {
destroy .t
} -body {
toplevel .t
canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
-relief sunken -xscrollincrement 1 -yscrollincrement 1 \
-highlightthickness 1
pack .t.c -fill both -expand 1 -padx 20 -pady 20
wm geometry .t +0+0
set f .t.c.f
frame $f -width 80 -height 50 -bg red
.t.c create window 300 400 -window $f -anchor nw
.t.c xview moveto .3
.t.c yview moveto .50
update
set x [list [list [winfo ismapped $f] [winfo x $f]]]
.t.c xview scroll 82 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
.t.c xview scroll 1 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
.t.c xview scroll -335 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
.t.c xview scroll -1 units
update
lappend x [list [winfo ismapped $f] [winfo x $f]]
} -cleanup {
destroy .t
} -result {{1 3} {1 -79} {0 -79} {1 255} {0 255}}
test canvWind-2.1 {DisplayWinItem, window gets destroyed during <Configure>} -setup {
destroy .t
} -body {
toplevel .t
canvas .t.c
pack .t.c
frame .t.c.f -width 50 -height 50 -background red
set id [.t.c create window 50 50 -window .t.c.f]
update
bind .t.c.f <Configure> {destroy .t.c.f}
.t.c coords $id 60 60 ; # was crashing
update
} -cleanup {
destroy .t
} -result {}
# cleanup
cleanupTests
return
|
