1
# This file is a Tcl script to test out Tk's clipboard management code,
2
# especially the "clipboard" command. It is organized in the standard
3
# fashion for Tcl tests.
5
# Copyright (c) 1994 Sun Microsystems, Inc.
7
# See the file "license.terms" for information on usage and redistribution
8
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10
# RCS: @(#) $Id: clipboard.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
13
# Note: Multiple display clipboard handling will only be tested if the
14
# environment variable TK_ALT_DISPLAY is set to an alternate display.
17
if {[string compare test [info procs test]] == 1} {
21
eval destroy [winfo child .]
23
# set up a very large buffer to test INCR retrievals
25
foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
26
set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
27
append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
30
# Now we start the main body of the test code
32
test clipboard-1.1 {ClipboardHandler procedure} {
34
clipboard append "test"
35
selection get -s CLIPBOARD
37
test clipboard-1.2 {ClipboardHandler procedure} {
39
clipboard append "test"
40
clipboard append "ing"
41
selection get -s CLIPBOARD
43
test clipboard-1.3 {ClipboardHandler procedure} {
49
selection get -s CLIPBOARD
51
test clipboard-1.4 {ClipboardHandler procedure} {
53
clipboard append $longValue
54
selection get -s CLIPBOARD
56
test clipboard-1.5 {ClipboardHandler procedure} {
58
clipboard append $longValue
59
clipboard append "test"
60
selection get -s CLIPBOARD
62
test clipboard-1.6 {ClipboardHandler procedure} {
64
clipboard append -t TEST $longValue
65
clipboard append -t STRING "test"
66
list [selection get -s CLIPBOARD -t STRING] \
67
[selection get -s CLIPBOARD -t TEST]
68
} [list test $longValue]
69
test clipboard-1.7 {ClipboardHandler procedure} {
71
clipboard append -t TEST [string range $longValue 1 4000]
72
clipboard append -t STRING "test"
73
list [selection get -s CLIPBOARD -t STRING] \
74
[selection get -s CLIPBOARD -t TEST]
75
} [list test [string range $longValue 1 4000]]
76
test clipboard-1.8 {ClipboardHandler procedure} {
79
selection get -s CLIPBOARD
81
test clipboard-1.9 {ClipboardHandler procedure} {
84
clipboard append "Test"
85
selection get -s CLIPBOARD
88
##############################################################################
90
test clipboard-2.1 {ClipboardAppHandler procedure} {
91
set oldAppName [tk appname]
92
tk appname UnexpectedName
94
clipboard append -type NEW_TYPE Data
95
set result [selection get -selection CLIPBOARD -type TK_APPLICATION]
96
tk appname $oldAppName
100
##############################################################################
102
test clipboard-3.1 {ClipboardWindowHandler procedure} {
103
set oldAppName [tk appname]
104
tk appname UnexpectedName
106
clipboard append -type NEW_TYPE Data
107
set result [selection get -selection CLIPBOARD -type TK_WINDOW]
108
tk appname $oldAppName
112
##############################################################################
114
test clipboard-4.1 {ClipboardLostSel procedure} {
116
clipboard append "Test"
117
selection clear -s CLIPBOARD
118
list [catch {selection get -s CLIPBOARD} msg] $msg
119
} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}}
120
test clipboard-4.2 {ClipboardLostSel procedure} {
122
clipboard append "Test"
123
clipboard append -t TEST "Test2"
124
selection clear -s CLIPBOARD
125
list [catch {selection get -s CLIPBOARD} msg] $msg \
126
[catch {selection get -s CLIPBOARD -t TEST} msg] $msg
127
} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
128
test clipboard-4.3 {ClipboardLostSel procedure} {
130
clipboard append "Test"
131
clipboard append -t TEST "Test2"
132
clipboard append "Test3"
133
selection clear -s CLIPBOARD
134
list [catch {selection get -s CLIPBOARD} msg] $msg \
135
[catch {selection get -s CLIPBOARD -t TEST} msg] $msg
136
} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
138
##############################################################################
140
test clipboard-5.1 {Tk_ClipboardClear procedure} {
142
clipboard append -t TEST "test"
143
set result [lsort [selection get -s CLIPBOARD TARGETS]]
145
list $result [lsort [selection get -s CLIPBOARD TARGETS]]
146
} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
147
test clipboard-5.2 {Tk_ClipboardClear procedure} {
149
clipboard append -t TEST "test"
150
set result [lsort [selection get -s CLIPBOARD TARGETS]]
151
selection own -s CLIPBOARD .
152
lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
154
clipboard append -t TEST "test"
155
lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
156
} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
158
##############################################################################
160
test clipboard-6.1 {Tk_ClipboardAppend procedure} {
162
clipboard append "first chunk"
163
selection own -s CLIPBOARD .
165
clipboard append " second chunk"
166
selection get -s CLIPBOARD
168
} {0 {first chunk second chunk}}
169
test clipboard-6.2 {Tk_ClipboardAppend procedure} {unixOnly} {
172
clipboard append -f INTEGER -t TEST "16"
173
set result [dobg {selection get -s CLIPBOARD TEST}]
177
test clipboard-6.3 {Tk_ClipboardAppend procedure} {
179
clipboard append -f INTEGER -t TEST "16"
180
list [catch {clipboard append -t TEST "test"} msg] $msg
181
} {1 {format "STRING" does not match current format "INTEGER" for TEST}}
183
##############################################################################
185
test clipboard-7.1 {Tk_ClipboardCmd procedure} {
186
list [catch {clipboard} msg] $msg
187
} {1 {wrong # args: should be "clipboard option ?arg arg ...?"}}
188
test clipboard-7.2 {Tk_ClipboardCmd procedure} {
190
list [catch {clipboard append --} msg] $msg \
191
[selection get -selection CLIPBOARD]
193
test clipboard-7.3 {Tk_ClipboardCmd procedure} {
195
list [catch {clipboard append -- information} msg] $msg \
196
[selection get -selection CLIPBOARD]
198
test clipboard-7.4 {Tk_ClipboardCmd procedure} {
199
list [catch {clipboard append --x a b} msg] $msg
200
} {1 {unknown option "--x"}}
201
test clipboard-7.5 {Tk_ClipboardCmd procedure} {
202
list [catch {clipboard append -- a b} msg] $msg
203
} {1 {wrong # args: should be "clipboard append ?options? data"}}
204
test clipboard-7.6 {Tk_ClipboardCmd procedure} {
206
list [catch {clipboard append -format} msg] $msg \
207
[selection get -selection CLIPBOARD]
209
test clipboard-7.7 {Tk_ClipboardCmd procedure} {
210
list [catch {clipboard append -displayofoo f} msg] $msg
211
} {1 {unknown option "-displayofoo"}}
212
test clipboard-7.8 {Tk_ClipboardCmd procedure} {
213
list [catch {clipboard append -type TEST} msg] $msg
214
} {1 {wrong # args: should be "clipboard append ?options? data"}}
215
test clipboard-7.9 {Tk_ClipboardCmd procedure} {
216
list [catch {clipboard append -displayof foo "test"} msg] $msg
217
} {1 {bad window path name "foo"}}
219
test clipboard-7.10 {Tk_ClipboardCmd procedure} {
220
list [catch {clipboard clear -displayof} msg] $msg
221
} {1 {value for "-displayof" missing}}
222
test clipboard-7.11 {Tk_ClipboardCmd procedure} {
223
list [catch {clipboard clear -displayofoo f} msg] $msg
224
} {1 {unknown option "-displayofoo"}}
225
test clipboard-7.12 {Tk_ClipboardCmd procedure} {
226
list [catch {clipboard clear foo} msg] $msg
227
} {1 {wrong # args: should be "clipboard clear ?options?"}}
228
test clipboard-7.13 {Tk_ClipboardCmd procedure} {
229
list [catch {clipboard clear -displayof foo} msg] $msg
230
} {1 {bad window path name "foo"}}
232
test clipboard-7.14 {Tk_ClipboardCmd procedure} {
233
list [catch {clipboard error} msg] $msg
234
} {1 {bad option "error": must be clear or append}}
added
removed
tests/clipboard.test
