SGI/util/SGI/lib/tk8.0/dialog.tcl

   1 # dialog.tcl --
   2 #
   3 # This file defines the procedure tk_dialog, which creates a dialog
   4 # box containing a bitmap, a message, and one or more buttons.
   5 #
   6 # SCCS: @(#) dialog.tcl 1.33 97/06/06 11:20:04
   7 #
   8 # Copyright (c) 1992-1993 The Regents of the University of California.
   9 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10 #
  11 # See the file "license.terms" for information on usage and redistribution
  12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13 #
  14
  15 #
  16 # tk_dialog:
  17 #
  18 # This procedure displays a dialog box, waits for a button in the dialog
  19 # to be invoked, then returns the index of the selected button.  If the
  20 # dialog somehow gets destroyed, -1 is returned.
  21 #
  22 # Arguments:
  23 # w -           Window to use for dialog top-level.
  24 # title -       Title to display in dialog's decorative frame.
  25 # text -        Message to display in dialog.
  26 # bitmap -      Bitmap to display in dialog (empty string means none).
  27 # default -     Index of button that is to display the default ring
  28 #               (-1 means none).
  29 # args -        One or more strings to display in buttons across the
  30 #               bottom of the dialog box.
  31
  32 proc tk_dialog {w title text bitmap default args} {
  33     global tkPriv tcl_platform
  34
  35     # 1. Create the top-level window and divide it into top
  36     # and bottom parts.
  37
  38     catch {destroy $w}
  39     toplevel $w -class Dialog
  40     wm title $w $title
  41     wm iconname $w Dialog
  42     wm protocol $w WM_DELETE_WINDOW { }
  43
  44     # The following command means that the dialog won't be posted if
  45     # [winfo parent $w] is iconified, but it's really needed;  otherwise
  46     # the dialog can become obscured by other windows in the application,
  47     # even though its grab keeps the rest of the application from being used.
  48
  49     wm transient $w [winfo toplevel [winfo parent $w]]
  50     if {$tcl_platform(platform) == "macintosh"} {
  51         unsupported1 style $w dBoxProc
  52     }
  53
  54     frame $w.bot
  55     frame $w.top
  56     if {$tcl_platform(platform) == "unix"} {
  57         $w.bot configure -relief raised -bd 1
  58         $w.top configure -relief raised -bd 1
  59     }
  60     pack $w.bot -side bottom -fill both
  61     pack $w.top -side top -fill both -expand 1
  62
  63     # 2. Fill the top part with bitmap and message (use the option
  64     # database for -wraplength so that it can be overridden by
  65     # the caller).
  66
  67     option add *Dialog.msg.wrapLength 3i widgetDefault
  68     label $w.msg -justify left -text $text
  69     if {$tcl_platform(platform) == "macintosh"} {
  70         $w.msg configure -font system
  71     } else {
  72         $w.msg configure -font {Times 18}
  73     }
  74     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  75     if {$bitmap != ""} {
  76         if {($tcl_platform(platform) == "macintosh") && ($bitmap == "error")} {
  77             set bitmap "stop"
  78         }
  79         label $w.bitmap -bitmap $bitmap
  80         pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
  81     }
  82
  83     # 3. Create a row of buttons at the bottom of the dialog.
  84
  85     set i 0
  86     foreach but $args {
  87         button $w.button$i -text $but -command "set tkPriv(button) $i"
  88         if {$i == $default} {
  89             $w.button$i configure -default active
  90         } else {
  91             $w.button$i configure -default normal
  92         }
  93         grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
  94         grid columnconfigure $w.bot $i
  95         # We boost the size of some Mac buttons for l&f
  96         if {$tcl_platform(platform) == "macintosh"} {
  97             set tmp [string tolower $but]
  98             if {($tmp == "ok") || ($tmp == "cancel")} {
  99                 grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
 100             }
 101         }
 102         incr i
 103     }
 104
 105     # 4. Create a binding for <Return> on the dialog if there is a
 106     # default button.
 107
 108     if {$default >= 0} {
 109         bind $w <Return> "
 110             $w.button$default configure -state active -relief sunken
 111             update idletasks
 112             after 100
 113             set tkPriv(button) $default
 114         "
 115     }
 116
 117     # 5. Create a <Destroy> binding for the window that sets the
 118     # button variable to -1;  this is needed in case something happens
 119     # that destroys the window, such as its parent window being destroyed.
 120
 121     bind $w <Destroy> {set tkPriv(button) -1}
 122
 123     # 6. Withdraw the window, then update all the geometry information
 124     # so we know how big it wants to be, then center the window in the
 125     # display and de-iconify it.
 126
 127     wm withdraw $w
 128     update idletasks
 129     set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
 130             - [winfo vrootx [winfo parent $w]]]
 131     set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
 132             - [winfo vrooty [winfo parent $w]]]
 133     wm geom $w +$x+$y
 134     wm deiconify $w
 135
 136     # 7. Set a grab and claim the focus too.
 137
 138     set oldFocus [focus]
 139     set oldGrab [grab current $w]
 140     if {$oldGrab != ""} {
 141         set grabStatus [grab status $oldGrab]
 142     }
 143     grab $w
 144     if {$default >= 0} {
 145         focus $w.button$default
 146     } else {
 147         focus $w
 148     }
 149
 150     # 8. Wait for the user to respond, then restore the focus and
 151     # return the index of the selected button.  Restore the focus
 152     # before deleting the window, since otherwise the window manager
 153     # may take the focus away so we can't redirect it.  Finally,
 154     # restore any grab that was in effect.
 155
 156     tkwait variable tkPriv(button)
 157     catch {focus $oldFocus}
 158     catch {
 159         # It's possible that the window has already been destroyed,
 160         # hence this "catch".  Delete the Destroy handler so that
 161         # tkPriv(button) doesn't get reset by it.
 162
 163         bind $w <Destroy> {}
 164         destroy $w
 165     }
 166     if {$oldGrab != ""} {
 167         if {$grabStatus == "global"} {
 168             grab -global $oldGrab
 169         } else {
 170             grab $oldGrab
 171         }
 172     }
 173     return $tkPriv(button)
 174 }