library/dialog.tcl

   1 # dialog.tcl --
   2 #
   3 # This file defines the procedure ck_dialog, which creates a dialog
   4 # box containing a bitmap, a message, and one or more buttons.
   5 #
   6 # Copyright (c) 1992-1993 The Regents of the University of California.
   7 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
   8 #
   9 # See the file "license.terms" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12
  13 #
  14 # ck_dialog:
  15 #
  16 # This procedure displays a dialog box, waits for a button in the dialog
  17 # to be invoked, then returns the index of the selected button.
  18 #
  19 # Arguments:
  20 # w -           Window to use for dialog top-level.
  21 # title -       Title to display in dialog's decorative frame.
  22 # text -        Message to display in dialog.
  23 # default -
  24 # args -        One or more strings to display in buttons across the
  25 #               bottom of the dialog box.
  26
  27 proc ck_dialog {w title text default args} {
  28     global ckPriv
  29     if {[llength $args] <= 0} {
  30         return -1
  31     }
  32     catch {destroy $w}
  33     toplevel $w -class Dialog \
  34         -border {ulcorner hline urcorner vline lrcorner hline llcorner vline}
  35     place $w -relx 0.5 -rely 0.5 -anchor center
  36     if {[string length $title] > 0} {
  37         label $w.title -text $title
  38         pack $w.title -side top -fill x
  39         frame $w.sep0 -border hline -height 1
  40         pack $w.sep0 -side top -fill x
  41     }
  42     message $w.msg -text $text
  43     pack $w.msg -side top
  44     frame $w.sep1 -border hline -height 1
  45     pack $w.sep1 -side top -fill x
  46     frame $w.b
  47     pack $w.b -side top -fill x
  48     set i 0
  49     foreach but $args {
  50         button $w.b.b$i -text $but -command \
  51             "set ckPriv(button) $i ; destroy $w"
  52         pack $w.b.b$i -side left -ipadx 1 -expand 1
  53         incr i
  54     }
  55         if {catch {set default [expr $default+0]} {
  56                 set default 0
  57         }
  58         if {[string length $default]&&$default >=0&& $default <$i} {
  59                 focus $w.b.b$default
  60         } else {
  61         focus $w.b.b0
  62         }
  63     tkwait window $w
  64     return $ckPriv(button)
  65 }