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     ! 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.