X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;f=client.tcl;h=21e19476352b54e74f00ce6f1afe199b683338f3;hb=495243c2c85b5c01b6f3cfe026c5ac9acb7f62fd;hp=a99e741804fee896c36f3bff570624e564c065e4;hpb=936873a6012cd41b7534a38d633d7cf6572877fa;p=ir-tcl-moved-to-github.git

diff --git a/client.tcl b/client.tcl
index a99e741..21e1947 100644
--- a/client.tcl
+++ b/client.tcl
@@ -4,7 +4,25 @@
 # Sebastian Hammer, Adam Dickmeiss
 #
 # $Log: client.tcl,v $
-# Revision 1.58  1995-06-29 12:34:06  adam
+# Revision 1.63  1995-08-04 13:20:48  adam
+# Buttons at the bottom are slightly smaller.
+#
+# Revision 1.62  1995/08/04  11:32:37  adam
+# More work on output queue. Memory related routines moved
+# to mem.c
+#
+# Revision 1.61  1995/07/20  08:09:39  adam
+# client.tcl: Targets removed from hotTargets list when targets
+#  are removed/modified.
+# ir-tcl.c: More work on triggerResourceControl.
+#
+# Revision 1.60  1995/06/30  16:30:19  adam
+# Minor changes.
+#
+# Revision 1.59  1995/06/29  14:06:25  adam
+# Another bug in install fixed. Configure searches for more versions of yaz.
+#
+# Revision 1.58  1995/06/29  12:34:06  adam
 # IrTcl now works with both tk4.0b4/tcl7.4b4 and tk3.6/tcl7.3
 #
 # Revision 1.57  1995/06/29  09:20:30  adam
@@ -206,7 +224,12 @@
 #
 #
 
-set tk4 0
+if {$tk_version == "3.6"} {
+    set tk4 0
+} else {
+    set tk4 1
+}
+
 if {$tk4} {
     proc configure-enable-e {w n} {
         incr n
@@ -239,7 +262,7 @@ if {! $tk4} {
 
 set libdir LIBDIR
 if {[file readable bitmaps/book2]} {
-	set libdir .
+    set libdir .
 }
 if {! [file readable ${libdir}/bitmaps/book2]} {
     puts "Cannot locate system files in ${libdir}. You must either run this"
@@ -275,7 +298,6 @@ wm minsize . 0 0
 set setOffset 0
 set setMax 0
 
-if {0} {
 proc tkerror err {
     set w .tkerrorw
 
@@ -290,12 +312,11 @@ proc tkerror err {
 
     label $w.top.b -bitmap error
     message $w.top.t -aspect 300 -text "Error: $err" \
-            -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
+            -font -Adobe-Helvetica-Bold-R-Normal-*-180-*
     pack $w.top.b $w.top.t -side left -padx 10 -pady 10
 
     bottom-buttons $w [list {Close} [list destroy $w]] 1
 }
-}
 
 proc read-formats {} {
     global displayFormats
@@ -320,7 +341,7 @@ proc set-wrap {m} {
 }
 
 proc dputs {m} {
-#   puts $m
+   puts $m
 }
 
 proc set-display-format {f} {
@@ -414,8 +435,8 @@ proc top-down-window {w} {
 
 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 -ipadx 2 -ipady 2 -padx 5 -pady 5
-    button $w.bot.left.ok -width 6 -text {Ok} \
+    pack $w.bot.left -side left -expand yes -ipadx 2 -ipady 2 -padx 4 -pady 4
+    button $w.bot.left.ok -width 5 -text {Ok} \
             -command ${ok-action}
     pack $w.bot.left.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3
     button $w.bot.cancel -width 6 -text {Cancel} \
@@ -433,16 +454,16 @@ proc bottom-buttons {w buttonList g} {
     set l [llength $buttonList]
 
     frame $w.bot.$i -relief sunken -border 1
-    pack $w.bot.$i -side left -expand yes -padx 5 -pady 5
+    pack $w.bot.$i -side left -expand yes -padx 4 -pady 4
     button $w.bot.$i.ok -text [lindex $buttonList $i] \
             -command [lindex $buttonList [expr $i+1]]
-    pack $w.bot.$i.ok -expand yes -ipadx 3 -ipady 2 -padx 3 -pady 3 -side left
+    pack $w.bot.$i.ok -expand yes -ipadx 2 -ipady 2 -padx 2 -pady 2 -side left
 
     incr i 2
     while {$i < $l} {
         button $w.bot.$i -text [lindex $buttonList $i] \
                 -command [lindex $buttonList [expr $i+1]]
-        pack $w.bot.$i -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
+        pack $w.bot.$i -expand yes -ipadx 2 -ipady 2 -padx 2 -pady 2 -side left
         incr i 2
     }
     if {$g} {
@@ -771,16 +792,8 @@ proc popup-marc {sno no b df} {
 
 proc update-target-hotlist {target base} {
     global hotTargets
-    global tk4
 
-    set len [llength $hotTargets]
-    if {$len > 0} {
-        if {$tk4} {
-            .top.target.m delete 7 [expr 7+[llength $hotTargets]]
-        } else {
-            .top.target.m delete 6 [expr 6+[llength $hotTargets]]
-        }
-    }
+    set olen [llength $hotTargets]
     set i 0
     foreach e $hotTargets {
         if {$target == [lindex $e 0] && $base == [lindex $e 1]} {
@@ -790,12 +803,34 @@ proc update-target-hotlist {target base} {
         incr i    
     }
     set hotTargets [linsert $hotTargets 0 [list $target $base]]
-    set-target-hotlist    
+    set-target-hotlist $olen
 } 
 
-proc set-target-hotlist {} {
+proc delete-target-hotlist {target} {
     global hotTargets
-    
+
+    set olen [llength $hotTargets]
+    set i 0
+    foreach e $hotTargets {
+        if {$target == [lindex $e 0]} {
+	    set hotTargets [lreplace $hotTargets $i $i]
+        }
+        incr i
+    }
+    set-target-hotlist $olen
+}
+
+proc set-target-hotlist {olen} {
+    global hotTargets
+    global tk4
+   
+    if {$olen > 0} {
+        if {$tk4} {
+            .top.target.m delete 7 [expr 7+$olen]
+        } else {
+            .top.target.m delete 6 [expr 6+$olen]
+        }
+    }
     set i 1
     foreach e $hotTargets {
         set target [lindex $e 0]
@@ -869,7 +904,7 @@ proc open-target {target base} {
     dputs [z39 maximumRecordSize]
     dputs "preferredMessageSize="
     dputs [z39 preferredMessageSize]
-    show-status {Connecting} 1 0
+    show-status Connecting 1 0
     if {$base == ""} {
         z39 databaseNames [lindex [lindex $profile($target) 7] 0]
     } else {
@@ -929,7 +964,7 @@ proc load-set-action {} {
     set fname [.load-set.top.filename.entry get]
     destroy .load-set
     if {$fname != ""} {
-        show-status {Loading} 1 {}
+        show-status Loading 1 {}
         update
         z39.$setNoLast loadFile $fname
 
@@ -939,15 +974,13 @@ proc load-set-action {} {
     set l [format "%-4d %7d" $setNoLast $no]
     .top.rset.m add command -label $l \
             -command [list add-title-lines $setNoLast 10000 1]
-    show-status {Ready} 0 {}
+    show-status Ready 0 {}
 }
 
 proc load-set {} {
     set w .load-set
-
-    set oldFocus [focus]
     toplevel $w
-
+    set oldFocus [focus]
     place-force $w .
     top-down-window $w
 
@@ -970,7 +1003,7 @@ proc init-request {} {
         return
     }
     z39 callback {init-response}
-    show-status {Initializing} 1 {}
+    show-status Initializing 1 {}
     set err [catch {z39 init} errorMessage]
     if {$err} {
         tkerror $errorMessage
@@ -987,7 +1020,7 @@ proc init-response {} {
         return
     }
     if {![z39 initResult]} {
-        show-status {Ready} 0 1
+        show-status Ready 0 1
         set u [z39 userInformationField]
         close-target
         tkerror "Connection rejected by target: $u"
@@ -997,7 +1030,7 @@ proc init-response {} {
         } else {
             set scanEnable 0
         }
-        show-status {Ready} 0 1
+        show-status Ready 0 1
     }
 }
 
@@ -1021,7 +1054,7 @@ proc search-request {bflag} {
     }
     if {$cancelFlag} {
         dputs "cancelFlag"
-        show-status {Searching} 1 0
+        show-status Searching 1 0
         set delayRequest {search-request 1}
         return
     }
@@ -1057,7 +1090,7 @@ proc search-request {bflag} {
     }
     z39 callback {search-response}
     z39.$setNo search $query
-    show-status {Searching} 1 0
+    show-status Searching 1 0
 }
 
 proc scan-copy {y entry} {
@@ -1084,7 +1117,7 @@ proc scan-request {} {
     dputs "scan-request"
     if {$cancelFlag} {
         dputs "cancelFlag"
-        show-status {Scanning} 1 0
+        show-status Scanning 1 0
         set delayRequest scan-request
         return
     }
@@ -1134,7 +1167,7 @@ proc scan-request {} {
     z39.scan preferredPositionInResponse 1
     z39.scan scan "${attr} 0"
     
-    show-status {Scanning} 1 0
+    show-status Scanning 1 0
 }
 
 proc scan-term-h {attr} {
@@ -1159,7 +1192,7 @@ proc scan-term-h {attr} {
     } else {
         z39.scan scan "${attr} \{${scanTerm}\}"
     }
-    show-status {Scanning} 1 0
+    show-status Scanning 1 0
 }
 
 proc scan-response {attr start toget} {
@@ -1185,7 +1218,7 @@ proc scan-response {attr start toget} {
             }
             return
         }
-        show-status {Ready} 0 1
+        show-status Ready 0 1
         return
     }
     set nScanTerm [$w.top.entry get]
@@ -1200,13 +1233,13 @@ proc scan-response {attr start toget} {
         } else {
             z39.scan scan "${attr} \{${scanTerm}\}"
         }
-        show-status {Scanning} 1 0
+        show-status Scanning 1 0
         return
     }
     set status [z39.scan scanStatus]
     if {$status == 6} {
         tkerror "Scan fail"
-        show-status {Ready} 0 1
+        show-status Ready 0 1
         set cancelFlag 0
         return
     }
@@ -1268,7 +1301,7 @@ proc scan-response {attr start toget} {
         z39.scan scan "${attr} \{$q\}"
         return
     }
-    show-status {Ready} 0 1
+    show-status Ready 0 1
 }
 
 proc scan-down {attr} {
@@ -1294,7 +1327,7 @@ proc scan-down {attr} {
         dputs "down: $q"
         z39.scan numberOfTermsRequested 10
         z39.scan preferredPositionInResponse 1
-        show-status {Scanning} 1 0
+        show-status Scanning 1 0
         dputs "${attr} \{$q\}"
         z39.scan scan "${attr} \{$q\}"
         return
@@ -1310,7 +1343,7 @@ proc scan-up {attr} {
     dputs {scan-up}
     if {$cancelFlag} {
         dputs "cancelFlag"
-        show-status {Scanning up} 1 0
+        show-status Scanning 1 0
         set delayRequest [list scan-up $attr]
         return
     }
@@ -1324,7 +1357,7 @@ proc scan-up {attr} {
         dputs "up: $q"
         z39.scan numberOfTermsRequested 10
         z39.scan preferredPositionInResponse 11
-        show-status {Scanning} 1 0
+        show-status Scanning 1 0
         z39.scan scan "${attr} \{$q\}"
         return
     }
@@ -1352,7 +1385,7 @@ proc search-response {} {
     set delayRequest {}
     init-title-lines
     set setMax [z39.$setNo resultCount]
-    show-status {Ready} 0 1
+    show-status Ready 0 1
     set status [z39.$setNo responseStatus]
     if {[lindex $status 0] == "NSD"} {
         z39.$setNo nextResultSetPosition 0
@@ -1367,7 +1400,7 @@ proc search-response {} {
         return
     }
     set setOffset 1
-    show-status {Ready} 0 1
+    show-status Ready 0 1
     set l [format "%-4d %7d" $setNo $setMax]
     .top.rset.m add command -label $l \
             -command [list add-title-lines $setNo 10000 1]
@@ -1376,7 +1409,7 @@ proc search-response {} {
     }
     z39 callback {present-response}
     z39.$setNo present $setOffset 1
-    show-status {Retrieving} 1 0
+    show-status Retrieving 1 0
 }
 
 proc present-more {number} {
@@ -1389,7 +1422,7 @@ proc present-more {number} {
 
     dputs "present-more"
     if {$cancelFlag} {
-        show-status {Retrieving} 1 0
+        show-status Retrieving 1 0
         set delayRequest "present-more $number"
         return
     }
@@ -1427,7 +1460,7 @@ proc present-more {number} {
         set toGet 3
     } 
     z39.$setNo present $setOffset $toGet
-    show-status {Retrieving} 1 0
+    show-status Retrieving 1 0
 }
 
 proc init-title-lines {} {
@@ -1498,7 +1531,7 @@ proc present-response {} {
     }
     set status [z39.$setNo responseStatus]
     if {[lindex $status 0] == "NSD"} {
-        show-status {Ready} 0 1
+        show-status Ready 0 1
         set code [lindex $status 1]
         set msg [lindex $status 2]
         set addinfo [lindex $status 3]
@@ -1513,7 +1546,7 @@ proc present-response {} {
         }
         z39.$setNo present $setOffset $toGet
     } else {
-        show-status {Ready} 0 1
+        show-status Ready 0 1
     }
 }
 
@@ -1551,7 +1584,7 @@ proc bind-fields {list returnAction escapeAction} {
     bind [lindex $list $i] <Return> $returnAction
     bind [lindex $list $i] <Escape> $escapeAction
     if {!$tk4} {
-        bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
+        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]]
     }
@@ -1602,6 +1635,7 @@ definition $target ?"]
         unset profile($target)
         set settingsChanged 1
         cascade-target-list
+        delete-target-hotlist $target
     }
 }
 
@@ -1638,6 +1672,7 @@ proc protocol-setup-action {target} {
             $wno]
 
     cascade-target-list
+    delete-target-hotlist $target
     dputs $profile($target)
     destroy $w
 }
@@ -1668,9 +1703,8 @@ proc add-database {target} {
     global profile
 
     set w .database-select
-
-    set oldFocus [focus]
     toplevel $w
+    set oldFocus [focus]
  
     set wno [lindex $profile($target) 12]
     place-force $w .setup-${wno}
@@ -1865,7 +1899,7 @@ proc database-select {} {
     global hostid
 
     toplevel $w
-
+    set oldFocus [focus]
     place-force $w .
 
     top-down-window $w
@@ -1875,7 +1909,7 @@ proc database-select {} {
     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
 
     label $w.top.databases.label -text "List"
-    listbox $w.top.databases.list -geometry 20x6 \
+    listbox $w.top.databases.list -width 20 -height 6 \
             -yscrollcommand "$w.top.databases.scroll set"
     scrollbar $w.top.databases.scroll -orient vertical -border 1
     pack $w.top.databases.label -side top -fill x \
@@ -1890,6 +1924,7 @@ proc database-select {} {
         $w.top.databases.list insert end $b
     }
     top-down-ok-cancel $w {database-select-action} 1
+    focus $oldFocus
 }
 
 proc cascade-target-list {} {
@@ -1956,6 +1991,7 @@ proc query-new {} {
     set w .query-new
 
     toplevel $w
+    set oldFocus [focus]
     place-force $w .
     top-down-window $w
     frame $w.top.index
@@ -1965,6 +2001,7 @@ proc query-new {} {
             {{Query Name:}} \
             query-new-action {destroy .query-new}
     top-down-ok-cancel $w query-new-action 1
+    focus $oldFocus
 }
 
 proc query-delete-action {queryNo} {
@@ -2096,6 +2133,7 @@ proc alert {ask} {
     global alertAnswer
 
     toplevel $w
+    set oldFocus [focus]
     place-force $w .
     top-down-window $w
 
@@ -2107,6 +2145,7 @@ proc alert {ask} {
   
     set alertAnswer 0
     top-down-ok-cancel $w {alert-action} 1
+    focus $oldFocus
     return $alertAnswer
 }
 
@@ -2244,6 +2283,7 @@ proc query-add-index {queryNo} {
     set w .query-add-index
 
     toplevel $w
+    set oldFocus [focus]
     place-force $w .query-setup
     top-down-window $w
     frame $w.top.index
@@ -2253,6 +2293,7 @@ proc query-add-index {queryNo} {
             {{Index Name:}} \
             [list query-add-index-action $queryNo] [list destroy $w]
     top-down-ok-cancel $w [list query-add-index-action $queryNo] 1
+    focus $oldFocus
 }
 
 proc query-setup-action {queryNo} {
@@ -2907,7 +2948,7 @@ menu .top.target.m
 .top.target.m add cascade -label "Setup" -menu .top.target.m.slist
 .top.target.m add command -label "Setup new" -command {define-target-dialog}
 .top.target.m add separator
-set-target-hotlist
+set-target-hotlist 0
 
 configure-disable-e .top.target.m 1
 configure-disable-e .top.target.m 2
@@ -3060,6 +3101,6 @@ pack .bot.a.status .bot.a.set .bot.a.message \
         -side left -padx 2 -pady 2
 
 ir z39
-
+z39 logLevel all
 show-logo 1