First work on Explain.
[ir-tcl-moved-to-github.git] / ir-tcl.c
index 2ac5a47..2db9f28 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -1,11 +1,35 @@
 /*
  * IR toolkit for tcl/tk
- * (c) Index Data 1995
+ * (c) Index Data 1995-1996
  * See the file LICENSE for details.
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.86  1996-03-20 13:54:04  adam
+ * Revision 1.93  1996-08-16 15:07:45  adam
+ * First work on Explain.
+ *
+ * Revision 1.92  1996/08/09  15:33:07  adam
+ * Modified the code to use tk4.1/tcl7.5 patch level 1. The time-driven
+ * polling is no longer activated on Windows since asynchrounous I/O works
+ * better.
+ *
+ * Revision 1.91  1996/07/03  13:31:11  adam
+ * The xmalloc/xfree functions from YAZ are used to manage memory.
+ *
+ * Revision 1.90  1996/06/27  14:21:00  adam
+ * Yet another Windows port.
+ *
+ * Revision 1.89  1996/06/11  15:27:15  adam
+ * Event type set to connect a little earlier in the do_connect function.
+ *
+ * Revision 1.88  1996/06/03  09:04:22  adam
+ * Changed a few logf calls.
+ *
+ * Revision 1.87  1996/05/29  06:37:51  adam
+ * Function ir_tcl_get_grs_r enhanced so that specific elements can be
+ * extracted.
+ *
+ * Revision 1.86  1996/03/20 13:54:04  adam
  * The Tcl_File structure is only manipulated in the Tk-event interface
  * in tkinit.c.
  *
 
 #include <stdlib.h>
 #include <stdio.h>
+#ifdef WINDOWS
+
+#else
 #include <unistd.h>
+#endif
 #include <time.h>
 #include <assert.h>
 
@@ -356,14 +384,15 @@ static void delete_IR_record (IrTcl_RecordList *rl)
         default:
             break;
         }
-        free (rl->u.dbrec.buf);
+        xfree (rl->u.dbrec.buf);
+        rl->u.dbrec.buf = NULL;
         break;
     case Z_NamePlusRecord_surrogateDiagnostic:
         ir_deleteDiags (&rl->u.surrogateDiagnostics.list,
                         &rl->u.surrogateDiagnostics.num);
         break;
     }
-    free (rl->elements);
+    xfree (rl->elements);
 }
 
 static IrTcl_RecordList *new_IR_record (IrTcl_SetObj *setobj, 
@@ -407,10 +436,12 @@ int ir_tcl_eval (Tcl_Interp *interp, const char *command)
     strcpy (tmp, command);
     r = Tcl_Eval (interp, tmp);
     if (r == TCL_ERROR)
+    {
         logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, 
               interp->result);
+    }
     Tcl_FreeResult (interp);
-    free (tmp);
+    xfree (tmp);
     return r;
 }
 
@@ -462,7 +493,7 @@ static void delete_IR_records (IrTcl_SetObj *setobj)
     {
         delete_IR_record (rl);
         rl1 = rl->next;
-        free (rl);
+        xfree (rl);
     }
     setobj->record_list = NULL;
 }
@@ -568,7 +599,7 @@ static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src)
 
 static void get_referenceId (char **dst, Z_ReferenceId *src)
 {
-    free (*dst);
+    xfree (*dst);
     if (!src)
     {
         *dst = NULL;
@@ -593,6 +624,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
 
     if (argc <= 0)
         return TCL_OK;
+    logf (LOG_DEBUG, "init %s", *argv);
     if (!p->cs_link)
     {
         interp->result = "init: not connected";
@@ -871,7 +903,7 @@ static int do_implementationName (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->implementationName);
     if (argc == 3)
     {
-        free (p->implementationName);
+        xfree (p->implementationName);
         if (ir_tcl_strdup (interp, &p->implementationName, argv[2])
             == TCL_ERROR)
             return TCL_ERROR;
@@ -906,7 +938,11 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp,
 
     if (argc == 0)
         return ir_tcl_strdup (interp, &p->implementationVersion, 
-                          "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
+                          "YAZ: " YAZ_VERSION
+#ifdef IR_TCL_VERSION
+                          " / Irtcl: " IR_TCL_VERSION
+#endif
+                          );
     else if (argc == -1)
         return ir_tcl_strdel (interp, &p->implementationVersion);
     Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
@@ -980,10 +1016,10 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp,
 
     if (argc >= 3 || argc == -1)
     {
-        free (p->idAuthenticationOpen);
-        free (p->idAuthenticationGroupId);
-        free (p->idAuthenticationUserId);
-        free (p->idAuthenticationPassword);
+        xfree (p->idAuthenticationOpen);
+        xfree (p->idAuthenticationGroupId);
+        xfree (p->idAuthenticationUserId);
+        xfree (p->idAuthenticationPassword);
     }
     if (argc >= 3 || argc <= 0)
     {
@@ -1044,6 +1080,7 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         return TCL_OK;
     if (argc == 3)
     {
+        logf (LOG_DEBUG, "connect %s %s", *argv, argv[2]);
         if (p->hostname)
         {
             interp->result = "already connected";
@@ -1084,23 +1121,23 @@ static int do_connect (void *obj, Tcl_Interp *interp,
         }
         if (ir_tcl_strdup (interp, &p->hostname, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
+        p->eventType = "connect";
         if ((r=cs_connect (p->cs_link, addr)) < 0)
         {
             interp->result = "connect fail";
             ir_tcl_disconnect (p);
             return TCL_ERROR;
         }
-        logf(LOG_DEBUG, "cs_connect() returned %d fd=%d", r,
-             cs_fileno(p->cs_link));
-        p->eventType = "connect";
         ir_select_add (cs_fileno (p->cs_link), p);
         if (r == 1)
         {
+            logf (LOG_DEBUG, "connect pending fd=%d", cs_fileno(p->cs_link));
             ir_select_add_write (cs_fileno (p->cs_link), p);
             p->state = IR_TCL_R_Connecting;
         }
         else
         {
+            logf (LOG_DEBUG, "connect ok fd=%d", cs_fileno(p->cs_link));
             p->state = IR_TCL_R_Idle;
             if (p->callback)
                 ir_tcl_eval (p->interp, p->callback);
@@ -1119,7 +1156,7 @@ void ir_tcl_disconnect (IrTcl_Obj *p)
     if (p->hostname)
     {
         logf(LOG_DEBUG, "Closing connection to %s", p->hostname);
-        free (p->hostname);
+        xfree (p->hostname);
         p->hostname = NULL;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         ir_select_remove (cs_fileno (p->cs_link), p);
@@ -1179,7 +1216,7 @@ static int do_comstack (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->comstackType);
     else if (argc == 3)
     {
-        free (obj->comstackType);
+        xfree (obj->comstackType);
         if (ir_tcl_strdup (interp, &obj->comstackType, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1240,7 +1277,7 @@ static int do_callback (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->callback);
     if (argc == 3)
     {
-        free (p->callback);
+        xfree (p->callback);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &p->callback, argv[2]) == TCL_ERROR)
@@ -1269,7 +1306,7 @@ static int do_failback (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->failback);
     else if (argc == 3)
     {
-        free (p->failback);
+        xfree (p->failback);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &p->failback, argv[2]) == TCL_ERROR)
@@ -1298,7 +1335,7 @@ static int do_initResponse (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->initResponse);
     if (argc == 3)
     {
-        free (p->initResponse);
+        xfree (p->initResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &p->initResponse, argv[2]) == TCL_ERROR)
@@ -1385,8 +1422,8 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
     if (argc == -1)
     {
         for (i=0; i<p->num_databaseNames; i++)
-            free (p->databaseNames[i]);
-        free (p->databaseNames);
+            xfree (p->databaseNames[i]);
+        xfree (p->databaseNames);
     }
     if (argc <= 0)
     {
@@ -1403,8 +1440,8 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp,
     if (p->databaseNames)
     {
         for (i=0; i<p->num_databaseNames; i++)
-            free (p->databaseNames[i]);
-        free (p->databaseNames);
+            xfree (p->databaseNames[i]);
+        xfree (p->databaseNames);
     }
     p->num_databaseNames = argc - 2;
     p->databaseNames =
@@ -1449,7 +1486,7 @@ static int do_queryType (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->queryType);
     if (argc == 3)
     {
-        free (p->queryType);
+        xfree (p->queryType);
         if (ir_tcl_strdup (interp, &p->queryType, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1541,7 +1578,7 @@ static int do_referenceId (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->referenceId);
     if (argc == 3)
     {
-        free (p->referenceId);
+        xfree (p->referenceId);
         if (ir_tcl_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1564,13 +1601,13 @@ static int do_preferredRecordSyntax (void *obj, Tcl_Interp *interp,
     }
     else if (argc == -1)
     {
-        free (p->preferredRecordSyntax);
+        xfree (p->preferredRecordSyntax);
         p->preferredRecordSyntax = NULL;
         return TCL_OK;
     }
     if (argc == 3)
     {
-        free (p->preferredRecordSyntax);
+        xfree (p->preferredRecordSyntax);
         p->preferredRecordSyntax = NULL;
         if (argv[2][0] && (p->preferredRecordSyntax = 
                            ir_tcl_malloc (sizeof(*p->preferredRecordSyntax))))
@@ -1603,7 +1640,7 @@ static int do_elementSetNames (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->elementSetNames);
     if (argc == 3)
     {
-        free (p->elementSetNames);
+        xfree (p->elementSetNames);
         if (ir_tcl_strdup (interp, &p->elementSetNames, argv[2]) == TCL_ERROR)
             return TCL_ERROR;
     }
@@ -1628,7 +1665,7 @@ static int do_smallSetElementSetNames (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->smallSetElementSetNames);
     if (argc == 3)
     {
-        free (p->smallSetElementSetNames);
+        xfree (p->smallSetElementSetNames);
         if (ir_tcl_strdup (interp, &p->smallSetElementSetNames,
                            argv[2]) == TCL_ERROR)
             return TCL_ERROR;
@@ -1654,7 +1691,7 @@ static int do_mediumSetElementSetNames (void *obj, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &p->mediumSetElementSetNames);
     if (argc == 3)
     {
-        free (p->mediumSetElementSetNames);
+        xfree (p->mediumSetElementSetNames);
         if (ir_tcl_strdup (interp, &p->mediumSetElementSetNames,
                            argv[2]) == TCL_ERROR)
             return TCL_ERROR;
@@ -1759,7 +1796,7 @@ static void ir_obj_delete (ClientData clientData)
     odr_destroy (obj->odr_in);
     odr_destroy (obj->odr_out);
     odr_destroy (obj->odr_pr);
-    free (obj);
+    xfree (obj);
 }
 
 /* 
@@ -1862,9 +1899,11 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
     p = obj->parent;
     if (argc != 3)
     {
+        logf (LOG_DEBUG, "search %s", *argv);
         interp->result = "wrong # args";
         return TCL_ERROR;
     }
+    logf (LOG_DEBUG, "search %s %s", *argv, argv[2]);
     if (!obj->set_inher.num_databaseNames)
     {
         interp->result = "no databaseNames";
@@ -1932,7 +1971,8 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         req->mediumSetElementSetNames = NULL; 
     
     req->query = &query;
-    
+   
+    logf (LOG_DEBUG, "queryType %s", obj->set_inher.queryType);
     if (!strcmp (obj->set_inher.queryType, "rpn"))
     {
         Z_RPNQuery *RPNquery;
@@ -1945,7 +1985,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         }
         query.which = Z_Query_type_1;
         query.u.type_1 = RPNquery;
-        logf (LOG_DEBUG, "RPN");
     }
 #if CCL2RPN
     else if (!strcmp (obj->set_inher.queryType, "cclrpn"))
@@ -1967,13 +2006,14 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
                               ccl_err_msg(error), NULL);
             return TCL_ERROR;
         }
+#if 0
         ccl_pr_tree (rpn, stderr);
         fprintf (stderr, "\n");
+#endif
         assert((RPNquery = ccl_rpn_query(rpn)));
         RPNquery->attributeSetId = oid_getoidbyent (&bib1);
         query.which = Z_Query_type_1;
         query.u.type_1 = RPNquery;
-        logf (LOG_DEBUG, "CCLRPN");
     }
 #endif
     else if (!strcmp (obj->set_inher.queryType, "ccl"))
@@ -1982,7 +2022,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         query.u.type_2 = &ccl_query;
         ccl_query.buf = (unsigned char *) argv[2];
         ccl_query.len = strlen (argv[2]);
-        logf (LOG_DEBUG, "CCL");
     }
     else
     {
@@ -2009,7 +2048,7 @@ static int do_searchResponse (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->searchResponse);
     if (argc == 3)
     {
-        free (obj->searchResponse);
+        xfree (obj->searchResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &obj->searchResponse, argv[2])
@@ -2039,7 +2078,7 @@ static int do_presentResponse (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->presentResponse);
     if (argc == 3)
     {
-        free (obj->presentResponse);
+        xfree (obj->presentResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &obj->presentResponse, argv[2])
@@ -2126,7 +2165,7 @@ static int do_setName (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->setName);
     if (argc == 3)
     {
-        free (obj->setName);
+        xfree (obj->setName);
         if (ir_tcl_strdup (interp, &obj->setName, argv[2])
             == TCL_ERROR)
             return TCL_ERROR;
@@ -2256,7 +2295,7 @@ static int do_recordElements (void *o, Tcl_Interp *interp,
     }
     if (argc == 3)
     {
-        free (obj->recordElements);
+        xfree (obj->recordElements);
         return ir_tcl_strdup (NULL, &obj->recordElements, 
                               (*argv[2] ? argv[2] : NULL));
     }
@@ -2275,7 +2314,6 @@ static int ir_diagResult (Tcl_Interp *interp, IrTcl_Diagnostic *list, int num)
 
     for (i = 0; i<num; i++)
     {
-        logf (LOG_DEBUG, "Diagnostic, code %d", list[i].condition);
         sprintf (buf, "%d", list[i].condition);
         Tcl_AppendElement (interp, buf);
         cp = diagbib1_str (list[i].condition);
@@ -2393,7 +2431,7 @@ static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 
 
 /*
- * do_getGrs: Get a GRS1 Record
+ * do_getGrs: Get a GRS-1 Record
  */
 static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 {
@@ -2428,6 +2466,54 @@ static int do_getGrs (void *o, Tcl_Interp *interp, int argc, char **argv)
 
 
 /*
+ * do_getExplain: Get an Explain Record
+ */
+static int do_getExplain (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    IrTcl_Obj *p = obj->parent;
+    void *rr;
+    Z_ext_typeent *etype;
+    int offset;
+    IrTcl_RecordList *rl;
+
+    if (argc <= 0)
+        return TCL_OK;
+    if (argc < 3)
+    {
+        sprintf (interp->result, "wrong # args");
+        return TCL_ERROR;
+    }
+    if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
+        return TCL_ERROR;
+    rl = find_IR_record (obj, offset);
+    if (!rl)
+    {
+        Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->which != Z_NamePlusRecord_databaseRecord)
+    {
+        Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->u.dbrec.type != VAL_EXPLAIN)
+        return TCL_OK;
+
+    if (!(etype = z_ext_getentbyref (VAL_EXPLAIN)))
+        return TCL_OK;
+
+    odr_setbuf (p->odr_in, rl->u.dbrec.buf, rl->u.dbrec.size, 0);
+    if (!(*etype->fun)(p->odr_in, &rr, 0))
+        return TCL_OK;
+    
+    if (etype->what != Z_External_explainRecord)
+        return TCL_OK;
+
+    return ir_tcl_get_explain (interp, rr, argc, argv);
+}
+
+/*
  * do_responseStatus: Return response status (present or search)
  */
 static int do_responseStatus (void *o, Tcl_Interp *interp, 
@@ -2495,6 +2581,7 @@ static int do_present (void *o, Tcl_Interp *interp, int argc, char **argv)
     }
     else 
         number = 10;
+    logf (LOG_DEBUG, "present %s %d %d", *argv, start, number);
     p = obj->parent;
     if (!p->cs_link)
     {
@@ -2602,6 +2689,7 @@ static IrTcl_Method ir_set_method_tab[] = {
     { "getMarc",                 do_getMarc, NULL},
     { "getSutrs",                do_getSutrs, NULL},
     { "getGrs",                  do_getGrs, NULL},
+    { "getExplain",              do_getExplain, NULL},
     { "recordType",              do_recordType, NULL},
     { "recordElements",          do_recordElements, NULL},
     { "diag",                    do_diag, NULL},
@@ -2653,7 +2741,7 @@ static void ir_set_obj_delete (ClientData clientData)
 
     ir_tcl_method (NULL, -1, NULL, tabs, NULL);
 
-    free (p);
+    xfree (p);
 }
 
 /*
@@ -2672,7 +2760,7 @@ static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp,
         return TCL_ERROR;
     }
     obj = ir_tcl_malloc (sizeof(*obj));
-    logf (LOG_DEBUG, "ir set create");
+    logf (LOG_DEBUG, "ir set create %s", argv[1]);
     if (parentData)
     {
         int i;
@@ -2803,6 +2891,7 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
         interp->result = "wrong # args";
         return TCL_ERROR;
     }
+    logf (LOG_DEBUG, "scan %s %s", *argv, argv[2]);
     if (!p->set_inher.num_databaseNames)
     {
         interp->result = "no databaseNames";
@@ -2841,8 +2930,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv)
     bib1.value = VAL_BIB1;
 
     req->attributeSet = oid_getoidbyent (&bib1);
-    ccl_pr_tree (rpn, stderr);
-    fprintf (stderr, "\n");
     if (!(req->termListAndStartPoint = ccl_scan_query (rpn)))
         return TCL_ERROR;
 #endif
@@ -2875,7 +2962,7 @@ static int do_scanResponse (void *o, Tcl_Interp *interp,
         return ir_tcl_strdel (interp, &obj->scanResponse);
     if (argc == 3)
     {
-        free (obj->scanResponse);
+        xfree (obj->scanResponse);
         if (argv[2][0])
         {
             if (ir_tcl_strdup (interp, &obj->scanResponse, argv[2])
@@ -3082,7 +3169,7 @@ static void ir_scan_obj_delete (ClientData clientData)
     tabs[1].tab = NULL;
 
     ir_tcl_method (NULL, -1, NULL, tabs, NULL);
-    free (obj);
+    xfree (obj);
 }
 
 /* 
@@ -3100,6 +3187,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp,
         interp->result = "wrong # args";
         return TCL_ERROR;
     }
+    logf (LOG_DEBUG, "ir scan create %s", argv[1]);
     if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info))
     {
         interp->result = "No parent";
@@ -3133,13 +3221,13 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
 
     get_referenceId (&p->set_inher.referenceId, initrs->referenceId);
 
-    free (p->targetImplementationId);
+    xfree (p->targetImplementationId);
     ir_tcl_strdup (p->interp, &p->targetImplementationId,
                initrs->implementationId);
-    free (p->targetImplementationName);
+    xfree (p->targetImplementationName);
     ir_tcl_strdup (p->interp, &p->targetImplementationName,
                initrs->implementationName);
-    free (p->targetImplementationVersion);
+    xfree (p->targetImplementationVersion);
     ir_tcl_strdup (p->interp, &p->targetImplementationVersion,
                initrs->implementationVersion);
 
@@ -3149,7 +3237,7 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
     memcpy (&p->options, initrs->options, sizeof(initrs->options));
     memcpy (&p->protocolVersion, initrs->protocolVersion,
             sizeof(initrs->protocolVersion));
-    free (p->userInformationField);
+    xfree (p->userInformationField);
     p->userInformationField = NULL;
     if (initrs->userInformationField)
     {
@@ -3173,14 +3261,14 @@ static void ir_deleteDiags (IrTcl_Diagnostic **dst_list, int *dst_num)
 {
     int i;
     for (i = 0; i<*dst_num; i++)
-        free (dst_list[i]->addinfo);
-    free (*dst_list);
+        xfree (dst_list[i]->addinfo);
+    xfree (*dst_list);
     *dst_list = NULL;
     *dst_num = 0;
 }
 
 static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
-                    Z_DiagRec **list, int num)
+                            Z_DiagRec **list, int num)
 {
     int i;
     char *addinfo;
@@ -3189,6 +3277,7 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
     *dst_list = ir_tcl_malloc (sizeof(**dst_list) * num);
     for (i = 0; i<num; i++)
     {
+        const char *cp;
         switch (list[i]->which)
         {
         case Z_DiagRec_defaultFormat:
@@ -3197,6 +3286,9 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
             if (addinfo && 
                 ((*dst_list)[i].addinfo = ir_tcl_malloc (strlen(addinfo)+1)))
                 strcpy ((*dst_list)[i].addinfo, addinfo);
+            cp = diagbib1_str ((*dst_list)[i].condition);
+            logf (LOG_DEBUG, "Diag %d %s %s", (*dst_list)[i].condition,
+                  cp ? cp : "", addinfo ? addinfo : "");
             break;
         default:
             (*dst_list)[i].addinfo = NULL;
@@ -3205,7 +3297,86 @@ static void ir_handleDiags (IrTcl_Diagnostic **dst_list, int *dst_num,
     }
 }
 
-static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
+static void ir_handleDBRecord (IrTcl_Obj *p, IrTcl_RecordList *rl,
+                               Z_External *oe)
+{
+    struct oident *ident;
+    Z_ext_typeent *etype;
+                
+    rl->u.dbrec.size = oe->u.octet_aligned->len;
+    rl->u.dbrec.buf = NULL;
+    
+    if ((ident = oid_getentbyoid (oe->direct_reference)))
+        rl->u.dbrec.type = ident->value;
+    else
+        rl->u.dbrec.type = VAL_USMARC;
+
+    if (ident && (oe->which == Z_External_single ||
+                  oe->which == Z_External_octet)
+        && (etype = z_ext_getentbyref (ident->value)))
+    {
+        void *rr;
+        
+        odr_setbuf (p->odr_in, (char*) oe->u.octet_aligned->buf,
+                    oe->u.octet_aligned->len, 0);
+        if (!(*etype->fun)(p->odr_in, &rr, 0))
+            return;
+        switch (etype->what)
+        {
+        case Z_External_sutrs:
+            logf (LOG_LOG, "Z_External_sutrs");
+            oe->u.sutrs = rr;
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
+            {
+                memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
+                        oe->u.sutrs->len);
+                rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
+            }
+            rl->u.dbrec.size = oe->u.sutrs->len;
+            break;
+        case Z_External_grs1:
+            logf (LOG_LOG, "Z_External_grs1");
+            oe->u.grs1 = rr;
+            ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
+            break;
+        case Z_External_explainRecord:
+            logf (LOG_LOG, "Z_External_explainRecord");
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
+            {
+                memcpy (rl->u.dbrec.buf, oe->u.octet_aligned->buf,
+                        rl->u.dbrec.size);
+            }
+            break;
+        }
+    }
+    else
+    {
+        if (oe->which == Z_External_octet && rl->u.dbrec.size > 0)
+        {
+            char *buf = (char*) oe->u.octet_aligned->buf;
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
+                memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
+        }
+        else if (rl->u.dbrec.type == VAL_SUTRS && 
+                 oe->which == Z_External_sutrs)
+        {
+            if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
+            {
+                memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
+                        oe->u.sutrs->len);
+                rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
+            }
+            rl->u.dbrec.size = oe->u.sutrs->len;
+        }
+        else if (rl->u.dbrec.type == VAL_GRS1 && 
+                 oe->which == Z_External_grs1)
+        {
+            ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
+        }
+    }
+}
+
+static void ir_handleZRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
                               const char *elements)
 {
     IrTcl_Obj *p = o;
@@ -3223,64 +3394,21 @@ static void ir_handleRecords (void *o, Z_Records *zrs, IrTcl_SetObj *setobj,
         setobj->numberOfRecordsReturned = 
             zrs->u.databaseOrSurDiagnostics->num_records;
         logf (LOG_DEBUG, "Got %d records", setobj->numberOfRecordsReturned);
-        for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
+        for (offset = 0; offset < setobj->numberOfRecordsReturned; offset++)
         {
-            rl = new_IR_record (setobj, setobj->start + offset,
-                                zrs->u.databaseOrSurDiagnostics->
-                                records[offset]->which,
+            Z_NamePlusRecord *znpr = zrs->u.databaseOrSurDiagnostics->
+                records[offset];
+            
+            rl = new_IR_record (setobj, setobj->start + offset, znpr->which,
                                 elements);
             if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
-            {
                 ir_handleDiags (&rl->u.surrogateDiagnostics.list,
                                 &rl->u.surrogateDiagnostics.num,
-                                &zrs->u.databaseOrSurDiagnostics->
-                                records[offset]->u.surrogateDiagnostic,
+                                &znpr->u.surrogateDiagnostic,
                                 1);
-            } 
             else
-            {
-                Z_DatabaseRecord *zr; 
-                Z_External *oe;
-                struct oident *ident;
-                
-                zr = zrs->u.databaseOrSurDiagnostics->records[offset]
-                    ->u.databaseRecord;
-                oe = (Z_External*) zr;
-                rl->u.dbrec.size = zr->u.octet_aligned->len;
-
-                if ((ident = oid_getentbyoid (oe->direct_reference)))
-                    rl->u.dbrec.type = ident->value;
-                else
-                    rl->u.dbrec.type = VAL_USMARC;
-
-                if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
-                {
-                    char *buf = (char*) zr->u.octet_aligned->buf;
-                    if ((rl->u.dbrec.buf = ir_tcl_malloc (rl->u.dbrec.size)))
-                        memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
-                }
-                else if (rl->u.dbrec.type == VAL_SUTRS && 
-                         oe->which == Z_External_sutrs)
-                {
-                    odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
-                                oe->u.single_ASN1_type->len, 0);
-                    if ((rl->u.dbrec.buf = ir_tcl_malloc (oe->u.sutrs->len+1)))
-                    {
-                        memcpy (rl->u.dbrec.buf, oe->u.sutrs->buf,
-                                oe->u.sutrs->len);
-                        rl->u.dbrec.buf[oe->u.sutrs->len] = '\0';
-                    }
-                    rl->u.dbrec.size = oe->u.sutrs->len;
-                }
-                else if (rl->u.dbrec.type == VAL_GRS1 && 
-                         oe->which == Z_External_grs1)
-                {
-                    ir_tcl_grs_mk (oe->u.grs1, &rl->u.dbrec.u.grs1);
-                    rl->u.dbrec.buf = NULL;
-                }
-                else
-                    rl->u.dbrec.buf = NULL;
-            }
+                ir_handleDBRecord (p, rl,
+                                   (Z_External*) (znpr->u.databaseRecord));
         }
     }
     else if (zrs->which == Z_Records_multipleNSD)
@@ -3323,7 +3451,7 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
     if (searchrs->nextResultSetPosition)
         setobj->nextResultSetPosition = *searchrs->nextResultSetPosition;
 
-    logf (LOG_DEBUG, "Search response %d, %d hits", 
+    logf (LOG_DEBUG, "status %d hits %d", 
           setobj->searchStatus, setobj->resultCount);
     if (zrs)
     {
@@ -3332,7 +3460,7 @@ static void ir_searchResponse (void *o, Z_SearchResponse *searchrs,
             es = setobj->set_inher.smallSetElementSetNames;
         else 
             es = setobj->set_inher.mediumSetElementSetNames;
-        ir_handleRecords (o, zrs, setobj, es);
+        ir_handleZRecords (o, zrs, setobj, es);
     }
     else
         setobj->recordFlag = 0;
@@ -3354,7 +3482,7 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs,
     get_referenceId (&setobj->set_inher.referenceId, presrs->referenceId);
     setobj->nextResultSetPosition = *presrs->nextResultSetPosition;
     if (zrs)
-        ir_handleRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
+        ir_handleZRecords (o, zrs, setobj, setobj->set_inher.elementSetNames);
     else
     {
         setobj->recordFlag = 0;
@@ -3387,7 +3515,7 @@ static void ir_scanResponse (void *o, Z_ScanResponse *scanrs,
         scanobj->positionOfTerm = -1;
     logf (LOG_DEBUG, "positionOfTerm=%d", scanobj->positionOfTerm);
 
-    free (scanobj->entries);
+    xfree (scanobj->entries);
     scanobj->entries = NULL;
 
     ir_deleteDiags (&scanobj->nonSurrogateDiagnosticList,
@@ -3545,7 +3673,6 @@ static void ir_select_read (ClientData clientData)
             ir_obj_delete (p);
             return;
         }
-        logf(LOG_DEBUG, "Decoded ok");
         /* handle APDU and invoke callback */
         rq = p->request_queue;
         if (!rq)
@@ -3554,7 +3681,7 @@ static void ir_select_read (ClientData clientData)
             exit (1);
         }
         object_name = rq->object_name;
-        logf (LOG_DEBUG, "getCommandInfo (%s)", object_name);
+        logf (LOG_DEBUG, "Object %s", object_name);
         apdu_call = NULL;
         if (Tcl_GetCommandInfo (p->interp, object_name, &cmd_info))
         {
@@ -3605,10 +3732,10 @@ static void ir_select_read (ClientData clientData)
             ir_tcl_eval (p->interp, apdu_call);
         else if (rq->callback)
             ir_tcl_eval (p->interp, rq->callback);
-        free (rq->buf_out);
-        free (rq->callback);
-        free (rq->object_name);
-        free (rq);
+        xfree (rq->buf_out);
+        xfree (rq->callback);
+        xfree (rq->object_name);
+        xfree (rq);
         odr_reset (p->odr_in);
         if (p->ref_count == 1)
         {
@@ -3624,7 +3751,7 @@ static void ir_select_read (ClientData clientData)
 /*
  * ir_select_write: handle outgoing packages - not yet written.
  */
-static void ir_select_write (ClientData clientData)
+static int ir_select_write (ClientData clientData)
 {
     IrTcl_Obj *p = clientData;
     int r;
@@ -3638,7 +3765,7 @@ static void ir_select_write (ClientData clientData)
         if (r == 1)
         {
             logf (LOG_DEBUG, "cs_rcvconnect returned 1");
-            return;
+            return 2;
         }
         p->state = IR_TCL_R_Idle;
         p->ref_count = 2;
@@ -3653,22 +3780,22 @@ static void ir_select_write (ClientData clientData)
                 ir_tcl_eval (p->interp, p->failback);
             }
             ir_obj_delete (p);
-            return;
+            return 2;
         }
         if (p->callback)
             ir_tcl_eval (p->interp, p->callback);
         ir_obj_delete (p);
-        return;
+        return 2;
     }
     rq = p->request_queue;
     if (!rq || !rq->buf_out)
-        return;
+        return 0;
     assert (rq);
     if ((r=cs_put (p->cs_link, rq->buf_out, rq->len_out)) < 0)
     {
         logf (LOG_DEBUG, "cs_put write fail");
         p->ref_count = 2;
-        free (rq->buf_out);
+        xfree (rq->buf_out);
         rq->buf_out = NULL;
         ir_tcl_disconnect (p);
         if (p->failback)
@@ -3683,17 +3810,23 @@ static void ir_select_write (ClientData clientData)
         logf (LOG_DEBUG, "Write completed");
         p->state = IR_TCL_R_Waiting;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
-        free (rq->buf_out);
+        xfree (rq->buf_out);
         rq->buf_out = NULL;
     }
+    return 1;
 }
 
 static void ir_select_notify (ClientData clientData, int r, int w, int e)
 {
-    if (r)
+    if (w)
+    {
+        if (!ir_select_write (clientData) && r)
+            ir_select_read (clientData);
+    } 
+    else if (r)
+    {
         ir_select_read (clientData);
-    else if (w)
-        ir_select_write (clientData);
+    }
 }
 
 /* ------------------------------------------------------- */