Bug fix in search-response. Didn't always observe non-surrogate diagnostics.

[ir-tcl-moved-to-github.git] / client.tcl

diff --git a/client.tcl b/client.tcl
index 0418f81..d227e4c 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,14 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.52  1995-06-22 13:14:59  adam
+# Revision 1.54  1995-06-27 14:41:03  adam
+# Bug fix in search-response. Didn't always observe non-surrogate diagnostics.
+#
+# Revision 1.53  1995/06/26  12:40:09  adam
+# Client defines its own tkerror.
+# User may specify 'no preferredRecordSyntax'.
+#
+# Revision 1.52  1995/06/22  13:14:59  adam
 # Feature: SUTRS. Setting getSutrs implemented.
 # Work on display formats.
 # Preferred record syntax can be set by the user.
@@ -204,7 +211,7 @@ set fullMarcSeq 0
 set displayFormat 1
 set popupMarcdf 0
 set textWrap word
-set recordSyntax USMARC
+set recordSyntax None
 set delayRequest {}
 
 set queryTypes {Simple}
@@ -216,6 +223,26 @@ wm minsize . 0 0
 set setOffset 0
 set setMax 0
 
+proc tkerror err {
+    set w .tkerrorw
+
+    if {[winfo exists $w]} {
+        destroy $w
+    }
+    toplevel $w
+    wm title $w "Error"
+
+    place-force $w .
+    top-down-window $w
+
+    label $w.top.b -bitmap error
+    message $w.top.t -aspect 300 -text "Error: $err" \
+            -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
+    pack $w.top.b $w.top.t -side left -padx 10 -pady 10
+
+    bottom-buttons $w [list {Close} [list destroy $w]] 0
+}
+
 proc read-formats {} {
     global displayFormats
     global libdir
@@ -517,6 +544,7 @@ proc about-target {} {
     toplevel $w
 
     wm title $w "About target"
+    place-force $w .
     top-down-window $w
 
     frame $w.top.a -relief ridge -border 2
@@ -947,7 +975,11 @@ proc search-request {bflag} {
     }
     dputs Setting
     dputs $recordSyntax
-    z39.$setNo preferredRecordSyntax $recordSyntax
+    if {$recordSyntax == "None" } {
+        z39.$setNo preferredRecordSyntax {}
+    } else {
+        z39.$setNo preferredRecordSyntax $recordSyntax
+    }
     z39 callback {search-response}
     z39.$setNo search $query
     show-status {Searching} 1 0
@@ -1248,26 +1280,25 @@ proc search-response {} {
     set delayRequest {}
     init-title-lines
     set setMax [z39.$setNo resultCount]
-    show-message "${setMax} hits"
-    set l [format "%-4d %7d" $setNo $setMax]
-    .top.rset.m add command -label $l \
-            -command [list add-title-lines $setNo 10000 1]
-    if {$setMax <= 0} {
-        show-status {Ready} 0 1
-        set status [z39.$setNo responseStatus]
-        if {[lindex $status 0] == "NSD"} {
-            set code [lindex $status 1]
-            set msg [lindex $status 2]
-            set addinfo [lindex $status 3]
-            tkerror "NSD$code: $msg: $addinfo"
-        }
+    show-status {Ready} 0 1
+    set status [z39.$setNo responseStatus]
+    if {[lindex $status 0] == "NSD"} {
+        set setOffset 0
+        set code [lindex $status 1]
+        set msg [lindex $status 2]
+        set addinfo [lindex $status 3]
+        tkerror "NSD$code: $msg: $addinfo"
         return
     }
     if {$setMax > 20} {
         set setMax 20
     }
+    show-message "${setMax} hits"
     set setOffset 1
     show-status {Ready} 0 1
+    set l [format "%-4d %7d" $setNo $setMax]
+    .top.rset.m add command -label $l \
+            -command [list add-title-lines $setNo 10000 1]
     z39 callback {present-response}
     z39.$setNo present $setOffset 1
     show-status {Retrieving} 1 0
@@ -2806,6 +2837,9 @@ menu .top.options.m.wrap
         -value none -variable textWrap -command {set-wrap none}
 
 menu .top.options.m.syntax
+.top.options.m.syntax add radiobutton -label "None" \
+        -value None -variable recordSyntax
+.top.options.m.syntax add separator
 .top.options.m.syntax add radiobutton -label "USMARC" \
         -value USMARC -variable recordSyntax
 .top.options.m.syntax add radiobutton -label "UNIMARC" \