summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-08-03 20:36:15 (GMT)
committerericm <ericm>2000-08-03 20:36:15 (GMT)
commit0cdb0677540aa8995226f52ec82b9037920b6d29 (patch)
treeff2867076396bc073331bbed420d5ef47e09b88e
parent7d67184a277c2923bc3f951b256ad643113c6a8e (diff)
downloadtk-0cdb0677540aa8995226f52ec82b9037920b6d29.zip
tk-0cdb0677540aa8995226f52ec82b9037920b6d29.tar.gz
tk-0cdb0677540aa8995226f52ec82b9037920b6d29.tar.bz2
* 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.
-rw-r--r--ChangeLog17
-rw-r--r--generic/tkCmds.c71
-rw-r--r--generic/tkInt.h7
-rw-r--r--generic/tkMenu.c22
-rw-r--r--generic/tkWindow.c4
-rw-r--r--tests/bind.test6
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 <ericm@ajubasolutions.com>
+
+ * 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 <ericm@ajubasolutions.com>
* 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"}}