# 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
}
proc dputs {m} {
-# puts $m
+ puts $m
}
proc set-display-format {f} {
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]} {
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]
proc load-set {} {
set w .load-set
-
- set oldFocus [focus]
toplevel $w
-
+ set oldFocus [focus]
place-force $w .
top-down-window $w
unset profile($target)
set settingsChanged 1
cascade-target-list
+ delete-target-hotlist $target
}
}
$wno]
cascade-target-list
+ delete-target-hotlist $target
dputs $profile($target)
destroy $w
}
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}
global hostid
toplevel $w
-
+ set oldFocus [focus]
place-force $w .
top-down-window $w
$w.top.databases.list insert end $b
}
top-down-ok-cancel $w {database-select-action} 1
+ focus $oldFocus
}
proc cascade-target-list {} {
set w .query-new
toplevel $w
+ set oldFocus [focus]
place-force $w .
top-down-window $w
frame $w.top.index
{{Query Name:}} \
query-new-action {destroy .query-new}
top-down-ok-cancel $w query-new-action 1
+ focus $oldFocus
}
proc query-delete-action {queryNo} {
global alertAnswer
toplevel $w
+ set oldFocus [focus]
place-force $w .
top-down-window $w
set alertAnswer 0
top-down-ok-cancel $w {alert-action} 1
+ focus $oldFocus
return $alertAnswer
}
set w .query-add-index
toplevel $w
+ set oldFocus [focus]
place-force $w .query-setup
top-down-window $w
frame $w.top.index
{{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} {
.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
* 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.
/* ------------------------------------------------------- */
/*
+ * 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,
Z_APDU *apdu;
IrTcl_Obj *p = obj;
Z_InitRequest *req;
- int r;
if (argc <= 0)
return TCL_OK;
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;
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");
}
/*
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;
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);
IrTcl_Obj *p = obj;
Z_APDU *apdu;
Z_TriggerResourceControlRequest *req;
- int r;
+ bool_t is_false = 0;
if (argc <= 0)
return TCL_OK;
}
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");
}
/*
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;
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");
}
/*
Z_PresentRequest *req;
int start;
int number;
- int r;
if (argc <= 0)
return TCL_OK;
p = obj->parent;
p->set_child = obj;
- odr_reset (p->odr_out);
obj->start = start;
obj->number = number;
}
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");
}
/*
Z_APDU *apdu;
IrTcl_ScanObj *obj = o;
IrTcl_Obj *p = obj->parent;
- int r;
oident bib1;
#if CCL2RPN
struct ccl_rpn_node *rpn;
interp->result = "not connected";
return TCL_ERROR;
}
- odr_reset (p->odr_out);
bib1.proto = p->protocol_type;
bib1.class = CLASS_ATTSET;
*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");
}
/*
projects / ir-tcl-moved-to-github.git / commitdiff