[37] | 1 | # msgbox.tcl -- |
---|
| 2 | # |
---|
| 3 | # Implements messageboxes for platforms that do not have native |
---|
| 4 | # messagebox support. |
---|
| 5 | # |
---|
| 6 | # RCS: @(#) $Id: msgbox.tcl,v 1.24.2.2 2004/05/13 23:28:34 dkf Exp $ |
---|
| 7 | # |
---|
| 8 | # Copyright (c) 1994-1997 Sun Microsystems, Inc. |
---|
| 9 | # |
---|
| 10 | # See the file "license.terms" for information on usage and redistribution |
---|
| 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | # |
---|
| 13 | |
---|
| 14 | # Ensure existence of ::tk::dialog namespace |
---|
| 15 | # |
---|
| 16 | namespace eval ::tk::dialog {} |
---|
| 17 | |
---|
| 18 | image create bitmap ::tk::dialog::b1 -foreground black \ |
---|
| 19 | -data "#define b1_width 32\n#define b1_height 32 |
---|
| 20 | static unsigned char q1_bits[] = { |
---|
| 21 | 0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03, |
---|
| 22 | 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, |
---|
| 23 | 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40, |
---|
| 24 | 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, |
---|
| 25 | 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, |
---|
| 26 | 0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40, |
---|
| 27 | 0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08, |
---|
| 28 | 0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00, |
---|
| 29 | 0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, |
---|
| 30 | 0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00, |
---|
| 31 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" |
---|
| 32 | image create bitmap ::tk::dialog::b2 -foreground white \ |
---|
| 33 | -data "#define b2_width 32\n#define b2_height 32 |
---|
| 34 | static unsigned char b2_bits[] = { |
---|
| 35 | 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00, |
---|
| 36 | 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, |
---|
| 37 | 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f, |
---|
| 38 | 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, |
---|
| 39 | 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, |
---|
| 40 | 0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f, |
---|
| 41 | 0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07, |
---|
| 42 | 0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00, |
---|
| 43 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, |
---|
| 44 | 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 45 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" |
---|
| 46 | image create bitmap ::tk::dialog::q -foreground blue \ |
---|
| 47 | -data "#define q_width 32\n#define q_height 32 |
---|
| 48 | static unsigned char q_bits[] = { |
---|
| 49 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 50 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00, |
---|
| 51 | 0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00, |
---|
| 52 | 0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00, |
---|
| 53 | 0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, |
---|
| 54 | 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, |
---|
| 55 | 0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 56 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 57 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 58 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 59 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" |
---|
| 60 | image create bitmap ::tk::dialog::i -foreground blue \ |
---|
| 61 | -data "#define i_width 32\n#define i_height 32 |
---|
| 62 | static unsigned char i_bits[] = { |
---|
| 63 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 64 | 0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, |
---|
| 65 | 0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 66 | 0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, |
---|
| 67 | 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, |
---|
| 68 | 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00, |
---|
| 69 | 0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 70 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 71 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 72 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 73 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" |
---|
| 74 | image create bitmap ::tk::dialog::w1 -foreground black \ |
---|
| 75 | -data "#define w1_width 32\n#define w1_height 32 |
---|
| 76 | static unsigned char w1_bits[] = { |
---|
| 77 | 0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00, |
---|
| 78 | 0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, |
---|
| 79 | 0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00, |
---|
| 80 | 0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00, |
---|
| 81 | 0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01, |
---|
| 82 | 0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02, |
---|
| 83 | 0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, |
---|
| 84 | 0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10, |
---|
| 85 | 0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40, |
---|
| 86 | 0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, |
---|
| 87 | 0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};" |
---|
| 88 | image create bitmap ::tk::dialog::w2 -foreground yellow \ |
---|
| 89 | -data "#define w2_width 32\n#define w2_height 32 |
---|
| 90 | static unsigned char w2_bits[] = { |
---|
| 91 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, |
---|
| 92 | 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00, |
---|
| 93 | 0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00, |
---|
| 94 | 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00, |
---|
| 95 | 0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00, |
---|
| 96 | 0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01, |
---|
| 97 | 0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, |
---|
| 98 | 0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f, |
---|
| 99 | 0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f, |
---|
| 100 | 0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f, |
---|
| 101 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" |
---|
| 102 | image create bitmap ::tk::dialog::w3 -foreground black \ |
---|
| 103 | -data "#define w3_width 32\n#define w3_height 32 |
---|
| 104 | static unsigned char w3_bits[] = { |
---|
| 105 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 106 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 107 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 108 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, |
---|
| 109 | 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, |
---|
| 110 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, |
---|
| 111 | 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, |
---|
| 112 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, |
---|
| 113 | 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 114 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, |
---|
| 115 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" |
---|
| 116 | |
---|
| 117 | # ::tk::MessageBox -- |
---|
| 118 | # |
---|
| 119 | # Pops up a messagebox with an application-supplied message with |
---|
| 120 | # an icon and a list of buttons. This procedure will be called |
---|
| 121 | # by tk_messageBox if the platform does not have native |
---|
| 122 | # messagebox support, or if the particular type of messagebox is |
---|
| 123 | # not supported natively. |
---|
| 124 | # |
---|
| 125 | # Color icons are used on Unix displays that have a color |
---|
| 126 | # depth of 4 or more and $tk_strictMotif is not on. |
---|
| 127 | # |
---|
| 128 | # This procedure is a private procedure shouldn't be called |
---|
| 129 | # directly. Call tk_messageBox instead. |
---|
| 130 | # |
---|
| 131 | # See the user documentation for details on what tk_messageBox does. |
---|
| 132 | # |
---|
| 133 | proc ::tk::MessageBox {args} { |
---|
| 134 | global tcl_platform tk_strictMotif |
---|
| 135 | variable ::tk::Priv |
---|
| 136 | |
---|
| 137 | set w ::tk::PrivMsgBox |
---|
| 138 | upvar $w data |
---|
| 139 | |
---|
| 140 | # |
---|
| 141 | # The default value of the title is space (" ") not the empty string |
---|
| 142 | # because for some window managers, a |
---|
| 143 | # wm title .foo "" |
---|
| 144 | # causes the window title to be "foo" instead of the empty string. |
---|
| 145 | # |
---|
| 146 | set specs { |
---|
| 147 | {-default "" "" ""} |
---|
| 148 | {-icon "" "" "info"} |
---|
| 149 | {-message "" "" ""} |
---|
| 150 | {-parent "" "" .} |
---|
| 151 | {-title "" "" " "} |
---|
| 152 | {-type "" "" "ok"} |
---|
| 153 | } |
---|
| 154 | |
---|
| 155 | tclParseConfigSpec $w $specs "" $args |
---|
| 156 | |
---|
| 157 | if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { |
---|
| 158 | error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" |
---|
| 159 | } |
---|
| 160 | if {[string equal [tk windowingsystem] "classic"] |
---|
| 161 | || [string equal [tk windowingsystem] "aqua"]} { |
---|
| 162 | switch -- $data(-icon) { |
---|
| 163 | "error" {set data(-icon) "stop"} |
---|
| 164 | "warning" {set data(-icon) "caution"} |
---|
| 165 | "info" {set data(-icon) "note"} |
---|
| 166 | } |
---|
| 167 | } |
---|
| 168 | |
---|
| 169 | if {![winfo exists $data(-parent)]} { |
---|
| 170 | error "bad window path name \"$data(-parent)\"" |
---|
| 171 | } |
---|
| 172 | |
---|
| 173 | switch -- $data(-type) { |
---|
| 174 | abortretryignore { |
---|
| 175 | set names [list abort retry ignore] |
---|
| 176 | set labels [list &Abort &Retry &Ignore] |
---|
| 177 | } |
---|
| 178 | ok { |
---|
| 179 | set names [list ok] |
---|
| 180 | set labels {&OK} |
---|
| 181 | } |
---|
| 182 | okcancel { |
---|
| 183 | set names [list ok cancel] |
---|
| 184 | set labels [list &OK &Cancel] |
---|
| 185 | } |
---|
| 186 | retrycancel { |
---|
| 187 | set names [list retry cancel] |
---|
| 188 | set labels [list &Retry &Cancel] |
---|
| 189 | } |
---|
| 190 | yesno { |
---|
| 191 | set names [list yes no] |
---|
| 192 | set labels [list &Yes &No] |
---|
| 193 | } |
---|
| 194 | yesnocancel { |
---|
| 195 | set names [list yes no cancel] |
---|
| 196 | set labels [list &Yes &No &Cancel] |
---|
| 197 | } |
---|
| 198 | default { |
---|
| 199 | error "bad -type value \"$data(-type)\": must be\ |
---|
| 200 | abortretryignore, ok, okcancel, retrycancel,\ |
---|
| 201 | yesno, or yesnocancel" |
---|
| 202 | } |
---|
| 203 | } |
---|
| 204 | |
---|
| 205 | set buttons {} |
---|
| 206 | foreach name $names lab $labels { |
---|
| 207 | lappend buttons [list $name -text [mc $lab]] |
---|
| 208 | } |
---|
| 209 | |
---|
| 210 | # If no default button was specified, the default default is the |
---|
| 211 | # first button (Bug: 2218). |
---|
| 212 | |
---|
| 213 | if {$data(-default) == ""} { |
---|
| 214 | set data(-default) [lindex [lindex $buttons 0] 0] |
---|
| 215 | } |
---|
| 216 | |
---|
| 217 | set valid 0 |
---|
| 218 | foreach btn $buttons { |
---|
| 219 | if {[string equal [lindex $btn 0] $data(-default)]} { |
---|
| 220 | set valid 1 |
---|
| 221 | break |
---|
| 222 | } |
---|
| 223 | } |
---|
| 224 | if {!$valid} { |
---|
| 225 | error "invalid default button \"$data(-default)\"" |
---|
| 226 | } |
---|
| 227 | |
---|
| 228 | # 2. Set the dialog to be a child window of $parent |
---|
| 229 | # |
---|
| 230 | # |
---|
| 231 | if {[string compare $data(-parent) .]} { |
---|
| 232 | set w $data(-parent).__tk__messagebox |
---|
| 233 | } else { |
---|
| 234 | set w .__tk__messagebox |
---|
| 235 | } |
---|
| 236 | |
---|
| 237 | # 3. Create the top-level window and divide it into top |
---|
| 238 | # and bottom parts. |
---|
| 239 | |
---|
| 240 | catch {destroy $w} |
---|
| 241 | toplevel $w -class Dialog |
---|
| 242 | wm title $w $data(-title) |
---|
| 243 | wm iconname $w Dialog |
---|
| 244 | wm protocol $w WM_DELETE_WINDOW { } |
---|
| 245 | # There is only one background colour for the whole dialog |
---|
| 246 | set bg [$w cget -background] |
---|
| 247 | |
---|
| 248 | # Message boxes should be transient with respect to their parent so that |
---|
| 249 | # they always stay on top of the parent window. But some window managers |
---|
| 250 | # will simply create the child window as withdrawn if the parent is not |
---|
| 251 | # viewable (because it is withdrawn or iconified). This is not good for |
---|
| 252 | # "grab"bed windows. So only make the message box transient if the parent |
---|
| 253 | # is viewable. |
---|
| 254 | # |
---|
| 255 | if {[winfo viewable [winfo toplevel $data(-parent)]] } { |
---|
| 256 | wm transient $w $data(-parent) |
---|
| 257 | } |
---|
| 258 | |
---|
| 259 | if {[string equal [tk windowingsystem] "classic"] |
---|
| 260 | || [string equal [tk windowingsystem] "aqua"]} { |
---|
| 261 | unsupported::MacWindowStyle style $w dBoxProc |
---|
| 262 | } |
---|
| 263 | |
---|
| 264 | frame $w.bot -background $bg |
---|
| 265 | pack $w.bot -side bottom -fill both |
---|
| 266 | frame $w.top -background $bg |
---|
| 267 | pack $w.top -side top -fill both -expand 1 |
---|
| 268 | if {![string equal [tk windowingsystem] "classic"] |
---|
| 269 | && ![string equal [tk windowingsystem] "aqua"]} { |
---|
| 270 | $w.bot configure -relief raised -bd 1 |
---|
| 271 | $w.top configure -relief raised -bd 1 |
---|
| 272 | } |
---|
| 273 | |
---|
| 274 | # 4. Fill the top part with bitmap and message (use the option |
---|
| 275 | # database for -wraplength and -font so that they can be |
---|
| 276 | # overridden by the caller). |
---|
| 277 | |
---|
| 278 | option add *Dialog.msg.wrapLength 3i widgetDefault |
---|
| 279 | if {[string equal [tk windowingsystem] "classic"] |
---|
| 280 | || [string equal [tk windowingsystem] "aqua"]} { |
---|
| 281 | option add *Dialog.msg.font system widgetDefault |
---|
| 282 | } else { |
---|
| 283 | option add *Dialog.msg.font {Times 14} widgetDefault |
---|
| 284 | } |
---|
| 285 | |
---|
| 286 | label $w.msg -anchor nw -justify left -text $data(-message) \ |
---|
| 287 | -background $bg |
---|
| 288 | if {[string compare $data(-icon) ""]} { |
---|
| 289 | if {([string equal [tk windowingsystem] "classic"] |
---|
| 290 | || [string equal [tk windowingsystem] "aqua"]) |
---|
| 291 | || ([winfo depth $w] < 4) || $tk_strictMotif} { |
---|
| 292 | label $w.bitmap -bitmap $data(-icon) -background $bg |
---|
| 293 | } else { |
---|
| 294 | canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ |
---|
| 295 | -background $bg |
---|
| 296 | switch $data(-icon) { |
---|
| 297 | error { |
---|
| 298 | $w.bitmap create oval 0 0 31 31 -fill red -outline black |
---|
| 299 | $w.bitmap create line 9 9 23 23 -fill white -width 4 |
---|
| 300 | $w.bitmap create line 9 23 23 9 -fill white -width 4 |
---|
| 301 | } |
---|
| 302 | info { |
---|
| 303 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 304 | -image ::tk::dialog::b1 |
---|
| 305 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 306 | -image ::tk::dialog::b2 |
---|
| 307 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 308 | -image ::tk::dialog::i |
---|
| 309 | } |
---|
| 310 | question { |
---|
| 311 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 312 | -image ::tk::dialog::b1 |
---|
| 313 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 314 | -image ::tk::dialog::b2 |
---|
| 315 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 316 | -image ::tk::dialog::q |
---|
| 317 | } |
---|
| 318 | default { |
---|
| 319 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 320 | -image ::tk::dialog::w1 |
---|
| 321 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 322 | -image ::tk::dialog::w2 |
---|
| 323 | $w.bitmap create image 0 0 -anchor nw \ |
---|
| 324 | -image ::tk::dialog::w3 |
---|
| 325 | } |
---|
| 326 | } |
---|
| 327 | } |
---|
| 328 | } |
---|
| 329 | grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m |
---|
| 330 | grid columnconfigure $w.top 1 -weight 1 |
---|
| 331 | grid rowconfigure $w.top 0 -weight 1 |
---|
| 332 | |
---|
| 333 | # 5. Create a row of buttons at the bottom of the dialog. |
---|
| 334 | |
---|
| 335 | set i 0 |
---|
| 336 | foreach but $buttons { |
---|
| 337 | set name [lindex $but 0] |
---|
| 338 | set opts [lrange $but 1 end] |
---|
| 339 | if {![llength $opts]} { |
---|
| 340 | # Capitalize the first letter of $name |
---|
| 341 | set capName [string toupper $name 0] |
---|
| 342 | set opts [list -text $capName] |
---|
| 343 | } |
---|
| 344 | |
---|
| 345 | eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \ |
---|
| 346 | [list -command [list set tk::Priv(button) $name]] |
---|
| 347 | |
---|
| 348 | if {[string equal $name $data(-default)]} { |
---|
| 349 | $w.$name configure -default active |
---|
| 350 | } else { |
---|
| 351 | $w.$name configure -default normal |
---|
| 352 | } |
---|
| 353 | grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew |
---|
| 354 | grid columnconfigure $w.bot $i -uniform buttons |
---|
| 355 | incr i |
---|
| 356 | |
---|
| 357 | # create the binding for the key accelerator, based on the underline |
---|
| 358 | # |
---|
| 359 | # set underIdx [$w.$name cget -under] |
---|
| 360 | # if {$underIdx >= 0} { |
---|
| 361 | # set key [string index [$w.$name cget -text] $underIdx] |
---|
| 362 | # bind $w <Alt-[string tolower $key]> [list $w.$name invoke] |
---|
| 363 | # bind $w <Alt-[string toupper $key]> [list $w.$name invoke] |
---|
| 364 | # } |
---|
| 365 | } |
---|
| 366 | bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] |
---|
| 367 | |
---|
| 368 | if {[string compare {} $data(-default)]} { |
---|
| 369 | bind $w <FocusIn> { |
---|
| 370 | if {[string equal Button [winfo class %W]]} { |
---|
| 371 | %W configure -default active |
---|
| 372 | } |
---|
| 373 | } |
---|
| 374 | bind $w <FocusOut> { |
---|
| 375 | if {[string equal Button [winfo class %W]]} { |
---|
| 376 | %W configure -default normal |
---|
| 377 | } |
---|
| 378 | } |
---|
| 379 | } |
---|
| 380 | |
---|
| 381 | # 6. Create a binding for <Return> on the dialog |
---|
| 382 | |
---|
| 383 | bind $w <Return> { |
---|
| 384 | if {[string equal Button [winfo class %W]]} { |
---|
| 385 | tk::ButtonInvoke %W |
---|
| 386 | } |
---|
| 387 | } |
---|
| 388 | |
---|
| 389 | # 7. Withdraw the window, then update all the geometry information |
---|
| 390 | # so we know how big it wants to be, then center the window in the |
---|
| 391 | # display and de-iconify it. |
---|
| 392 | |
---|
| 393 | ::tk::PlaceWindow $w widget $data(-parent) |
---|
| 394 | |
---|
| 395 | # 8. Set a grab and claim the focus too. |
---|
| 396 | |
---|
| 397 | if {[string compare $data(-default) ""]} { |
---|
| 398 | set focus $w.$data(-default) |
---|
| 399 | } else { |
---|
| 400 | set focus $w |
---|
| 401 | } |
---|
| 402 | ::tk::SetFocusGrab $w $focus |
---|
| 403 | |
---|
| 404 | # 9. Wait for the user to respond, then restore the focus and |
---|
| 405 | # return the index of the selected button. Restore the focus |
---|
| 406 | # before deleting the window, since otherwise the window manager |
---|
| 407 | # may take the focus away so we can't redirect it. Finally, |
---|
| 408 | # restore any grab that was in effect. |
---|
| 409 | |
---|
| 410 | vwait ::tk::Priv(button) |
---|
| 411 | |
---|
| 412 | ::tk::RestoreFocusGrab $w $focus |
---|
| 413 | |
---|
| 414 | return $Priv(button) |
---|
| 415 | } |
---|