- * Copyright (C) 1995-1996, Index Data.
+ * Copyright (C) 1995-1997, Index Data.
* See the file LICENSE for details.
* Sebastian Hammer, Adam Dickmeiss
IrTcl version 1.2pl1
----- $Date: 1996-08-09 15:33:05 $
+---- $Date: 1997-09-09 10:19:49 $
Information about IrTcl can be found at http://www.indexdata.dk/irtcl.html.
This page contains pointers to documentation in various formats.
# IR toolkit for tcl/tk
-# (c) Index Data 1995-1996
+# (c) Index Data 1995-1997
# See the file LICENSE for details.
# Sebastian Hammer, Adam Dickmeiss
#
# $Log: client.tcl,v $
-# Revision 1.99 1997-04-13 19:00:37 adam
+# Revision 1.100 1997-09-09 10:19:50 adam
+# New MSV5.0 port with fewer warnings.
+#
+# Revision 1.99 1997/04/13 19:00:37 adam
# Added support for Tcl8.0/Tk8.0.
# New command ir-log-init to setup yaz logging facilities.
#
set setOffset 0
set setMax 0
+if {$tk_version == "3.6" || $tk_version == "4.0" || $tk_version == "4.1" ||
+ $tk_version == "4.2"} {
+ set font(bb,normal) -Adobe-Helvetica-Medium-R-Normal-*-240-*
+ set font(bb,bold) -Adobe-Helvetica-Bold-R-Normal-*-240-*
+ set font(b,normal) -Adobe-Helvetica-Medium-R-Normal-*-180-*
+ set font(b,bold) -Adobe-Helvetica-Bold-R-Normal-*-180-*
+ set font(n,normal) -Adobe-Helvetica-Medium-R-Normal-*-120-*
+ set font(n,bold) -Adobe-Helvetica-Bold-R-Normal-*-120-*
+ set font(s,bold) -Adobe-Helvetica-Bold-R-Normal-*-100-*
+ set font(ss,bold) -Adobe-Helvetica-Bold-R-Normal-*-80-*
+} else {
+ set font(bb,normal) {Helvetica 24}
+ set font(bb,bold) {Helvetica 24 bold}
+ set font(b,normal) {Helvetica 24}
+ set font(b,bold) {Helvetica 18 bold}
+ set font(n,normal) {Helvetica 12}
+ set font(n,bold) {Helvetica 12 bold}
+ set font(s,bold) {Helvetica 10 bold}
+ set font(ss,bold) {Helvetica 8 bold}
+}
+
# Procedure tkerror {err}
# err error message
# Override the Tk error handler function.
proc tkerror err {
+ global font
set w .tkerrorw
if {[winfo exists $w]} {
label $w.top.b -bitmap error
message $w.top.t -aspect 300 -text "Error: $err" \
- -font -Adobe-Helvetica-Bold-R-Normal-*-180-*
+ -font $font(b,bold)
pack $w.top.b $w.top.t -side left -padx 10 -pady 10
bottom-buttons $w [list {Close} [list destroy $w]] 1
# as implementation-name, implementation-id, etc.
proc about-target {} {
set w .about-target-w
- global hostid
+ global hostid font
toplevel $w
pack $w.top.a $w.top.p -side top -fill x
label $w.top.a.about -text "About"
- label $w.top.a.irtcl -text $hostid \
- -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
+ label $w.top.a.irtcl -text $hostid -font $font(bb,bold)
pack $w.top.a.about $w.top.a.irtcl -side top
set i [z39 targetImplementationName]
# Display various information about origin (this client).
proc about-origin {} {
set w .about-origin-w
- global libdir
- global tk_version
+ global libdir font tk_version
if {[winfo exists $w]} {
destroy $w
pack $w.top.a $w.top.p -side top -fill x
- label $w.top.a.irtcl -text "IrTcl" \
- -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
+ label $w.top.a.irtcl -text "IrTcl" -font $font(bb,bold)
label $w.top.a.logo -bitmap @${libdir}/bitmaps/book1
pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
# Displays record in set $sno at position $no in window .full-marc$b.
# The global variable $popupMarcdf holds the current format method.
proc popup-marc {sno no b df} {
- global displayFormats
- global popupMarcdf
+ global font displayFormats popupMarcdf
if {[z39.$sno type $no] != "DB"} {
return
$w.top.record tag configure marc-id -foreground black
}
$w.top.record tag configure marc-data -foreground black
- $w.top.record tag configure marc-head \
- -font -Adobe-Times-Medium-R-Normal-*-180-* \
+ $w.top.record tag configure marc-head -font $font(n,bold) \
-background black -foreground white
- $w.top.record tag configure marc-pref \
- -font -Adobe-Times-Medium-R-Normal-*-180-* \
+ $w.top.record tag configure marc-pref -font $font(n,normal) \
-foreground blue
- $w.top.record tag configure marc-text \
- -font -Adobe-Times-Medium-R-Normal-*-180-* \
+ $w.top.record tag configure marc-text -font $font(n,normal) \
-foreground black
- $w.top.record tag configure marc-it \
- -font -Adobe-Times-Medium-I-Normal-*-180-* \
+ $w.top.record tag configure marc-it -font $font(n,normal) \
-foreground black
pack $w.top.s -side right -fill y
proc alert {ask} {
set w .alert
- global alertAnswer
+ global alertAnswer font
toplevel $w
set oldFocus [focus]
top-down-window $w
label $w.top.warning -bitmap warning
- message $w.top.message -text $ask -aspect 300 \
- -font -Adobe-Times-Medium-R-Normal-*-180-*
+ message $w.top.message -text $ask -aspect 300 -font $font(b,normal)
pack $w.top.warning $w.top.message -side left -pady 5 -padx 10 -expand yes
.data.record tag configure marc-id -foreground black
}
.data.record tag configure marc-data -foreground black
-.data.record tag configure marc-head \
- -font -Adobe-Times-Bold-R-Normal-*-140-* \
+.data.record tag configure marc-head -font $font(n,normal) \
-foreground brown -relief raised -borderwidth 1
.data.record tag configure marc-small-head -foreground brown
.data.record tag configure marc-pref \
- -font -Adobe-Times-Medium-R-Normal-*-140-* \
- -foreground blue
+ -font $font(n,normal) -foreground blue
.data.record tag configure marc-text \
- -font -Adobe-Times-Medium-R-Normal-*-140-* \
- -foreground black
+ -font $font(n,normal) -foreground black
.data.record tag configure marc-it \
- -font -Adobe-Times-Medium-I-Normal-*-140-* \
- -foreground black
+ -font $font(n,normal) -foreground black
# Init: Define logo.
button .bot.logo -bitmap @${libdir}/bitmaps/book1 -command cancel-operation
source ${libdir}/explain.tcl
}
-if {[file exists ${libdir}/setup.tcl]} {
- source ${libdir}/setup.tcl
-}
+#if {[file exists ${libdir}/setup.tcl]} {
+# source ${libdir}/setup.tcl
+#}
# Init: Uncomment this line if you wan't to enable logging.
ir-log-init all
/*
* IR toolkit for tcl/tk
- * (c) Index Data 1996
+ * (c) Index Data 1996-1997
* See the file LICENSE for details.
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: explain.c,v $
- * Revision 1.7 1997-08-28 20:17:36 adam
+ * Revision 1.8 1997-09-09 10:19:51 adam
+ * New MSV5.0 port with fewer warnings.
+ *
+ * Revision 1.7 1997/08/28 20:17:36 adam
* Fixed small bug.
*
* Revision 1.6 1997/05/14 06:57:14 adam
int (*handle)();
} IrExpChoice;
+static Odr_null *ODR_NULLVALUE = "NULL";
+
typedef char *Z_ElementSetName;
typedef Odr_oid *Z_AttributeSetId;
typedef char *Z_InternationalString;
typedef char *Z_LanguageCode;
+
static int ir_UnitType (IrExpArg *iea,
Z_UnitType *p, const char *name, int argi);
static int ir_Unit (IrExpArg *iea,
if (!ir_match_start (name, p, iea, ++argi))
return TCL_OK;
- ir_choice (iea, arm, p, ODR_NULLVAL, argi);
+ ir_choice (iea, arm, p, ODR_NULLVALUE, argi);
return ir_match_end (name, iea, argi);
}
ir_InternationalString (iea, p->name, "name", argi);
ir_HumanString (iea, p->title, "title", argi);
if (p->searchCost)
- ir_choice (iea, searchCostArm, p->searchCost, ODR_NULLVAL, argi);
+ ir_choice (iea, searchCostArm, p->searchCost, ODR_NULLVALUE, argi);
ir_bool (iea, p->scanable, "scanable", argi);
ir_sequence (ir_InternationalString, iea, p->broader,
ir_bool (iea, p->available, "available", argi);
ir_bool (iea, p->retentionSupported, "retentionSupported", argi);
- ir_choice (iea, waitActionArm, p->waitAction, ODR_NULLVAL, argi);
+ ir_choice (iea, waitActionArm, p->waitAction, ODR_NULLVALUE, argi);
ir_HumanString (iea, p->description, "description", argi);
ir_External (iea, p->specificExplain, "specificExplain", argi);
ir_SortKeyDetailsSortType (iea, p->sortType, "sortType", argi);
if (p->caseSensitivity)
- ir_choice (iea, sortArm, p->caseSensitivity, ODR_NULLVAL, argi);
+ ir_choice (iea, sortArm, p->caseSensitivity, ODR_NULLVALUE, argi);
return ir_match_end (name, iea, argi);
}
ir_CommonInfo (iea, p->commonInfo, "commonInfo", argi);
ir_DatabaseName (iea, p->databaseName, "databaseName", argi);
- ir_choice (iea, arm, p->processingContext, ODR_NULLVAL, argi);
+ ir_choice (iea, arm, p->processingContext, ODR_NULLVALUE, argi);
ir_InternationalString (iea, p->name, "name", argi);
ir_oid (iea, p->oid, "oid", argi);
ir_HumanString (iea, p->description, "description", argi);
{ NULL, 0, NULL }};
if (!ir_match_start (name, p, iea, ++argi))
return TCL_OK;
- ir_choice (iea, arm, &p->which, ODR_NULLVAL, argi);
+ ir_choice (iea, arm, &p->which, ODR_NULLVALUE, argi);
ir_InternationalString (iea, p->bodyType, "bodyType", argi);
ir_octet (iea, p->content, "content", argi);
return ir_match_end (name, iea, argi);
if (!ir_match_start (name, p, iea, ++argi))
return TCL_OK;
- ir_choice (iea, arm, p->accessType, ODR_NULLVAL, argi);
+ ir_choice (iea, arm, p->accessType, ODR_NULLVALUE, argi);
ir_HumanString (iea, p->accessText, "accessText", argi);
ir_sequence (ir_oid, iea, p->accessChallenges,
&p->num_accessChallenges, "accessChallenges", argi);
/*
* IR toolkit for tcl/tk
- * (c) Index Data 1995-1996
+ * (c) Index Data 1995-1997
* See the file LICENSE for details.
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: grs.c,v $
- * Revision 1.9 1996-08-16 15:07:44 adam
+ * Revision 1.10 1997-09-09 10:19:52 adam
+ * New MSV5.0 port with fewer warnings.
+ *
+ * Revision 1.9 1996/08/16 15:07:44 adam
* First work on Explain.
*
* Revision 1.8 1996/07/03 13:31:10 adam
}
else
{
- int len = strlen(cp1+1);
+ size_t len = strlen(cp1+1);
if (cp1[len] == ')')
len--;
if (len && strlen(e->tagVal.str) == len &&
/*
* IR toolkit for tcl/tk
- * (c) Index Data 1995-1996
+ * (c) Index Data 1995-1997
* See the file LICENSE for details.
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tcl.c,v $
- * Revision 1.100 1997-05-01 15:04:05 adam
+ * Revision 1.101 1997-09-09 10:19:53 adam
+ * New MSV5.0 port with fewer warnings.
+ *
+ * Revision 1.100 1997/05/01 15:04:05 adam
* Added ir-log command.
*
* Revision 1.99 1997/04/30 07:24:47 adam
odr_reset (p->odr_in);
+#if TCL_MAJOR_VERSION == 8
+ cs_fileno(p->cs_link) = -1;
+#endif
cs_close (p->cs_link);
p->cs_link = NULL;
int argc, char **argv)
{
IrTcl_Methods tab[3];
- IrTcl_Obj *p = clientData;
+ IrTcl_Obj *p = (IrTcl_Obj *) clientData;
int r;
if (argc < 2)
*/
static void ir_obj_delete (ClientData clientData)
{
- IrTcl_Obj *obj = clientData;
+ IrTcl_Obj *obj = (IrTcl_Obj *) clientData;
IrTcl_Methods tab[3];
--(obj->ref_count);
Tcl_AppendResult (interp, "Failed to initialize ", argv[1], NULL);
return TCL_ERROR;
}
- *subData = obj;
+ *subData = (ClientData) obj;
return TCL_OK;
}
Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
return TCL_ERROR;
}
- if (rl->u.dbrec.type != VAL_SUTRS)
+ if (!rl->u.dbrec.buf || rl->u.dbrec.type != VAL_SUTRS)
return TCL_OK;
Tcl_AppendElement (interp, rl->u.dbrec.buf);
return TCL_OK;
Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
return TCL_ERROR;
}
- if (rl->u.dbrec.type != VAL_EXPLAIN)
+ if (!rl->u.dbrec.buf || rl->u.dbrec.type != VAL_EXPLAIN)
return TCL_OK;
if (!(etype = z_ext_getentbyref (VAL_EXPLAIN)))
return TCL_OK;
-
+ assert (rl->u.dbrec.buf);
odr_setbuf (p->odr_in, rl->u.dbrec.buf, rl->u.dbrec.size, 0);
if (!(*etype->fun)(p->odr_in, &rr, 0))
return TCL_OK;
typedef struct {
int encoding;
int syntax;
- int size;
+ size_t size;
} IrTcl_FileRecordHead;
/*
int argc, char **argv)
{
IrTcl_Methods tabs[3];
- IrTcl_SetObj *p = clientData;
+ IrTcl_SetObj *p = (IrTcl_SetObj *) clientData;
int r;
if (argc < 2)
static void ir_set_obj_delete (ClientData clientData)
{
IrTcl_Methods tabs[3];
- IrTcl_SetObj *p = clientData;
+ IrTcl_SetObj *p = (IrTcl_SetObj *) clientData;
logf (LOG_DEBUG, "ir set delete");
if (ir_tcl_method (interp, 0, NULL, tabs, NULL) == TCL_ERROR)
return TCL_ERROR;
- *subData = obj;
+ *subData = (ClientData) obj;
return TCL_OK;
}
static void ir_scan_obj_delete (ClientData clientData)
{
IrTcl_Methods tabs[2];
- IrTcl_ScanObj *obj = clientData;
+ IrTcl_ScanObj *obj = (IrTcl_ScanObj *) clientData;
tabs[0].tab = ir_scan_method_tab;
tabs[0].obj = obj;
*/
static void ir_select_read (ClientData clientData)
{
- IrTcl_Obj *p = clientData;
+ IrTcl_Obj *p = (IrTcl_Obj *) clientData;
Z_APDU *apdu;
int r;
IrTcl_Request *rq;
p->failInfo = IR_TCL_FAIL_CONNECT;
ir_tcl_eval (p->interp, p->failback);
}
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return;
}
if (p->callback)
if (p->ref_count == 2 && p->cs_link && p->request_queue
&& p->state == IR_TCL_R_Idle)
ir_tcl_send_q (p, p->request_queue, "x");
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return;
}
do
if (r <= 0)
{
logf (LOG_DEBUG, "cs_get failed, code %d", r);
- ir_select_remove (cs_fileno (p->cs_link), p);
ir_tcl_disconnect (p);
if (p->failback)
{
ir_tcl_eval (p->interp, p->failback);
}
/* release ir object now if callback deleted it */
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return;
}
/* got complete APDU. Now decode */
ir_tcl_eval (p->interp, p->failback);
}
/* release ir object now if failback deleted it */
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return;
}
/* handle APDU and invoke callback */
odr_reset (p->odr_in);
if (p->ref_count == 1)
{
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return;
}
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
} while (p->cs_link && cs_more (p->cs_link));
if (p->cs_link && p->request_queue && p->state == IR_TCL_R_Idle)
ir_tcl_send_q (p, p->request_queue, "x");
*/
static int ir_select_write (ClientData clientData)
{
- IrTcl_Obj *p = clientData;
+ IrTcl_Obj *p = (IrTcl_Obj *) clientData;
int r;
IrTcl_Request *rq;
p->failInfo = IR_TCL_FAIL_CONNECT;
ir_tcl_eval (p->interp, p->failback);
}
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return 2;
}
if (p->callback)
ir_tcl_eval (p->interp, p->callback);
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
return 2;
}
rq = p->request_queue;
p->failInfo = IR_TCL_FAIL_WRITE;
ir_tcl_eval (p->interp, p->failback);
}
- ir_obj_delete (p);
+ ir_obj_delete ((ClientData) p);
}
else if (r == 0) /* remove select bit */
{
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: ir-tclp.h,v $
- * Revision 1.34 1996-08-16 15:07:47 adam
+ * Revision 1.35 1997-09-09 10:19:54 adam
+ * New MSV5.0 port with fewer warnings.
+ *
+ * Revision 1.34 1996/08/16 15:07:47 adam
* First work on Explain.
*
* Revision 1.33 1996/07/03 13:31:13 adam
struct IrTcl_GRS_Record_ *sub;
char *str;
struct {
- int len;
+ size_t len;
char *buf;
} octets;
int num;
union {
IrTcl_GRS_Record *grs1;
} u;
+ int type;
+#if 0
enum oid_value type;
+#endif
} dbrec;
struct {
int num;
* Sebastian Hammer, Adam Dickmeiss
*
* $Log: select.c,v $
- * Revision 1.4 1997-08-28 20:20:48 adam
+ * Revision 1.5 1997-09-09 10:19:55 adam
+ * New MSV5.0 port with fewer warnings.
+ *
+ * Revision 1.4 1997/08/28 20:20:48 adam
* Added support for Tk8.0/Tcl8.0. Since Tcl_File handlers are gone
* we've moved to Tcl_Channel handlers instead.
*
(*sp)->f = f;
(*sp)->clientData = clientData;
Tcl_CreateChannelHandler ((*sp)->tcl_Channel, mask,
- ir_tcl_tk_select_proc, *sp);
+ ir_tcl_tk_select_proc,
+ (ClientData) *sp);
}
#endif