Minor changes.

[ir-tcl-moved-to-github.git] / ir-tcl.c

diff --git a/ir-tcl.c b/ir-tcl.c
index 942ad55..468bf3a 100644 (file)
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,13 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.42  1995-06-19 08:08:52  adam
+ * Revision 1.44  1995-06-19 17:01:20  adam
+ * Minor changes.
+ *
+ * Revision 1.43  1995/06/19  13:06:08  adam
+ * New define: IR_TCL_VERSION.
+ *
+ * Revision 1.42  1995/06/19  08:08:52  adam
  * client.tcl: hotTargets now contain both database and target name.
  * ir-tcl.c: setting protocol edited. Errors in callbacks are logged
  * by logf(LOG_WARN, ...) calls.
@@ -243,7 +249,9 @@ int IrTcl_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);
+        logf (LOG_WARN, "Tcl error in line %d: %s", interp->errorLine, 
+              interp->result);
+    Tcl_FreeResult (interp);
     free (tmp);
     return r;
 }
@@ -573,13 +581,8 @@ static int do_init_request (void *obj, Tcl_Interp *interp,
 static int do_protocolVersion (void *obj, Tcl_Interp *interp,
                                int argc, char **argv)
 {
-    static struct ir_named_entry version_tab[] = {
-    { "1", 0 },
-    { "2", 1 },
-    { "3", 2 },
-    { "4", 3 },
-    { NULL,0}
-    };
+    int version, i;
+    char buf[10];
     IrTcl_Obj *p = obj;
 
     if (argc <= 0)
@@ -589,8 +592,20 @@ static int do_protocolVersion (void *obj, Tcl_Interp *interp,
        ODR_MASK_SET (&p->protocolVersion, 1);
         return TCL_OK;
     }
-    return ir_named_bits (version_tab, &p->protocolVersion,
-                          interp, argc-2, argv+2);
+    if (argc == 3)
+    {
+        if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR)
+            return TCL_ERROR;
+        ODR_MASK_ZERO (&p->protocolVersion);
+        for (i = 0; i<version; i++)
+            ODR_MASK_SET (&p->protocolVersion, i);
+    }
+    for (i = 4; --i >= 0; )
+        if (ODR_MASK_GET (&p->protocolVersion, i))
+            break;
+    sprintf (buf, "%d", i+1);
+    interp->result = buf;
+    return TCL_OK;
 }
 
 /*
@@ -725,7 +740,8 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp,
     IrTcl_Obj *p = obj;
 
     if (argc == 0)
-        return ir_strdup (interp, &p->implementationVersion, YAZ_VERSION);
+        return ir_strdup (interp, &p->implementationVersion, 
+                          "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION);
     else if (argc == -1)
         return ir_strdel (interp, &p->implementationVersion);
     Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL);
@@ -954,6 +970,10 @@ static int do_disconnect (void *obj, Tcl_Interp *interp,
        ODR_MASK_SET (&p->options, 1);
        ODR_MASK_SET (&p->options, 7);
        ODR_MASK_SET (&p->options, 14);
+
+        ODR_MASK_ZERO (&p->protocolVersion);
+       ODR_MASK_SET (&p->protocolVersion, 0);
+       ODR_MASK_SET (&p->protocolVersion, 1);
     }
     assert (!p->cs_link);
     return TCL_OK;
@@ -1007,7 +1027,7 @@ static int do_callback (void *obj, Tcl_Interp *interp,
        }
        else
            p->callback = NULL;
-        p->interp = irTcl_interp;
+        p->interp = interp;
     }
     return TCL_OK;
 }
@@ -1037,7 +1057,7 @@ static int do_failback (void *obj, Tcl_Interp *interp,
        }
        else
            p->failback = NULL;
-        p->interp = irTcl_interp;
+        p->interp = interp;
     }
     return TCL_OK;
 }
@@ -2787,7 +2807,10 @@ void ir_select_read (ClientData clientData)
     {
         r = cs_rcvconnect (p->cs_link);
         if (r == 1)
+        {
+            logf (LOG_WARN, "cs_rcvconnect returned 1");
             return;
+        }
         p->connectFlag = 0;
         ir_select_remove_write (cs_fileno (p->cs_link), p);
         if (r < 0)