git.zerfleddert.de Git - micropolis/blob - src/tk/library/demos/mkDialog.tcl

   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 }