]> git.zerfleddert.de Git - micropolis/blame - src/tk/library/demos/mkDialog.tcl
Makefile: Micropolis build fixes for recent macOS
[micropolis] / src / tk / library / demos / mkDialog.tcl
CommitLineData
6a5fa4e0
MG
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
15proc 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}
Impressum, Datenschutz