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.
4#
5# Copyright (c) 1994 Sun Microsystems, Inc.
6# Copyright (c) 1998-1999 by Scriptics Corporation.
7# All rights reserved.
8#
9# RCS: @(#) $Id$
10
11#
12# Note: Multiple display clipboard handling will only be tested if the
13# environment variable TK_ALT_DISPLAY is set to an alternate display.
14#
15
16package require tcltest 2.1
17eval tcltest::configure $argv
18tcltest::loadTestedCommands
19
20# set up a very large buffer to test INCR retrievals
21set longValue ""
22foreach 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} {
23    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
24    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
25}
26
27# Now we start the main body of the test code
28
29test clipboard-1.1 {ClipboardHandler procedure} {
30    clipboard clear
31    clipboard append "test"
32    clipboard get
33} {test}
34test clipboard-1.2 {ClipboardHandler procedure} {
35    clipboard clear
36    clipboard append "test"
37    clipboard append "ing"
38    clipboard get
39} {testing}
40test clipboard-1.3 {ClipboardHandler procedure} {
41    clipboard clear
42    clipboard append "t"
43    clipboard append "e"
44    clipboard append "s"
45    clipboard append "t"
46    clipboard get
47} {test}
48test clipboard-1.4 {ClipboardHandler procedure} {
49    clipboard clear
50    clipboard append $longValue
51    clipboard get
52} "$longValue"
53test clipboard-1.5 {ClipboardHandler procedure} {
54    clipboard clear
55    clipboard append $longValue
56    clipboard append "test"
57    clipboard get
58} "${longValue}test"
59test clipboard-1.6 {ClipboardHandler procedure} {
60    clipboard clear
61    clipboard append -t TEST $longValue
62    clipboard append -t STRING "test"
63    list [clipboard get -t STRING] \
64	[clipboard get -t TEST]
65} [list test $longValue]
66test clipboard-1.7 {ClipboardHandler procedure} {
67    clipboard clear
68    clipboard append -t TEST [string range $longValue 1 4000]
69    clipboard append -t STRING "test"
70    list [clipboard get -t STRING] \
71	[clipboard get -t TEST]
72} [list test [string range $longValue 1 4000]]
73test clipboard-1.8 {ClipboardHandler procedure} {
74    clipboard clear
75    clipboard append ""
76    clipboard get
77} {}
78test clipboard-1.9 {ClipboardHandler procedure} {
79    clipboard clear
80    clipboard append ""
81    clipboard append "Test"
82    clipboard get
83} {Test}
84
85##############################################################################
86
87test clipboard-2.1 {ClipboardAppHandler procedure} {
88    set oldAppName [tk appname]
89    tk appname UnexpectedName
90    clipboard clear
91    clipboard append -type NEW_TYPE Data
92    set result [selection get -selection CLIPBOARD -type TK_APPLICATION]
93    tk appname $oldAppName
94    set result
95} {UnexpectedName}
96
97##############################################################################
98
99test clipboard-3.1 {ClipboardWindowHandler procedure} {
100    set oldAppName [tk appname]
101    tk appname UnexpectedName
102    clipboard clear
103    clipboard append -type NEW_TYPE Data
104    set result [selection get -selection CLIPBOARD -type TK_WINDOW]
105    tk appname $oldAppName
106    set result
107} {.}
108
109##############################################################################
110
111test clipboard-4.1 {ClipboardLostSel procedure} {
112    clipboard clear
113    clipboard append "Test"
114    selection clear -s CLIPBOARD
115    list [catch {clipboard get} msg] $msg
116} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}}
117test clipboard-4.2 {ClipboardLostSel procedure} {
118    clipboard clear
119    clipboard append "Test"
120    clipboard append -t TEST "Test2"
121    selection clear -s CLIPBOARD
122    list [catch {clipboard get} msg] $msg \
123	[catch {clipboard get -t TEST} msg] $msg
124} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
125test clipboard-4.3 {ClipboardLostSel procedure} {
126    clipboard clear
127    clipboard append "Test"
128    clipboard append -t TEST "Test2"
129    clipboard append "Test3"
130    selection clear -s CLIPBOARD
131    list [catch {clipboard get} msg] $msg \
132	[catch {clipboard get -t TEST} msg] $msg
133} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
134
135##############################################################################
136
137test clipboard-5.1 {Tk_ClipboardClear procedure} {
138    clipboard clear
139    clipboard append -t TEST "test"
140    set result [lsort [clipboard get TARGETS]]
141    clipboard clear
142    list $result [lsort [clipboard get TARGETS]]
143} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
144test clipboard-5.2 {Tk_ClipboardClear procedure} {
145    clipboard clear
146    clipboard append -t TEST "test"
147    set result [lsort [clipboard get TARGETS]]
148    selection own -s CLIPBOARD .
149    lappend result [lsort [clipboard get TARGETS]]
150    clipboard clear
151    clipboard append -t TEST "test"
152    lappend result [lsort [clipboard get TARGETS]]
153} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
154
155##############################################################################
156
157test clipboard-6.1 {Tk_ClipboardAppend procedure} {
158    clipboard clear
159    clipboard append "first chunk"
160    selection own -s CLIPBOARD .
161    list [catch {
162	clipboard append " second chunk"
163	clipboard get
164    } msg] $msg
165} {0 {first chunk second chunk}}
166test clipboard-6.2 {Tk_ClipboardAppend procedure} unix {
167    setupbg
168    clipboard clear
169    clipboard append -f INTEGER -t TEST "16"
170    set result [dobg {clipboard get TEST}]
171    cleanupbg
172    set result
173} {0x10 }
174test clipboard-6.3 {Tk_ClipboardAppend procedure} {
175    clipboard clear
176    clipboard append -f INTEGER -t TEST "16"
177    list [catch {clipboard append -t TEST "test"} msg] $msg
178} {1 {format "STRING" does not match current format "INTEGER" for TEST}}
179
180##############################################################################
181
182test clipboard-7.1 {Tk_ClipboardCmd procedure} {
183    list [catch {clipboard} msg] $msg
184} {1 {wrong # args: should be "clipboard option ?arg arg ...?"}}
185test clipboard-7.2 {Tk_ClipboardCmd procedure} {
186    clipboard clear
187    list [catch {clipboard append --} msg] $msg \
188	    [selection get -selection CLIPBOARD]
189} {0 {} --}
190test clipboard-7.3 {Tk_ClipboardCmd procedure} {
191    clipboard clear
192    list [catch {clipboard append -- information} msg] $msg \
193	    [selection get -selection CLIPBOARD]
194} {0 {} information}
195test clipboard-7.4 {Tk_ClipboardCmd procedure} {
196    list [catch {clipboard append --x a b} msg] $msg
197} {1 {bad option "--x": must be -displayof, -format, or -type}}
198test clipboard-7.5 {Tk_ClipboardCmd procedure} {
199    list [catch {clipboard append -- a b} msg] $msg
200} {1 {wrong # args: should be "clipboard append ?options? data"}}
201test clipboard-7.6 {Tk_ClipboardCmd procedure} {
202    clipboard clear
203    list [catch {clipboard append -format} msg] $msg \
204	    [selection get -selection CLIPBOARD]
205} {0 {} -format}
206test clipboard-7.7 {Tk_ClipboardCmd procedure} {
207    list [catch {clipboard append -displayofoo f} msg] $msg
208} {1 {bad option "-displayofoo": must be -displayof, -format, or -type}}
209test clipboard-7.8 {Tk_ClipboardCmd procedure} {
210    list [catch {clipboard append -type TEST} msg] $msg
211} {1 {wrong # args: should be "clipboard append ?options? data"}}
212test clipboard-7.9 {Tk_ClipboardCmd procedure} {
213    list [catch {clipboard append -displayof foo "test"} msg] $msg
214} {1 {bad window path name "foo"}}
215
216test clipboard-7.10 {Tk_ClipboardCmd procedure} {
217    list [catch {clipboard clear -displayof} msg] $msg
218} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}}
219test clipboard-7.11 {Tk_ClipboardCmd procedure} {
220    list [catch {clipboard clear -displayofoo f} msg] $msg
221} {1 {bad option "-displayofoo": must be -displayof}}
222test clipboard-7.12 {Tk_ClipboardCmd procedure} {
223    list [catch {clipboard clear foo} msg] $msg
224} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}}
225test clipboard-7.13 {Tk_ClipboardCmd procedure} {
226    list [catch {clipboard clear -displayof foo} msg] $msg
227} {1 {bad window path name "foo"}}
228
229test clipboard-7.14 {Tk_ClipboardCmd procedure} {
230    list [catch {clipboard error} msg] $msg
231} {1 {bad option "error": must be append, clear, or get}}
232
233test clipboard-7.15 {Tk_ClipboardCmd procedure} {
234    clipboard clear
235    list [catch {clipboard append -displayof} msg] $msg \
236	    [selection get -selection CLIPBOARD]
237} {0 {} -displayof}
238test clipboard-7.16 {Tk_ClipboardCmd procedure} {
239    clipboard clear
240    list [catch {clipboard append -type} msg] $msg \
241	    [selection get -selection CLIPBOARD]
242} {0 {} -type}
243
244# cleanup
245cleanupTests
246return
247