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