1# This file is a Tcl script to test the tk command.
2# It is organized in the standard fashion for Tcl tests.
3#
4# Copyright (c) 1997 Sun Microsystems, Inc.
5# Copyright (c) 1998-1999 by Scriptics Corporation.
6# Copyright (c) 2002 ActiveState Corporation.
7
8package require tcltest 2.2
9eval tcltest::configure $argv
10tcltest::loadTestedCommands
11namespace import -force tcltest::test
12
13test tk-1.1 {tk command: general} -body {
14    tk
15} -returnCodes error -result {wrong # args: should be "tk subcommand ?arg ...?"}
16test tk-1.2 {tk command: general} -body {
17    tk xyz
18} -returnCodes error -result {unknown or ambiguous subcommand "xyz": must be appname, busy, caret, fontchooser, inactive, scaling, useinputmethods, or windowingsystem}
19
20# Value stored to restore default settings after 2.* tests
21set appname [tk appname]
22test tk-2.1 {tk command: appname} -body {
23    tk appname xyz abc
24} -returnCodes error -result {wrong # args: should be "tk appname ?newName?"}
25test tk-2.2 {tk command: appname} -body {
26    tk appname foobazgarply
27} -result {foobazgarply}
28test tk-2.3 {tk command: appname} -constraints unix -body {
29    tk appname bazfoogarply
30    expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
31} -result {1}
32test tk-2.4 {tk command: appname} -body {
33    tk appname [tk appname]
34} -result [tk appname]
35tk appname $appname
36
37# Value stored to restore default settings after 3.* tests
38set scaling [tk scaling]
39test tk-3.1 {tk command: scaling} -body {
40    tk scaling -displayof
41} -returnCodes error -result {value for "-displayof" missing}
42test tk-3.2 {tk command: scaling: get current} -body {
43    tk scaling 1
44    format %.2g [tk scaling]
45}  -result 1
46test tk-3.3 {tk command: scaling: get current} -body {
47    tk scaling -displayof . 1.25
48    format %.3g [tk scaling]
49}  -result 1.25
50test tk-3.4 {tk command: scaling: set new} -body {
51    tk scaling xyz
52} -returnCodes error -result {expected floating-point number but got "xyz"}
53test tk-3.5 {tk command: scaling: set new} -body {
54    tk scaling -displayof . xyz
55} -returnCodes error -result {expected floating-point number but got "xyz"}
56test tk-3.6 {tk command: scaling: set new} -body {
57    tk scaling 1
58    format %.2g [tk scaling]
59} -result 1
60test tk-3.7 {tk command: scaling: set new} -body {
61    tk scaling -displayof . 1.25
62    format %.3g [tk scaling]
63} -result 1.25
64test tk-3.8 {tk command: scaling: negative} -body {
65    tk scaling -1
66    expr {[tk scaling] > 0}
67} -result {1}
68test tk-3.9 {tk command: scaling: too big} -body {
69    tk scaling 1000000
70    expr {[tk scaling] < 10000}
71} -result {1}
72test tk-3.10 {tk command: scaling: widthmm} -body {
73    tk scaling 1.25
74    expr {int((25.4*[winfo screenwidth .])/(72*1.25) + 0.5) \
75        - [winfo screenmmwidth .]}
76} -result {0}
77test tk-3.11 {tk command: scaling: heightmm} -body {
78    tk scaling 1.25
79    expr {int((25.4*[winfo screenheight .])/(72*1.25) + 0.5) \
80        - [winfo screenmmheight .]}
81} -result {0}
82tk scaling $scaling
83
84# Value stored to restore default settings after 4.* tests
85set useim [tk useinputmethods]
86test tk-4.1 {tk command: useinputmethods} -body {
87    tk useinputmethods -displayof
88} -returnCodes error -result {value for "-displayof" missing}
89test tk-4.2 {tk command: useinputmethods: get current} -body {
90    tk useinputmethods no
91} -cleanup {
92    tk useinputmethods $useim
93} -result 0
94test tk-4.3 {tk command: useinputmethods: get current} -body {
95    tk useinputmethods no
96    tk useinputmethods -displayof .
97} -cleanup {
98    tk useinputmethods $useim
99} -result 0
100test tk-4.4 {tk command: useinputmethods: set new} -body {
101    tk useinputmethods xyz
102} -returnCodes error -result {expected boolean value but got "xyz"}
103test tk-4.5 {tk command: useinputmethods: set new} -body {
104    tk useinputmethods -displayof . xyz
105} -returnCodes error -result {expected boolean value but got "xyz"}
106test tk-4.6 {tk command: useinputmethods: set new} -body {
107    # This isn't really a test, but more of a check... The answer is what was
108    # given, because we may be on a Unix system that doesn't have the XIM
109    # stuff
110    if {[tk useinputmethods 1] == 0} {
111	puts "this wish doesn't have XIM (X Input Methods) support"
112    }
113    return $useim
114} -result $useim
115test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body {
116    # Mac and Windows don't have X Input Methods, so this should always return
117    # 0
118    tk useinputmethods 1
119} -cleanup {
120    tk useinputmethods $useim
121} -result 0
122
123test tk-5.1 {tk caret} -body {
124    tk caret
125} -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
126test tk-5.2 {tk caret} -body {
127    tk caret bogus
128} -returnCodes error -result {bad window path name "bogus"}
129test tk-5.3 {tk caret} -body {
130    tk caret . -foo
131} -returnCodes error -result {bad caret option "-foo": must be -x, -y, or -height}
132test tk-5.4 {tk caret} -body {
133    tk caret . -x 0 -y
134} -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
135test tk-5.5 {tk caret} -body {
136    tk caret . -x 10 -y 11 -h 12; tk caret .
137} -result {-height 12 -x 10 -y 11}
138test tk-5.6 {tk caret} -body {
139    tk caret . -x 20 -y 25 -h 30; tk caret . -hei
140} -result {30}
141
142# tk inactive
143test tk-6.1 {tk inactive} -body {
144    string is integer [tk inactive]
145} -result 1
146test tk-6.2 {tk inactive reset} -body {
147    tk inactive reset
148} -returnCodes ok -match glob -result *
149test tk-6.3 {tk inactive wrong argument} -body {
150    tk inactive foo
151} -returnCodes 1 -result {bad option "foo": must be reset}
152test tk-6.4 {tk inactive too many arguments} -body {
153    tk inactive reset foo
154} -returnCodes 1 -result {wrong # args: should be "tk inactive ?-displayof window? ?reset?"}
155test tk-6.5 {tk inactive} -body {
156    tk inactive reset
157    update
158    after 100
159    set i [tk inactive]
160    expr {$i < 0 || ( $i > 90 && $i < 300 )}
161} -result 1
162
163test tk-7.1 {tk inactive in a safe interpreter} -body {
164# tk inactive in safe interpreters
165    safe::interpCreate foo
166    safe::loadTk foo
167    foo eval {tk inactive}
168} -cleanup {
169    ::safe::interpDelete foo
170} -result -1
171test tk-7.2 {tk inactive reset in a safe interpreter} -body {
172# tk inactive in safe interpreters
173    safe::interpCreate foo
174    safe::loadTk foo
175    foo eval {tk inactive reset}
176} -cleanup {
177    ::safe::interpDelete foo
178} -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}
179
180# tests of [tk busy] in busy.test
181
182# cleanup
183cleanupTests
184return
185