]>
Commit | Line | Data |
---|---|---|
1 | # mkDialog w msgArgs list list ... | |
2 | # | |
3 | # Create a dialog box with a message and any number of buttons at | |
4 | # the bottom. | |
5 | # | |
6 | # Arguments: | |
7 | # w - Name to use for new top-level window. | |
8 | # msgArgs - List of arguments to use when creating the message of the | |
9 | # dialog box (e.g. text, justifcation, etc.) | |
10 | # list - A two-element list that describes one of the buttons that | |
11 | # will appear at the bottom of the dialog. The first element | |
12 | # gives the text to be displayed in the button and the second | |
13 | # gives the command to be invoked when the button is invoked. | |
14 | ||
15 | proc mkDialog {w msgArgs args} { | |
16 | catch {destroy $w} | |
17 | toplevel $w -class Dialog | |
18 | wm title $w "Dialog box" | |
19 | wm iconname $w "Dialog" | |
20 | ||
21 | # Create two frames in the main window. The top frame will hold the | |
22 | # message and the bottom one will hold the buttons. Arrange them | |
23 | # one above the other, with any extra vertical space split between | |
24 | # them. | |
25 | ||
26 | frame $w.top -relief raised -border 1 | |
27 | frame $w.bot -relief raised -border 1 | |
28 | pack append $w $w.top {top fill expand} $w.bot {top fill expand} | |
29 | ||
30 | # Create the message widget and arrange for it to be centered in the | |
31 | # top frame. | |
32 | ||
33 | eval message $w.top.msg -justify center \ | |
34 | -font -Adobe-times-medium-r-normal--*-180* $msgArgs | |
35 | pack append $w.top $w.top.msg {top expand padx 5 pady 5} | |
36 | ||
37 | # Create as many buttons as needed and arrange them from left to right | |
38 | # in the bottom frame. Embed the left button in an additional sunken | |
39 | # frame to indicate that it is the default button, and arrange for that | |
40 | # button to be invoked as the default action for clicks and returns in | |
41 | # the dialog. | |
42 | ||
43 | if {[llength $args] > 0} { | |
44 | set arg [lindex $args 0] | |
45 | frame $w.bot.0 -relief sunken -border 1 | |
46 | pack append $w.bot $w.bot.0 {left expand padx 20 pady 20} | |
47 | button $w.bot.0.button -text [lindex $arg 0] \ | |
48 | -command "[lindex $arg 1]; destroy $w" | |
49 | pack append $w.bot.0 $w.bot.0.button {expand padx 12 pady 12} | |
50 | bind $w <Return> "[lindex $arg 1]; destroy $w" | |
51 | focus $w | |
52 | ||
53 | set i 1 | |
54 | foreach arg [lrange $args 1 end] { | |
55 | button $w.bot.$i -text [lindex $arg 0] \ | |
56 | -command "[lindex $arg 1]; destroy $w" | |
57 | pack append $w.bot $w.bot.$i {left expand padx 20} | |
58 | set i [expr $i+1] | |
59 | } | |
60 | } | |
61 | bind $w <Any-Enter> [list focus $w] | |
62 | focus $w | |
63 | } |