Index: doc/winfo.n
===================================================================
RCS file: /cvsroot/tktoolkit/tk/doc/winfo.n,v
retrieving revision 1.2
diff -u -r1.2 winfo.n
--- doc/winfo.n	1998/09/14 18:23:00	1.2
+++ doc/winfo.n	2001/11/26 08:55:17
@@ -46,9 +46,11 @@
 .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.
Index: doc/wm.n
===================================================================
RCS file: /cvsroot/tktoolkit/tk/doc/wm.n,v
retrieving revision 1.6
diff -u -r1.6 wm.n
--- doc/wm.n	2001/01/02 19:13:02	1.6
+++ doc/wm.n	2001/11/26 08:55:18
@@ -400,6 +400,19 @@
 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 also 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
Index: generic/tkInt.decls
===================================================================
RCS file: /cvsroot/tktoolkit/tk/generic/tkInt.decls,v
retrieving revision 1.22
diff -u -r1.22 tkInt.decls
--- generic/tkInt.decls	2001/11/23 02:04:56	1.22
+++ generic/tkInt.decls	2001/11/26 08:55:18
@@ -640,6 +640,10 @@
     TkRegion TkPhotoGetValidRegion (Tk_PhotoHandle handle)
 }
 
+declare 141 generic {
+    TkWindow ** TkWmStackorderToplevel(TkWindow *parentPtr)
+}
+
 ##############################################################################
 
 # Define the platform specific internal Tcl interface. These functions are
Index: tests/unixWm.test
===================================================================
RCS file: /cvsroot/tktoolkit/tk/tests/unixWm.test,v
retrieving revision 1.13
diff -u -r1.13 unixWm.test
--- tests/unixWm.test	2001/03/28 17:27:10	1.13
+++ tests/unixWm.test	2001/11/26 08:55:21
@@ -888,7 +907,7 @@
 
 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 +1340,7 @@
 
 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}
Index: tests/wm.test
===================================================================
RCS file: wm.test
diff -N wm.test
--- /dev/null	Thu May 24 22:33:05 2001
+++ wm.test	Mon Nov 26 00:55:21 2001
@@ -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.13 2001/03/28 17:27:10 dgp 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
+
+
+
Index: unix/tkUnixWm.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/unix/tkUnixWm.c,v
retrieving revision 1.9
diff -u -r1.9 tkUnixWm.c
--- unix/tkUnixWm.c	2001/08/28 19:41:55	1.9
+++ unix/tkUnixWm.c	2001/11/26 08:55:24
@@ -323,6 +323,9 @@
 			    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 @@
     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,96 @@
 	}
 	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 returned by TkWmStackorderToplevel()");
+                if (index2 == -1)
+                    panic("winPtr2 window not returned by TkWmStackorderToplevel()");
+
+                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 +2047,8 @@
 		"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;
     }
@@ -4068,6 +4161,133 @@
     if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
 	Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
     }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;			/* Table that 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;
 }
 
 /*
Index: win/tkWinWm.c
===================================================================
RCS file: /cvsroot/tktoolkit/tk/win/tkWinWm.c,v
retrieving revision 1.31
diff -u -r1.31 tkWinWm.c
--- win/tkWinWm.c	2001/10/12 13:30:32	1.31
+++ win/tkWinWm.c	2001/11/26 08:55:30
@@ -53,6 +53,14 @@
 #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 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 +3067,96 @@
 	    }
 	}
 	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 returned by TkWmStackorderToplevel()");
+                if (index2 == -1)
+                    panic("winPtr2 window not returned by TkWmStackorderToplevel()");
+
+                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 +3337,8 @@
 		"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;
     }
@@ -4145,6 +4258,170 @@
     if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
 	Tk_DestroyWindow((Tk_Window) winPtr);
     }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
 }
 
 /*
