Tk Source Code

Check-in [39ba3d50]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix msgbox.test expected results when running on macOS
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-66db98f30d
Files: files | file ages | folders
SHA3-256: 39ba3d5069360f4b28d0d218c48d98c42316f6388d3dd5fa7616afd9e344f7d0
User & Date: fvogel 2018-05-01 10:46:30
References
2018-05-01
10:49 Ticket [66db98f3] choosedir-1.5 fails on macOS + undocumented options -message and -command status still Open with 3 other changes artifact: ee385081 user: fvogel
Context
2018-05-01
11:49
Fix mistake in previous commit check-in: ee50df16 user: fvogel tags: bug-66db98f30d
10:46
Fix msgbox.test expected results when running on macOS check-in: 39ba3d50 user: fvogel tags: bug-66db98f30d
10:15
Document -command macOS-specific option of tk_messageBox check-in: 1c3b84d4 user: fvogel tags: bug-66db98f30d
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to library/msgbox.tcl.

151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
...
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
        {-type "" "" "ok"}
    }

    tclParseConfigSpec $w $specs "" $args

    if {$data(-icon) ni {info warning error question}} {
	return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \
	    "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
    }
    set windowingsystem [tk windowingsystem]
    if {$windowingsystem eq "aqua"} {
	switch -- $data(-icon) {
	    "error"     {set data(-icon) "stop"}
	    "warning"   {set data(-icon) "caution"}
	    "info"      {set data(-icon) "note"}
................................................................................
	yesnocancel {
	    set names [list yes no cancel]
	    set labels [list &Yes &No &Cancel]
	    set cancel cancel
	}
	default {
	    return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \
		"bad -type value \"$data(-type)\": must be\
		abortretryignore, ok, okcancel, retrycancel,\
		yesno, or yesnocancel"
	}
    }

    set buttons {}
    foreach name $names lab $labels {






|







 







|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
...
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
        {-type "" "" "ok"}
    }

    tclParseConfigSpec $w $specs "" $args

    if {$data(-icon) ni {info warning error question}} {
	return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \
	    "bad value \"$data(-icon)\": must be error, info, question, or warning"
    }
    set windowingsystem [tk windowingsystem]
    if {$windowingsystem eq "aqua"} {
	switch -- $data(-icon) {
	    "error"     {set data(-icon) "stop"}
	    "warning"   {set data(-icon) "caution"}
	    "info"      {set data(-icon) "note"}
................................................................................
	yesnocancel {
	    set names [list yes no cancel]
	    set labels [list &Yes &No &Cancel]
	    set cancel cancel
	}
	default {
	    return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \
		"bad value \"$data(-type)\": must be\
		abortretryignore, ok, okcancel, retrycancel,\
		yesno, or yesnocancel"
	}
    }

    set buttons {}
    foreach name $names lab $labels {

Changes to tests/msgbox.test.

7
8
9
10
11
12
13
14
15
16
17



18
19



20
21
22
23
24
25
26
..
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
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test


test msgbox-1.1 {tk_messageBox command} -body {
    tk_messageBox -foo
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}
test msgbox-1.2 {tk_messageBox command} -body {



    tk_messageBox -foo bar
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}




test msgbox-1.3 {tk_messageBox command} -body {
    tk_messageBox -default
} -returnCodes error -result {value for "-default" missing}
test msgbox-1.4 {tk_messageBox command} -body {
    tk_messageBox -detail
} -returnCodes error -result {value for "-detail" missing}
................................................................................

test msgbox-1.10 {tk_messageBox command} -body {
    tk_messageBox -default
} -returnCodes error -result {value for "-default" missing}

test msgbox-1.11 {tk_messageBox command} -body {
    tk_messageBox -type foo
} -returnCodes error -result {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}

test msgbox-1.12 {tk_messageBox command} -constraints unix -body {
    tk_messageBox -default 1.1
} -returnCodes error -result {invalid default button "1.1"}
test msgbox-1.13 {tk_messageBox command} -constraints macOrWin -body {
    tk_messageBox -default 1.1
} -returnCodes error -result {bad -default value "1.1": must be abort, retry, ignore, ok, cancel, no, or yes}

test msgbox-1.14 {tk_messageBox command} -constraints unix -body {
    tk_messageBox -default foo
} -returnCodes error -result {invalid default button "foo"}
test msgbox-1.15 {tk_messageBox command} -constraints macOrWin -body {
    tk_messageBox -default foo
} -returnCodes error -result {bad -default value "foo": must be abort, retry, ignore, ok, cancel, no, or yes}

test msgbox-1.16 {tk_messageBox command} -constraints unix -body {
    tk_messageBox -type yesno -default 3
} -returnCodes error -result {invalid default button "3"}
test msgbox-1.17 {tk_messageBox command} -constraints macOrWin -body {
    tk_messageBox -type yesno -default 3
} -returnCodes error -result {bad -default value "3": must be abort, retry, ignore, ok, cancel, no, or yes}

test msgbox-1.18 {tk_messageBox command} -body {
    tk_messageBox -icon foo
} -returnCodes error -result {bad -icon value "foo": must be error, info, question, or warning}
test msgbox-1.19 {tk_messageBox command} -body {
    tk_messageBox -parent foo.bar
} -returnCodes error -result {bad window path name "foo.bar"}


catch {tk_messageBox -foo bar}
set isNative [expr {[info commands tk::MessageBox] == ""}]






|


|
>
>
>


>
>
>







 







|

|


|

|

|


|

|

|


|

|



|







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
..
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
package require tcltest 2.2
eval tcltest::configure $argv
tcltest::loadTestedCommands
namespace import -force tcltest::test


test msgbox-1.1.1 {tk_messageBox command} -constraints notAqua -body {
    tk_messageBox -foo
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}
test msgbox-1.1.2 {tk_messageBox command} -constraints notAqua -body {
    tk_messageBox -foo
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, -type, or -command}
test msgbox-1.2.1 {tk_messageBox command} -constraints notAqua -body {
    tk_messageBox -foo bar
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, or -type}
test msgbox-1.2.2 {tk_messageBox command} -constraints aqua -body {
    tk_messageBox -foo bar
} -returnCodes error -result {bad option "-foo": must be -default, -detail, -icon, -message, -parent, -title, -type, or -command}

test msgbox-1.3 {tk_messageBox command} -body {
    tk_messageBox -default
} -returnCodes error -result {value for "-default" missing}
test msgbox-1.4 {tk_messageBox command} -body {
    tk_messageBox -detail
} -returnCodes error -result {value for "-detail" missing}
................................................................................

test msgbox-1.10 {tk_messageBox command} -body {
    tk_messageBox -default
} -returnCodes error -result {value for "-default" missing}

test msgbox-1.11 {tk_messageBox command} -body {
    tk_messageBox -type foo
} -returnCodes error -result {bad value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}

test msgbox-1.12 {tk_messageBox command} -constraints x11 -body {
    tk_messageBox -default 1.1
} -returnCodes error -result {invalid default button "1.1"}
test msgbox-1.13 {tk_messageBox command} -constraints aquaOrWin32 -body {
    tk_messageBox -default 1.1
} -returnCodes error -result {bad value "1.1": must be abort, retry, ignore, ok, cancel, yes, or no}

test msgbox-1.14 {tk_messageBox command} -constraints x11 -body {
    tk_messageBox -default foo
} -returnCodes error -result {invalid default button "foo"}
test msgbox-1.15 {tk_messageBox command} -constraints aquaOrWin32 -body {
    tk_messageBox -default foo
} -returnCodes error -result {bad value "foo": must be abort, retry, ignore, ok, cancel, yes, or no}

test msgbox-1.16 {tk_messageBox command} -constraints x11 -body {
    tk_messageBox -type yesno -default 3
} -returnCodes error -result {invalid default button "3"}
test msgbox-1.17 {tk_messageBox command} -constraints aquaOrWin32 -body {
    tk_messageBox -type yesno -default 3
} -returnCodes error -result {bad value "3": must be abort, retry, ignore, ok, cancel, yes, or no}

test msgbox-1.18 {tk_messageBox command} -body {
    tk_messageBox -icon foo
} -returnCodes error -result {bad value "foo": must be error, info, question, or warning}
test msgbox-1.19 {tk_messageBox command} -body {
    tk_messageBox -parent foo.bar
} -returnCodes error -result {bad window path name "foo.bar"}


catch {tk_messageBox -foo bar}
set isNative [expr {[info commands tk::MessageBox] == ""}]