From e362ccb25a38008c0f631717e1cc8c73b7987b84 Mon Sep 17 00:00:00 2001 From: ericm Date: Fri, 4 Aug 2000 00:46:32 +0000 Subject: * generic/tkWindow.c: Updated "grab" command entry to use Tcl_Obj'ified command. * generic/tkInt.h: Replaced Tk_GrabCmd prototype with Tk_GrabObjCmd prototype. * tests/grab.test: Initial suite of tests for [grab] command. * generic/tkGrab.c (Tk_GrabObjCmd): Tcl_Obj'ified [grab] command. * generic/tkCmds.c: Fixed casting problem in Tk_BindtagsObjCmd. --- ChangeLog | 19 +++- generic/tkCmds.c | 4 +- generic/tkGrab.c | 259 ++++++++++++++++++++++++++++++++--------------------- generic/tkInt.h | 22 +++-- generic/tkWindow.c | 4 +- tests/grab.test | 179 ++++++++++++++++++++++++++++++++++++ 6 files changed, 369 insertions(+), 118 deletions(-) create mode 100644 tests/grab.test diff --git a/ChangeLog b/ChangeLog index 609dfb5..3a9e318 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,21 @@ 2000-08-03 Eric Melski - * generic/tkInt.h: Removed Tk_AfterCmd function prototype; the - function does not exist (since 7.4p3). + * generic/tkWindow.c: Updated "grab" command entry to use + Tcl_Obj'ified command. + + * generic/tkInt.h: Replaced Tk_GrabCmd prototype with + Tk_GrabObjCmd prototype. + + * tests/grab.test: Initial suite of tests for [grab] command. - * generic/tk.h: Removed Tk_AfterCmd => Tcl_AfterCmd #define; - nothing in the core uses it, and Tcl_AfterCmd doesn't exist + * generic/tkGrab.c (Tk_GrabObjCmd): Tcl_Obj'ified [grab] command. + + * generic/tkInt.h: Removed Tk_AfterCmd function prototype; the + function does not exist (since 7.4p3). Cleaned up some line + wrapping. + + * generic/tk.h: Removed "#define Tk_AfterCmd Tcl_AfterCmd"; + nothing in the core uses Tk_AfterCmd, and Tcl_AfterCmd doesn't exist anymore anyway. * generic/tkInt.h: Replace Tk_BindCmd prototype with diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 726eea6..4d3f5ae 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.17 2000/08/03 21:02:19 ericm Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.18 2000/08/04 00:46:32 ericm Exp $ */ #include "tkPort.h" @@ -349,7 +349,7 @@ Tk_BindtagsObjCmd(clientData, interp, objc, objv) } else { for (i = 0; i < winPtr->numTags; i++) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(winPtr->tagPtr[i], -1)); + Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1)); } } Tcl_SetObjResult(interp, listPtr); diff --git a/generic/tkGrab.c b/generic/tkGrab.c index 16b8b2a..84fad8c 100644 --- a/generic/tkGrab.c +++ b/generic/tkGrab.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkGrab.c,v 1.4 1999/04/16 01:51:14 stanton Exp $ + * RCS: @(#) $Id: tkGrab.c,v 1.5 2000/08/04 00:46:33 ericm Exp $ */ #include "tkPort.h" @@ -173,7 +173,7 @@ static void ReleaseButtonGrab _ANSI_ARGS_((TkDisplay *dispPtr)); /* *---------------------------------------------------------------------- * - * Tk_GrabCmd -- + * Tk_GrabObjCmd -- * * This procedure is invoked to process the "grab" Tcl command. * See the user documentation for details on what it does. @@ -189,137 +189,192 @@ static void ReleaseButtonGrab _ANSI_ARGS_((TkDisplay *dispPtr)); /* ARGSUSED */ int -Tk_GrabCmd(clientData, interp, argc, argv) +Tk_GrabObjCmd(clientData, interp, objc, objv) ClientData clientData; /* Main window associated with * interpreter. */ Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - int globalGrab, c; + int globalGrab; Tk_Window tkwin; TkDisplay *dispPtr; - size_t length; - - if (argc < 2) { - badArgs: + char *arg; + int index; + size_t len; + static char *optionStrings[] = { "current", "release", + "set", "status", (char *) NULL }; + + static char *flagStrings[] = { "-global", (char *) NULL }; + + enum options { GRABCMD_CURRENT, GRABCMD_RELEASE, + GRABCMD_SET, GRABCMD_STATUS }; + + if (objc < 2) { + /* + * Can't use Tcl_WrongNumArgs here because we want the message to + * read: + * wrong # args: should be "cmd ?-global window" or "cmd option + * ?arg arg ...?" + * We can fake it with Tcl_WrongNumArgs if we assume the command name + * is "grab", but if it has been aliased, the message will be + * incorrect. + */ + Tcl_ResetResult(interp); Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " ?-global? window\" or \"", argv[0], - " option ?arg arg ...?\"", (char *) NULL); + Tcl_GetString(objv[0]), " ?-global? window\" or \"", + Tcl_GetString(objv[0]), " option ?arg arg ...?\"", + (char *) NULL); return TCL_ERROR; } - c = argv[1][0]; - length = strlen(argv[1]); - if (c == '.') { - if (argc != 2) { - goto badArgs; + + /* + * First check for a window name or "-global" as the first argument. + */ + + arg = Tcl_GetStringFromObj(objv[1], &len); + if (arg[0] == '.') { + /* [grab window] */ + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); + return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, argv[1], (Tk_Window) clientData); + tkwin = Tk_NameToWindow(interp, arg, (Tk_Window) clientData); if (tkwin == NULL) { return TCL_ERROR; } return Tk_Grab(interp, tkwin, 0); - } else if ((c == '-') && (strncmp(argv[1], "-global", length) == 0) - && (length >= 2)) { - if (argc != 3) { - goto badArgs; + } else if (arg[0] == '-' && len > 1) { + if (Tcl_GetIndexFromObj(interp, objv[1], flagStrings, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData); - if (tkwin == NULL) { + + /* [grab -global window] */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "?-global? window"); return TCL_ERROR; } - return Tk_Grab(interp, tkwin, 1); - } else if ((c == 'c') && (strncmp(argv[1], "current", length) == 0)) { - if (argc > 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " current ?window?\"", (char *) NULL); + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), + (Tk_Window) clientData); + if (tkwin == NULL) { return TCL_ERROR; } - if (argc == 3) { - tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData); - if (tkwin == NULL) { + return Tk_Grab(interp, tkwin, 1); + } + + /* + * First argument is not a window name and not "-global", find out + * which option it is. + */ + + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case GRABCMD_CURRENT: { + /* [grab current ?window?] */ + if (objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "current ?window?"); return TCL_ERROR; } - dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName, - TCL_STATIC); - } - } else { - for (dispPtr = TkGetDisplayList(); dispPtr != NULL; - dispPtr = dispPtr->nextPtr) { + if (objc == 3) { + tkwin = Tk_NameToWindow(interp, + Tcl_GetString(objv[2]), (Tk_Window) clientData); + if (tkwin == NULL) { + return TCL_ERROR; + } + dispPtr = ((TkWindow *) tkwin)->dispPtr; if (dispPtr->eventualGrabWinPtr != NULL) { - Tcl_AppendElement(interp, - dispPtr->eventualGrabWinPtr->pathName); + Tcl_SetResult(interp, + dispPtr->eventualGrabWinPtr->pathName, TCL_STATIC); + } + } else { + for (dispPtr = TkGetDisplayList(); dispPtr != NULL; + dispPtr = dispPtr->nextPtr) { + if (dispPtr->eventualGrabWinPtr != NULL) { + Tcl_AppendElement(interp, + dispPtr->eventualGrabWinPtr->pathName); + } } } + return TCL_OK; } - return TCL_OK; - } else if ((c == 'r') && (strncmp(argv[1], "release", length) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " release window\"", (char *) NULL); - return TCL_ERROR; - } - tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData); - if (tkwin == NULL) { - Tcl_ResetResult(interp); - } else { - Tk_Ungrab(tkwin); - } - } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0) - && (length >= 2)) { - if ((argc != 3) && (argc != 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " set ?-global? window\"", (char *) NULL); - return TCL_ERROR; - } - if (argc == 3) { - globalGrab = 0; - tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData); - } else { - globalGrab = 1; - length = strlen(argv[2]); - if ((strncmp(argv[2], "-global", length) != 0) || (length < 2)) { - Tcl_AppendResult(interp, "bad argument \"", argv[2], - "\": must be \"", argv[0], " set ?-global? window\"", - (char *) NULL); + + case GRABCMD_RELEASE: { + /* [grab release window] */ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "release window"); return TCL_ERROR; } - tkwin = Tk_NameToWindow(interp, argv[3], (Tk_Window) clientData); - } - if (tkwin == NULL) { - return TCL_ERROR; - } - return Tk_Grab(interp, tkwin, globalGrab); - } else if ((c == 's') && (strncmp(argv[1], "status", length) == 0) - && (length >= 2)) { - TkWindow *winPtr; - - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " status window\"", (char *) NULL); - return TCL_ERROR; + tkwin = Tk_NameToWindow(interp, + Tcl_GetString(objv[2]), (Tk_Window) clientData); + if (tkwin == NULL) { + Tcl_ResetResult(interp); + } else { + Tk_Ungrab(tkwin); + } + break; } - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], - (Tk_Window) clientData); - if (winPtr == NULL) { - return TCL_ERROR; + + case GRABCMD_SET: { + /* [grab set ?-global? window] */ + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 1, objv, "set ?-global? window"); + return TCL_ERROR; + } + if (objc == 3) { + globalGrab = 0; + tkwin = Tk_NameToWindow(interp, + Tcl_GetString(objv[2]), (Tk_Window) clientData); + } else { + globalGrab = 1; + /* + * We could just test the argument by hand instead of using + * Tcl_GetIndexFromObj; the benefit of using the function is + * that it sets up the error message for us, so we are + * certain to be consistant with the rest of Tcl. + */ + if (Tcl_GetIndexFromObj(interp, objv[2], flagStrings, "option", + 0, &index) != TCL_OK) { + return TCL_ERROR; + } + tkwin = Tk_NameToWindow(interp, + Tcl_GetString(objv[3]), (Tk_Window) clientData); + } + if (tkwin == NULL) { + return TCL_ERROR; + } + return Tk_Grab(interp, tkwin, globalGrab); } - dispPtr = winPtr->dispPtr; - if (dispPtr->eventualGrabWinPtr != winPtr) { - Tcl_SetResult(interp, "none", TCL_STATIC); - } else if (dispPtr->grabFlags & GRAB_GLOBAL) { - Tcl_SetResult(interp, "global", TCL_STATIC); - } else { - Tcl_SetResult(interp, "local", TCL_STATIC); + + case GRABCMD_STATUS: { + /* [grab status window] */ + TkWindow *winPtr; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "status window"); + return TCL_ERROR; + } + winPtr = (TkWindow *) Tk_NameToWindow(interp, + Tcl_GetString(objv[2]), (Tk_Window) clientData); + if (winPtr == NULL) { + return TCL_ERROR; + } + dispPtr = winPtr->dispPtr; + if (dispPtr->eventualGrabWinPtr != winPtr) { + Tcl_SetResult(interp, "none", TCL_STATIC); + } else if (dispPtr->grabFlags & GRAB_GLOBAL) { + Tcl_SetResult(interp, "global", TCL_STATIC); + } else { + Tcl_SetResult(interp, "local", TCL_STATIC); + } + break; } - } else { - Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1], - "\": must be current, release, set, or status", - (char *) NULL); - return TCL_ERROR; } + return TCL_OK; } diff --git a/generic/tkInt.h b/generic/tkInt.h index 8b67693..5482f9d 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.30 2000/08/03 21:14:30 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.31 2000/08/04 00:46:33 ericm Exp $ */ #ifndef _TKINT @@ -900,8 +900,10 @@ EXTERN int Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tk_CanvasObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_CheckbuttonObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int argc, + Tcl_Obj *CONST objv[])); +EXTERN int Tk_CheckbuttonObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tk_ClipboardObjCmd _ANSI_ARGS_(( @@ -936,14 +938,17 @@ EXTERN int Tk_FocusObjCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_GetOpenFileObjCmd _ANSI_ARGS_((ClientData clientData, +EXTERN int Tk_GetOpenFileObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_GetSaveFileObjCmd _ANSI_ARGS_((ClientData clientData, +EXTERN int Tk_GetSaveFileObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_GrabCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_GrabObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_GridCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_ImageObjCmd _ANSI_ARGS_((ClientData clientData, @@ -974,7 +979,8 @@ EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_((ClientData clientData, +EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_(( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tk_RaiseObjCmd _ANSI_ARGS_((ClientData clientData, diff --git a/generic/tkWindow.c b/generic/tkWindow.c index f03f946..8b41f05 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkWindow.c,v 1.22 2000/08/03 21:02:20 ericm Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.23 2000/08/04 00:46:33 ericm Exp $ */ #include "tkPort.h" @@ -105,7 +105,7 @@ static TkCmd commands[] = { {"event", NULL, Tk_EventObjCmd, 1, 1}, {"focus", NULL, Tk_FocusObjCmd, 1, 1}, {"font", NULL, Tk_FontObjCmd, 1, 1}, - {"grab", Tk_GrabCmd, NULL, 0, 1}, + {"grab", NULL, Tk_GrabObjCmd, 0, 1}, {"grid", Tk_GridCmd, NULL, 1, 1}, {"image", NULL, Tk_ImageObjCmd, 1, 1}, {"lower", NULL, Tk_LowerObjCmd, 1, 1}, diff --git a/tests/grab.test b/tests/grab.test new file mode 100644 index 0000000..b1fd106 --- /dev/null +++ b/tests/grab.test @@ -0,0 +1,179 @@ +# Tests for the grab 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 Ajuba Solutions. +# All rights reserved. +# +# RCS: @(#) $Id: grab.test,v 1.1 2000/08/04 00:46:33 ericm Exp $ + +if {[lsearch [namespace children] ::tcltest] == -1} { + source [file join [pwd] [file dirname [info script]] defs.tcl] +} + +# 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 grab-1.1 {Tk_GrabObjCmd} { + list [catch {grab} msg] $msg +} [list 1 "wrong # args: should be \"grab ?-global? window\" or \"grab option ?arg arg ...?\""] +test grab-1.2 {Tk_GrabObjCmd} { + rename grab grabTest1.2 + set res [list [catch {grabTest1.2} msg] $msg] + rename grabTest1.2 grab + set res +} [list 1 "wrong # args: should be \"grabTest1.2 ?-global? window\" or \"grabTest1.2 option ?arg arg ...?\""] + +test grab-1.3 {Tk_GrabObjCmd, "grab ?-global? window"} { + list [catch {grab .foo bar baz} msg] $msg +} [list 1 "wrong # args: should be \"grab ?-global? window\""] +test grab-1.4 {Tk_GrabObjCmd, "grab ?-global? window"} { + catch {destroy .foo} + list [catch {grab .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] +test grab-1.5 {Tk_GrabObjCmd, "grab ?-global? window"} { + list [catch {grab -foo bar} msg] $msg +} [list 1 "bad option \"-foo\": must be -global"] +test grab-1.6 {Tk_GrabObjCmd, "grab ?-global? window"} { + catch {destroy .foo} + list [catch {grab -global .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] + +test grab-1.7 {Tk_GrabObjCmd} { + list [catch {grab foo} msg] $msg +} [list 1 "bad option \"foo\": must be current, release, set, or status"] + +test grab-1.8 {Tk_GrabObjCmd, "grab current ?window?"} { + list [catch {grab current foo bar} msg] $msg +} [list 1 "wrong # args: should be \"grab current ?window?\""] +test grab-1.9 {Tk_GrabObjCmd, "grab current ?window?"} { + catch {destroy .foo} + list [catch {grab current .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] + +test grab-1.10 {Tk_GrabObjCmd, "grab release window"} { + list [catch {grab release} msg] $msg +} [list 1 "wrong # args: should be \"grab release window\""] +test grab-1.11 {Tk_GrabObjCmd, "grab release window"} { + catch {destroy .foo} + list [catch {grab release .foo} msg] $msg +} [list 0 ""] +test grab-1.12 {Tk_GrabObjCmd, "grab release window"} { + list [catch {grab release foo} msg] $msg +} [list 0 ""] + +test grab-1.13 {Tk_GrabObjCmd, "grab set ?-global? window"} { + list [catch {grab set} msg] $msg +} [list 1 "wrong # args: should be \"grab set ?-global? window\""] +test grab-1.14 {Tk_GrabObjCmd, "grab set ?-global? window"} { + list [catch {grab set foo bar baz} msg] $msg +} [list 1 "wrong # args: should be \"grab set ?-global? window\""] +test grab-1.15 {Tk_GrabObjCmd, "grab set ?-global? window"} { + catch {destroy .foo} + list [catch {grab set .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] +test grab-1.16 {Tk_GrabObjCmd, "grab set ?-global? window"} { + list [catch {grab set -foo bar} msg] $msg +} [list 1 "bad option \"-foo\": must be -global"] +test grab-1.17 {Tk_GrabObjCmd, "grab set ?-global? window"} { + catch {destroy .foo} + list [catch {grab set -global .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] + +test grab-1.18 {Tk_GrabObjCmd, "grab status window"} { + list [catch {grab status} msg] $msg +} [list 1 "wrong # args: should be \"grab status window\""] +test grab-1.19 {Tk_GrabObjCmd, "grab status window"} { + list [catch {grab status foo bar} msg] $msg +} [list 1 "wrong # args: should be \"grab status window\""] +test grab-1.20 {Tk_GrabObjCmd, "grab status window"} { + catch {destroy .foo} + list [catch {grab status .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] + +test grab-2.1 {Tk_GrabObjCmd, grab status gives correct status} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + set result [grab status .] + grab release . + set result +} "none" +test grab-2.2 {Tk_GrabObjCmd, grab status gives correct status} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab . + set result [grab status .] + grab release . + set result +} "local" +test grab-2.3 {Tk_GrabObjCmd, grab status gives correct status} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab -global . + set result [grab status .] + grab release . + set result +} "global" + +test grab-3.1 {Tk_GrabObjCmd, grab current gives correct information} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + set curr +} "" +test grab-3.2 {Tk_GrabObjCmd, grab current gives correct information} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab . + set curr [grab current] + grab release . + set curr +} "." + +test grab-4.1 {Tk_GrabObjCmd, grab release releases grab} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab . + set result [grab status .] + grab release . + lappend result [grab status .] + grab -global . + lappend result [grab status .] + grab release . + lappend result [grab status .] +} [list "local" "none" "global" "none"] + +test grab-5.1 {Tk_GrabObjCmd, grab set} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab set . + set result [list [grab current .] [grab status .]] + grab release . + set result +} [list "." "local"] +test grab-5.2 {Tk_GrabObjCmd, grab set} { + set curr [grab current .] + if { [string length $curr] > 0 } { + grab release $curr + } + grab set -global . + set result [list [grab current .] [grab status .]] + grab release . + set result +} [list "." "global"] -- cgit v0.12