[cvslog] Module eggdrop1.7: Change committed

cvslog cvs at tsss.org
Mon Oct 15 21:43:00 CST 2001


CVSROOT    : /usr/local/cvsroot
Module     : eggdrop1.7
Commit time: 2001-10-16 02:42:43 UTC
Commited by: stdarg <stdarg at techmonkeys.org>

Modified files:
     eggdrop.complete.conf eggdrop.simple.conf src/script.c
     src/script.h src/script_api.h src/tclhash.c
     src/mod/tclscript.mod/tclscript.c

Log message:

Updated tclscript.mod a bit.
Made bind and unbind use the new tclscript module.

---------------------- diff included ----------------------
Index: eggdrop1.7/eggdrop.complete.conf
diff -u eggdrop1.7/eggdrop.complete.conf:1.44 eggdrop1.7/eggdrop.complete.conf:1.45
--- eggdrop1.7/eggdrop.complete.conf:1.44	Wed Oct 10 08:15:58 2001
+++ eggdrop1.7/eggdrop.complete.conf	Mon Oct 15 21:42:32 2001
@@ -1,7 +1,7 @@
 #! /path/to/executable/eggdrop
 # ^- set that to the directory eggdrop is in i.e. "#! /home/lamest/egg/eggdrop"
 #
-# $Id: eggdrop.complete.conf,v 1.44 2001/10/10 13:15:58 tothwolf Exp $
+# $Id: eggdrop.complete.conf,v 1.45 2001/10/16 02:42:32 stdarg Exp $
 #
 # This config file includes all possible options you can
 # use to configure your bot properly.
@@ -1147,6 +1147,11 @@
 # this module reports uptime statistics to http://uptime.energymech.net
 # go look and see what your uptime is! (it will show up after 9 hours or so)
 loadmodule uptime
+
+##### TCLSCRIPT MODULE #####
+
+# this module lets eggdrop interact with tcl scripts
+loadmodule tclscript
 
 ##### SCRIPTS #####
 
Index: eggdrop1.7/eggdrop.simple.conf
diff -u eggdrop1.7/eggdrop.simple.conf:1.15 eggdrop1.7/eggdrop.simple.conf:1.16
--- eggdrop1.7/eggdrop.simple.conf:1.15	Mon Aug 13 14:12:27 2001
+++ eggdrop1.7/eggdrop.simple.conf	Mon Oct 15 21:42:32 2001
@@ -1,7 +1,7 @@
 #! /path/to/executable/eggdrop
 # ^- set that to the directory eggdrop is in ie "#! /home/lamest/egg/eggdrop"
 #
-# $Id: eggdrop.simple.conf,v 1.15 2001/08/13 19:12:27 guppy Exp $
+# $Id: eggdrop.simple.conf,v 1.16 2001/10/16 02:42:32 stdarg Exp $
 #
 # This is a sample configuration file for your bot.  You will definitely
 # want to edit this, to set up your bot.  Right now it creates a bot called
@@ -20,6 +20,7 @@
 set mod-path "modules/"
 set help-path "help/"
 set text-path "text/"
+loadmodule tclscript
 loadmodule channels
 loadmodule server
 loadmodule ctcp
Index: eggdrop1.7/src/mod/tclscript.mod/tclscript.c
diff -u eggdrop1.7/src/mod/tclscript.mod/tclscript.c:1.5 eggdrop1.7/src/mod/tclscript.mod/tclscript.c:1.6
--- eggdrop1.7/src/mod/tclscript.mod/tclscript.c:1.5	Mon Oct 15 04:54:01 2001
+++ eggdrop1.7/src/mod/tclscript.mod/tclscript.c	Mon Oct 15 21:42:33 2001
@@ -22,7 +22,7 @@
 } my_callback_cd_t;
 
 static int my_command_handler(ClientData client_data, Tcl_Interp *myinterp, int objc, Tcl_Obj *CONST objv[]);
-static Tcl_Obj *my_resolve_var(Tcl_Interp *myinterp, script_var_t *v);
+static Tcl_Obj *my_resolve_one_var(Tcl_Interp *myinterp, script_var_t *v);
 
 static Tcl_Interp *ginterp; /* Our global interpreter. */
 static char *my_syntax_error = "syntax error";
@@ -105,12 +105,12 @@
 	return(0);
 }
 
-static int my_tcl_callbacker(script_callback_t *me, int n, ...)
+static int my_tcl_callbacker(script_callback_t *me, ...)
 {
-	Tcl_Obj *arg, *final_command;
-	script_var_t *var;
+	Tcl_Obj *arg, *final_command, *result;
+	script_var_t var;
 	my_callback_cd_t *cd; /* My callback client data */
-	int i, *al;
+	int i, n, retval, *al;
 
 	/* This struct contains the interp and the obj command. */
 	cd = (my_callback_cd_t *)me->callback_data;
@@ -118,16 +118,23 @@
 	/* Get a copy of the command, then append args. */
 	final_command = Tcl_DuplicateObj(cd->command);
 
-	al = &n;
-	for (i = 1; i <= n; i++) {
-		var = (script_var_t *)al[i];
-		arg = my_resolve_var(cd->myinterp, var);
+	al = (int *)&me;
+	al++;
+	if (me->syntax) n = strlen(me->syntax);
+	else n = 0;
+	for (i = 0; i < n; i++) {
+		var.type = me->syntax[i];
+		var.value = (void *)al[i];
+		var.len = -1;
+		arg = my_resolve_one_var(cd->myinterp, &var);
 		Tcl_ListObjAppendElement(cd->myinterp, final_command, arg);
 	}
 
 	Tcl_EvalObjEx(cd->myinterp, final_command, TCL_EVAL_GLOBAL);
+	result = Tcl_GetObjResult(cd->myinterp);
+	Tcl_GetIntFromObj(cd->myinterp, result, &retval);
 
-	return(0);
+	return(retval);
 }
 
 static int my_tcl_cb_delete(script_callback_t *me)
@@ -136,6 +143,8 @@
 
 	cd = (my_callback_cd_t *)me->callback_data;
 	Tcl_DecrRefCount(cd->command);
+	if (me->syntax) free(me->syntax);
+	if (me->name) free(me->name);
 	free(cd);
 	free(me);
 	return(0);
@@ -145,7 +154,12 @@
 {
 	char *cmdname;
 
-	cmdname = msprintf("%s_%s", info->class, info->name);
+	if (info->class && strlen(info->class)) {
+		cmdname = msprintf("%s_%s", info->class, info->name);
+	}
+	else {
+		malloc_strcpy(cmdname, info->name);
+	}
 	Tcl_CreateObjCommand(interp, cmdname, my_command_handler, (ClientData) info, NULL);
 	free(cmdname);
 
@@ -162,58 +176,46 @@
 	return(0);
 }
 
-static Tcl_Obj *my_resolve_var(Tcl_Interp *myinterp, script_var_t *v)
+static Tcl_Obj *my_resolve_one_var(Tcl_Interp *myinterp, script_var_t *v)
 {
 	Tcl_Obj *result;
 
 	result = NULL;
-	if (v->type & SCRIPT_INTEGER) result = Tcl_NewIntObj((int) v->value);
-	else if (v->type & SCRIPT_STRING) {
-		/* A normal string. */
-
-		if (v->len == -1) v->len = strlen((char *)v->value);
-		#ifdef USE_BYTE_ARRAYS
+	switch (v->type & SCRIPT_TYPE_MASK) {
+		case SCRIPT_INTEGER:
+			result = Tcl_NewIntObj((int) v->value);
+			break;
+		case SCRIPT_STRING:
+		case SCRIPT_BYTES:
+			if (v->len == -1) v->len = strlen((char *)v->value);
+			#ifdef USE_BYTE_ARRAYS
 			result = Tcl_NewByteArrayObj((char *)v->value, v->len);
-		#else
+			#else
 			result = Tcl_NewStringObj((char *)v->value, v->len);
-		#endif
-		if (!(v->type & SCRIPT_STATIC)) free((char *)v->value);
-	}
-	else if (v->type & SCRIPT_ARRAY) {
-		/* An array of script_var_t's (not pointers, actual struct). */
-		script_var_t *vararray;
-		int i;
-
-		vararray = (script_var_t *)v->value;
-		result = Tcl_NewListObj(0, NULL);
-		for (i = 0; i < v->len; i++) {
-			Tcl_Obj *item;
+			#endif
+			if (v->type & SCRIPT_FREE) free((char *)v->value);
+			break;
+		case SCRIPT_POINTER: {
+			char str[32];
 
-			item = my_resolve_var(myinterp, &vararray[i]);
-			if (item) Tcl_ListObjAppendElement(myinterp, result, item);
+			sprintf(str, "#%u", v->value);
+			result = Tcl_NewStringObj(str, -1);
+			break;
 		}
+		case SCRIPT_USER: {
+			/* An eggdrop user record (struct userrec *). */
+			char *handle;
+			struct userrec *u = (struct userrec *)v->value;
+
+			if (u) handle = u->handle;
+			else handle = "*";
+			result = Tcl_NewStringObj(handle, -1);
+			break;
+		}
+		default:
+			/* Default: just pass a string with an error message. */
+			result = Tcl_NewStringObj("unsupported type", -1);
 	}
-	else if (v->type & SCRIPT_POINTER) {
-		/* A pointer variable (will be represented as a decimal string). */
-		char str[32];
-
-		sprintf(str, "#%u", v->value);
-		result = Tcl_NewStringObj(str, -1);
-	}
-	else if (v->type & SCRIPT_USER) {
-		/* An eggdrop user record (struct userrec *). */
-		char *handle;
-		struct userrec *u = (struct userrec *)v->value;
-
-		if (u) handle = u->handle;
-		else handle = "*";
-		result = Tcl_NewStringObj(handle, -1);
-	}
-	else {
-		/* Default: just pass a string with an error message. */
-		result = Tcl_NewStringObj("unsupported return type", -1);
-	}
-	if (!(v->flags & SCRIPT_STATIC)) free(v);
 	return(result);
 }
 
@@ -226,7 +228,7 @@
 	for (i = 1; i < objc; i++) {
 		objptr = objv[i];
 		switch (*syntax++) {
-		case 's': { /* Null-terminated string. */
+		case SCRIPT_STRING: { /* Null-terminated string. */
 			char *nullterm;
 
 			#ifdef USE_BYTE_ARRAYS
@@ -243,27 +245,38 @@
 			arg = (void *)nullterm;
 			break;
 		}
-		case 'b': { /* Byte-array (could be anything). */
+		case SCRIPT_BYTES: { /* Byte-array (could be anything). */
 			#ifdef USE_BYTE_ARRAYS
-				arg = (void *)Tcl_GetByteArrayFromObj(objptr, &len);
+			arg = (void *)Tcl_GetByteArrayFromObj(objptr, &len);
 			#else
-				arg = (void *)Tcl_GetStringFromObj(objptr, &len);
+			arg = (void *)Tcl_GetStringFromObj(objptr, &len);
 			#endif
 			break;
 		}
-		case 'i': { /* Integer. */
+		case SCRIPT_INTEGER: { /* Integer. */
 			err = Tcl_GetIntFromObj(myinterp, objptr, (int *)&arg);
 			break;
 		}
-		case 'c': { /* Callback. */
+		case SCRIPT_CALLBACK: { /* Callback. */
 			script_callback_t *cback; /* Callback struct */
 			my_callback_cd_t *cdata; /* Our client data */
+			char *name, *nullterm;
 
-			cback = (script_callback_t *)malloc(sizeof(*cback));
-			cdata = (my_callback_cd_t *)malloc(sizeof(*cdata));
+			cback = (script_callback_t *)calloc(1, sizeof(*cback));
+			cdata = (my_callback_cd_t *)calloc(1, sizeof(*cdata));
 			cback->callback = (Function) my_tcl_callbacker;
 			cback->callback_data = (void *)cdata;
 			cback->delete = (Function) my_tcl_cb_delete;
+			#ifdef USE_BYTE_ARRAYS
+			name = (void *)Tcl_GetByteArrayFromObj(objptr, &len);
+			nullterm = (char *)malloc(len+1);
+			memcpy(nullterm, name, len);
+			nullterm[len] = 0;
+			#else
+			name = (char *)Tcl_GetStringFromObj(objptr, &len);
+			malloc_strcpy(nullterm, name);
+			#endif
+			cback->name = nullterm;
 			cdata->myinterp = myinterp;
 			cdata->command = objptr;
 			Tcl_IncrRefCount(objptr);
@@ -271,7 +284,7 @@
 			arg = (void *)cback;
 			break;
 		}
-		case 'U': { /* User. */
+		case SCRIPT_USER: { /* User. */
 			struct userrec *u;
 			char *handle;
 
@@ -368,8 +381,7 @@
 	}
 
 	my_err = retval.type & SCRIPT_ERROR;
-	retval.flags |= SCRIPT_STATIC; /* We don't want to segfault. */
-	tcl_retval = my_resolve_var(myinterp, &retval);
+	tcl_retval = my_resolve_one_var(myinterp, &retval);
 
 	if (tcl_retval) Tcl_SetObjResult(myinterp, tcl_retval);
 
Index: eggdrop1.7/src/script.c
diff -u eggdrop1.7/src/script.c:1.4 eggdrop1.7/src/script.c:1.5
--- eggdrop1.7/src/script.c:1.4	Mon Oct 15 04:54:01 2001
+++ eggdrop1.7/src/script.c	Mon Oct 15 21:42:32 2001
@@ -2,6 +2,7 @@
 typedef int (*Function)();
 #include "registry.h"
 #include "script_api.h"
+#include "script.h"
 #include "egglib/mstack.h"
 
 static Function link_int, unlink_int, link_str, unlink_str, create_cmd, delete_cmd;
@@ -44,7 +45,7 @@
 	for (i = 0; i < script_events->len; i++) {
 		event = (script_event_t *)script_events->stack[i];
 		if (event->type < max && table[event->type]) {
-			(table[event->type])(event->arg1, event->arg2, event->arg3);
+			(table[event->type])(NULL, event->arg1, event->arg2, event->arg3);
 		}
 	}
 	return(0);
Index: eggdrop1.7/src/script.h
diff -u eggdrop1.7/src/script.h:1.1 eggdrop1.7/src/script.h:1.2
--- eggdrop1.7/src/script.h:1.1	Sun Oct 14 18:13:33 2001
+++ eggdrop1.7/src/script.h	Mon Oct 15 21:42:32 2001
@@ -1,5 +1,13 @@
-#ifndef _SCRIPT_HELPER_H_
-#define _SCRIPT_HELPER_H_
+#ifndef _SCRIPT_H_
+#define _SCRIPT_H_
+
+typedef struct {
+	char *name;
+	Function callback;
+	char *syntax;
+	char *syntax_error;
+	int retval_type;
+} script_simple_command_t;
 
 int script_link_int_table(script_int_t *table);
 int script_unlink_int_table(script_int_t *table);
Index: eggdrop1.7/src/script_api.h
diff -u eggdrop1.7/src/script_api.h:1.3 eggdrop1.7/src/script_api.h:1.4
--- eggdrop1.7/src/script_api.h:1.3	Mon Oct 15 04:27:08 2001
+++ eggdrop1.7/src/script_api.h	Mon Oct 15 21:42:32 2001
@@ -28,34 +28,33 @@
 /* Flags for linked variables. */
 #define SCRIPT_READ_ONLY	1
 
-/* Flags for variables (check out struct script_var_t) */
-#define SCRIPT_STATIC	1
-#define SCRIPT_STRING	2
-#define SCRIPT_INTEGER	4
-#define SCRIPT_LIST	8
-#define SCRIPT_ARRAY	16
-#define SCRIPT_VARRAY	32
-#define SCRIPT_POINTER	64
-#define SCRIPT_CALLBACK	128
-
-/* Eggdrop specific types. */
-#define SCRIPT_USER	256
-
-/* Error bit. */
-#define SCRIPT_ERROR	512
+/* Flags for variables. */
+#define SCRIPT_FREE	256
+#define SCRIPT_ARRAY	512
+#define SCRIPT_ERROR	1024
+
+/* Types for variables. */
+#define SCRIPT_STRING	((int)'s')
+#define SCRIPT_INTEGER	((int)'i')
+#define SCRIPT_POINTER	((int)'p')
+#define SCRIPT_CALLBACK	((int)'c')
+#define SCRIPT_USER	((int)'U')
+#define SCRIPT_BYTES	((int)'b')
+#define SCRIPT_TYPE_MASK	255
 
 typedef struct script_callback_b {
 	int (*callback)();
 	void *callback_data;
 	int (*delete)();
 	void *delete_data;
+	char *syntax;
+	char *name;
 } script_callback_t;
 
 typedef struct script_var_b {
 	int type;	/* Type of variable (int, str, etc). */
 	void *value;	/* Value (needs to be cast to right type). */
-	int len;	/* Length of string of array (when appropriate). */
-	int flags;	/* Not used right now. */
+	int len;	/* Length of string or array (when appropriate). */
 } script_var_t;
 
 typedef struct script_int_b {
@@ -82,13 +81,5 @@
 	int retval_type; /* Limited return value type, for simple stuff. */
 	int flags;
 } script_command_t;
-
-typedef struct script_simple_command_b {
-	char *name;
-	Function callback;
-	char *syntax;
-	char *syntax_error;
-	int retval_type;
-} script_simple_command_t;
 
 #endif
Index: eggdrop1.7/src/tclhash.c
diff -u eggdrop1.7/src/tclhash.c:1.45 eggdrop1.7/src/tclhash.c:1.46
--- eggdrop1.7/src/tclhash.c:1.45	Sun Oct 14 18:13:33 2001
+++ eggdrop1.7/src/tclhash.c	Mon Oct 15 21:42:33 2001
@@ -7,7 +7,7 @@
  *   (non-Tcl) procedure lookups for msg/dcc/file commands
  *   (Tcl) binding internal procedures to msg/dcc/file commands
  *
- * $Id: tclhash.c,v 1.45 2001/10/14 23:13:33 stdarg Exp $
+ * $Id: tclhash.c,v 1.46 2001/10/16 02:42:33 stdarg Exp $
  */
 /*
  * Copyright (C) 1997 Robey Pointer
@@ -31,6 +31,8 @@
 #include "main.h"
 #include "chan.h"
 #include "users.h"
+#include "script_api.h"
+#include "script.h"
 
 extern Tcl_Interp	*interp;
 extern struct dcc_t	*dcc;
@@ -148,13 +150,20 @@
 
 
 extern cmd_t C_dcc[];
-static int tcl_bind();
-static int tcl_bind2();
-static int tcl_unbind2();
+static int script_bind();
+static int script_unbind();
+
+static script_simple_command_t script_commands[] = {
+	{"", NULL, NULL, NULL, 0},
+	{"bind", script_bind, "sssc", "table flags mask command", SCRIPT_INTEGER},
+	{"unbind", script_unbind, "ssss", "table flags mask command", SCRIPT_INTEGER},
+	0
+};
 
 void binds_init(void)
 {
 	bind_table_list_head = NULL;
+	script_create_simple_cmd_table(script_commands);
 	BT_link = add_bind_table2("link", 2, "ss", MATCH_MASK, BIND_STACKABLE);
 	BT_disc = add_bind_table2("disc", 1, "s", MATCH_MASK, BIND_STACKABLE);
 	BT_away = add_bind_table2("away", 3, "sis", MATCH_MASK, BIND_STACKABLE);
@@ -166,8 +175,6 @@
 {
   bind_table_list = NULL;
   Context;
-  Tcl_CreateCommand(interp, "bind", tcl_bind, (ClientData) 0, NULL);
-  Tcl_CreateCommand(interp, "unbind", tcl_bind, (ClientData) 1, NULL);
   H_unld = add_bind_table("unld", HT_STACKABLE, builtin_char);
   H_note = add_bind_table("note", 0, builtin_3char);
   H_nkch = add_bind_table("nkch", HT_STACKABLE, builtin_2char);
@@ -355,14 +362,14 @@
 
 	/* Delete it. */
 	if (prev) prev->next = entry->next;
-	else if (entry->next) chain->entries = entry->next;
+	else chain->entries = entry->next;
 	free(entry->function_name);
 	free(entry);
 
 	return(0);
 }
 
-static void *get_bind_cdata(bind_table_t *table , const char *flags, const char *mask, const char *function_name)
+static void *get_bind_cdata(bind_table_t *table, const char *flags, const char *mask, const char *function_name)
 {
 	bind_chain_t *chain;
 	bind_entry_t *entry;
@@ -550,132 +557,32 @@
   return TCL_OK;
 }
 
-/* Works with string, int, and user type. */
-static int my_tcl_bind_callback(tcl_cmd_cdata *cdata, ...)
-{
-	Tcl_DString final;
-	int *arg;
-	char *syntax, *str, buf[32];
-	int retval;
-
-	arg = (int *)&cdata;
-	arg++;
-	Tcl_DStringInit(&final);
-	Tcl_DStringAppend(&final, cdata->cmd, -1);
-	for (syntax = cdata->syntax; *syntax; syntax++) {
-		switch (*syntax) {
-			case 's':
-				str = (char *)(*arg);
-				break;
-			case 'i': {
-				sprintf(buf, "%d", *arg);
-				str = buf;
-				break;
-			}
-			case 'U': {
-				struct userrec *u;
-				u = (struct userrec *)(*arg);
-				if (u) str = u->handle;
-				else str = "*";
-				break;
-			}
-			default:
-				str = "(unsupported argument type)";
-		}
-		if (!str) str = "(null)";
-		Tcl_DStringAppendElement(&final, str);
-		arg++;
-	}
-	Tcl_Eval(cdata->irp, Tcl_DStringValue(&final));
-	Tcl_DStringGetResult(cdata->irp, &final);
-	retval = atoi(Tcl_DStringValue(&final));
-	Tcl_DStringFree(&final);
-	return(retval);
-}
-
-static int tcl_bind2 STDVAR
+static int script_bind(char *table_name, char *flags, char *mask, script_callback_t *callback)
 {
-	tcl_cmd_cdata *cdata;
 	bind_table_t *table;
+	int retval;
 
-	BADARGS(5, 5, " type flags cmd/mask procname");
-
-	table = find_bind_table2(argv[1]);
-	if (!table) {
-		Tcl_AppendResult(irp, "invalid table type", NULL);
-		return(TCL_ERROR);
-	}
+	table = find_bind_table2(table_name);
+	if (!table) return(1);
 
-	cdata = (tcl_cmd_cdata *)malloc(sizeof(*cdata));
-	cdata->irp = irp;
-	malloc_strcpy(cdata->syntax, table->syntax);
-	malloc_strcpy(cdata->cmd, argv[4]);
-	add_bind_entry(table, argv[2], argv[3], argv[4], BIND_WANTS_CD, (Function) my_tcl_bind_callback, cdata);
-	Tcl_AppendResult(irp, "moooo", NULL);
-	return(TCL_OK);
+	malloc_strcpy(callback->syntax, table->syntax);
+	retval = add_bind_entry(table, flags, mask, callback->name, BIND_WANTS_CD, callback->callback, callback);
+	return(retval);
 }
 
-static int tcl_unbind2 STDVAR
+static int script_unbind(char *table_name, char *flags, char *mask, char *name)
 {
 	bind_table_t *table;
-	tcl_cmd_cdata *cdata;
-
-	BADARGS(5, 5, " type flags cmd/mask procname");
-	table = find_bind_table2(argv[1]);
-	if (!table) {
-		Tcl_AppendResult(irp, "invalid table type", NULL);
-		return(TCL_ERROR);
-	}
-	cdata = get_bind_cdata(table, argv[2], argv[3], argv[4]);
-	if (cdata) {
-		free(cdata->cmd);
-		free(cdata->syntax);
-		free(cdata);
-		del_bind_entry(table, argv[2], argv[3], argv[4]);
-	}
-	Tcl_AppendResult(irp, "mooooo", NULL);
-	return(TCL_OK);
-}
+	script_callback_t *callback;
+	int retval;
 
-static int tcl_bind STDVAR
-{
-  tcl_bind_list_t	*tl;
-  bind_table_t *table;
+	table = find_bind_table2(table_name);
+	if (!table) return(1);
 
-  /* Note: `cd' defines what tcl_bind is supposed do: 0 stands for
-           bind and 1 stands for unbind. */
-  if ((long int) cd == 1)
-    BADARGS(5, 5, " type flags cmd/mask procname");
-  else
-    BADARGS(4, 5, " type flags cmd/mask ?procname?");
-
-  table = find_bind_table2(argv[1]);
-  if (table) {
-    if ((int) cd == 0) return tcl_bind2(cd, irp, argc, argv);
-    else return tcl_unbind2(cd, irp, argc, argv);
-  }
-  tl = find_bind_table(argv[1]);
-  if (!tl) {
-    Tcl_AppendResult(irp, "bad table type", NULL);
-    return TCL_OK;
-  }
-
-  if ((long int) cd == 1) {
-    if (!unbind_bind_entry(tl, argv[2], argv[3], argv[4])) {
-      /* Don't error if trying to re-unbind a builtin */
-      if (argv[4][0] != '*' || argv[4][4] != ':' ||
-	  strcmp(argv[3], &argv[4][5]) || strncmp(argv[1], &argv[4][1], 3)) {
-	Tcl_AppendResult(irp, "no such binding", NULL);
-	return TCL_ERROR;
-      }
-    }
-  } else {
-    if (argc == 4)
-      return tcl_getbinds(tl, argv[3]);
-    bind_bind_entry(tl, argv[2], argv[3], argv[4]);
-  }
-  Tcl_AppendResult(irp, argv[3], NULL);
-  return TCL_OK;
+	callback = get_bind_cdata(table, flags, mask, name);
+	retval = del_bind_entry(table, flags, mask, name);
+	if (callback) callback->delete(callback);
+	return(retval);
 }
 
 int check_validity(char *nme, Function func)
----------------------- End of diff -----------------------



More information about the Changes mailing list