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