New button "Search".

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

diff --git a/client.tcl b/client.tcl
index 4e859b8..52c3064 100644 (file)
--- a/client.tcl
+++ b/client.tcl
@@ -1,6 +1,14 @@
 #
 # $Log: client.tcl,v $
-# Revision 1.14  1995-03-22 16:07:55  adam
+# 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 +61,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"
@@ -253,6 +261,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 +276,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 +290,25 @@ 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
+}
+
+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
 }
 
 proc load-set-action {} {
@@ -333,7 +359,6 @@ proc init-request {} {
     z39 callback {init-response}
     z39 init
     show-status {Initializing} 1
-    set setNo 0
 }
 
 proc init-response {} {
@@ -386,12 +411,34 @@ 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"
+    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 +550,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
@@ -737,10 +773,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
@@ -882,10 +914,17 @@ 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 {}]
 
 menubutton .top.help -text "Help" -menu .top.help.m
 menu .top.help.m
@@ -893,7 +932,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:}