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