From: Adam Dickmeiss Date: Fri, 17 Mar 1995 18:26:16 +0000 (+0000) Subject: Non-blocking i/o used now. Database names popup as cascade items. X-Git-Tag: IRTCL.1.4~331 X-Git-Url: http://git.indexdata.com/?p=ir-tcl-moved-to-github.git;a=commitdiff_plain;h=249971a4d8dae10b1b437320268d6bcf8b2b8886 Non-blocking i/o used now. Database names popup as cascade items. --- diff --git a/client.tcl b/client.tcl index fed603c..1d57b89 100644 --- a/client.tcl +++ b/client.tcl @@ -1,6 +1,9 @@ # # $Log: client.tcl,v $ -# Revision 1.8 1995-03-17 15:45:00 adam +# Revision 1.9 1995-03-17 18:26:16 adam +# Non-blocking i/o used now. Database names popup as cascade items. +# +# Revision 1.8 1995/03/17 15:45:00 adam # Improved target/database setup. # # Revision 1.7 1995/03/16 17:54:03 adam @@ -130,7 +133,7 @@ proc show-full-marc {no} { pack $w.top -side top -fill both -expand yes pack $w.bot -fill both - text $w.top.record -width 60 -height 10 \ + text $w.top.record -width 60 -height 10 -wrap word \ -yscrollcommand [list $w.top.s set] scrollbar $w.top.s -command [list $w.top.record yview] @@ -238,6 +241,8 @@ proc define-target-action {} { proc open-target {target base} { global profile + .top.target.m disable 0 + .top.target.m enable 1 z39 disconnect z39 comstack [lindex $profile($target) 6] # z39 idAuthentication [lindex $profile($target) 3] @@ -375,16 +380,34 @@ proc present-response {} { } } +proc left-cursor {w} { + set i [$w index insert] + if {$i > 0} { + incr i -1 + $w icursor $i + } +} + +proc right-cursor {w} { + set i [$w index insert] + incr i + $w icursor $i +} + proc bind-fields {list returnAction escapeAction} { set max [expr [llength $list]-1] for {set i 0} {$i < $max} {incr i} { bind [lindex $list $i] $returnAction bind [lindex $list $i] $escapeAction bind [lindex $list $i] [list focus [lindex $list [expr $i+1]]] + bind [lindex $list $i] [list left-cursor [lindex $list $i]] + bind [lindex $list $i] [list right-cursor [lindex $list $i]] } bind [lindex $list $i] $returnAction bind [lindex $list $i] $escapeAction bind [lindex $list $i] [list focus [lindex $list 0]] + bind [lindex $list $i] [list left-cursor [lindex $list $i]] + bind [lindex $list $i] [list right-cursor [lindex $list $i]] focus [lindex $list 0] } @@ -395,7 +418,7 @@ proc entry-fields {parent list tlist returnAction escapeAction} { set label ${parent}.${field}.label set entry ${parent}.${field}.entry label $label -text [lindex $tlist $i] -anchor e - entry $entry -width 26 -relief sunken + entry $entry -width 28 -relief sunken pack $label -side left pack $entry -side right lappend alist $entry @@ -431,6 +454,8 @@ proc close-target {} { show-target {None} show-status {Not connected} 0 show-message {} + .top.target.m disable 1 + .top.target.m enable 0 } proc protocol-setup-action {target} { @@ -768,6 +793,8 @@ menu .top.target.m .top.target.m add separator set-target-hotlist +.top.target.m disable 1 + menu .top.target.m.clist menu .top.target.m.slist cascade-target-list @@ -789,6 +816,9 @@ pack .top.help -side right label .mid.searchlabel -text {Search:} entry .mid.searchentry -width 40 -relief sunken +bind .mid.searchentry {left-cursor .mid.searchentry} +bind .mid.searchentry {right-cursor .mid.searchentry} + listbox .data.list -yscrollcommand {.data.scroll set} scrollbar .data.scroll -orient vertical -border 1 pack .data.list -side left -fill both -expand yes @@ -806,4 +836,3 @@ bind .data.list {set indx [.data.list nearest %y] show-full-marc $indx} ir z39 -z39 comstack tcpip diff --git a/ir-tcl.c b/ir-tcl.c index c9ac4b8..19bed8c 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -3,7 +3,10 @@ * (c) Index Data 1995 * * $Log: ir-tcl.c,v $ - * Revision 1.12 1995-03-17 15:45:00 adam + * Revision 1.13 1995-03-17 18:26:17 adam + * Non-blocking i/o used now. Database names popup as cascade items. + * + * Revision 1.12 1995/03/17 15:45:00 adam * Improved target/database setup. * * Revision 1.11 1995/03/16 17:54:03 adam @@ -73,6 +76,9 @@ typedef struct { char *buf_in; int len_in; + char *sbuf; + int slen; + ODR odr_in; ODR odr_out; ODR odr_pr; @@ -299,8 +305,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, Z_APDU apdu, *apdup; IRObj *p = obj; Z_InitRequest req; - char *sbuf; - int slen; + int r; req.referenceId = 0; req.options = &p->options; @@ -325,13 +330,19 @@ static int do_init_request (void *obj, Tcl_Interp *interp, odr_reset (p->odr_out); return TCL_ERROR; } - sbuf = odr_getbuf (p->odr_out, &slen); - if (cs_put (p->cs_link, sbuf, slen) < 0) - { + p->sbuf = odr_getbuf (p->odr_out, &p->slen); + if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) + { interp->result = "cs_put failed in init"; return TCL_ERROR; } - printf("Sent initializeRequest (%d bytes).\n", slen); + else if (r == 1) + { + ir_select_add_write (cs_fileno(p->cs_link), p); + printf("Sent part of initializeRequest (%d bytes).\n", p->slen); + } + else + printf("Sent whole initializeRequest (%d bytes).\n", p->slen); return TCL_OK; } @@ -515,12 +526,12 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, if (cs_type (p->cs_link) == tcpip_type) { cs_close (p->cs_link); - p->cs_link = cs_create (tcpip_type, 1); + p->cs_link = cs_create (tcpip_type, 0); } else if (cs_type (p->cs_link) == mosi_type) { cs_close (p->cs_link); - p->cs_link = cs_create (mosi_type, 1); + p->cs_link = cs_create (mosi_type, 0); } else { @@ -539,10 +550,11 @@ static int do_comstack (void *obj, Tcl_Interp *interp, char *cs_type = NULL; if (argc == 3) { + cs_close (((IRObj*) obj)->cs_link); if (!strcmp (argv[2], "tcpip")) - ((IRObj *)obj)->cs_link = cs_create (tcpip_type, 1); + ((IRObj *)obj)->cs_link = cs_create (tcpip_type, 0); else if (!strcmp (argv[2], "mosi")) - ((IRObj *)obj)->cs_link = cs_create (mosi_type, 1); + ((IRObj *)obj)->cs_link = cs_create (mosi_type, 0); else { interp->result = "wrong comstack type"; @@ -677,7 +689,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } if (!(obj = ir_malloc (interp, sizeof(*obj)))) return TCL_ERROR; - obj->cs_link = cs_create (tcpip_type, 1); + obj->cs_link = cs_create (tcpip_type, 0); obj->maximumRecordSize = 32768; obj->preferredMessageSize = 4096; @@ -748,8 +760,7 @@ static int do_search (void *o, Tcl_Interp *interp, Odr_oct ccl_query; IRSetObj *obj = o; IRObj *p = obj->parent; - char *sbuf; - int slen; + int r; p->child = o; if (argc != 3) @@ -815,13 +826,21 @@ static int do_search (void *o, Tcl_Interp *interp, odr_reset (p->odr_out); return TCL_ERROR; } - sbuf = odr_getbuf (p->odr_out, &slen); - if (cs_put (p->cs_link, sbuf, slen) < 0) + p->sbuf = odr_getbuf (p->odr_out, &p->slen); + if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) { interp->result = "cs_put failed in init"; return TCL_ERROR; } - printf ("Search request\n"); + else if (r == 1) + { + ir_select_add_write (cs_fileno(p->cs_link), p); + printf("Sent part of searchRequest (%d bytes).\n", p->slen); + } + else + { + printf ("Whole search request\n"); + } return TCL_OK; } @@ -1072,8 +1091,7 @@ static int do_present (void *o, Tcl_Interp *interp, Z_PresentRequest req; int start; int number; - char *sbuf; - int slen; + int r; if (argc >= 3) { @@ -1109,13 +1127,23 @@ static int do_present (void *o, Tcl_Interp *interp, odr_reset (p->odr_out); return TCL_ERROR; } - sbuf = odr_getbuf (p->odr_out, &slen); - if (cs_put (p->cs_link, sbuf, slen) < 0) + p->sbuf = odr_getbuf (p->odr_out, &p->slen); + if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) { interp->result = "cs_put failed in init"; return TCL_ERROR; } - printf ("Present request, start=%d, num=%d\n", start, number); + else if (r == 1) + { + ir_select_add_write (cs_fileno(p->cs_link), p); + printf ("Part of present request, start=%d, num=%d (%d bytes)\n", + start, number, p->slen); + } + else + { + printf ("Whole present request, start=%d, num=%d (%d bytes)\n", + start, number, p->slen); + } return TCL_OK; } @@ -1341,7 +1369,10 @@ static void ir_presentResponse (void *o, Z_PresentResponse *presrs) } } -void ir_select_proc (ClientData clientData) +/* + * ir_select_read: handle incoming packages + */ +void ir_select_read (ClientData clientData) { IRObj *p = clientData; Z_APDU *apdu; @@ -1384,6 +1415,25 @@ void ir_select_proc (ClientData clientData) } while (cs_more (p->cs_link)); } +/* + * ir_select_write: handle outgoing packages - not yet written. + */ +void ir_select_write (ClientData clientData) +{ + IRObj *p = clientData; + int r; + + if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) + { + printf ("select write fail\n"); + cs_close (p->cs_link); + } + else if (r == 0) /* remove select bit */ + { + ir_select_remove_write (cs_fileno (p->cs_link), p); + } +} + /* ------------------------------------------------------- */ /* @@ -1397,3 +1447,5 @@ int ir_tcl_init (Tcl_Interp *interp) (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } + + diff --git a/ir-tcl.h b/ir-tcl.h index 7b5883f..42ee0d1 100644 --- a/ir-tcl.h +++ b/ir-tcl.h @@ -3,13 +3,19 @@ * (c) Index Data 1995 * * $Log: ir-tcl.h,v $ - * Revision 1.3 1995-03-17 07:50:28 adam + * Revision 1.4 1995-03-17 18:26:18 adam + * Non-blocking i/o used now. Database names popup as cascade items. + * + * Revision 1.3 1995/03/17 07:50:28 adam * Headers have changed a little. * */ int ir_tcl_init (Tcl_Interp *interp); -void ir_select_add (int fd, void *obj); -void ir_select_remove (int fd, void *obj); -void ir_select_proc (ClientData clientData); +void ir_select_add (int fd, void *obj); +void ir_select_add_write (int fd, void *obj); +void ir_select_remove (int fd, void *obj); +void ir_select_remove_write (int fd, void *obj); +void ir_select_read (ClientData clientData); +void ir_select_write (ClientData clientData);