More work on explain.

Renamed tkinit.c to tkmain.c. The tcl shell uses the Tcl 7.5 interface
for socket i/o instead of the handcrafted one (for Tcl 7.3 and Tcl7.4).

diff --git a/Makefile.in b/Makefile.in
index 28c0a7b..76960de 100644 (file)
--- a/Makefile.in
+++ b/Makefile.in
@@ -2,7 +2,7 @@
 # (c) Index Data 1995-1996
 # See the file LICENSE for details.
 # Sebastian Hammer, Adam Dickmeiss
-# $Id: Makefile.in,v 1.39 1996-08-16 15:07:42 adam Exp $
+# $Id: Makefile.in,v 1.40 1996-08-20 09:27:48 adam Exp $
 SHELL=/bin/sh
 
 # IrTcl Version
@@ -53,12 +53,12 @@ INSTALL_PROGRAM = @INSTALL_PROGRAM@
 INSTALL_DATA = @INSTALL_DATA@
 RANLIB = @RANLIB@
 
-O=ir-tcl.o marc.o queue.o mem.o grs.o explain.o
+O=ir-tcl.o marc.o queue.o mem.o grs.o explain.o events.o
 
 all: ir-tcl ir-tk
 
-ir-tk: libirtcl.a tkinit.o
-       $(CC) $(CFLAGS) tkinit.o -o ir-tk libirtcl.a $(YAZLIB) $(TKLIB) 
+ir-tk: libirtcl.a tkmain.o
+       $(CC) $(CFLAGS) tkmain.o -o ir-tk libirtcl.a $(YAZLIB) $(TKLIB) 
 
 ir-tcl: libirtcl.a tclmain.o
        $(CC) $(CFLAGS) tclmain.o -o ir-tcl libirtcl.a $(YAZLIB) $(TCLLIB) 
@@ -174,5 +174,5 @@ distribution:
 .c.o:
        $(CC) -c $(CFLAGS) $(DEFS) $<
 
-$(O) tkinit.o tclmain.o wais-tcl.o waismain.o: ir-tcl.h ir-tclp.h
+$(O) tkmain.o tclmain.o wais-tcl.o waismain.o: ir-tcl.h ir-tclp.h
 

diff --git a/explain.c b/explain.c
index ad33770..8227d70 100644 (file)
--- a/explain.c
+++ b/explain.c
@@ -5,7 +5,12 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: explain.c,v $
- * Revision 1.1  1996-08-16 15:07:43  adam
+ * Revision 1.2  1996-08-20 09:27:48  adam
+ * More work on explain.
+ * Renamed tkinit.c to tkmain.c. The tcl shell uses the Tcl 7.5 interface
+ * for socket i/o instead of the handcrafted one (for Tcl 7.3 and Tcl7.4).
+ *
+ * Revision 1.1  1996/08/16  15:07:43  adam
  * First work on Explain.
  *
  */
@@ -31,7 +36,6 @@ typedef struct {
 
 typedef char *Z_ElementSetName;
 typedef Odr_oid *Z_AttributeSetId;
-typedef int Z_integer;
 typedef char *Z_InternationalString;
 typedef char *Z_LanguageCode;
 
@@ -51,8 +55,6 @@ static int ir_RetrievalRecordDetails (IrExpArg *iea,
             Z_RetrievalRecordDetails *p, const char *name, int argi);
 static int ir_ElementInfo (IrExpArg *iea,
             Z_ElementInfo *p, const char *name, int argi);
-static int ir_integer (IrExpArg *iea,
-            Z_integer *p, const char *name, int argi);
 static int ir_InternationalString (IrExpArg *iea,
             char *p, const char *name, int argi);
 static int ir_TagSetInfo (IrExpArg *iea,
@@ -176,7 +178,12 @@ ir_match_start (const char *name, void *p, IrExpArg *iea, int argi)
 {
     if (!p)
         return 0;
-    Tcl_AppendResult (iea->interp, name, " {", NULL);
+    if (argi < iea->argc)
+    {
+        if (strcmp (name, iea->argv[argi]))
+            return 0;
+    }
+    Tcl_AppendResult (iea->interp, "{", name, " ", NULL);
     return 1;
 }
 
@@ -202,23 +209,21 @@ ir_choice (IrExpArg *iea, IrExpChoice *clist, int what, void *p, int argi)
 static int ir_null (IrExpArg *iea,
             Odr_null *p, const char *name, int argi)
 {
-    if (p)
-        Tcl_AppendResult (iea->interp, name, " ", NULL);
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    Tcl_AppendResult (iea->interp, "{} ", NULL);
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_CString (IrExpArg *iea,
             char *p, const char *name, int argi)
 {
-    Tcl_AppendResult (iea->interp, "{", name, " ", NULL);
-    if (p)
-        Tcl_AppendElement (iea->interp, p);
-    Tcl_AppendResult (iea->interp, "} ", NULL);
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    Tcl_AppendElement (iea->interp, p);
+    return ir_match_end (name, iea, argi);
 }
 
-
-
 static int ir_ElementSetName (IrExpArg *iea,
             char *p, const char *name, int argi)
 {
@@ -246,25 +251,45 @@ static int ir_GeneralizedTime (IrExpArg *iea,
 static int ir_oid (IrExpArg *iea,
             Odr_oid *p, const char *name, int argi)
 {
-    return TCL_OK;
+    int first = ' ';
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    while (*p != -1)
+    {
+        char buf[32];
+        
+        sprintf (buf, "%c%d", first, *p);
+        Tcl_AppendResult (iea->interp, buf, NULL);
+        first = '.';
+    }
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_TagTypeMapping (IrExpArg *iea,
             Z_TagTypeMapping **p, const char *name, int argi)
 {
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    /* missing */
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_PrimitiveDataType (IrExpArg *iea,
             int *p, const char *name, int argi)
 {
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    /* missing */
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_octet (IrExpArg *iea,
             Odr_oct *p, const char *name, int argi)
 {
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    /* missing */
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_choice_nop (IrExpArg *iea,
@@ -274,64 +299,80 @@ static int ir_choice_nop (IrExpArg *iea,
     return TCL_OK;
 }
 
-static int ir_Term (IrExpArg *iea,
-            Z_Term *p, const char *name, int argi)
-{
-    return TCL_OK;
-}
-
 static int ir_bool (IrExpArg *iea,
             bool_t *p, const char *name, int argi)
 {
-    Tcl_AppendResult (iea->interp, "{", name, " ", NULL);
-    if (p)
-        Tcl_AppendResult (iea->interp, *p ? "1" : "0", NULL);
-    Tcl_AppendResult (iea->interp, "} ", NULL);
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    Tcl_AppendResult (iea->interp, *p ? "1" : "0", NULL);
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_integer (IrExpArg *iea,
             int *p, const char *name, int argi)
 {
-    Tcl_AppendResult (iea->interp, "{", name, NULL);
-    if (p)
-    {
-        char buf[64];
-        sprintf (buf, " %d", *p);
-        Tcl_AppendResult (iea->interp, buf, NULL);
-    }
-    Tcl_AppendResult (iea->interp, "} ", NULL);
-    return TCL_OK;
+    char buf[64];
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    sprintf (buf, " %d", *p);
+    Tcl_AppendResult (iea->interp, buf, NULL);
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_LanguageCode (IrExpArg *iea,
             char *p, const char *name, int argi)
 {
-    if (p)
-        Tcl_AppendResult (iea->interp, name, " ", p, " ", NULL);
-    return TCL_OK;
+    return ir_CString (iea, p, name, argi);
 }
 
 static int ir_External (IrExpArg *iea,
             Z_External *p, const char *name, int argi)
 {
-    return TCL_OK;
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    /* missing */
+    return ir_match_end (name, iea, argi);
 }
 
 static int ir_sequence (int (*fh)(), IrExpArg *iea, void *p, int num, 
                  const char *name, int argi)
 {
     void **pp = (void **) p;
-    if (num > 0 && ir_match_start (name, p, iea, argi))
-    {
-        int i;
-        for (i = 0; i<num; i++)
-            (*fh)(iea, pp[i], "", argi);
-        return ir_match_end (name, iea, argi);
-    }
-    return TCL_OK;
+    int i;
+
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+    for (i = 0; i<num; i++)
+        (*fh)(iea, pp[i], "", argi);
+    return ir_match_end (name, iea, argi);
 }
 
+static int ir_Term (IrExpArg *iea,
+            Z_Term *p, const char *name, int argi)
+{
+    static IrExpChoice arm [] = {
+        { "general",            Z_Term_general,
+                               ir_octet },
+        { "numeric",            Z_Term_numeric,
+                               ir_integer },
+        { "characterString",    Z_Term_characterString,
+                               ir_InternationalString },
+        { "oid",                Z_Term_oid,
+                               ir_oid },
+        { "dateTime",           Z_Term_dateTime,
+                               ir_GeneralizedTime },
+        { "external",           Z_Term_external,
+                               ir_External },
+        { "null",               Z_Term_null,
+                                ir_null },
+        { NULL, 0, NULL }};
+
+    if (!ir_match_start (name, p, iea, ++argi))
+        return TCL_OK;
+
+    ir_choice (iea, arm, p->which, p->u.general, argi);
+    return ir_match_end (name, iea, argi);
+}
 
 static int ir_TargetInfo (IrExpArg *iea,
             Z_TargetInfo *p, const char *name, int argi)
@@ -340,7 +381,7 @@ static int ir_TargetInfo (IrExpArg *iea,
         return TCL_OK;
     ir_CommonInfo (iea, p->commonInfo, "commonInfo", argi);
     ir_InternationalString (iea, p->name, "name", argi);
-    ir_HumanString (iea, p->recentNews, "recent-news", argi);
+    ir_HumanString (iea, p->recentNews, "recentNews", argi);
     ir_IconObject (iea, p->icon, "icon", argi);
     ir_bool (iea, p->namedResultSets, "namedResultSets", argi);
     ir_bool (iea, p->multipleDBsearch, "multipleDBsearch", argi);
@@ -353,7 +394,7 @@ static int ir_TargetInfo (IrExpArg *iea,
     ir_HumanString (iea, p->description, "description", argi);
     ir_sequence (ir_InternationalString, iea, p->nicknames,
                  p->num_nicknames, "nicknames", argi);
-    ir_HumanString (iea, p->usageRest, "usage-rest", argi);
+    ir_HumanString (iea, p->usageRest, "usageRest", argi);
     ir_HumanString (iea, p->paymentAddr, "paymentAddr", argi);
     ir_HumanString (iea, p->hours, "hours", argi);
     ir_sequence (ir_DatabaseList, iea, p->dbCombinations,
@@ -382,7 +423,7 @@ static int ir_DatabaseInfo (IrExpArg *iea,
     ir_sequence (ir_DatabaseName, iea, p->nicknames,
                  p->num_nicknames, "nicknames", argi);
     ir_IconObject (iea, p->icon, "icon", argi);
-    ir_bool (iea, p->userFee, "user-fee", argi);
+    ir_bool (iea, p->userFee, "userFee", argi);
     ir_bool (iea, p->available, "available", argi);
     ir_HumanString (iea, p->titleString, "titleString", argi);
     ir_sequence (ir_HumanString, iea, p->keywords,
@@ -1325,11 +1366,11 @@ static int ir_AccessRestrictionsUnit (IrExpArg *iea,
                                ir_choice_nop },
         { "present",           Z_AccessRestrictions_present,
                                ir_choice_nop },
-        { "specific-elements", Z_AccessRestrictions_specific_elements,
+        { "specificElements",  Z_AccessRestrictions_specific_elements,
                                ir_choice_nop },
-        { "extended-services", Z_AccessRestrictions_extended_services,
+        { "extendedServices",  Z_AccessRestrictions_extended_services,
                                ir_choice_nop },
-        { "by-database",       Z_AccessRestrictions_by_database,
+        { "byDatabase",        Z_AccessRestrictions_by_database,
                                ir_choice_nop },
         { NULL, 0, NULL }};
 
@@ -1434,7 +1475,7 @@ static int ir_AttributeOccurrence (IrExpArg *iea,
             Z_AttributeOccurrence *p, const char *name, int argi)
 {
     static IrExpChoice arm [] = {
-        { "any-or-none", Z_AttributeOcc_anyOrNone, ir_null },
+        { "anyOrNone",   Z_AttributeOcc_anyOrNone, ir_null },
         { "specific",    Z_AttributeOcc_specific,  ir_AttributeValueList },
         { NULL, 0, NULL } };
     if (!ir_match_start (name, p, iea, ++argi))

diff --git a/tclmain.c b/tclmain.c
index bf27a74..7239aed 100644 (file)
--- a/tclmain.c
+++ b/tclmain.c
@@ -1,64 +1,14 @@
 /*
  * 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: tclmain.c,v $
- * Revision 1.18  1996-02-23 17:31:42  adam
- * More functions made available to the wais tcl extension.
- *
- * Revision 1.17  1996/02/21  10:16:21  adam
- * Simplified select handling. Only one function ir_tcl_select_set has
- * to be externally defined.
- *
- * Revision 1.16  1996/02/05  17:58:05  adam
- * Ported ir-tcl to use the beta releases of tcl7.5/tk4.1.
- *
- * Revision 1.15  1996/01/10  09:18:45  adam
- * PDU specific callbacks implemented: initRespnse, searchResponse,
- *  presentResponse and scanResponse.
- * Bug fix in the command line shell (tclmain.c) - discovered on OSF/1.
- *
- * Revision 1.14  1995/09/21  13:11:53  adam
- * Support of dynamic loading.
- * Test script uses load command if necessary.
- *
- * Revision 1.13  1995/08/28  12:21:22  adam
- * Removed lines and list as synonyms of list in MARC extractron.
- * Configure searches also for tk4.0 / tcl7.4.
- *
- * Revision 1.12  1995/08/28  11:07:16  adam
- * Minor changes.
- *
- * Revision 1.11  1995/08/03  13:23:02  adam
- * Request queue.
- *
- * Revision 1.10  1995/06/30  12:39:28  adam
- * Bug fix: loadFile didn't set record type.
- * The MARC routines are a little less strict in the interpretation.
- * Script display.tcl replaces the old marc.tcl.
- * New interactive script: shell.tcl.
- *
- * Revision 1.9  1995/06/26  10:20:20  adam
- * ir-tk works like wish.
- *
- * Revision 1.8  1995/06/21  15:16:44  adam
- * More work on configuration.
- *
- * Revision 1.7  1995/06/21  11:04:54  adam
- * Uses GNU autoconf 2.3.
- * Install procedure implemented.
- * boook bitmaps moved to sub directory bitmaps.
- *
- * Revision 1.6  1995/05/29  08:44:28  adam
- * Work on delete of objects.
- *
- * Revision 1.5  1995/03/20  08:53:30  adam
- * Event loop in tclmain.c rewritten. New method searchStatus.
- *
- * Revision 1.4  1995/03/17  07:50:31  adam
- * Headers have changed a little.
+ * Revision 1.19  1996-08-20 09:27:49  adam
+ * More work on explain.
+ * Renamed tkinit.c to tkmain.c. The tcl shell uses the Tcl 7.5 interface
+ * for socket i/o instead of the handcrafted one (for Tcl 7.3 and Tcl7.4).
  *
  */
 
@@ -68,13 +18,40 @@
 #ifdef _AIX
 #include <sys/select.h>
 #endif
+
 #include <assert.h>
 
 #include <tcl.h>
 #include <log.h>
 #include "ir-tcl.h"
 
+int Tcl_AppInit (Tcl_Interp *interp)
+{
+    if (Tcl_Init(interp) == TCL_ERROR)
+        return TCL_ERROR;
+    if (Irtcl_Init(interp) == TCL_ERROR)
+        return TCL_ERROR;
+#if USE_WAIS
+    if (Waistcl_Init(interp) == TCL_ERROR)
+        return TCL_ERROR;
+#endif
+    return TCL_OK;
+}
+
+#if TCL_MAJOR_VERSION > 7 || (TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION > 4)
+extern int matherr ();
+int *tclDummyMathPtr = (int*) matherr;
+
+int main (int argc, char **argv)
+{
+    Tcl_Main (argc, argv, Tcl_AppInit);
+    return 0;
+}
+
+#else
 static char *fileName = NULL;
+extern int main ();
+int *tclDummyMainPtr = (int*) main;
 
 /* select(2) callbacks */
 struct callback {
@@ -89,19 +66,6 @@ static int max_fd = 3;            /* don't worry: it will grow... */
 
 void tcl_mainloop (Tcl_Interp *interp, int interactive);
 
-int Tcl_AppInit (Tcl_Interp *interp)
-{
-    if (Tcl_Init(interp) == TCL_ERROR)
-        return TCL_ERROR;
-    if (Irtcl_Init(interp) == TCL_ERROR)
-        return TCL_ERROR;
-#if USE_WAIS
-    if (Waistcl_Init(interp) == TCL_ERROR)
-        return TCL_ERROR;
-#endif
-    return TCL_OK;
-}
-
 int main (int argc, char **argv)
 {
     Tcl_Interp *interp;
@@ -261,3 +225,4 @@ void ir_tcl_select_set (void (*f)(ClientData clientData, int r, int w, int e),
         max_fd = fd;
 }
 
+#endif

diff --git a/tkmain.c b/tkmain.c
new file mode 100644 (file)
index 0000000..c770138
--- /dev/null
+++ b/tkmain.c
@@ -0,0 +1,108 @@
+/*
+ * IR toolkit for tcl/tk
+ * (c) Index Data 1995-1996
+ * See the file LICENSE for details.
+ * Sebastian Hammer, Adam Dickmeiss
+ *
+ * $Log: tkmain.c,v $
+ * Revision 1.1  1996-08-20 09:27:49  adam
+ * More work on explain.
+ * Renamed tkinit.c to tkmain.c. The tcl shell uses the Tcl 7.5 interface
+ * for socket i/o instead of the handcrafted one (for Tcl 7.3 and Tcl7.4).
+ *
+ */
+
+#include <tk.h>
+#include <log.h>
+#include "ir-tcl.h"
+
+/* socket layer code for tk3.x and tk4.0 */
+#if TK_MAJOR_VERSION < 4 || (TK_MAJOR_VERSION == 4 && TK_MINOR_VERSION == 0)
+
+struct sel_proc {
+    void (*f)(ClientData clientData, int r, int w, int e);
+    ClientData clientData;
+    int fd;
+    struct sel_proc *next;
+};
+
+static struct sel_proc *sel_proc_list = NULL;
+
+static void ir_tcl_tk_select_proc (ClientData clientData, int mask)
+{
+    struct sel_proc *sp = (struct sel_proc *) clientData;
+
+    if (!sp->f)
+        return ;
+    (*sp->f)(sp->clientData, mask & TK_READABLE, mask & TK_WRITABLE,
+             mask & TK_EXCEPTION);
+}
+
+void ir_tcl_select_set (void (*f)(ClientData clientData, int r, int w, int e),
+                        int fd, ClientData clientData, int r, int w, int e)
+{
+    int mask = 0;
+    struct sel_proc *sp = sel_proc_list;
+
+    if (r)
+        mask |= TK_READABLE;
+    if (w)
+        mask |= TK_WRITABLE;
+    if (e)
+        mask |= TK_EXCEPTION;
+    while (sp)
+    {
+        if (sp->fd == fd)
+             break;
+        sp = sp->next;
+    }
+    if (!sp)
+    {
+        sp = ir_tcl_malloc (sizeof(*sp));
+        sp->next = sel_proc_list;
+        sel_proc_list = sp;
+        sp->fd = fd;
+    }
+    sp->f = f;
+    sp->clientData = clientData;
+    if (f)
+        Tk_CreateFileHandler (fd, mask, ir_tcl_tk_select_proc, sp);
+    else
+        Tk_DeleteFileHandler (fd);
+}
+#endif
+
+#if TK_MAJOR_VERSION >= 4
+
+extern int matherr ();
+int *tclDummyMathPtr = (int*) matherr;
+
+int main (int argc, char **argv)
+{
+    Tk_Main (argc, argv, Tcl_AppInit);
+    return 0;
+}
+
+#else
+
+extern int main ();
+int *tclDummyMainPtr = (int*) main;
+
+#endif
+
+int Tcl_AppInit (Tcl_Interp *interp)
+{
+#if TK_MAJOR_VERSION < 4 
+    Tk_Window mainw;
+
+    if (!(mainw = Tk_MainWindow(interp)))
+        return TCL_ERROR;
+#endif
+    if (Tcl_Init(interp) == TCL_ERROR)
+        return TCL_ERROR;
+    if (Tk_Init(interp) == TCL_ERROR)
+        return TCL_ERROR;
+    if (Irtcl_Init(interp) == TCL_ERROR)
+        return TCL_ERROR;
+    return TCL_OK;
+}