"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/msgbox.tcl" (17 Mar 2020, 16359 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    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     }
  168 
  169     if {![winfo exists $data(-parent)]} {
  170     return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \
  171         "bad window path name \"$data(-parent)\""
  172     }
  173 
  174     switch -- $data(-type) {
  175     abortretryignore {
  176         set names [list abort retry ignore]
  177         set labels [list &Abort &Retry &Ignore]
  178         set cancel abort
  179     }
  180     ok {
  181         set names [list ok]
  182         set labels {&OK}
  183         set cancel ok
  184     }
  185     okcancel {
  186         set names [list ok cancel]
  187         set labels [list &OK &Cancel]
  188         set cancel cancel
  189     }
  190     retrycancel {
  191         set names [list retry cancel]
  192         set labels [list &Retry &Cancel]
  193         set cancel cancel
  194     }
  195     yesno {
  196         set names [list yes no]
  197         set labels [list &Yes &No]
  198         set cancel no
  199     }
  200     yesnocancel {
  201         set names [list yes no cancel]
  202         set labels [list &Yes &No &Cancel]
  203         set cancel cancel
  204     }
  205     default {
  206         return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \
  207         "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     return -code error -errorcode {TK MSGBOX DEFAULT} \
  234         "bad -default value \"$data(-default)\": must be\
  235         abort, retry, ignore, ok, cancel, no, or yes"
  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     # There is only one background colour for the whole dialog
  248     set bg [ttk::style lookup . -background]
  249 
  250     # 3. Create the top-level window and divide it into top
  251     # and bottom parts.
  252 
  253     catch {destroy $w}
  254     toplevel $w -class Dialog -bg $bg
  255     wm title $w $data(-title)
  256     wm iconname $w Dialog
  257     wm protocol $w WM_DELETE_WINDOW [list $w.$cancel invoke]
  258 
  259     # Message boxes should be transient with respect to their parent so that
  260     # they always stay on top of the parent window.  But some window managers
  261     # will simply create the child window as withdrawn if the parent is not
  262     # viewable (because it is withdrawn or iconified).  This is not good for
  263     # "grab"bed windows.  So only make the message box transient if the parent
  264     # is viewable.
  265     #
  266     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  267     wm transient $w $data(-parent)
  268     }
  269 
  270     if {$windowingsystem eq "aqua"} {
  271     ::tk::unsupported::MacWindowStyle style $w moveableModal {}
  272     } elseif {$windowingsystem eq "x11"} {
  273         wm attributes $w -type dialog
  274     }
  275 
  276     ttk::frame $w.bot
  277     grid anchor $w.bot center
  278     pack $w.bot -side bottom -fill both
  279     ttk::frame $w.top
  280     pack $w.top -side top -fill both -expand 1
  281 
  282     # 4. Fill the top part with bitmap, message and detail (use the
  283     # option database for -wraplength and -font so that they can be
  284     # overridden by the caller).
  285 
  286     option add *Dialog.msg.wrapLength 3i widgetDefault
  287     option add *Dialog.dtl.wrapLength 3i widgetDefault
  288     option add *Dialog.msg.font TkCaptionFont widgetDefault
  289     option add *Dialog.dtl.font TkDefaultFont widgetDefault
  290 
  291     ttk::label $w.msg -anchor nw -justify left -text $data(-message)
  292     if {$data(-detail) ne ""} {
  293     ttk::label $w.dtl -anchor nw -justify left -text $data(-detail)
  294     }
  295     if {$data(-icon) ne ""} {
  296     if {([winfo depth $w] < 4) || $tk_strictMotif} {
  297         # ttk::label has no -bitmap option
  298         label $w.bitmap -bitmap $data(-icon) -background $bg
  299     } else {
  300         switch $data(-icon) {
  301                 error {
  302                     ttk::label $w.bitmap -image ::tk::icons::error
  303                 }
  304                 info {
  305                     ttk::label $w.bitmap -image ::tk::icons::information
  306                 }
  307                 question {
  308                     ttk::label $w.bitmap -image ::tk::icons::question
  309                 }
  310                 default {
  311                     ttk::label $w.bitmap -image ::tk::icons::warning
  312                 }
  313         }
  314     }
  315     }
  316     grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
  317     grid configure $w.bitmap -sticky nw
  318     grid columnconfigure $w.top 1 -weight 1
  319     if {$data(-detail) ne ""} {
  320     grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m}
  321     grid rowconfigure $w.top 1 -weight 1
  322     } else {
  323     grid rowconfigure $w.top 0 -weight 1
  324     }
  325 
  326     # 5. Create a row of buttons at the bottom of the dialog.
  327 
  328     set i 0
  329     foreach but $buttons {
  330     set name [lindex $but 0]
  331     set opts [lrange $but 1 end]
  332     if {![llength $opts]} {
  333         # Capitalize the first letter of $name
  334         set capName [string toupper $name 0]
  335         set opts [list -text $capName]
  336     }
  337 
  338     eval [list tk::AmpWidget ttk::button $w.$name] $opts \
  339         [list -command [list set tk::Priv(button) $name]]
  340 
  341     if {$name eq $data(-default)} {
  342         $w.$name configure -default active
  343     } else {
  344         $w.$name configure -default normal
  345     }
  346     grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew
  347     grid columnconfigure $w.bot $i -uniform buttons
  348     # We boost the size of some Mac buttons for l&f
  349     if {$windowingsystem eq "aqua"} {
  350         set tmp [string tolower $name]
  351         if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" ||
  352             $tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" ||
  353             $tmp eq "ignore"} {
  354         grid columnconfigure $w.bot $i -minsize 90
  355         }
  356         grid configure $w.$name -pady 7
  357     }
  358         incr i
  359 
  360     # create the binding for the key accelerator, based on the underline
  361     #
  362         # set underIdx [$w.$name cget -under]
  363         # if {$underIdx >= 0} {
  364         #     set key [string index [$w.$name cget -text] $underIdx]
  365         #     bind $w <Alt-[string tolower $key]>  [list $w.$name invoke]
  366         #     bind $w <Alt-[string toupper $key]>  [list $w.$name invoke]
  367         # }
  368     }
  369     bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
  370 
  371     if {$data(-default) ne ""} {
  372     bind $w <FocusIn> {
  373         if {[winfo class %W] in "Button TButton"} {
  374         %W configure -default active
  375         }
  376     }
  377     bind $w <FocusOut> {
  378         if {[winfo class %W] in "Button TButton"} {
  379         %W configure -default normal
  380         }
  381     }
  382     }
  383 
  384     # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
  385 
  386     bind $w <Return> {
  387     if {[winfo class %W] in "Button TButton"} {
  388         %W invoke
  389     }
  390     }
  391 
  392     # Invoke the designated cancelling operation
  393     bind $w <Escape> [list $w.$cancel invoke]
  394 
  395     # At <Destroy> the buttons have vanished, so must do this directly.
  396     bind $w.msg <Destroy> [list set tk::Priv(button) $cancel]
  397 
  398     # 7. Withdraw the window, then update all the geometry information
  399     # so we know how big it wants to be, then center the window in the
  400     # display (Motif style) and de-iconify it.
  401 
  402     ::tk::PlaceWindow $w widget $data(-parent)
  403 
  404     # 8. Set a grab and claim the focus too.
  405 
  406     if {$data(-default) ne ""} {
  407     set focus $w.$data(-default)
  408     } else {
  409     set focus $w
  410     }
  411     ::tk::SetFocusGrab $w $focus
  412 
  413     # 9. Wait for the user to respond, then restore the focus and
  414     # return the index of the selected button.  Restore the focus
  415     # before deleting the window, since otherwise the window manager
  416     # may take the focus away so we can't redirect it.  Finally,
  417     # restore any grab that was in effect.
  418 
  419     vwait ::tk::Priv(button)
  420     # Copy the result now so any <Destroy> that happens won't cause
  421     # trouble
  422     set result $Priv(button)
  423 
  424     ::tk::RestoreFocusGrab $w $focus
  425 
  426     return $result
  427 }