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"
}
|