From 6df0f87c2b7371a450da4a6be3c698b0c150022c Mon Sep 17 00:00:00 2001 From: hobbs Date: Sat, 17 Apr 2004 03:54:09 +0000 Subject: * library/bgerror.tcl (bgerror): rework to only set -topmost bit on Windows if necessary. Also use existing ::tk functions for placing dialog and managing focus/grab. --- ChangeLog | 8 ++++- library/bgerror.tcl | 90 +++++++++++++++++++++-------------------------------- 2 files changed, 42 insertions(+), 56 deletions(-) diff --git a/ChangeLog b/ChangeLog index 27b621e..67ac5ca 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-04-16 Jeff Hobbs + + * library/bgerror.tcl (bgerror): rework to only set -topmost bit + on Windows if necessary. Also use existing ::tk functions for + placing dialog and managing focus/grab. + 2004-03-31 Jim Ingham * tkMacOSXMenu.c (EventuallyInvokeMenu): Report errors from invoking @@ -296,7 +302,7 @@ * generic/tkMenu.c (MenuVarProc): prevent this from triggering while interp is being destroyed. -2x03-11-21 Benjamin Riefenstahl +2003-11-21 Benjamin Riefenstahl *** 8.4.5 TAGGED FOR RELEASE *** diff --git a/library/bgerror.tcl b/library/bgerror.tcl index e0d32c7..8f6d22e 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,24 +9,20 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.1 2003/04/25 20:11:06 hobbs Exp $ -# $Id: bgerror.tcl,v 1.23.2.1 2003/04/25 20:11:06 hobbs Exp $ - -namespace eval ::tk { - namespace eval dialog { - namespace eval error { - namespace import ::tk::msgcat::* - namespace export bgerror - option add *ErrorDialog.function.text [mc "Save To Log"] \ - widgetDefault - option add *ErrorDialog.function.command [namespace code SaveToLog] - } - } +# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.2 2004/04/17 03:54:10 hobbs Exp $ +# $Id: bgerror.tcl,v 1.23.2.2 2004/04/17 03:54:10 hobbs Exp $ + +namespace eval ::tk::dialog::error { + namespace import -force ::tk::msgcat::* + namespace export bgerror + option add *ErrorDialog.function.text [mc "Save To Log"] \ + widgetDefault + option add *ErrorDialog.function.command [namespace code SaveToLog] } proc ::tk::dialog::error::Return {} { variable button - + .bgerrorDialog.ok configure -state active -relief sunken update idletasks after 100 @@ -40,8 +36,8 @@ proc ::tk::dialog::error::Details {} { if { ($caption eq "") || ($command eq "") } { grid forget $w.function } - $w.function configure -text $caption -command \ - "$command [list [.bgerrorDialog.top.info.text get 1.0 end]]" + lappend command [.bgerrorDialog.top.info.text get 1.0 end-1c] + $w.function configure -text $caption -command $command grid $w.top.info - -sticky nsew -padx 3m -pady 3m } @@ -74,7 +70,7 @@ proc ::tk::dialog::error::Destroy {w} { } # ::tk::dialog::error::bgerror -- -# This is the default version of bgerror. +# This is the default version of bgerror. # It tries to execute tkerror, if that fails it posts a dialog box containing # the error message and gives the user a chance to ask to see a stack # trace. @@ -136,13 +132,11 @@ proc ::tk::dialog::error::bgerror err { catch {destroy .bgerrorDialog} toplevel .bgerrorDialog -class ErrorDialog + wm withdraw .bgerrorDialog wm title .bgerrorDialog $title wm iconname .bgerrorDialog ErrorDialog wm protocol .bgerrorDialog WM_DELETE_WINDOW { } - if {$tcl_platform(platform) eq "windows"} { - wm attributes .bgerrorDialog -topmost 1 - } if {($tcl_platform(platform) eq "macintosh") || ([tk windowingsystem] eq "aqua")} { ::tk::unsupported::MacWindowStyle style .bgerrorDialog dBoxProc @@ -213,7 +207,7 @@ proc ::tk::dialog::error::bgerror err { button .bgerrorDialog.$name \ -text $caption \ -default normal \ - -command [namespace code "set button $i"] + -command [namespace code [list set button $i]] grid .bgerrorDialog.$name \ -in .bgerrorDialog.bot \ -column $i \ @@ -237,34 +231,27 @@ proc ::tk::dialog::error::bgerror err { bind .bgerrorDialog [namespace code [list Destroy %W]] .bgerrorDialog.function configure -command [namespace code Details] - # 6. 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. + # 6. Update all the geometry information so we know how big it wants + # to be, then center the window in the display and deiconify it. - wm withdraw .bgerrorDialog - update idletasks - set parent [winfo parent .bgerrorDialog] - set width [winfo reqwidth .bgerrorDialog] - set height [winfo reqheight .bgerrorDialog] - set x [expr {([winfo screenwidth .bgerrorDialog] - $width )/2 - \ - [winfo vrootx $parent]}] - set y [expr {([winfo screenheight .bgerrorDialog] - $height)/2 - \ - [winfo vrooty $parent]}] - .bgerrorDialog configure -width $width - wm geometry .bgerrorDialog +$x+$y - wm deiconify .bgerrorDialog - - # 7. Set a grab and claim the focus too. - - set oldFocus [focus] - set oldGrab [grab current .bgerrorDialog] - if {$oldGrab != ""} { - set grabStatus [grab status $oldGrab] + ::tk::PlaceWindow .bgerrorDialog + + # 7. Ensure that we are topmost. + + raise .bgerrorDialog + if {$tcl_platform(platform) eq "windows"} { + # Place it topmost if we aren't at the top of the stacking + # order to ensure that it's seen + if {[lindex [wm stackorder .] end] ne ".bgerrorDialog"} { + wm attributes .bgerrorDialog -topmost 1 + } } - grab .bgerrorDialog - focus .bgerrorDialog.ok - # 8. Wait for the user to respond, then restore the focus and + # 8. Set a grab and claim the focus too. + + ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.ok + + # 9. Wait for the user to respond, then restore the focus and # return the index of the selected button. Restore the focus # before deleting the window, since otherwise the window manager # may take the focus away so we can't redirect it. Finally, @@ -272,15 +259,8 @@ proc ::tk::dialog::error::bgerror err { vwait [namespace which -variable button] set copy $button; # Save a copy... - catch {focus $oldFocus} - catch {destroy .bgerrorDialog} - if {$oldGrab ne ""} { - if {$grabStatus eq "global"} { - grab -global $oldGrab - } else { - grab $oldGrab - } - } + + ::tk::RestoreFocusGrab .bgerrorDialog .bgerrorDialog.ok destroy if {$copy == 1} { return -code break -- cgit v0.12