Diagnostic records saved on searchResponse.

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

diff --git a/client.tcl b/client.tcl
index fed603c..8b32509 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,12 @@
 #
 # $Log: client.tcl,v $
-# Revision 1.8  1995-03-17 15:45:00  adam
+# Revision 1.10  1995-03-20 15:24:06  adam
+# Diagnostic records saved on searchResponse.
+#
+# Revision 1.9  1995/03/17  18:26:16  adam
+# Non-blocking i/o used now. Database names popup as cascade items.
+#
+# Revision 1.8  1995/03/17  15:45:00  adam
 # Improved target/database setup.
 #
 # Revision 1.7  1995/03/16  17:54:03  adam
@@ -48,7 +54,7 @@ proc top-down-window {w} {
     pack  $w.top $w.bot -side top -fill both -expand yes
 }
 
-proc top-down-ok-cancel {w ok-action} {
+proc top-down-ok-cancel {w ok-action g} {
     frame $w.bot.left -relief sunken -border 1
     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
     button $w.bot.left.ok -width 6 -text {Ok} \
@@ -57,11 +63,12 @@ proc top-down-ok-cancel {w ok-action} {
     button $w.bot.cancel -width 6 -text {Cancel} \
             -command "destroy $w"
     pack $w.bot.cancel -side left -expand yes    
-    
-    # Grab ...
-    grab $w
-    
-    tkwait window $w
+
+    if {$g} {
+        # Grab ...
+        grab $w
+        tkwait window $w
+    }
 }
 
 proc show-target {target} {
@@ -130,7 +137,7 @@ proc show-full-marc {no} {
         pack  $w.top -side top -fill both -expand yes
         pack  $w.bot -fill both
 
-        text $w.top.record -width 60 -height 10 \
+        text $w.top.record -width 60 -height 10 -wrap word \
                 -yscrollcommand [list $w.top.s set]
         scrollbar $w.top.s -command [list $w.top.record yview]
 
@@ -238,6 +245,8 @@ proc define-target-action {} {
 proc open-target {target base} {
     global profile
 
+    .top.target.m disable 0
+    .top.target.m enable 1
     z39 disconnect
     z39 comstack [lindex $profile($target) 6]
     # z39 idAuthentication [lindex $profile($target) 3]
@@ -294,7 +303,7 @@ proc load-set {} {
             {{Filename:}} \
             {load-set-action} {destroy .load-set}
     
-    top-down-ok-cancel $w {load-set-action}
+    top-down-ok-cancel $w {load-set-action} 1
 }
 
 proc init-request {} {
@@ -337,8 +346,8 @@ proc search-response {} {
     if {$setMax == 0} {
         return
     }
-    if {$setMax > 20} {
-        set setMax 20
+    if {$setMax > 10} {
+        set setMax 10
     }
     z39 callback {present-response}
     set setOffset 1
@@ -368,23 +377,41 @@ proc present-response {} {
     puts "Returned $no records, setOffset $setOffset"
     add-title-lines $no $setOffset
     set setOffset [expr $setOffset + $no]
-    if { $setOffset <= $setMax} {
+    if {$no > 0 && $setOffset <= $setMax} {
         z39.$setNo present $setOffset [expr $setMax - $setOffset + 1]
     } else {
         show-status {Finished} 0
     }
 }
 
+proc left-cursor {w} {
+    set i [$w index insert]
+    if {$i > 0} {
+        incr i -1
+        $w icursor $i
+    }
+}
+
+proc right-cursor {w} {
+    set i [$w index insert]
+    incr i
+    $w icursor $i
+}
+
 proc bind-fields {list returnAction escapeAction} {
     set max [expr [llength $list]-1]
     for {set i 0} {$i < $max} {incr i} {
         bind [lindex $list $i] <Return> $returnAction
         bind [lindex $list $i] <Escape> $escapeAction
         bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
+        bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
+        bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
     }
     bind [lindex $list $i] <Return> $returnAction
     bind [lindex $list $i] <Escape> $escapeAction
     bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
+    bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
+    bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
     focus [lindex $list 0]
 }
 
@@ -395,7 +422,7 @@ proc entry-fields {parent list tlist returnAction escapeAction} {
         set label ${parent}.${field}.label
         set entry ${parent}.${field}.entry
         label $label -text [lindex $tlist $i] -anchor e
-        entry $entry -width 26 -relief sunken
+        entry $entry -width 32 -relief sunken
         pack $label -side left
         pack $entry -side right
         lappend alist $entry
@@ -422,7 +449,7 @@ proc define-target-dialog {} {
             {{Target:}} \
             {define-target-action} {destroy .target-define}
     
-    top-down-ok-cancel $w {define-target-action}
+    top-down-ok-cancel $w {define-target-action} 1
 }
 
 proc close-target {} {
@@ -431,6 +458,8 @@ proc close-target {} {
     show-target {None}
     show-status {Not connected} 0
     show-message {}
+    .top.target.m disable 1
+    .top.target.m enable 0
 }
 
 proc protocol-setup-action {target} {
@@ -438,7 +467,9 @@ proc protocol-setup-action {target} {
     global csRadioType
     global settingsChanged
 
-    set w .protocol-setup.top
+    set w .setup-${target}.top
+
+    #set w .protocol-setup.top
     
     set b {}
     set settingsChanged 1
@@ -457,7 +488,7 @@ proc protocol-setup-action {target} {
 
     cascade-target-list
     puts $profile($target)
-    destroy .protocol-setup
+    destroy .setup-${target}
 }
 
 
@@ -473,18 +504,21 @@ proc place-force {window parent} {
 }
 
 
-proc add-database-action {} {
-    .protocol-setup.top.databases.list insert end \
+proc add-database-action {target} {
+    set w .setup-${target}
+    
+    ${w}.top.databases.list insert end \
             [.database-select.top.database.entry get]
     destroy .database-select
 }
 
-proc add-database {} {
+proc add-database {target} {
     set w .database-select
 
+    set oldFocus [focus]
     toplevel $w
 
-    place-force $w .protocol-setup
+    place-force $w .setup-${target}
 
     top-down-window $w
 
@@ -494,20 +528,23 @@ proc add-database {} {
     
     entry-fields $w.top {database} \
             {{Database to add:}} \
-            {add-database-action} {destroy .database-select}
+            [list add-database-action $target] {destroy .database-select}
 
-    top-down-ok-cancel $w {add-database-action}
+    top-down-ok-cancel $w [list add-database-action $target] 1
+    focus $oldFocus
 }
 
-proc delete-database {} {
+proc delete-database {target} {
+    set w .setup-${target}
+    
     foreach i [lsort -decreasing \
-            [.protocol-setup.top.databases.list curselection]] {
-        .protocol-setup.top.databases.list delete $i
+            [$w.top.databases.list curselection]] {
+        $w.top.databases.list delete $i
     }
 }
 
 proc protocol-setup {target} {
-    set w .protocol-setup
+    set w .setup-$target
 
     global profile
     global csRadioType
@@ -545,7 +582,7 @@ proc protocol-setup {target} {
             maximumRecordSize preferredMessageSize} \
             {{Description:} {Host:} {Port:} {Id Authentification:} \
             {Maximum Record Size:} {Preferred Message Size:}} \
-            [list protocol-setup-action $target] {destroy .protocol-setup}
+            [list protocol-setup-action $target] [list destroy $w]
     
     $w.top.description.entry insert 0 [lindex $profile($target) 0]
     $w.top.host.entry insert 0 [lindex $profile($target) 1]
@@ -558,8 +595,10 @@ proc protocol-setup {target} {
     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
 
     label $w.top.databases.label -text "Databases"
-    button $w.top.databases.add -text "Add" -command {add-database}
-    button $w.top.databases.delete -text "Delete" -command {delete-database}
+    button $w.top.databases.add -text "Add" \
+            -command "add-database $target"
+    button $w.top.databases.delete -text "Delete" \
+            -command "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
@@ -602,8 +641,12 @@ proc protocol-setup {target} {
     pack $w.top.query.label -side top 
     pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
             -padx 4 -side top -fill x
-    
-    top-down-ok-cancel $w [list protocol-setup-action $target]
+
+    foreach sub [winfo children $w.top] {
+        puts $sub
+        bind $sub <Control-a> "add-database $target"
+    }
+    top-down-ok-cancel $w [list protocol-setup-action $target] 0
 }
 
 proc database-select-action {} {
@@ -652,7 +695,7 @@ proc database-select {} {
     foreach b [lindex $profile($hostid) 7] {
         $w.top.databases.list insert end $b
     }
-    top-down-ok-cancel $w {database-select-action}
+    top-down-ok-cancel $w {database-select-action} 1
 }
 
 proc cascade-target-list {} {
@@ -721,7 +764,7 @@ proc alert {ask} {
     pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
   
     set alertAnswer 0
-    top-down-ok-cancel $w {alert-action}
+    top-down-ok-cancel $w {alert-action} 1
     return $alertAnswer
 }
 
@@ -768,6 +811,8 @@ menu .top.target.m
 .top.target.m add separator
 set-target-hotlist
 
+.top.target.m disable 1
+
 menu .top.target.m.clist
 menu .top.target.m.slist
 cascade-target-list
@@ -789,6 +834,9 @@ pack .top.help -side right
 label .mid.searchlabel -text {Search:}
 entry .mid.searchentry -width 40 -relief sunken
 
+bind .mid.searchentry <Left> {left-cursor .mid.searchentry}
+bind .mid.searchentry <Right> {right-cursor .mid.searchentry}
+
 listbox .data.list -yscrollcommand {.data.scroll set}
 scrollbar .data.scroll -orient vertical -border 1
 pack .data.list -side left -fill both -expand yes
@@ -806,4 +854,3 @@ bind .data.list <Double-Button-1> {set indx [.data.list nearest %y]
 show-full-marc $indx}
 
 ir z39
-z39 comstack tcpip