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 # RCS: @(#) $Id: dialog.tcl,v 1.24 2007/12/13 15:26:27 dgp Exp $
   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 tcl_platform
  34     variable ::tk::Priv
  35
  36     # Check that $default was properly given
  37     if {[string is integer -strict $default]} {
  38         if {$default >= [llength $args]} {
  39             return -code error "default button index greater than number of\
  40                     buttons specified for tk_dialog"
  41         }
  42     } elseif {"" eq $default} {
  43         set default -1
  44     } else {
  45         set default [lsearch -exact $args $default]
  46     }
  47
  48     set windowingsystem [tk windowingsystem]
  49     if {$windowingsystem eq "aqua"} {
  50         option add *Dialog*background systemDialogBackgroundActive widgetDefault
  51         option add *Dialog*Button.highlightBackground \
  52                 systemDialogBackgroundActive widgetDefault
  53     }
  54
  55     # 1. Create the top-level window and divide it into top
  56     # and bottom parts.
  57
  58     destroy $w
  59     toplevel $w -class Dialog
  60     wm title $w $title
  61     wm iconname $w Dialog
  62     wm protocol $w WM_DELETE_WINDOW { }
  63
  64     # Dialog boxes should be transient with respect to their parent,
  65     # so that they will always stay on top of their parent window.  However,
  66     # some window managers will create the window as withdrawn if the parent
  67     # window is withdrawn or iconified.  Combined with the grab we put on the
  68     # window, this can hang the entire application.  Therefore we only make
  69     # the dialog transient if the parent is viewable.
  70     #
  71     if {[winfo viewable [winfo toplevel [winfo parent $w]]] } {
  72         wm transient $w [winfo toplevel [winfo parent $w]]
  73     }
  74
  75     if {$windowingsystem eq "aqua"} {
  76         ::tk::unsupported::MacWindowStyle style $w moveableModal {}
  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
 133     if {$default >= 0} {
 134         bind $w <Return> "
 135         [list $w.button$default] configure -state active -relief sunken
 136         update idletasks
 137         after 100
 138         set ::tk::Priv(button) $default
 139         "
 140     }
 141
 142     # 5. Create a <Destroy> binding for the window that sets the
 143     # button variable to -1;  this is needed in case something happens
 144     # that destroys the window, such as its parent window being destroyed.
 145
 146     bind $w <Destroy> {set ::tk::Priv(button) -1}
 147
 148     # 6. Withdraw the window, then update all the geometry information
 149     # so we know how big it wants to be, then center the window in the
 150     # display and de-iconify it.
 151
 152     wm withdraw $w
 153     update idletasks
 154     set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
 155             - [winfo vrootx [winfo parent $w]]}]
 156     set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
 157             - [winfo vrooty [winfo parent $w]]}]
 158     # Make sure that the window is on the screen and set the maximum
 159     # size of the window is the size of the screen.  That'll let things
 160     # fail fairly gracefully when very large messages are used. [Bug 827535]
 161     if {$x < 0} {
 162         set x 0
 163     }
 164     if {$y < 0} {
 165         set y 0
 166     }
 167     wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w]
 168     wm geometry $w +$x+$y
 169     wm deiconify $w
 170
 171     tkwait visibility $w
 172
 173     # 7. Set a grab and claim the focus too.
 174
 175     set oldFocus [focus]
 176     set oldGrab [grab current $w]
 177     if {$oldGrab ne ""} {
 178         set grabStatus [grab status $oldGrab]
 179     }
 180     grab $w
 181     if {$default >= 0} {
 182         focus $w.button$default
 183     } else {
 184         focus $w
 185     }
 186
 187     # 8. Wait for the user to respond, then restore the focus and
 188     # return the index of the selected button.  Restore the focus
 189     # before deleting the window, since otherwise the window manager
 190     # may take the focus away so we can't redirect it.  Finally,
 191     # restore any grab that was in effect.
 192
 193     vwait ::tk::Priv(button)
 194     catch {focus $oldFocus}
 195     catch {
 196         # It's possible that the window has already been destroyed,
 197         # hence this "catch".  Delete the Destroy handler so that
 198         # Priv(button) doesn't get reset by it.
 199
 200         bind $w <Destroy> {}
 201         destroy $w
 202     }
 203     if {$oldGrab ne ""} {
 204         if {$grabStatus ne "global"} {
 205             grab $oldGrab
 206         } else {
 207             grab -global $oldGrab
 208         }
 209     }
 210     return $Priv(button)
 211 }