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
|
# $XConsortium: dialog.tcl /main/1 1996/09/21 14:15:10 kaleb $
#
#
#
#
# $XFree86$
#
# dialog.tcl --
#
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
# @(#) dialog.tcl 1.18 95/11/24 15:03:04
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
# tk_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.
#
# Arguments:
# w - Window to use for dialog top-level.
# title - Title to display in dialog's decorative frame.
# text - Message to display in dialog.
# bitmap - Bitmap 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 tk_dialog {w title text bitmap default args} {
global tkPriv
# 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 transient $w [winfo toplevel [winfo parent $w]]
frame $w.top -relief raised -bd 1
pack $w.top -side top -fill both
frame $w.bot -relief raised -bd 1
pack $w.bot -side bottom -fill both
# 2. Fill the top part with bitmap and message (use the option
# database for -wraplength so that it can be overridden by
# the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
label $w.msg -justify left -text $text \
-font -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
if {$bitmap != ""} {
label $w.bitmap -bitmap $bitmap
pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
}
# 3. Create a row of buttons at the bottom of the dialog.
set i 0
foreach but $args {
button $w.button$i -text $but -command "set tkPriv(button) $i"
if {$i == $default} {
frame $w.default -relief sunken -bd 1
raise $w.button$i $w.default
pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
pack $w.button$i -in $w.default -padx 2m -pady 2m
} else {
pack $w.button$i -in $w.bot -side left -expand 1 \
-padx 3m -pady 2m
}
incr i
}
# 4. 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 x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- [winfo vrootx [winfo parent $w]]]
set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- [winfo vrooty [winfo parent $w]]]
wm geom $w +$x+$y
wm deiconify $w
# 5. Set a grab and claim the focus too.
set oldFocus [focus]
set oldGrab [grab current $w]
if {$oldGrab != ""} {
set grabStatus [grab status $oldGrab]
}
grab $w
tkwait visibility $w
if {$default >= 0} {
focus $w.button$default
} else {
focus $w
}
# 6. 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}
destroy $w
if {$oldGrab != ""} {
if {$grabStatus == "global"} {
grab -global $oldGrab
} else {
grab $oldGrab
}
}
return $tkPriv(button)
}
|
