dialog.tcl
1 # Nf Screen designer for Tk toolkit 2 # Copyright (C) 2004 Jeff Epler <jepler@unpythonic.net> 3 # 4 # This program is free software; you can redistribute it and/or modify 5 # it under the terms of the GNU General Public License as published by 6 # the Free Software Foundation; either version 2 of the License, or 7 # (at your option) any later version. 8 # 9 # This program is distributed in the hope that it will be useful, 10 # but WITHOUT ANY WARRANTY; without even the implied warranty of 11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 # GNU General Public License for more details. 13 # 14 # You should have received a copy of the GNU General Public License 15 # along with this program; if not, write to the Free Software 16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 17 18 # dialog.tcl -- 19 # 20 # This file defines the procedure nf_dialog, which creates a dialog 21 # box containing an image, a message, and one or more buttons. 22 # 23 # RCS: @(#) $Id$ 24 # 25 # Copyright (c) 1992-1993 The Regents of the University of California. 26 # Copyright (c) 1994-1997 Sun Microsystems, Inc. 27 # 28 # See the file "license.terms" for information on usage and redistribution 29 # of this file, and for a DISCLAIMER OF ALL WARRANTIES. 30 # 31 32 proc patient_grab w { 33 set ret [catch { grab $w } res] 34 if {!$ret} { return } 35 set sei $::errorInfo 36 if {$res == "grab failed: another application has grab" 37 || $res == "grab failed: window not viewable"} { 38 after 100 39 after idle patient_grab $w 40 } else { 41 error $ret $savedInfo 42 } 43 } 44 45 # 46 # nf_dialog: 47 # 48 # This procedure displays a dialog box, waits for a button in the dialog 49 # to be invoked, then returns the index of the selected button. If the 50 # dialog somehow gets destroyed, -1 is returned. 51 # 52 # Arguments: 53 # w - Window to use for dialog top-level. 54 # 55 # If it is a list, then it is of the form {w args} 56 # where args (different from the 'args' below) specify 57 # extra keyword arguments: 58 # -ext ...: show ... in a scrolling text area below the main 59 # text 60 # title - Title to display in dialog's decorative frame. 61 # text - Message to display in dialog. 62 # image - Image to display in dialog (empty string means none). 63 # default - Index of button that is to display the default ring 64 # (-1 means none). 65 # args - One or more strings to display in buttons across the 66 # bottom of the dialog box. 67 68 proc nf_dialog_default {t n i} { 69 for {set j 0} {$j < $n} {incr j} { 70 if {$i == $j} { 71 $t.button$j configure -default active 72 } else { 73 $t.button$j configure -default normal 74 } 75 } 76 } 77 78 proc nf_dialog {w title text image default args} { 79 global tkPriv tcl_platform 80 81 set pargs [lrange $w 1 end] 82 set w [lindex $w 0] 83 84 set ext {} 85 foreach {k v} $pargs { 86 switch -- $k { 87 -ext { set ext $v } 88 default { error "nf_dialog: unexpected positional argument $k $v" } 89 } 90 } 91 92 if {[llength $default] != 1} { 93 set accel $default 94 set default [lsearch $accel -2] 95 } else { 96 set accel {} 97 } 98 99 # 1. Create the top-level window and divide it into top 100 # and bottom parts. 101 102 catch {destroy $w} 103 toplevel $w -class Dialog 104 wm title $w $title 105 wm iconname $w Dialog 106 wm protocol $w WM_DELETE_WINDOW { } 107 wm resiz $w 0 0 108 109 # The following command means that the dialog won't be posted if 110 # [winfo parent $w] is iconified, but it's really needed; otherwise 111 # the dialog can become obscured by other windows in the application, 112 # even though its grab keeps the rest of the application from being used. 113 114 wm transient $w [winfo toplevel [winfo parent $w]] 115 if {![string compare $tcl_platform(platform) "macintosh"]} { 116 unsupported1 style $w dBoxProc 117 } 118 119 frame $w.bot 120 frame $w.top 121 if {[llength $args] == 1} { 122 pack $w.bot -side bottom -fill both 123 } else { 124 pack $w.bot -side bottom -fill none -anchor e -expand 1 125 } 126 pack $w.top -side top -fill both -expand 1 127 128 # 2. Fill the top part with image and message (use the option 129 # database for -wraplength and -font so that they can be 130 # overridden by the caller). 131 132 option add *Dialog.msg.wrapLength 3i widgetDefault 133 if {![string compare $tcl_platform(platform) "macintosh"]} { 134 option add *Dialog.msg.font system widgetDefault 135 } else { 136 option add *Dialog.msg.font {Times 12} widgetDefault 137 } 138 139 label $w.msg -justify left -text $text 140 pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m 141 if {[string compare $image ""]} { 142 if {![string compare $tcl_platform(platform) "macintosh"] && ![string compare $image "error"]} { 143 set image "stop" 144 } 145 label $w.image -image [load_image std_$image] 146 pack $w.image -in $w.top -side left -padx 3m -pady 3m 147 } 148 149 if {$ext != {}} { 150 frame $w.ext 151 text $w.ext.t -yscrollcommand [list $w.ext.s set] -wrap word 152 scrollbar $w.ext.s -command [list $w.ext.t yview] -orient v 153 pack $w.ext.t -side left -fill both -expand 1 154 pack $w.ext.s -side left -fill y 155 $w.ext.t insert end $ext 156 $w.ext.t configure -state disabled 157 pack $w.ext -side top 158 } 159 160 # 3. Create a row of buttons at the bottom of the dialog. 161 162 set i 0 163 set l [llength $args] 164 foreach but $args { 165 button $w.button$i -text $but -command "set tkPriv(button) $i" \ 166 -width 10 -height 1 -padx 0 -pady .25 167 168 set u [lindex $accel $i] 169 170 bind $w.button$i <FocusIn> [list nf_dialog_default $w $l $i] 171 172 if {$u == -3} { 173 bind $w <Escape> "$w.button$i flash; set tkPriv(button) $i" 174 } 175 bind $w.button$i <Return> {%W flash; %W invoke} 176 177 if {$u >= 0} { 178 set c [string index $but $u] 179 bind $w "[string tolower $c]" \ 180 "$w.button$i flash; set tkPriv(button) $i" 181 $w.button$i configure -underline $u 182 } 183 184 grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 3 -pady 3 185 grid columnconfigure $w.bot $i 186 187 set f [$w.button$i cget -font] 188 set bwidth [expr 9 * [font measure $f "0"]] 189 set twidth [font measure $f $but] 190 if {$twidth > $bwidth} { 191 $w.button$i configure -width 0 -padx .25m 192 } 193 194 incr i 195 } 196 197 # 4. Create a <Destroy> binding for the window that sets the 198 # button variable to -1; this is needed in case something happens 199 # that destroys the window, such as its parent window being destroyed. 200 201 bind $w <Destroy> {set tkPriv(button) -1} 202 203 # 5. Withdraw the window, then update all the geometry information 204 # so we know how big it wants to be, then center the window in the 205 # display and de-iconify it. 206 207 wm withdraw $w 208 update idletasks 209 210 set parent [winfo parent $w] 211 if {[winfo viewable $parent]} { 212 set x [expr {[winfo rootx $parent]+([winfo reqwidth $parent]-[winfo reqwidth $w])/2}] 213 set y [expr {[winfo rooty $parent]+([winfo reqheight $parent]-[winfo reqheight $w])/2}] 214 } else { 215 set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}] 216 set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}] 217 } 218 wm geom $w +$x+$y 219 wm deiconify $w 220 221 # 6. Set a grab and claim the focus too. 222 223 set oldFocus [focus] 224 set oldGrab [grab current $w] 225 if {[string compare $oldGrab ""]} { 226 set grabStatus [grab status $oldGrab] 227 } 228 patient_grab $w 229 if {$default >= 0} { 230 focus $w.button$default 231 } else { 232 focus $w 233 } 234 235 # 7. Wait for the user to respond, then restore the focus and 236 # return the index of the selected button. Restore the focus 237 # before deleting the window, since otherwise the window manager 238 # may take the focus away so we can't redirect it. Finally, 239 # restore any grab that was in effect. 240 241 tkwait variable tkPriv(button) 242 catch {focus $oldFocus} 243 catch { 244 # It's possible that the window has already been destroyed, 245 # hence this "catch". Delete the Destroy handler so that 246 # tkPriv(button) doesn't get reset by it. 247 248 bind $w <Destroy> {} 249 destroy $w 250 } 251 if {[string compare $oldGrab ""]} { 252 if {[string compare $grabStatus "global"]} { 253 grab $oldGrab 254 } else { 255 grab -global $oldGrab 256 } 257 } 258 return $tkPriv(button) 259 } 260 261 # vim:sw=4:sts=4: