You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
420 lines
16 KiB
Tcl
420 lines
16 KiB
Tcl
# msgbox.tcl --
|
|
#
|
|
# Implements messageboxes for platforms that do not have native
|
|
# messagebox support.
|
|
#
|
|
# RCS: @(#) $Id: msgbox.tcl,v 1.23 2002/08/31 06:12:28 das Exp $
|
|
#
|
|
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
|
#
|
|
# See the file "license.terms" for information on usage and redistribution
|
|
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
#
|
|
|
|
# Ensure existence of ::tk::dialog namespace
|
|
#
|
|
namespace eval ::tk::dialog {}
|
|
|
|
image create bitmap ::tk::dialog::b1 -foreground black \
|
|
-data "#define b1_width 32\n#define b1_height 32
|
|
static unsigned char q1_bits[] = {
|
|
0x00, 0xf8, 0x1f, 0x00, 0x00, 0x07, 0xe0, 0x00, 0xc0, 0x00, 0x00, 0x03,
|
|
0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10,
|
|
0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
|
|
0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
|
|
0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80,
|
|
0x01, 0x00, 0x00, 0x80, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40,
|
|
0x04, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x10, 0x10, 0x00, 0x00, 0x08,
|
|
0x60, 0x00, 0x00, 0x04, 0x80, 0x03, 0x80, 0x03, 0x00, 0x0c, 0x78, 0x00,
|
|
0x00, 0x30, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00, 0x00, 0x40, 0x04, 0x00,
|
|
0x00, 0x80, 0x04, 0x00, 0x00, 0x00, 0x05, 0x00, 0x00, 0x00, 0x06, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
|
|
image create bitmap ::tk::dialog::b2 -foreground white \
|
|
-data "#define b2_width 32\n#define b2_height 32
|
|
static unsigned char b2_bits[] = {
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xff, 0xff, 0x00,
|
|
0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f,
|
|
0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
|
|
0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
|
|
0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0x7f,
|
|
0xfe, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x3f,
|
|
0xf8, 0xff, 0xff, 0x1f, 0xf0, 0xff, 0xff, 0x0f, 0xe0, 0xff, 0xff, 0x07,
|
|
0x80, 0xff, 0xff, 0x03, 0x00, 0xfc, 0x7f, 0x00, 0x00, 0xf0, 0x07, 0x00,
|
|
0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00, 0x80, 0x03, 0x00,
|
|
0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
|
|
image create bitmap ::tk::dialog::q -foreground blue \
|
|
-data "#define q_width 32\n#define q_height 32
|
|
static unsigned char q_bits[] = {
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x07, 0x00,
|
|
0x00, 0x10, 0x0f, 0x00, 0x00, 0x18, 0x1e, 0x00, 0x00, 0x38, 0x1e, 0x00,
|
|
0x00, 0x38, 0x1e, 0x00, 0x00, 0x10, 0x0f, 0x00, 0x00, 0x80, 0x07, 0x00,
|
|
0x00, 0xc0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00,
|
|
0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
|
|
image create bitmap ::tk::dialog::i -foreground blue \
|
|
-data "#define i_width 32\n#define i_height 32
|
|
static unsigned char i_bits[] = {
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00,
|
|
0x00, 0xe0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0xf8, 0x03, 0x00, 0x00, 0xf0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
|
|
0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00,
|
|
0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
|
|
0x00, 0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
|
|
image create bitmap ::tk::dialog::w1 -foreground black \
|
|
-data "#define w1_width 32\n#define w1_height 32
|
|
static unsigned char w1_bits[] = {
|
|
0x00, 0x80, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20, 0x04, 0x00,
|
|
0x00, 0x10, 0x04, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x08, 0x08, 0x00,
|
|
0x00, 0x08, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x20, 0x00,
|
|
0x00, 0x02, 0x20, 0x00, 0x00, 0x02, 0x40, 0x00, 0x00, 0x01, 0x40, 0x00,
|
|
0x00, 0x01, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x80, 0x00, 0x00, 0x01,
|
|
0x40, 0x00, 0x00, 0x01, 0x40, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x02,
|
|
0x20, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x04, 0x10, 0x00, 0x00, 0x08,
|
|
0x08, 0x00, 0x00, 0x08, 0x08, 0x00, 0x00, 0x10, 0x04, 0x00, 0x00, 0x10,
|
|
0x04, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x40,
|
|
0x01, 0x00, 0x00, 0x40, 0x01, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x20,
|
|
0xfc, 0xff, 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00};"
|
|
image create bitmap ::tk::dialog::w2 -foreground yellow \
|
|
-data "#define w2_width 32\n#define w2_height 32
|
|
static unsigned char w2_bits[] = {
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
|
|
0x00, 0xe0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x07, 0x00,
|
|
0x00, 0xf0, 0x0f, 0x00, 0x00, 0xf8, 0x0f, 0x00, 0x00, 0xf8, 0x1f, 0x00,
|
|
0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x3f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
|
|
0x00, 0xfe, 0x7f, 0x00, 0x00, 0xff, 0x7f, 0x00, 0x00, 0xff, 0xff, 0x00,
|
|
0x80, 0xff, 0xff, 0x00, 0x80, 0xff, 0xff, 0x01, 0xc0, 0xff, 0xff, 0x01,
|
|
0xc0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x03, 0xe0, 0xff, 0xff, 0x07,
|
|
0xf0, 0xff, 0xff, 0x07, 0xf0, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f,
|
|
0xf8, 0xff, 0xff, 0x1f, 0xfc, 0xff, 0xff, 0x1f, 0xfe, 0xff, 0xff, 0x3f,
|
|
0xfe, 0xff, 0xff, 0x3f, 0xfe, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x1f,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
|
|
image create bitmap ::tk::dialog::w3 -foreground black \
|
|
-data "#define w3_width 32\n#define w3_height 32
|
|
static unsigned char w3_bits[] = {
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
|
|
0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x07, 0x00,
|
|
0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0xc0, 0x03, 0x00,
|
|
0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x80, 0x01, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00,
|
|
0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
|
|
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};"
|
|
|
|
# ::tk::MessageBox --
|
|
#
|
|
# Pops up a messagebox with an application-supplied message with
|
|
# an icon and a list of buttons. This procedure will be called
|
|
# by tk_messageBox if the platform does not have native
|
|
# messagebox support, or if the particular type of messagebox is
|
|
# not supported natively.
|
|
#
|
|
# Color icons are used on Unix displays that have a color
|
|
# depth of 4 or more and $tk_strictMotif is not on.
|
|
#
|
|
# This procedure is a private procedure shouldn't be called
|
|
# directly. Call tk_messageBox instead.
|
|
#
|
|
# See the user documentation for details on what tk_messageBox does.
|
|
#
|
|
proc ::tk::MessageBox {args} {
|
|
global tcl_platform tk_strictMotif
|
|
variable ::tk::Priv
|
|
|
|
set w ::tk::PrivMsgBox
|
|
upvar $w data
|
|
|
|
#
|
|
# The default value of the title is space (" ") not the empty string
|
|
# because for some window managers, a
|
|
# wm title .foo ""
|
|
# causes the window title to be "foo" instead of the empty string.
|
|
#
|
|
set specs {
|
|
{-default "" "" ""}
|
|
{-icon "" "" "info"}
|
|
{-message "" "" ""}
|
|
{-parent "" "" .}
|
|
{-title "" "" " "}
|
|
{-type "" "" "ok"}
|
|
}
|
|
|
|
tclParseConfigSpec $w $specs "" $args
|
|
|
|
if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
|
|
error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
|
|
}
|
|
if {[string equal [tk windowingsystem] "classic"]
|
|
|| [string equal [tk windowingsystem] "aqua"]} {
|
|
switch -- $data(-icon) {
|
|
"error" {set data(-icon) "stop"}
|
|
"warning" {set data(-icon) "caution"}
|
|
"info" {set data(-icon) "note"}
|
|
}
|
|
}
|
|
|
|
if {![winfo exists $data(-parent)]} {
|
|
error "bad window path name \"$data(-parent)\""
|
|
}
|
|
|
|
switch -- $data(-type) {
|
|
abortretryignore {
|
|
set names [list abort retry ignore]
|
|
set labels [list &Abort &Retry &Ignore]
|
|
}
|
|
ok {
|
|
set names [list ok]
|
|
set labels {&OK}
|
|
}
|
|
okcancel {
|
|
set names [list ok cancel]
|
|
set labels [list &OK &Cancel]
|
|
}
|
|
retrycancel {
|
|
set names [list retry cancel]
|
|
set labels [list &Retry &Cancel]
|
|
}
|
|
yesno {
|
|
set names [list yes no]
|
|
set labels [list &Yes &No]
|
|
}
|
|
yesnocancel {
|
|
set names [list yes no cancel]
|
|
set labels [list &Yes &No &Cancel]
|
|
}
|
|
default {
|
|
error "bad -type value \"$data(-type)\": must be\
|
|
abortretryignore, ok, okcancel, retrycancel,\
|
|
yesno, or yesnocancel"
|
|
}
|
|
}
|
|
|
|
set maxWidth [eval mcmaxamp $labels]
|
|
if {$maxWidth <6} {
|
|
set maxWidth 6
|
|
}
|
|
|
|
set buttons {}
|
|
foreach name $names lab $labels {
|
|
lappend buttons [list $name -width $maxWidth -text [mc $lab]]
|
|
}
|
|
|
|
# If no default button was specified, the default default is the
|
|
# first button (Bug: 2218).
|
|
|
|
if {$data(-default) == ""} {
|
|
set data(-default) [lindex [lindex $buttons 0] 0]
|
|
}
|
|
|
|
set valid 0
|
|
foreach btn $buttons {
|
|
if {[string equal [lindex $btn 0] $data(-default)]} {
|
|
set valid 1
|
|
break
|
|
}
|
|
}
|
|
if {!$valid} {
|
|
error "invalid default button \"$data(-default)\""
|
|
}
|
|
|
|
# 2. Set the dialog to be a child window of $parent
|
|
#
|
|
#
|
|
if {[string compare $data(-parent) .]} {
|
|
set w $data(-parent).__tk__messagebox
|
|
} else {
|
|
set w .__tk__messagebox
|
|
}
|
|
|
|
# 3. Create the top-level window and divide it into top
|
|
# and bottom parts.
|
|
|
|
catch {destroy $w}
|
|
toplevel $w -class Dialog
|
|
wm title $w $data(-title)
|
|
wm iconname $w Dialog
|
|
wm protocol $w WM_DELETE_WINDOW { }
|
|
# There is only one background colour for the whole dialog
|
|
set bg [$w cget -background]
|
|
|
|
# Message boxes should be transient with respect to their parent so that
|
|
# they always stay on top of the parent window. But some window managers
|
|
# will simply create the child window as withdrawn if the parent is not
|
|
# viewable (because it is withdrawn or iconified). This is not good for
|
|
# "grab"bed windows. So only make the message box transient if the parent
|
|
# is viewable.
|
|
#
|
|
if {[winfo viewable [winfo toplevel $data(-parent)]] } {
|
|
wm transient $w $data(-parent)
|
|
}
|
|
|
|
if {[string equal [tk windowingsystem] "classic"]
|
|
|| [string equal [tk windowingsystem] "aqua"]} {
|
|
unsupported::MacWindowStyle style $w dBoxProc
|
|
}
|
|
|
|
frame $w.bot -background $bg
|
|
pack $w.bot -side bottom -fill both
|
|
frame $w.top -background $bg
|
|
pack $w.top -side top -fill both -expand 1
|
|
if {![string equal [tk windowingsystem] "classic"]
|
|
&& ![string equal [tk windowingsystem] "aqua"]} {
|
|
$w.bot configure -relief raised -bd 1
|
|
$w.top configure -relief raised -bd 1
|
|
}
|
|
|
|
# 4. Fill the top part with bitmap and message (use the option
|
|
# database for -wraplength and -font so that they can be
|
|
# overridden by the caller).
|
|
|
|
option add *Dialog.msg.wrapLength 3i widgetDefault
|
|
if {[string equal [tk windowingsystem] "classic"]
|
|
|| [string equal [tk windowingsystem] "aqua"]} {
|
|
option add *Dialog.msg.font system widgetDefault
|
|
} else {
|
|
option add *Dialog.msg.font {Times 18} widgetDefault
|
|
}
|
|
|
|
label $w.msg -anchor nw -justify left -text $data(-message) \
|
|
-background $bg
|
|
if {[string compare $data(-icon) ""]} {
|
|
if {([string equal [tk windowingsystem] "classic"]
|
|
|| [string equal [tk windowingsystem] "aqua"])
|
|
|| ([winfo depth $w] < 4) || $tk_strictMotif} {
|
|
label $w.bitmap -bitmap $data(-icon) -background $bg
|
|
} else {
|
|
canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \
|
|
-background $bg
|
|
switch $data(-icon) {
|
|
error {
|
|
$w.bitmap create oval 0 0 31 31 -fill red -outline black
|
|
$w.bitmap create line 9 9 23 23 -fill white -width 4
|
|
$w.bitmap create line 9 23 23 9 -fill white -width 4
|
|
}
|
|
info {
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::b1
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::b2
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::i
|
|
}
|
|
question {
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::b1
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::b2
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::q
|
|
}
|
|
default {
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::w1
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::w2
|
|
$w.bitmap create image 0 0 -anchor nw \
|
|
-image ::tk::dialog::w3
|
|
}
|
|
}
|
|
}
|
|
}
|
|
grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m
|
|
grid columnconfigure $w.top 1 -weight 1
|
|
grid rowconfigure $w.top 0 -weight 1
|
|
|
|
# 5. Create a row of buttons at the bottom of the dialog.
|
|
|
|
set i 0
|
|
foreach but $buttons {
|
|
set name [lindex $but 0]
|
|
set opts [lrange $but 1 end]
|
|
if {![llength $opts]} {
|
|
# Capitalize the first letter of $name
|
|
set capName [string toupper $name 0]
|
|
set opts [list -text $capName]
|
|
}
|
|
|
|
eval [list tk::AmpWidget button $w.$name] $opts \
|
|
[list -command [list set tk::Priv(button) $name]]
|
|
|
|
if {[string equal $name $data(-default)]} {
|
|
$w.$name configure -default active
|
|
} else {
|
|
$w.$name configure -default normal
|
|
}
|
|
pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
|
|
|
|
# create the binding for the key accelerator, based on the underline
|
|
#
|
|
# set underIdx [$w.$name cget -under]
|
|
# if {$underIdx >= 0} {
|
|
# set key [string index [$w.$name cget -text] $underIdx]
|
|
# bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
|
|
# bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
|
|
# }
|
|
# incr i
|
|
}
|
|
bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A]
|
|
|
|
if {[string compare {} $data(-default)]} {
|
|
bind $w <FocusIn> {
|
|
if {[string equal Button [winfo class %W]]} {
|
|
%W configure -default active
|
|
}
|
|
}
|
|
bind $w <FocusOut> {
|
|
if {[string equal Button [winfo class %W]]} {
|
|
%W configure -default normal
|
|
}
|
|
}
|
|
}
|
|
|
|
# 6. Create a binding for <Return> on the dialog
|
|
|
|
bind $w <Return> {
|
|
if {[string equal Button [winfo class %W]]} {
|
|
tk::ButtonInvoke %W
|
|
}
|
|
}
|
|
|
|
# 7. Withdraw the window, then update all the geometry information
|
|
# so we know how big it wants to be, then center the window in the
|
|
# display and de-iconify it.
|
|
|
|
::tk::PlaceWindow $w widget $data(-parent)
|
|
|
|
# 8. Set a grab and claim the focus too.
|
|
|
|
if {[string compare $data(-default) ""]} {
|
|
set focus $w.$data(-default)
|
|
} else {
|
|
set focus $w
|
|
}
|
|
::tk::SetFocusGrab $w $focus
|
|
|
|
# 9. Wait for the user to respond, then restore the focus and
|
|
# return the index of the selected button. Restore the focus
|
|
# before deleting the window, since otherwise the window manager
|
|
# may take the focus away so we can't redirect it. Finally,
|
|
# restore any grab that was in effect.
|
|
|
|
vwait ::tk::Priv(button)
|
|
|
|
::tk::RestoreFocusGrab $w $focus
|
|
|
|
return $Priv(button)
|
|
}
|