Bug fix in do_present in ir-tcl.c: p->set_child member weren't set.

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

diff --git a/client.tcl b/client.tcl
index d227e4c..ac98e3a 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,15 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.54  1995-06-27 14:41:03  adam
+# Revision 1.56  1995-06-27 19:03:48  adam
+# Bug fix in do_present in ir-tcl.c: p->set_child member weren't set.
+# nextResultSetPosition used instead of setOffset.
+#
+# Revision 1.55  1995/06/27  17:10:37  adam
+# Bug fix: install procedure didn't work on some systems.
+# Error turned up when clientrc.tcl was't present.
+#
+# 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
@@ -193,18 +201,25 @@
 #
 
 set libdir LIBDIR
-if {[file readable clientrc.tcl]} {
+if {[file readable bitmaps/book2]} {
        set libdir .
 }
+if {! [file readable ${libdir}/bitmaps/book2]} {
+    puts "Cannot locate system files in ${libdir}. You must either run this"
+    puts "program from the source directory root of ir-tcl or you must assure"
+    puts "that it is installed - normally in /usr/local/lib/irtcl"
+    exit 1
+}
+
 set hotTargets {}
 set hotInfo {}
 set busy 0
 
-set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} Z39}
+set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} Z39 1}
 set hostid Default
 set settingsChanged 0
 set setNo 0
-set lastSetNo 0
+set setNoLast 0
 set cancelFlag 0
 set scanEnable 0
 set fullMarcSeq 0
@@ -240,7 +255,7 @@ proc tkerror 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
+    bottom-buttons $w [list {Close} [list destroy $w]] 1
 }
 
 proc read-formats {} {
@@ -266,7 +281,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
-#    puts $m
+    puts $m
 }
 
 proc set-display-format {f} {
@@ -283,9 +298,6 @@ proc set-display-format {f} {
     }
     update idletasks
     add-title-lines -1 10000 1
-    if {!$busy} {
-        .bot.a.status configure -text "Ready"
-    }
 }
 
 proc initBindings {} {
@@ -338,8 +350,12 @@ proc toplevelG {w} {
     bind $w <Destroy> [list destroyGW $w]
 }
 
-if {[file readable "${libdir}/clientrc.tcl"]} {
-    source "${libdir}/clientrc.tcl"
+if {[file readable "clientrc.tcl"]} {
+    source "clientrc.tcl"
+} else {
+    if {[file readable "${libdir}/clientrc.tcl"]} {
+        source "${libdir}/clientrc.tcl"
+    }
 }
 
 if {[file readable "~/.clientrc.tcl"]} {
@@ -470,11 +486,13 @@ proc show-status {status b sb} {
         }
         if {$setNo == 0} {
             .top.service.m disable 1
-        } elseif {$setOffset > 0 && $setOffset <= [z39.$setNo resultCount]} {
+        } elseif {[z39.$setNo nextResultSetPosition] > 0 && 
+            [z39.$setNo nextResultSetPosition] <= [z39.$setNo resultCount]} {
             .top.service.m enable 1
             .mid.present configure -state normal
         } else {
             .top.service.m disable 1
+            .mid.present configure -state disabled
         }
         if {[winfo exists .scan-window]} {
             .scan-window.bot.2 configure -state normal
@@ -831,9 +849,11 @@ proc close-target {} {
     global hostid
     global cancelFlag
     global setNo
+    global setNoLast
 
     set cancelFlag 0
     set setNo 0
+    set setNoLast 0
     .bot.a.set configure -text ""
     set hostid Default
     z39 disconnect
@@ -843,14 +863,16 @@ proc close-target {} {
     show-message {}
     .top.target.m disable 1
     .top.target.m disable 2
+    .top.rset.m delete 1 last
+    .top.rset.m add separator
     .top.target.m enable 0
 }
 
 proc load-set-action {} {
-    global setNo
+    global setNoLast
 
-    incr setNo
-    ir-set z39.$setNo z39
+    incr setNoLast
+    ir-set z39.$setNoLast z39
 
     set fname [.load-set.top.filename.entry get]
     destroy .load-set
@@ -859,12 +881,12 @@ proc load-set-action {} {
         update
         z39.$setNo loadFile $fname
 
-        set no [z39.$setNo numberOfRecordsReturned]
-        add-title-lines $setNo $no 1
+        set no [z39.$setNoLast numberOfRecordsReturned]
+        add-title-lines $setNoLast $no 1
     }
-    set l [format "%-4d %7d" $setNo $no]
+    set l [format "%-4d %7d" $setNoLast $no]
     .top.rset.m add command -label $l \
-            -command [list add-title-lines $setNo 10000 1]
+            -command [list add-title-lines $setNoLast 10000 1]
     show-status {Ready} 0 {}
 }
 
@@ -889,7 +911,6 @@ proc load-set {} {
 }
 
 proc init-request {} {
-    global setNo
     global cancelFlag
 
     if {$cancelFlag} {
@@ -930,6 +951,7 @@ proc init-response {} {
 
 proc search-request {bflag} {
     global setNo
+    global setNoLast
     global profile
     global hostid
     global busy
@@ -957,7 +979,8 @@ proc search-request {bflag} {
     if {$query==""} {
         return
     }
-    incr setNo
+    incr setNoLast
+    set setNo $setNoLast
     ir-set z39.$setNo z39
 
     if {[lindex $profile($target) 10] == 1} {
@@ -1277,28 +1300,32 @@ proc search-response {} {
         }
         return
     }
+    set setOffset 0
     set delayRequest {}
     init-title-lines
     set setMax [z39.$setNo resultCount]
     show-status {Ready} 0 1
     set status [z39.$setNo responseStatus]
     if {[lindex $status 0] == "NSD"} {
-        set setOffset 0
+        z39.$setNo nextResultSetPosition 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"
+    if {$setMax == 0} {
+        return
+    }
     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]
+    if {$setMax > 20} {
+        set setMax 20
+    }
     z39 callback {present-response}
     z39.$setNo present $setOffset 1
     show-status {Retrieving} 1 0
@@ -1324,10 +1351,14 @@ proc present-more {number} {
         dputs "setNo=$setNo"
        return
     }
+    set setOffset [z39.$setNo nextResultSetPosition]
+    dputs "setOffest=${setOffset}"
+    dputs "setNo=${setNo}"
     set max [z39.$setNo resultCount]
-    if {$max <= $setOffset} {
+    if {$max < $setOffset} {
         dputs "max=$max"
         dputs "setOffset=$setOffset"
+        show-status Ready 0 1
         return
     }
     if {$number == ""} {
@@ -1362,12 +1393,13 @@ proc title-press {y setno} {
 proc add-title-lines {setno no offset} {
     global displayFormats
     global displayFormat
-    global lastSetNo
+    global setNo
+    global busy
 
-    if {$setno == -1} {
-        set setno $lastSetNo
+    if {$setno != -1} {
+        set setNo $setno
     } else {
-        set lastSetNo $setno
+        set setno $setNo
     }
     if {$offset == 1} {
         .bot.a.set configure -text $setno
@@ -1391,6 +1423,9 @@ proc add-title-lines {setno no offset} {
                 [list popup-marc $setno $o 0 0]
         update idletasks
     }
+    if {!$busy} {
+        show-status Ready 0 1
+    }
 }
 
 proc present-response {} {
@@ -1895,7 +1930,7 @@ proc query-delete {queryNo} {
 
     label $w.top.warning -bitmap warning
     message $w.top.quest -text "Are you sure you want to delete the \
-query type $n ?"  -aspect 200
+query type $n ?"  -aspect 300
     pack $w.top.warning $w.top.quest -side left -expand yes -padx 10 -pady 5
     bottom-buttons $w [list {Ok} [list query-delete-action $queryNo] \
                             {Cancel} [list destroy $w]] 1
@@ -1960,9 +1995,15 @@ proc save-settings {} {
     global queryInfo
    
     if {![file writable "${libdir}/clientrc.tcl"]} {
-       return
+        set a [alert "Cannot open ${libdir}/clientrc.tcl for writing. Do you \
+                wish to save clientrc.tcl in the current directory instead?"]
+        if {! $a} {
+            return
+        }
+        set f [open "clientrc.tcl" w]
+    } else {
+        set f [open "${libdir}/clientrc.tcl" w]
     }
-    set f [open "${libdir}/clientrc.tcl" w]
     puts $f "# Setup file"
 
     foreach n [array names profile] {
@@ -1995,7 +2036,7 @@ proc alert {ask} {
     top-down-window $w
 
     label $w.top.warning -bitmap warning
-    message $w.top.message -text $ask -aspect 200 \
+    message $w.top.message -text $ask -aspect 300 \
             -font -Adobe-Times-Medium-R-Normal-*-180-*
 
     pack $w.top.warning $w.top.message -side left -pady 5 -padx 10 -expand yes