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.36.2.2 2009/08/24 21:19:35 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 package require Ttk
  15
  16 # Ensure existence of ::tk::dialog namespace
  17 #
  18 namespace eval ::tk::dialog {}
  19
  20 image create bitmap ::tk::dialog::b1 -foreground black \
  21 -data "#define b1_width 32\n#define b1_height 32
  22 static unsigned char q1_bits[] = {
  23    0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,
  24    0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,
  25    0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
  26    0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
  27    0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
  28    0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
  29    0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,
  30    0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,
  31    0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,
  32    0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,
  33    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
  34 image create bitmap ::tk::dialog::b2 -foreground white \
  35 -data "#define b2_width 32\n#define b2_height 32
  36 static unsigned char b2_bits[] = {
  37    0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,
  38    0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,
  39    0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
  40    0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
  41    0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
  42    0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
  43    0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,
  44    0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,
  45    0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,
  46    0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
  47    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
  48 image create bitmap ::tk::dialog::q -foreground blue \
  49 -data "#define q_width 32\n#define q_height 32
  50 static unsigned char q_bits[] = {
  51    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  52    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,
  53    0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,
  54    0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,
  55    0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,
  56    0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,
  57    0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 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, 0x00, 0x00, 0x00, 0x00,
  60    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  61    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
  62 image create bitmap ::tk::dialog::i -foreground blue \
  63 -data "#define i_width 32\n#define i_height 32
  64 static unsigned char i_bits[] = {
  65    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  66    0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,
  67    0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  68    0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
  69    0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
  70    0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
  71    0x00, 0xf8, 0x0f, 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, 0x00, 0x00, 0x00, 0x00,
  74    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  75    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
  76 image create bitmap ::tk::dialog::w1 -foreground black \
  77 -data "#define w1_width 32\n#define w1_height 32
  78 static unsigned char w1_bits[] = {
  79    0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,
  80    0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,
  81    0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,
  82    0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,
  83    0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,
  84    0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,
  85    0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,
  86    0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,
  87    0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,
  88    0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,
  89    0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"
  90 image create bitmap ::tk::dialog::w2 -foreground yellow \
  91 -data "#define w2_width 32\n#define w2_height 32
  92 static unsigned char w2_bits[] = {
  93    0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
  94    0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,
  95    0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,
  96    0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
  97    0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,
  98    0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,
  99    0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,
 100    0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,
 101    0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,
 102    0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,
 103    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
 104 image create bitmap ::tk::dialog::w3 -foreground black \
 105 -data "#define w3_width 32\n#define w3_height 32
 106 static unsigned char w3_bits[] = {
 107    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
 108    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
 109    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
 110    0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
 111    0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
 112    0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,
 113    0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,
 114    0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
 115    0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
 116    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
 117    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
 118
 119 # ::tk::MessageBox --
 120 #
 121 #       Pops up a messagebox with an application-supplied message with
 122 #       an icon and a list of buttons. This procedure will be called
 123 #       by tk_messageBox if the platform does not have native
 124 #       messagebox support, or if the particular type of messagebox is
 125 #       not supported natively.
 126 #
 127 #       Color icons are used on Unix displays that have a color
 128 #       depth of 4 or more and $tk_strictMotif is not on.
 129 #
 130 #       This procedure is a private procedure shouldn't be called
 131 #       directly. Call tk_messageBox instead.
 132 #
 133 #       See the user documentation for details on what tk_messageBox does.
 134 #
 135 proc ::tk::MessageBox {args} {
 136     global tcl_platform tk_strictMotif
 137     variable ::tk::Priv
 138
 139     set w ::tk::PrivMsgBox
 140     upvar $w data
 141
 142     #
 143     # The default value of the title is space (" ") not the empty string
 144     # because for some window managers, a
 145     #           wm title .foo ""
 146     # causes the window title to be "foo" instead of the empty string.
 147     #
 148     set specs {
 149         {-default "" "" ""}
 150         {-detail "" "" ""}
 151         {-icon "" "" "info"}
 152         {-message "" "" ""}
 153         {-parent "" "" .}
 154         {-title "" "" " "}
 155         {-type "" "" "ok"}
 156     }
 157
 158     tclParseConfigSpec $w $specs "" $args
 159
 160     if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
 161         error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
 162     }
 163     set windowingsystem [tk windowingsystem]
 164     if {$windowingsystem eq "aqua"} {
 165         switch -- $data(-icon) {
 166             "error"     {set data(-icon) "stop"}
 167             "warning"   {set data(-icon) "caution"}
 168             "info"      {set data(-icon) "note"}
 169         }
 170         option add *Dialog*background systemDialogBackgroundActive widgetDefault
 171         option add *Dialog*Button.highlightBackground \
 172                 systemDialogBackgroundActive widgetDefault
 173     }
 174
 175     if {![winfo exists $data(-parent)]} {
 176         error "bad window path name \"$data(-parent)\""
 177     }
 178
 179     switch -- $data(-type) {
 180         abortretryignore {
 181             set names [list abort retry ignore]
 182             set labels [list &Abort &Retry &Ignore]
 183             set cancel abort
 184         }
 185         ok {
 186             set names [list ok]
 187             set labels {&OK}
 188             set cancel ok
 189         }
 190         okcancel {
 191             set names [list ok cancel]
 192             set labels [list &OK &Cancel]
 193             set cancel cancel
 194         }
 195         retrycancel {
 196             set names [list retry cancel]
 197             set labels [list &Retry &Cancel]
 198             set cancel cancel
 199         }
 200         yesno {
 201             set names [list yes no]
 202             set labels [list &Yes &No]
 203             set cancel no
 204         }
 205         yesnocancel {
 206             set names [list yes no cancel]
 207             set labels [list &Yes &No &Cancel]
 208             set cancel cancel
 209         }
 210         default {
 211             error "bad -type value \"$data(-type)\": must be\
 212                     abortretryignore, ok, okcancel, retrycancel,\
 213                     yesno, or yesnocancel"
 214         }
 215     }
 216
 217     set buttons {}
 218     foreach name $names lab $labels {
 219         lappend buttons [list $name -text [mc $lab]]
 220     }
 221
 222     # If no default button was specified, the default default is the
 223     # first button (Bug: 2218).
 224
 225     if {$data(-default) eq ""} {
 226         set data(-default) [lindex [lindex $buttons 0] 0]
 227     }
 228
 229     set valid 0
 230     foreach btn $buttons {
 231         if {[lindex $btn 0] eq $data(-default)} {
 232             set valid 1
 233             break
 234         }
 235     }
 236     if {!$valid} {
 237         error "invalid default button \"$data(-default)\""
 238     }
 239
 240     # 2. Set the dialog to be a child window of $parent
 241     #
 242     #
 243     if {$data(-parent) ne "."} {
 244         set w $data(-parent).__tk__messagebox
 245     } else {
 246         set w .__tk__messagebox
 247     }
 248
 249     # There is only one background colour for the whole dialog
 250     set bg [ttk::style lookup . -background]
 251
 252     # 3. Create the top-level window and divide it into top
 253     # and bottom parts.
 254
 255     catch {destroy $w}
 256     toplevel $w -class Dialog -bg $bg
 257     wm title $w $data(-title)
 258     wm iconname $w Dialog
 259     wm protocol $w WM_DELETE_WINDOW { }
 260
 261     # Message boxes should be transient with respect to their parent so that
 262     # they always stay on top of the parent window.  But some window managers
 263     # will simply create the child window as withdrawn if the parent is not
 264     # viewable (because it is withdrawn or iconified).  This is not good for
 265     # "grab"bed windows.  So only make the message box transient if the parent
 266     # is viewable.
 267     #
 268     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
 269         wm transient $w $data(-parent)
 270     }
 271
 272     if {$windowingsystem eq "aqua"} {
 273         ::tk::unsupported::MacWindowStyle style $w moveableModal {}
 274     }
 275
 276     ttk::frame $w.bot;# -background $bg
 277     grid anchor $w.bot center
 278     pack $w.bot -side bottom -fill both
 279     ttk::frame $w.top;# -background $bg
 280     pack $w.top -side top -fill both -expand 1
 281     if {$windowingsystem ne "aqua"} {
 282         #$w.bot configure -relief raised -bd 1
 283         #$w.top configure -relief raised -bd 1
 284     }
 285
 286     # 4. Fill the top part with bitmap, message and detail (use the
 287     # option database for -wraplength and -font so that they can be
 288     # overridden by the caller).
 289
 290     option add *Dialog.msg.wrapLength 3i widgetDefault
 291     option add *Dialog.dtl.wrapLength 3i widgetDefault
 292     option add *Dialog.msg.font TkCaptionFont widgetDefault
 293     option add *Dialog.dtl.font TkDefaultFont widgetDefault
 294
 295     ttk::label $w.msg -anchor nw -justify left -text $data(-message)
 296     #-background $bg
 297     if {$data(-detail) ne ""} {
 298         ttk::label $w.dtl -anchor nw -justify left -text $data(-detail)
 299         #-background $bg
 300     }
 301     if {$data(-icon) ne ""} {
 302         if {$windowingsystem eq "aqua"
 303                 || ([winfo depth $w] < 4) || $tk_strictMotif} {
 304             # ttk::label has no -bitmap option
 305             label $w.bitmap -bitmap $data(-icon);# -background $bg
 306         } else {
 307             canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
 308                     -background $bg
 309             switch $data(-icon) {
 310                 error {
 311                     $w.bitmap create oval 0 0 31 31 -fill red -outline black
 312                     $w.bitmap create line 9 9 23 23 -fill white -width 4
 313                     $w.bitmap create line 9 23 23 9 -fill white -width 4
 314                 }
 315                 info {
 316                     $w.bitmap create image 0 0 -anchor nw \
 317                             -image ::tk::dialog::b1
 318                     $w.bitmap create image 0 0 -anchor nw \
 319                             -image ::tk::dialog::b2
 320                     $w.bitmap create image 0 0 -anchor nw \
 321                             -image ::tk::dialog::i
 322                 }
 323                 question {
 324                     $w.bitmap create image 0 0 -anchor nw \
 325                             -image ::tk::dialog::b1
 326                     $w.bitmap create image 0 0 -anchor nw \
 327                             -image ::tk::dialog::b2
 328                     $w.bitmap create image 0 0 -anchor nw \
 329                             -image ::tk::dialog::q
 330                 }
 331                 default {
 332                     $w.bitmap create image 0 0 -anchor nw \
 333                             -image ::tk::dialog::w1
 334                     $w.bitmap create image 0 0 -anchor nw \
 335                             -image ::tk::dialog::w2
 336                     $w.bitmap create image 0 0 -anchor nw \
 337                             -image ::tk::dialog::w3
 338                 }
 339             }
 340         }
 341     }
 342     grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
 343     grid columnconfigure $w.top 1 -weight 1
 344     if {$data(-detail) ne ""} {
 345         grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m}
 346         grid rowconfigure $w.top 1 -weight 1
 347     } else {
 348         grid rowconfigure $w.top 0 -weight 1
 349     }
 350
 351     # 5. Create a row of buttons at the bottom of the dialog.
 352
 353     set i 0
 354     foreach but $buttons {
 355         set name [lindex $but 0]
 356         set opts [lrange $but 1 end]
 357         if {![llength $opts]} {
 358             # Capitalize the first letter of $name
 359             set capName [string toupper $name 0]
 360             set opts [list -text $capName]
 361         }
 362
 363         eval [list tk::AmpWidget ttk::button $w.$name] $opts \
 364                 [list -command [list set tk::Priv(button) $name]]
 365         # -padx 3m
 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] in "Button TButton"} {
 400                 %W configure -default active
 401             }
 402         }
 403         bind $w <FocusOut> {
 404             if {[winfo class %W] in "Button TButton"} {
 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] in "Button TButton"} {
 414             %W invoke
 415         }
 416     }
 417
 418     # Invoke the designated cancelling operation
 419     bind $w <Escape> [list $w.$cancel invoke]
 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 }