X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;f=client.tcl;h=7f95380832af08d76b038905a5c594436a2c9268;hb=ccdfb0b1bf6abd6438ee03ec1cd9b19b0bb77df8;hp=6813715e2aa4d102a36acd8926d52aebf63a8d06;hpb=ee456fe2135ec673d894d6d08474dc24e9a98d31;p=ir-tcl-moved-to-github.git diff --git a/client.tcl b/client.tcl index 6813715..7f95380 100644 --- a/client.tcl +++ b/client.tcl @@ -1,6 +1,16 @@ # # $Log: client.tcl,v $ -# Revision 1.29 1995-06-05 14:11:18 adam +# 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 @@ -106,6 +116,7 @@ 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} } } @@ -298,8 +309,136 @@ proc about-origin {} { bottom-buttons $w [list {Close} [list destroy $w]] 1 } +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.$sno type $no] != "DB"} { return @@ -311,7 +450,6 @@ proc show-full-marc {sno no b} { set w .full-marc } if {[winfo exists $w]} { - $w.top.record delete 0.0 end set new 0 } else { @@ -331,42 +469,28 @@ proc show-full-marc {sno no b} { set new 1 } - set r [z39.$sno 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] \ + {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] } } @@ -391,7 +515,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 @@ -407,7 +531,7 @@ proc reopen-target {target base} { proc define-target-action {} { global profile - + set target [.target-define.top.target.entry get] if {$target == ""} { return @@ -419,7 +543,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 } @@ -457,7 +585,7 @@ 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] - z39 options search present scan namedResultSets triggerResourceCtrl +# z39 options search present scan namedResultSets triggerResourceCtrl show-status {Connecting} 1 {} set hostid $target .top.target.m disable 0 @@ -489,14 +617,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 {} } @@ -594,13 +723,14 @@ proc scan-request {attr} { global profile global hostid global scanView + global scanTerm set target $hostid set scanView 0 + set scanTerm {} ir-scan z39.scan z39 - z39 callback [list scan-response $attr 0 25] if {![winfo exists $w]} { toplevel $w @@ -609,7 +739,10 @@ proc scan-request {attr} { 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 @@ -628,17 +761,44 @@ proc scan-request {attr} { bind $w.top.list [list scan-up $attr] bind $w.top.list [list scan-down $attr] } - focus $w.top.list + focus $w.top.entry + z39 callback [list scan-response $attr 0 35] z39.scan numberOfTermsRequested 5 z39.scan preferredPositionInResponse 1 - z39.scan scan "${attr} b" + z39.scan scan "${attr} 0" show-status {Scan} 1 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}\}" + } + show-status {Scan} 1 0 +} proc scan-response {attr start toget} { global cancelFlag + global scanTerm + global scanView set w .scan-window puts "In scan-response" @@ -653,12 +813,36 @@ proc scan-response {attr start toget} { 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} { @@ -684,6 +868,7 @@ proc scan-response {attr start toget} { z39.scan numberOfTermsRequested $ntoget } z39.scan preferredPositionInResponse 1 + puts "${attr} \{$q\}" z39.scan scan "${attr} \{$q\}" return } @@ -691,7 +876,7 @@ proc scan-response {attr start 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] 7 end] + set q [string range [$w.top.list get 0] 8 end] puts "up continue: $q" if {$ntoget > 10} { z39.scan numberOfTermsRequested 10 @@ -700,6 +885,7 @@ proc scan-response {attr start toget} { z39.scan numberOfTermsRequested $ntoget z39.scan preferredPositionInResponse [incr ntoget] } + puts "${attr} \{$q\}" z39.scan scan "${attr} \{$q\}" return } @@ -713,12 +899,13 @@ proc scan-down {attr} { set scanView [expr $scanView + 5] set s [$w.top.list size] if {$scanView > $s} { - z39 callback [list scan-response $attr [expr $s - 1] 30] - set q [string range [$w.top.list get [expr $s - 1]] 7 end] + 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 } @@ -729,9 +916,10 @@ proc scan-up {attr} { global scanView set w .scan-window - if {$scanView < 5} { - z39 callback [list scan-response $attr 0 -30] - set q [string range [$w.top.list get 0] 7 end] + 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 @@ -739,7 +927,6 @@ proc scan-up {attr} { z39.scan scan "${attr} \{$q\}" return } - set scanView [expr $scanView - 5] $w.top.list yview $scanView } @@ -753,9 +940,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] @@ -825,7 +1015,12 @@ proc title-press {y setno} { } 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] @@ -842,7 +1037,7 @@ proc add-title-lines {setno no offset} { } .data.list insert end "Error ${err}${add}" } elseif {$type == ""} { - .data.list insert end "empty" + break } } } @@ -955,32 +1150,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} + destroy $w } proc place-force {window parent} { @@ -995,20 +1190,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 @@ -1025,8 +1226,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 @@ -1034,7 +1238,6 @@ proc delete-database {target} { } proc protocol-setup {target} { - set w .setup-$target global profile global csRadioType @@ -1043,6 +1246,9 @@ proc protocol-setup {target} { global CCLCheck global ResultSetCheck + set wno [lindex $profile($target) 12] + set w .setup-${wno} + toplevel $w wm title $w "Setup $target" @@ -1081,8 +1287,8 @@ proc protocol-setup {target} { 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] @@ -1104,9 +1310,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 @@ -1226,11 +1432,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 {}] } } } @@ -1238,7 +1444,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] } } } @@ -1247,17 +1453,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 } @@ -1276,7 +1482,7 @@ proc save-settings {} { 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 "\}" } @@ -1721,7 +1927,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 @@ -1761,17 +1966,16 @@ menu .top.service.m.present menubutton .top.rset -text "Set" -menu .top.rset.m menu .top.rset.m -.top.rset.m add cascade -label "Select" -menu .top.rset.m.list .top.rset.m add command -label "Load" -command {load-set} -menu .top.rset.m.list - -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 +.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 @@ -1782,7 +1986,7 @@ menu .top.help.m .top.help.m add command -label "About" \ -command {tkerror "About not available. Sorry"} -pack .top.file .top.target .top.rset .top.query .top.service -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 @@ -1790,7 +1994,7 @@ 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 [list scan-request "@attr 1=4"] -state disabled + -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 @@ -1813,7 +2017,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