Tk Source Code

Check-in [c2a16489]
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:Make msgbox.test pass on all platforms (checked on Win Vista, Linux Debian 8 and macOS 10.12.6)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-66db98f30d
Files: files | file ages | folders
SHA3-256: c2a1648922e0b68b56689372fca82e4cbb5bf13955f92a5dfd790e9933b6a63c
User & Date: fvogel 2018-05-01 12:20:42
Original Comment: Make msgbox.test pass on all platforms (hopefully)
Context
2018-05-01
12:37
Unify error messages for wrong values of 'tk_messageBox -default' among platforms: Windows and X11 now return the same error check-in: f89fc3bb user: fvogel tags: bug-66db98f30d
12:20
Make msgbox.test pass on all platforms (checked on Win Vista, Linux Debian 8 and macOS 10.12.6) check-in: c2a16489 user: fvogel tags: bug-66db98f30d
11:49
Fix mistake in previous commit check-in: ee50df16 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 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 {






|







 







|







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 {

Changes to tests/msgbox.test.

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
82
83
84
85
86
87
    tk_messageBox -type
} -returnCodes error -result {value for "-type" 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] == ""}]






>
>
>
|






|


>
>
>




|


>
>
>




|


>
>
>

|

>
>
>

>







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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
    tk_messageBox -type
} -returnCodes error -result {value for "-type" missing}

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

test msgbox-1.11.1 {tk_messageBox command} -constraints notAqua -body {
    tk_messageBox -type foo
} -returnCodes error -result {bad -type value "foo": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel}
test msgbox-1.11.2 {tk_messageBox command} -constraints aqua -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 aqua -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.13a {tk_messageBox command} -constraints win -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 x11 -body {
    tk_messageBox -default foo
} -returnCodes error -result {invalid default button "foo"}
test msgbox-1.15 {tk_messageBox command} -constraints aqua -body {
    tk_messageBox -default foo
} -returnCodes error -result {bad value "foo": must be abort, retry, ignore, ok, cancel, yes, or no}
test msgbox-1.15a {tk_messageBox command} -constraints win -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 x11 -body {
    tk_messageBox -type yesno -default 3
} -returnCodes error -result {invalid default button "3"}
test msgbox-1.17 {tk_messageBox command} -constraints aqua -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.17a {tk_messageBox command} -constraints win -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} -constraints notAqua -body {
    tk_messageBox -icon foo
} -returnCodes error -result {bad -icon value "foo": must be error, info, question, or warning}
test msgbox-1.18a {tk_messageBox command} -constraints aqua -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] == ""}]