1# dialog.tcl -- 2# 3# This file defines the procedure tk_dialog, which creates a dialog 4# box containing a bitmap, a message, and one or more buttons. 5# 6# SCCS: @(#) dialog.tcl 1.26 96/05/07 09:30:31 7# 8# Copyright (c) 1992-1993 The Regents of the University of California. 9# Copyright (c) 1994-1996 Sun Microsystems, Inc. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14 15# 16# tk_dialog: 17# 18# This procedure displays a dialog box, waits for a button in the dialog 19# to be invoked, then returns the index of the selected button. If the 20# dialog somehow gets destroyed, -1 is returned. 21# 22# Arguments: 23# w - Window to use for dialog top-level. 24# title - Title to display in dialog's decorative frame. 25# text - Message to display in dialog. 26# bitmap - Bitmap to display in dialog (empty string means none). 27# default - Index of button that is to display the default ring 28# (-1 means none). 29# args - One or more strings to display in buttons across the 30# bottom of the dialog box. 31 32proc tk_dialog {w title text bitmap default args} { 33 global tkPriv 34 35 # 1. Create the top-level window and divide it into top 36 # and bottom parts. 37 38 catch {destroy $w} 39 toplevel $w -class Dialog 40 wm title $w $title 41 wm iconname $w Dialog 42 wm protocol $w WM_DELETE_WINDOW { } 43 44 # The following command means that the dialog won't be posted if 45 # [winfo parent $w] is iconified, but it's really needed; otherwise 46 # the dialog can become obscured by other windows in the application, 47 # even though its grab keeps the rest of the application from being used. 48 49 wm transient $w [winfo toplevel [winfo parent $w]] 50 frame $w.bot -relief raised -bd 1 51 pack $w.bot -side bottom -fill both 52 frame $w.top -relief raised -bd 1 53 pack $w.top -side top -fill both -expand 1 54 55 # 2. Fill the top part with bitmap and message (use the option 56 # database for -wraplength so that it can be overridden by 57 # the caller). 58 59 option add *Dialog.msg.wrapLength 3i widgetDefault 60 label $w.msg -justify left -text $text 61 catch {$w.msg configure -font \ 62 -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* 63 } 64 pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m 65 if {$bitmap != ""} { 66 label $w.bitmap -bitmap $bitmap 67 pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m 68 } 69 70 # 3. Create a row of buttons at the bottom of the dialog. 71 72 set i 0 73 foreach but $args { 74 button $w.button$i -text $but -command "set tkPriv(button) $i" 75 if {$i == $default} { 76 frame $w.default -relief sunken -bd 1 77 raise $w.button$i $w.default 78 pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m 79 pack $w.button$i -in $w.default -padx 2m -pady 2m 80 } else { 81 pack $w.button$i -in $w.bot -side left -expand 1 \ 82 -padx 3m -pady 2m 83 } 84 incr i 85 } 86 87 # 4. Create a binding for <Return> on the dialog if there is a 88 # default button. 89 90 if {$default >= 0} { 91 bind $w <Return> " 92 $w.button$default configure -state active -relief sunken 93 update idletasks 94 after 100 95 set tkPriv(button) $default 96 " 97 } 98 99 # 5. Create a <Destroy> binding for the window that sets the 100 # button variable to -1; this is needed in case something happens 101 # that destroys the window, such as its parent window being destroyed. 102 103 bind $w <Destroy> {set tkPriv(button) -1} 104 105 # 6. Withdraw the window, then update all the geometry information 106 # so we know how big it wants to be, then center the window in the 107 # display and de-iconify it. 108 109 wm withdraw $w 110 update idletasks 111 set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ 112 - [winfo vrootx [winfo parent $w]]] 113 set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ 114 - [winfo vrooty [winfo parent $w]]] 115 wm geom $w +$x+$y 116 wm deiconify $w 117 118 # 7. Set a grab and claim the focus too. 119 120 set oldFocus [focus] 121 set oldGrab [grab current $w] 122 if {$oldGrab != ""} { 123 set grabStatus [grab status $oldGrab] 124 } 125 grab $w 126 if {$default >= 0} { 127 focus $w.button$default 128 } else { 129 focus $w 130 } 131 132 # 8. Wait for the user to respond, then restore the focus and 133 # return the index of the selected button. Restore the focus 134 # before deleting the window, since otherwise the window manager 135 # may take the focus away so we can't redirect it. Finally, 136 # restore any grab that was in effect. 137 138 tkwait variable tkPriv(button) 139 catch {focus $oldFocus} 140 catch { 141 # It's possible that the window has already been destroyed, 142 # hence this "catch". Delete the Destroy handler so that 143 # tkPriv(button) doesn't get reset by it. 144 145 bind $w <Destroy> {} 146 destroy $w 147 } 148 if {$oldGrab != ""} { 149 if {$grabStatus == "global"} { 150 grab -global $oldGrab 151 } else { 152 grab $oldGrab 153 } 154 } 155 return $tkPriv(button) 156} 157