diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | library/clrpick.tcl | 141 | ||||
| -rw-r--r-- | library/msgbox.tcl | 49 |
3 files changed, 108 insertions, 89 deletions
@@ -1,3 +1,10 @@ +2004-08-05 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * library/clrpick.tcl (BuildDialog): + * library/msgbox.tcl (MessageBox): Add scheme for cancelling + dialog boxes with Escape and also handle what happens when the + window gets nuked from outside. [Bug 987169] + 2004-08-04 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tkImgPhoto.c (ImgPhotoBlendComplexAlpha): Clean the code diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 8f1acbb..ecc682c 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -3,7 +3,7 @@ # Color selection dialog for platforms that do not support a # standard color selection dialog. # -# RCS: @(#) $Id: clrpick.tcl,v 1.20 2003/02/21 14:40:26 dkf Exp $ +# RCS: @(#) $Id: clrpick.tcl,v 1.21 2004/08/05 10:04:36 dkf Exp $ # # Copyright (c) 1996 Sun Microsystems, Inc. # @@ -69,7 +69,7 @@ proc ::tk::dialog::color:: {args} { set sc [winfo screen $data(-parent)] set winExists [winfo exists $w] - if {!$winExists || [string compare $sc [winfo screen $w]]} { + if {!$winExists || $sc ne [winfo screen $w]} { if {$winExists} { destroy $w } @@ -106,10 +106,11 @@ proc ::tk::dialog::color:: {args} { # restore any grab that was in effect. vwait ::tk::Priv(selectColor) + set result $Priv(selectColor) ::tk::RestoreFocusGrab $w $data(okBtn) unset data - return $Priv(selectColor) + return $result } # ::tk::dialog::color::InitValues -- @@ -124,8 +125,7 @@ proc ::tk::dialog::color::InitValues {dataName} { set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}] # ColorbarWidth is the width of each colorbar - set data(colorbarWidth) \ - [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}] + set data(colorbarWidth) [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}] # Indent is the width of the space at the left and right side of the # colorbar. It is always half the selector polygon width, because the @@ -171,8 +171,7 @@ proc ::tk::dialog::color::Config {dataName argList} { # 1: the configuration specs # - if {[info exists Priv(selectColor)] && \ - [string compare $Priv(selectColor) ""]} { + if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} { set defaultColor $Priv(selectColor) } else { set defaultColor [. cget -background] @@ -188,7 +187,7 @@ proc ::tk::dialog::color::Config {dataName argList} { # tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList - if {[string equal $data(-title) ""]} { + if {$data(-title) eq ""} { set data(-title) " " } if {[catch {winfo rgb . $data(-initialcolor)} err]} { @@ -215,12 +214,12 @@ proc ::tk::dialog::color::BuildDialog {w} { set stripsFrame [frame $topFrame.colorStrip] set maxWidth [::tk::mcmaxamp &Red &Green &Blue] - set maxWidth [expr {$maxWidth<6?6:$maxWidth}] - set colorList [list \ - red [mc "&Red"] \ - green [mc "&Green"] \ - blue [mc "&Blue"] \ - ] + set maxWidth [expr {$maxWidth<6 ? 6 : $maxWidth}] + set colorList { + red "&Red" + green "&Green" + blue "&Blue" + } foreach {color l} $colorList { # each f frame contains an [R|G|B] entry and the equiv. color strip. set f [frame $stripsFrame.$color] @@ -228,9 +227,10 @@ proc ::tk::dialog::color::BuildDialog {w} { # The box frame contains the label and entry widget for an [R|G|B] set box [frame $f.box] - bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \ - -anchor ne] <<AltUnderlined>> [list focus $box.entry] - + ::tk::AmpWidget label $box.label -text "[mc $l]:" \ + -width $maxWidth -anchor ne + bind $box.label <<AltUnderlined>> [list focus $box.entry] + entry $box.entry -textvariable \ ::tk::dialog::color::[winfo name $w]($color,intensity) \ -width 4 @@ -238,14 +238,15 @@ proc ::tk::dialog::color::BuildDialog {w} { pack $box.entry -side left -anchor n -pady 0 pack $box -side left -fill both - set height [expr \ - {[winfo reqheight $box.entry] - \ - 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}] + set height [expr { + [winfo reqheight $box.entry] - + 2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd]) + }] - canvas $f.color -height $height\ - -width $data(BARS_WIDTH) -relief sunken -bd 2 + canvas $f.color -height $height \ + -width $data(BARS_WIDTH) -relief sunken -bd 2 canvas $f.sel -height $data(PLGN_HEIGHT) \ - -width $data(canvasWidth) -highlightthickness 0 + -width $data(canvasWidth) -highlightthickness 0 pack $f.color -expand yes -fill both pack $f.sel -expand yes -fill both @@ -256,16 +257,16 @@ proc ::tk::dialog::color::BuildDialog {w} { set data($color,sel) $f.sel bind $data($color,col) <Configure> \ - [list tk::dialog::color::DrawColorScale $w $color 1] + [list tk::dialog::color::DrawColorScale $w $color 1] bind $data($color,col) <Enter> \ - [list tk::dialog::color::EnterColorBar $w $color] + [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,col) <Leave> \ - [list tk::dialog::color::LeaveColorBar $w $color] + [list tk::dialog::color::LeaveColorBar $w $color] bind $data($color,sel) <Enter> \ - [list tk::dialog::color::EnterColorBar $w $color] + [list tk::dialog::color::EnterColorBar $w $color] bind $data($color,sel) <Leave> \ - [list tk::dialog::color::LeaveColorBar $w $color] + [list tk::dialog::color::LeaveColorBar $w $color] bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w] } @@ -276,11 +277,11 @@ proc ::tk::dialog::color::BuildDialog {w} { # selected color # set selFrame [frame $topFrame.sel] - set lab [::tk::AmpWidget label $selFrame.lab -text [mc "&Selection:"] \ - -anchor sw] + set lab [::tk::AmpWidget label $selFrame.lab \ + -text [mc "&Selection:"] -anchor sw] set ent [entry $selFrame.ent \ - -textvariable ::tk::dialog::color::[winfo name $w](selection) \ - -width 16] + -textvariable ::tk::dialog::color::[winfo name $w](selection) \ + -width 16] set f1 [frame $selFrame.f1 -relief sunken -bd 2] set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70] @@ -296,7 +297,7 @@ proc ::tk::dialog::color::BuildDialog {w} { # the botFrame frame contains the buttons # set botFrame [frame $w.bot -relief raised -bd 1] - + ::tk::AmpWidget button $botFrame.ok -text [mc "&OK"] \ -command [list tk::dialog::color::OkCmd $w] ::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"] \ @@ -304,7 +305,7 @@ proc ::tk::dialog::color::BuildDialog {w} { set data(okBtn) $botFrame.ok set data(cancelBtn) $botFrame.cancel - + grid x $botFrame.ok x $botFrame.cancel x -sticky ew grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10 grid columnconfigure $botFrame {0 4} -weight 1 -uniform space @@ -312,13 +313,13 @@ proc ::tk::dialog::color::BuildDialog {w} { grid columnconfigure $botFrame 2 -weight 2 -uniform space pack $botFrame -side bottom -fill x - # Accelerator bindings bind $lab <<AltUnderlined>> [list focus $ent] bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)] bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A] wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w] + bind $lab <Destroy> [list tk::dialog::color::CancelCmd $w] } # ::tk::dialog::color::SetRGBValue -- @@ -331,11 +332,11 @@ proc ::tk::dialog::color::SetRGBValue {w color} { set data(red,intensity) [lindex $color 0] set data(green,intensity) [lindex $color 1] set data(blue,intensity) [lindex $color 2] - + RedrawColorBars $w all # Now compute the new x value of each colorbars pointer polygon - foreach color [list red green blue ] { + foreach color {red green blue} { set x [RgbToX $w $data($color,intensity)] MoveSelector $w $data($color,sel) $color $x 0 } @@ -347,9 +348,11 @@ proc ::tk::dialog::color::SetRGBValue {w color} { # proc ::tk::dialog::color::XToRgb {w x} { upvar ::tk::dialog::color::[winfo name $w] data - + set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}] - if {$x > 255} { set x 255 } + if {$x > 255} { + set x 255 + } return $x } @@ -359,11 +362,10 @@ proc ::tk::dialog::color::XToRgb {w x} { # proc ::tk::dialog::color::RgbToX {w color} { upvar ::tk::dialog::color::[winfo name $w] data - + return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}] } - # ::tk::dialog::color::DrawColorScale -- # # Draw color scale is called whenever the size of one of the color @@ -382,7 +384,7 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { # First remove all the lines that already exist. if { $data(lines,$c,last) > $data(lines,$c,start)} { for {set i $data(lines,$c,start)} \ - {$i <= $data(lines,$c,last)} { incr i} { + {$i <= $data(lines,$c,last)} {incr i} { $sel delete $i } } @@ -390,7 +392,7 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { if {[info exists data($c,index)]} { $sel delete $data($c,index) } - + # Draw the selection polygons CreateSelector $w $sel $c $sel bind $data($c,index) <ButtonPress-1> \ @@ -423,34 +425,28 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { # l is the canvas index of the first colorbar. set l $data(lines,$c,start) } - + # Draw the color bars. set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}] for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} { set intensity [expr {$i * $data(intensityIncr)}] set startx [expr {$i * $data(colorbarWidth) + $highlightW}] - if {[string equal $c "red"]} { + if {$c eq "red"} { set color [format "#%02x%02x%02x" \ - $intensity \ - $data(green,intensity) \ - $data(blue,intensity)] - } elseif {[string equal $c "green"]} { + $intensity $data(green,intensity) $data(blue,intensity)] + } elseif {$c eq "green"} { set color [format "#%02x%02x%02x" \ - $data(red,intensity) \ - $intensity \ - $data(blue,intensity)] + $data(red,intensity) $intensity $data(blue,intensity)] } else { set color [format "#%02x%02x%02x" \ - $data(red,intensity) \ - $data(green,intensity) \ - $intensity] + $data(red,intensity) $data(green,intensity) $intensity] } if {$create} { set index [$col create rect $startx $highlightW \ [expr {$startx +$data(colorbarWidth)}] \ - [expr {[winfo height $col] + $highlightW}]\ - -fill $color -outline $color] + [expr {[winfo height $col] + $highlightW}] \ + -fill $color -outline $color] } else { $col itemconfigure $l -fill $color -outline $color incr l @@ -474,9 +470,9 @@ proc ::tk::dialog::color::DrawColorScale {w c {create 0}} { proc ::tk::dialog::color::CreateSelector {w sel c } { upvar ::tk::dialog::color::[winfo name $w] data set data($c,index) [$sel create polygon \ - 0 $data(PLGN_HEIGHT) \ - $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \ - $data(indent) 0] + 0 $data(PLGN_HEIGHT) \ + $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \ + $data(indent) 0] set data($c,x) [RgbToX $w $data($c,intensity)] $sel move $data($c,index) $data($c,x) 0 } @@ -489,8 +485,8 @@ proc ::tk::dialog::color::RedrawFinalColor {w} { upvar ::tk::dialog::color::[winfo name $w] data set color [format "#%02x%02x%02x" $data(red,intensity) \ - $data(green,intensity) $data(blue,intensity)] - + $data(green,intensity) $data(blue,intensity)] + $data(finalCanvas) configure -bg $color set data(finalColor) $color set data(selection) $color @@ -573,7 +569,7 @@ proc ::tk::dialog::color::MoveSelector {w sel color x delta} { set diff [expr {$x - $data($color,x)}] $sel move $data($color,index) $diff 0 set data($color,x) [expr {$data($color,x) + $diff}] - + # Return the x value that it was actually set at return $x } @@ -589,7 +585,7 @@ proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { upvar ::tk::dialog::color::[winfo name $w] data set x [MoveSelector $w $sel $color $x $delta] - + # Determine exactly what color we are looking at. set data($color,intensity) [XToRgb $w $x] @@ -603,13 +599,15 @@ proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { # proc ::tk::dialog::color::ResizeColorBars {w} { upvar ::tk::dialog::color::[winfo name $w] data - - if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || - (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} { + + if { + ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || + (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0) + } then { set data(BARS_WIDTH) $data(NUM_COLORBARS) } InitValues [winfo name $w] - foreach color [list red green blue ] { + foreach color {red green blue} { $data($color,col) configure -width $data(canvasWidth) DrawColorScale $w $color 1 } @@ -628,7 +626,7 @@ proc ::tk::dialog::color::HandleSelEntry {w} { set data(selection) $data(finalColor) return } - + set R [expr {[lindex $color 0]/0x100}] set G [expr {[lindex $color 1]/0x100}] set B [expr {[lindex $color 2]/0x100}] @@ -644,7 +642,7 @@ proc ::tk::dialog::color::HandleSelEntry {w} { proc ::tk::dialog::color::HandleRGBEntry {w} { upvar ::tk::dialog::color::[winfo name $w] data - foreach c [list red green blue] { + foreach c {red green blue} { if {[catch { set data($c,intensity) [expr {int($data($c,intensity))}] }]} { @@ -688,10 +686,9 @@ proc ::tk::dialog::color::OkCmd {w} { set Priv(selectColor) $data(finalColor) } -# user hits Cancel button +# user hits Cancel button or destroys window # proc ::tk::dialog::color::CancelCmd {w} { variable ::tk::Priv set Priv(selectColor) "" } - diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 24bc516..365882d 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# RCS: @(#) $Id: msgbox.tcl,v 1.28 2004/05/13 23:19:57 dkf Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.29 2004/08/05 10:04:36 dkf Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -158,7 +158,7 @@ proc ::tk::MessageBox {args} { if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { switch -- $data(-icon) { "error" {set data(-icon) "stop"} "warning" {set data(-icon) "caution"} @@ -174,26 +174,32 @@ proc ::tk::MessageBox {args} { abortretryignore { set names [list abort retry ignore] set labels [list &Abort &Retry &Ignore] + set cancel abort } ok { set names [list ok] set labels {&OK} + set cancel ok } okcancel { set names [list ok cancel] set labels [list &OK &Cancel] + set cancel cancel } retrycancel { set names [list retry cancel] set labels [list &Retry &Cancel] + set cancel cancel } yesno { set names [list yes no] set labels [list &Yes &No] + set cancel no } yesnocancel { set names [list yes no cancel] set labels [list &Yes &No &Cancel] + set cancel cancel } default { error "bad -type value \"$data(-type)\": must be\ @@ -216,7 +222,7 @@ proc ::tk::MessageBox {args} { set valid 0 foreach btn $buttons { - if {[string equal [lindex $btn 0] $data(-default)]} { + if {[lindex $btn 0] eq $data(-default)} { set valid 1 break } @@ -228,7 +234,7 @@ proc ::tk::MessageBox {args} { # 2. Set the dialog to be a child window of $parent # # - if {[string compare $data(-parent) .]} { + if {$data(-parent) ne "."} { set w $data(-parent).__tk__messagebox } else { set w .__tk__messagebox @@ -256,7 +262,7 @@ proc ::tk::MessageBox {args} { wm transient $w $data(-parent) } - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { unsupported::MacWindowStyle style $w dBoxProc } @@ -265,7 +271,7 @@ proc ::tk::MessageBox {args} { pack $w.bot -side bottom -fill both frame $w.top -background $bg pack $w.top -side top -fill both -expand 1 - if {![string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] ne "aqua"} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } @@ -276,7 +282,7 @@ proc ::tk::MessageBox {args} { option add *Dialog.msg.wrapLength 3i widgetDefault option add *Dialog.dtl.wrapLength 3i widgetDefault - if {[string equal [tk windowingsystem] "aqua"]} { + if {[tk windowingsystem] eq "aqua"} { option add *Dialog.msg.font system widgetDefault option add *Dialog.dtl.font system widgetDefault } else { @@ -290,8 +296,8 @@ proc ::tk::MessageBox {args} { label $w.dtl -anchor nw -justify left -text $data(-detail) \ -background $bg } - if {[string compare $data(-icon) ""]} { - if {[string equal [tk windowingsystem] "aqua"] + if {$data(-icon) ne ""} { + if {[tk windowingsystem] eq "aqua" || ([winfo depth $w] < 4) || $tk_strictMotif} { label $w.bitmap -bitmap $data(-icon) -background $bg } else { @@ -354,7 +360,7 @@ proc ::tk::MessageBox {args} { eval [list tk::AmpWidget button $w.$name -padx 3m] $opts \ [list -command [list set tk::Priv(button) $name]] - if {[string equal $name $data(-default)]} { + if {$name eq $data(-default)} { $w.$name configure -default active } else { $w.$name configure -default normal @@ -374,27 +380,33 @@ proc ::tk::MessageBox {args} { } bind $w <Alt-Key> [list ::tk::AltKeyInDialog $w %A] - if {[string compare {} $data(-default)]} { + if {$data(-default) ne ""} { bind $w <FocusIn> { - if {[string equal Button [winfo class %W]]} { + if {[winfo class %W] eq "Button"} { %W configure -default active } } bind $w <FocusOut> { - if {[string equal Button [winfo class %W]]} { + if {[winfo class %W] eq "Button"} { %W configure -default normal } } } - # 6. Create a binding for <Return> on the dialog + # 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog bind $w <Return> { - if {[string equal Button [winfo class %W]]} { + if {[winfo class %W] eq "Button"} { tk::ButtonInvoke %W } } + # Invoke the designated cancelling operation + bind $w <Escape> [list tk::ButtonInvoke $w.$cancel] + + # 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. @@ -403,7 +415,7 @@ proc ::tk::MessageBox {args} { # 8. Set a grab and claim the focus too. - if {[string compare $data(-default) ""]} { + if {$data(-default) ne ""} { set focus $w.$data(-default) } else { set focus $w @@ -417,8 +429,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 } |