home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / msgbox.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  16.6 KB  |  454 lines
  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. }
  454.