Search-button disabled when there is no connection.

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

diff --git a/client.tcl b/client.tcl
index 4e859b8..945fd9c 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,17 @@
 #
 # $Log: client.tcl,v $
-# Revision 1.14  1995-03-22 16:07:55  adam
+# Revision 1.17  1995-03-31 09:34:57  adam
+# Search-button disabled when there is no connection.
+#
+# Revision 1.16  1995/03/31  08:56:36  adam
+# New button "Search".
+#
+# Revision 1.15  1995/03/28  12:45:22  adam
+# New ir method failback: called on disconnect/protocol error.
+# New ir set/get method: protocol: SR / Z3950.
+# Simple popup and disconnect when failback is invoked.
+#
+# Revision 1.14  1995/03/22  16:07:55  adam
 # Minor changes.
 #
 # Revision 1.13  1995/03/21  17:27:26  adam
@@ -53,7 +64,7 @@ set hostid Default
 set settingsChanged 0
 set setNo 0
 
-wm minsize . 300 200
+wm minsize . 300 250
 
 if {[file readable "~/.tk-c"]} {
     source "~/.tk-c"
@@ -221,7 +232,7 @@ proc set-target-hotlist {} {
     set i 1
     foreach target $hotTargets {
         .top.target.m add command -label "$i $target" -command \
-                "menu-open-target $target {}"
+                "reopen-target $target {}"
         incr i
         if {$i > 8} {
              break
@@ -229,7 +240,8 @@ proc set-target-hotlist {} {
     }
 }
 
-proc menu-open-target {target base} {
+proc reopen-target {target base} {
+    close-target
     open-target $target $base
     update-target-hotlist $target
 }
@@ -253,6 +265,11 @@ proc define-target-action {} {
     destroy .target-define
 }
 
+proc fail-response {target} {
+    close-target
+    tkerror "Target connection closed or protocol error"
+}
+
 proc connect-response {target} {
     puts "connect-response"
     show-target $target
@@ -263,9 +280,6 @@ proc open-target {target base} {
     global profile
     global hostid
 
-    set hostid $target
-    .top.target.m disable 0
-    .top.target.m enable 1
     z39 disconnect
     z39 comstack [lindex $profile($target) 6]
     # z39 idAuthentication [lindex $profile($target) 3]
@@ -280,9 +294,27 @@ proc open-target {target base} {
     } else {
         z39 databaseNames $base
     }
-    show-status {Connecting} 1
+    z39 failback [list fail-response $target]
     z39 callback [list connect-response $target]
     z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
+    show-status {Connecting} 1
+    set hostid $target
+    .top.target.m disable 0
+    .top.target.m enable 1
+    .top.search configure -state normal
+}
+
+proc close-target {} {
+    global hostid
+
+    set hostid Default
+    z39 disconnect
+    show-target {None}
+    show-status {Not connected} 0
+    show-message {}
+    .top.target.m disable 1
+    .top.target.m enable 0
+    .top.search configure -state disabled
 }
 
 proc load-set-action {} {
@@ -333,7 +365,6 @@ proc init-request {} {
     z39 callback {init-response}
     z39 init
     show-status {Initializing} 1
-    set setNo 0
 }
 
 proc init-response {} {
@@ -386,12 +417,37 @@ proc search-response {} {
         }
         return
     }
-    if {$setMax > 10} {
-        set setMax 10
+    if {$setMax > 4} {
+        set setMax 4
     }
     z39 callback {present-response}
     set setOffset 1
-    z39.$setNo present 1 $setMax
+    z39.$setNo present $setOffset $setMax
+    show-status {Retrieve} 1
+}
+
+proc present-more {number} {
+    global setNo
+    global setOffset
+    global setMax
+
+    puts "present-more"
+    if {$setNo == 0} {
+       return
+    }
+    set max [z39.$setNo resultCount]
+    if {$max <= $setMax} {
+        return
+    }
+    puts "max=$max"
+    puts "setOffset=$setOffset"
+    if {$number == ""} {
+        set setMax $max
+    } else {
+        incr setMax $number
+    }
+    z39 callback {present-response}
+    z39.$setNo present $setOffset [expr $setMax - $setOffset + 1]
     show-status {Retrieve} 1
 }
 
@@ -503,17 +559,6 @@ proc define-target-dialog {} {
     top-down-ok-cancel $w {define-target-action} 1
 }
 
-proc close-target {} {
-    # pack forget .mid.searchlabel .mid.searchentry
-    #.mid.searchentry -state disabled
-    z39 disconnect
-    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} {
     global profile
     global csRadioType
@@ -549,7 +594,6 @@ proc protocol-setup-action {target} {
     destroy .setup-${target}
 }
 
-
 proc place-force {window parent} {
     set g [wm geometry $parent]
 
@@ -561,7 +605,6 @@ proc place-force {window parent} {
     wm geometry $window +${x}+${y}
 }
 
-
 proc add-database-action {target} {
     set w .setup-${target}
     
@@ -737,10 +780,6 @@ proc database-select {} {
 
     top-down-window $w
 
-    if {$hostid == ""} {
-        set hostid Default
-    }
-
     frame $w.top.databases -relief ridge -border 2
 
     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
@@ -780,11 +819,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 "menu-open-target $n $b"
+                            -command "reopen-target $n $b"
                 }
             } else {
                 .top.target.m.clist add command -label $n \
-                        -command "menu-open-target $n {}"
+                        -command "reopen-target $n {}"
             }
         }
     }
@@ -882,10 +921,18 @@ menu .top.target.m.clist
 menu .top.target.m.slist
 cascade-target-list
 
-menubutton .top.database -text "Database" -underline 0 -menu .top.database.m
-menu .top.database.m
-.top.database.m add command -label "Select ..." -command {database-select}
-.top.database.m add command -label "Add ..." -command {puts "Add"}
+menubutton .top.search -text "Search" -underline 0 -menu .top.search.m
+menu .top.search.m
+.top.search.m add command -label "Database" -command {database-select}
+.top.search.m add cascade -label "Query type" -menu .top.search.m.querytype
+menu .top.search.m.querytype
+.top.search.m.querytype add radiobutton -label "RPN"
+.top.search.m.querytype add radiobutton -label "CCL"
+.top.search.m add cascade -label "Present" -menu .top.search.m.present
+menu .top.search.m.present
+.top.search.m.present add command -label "More" -command [list present-more 10]
+.top.search.m.present add command -label "All" -command [list present-more {}]
+.top.search configure -state disabled
 
 menubutton .top.help -text "Help" -menu .top.help.m
 menu .top.help.m
@@ -893,7 +940,7 @@ menu .top.help.m
 .top.help.m add command -label "Help on help" -command {puts "Help on help"}
 .top.help.m add command -label "About" -command {puts "About"}
 
-pack .top.file .top.target .top.database -side left
+pack .top.file .top.target .top.search -side left
 pack .top.help -side right
 
 label .mid.searchlabel -text {Search:}