mingw/lib/tk8.5/msgbox.tcl

   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.31 2007/05/30 06:34:18 das 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         {-detail "" "" ""}
 149         {-icon "" "" "info"}
 150         {-message "" "" ""}
 151         {-parent "" "" .}
 152         {-title "" "" " "}
 153         {-type "" "" "ok"}
 154     }
 155
 156     tclParseConfigSpec $w $specs "" $args
 157
 158     if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
 159         error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
 160     }
 161     set windowingsystem [tk windowingsystem]
 162     if {$windowingsystem eq "aqua"} {
 163         switch -- $data(-icon) {
 164             "error"     {set data(-icon) "stop"}
 165             "warning"   {set data(-icon) "caution"}
 166             "info"      {set data(-icon) "note"}
 167         }
 168         option add *Dialog*background systemDialogBackgroundActive widgetDefault
 169         option add *Dialog*Button.highlightBackground \
 170                 systemDialogBackgroundActive widgetDefault
 171     }
 172
 173     if {![winfo exists $data(-parent)]} {
 174         error "bad window path name \"$data(-parent)\""
 175     }
 176
 177     switch -- $data(-type) {
 178         abortretryignore {
 179             set names [list abort retry ignore]
 180             set labels [list &Abort &Retry &Ignore]
 181             set cancel abort
 182         }
 183         ok {
 184             set names [list ok]
 185             set labels {&OK}
 186             set cancel ok
 187         }
 188         okcancel {
 189             set names [list ok cancel]
 190             set labels [list &OK &Cancel]
 191             set cancel cancel
 192         }
 193         retrycancel {
 194             set names [list retry cancel]
 195             set labels [list &Retry &Cancel]
 196             set cancel cancel
 197         }
 198         yesno {
 199             set names [list yes no]
 200             set labels [list &Yes &No]
 201             set cancel no
 202         }
 203         yesnocancel {
 204             set names [list yes no cancel]
 205             set labels [list &Yes &No &Cancel]
 206             set cancel cancel
 207         }
 208         default {
 209             error "bad -type value \"$data(-type)\": must be\
 210                     abortretryignore, ok, okcancel, retrycancel,\
 211                     yesno, or yesnocancel"
 212         }
 213     }
 214
 215     set buttons {}
 216     foreach name $names lab $labels {
 217         lappend buttons [list $name -text [mc $lab]]
 218     }
 219
 220     # If no default button was specified, the default default is the
 221     # first button (Bug: 2218).
 222
 223     if {$data(-default) eq ""} {
 224         set data(-default) [lindex [lindex $buttons 0] 0]
 225     }
 226
 227     set valid 0
 228     foreach btn $buttons {
 229         if {[lindex $btn 0] eq $data(-default)} {
 230             set valid 1
 231             break
 232         }
 233     }
 234     if {!$valid} {
 235         error "invalid default button \"$data(-default)\""
 236     }
 237
 238     # 2. Set the dialog to be a child window of $parent
 239     #
 240     #
 241     if {$data(-parent) ne "."} {
 242         set w $data(-parent).__tk__messagebox
 243     } else {
 244         set w .__tk__messagebox
 245     }
 246
 247     # 3. Create the top-level window and divide it into top
 248     # and bottom parts.
 249
 250     catch {destroy $w}
 251     toplevel $w -class Dialog
 252     wm title $w $data(-title)
 253     wm iconname $w Dialog
 254     wm protocol $w WM_DELETE_WINDOW { }
 255     # There is only one background colour for the whole dialog
 256     set bg [$w cget -background]
 257
 258     # Message boxes should be transient with respect to their parent so that
 259     # they always stay on top of the parent window.  But some window managers
 260     # will simply create the child window as withdrawn if the parent is not
 261     # viewable (because it is withdrawn or iconified).  This is not good for
 262     # "grab"bed windows.  So only make the message box transient if the parent
 263     # is viewable.
 264     #
 265     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
 266         wm transient $w $data(-parent)
 267     }
 268
 269     if {$windowingsystem eq "aqua"} {
 270         ::tk::unsupported::MacWindowStyle style $w moveableModal {}
 271     }
 272
 273     frame $w.bot -background $bg
 274     grid anchor $w.bot center
 275     pack $w.bot -side bottom -fill both
 276     frame $w.top -background $bg
 277     pack $w.top -side top -fill both -expand 1
 278     if {$windowingsystem ne "aqua"} {
 279         $w.bot configure -relief raised -bd 1
 280         $w.top configure -relief raised -bd 1
 281     }
 282
 283     # 4. Fill the top part with bitmap, message and detail (use the
 284     # option database for -wraplength and -font so that they can be
 285     # overridden by the caller).
 286
 287     option add *Dialog.msg.wrapLength 3i widgetDefault
 288     option add *Dialog.dtl.wrapLength 3i widgetDefault
 289     if {$windowingsystem eq "aqua"} {
 290         option add *Dialog.msg.font system widgetDefault
 291         option add *Dialog.dtl.font system widgetDefault
 292     } else {
 293         option add *Dialog.msg.font {Times 14} widgetDefault
 294         option add *Dialog.dtl.font {Times 10} widgetDefault
 295     }
 296
 297     label $w.msg -anchor nw -justify left -text $data(-message) \
 298             -background $bg
 299     if {$data(-detail) ne ""} {
 300         label $w.dtl -anchor nw -justify left -text $data(-detail) \
 301                 -background $bg
 302     }
 303     if {$data(-icon) ne ""} {
 304         if {$windowingsystem eq "aqua"
 305                 || ([winfo depth $w] < 4) || $tk_strictMotif} {
 306             label $w.bitmap -bitmap $data(-icon) -background $bg
 307         } else {
 308             canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
 309                     -background $bg
 310             switch $data(-icon) {
 311                 error {
 312                     $w.bitmap create oval 0 0 31 31 -fill red -outline black
 313                     $w.bitmap create line 9 9 23 23 -fill white -width 4
 314                     $w.bitmap create line 9 23 23 9 -fill white -width 4
 315                 }
 316                 info {
 317                     $w.bitmap create image 0 0 -anchor nw \
 318                             -image ::tk::dialog::b1
 319                     $w.bitmap create image 0 0 -anchor nw \
 320                             -image ::tk::dialog::b2
 321                     $w.bitmap create image 0 0 -anchor nw \
 322                             -image ::tk::dialog::i
 323                 }
 324                 question {
 325                     $w.bitmap create image 0 0 -anchor nw \
 326                             -image ::tk::dialog::b1
 327                     $w.bitmap create image 0 0 -anchor nw \
 328                             -image ::tk::dialog::b2
 329                     $w.bitmap create image 0 0 -anchor nw \
 330                             -image ::tk::dialog::q
 331                 }
 332                 default {
 333                     $w.bitmap create image 0 0 -anchor nw \
 334                             -image ::tk::dialog::w1
 335                     $w.bitmap create image 0 0 -anchor nw \
 336                             -image ::tk::dialog::w2
 337                     $w.bitmap create image 0 0 -anchor nw \
 338                             -image ::tk::dialog::w3
 339                 }
 340             }
 341         }
 342     }
 343     grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
 344     grid columnconfigure $w.top 1 -weight 1
 345     if {$data(-detail) ne ""} {
 346         grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m}
 347         grid rowconfigure $w.top 1 -weight 1
 348     } else {
 349         grid rowconfigure $w.top 0 -weight 1
 350     }
 351
 352     # 5. Create a row of buttons at the bottom of the dialog.
 353
 354     set i 0
 355     foreach but $buttons {
 356         set name [lindex $but 0]
 357         set opts [lrange $but 1 end]
 358         if {![llength $opts]} {
 359             # Capitalize the first letter of $name
 360             set capName [string toupper $name 0]
 361             set opts [list -text $capName]
 362         }
 363
 364         eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \
 365                 [list -command [list set tk::Priv(button) $name]]
 366
 367         if {$name eq $data(-default)} {
 368             $w.$name configure -default active
 369         } else {
 370             $w.$name configure -default normal
 371         }
 372         grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew
 373         grid columnconfigure $w.bot $i -uniform buttons
 374         # We boost the size of some Mac buttons for l&f
 375         if {$windowingsystem eq "aqua"} {
 376             set tmp [string tolower $name]
 377             if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" ||
 378                     $tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" ||
 379                     $tmp eq "ignore"} {
 380                 grid columnconfigure $w.bot $i -minsize 90
 381             }
 382             grid configure $w.$name -pady 7
 383         }
 384         incr i
 385
 386         # create the binding for the key accelerator, based on the underline
 387         #
 388         # set underIdx [$w.$name cget -under]
 389         # if {$underIdx >= 0} {
 390         #     set key [string index [$w.$name cget -text] $underIdx]
 391         #     bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
 392         #     bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
 393         # }
 394     }
 395     bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
 396
 397     if {$data(-default) ne ""} {
 398         bind $w <FocusIn> {
 399             if {[winfo class %W] eq "Button"} {
 400                 %W configure -default active
 401             }
 402         }
 403         bind $w <FocusOut> {
 404             if {[winfo class %W] eq "Button"} {
 405                 %W configure -default normal
 406             }
 407         }
 408     }
 409
 410     # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
 411
 412     bind $w <Return> {
 413         if {[winfo class %W] eq "Button"} {
 414             tk::ButtonInvoke %W
 415         }
 416     }
 417
 418     # Invoke the designated cancelling operation
 419     bind $w <Escape> [list tk::ButtonInvoke $w.$cancel]
 420
 421     # At <Destroy> the buttons have vanished, so must do this directly.
 422     bind $w.msg <Destroy> [list set tk::Priv(button) $cancel]
 423
 424     # 7. Withdraw the window, then update all the geometry information
 425     # so we know how big it wants to be, then center the window in the
 426     # display and de-iconify it.
 427
 428     ::tk::PlaceWindow $w widget $data(-parent)
 429
 430     # 8. Set a grab and claim the focus too.
 431
 432     if {$data(-default) ne ""} {
 433         set focus $w.$data(-default)
 434     } else {
 435         set focus $w
 436     }
 437     ::tk::SetFocusGrab $w $focus
 438
 439     # 9. Wait for the user to respond, then restore the focus and
 440     # return the index of the selected button.  Restore the focus
 441     # before deleting the window, since otherwise the window manager
 442     # may take the focus away so we can't redirect it.  Finally,
 443     # restore any grab that was in effect.
 444
 445     vwait ::tk::Priv(button)
 446     # Copy the result now so any <Destroy> that happens won't cause
 447     # trouble
 448     set result $Priv(button)
 449
 450     ::tk::RestoreFocusGrab $w $focus
 451
 452     return $result
 453 }