diff options
-rw-r--r-- | doc/WinViewable.3 | 31 | ||||
-rw-r--r-- | generic/tk.decls | 5 | ||||
-rw-r--r-- | generic/tkCmds.c | 16 | ||||
-rw-r--r-- | generic/tkDecls.h | 9 | ||||
-rw-r--r-- | generic/tkStubInit.c | 3 | ||||
-rw-r--r-- | generic/tkUtil.c | 36 | ||||
-rw-r--r-- | library/bgerror.tcl | 17 | ||||
-rw-r--r-- | library/dialog.tcl | 17 | ||||
-rw-r--r-- | library/msgbox.tcl | 15 | ||||
-rw-r--r-- | tests/msgbox.test | 32 | ||||
-rw-r--r-- | unix/mkLinks | 4 | ||||
-rw-r--r-- | win/tkWinDialog.c | 18 |
12 files changed, 142 insertions, 61 deletions
diff --git a/doc/WinViewable.3 b/doc/WinViewable.3 new file mode 100644 index 0000000..bc8bff7 --- /dev/null +++ b/doc/WinViewable.3 @@ -0,0 +1,31 @@ +'\" +'\" Copyright (c) 1998-2000 by Scriptics Corporation. +'\" All rights reserved. +'\" +'\" RCS: @(#) $Id: WinViewable.3,v 1.1 2000/04/18 02:18:32 ericm Exp $ +'\" +'\" +.so man.macros +.TH Tk_IsViewable 3 "" Tk "Tk Library Procedures" +.BS +.SH NAME +Tk_IsViewable \- determine whether a Tk window is viewable +.SH SYNOPSIS +.nf +\fB#include <tk.h>\fR +.sp +int +\fBTk_IsViewable\fR(\fItkwin\fR) +.SH ARGUMENTS +.AP Tk_Window tkwin +Window to examine. +.BE + +.SH DESCRIPTION +.PP +\fBTk_IsViewable\fR is a utility function used to +determine whether or not a Tk window is viewable. It returns +1 if the window given by \fItkwin\fR is viewable, and 0 if it is not. + +.SH KEYWORDS +window, viewable diff --git a/generic/tk.decls b/generic/tk.decls index fe8b72e..9c1d115 100644 --- a/generic/tk.decls +++ b/generic/tk.decls @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tk.decls,v 1.7 2000/02/09 02:13:50 hobbs Exp $ +# RCS: @(#) $Id: tk.decls,v 1.8 2000/04/18 02:18:32 ericm Exp $ library tk @@ -1120,6 +1120,9 @@ declare 236 generic { declare 237 generic { double Tk_PostscriptY (double y, Tk_PostscriptInfo psInfo) } +declare 238 generic { + int Tk_IsViewable (Tk_Window tkwin) +} # Define the platform specific public Tk interface. These functions are # only available on the designated platform. diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 34d383c..60b1515 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCmds.c,v 1.11 2000/02/01 11:41:10 hobbs Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.12 2000/04/18 02:18:32 ericm Exp $ */ #include "tkPort.h" @@ -1179,19 +1179,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) break; } case WIN_VIEWABLE: { - int viewable; - - viewable = 0; - for ( ; ; winPtr = winPtr->parentPtr) { - if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) { - break; - } - if (winPtr->flags & TK_TOP_LEVEL) { - viewable = 1; - break; - } - } - Tcl_SetBooleanObj(resultPtr, viewable); + Tcl_SetBooleanObj(resultPtr, Tk_IsViewable(tkwin)); break; } case WIN_VISUAL: { diff --git a/generic/tkDecls.h b/generic/tkDecls.h index 0a0820d..1ad995c 100644 --- a/generic/tkDecls.h +++ b/generic/tkDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkDecls.h,v 1.8 2000/02/08 11:31:32 hobbs Exp $ + * RCS: @(#) $Id: tkDecls.h,v 1.9 2000/04/18 02:18:32 ericm Exp $ */ #ifndef _TKDECLS @@ -815,6 +815,8 @@ EXTERN int Tk_PostscriptStipple _ANSI_ARGS_(( /* 237 */ EXTERN double Tk_PostscriptY _ANSI_ARGS_((double y, Tk_PostscriptInfo psInfo)); +/* 238 */ +EXTERN int Tk_IsViewable _ANSI_ARGS_((Tk_Window tkwin)); typedef struct TkStubHooks { struct TkPlatStubs *tkPlatStubs; @@ -1065,6 +1067,7 @@ typedef struct TkStubs { void (*tk_PostscriptPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_PostscriptInfo psInfo, double * coordPtr, int numPoints)); /* 235 */ int (*tk_PostscriptStipple) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_PostscriptInfo psInfo, Pixmap bitmap)); /* 236 */ double (*tk_PostscriptY) _ANSI_ARGS_((double y, Tk_PostscriptInfo psInfo)); /* 237 */ + int (*tk_IsViewable) _ANSI_ARGS_((Tk_Window tkwin)); /* 238 */ } TkStubs; #ifdef __cplusplus @@ -2027,6 +2030,10 @@ extern TkStubs *tkStubsPtr; #define Tk_PostscriptY \ (tkStubsPtr->tk_PostscriptY) /* 237 */ #endif +#ifndef Tk_IsViewable +#define Tk_IsViewable \ + (tkStubsPtr->tk_IsViewable) /* 238 */ +#endif #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index f242892..7dee693 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkStubInit.c,v 1.19 2000/04/10 22:43:12 ericm Exp $ + * RCS: @(#) $Id: tkStubInit.c,v 1.20 2000/04/18 02:18:33 ericm Exp $ */ #include "tkInt.h" @@ -948,6 +948,7 @@ TkStubs tkStubs = { Tk_PostscriptPath, /* 235 */ Tk_PostscriptStipple, /* 236 */ Tk_PostscriptY, /* 237 */ + Tk_IsViewable, /* 238 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tkUtil.c b/generic/tkUtil.c index 0ba1f96..b677e03 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUtil.c,v 1.7 1999/12/14 06:52:34 hobbs Exp $ + * RCS: @(#) $Id: tkUtil.c,v 1.8 2000/04/18 02:18:33 ericm Exp $ */ #include "tkInt.h" @@ -951,3 +951,37 @@ TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr) } return mPtr->numKey; } + +/* + *---------------------------------------------------------------------- + * + * Tk_IsViewable -- + * + * Given a Tk_Window pointer, determine if that window is viewable. + * + * Results: + * 1 if the window is viewable, 0 otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tk_IsViewable(tkwin) + Tk_Window tkwin; /* Pointer to the window to examine */ +{ + TkWindow *winPtr = (TkWindow *)tkwin; + int viewable = 0; + for ( ; ; winPtr = winPtr->parentPtr) { + if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) { + break; + } + if (winPtr->flags & TK_TOP_LEVEL) { + viewable = 1; + break; + } + } + return viewable; +} diff --git a/library/bgerror.tcl b/library/bgerror.tcl index f9dc8d8..398e140 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -4,7 +4,7 @@ # posts a dialog box with the error message and gives the user a chance # to see a more detailed stack trace. # -# RCS: @(#) $Id: bgerror.tcl,v 1.7 2000/04/11 18:19:06 ericm Exp $ +# RCS: @(#) $Id: bgerror.tcl,v 1.8 2000/04/18 02:18:33 ericm Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -40,21 +40,6 @@ proc bgerror err { set ret [catch {tkerror $err} msg]; if {$ret != 1} {return -code $ret $msg} - # Normally, the bgerror dialog is made transient with respect to "." (due - # to the implementation of tk_dialog). On some systems (like Windows), - # when a window is withdraw or iconified, it's transient windows go with - # it. Unfortunately, there is also a grab on the dialog (again because of - # the implementation of tk_dialog). So if "." is withdrawn or iconified - # and the user gets a bgerror, the app will hang, for no apparent reason. - # - # One (somewhat hacky) way to address this is to un-transient the dialog - # if "." is withdrawn or iconified. - after idle { - if { ![winfo viewable .bgerrorDialog] } { - wm transient .bgerrorDialog {} - } - } - # Ok the application's tkerror either failed or was not found # we use the default dialog then : if {$tcl_platform(platform) == "macintosh"} { diff --git a/library/dialog.tcl b/library/dialog.tcl index 499526e..b3c9dbd 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -3,7 +3,7 @@ # This file defines the procedure tk_dialog, which creates a dialog # box containing a bitmap, a message, and one or more buttons. # -# RCS: @(#) $Id: dialog.tcl,v 1.7 2000/01/12 11:45:14 hobbs Exp $ +# RCS: @(#) $Id: dialog.tcl,v 1.8 2000/04/18 02:18:33 ericm Exp $ # # Copyright (c) 1992-1993 The Regents of the University of California. # Copyright (c) 1994-1997 Sun Microsystems, Inc. @@ -53,12 +53,17 @@ proc tk_dialog {w title text bitmap default args} { wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW { } - # The following command means that the dialog won't be posted if - # [winfo parent $w] is iconified, but it's really needed; otherwise - # the dialog can become obscured by other windows in the application, - # even though its grab keeps the rest of the application from being used. + # Dialog boxes should be transient with respect to their parent, + # so that they will always stay on top of their parent window. However, + # some window managers will create the window as withdrawn if the parent + # window is withdrawn or iconified. Combined with the grab we put on the + # window, this can hang the entire application. Therefore we only make + # the dialog transient if the parent is viewable. + # + if { [winfo viewable [winfo toplevel [winfo parent $w]]] } { + wm transient $w [winfo toplevel [winfo parent $w]] + } - wm transient $w [winfo toplevel [winfo parent $w]] if {[string equal $tcl_platform(platform) "macintosh"]} { unsupported1 style $w dBoxProc } diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 09928ee..f3df745 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.8 1999/12/03 07:15:02 hobbs Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.9 2000/04/18 02:18:33 ericm Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -244,7 +244,18 @@ proc tkMessageBox {args} { wm title $w $data(-title) wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW { } - wm transient $w $data(-parent) + + # 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 + # will simply create the child window as withdrawn if the parent is not + # viewable (because it is withdrawn or iconified). This is not good for + # "grab"bed windows. So only make the message box transient if the parent + # is viewable. + # + if { [winfo viewable [winfo toplevel $data(-parent)]] } { + wm transient $w $data(-parent) + } + if {[string equal $tcl_platform(platform) "macintosh"]} { unsupported1 style $w dBoxProc } diff --git a/tests/msgbox.test b/tests/msgbox.test index e9a16d4..78adb81 100644 --- a/tests/msgbox.test +++ b/tests/msgbox.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: msgbox.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ +# RCS: @(#) $Id: msgbox.test,v 1.4 2000/04/18 02:18:34 ericm Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -165,19 +165,23 @@ foreach spec $specs { } } +# These tests will hang your test suite if they fail. +test msgbox-3.1 {tk_messageBox handles withdrawn parent} {nonUnixUserInteraction} { + wm withdraw . + ChooseMsg . "ok" + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -default ok +} "ok" +wm deiconify . + +test msgbox-3.2 {tk_messageBox handles iconified parent} {nonUnixUserInteraction} { + wm iconify . + ChooseMsg . "ok" + tk_messageBox -title Hi -message "Please press ok" \ + -type ok -default ok +} "ok" +wm deiconify . + # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/unix/mkLinks b/unix/mkLinks index 975b639..d3bac5c 100644 --- a/unix/mkLinks +++ b/unix/mkLinks @@ -663,6 +663,10 @@ if test -r MapWindow.3; then rm -f Tk_MapWindow.3 ln MapWindow.3 Tk_MapWindow.3 fi +if test -r WinViewable.3; then + rm -f Tk_IsViewable.3 + ln WinViewable.3 Tk_IsViewable.3 +fi if test -r MeasureChar.3; then rm -f Tk_MeasureChars.3 ln MeasureChar.3 Tk_MeasureChars.3 diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c index d7fc92a..c4a2bd8 100644 --- a/win/tkWinDialog.c +++ b/win/tkWinDialog.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinDialog.c,v 1.8 2000/03/31 09:24:26 hobbs Exp $ + * RCS: @(#) $Id: tkWinDialog.c,v 1.9 2000/04/18 02:18:34 ericm Exp $ * */ @@ -269,8 +269,13 @@ Tk_ChooseColorObjCmd(clientData, interp, objc, objv) } Tk_MakeWindowExist(parent); - chooseColor.hwndOwner = hWnd = Tk_GetHWND(Tk_WindowId(parent)); - + chooseColor.hwndOwner = NULL; + hWnd = NULL; + if (Tk_IsViewable(parent)) { + hWnd = Tk_GetHWND(Tk_WindowId(parent)); + chooseColor.hwndOwner = hWnd; + } + oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL); winCode = ChooseColor(&chooseColor); (void) Tcl_SetServiceMode(oldMode); @@ -1701,8 +1706,11 @@ Tk_MessageBoxObjCmd(clientData, interp, objc, objv) } Tk_MakeWindowExist(parent); - hWnd = Tk_GetHWND(Tk_WindowId(parent)); - + hWnd = NULL; + if ( Tk_IsViewable(parent) ) { + hWnd = Tk_GetHWND(Tk_WindowId(parent)); + } + flags = 0; if (defaultBtn >= 0) { int defaultBtnIdx; |