From d446a56fc51edc47a986b8a7e6c0b7c90065a431 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Tue, 20 Aug 1996 09:27:48 +0000 Subject: [PATCH] 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). --- Makefile.in | 10 ++-- explain.c | 157 +++++++++++++++++++++++++++++++++++++---------------------- tclmain.c | 101 +++++++++++++------------------------- tkmain.c | 108 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 245 insertions(+), 131 deletions(-) create mode 100644 tkmain.c diff --git a/Makefile.in b/Makefile.in index 28c0a7b..76960de 100644 --- 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 --- 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; iwhich, 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 --- 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 #endif + #include #include #include #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 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 +#include +#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; +} -- 1.7.10.4