mingw/lib/tk8.5/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 # Copyright (c) 1992-1993 The Regents of the University of California.
   7 # Copyright (c) 1994-1997 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 # ::tk_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.  If the
  18 # dialog somehow gets destroyed, -1 is returned.
  19 #
  20 # Arguments:
  21 # w -           Window to use for dialog top-level.
  22 # title -       Title to display in dialog's decorative frame.
  23 # text -        Message to display in dialog.
  24 # bitmap -      Bitmap to display in dialog (empty string means none).
  25 # default -     Index of button that is to display the default ring
  26 #               (-1 means none).
  27 # args -        One or more strings to display in buttons across the
  28 #               bottom of the dialog box.
  29
  30 proc ::tk_dialog {w title text bitmap default args} {
  31     global tcl_platform
  32     variable ::tk::Priv
  33
  34     # Check that $default was properly given
  35     if {[string is integer -strict $default]} {
  36         if {$default >= [llength $args]} {
  37             return -code error "default button index greater than number of\
  38                     buttons specified for tk_dialog"
  39         }
  40     } elseif {"" eq $default} {
  41         set default -1
  42     } else {
  43         set default [lsearch -exact $args $default]
  44     }
  45
  46     set windowingsystem [tk windowingsystem]
  47     if {$windowingsystem eq "aqua"} {
  48         option add *Dialog*background systemDialogBackgroundActive widgetDefault
  49         option add *Dialog*Button.highlightBackground \
  50                 systemDialogBackgroundActive widgetDefault
  51     }
  52
  53     # 1. Create the top-level window and divide it into top
  54     # and bottom parts.
  55
  56     destroy $w
  57     toplevel $w -class Dialog
  58     wm title $w $title
  59     wm iconname $w Dialog
  60     wm protocol $w WM_DELETE_WINDOW { }
  61
  62     # Dialog boxes should be transient with respect to their parent,
  63     # so that they will always stay on top of their parent window.  However,
  64     # some window managers will create the window as withdrawn if the parent
  65     # window is withdrawn or iconified.  Combined with the grab we put on the
  66     # window, this can hang the entire application.  Therefore we only make
  67     # the dialog transient if the parent is viewable.
  68     #
  69     if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
  70         wm transient $w [winfo toplevel [winfo parent $w]]
  71     }
  72
  73     if {$windowingsystem eq "aqua"} {
  74         ::tk::unsupported::MacWindowStyle style $w moveableModal {}
  75     } elseif {$windowingsystem eq "x11"} {
  76         wm attributes $w -type dialog
  77     }
  78
  79     frame $w.bot
  80     frame $w.top
  81     if {$windowingsystem eq "x11"} {
  82         $w.bot configure -relief raised -bd 1
  83         $w.top configure -relief raised -bd 1
  84     }
  85     pack $w.bot -side bottom -fill both
  86     pack $w.top -side top -fill both -expand 1
  87     grid anchor $w.bot center
  88
  89     # 2. Fill the top part with bitmap and message (use the option
  90     # database for -wraplength and -font so that they can be
  91     # overridden by the caller).
  92
  93     option add *Dialog.msg.wrapLength 3i widgetDefault
  94     option add *Dialog.msg.font TkCaptionFont widgetDefault
  95
  96     label $w.msg -justify left -text $text
  97     pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
  98     if {$bitmap ne ""} {
  99         if {$windowingsystem eq "aqua" && $bitmap eq "error"} {
 100             set bitmap "stop"
 101         }
 102         label $w.bitmap -bitmap $bitmap
 103         pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
 104     }
 105
 106     # 3. Create a row of buttons at the bottom of the dialog.
 107
 108     set i 0
 109     foreach but $args {
 110         button $w.button$i -text $but -command [list set ::tk::Priv(button) $i]
 111         if {$i == $default} {
 112             $w.button$i configure -default active
 113         } else {
 114             $w.button$i configure -default normal
 115         }
 116         grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \
 117                 -padx 10 -pady 4
 118         grid columnconfigure $w.bot $i
 119         # We boost the size of some Mac buttons for l&f
 120         if {$windowingsystem eq "aqua"} {
 121             set tmp [string tolower $but]
 122             if {$tmp eq "ok" || $tmp eq "cancel"} {
 123                 grid columnconfigure $w.bot $i -minsize 90
 124             }
 125             grid configure $w.button$i -pady 7
 126         }
 127         incr i
 128     }
 129
 130     # 4. Create a binding for <Return> on the dialog if there is a
 131     # default button.
 132     # Convention also dictates that if the keyboard focus moves among the
 133     # the buttons that the <Return> binding affects the button with the focus.
 134
 135     if {$default >= 0} {
 136         bind $w <Return> [list $w.button$default invoke]
 137     }
 138     bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}]
 139     bind $w <Tab> [list bind $w <Return> {[tk_focusNext %W] invoke}]
 140
 141     # 5. Create a <Destroy> binding for the window that sets the
 142     # button variable to -1;  this is needed in case something happens
 143     # that destroys the window, such as its parent window being destroyed.
 144
 145     bind $w <Destroy> {set ::tk::Priv(button) -1}
 146
 147     # 6. Withdraw the window, then update all the geometry information
 148     # so we know how big it wants to be, then center the window in the
 149     # display (Motif style) and de-iconify it.
 150
 151     ::tk::PlaceWindow $w
 152     tkwait visibility $w
 153
 154     # 7. Set a grab and claim the focus too.
 155
 156     if {$default >= 0} {
 157         set focus $w.button$default
 158     } else {
 159         set focus $w
 160     }
 161     tk::SetFocusGrab $w $focus
 162
 163     # 8. Wait for the user to respond, then restore the focus and
 164     # return the index of the selected button.  Restore the focus
 165     # before deleting the window, since otherwise the window manager
 166     # may take the focus away so we can't redirect it.  Finally,
 167     # restore any grab that was in effect.
 168
 169     vwait ::tk::Priv(button)
 170
 171     catch {
 172         # It's possible that the window has already been destroyed,
 173         # hence this "catch".  Delete the Destroy handler so that
 174         # Priv(button) doesn't get reset by it.
 175
 176         bind $w <Destroy> {}
 177     }
 178     tk::RestoreFocusGrab $w $focus
 179     return $Priv(button)
 180 }