X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=client.tcl;h=31685b76683d91d774c114463bdb85c2e01381da;hb=343e22f495edc668d0302488e64bf6b3874e536d;hp=1bb1466e4f4b8bb7dfce6456b05d76343b9d7f66;hpb=841680acd268a8d673fbec862e21cd607c787cfa;p=ir-tcl-moved-to-github.git

diff --git a/client.tcl b/client.tcl
index 1bb1466..31685b7 100644
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,29 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.72  1995-10-16 17:00:52  adam
+# Revision 1.79  1995-10-18 16:42:37  adam
+# New settings: smallSetElementSetNames and mediumSetElementSetNames.
+#
+# Revision 1.78  1995/10/18  15:45:36  quinn
+# *** empty log message ***
+#
+# Revision 1.77  1995/10/18  15:37:46  adam
+# Piggy-back present.
+#
+# Revision 1.76  1995/10/18  15:15:20  adam
+# Fixed bug.
+#
+# Revision 1.75  1995/10/17  14:18:05  adam
+# Minor changes in presentation formats.
+#
+# Revision 1.74  1995/10/17  12:18:57  adam
+# Bug fix: when target connection closed, the connection was not
+# properly reestablished.
+#
+# Revision 1.73  1995/10/17  10:58:06  adam
+# More work on presentation formats.
+#
+# Revision 1.72  1995/10/16  17:00:52  adam
 # New setting: elementSetNames.
 # Various client improvements. Medium presentation format looks better.
 #
@@ -378,6 +400,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
+    puts $m
 }
 
 proc set-display-format {f} {
@@ -1064,6 +1087,7 @@ proc init-response {} {
     global cancelFlag
     global scanEnable
 
+    dputs {init-reponse}
     if {$cancelFlag} {
         close-target
         return
@@ -1096,6 +1120,9 @@ proc search-request {bflag} {
 
     set target $hostid
 
+    if {[z39 connect] == ""} {
+        return
+    }
     dputs "search-request"
     show-message {}
     if {!$bflag && $busy} {
@@ -1140,8 +1167,12 @@ proc search-request {bflag} {
     }
     if {$elementSetNames == "None" } {
         z39.$setNo elementSetNames {}
+        z39.$setNo smallSetElementSetNames {}
+        z39.$setNo mediumSetElementSetNames {}
     } else {
         z39.$setNo elementSetNames $elementSetNames
+        z39.$setNo smallSetElementSetNames $elementSetNames
+        z39.$setNo mediumSetElementSetNames $elementSetNames
     }
     z39 callback {search-response}
     z39.$setNo search $query
@@ -1462,6 +1493,10 @@ proc search-response {} {
     if {$setMax > 20} {
         set setMax 20
     }
+    set no [z39.$setNo numberOfRecordsReturned]
+    dputs "Returned $no records, setOffset $setOffset"
+    add-title-lines $setNo $no $setOffset
+    set setOffset [expr $setOffset + $no]
     z39 callback {present-response}
     z39.$setNo present $setOffset 1
     show-status Retrieving 1 0
@@ -1528,12 +1563,14 @@ proc add-title-lines {setno no offset} {
     global setNo
     global busy
 
+    dputs "add-title-lines offset=${offset} no=${no}"
     if {$setno != -1} {
         set setNo $setno
     } else {
         set setno $setNo
     }
     if {$offset == 1} {
+        
         .bot.a.set configure -text $setno
         .data.record delete 0.0 end
     }
@@ -1544,6 +1581,7 @@ proc add-title-lines {setno no offset} {
         set o [expr $i + $offset]
         set type [z39.$setno type $o]
         if {$type == ""} {
+            dputs "no more at $o"
             break
         }
         .data.record tag bind r$o <Any-Enter> {}
@@ -1672,15 +1710,13 @@ proc define-target-dialog {} {
     top-down-ok-cancel $w {define-target-action} 1
 }
 
-proc protocol-setup-delete {target} {
+proc protocol-setup-delete {target w} {
     global profile
     global settingsChanged
 
     set a [alert "Are you sure you want to delete the target \
 definition $target ?"]
     if {$a} {
-        set wno [lindex $profile($target) 12]
-        set w .setup-${wno}
         destroy $w
         unset profile($target)
         set settingsChanged 1
@@ -1689,7 +1725,7 @@ definition $target ?"]
     }
 }
 
-proc protocol-setup-action {target} {
+proc protocol-setup-action {target w} {
     global profile
     global csRadioType
     global protocolRadioType
@@ -1698,15 +1734,14 @@ proc protocol-setup-action {target} {
     global CCLCheck
     global ResultSetCheck
 
-    set wno [lindex $profile($target) 12]
-    set w .setup-${wno}
-    
     set b {}
     set settingsChanged 1
     set len [$w.top.databases.list size]
     for {set i 0} {$i < $len} {incr i} {
         lappend b [$w.top.databases.list get $i]
     }
+    set wno [lindex $profile($target) 12]
+
     set profile($target) [list [$w.top.description.entry get] \
             [$w.top.host.entry get] \
             [$w.top.port.entry get] \
@@ -1738,26 +1773,22 @@ proc place-force {window parent} {
     wm geometry $window +${x}+${y}
 }
 
-proc add-database-action {target} {
+proc add-database-action {target w} {
     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} {
+proc add-database {target wp} {
     global profile
 
     set w .database-select
     toplevel $w
     set oldFocus [focus]
  
-    set wno [lindex $profile($target) 12]
-    place-force $w .setup-${wno}
+    place-force $w $wp
 
     top-down-window $w
 
@@ -1767,17 +1798,15 @@ proc add-database {target} {
     
     entry-fields $w.top {database} \
             {{Database to add:}} \
-            [list add-database-action $target] {destroy .database-select}
+            [list add-database-action $target $wp] {destroy .database-select}
 
-    top-down-ok-cancel $w [list add-database-action $target] 1
+    top-down-ok-cancel $w [list add-database-action $target $wp] 1
     focus $oldFocus
 }
 
-proc delete-database {target} {
+proc delete-database {target w} {
     global profile
 
-    set wno [lindex $profile($target) 12]
-    set w .setup-${wno}
     set l {}
     foreach i [$w.top.databases.list curselection] {
         set b [$w.top.databases.list get $i]
@@ -1799,9 +1828,12 @@ proc protocol-setup {target} {
     global RPNCheck
     global CCLCheck
     global ResultSetCheck
-
-    set wno [lindex $profile($target) 12]
-    set w .setup-${wno}
+    
+    set b 0
+    while {[winfo exists .setup-$b]} {
+        incr b
+    }
+    set w .setup-$b
 
     toplevelG $w
 
@@ -1835,13 +1867,13 @@ proc protocol-setup {target} {
             maximumRecordSize preferredMessageSize} \
             {{Description:} {Host:} {Port:} {Id Authentication:} \
             {Maximum Record Size:} {Preferred Message Size:}} \
-            [list protocol-setup-action $target] [list destroy $w]
+            [list protocol-setup-action $target $w] [list destroy $w]
     
     foreach sub {description host port idAuthentication \
             maximumRecordSize preferredMessageSize} {
         dputs $sub
-        bind $w.top.$sub.entry <Control-a> [list add-database $target]
-        bind $w.top.$sub.entry <Control-d> [list delete-database $target]
+        bind $w.top.$sub.entry <Control-a> [list add-database $target $w]
+        bind $w.top.$sub.entry <Control-d> [list delete-database $target $w]
     }
     $w.top.description.entry insert 0 [lindex $profile($target) 0]
     $w.top.host.entry insert 0 [lindex $profile($target) 1]
@@ -1862,10 +1894,10 @@ proc protocol-setup {target} {
     pack $w.top.databases -side left -pady 2 -padx 2 -expand yes -fill both
 
     label $w.top.databases.label -text "Databases"
-    button $w.top.databases.add -text "Add" \
-            -command [list add-database $target]
-    button $w.top.databases.delete -text "Delete" \
-            -command [list delete-database $target]
+    button $w.top.databases.add -text Add \
+            -command [list add-database $target $w]
+    button $w.top.databases.delete -text Delete \
+            -command [list delete-database $target $w]
     if {! [tk4]} {
         listbox $w.top.databases.list -geometry 14x6 \
                 -yscrollcommand "$w.top.databases.scroll set"
@@ -1925,8 +1957,8 @@ proc protocol-setup {target} {
             -padx 2 -side top -fill x
 
     # Ok-cancel
-    bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \
-            {Delete} [list protocol-setup-delete $target] \
+    bottom-buttons $w [list {Ok} [list protocol-setup-action $target $w] \
+            {Delete} [list protocol-setup-delete $target $w] \
             {Cancel} [list destroy $w]] 0   
 }
 
@@ -3167,8 +3199,9 @@ if {! $monoFlag} {
 }
 .data.record tag configure marc-data -foreground black
 .data.record tag configure marc-head \
-        -font -Adobe-Times-Medium-R-Normal-*-140-* \
-        -foreground white -background black
+        -font -Adobe-Times-Bold-R-Normal-*-140-* \
+        -foreground brown -relief raised -borderwidth 1
+.data.record tag configure marc-small-head -foreground brown
 .data.record tag configure marc-pref \
         -font -Adobe-Times-Medium-R-Normal-*-140-* \
         -foreground blue
@@ -3207,6 +3240,8 @@ if {[catch {ir z39}]} {
     ir z39
     puts "ok"
 }
-#z39 logLevel all
+z39 largeSetLowerBound 20
+z39 smallSetUpperBound 2
+z39 mediumSetPresentNumber 2
+z39 logLevel all
 show-logo 1
-