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
|
# colorscheme added by M Callahan <mjc@stelias.com>
catch {source $env(CONTROL_PANEL_LIB_DIR)/colorscheme.tcl}
# The dialog boxes go here
proc center_dialog {w {p ""}} {
update idletasks
if {$p == ""} {
catch {set p [winfo parent $w]}
}
set x [expr 0 - [winfo reqwidth $w]/2 ]
set y [expr 0 - [winfo reqheight $w]/2 ]
if {$p != "" && [winfo ismapped $p] == 1} {
set x [expr $x + [winfo width $p]/2 + [winfo x $p] + [winfo vrootx $p]]
set y [expr $y + [winfo height $p]/2 + [winfo y $p] + [winfo vrooty $p]]
} else {
# window seems to have no parent (or parent is unmapped) - center in root
set x [expr $x + [winfo screenwidth $w]/2]
set y [expr $y + [winfo screenheight $w]/2]
}
wm group $w $p
wm geometry $w +$x+$y
wm deiconify $w
}
# The following copyright is included for the following modified
# version of tk_dialog
# Copyright (c) 1992-1993 The Regents of the University of California.
# All rights reserved.
#
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#
# 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 rhs_dialog {w title text bitmap default args} {
global tk_priv
# 1. Create the top-level window and divide it into top
# and bottom parts.
catch {destroy $w}
toplevel $w -class Dialog
# M Callahan <mjc@stelias.com>: make window transient
wm transient $w .
wm title $w $title
wm iconname $w Dialog
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.
message $w.msg -aspect 100000 -text $text -font fixed
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 5m -pady 5m
if {$bitmap != ""} {
label $w.bitmap -bitmap $bitmap
pack $w.bitmap -in $w.top -side left -padx 5m -pady 5m
}
# 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 tk_priv(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 \
-ipadx 2m -ipady 1m
bind $w <Return> "$w.button$i flash; set tk_priv(button) $i"
} else {
pack $w.button$i -in $w.bot -side left -expand 1 \
-padx 3m -pady 3m -ipadx 2m -ipady 1m
}
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
center_dialog $w
# 5. Set a grab and claim the focus too.
set oldFocus [focus]
grab $w
focus $w
# 6. Wait for the user to respond, then restore the focus and
# return the index of the selected button.
tkwait variable tk_priv(button)
destroy $w
focus $oldFocus
return $tk_priv(button)
}
proc rhs_error_dialog {s} {
rhs_dialog .error "Error" $s error 0 "Ok"
}
proc rhs_continue_dialog {s} {
return [rhs_dialog .error "Notice" $s question 1 "Continue" "Cancel"]
}
proc rhs_yesno_dialog {s c} {
return [rhs_dialog .error "Notice" $s question $c "Yes" "No"]
}
proc rhs_info_dialog {s} {
rhs_dialog .error "Info" $s info 0 "Ok"
}
|
