From: Adam Dickmeiss Date: Wed, 31 May 1995 08:36:24 +0000 (+0000) Subject: Bug fix in client.tcl: didn't save options on clientrc.tcl. X-Git-Tag: IRTCL.1.4~299 X-Git-Url: http://sru.miketaylor.org.uk/cgi-bin?a=commitdiff_plain;h=0156d9d5a0909dc5cfc8137c892eb8aceb3c218c;p=ir-tcl-moved-to-github.git Bug fix in client.tcl: didn't save options on clientrc.tcl. New method: referenceId. More work on scan. --- diff --git a/client.tcl b/client.tcl index 45358ed..8a18b90 100644 --- a/client.tcl +++ b/client.tcl @@ -1,6 +1,10 @@ # # $Log: client.tcl,v $ -# Revision 1.23 1995-05-29 10:33:41 adam +# Revision 1.24 1995-05-31 08:36:24 adam +# Bug fix in client.tcl: didn't save options on clientrc.tcl. +# New method: referenceId. More work on scan. +# +# Revision 1.23 1995/05/29 10:33:41 adam # README and rename of startup script. # # Revision 1.22 1995/05/26 11:44:09 adam @@ -477,7 +481,7 @@ proc scan-request {} { set target $hostid - ir-scan z39.scan + ir-scan z39.scan z39 z39 callback {scan-response} if {![winfo exists $w]} { @@ -998,7 +1002,7 @@ proc save-settings {} { global queryButtons global queryInfo - set f [open "~/.tk-c" w] + set f [open "clientrc.tcl" w] puts $f "# Setup file" puts $f "set hotTargets \{ $hotTargets \}" diff --git a/ir-tcl.c b/ir-tcl.c index bb22467..990caf9 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,11 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.34 1995-05-29 10:33:42 adam + * Revision 1.35 1995-05-31 08:36:33 adam + * Bug fix in client.tcl: didn't save options on clientrc.tcl. + * New method: referenceId. More work on scan. + * + * Revision 1.34 1995/05/29 10:33:42 adam * README and rename of startup script. * * Revision 1.33 1995/05/29 09:15:11 quinn @@ -241,37 +245,6 @@ static int mk_nonSurrogateDiagnostics (Tcl_Interp *interp, } /* - * get_parent_info: Returns information about parent object. - */ -static int get_parent_info (Tcl_Interp *interp, const char *name, - Tcl_CmdInfo *parent_info, - const char **suffix) -{ - char parent_name[128]; - const char *csep = strrchr (name, '.'); - int pos; - - if (!csep) - { - interp->result = "missing ."; - return TCL_ERROR; - } - if (suffix) - *suffix = csep+1; - pos = csep-name; - if (pos > 127) - pos = 127; - memcpy (parent_name, name, pos); - parent_name[pos] = '\0'; - if (!Tcl_GetCommandInfo (interp, parent_name, parent_info)) - { - interp->result = "No parent"; - return TCL_ERROR; - } - return TCL_OK; -} - -/* * ir_method: Search for method in table and invoke method handler */ int ir_method (Tcl_Interp *interp, int argc, char **argv, IRMethods *tab) @@ -396,6 +369,18 @@ void *ir_malloc (Tcl_Interp *interp, size_t size) return p; } +static void set_referenceId (ODR o, Z_ReferenceId **dst, const char *src) +{ + if (!src || !*src) + *dst = NULL; + else + { + *dst = odr_malloc (o, sizeof(**dst)); + (*dst)->size = (*dst)->len = strlen(src); + (*dst)->buf = odr_malloc (o, (*dst)->len); + memcpy ((*dst)->buf, src, (*dst)->len); + } +} /* ------------------------------------------------------- */ /* @@ -418,7 +403,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, } odr_reset (p->odr_out); - req.referenceId = 0; + set_referenceId (p->odr_out, &req.referenceId, p->set_inher.referenceId); req.options = &p->options; req.protocolVersion = &p->protocolVersion; req.preferredMessageSize = &p->preferredMessageSize; @@ -615,8 +600,7 @@ static int do_implementationName (void *obj, Tcl_Interp *interp, == TCL_ERROR) return TCL_ERROR; } - Tcl_AppendResult (interp, p->implementationName, - (char*) NULL); + Tcl_AppendResult (interp, p->implementationName, (char*) NULL); return TCL_OK; } @@ -657,8 +641,7 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, } else if (argc == -1) return ir_strdel (interp, &p->targetImplementationName); - Tcl_AppendResult (interp, p->targetImplementationName, - (char*) NULL); + Tcl_AppendResult (interp, p->targetImplementationName, (char*) NULL); return TCL_OK; } @@ -1125,6 +1108,27 @@ static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp, return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); } +/* + * do_referenceId: Set/Get referenceId + */ +static int do_referenceId (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IRSetCObj *p = obj; + + if (argc == 0) + p->referenceId = NULL; + else if (argc == -1) + return ir_strdel (interp, &p->referenceId); + if (argc == 3) + { + free (p->referenceId); + if (ir_strdup (interp, &p->referenceId, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->referenceId, NULL); + return TCL_OK; +} static IRMethod ir_method_tab[] = { { 1, "comstack", do_comstack }, @@ -1157,6 +1161,7 @@ static IRMethod ir_set_c_method_tab[] = { { 0, "smallSetUpperBound", do_smallSetUpperBound}, { 0, "largeSetLowerBound", do_largeSetLowerBound}, { 0, "mediumSetPresentNumber", do_mediumSetPresentNumber}, +{ 0, "referenceId", do_referenceId }, { 0, NULL, NULL} }; @@ -1289,7 +1294,7 @@ static int do_search (void *o, Tcl_Interp *interp, interp->result = "wrong # args"; return TCL_ERROR; } - if (!p->set_inher.num_databaseNames) + if (!obj->set_inher.num_databaseNames) { interp->result = "no databaseNames"; return TCL_ERROR; @@ -1307,23 +1312,24 @@ static int do_search (void *o, Tcl_Interp *interp, bib1.class = CLASS_ATTSET; bib1.value = VAL_BIB1; - req.referenceId = 0; - req.smallSetUpperBound = &p->set_inher.smallSetUpperBound; - req.largeSetLowerBound = &p->set_inher.largeSetLowerBound; - req.mediumSetPresentNumber = &p->set_inher.mediumSetPresentNumber; - req.replaceIndicator = &p->set_inher.replaceIndicator; + set_referenceId (p->odr_out, &req.referenceId, obj->set_inher.referenceId); + + req.smallSetUpperBound = &obj->set_inher.smallSetUpperBound; + req.largeSetLowerBound = &obj->set_inher.largeSetLowerBound; + req.mediumSetPresentNumber = &obj->set_inher.mediumSetPresentNumber; + req.replaceIndicator = &obj->set_inher.replaceIndicator; req.resultSetName = obj->setName ? obj->setName : "Default"; logf (LOG_DEBUG, "Search, resultSetName %s", req.resultSetName); - req.num_databaseNames = p->set_inher.num_databaseNames; - req.databaseNames = p->set_inher.databaseNames; - for (r=0; r < p->set_inher.num_databaseNames; r++) - logf (LOG_DEBUG, " Database %s", p->set_inher.databaseNames[r]); + req.num_databaseNames = obj->set_inher.num_databaseNames; + req.databaseNames = obj->set_inher.databaseNames; + for (r=0; r < obj->set_inher.num_databaseNames; r++) + logf (LOG_DEBUG, " Database %s", obj->set_inher.databaseNames[r]); req.smallSetElementSetNames = 0; req.mediumSetElementSetNames = 0; req.preferredRecordSyntax = 0; req.query = &query; - if (!strcmp (p->set_inher.queryType, "rpn")) + if (!strcmp (obj->set_inher.queryType, "rpn")) { Z_RPNQuery *RPNquery; @@ -1339,7 +1345,7 @@ static int do_search (void *o, Tcl_Interp *interp, logf (LOG_DEBUG, "RPN"); } #if CCL2RPN - else if (!strcmp (p->set_inher.queryType, "cclrpn")) + else if (!strcmp (obj->set_inher.queryType, "cclrpn")) { int error; int pos; @@ -1361,7 +1367,7 @@ static int do_search (void *o, Tcl_Interp *interp, logf (LOG_DEBUG, "CCLRPN"); } #endif - else if (!strcmp (p->set_inher.queryType, "ccl")) + else if (!strcmp (obj->set_inher.queryType, "ccl")) { query.which = Z_Query_type_2; query.u.type_2 = &ccl_query; @@ -1673,8 +1679,8 @@ static int do_present (void *o, Tcl_Interp *interp, apdu.which = Z_APDU_presentRequest; apdu.u.presentRequest = &req; - req.referenceId = 0; - /* sprintf(setstring, "%d", setnumber); */ + + set_referenceId (p->odr_out, &req.referenceId, obj->set_inher.referenceId); req.resultSetId = obj->setName ? obj->setName : "Default"; @@ -1855,6 +1861,10 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, if (ir_strdup (interp, &dst->queryType, src->queryType) == TCL_ERROR) return TCL_ERROR; + + if (ir_strdup (interp, &dst->referenceId, src->referenceId) + == TCL_ERROR) + return TCL_ERROR; dst->smallSetUpperBound = src->smallSetUpperBound; dst->largeSetLowerBound = src->largeSetLowerBound; @@ -1919,7 +1929,7 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) apdu.which = Z_APDU_scanRequest; apdu.u.scanRequest = &req; - req.referenceId = NULL; + set_referenceId (p->odr_out, &req.referenceId, p->set_inher.referenceId); req.num_databaseNames = p->set_inher.num_databaseNames; req.databaseNames = p->set_inher.databaseNames; req.attributeSet = oid_getoidbyent (&bib1); @@ -2135,7 +2145,7 @@ static IRMethod ir_scan_method_tab[] = { static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { - IRMethods tabs[3]; + IRMethods tabs[2]; if (argc < 2) { @@ -2154,7 +2164,15 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, */ static void ir_scan_obj_delete (ClientData clientData) { - free ( (void*) clientData); + IRMethods tabs[2]; + IRScanObj *obj = clientData; + + tabs[0].tab = ir_scan_method_tab; + tabs[0].obj = obj; + tabs[1].tab = NULL; + + ir_method (NULL, -1, NULL, tabs); + free (obj); } /* @@ -2165,34 +2183,29 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, { Tcl_CmdInfo parent_info; IRScanObj *obj; - IRMethods tabs[3]; + IRMethods tabs[2]; - if (argc != 2) + if (argc != 3) { interp->result = "wrong # args"; return TCL_ERROR; } - if (get_parent_info (interp, argv[1], &parent_info, NULL) == TCL_ERROR) - return TCL_ERROR; + if (!Tcl_GetCommandInfo (interp, argv[2], &parent_info)) + { + interp->result = "No parent"; + return TCL_ERROR; + } if (!(obj = ir_malloc (interp, sizeof(*obj)))) return TCL_ERROR; + obj->parent = (IRObj *) parent_info.clientData; + tabs[0].tab = ir_scan_method_tab; tabs[0].obj = obj; tabs[1].tab = NULL; if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) return TCL_ERROR; -#if 0 - obj->stepSize = 0; - obj->numberOfTermsRequested = 20; - obj->preferredPositionInResponse = 1; - - obj->entries = NULL; - obj->nonSurrogateDiagnostics = NULL; -#endif - - obj->parent = (IRObj *) parent_info.clientData; Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method, (ClientData) obj, ir_scan_obj_delete); return TCL_OK; diff --git a/ir-tclp.h b/ir-tclp.h index 31fe2c0..3732962 100644 --- a/ir-tclp.h +++ b/ir-tclp.h @@ -5,7 +5,11 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tclp.h,v $ - * Revision 1.5 1995-05-29 08:44:25 adam + * Revision 1.6 1995-05-31 08:36:40 adam + * Bug fix in client.tcl: didn't save options on clientrc.tcl. + * New method: referenceId. More work on scan. + * + * Revision 1.5 1995/05/29 08:44:25 adam * Work on delete of objects. * * Revision 1.4 1995/05/26 11:44:10 adam @@ -59,6 +63,7 @@ typedef struct { char *queryType; int replaceIndicator; + char *referenceId; int smallSetUpperBound; int largeSetLowerBound;