* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.79 1996-02-23 13:41:38 adam
+ * Revision 1.82 1996-02-29 15:30:21 adam
+ * Export of IrTcl functionality to extensions.
+ *
+ * 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
* Work on public access to simple ir class system.
*
* Revision 1.78 1996/02/21 10:16:08 adam
}
/*
- * IrTcl_eval
+ * ir_tcl_eval
*/
-int IrTcl_eval (Tcl_Interp *interp, const char *command)
+int ir_tcl_eval (Tcl_Interp *interp, const char *command)
{
char *tmp = ir_tcl_malloc (strlen(command)+1);
int r;
}
/*
- * get_set_int: Set/get integer value
+ * ir_tcl_get_set_int: Set/get integer value
*/
-static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
+int ir_tcl_get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv)
{
char buf[20];
/*
* ir_tcl_method: Search for method in table and invoke method handler
*/
-int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
+int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv,
+ IrTcl_Methods *tab, int *ret)
{
IrTcl_Methods *tab_i = tab;
IrTcl_Method *t;
}
else
if (!strcmp (t->name, argv[1]))
- return (*t->method)(tab_i->obj, interp, argc, argv);
+ {
+ *ret = (*t->method)(tab_i->obj, interp, argc, argv);
+ return TCL_OK;
+ }
if (argc <= 0)
return TCL_OK;
for (t = tab_i->tab; t->name; t++)
Tcl_AppendResult (interp, " ", t->name, NULL);
#endif
+ *ret = TCL_ERROR;
return TCL_ERROR;
}
/*
- * ir_named_bits: get/set named bits
+ * ir_tcl_named_bits: get/set named bits
*/
-int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
- Tcl_Interp *interp, int argc, char **argv)
+int ir_tcl_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob,
+ Tcl_Interp *interp, int argc, char **argv)
{
struct ir_named_entry *ti;
if (argc > 0)
ODR_MASK_SET (&p->options, 14);
return TCL_OK;
}
- return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2);
+ return ir_tcl_named_bits (options_tab, &p->options, interp, argc-2, argv+2);
}
/*
p->preferredMessageSize = 30000;
return TCL_OK;
}
- return get_set_int (&p->preferredMessageSize, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->preferredMessageSize, interp, argc, argv);
}
/*
p->maximumRecordSize = 30000;
return TCL_OK;
}
- return get_set_int (&p->maximumRecordSize, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->maximumRecordSize, interp, argc, argv);
}
/*
if (argc <= 0)
return TCL_OK;
- return get_set_int (&p->initResult, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->initResult, interp, argc, argv);
}
{
p->state = IR_TCL_R_Idle;
if (p->callback)
- IrTcl_eval (p->interp, p->callback);
+ ir_tcl_eval (p->interp, p->callback);
}
}
else
}
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; i<p->num_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;
}
p->replaceIndicator = 1;
return TCL_OK;
}
- return get_set_int (&p->replaceIndicator, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->replaceIndicator, interp, argc, argv);
}
/*
p->smallSetUpperBound = 0;
return TCL_OK;
}
- return get_set_int (&p->smallSetUpperBound, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->smallSetUpperBound, interp, argc, argv);
}
/*
p->largeSetLowerBound = 2;
return TCL_OK;
}
- return get_set_int (&p->largeSetLowerBound, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->largeSetLowerBound, interp, argc, argv);
}
/*
p->mediumSetPresentNumber = 0;
return TCL_OK;
}
- return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->mediumSetPresentNumber, interp, argc, argv);
}
/*
{
IrTcl_Methods tab[3];
IrTcl_Obj *p = clientData;
+ int r;
if (argc < 2)
return TCL_ERROR;
-
+
tab[0].tab = ir_method_tab;
tab[0].obj = p;
tab[1].tab = ir_set_c_method_tab;
tab[1].obj = &p->set_inher;
tab[2].tab = NULL;
-
- return ir_tcl_method (interp, argc, argv, tab);
+
+ ir_tcl_method (interp, argc, argv, tab, &r);
+ return r;
}
/*
tab[1].obj = &obj->set_inher;
tab[2].tab = NULL;
- ir_tcl_method (NULL, -1, NULL, tab);
+ ir_tcl_method (NULL, -1, NULL, tab, NULL);
ir_tcl_del_q (obj);
odr_destroy (obj->odr_in);
* 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;
tab[1].obj = &obj->set_inher;
tab[2].tab = NULL;
- if (ir_tcl_method (interp, 0, NULL, tab) == TCL_ERROR)
+ if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
{
Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
return TCL_ERROR;
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;
obj->resultCount = 0;
return TCL_OK;
}
- return get_set_int (&obj->resultCount, interp, argc, argv);
+ return ir_tcl_get_set_int (&obj->resultCount, interp, argc, argv);
}
/*
if (argc <= 0)
return TCL_OK;
- return get_set_int (&obj->searchStatus, interp, argc, argv);
+ return ir_tcl_get_set_int (&obj->searchStatus, interp, argc, argv);
}
/*
if (argc <= 0)
return TCL_OK;
- return get_set_int (&obj->presentStatus, interp, argc, argv);
+ return ir_tcl_get_set_int (&obj->presentStatus, interp, argc, argv);
}
/*
obj->nextResultSetPosition = 0;
return TCL_OK;
}
- return get_set_int (&obj->nextResultSetPosition, interp, argc, argv);
+ return ir_tcl_get_set_int (&obj->nextResultSetPosition, interp,
+ argc, argv);
}
/*
obj->numberOfRecordsReturned = 0;
return TCL_OK;
}
- return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv);
+ return ir_tcl_get_set_int (&obj->numberOfRecordsReturned, interp,
+ argc, argv);
}
/*
{
IrTcl_Methods tabs[3];
IrTcl_SetObj *p = clientData;
+ int r;
if (argc < 2)
{
tabs[1].obj = &p->set_inher;
tabs[2].tab = NULL;
- return ir_tcl_method (interp, argc, argv, tabs);
+ ir_tcl_method (interp, argc, argv, tabs, &r);
+ return r;
}
/*
tabs[1].obj = &p->set_inher;
tabs[2].tab = NULL;
- ir_tcl_method (NULL, -1, NULL, tabs);
+ ir_tcl_method (NULL, -1, NULL, tabs, NULL);
free (p);
}
/*
- * 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;
}
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;
tabs[0].obj = obj;
tabs[1].tab = NULL;
- if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR)
+ if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == 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
+};
+
/* ------------------------------------------------------- */
/*
p->stepSize = 0;
return TCL_OK;
}
- return get_set_int (&p->stepSize, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->stepSize, interp, argc, argv);
}
/*
p->numberOfTermsRequested = 20;
return TCL_OK;
}
- return get_set_int (&p->numberOfTermsRequested, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->numberOfTermsRequested, interp, argc, argv);
}
p->preferredPositionInResponse = 1;
return TCL_OK;
}
- return get_set_int (&p->preferredPositionInResponse, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->preferredPositionInResponse, interp,
+ argc, argv);
}
/*
if (argc <= 0)
return TCL_OK;
- return get_set_int (&p->scanStatus, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->scanStatus, interp, argc, argv);
}
/*
if (argc <= 0)
return TCL_OK;
- return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->numberOfEntriesReturned, interp,
+ argc, argv);
}
/*
if (argc <= 0)
return TCL_OK;
- return get_set_int (&p->positionOfTerm, interp, argc, argv);
+ return ir_tcl_get_set_int (&p->positionOfTerm, interp, argc, argv);
}
/*
int argc, char **argv)
{
IrTcl_Methods tabs[2];
+ int r;
if (argc < 2)
{
tabs[0].obj = clientData;
tabs[1].tab = NULL;
- return ir_tcl_method (interp, argc, argv, tabs);
+ ir_tcl_method (interp, argc, argv, tabs, &r);
+ return r;
}
/*
tabs[0].obj = obj;
tabs[1].tab = NULL;
- ir_tcl_method (NULL, -1, NULL, tabs);
+ ir_tcl_method (NULL, -1, NULL, tabs, NULL);
free (obj);
}
tabs[0].obj = obj;
tabs[1].tab = NULL;
- if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR)
+ if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR)
return TCL_ERROR;
Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method,
(ClientData) obj, ir_scan_obj_delete);
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_CONNECT;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
do_disconnect (p, NULL, 2, NULL);
return;
}
p->state = IR_TCL_R_Idle;
if (p->callback)
- IrTcl_eval (p->interp, p->callback);
+ ir_tcl_eval (p->interp, p->callback);
if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
ir_tcl_send_q (p, p->request_queue, "x");
return;
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_READ;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
/* release ir object now if callback deleted it */
ir_obj_delete (p);
{
p->failInfo = IR_TCL_FAIL_IN_APDU;
p->apduOffset = odr_offset (p->odr_in);
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
/* release ir object now if failback deleted it */
ir_obj_delete (p);
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
return;
}
p->state = IR_TCL_R_Idle;
if (apdu_call)
- IrTcl_eval (p->interp, apdu_call);
+ ir_tcl_eval (p->interp, apdu_call);
else if (rq->callback)
- IrTcl_eval (p->interp, rq->callback);
+ ir_tcl_eval (p->interp, rq->callback);
free (rq->buf_out);
free (rq->callback);
free (rq->object_name);
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_CONNECT;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
do_disconnect (p, NULL, 2, NULL);
return;
ir_select_remove_write (cs_fileno (p->cs_link), p);
#endif
if (p->callback)
- IrTcl_eval (p->interp, p->callback);
+ ir_tcl_eval (p->interp, p->callback);
return;
}
rq = p->request_queue;
if (p->failback)
{
p->failInfo = IR_TCL_FAIL_WRITE;
- IrTcl_eval (p->interp, p->failback);
+ ir_tcl_eval (p->interp, p->failback);
}
free (rq->buf_out);
rq->buf_out = NULL;
projects / ir-tcl-moved-to-github.git / blobdiff