From: Adam Dickmeiss Date: Thu, 20 Jul 1995 08:09:35 +0000 (+0000) Subject: client.tcl: Targets removed from hotTargets list when targets X-Git-Tag: IRTCL.1.4~228 X-Git-Url: http://lists.indexdata.dk/?a=commitdiff_plain;h=c35c5cc9a0456642119e21bfa63eeaf14cbf0415;p=ir-tcl-moved-to-github.git client.tcl: Targets removed from hotTargets list when targets are removed/modified. ir-tcl.c: More work on triggerResourceControl. --- diff --git a/CHANGELOG b/CHANGELOG index ba510d9..20b6be9 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,4 @@ -$Id: CHANGELOG,v 1.2 1995-06-26 10:20:19 adam Exp $ +$Id: CHANGELOG,v 1.3 1995-07-20 08:09:35 adam Exp $ 06/19/95 Release of ir-tcl-1.0b ------------------------------------------------------ @@ -26,4 +26,18 @@ $Id: CHANGELOG,v 1.2 1995-06-26 10:20:19 adam Exp $ when installed in the directory with executables. ------------------------------------------------------ 06/26/95 Release of ir-tcl-1.0b1 - + +06/27/95 Bug fix. The present response didn't always get proper + result-set info. + +06/27/95 Bug fix. Action loadFile didn't set record type. + +06/27/95 Bug fix. 'make install' fails on some systems. + +06/27/95 Bug fix. In client.tcl: didn't observe non-surrogate diagnostics + when resultCount was non-zero. + +06/29/95 IrTcl now works with both tk4.0b4/tcl7.4b4 and tk3.6/tcl7.3 + +06/30/95 The interpretation of MARC records is a little less strict, i.e. + a larger set of records are treated as being MARC. diff --git a/client.tcl b/client.tcl index 405ea0d..a5c148e 100644 --- a/client.tcl +++ b/client.tcl @@ -4,7 +4,12 @@ # Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.60 1995-06-30 16:30:19 adam +# Revision 1.61 1995-07-20 08:09:39 adam +# client.tcl: Targets removed from hotTargets list when targets +# are removed/modified. +# ir-tcl.c: More work on triggerResourceControl. +# +# Revision 1.60 1995/06/30 16:30:19 adam # Minor changes. # # Revision 1.59 1995/06/29 14:06:25 adam @@ -329,7 +334,7 @@ proc set-wrap {m} { } proc dputs {m} { -# puts $m + puts $m } proc set-display-format {f} { @@ -780,16 +785,8 @@ proc popup-marc {sno no b df} { proc update-target-hotlist {target base} { global hotTargets - global tk4 - set len [llength $hotTargets] - if {$len > 0} { - if {$tk4} { - .top.target.m delete 7 [expr 7+[llength $hotTargets]] - } else { - .top.target.m delete 6 [expr 6+[llength $hotTargets]] - } - } + set olen [llength $hotTargets] set i 0 foreach e $hotTargets { if {$target == [lindex $e 0] && $base == [lindex $e 1]} { @@ -799,12 +796,34 @@ proc update-target-hotlist {target base} { incr i } set hotTargets [linsert $hotTargets 0 [list $target $base]] - set-target-hotlist + set-target-hotlist $olen } -proc set-target-hotlist {} { +proc delete-target-hotlist {target} { global hotTargets - + + set olen [llength $hotTargets] + set i 0 + foreach e $hotTargets { + if {$target == [lindex $e 0]} { + set hotTargets [lreplace $hotTargets $i $i] + } + incr i + } + set-target-hotlist $olen +} + +proc set-target-hotlist {olen} { + global hotTargets + global tk4 + + if {$olen > 0} { + if {$tk4} { + .top.target.m delete 7 [expr 7+$olen] + } else { + .top.target.m delete 6 [expr 6+$olen] + } + } set i 1 foreach e $hotTargets { set target [lindex $e 0] @@ -953,10 +972,8 @@ proc load-set-action {} { proc load-set {} { set w .load-set - - set oldFocus [focus] toplevel $w - + set oldFocus [focus] place-force $w . top-down-window $w @@ -1611,6 +1628,7 @@ definition $target ?"] unset profile($target) set settingsChanged 1 cascade-target-list + delete-target-hotlist $target } } @@ -1647,6 +1665,7 @@ proc protocol-setup-action {target} { $wno] cascade-target-list + delete-target-hotlist $target dputs $profile($target) destroy $w } @@ -1677,9 +1696,8 @@ proc add-database {target} { global profile set w .database-select - - set oldFocus [focus] toplevel $w + set oldFocus [focus] set wno [lindex $profile($target) 12] place-force $w .setup-${wno} @@ -1874,7 +1892,7 @@ proc database-select {} { global hostid toplevel $w - + set oldFocus [focus] place-force $w . top-down-window $w @@ -1899,6 +1917,7 @@ proc database-select {} { $w.top.databases.list insert end $b } top-down-ok-cancel $w {database-select-action} 1 + focus $oldFocus } proc cascade-target-list {} { @@ -1965,6 +1984,7 @@ proc query-new {} { set w .query-new toplevel $w + set oldFocus [focus] place-force $w . top-down-window $w frame $w.top.index @@ -1974,6 +1994,7 @@ proc query-new {} { {{Query Name:}} \ query-new-action {destroy .query-new} top-down-ok-cancel $w query-new-action 1 + focus $oldFocus } proc query-delete-action {queryNo} { @@ -2105,6 +2126,7 @@ proc alert {ask} { global alertAnswer toplevel $w + set oldFocus [focus] place-force $w . top-down-window $w @@ -2116,6 +2138,7 @@ proc alert {ask} { set alertAnswer 0 top-down-ok-cancel $w {alert-action} 1 + focus $oldFocus return $alertAnswer } @@ -2253,6 +2276,7 @@ proc query-add-index {queryNo} { set w .query-add-index toplevel $w + set oldFocus [focus] place-force $w .query-setup top-down-window $w frame $w.top.index @@ -2262,6 +2286,7 @@ proc query-add-index {queryNo} { {{Index Name:}} \ [list query-add-index-action $queryNo] [list destroy $w] top-down-ok-cancel $w [list query-add-index-action $queryNo] 1 + focus $oldFocus } proc query-setup-action {queryNo} { @@ -2916,7 +2941,7 @@ menu .top.target.m .top.target.m add cascade -label "Setup" -menu .top.target.m.slist .top.target.m add command -label "Setup new" -command {define-target-dialog} .top.target.m add separator -set-target-hotlist +set-target-hotlist 0 configure-disable-e .top.target.m 1 configure-disable-e .top.target.m 2 diff --git a/clientrc.tcl b/clientrc.tcl index 48e4f59..d8aa647 100644 --- a/clientrc.tcl +++ b/clientrc.tcl @@ -1,6 +1,6 @@ # Setup file 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 {} 16384 4096 tcpip dummy 1 {} 1 Z39 3} +set {profile(ztest)} {{test server} localhost 9999 {} 16384 4096 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(Default)} {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} {} 27} 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} @@ -10,11 +10,11 @@ set {profile(DANBIB)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 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(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 0} {I 1} {I 2} } {{I 0} {I 1} {I 0}}} set queryInfo {{ {Title {1=4}} {Author {1=1}} {Subject {1=21}} {Any {1=1016}}} {{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 37386ae..7f9fc2f 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,12 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.49 1995-06-30 12:39:21 adam + * Revision 1.50 1995-07-20 08:09:49 adam + * client.tcl: Targets removed from hotTargets list when targets + * are removed/modified. + * ir-tcl.c: More work on triggerResourceControl. + * + * Revision 1.49 1995/06/30 12:39:21 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. @@ -512,6 +517,39 @@ static void get_referenceId (char **dst, Z_ReferenceId *src) /* ------------------------------------------------------- */ /* + * ir-tcl_send_APDU: send APDU + */ +static int ir_tcl_send_APDU (Tcl_Interp *interp, IrTcl_Obj *p, Z_APDU *apdu, + const char *msg) +{ + int r; + + if (!z_APDU (p->odr_out, &apdu, 0)) + { + Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], + NULL); + odr_reset (p->odr_out); + return TCL_ERROR; + } + p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); + odr_reset (p->odr_out); + if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) + { + sprintf (interp->result, "cs_put failed in %s", msg); + do_disconnect (p, NULL, 2, NULL); + return TCL_ERROR; + } + else if (r == 1) + { + ir_select_add_write (cs_fileno(p->cs_link), p); + logf (LOG_DEBUG, "Sent part of %s (%d bytes)", msg, p->slen); + } + else + logf (LOG_DEBUG, "Sent whole %s (%d bytes)", msg, p->slen); + return TCL_OK; +} + +/* * do_init_request: init method on IR object */ static int do_init_request (void *obj, Tcl_Interp *interp, @@ -520,7 +558,6 @@ static int do_init_request (void *obj, Tcl_Interp *interp, Z_APDU *apdu; IrTcl_Obj *p = obj; Z_InitRequest *req; - int r; if (argc <= 0) return TCL_OK; @@ -529,7 +566,6 @@ static int do_init_request (void *obj, Tcl_Interp *interp, interp->result = "not connected"; return TCL_ERROR; } - odr_reset (p->odr_out); apdu = zget_APDU (p->odr_out, Z_APDU_initRequest); req = apdu->u.initRequest; @@ -575,28 +611,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, req->implementationVersion = p->implementationVersion; req->userInformationField = 0; - if (!z_APDU (p->odr_out, &apdu, 0)) - { - Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], - NULL); - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in init"; - do_disconnect (p, NULL, 2, NULL); - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of initializeRequest (%d bytes)", p->slen); - } - else - logf (LOG_DEBUG, "Sent whole initializeRequest (%d bytes)", p->slen); - return TCL_OK; + return ir_tcl_send_APDU (interp, p, apdu, "init"); } /* @@ -662,6 +677,7 @@ static int do_options (void *obj, Tcl_Interp *interp, ODR_MASK_ZERO (&p->options); ODR_MASK_SET (&p->options, 0); ODR_MASK_SET (&p->options, 1); + ODR_MASK_SET (&p->options, 4); ODR_MASK_SET (&p->options, 7); ODR_MASK_SET (&p->options, 14); return TCL_OK; @@ -1032,6 +1048,7 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, ODR_MASK_ZERO (&p->options); ODR_MASK_SET (&p->options, 0); ODR_MASK_SET (&p->options, 1); + ODR_MASK_SET (&p->options, 4); ODR_MASK_SET (&p->options, 7); ODR_MASK_SET (&p->options, 14); @@ -1172,7 +1189,7 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; Z_APDU *apdu; Z_TriggerResourceControlRequest *req; - int r; + bool_t is_false = 0; if (argc <= 0) return TCL_OK; @@ -1183,31 +1200,10 @@ static int do_triggerResourceControl (void *obj, Tcl_Interp *interp, } apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest); req = apdu->u.triggerResourceControlRequest; + *req->requestedAction = Z_TriggerResourceCtrl_cancel; + req->resultSetWanted = &is_false; - if (!z_APDU (p->odr_out, &apdu, 0)) - { - Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)], - NULL); - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in triggerResourceControl"; - do_disconnect (p, NULL, 2, NULL); - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of triggerResourceControl (%d bytes)", - p->slen); - } - else - logf (LOG_DEBUG, "Sent whole of triggerResourceControl (%d bytes)", - p->slen); - return TCL_OK; + return ir_tcl_send_APDU (interp, p, apdu, "triggerResourceControl"); } /* @@ -1594,7 +1590,6 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) interp->result = "not connected"; return TCL_ERROR; } - odr_reset (p->odr_out); apdu = zget_APDU (p->odr_out, Z_APDU_searchRequest); req = apdu->u.searchRequest; @@ -1684,28 +1679,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv) interp->result = "unknown query method"; return TCL_ERROR; } - if (!z_APDU (p->odr_out, &apdu, 0)) - { - interp->result = odr_errlist [odr_geterror (p->odr_out)]; - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in search"; - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of searchRequest (%d bytes)", p->slen); - } - else - { - logf (LOG_DEBUG, "Whole search request (%d bytes)", p->slen); - } - return TCL_OK; + return ir_tcl_send_APDU (interp, p, apdu, "search"); } /* @@ -2062,7 +2036,6 @@ static int do_present (void *o, Tcl_Interp *interp, Z_PresentRequest *req; int start; int number; - int r; if (argc <= 0) return TCL_OK; @@ -2088,7 +2061,6 @@ static int do_present (void *o, Tcl_Interp *interp, p = obj->parent; p->set_child = obj; - odr_reset (p->odr_out); obj->start = start; obj->number = number; @@ -2115,31 +2087,8 @@ static int do_present (void *o, Tcl_Interp *interp, } else req->preferredRecordSyntax = 0; - - if (!z_APDU (p->odr_out, &apdu, 0)) - { - interp->result = odr_errlist [odr_geterror (p->odr_out)]; - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in present"; - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Part of present request, start=%d, num=%d" - " (%d bytes)", start, number, p->slen); - } - else - { - logf (LOG_DEBUG, "Whole present request, start=%d, num=%d" - " (%d bytes)", start, number, p->slen); - } - return TCL_OK; + + return ir_tcl_send_APDU (interp, p, apdu, "present"); } /* @@ -2333,7 +2282,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) Z_APDU *apdu; IrTcl_ScanObj *obj = o; IrTcl_Obj *p = obj->parent; - int r; oident bib1; #if CCL2RPN struct ccl_rpn_node *rpn; @@ -2358,7 +2306,6 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) interp->result = "not connected"; return TCL_ERROR; } - odr_reset (p->odr_out); bib1.proto = p->protocol_type; bib1.class = CLASS_ATTSET; @@ -2398,29 +2345,8 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) *req->numberOfTermsRequested); logf (LOG_DEBUG, "preferredPositionInResponse=%d", *req->preferredPositionInResponse); - - if (!z_APDU (p->odr_out, &apdu, 0)) - { - interp->result = odr_errlist [odr_geterror (p->odr_out)]; - odr_reset (p->odr_out); - return TCL_ERROR; - } - p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL); - if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) - { - interp->result = "cs_put failed in scan"; - return TCL_ERROR; - } - else if (r == 1) - { - ir_select_add_write (cs_fileno(p->cs_link), p); - logf (LOG_DEBUG, "Sent part of scanRequest (%d bytes)", p->slen); - } - else - { - logf (LOG_DEBUG, "Whole scan request (%d bytes)", p->slen); - } - return TCL_OK; + + return ir_tcl_send_APDU (interp, p, apdu, "scan"); } /*