From: Adam Dickmeiss Date: Mon, 26 Feb 1996 18:38:31 +0000 (+0000) Subject: Work on export of set methods. X-Git-Tag: IRTCL.1.4~146 X-Git-Url: http://jsfdemo.indexdata.com/cgi-bin?a=commitdiff_plain;h=2dd3b1f77ee9144d7afcf4238a61a1843c0499d0;p=ir-tcl-moved-to-github.git Work on export of set methods. --- diff --git a/Makefile.in b/Makefile.in index 1a23685..ab4c96c 100644 --- a/Makefile.in +++ b/Makefile.in @@ -2,7 +2,7 @@ # (c) Index Data 1995 # See the file LICENSE for details. # Sebastian Hammer, Adam Dickmeiss -# $Id: Makefile.in,v 1.28 1996-02-23 17:31:38 adam Exp $ +# $Id: Makefile.in,v 1.29 1996-02-26 18:38:31 adam Exp $ SHELL=/bin/sh # IrTcl Version @@ -67,7 +67,7 @@ ir-tcl: libirtcl.a tclmain.o $(CC) $(CFLAGS) tclmain.o -o ir-tcl libirtcl.a $(YAZLIB) $(TCLLIB) $(LIBS) wais-tcl: libirtcl.a wais-tcl.o waismain.o - $(CC) $(CFLAGS) wais-tcl.o waismain.o -o wais-tcl libirtcl.a $(YAZLIB) $(TCLLIB) $(LIBS) + $(CC) $(CFLAGS) wais-tcl.o waismain.o -o wais-tcl libirtcl.a $(YAZLIB) $(TCLLIB) /home/proj/freeWAIS-sf/freeWAIS-sf-2.0.60/ir/libwais.a $(LIBS) waismain.o: tclmain.c $(CC) -c $(CFLAGS) -DUSE_WAIS=1 $(DEFS) tclmain.c -o waismain.o diff --git a/ir-tcl.c b/ir-tcl.c index f397668..f18c248 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.80 1996-02-23 17:31:39 adam + * Revision 1.81 1996-02-26 18:38:32 adam + * Work on export of set methods. + * + * Revision 1.80 1996/02/23 17:31:39 adam * More functions made available to the wais tcl extension. * * Revision 1.79 1996/02/23 13:41:38 adam @@ -1396,13 +1399,14 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, } p->num_databaseNames = argc - 2; p->databaseNames = - ir_tcl_malloc (sizeof(*p->databaseNames) * p->num_databaseNames); + ir_tcl_malloc (sizeof(*p->databaseNames) * (1+p->num_databaseNames)); for (i=0; inum_databaseNames; i++) { if (ir_tcl_strdup (interp, &p->databaseNames[i], argv[2+i]) == TCL_ERROR) return TCL_ERROR; } + p->databaseNames[i] = NULL; return TCL_OK; } @@ -1750,7 +1754,8 @@ static void ir_obj_delete (ClientData clientData) * ir_obj_init: IR Object initialization */ int ir_obj_init (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv, ClientData *subData) + int argc, char **argv, ClientData *subData, + ClientData parentData) { IrTcl_Methods tab[3]; IrTcl_Obj *obj; @@ -1808,7 +1813,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { ClientData subData; - int r = ir_obj_init (clientData, interp, argc, argv, &subData); + int r = ir_obj_init (clientData, interp, argc, argv, &subData, 0); if (r == TCL_ERROR) return TCL_ERROR; @@ -2637,10 +2642,11 @@ static void ir_set_obj_delete (ClientData clientData) } /* - * ir_set_obj_mk: IR Set Object creation + * ir_set_obj_init: IR Set Object initialization */ -static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) +static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv, ClientData *subData, + ClientData parentData) { IrTcl_Methods tabs[3]; IrTcl_SetObj *obj; @@ -2652,33 +2658,30 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, } obj = ir_tcl_malloc (sizeof(*obj)); logf (LOG_DEBUG, "ir set create"); - if (argc == 3) + if (parentData) { - Tcl_CmdInfo parent_info; int i; IrTcl_SetCObj *dst; IrTcl_SetCObj *src; - if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) - { - interp->result = "No parent"; - return TCL_ERROR; - } - obj->parent = (IrTcl_Obj *) parent_info.clientData; + obj->parent = (IrTcl_Obj *) parentData; dst = &obj->set_inher; src = &obj->parent->set_inher; if ((dst->num_databaseNames = src->num_databaseNames)) + { dst->databaseNames = ir_tcl_malloc (sizeof (*dst->databaseNames) - * dst->num_databaseNames); + * (1+dst->num_databaseNames)); + for (i = 0; i < dst->num_databaseNames; i++) + if (ir_tcl_strdup (interp, &dst->databaseNames[i], + src->databaseNames[i]) == TCL_ERROR) + return TCL_ERROR; + dst->databaseNames[i] = NULL; + } else dst->databaseNames = NULL; - for (i = 0; i < dst->num_databaseNames; i++) - if (ir_tcl_strdup (interp, &dst->databaseNames[i], - src->databaseNames[i]) == TCL_ERROR) - return TCL_ERROR; if (ir_tcl_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; @@ -2722,11 +2725,45 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR) return TCL_ERROR; + *subData = obj; + return TCL_OK; +} + +/* + * ir_set_obj_mk: IR Set Object creation + */ +static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ + ClientData subData; + ClientData parentData = 0; + int r; + + if (argc == 3) + { + Tcl_CmdInfo parent_info; + if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) + { + interp->result = "No parent"; + return TCL_ERROR; + } + parentData = parent_info.clientData; + } + r = ir_set_obj_init (clientData, interp, argc, argv, &subData, parentData); + if (r == TCL_ERROR) + return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_set_obj_method, - (ClientData) obj, ir_set_obj_delete); + subData, ir_set_obj_delete); return TCL_OK; } +IrTcl_Class ir_set_obj_class = { + "ir-set", + ir_set_obj_init, + ir_set_obj_method, + ir_set_obj_delete +}; + /* ------------------------------------------------------- */ /* diff --git a/ir-tclp.h b/ir-tclp.h index 5cda7ff..acab97f 100644 --- a/ir-tclp.h +++ b/ir-tclp.h @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tclp.h,v $ - * Revision 1.28 1996-02-23 17:31:41 adam + * Revision 1.29 1996-02-26 18:38:33 adam + * Work on export of set methods. + * + * Revision 1.28 1996/02/23 17:31:41 adam * More functions made available to the wais tcl extension. * * Revision 1.27 1996/02/23 13:41:41 adam @@ -364,13 +367,15 @@ int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, typedef struct { const char *name; int (*ir_init) (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv, ClientData *subData); + int argc, char **argv, ClientData *subData, + ClientData parentData); int (*ir_method) (ClientData clientData, Tcl_Interp *interp, int argc, char **argv); void (*ir_delete)(ClientData clientData); } IrTcl_Class; extern IrTcl_Class ir_obj_class; +extern IrTcl_Class ir_set_obj_class; void ir_select_add (int fd, void *obj); void ir_select_add_write (int fd, void *obj);