Work on target setup in client.tcl.

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

diff --git a/client.tcl b/client.tcl
index 80bb76a..f08a26b 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,25 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.74  1995-10-17 12:18:57  adam
+# Revision 1.80  1995-10-18 17:20:32  adam
+# Work on target setup in client.tcl.
+#
+# 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.
 #
@@ -1152,8 +1170,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
@@ -1474,6 +1496,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
@@ -1540,12 +1566,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
     }
@@ -1556,6 +1584,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> {}
@@ -1714,6 +1743,8 @@ proc protocol-setup-action {target w} {
     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] \
@@ -1801,11 +1832,11 @@ proc protocol-setup {target} {
     global CCLCheck
     global ResultSetCheck
     
-    set b 0
-    while {[winfo exists .setup-$b]} {
-        incr b
+    set bno 0
+    while {[winfo exists .setup-$bno]} {
+        incr bno
     }
-    set w .setup-$b
+    set w .setup-$bno
 
     toplevelG $w
 
@@ -1931,9 +1962,59 @@ proc protocol-setup {target} {
     # Ok-cancel
     bottom-buttons $w [list {Ok} [list protocol-setup-action $target $w] \
             {Delete} [list protocol-setup-delete $target $w] \
+            {Advanced} [list advanced-setup $target $bno] \
+            {Cancel} [list destroy $w]] 0   
+}
+
+
+proc advanced-setup {target b} {
+    global profile
+
+    set w .advanced-setup-$b
+    
+    toplevelG $w
+    
+    wm title $w "Advanced setup $target"
+    
+    top-down-window $w
+    
+    if {$target == ""} {
+        set target Default
+    }
+    dputs target
+    dputs $profile($target)
+    
+    frame $w.top.largeSetLowerBound
+    frame $w.top.smallSetUpperBound
+    frame $w.top.mediumSetPresentNumber
+    frame $w.top.presentChunk
+    frame $w.top.maximumRecordSize
+    frame $w.top.preferredMessageSize
+
+    pack $w.top.largeSetLowerBound $w.top.smallSetUpperBound \
+            $w.top.mediumSetPresentNumber $w.top.presentChunk \
+            $w.top.maximumRecordSize $w.top.preferredMessageSize \
+            -side top -anchor e -pady 2
+    
+    entry-fields $w.top {largeSetLowerBound smallSetUpperBound \
+            mediumSetPresentNumber presentChunk maximumRecordSize \
+            preferredMessageSize} \
+            {{Large Set Lower Bound:} {Small Set Upper Bound:} \
+            {Medium Set Present Number:} {Present Chunk:} \
+            {Maximum Record Size:} {Preferred Message Size:}} \
+            [list advanced-setup-action $target $b] [list destroy $w]
+    
+    bottom-buttons $w [list {Ok} [list advanced-setup-action $target $b] \
             {Cancel} [list destroy $w]] 0   
 }
 
+proc advanced-setup-action {target b} {
+    set w .advanced-setup-$b
+
+    dputs "advanced-setup-action"
+    destroy $w
+}
+
 proc database-select-action {} {
     set w .database-select.top
     set b {}
@@ -3171,7 +3252,7 @@ if {! $monoFlag} {
 }
 .data.record tag configure marc-data -foreground black
 .data.record tag configure marc-head \
-        -font -Adobe-Times-Medium-R-Normal-*-140-* \
+        -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 \
@@ -3212,6 +3293,8 @@ if {[catch {ir z39}]} {
     ir z39
     puts "ok"
 }
+z39 largeSetLowerBound 20
+z39 smallSetUpperBound 2
+z39 mediumSetPresentNumber 2
 z39 logLevel all
 show-logo 1
-