Non-blocking i/o used now. Database names popup as cascade items.

diff --git a/client.tcl b/client.tcl
index fed603c..1d57b89 100644 (file)
--- 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] <Return> $returnAction
         bind [lindex $list $i] <Escape> $escapeAction
         bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
+        bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
+        bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
     }
     bind [lindex $list $i] <Return> $returnAction
     bind [lindex $list $i] <Escape> $escapeAction
     bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
+    bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
+    bind [lindex $list $i] <Right> [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> {left-cursor .mid.searchentry}
+bind .mid.searchentry <Right> {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 <Double-Button-1> {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 (file)
--- 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 (file)
--- 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);