diff options
| -rw-r--r-- | ChangeLog | 27 | ||||
| -rw-r--r-- | doc/winfo.n | 10 | ||||
| -rw-r--r-- | doc/wm.n | 15 | ||||
| -rw-r--r-- | generic/tkInt.decls | 6 | ||||
| -rw-r--r-- | generic/tkIntDecls.h | 10 | ||||
| -rw-r--r-- | generic/tkStubInit.c | 3 | ||||
| -rw-r--r-- | tests/unixWm.test | 6 | ||||
| -rw-r--r-- | tests/wm.test | 301 | ||||
| -rw-r--r-- | unix/tkUnixWm.c | 232 | ||||
| -rw-r--r-- | win/tkWinWm.c | 274 |
10 files changed, 866 insertions, 18 deletions
@@ -1,3 +1,30 @@ +2001-12-03 Mo DeJong <mdejong@users.sourceforge.net> + + Add TK patch 481148 to implement TIP 74, the + wm stackorder command. + + * doc/winfo.n: Update documentation for the winfo + children command to indicate that top-level windows + are not returned in stacking order. + * doc/wm.n: Add documentation for wm stackorder. + * generic/tkInt.decls (TkWmStackorderToplevel): + Add decl for new function. + * generic/tkIntDecls.h: Regen. + * generic/tkStubInit.c: Regen. + * tests/unixWm.test: Add stackorder command to test + for wm command usage message. + * tests/wm.test: Add new set of tests for generic + window manager methods. + * unix/tkUnixWm.c (Tk_WmCmd, + TkWmStackorderToplevelWrapperMap, + TkWmStackorderToplevel): Add unix implementation of + new wm stackorder command. + * win/tkWinWm.c (Tk_WmCmd, + TkWmStackorderToplevelEnumProc, + TkWmStackorderToplevelWrapperMap, + TkWmStackorderToplevel): Add windows implementation + of new wm stackorder command. + 2001-12-03 David Gravereaux <davygrvy@pobox.com> * win/makefile.vc: install target changes by request from diff --git a/doc/winfo.n b/doc/winfo.n index f9e4de1..aacdabf 100644 --- a/doc/winfo.n +++ b/doc/winfo.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: winfo.n,v 1.2 1998/09/14 18:23:00 stanton Exp $ +'\" RCS: @(#) $Id: winfo.n,v 1.3 2001/12/04 03:07:43 mdejong Exp $ '\" .so man.macros .TH winfo n 4.3 Tk "Tk Built-In Commands" @@ -46,9 +46,11 @@ color map for \fIwindow\fR. .TP \fBwinfo children \fIwindow\fR Returns a list containing the path names of all the children -of \fIwindow\fR. The list is in stacking order, with the lowest -window first. Top-level windows are returned as children -of their logical parents. +of \fIwindow\fR. Top-level windows are returned as children +of their logical parents. The list is in stacking order, with +the lowest window first, except for Top-level windows which +are not returned in stacking order. Use the \fBwm stackorder\fR +command to query the stacking order of Top-level windows. .TP \fBwinfo class \fIwindow\fR Returns the class name for \fIwindow\fR. @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: wm.n,v 1.6 2001/01/02 19:13:02 andreas_kupries Exp $ +'\" RCS: @(#) $Id: wm.n,v 1.7 2001/12/04 03:07:43 mdejong Exp $ '\" .so man.macros .TH wm n 4.3 Tk "Tk Built-In Commands" @@ -400,6 +400,19 @@ source of the window's current size, or an empty string if no source has been specified yet. Most window managers interpret ``no source'' as equivalent to \fBprogram\fR. .TP +\fBwm stackorder \fIwindow\fR ?\fIisabove|isbelow\fR? \fI?window?\fR +The stackorder command returns a list of toplevel windows +in stacking order, from lowest to highest. When a single toplevel +window is passed, the returned list recursively includes all of the +window's children that are toplevels. Only those toplevels +that are currently mapped to the screen are returned. +The stackorder command can also be used to determine if one +toplevel is positioned above or below a second toplevel. +When two window arguments separated by either \fIisabove\fR or +\fIisbelow\fR are passed, a boolean result indicates whether +or not the first window is currently above or below the second +window in the stacking order. +.TP \fBwm state \fIwindow\fR ?newstate? If \fInewstate\fR is specified, the window will be set to the new state, otherwise it returns the current state of \fIwindow\fR: either diff --git a/generic/tkInt.decls b/generic/tkInt.decls index 13383a9..4a0593e 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -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: tkInt.decls,v 1.22 2001/11/23 02:04:56 das Exp $ +# RCS: @(#) $Id: tkInt.decls,v 1.23 2001/12/04 03:07:43 mdejong Exp $ library tk @@ -640,6 +640,10 @@ declare 140 generic { TkRegion TkPhotoGetValidRegion (Tk_PhotoHandle handle) } +declare 141 generic { + TkWindow ** TkWmStackorderToplevel(TkWindow *parentPtr) +} + ############################################################################## # Define the platform specific internal Tcl interface. These functions are diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index 11875d8..003b4b7 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -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: tkIntDecls.h,v 1.14 2001/11/23 02:05:04 das Exp $ + * RCS: @(#) $Id: tkIntDecls.h,v 1.15 2001/12/04 03:07:43 mdejong Exp $ */ #ifndef _TKINTDECLS @@ -479,6 +479,9 @@ EXTERN void TkpInitKeymapInfo _ANSI_ARGS_((TkDisplay * dispPtr)); /* 140 */ EXTERN TkRegion TkPhotoGetValidRegion _ANSI_ARGS_(( Tk_PhotoHandle handle)); +/* 141 */ +EXTERN TkWindow ** TkWmStackorderToplevel _ANSI_ARGS_(( + TkWindow * parentPtr)); typedef struct TkIntStubs { int magic; @@ -705,6 +708,7 @@ typedef struct TkIntStubs { KeySym (*tkpGetKeySym) _ANSI_ARGS_((TkDisplay * dispPtr, XEvent * eventPtr)); /* 138 */ void (*tkpInitKeymapInfo) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 139 */ TkRegion (*tkPhotoGetValidRegion) _ANSI_ARGS_((Tk_PhotoHandle handle)); /* 140 */ + TkWindow ** (*tkWmStackorderToplevel) _ANSI_ARGS_((TkWindow * parentPtr)); /* 141 */ } TkIntStubs; #ifdef __cplusplus @@ -1308,6 +1312,10 @@ extern TkIntStubs *tkIntStubsPtr; #define TkPhotoGetValidRegion \ (tkIntStubsPtr->tkPhotoGetValidRegion) /* 140 */ #endif +#ifndef TkWmStackorderToplevel +#define TkWmStackorderToplevel \ + (tkIntStubsPtr->tkWmStackorderToplevel) /* 141 */ +#endif #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 2d3a211..80ce36b 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.29 2001/11/23 02:07:07 das Exp $ + * RCS: @(#) $Id: tkStubInit.c,v 1.30 2001/12/04 03:07:43 mdejong Exp $ */ #include "tkInt.h" @@ -268,6 +268,7 @@ TkIntStubs tkIntStubs = { TkpGetKeySym, /* 138 */ TkpInitKeymapInfo, /* 139 */ TkPhotoGetValidRegion, /* 140 */ + TkWmStackorderToplevel, /* 141 */ }; TkIntPlatStubs tkIntPlatStubs = { diff --git a/tests/unixWm.test b/tests/unixWm.test index 78b9bd7..2cf9ad3 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: unixWm.test,v 1.13 2001/03/28 17:27:10 dgp Exp $ +# RCS: @(#) $Id: unixWm.test,v 1.14 2001/12/04 03:07:43 mdejong Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -888,7 +888,7 @@ test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} { test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm icon .t} msg] $msg -} {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}} +} {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm iconname .t 12 13} msg] $msg } {1 {wrong # arguments: must be "wm iconname window ?newName?"}} @@ -1321,7 +1321,7 @@ test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} { test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} { list [catch {wm unknown .t} msg] $msg -} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}} +} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} catch {destroy .t} catch {destroy .icon} diff --git a/tests/wm.test b/tests/wm.test new file mode 100644 index 0000000..2c5b121 --- /dev/null +++ b/tests/wm.test @@ -0,0 +1,301 @@ +# This file is a Tcl script to test out Tk's interactions with +# the window manager, including the "wm" command. It is organized +# in the standard fashion for Tcl tests. +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. +# +# RCS: @(#) $Id: wm.test,v 1.1 2001/12/04 03:07:43 mdejong Exp $ + +# This file tests window manager interactions that work across +# platforms. Window manager tests that only work on a specific +# platform should be placed in unixWm.test or winWm.test. + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* +} + +proc deleteWindows {} { + foreach i [winfo children .] { + catch [destroy $i] + } +} + + +deleteWindows + + +test wm-stackorder-1.1 {usage} { + list [catch {wm stackorder} err] $err +} {1 {wrong # args: should be "wm option window ?arg ...?"}} + +test wm-stackorder-1.2 {usage} { + list [catch {wm stackorder . _} err] $err +} {1 {wrong # arguments: must be "wm stackorder window ?isabove|isbelow? ?window?"}} + +test wm-stackorder-1.3 {usage} { + list [catch {wm stackorder . _ _ _} err] $err +} {1 {wrong # arguments: must be "wm stackorder window ?isabove|isbelow? ?window?"}} + +test wm-stackorder-1.4 {usage} { + list [catch {wm stackorder . is .} err] $err +} {1 {bad argument "is": must be isabove or isbelow}} + +test wm-stackorder-1.5 {usage} { + list [catch {wm stackorder _} err] $err +} {1 {bad window path name "_"}} + +test wm-stackorder-1.6 {usage} { + list [catch {wm stackorder . isabove _} err] $err +} {1 {bad window path name "_"}} + +test wm-stackorder-1.7 {usage} { + catch {destroy .t} + toplevel .t + button .t.b + list [catch {wm stackorder .t.b} err] $err +} {1 {window ".t.b" isn't a top-level window}} + +test wm-stackorder-1.8 {usage} { + catch {destroy .t} + toplevel .t + button .t.b + pack .t.b + update + list [catch {wm stackorder . isabove .t.b} err] $err +} {1 {window ".t.b" isn't a top-level window}} + +test wm-stackorder-1.9 {usage} { + catch {destroy .t} + toplevel .t + button .t.b + pack .t.b + update + list [catch {wm stackorder . isbelow .t.b} err] $err +} {1 {window ".t.b" isn't a top-level window}} + +test wm-stackorder-1.10 {usage, isabove|isbelow toplevels must be mapped} { + catch {destroy .t} + toplevel .t ; update + wm withdraw .t + list [catch {wm stackorder .t isabove .} err] $err +} {1 {window ".t" isn't mapped}} + +test wm-stackorder-1.11 {usage, isabove|isbelow toplevels must be mapped} { + catch {destroy .t} + toplevel .t ; update + wm withdraw .t + list [catch {wm stackorder . isbelow .t} err] $err +} {1 {window ".t" isn't mapped}} + + +deleteWindows + + +test wm-stackorder-2.1 {} { + catch {destroy .t} + toplevel .t ; update + wm stackorder . +} {. .t} + +test wm-stackorder-2.2 {} { + catch {destroy .t} + toplevel .t ; update + raise . + wm stackorder . +} {.t .} + +test wm-stackorder-2.3 {} { + catch {destroy .t} + toplevel .t ; update + catch {destroy .t2} + toplevel .t2 ; update + raise . + raise .t2 + wm stackorder . +} {.t . .t2} + +test wm-stackorder-2.4 {} { + catch {destroy .t} + toplevel .t ; update + catch {destroy .t2} + toplevel .t2 ; update + raise . + lower .t2 + wm stackorder . +} {.t2 .t .} + +test wm-stackorder-2.5 {} { + catch {destroy .parent} + toplevel .parent ; update + catch {destroy .parent.child1} + toplevel .parent.child1 ; update + catch {destroy .parent.child2} + toplevel .parent.child2 ; update + catch {destroy .extra} + toplevel .extra ; update + raise .parent + lower .parent.child2 + wm stackorder .parent +} {.parent.child2 .parent.child1 .parent} + +deleteWindows + +test wm-stackorder-2.6 {non-toplevel widgets ignored} { + catch {destroy .t1} + toplevel .t1 + button .t1.b + pack .t1.b + update + wm stackorder . +} {. .t1} + +deleteWindows + +test wm-stackorder-2.7 {no children returns self} { + wm stackorder . +} {.} + +deleteWindows + + +test wm-stackorder-3.1 {unmapped toplevel} { + catch {destroy .t1} + toplevel .t1 ; update + catch {destroy .t2} + toplevel .t2 ; update + wm iconify .t1 + wm stackorder . +} {. .t2} + +test wm-stackorder-3.2 {unmapped toplevel} { + catch {destroy .t1} + toplevel .t1 ; update + catch {destroy .t2} + toplevel .t2 ; update + wm withdraw .t2 + wm stackorder . +} {. .t1} + +test wm-stackorder-3.3 {unmapped toplevel} { + catch {destroy .t1} + toplevel .t1 ; update + catch {destroy .t2} + toplevel .t2 ; update + wm withdraw .t2 + wm stackorder .t2 +} {} + +test wm-stackorder-3.4 {unmapped toplevel} { + catch {destroy .t1} + toplevel .t1 ; update + toplevel .t1.t2 ; update + wm withdraw .t1.t2 + wm stackorder .t1 +} {.t1} + +test wm-stackorder-3.5 {unmapped toplevel} { + catch {destroy .t1} + toplevel .t1 ; update + toplevel .t1.t2 ; update + wm withdraw .t1 + wm stackorder .t1 +} {.t1.t2} + +test wm-stackorder-3.6 {unmapped toplevel} { + catch {destroy .t1} + toplevel .t1 ; update + toplevel .t1.t2 ; update + toplevel .t1.t2.t3 ; update + wm withdraw .t1.t2 + wm stackorder .t1 +} {.t1 .t1.t2.t3} + +test wm-stackorder-3.7 {unmapped toplevel, mapped children returned} { + catch {destroy .t1} + toplevel .t1 ; update + toplevel .t1.t2 ; update + wm withdraw .t1 + wm stackorder .t1 +} {.t1.t2} + +test wm-stackorder-3.8 {toplevel mapped in idle callback } { + catch {destroy .t1} + toplevel .t1 + wm stackorder . +} {.} + + +deleteWindows + + +test wm-stackorder-4.1 {wm stackorder isabove|isbelow} { + catch {destroy .t} + toplevel .t ; update + raise .t + wm stackorder . isabove .t +} {0} + +test wm-stackorder-4.2 {wm stackorder isabove|isbelow} { + catch {destroy .t} + toplevel .t ; update + raise .t + wm stackorder . isbelow .t +} {1} + +test wm-stackorder-4.3 {wm stackorder isabove|isbelow} { + catch {destroy .t} + toplevel .t ; update + raise . + wm stackorder .t isa . +} {0} + +test wm-stackorder-4.4 {wm stackorder isabove|isbelow} { + catch {destroy .t} + toplevel .t ; update + raise . + wm stackorder .t isb . +} {1} + +deleteWindows + +test wm-stackorder-5.1 {overrideredirect does not change stackorder} { + catch {destroy .t} + toplevel .t + wm overrideredirect .t 1 + update + raise . + wm stackorder . isabove .t +} {1} + +test wm-stackorder-5.2 {a menu is not a toplevel} { + catch {destroy .t} + toplevel .t + menu .t.m -type menubar + .t.m add cascade -label "File" + .t configure -menu .t.m + update + raise . + wm stackorder . +} {.t .} + + +deleteWindows + + +# FIXME: + +# Need test cases for embedded Windows, they should not appear in +# the stacking order since they are not actually toplevel Windows. + +# Test delivery of virtual events to the WM. We could check to see +# if the window was raised after a button click for example. +# This sort of testing may not be possible. + +return + + + diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c index 9fff250..f0ee0b9 100644 --- a/unix/tkUnixWm.c +++ b/unix/tkUnixWm.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkUnixWm.c,v 1.9 2001/08/28 19:41:55 hobbs Exp $ + * RCS: @(#) $Id: tkUnixWm.c,v 1.10 2001/12/04 03:07:43 mdejong Exp $ */ #include "tkPort.h" @@ -323,6 +323,9 @@ static int ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp, char *string, TkWindow *winPtr)); static void ReparentEvent _ANSI_ARGS_((WmInfo *wmPtr, XReparentEvent *eventPtr)); +static void TkWmStackorderToplevelWrapperMap _ANSI_ARGS_(( + TkWindow *winPtr, + Tcl_HashTable *reparentTable)); static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy, Tk_Window tkwin)); static void UpdateCommand _ANSI_ARGS_((TkWindow *winPtr)); @@ -818,7 +821,7 @@ Tk_WmCmd(clientData, interp, argc, argv) if (winPtr == NULL) { return TCL_ERROR; } - if (!(winPtr->flags & TK_TOP_LEVEL)) { + if (!Tk_IsTopLevel(winPtr)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, "\" isn't a top-level window", (char *) NULL); return TCL_ERROR; @@ -1748,6 +1751,99 @@ Tk_WmCmd(clientData, interp, argc, argv) } wmPtr->flags |= WM_UPDATE_SIZE_HINTS; goto updateGeom; + } else if ((c == 's') && (strncmp(argv[1], "stackorder", length) == 0) + && (length >= 2)) { + TkWindow **windows, **window_ptr; + + if ((argc != 3) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # arguments: must be \"", + argv[0], + " stackorder window ?isabove|isbelow? ?window?\"", + (char *) NULL); + return TCL_ERROR; + } + + if (argc == 3) { + windows = TkWmStackorderToplevel(winPtr); + if (windows == NULL) { + panic("TkWmStackorderToplevel failed"); + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + Tcl_AppendElement(interp, (*window_ptr)->pathName); + } + ckfree((char *) windows); + return TCL_OK; + } + } else { + TkWindow *winPtr2; + int index1=-1, index2=-1, result; + + winPtr2 = (TkWindow *) Tk_NameToWindow(interp, argv[4], tkwin); + if (winPtr2 == NULL) { + return TCL_ERROR; + } + + if (!Tk_IsTopLevel(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + "\" isn't a top-level window", (char *) NULL); + return TCL_ERROR; + } + + if (!Tk_IsMapped(winPtr)) { + Tcl_AppendResult(interp, "window \"", winPtr->pathName, + "\" isn't mapped", (char *) NULL); + return TCL_ERROR; + } + + if (!Tk_IsMapped(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + "\" isn't mapped", (char *) NULL); + return TCL_ERROR; + } + + /* + * Lookup stacking order of all toplevels that are children + * of "." and find the position of winPtr and winPtr2 + * in the stacking order. + */ + + windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); + + if (windows == NULL) { + Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", + (char *) NULL); + return TCL_ERROR; + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + if (*window_ptr == winPtr) + index1 = (window_ptr - windows); + if (*window_ptr == winPtr2) + index2 = (window_ptr - windows); + } + if (index1 == -1) + panic("winPtr window not found"); + if (index2 == -1) + panic("winPtr2 window not found"); + + ckfree((char *) windows); + } + + c = argv[3][0]; + length = strlen(argv[3]); + if ((length > 2) && (c == 'i') + && (strncmp(argv[3], "isabove", length) == 0)) { + result = index1 > index2; + } else if ((length > 2) && (c == 'i') + && (strncmp(argv[3], "isbelow", length) == 0)) { + result = index1 < index2; + } else { + Tcl_AppendResult(interp, "bad argument \"", argv[3], + "\": must be isabove or isbelow", (char *) NULL); + return TCL_ERROR; + } + Tcl_SetIntObj(Tcl_GetObjResult(interp), result); + return TCL_OK; + } } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0) && (length >= 2)) { if ((argc < 3) || (argc > 4)) { @@ -1954,8 +2050,8 @@ Tk_WmCmd(clientData, interp, argc, argv) "focusmodel, frame, geometry, grid, group, iconbitmap, ", "iconify, iconmask, iconname, iconposition, ", "iconwindow, maxsize, minsize, overrideredirect, ", - "positionfrom, protocol, resizable, sizefrom, state, title, ", - "transient, or withdraw", + "positionfrom, protocol, resizable, sizefrom, stackorder, ", + "state, title, transient, or withdraw", (char *) NULL); return TCL_ERROR; } @@ -4073,6 +4169,134 @@ TkWmProtocolEventProc(winPtr, eventPtr) /* *---------------------------------------------------------------------- * + * TkWmStackorderToplevelWrapperMap -- + * + * This procedure will create a table that maps the reparent wrapper + * X id for a toplevel to the TkWindow structure that is wraps. + * Tk keeps track of a mapping from the window X id to the TkWindow + * structure but that does us no good here since we only get the X + * id of the wrapper window. Only those toplevel windows that are + * mapped have a position in the stacking order. + * + * Results: + * None. + * + * Side effects: + * Adds entries to the passed hashtable. + * + *---------------------------------------------------------------------- + */ +void +TkWmStackorderToplevelWrapperMap(winPtr, table) + TkWindow *winPtr; /* TkWindow to recurse on */ + Tcl_HashTable *table; /* Maps X id to TkWindow */ +{ + TkWindow *childPtr; + Tcl_HashEntry *hPtr; + Window wrapper; + int newEntry; + + if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr)) { + wrapper = (winPtr->wmInfoPtr->reparent != None) + ? winPtr->wmInfoPtr->reparent + : winPtr->wmInfoPtr->wrapperPtr->window; + + hPtr = Tcl_CreateHashEntry(table, + (char *) wrapper, &newEntry); + Tcl_SetHashValue(hPtr, winPtr); + } + + for (childPtr = winPtr->childList; childPtr != NULL; + childPtr = childPtr->nextPtr) { + TkWmStackorderToplevelWrapperMap(childPtr, table); + } +} + +/* + *---------------------------------------------------------------------- + * + * TkWmStackorderToplevel -- + * + * This procedure returns the stack order of toplevel windows. + * + * Results: + * An array of pointers to tk window objects in stacking order + * or else NULL if there was an error. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +TkWindow ** +TkWmStackorderToplevel(parentPtr) + TkWindow *parentPtr; /* Parent toplevel window. */ +{ + Window dummy1, dummy2, vRoot; + Window *children; + unsigned int numChildren, i; + TkWindow *childWinPtr, **windows, **window_ptr; + Tcl_HashTable table; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + /* + * Map X Window ids to a TkWindow of the wrapped toplevel. + */ + + Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); + TkWmStackorderToplevelWrapperMap(parentPtr, &table); + + window_ptr = windows = (TkWindow **) ckalloc((table.numEntries+1) + * sizeof(TkWindow *)); + + /* + * Special cases: If zero or one toplevels were mapped + * there is no need to call XQueryTree. + */ + + switch (table.numEntries) { + case 0: + windows[0] = NULL; + goto done; + case 1: + hPtr = Tcl_FirstHashEntry(&table, &search); + windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr); + windows[1] = NULL; + goto done; + } + + vRoot = parentPtr->wmInfoPtr->vRoot; + if (vRoot == None) { + vRoot = RootWindowOfScreen(Tk_Screen((Tk_Window) parentPtr)); + } + + if (XQueryTree(parentPtr->display, vRoot, &dummy1, &dummy2, + &children, &numChildren) == 0) { + ckfree((char *) windows); + windows = NULL; + } else { + for (i = 0; i < numChildren; i++) { + hPtr = Tcl_FindHashEntry(&table, (char *) children[i]); + if (hPtr != NULL) { + childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr); + *window_ptr++ = childWinPtr; + } + } + if ((window_ptr - windows) != table.numEntries) + panic("num matched toplevel windows does not equal num children"); + *window_ptr = NULL; + } + + done: + Tcl_DeleteHashTable(&table); + return windows; +} + +/* + *---------------------------------------------------------------------- + * * TkWmRestackToplevel -- * * This procedure restacks a top-level window. diff --git a/win/tkWinWm.c b/win/tkWinWm.c index b2041c5..5b96e3d 100644 --- a/win/tkWinWm.c +++ b/win/tkWinWm.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWinWm.c,v 1.31 2001/10/12 13:30:32 tmh Exp $ + * RCS: @(#) $Id: tkWinWm.c,v 1.32 2001/12/04 03:07:43 mdejong Exp $ */ #include "tkWinInt.h" @@ -53,6 +53,14 @@ typedef struct ProtocolHandler { #define HANDLER_SIZE(cmdLength) \ ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength)) +/* + * Helper type passed via lParam to TkWmStackorderToplevelEnumProc + */ +typedef struct TkWmStackorderToplevelPair { + Tcl_HashTable *table; + TkWindow **window_ptr; +} TkWmStackorderToplevelPair; + /* * This structure represents the contents of a icon, in terms of its * image. The HICON is an internal Windows format. Most of these @@ -371,6 +379,9 @@ static int ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp, static void RefreshColormap _ANSI_ARGS_((Colormap colormap, TkDisplay *dispPtr)); static void SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info)); +static void TkWmStackorderToplevelWrapperMap _ANSI_ARGS_(( + TkWindow *winPtr, + Tcl_HashTable *table)); static LRESULT CALLBACK TopLevelProc _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)); static void TopLevelEventProc _ANSI_ARGS_((ClientData clientData, @@ -3044,6 +3055,99 @@ Tk_WmCmd(clientData, interp, argc, argv) } } goto updateGeom; + } else if ((c == 's') && (strncmp(argv[1], "stackorder", length) == 0) + && (length >= 2)) { + TkWindow **windows, **window_ptr; + + if ((argc != 3) && (argc != 5)) { + Tcl_AppendResult(interp, "wrong # arguments: must be \"", + argv[0], + " stackorder window ?isabove|isbelow? ?window?\"", + (char *) NULL); + return TCL_ERROR; + } + + if (argc == 3) { + windows = TkWmStackorderToplevel(winPtr); + if (windows == NULL) { + panic("TkWmStackorderToplevel failed"); + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + Tcl_AppendElement(interp, (*window_ptr)->pathName); + } + ckfree((char *) windows); + return TCL_OK; + } + } else { + TkWindow *winPtr2; + int index1=-1, index2=-1, result; + + winPtr2 = (TkWindow *) Tk_NameToWindow(interp, argv[4], tkwin); + if (winPtr2 == NULL) { + return TCL_ERROR; + } + + if (!Tk_IsTopLevel(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + "\" isn't a top-level window", (char *) NULL); + return TCL_ERROR; + } + + if (!Tk_IsMapped(winPtr)) { + Tcl_AppendResult(interp, "window \"", winPtr->pathName, + "\" isn't mapped", (char *) NULL); + return TCL_ERROR; + } + + if (!Tk_IsMapped(winPtr2)) { + Tcl_AppendResult(interp, "window \"", winPtr2->pathName, + "\" isn't mapped", (char *) NULL); + return TCL_ERROR; + } + + /* + * Lookup stacking order of all toplevels that are children + * of "." and find the position of winPtr and winPtr2 + * in the stacking order. + */ + + windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr); + + if (windows == NULL) { + Tcl_AppendResult(interp, "TkWmStackorderToplevel failed", + (char *) NULL); + return TCL_ERROR; + } else { + for (window_ptr = windows; *window_ptr ; window_ptr++) { + if (*window_ptr == winPtr) + index1 = (window_ptr - windows); + if (*window_ptr == winPtr2) + index2 = (window_ptr - windows); + } + if (index1 == -1) + panic("winPtr window not found"); + if (index2 == -1) + panic("winPtr2 window not found"); + + ckfree((char *) windows); + } + + c = argv[3][0]; + length = strlen(argv[3]); + if ((length > 2) && (c == 'i') + && (strncmp(argv[3], "isabove", length) == 0)) { + result = index1 > index2; + } else if ((length > 2) && (c == 'i') + && (strncmp(argv[3], "isbelow", length) == 0)) { + result = index1 < index2; + } else { + Tcl_AppendResult(interp, "bad argument \"", argv[3], + "\": must be isabove or isbelow", (char *) NULL); + return TCL_ERROR; + } + Tcl_SetIntObj(Tcl_GetObjResult(interp), result); + return TCL_OK; + } } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0) && (length >= 2)) { if ((argc < 3) || (argc > 4)) { @@ -3224,8 +3328,8 @@ Tk_WmCmd(clientData, interp, argc, argv) "focusmodel, frame, geometry, grid, group, iconbitmap, ", "iconify, iconmask, iconname, iconposition, ", "iconwindow, maxsize, minsize, overrideredirect, ", - "positionfrom, protocol, resizable, sizefrom, state, title, ", - "transient, or withdraw", + "positionfrom, protocol, resizable, sizefrom, stackorder ", + "state, title, transient, or withdraw", (char *) NULL); return TCL_ERROR; } @@ -4150,6 +4254,170 @@ TkWmProtocolEventProc(winPtr, eventPtr) /* *---------------------------------------------------------------------- * + * TkWmStackorderToplevelEnumProc -- + * + * This procedure is invoked once for each HWND Window on the + * display as a result of calling EnumWindows from + * TkWmStackorderToplevel. + * + * Results: + * TRUE to request further iteration. + * + * Side effects: + * Adds entries to the passed array of TkWindows. + * + *---------------------------------------------------------------------- + */ + +BOOL CALLBACK TkWmStackorderToplevelEnumProc(hwnd, lParam) + HWND hwnd; /* handle to parent window */ + LPARAM lParam; /* application-defined value */ +{ + Tcl_HashEntry *hPtr; + TkWindow *childWinPtr; + + TkWmStackorderToplevelPair *pair = + (TkWmStackorderToplevelPair *) lParam; + + /*fprintf(stderr, "Looking up HWND %d\n", hwnd);*/ + + hPtr = Tcl_FindHashEntry(pair->table, (char *) hwnd); + if (hPtr != NULL) { + childWinPtr = (TkWindow *) Tcl_GetHashValue(hPtr); + /* Double check that same HWND does not get passed twice */ + if (childWinPtr == NULL) { + panic("duplicate HWND in TkWmStackorderToplevelEnumProc"); + } else { + Tcl_SetHashValue(hPtr, NULL); + } + /*fprintf(stderr, "Found mapped HWND %d -> %x (%s)\n", hwnd, + childWinPtr, childWinPtr->pathName);*/ + *(pair->window_ptr)-- = childWinPtr; + } + return TRUE; +} + +/* + *---------------------------------------------------------------------- + * + * TkWmStackorderToplevelWrapperMap -- + * + * This procedure will create a table that maps the wrapper + * HWND id for a toplevel to the TkWindow structure that is wraps. + * + * Results: + * None. + * + * Side effects: + * Adds entries to the passed hashtable. + * + *---------------------------------------------------------------------- + */ +void +TkWmStackorderToplevelWrapperMap(winPtr, table) + TkWindow *winPtr; /* TkWindow to recurse on */ + Tcl_HashTable *table; /* Table to maps HWND to TkWindow */ +{ + TkWindow *childPtr; + Tcl_HashEntry *hPtr; + HWND wrapper; + int newEntry; + + if (Tk_IsMapped(winPtr) && Tk_IsTopLevel(winPtr)) { + wrapper = TkWinGetWrapperWindow((Tk_Window) winPtr); + + /*fprintf(stderr, "Mapped HWND %d to %x (%s)\n", wrapper, + winPtr, winPtr->pathName);*/ + + hPtr = Tcl_CreateHashEntry(table, + (char *) wrapper, &newEntry); + Tcl_SetHashValue(hPtr, winPtr); + } + + for (childPtr = winPtr->childList; childPtr != NULL; + childPtr = childPtr->nextPtr) { + TkWmStackorderToplevelWrapperMap(childPtr, table); + } +} +/* + *---------------------------------------------------------------------- + * + * TkWmStackorderToplevel -- + * + * This procedure returns the stack order of toplevel windows. + * + * Results: + * An array of pointers to tk window objects in stacking order + * or else NULL if there was an error. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +TkWindow ** +TkWmStackorderToplevel(parentPtr) + TkWindow *parentPtr; /* Parent toplevel window. */ +{ + TkWmStackorderToplevelPair pair; + TkWindow **windows; + Tcl_HashTable table; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + + /* + * Map HWND ids to a TkWindow of the wrapped toplevel. + */ + + Tcl_InitHashTable(&table, TCL_ONE_WORD_KEYS); + TkWmStackorderToplevelWrapperMap(parentPtr, &table); + + windows = (TkWindow **) ckalloc((table.numEntries+1) + * sizeof(TkWindow *)); + + /* + * Special cases: If zero or one toplevels were mapped + * there is no need to call EnumWindows. + */ + + switch (table.numEntries) { + case 0: + windows[0] = NULL; + goto done; + case 1: + hPtr = Tcl_FirstHashEntry(&table, &search); + windows[0] = (TkWindow *) Tcl_GetHashValue(hPtr); + windows[1] = NULL; + goto done; + } + + /* + * We will be inserting into the array starting at the end + * and working our way to the beginning since EnumWindows + * returns windows in highest to lowest order. + */ + + pair.table = &table; + pair.window_ptr = windows + table.numEntries; + *pair.window_ptr-- = NULL; + + if (EnumWindows(TkWmStackorderToplevelEnumProc, (LPARAM) &pair) == 0) { + ckfree((char *) windows); + windows = NULL; + } else { + if (pair.window_ptr != (windows-1)) + panic("num matched toplevel windows does not equal num children"); + } + + done: + Tcl_DeleteHashTable(&table); + return windows; +} + +/* + *---------------------------------------------------------------------- + * * TkWmRestackToplevel -- * * This procedure restacks a top-level window. |