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