X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;ds=sidebyside;f=client.tcl;h=ebb18f16e8e60cf539bd22045db750cc1847f067;hb=600bbc839430064941f0e48ec2be3588eb5ec84a;hp=6af6a9529afd9d0fd258f2b25a92d310c1f10da5;hpb=317f0c64410255f096bba36986939d9dd6a5e26d;p=ir-tcl-moved-to-github.git diff --git a/client.tcl b/client.tcl index 6af6a95..ebb18f1 100644 --- a/client.tcl +++ b/client.tcl @@ -1,6 +1,28 @@ # # $Log: client.tcl,v $ -# Revision 1.26 1995-06-01 16:36:46 adam +# Revision 1.33 1995-06-09 11:17:35 adam +# Start work on geometry management. +# +# Revision 1.32 1995/06/07 09:16:37 adam +# New presentation format. +# +# Revision 1.31 1995/06/06 16:31:09 adam +# Bug fix: target names couldn't contain blanks. +# Bug fix: scan. +# +# Revision 1.30 1995/06/06 11:35:41 adam +# Work on scan. Display of old sets. +# +# Revision 1.29 1995/06/05 14:11:18 adam +# Bug fix in present-more. +# +# Revision 1.28 1995/06/02 14:52:13 adam +# Minor changes really. +# +# Revision 1.27 1995/06/02 14:29:42 adam +# Work on scan interface - up/down buttons. +# +# Revision 1.26 1995/06/01 16:36:46 adam # About buttons. Minor bug fixes. # # Revision 1.25 1995/05/31 13:09:57 adam @@ -97,12 +119,33 @@ set setNo 0 set cancelFlag 0 set searchEnable 0 set fullMarcSeq 0 +set displayFormat nice set queryTypes {Simple} set queryButtons { { {I 0} {I 1} {I 2} } } set queryInfo { { {Title {1=4}} {Author {1=1}} \ {Subject {1=21}} {Any {1=1016}} } } +set windowGeometry(.scan-window) {} + +proc destroyG {w} { + global windowGeometry + set windowGeometry($w) [wm geometry $w] + destroy $w +} + +proc toplevelG {w} { + global windowGeometry + + toplevel $w + if {[info exists windowGeometry($w)]} { + set g $windowGeometry($w) + if {$g != ""} { + wm geometry $w $g + } + } +} + wm minsize . 0 0 if {[file readable "clientrc.tcl"]} { @@ -127,7 +170,7 @@ proc top-down-ok-cancel {w ok-action g} { -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} \ - -command "destroy $w" + -command [list destroy $w] pack $w.bot.cancel -side left -expand yes if {$g} { @@ -209,16 +252,25 @@ proc show-status {status b sb} { return } if {$sb} { - .top.search configure -state normal + .top.service configure -state normal .mid.search configure -state normal .mid.scan configure -state normal .mid.present configure -state normal + if {[winfo exists .scan-window]} { + .scan-window.bot.2 configure -state normal + .scan-window.bot.4 configure -state normal + } set searchEnable 1 } else { - .top.search configure -state disabled + .top.service configure -state disabled .mid.search configure -state disabled .mid.scan configure -state disabled .mid.present configure -state disabled + + if {[winfo exists .scan-window]} { + .scan-window.bot.2 configure -state disabled + .scan-window.bot.4 configure -state disabled + } set searchEnable 0 } } @@ -241,10 +293,9 @@ proc insertWithTags {w text args} { proc about-target {} { set w .about-target-w - toplevel $w + toplevelG $w wm title $w "About target" - place-force $w . top-down-window $w set i [z39 targetImplementationName] @@ -253,16 +304,18 @@ proc about-target {} { label $w.top.ii -text "Implementation id: $i" set i [z39 targetImplementationVersion] label $w.top.iv -text "Implementation version: $i" + set i [z39 options] + label $w.top.op -text "Protocol options: $i" - pack $w.top.in $w.top.ii $w.top.iv -side top -anchor nw + pack $w.top.in $w.top.ii $w.top.iv $w.top.op -side top -anchor nw - bottom-buttons $w [list {Close} [list destroy $w]] 1 + bottom-buttons $w [list {Close} [list destroyG $w]] 1 } proc about-origin {} { set w .about-origin-w - toplevel $w + toplevelG $w wm title $w "About IrTcl" place-force $w . @@ -275,14 +328,141 @@ proc about-origin {} { pack $w.top.in $w.top.ii -side top -anchor nw - bottom-buttons $w [list {Close} [list destroy $w]] 1 + bottom-buttons $w [list {Close} [list destroyG $w]] 1 } -proc show-full-marc {no b} { - global setNo +proc display-raw {sno no w} { + $w delete 0.0 end + set r [z39.$sno getMarc $no list * * *] + foreach line $r { + set tag [lindex $line 0] + set indicator [lindex $line 1] + set fields [lindex $line 2] + + if {$indicator != ""} { + insertWithTags $w "$tag $indicator" marc-tag + } else { + insertWithTags $w "$tag " marc-tag + } + foreach field $fields { + set id [lindex $field 0] + set data [lindex $field 1] + if {$id != ""} { + insertWithTags $w " $id " marc-id + } + set start [$w index insert] + insertWithTags $w $data {} + } + $w insert end "\n" + } +} + +proc display-nice {sno no w} { + $w delete 0.0 end + set i [z39.$sno getMarc $no field 245 * a] + if {$i != ""} { + set i [lindex $i 0] + insertWithTags $w "Title: " marc-tag + insertWithTags $w $i marc-data + set i [z39.$sno getMarc $no field 245 * b] + if {$i != ""} { + insertWithTags $w [lindex $i 0] marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 700 * a] + if {$i == ""} { + set i [z39.$sno getMarc $no field 100 * a] + } + if {$i != ""} { + if {[llength $i] > 1} { + insertWithTags $w "Authors: " marc-tag + } else { + insertWithTags $w "Author: " marc-tag + } + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 110 * *] + if {$i != ""} { + insertWithTags $w "Co-Author: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + + set i [z39.$sno getMarc $no field 650 * *] + if {$i != ""} { + set n 0 + insertWithTags $w "Keywords: " marc-tag + foreach x $i { + if {$n > 0} { + $w insert end ", " + } + insertWithTags $w $x marc-data + incr n + } + $w insert end "\n" + } + set i [concat [z39.$sno getMarc $no field 260 * a] \ + [z39.$sno getMarc $no field 260 * b]] + if {$i != ""} { + insertWithTags $w "Publisher: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 020 * a] + if {$i != ""} { + insertWithTags $w "ISBN: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 022 * a] + if {$i != ""} { + insertWithTags $w "ISSN: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 030 * a] + if {$i != ""} { + insertWithTags $w "CODEN: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 015 * a] + if {$i != ""} { + insertWithTags $w "Ctl number: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } + set i [z39.$sno getMarc $no field 010 * a] + if {$i != ""} { + insertWithTags $w "LC number: " marc-tag + foreach x $i { + insertWithTags $w $x marc-data + } + $w insert end "\n" + } +} + +proc show-full-marc {sno no b} { global fullMarcSeq + global displayFormat - if {[z39.$setNo type $no] != "DB"} { + if {[z39.$sno type $no] != "DB"} { return } if {$b} { @@ -292,11 +472,14 @@ proc show-full-marc {no b} { set w .full-marc } if {[winfo exists $w]} { - $w.top.record delete 0.0 end set new 0 } else { - toplevel $w + if {$b} { + toplevel $w + } else { + toplevelG $w + } wm minsize $w 0 0 @@ -312,42 +495,28 @@ proc show-full-marc {no b} { set new 1 } - set r [z39.$setNo getMarc $no list * * *] - $w.top.record tag configure marc-tag -foreground blue $w.top.record tag configure marc-data -foreground black $w.top.record tag configure marc-id -foreground red - foreach line $r { - set tag [lindex $line 0] - set indicator [lindex $line 1] - set fields [lindex $line 2] - - if {$indicator != ""} { - insertWithTags $w.top.record "$tag $indicator" marc-tag - } else { - insertWithTags $w.top.record "$tag " marc-tag - } - foreach field $fields { - set id [lindex $field 0] - set data [lindex $field 1] - if {$id != ""} { - insertWithTags $w.top.record " $id " marc-id - } - set start [$w.top.record index insert] - insertWithTags $w.top.record $data {} - } - $w.top.record insert end "\n" + if {$displayFormat == "nice"} { + display-nice $sno $no $w.top.record + } else { + display-raw $sno $no $w.top.record } if {$new} { - bind $w {destroy .full-marc} + bind $w.top.record {destroy .full-marc} pack $w.top.s -side right -fill y pack $w.top.record -expand yes -fill both bottom-buttons $w [list \ {Close} [list destroy $w] \ - {Duplicate} [list show-full-marc $no 1]] 0 + {Raw} [list display-raw $sno $no $w.top.record] \ + {Duplicate} [list show-full-marc $sno $no 1]] 0 + } else { + $w.bot.2 configure -command [list display-raw $sno $no $w.top.record] + $w.bot.4 configure -command [list show-full-marc $sno $no 1] } } @@ -372,7 +541,7 @@ proc set-target-hotlist {} { set i 1 foreach target $hotTargets { .top.target.m add command -label "$i $target" -command \ - "reopen-target $target {}" + [list reopen-target $target {}] incr i if {$i > 8} { break @@ -388,7 +557,7 @@ proc reopen-target {target base} { proc define-target-action {} { global profile - + set target [.target-define.top.target.entry get] if {$target == ""} { return @@ -400,7 +569,11 @@ proc define-target-action {} { return } } + set seq [lindex $profile(Default) 12] + puts "seq=${seq}" set profile($target) $profile(Default) + set profile(Default) [lreplace $profile(Default) 12 12 [incr seq]] + protocol-setup $target destroy .target-define } @@ -429,6 +602,7 @@ proc open-target {target base} { puts [z39 maximumRecordSize] puts -nonewline "preferredMessageSize=" puts [z39 preferredMessageSize] + show-status {Connecting} 0 0 if {$base == ""} { z39 databaseNames [lindex [lindex $profile($target) 7] 0] } else { @@ -437,7 +611,8 @@ proc open-target {target base} { 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 0 +# z39 options search present scan namedResultSets triggerResourceCtrl + show-status {Connecting} 1 {} set hostid $target .top.target.m disable 0 .top.target.m enable 1 @@ -468,14 +643,15 @@ proc load-set-action {} { set fname [.load-set.top.filename.entry get] destroy .load-set if {$fname != ""} { - init-title-lines - show-status {Loading} 1 {} z39.$setNo loadFile $fname set no [z39.$setNo numberOfRecordsReturned] add-title-lines $setNo $no 1 } + set l [format "%-4d %7d" $setNo $no] + .top.rset.m add command -label $l \ + -command [list add-title-lines $setNo 10000 1] show-status {Ready} 0 {} } @@ -567,54 +743,219 @@ proc search-request {} { show-status {Search} 1 0 } -proc scan-request {} { +proc scan-request {attr} { set w .scan-window global profile global hostid + global scanView + global scanTerm set target $hostid + set scanView 0 + set scanTerm {} ir-scan z39.scan z39 - z39 callback {scan-response} if {![winfo exists $w]} { - toplevel $w + toplevelG $w wm title $w "Scan" - wm minsize $w 200 200 + wm minsize $w 0 0 top-down-window $w + + entry $w.top.entry -relief sunken + pack $w.top.entry -fill x -padx 4 -pady 2 + bind $w.top.entry [list scan-term-h $attr] + if {1} { + listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \ + -font fixed -geometry 50x14 + scrollbar $w.top.scroll -orient vertical -border 1 + pack $w.top.list -side left -fill both -expand yes + pack $w.top.scroll -side right -fill y + $w.top.scroll config -command [list $w.top.list yview] + } else { + listbox $w.top.list -font fixed -geometry 60x14 + pack $w.top.list -side left -fill both -expand yes + } - listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \ - -font fixed -geometry 50x14 - scrollbar $w.top.scroll -orient vertical -border 1 - pack $w.top.list -side left -fill both -expand yes - pack $w.top.scroll -side right -fill y - $w.top.scroll config -command [list $w.top.list yview] + bottom-buttons $w [list {Close} [list destroyG $w] \ + {Up} [list scan-up $attr] \ + {Down} [list scan-down $attr]] 0 + bind $w.top.list [list scan-up $attr] + bind $w.top.list [list scan-down $attr] + } + focus $w.top.entry + z39 callback [list scan-response $attr 0 35] + z39.scan numberOfTermsRequested 5 + z39.scan preferredPositionInResponse 1 + z39.scan scan "${attr} 0" + + show-status {Scan} 1 0 +} - bottom-buttons $w [list {Close} [list destroy $w]] 0 +proc scan-term-h {attr} { + global busy + global scanTerm + + if {$busy} { + return + } + set w .scan-window + set nScanTerm [$w.top.entry get] + if {$nScanTerm == $scanTerm} { + return + } + set scanTerm $nScanTerm + z39 callback [list scan-response $attr 0 35] + z39.scan numberOfTermsRequested 5 + z39.scan preferredPositionInResponse 1 + puts "${attr} \{${scanTerm}\}" + if {$scanTerm == ""} { + z39.scan scan "${attr} 0" + } else { + z39.scan scan "${attr} \{${scanTerm}\}" } - z39.scan numberOfTermsRequested 100 - z39.scan scan "@attr 1=4 0" - show-status {Scan} 1 0 } -proc scan-response {} { +proc scan-response {attr start toget} { + global cancelFlag + global scanTerm + global scanView + set w .scan-window + puts "In scan-response" set m [z39.scan numberOfEntriesReturned] puts $m - for {set i 0} {$i < $m} {incr i} { - set term [lindex [z39.scan scanLine $i] 1] - set nostr [format "%7d" [lindex [z39.scan scanLine $i] 2]] + puts attr=$attr + puts start=$start + puts toget=$toget - $w.top.list insert end "$nostr $term" + if {![winfo exists .scan-window]} { + show-status {Ready} 0 1 + set cancelFlag 0 + return + } + set nScanTerm [$w.top.entry get] + if {$nScanTerm != $scanTerm} { + z39 callback [list scan-response $attr 0 35] + z39.scan numberOfTermsRequested 5 + z39.scan preferredPositionInResponse 1 + set scanTerm $nScanTerm + puts "${attr} \{${scanTerm}\}" + if {$scanTerm == ""} { + z39.scan scan "${attr} 0" + } else { + z39.scan scan "${attr} \{${scanTerm}\}" + } + show-status {Scan} 1 0 + return + } + set status [z39.scan scanStatus] + if {$status == 6} { + tkerror "Scan fail" + show-status {Ready} 0 1 + set cancelFlag 0 + return + } + if {$toget < 0} { + for {set i 0} {$i < $m} {incr i} { + set term [lindex [z39.scan scanLine $i] 1] + set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]] + $w.top.list insert $i "$nostr $term" + } + incr scanView $m + $w.top.list yview $scanView + } else { + $w.top.list delete $start end + for {set i 0} {$i < $m} {incr i} { + set term [lindex [z39.scan scanLine $i] 1] + set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]] + $w.top.list insert end "$nostr $term" + } + } + if {$cancelFlag} { + show-status {Ready} 0 1 + set cancelFlag 0 + return + } + if {$toget > 0 && $m > 1 && $m < $toget} { + set ntoget [expr $toget - $m + 1] + puts ntoget=$ntoget + z39 callback [list scan-response $attr [expr $start + $m - 1] $ntoget] + set q $term + puts "down continue: $q" + if {$ntoget > 10} { + z39.scan numberOfTermsRequested 10 + } else { + z39.scan numberOfTermsRequested $ntoget + } + z39.scan preferredPositionInResponse 1 + puts "${attr} \{$q\}" + z39.scan scan "${attr} \{$q\}" + return + } + if {$toget < 0 && $m > 1 && $m < [expr - $toget]} { + set ntoget [expr - $toget - $m] + puts ntoget=$ntoget + z39 callback [list scan-response $attr 0 -$ntoget] + set q [string range [$w.top.list get 0] 8 end] + puts "up continue: $q" + if {$ntoget > 10} { + z39.scan numberOfTermsRequested 10 + z39.scan preferredPositionInResponse 11 + } else { + z39.scan numberOfTermsRequested $ntoget + z39.scan preferredPositionInResponse [incr ntoget] + } + puts "${attr} \{$q\}" + z39.scan scan "${attr} \{$q\}" + return } show-status {Ready} 0 1 } +proc scan-down {attr} { + global scanView + + set w .scan-window + set scanView [expr $scanView + 5] + set s [$w.top.list size] + if {$scanView > $s} { + z39 callback [list scan-response $attr [expr $s - 1] 25] + set q [string range [$w.top.list get [expr $s - 1]] 8 end] + puts "down: $q" + z39.scan numberOfTermsRequested 10 + z39.scan preferredPositionInResponse 1 + show-status {Scan} 1 0 + puts "${attr} \{$q\}" + z39.scan scan "${attr} \{$q\}" + return + } + $w.top.list yview $scanView +} + +proc scan-up {attr} { + global scanView + + set w .scan-window + set scanView [expr $scanView - 5] + if {$scanView < 0} { + z39 callback [list scan-response $attr 0 -25] + set q [string range [$w.top.list get 0] 8 end] + puts "up: $q" + z39.scan numberOfTermsRequested 10 + z39.scan preferredPositionInResponse 11 + show-status {Scan} 1 0 + z39.scan scan "${attr} \{$q\}" + return + } + $w.top.list yview $scanView +} + proc search-response {} { global setNo global setOffset @@ -625,9 +966,12 @@ proc search-response {} { puts "In search-response" init-title-lines show-status {Ready} 0 1 - show-message "[z39.$setNo resultCount] hits" set setMax [z39.$setNo resultCount] - if {$setMax == 0} { + show-message "${setMax} hits" + set l [format "%-4d %7d" $setNo $setMax] + .top.rset.m add command -label $l \ + -command [list add-title-lines $setNo 10000 1] + if {$setMax <= 0} { set status [z39.$setNo responseStatus] if {[lindex $status 0] == "NSD"} { set code [lindex $status 1] @@ -655,25 +999,35 @@ proc present-more {number} { global setOffset global setMax + puts "setOffset=$setOffset" puts "present-more" if {$setNo == 0} { + puts "setNo=$setNo" return } set max [z39.$setNo resultCount] - if {$max <= $setMax} { + if {$max <= $setOffset} { + puts "max=$max" + puts "setOffset=$setOffset" return } if {$number == ""} { set setMax $max } else { incr setMax $number + if {$setMax > $max} { + set setMax $max + } } z39 callback {present-response} set toGet [expr $setMax - $setOffset + 1] + if {$toGet <= 0} { + return + } if {$toGet > 3} { set toGet 3 - } + } z39.$setNo present $setOffset $toGet show-status {Retrieve} 1 0 } @@ -682,7 +1036,17 @@ proc init-title-lines {} { .data.list delete 0 end } +proc title-press {y setno} { + show-full-marc $setno [expr 1 + [.data.list nearest $y]] 0 +} + proc add-title-lines {setno no offset} { + if {$offset == 1} { + .bot.a.set configure -text $setno + .data.list delete 0 end + } + bind .data.list [list title-press %y $setno] + bind .data.list [list title-press %y $setno] for {set i 0} {$i < $no} {incr i} { set o [expr $i + $offset] set type [z39.$setno type $o] @@ -699,7 +1063,7 @@ proc add-title-lines {setno no offset} { } .data.list insert end "Error ${err}${add}" } elseif {$type == ""} { - .data.list insert end "empty" + break } } } @@ -812,32 +1176,32 @@ proc protocol-setup-action {target} { global CCLCheck global ResultSetCheck - set w .setup-${target}.top - - #set w .protocol-setup.top + set wno [lindex $profile($target) 12] + set w .setup-${wno} set b {} set settingsChanged 1 - set len [$w.databases.list size] + set len [$w.top.databases.list size] for {set i 0} {$i < $len} {incr i} { - lappend b [$w.databases.list get $i] - } - set profile($target) [list [$w.description.entry get] \ - [$w.host.entry get] \ - [$w.port.entry get] \ - [$w.idAuthentication.entry get] \ - [$w.maximumRecordSize.entry get] \ - [$w.preferredMessageSize.entry get] \ + lappend b [$w.top.databases.list get $i] + } + set profile($target) [list [$w.top.description.entry get] \ + [$w.top.host.entry get] \ + [$w.top.port.entry get] \ + [$w.top.idAuthentication.entry get] \ + [$w.top.maximumRecordSize.entry get] \ + [$w.top.preferredMessageSize.entry get] \ $csRadioType \ $b \ $RPNCheck \ $CCLCheck \ $ResultSetCheck \ - $protocolRadioType ] + $protocolRadioType \ + $wno] cascade-target-list puts $profile($target) - destroy .setup-${target} + destroyG $w } proc place-force {window parent} { @@ -852,20 +1216,26 @@ proc place-force {window parent} { } proc add-database-action {target} { - set w .setup-${target} - - ${w}.top.databases.list insert end \ + global profile + + set wno [lindex $profile($target) 12] + set w .setup-${wno} + + $w.top.databases.list insert end \ [.database-select.top.database.entry get] destroy .database-select } proc add-database {target} { + global profile + set w .database-select set oldFocus [focus] toplevel $w - - place-force $w .setup-${target} + + set wno [lindex $profile($target) 12] + place-force $w .setup-${wno} top-down-window $w @@ -882,8 +1252,11 @@ proc add-database {target} { } proc delete-database {target} { - set w .setup-${target} - + global profile + + set wno [lindex $profile($target) 12] + set w .setup-${wno} + foreach i [lsort -decreasing \ [$w.top.databases.list curselection]] { $w.top.databases.list delete $i @@ -891,8 +1264,6 @@ proc delete-database {target} { } proc protocol-setup {target} { - set w .setup-$target - global profile global csRadioType global protocolRadioType @@ -900,10 +1271,12 @@ proc protocol-setup {target} { global CCLCheck global ResultSetCheck - toplevel $w + set wno [lindex $profile($target) 12] + set w .setup-${wno} + + toplevelG $w wm title $w "Setup $target" - place-force $w . top-down-window $w @@ -933,13 +1306,13 @@ proc protocol-setup {target} { maximumRecordSize preferredMessageSize} \ {{Description:} {Host:} {Port:} {Id Authentication:} \ {Maximum Record Size:} {Preferred Message Size:}} \ - [list protocol-setup-action $target] [list destroy $w] + [list protocol-setup-action $target] [list destroyG $w] foreach sub {description host port idAuthentication \ maximumRecordSize preferredMessageSize} { puts $sub - bind $w.top.$sub.entry "add-database $target" - bind $w.top.$sub.entry "delete-database $target" + bind $w.top.$sub.entry [list add-database $target] + bind $w.top.$sub.entry [list delete-database $target] } $w.top.description.entry insert 0 [lindex $profile($target) 0] $w.top.host.entry insert 0 [lindex $profile($target) 1] @@ -961,9 +1334,9 @@ proc protocol-setup {target} { label $w.top.databases.label -text "Databases" button $w.top.databases.add -text "Add" \ - -command "add-database $target" + -command [list add-database $target] button $w.top.databases.delete -text "Delete" \ - -command "delete-database $target" + -command [list 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 @@ -1018,7 +1391,9 @@ proc protocol-setup {target} { -padx 4 -side top -fill x # Ok-cancel - top-down-ok-cancel $w [list protocol-setup-action $target] 0 + bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \ + {Cancel} [list destroyG $w]] 0 +# top-down-ok-cancel $w [list protocol-setup-action $target] 0 } proc database-select-action {} { @@ -1083,11 +1458,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 "reopen-target $n $b" + -command [list reopen-target $n $b] } } else { .top.target.m.clist add command -label $n \ - -command "reopen-target $n {}" + -command [list reopen-target $n {}] } } } @@ -1095,7 +1470,7 @@ proc cascade-target-list {} { foreach n [array names profile] { if {$n != "Default"} { .top.target.m.slist add command -label $n \ - -command "protocol-setup $n" + -command [list protocol-setup $n] } } } @@ -1104,17 +1479,17 @@ proc cascade-query-list {} { global queryTypes set i 0 - .top.query.m.slist delete 0 last + .top.options.m.slist delete 0 last foreach n $queryTypes { - .top.query.m.slist add command -label $n \ + .top.options.m.slist add command -label $n \ -command [list query-setup $i] incr i } set i 0 - .top.query.m.clist delete 0 last + .top.options.m.clist delete 0 last foreach n $queryTypes { - .top.query.m.clist add command -label $n \ + .top.options.m.clist add command -label $n \ -command [list query-select $i] incr i } @@ -1128,12 +1503,14 @@ proc save-settings {} { global queryButtons global queryInfo + destroyG . + set f [open "clientrc.tcl" w] puts $f "# Setup file" puts $f "set hotTargets \{ $hotTargets \}" foreach n [array names profile] { - puts -nonewline $f "set profile($n) \{" + puts -nonewline $f "set \{profile($n)\} \{" puts -nonewline $f $profile($n) puts $f "\}" } @@ -1566,6 +1943,13 @@ proc search-fields {w buttondefs} { $w.0 configure -background red } +if {[info exists windowGeometry(.w)]} { + set g $windowGeometry(.w) + if {$g != ""} { + wm geometry .w $g + } +} + frame .top -border 1 -relief raised frame .lines -border 1 -relief raised frame .mid -border 1 -relief raised @@ -1578,7 +1962,6 @@ pack .bot -fill x menubutton .top.file -text "File" -underline 0 -menu .top.file.m menu .top.file.m .top.file.m add command -label "Save settings" -command {save-settings} -.top.file.m add command -label "Load Set" -command {load-set} .top.file.m add separator .top.file.m add command -label "Exit" -command {exit-action} .top.file.m add separator @@ -1601,26 +1984,33 @@ menu .top.target.m.clist menu .top.target.m.slist cascade-target-list -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.query -text "Query" -underline 0 -menu .top.query.m -menu .top.query.m -.top.query.m add cascade -label "Choose" -menu .top.query.m.clist -.top.query.m add command -label "Define" -command {new-query-dialog} -.top.query.m add cascade -label "Edit" -menu .top.query.m.slist -menu .top.query.m.clist -menu .top.query.m.slist +menubutton .top.service -text "Service" -underline 0 -menu .top.service.m +menu .top.service.m +.top.service.m add command -label "Database" -command {database-select} +.top.service.m add cascade -label "Query type" -menu .top.service.m.querytype +menu .top.service.m.querytype +.top.service.m.querytype add radiobutton -label "RPN" +.top.service.m.querytype add radiobutton -label "CCL" +.top.service.m add cascade -label "Present" -menu .top.service.m.present +menu .top.service.m.present +.top.service.m.present add command -label "More" \ + -command [list present-more 10] +.top.service.m.present add command -label "All" \ + -command [list present-more {}] +.top.service configure -state disabled + +menubutton .top.rset -text "Set" -menu .top.rset.m +menu .top.rset.m +.top.rset.m add command -label "Load" -command {load-set} +.top.rset.m add separator + +menubutton .top.options -text "Options" -underline 0 -menu .top.options.m +menu .top.options.m +.top.options.m add cascade -label "Choose query" -menu .top.options.m.clist +.top.options.m add command -label "Define query" -command {new-query-dialog} +.top.options.m add cascade -label "Edit query" -menu .top.options.m.slist +menu .top.options.m.clist +menu .top.options.m.slist cascade-query-list menubutton .top.help -text "Help" -menu .top.help.m @@ -1631,15 +2021,15 @@ menu .top.help.m .top.help.m add command -label "About" \ -command {tkerror "About not available. Sorry"} -pack .top.file .top.target .top.query .top.search -side left +pack .top.file .top.target .top.service .top.rset .top.options -side left pack .top.help -side right index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index button .mid.search -width 7 -text {Search} -command search-request \ -state disabled -button .mid.scan -width 7 -text {Scan} -command scan-request \ - -state disabled +button .mid.scan -width 7 -text {Scan} \ + -command [list scan-request "@attr 1=4 @attr 5=1 @attr 4=1"] -state disabled button .mid.present -width 7 -text {Present} -command [list present-more 10] \ -state disabled @@ -1647,7 +2037,7 @@ button .mid.clear -width 7 -text {Clear} -command index-clear pack .mid.search .mid.scan .mid.present .mid.clear -side left \ -fill y -padx 5 -pady 3 -listbox .data.list -yscrollcommand {.data.scroll set} -font fixed +listbox .data.list -yscrollcommand {.data.scroll set} -font fixed -geometry 20x2 scrollbar .data.scroll -orient vertical -border 1 pack .data.list -side left -fill both -expand yes pack .data.scroll -side right -fill y @@ -1662,7 +2052,7 @@ message .bot.a.target -text "" -aspect 1000 -border 1 label .bot.a.status -text "Not connected" -width 15 -relief \ sunken -anchor w -border 1 -label .bot.a.set -textvariable setNo -width 5 -relief \ +label .bot.a.set -text "" -width 5 -relief \ sunken -anchor w -border 1 label .bot.a.message -text "" -width 15 -relief \ sunken -anchor w -border 1 @@ -1671,9 +2061,6 @@ pack .bot.a.target -side top -anchor nw -padx 2 -pady 2 pack .bot.a.status .bot.a.set .bot.a.message \ -side left -padx 2 -pady 2 -bind .data.list {set indx [.data.list nearest %y] -show-full-marc [incr indx] 0} - ir z39 show-logo 1