figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

msgbox.tcl (16471B)


      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 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 {$data(-icon) ni {info warning error question}} {
    157 	return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \
    158 	    "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
    159     }
    160     set windowingsystem [tk windowingsystem]
    161     if {$windowingsystem eq "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 	option add *Dialog*background systemDialogBackgroundActive widgetDefault
    168 	option add *Dialog*Button.highlightBackground \
    169 		systemDialogBackgroundActive widgetDefault
    170     }
    171 
    172     if {![winfo exists $data(-parent)]} {
    173 	return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
    174 	    "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 	    return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \
    210 		"bad -type value \"$data(-type)\": must be\
    211 		abortretryignore, ok, okcancel, retrycancel,\
    212 		yesno, or yesnocancel"
    213 	}
    214     }
    215 
    216     set buttons {}
    217     foreach name $names lab $labels {
    218 	lappend buttons [list $name -text [mc $lab]]
    219     }
    220 
    221     # If no default button was specified, the default default is the
    222     # first button (Bug: 2218).
    223 
    224     if {$data(-default) eq ""} {
    225 	set data(-default) [lindex [lindex $buttons 0] 0]
    226     }
    227 
    228     set valid 0
    229     foreach btn $buttons {
    230 	if {[lindex $btn 0] eq $data(-default)} {
    231 	    set valid 1
    232 	    break
    233 	}
    234     }
    235     if {!$valid} {
    236 	return -code error -errorcode {TK MSGBOX DEFAULT} \
    237 	    "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 [list $w.$cancel invoke]
    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     } elseif {$windowingsystem eq "x11"} {
    275         wm attributes $w -type dialog
    276     }
    277 
    278     ttk::frame $w.bot
    279     grid anchor $w.bot center
    280     pack $w.bot -side bottom -fill both
    281     ttk::frame $w.top
    282     pack $w.top -side top -fill both -expand 1
    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     if {$data(-detail) ne ""} {
    295 	ttk::label $w.dtl -anchor nw -justify left -text $data(-detail)
    296     }
    297     if {$data(-icon) ne ""} {
    298 	if {([winfo depth $w] < 4) || $tk_strictMotif} {
    299 	    # ttk::label has no -bitmap option
    300 	    label $w.bitmap -bitmap $data(-icon) -background $bg
    301 	} else {
    302 	    switch $data(-icon) {
    303                 error {
    304                     ttk::label $w.bitmap -image ::tk::icons::error
    305                 }
    306                 info {
    307                     ttk::label $w.bitmap -image ::tk::icons::information
    308                 }
    309                 question {
    310                     ttk::label $w.bitmap -image ::tk::icons::question
    311                 }
    312                 default {
    313                     ttk::label $w.bitmap -image ::tk::icons::warning
    314                 }
    315 	    }
    316 	}
    317     }
    318     grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
    319     grid configure $w.bitmap -sticky nw
    320     grid columnconfigure $w.top 1 -weight 1
    321     if {$data(-detail) ne ""} {
    322 	grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m}
    323 	grid rowconfigure $w.top 1 -weight 1
    324     } else {
    325 	grid rowconfigure $w.top 0 -weight 1
    326     }
    327 
    328     # 5. Create a row of buttons at the bottom of the dialog.
    329 
    330     set i 0
    331     foreach but $buttons {
    332 	set name [lindex $but 0]
    333 	set opts [lrange $but 1 end]
    334 	if {![llength $opts]} {
    335 	    # Capitalize the first letter of $name
    336 	    set capName [string toupper $name 0]
    337 	    set opts [list -text $capName]
    338 	}
    339 
    340 	eval [list tk::AmpWidget ttk::button $w.$name] $opts \
    341 		[list -command [list set tk::Priv(button) $name]]
    342 
    343 	if {$name eq $data(-default)} {
    344 	    $w.$name configure -default active
    345 	} else {
    346 	    $w.$name configure -default normal
    347 	}
    348 	grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew
    349 	grid columnconfigure $w.bot $i -uniform buttons
    350 	# We boost the size of some Mac buttons for l&f
    351 	if {$windowingsystem eq "aqua"} {
    352 	    set tmp [string tolower $name]
    353 	    if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" ||
    354 		    $tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" ||
    355 		    $tmp eq "ignore"} {
    356 		grid columnconfigure $w.bot $i -minsize 90
    357 	    }
    358 	    grid configure $w.$name -pady 7
    359 	}
    360         incr i
    361 
    362 	# create the binding for the key accelerator, based on the underline
    363 	#
    364         # set underIdx [$w.$name cget -under]
    365         # if {$underIdx >= 0} {
    366         #     set key [string index [$w.$name cget -text] $underIdx]
    367         #     bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
    368         #     bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
    369         # }
    370     }
    371     bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
    372 
    373     if {$data(-default) ne ""} {
    374 	bind $w <FocusIn> {
    375 	    if {[winfo class %W] in "Button TButton"} {
    376 		%W configure -default active
    377 	    }
    378 	}
    379 	bind $w <FocusOut> {
    380 	    if {[winfo class %W] in "Button TButton"} {
    381 		%W configure -default normal
    382 	    }
    383 	}
    384     }
    385 
    386     # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
    387 
    388     bind $w <Return> {
    389 	if {[winfo class %W] in "Button TButton"} {
    390 	    %W invoke
    391 	}
    392     }
    393 
    394     # Invoke the designated cancelling operation
    395     bind $w <Escape> [list $w.$cancel invoke]
    396 
    397     # At <Destroy> the buttons have vanished, so must do this directly.
    398     bind $w.msg <Destroy> [list set tk::Priv(button) $cancel]
    399 
    400     # 7. Withdraw the window, then update all the geometry information
    401     # so we know how big it wants to be, then center the window in the
    402     # display (Motif style) and de-iconify it.
    403 
    404     ::tk::PlaceWindow $w widget $data(-parent)
    405 
    406     # 8. Set a grab and claim the focus too.
    407 
    408     if {$data(-default) ne ""} {
    409 	set focus $w.$data(-default)
    410     } else {
    411 	set focus $w
    412     }
    413     ::tk::SetFocusGrab $w $focus
    414 
    415     # 9. Wait for the user to respond, then restore the focus and
    416     # return the index of the selected button.  Restore the focus
    417     # before deleting the window, since otherwise the window manager
    418     # may take the focus away so we can't redirect it.  Finally,
    419     # restore any grab that was in effect.
    420 
    421     vwait ::tk::Priv(button)
    422     # Copy the result now so any <Destroy> that happens won't cause
    423     # trouble
    424     set result $Priv(button)
    425 
    426     ::tk::RestoreFocusGrab $w $focus
    427 
    428     return $result
    429 }