[37] | 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 | # RCS: @(#) $Id: dialog.tcl,v 1.14.2.1 2003/10/22 15:22:07 dkf Exp $ |
---|
| 7 | # |
---|
| 8 | # Copyright (c) 1992-1993 The Regents of the University of California. |
---|
| 9 | # Copyright (c) 1994-1997 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 | |
---|
| 32 | proc ::tk_dialog {w title text bitmap default args} { |
---|
| 33 | global tcl_platform |
---|
| 34 | variable ::tk::Priv |
---|
| 35 | |
---|
| 36 | # Check that $default was properly given |
---|
| 37 | if {[string is int $default]} { |
---|
| 38 | if {$default >= [llength $args]} { |
---|
| 39 | return -code error "default button index greater than number of\ |
---|
| 40 | buttons specified for tk_dialog" |
---|
| 41 | } |
---|
| 42 | } elseif {[string equal {} $default]} { |
---|
| 43 | set default -1 |
---|
| 44 | } else { |
---|
| 45 | set default [lsearch -exact $args $default] |
---|
| 46 | } |
---|
| 47 | |
---|
| 48 | # 1. Create the top-level window and divide it into top |
---|
| 49 | # and bottom parts. |
---|
| 50 | |
---|
| 51 | catch {destroy $w} |
---|
| 52 | toplevel $w -class Dialog |
---|
| 53 | wm title $w $title |
---|
| 54 | wm iconname $w Dialog |
---|
| 55 | wm protocol $w WM_DELETE_WINDOW { } |
---|
| 56 | |
---|
| 57 | # Dialog boxes should be transient with respect to their parent, |
---|
| 58 | # so that they will always stay on top of their parent window. However, |
---|
| 59 | # some window managers will create the window as withdrawn if the parent |
---|
| 60 | # window is withdrawn or iconified. Combined with the grab we put on the |
---|
| 61 | # window, this can hang the entire application. Therefore we only make |
---|
| 62 | # the dialog transient if the parent is viewable. |
---|
| 63 | # |
---|
| 64 | if {[winfo viewable [winfo toplevel [winfo parent $w]]] } { |
---|
| 65 | wm transient $w [winfo toplevel [winfo parent $w]] |
---|
| 66 | } |
---|
| 67 | |
---|
| 68 | if {[string equal $tcl_platform(platform) "macintosh"] |
---|
| 69 | || [string equal [tk windowingsystem] "aqua"]} { |
---|
| 70 | ::tk::unsupported::MacWindowStyle style $w dBoxProc |
---|
| 71 | } |
---|
| 72 | |
---|
| 73 | frame $w.bot |
---|
| 74 | frame $w.top |
---|
| 75 | if {[string equal [tk windowingsystem] "x11"]} { |
---|
| 76 | $w.bot configure -relief raised -bd 1 |
---|
| 77 | $w.top configure -relief raised -bd 1 |
---|
| 78 | } |
---|
| 79 | pack $w.bot -side bottom -fill both |
---|
| 80 | pack $w.top -side top -fill both -expand 1 |
---|
| 81 | |
---|
| 82 | # 2. Fill the top part with bitmap and message (use the option |
---|
| 83 | # database for -wraplength and -font so that they can be |
---|
| 84 | # overridden by the caller). |
---|
| 85 | |
---|
| 86 | option add *Dialog.msg.wrapLength 3i widgetDefault |
---|
| 87 | if {[string equal $tcl_platform(platform) "macintosh"] |
---|
| 88 | || [string equal [tk windowingsystem] "aqua"]} { |
---|
| 89 | option add *Dialog.msg.font system widgetDefault |
---|
| 90 | } else { |
---|
| 91 | option add *Dialog.msg.font {Times 12} widgetDefault |
---|
| 92 | } |
---|
| 93 | |
---|
| 94 | label $w.msg -justify left -text $text |
---|
| 95 | pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m |
---|
| 96 | if {[string compare $bitmap ""]} { |
---|
| 97 | if {([string equal $tcl_platform(platform) "macintosh"] |
---|
| 98 | || [string equal [tk windowingsystem] "aqua"]) &&\ |
---|
| 99 | [string equal $bitmap "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 {[string equal $tcl_platform(platform) "macintosh"] |
---|
| 121 | || [string equal [tk windowingsystem] "aqua"]} { |
---|
| 122 | set tmp [string tolower $but] |
---|
| 123 | if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} { |
---|
| 124 | grid columnconfigure $w.bot $i -minsize [expr {59 + 20}] |
---|
| 125 | } |
---|
| 126 | } |
---|
| 127 | incr i |
---|
| 128 | } |
---|
| 129 | |
---|
| 130 | # 4. Create a binding for <Return> on the dialog if there is a |
---|
| 131 | # default button. |
---|
| 132 | |
---|
| 133 | if {$default >= 0} { |
---|
| 134 | bind $w <Return> " |
---|
| 135 | [list $w.button$default] configure -state active -relief sunken |
---|
| 136 | update idletasks |
---|
| 137 | after 100 |
---|
| 138 | set ::tk::Priv(button) $default |
---|
| 139 | " |
---|
| 140 | } |
---|
| 141 | |
---|
| 142 | # 5. Create a <Destroy> binding for the window that sets the |
---|
| 143 | # button variable to -1; this is needed in case something happens |
---|
| 144 | # that destroys the window, such as its parent window being destroyed. |
---|
| 145 | |
---|
| 146 | bind $w <Destroy> {set ::tk::Priv(button) -1} |
---|
| 147 | |
---|
| 148 | # 6. Withdraw the window, then update all the geometry information |
---|
| 149 | # so we know how big it wants to be, then center the window in the |
---|
| 150 | # display and de-iconify it. |
---|
| 151 | |
---|
| 152 | wm withdraw $w |
---|
| 153 | update idletasks |
---|
| 154 | set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \ |
---|
| 155 | - [winfo vrootx [winfo parent $w]]}] |
---|
| 156 | set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \ |
---|
| 157 | - [winfo vrooty [winfo parent $w]]}] |
---|
| 158 | # Make sure that the window is on the screen and set the maximum |
---|
| 159 | # size of the window is the size of the screen. That'll let things |
---|
| 160 | # fail fairly gracefully when very large messages are used. [Bug 827535] |
---|
| 161 | if {$x < 0} { |
---|
| 162 | set x 0 |
---|
| 163 | } |
---|
| 164 | if {$y < 0} { |
---|
| 165 | set y 0 |
---|
| 166 | } |
---|
| 167 | wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w] |
---|
| 168 | wm geom $w +$x+$y |
---|
| 169 | wm deiconify $w |
---|
| 170 | |
---|
| 171 | # 7. Set a grab and claim the focus too. |
---|
| 172 | |
---|
| 173 | set oldFocus [focus] |
---|
| 174 | set oldGrab [grab current $w] |
---|
| 175 | if {[string compare $oldGrab ""]} { |
---|
| 176 | set grabStatus [grab status $oldGrab] |
---|
| 177 | } |
---|
| 178 | grab $w |
---|
| 179 | if {$default >= 0} { |
---|
| 180 | focus $w.button$default |
---|
| 181 | } else { |
---|
| 182 | focus $w |
---|
| 183 | } |
---|
| 184 | |
---|
| 185 | # 8. Wait for the user to respond, then restore the focus and |
---|
| 186 | # return the index of the selected button. Restore the focus |
---|
| 187 | # before deleting the window, since otherwise the window manager |
---|
| 188 | # may take the focus away so we can't redirect it. Finally, |
---|
| 189 | # restore any grab that was in effect. |
---|
| 190 | |
---|
| 191 | vwait ::tk::Priv(button) |
---|
| 192 | catch {focus $oldFocus} |
---|
| 193 | catch { |
---|
| 194 | # It's possible that the window has already been destroyed, |
---|
| 195 | # hence this "catch". Delete the Destroy handler so that |
---|
| 196 | # Priv(button) doesn't get reset by it. |
---|
| 197 | |
---|
| 198 | bind $w <Destroy> {} |
---|
| 199 | destroy $w |
---|
| 200 | } |
---|
| 201 | if {[string compare $oldGrab ""]} { |
---|
| 202 | if {[string compare $grabStatus "global"]} { |
---|
| 203 | grab $oldGrab |
---|
| 204 | } else { |
---|
| 205 | grab -global $oldGrab |
---|
| 206 | } |
---|
| 207 | } |
---|
| 208 | return $Priv(button) |
---|
| 209 | } |
---|