diff options
Diffstat (limited to 'library/msgbox.tcl')
| -rw-r--r-- | library/msgbox.tcl | 78 |
1 files changed, 48 insertions, 30 deletions
diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 2a22d54..ed1f4fe 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -143,6 +143,7 @@ proc ::tk::MessageBox {args} { # set specs { {-default "" "" ""} + {-detail "" "" ""} {-icon "" "" "info"} {-message "" "" ""} {-parent "" "" .} @@ -156,7 +157,7 @@ proc ::tk::MessageBox {args} { error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } set windowingsystem [tk windowingsystem] - if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { + if {$windowingsystem eq "aqua"} { switch -- $data(-icon) { "error" {set data(-icon) "stop"} "warning" {set data(-icon) "caution"} @@ -241,16 +242,17 @@ proc ::tk::MessageBox {args} { set w .__tk__messagebox } + # There is only one background colour for the whole dialog + set bg [ttk::style lookup . -background] + # 3. Create the top-level window and divide it into top # and bottom parts. catch {destroy $w} - toplevel $w -class Dialog + toplevel $w -class Dialog -bg $bg wm title $w $data(-title) wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW [list $w.$cancel invoke] - # There is only one background colour for the whole dialog - set bg [$w cget -background] # Message boxes should be transient with respect to their parent so that # they always stay on top of the parent window. But some window managers @@ -263,38 +265,42 @@ proc ::tk::MessageBox {args} { wm transient $w $data(-parent) } - if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { + if {$windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w moveableModal {} } elseif {$windowingsystem eq "x11"} { wm attributes $w -type dialog } - frame $w.bot -background $bg + ttk::frame $w.bot;# -background $bg + grid anchor $w.bot center pack $w.bot -side bottom -fill both - frame $w.top -background $bg + ttk::frame $w.top;# -background $bg pack $w.top -side top -fill both -expand 1 - if {$windowingsystem ne "classic" && $windowingsystem ne "aqua"} { - $w.bot configure -relief raised -bd 1 - $w.top configure -relief raised -bd 1 + if {$windowingsystem ne "aqua"} { + #$w.bot configure -relief raised -bd 1 + #$w.top configure -relief raised -bd 1 } - # 4. Fill the top part with bitmap and message (use the option - # database for -wraplength and -font so that they can be + # 4. Fill the top part with bitmap, message and detail (use the + # option database for -wraplength and -font so that they can be # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { - option add *Dialog.msg.font system widgetDefault - } else { - option add *Dialog.msg.font {Times 14} widgetDefault + option add *Dialog.dtl.wrapLength 3i widgetDefault + option add *Dialog.msg.font TkCaptionFont widgetDefault + option add *Dialog.dtl.font TkDefaultFont widgetDefault + + ttk::label $w.msg -anchor nw -justify left -text $data(-message) + #-background $bg + if {$data(-detail) ne ""} { + ttk::label $w.dtl -anchor nw -justify left -text $data(-detail) + #-background $bg } - - label $w.msg -anchor nw -justify left -text $data(-message) \ - -background $bg if {$data(-icon) ne ""} { - if {($windowingsystem eq "classic" || $windowingsystem eq "aqua") + if {$windowingsystem eq "aqua" || ([winfo depth $w] < 4) || $tk_strictMotif} { - label $w.bitmap -bitmap $data(-icon) -background $bg + # ttk::label has no -bitmap option + label $w.bitmap -bitmap $data(-icon);# -background $bg } else { canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ -background $bg @@ -333,7 +339,12 @@ proc ::tk::MessageBox {args} { } grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m grid columnconfigure $w.top 1 -weight 1 - grid rowconfigure $w.top 0 -weight 1 + if {$data(-detail) ne ""} { + grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m} + grid rowconfigure $w.top 1 -weight 1 + } else { + grid rowconfigure $w.top 0 -weight 1 + } # 5. Create a row of buttons at the bottom of the dialog. @@ -347,8 +358,9 @@ proc ::tk::MessageBox {args} { set opts [list -text $capName] } - eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \ + eval [list tk::AmpWidget ttk::button $w.$name] $opts \ [list -command [list set tk::Priv(button) $name]] + # -padx 3m if {$name eq $data(-default)} { $w.$name configure -default active @@ -358,7 +370,7 @@ proc ::tk::MessageBox {args} { grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew grid columnconfigure $w.bot $i -uniform buttons # We boost the size of some Mac buttons for l&f - if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} { + if {$windowingsystem eq "aqua"} { set tmp [string tolower $name] if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" || $tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" || @@ -382,28 +394,31 @@ proc ::tk::MessageBox {args} { if {$data(-default) ne ""} { bind $w <FocusIn> { - if {"Button" eq [winfo class %W]} { + if {[winfo class %W] in "Button TButton"} { %W configure -default active } } bind $w <FocusOut> { - if {"Button" eq [winfo class %W]} { + if {[winfo class %W] in "Button TButton"} { %W configure -default normal } } } - # 6. Create bindings for <Return> and <Escape> on the dialog + # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog bind $w <Return> { - if {"Button" eq [winfo class %W]} { - tk::ButtonInvoke %W + if {[winfo class %W] in "Button TButton"} { + %W invoke } } # Invoke the designated cancelling operation bind $w <Escape> [list $w.$cancel invoke] + # At <Destroy> the buttons have vanished, so must do this directly. + bind $w.msg <Destroy> [list set tk::Priv(button) $cancel] + # 7. Withdraw the window, then update all the geometry information # so we know how big it wants to be, then center the window in the # display and de-iconify it. @@ -426,8 +441,11 @@ proc ::tk::MessageBox {args} { # restore any grab that was in effect. vwait ::tk::Priv(button) + # Copy the result now so any <Destroy> that happens won't cause + # trouble + set result $Priv(button) ::tk::RestoreFocusGrab $w $focus - return $Priv(button) + return $result } |