diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2008-10-18 14:22:20 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2008-10-18 14:22:20 (GMT) |
commit | 678e5a8acf06358ad722dff065fb80fcd06e7d15 (patch) | |
tree | 5859725f08cf8f5c220d3fd04da0f8fe6f0d3103 | |
parent | ce82534d5c94d852ec68426e7cfd45c29f72e5c9 (diff) | |
download | tk-678e5a8acf06358ad722dff065fb80fcd06e7d15.zip tk-678e5a8acf06358ad722dff065fb80fcd06e7d15.tar.gz tk-678e5a8acf06358ad722dff065fb80fcd06e7d15.tar.bz2 |
Implementation of the [tk busy] command on non-OSX.
Adapted from [Patch 1997907]
-rw-r--r-- | ChangeLog | 35 | ||||
-rw-r--r-- | doc/busy.n | 268 | ||||
-rw-r--r-- | doc/grab.n | 4 | ||||
-rw-r--r-- | doc/tk.n | 13 | ||||
-rw-r--r-- | generic/tkBusy.c | 1222 | ||||
-rw-r--r-- | generic/tkCmds.c | 16 | ||||
-rw-r--r-- | generic/tkInt.h | 6 | ||||
-rw-r--r-- | generic/tkWindow.c | 4 | ||||
-rw-r--r-- | tests/busy.test | 424 | ||||
-rw-r--r-- | tests/tk.test | 26 | ||||
-rw-r--r-- | unix/Makefile.in | 11 | ||||
-rw-r--r-- | win/Makefile.in | 3 | ||||
-rw-r--r-- | win/makefile.bc | 3 | ||||
-rw-r--r-- | win/makefile.vc | 3 |
14 files changed, 1988 insertions, 50 deletions
@@ -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: @@ -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: @@ -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, + ¬Used); + 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 \ |