dialog.tcl (6025B)
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 # Copyright (c) 1992-1993 The Regents of the University of California. 7 # Copyright (c) 1994-1997 Sun Microsystems, Inc. 8 # 9 # See the file "license.terms" for information on usage and redistribution 10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 # 12 13 # 14 # ::tk_dialog: 15 # 16 # This procedure displays a dialog box, waits for a button in the dialog 17 # to be invoked, then returns the index of the selected button. If the 18 # dialog somehow gets destroyed, -1 is returned. 19 # 20 # Arguments: 21 # w - Window to use for dialog top-level. 22 # title - Title to display in dialog's decorative frame. 23 # text - Message to display in dialog. 24 # bitmap - Bitmap to display in dialog (empty string means none). 25 # default - Index of button that is to display the default ring 26 # (-1 means none). 27 # args - One or more strings to display in buttons across the 28 # bottom of the dialog box. 29 30 proc ::tk_dialog {w title text bitmap default args} { 31 variable ::tk::Priv 32 33 # Check that $default was properly given 34 if {[string is integer -strict $default]} { 35 if {$default >= [llength $args]} { 36 return -code error -errorcode {TK DIALOG BAD_DEFAULT} \ 37 "default button index greater than number of buttons\ 38 specified for tk_dialog" 39 } 40 } elseif {"" eq $default} { 41 set default -1 42 } else { 43 set default [lsearch -exact $args $default] 44 } 45 46 set windowingsystem [tk windowingsystem] 47 if {$windowingsystem eq "aqua"} { 48 option add *Dialog*background systemDialogBackgroundActive widgetDefault 49 option add *Dialog*Button.highlightBackground \ 50 systemDialogBackgroundActive widgetDefault 51 } 52 53 # 1. Create the top-level window and divide it into top 54 # and bottom parts. 55 56 destroy $w 57 toplevel $w -class Dialog 58 wm title $w $title 59 wm iconname $w Dialog 60 wm protocol $w WM_DELETE_WINDOW { } 61 62 # Dialog boxes should be transient with respect to their parent, 63 # so that they will always stay on top of their parent window. However, 64 # some window managers will create the window as withdrawn if the parent 65 # window is withdrawn or iconified. Combined with the grab we put on the 66 # window, this can hang the entire application. Therefore we only make 67 # the dialog transient if the parent is viewable. 68 # 69 if {[winfo viewable [winfo toplevel [winfo parent $w]]] } { 70 wm transient $w [winfo toplevel [winfo parent $w]] 71 } 72 73 if {$windowingsystem eq "aqua"} { 74 ::tk::unsupported::MacWindowStyle style $w moveableModal {} 75 } elseif {$windowingsystem eq "x11"} { 76 wm attributes $w -type dialog 77 } 78 79 frame $w.bot 80 frame $w.top 81 if {$windowingsystem eq "x11"} { 82 $w.bot configure -relief raised -bd 1 83 $w.top configure -relief raised -bd 1 84 } 85 pack $w.bot -side bottom -fill both 86 pack $w.top -side top -fill both -expand 1 87 grid anchor $w.bot center 88 89 # 2. Fill the top part with bitmap and message (use the option 90 # database for -wraplength and -font so that they can be 91 # overridden by the caller). 92 93 option add *Dialog.msg.wrapLength 3i widgetDefault 94 option add *Dialog.msg.font TkCaptionFont widgetDefault 95 96 label $w.msg -justify left -text $text 97 pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m 98 if {$bitmap ne ""} { 99 if {$windowingsystem eq "aqua" && $bitmap eq "error"} { 100 set bitmap "stop" 101 } 102 label $w.bitmap -bitmap $bitmap 103 pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m 104 } 105 106 # 3. Create a row of buttons at the bottom of the dialog. 107 108 set i 0 109 foreach but $args { 110 button $w.button$i -text $but -command [list set ::tk::Priv(button) $i] 111 if {$i == $default} { 112 $w.button$i configure -default active 113 } else { 114 $w.button$i configure -default normal 115 } 116 grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \ 117 -padx 10 -pady 4 118 grid columnconfigure $w.bot $i 119 # We boost the size of some Mac buttons for l&f 120 if {$windowingsystem eq "aqua"} { 121 set tmp [string tolower $but] 122 if {$tmp eq "ok" || $tmp eq "cancel"} { 123 grid columnconfigure $w.bot $i -minsize 90 124 } 125 grid configure $w.button$i -pady 7 126 } 127 incr i 128 } 129 130 # 4. Create a binding for <Return> on the dialog if there is a 131 # default button. 132 # Convention also dictates that if the keyboard focus moves among the 133 # the buttons that the <Return> binding affects the button with the focus. 134 135 if {$default >= 0} { 136 bind $w <Return> [list $w.button$default invoke] 137 } 138 bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}] 139 bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}] 140 141 # 5. Create a <Destroy> binding for the window that sets the 142 # button variable to -1; this is needed in case something happens 143 # that destroys the window, such as its parent window being destroyed. 144 145 bind $w <Destroy> {set ::tk::Priv(button) -1} 146 147 # 6. Withdraw the window, then update all the geometry information 148 # so we know how big it wants to be, then center the window in the 149 # display (Motif style) and de-iconify it. 150 151 ::tk::PlaceWindow $w 152 tkwait visibility $w 153 154 # 7. Set a grab and claim the focus too. 155 156 if {$default >= 0} { 157 set focus $w.button$default 158 } else { 159 set focus $w 160 } 161 tk::SetFocusGrab $w $focus 162 163 # 8. Wait for the user to respond, then restore the focus and 164 # return the index of the selected button. Restore the focus 165 # before deleting the window, since otherwise the window manager 166 # may take the focus away so we can't redirect it. Finally, 167 # restore any grab that was in effect. 168 169 vwait ::tk::Priv(button) 170 171 catch { 172 # It's possible that the window has already been destroyed, 173 # hence this "catch". Delete the Destroy handler so that 174 # Priv(button) doesn't get reset by it. 175 176 bind $w <Destroy> {} 177 } 178 tk::RestoreFocusGrab $w $focus 179 return $Priv(button) 180 }