Return to mkDialog.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tk / library / demos

Annotation of micropolis/src/tk/library/demos/mkDialog.tcl, revision 1.1.1.1

1.1       root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.