# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
# RCS: @(#) $Id: dialog.tcl,v 1.14.2.1 2003/10/22 15:22:07 dkf Exp $
# Copyright (c) 1992-1993 The Regents of the University of California.
# 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.
# This procedure displays a dialog box, waits for a button in the dialog
# to be invoked, then returns the index of the selected button. If the
# dialog somehow gets destroyed, -1 is returned.
# w - Window to use for dialog top-level.
# title - Title to display in dialog's decorative frame.
# text - Message to display in dialog.
# bitmap - Bitmap to display in dialog (empty string means none).
# default - Index of button that is to display the default ring
# args - One or more strings to display in buttons across the
# bottom of the dialog box.
proc ::tk_dialog {w title
text bitmap default args
} {
# Check that $default was properly given
if {[string is int
$default]} {
if {$default >= [llength $args]} {
return -code error "default button index greater than number of\
buttons specified for tk_dialog"
} elseif
{[string equal
{} $default]} {
set default [lsearch -exact $args $default]
# 1. Create the top-level window and divide it into top
toplevel $w -class Dialog
wm protocol
$w WM_DELETE_WINDOW
{ }
# Dialog boxes should be transient with respect to their parent,
# so that they will always stay on top of their parent window. However,
# some window managers will create the window as withdrawn if the parent
# window is withdrawn or iconified. Combined with the grab we put on the
# window, this can hang the entire application. Therefore we only make
# the dialog transient if the parent is viewable.
if {[winfo viewable
[winfo toplevel [winfo parent
$w]]] } {
wm transient
$w [winfo toplevel [winfo parent
$w]]
if {[string equal
$tcl_platform(platform
) "macintosh"]
||
[string equal
[tk windowingsystem
] "aqua"]} {
::tk::unsupported::MacWindowStyle style
$w dBoxProc
if {[string equal
[tk windowingsystem
] "x11"]} {
$w.bot configure
-relief raised
-bd 1
$w.top configure
-relief raised
-bd 1
pack $w.bot
-side bottom
-fill both
pack $w.top
-side top
-fill both
-expand 1
# 2. 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
$tcl_platform(platform
) "macintosh"]
||
[string equal
[tk windowingsystem
] "aqua"]} {
option add
*Dialog.msg.
font system widgetDefault
option add
*Dialog.msg.
font {Times
12} widgetDefault
label $w.msg
-justify left
-text $text
pack $w.msg
-in $w.top
-side right
-expand 1 -fill both
-padx 3m
-pady 3m
if {[string compare
$bitmap ""]} {
if {([string equal
$tcl_platform(platform
) "macintosh"]
||
[string equal
[tk windowingsystem
] "aqua"]) &&\
[string equal
$bitmap "error"]} {
label $w.
bitmap -bitmap $bitmap
pack $w.
bitmap -in $w.top
-side left
-padx 3m
-pady 3m
# 3. Create a row of buttons at the bottom of the dialog.
button $w.
button$i -text $but -command [list set ::tk::Priv(button) $i]
$w.
button$i configure
-default active
$w.
button$i configure
-default normal
grid $w.
button$i -in $w.bot
-column $i -row 0 -sticky ew
\
grid columnconfigure
$w.bot
$i
# We boost the size of some Mac buttons for l&f
if {[string equal
$tcl_platform(platform
) "macintosh"]
||
[string equal
[tk windowingsystem
] "aqua"]} {
set tmp
[string tolower
$but]
if {[string equal
$tmp "ok"] ||
[string equal
$tmp "cancel"]} {
grid columnconfigure
$w.bot
$i -minsize [expr {59 + 20}]
# 4. Create a binding for <Return> on the dialog if there is a
[list $w.button$default] configure -state active -relief sunken
set ::tk::Priv(button) $default
# 5. Create a <Destroy> binding for the window that sets the
# button variable to -1; this is needed in case something happens
# that destroys the window, such as its parent window being destroyed.
bind $w <Destroy
> {set ::tk::Priv(button) -1}
# 6. 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.
set x
[expr {[winfo screenwidth
$w]/2 - [winfo reqwidth
$w]/2 \
- [winfo vrootx
[winfo parent
$w]]}]
set y
[expr {[winfo screenheight
$w]/2 - [winfo reqheight
$w]/2 \
- [winfo vrooty
[winfo parent
$w]]}]
# Make sure that the window is on the screen and set the maximum
# size of the window is the size of the screen. That'll let things
# fail fairly gracefully when very large messages are used. [Bug 827535]
wm maxsize
$w [winfo screenwidth
$w] [winfo screenheight
$w]
# 7. Set a grab and claim the focus too.
set oldGrab
[grab current
$w]
if {[string compare
$oldGrab ""]} {
set grabStatus
[grab status
$oldGrab]
# 8. 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.
# It's possible that the window has already been destroyed,
# hence this "catch". Delete the Destroy handler so that
# Priv(button) doesn't get reset by it.
if {[string compare
$oldGrab ""]} {
if {[string compare
$grabStatus "global"]} {