More work on cancel mechanism.

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

diff --git a/client.tcl b/client.tcl
index 0e22966..9da25e0 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,14 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.47  1995-06-19 14:05:29  adam
+# Revision 1.49  1995-06-20 14:16:42  adam
+# More work on cancel mechanism.
+#
+# Revision 1.48  1995/06/20  08:07:23  adam
+# New setting: failInfo.
+# Working on better cancel mechanism.
+#
+# Revision 1.47  1995/06/19  14:05:29  adam
 # Bug fix: asked for SUTRS.
 #
 # Revision 1.46  1995/06/19  13:06:06  adam
@@ -176,12 +183,12 @@ set settingsChanged 0
 set setNo 0
 set lastSetNo 0
 set cancelFlag 0
-set searchEnable 0
 set scanEnable 0
 set fullMarcSeq 0
 set displayFormat 1
 set popupMarcdf 0
 set textWrap word
+set delayRequest {}
 
 set queryTypes {Simple}
 set queryButtons { { {I 0} {I 1} {I 2} } }
@@ -210,7 +217,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
-#    puts $m
+    puts $m
 }
 
 proc set-display-format {f} {
@@ -344,10 +351,12 @@ proc bottom-buttons {w buttonList g} {
 proc cancel-operation {} {
     global cancelFlag
     global busy
+    global delayRequest
 
-    set cancelFlag 1
     if {$busy} {
-        show-status Canceling 0 {}
+        set cancelFlag 1
+        set delayRequest {}
+        show-status Cancel 0 1
     }
 }
 
@@ -388,7 +397,6 @@ proc show-logo {v1} {
         
 proc show-status {status b sb} {
     global busy
-    global searchEnable
     global scanEnable
     global setOffset
     global setMax
@@ -421,7 +429,6 @@ proc show-status {status b sb} {
             .scan-window.bot.2 configure -state normal
             .scan-window.bot.4 configure -state normal
         }
-        set searchEnable 1
     } else {
         .top.service configure -state disabled
         .mid.search configure -state disabled
@@ -432,7 +439,6 @@ proc show-status {status b sb} {
             .scan-window.bot.2 configure -state disabled
             .scan-window.bot.4 configure -state disabled
         }
-        set searchEnable 0
     }
 }
 
@@ -716,8 +722,10 @@ proc define-target-action {} {
 }
 
 proc fail-response {target} {
+    set c [lindex [z39 failInfo] 0]
+    set m [lindex [z39 failInfo] 1]
     close-target
-    tkerror "Target connection closed or protocol error"
+    tkerror "$m ($c)"
 }
 
 proc connect-response {target base} {
@@ -865,19 +873,30 @@ proc init-response {} {
     }
 }
 
-proc search-request {} {
+proc search-request {bflag} {
     global setNo
     global profile
     global hostid
     global busy
     global cancelFlag
-    global searchEnable
+    global delayRequest
 
     set target $hostid
 
-    if {$searchEnable == 0} {
+    dputs "search-request"
+    show-message {}
+    if {!$bflag && $busy} {
+        dputs "busy: search-request ignored"
         return
     }
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Searching} 1 0
+        set delayRequest {search-request 1}
+        return
+    }
+    set delayRequest {} 
+
     set query [index-query]
     if {$query==""} {
         return
@@ -921,6 +940,17 @@ proc scan-request {} {
     global curIndexEntry
     global queryButtonsFind
     global queryInfoFind
+    global cancelFlag
+    global delayRequest
+
+    dputs "scan-request"
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Scanning} 1 0
+        set delayRequest scan-request
+        return
+    }
+    set delayRequest {} 
 
     set target $hostid
     set scanView 0
@@ -1000,6 +1030,7 @@ proc scan-term-h {attr} {
 
 proc scan-response {attr start toget} {
     global cancelFlag
+    global delayRequest
     global scanTerm
     global scanView
 
@@ -1012,8 +1043,15 @@ proc scan-response {attr start toget} {
     dputs toget=$toget
 
     if {![winfo exists .scan-window]} {
+        if {$cancelFlag} {
+            set cancelFlag 0
+            dputs "Handling cancel"
+            if {$delayRequest != ""} {
+                eval $delayRequest
+            }
+            return
+        }
         show-status {Ready} 0 1
-        set cancelFlag 0
         return
     }
     set nScanTerm [$w.top.entry get]
@@ -1055,10 +1093,14 @@ proc scan-response {attr start toget} {
         }
     }
     if {$cancelFlag} {
-        show-status {Ready} 0 1
+        dputs "Handling cancel"
         set cancelFlag 0
+        if {$delayRequest != ""} {
+            eval $delayRequest
+        }
         return
     }
+    set delayRequest {}
     if {$toget > 0 && $m > 1 && $m < $toget} {
         set ntoget [expr $toget - $m + 1]
         dputs ntoget=$ntoget
@@ -1097,6 +1139,17 @@ proc scan-response {attr start toget} {
 
 proc scan-down {attr} {
     global scanView
+    global cancelFlag
+    global delayRequest
+
+    dputs {scan-down}
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Scanning down} 1 0
+        set delayRequest [list scan-down $attr]
+        return
+    }
+    set delayRequest {} 
 
     set w .scan-window
     set scanView [expr $scanView + 5]
@@ -1117,6 +1170,17 @@ proc scan-down {attr} {
 
 proc scan-up {attr} {
     global scanView
+    global cancelFlag
+    global delayRequest
+
+    dputs {scan-up}
+    if {$cancelFlag} {
+        dputs "cancelFlag"
+        show-status {Scanning up} 1 0
+        set delayRequest [list scan-up $attr]
+        return
+    }
+    set delayRequest {} 
 
     set w .scan-window
     set scanView [expr $scanView - 5]
@@ -1139,8 +1203,18 @@ proc search-response {} {
     global setMax
     global cancelFlag
     global busy
+    global delayRequest
 
     dputs "In search-response"
+    if {$cancelFlag} {
+        dputs "Handling cancel"
+        set cancelFlag 0
+        if {$delayRequest != ""} {
+            eval $delayRequest
+        }
+        return
+    }
+    set delayRequest {}
     init-title-lines
     set setMax [z39.$setNo resultCount]
     show-message "${setMax} hits"
@@ -1163,10 +1237,6 @@ proc search-response {} {
     }
     set setOffset 1
     show-status {Ready} 0 1
-    if {$cancelFlag} {
-        set cancelFlag 0
-        return
-    }
     z39 callback {present-response}
     z39.$setNo present $setOffset 1
     show-status {Retrieving} 1 0
@@ -1176,9 +1246,18 @@ proc present-more {number} {
     global setNo
     global setOffset
     global setMax
+    global busy
+    global cancelFlag
+    global delayRequest
 
-    dputs "setOffset=$setOffset"
     dputs "present-more"
+    if {$cancelFlag} {
+        show-status {Retrieving} 1 0
+        set delayRequest "present-more $number"
+        return
+    }
+    set delayRequest {}
+
     if {$setNo == 0} {
         dputs "setNo=$setNo"
        return
@@ -1256,12 +1335,21 @@ proc present-response {} {
     global setOffset
     global setMax
     global cancelFlag
+    global delayRequest
 
     dputs "In present-response"
     set no [z39.$setNo numberOfRecordsReturned]
     dputs "Returned $no records, setOffset $setOffset"
     add-title-lines $setNo $no $setOffset
     set setOffset [expr $setOffset + $no]
+    if {$cancelFlag} {
+        dputs "Handling cancel"
+        set cancelFlag 0
+        if {$delayRequest != ""} {
+            eval $delayRequest
+        }
+        return
+    }
     set status [z39.$setNo responseStatus]
     if {[lindex $status 0] == "NSD"} {
         show-status {Ready} 0 1
@@ -1271,11 +1359,6 @@ proc present-response {} {
         tkerror "NSD$code: $msg: $addinfo"
         return
     }
-    if {$cancelFlag} {
-        show-status {Ready} 0 1
-        set cancelFlag 0
-        return
-    }
     if {$no > 0 && $setOffset <= $setMax} {
         dputs "present-request from ${setOffset}"
         set toGet [expr $setMax - $setOffset + 1]
@@ -2523,7 +2606,7 @@ proc index-lines {w realOp buttonInfo queryInfo handle} {
                 pack $w.$i -side top -fill x -padx 2 -pady 2
                 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
                 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
-                bind $w.$i.e <Return> search-request
+                bind $w.$i.e <Return> {search-request 0}
             }
         } else {
             pack $w.$i.l -side left
@@ -2636,7 +2719,7 @@ menu .top.service.m.present
         -command [list present-more 10]
 .top.service.m.present add command -label "All" \
         -command [list present-more {}]
-.top.service.m add command -label "Search" -command {search-request}
+.top.service.m add command -label "Search" -command {search-request 0}
 .top.service.m add command -label "Scan" -command {scan-request}
 
 .top.service configure -state disabled
@@ -2695,7 +2778,7 @@ pack .top.help -side right
 
 index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
 
-button .mid.search -width 7 -text {Search} -command search-request \
+button .mid.search -width 7 -text {Search} -command {search-request 0} \
         -state disabled
 button .mid.scan -width 7 -text {Scan} \
         -command scan-request -state disabled