2 * NWI - Nordic Web Index
3 * Technical Knowledge Centre & Library of Denmark (DTV)
5 * Wais extension to IrTcl
8 * Revision 1.1 1996-02-29 15:28:08 adam
9 * First version of Wais extension to IrTcl.
22 /* IrTcl internal header */
25 /* FreeWAIS-sf header */
38 typedef struct WaisTcl_Records {
39 WaisTcl_Record *record;
40 struct WaisTcl_Records *next;
57 IrTcl_SetObj *irtcl_set_obj;
59 WaisTcl_Records *records;
65 static void wais_obj_delete (ClientData clientData);
66 static void wais_select_notify (ClientData clientData, int r, int w, int e);
67 static int do_disconnect (void *obj, Tcl_Interp *interp,
68 int argc, char **argv);
70 /* --- N E T W O R K I / O ----------------------------------------- */
72 static void wais_select_write (ClientData clientData)
74 WaisTcl_Obj *p = clientData;
77 logf (LOG_DEBUG, "Wais write handler fd=%d", cs_fileno(p->wais_link));
78 switch (p->irtcl_obj->state)
80 case IR_TCL_R_Connecting:
81 logf(LOG_DEBUG, "Connect handler");
82 r = cs_rcvconnect (p->wais_link);
85 p->irtcl_obj->state = IR_TCL_R_Idle;
88 logf (LOG_DEBUG, "cs_rcvconnect error");
89 if (p->irtcl_obj->failback)
91 p->irtcl_obj->failInfo = IR_TCL_FAIL_CONNECT;
92 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
94 do_disconnect (p, NULL, 2, NULL);
97 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
99 if (p->irtcl_obj->callback)
101 logf (LOG_DEBUG, "Invoking connect callback");
102 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
105 case IR_TCL_R_Writing:
106 if ((r=cs_put (p->wais_link, p->buf_out, p->len_out)) < 0)
108 logf (LOG_DEBUG, "cs_put write fail");
109 if (p->irtcl_obj->failback)
111 p->irtcl_obj->failInfo = IR_TCL_FAIL_WRITE;
112 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
114 do_disconnect (p, NULL, 2, NULL);
116 else if (r == 0) /* remove select bit */
118 logf(LOG_DEBUG, "Write completed");
119 p->irtcl_obj->state = IR_TCL_R_Waiting;
121 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
122 clientData, 1, 0, 0);
126 logf (LOG_FATAL|LOG_ERRNO, "Wais read. state=%d", p->irtcl_obj->state);
131 static WaisTcl_Record *wais_lookup_record_pos (WaisSetTcl_Obj *p, int pos)
133 WaisTcl_Records *recs;
135 for (recs = p->records; recs; recs = recs->next)
136 if (recs->record->position == pos)
141 static WaisTcl_Record *wais_lookup_record_pos_bf (WaisSetTcl_Obj *p, int pos)
145 rec = wais_lookup_record_pos (p, pos);
150 if (rec->documentText ||
151 !p->irtcl_set_obj->recordElements ||
152 !*p->irtcl_set_obj->recordElements ||
153 strcmp (p->irtcl_set_obj->recordElements, "F"))
158 static WaisTcl_Record *wais_lookup_record_id (WaisSetTcl_Obj *p, any *id)
160 WaisTcl_Records *recs;
162 for (recs = p->records; recs; recs = recs->next)
163 if (recs->record->documentID->size == id->size &&
164 !memcmp (recs->record->documentID->bytes, id->bytes, id->size))
169 static void wais_delete_record (WaisTcl_Record *rec)
171 freeAny (rec->documentID);
172 free (rec->headline);
173 if (rec->documentText)
174 free (rec->documentText);
178 static void wais_add_record_brief (WaisSetTcl_Obj *p,
187 WaisTcl_Records *recs;
189 rec = wais_lookup_record_pos (p, position);
192 rec = ir_tcl_malloc (sizeof(*rec));
194 recs = ir_tcl_malloc (sizeof(*recs));
196 recs->next = p->records;
201 freeAny (rec->documentID);
202 free (rec->headline);
203 if (rec->documentText)
204 free (rec->documentText);
206 rec->position = position;
207 rec->documentID = duplicateAny (documentID);
209 rec->documentLength = documentLength;
211 ir_tcl_strdup (NULL, &rec->headline, headline);
212 rec->documentText = NULL;
215 static void wais_add_record_full (WaisSetTcl_Obj *p,
220 rec = wais_lookup_record_id (p, documentID);
224 logf (LOG_DEBUG, "Adding text. Didn't find corresponding brief");
227 if (rec->documentText)
228 free (rec->documentText);
229 rec->documentText = ir_tcl_malloc (documentText->size+1);
230 memcpy (rec->documentText, documentText->bytes, documentText->size);
231 rec->documentText[documentText->size] = '\0';
232 logf (LOG_DEBUG, "Adding text record: \n%.20s", rec->documentText);
235 static void wais_handle_search_response (WaisSetTcl_Obj *p, char *buf)
237 SearchResponseAPDU *responseAPDU = NULL;
239 readSearchResponseAPDU (&responseAPDU, buf);
240 if (responseAPDU->DatabaseDiagnosticRecords)
242 WAISSearchResponse *ddr = responseAPDU->DatabaseDiagnosticRecords;
244 p->irtcl_set_obj->searchStatus = 1;
246 p->irtcl_set_obj->nextResultSetPosition =
247 responseAPDU->NextResultSetPosition;
248 p->irtcl_set_obj->numberOfRecordsReturned =
249 responseAPDU->NumberOfRecordsReturned;
251 if (!p->irtcl_set_obj->resultCount)
253 if (responseAPDU->NumberOfRecordsReturned >
254 responseAPDU->ResultCount)
255 p->irtcl_set_obj->resultCount =
256 responseAPDU->NumberOfRecordsReturned;
258 p->irtcl_set_obj->resultCount =
259 responseAPDU->ResultCount;
265 if (ddr->Diagnostics)
267 diagnosticRecord **dr = ddr->Diagnostics;
270 logf (LOG_DEBUG, "Diagnostic response. %s : %s",
271 dr[0]->DIAG ? dr[0]->DIAG : "<null>",
272 dr[0]->ADDINFO ? dr[0]->ADDINFO : "<null>");
273 ir_tcl_strdup (NULL, &p->diag, dr[0]->DIAG);
274 ir_tcl_strdup (NULL, &p->addinfo, dr[0]->ADDINFO);
277 logf (LOG_DEBUG, "Diagnostic response");
282 logf (LOG_DEBUG, "Got doc header entries");
283 for (i = 0; ddr->DocHeaders[i]; i++)
285 WAISDocumentHeader *head = ddr->DocHeaders[i];
287 wais_add_record_brief (p, i+1, head->DocumentID,
288 head->Score, head->DocumentLength,
289 head->Lines, head->Headline);
291 logf (LOG_DEBUG, "got %d DBOSD records", i);
296 logf (LOG_DEBUG, "Got text entries");
297 for (i = 0; ddr->Text[i]; i++)
298 wais_add_record_full (p,
299 ddr->Text[i]->DocumentID,
300 ddr->Text[i]->DocumentText);
302 freeWAISSearchResponse (ddr);
306 logf (LOG_DEBUG, "No records!");
308 freeSearchResponseAPDU (responseAPDU);
312 static void wais_select_read (ClientData clientData)
314 ClientData objectClientData;
315 WaisTcl_Obj *p = clientData;
319 logf (LOG_DEBUG, "Wais read handler fd=%d", cs_fileno(p->wais_link));
322 /* signal one more use of ir object - callbacks must not
323 release the ir memory (p pointer) */
324 p->irtcl_obj->state = IR_TCL_R_Reading;
327 /* read incoming APDU */
328 if ((r=cs_get (p->wais_link, &p->irtcl_obj->buf_in,
329 &p->irtcl_obj->len_in)) <= 0)
331 logf (LOG_DEBUG, "cs_get failed, code %d", r);
332 do_disconnect (p, NULL, 2, NULL);
333 if (p->irtcl_obj->failback)
335 p->irtcl_obj->failInfo = IR_TCL_FAIL_READ;
336 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
338 /* release wais object now if callback deleted it */
344 logf(LOG_DEBUG, "PDU Fraction read");
348 logf (LOG_DEBUG, "cs_get ok, total size %d", r);
349 /* got complete APDU. Now decode */
351 /* determine set/ir object corresponding to response */
352 objectClientData = 0;
355 Tcl_CmdInfo cmd_info;
357 if (Tcl_GetCommandInfo (p->interp, p->object, &cmd_info))
358 objectClientData = cmd_info.clientData;
362 pdup = p->irtcl_obj->buf_in + HEADER_LENGTH;
363 switch (peekPDUType (pdup))
365 case initResponseAPDU:
366 logf (LOG_DEBUG, "Got Wais Init response");
368 case searchResponseAPDU:
369 logf (LOG_DEBUG, "Got Wais Search response");
370 if (objectClientData)
371 wais_handle_search_response (objectClientData,
375 logf (LOG_WARN, "Received unknown WAIS APDU type %d",
377 do_disconnect (p, NULL, 2, NULL);
378 if (p->irtcl_obj->failback)
380 p->irtcl_obj->failInfo = IR_TCL_FAIL_UNKNOWN_APDU;
381 ir_tcl_eval (p->interp, p->irtcl_obj->failback);
385 p->irtcl_obj->state = IR_TCL_R_Idle;
387 if (p->irtcl_obj->callback)
388 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
389 if (p->ref_count == 1)
395 } while (p->wais_link && cs_more (p->wais_link));
398 static void wais_select_notify (ClientData clientData, int r, int w, int e)
401 wais_select_write (clientData);
403 wais_select_read (clientData);
406 static int wais_send_apdu (WaisTcl_Obj *p, const char *msg, const char *object)
412 logf (LOG_DEBUG, "Cannot send. object=%s", p->object);
415 r = cs_put (p->wais_link, p->buf_out, p->len_out);
418 ir_tcl_strdup (NULL, &p->object, object);
421 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
423 logf (LOG_DEBUG, "Send part of wais %s APDU", msg);
424 p->irtcl_obj->state = IR_TCL_R_Writing;
428 logf (LOG_DEBUG, "Send %s (%d bytes) fd=%d", msg, p->len_out,
429 cs_fileno(p->wais_link));
430 p->irtcl_obj->state = IR_TCL_R_Waiting;
435 /* --- A S S O C I A T I O N S ----------------------------------------- */
437 static int do_connect (void *obj, Tcl_Interp *interp,
438 int argc, char **argv)
441 WaisTcl_Obj *p = obj;
448 Tcl_AppendResult (interp, p->hostname, NULL);
453 interp->result = "already connected";
456 if (strcmp (p->irtcl_obj->comstackType, "wais"))
458 interp->result = "only wais comstack supported";
461 p->wais_link = cs_create (tcpip_type, 0, PROTO_WAIS);
462 addr = tcpip_strtoaddr (argv[2]);
465 interp->result = "tcpip_strtoaddr fail";
468 logf (LOG_DEBUG, "tcp/ip wais connect %s", argv[2]);
470 if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
472 r = cs_connect (p->wais_link, addr);
473 logf(LOG_DEBUG, "cs_connect returned %d fd=%d", r,
474 cs_fileno(p->wais_link));
477 interp->result = "wais connect fail";
478 do_disconnect (p, NULL, 2, NULL);
481 p->irtcl_obj->eventType = "connect";
484 p->irtcl_obj->state = IR_TCL_R_Connecting;
485 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
490 p->irtcl_obj->state = IR_TCL_R_Idle;
491 ir_tcl_select_set (wais_select_notify, cs_fileno(p->wais_link),
493 if (p->irtcl_obj->callback)
494 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
499 static int do_disconnect (void *obj, Tcl_Interp *interp,
500 int argc, char **argv)
502 WaisTcl_Obj *p = obj;
513 ir_tcl_select_set (NULL, cs_fileno(p->wais_link), NULL, 0, 0, 0);
517 cs_close (p->wais_link);
525 static int do_init (void *obj, Tcl_Interp *interp, int argc, char **argv)
527 WaisTcl_Obj *p = obj;
531 p->irtcl_obj->initResult = 0;
534 interp->result = "not connected";
537 p->irtcl_obj->initResult = 1;
538 if (p->irtcl_obj->callback)
539 ir_tcl_eval (p->interp, p->irtcl_obj->callback);
543 static int do_options (void *obj, Tcl_Interp *interp, int argc, char **argv)
545 WaisTcl_Obj *p = obj;
551 Tcl_AppendElement (p->interp, "search");
552 Tcl_AppendElement (p->interp, "present");
557 static IrTcl_Method wais_method_tab[] = {
558 { "connect", do_connect, NULL },
559 { "disconnect", do_disconnect, NULL },
560 { "init", do_init, NULL },
561 { "options", do_options, NULL },
566 int wais_obj_init(ClientData clientData, Tcl_Interp *interp,
567 int argc, char **argv, ClientData *subData,
568 ClientData parentData)
570 IrTcl_Methods tab[3];
577 interp->result = "wrong # args";
580 obj = ir_tcl_malloc (sizeof(*obj));
582 obj->interp = interp;
584 logf (LOG_DEBUG, "wais object create %s", argv[1]);
586 r = (*ir_obj_class.ir_init)(clientData, interp, argc, argv, &subP, 0);
589 obj->irtcl_obj = subP;
592 obj->buf_out = ir_tcl_malloc (obj->max_out);
594 free (obj->irtcl_obj->comstackType);
595 ir_tcl_strdup (NULL, &obj->irtcl_obj->comstackType, "wais");
597 tab[0].tab = wais_method_tab;
601 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
603 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
604 /* cleanup missing ... */
613 * wais_obj_delete: Wais Object disposal
615 static void wais_obj_delete (ClientData clientData)
617 WaisTcl_Obj *obj = clientData;
618 IrTcl_Methods tab[3];
621 if (obj->ref_count > 0)
624 logf (LOG_DEBUG, "wais object delete");
626 tab[0].tab = wais_method_tab;
630 ir_tcl_method (NULL, -1, NULL, tab, NULL);
632 (*ir_obj_class.ir_delete)((ClientData) obj->irtcl_obj);
639 * wais_obj_method: Wais Object methods
641 static int wais_obj_method (ClientData clientData, Tcl_Interp *interp,
642 int argc, char **argv)
644 IrTcl_Methods tab[3];
645 WaisTcl_Obj *p = clientData;
651 tab[0].tab = wais_method_tab;
655 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
657 return (*ir_obj_class.ir_method)((ClientData) p->irtcl_obj,
664 * wais_obj_mk: Wais Object creation
666 static int wais_obj_mk (ClientData clientData, Tcl_Interp *interp,
667 int argc, char **argv)
670 int r = wais_obj_init (clientData, interp, argc, argv, &subData, 0);
674 Tcl_CreateCommand (interp, argv[1], wais_obj_method,
675 subData, wais_obj_delete);
679 /* --- S E T S ---------------------------------------------------------- */
681 static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
683 WaisSetTcl_Obj *obj = o;
684 WaisTcl_Obj *p = obj->parent;
685 int i, start, number;
686 static char *element_names[3];
690 SearchAPDU *waisSearch;
697 if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR)
704 if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR)
711 interp->result = "present: not connected";
714 element_names[0] = " ";
715 element_names[1] = ES_DocumentText;
716 element_names[2] = NULL;
718 docObjs = ir_tcl_malloc (sizeof(*docObjs) * (number+1));
719 for (i = 0; i<number; i++)
723 rec = wais_lookup_record_pos (obj, i+start);
726 interp->result = "present request out of range";
729 docObjs[i] = makeDocObjUsingLines (rec->documentID, "TEXT", 0, 60000);
732 waisQuery = makeWAISTextQuery (docObjs);
734 makeSearchAPDU (30L, /* small */
737 (boolean) obj->irtcl_set_obj->
738 set_inher.replaceIndicator, /* replace indicator */
740 setName, /* result set name */
741 obj->irtcl_set_obj->set_inher.databaseNames,
742 QT_TextRetrievalQuery, /* query type */
743 element_names, /* element name */
744 NULL, /* reference ID */
748 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
749 p->len_out = p->max_out - left;
751 for (i = 0; i<number; i++)
752 CSTFreeDocObj (docObjs[i]);
755 CSTFreeWAISTextQuery (waisQuery);
756 freeSearchAPDU (waisSearch);
759 interp->result = "Couldn't encode WAIS text search APDU";
762 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
763 (long) NO_COMPRESSION,
765 (long) HEADER_VERSION);
767 p->len_out += HEADER_LENGTH;
768 return wais_send_apdu (p, "search", argv[0]);
771 static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
773 WaisSetTcl_Obj *obj = o;
774 WaisTcl_Obj *p = obj->parent;
775 WAISSearch *waisQuery;
776 SearchAPDU *waisSearch;
784 interp->result = "wrong # args";
787 if (!obj->irtcl_set_obj->set_inher.num_databaseNames)
789 interp->result = "no databaseNames";
792 logf (LOG_DEBUG, "parent = %p", p);
795 interp->result = "not connected";
798 obj->irtcl_set_obj->resultCount = 0;
799 obj->irtcl_set_obj->searchStatus = 0;
801 makeWAISSearch (argv[2], /* seed words */
804 1L, /* date factor */
805 0L, /* begin date range */
806 0L, /* end date range */
807 obj->maxDocs); /* max docs retrieved */
810 makeSearchAPDU (30L, /* small */
813 (boolean) obj->irtcl_set_obj->
814 set_inher.replaceIndicator, /* replace indicator */
816 setName, /* result set name */
817 obj->irtcl_set_obj->set_inher.databaseNames,
818 QT_RelevanceFeedbackQuery, /* query type */
819 NULL, /* element name */
820 NULL, /* reference ID */
824 retp = writeSearchAPDU (waisSearch, p->buf_out + HEADER_LENGTH, &left);
825 p->len_out = p->max_out - left;
827 CSTFreeWAISSearch (waisQuery);
828 freeSearchAPDU (waisSearch);
831 interp->result = "Couldn't encode WAIS search APDU";
834 writeWAISPacketHeader (p->buf_out, (long) (p->len_out), (long) 'z', "wais",
835 (long) NO_COMPRESSION,
837 (long) HEADER_VERSION);
839 p->len_out += HEADER_LENGTH;
840 return wais_send_apdu (p, "search", argv[0]);
844 * do_responseStatus: Return response status (present or search)
846 static int do_responseStatus (void *o, Tcl_Interp *interp,
847 int argc, char **argv)
849 WaisSetTcl_Obj *obj = o;
864 Tcl_AppendElement (interp, "NSD");
866 Tcl_AppendElement (interp, obj->diag);
867 Tcl_AppendElement (interp, obj->diag);
869 Tcl_AppendElement (interp, obj->addinfo ? obj->addinfo : "");
872 Tcl_AppendElement (interp, "DBOSD");
877 * do_maxDocs: Set number of documents to be retrieved in ranked query
879 static int do_maxDocs (void *o, Tcl_Interp *interp, int argc, char **argv)
881 WaisSetTcl_Obj *obj = o;
888 return ir_tcl_get_set_int (&obj->maxDocs, interp, argc, argv);
893 * do_type: Return type (if any) at position.
895 static int do_type (void *o, Tcl_Interp *interp, int argc, char **argv)
897 WaisSetTcl_Obj *obj = o;
909 delete_IR_records (obj);
915 sprintf (interp->result, "wrong # args");
918 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
920 rec = wais_lookup_record_pos_bf (obj, offset);
923 logf (LOG_DEBUG, "No record at position %d", offset);
926 interp->result = "DB";
932 * do_recordType: Return record type (if any) at position.
934 static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv)
936 WaisSetTcl_Obj *obj = o;
946 sprintf (interp->result, "wrong # args");
949 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
952 rec = wais_lookup_record_pos_bf (obj, offset);
956 Tcl_AppendElement (interp, "WAIS");
961 * do_getWAIS: Return WAIS record at position.
963 static int do_getWAIS (void *o, Tcl_Interp *interp, int argc, char **argv)
965 WaisSetTcl_Obj *obj = o;
976 sprintf (interp->result, "wrong # args");
979 if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
981 rec = wais_lookup_record_pos_bf (obj, offset);
984 if (!strcmp (argv[3], "score"))
986 sprintf (prbuf, "%ld", (long) rec->score);
987 Tcl_AppendElement (interp, prbuf);
989 else if (!strcmp (argv[3], "headline"))
991 Tcl_AppendElement (interp, rec->headline);
993 else if (!strcmp (argv[3], "documentLength"))
995 sprintf (prbuf, "%ld", (long) rec->documentLength);
996 Tcl_AppendElement (interp, prbuf);
998 else if (!strcmp (argv[3], "text"))
1000 Tcl_AppendElement (interp, rec->documentText);
1002 else if (!strcmp (argv[3], "lines"))
1004 sprintf (prbuf, "%ld", (long) rec->lines);
1005 Tcl_AppendElement (interp, prbuf);
1011 static IrTcl_Method wais_set_method_tab[] = {
1012 { "maxDocs", do_maxDocs, NULL },
1013 { "search", do_search, NULL },
1014 { "present", do_present, NULL },
1015 { "responseStatus", do_responseStatus, NULL },
1016 { "type", do_type, NULL },
1017 { "recordType", do_recordType, NULL },
1018 { "getWAIS", do_getWAIS, NULL },
1023 * wais_obj_method: Wais Set Object methods
1025 static int wais_set_obj_method (ClientData clientData, Tcl_Interp *interp,
1026 int argc, char **argv)
1028 IrTcl_Methods tab[3];
1029 WaisSetTcl_Obj *p = clientData;
1035 tab[0].tab = wais_set_method_tab;
1039 if (ir_tcl_method (interp, argc, argv, tab, &r) == TCL_ERROR)
1041 return (*ir_set_obj_class.ir_method)((ClientData) p->irtcl_set_obj,
1042 interp, argc, argv);
1047 int wais_set_obj_init (ClientData clientData, Tcl_Interp *interp,
1048 int argc, char **argv, ClientData *subData,
1049 ClientData parentData)
1051 IrTcl_Methods tab[3];
1052 WaisSetTcl_Obj *obj;
1056 assert (parentData);
1059 interp->result = "wrong # args";
1062 obj = ir_tcl_malloc (sizeof(*obj));
1063 obj->parent = (WaisTcl_Obj *) parentData;
1064 logf (LOG_DEBUG, "parent = %p", obj->parent);
1065 obj->interp = interp;
1067 obj->addinfo = NULL;
1069 logf (LOG_DEBUG, "wais set object create %s", argv[1]);
1071 r = (*ir_set_obj_class.ir_init)(clientData, interp, argc, argv, &subP,
1072 obj->parent->irtcl_obj);
1075 obj->irtcl_set_obj = subP;
1077 tab[0].tab = wais_set_method_tab;
1081 if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR)
1083 Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
1084 /* cleanup missing ... */
1093 * wais_set_obj_delete: Wais Set Object disposal
1095 static void wais_set_obj_delete (ClientData clientData)
1097 WaisSetTcl_Obj *obj = clientData;
1098 IrTcl_Methods tab[3];
1100 logf (LOG_DEBUG, "wais set object delete");
1102 tab[0].tab = wais_set_method_tab;
1106 ir_tcl_method (NULL, -1, NULL, tab, NULL);
1108 (*ir_set_obj_class.ir_delete)((ClientData) obj->irtcl_set_obj);
1114 * wais_set_obj_mk: Wais Set Object creation
1116 static int wais_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
1117 int argc, char **argv)
1121 Tcl_CmdInfo parent_info;
1125 interp->result = "wrong # args";
1128 parent_info.clientData = 0;
1129 if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
1131 interp->result = "No parent";
1134 r = wais_set_obj_init (clientData, interp, argc, argv, &subData,
1135 parent_info.clientData);
1138 Tcl_CreateCommand (interp, argv[1], wais_set_obj_method,
1139 subData, wais_set_obj_delete);
1144 /* --- R E G I S T R A T I O N ---------------------------------------- */
1146 * Waistcl_init: Registration of TCL commands.
1148 int Waistcl_Init (Tcl_Interp *interp)
1150 Tcl_CreateCommand (interp, "wais", wais_obj_mk, (ClientData) NULL,
1151 (Tcl_CmdDeleteProc *) NULL);
1152 Tcl_CreateCommand (interp, "wais-set", wais_set_obj_mk,
1153 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);