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