Implementation of the [tk busy] command on non-OSX.

Adapted from [Patch 1997907]


FossilOrigin-Name: d9f9056ec1e227748b77891bf1b9bd0bddd4cae0

14 files changed, 1988 insertions, 50 deletions

diff --git a/ChangeLog b/ChangeLog
index 9216c61..fc8ed9e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,17 +1,24 @@
+2008-10-18  Donal K. Fellows  <dkf@users.sf.net>
+
+	TIP #321 IMPLEMENTATION
+
+	* generic/tkBusy.c, doc/busy.n, tests/busy.test: Implementation of the
+	[tk busy] command. [Patch 1997907]
+
 2008-10-18  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
-	* win/tkWinFont.c: [Bug 1825353] To fix a problem with tiny fonts
-	on Russian versions of Windows we will avoid removing the internal
+	* win/tkWinFont.c: [Bug 1825353] To fix a problem with tiny fonts on
+	Russian versions of Windows we will avoid removing the internal
 	leading for fixed width fonts.
 
 2008-10-15  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tk.h:          Add "const" to many internal
-	* generic/tkBind.c:      const tables, so those will be
-	* generic/tkButton.c:    put by the C-compiler in the
-	* generic/tkCanvas.c:    TEXT segment in stead of the
-	* generic/tkClipboard.c: DATA segment. This makes those
-	* generic/tkCmds.c:      table sharable in shared libraries.
+	* generic/tk.h:          Add "const" to many internal const tables, so
+	* generic/tkBind.c:      those will be put by the C-compiler in the
+	* generic/tkButton.c:    TEXT segment instead of the DATA segment.
+	* generic/tkCanvas.c:    This makes those tables as being shareable in
+	* generic/tkClipboard.c: shared libraries.
+	* generic/tkCmds.c:
 	* generic/tkConsole.c:
 	* generic/tkEntry.c:
 	* generic/tkFocus.c:
@@ -60,12 +67,12 @@
 
 2008-10-15  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tkInt.h:       Add "const" to many internal
-	* generic/tk3d.c:        const tables, so those will be
-	* generic/tkBitmap.c:    put by the C-compiler in the
-	* generic/tkColor.c:     TEXT segment in stead of the
-	* generic/tkConfig.c:    DATA segment. This makes those
-	* generic/tkCursor.c:    table sharable in shared libraries.
+	* generic/tkInt.h:       Add "const" to many internal const tables, so
+	* generic/tk3d.c:        those will be put by the C-compiler in the
+	* generic/tkBitmap.c:    TEXT segment instead of the DATA segment.
+	* generic/tkColor.c:     This makes those tables as being shareable in
+	* generic/tkConfig.c:    shared libraries.
+	* generic/tkCursor.c:
 	* generic/tkFont.c:
 	* generic/tkObj.c:
 	* generic/tkStyle.c:
diff --git a/doc/busy.n b/doc/busy.n
new file mode 100644
index 0000000..b355a29
--- /dev/null
+++ b/doc/busy.n
@@ -0,0 +1,268 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\" Copyright (c) 2008, Jos Decoster
+'\"
+'\" Permission to use, copy, modify, and distribute this software and its
+'\" documentation for any purpose and without fee is hereby granted, provided
+'\" that the above copyright notice appear in all copies and that both that
+'\" the copyright notice and warranty disclaimer appear in supporting
+'\" documentation, and that the names of Lucent Technologies any of their
+'\" entities not be used in advertising or publicity pertaining to
+'\" distribution of the software without specific, written prior permission.
+'\"
+'\" Lucent Technologies disclaims all warranties with regard to this software,
+'\" including all implied warranties of merchantability and fitness. In no
+'\" event shall Lucent Technologies be liable for any special, indirect or
+'\" consequential damages or any damages whatsoever resulting from loss of
+'\" use, data or profits, whether in an action of contract, negligence or
+'\" other tortuous action, arising out of or in connection with the use or
+'\" performance of this software.
+'\"
+'\" BLT::busy command created by George Howlett.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id: busy.n,v 1.1 2008/10/18 14:22:21 dkf Exp $
+'\"
+.so man.macros
+.TH busy n "" Tk "Tk Built-In Commands"
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+busy \- confine pointer and keyboard events to a window sub-tree
+.SH SYNOPSIS
+\fBtk busy\fR \fIwindow \fR?\fIoptions\fR?
+.sp
+\fBtk busy hold\fR \fIwindow \fR?\fIoptions\fR?
+.sp
+\fBtk busy configure \fIwindow\fR ?\fIoption value\fR?...
+.sp
+\fBtk busy forget\fR \fIwindow \fR?\fIwindow \fR?...
+.sp
+\fBtk busy current\fR ?\fIpattern\fR?
+.sp
+\fBtk busy status \fIwindow\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBtk busy\fR command provides a simple means to block keyboard, button,
+and pointer events from Tk widgets, while overriding the widget's cursor with
+a configurable busy cursor.
+.SH INTRODUCTION
+.PP
+There are many times in applications where you want to temporarily restrict
+what actions the user can take. For example, an application could have a
+.QW Run
+button that when pressed causes some processing to occur. But while the
+application is busy processing, you probably don't want the the user to be
+able to click the
+.QW Run
+button again. You may also want restrict the user from other tasks such as
+clicking a
+.QW Print
+button.
+.PP
+The \fBtk busy\fR command lets you make Tk widgets busy. This means that user
+interactions such as button clicks, moving the mouse, typing at the keyboard,
+etc.\0are ignored by the widget. You can set a special cursor (like a watch)
+that overrides the widget's normal cursor, providing feedback that the
+application (widget) is temporarily busy.
+.PP
+When a widget is made busy, the widget and all of its descendents will ignore
+events. It's easy to make an entire panel of widgets busy. You can simply make
+the toplevel widget (such as
+.QW . )
+busy. This is easier and far much more efficient than recursively traversing
+the widget hierarchy, disabling each widget and re-configuring its cursor.
+.PP
+Often, the \fBtk busy\fR command can be used instead of Tk's \fBgrab\fR
+command. Unlike \fBgrab\fR which restricts all user interactions to one
+widget, with the \fBtk busy\fR command you can have more than one widget
+active (for example, a
+.QW Cancel
+dialog and a
+.QW Help
+button).
+.SS EXAMPLE
+.PP
+You can make several widgets busy by simply making its ancestor widget busy
+using the \fBhold\fR operation.
+.PP
+.CS
+frame .top
+button .top.button; canvas .top.canvas
+pack .top.button .top.canvas
+pack .top
+# . . .
+\fBtk busy\fR hold .top
+update
+.CE
+.PP
+All the widgets within \fB.top\fR (including \fB.top\fR) are now busy. Using
+\fBupdate\fR insures that \fBtk busy\fR command will take effect before any
+other user events can occur.
+.PP
+When the application is no longer busy processing, you can allow user
+interactions again and free any resources it allocated by the \fBforget\fR
+operation.
+.PP
+.CS
+\fBtk busy\fR forget .top
+.CE
+.PP
+The busy window has a configurable cursor. You can change the busy cursor
+using the \fBconfigure\fR operation.
+.PP
+.CS
+\fBtk busy\fR configure .top \-cursor "watch"
+.CE
+.PP
+Destroying the widget will also clean up any resources allocated by the \fBtk
+busy\fR command.
+.PP
+.SH OPERATIONS
+.PP
+The following operations are available for the \fBtk busy\fR command:
+.TP
+\fBtk busy \fIwindow\fR ?\fIoption value\fR?...
+.
+Shortcut for \fBtk busy hold\fR command.
+.TP
+\fBtk busy hold \fIwindow\fR ?\fIoption value\fR?...
+.
+Makes the specified \fIwindow\fR (and its descendants in the Tk window
+hierarchy) appear busy. \fIWindow\fR must be a valid path name of a Tk widget.
+A transparent window is put in front of the specified window. This transparent
+window is mapped the next time idle tasks are processed, and the specified
+window and its descendants will be blocked from user interactions. Normally
+\fBupdate\fR should be called immediately afterward to insure that the hold
+operation is in effect before the application starts its processing. The
+following configuration options are valid:
+.RS
+.TP
+\fB\-cursor \fIcursorName\fR
+.
+Specifies the cursor to be displayed when the widget is made busy.
+\fICursorName\fR can be in any form accepted by \fBTk_GetCursor\fR. The
+default cursor is \fBwait\fR on Windows and \fBwatch\fR on other platforms.
+.RE
+.TP
+\fBtk busy cget \fIwindow\fR \fIoption\fR
+.
+Queries the \fBtk busy\fR command configuration options for \fIwindow\fR.
+\fIWindow\fR must be the path name of a widget previously made busy by the
+\fBhold\fR operation. The command returns the present value of the specified
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBhold\fR operation.
+.TP
+\fBtk busy configure \fIwindow\fR ?\fIoption value\fR?...
+.
+Queries or modifies the \fBtk busy\fR command configuration options for
+\fIwindow\fR. \fIWindow\fR must be the path name of a widget previously made
+busy by the \fBhold\fR operation.  If no options are specified, a list
+describing all of the available options for \fIwindow\fR (see
+\fBTk_ConfigureInfo\fR for information on the format of this list) is
+returned. If \fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option (this list will be identical to
+the corresponding sublist of the value returned if no \fIoption\fR is
+specified). If one or more \fIoption\-value\fR pairs are specified, then the
+command modifies the given widget option(s) to have the given value(s); in
+this case the command returns the empty string. \fIOption\fR may have any of
+the values accepted by the \fBhold\fR operation.
+.RS
+.PP
+Please note that the option database is referenced through \fIwindow\fR. For
+example, if the widget \fB.frame\fR is to be made busy, the busy cursor can be
+specified for it by either \fBoption\fR command:
+.PP
+.CS
+option add *frame.busyCursor gumby
+option add *Frame.BusyCursor gumby
+.CE
+.RE
+.TP
+\fBtk busy forget \fIwindow\fR ?\fIwindow\fR?...
+.
+Releases resources allocated by the \fBtk busy\fR command for \fIwindow\fR,
+including the transparent window. User events will again be received by
+\fIwindow\fR. Resources are also released when \fIwindow\fR is destroyed.
+\fIWindow\fR must be the name of a widget specified in the \fBhold\fR
+operation, otherwise an error is reported.
+.TP
+\fBtk busy current \fR?\fIpattern\fR?
+.
+Returns the pathnames of all widgets that are currently busy. If a
+\fIpattern\fR is given, only the path names of busy widgets matching
+\fIpattern\fR are returned.
+.TP
+\fBtk busy status \fIwindow\fR
+.
+Returns the status of a widget \fIwindow\fR. If \fIwindow\fR presently can not
+receive user interactions, \fB1\fR is returned, otherwise \fB0\fR.
+.SH "EVENT HANDLING"
+.SS BINDINGS
+.PP
+The event blocking feature is implemented by creating and mapping a
+transparent window that completely covers the widget. When the busy window is
+mapped, it invisibly shields the widget and its hierarchy from all events that
+may be sent. Like Tk widgets, busy windows have widget names in the Tk window
+hierarchy. This means that you can use the \fBbind\fR command, to handle
+events in the busy window.
+.PP
+.CS
+\fBtk busy\fR hold .frame.canvas
+bind .frame.canvas_Busy <Enter> { ... }
+.CE
+.PP
+Normally the busy window is a sibling of the widget. The name of the busy
+window is
+.QW \fIwidget\fB_Busy\fR
+where \fIwidget\fR is the name of the widget to be made busy. In the previous
+example, the pathname of the busy window is
+.QW \fB.frame.canvas_Busy\fR .
+The exception is when the widget is a toplevel widget (such as
+.QW . )
+where the busy window can't be made a sibling. The busy window is then a child
+of the widget named
+.QW \fIwidget\fB._Busy\fR
+where \fIwidget\fR is the name of the toplevel widget. In the following
+example, the pathname of the busy window is
+.QW \fB._Busy\fR .
+.PP
+.CS
+\fBtk busy\fR hold .
+bind ._Busy <Enter> { ... }
+.CE
+.SS "ENTER/LEAVE EVENTS"
+.PP
+Mapping and unmapping busy windows generates Enter/Leave events for all
+widgets they cover. Please note this if you are tracking Enter/Leave events in
+widgets.
+.SS "KEYBOARD EVENTS"
+.PP
+When a widget is made busy, the widget is prevented from gaining the keyboard
+focus by the busy window. But if the widget already had focus, it still may
+received keyboard events. To prevent this, you must move focus to another
+window.
+.PP
+.CS
+\fBtk busy\fR hold .frame
+label .dummy
+focus .dummy
+update
+.CE
+.PP
+The above example moves the focus from .frame immediately after invoking the
+\fBhold\fR so that no keyboard events will be sent to \fB.frame\fR or any of
+its descendants.
+.SH PORTABILITY
+.PP
+Note that the \fBtk busy\fR command does not currently have any effect on OSX
+when Tk is built using Aqua support.
+.SH "SEE ALSO"
+grab(n)
+.SH KEYWORDS
+busy, keyboard events, pointer events, window
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/grab.n b/doc/grab.n
index 1d87086..670dc9d 100644
--- a/doc/grab.n
+++ b/doc/grab.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: grab.n,v 1.10 2008/09/23 13:36:40 dkf Exp $
+'\" RCS: @(#) $Id: grab.n,v 1.11 2008/10/18 14:22:21 dkf Exp $
 '\" 
 .so man.macros
 .TH grab n "" Tk "Tk Built-In Commands"
@@ -133,6 +133,8 @@ pack [button .b2 \-text "Click me! #2" \-command {destroy .b2}]
 pack [button .b3 \-text "Click me! #3" \-command {destroy .b3}]
 \fBgrab\fR .b2
 .CE
+.SH "SEE ALSO"
+busy(n)
 .SH KEYWORDS
 grab, keyboard events, pointer events, window
 '\" Local Variables:
diff --git a/doc/tk.n b/doc/tk.n
index e36106f..ece777e 100644
--- a/doc/tk.n
+++ b/doc/tk.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: tk.n,v 1.19 2008/09/23 13:36:55 dkf Exp $
+'\" RCS: @(#) $Id: tk.n,v 1.20 2008/10/18 14:22:21 dkf Exp $
 '\" 
 .so man.macros
 .TH tk n 8.4 Tk "Tk Built-In Commands"
@@ -47,6 +47,13 @@ If sends have been disabled by deleting the \fBsend\fR command,
 this command will reenable them and recreate the \fBsend\fR
 command.
 .TP
+\fBtk busy \fIsubcommand\fR ...
+.
+This command controls the marking of window hierarchies as
+.QW busy ,
+rendering them non-interactive while some other operation is proceeding. For
+more details see the \fBbusy\fR manual page.
+.TP
 \fBtk caret window \fR?\fB\-x \fIx\fR? ?\fB\-y \fIy\fR? ?\fB\-height \fIheight\fR?
 .
 Sets and queries the caret location for the display of the specified
@@ -65,7 +72,7 @@ Sets and queries the current scaling factor used by Tk to convert between
 physical units (for example, points, inches, or millimeters) and pixels.  The
 \fInumber\fR argument is a floating point number that specifies the number of
 pixels per point on \fIwindow\fR's display.  If the \fIwindow\fR argument is
-omitted, it defaults to the main window.  If the \fInumber\fR argument is 
+omitted, it defaults to the main window.  If the \fInumber\fR argument is
 omitted, the current value of the scaling factor is returned.
 .RS
 .PP
@@ -118,7 +125,7 @@ Returns the current Tk windowing system, one of
 \fBx11\fR (X11-based), \fBwin32\fR (MS Windows),
 or \fBaqua\fR (Mac OS X Aqua).
 .SH "SEE ALSO"
-send(n), winfo(n)
+busy(n), send(n), winfo(n)
 .SH KEYWORDS
 application name, send
 '\" Local Variables:
diff --git a/generic/tkBusy.c b/generic/tkBusy.c
new file mode 100644
index 0000000..e8343e3
--- /dev/null
+++ b/generic/tkBusy.c
@@ -0,0 +1,1222 @@
+/*
+ * tkBusy.c --
+ *
+ *	This file provides functions that implement busy for Tk.
+ *
+ * Copyright 1993-1998 Lucent Technologies, Inc.
+ *
+ *	The "busy" command was created by George Howlett. Adapted for
+ *	integration into Tk by Jos Decoster and Donal K. Fellows.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkBusy.c,v 1.1 2008/10/18 14:22:22 dkf Exp $
+ */
+
+#include "tkInt.h"
+
+#if !(defined(__WIN32__) || defined(MAC_OSX_TK))
+#include "tkUnixInt.h"
+#endif
+
+#ifdef WIN32
+#include <windows.h>
+extern HINSTANCE	Tk_GetHINSTANCE(void);
+extern Window		Tk_AttachHWND(Tk_Window tkwin, HWND hwnd);
+extern HWND		Tk_GetHWND(Window window);
+
+#define DEF_BUSY_CURSOR "wait"
+#else
+#define DEF_BUSY_CURSOR "watch"
+#endif
+
+/*
+ * Types used in this file.
+ */
+
+typedef struct {
+    Display *display;		/* Display of busy window */
+    Tcl_Interp *interp;		/* Interpreter where "busy" command was
+				 * created. It's used to key the searches in
+				 * the window hierarchy. See the "windows"
+				 * command. */
+    Tk_Window tkBusy;		/* Busy window: Transparent window used to
+				 * block delivery of events to windows
+				 * underneath it. */
+    Tk_Window tkParent;		/* Parent window of the busy window. It may be
+				 * the reference window (if the reference is a
+				 * toplevel) or a mutual ancestor of the
+				 * reference window */
+    Tk_Window tkRef;		/* Reference window of the busy window. It is
+				 * used to manage the size and position of the
+				 * busy window. */
+    int x, y;			/* Position of the reference window */
+    int width, height;		/* Size of the reference window. Retained to
+				 * know if the reference window has been
+				 * reconfigured to a new size. */
+    int menuBar;		/* Menu bar flag. */
+    Tk_Cursor cursor;		/* Cursor for the busy window. */
+    Tcl_HashEntry *hashPtr;	/* Used the delete the busy window entry out
+				 * of the global hash table. */
+    Tcl_HashTable *tablePtr;
+    Tk_OptionTable optionTable;
+} Busy;
+
+/*
+ * Things about the busy system that may be configured.
+ */
+
+static Tk_OptionSpec busyOptionSpecs[] = {
+    {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+	DEF_BUSY_CURSOR, -1, Tk_Offset(Busy, cursor),
+	TK_OPTION_NULL_OK, 0, 0},
+    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0}
+};
+
+/*
+ * Forward declarations of functions defined in this file.
+ */
+
+static void		DestroyBusy(char *dataPtr);
+static void		BusyEventProc(ClientData clientData,
+			    XEvent *eventPtr);
+static void		BusyGeometryProc(ClientData clientData,
+			    Tk_Window tkwin);
+static void		BusyCustodyProc(ClientData clientData,
+			    Tk_Window tkwin);
+
+/*
+ * The "busy" geometry manager definition.
+ */
+
+static Tk_GeomMgr busyMgrInfo = {
+    "busy",			/* Name of geometry manager used by winfo */
+    BusyGeometryProc,		/* Procedure to for new geometry requests */
+    BusyCustodyProc,		/* Procedure when window is taken away */
+};
+
+/*
+ * Helper functions, need to check if a Tcl/Tk alternative already exists.
+ */
+
+static inline Tk_Window
+FirstChild(
+    Tk_Window parent)
+{
+    struct TkWindow *parentPtr = (struct TkWindow *) parent;
+
+    return (Tk_Window) parentPtr->childList;
+}
+
+static inline Tk_Window
+NextChild(
+    Tk_Window tkwin)
+{
+    struct TkWindow *winPtr = (struct TkWindow *) tkwin;
+
+    if (winPtr == NULL) {
+	return NULL;
+    }
+    return (Tk_Window) winPtr->nextPtr;
+}
+
+static inline void
+SetWindowInstanceData(
+    Tk_Window tkwin,
+    ClientData instanceData)
+{
+    struct TkWindow *winPtr = (struct TkWindow *) tkwin;
+
+    winPtr->instanceData = instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpShowBusyWindow, TkpHideBusyWindow, TkpMakeTransparentWindowExist,
+ * TkpCreateBusy --
+ *
+ *	Portability layer. Holds platform-specific gunk for the [tk busy]
+ *	command, including a wholly dummy implementation for OSX/Aqua. The
+ *	individual functions do the following:
+ *
+ * TkpShowBusyWindow --
+ *	Make the busy window appear.
+ *
+ * TkpHideBusyWindow --
+ *	Make the busy window go away.
+ *
+ * TkpMakeTransparentWindowExist --
+ *	Actually make a transparent window.
+ *
+ * TkpCreateBusy --
+ *	Creates the platform-specific part of a busy window structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef WIN32			/* Windows */
+
+void
+TkpShowBusyWindow(
+    Busy *busyPtr)
+{
+    HWND hWnd;
+    POINT point;
+    Display *display;
+    Window window;
+
+    if (busyPtr->tkBusy != NULL) {
+	Tk_MapWindow(busyPtr->tkBusy);
+	window = Tk_WindowId(busyPtr->tkBusy);
+	display = Tk_Display(busyPtr->tkBusy);
+	hWnd = Tk_GetHWND(window);
+	display->request++;
+	SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE);
+    }
+
+    /*
+     * Under Win32, cursors aren't associated with windows. Tk fakes this by
+     * watching Motion events on its windows. So Tk will automatically change
+     * the cursor when the pointer enters the Busy window. But Windows does
+     * not immediately change the cursor; it waits for the cursor position to
+     * change or a system call. We need to change the cursor before the
+     * application starts processing, so set the cursor position redundantly
+     * back to the current position.
+     */
+
+    GetCursorPos(&point);
+    SetCursorPos(point.x, point.y);
+}
+
+void
+TkpHideBusyWindow(
+    Busy *busyPtr)
+{
+    POINT point;
+
+    if (busyPtr->tkBusy != NULL) {
+	Tk_UnmapWindow(busyPtr->tkBusy);
+    }
+
+    /*
+     * Under Win32, cursors aren't associated with windows. Tk fakes this by
+     * watching Motion events on its windows. So Tk will automatically change
+     * the cursor when the pointer enters the Busy window. But Windows does
+     * not immediately change the cursor: it waits for the cursor position to
+     * change or a system call. We need to change the cursor before the
+     * application starts processing, so set the cursor position redundantly
+     * back to the current position.
+     */
+
+    GetCursorPos(&point);
+    SetCursorPos(point.x, point.y);
+}
+
+void
+TkpMakeTransparentWindowExist(
+    Tk_Window tkwin,		/* Token for window. */
+    Window parent)		/* Parent window. */
+{
+    TkWindow *winPtr = (TkWindow *) tkwin;
+    HWND hParent;
+    HWND hWnd;
+    int style;
+    DWORD exStyle;
+
+    hParent = (HWND) parent;
+    style = WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS;
+    exStyle = WS_EX_TRANSPARENT | WS_EX_TOPMOST;
+#define TK_WIN_CHILD_CLASS_NAME "TkChild"
+    hWnd = CreateWindowEx(exStyle, TK_WIN_CHILD_CLASS_NAME, NULL, style,
+	    Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin),
+	    hParent, NULL, Tk_GetHINSTANCE(), NULL);
+    winPtr->window = Tk_AttachHWND(tkwin, hWnd);
+}
+
+void
+TkpCreateBusy(
+    Tk_FakeWin *winPtr,
+    Tk_Window tkRef,
+    Window* parentPtr,
+    Tk_Window tkParent,
+    Busy *busyPtr)
+{
+    if (winPtr->flags & TK_REPARENTED) {
+	/*
+	 * This works around a bug in the implementation of menubars for
+	 * non-MacIntosh window systems (Win32 and X11). Tk doesn't reset the
+	 * pointers to the parent window when the menu is reparented
+	 * (winPtr->parentPtr points to the wrong window). We get around this
+	 * by determining the parent via the native API calls.
+	 */
+
+	HWND hWnd;
+	RECT rect;
+
+	hWnd = GetParent(Tk_GetHWND(Tk_WindowId(tkRef)));
+	if (GetWindowRect(hWnd, &rect)) {
+	    busyPtr->width = rect.right - rect.left;
+	    busyPtr->height = rect.bottom - rect.top;
+	}
+    } else {
+	*parentPtr = Tk_WindowId(tkParent);
+	*parentPtr = (Window) Tk_GetHWND(*parentPtr);
+    }
+}
+
+#elif defined(MAC_OSX_TK)	/* Aqua */
+
+void
+TkpShowBusyWindow(
+    Busy *busyPtr)
+{
+}
+
+void
+TkpHideBusyWindow(
+    Busy *busyPtr)
+{
+}
+
+void
+TkpMakeTransparentWindowExist(
+    Tk_Window tkwin,		/* Token for window. */
+    Window parent)		/* Parent window. */
+{
+}
+
+void
+TkpCreateBusy(
+    Tk_FakeWin *winPtr,
+    Tk_Window tkRef,
+    Window* parentPtr,
+    Tk_Window tkParent,
+    Busy *busyPtr)
+{
+}
+
+#else /* UNIX/X11 */
+
+void
+TkpShowBusyWindow(
+    Busy *busyPtr)
+{
+    if (busyPtr->tkBusy != NULL) {
+	Tk_MapWindow(busyPtr->tkBusy);
+
+	/*
+	 * Always raise the busy window just in case new sibling windows have
+	 * been created in the meantime. Can't use Tk_RestackWindow because it
+	 * doesn't work under Win32.
+	 */
+
+	XRaiseWindow(Tk_Display(busyPtr->tkBusy),
+		Tk_WindowId(busyPtr->tkBusy));
+    }
+}
+
+void
+TkpHideBusyWindow(
+    Busy *busyPtr)
+{
+    if (busyPtr->tkBusy != NULL) {
+	Tk_UnmapWindow(busyPtr->tkBusy);
+    }
+}
+
+void
+TkpMakeTransparentWindowExist(
+    Tk_Window tkwin,		/* Token for window. */
+    Window parent)		/* Parent window. */
+{
+    TkWindow *winPtr = (TkWindow *) tkwin;
+    long int mask = CWDontPropagate | CWEventMask;
+
+    /*
+     * Ignore the important events while the window is mapped.
+     */
+
+#define USER_EVENTS \
+	(EnterWindowMask | LeaveWindowMask | KeyPressMask | KeyReleaseMask | \
+	ButtonPressMask | ButtonReleaseMask | PointerMotionMask)
+#define PROP_EVENTS \
+	(KeyPressMask | KeyReleaseMask | ButtonPressMask | \
+	ButtonReleaseMask | PointerMotionMask)
+
+    winPtr->atts.do_not_propagate_mask = PROP_EVENTS;
+    winPtr->atts.event_mask = USER_EVENTS;
+    winPtr->changes.border_width = 0;
+    winPtr->depth = 0;
+
+    winPtr->window = XCreateWindow(winPtr->display, parent,
+	    winPtr->changes.x, winPtr->changes.y,
+	    (unsigned) winPtr->changes.width,		/* width */
+	    (unsigned) winPtr->changes.height,		/* height */
+	    (unsigned) winPtr->changes.border_width,	/* border_width */
+	    winPtr->depth, InputOnly, winPtr->visual, mask, &winPtr->atts);
+}
+
+static Window
+GetParent(
+    Display *display,
+    Window window)
+{
+    Window root, parent;
+    Window *dummy;
+    unsigned int count;
+
+    if (XQueryTree(display, window, &root, &parent, &dummy, &count) > 0) {
+	XFree(dummy);
+	return parent;
+    }
+    return None;
+}
+
+void
+TkpCreateBusy(
+    Tk_FakeWin *winPtr,
+    Tk_Window tkRef,
+    Window* parentPtr,
+    Tk_Window tkParent,
+    Busy *busyPtr)
+{
+    if (winPtr->flags & TK_REPARENTED) {
+	/*
+	 * This works around a bug in the implementation of menubars for
+	 * non-MacIntosh window systems (Win32 and X11). Tk doesn't reset the
+	 * pointers to the parent window when the menu is reparented
+	 * (winPtr->parentPtr points to the wrong window). We get around this
+	 * by determining the parent via the native API calls.
+	 */
+
+	*parentPtr = GetParent(Tk_Display(tkRef), Tk_WindowId(tkRef));
+    } else {
+	*parentPtr = Tk_WindowId(tkParent);
+    }
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BusyCustodyProc --
+ *
+ *	This procedure is invoked when the busy window has been stolen by
+ *	another geometry manager. The information and memory associated with
+ *	the busy window is released. I don't know why anyone would try to pack
+ *	a busy window, but this should keep everything sane, if it is.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The Busy structure is freed at the next idle point.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* ARGSUSED */
+static void
+BusyCustodyProc(
+    ClientData clientData,	/* Information about the busy window. */
+    Tk_Window tkwin)		/* Not used. */
+{
+    Busy *busyPtr = clientData;
+
+    Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask, BusyEventProc,
+	    busyPtr);
+    TkpHideBusyWindow(busyPtr);
+    busyPtr->tkBusy = NULL;
+    Tcl_EventuallyFree(busyPtr, DestroyBusy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BusyGeometryProc --
+ *
+ *	This procedure is invoked by Tk_GeometryRequest for busy windows.
+ *	Busy windows never request geometry, so it's unlikely that this
+ *	function will ever be called;it exists simply as a place holder for
+ *	the GeomProc in the Geometry Manager structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* ARGSUSED */
+static void
+BusyGeometryProc(
+    ClientData clientData,	/* Information about window that got new
+				 * preferred geometry. */
+    Tk_Window tkwin)		/* Other Tk-related information about the
+				 * window. */
+{
+    /* Should never get here */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoConfigureNotify --
+ *
+ *	Generate a ConfigureNotify event describing the current configuration
+ *	of a window.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	An event is generated and processed by Tk_HandleEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DoConfigureNotify(
+    Tk_FakeWin *winPtr)		/* Window whose configuration was just
+				 * changed. */
+{
+    XEvent event;
+
+    event.type = ConfigureNotify;
+    event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display);
+    event.xconfigure.send_event = False;
+    event.xconfigure.display = winPtr->display;
+    event.xconfigure.event = winPtr->window;
+    event.xconfigure.window = winPtr->window;
+    event.xconfigure.x = winPtr->changes.x;
+    event.xconfigure.y = winPtr->changes.y;
+    event.xconfigure.width = winPtr->changes.width;
+    event.xconfigure.height = winPtr->changes.height;
+    event.xconfigure.border_width = winPtr->changes.border_width;
+    if (winPtr->changes.stack_mode == Above) {
+	event.xconfigure.above = winPtr->changes.sibling;
+    } else {
+	event.xconfigure.above = None;
+    }
+    event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+    Tk_HandleEvent(&event);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefWinEventProc --
+ *
+ *	This procedure is invoked by the Tk dispatcher for the following
+ *	events on the reference window. If the reference and parent windows
+ *	are the same, only the first event is important.
+ *
+ *	1) ConfigureNotify	The reference window has been resized or
+ *				moved. Move and resize the busy window to be
+ *				the same size and position of the reference
+ *				window.
+ *
+ *	2) DestroyNotify	The reference window was destroyed. Destroy
+ *				the busy window and the free resources used.
+ *
+ *	3) MapNotify		The reference window was (re)shown. Map the
+ *				busy window again.
+ *
+ *	4) UnmapNotify		The reference window was hidden. Unmap the
+ *				busy window.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When the reference window gets deleted, internal structures get
+ *	cleaned up. When it gets resized, the busy window is resized
+ *	accordingly. If it's displayed, the busy window is displayed. And when
+ *	it's hidden, the busy window is unmapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RefWinEventProc(
+    ClientData clientData,	/* Busy window record */
+    register XEvent *eventPtr)	/* Event which triggered call to routine */
+{
+    register Busy *busyPtr = clientData;
+
+    switch (eventPtr->type) {
+    case ReparentNotify:
+    case DestroyNotify:
+	/*
+	 * Arrange for the busy structure to be removed at a proper time.
+	 */
+
+	Tcl_EventuallyFree(busyPtr, DestroyBusy);
+	break;
+
+    case ConfigureNotify:
+	if ((busyPtr->width != Tk_Width(busyPtr->tkRef)) ||
+		(busyPtr->height != Tk_Height(busyPtr->tkRef)) ||
+		(busyPtr->x != Tk_X(busyPtr->tkRef)) ||
+		(busyPtr->y != Tk_Y(busyPtr->tkRef))) {
+	    int x, y;
+
+	    busyPtr->width = Tk_Width(busyPtr->tkRef);
+	    busyPtr->height = Tk_Height(busyPtr->tkRef);
+	    busyPtr->x = Tk_X(busyPtr->tkRef);
+	    busyPtr->y = Tk_Y(busyPtr->tkRef);
+
+	    x = y = 0;
+
+	    if (busyPtr->tkParent != busyPtr->tkRef) {
+		Tk_Window tkwin;
+
+		for (tkwin = busyPtr->tkRef; (tkwin != NULL) &&
+			 (!Tk_IsTopLevel(tkwin)); tkwin = Tk_Parent(tkwin)) {
+		    if (tkwin == busyPtr->tkParent) {
+			break;
+		    }
+		    x += Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+		    y += Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+		}
+	    }
+	    if (busyPtr->tkBusy != NULL) {
+		Tk_MoveResizeWindow(busyPtr->tkBusy, x, y, busyPtr->width,
+			busyPtr->height);
+		TkpShowBusyWindow(busyPtr);
+	    }
+	}
+	break;
+
+    case MapNotify:
+	if (busyPtr->tkParent != busyPtr->tkRef) {
+	    TkpShowBusyWindow(busyPtr);
+	}
+	break;
+
+    case UnmapNotify:
+	if (busyPtr->tkParent != busyPtr->tkRef) {
+	    TkpHideBusyWindow(busyPtr);
+	}
+	break;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyBusy --
+ *
+ *	This procedure is called from the Tk event dispatcher. It releases X
+ *	resources and memory used by the busy window and updates the internal
+ *	hash table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory and resources are released and the Tk event handler is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyBusy(
+    char *data)			/* Busy window structure record */
+{
+    register Busy *busyPtr = (Busy *) data;
+
+    if (busyPtr->hashPtr != NULL) {
+	Tcl_DeleteHashEntry(busyPtr->hashPtr);
+    }
+    Tk_DeleteEventHandler(busyPtr->tkRef, StructureNotifyMask,
+	    RefWinEventProc, busyPtr);
+
+    if (busyPtr->tkBusy != NULL) {
+	Tk_FreeConfigOptions(data, busyPtr->optionTable, busyPtr->tkBusy);
+	Tk_DeleteEventHandler(busyPtr->tkBusy, StructureNotifyMask,
+		BusyEventProc, busyPtr);
+	Tk_ManageGeometry(busyPtr->tkBusy, NULL, busyPtr);
+	Tk_DestroyWindow(busyPtr->tkBusy);
+    }
+    ckfree(data);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BusyEventProc --
+ *
+ *	This procedure is invoked by the Tk dispatcher for events on the busy
+ *	window itself. We're only concerned with destroy events.
+ *
+ *	It might be necessary (someday) to watch resize events. Right now, I
+ *	don't think there's any point in it.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When a busy window is destroyed, all internal structures associated
+ *	with it released at the next idle point.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BusyEventProc(
+    ClientData clientData,	/* Busy window record */
+    XEvent *eventPtr)		/* Event which triggered call to routine */
+{
+    Busy *busyPtr = clientData;
+
+    if (eventPtr->type == DestroyNotify) {
+	busyPtr->tkBusy = NULL;
+	Tcl_EventuallyFree(busyPtr, DestroyBusy);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MakeTransparentWindowExist --
+ *
+ *	Similar to Tk_MakeWindowExist but instead creates a transparent window
+ *	to block for user events from sibling windows.
+ *
+ *	Differences from Tk_MakeWindowExist.
+ *
+ *	1. This is always a "busy" window. There's never a platform-specific
+ *	   class procedure to execute instead.
+ *	2. The window is transparent and never will contain children, so
+ *	   colormap information is irrelevant.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	When the procedure returns, the internal window associated with tkwin
+ *	is guaranteed to exist. This may require the window's ancestors to be
+ *	created too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MakeTransparentWindowExist(
+    Tk_Window tkwin,		/* Token for window. */
+    Window parent)		/* Parent window. */
+{
+    TkWindow *winPtr = (TkWindow *) tkwin;
+    Tcl_HashEntry *hPtr;
+    int notUsed;
+    TkDisplay *dispPtr;
+
+    if (winPtr->window != None) {
+	return;			/* Window already exists. */
+    }
+
+    /*
+     * Create a transparent window and put it on top.
+     */
+
+    TkpMakeTransparentWindowExist(tkwin, parent);
+
+    dispPtr = winPtr->dispPtr;
+    hPtr = Tcl_CreateHashEntry(&dispPtr->winTable, (char *) winPtr->window,
+	    &notUsed);
+    Tcl_SetHashValue(hPtr, winPtr);
+    winPtr->dirtyAtts = 0;
+    winPtr->dirtyChanges = 0;
+
+    if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
+	TkWindow *winPtr2;
+
+	/*
+	 * If any siblings higher up in the stacking order have already been
+	 * created then move this window to its rightful position in the
+	 * stacking order.
+	 *
+	 * NOTE: this code ignores any changes anyone might have made to the
+	 * sibling and stack_mode field of the window's attributes, so it
+	 * really isn't safe for these to be manipulated except by calling
+	 * Tk_RestackWindow.
+	 */
+
+	for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL;
+		winPtr2 = winPtr2->nextPtr) {
+	    if ((winPtr2->window != None) &&
+		    !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) {
+		XWindowChanges changes;
+
+		changes.sibling = winPtr2->window;
+		changes.stack_mode = Below;
+		XConfigureWindow(winPtr->display, winPtr->window,
+			CWSibling | CWStackMode, &changes);
+		break;
+	    }
+	}
+    }
+
+    /*
+     * Issue a ConfigureNotify event if there were deferred configuration
+     * changes (but skip it if the window is being deleted; the
+     * ConfigureNotify event could cause problems if we're being called from
+     * Tk_DestroyWindow under some conditions).
+     */
+
+    if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY)
+	    && !(winPtr->flags & TK_ALREADY_DEAD)) {
+	winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY;
+	DoConfigureNotify((Tk_FakeWin *) tkwin);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateBusy --
+ *
+ *	Creates a child transparent window that obscures its parent window
+ *	thereby effectively blocking device events. The size and position of
+ *	the busy window is exactly that of the reference window.
+ *
+ *	We want to create sibling to the window to be blocked. If the busy
+ *	window is a child of the window to be blocked, Enter/Leave events can
+ *	sneak through. Futhermore under WIN32, messages of transparent windows
+ *	are sent directly to the parent. The only exception to this are
+ *	toplevels, since we can't make a sibling. Fortunately, toplevel
+ *	windows rarely receive events that need blocking.
+ *
+ * Results:
+ *	Returns a pointer to the new busy window structure.
+ *
+ * Side effects:
+ *	When the busy window is eventually displayed, it will screen device
+ *	events (in the area of the reference window) from reaching its parent
+ *	window and its children. User feed back can be achieved by changing
+ *	the cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Busy *
+CreateBusy(
+    Tcl_Interp *interp,		/* Interpreter to report error to */
+    Tk_Window tkRef)		/* Window hosting the busy window */
+{
+    Busy *busyPtr;
+    int length, x, y;
+    char *fmt, *name;
+    Tk_Window tkBusy, tkChild, tkParent;
+    Window parent;
+    Tk_FakeWin *winPtr;
+
+    busyPtr = (Busy *) ckalloc(sizeof(Busy));
+    x = y = 0;
+    length = strlen(Tk_Name(tkRef));
+    name = ckalloc(length + 6);
+    if (Tk_IsTopLevel(tkRef)) {
+	fmt = "_Busy";		/* Child */
+	tkParent = tkRef;
+    } else {
+	Tk_Window tkwin;
+
+	fmt = "%s_Busy";	/* Sibling */
+	tkParent = Tk_Parent(tkRef);
+	for (tkwin = tkRef; (tkwin != NULL) && !Tk_IsTopLevel(tkwin);
+		tkwin = Tk_Parent(tkwin)) {
+	    if (tkwin == tkParent) {
+		break;
+	    }
+	    x += Tk_X(tkwin) + Tk_Changes(tkwin)->border_width;
+	    y += Tk_Y(tkwin) + Tk_Changes(tkwin)->border_width;
+	}
+    }
+    for (tkChild = FirstChild(tkParent); tkChild != NULL;
+	    tkChild = NextChild(tkChild)) {
+	Tk_MakeWindowExist(tkChild);
+    }
+    sprintf(name, fmt, Tk_Name(tkRef));
+    tkBusy = Tk_CreateWindow(interp, tkParent, name, NULL);
+    ckfree(name);
+
+    if (tkBusy == NULL) {
+	return NULL;
+    }
+    Tk_MakeWindowExist(tkRef);
+    busyPtr->display = Tk_Display(tkRef);
+    busyPtr->interp = interp;
+    busyPtr->tkRef = tkRef;
+    busyPtr->tkParent = tkParent;
+    busyPtr->tkBusy = tkBusy;
+    busyPtr->width = Tk_Width(tkRef);
+    busyPtr->height = Tk_Height(tkRef);
+    busyPtr->x = Tk_X(tkRef);
+    busyPtr->y = Tk_Y(tkRef);
+    busyPtr->cursor = None;
+    Tk_SetClass(tkBusy, "Busy");
+    busyPtr->optionTable = Tk_CreateOptionTable(interp, busyOptionSpecs);
+    if (Tk_InitOptions(interp, (char *) busyPtr, busyPtr->optionTable,
+	    tkBusy) != TCL_OK) {
+	Tk_DestroyWindow(tkBusy);
+	return NULL;
+    }
+    SetWindowInstanceData(tkBusy, (ClientData)busyPtr);
+    winPtr = (Tk_FakeWin *) tkRef;
+
+    TkpCreateBusy(winPtr, tkRef, &parent, tkParent, busyPtr);
+
+    MakeTransparentWindowExist(tkBusy, parent);
+
+    Tk_MoveResizeWindow(tkBusy, x, y, busyPtr->width, busyPtr->height);
+
+    /*
+     * Only worry if the busy window is destroyed.
+     */
+
+    Tk_CreateEventHandler(tkBusy, StructureNotifyMask, BusyEventProc,
+	    busyPtr);
+
+    /*
+     * Indicate that the busy window's geometry is being managed. This will
+     * also notify us if the busy window is ever packed.
+     */
+
+    Tk_ManageGeometry(tkBusy, &busyMgrInfo, busyPtr);
+#ifndef MAC_OSX_TK
+    if (busyPtr->cursor != None) {
+	Tk_DefineCursor(tkBusy, busyPtr->cursor);
+    }
+#endif
+
+    /*
+     * Track the reference window to see if it is resized or destroyed.
+     */
+
+    Tk_CreateEventHandler(tkRef, StructureNotifyMask, RefWinEventProc,
+	    busyPtr);
+    return busyPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureBusy --
+ *
+ *	This procedure is called from the Tk event dispatcher. It releases X
+ *	resources and memory used by the busy window and updates the internal
+ *	hash table.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory and resources are released and the Tk event handler is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureBusy(
+    Tcl_Interp *interp,
+    Busy *busyPtr,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+#ifndef MAC_OSX_TK
+    Tk_Cursor oldCursor = busyPtr->cursor;
+
+    if (Tk_SetOptions(interp, (char *) busyPtr, busyPtr->optionTable, objc,
+	    objv, busyPtr->tkBusy, NULL, NULL) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (busyPtr->cursor != oldCursor) {
+	if (busyPtr->cursor == None) {
+	    Tk_UndefineCursor(busyPtr->tkBusy);
+	} else {
+	    Tk_DefineCursor(busyPtr->tkBusy, busyPtr->cursor);
+	}
+    }
+#endif
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBusy --
+ *
+ *	Returns the busy window structure associated with the reference
+ *	window, keyed by its path name. The clientData argument is the main
+ *	window of the interpreter, used to search for the reference window in
+ *	its own window hierarchy.
+ *
+ * Results:
+ *	If path name represents a reference window with a busy window, a
+ *	pointer to the busy window structure is returned. Otherwise, NULL is
+ *	returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetBusy(
+    Tcl_HashTable *busyTablePtr,/* busy hash table */
+    Tcl_Interp *interp,		/* Interpreter to report errors to */
+    Tcl_Obj *const windowObj,	/* Path name of parent window */
+    Busy **busyPtrPtr)		/* Will contain address of busy window if
+				 * found. */
+{
+    Tcl_HashEntry *hPtr;
+    Tk_Window tkwin;
+
+    if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj,
+	    &tkwin) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    hPtr = Tcl_FindHashEntry(busyTablePtr, (char *) tkwin);
+    if (hPtr == NULL) {
+	Tcl_AppendResult(interp, "can't find busy window \"",
+		Tcl_GetString(windowObj), "\"", NULL);
+	return TCL_ERROR;
+    }
+    *busyPtrPtr = Tcl_GetHashValue(hPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HoldBusy --
+ *
+ *	Creates (if necessary) and maps a busy window, thereby preventing
+ *	device events from being be received by the parent window and its
+ *	children.
+ *
+ * Results:
+ *	Returns a standard TCL result. If path name represents a busy window,
+ *	it is unmapped and TCL_OK is returned. Otherwise, TCL_ERROR is
+ *	returned and an error message is left in interp->result.
+ *
+ * Side effects:
+ *	The busy window is created and displayed, blocking events from the
+ *	parent window and its children.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HoldBusy(
+    Tcl_HashTable *busyTablePtr,/* Busy hash table. */
+    Tcl_Interp *interp,		/* Interpreter to report errors to. */
+    Tcl_Obj *const windowObj,	/* Window name. */
+    int configObjc,		/* Option pairs. */
+    Tcl_Obj *const configObjv[])
+{
+    Tk_Window tkwin;
+    Tcl_HashEntry *hPtr;
+    Busy *busyPtr;
+    int isNew, result;
+
+    if (TkGetWindowFromObj(interp, Tk_MainWindow(interp), windowObj,
+	    &tkwin) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    hPtr = Tcl_CreateHashEntry(busyTablePtr, (char *) tkwin, &isNew);
+    if (isNew) {
+	busyPtr = (Busy *) CreateBusy(interp, tkwin);
+	if (busyPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_SetHashValue(hPtr, busyPtr);
+	busyPtr->hashPtr = hPtr;
+    } else {
+	busyPtr = Tcl_GetHashValue(hPtr);
+    }
+
+    busyPtr->tablePtr = busyTablePtr;
+    result = ConfigureBusy(interp, busyPtr, configObjc, configObjv);
+
+    /*
+     * Don't map the busy window unless the reference window is also currently
+     * displayed.
+     */
+
+    if (Tk_IsMapped(busyPtr->tkRef)) {
+	TkpShowBusyWindow(busyPtr);
+    } else {
+	TkpHideBusyWindow(busyPtr);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BusyObjCmd --
+ *
+ *	This function is invoked to process the "tk busy" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_BusyObjCmd(
+    ClientData clientData,	/* Main window associated with interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tk_Window tkwin = clientData;
+    Tcl_HashTable *busyTablePtr = &((TkWindow *) tkwin)->mainPtr->busyTable;
+    Busy *busyPtr;
+    Tcl_Obj *objPtr;
+    int index, result = TCL_OK;
+    static const char *optionStrings[] = {
+	"cget", "configure", "current", "forget", "hold", "status", NULL
+    };
+    enum options {
+	BUSY_CGET, BUSY_CONFIGURE, BUSY_CURRENT, BUSY_FORGET, BUSY_HOLD,
+	BUSY_STATUS
+    };
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "options ?arg arg ...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * [tk busy <window>] command shortcut.
+     */
+
+    if (Tcl_GetString(objv[2])[0] == '.') {
+	if (objc%2 != 1) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "window ?option value ...?");
+	    return TCL_ERROR;
+	}
+	return HoldBusy(busyTablePtr, interp, objv[2], objc-3, objv+3);
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[2], optionStrings, "option", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch ((enum options) index) {
+    case BUSY_CGET:
+	if (objc != 5) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "window option");
+	    return TCL_ERROR;
+	}
+	if (GetBusy(busyTablePtr, interp, objv[3], &busyPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_Preserve(busyPtr);
+	objPtr = Tk_GetOptionValue(interp, (char *) busyPtr,
+		busyPtr->optionTable, objv[4], busyPtr->tkBusy);
+	if (objPtr == NULL) {
+	    result = TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, objPtr);
+	}
+	Tcl_Release(busyPtr);
+	return result;
+
+    case BUSY_CONFIGURE:
+	if (objc < 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "window ?option? ?value ...?");
+	    return TCL_ERROR;
+	}
+	if (GetBusy(busyTablePtr, interp, objv[3], &busyPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_Preserve(busyPtr);
+	if (objc <= 5) {
+	    objPtr = Tk_GetOptionInfo(interp, (char *) busyPtr,
+		    busyPtr->optionTable, (objc == 5) ? objv[4] : NULL,
+		    busyPtr->tkBusy);
+	    if (objPtr == NULL) {
+		result = TCL_ERROR;
+	    } else {
+		Tcl_SetObjResult(interp, objPtr);
+	    }
+	} else {
+	    result = ConfigureBusy(interp, busyPtr, objc-4, objv+4);
+	}
+	Tcl_Release(busyPtr);
+	return TCL_OK;
+
+    case BUSY_CURRENT: {
+	Tcl_HashEntry *hPtr;
+	Tcl_HashSearch cursor;
+	const char *pattern = (objc == 4 ? Tcl_GetString(objv[3]) : NULL);
+
+	objPtr = Tcl_NewObj();
+	for (hPtr = Tcl_FirstHashEntry(busyTablePtr, &cursor); hPtr != NULL;
+		hPtr = Tcl_NextHashEntry(&cursor)) {
+	    busyPtr = Tcl_GetHashValue(hPtr);
+	    if (pattern == NULL ||
+		    Tcl_StringMatch(Tk_PathName(busyPtr->tkRef), pattern)) {
+		Tcl_ListObjAppendElement(interp, objPtr,
+			TkNewWindowObj(busyPtr->tkRef));
+	    }
+	}
+	Tcl_SetObjResult(interp, objPtr);
+	return TCL_OK;
+    }
+
+    case BUSY_FORGET:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "window");
+	    return TCL_ERROR;
+	}
+	if (GetBusy(busyTablePtr, interp, objv[3], &busyPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	TkpHideBusyWindow(busyPtr);
+	Tcl_EventuallyFree(busyPtr, DestroyBusy);
+	return TCL_OK;
+
+    case BUSY_HOLD:
+	if (objc < 4 || objc%2 == 1) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "window ?option value ...?");
+	    return TCL_ERROR;
+	}
+	return HoldBusy(busyTablePtr, interp, objv[3], objc-4, objv+4);
+
+    case BUSY_STATUS:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 3, objv, "window");
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
+		GetBusy(busyTablePtr, interp, objv[3], &busyPtr) == TCL_OK));
+	return TCL_OK;
+    }
+
+    Tcl_Panic("unhandled option: %d", index);
+    return TCL_ERROR;		/* Unreachable */
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index 64896c5..83a6ecc 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.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: tkCmds.c,v 1.45 2008/10/17 23:18:37 nijtmans Exp $
+ * RCS: @(#) $Id: tkCmds.c,v 1.46 2008/10/18 14:22:21 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -611,18 +611,16 @@ Tk_TkObjCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int index;
-    Tk_Window tkwin;
+    Tk_Window tkwin = clientData;
     static const char *const optionStrings[] = {
-	"appname",	"caret",	"scaling",	"useinputmethods",
-	"windowingsystem",		"inactive",	NULL
+	"appname", "busy", "caret", "inactive", "scaling", "useinputmethods",
+	"windowingsystem", NULL
     };
     enum options {
-	TK_APPNAME,	TK_CARET,	TK_SCALING,	TK_USE_IM,
-	TK_WINDOWINGSYSTEM,		TK_INACTIVE
+	TK_APPNAME, TK_BUSY, TK_CARET, TK_INACTIVE, TK_SCALING, TK_USE_IM,
+	TK_WINDOWINGSYSTEM
     };
 
-    tkwin = (Tk_Window) clientData;
-
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
 	return TCL_ERROR;
@@ -657,6 +655,8 @@ Tk_TkObjCmd(
 	Tcl_AppendResult(interp, winPtr->nameUid, NULL);
 	break;
     }
+    case TK_BUSY:
+	return Tk_BusyObjCmd(clientData, interp, objc, objv);
     case TK_CARET: {
 	Tcl_Obj *objPtr;
 	TkCaret *caretPtr;
diff --git a/generic/tkInt.h b/generic/tkInt.h
index ac46234..21d12f1 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.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: tkInt.h,v 1.85 2008/10/15 06:41:06 nijtmans Exp $
+ * RCS: $Id: tkInt.h,v 1.86 2008/10/18 14:22:21 dkf Exp $
  */
 
 #ifndef _TKINT
@@ -670,6 +670,7 @@ typedef struct TkMainInfo {
 				 * ::tk::AlwaysShowSelection variable. */
     struct TkMainInfo *nextPtr;	/* Next in list of all main windows managed by
 				 * this process. */
+    Tcl_HashTable busyTable;	/* Information used by [tk busy] command. */
 } TkMainInfo;
 
 /*
@@ -981,6 +982,9 @@ MODULE_SCOPE int	Tk_BindObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tk_BindtagsObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tk_BusyObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tk_ButtonObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 7e947cf..87e93c9 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.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: tkWindow.c,v 1.96 2008/08/19 15:52:12 georgeps Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.97 2008/10/18 14:22:21 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -926,6 +926,7 @@ TkCreateMainWindow(
     hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
     Tcl_SetHashValue(hPtr, winPtr);
     winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
+    Tcl_InitHashTable(&mainPtr->busyTable, TCL_ONE_WORD_KEYS);
 
     /*
      * We have just created another Tk application; increment the refcount on
@@ -1529,6 +1530,7 @@ Tk_DestroyWindow(
 			"::tk::AlwaysShowSelection");
 	    }
 
+	    Tcl_DeleteHashTable(&winPtr->mainPtr->busyTable);
 	    Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
 	    TkBindFree(winPtr->mainPtr);
 	    TkDeleteAllImages(winPtr->mainPtr);
diff --git a/tests/busy.test b/tests/busy.test
new file mode 100644
index 0000000..a35fb60
--- /dev/null
+++ b/tests/busy.test
@@ -0,0 +1,424 @@
+# Tests for the tk busy command.
+#
+# This file contains a collection of tests for one or more of the Tk built-in
+# commands. Sourcing this file runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 1998-2000 by Jos Decoster. All rights reserved.
+#
+# RCS: @(#) $Id: busy.test,v 1.1 2008/10/18 14:22:22 dkf Exp $
+
+package require tcltest 2.1
+tcltest::configure {*}$argv
+tcltest::loadTestedCommands
+namespace import -force tcltest::test
+
+# There's currently no way to test the actual grab effect, per se, in an
+# automated test. Therefore, this test suite only covers the interface to the
+# grab command (ie, error messages, etc.)
+
+test busy-1.1 {Tk_BusyObjCmd} -returnCodes error -body {
+    tk busy
+} -result {wrong # args: should be "tk busy options ?arg arg ...?"}
+
+test busy-2.1 {tk busy hold} -returnCodes error -body {
+    tk busy hold
+} -result {wrong # args: should be "tk busy hold window ?option value ...?"}
+test busy-2.2 {tk busy hold root window} -body {
+    tk busy hold .
+    update
+} -cleanup {
+    tk busy forget .
+} -result {}
+test busy-2.3 {tk busy hold root window with shortcut} -body {
+    tk busy .
+    update
+} -cleanup {
+    tk busy forget .
+} -result {}
+test busy-2.4 {tk busy hold nested window} -setup {
+    pack [frame .f]
+} -body {
+    tk busy hold .f
+    update
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {}
+test busy-2.5 {tk busy hold nested window with shortcut} -setup {
+    pack [frame .f]
+} -body {
+    tk busy .f
+    update
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {}
+test busy-2.6 {tk busy hold toplevel window} -setup {
+    toplevel .f
+} -body {
+    tk busy hold .f
+    update
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {}
+test busy-2.7 {tk busy hold toplevel window with shortcut} -setup {
+    toplevel .f
+} -body {
+    tk busy .f
+    update
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {}
+test busy-2.8 {tk busy hold non existing window} -body {
+    tk busy hold .f
+    update
+} -returnCodes error -result {bad window path name ".f"}
+test busy-2.9 {tk busy hold (shortcut) non existing window} -body {
+    tk busy .f
+    update
+} -returnCodes {error} -result {bad window path name ".f"}
+test busy-2.10 {tk busy hold root window with cursor} -body {
+    tk busy hold . -cursor arrow
+    update
+} -cleanup {
+    tk busy forget .
+} -result {}
+test busy-2.11 {tk busy hold (shortcut) root window, cursor} -body {
+    tk busy . -cursor arrow
+    update
+} -cleanup {
+    tk busy forget .
+} -result {}
+test busy-2.12 {tk busy hold root window, invalid cursor} -body {
+    tk busy hold . -cursor nonExistingCursor
+    update
+} -constraints tempNotMac -returnCodes error -cleanup {
+    tk busy forget .
+} -result {bad cursor spec "nonExistingCursor"}
+test busy-2.13 {tk busy hold (shortcut) root window, invalid cursor} -body {
+    tk busy . -cursor nonExistingCursor
+    update
+} -constraints tempNotMac -returnCodes error -cleanup {
+    tk busy forget .
+} -result {bad cursor spec "nonExistingCursor"}
+test busy-2.14 {tk busy hold root window, invalid option} -body {
+    tk busy hold . -invalidOption 1
+    update
+} -constraints tempNotMac -returnCodes error -cleanup {
+    tk busy forget .
+} -result {unknown option "-invalidOption"}
+test busy-2.15 {tk busy hold (shortcut) root window, invalid option} -body {
+    tk busy . -invalidOption 1
+    update
+} -constraints tempNotMac -returnCodes error -cleanup {
+    tk busy forget .
+} -result {unknown option "-invalidOption"}
+
+test busy-3.1 {tk busy cget no window} -returnCodes error -body {
+    tk busy cget
+} -result {wrong # args: should be "tk busy cget window option"}
+test busy-3.2 {tk busy cget no option} -returnCodes error -body {
+    tk busy cget
+} -result {wrong # args: should be "tk busy cget window option"}
+test busy-3.3 {tk busy cget invalid window} -returnCodes error -body {
+    tk busy cget .f -cursor
+} -result {bad window path name ".f"}
+test busy-3.4 {tk busy cget non-busy window} -setup {
+    pack [frame .f]
+} -body {
+    tk busy cget .f -cursor
+} -cleanup {
+    destroy .f
+} -returnCodes error -result {can't find busy window ".f"}
+test busy-3.5 {tk busy cget invalid option} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy cget .f -invalidOption
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -returnCodes error -result {unknown option "-invalidOption"}
+test busy-3.6unix {tk busy cget unix} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy cget .f -cursor
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {watch} -constraints unix
+test busy-3.6win {tk busy cget win} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy cget .f -cursor
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {wait} -constraints win
+test busy-3.7 {tk busy cget unix} -setup {
+    pack [frame .f]
+    tk busy hold .f -cursor hand1
+    update
+} -body {
+    tk busy cget .f -cursor
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {hand1} -constraints tempNotMac
+
+test busy-4.1 {tk busy configure no window} -returnCodes error -body {
+    tk busy configure
+} -result {wrong # args: should be "tk busy configure window ?option? ?value ...?"}
+test busy-4.2 {tk busy configure invalid window} -body {
+    tk busy configure .f
+} -returnCodes error -result {bad window path name ".f"}
+test busy-4.3 {tk busy configure non-busy window} -setup {
+    pack [frame .f]
+} -body {
+    tk busy configure .f
+} -cleanup {
+    destroy .f
+} -returnCodes error -result {can't find busy window ".f"}
+test busy-4.4 {tk busy configure} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy configure .f
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {{-cursor cursor Cursor watch watch}}
+test busy-4.5 {tk busy configure} -setup {
+    pack [frame .f]
+    tk busy hold .f -cursor hand2
+    update
+} -body {
+    tk busy configure .f
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {{-cursor cursor Cursor watch hand2}} -constraints tempNotMac
+test busy-4.6 {tk busy configure invalid option} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy configure .f -invalidOption
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -returnCodes error -result {unknown option "-invalidOption"}
+test busy-4.7 {tk busy configure valid option} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy configure .f -cursor
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {-cursor cursor Cursor watch watch}
+test busy-4.8 {tk busy configure valid option} -setup {
+    pack [frame .f]
+    tk busy hold .f -cursor circle
+    update
+} -body {
+    tk busy configure .f -cursor
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {-cursor cursor Cursor watch circle} -constraints tempNotMac
+test busy-4.9 {tk busy configure valid option with value} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy configure .f -cursor pencil
+    tk busy cget .f -cursor
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {pencil} -constraints tempNotMac
+test busy-4.10 {tk busy configure valid option with invalid value} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy configure .f -cursor nonExistingCursor
+} -constraints tempNotMac -returnCodes error -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {bad cursor spec "nonExistingCursor"}
+
+test busy-5.1 {tk busy forget} -returnCodes error -body {
+    tk busy forget
+} -result {wrong # args: should be "tk busy forget window"}
+test busy-5.2 {tk busy forget non existing window} -body {
+    tk busy forget .f
+} -returnCodes error -result {bad window path name ".f"}
+test busy-5.3 {tk busy forget non busy window} -setup {
+    pack [frame .f]
+} -body {
+    tk busy forget .f
+} -cleanup {
+    destroy .f
+} -returnCodes error -result {can't find busy window ".f"}
+test busy-5.4 {tk busy forget window} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    set r [tk busy status .f]
+    tk busy forget .f
+    lappend r [tk busy status .f]
+} -cleanup {
+    destroy .f
+} -result {1 0}
+
+test busy-6.1 {tk busy status} -returnCodes error -body {
+    tk busy status
+} -result {wrong # args: should be "tk busy status window"}
+test busy-6.2 {tk busy status non existing window} -body {
+    tk busy status .f
+} -result {0}
+test busy-6.3 {tk busy status non busy window} -setup {
+    pack [frame .f]
+} -body {
+    tk busy status .f
+} -cleanup {
+    destroy .f
+} -result {0}
+test busy-6.4 {tk busy status busy window} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy status .f
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {1}
+test busy-6.5 {tk busy status forgotten busy window} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+    tk busy forget .f
+} -body {
+    tk busy status .f
+} -cleanup {
+    destroy .f
+} -result {0}
+
+test busy-7.1 {tk busy current no busy} -body {
+    tk busy current
+} -result {}
+test busy-7.2 {tk busy current 1 busy} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+} -body {
+    tk busy current
+} -cleanup {
+    tk busy forget .f
+    destroy .f
+} -result {.f}
+test busy-7.3 {tk busy current 2 busy} -setup {
+    pack [frame .f1]
+    pack [frame .f2]
+    tk busy hold .f1
+    tk busy hold .f2
+    update
+} -body {
+    lsort [tk busy current]
+} -cleanup {
+    tk busy forget .f1
+    tk busy forget .f2
+    destroy .f1 .f2
+} -result {.f1 .f2}
+test busy-7.4 {tk busy current 2 busy with matching filter} -setup {
+    pack [frame .f1]
+    pack [frame .f2]
+    tk busy hold .f1
+    tk busy hold .f2
+    update
+} -body {
+    lsort [tk busy current *2*]
+} -cleanup {
+    tk busy forget .f1
+    tk busy forget .f2
+    destroy .f1 .f2
+} -result {.f2}
+test busy-7.5 {tk busy current 2 busy with non matching filter} -setup {
+    pack [frame .f1]
+    pack [frame .f2]
+    tk busy hold .f1
+    tk busy hold .f2
+    update
+} -body {
+    lsort [tk busy current *3*]
+} -cleanup {
+    tk busy forget .f1
+    tk busy forget .f2
+    destroy .f1 .f2
+} -result {}
+test busy-7.6 {tk busy current 1 busy after forget} -setup {
+    pack [frame .f]
+    tk busy hold .f
+    update
+    tk busy forget .f
+} -body {
+    tk busy current
+} -cleanup {
+    destroy .f
+} -result {}
+test busy-7.7 {tk busy current 2 busy after forget} -setup {
+    pack [frame .f1]
+    pack [frame .f2]
+    tk busy hold .f1
+    tk busy hold .f2
+    update
+    tk busy forget .f1
+} -body {
+    lsort [tk busy current]
+} -cleanup {
+    tk busy forget .f2
+    destroy .f1 .f2
+} -result {.f2}
+test busy-7.8 {tk busy current 2 busy with matching filter after forget} -setup {
+    pack [frame .f1]
+    pack [frame .f2]
+    tk busy hold .f1
+    tk busy hold .f2
+    update
+    tk busy forget .f1
+} -body {
+    lsort [tk busy current *2*]
+} -cleanup {
+    tk busy forget .f2
+    destroy .f1 .f2
+} -result {.f2}
+test busy-7.9 {tk busy current 2 busy with non matching filter after forget} -setup {
+    pack [frame .f1]
+    pack [frame .f2]
+    tk busy hold .f1
+    tk busy hold .f2
+    update
+    tk busy forget .f1
+} -body {
+    lsort [tk busy current *3*]
+} -cleanup {
+    tk busy forget .f2
+    destroy .f1 .f2
+} -result {}
+
+::tcltest::cleanupTests
+return
diff --git a/tests/tk.test b/tests/tk.test
index 0527be0..3ebefe0 100644
--- a/tests/tk.test
+++ b/tests/tk.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 2002 ActiveState Corporation.
 #
-# RCS: @(#) $Id: tk.test,v 1.15 2008/08/16 23:52:34 aniap Exp $
+# RCS: @(#) $Id: tk.test,v 1.16 2008/10/18 14:22:22 dkf Exp $
 
 package require tcltest 2.2
 eval tcltest::configure $argv
@@ -17,8 +17,7 @@ test tk-1.1 {tk command: general} -body {
 } -returnCodes error -result {wrong # args: should be "tk option ?arg?"}
 test tk-1.2 {tk command: general} -body {
     tk xyz
-} -returnCodes error -result {bad option "xyz": must be appname, caret, scaling, useinputmethods, windowingsystem, or inactive}
-
+} -returnCodes error -result {bad option "xyz": must be appname, busy, caret, inactive, scaling, useinputmethods, or windowingsystem}
 
 # Value stored to restore default settings after 2.* tests
 set appname [tk appname]
@@ -37,7 +36,6 @@ test tk-2.4 {tk command: appname} -body {
 } -result [tk appname]
 tk appname $appname
 
-
 # Value stored to restore default settings after 3.* tests
 set scaling [tk scaling]
 test tk-3.1 {tk command: scaling} -body {
@@ -72,7 +70,7 @@ test tk-3.8 {tk command: scaling: negative} -body {
 test tk-3.9 {tk command: scaling: too big} -body {
     tk scaling 1000000
     expr {[tk scaling] < 10000}
-} -result {1}    
+} -result {1}
 test tk-3.10 {tk command: scaling: widthmm} -body {
     tk scaling 1.25
     expr {int((25.4*[winfo screenwidth .])/(72*1.25) + 0.5) \
@@ -85,7 +83,6 @@ test tk-3.11 {tk command: scaling: heightmm} -body {
 } -result {0}
 tk scaling $scaling
 
-
 # Value stored to restore default settings after 4.* tests
 set useim [tk useinputmethods]
 test tk-4.1 {tk command: useinputmethods} -body {
@@ -109,24 +106,22 @@ test tk-4.5 {tk command: useinputmethods: set new} -body {
     tk useinputmethods -displayof . xyz
 } -returnCodes error -result {expected boolean value but got "xyz"}
 test tk-4.6 {tk command: useinputmethods: set new} -body {
-    # This isn't really a test, but more of a check...
-    # The answer is what was given, because we may be on a Unix
-    # system that doesn't have the XIM stuff
+    # This isn't really a test, but more of a check... The answer is what was
+    # given, because we may be on a Unix system that doesn't have the XIM
+    # stuff
     if {[tk useinputmethods 1] == 0} {
-	    puts "this wish doesn't have XIM (X Input Methods) support"
+	puts "this wish doesn't have XIM (X Input Methods) support"
     }
-
     return $useim
 } -result $useim
 test tk-4.7 {tk command: useinputmethods: set new} -constraints win -body {
-    # Mac and Windows don't have X Input Methods, so this should
-    # always return 0
+    # Mac and Windows don't have X Input Methods, so this should always return
+    # 0
     tk useinputmethods 1
 } -cleanup {
     tk useinputmethods $useim
 } -result 0
 
-
 test tk-5.1 {tk caret} -body {
     tk caret
 } -returnCodes error -result {wrong # args: should be "tk caret window ?-x x? ?-y y? ?-height height?"}
@@ -146,7 +141,6 @@ test tk-5.6 {tk caret} -body {
     tk caret . -x 20 -y 25 -h 30; tk caret . -hei
 } -result {30}
 
-
 # tk inactive
 test tk-6.1 {tk inactive} -body {
     string is integer [tk inactive]
@@ -168,7 +162,6 @@ test tk-6.5 {tk inactive} -body {
     expr {$i == -1 || ( $i > 90 && $i < 200 )}
 } -result 1
 
-
 test tk-7.1 {tk inactive in a safe interpreter} -body {
 # tk inactive in safe interpreters
     safe::interpCreate foo
@@ -186,6 +179,7 @@ test tk-7.2 {tk inactive reset in a safe interpreter} -body {
     ::safe::interpDelete foo
 } -returnCodes 1 -result {resetting the user inactivity timer is not allowed in a safe interpreter}
 
+# tests of [tk busy] in busy.test
 
 # cleanup
 cleanupTests
diff --git a/unix/Makefile.in b/unix/Makefile.in
index da7d245..a9f2268 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.145 2008/08/25 11:44:03 dkf Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.146 2008/10/18 14:22:22 dkf Exp $
 
 # Current Tk version;  used in various names.
 
@@ -358,7 +358,8 @@ TEXT_OBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \
 # 
 FONT_OBJS = @UNIX_FONT_OBJS@
 
-GENERIC_OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkClipboard.o \
+GENERIC_OBJS = tk3d.o tkArgv.o tkAtom.o tkBind.o tkBitmap.o tkBusy.o \
+	tkClipboard.o \
 	tkCmds.o tkColor.o tkConfig.o tkConsole.o tkCursor.o tkError.o \
 	tkEvent.o tkFocus.o tkFont.o tkGet.o tkGC.o tkGeometry.o tkGrab.o \
 	tkGrid.o tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \
@@ -412,7 +413,8 @@ TTK_DECLS = \
 GENERIC_SRCS = \
 	$(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \
 	$(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c	\
-	$(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkClipboard.c \
+	$(GENERIC_DIR)/tkBitmap.c $(GENERIC_DIR)/tkBusy.c \
+	$(GENERIC_DIR)/tkClipboard.c \
 	$(GENERIC_DIR)/tkCmds.c $(GENERIC_DIR)/tkColor.c \
 	$(GENERIC_DIR)/tkConfig.c $(GENERIC_DIR)/tkCursor.c \
 	$(GENERIC_DIR)/tkError.c $(GENERIC_DIR)/tkEvent.c \
@@ -922,6 +924,9 @@ tkBind.o: $(GENERIC_DIR)/tkBind.c
 tkBitmap.o: $(GENERIC_DIR)/tkBitmap.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBitmap.c
 
+tkBusy.o: $(GENERIC_DIR)/tkBusy.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBusy.c
+
 tkClipboard.o: $(GENERIC_DIR)/tkClipboard.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkClipboard.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index 4d94162..627b0fd 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,7 +4,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.80 2008/08/25 11:44:04 dkf Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.81 2008/10/18 14:22:22 dkf Exp $
 
 TCLVERSION		= @TCL_VERSION@
 TCLPATCHL		= @TCL_PATCH_LEVEL@
@@ -282,6 +282,7 @@ TK_OBJS = \
 	tkAtom.$(OBJEXT) \
 	tkBind.$(OBJEXT) \
 	tkBitmap.$(OBJEXT) \
+	tkBusy.$(OBJEXT) \
 	tkButton.$(OBJEXT) \
 	tkCanvArc.$(OBJEXT) \
 	tkCanvBmap.$(OBJEXT) \
diff --git a/win/makefile.bc b/win/makefile.bc
index cf490f2..afc722d 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -13,7 +13,7 @@
 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Ajuba Solutions.
 #
-# RCS: @(#) $Id: makefile.bc,v 1.16 2008/08/25 11:44:04 dkf Exp $
+# RCS: @(#) $Id: makefile.bc,v 1.17 2008/10/18 14:22:22 dkf Exp $
 
 # Does not depend on the presence of any environment variables in
 # order to compile tcl; all needed information is derived from
@@ -163,6 +163,7 @@ TKOBJS = \
 	$(TMPDIR)\tkAtom.obj \
 	$(TMPDIR)\tkBind.obj \
 	$(TMPDIR)\tkBitmap.obj \
+	$(TMPDIR)\tkBusy.obj \
 	$(TMPDIR)\tkButton.obj \
 	$(TMPDIR)\tkCanvArc.obj \
 	$(TMPDIR)\tkCanvBmap.obj \
diff --git a/win/makefile.vc b/win/makefile.vc
index 32d353f..877b43c 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -13,7 +13,7 @@
 # Copyright (c) 2003-2008 Pat Thoyts.
 #
 #------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.124 2008/08/25 11:44:04 dkf Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.125 2008/10/18 14:22:22 dkf Exp $
 #------------------------------------------------------------------------------
 
 # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -290,6 +290,7 @@ TKOBJS = \
 	$(TMP_DIR)\tkAtom.obj \
 	$(TMP_DIR)\tkBind.obj \
 	$(TMP_DIR)\tkBitmap.obj \
+	$(TMP_DIR)\tkBusy.obj \
 	$(TMP_DIR)\tkButton.obj \
 	$(TMP_DIR)\tkCanvArc.obj \
 	$(TMP_DIR)\tkCanvBmap.obj \