From 641274e7f15702b5c3cbd36694c79183c8508725 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Thu, 29 Feb 1996 15:30:19 +0000 Subject: [PATCH] Export of IrTcl functionality to extensions. --- Makefile.in | 10 ++++--- clientrc.tcl | 9 +++--- ir-tcl.c | 90 +++++++++++++++++++++++++++++++++++----------------------- ir-tclp.h | 8 ++++-- 4 files changed, 71 insertions(+), 46 deletions(-) diff --git a/Makefile.in b/Makefile.in index ab4c96c..4ca4821 100644 --- a/Makefile.in +++ b/Makefile.in @@ -2,7 +2,7 @@ # (c) Index Data 1995 # See the file LICENSE for details. # Sebastian Hammer, Adam Dickmeiss -# $Id: Makefile.in,v 1.29 1996-02-26 18:38:31 adam Exp $ +# $Id: Makefile.in,v 1.30 1996-02-29 15:30:19 adam Exp $ SHELL=/bin/sh # IrTcl Version @@ -66,14 +66,16 @@ ir-tk: libirtcl.a tkinit.o ir-tcl: libirtcl.a tclmain.o $(CC) $(CFLAGS) tclmain.o -o ir-tcl libirtcl.a $(YAZLIB) $(TCLLIB) $(LIBS) +WAISDIR=../freeWAIS-sf-2.0 + wais-tcl: libirtcl.a wais-tcl.o waismain.o - $(CC) $(CFLAGS) wais-tcl.o waismain.o -o wais-tcl libirtcl.a $(YAZLIB) $(TCLLIB) /home/proj/freeWAIS-sf/freeWAIS-sf-2.0.60/ir/libwais.a $(LIBS) + $(CC) $(CFLAGS) wais-tcl.o waismain.o -o wais-tcl libirtcl.a $(YAZLIB) $(TCLLIB) $(WAISDIR)/ir/libwais.a $(LIBS) waismain.o: tclmain.c $(CC) -c $(CFLAGS) -DUSE_WAIS=1 $(DEFS) tclmain.c -o waismain.o wais-tcl.o: wais-tcl.c - $(CC) -c $(CFLAGS) -I/home/proj/freeWAIS-sf/freeWAIS-sf-2.0.60/ir $(DEFS) wais-tcl.c + $(CC) -c $(CFLAGS) -I$(WAISDIR)/ir $(DEFS) wais-tcl.c libirtcl.a: $(O) rm -f libirtcl.a @@ -156,5 +158,5 @@ distribution: .c.o: $(CC) -c $(CFLAGS) $(DEFS) $< -$(O) tkinit.o tclmain.o: ir-tcl.h ir-tclp.h +$(O) tkinit.o tclmain.o wais-tcl.o waismain.o: ir-tcl.h ir-tclp.h diff --git a/clientrc.tcl b/clientrc.tcl index f294055..3875317 100644 --- a/clientrc.tcl +++ b/clientrc.tcl @@ -3,20 +3,21 @@ set {profile(zserver)} {Zserver localhost 8889 {} 90000 90000 tcpip {esdd Defaul set {profile(Penn)} {{Penn State's Library} 128.118.88.200 210 {} 16384 8192 tcpip CATALOG 1 {} {} Z39 2} set {profile(ztest)} {{test server} localhost 210 {} 60000 60000 tcpip dummy 1 {} 1 Z39 3} set {profile(madison)} {{University of Wisconsin-Madison} z3950.adp.wisc.edu 210 {} 16384 8192 tcpip madison 1 {} {} Z39 22} +set {profile(arca-test)} {{} signore2.cnuce.cnr.it 5002 {} 50000 30000 tcpip CNRCP 1 {} {} Z39 29 2 0 0 4} set {profile(bibsys)} {{BIBSYS Target (YAZ-based)} z3950.bibsys.no 2100 {} 16384 8192 tcpip BIBSYS 1 {} 1 Z39 27} -set {profile(Default)} {{} {} {210} {} 50000 30000 tcpip {} 1 {} {} {} 29 2 0 0 4} +set {profile(Default)} {{} {} {210} {} 50000 30000 tcpip {} 1 {} {} {} 30 2 0 0 4} set {profile(RLG)} {{Research Libraries group} rlg.stanford.edu 210 {} 4096 4096 tcpip {BKS AMC MAPS MDF REC SCO SER VIM NAF SAF AUT CATALOG ABI AVI DSA EIP FLP HAP HST NPA PAI PRA WLI} 1 {} 1 Z39 5} set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 16384 16384 tcpip Default 1 {} {} Z39 21} set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 2210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 Z39 6} set {profile(DANBIB)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 SR 8} set {profile(OCLC)} {{OCLC First search engine} z3950.oclc.org 210 {} 16384 8192 tcpip {ArticleFirst BiographyIndex BusinessPeriodicalsIndex} 1 {} {} Z39 9} -set {profile(adad)} {a {} 210 {} 16384 8192 tcpip {} 1 {} {} Z39 26} set {profile(CARL)} {{CARL systems} Z3950.carl.org 210 {} 16384 8192 tcpip {ACC AIC AUR BEM CUB DPL DNU EPL FRC LAW LCC MCC MIN MPL NJC NWC OCC PPC PUE RDR RGU SPL TCC TKU UNC WYO} 1 {} {} Z39 11} -set {profile(CLSI)} {CLSI inet-gw.clsi.us.geac.com 210 {} 16384 8192 tcpip cl_default 1 {} {} Z39 13} +set {profile(adad)} {a {} 210 {} 16384 8192 tcpip {} 1 {} {} Z39 26} set {profile(Innovative)} {{Innovatives server: demo.iii.com} demo.iii.com 210 {} 16384 8192 tcpip DEFAULT 1 {} {} Z39 12} +set {profile(CLSI)} {CLSI inet-gw.clsi.us.geac.com 210 {} 16384 8192 tcpip cl_default 1 {} {} Z39 13} set {profile(AULS)} {{Acadia university} auls.acadiau.ca 210 {} 16384 8192 tcpip AULS 1 {} {} Z39 14} -set {profile(dranet)} {dranet dranet.dra.com 210 {} 16384 16384 tcpip drewdb 1 {} 1 Z39 15} set {profile(canberra)} {canberra canberra.cs.umass.edu 2110 {} 30000 30000 tcpip cacm_dots 1 {} {} Z39 25} +set {profile(dranet)} {dranet dranet.dra.com 210 {} 16384 16384 tcpip drewdb 1 {} 1 Z39 15} set queryTypes {Simple phrase} set queryButtons {{{I 3} {I 0} {I 0}} {{I 0} {I 1} {I 0}}} set queryInfo {{ {Title {1=4}} {Author {1=1}} {Subject {1=21}} {Any {1=1016}} {Query 1=1016 2=102} {Title-rank 1=4 2=102} {Date/time 1=1012} {Title-regular 1=4 2=3 4=2 5=102}} {{Title 1=4 4=1 6=2} {Author 1=1003 4=1 6=2} {ISBN 1=7} {ISSN 1=8} {Year 1=30 4=4 6=2} {Any {}}}} diff --git a/ir-tcl.c b/ir-tcl.c index f18c248..b9c9012 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.81 1996-02-26 18:38:32 adam + * Revision 1.82 1996-02-29 15:30:21 adam + * Export of IrTcl functionality to extensions. + * + * Revision 1.81 1996/02/26 18:38:32 adam * Work on export of set methods. * * Revision 1.80 1996/02/23 17:31:39 adam @@ -445,9 +448,9 @@ static void delete_IR_records (IrTcl_SetObj *setobj) } /* - * get_set_int: Set/get integer value + * ir_tcl_get_set_int: Set/get integer value */ -static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) +int ir_tcl_get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) { char buf[20]; @@ -464,7 +467,8 @@ static int get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv) /* * ir_tcl_method: Search for method in table and invoke method handler */ -int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab) +int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, + IrTcl_Methods *tab, int *ret) { IrTcl_Methods *tab_i = tab; IrTcl_Method *t; @@ -478,7 +482,10 @@ int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab } else if (!strcmp (t->name, argv[1])) - return (*t->method)(tab_i->obj, interp, argc, argv); + { + *ret = (*t->method)(tab_i->obj, interp, argc, argv); + return TCL_OK; + } if (argc <= 0) return TCL_OK; @@ -489,14 +496,15 @@ int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab for (t = tab_i->tab; t->name; t++) Tcl_AppendResult (interp, " ", t->name, NULL); #endif + *ret = TCL_ERROR; return TCL_ERROR; } /* - * ir_named_bits: get/set named bits + * ir_tcl_named_bits: get/set named bits */ -int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, - Tcl_Interp *interp, int argc, char **argv) +int ir_tcl_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, + Tcl_Interp *interp, int argc, char **argv) { struct ir_named_entry *ti; if (argc > 0) @@ -689,7 +697,7 @@ static int do_options (void *obj, Tcl_Interp *interp, ODR_MASK_SET (&p->options, 14); return TCL_OK; } - return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2); + return ir_tcl_named_bits (options_tab, &p->options, interp, argc-2, argv+2); } /* @@ -795,7 +803,7 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, p->preferredMessageSize = 30000; return TCL_OK; } - return get_set_int (&p->preferredMessageSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->preferredMessageSize, interp, argc, argv); } /* @@ -811,7 +819,7 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp, p->maximumRecordSize = 30000; return TCL_OK; } - return get_set_int (&p->maximumRecordSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->maximumRecordSize, interp, argc, argv); } /* @@ -824,7 +832,7 @@ static int do_initResult (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->initResult, interp, argc, argv); + return ir_tcl_get_set_int (&p->initResult, interp, argc, argv); } @@ -1423,7 +1431,7 @@ static int do_replaceIndicator (void *obj, Tcl_Interp *interp, p->replaceIndicator = 1; return TCL_OK; } - return get_set_int (&p->replaceIndicator, interp, argc, argv); + return ir_tcl_get_set_int (&p->replaceIndicator, interp, argc, argv); } /* @@ -1480,7 +1488,7 @@ static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, p->smallSetUpperBound = 0; return TCL_OK; } - return get_set_int (&p->smallSetUpperBound, interp, argc, argv); + return ir_tcl_get_set_int (&p->smallSetUpperBound, interp, argc, argv); } /* @@ -1496,7 +1504,7 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, p->largeSetLowerBound = 2; return TCL_OK; } - return get_set_int (&p->largeSetLowerBound, interp, argc, argv); + return ir_tcl_get_set_int (&p->largeSetLowerBound, interp, argc, argv); } /* @@ -1512,7 +1520,7 @@ static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp, p->mediumSetPresentNumber = 0; return TCL_OK; } - return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); + return ir_tcl_get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); } /* @@ -1708,6 +1716,7 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, { IrTcl_Methods tab[3]; IrTcl_Obj *p = clientData; + int r; if (argc < 2) return TCL_ERROR; @@ -1718,7 +1727,8 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, tab[1].obj = &p->set_inher; tab[2].tab = NULL; - return ir_tcl_method (interp, argc, argv, tab); + ir_tcl_method (interp, argc, argv, tab, &r); + return r; } /* @@ -1741,7 +1751,7 @@ static void ir_obj_delete (ClientData clientData) tab[1].obj = &obj->set_inher; tab[2].tab = NULL; - ir_tcl_method (NULL, -1, NULL, tab); + ir_tcl_method (NULL, -1, NULL, tab, NULL); ir_tcl_del_q (obj); odr_destroy (obj->odr_in); @@ -1796,7 +1806,7 @@ int ir_obj_init (ClientData clientData, Tcl_Interp *interp, tab[1].obj = &obj->set_inher; tab[2].tab = NULL; - if (ir_tcl_method (interp, 0, NULL, tab) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tab, NULL) == TCL_ERROR) { Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL); return TCL_ERROR; @@ -2054,7 +2064,7 @@ static int do_resultCount (void *o, Tcl_Interp *interp, obj->resultCount = 0; return TCL_OK; } - return get_set_int (&obj->resultCount, interp, argc, argv); + return ir_tcl_get_set_int (&obj->resultCount, interp, argc, argv); } /* @@ -2067,7 +2077,7 @@ static int do_searchStatus (void *o, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&obj->searchStatus, interp, argc, argv); + return ir_tcl_get_set_int (&obj->searchStatus, interp, argc, argv); } /* @@ -2080,7 +2090,7 @@ static int do_presentStatus (void *o, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&obj->presentStatus, interp, argc, argv); + return ir_tcl_get_set_int (&obj->presentStatus, interp, argc, argv); } /* @@ -2097,7 +2107,8 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp, obj->nextResultSetPosition = 0; return TCL_OK; } - return get_set_int (&obj->nextResultSetPosition, interp, argc, argv); + return ir_tcl_get_set_int (&obj->nextResultSetPosition, interp, + argc, argv); } /* @@ -2136,7 +2147,8 @@ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp, obj->numberOfRecordsReturned = 0; return TCL_OK; } - return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv); + return ir_tcl_get_set_int (&obj->numberOfRecordsReturned, interp, + argc, argv); } /* @@ -2605,6 +2617,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, { IrTcl_Methods tabs[3]; IrTcl_SetObj *p = clientData; + int r; if (argc < 2) { @@ -2617,7 +2630,8 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, tabs[1].obj = &p->set_inher; tabs[2].tab = NULL; - return ir_tcl_method (interp, argc, argv, tabs); + ir_tcl_method (interp, argc, argv, tabs, &r); + return r; } /* @@ -2636,7 +2650,7 @@ static void ir_set_obj_delete (ClientData clientData) tabs[1].obj = &p->set_inher; tabs[2].tab = NULL; - ir_tcl_method (NULL, -1, NULL, tabs); + ir_tcl_method (NULL, -1, NULL, tabs, NULL); free (p); } @@ -2722,7 +2736,7 @@ static int ir_set_obj_init (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = obj; tabs[1].tab = NULL; - if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; *subData = obj; @@ -2883,7 +2897,7 @@ static int do_stepSize (void *obj, Tcl_Interp *interp, p->stepSize = 0; return TCL_OK; } - return get_set_int (&p->stepSize, interp, argc, argv); + return ir_tcl_get_set_int (&p->stepSize, interp, argc, argv); } /* @@ -2899,7 +2913,7 @@ static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp, p->numberOfTermsRequested = 20; return TCL_OK; } - return get_set_int (&p->numberOfTermsRequested, interp, argc, argv); + return ir_tcl_get_set_int (&p->numberOfTermsRequested, interp, argc, argv); } @@ -2916,7 +2930,8 @@ static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp, p->preferredPositionInResponse = 1; return TCL_OK; } - return get_set_int (&p->preferredPositionInResponse, interp, argc, argv); + return ir_tcl_get_set_int (&p->preferredPositionInResponse, interp, + argc, argv); } /* @@ -2929,7 +2944,7 @@ static int do_scanStatus (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->scanStatus, interp, argc, argv); + return ir_tcl_get_set_int (&p->scanStatus, interp, argc, argv); } /* @@ -2942,7 +2957,8 @@ static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv); + return ir_tcl_get_set_int (&p->numberOfEntriesReturned, interp, + argc, argv); } /* @@ -2955,7 +2971,7 @@ static int do_positionOfTerm (void *obj, Tcl_Interp *interp, if (argc <= 0) return TCL_OK; - return get_set_int (&p->positionOfTerm, interp, argc, argv); + return ir_tcl_get_set_int (&p->positionOfTerm, interp, argc, argv); } /* @@ -3035,6 +3051,7 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IrTcl_Methods tabs[2]; + int r; if (argc < 2) { @@ -3045,7 +3062,8 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = clientData; tabs[1].tab = NULL; - return ir_tcl_method (interp, argc, argv, tabs); + ir_tcl_method (interp, argc, argv, tabs, &r); + return r; } /* @@ -3060,7 +3078,7 @@ static void ir_scan_obj_delete (ClientData clientData) tabs[0].obj = obj; tabs[1].tab = NULL; - ir_tcl_method (NULL, -1, NULL, tabs); + ir_tcl_method (NULL, -1, NULL, tabs, NULL); free (obj); } @@ -3091,7 +3109,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, tabs[0].obj = obj; tabs[1].tab = NULL; - if (ir_tcl_method (interp, 0, NULL, tabs) == TCL_ERROR) + if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method, (ClientData) obj, ir_scan_obj_delete); diff --git a/ir-tclp.h b/ir-tclp.h index acab97f..12a97c4 100644 --- a/ir-tclp.h +++ b/ir-tclp.h @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tclp.h,v $ - * Revision 1.29 1996-02-26 18:38:33 adam + * Revision 1.30 1996-02-29 15:30:23 adam + * Export of IrTcl functionality to extensions. + * + * Revision 1.29 1996/02/26 18:38:33 adam * Work on export of set methods. * * Revision 1.28 1996/02/23 17:31:41 adam @@ -362,7 +365,8 @@ int ir_tcl_get_grs (Tcl_Interp *interp, IrTcl_GRS_Record *grs_record, int argc, char **argv); int ir_tcl_method (Tcl_Interp *interp, int argc, char **argv, - IrTcl_Methods *tab); + IrTcl_Methods *tab, int *ret); +int ir_tcl_get_set_int (int *val, Tcl_Interp *interp, int argc, char **argv); typedef struct { const char *name; -- 1.7.10.4