From 028fd3679535d4b97a8f3fa248a61e97249441a5 Mon Sep 17 00:00:00 2001 From: ericm Date: Thu, 3 Aug 2000 21:02:19 +0000 Subject: * generic/tkInt.h: Replace Tk_BindCmd prototype with Tk_BindObjCmd prototype. * generic/tkWindow.c: Updated "bind" command entry to use Tcl_Obj'ified command. * generic/tkCmds.c (Tk_BindObjCmd): Tcl_Obj'ified [bind] command. --- ChangeLog | 8 +++++++ generic/tkCmds.c | 68 ++++++++++++++++++++++++++++++++++++++---------------- generic/tkInt.h | 7 +++--- generic/tkWindow.c | 4 ++-- 4 files changed, 62 insertions(+), 25 deletions(-) diff --git a/ChangeLog b/ChangeLog index f79d34f..5ae81d7 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,13 @@ 2000-08-03 Eric Melski + * generic/tkInt.h: Replace Tk_BindCmd prototype with + Tk_BindObjCmd prototype. + + * generic/tkWindow.c: Updated "bind" command entry to use + Tcl_Obj'ified command. + + * generic/tkCmds.c (Tk_BindObjCmd): Tcl_Obj'ified [bind] command. + * tests/bind.test: Tweaked expected error messages for [bindtags] to comply with updated error messages. diff --git a/generic/tkCmds.c b/generic/tkCmds.c index d3ac006..726eea6 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.16 2000/08/03 20:36:15 ericm Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.17 2000/08/03 21:02:19 ericm Exp $ */ #include "tkPort.h" @@ -106,7 +106,7 @@ Tk_BellObjCmd(clientData, interp, objc, objv) /* *---------------------------------------------------------------------- * - * Tk_BindCmd -- + * Tk_BindObjCmd -- * * This procedure is invoked to process the "bind" Tcl command. * See the user documentation for details on what it does. @@ -121,54 +121,82 @@ Tk_BellObjCmd(clientData, interp, objc, objv) */ int -Tk_BindCmd(clientData, interp, argc, argv) +Tk_BindObjCmd(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; ClientData object; - - if ((argc < 2) || (argc > 4)) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " window ?pattern? ?command?\"", (char *) NULL); + char *string; + + if ((objc < 2) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?"); return TCL_ERROR; } - if (argv[1][0] == '.') { - winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin); + string = Tcl_GetString(objv[1]); + + /* + * Bind tags either a window name or a tag name for the first argument. + * If the argument starts with ".", assume it is a window; otherwise, it + * is a tag. + */ + + if (string[0] == '.') { + winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin); if (winPtr == NULL) { return TCL_ERROR; } object = (ClientData) winPtr->pathName; } else { winPtr = (TkWindow *) clientData; - object = (ClientData) Tk_GetUid(argv[1]); + object = (ClientData) Tk_GetUid(string); } - if (argc == 4) { + /* + * If there are four arguments, the command is modifying a binding. If + * there are three arguments, the command is querying a binding. If there + * are only two arguments, the command is querying all the bindings for + * the given tag/window. + */ + + if (objc == 4) { int append = 0; unsigned long mask; + char *sequence, *script; + sequence = Tcl_GetString(objv[2]); + script = Tcl_GetString(objv[3]); + + /* + * If the script is null, just delete the binding. + */ - if (argv[3][0] == 0) { + if (script[0] == 0) { return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable, - object, argv[2]); + object, sequence); } - if (argv[3][0] == '+') { - argv[3]++; + + /* + * If the script begins with "+", append this script to the existing + * binding. + */ + + if (script[0] == '+') { + script++; append = 1; } mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable, - object, argv[2], argv[3], append); + object, sequence, script, append); if (mask == 0) { return TCL_ERROR; } - } else if (argc == 3) { + } else if (objc == 3) { char *command; command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable, - object, argv[2]); + object, Tcl_GetString(objv[2])); if (command == NULL) { Tcl_ResetResult(interp); return TCL_OK; diff --git a/generic/tkInt.h b/generic/tkInt.h index c8be3f6..5e5bd99 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.28 2000/08/03 20:36:15 ericm Exp $ + * RCS: $Id: tkInt.h,v 1.29 2000/08/03 21:02:19 ericm Exp $ */ #ifndef _TKINT @@ -892,8 +892,9 @@ EXTERN int Tk_AfterCmd _ANSI_ARGS_((ClientData clientData, EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); +EXTERN int Tk_BindObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); EXTERN int Tk_BindtagsObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 7712570..f03f946 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.21 2000/08/03 20:36:16 ericm Exp $ + * RCS: @(#) $Id: tkWindow.c,v 1.22 2000/08/03 21:02:20 ericm Exp $ */ #include "tkPort.h" @@ -98,7 +98,7 @@ static TkCmd commands[] = { */ {"bell", NULL, Tk_BellObjCmd, 0, 1}, - {"bind", Tk_BindCmd, NULL, 1, 1}, + {"bind", NULL, Tk_BindObjCmd, 1, 1}, {"bindtags", NULL, Tk_BindtagsObjCmd, 1, 1}, {"clipboard", NULL, Tk_ClipboardObjCmd, 0, 1}, {"destroy", NULL, Tk_DestroyObjCmd, 1, 1}, -- cgit v0.12