From: Adam Dickmeiss <adam@indexdata.dk>
Date: Tue, 6 Jun 1995 16:31:09 +0000 (+0000)
Subject: Bug fix: target names couldn't contain blanks.
X-Git-Tag: IRTCL.1.4~287
X-Git-Url: http://sru.miketaylor.org.uk/?a=commitdiff_plain;h=c5a9d6829720923f20fb4382d1f89d2a87101136;p=ir-tcl-moved-to-github.git

Bug fix: target names couldn't contain blanks.
Bug fix: scan.
---

diff --git a/client.tcl b/client.tcl
index f4c37c8..1478303 100644
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,10 @@
 #
 # $Log: client.tcl,v $
-# Revision 1.30  1995-06-06 11:35:41  adam
+# Revision 1.31  1995-06-06 16:31:09  adam
+# Bug fix: target names couldn't contain blanks.
+# Bug fix: scan.
+#
+# Revision 1.30  1995/06/06  11:35:41  adam
 # Work on scan. Display of old sets.
 #
 # Revision 1.29  1995/06/05  14:11:18  adam
@@ -394,7 +398,7 @@ proc set-target-hotlist {} {
     set i 1
     foreach target $hotTargets {
         .top.target.m add command -label "$i $target" -command \
-                "reopen-target $target {}"
+                [list reopen-target $target {}]
         incr i
         if {$i > 8} {
              break
@@ -410,7 +414,7 @@ proc reopen-target {target base} {
 
 proc define-target-action {} {
     global profile
-
+    
     set target [.target-define.top.target.entry get]
     if {$target == ""} {
         return
@@ -422,7 +426,11 @@ proc define-target-action {} {
             return
         }
     }
+    set seq [lindex $profile(Default) 12]
+    puts "seq=${seq}"
     set profile($target) $profile(Default)
+    set profile(Default) [lreplace $profile(Default) 12 12 [incr seq]]
+
     protocol-setup $target
     destroy .target-define
 }
@@ -639,7 +647,7 @@ proc scan-request {attr} {
         bind $w.top.list <Down> [list scan-down $attr]
     }
     focus $w.top.entry
-    z39 callback [list scan-response $attr 0 25]
+    z39 callback [list scan-response $attr 0 35]
     z39.scan numberOfTermsRequested 5
     z39.scan preferredPositionInResponse 1
     z39.scan scan "${attr} 0"
@@ -660,10 +668,9 @@ proc scan-term-h {attr} {
         return
     }
     set scanTerm $nScanTerm
-    z39 callback [list scan-response $attr 0 25]
+    z39 callback [list scan-response $attr 0 35]
     z39.scan numberOfTermsRequested 5
     z39.scan preferredPositionInResponse 1
-    $w.top.list delete 0 end
     puts "${attr} \{${scanTerm}\}"
     if {$scanTerm == ""} {
         z39.scan scan "${attr} 0"
@@ -676,6 +683,7 @@ proc scan-term-h {attr} {
 proc scan-response {attr start toget} {
     global cancelFlag
     global scanTerm
+    global scanView
 
     set w .scan-window
     puts "In scan-response"
@@ -692,11 +700,10 @@ proc scan-response {attr start toget} {
     }
     set nScanTerm [$w.top.entry get]
     if {$nScanTerm != $scanTerm} {
-        z39 callback [list scan-response $attr 0 25]
+        z39 callback [list scan-response $attr 0 35]
         z39.scan numberOfTermsRequested 5
         z39.scan preferredPositionInResponse 1
         set scanTerm $nScanTerm
-        $w.top.list delete 0 end
         puts "${attr} \{${scanTerm}\}"
         if {$scanTerm == ""} {
             z39.scan scan "${attr} 0"
@@ -704,6 +711,14 @@ proc scan-response {attr start toget} {
             z39.scan scan "${attr} \{${scanTerm}\}"
         }
         show-status {Scan} 1 0
+        return
+    }
+    set status [z39.scan scanStatus]
+    if {$status == 6} {
+        tkerror "Scan fail"
+        show-status {Ready} 0 1
+        set cancelFlag 0
+        return
     }
     if {$toget < 0} {
         for {set i 0} {$i < $m} {incr i} {
@@ -711,6 +726,8 @@ proc scan-response {attr start toget} {
             set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]]
             $w.top.list insert $i "$nostr $term"
         }
+        incr scanView $m
+        $w.top.list yview $scanView
     } else {
         $w.top.list delete $start end
         for {set i 0} {$i < $m} {incr i} {
@@ -767,7 +784,7 @@ proc scan-down {attr} {
     set scanView [expr $scanView + 5]
     set s [$w.top.list size]
     if {$scanView > $s} {
-        z39 callback [list scan-response $attr [expr $s - 1] 30]
+        z39 callback [list scan-response $attr [expr $s - 1] 25]
         set q [string range [$w.top.list get [expr $s - 1]] 8 end]
         puts "down: $q"
         z39.scan numberOfTermsRequested 10
@@ -784,8 +801,9 @@ proc scan-up {attr} {
     global scanView
 
     set w .scan-window
-    if {$scanView < 5} {
-        z39 callback [list scan-response $attr 0 -30]
+    set scanView [expr $scanView - 5]
+    if {$scanView < 0} {
+        z39 callback [list scan-response $attr 0 -25]
         set q [string range [$w.top.list get 0] 8 end]
         puts "up: $q"
         z39.scan numberOfTermsRequested 10
@@ -794,7 +812,6 @@ proc scan-up {attr} {
         z39.scan scan "${attr} \{$q\}"
         return
     }
-    set scanView [expr $scanView - 5]
     $w.top.list yview $scanView
 }
 
@@ -1016,32 +1033,32 @@ proc protocol-setup-action {target} {
     global CCLCheck
     global ResultSetCheck
 
-    set w .setup-${target}.top
-
-    #set w .protocol-setup.top
+    set wno [lindex $profile($target) 12]
+    set w .setup-${wno}
     
     set b {}
     set settingsChanged 1
-    set len [$w.databases.list size]
+    set len [$w.top.databases.list size]
     for {set i 0} {$i < $len} {incr i} {
-        lappend b [$w.databases.list get $i]
-    }
-    set profile($target) [list [$w.description.entry get] \
-            [$w.host.entry get] \
-            [$w.port.entry get] \
-            [$w.idAuthentication.entry get] \
-            [$w.maximumRecordSize.entry get] \
-            [$w.preferredMessageSize.entry get] \
+        lappend b [$w.top.databases.list get $i]
+    }
+    set profile($target) [list [$w.top.description.entry get] \
+            [$w.top.host.entry get] \
+            [$w.top.port.entry get] \
+            [$w.top.idAuthentication.entry get] \
+            [$w.top.maximumRecordSize.entry get] \
+            [$w.top.preferredMessageSize.entry get] \
             $csRadioType \
             $b \
             $RPNCheck \
             $CCLCheck \
             $ResultSetCheck \
-            $protocolRadioType ]
+            $protocolRadioType \
+            $wno]
 
     cascade-target-list
     puts $profile($target)
-    destroy .setup-${target}
+    destroy $w
 }
 
 proc place-force {window parent} {
@@ -1056,20 +1073,26 @@ proc place-force {window parent} {
 }
 
 proc add-database-action {target} {
-    set w .setup-${target}
-    
-    ${w}.top.databases.list insert end \
+    global profile
+
+    set wno [lindex $profile($target) 12]
+    set w .setup-${wno}
+
+    $w.top.databases.list insert end \
             [.database-select.top.database.entry get]
     destroy .database-select
 }
 
 proc add-database {target} {
+    global profile
+
     set w .database-select
 
     set oldFocus [focus]
     toplevel $w
-
-    place-force $w .setup-${target}
+ 
+    set wno [lindex $profile($target) 12]
+    place-force $w .setup-${wno}
 
     top-down-window $w
 
@@ -1086,8 +1109,11 @@ proc add-database {target} {
 }
 
 proc delete-database {target} {
-    set w .setup-${target}
-    
+    global profile
+
+    set wno [lindex $profile($target) 12]
+    set w .setup-${wno}
+
     foreach i [lsort -decreasing \
             [$w.top.databases.list curselection]] {
         $w.top.databases.list delete $i
@@ -1095,7 +1121,6 @@ proc delete-database {target} {
 }
 
 proc protocol-setup {target} {
-    set w .setup-$target
 
     global profile
     global csRadioType
@@ -1104,6 +1129,9 @@ proc protocol-setup {target} {
     global CCLCheck
     global ResultSetCheck
 
+    set wno [lindex $profile($target) 12]
+    set w .setup-${wno}
+
     toplevel $w
 
     wm title $w "Setup $target"
@@ -1142,8 +1170,8 @@ proc protocol-setup {target} {
     foreach sub {description host port idAuthentication \
             maximumRecordSize preferredMessageSize} {
         puts $sub
-        bind $w.top.$sub.entry <Control-a> "add-database $target"
-        bind $w.top.$sub.entry <Control-d> "delete-database $target"
+        bind $w.top.$sub.entry <Control-a> [list add-database $target]
+        bind $w.top.$sub.entry <Control-d> [list delete-database $target]
     }
     $w.top.description.entry insert 0 [lindex $profile($target) 0]
     $w.top.host.entry insert 0 [lindex $profile($target) 1]
@@ -1165,9 +1193,9 @@ proc protocol-setup {target} {
 
     label $w.top.databases.label -text "Databases"
     button $w.top.databases.add -text "Add" \
-            -command "add-database $target"
+            -command [list add-database $target]
     button $w.top.databases.delete -text "Delete" \
-            -command "delete-database $target"
+            -command [list 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
@@ -1287,11 +1315,11 @@ proc cascade-target-list {} {
                 menu .top.target.m.clist.$nl
                 foreach b [lindex $profile($n) 7] {
                     .top.target.m.clist.$nl add command -label $b \
-                            -command "reopen-target $n $b"
+                            -command [list reopen-target $n $b]
                 }
             } else {
                 .top.target.m.clist add command -label $n \
-                        -command "reopen-target $n {}"
+                        -command [list reopen-target $n {}]
             }
         }
     }
@@ -1299,7 +1327,7 @@ proc cascade-target-list {} {
     foreach n [array names profile] {
         if {$n != "Default"} {
             .top.target.m.slist add command -label $n \
-                    -command "protocol-setup $n"
+                    -command [list protocol-setup $n]
         }
     }
 }
@@ -1337,7 +1365,7 @@ proc save-settings {} {
     puts $f "set hotTargets \{ $hotTargets \}"
 
     foreach n [array names profile] {
-        puts -nonewline $f "set profile($n) \{"
+        puts -nonewline $f "set \{profile($n)\} \{"
         puts -nonewline $f $profile($n)
         puts $f "\}"
     }
@@ -1849,7 +1877,7 @@ index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
 button .mid.search -width 7 -text {Search} -command search-request \
         -state disabled
 button .mid.scan -width 7 -text {Scan} \
-        -command [list scan-request "@attr 1=4"] -state disabled 
+        -command [list scan-request "@attr 1=4 @attr 5=1 @attr 4=1"] -state disabled 
 button .mid.present -width 7 -text {Present} -command [list present-more 10] \
         -state disabled
 
diff --git a/clientrc.tcl b/clientrc.tcl
index e75ae33..ad7912b 100644
--- a/clientrc.tcl
+++ b/clientrc.tcl
@@ -1,21 +1,23 @@
 # Setup file
-set hotTargets { ztest  dranet RLG LOC Penn DANBIB Aleph CARL OCLC IREG Innovative CNIDR CLSI AULS Nsrtest                                          }
-set profile(CNIDR) {CNIDR Kudzu.cnidr.org 5556 {} 16384 8192 tcpip {Book ERIC} 1 {} {} z39v2}
-set profile(Penn) {{Penn State's Library} 128.118.88.200 210 {} 16384 8192 tcpip CATALOG 1 {} {} z39v2}
-set profile(ztest) {{test server} localhost 9999 {} 16384 4096 tcpip dummy 1 {} {} z39v2}
-set profile(Nsrtest) {{NSR in house.} localhost 4500 {} 16384 8192 mosi x 1 {} {} sr}
-set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} }
-set profile(RLG) {{Research Libraries group} rlg.stanford.edu 210 {} 16384 16384 tcpip {BKS AMC MAPS MDF REC SCO SER VIM NAF SAF AUT CATALOG ABI AVI DSA EIP FLP HAP HST NPA PAI PRA WLI} 1 {} {} z39v2}
-set profile(LOC) {{Library of Congress} IBM2.LOC.gov 210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 z39v2}
-set profile(IREG) {{Internet Resource} frost.notis.com 210 {} 16384 8192 tcpip {IREG ERIC} 1 {} {} z39v2}
-set profile(DANBIB) {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 z39v2}
-set profile(OCLC) {OCLC rdsd-rs6000.dev.oclc.org 211 {} 16384 8192 tcpip OLUC 1 {} {} z39v2}
-set profile(Aleph) {{Aleph at ram10.aleph.co.il:5555} localhost 9998 {} 16384 4096 tcpip {dem mar} 1 0 1 z39v2}
-set profile(CARL) {{CARL systems} Z39.50.carl.org 210 {} 16384 8192 tcpip {ACC AIC AUR BEM CUB DPL DNU EPL FRC LAW LCC MCC MIN MPL NJC NWC OCC PPC PUE RDR RGU SPL TCC TKU UNC WYO} 1 {} {} z39v2}
-set profile(Innovative) {{Innovatives server: demo.iii.com} demo.iii.com 210 {} 16384 8192 tcpip DEFAULT 1 {} {} z39v2}
-set profile(CLSI) {CLSI inet-gw.clsi.uc.geac.com 210 {} 16384 8192 tcpip Cl 1 {} {} z39v2}
-set profile(AULS) {{Acadia university} auls.acadiau.ca 210 {} 16384 8192 tcpip AULS 1 {} {} z39v2}
-set profile(dranet) {dranet dranet.dra.com 210 {} 16384 16384 tcpip drewdb 1 {} {} z39v2}
+set hotTargets { {AT&T server} RLG {A new server} ztest  dranet LOC Penn DANBIB Aleph CARL OCLC IREG Innovative CNIDR CLSI AULS Nsrtest                                                 }
+set {profile(CNIDR)} {CNIDR Kudzu.cnidr.org 5556 {} 16384 8192 tcpip {Book ERIC} 1 {} {} z39v2 1}
+set {profile(Penn)} {{Penn State's Library} 128.118.88.200 210 {} 16384 8192 tcpip CATALOG 1 {} {} z39v2 2}
+set {profile(A new server)} {{A completely new server} dtbsun.dtv.dk 9999 {} 16384 8192 tcpip dummy {} {} {} z39v2 20}
+set {profile(ztest)} {{test server} localhost 9999 {} 16384 4096 tcpip dummy 1 {} {} z39v2 3}
+set {profile(Nsrtest)} {{NSR in house.} localhost 4500 {} 16384 8192 mosi x 1 {} {} sr 4}
+set {profile(Default)} {{} {} {210} {} 16384 8192 tcpip {} {} {} {} {} 22}
+set {profile(RLG)} {{Research Libraries group} rlg.stanford.edu 210 {} 16384 16384 tcpip {BKS AMC MAPS MDF REC SCO SER VIM NAF SAF AUT CATALOG ABI AVI DSA EIP FLP HAP HST NPA PAI PRA WLI} 1 {} {} z39v2 5}
+set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 16384 8192 tcpip Default {} {} {} z39v2 21}
+set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 z39v2 6}
+set {profile(IREG)} {{Internet Resource} frost.notis.com 210 {} 16384 8192 tcpip {IREG ERIC} 1 {} {} z39v2 7}
+set {profile(DANBIB)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 z39v2 8}
+set {profile(OCLC)} {OCLC rdsd-rs6000.dev.oclc.org 211 {} 16384 8192 tcpip OLUC 1 {} {} z39v2 9}
+set {profile(CARL)} {{CARL systems} Z39.50.carl.org 210 {} 16384 8192 tcpip {ACC AIC AUR BEM CUB DPL DNU EPL FRC LAW LCC MCC MIN MPL NJC NWC OCC PPC PUE RDR RGU SPL TCC TKU UNC WYO} 1 {} {} z39v2 11}
+set {profile(Aleph)} {{Aleph at ram10.aleph.co.il:5555} localhost 9998 {} 16384 4096 tcpip {dem mar} 1 0 1 z39v2 10}
+set {profile(CLSI)} {CLSI inet-gw.clsi.uc.geac.com 210 {} 16384 8192 tcpip Cl 1 {} {} z39v2 13}
+set {profile(Innovative)} {{Innovatives server: demo.iii.com} demo.iii.com 210 {} 16384 8192 tcpip DEFAULT 1 {} {} z39v2 12}
+set {profile(AULS)} {{Acadia university} auls.acadiau.ca 210 {} 16384 8192 tcpip AULS 1 {} {} z39v2 14}
+set {profile(dranet)} {dranet dranet.dra.com 210 {} 16384 16384 tcpip drewdb 1 {} {} z39v2 15}
 set queryTypes {Simple}
 set queryButtons { { {I 0} {I 1} {I 2} } }
 set queryInfo { { {Title {1=4}} {Author {1=1}}  {Subject {1=21}} {Any {1=1016}} } }