From 0cdb0677540aa8995226f52ec82b9037920b6d29 Mon Sep 17 00:00:00 2001 From: ericm Date: Thu, 3 Aug 2000 20:36:15 +0000 Subject: * tests/bind.test: Tweaked expected error messages for [bindtags] to comply with updated error messages. * generic/tkMenu.c (CloneMenu): Replaced calls to Tk_BindtagsCmd with equivalent calls to Tk_BindtagsObjCmd. * generic/tkInt.h: Replace Tk_BindtagsCmd prototype with Tk_BindtagsObjCmd prototype. * generic/tkWindow.c: Updated "bindtags" command entry to use Tcl_Obj'ified command. * generic/tkCmds.c (Tk_BindtagsObjCmd): Tcl_Obj'ified [bindtags] command. --- ChangeLog | 17 +++++++++++++ generic/tkCmds.c | 71 ++++++++++++++++++++++++++++++------------------------ generic/tkInt.h | 7 +++--- generic/tkMenu.c | 22 ++++++++++------- generic/tkWindow.c | 4 +-- tests/bind.test | 6 ++--- 6 files changed, 79 insertions(+), 48 deletions(-) diff --git a/ChangeLog b/ChangeLog index fb3cf21..f79d34f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2000-08-03 Eric Melski + + * tests/bind.test: Tweaked expected error messages for [bindtags] + to comply with updated error messages. + + * generic/tkMenu.c (CloneMenu): Replaced calls to Tk_BindtagsCmd + with equivalent calls to Tk_BindtagsObjCmd. + + * generic/tkInt.h: Replace Tk_BindtagsCmd prototype with + Tk_BindtagsObjCmd prototype. + + * generic/tkWindow.c: Updated "bindtags" command entry to use + Tcl_Obj'ified command. + + * generic/tkCmds.c (Tk_BindtagsObjCmd): Tcl_Obj'ified [bindtags] + command. + 2000-08-02 Eric Melski * generic/tkCmds.c (Tk_TkwaitObjCmd): Tcl_Obj'ified [tkwait] command. diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 2718d03..d3ac006 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.15 2000/08/02 23:08:20 ericm Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.16 2000/08/03 20:36:15 ericm Exp $ */ #include "tkPort.h" @@ -264,7 +264,7 @@ TkBindEventProc(winPtr, eventPtr) /* *---------------------------------------------------------------------- * - * Tk_BindtagsCmd -- + * Tk_BindtagsObjCmd -- * * This procedure is invoked to process the "bindtags" Tcl command. * See the user documentation for details on what it does. @@ -279,60 +279,70 @@ TkBindEventProc(winPtr, eventPtr) */ int -Tk_BindtagsCmd(clientData, interp, argc, argv) +Tk_BindtagsObjCmd(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. */ { Tk_Window tkwin = (Tk_Window) clientData; TkWindow *winPtr, *winPtr2; - int i, tagArgc; - char *p, **tagArgv; - - if ((argc < 2) || (argc > 3)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " window ?tags?\"", (char *) NULL); + int i, length; + char *p; + Tcl_Obj *listPtr, **tags; + + if ((objc < 2) || (objc > 3)) { + Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?"); return TCL_ERROR; } - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); + winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]), + tkwin); if (winPtr == NULL) { return TCL_ERROR; } - if (argc == 2) { + if (objc == 2) { + listPtr = Tcl_NewObj(); + Tcl_IncrRefCount(listPtr); if (winPtr->numTags == 0) { - Tcl_AppendElement(interp, winPtr->pathName); - Tcl_AppendElement(interp, winPtr->classUid); - for (winPtr2 = winPtr; - (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL); - winPtr2 = winPtr2->parentPtr) { - /* Empty loop body. */ + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(winPtr->pathName, -1)); + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(winPtr->classUid, -1)); + winPtr2 = winPtr; + while ((winPtr2 != NULL) && !(Tk_IsTopLevel(winPtr2))) { + winPtr2 = winPtr2->parentPtr; } if ((winPtr != winPtr2) && (winPtr2 != NULL)) { - Tcl_AppendElement(interp, winPtr2->pathName); + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(winPtr2->pathName, -1)); } - Tcl_AppendElement(interp, "all"); + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj("all", -1)); } else { for (i = 0; i < winPtr->numTags; i++) { - Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]); + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(winPtr->tagPtr[i], -1)); } } + Tcl_SetObjResult(interp, listPtr); + Tcl_DecrRefCount(listPtr); return TCL_OK; } if (winPtr->tagPtr != NULL) { TkFreeBindingTags(winPtr); } - if (argv[2][0] == 0) { - return TCL_OK; - } - if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[2], &length, &tags) != TCL_OK) { return TCL_ERROR; } - winPtr->numTags = tagArgc; + if (length == 0) { + return TCL_OK; + } + + winPtr->numTags = length; winPtr->tagPtr = (ClientData *) ckalloc((unsigned) - (tagArgc * sizeof(ClientData))); - for (i = 0; i < tagArgc; i++) { - p = tagArgv[i]; + (length * sizeof(ClientData))); + for (i = 0; i < length; i++) { + p = Tcl_GetString(tags[i]); if (p[0] == '.') { char *copy; @@ -350,7 +360,6 @@ Tk_BindtagsCmd(clientData, interp, argc, argv) winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p); } } - ckfree((char *) tagArgv); return TCL_OK; } diff --git a/generic/tkInt.h b/generic/tkInt.h index d2e7d95..c8be3f6 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.27 2000/08/02 23:08:20 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.28 2000/08/03 20:36:15 ericm Exp $ */ #ifndef _TKINT @@ -894,8 +894,9 @@ EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Obj *CONST objv[])); EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int argc, char **argv)); -EXTERN int Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_BindtagsObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); diff --git a/generic/tkMenu.c b/generic/tkMenu.c index 89525ed..0aac47e 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.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: tkMenu.c,v 1.7 2000/06/27 17:15:58 ericm Exp $ + * RCS: @(#) $Id: tkMenu.c,v 1.8 2000/08/03 20:36:16 ericm Exp $ */ /* @@ -2665,7 +2665,6 @@ CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr) && (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) { TkMenu *newMenuPtr = menuRefPtr->menuPtr; Tcl_Obj *newObjv[3]; - char *newArgv[3]; int i, numElements; /* @@ -2692,15 +2691,18 @@ CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr) * clone structure. */ - newArgv[0] = "bindtags"; - newArgv[1] = Tk_PathName(newMenuPtr->tkwin); - if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, - newMenuPtr->interp, 2, newArgv) == TCL_OK) { + newObjv[0] = Tcl_NewStringObj("bindtags", -1); + newObjv[1] = Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin), -1); + Tcl_IncrRefCount(newObjv[0]); + Tcl_IncrRefCount(newObjv[1]); + if (Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin, + newMenuPtr->interp, 2, newObjv) == TCL_OK) { char *windowName; Tcl_Obj *bindingsPtr = Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp)); Tcl_Obj *elementPtr; + Tcl_IncrRefCount(bindingsPtr); Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements); for (i = 0; i < numElements; i++) { Tcl_ListObjIndex(newMenuPtr->interp, bindingsPtr, i, @@ -2713,14 +2715,16 @@ CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr) Tcl_IncrRefCount(newElementPtr); Tcl_ListObjReplace(menuPtr->interp, bindingsPtr, i + 1, 0, 1, &newElementPtr); - newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL); - Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin, - menuPtr->interp, 3, newArgv); + newObjv[2] = bindingsPtr; + Tk_BindtagsObjCmd((ClientData)newMenuPtr->tkwin, + menuPtr->interp, 3, newObjv); break; } } Tcl_DecrRefCount(bindingsPtr); } + Tcl_DecrRefCount(newObjv[0]); + Tcl_DecrRefCount(newObjv[1]); Tcl_ResetResult(menuPtr->interp); /* diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 7578c0f..7712570 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.20 2000/08/02 23:08:20 ericm Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.21 2000/08/03 20:36:16 ericm Exp $ */ #include "tkPort.h" @@ -99,7 +99,7 @@ static TkCmd commands[] = { {"bell", NULL, Tk_BellObjCmd, 0, 1}, {"bind", Tk_BindCmd, NULL, 1, 1}, - {"bindtags", Tk_BindtagsCmd, NULL, 1, 1}, + {"bindtags", NULL, Tk_BindtagsObjCmd, 1, 1}, {"clipboard", NULL, Tk_ClipboardObjCmd, 0, 1}, {"destroy", NULL, Tk_DestroyObjCmd, 1, 1}, {"event", NULL, Tk_EventObjCmd, 1, 1}, diff --git a/tests/bind.test b/tests/bind.test index 25ac2c3..06d3078 100644 --- a/tests/bind.test +++ b/tests/bind.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: bind.test,v 1.7 1999/12/14 06:53:11 hobbs Exp $ +# RCS: @(#) $Id: bind.test,v 1.8 2000/08/03 20:36:17 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -84,10 +84,10 @@ test bind-1.10 {bind command} { test bind-2.1 {bindtags command} { list [catch {bindtags} msg] $msg -} {1 {wrong # args: should be "bindtags window ?tags?"}} +} {1 {wrong # args: should be "bindtags window ?taglist?"}} test bind-2.2 {bindtags command} { list [catch {bindtags a b c} msg] $msg -} {1 {wrong # args: should be "bindtags window ?tags?"}} +} {1 {wrong # args: should be "bindtags window ?taglist?"}} test bind-2.3 {bindtags command} { list [catch {bindtags .foo} msg] $msg } {1 {bad window path name ".foo"}} -- cgit v0.12