From: Adam Dickmeiss <adam@indexdata.dk>
Date: Mon, 20 Mar 1995 15:24:06 +0000 (+0000)
Subject: Diagnostic records saved on searchResponse.
X-Git-Tag: IRTCL.1.4~329
X-Git-Url: http://sru.miketaylor.org.uk/?a=commitdiff_plain;h=f05f33b0806afdf3eaa97f767b99c974649159f8;p=ir-tcl-moved-to-github.git

Diagnostic records saved on searchResponse.
---

diff --git a/client.tcl b/client.tcl
index 1d57b89..8b32509 100644
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,9 @@
 #
 # $Log: client.tcl,v $
-# Revision 1.9  1995-03-17 18:26:16  adam
+# Revision 1.10  1995-03-20 15:24:06  adam
+# Diagnostic records saved on searchResponse.
+#
+# 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
@@ -51,7 +54,7 @@ proc top-down-window {w} {
     pack  $w.top $w.bot -side top -fill both -expand yes
 }
 
-proc top-down-ok-cancel {w ok-action} {
+proc top-down-ok-cancel {w ok-action g} {
     frame $w.bot.left -relief sunken -border 1
     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
     button $w.bot.left.ok -width 6 -text {Ok} \
@@ -60,11 +63,12 @@ proc top-down-ok-cancel {w ok-action} {
     button $w.bot.cancel -width 6 -text {Cancel} \
             -command "destroy $w"
     pack $w.bot.cancel -side left -expand yes    
-    
-    # Grab ...
-    grab $w
-    
-    tkwait window $w
+
+    if {$g} {
+        # Grab ...
+        grab $w
+        tkwait window $w
+    }
 }
 
 proc show-target {target} {
@@ -299,7 +303,7 @@ proc load-set {} {
             {{Filename:}} \
             {load-set-action} {destroy .load-set}
     
-    top-down-ok-cancel $w {load-set-action}
+    top-down-ok-cancel $w {load-set-action} 1
 }
 
 proc init-request {} {
@@ -342,8 +346,8 @@ proc search-response {} {
     if {$setMax == 0} {
         return
     }
-    if {$setMax > 20} {
-        set setMax 20
+    if {$setMax > 10} {
+        set setMax 10
     }
     z39 callback {present-response}
     set setOffset 1
@@ -373,7 +377,7 @@ proc present-response {} {
     puts "Returned $no records, setOffset $setOffset"
     add-title-lines $no $setOffset
     set setOffset [expr $setOffset + $no]
-    if { $setOffset <= $setMax} {
+    if {$no > 0 && $setOffset <= $setMax} {
         z39.$setNo present $setOffset [expr $setMax - $setOffset + 1]
     } else {
         show-status {Finished} 0
@@ -418,7 +422,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 28 -relief sunken
+        entry $entry -width 32 -relief sunken
         pack $label -side left
         pack $entry -side right
         lappend alist $entry
@@ -445,7 +449,7 @@ proc define-target-dialog {} {
             {{Target:}} \
             {define-target-action} {destroy .target-define}
     
-    top-down-ok-cancel $w {define-target-action}
+    top-down-ok-cancel $w {define-target-action} 1
 }
 
 proc close-target {} {
@@ -463,7 +467,9 @@ proc protocol-setup-action {target} {
     global csRadioType
     global settingsChanged
 
-    set w .protocol-setup.top
+    set w .setup-${target}.top
+
+    #set w .protocol-setup.top
     
     set b {}
     set settingsChanged 1
@@ -482,7 +488,7 @@ proc protocol-setup-action {target} {
 
     cascade-target-list
     puts $profile($target)
-    destroy .protocol-setup
+    destroy .setup-${target}
 }
 
 
@@ -498,18 +504,21 @@ proc place-force {window parent} {
 }
 
 
-proc add-database-action {} {
-    .protocol-setup.top.databases.list insert end \
+proc add-database-action {target} {
+    set w .setup-${target}
+    
+    ${w}.top.databases.list insert end \
             [.database-select.top.database.entry get]
     destroy .database-select
 }
 
-proc add-database {} {
+proc add-database {target} {
     set w .database-select
 
+    set oldFocus [focus]
     toplevel $w
 
-    place-force $w .protocol-setup
+    place-force $w .setup-${target}
 
     top-down-window $w
 
@@ -519,20 +528,23 @@ proc add-database {} {
     
     entry-fields $w.top {database} \
             {{Database to add:}} \
-            {add-database-action} {destroy .database-select}
+            [list add-database-action $target] {destroy .database-select}
 
-    top-down-ok-cancel $w {add-database-action}
+    top-down-ok-cancel $w [list add-database-action $target] 1
+    focus $oldFocus
 }
 
-proc delete-database {} {
+proc delete-database {target} {
+    set w .setup-${target}
+    
     foreach i [lsort -decreasing \
-            [.protocol-setup.top.databases.list curselection]] {
-        .protocol-setup.top.databases.list delete $i
+            [$w.top.databases.list curselection]] {
+        $w.top.databases.list delete $i
     }
 }
 
 proc protocol-setup {target} {
-    set w .protocol-setup
+    set w .setup-$target
 
     global profile
     global csRadioType
@@ -570,7 +582,7 @@ proc protocol-setup {target} {
             maximumRecordSize preferredMessageSize} \
             {{Description:} {Host:} {Port:} {Id Authentification:} \
             {Maximum Record Size:} {Preferred Message Size:}} \
-            [list protocol-setup-action $target] {destroy .protocol-setup}
+            [list protocol-setup-action $target] [list destroy $w]
     
     $w.top.description.entry insert 0 [lindex $profile($target) 0]
     $w.top.host.entry insert 0 [lindex $profile($target) 1]
@@ -583,8 +595,10 @@ proc protocol-setup {target} {
     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
 
     label $w.top.databases.label -text "Databases"
-    button $w.top.databases.add -text "Add" -command {add-database}
-    button $w.top.databases.delete -text "Delete" -command {delete-database}
+    button $w.top.databases.add -text "Add" \
+            -command "add-database $target"
+    button $w.top.databases.delete -text "Delete" \
+            -command "delete-database $target"
     listbox $w.top.databases.list -geometry 20x6 \
             -yscrollcommand "$w.top.databases.scroll set"
     scrollbar $w.top.databases.scroll -orient vertical -border 1
@@ -627,8 +641,12 @@ proc protocol-setup {target} {
     pack $w.top.query.label -side top 
     pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
             -padx 4 -side top -fill x
-    
-    top-down-ok-cancel $w [list protocol-setup-action $target]
+
+    foreach sub [winfo children $w.top] {
+        puts $sub
+        bind $sub <Control-a> "add-database $target"
+    }
+    top-down-ok-cancel $w [list protocol-setup-action $target] 0
 }
 
 proc database-select-action {} {
@@ -677,7 +695,7 @@ proc database-select {} {
     foreach b [lindex $profile($hostid) 7] {
         $w.top.databases.list insert end $b
     }
-    top-down-ok-cancel $w {database-select-action}
+    top-down-ok-cancel $w {database-select-action} 1
 }
 
 proc cascade-target-list {} {
@@ -746,7 +764,7 @@ proc alert {ask} {
     pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
   
     set alertAnswer 0
-    top-down-ok-cancel $w {alert-action}
+    top-down-ok-cancel $w {alert-action} 1
     return $alertAnswer
 }
 
diff --git a/ir-tcl.c b/ir-tcl.c
index baaf68d..d9c4908 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -4,7 +4,10 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.14  1995-03-20 08:53:22  adam
+ * Revision 1.15  1995-03-20 15:24:07  adam
+ * Diagnostic records saved on searchResponse.
+ *
+ * Revision 1.14  1995/03/20  08:53:22  adam
  * Event loop in tclmain.c rewritten. New method searchStatus.
  *
  * Revision 1.13  1995/03/17  18:26:17  adam
@@ -61,6 +64,8 @@
 
 #include "ir-tcl.h"
 
+#define CS_BLOCK 0
+
 typedef struct {
     COMSTACK cs_link;
 
@@ -531,12 +536,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, 0);
+        p->cs_link = cs_create (tcpip_type, CS_BLOCK);
     }
     else if (cs_type (p->cs_link) == mosi_type)
     {
         cs_close (p->cs_link);
-        p->cs_link = cs_create (mosi_type, 0);
+        p->cs_link = cs_create (mosi_type, CS_BLOCK);
     }
     else
     {
@@ -557,9 +562,9 @@ static int do_comstack (void *obj, Tcl_Interp *interp,
     {
         cs_close (((IRObj*) obj)->cs_link);
         if (!strcmp (argv[2], "tcpip"))
-            ((IRObj *)obj)->cs_link = cs_create (tcpip_type, 0);
+            ((IRObj *)obj)->cs_link = cs_create (tcpip_type, CS_BLOCK);
         else if (!strcmp (argv[2], "mosi"))
-            ((IRObj *)obj)->cs_link = cs_create (mosi_type, 0);
+            ((IRObj *)obj)->cs_link = cs_create (mosi_type, CS_BLOCK);
         else
         {
             interp->result = "wrong comstack type";
@@ -695,7 +700,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, 0);
+    obj->cs_link = cs_create (tcpip_type, CS_BLOCK);
 
     obj->maximumRecordSize = 32768;
     obj->preferredMessageSize = 4096;
@@ -791,6 +796,11 @@ static int do_search (void *o, Tcl_Interp *interp,
     req.resultSetName = "Default";
     req.num_databaseNames = p->num_databaseNames;
     req.databaseNames = p->databaseNames;
+    printf ("Search:");
+    for (r=0; r<p->num_databaseNames; r++)
+    {
+        printf (" %s", p->databaseNames[r]);
+    }
     req.smallSetElementSetNames = 0;
     req.mediumSetElementSetNames = 0;
     req.preferredRecordSyntax = 0;
@@ -813,6 +823,7 @@ static int do_search (void *o, Tcl_Interp *interp,
         assert((RPNquery = ccl_rpn_query(rpn)));
         RPNquery->attributeSetId = bib1;
         query.u.type_1 = RPNquery;
+        printf ("- RPN\n");
     }
     else if (!strcmp (p->query_method, "ccl"))
     {
@@ -820,6 +831,7 @@ static int do_search (void *o, Tcl_Interp *interp,
         query.u.type_2 = &ccl_query;
         ccl_query.buf = argv[2];
         ccl_query.len = strlen (argv[2]);
+        printf ("- CCL\n");
     }
     else
     {
@@ -1271,22 +1283,6 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp,
 
 /* ------------------------------------------------------- */
 
-static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
-{    
-    IRObj *p = o;
-    IRSetObj *obj = p->child;
-
-    if (obj)
-    {
-        obj->searchStatus = searchrs->searchStatus ? 1 : 0;
-        obj->resultCount = *searchrs->resultCount;
-        printf ("Search response %d, %d hits\n", 
-                 obj->searchStatus, obj->resultCount);
-    }
-    else
-        printf ("Search response, no object!\n");
-}
-
 static void ir_initResponse (void *obj, Z_InitResponse *initrs)
 {
     if (!*initrs->result)
@@ -1313,77 +1309,105 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs)
 #endif
 }
 
-static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
+static void ir_handleRecords (void *o, Z_Records *zrs)
 {
     IRObj *p = o;
     IRSetObj *setobj = p->child;
-    Z_Records *zrs = presrs->records;
-    setobj->z_records = presrs->records;
-    
-    printf ("Received presentResponse\n");
-    if (zrs)
-    {
-        setobj->which = zrs->which;
-        if (zrs->which == Z_Records_NSD)
-        {
-            const char *addinfo;
-
-            printf ("They are diagnostic!!!\n");
 
-            setobj->numberOfRecordsReturned = 0;
-            setobj->condition = *zrs->u.nonSurrogateDiagnostic->condition;
-            free (setobj->addinfo);
-            setobj->addinfo = NULL;
-            addinfo = zrs->u.nonSurrogateDiagnostic->addinfo;
-            if (addinfo && (setobj->addinfo = malloc (strlen(addinfo) + 1)))
-                strcpy (setobj->addinfo, addinfo);
-            return;
-        }
-        else
+    if (zrs->which == Z_Records_NSD)
+    {
+        const char *addinfo;
+        
+        setobj->numberOfRecordsReturned = 0;
+        setobj->condition = *zrs->u.nonSurrogateDiagnostic->condition;
+        free (setobj->addinfo);
+        setobj->addinfo = NULL;
+        addinfo = zrs->u.nonSurrogateDiagnostic->addinfo;
+        if (addinfo && (setobj->addinfo = malloc (strlen(addinfo) + 1)))
+            strcpy (setobj->addinfo, addinfo);
+        printf ("Diagnostic response. %s (%d), info %s\n",
+                diagbib1_str (setobj->condition),
+                setobj->condition,
+                setobj->addinfo ? setobj->addinfo : "");
+    }
+    else
+    {
+        int offset;
+        IRRecordList *rl;
+        
+        setobj->numberOfRecordsReturned = 
+            zrs->u.databaseOrSurDiagnostics->num_records;
+        printf ("Got %d records\n", setobj->numberOfRecordsReturned);
+        for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
         {
-            int offset;
-            IRRecordList *rl;
-            
-            setobj->numberOfRecordsReturned = 
-                zrs->u.databaseOrSurDiagnostics->num_records;
-            printf ("Got %d records\n", setobj->numberOfRecordsReturned);
-            for (offset = 0; offset<setobj->numberOfRecordsReturned; offset++)
+            rl = new_IR_record (setobj, setobj->start + offset,
+                                zrs->u.databaseOrSurDiagnostics->
+                                records[offset]->which);
+            if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
             {
-                rl = new_IR_record (setobj, setobj->start + offset,
-                                    zrs->u.databaseOrSurDiagnostics->
-                                    records[offset]->which);
-                if (rl->which == Z_NamePlusRecord_surrogateDiagnostic)
+                Z_DiagRec *diagrec;
+                
+                diagrec = zrs->u.databaseOrSurDiagnostics->
+                    records[offset]->u.surrogateDiagnostic;
+                
+                rl->u.diag.condition = *diagrec->condition;
+                if (diagrec->addinfo && (rl->u.diag.addinfo =
+                                         malloc (strlen (diagrec->addinfo)+1)))
+                    strcpy (rl->u.diag.addinfo, diagrec->addinfo);
+            }
+            else
+            {
+                Z_DatabaseRecord *zr; 
+                Odr_external *oe;
+                
+                zr = zrs->u.databaseOrSurDiagnostics->records[offset]
+                    ->u.databaseRecord;
+                oe = (Odr_external*) zr;
+                if (oe->which == ODR_EXTERNAL_octet
+                    && zr->u.octet_aligned->len)
                 {
-                    Z_DiagRec *diagrec;
-
-                    diagrec = zrs->u.databaseOrSurDiagnostics->
-                              records[offset]->u.surrogateDiagnostic;
-
-                    rl->u.diag.condition = *diagrec->condition;
-                    if (diagrec->addinfo && (rl->u.diag.addinfo =
-                        malloc (strlen (diagrec->addinfo)+1)))
-                        strcpy (rl->u.diag.addinfo, diagrec->addinfo);
+                    const char *buf = (char*) zr->u.octet_aligned->buf;
+                    rl->u.marc.rec = iso2709_cvt (buf);
                 }
                 else
-                {
-                    Z_DatabaseRecord *zr; 
-                    Odr_external *oe;
-                    
-                    zr = zrs->u.databaseOrSurDiagnostics->records[offset]
-                        ->u.databaseRecord;
-                    oe = (Odr_external*) zr;
-                    if (oe->which == ODR_EXTERNAL_octet
-                        && zr->u.octet_aligned->len)
-                    {
-                        const char *buf = (char*) zr->u.octet_aligned->buf;
-                        rl->u.marc.rec = iso2709_cvt (buf);
-                    }
-                    else
-                        rl->u.marc.rec = NULL;
-                }
+                    rl->u.marc.rec = NULL;
             }
         }
     }
+}
+
+static void ir_searchResponse (void *o, Z_SearchResponse *searchrs)
+{    
+    IRObj *p = o;
+    IRSetObj *obj = p->child;
+
+    if (obj)
+    {
+        obj->searchStatus = searchrs->searchStatus ? 1 : 0;
+        obj->resultCount = *searchrs->resultCount;
+        printf ("Search response %d, %d hits\n", 
+                 obj->searchStatus, obj->resultCount);
+        if (searchrs->records)
+            ir_handleRecords (o, searchrs->records);
+    }
+    else
+        printf ("Search response, no object!\n");
+}
+
+
+static void ir_presentResponse (void *o, Z_PresentResponse *presrs)
+{
+    IRObj *p = o;
+    IRSetObj *setobj = p->child;
+    Z_Records *zrs = presrs->records;
+    setobj->z_records = presrs->records;
+    
+    printf ("Received presentResponse\n");
+    if (zrs)
+    {
+        setobj->which = zrs->which;
+        ir_handleRecords (o, zrs);
+    }
     else
     {
         printf ("No records!\n");
@@ -1443,7 +1467,8 @@ void ir_select_write (ClientData clientData)
 {
     IRObj *p = clientData;
     int r;
-    
+
+    printf ("In write handler.....\n");
     if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
     {   
         printf ("select write fail\n");