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