X-Git-Url: http://lists.indexdata.dk/cgi-bin?a=blobdiff_plain;f=client.tcl;h=db9a17ed60c79da005fbf6c1ea825a05f45cdab8;hb=a9e94b1c52d13b2a95330b3df5c009b767ebcb36;hp=ff682193cafd654abfdb13f06628b5090871aaa5;hpb=7470e1bbfcf80e252bca329457c48e093dcbca20;p=ir-tcl-moved-to-github.git diff --git a/client.tcl b/client.tcl index ff68219..db9a17e 100644 --- a/client.tcl +++ b/client.tcl @@ -1,6 +1,33 @@ +# IR toolkit for tcl/tk +# (c) Index Data 1995 +# See the file LICENSE for details. +# Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.28 1995-06-02 14:52:13 adam +# Revision 1.35 1995-06-12 15:17:31 adam +# Text widget used in main window (instead of listbox) to support +# better presentation formats. +# +# Revision 1.34 1995/06/12 07:59:07 adam +# More work on geometry handling. +# +# 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 @@ -100,21 +127,65 @@ set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} z39v2} set hostid Default set settingsChanged 0 set setNo 0 +set lastSetNo 0 set cancelFlag 0 set searchEnable 0 set fullMarcSeq 0 +set displayFormat 1 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}} } } - wm minsize . 0 0 +proc read-formats {} { + global displayFormats + set formats [glob -nocomplain formats/*.tcl] + foreach f $formats { + source $f + set l [expr [string length $f] - 5] + lappend displayFormats [string range $f 8 $l] + } +} + +proc set-display-format {f} { + global displayFormat + global setNo + + set displayFormat $f + if {$setNo == 0} { + return + } + add-title-lines 0 10000 1 +} + +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 + } + } +} + if {[file readable "clientrc.tcl"]} { source "clientrc.tcl" } +if {[file readable "clientg.tcl"]} { + source "clientg.tcl" +} + set queryButtonsFind [lindex $queryButtons 0] set queryInfoFind [lindex $queryInfo 0] @@ -133,7 +204,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} { @@ -215,7 +286,7 @@ 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 @@ -225,7 +296,7 @@ proc show-status {status b sb} { } 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 @@ -256,10 +327,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] @@ -273,13 +343,13 @@ proc about-target {} { 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 . @@ -292,14 +362,15 @@ 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 popup-marc {sno no b df} { global fullMarcSeq + global displayFormats + global popupMarcOdf - if {[z39.$setNo type $no] != "DB"} { + if {[z39.$sno type $no] != "DB"} { return } if {$b} { @@ -309,11 +380,10 @@ 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 + toplevelG $w wm minsize $w 0 0 @@ -323,48 +393,69 @@ proc show-full-marc {no b} { pack $w.top -side top -fill both -expand yes pack $w.bot -fill both - text $w.top.record -width 60 -height 12 -wrap word \ + text $w.top.record -width 60 -height 5 -wrap word \ -yscrollcommand [list $w.top.s set] scrollbar $w.top.s -command [list $w.top.record yview] + if {[tk colormodel .] == "color"} { + $w.top.record tag configure marc-tag -foreground blue + $w.top.record tag configure marc-id -foreground red + } else { + $w.top.record tag configure marc-tag -foreground black + $w.top.record tag configure marc-id -foreground black + } + $w.top.record tag configure marc-data -foreground black set new 1 } - set r [z39.$setNo getMarc $no list * * *] + $w.top.record delete 0.0 end - $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 + set ffunc [lindex $displayFormats $df] + set ffunc "display-$ffunc" - foreach line $r { - set tag [lindex $line 0] - set indicator [lindex $line 1] - set fields [lindex $line 2] + $ffunc $sno $no $w.top.record 0 - 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 {$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 \ + + if {$b} { + bottom-buttons $w [list \ {Close} [list destroy $w] \ - {Duplicate} [list show-full-marc $no 1]] 0 + {Duplicate} [list popup-marc $sno $no 1 $df]] 0 + menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m + menu $w.bot.formats.m + set i 0 + foreach f $displayFormats { + $w.bot.formats.m add radiobutton -label $f \ + -command [list display-$f $sno $no $w.top.record 0] + incr i + } + pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \ + -padx 3 -pady 3 -side left + } else { + bottom-buttons $w [list \ + {Close} [list destroyG $w] \ + {Duplicate} [list popup-marc $sno $no 1 $df]] 0 + menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m + menu $w.bot.formats.m + set i 0 + foreach f $displayFormats { + $w.bot.formats.m add radiobutton -label $f \ + -command [list display-$f $sno $no $w.top.record 0] + incr i + } + pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \ + -padx 3 -pady 3 -side left + } + } else { + set i 0 + foreach f $displayFormats { + $w.bot.formats.m entryconfigure $i \ + -command [list display-f $sno $no $w.top.record 0] + incr i + } } } @@ -389,7 +480,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 @@ -405,7 +496,7 @@ proc reopen-target {target base} { proc define-target-action {} { global profile - + set target [.target-define.top.target.entry get] if {$target == ""} { return @@ -417,7 +508,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 } @@ -455,7 +550,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 @@ -487,14 +582,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 {} } @@ -592,25 +688,29 @@ 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 + toplevelG $w wm title $w "Scan" 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 + -font fixed 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 @@ -620,23 +720,51 @@ proc scan-request {attr} { pack $w.top.list -side left -fill both -expand yes } - bottom-buttons $w [list {Close} [list destroy $w] \ + 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] + +# bind $w.top [list focus $w.top.entry] } - focus $w.top.list + 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" @@ -651,12 +779,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} { @@ -682,6 +834,7 @@ proc scan-response {attr start toget} { z39.scan numberOfTermsRequested $ntoget } z39.scan preferredPositionInResponse 1 + puts "${attr} \{$q\}" z39.scan scan "${attr} \{$q\}" return } @@ -689,7 +842,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 @@ -698,6 +851,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 } @@ -711,12 +865,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 } @@ -727,9 +882,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 @@ -737,7 +893,6 @@ proc scan-up {attr} { z39.scan scan "${attr} \{$q\}" return } - set scanView [expr $scanView - 5] $w.top.list yview $scanView } @@ -751,9 +906,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] @@ -781,52 +939,74 @@ 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 } proc init-title-lines {} { - .data.list delete 0 end + .data.record delete 0.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} { + global displayFormats + global displayFormat + global lastSetNo + + if {$setno == 0} { + set setno $lastSetNo + } else { + set lastSetNo $setno + } + if {$offset == 1} { + .bot.a.set configure -text $setno + .data.record delete 0.0 end + } + set ffunc [lindex $displayFormats $displayFormat] + set ffunc "display-$ffunc" for {set i 0} {$i < $no} {incr i} { set o [expr $i + $offset] set type [z39.$setno type $o] - if {$type == "DB"} { - set title [lindex [z39.$setno getMarc $o field 245 * a] 0] - set year [lindex [z39.$setno getMarc $o field 260 * c] 0] - set nostr [format "%5d" $o] - .data.list insert end "$nostr $title - $year" - } elseif {$type == "SD"} { - set err [lindex [z39.$setno diag $o] 1] - set add [lindex [z39.$setno diag $o] 2] - if {$add != {}} { - set add " :${add}" - } - .data.list insert end "Error ${err}${add}" - } elseif {$type == ""} { - .data.list insert end "empty" + if {$type == ""} { + break } + set insert0 [.data.record index insert] + $ffunc $setno $o .data.record 1 + .data.record tag add r$o $insert0 insert + .data.record tag bind r$o <1> \ + [list popup-marc $setno $o 0 $displayFormat] } } @@ -856,7 +1036,7 @@ proc present-response {} { return } if {$no > 0 && $setOffset <= $setMax} { - puts "present from ${setOffset}" + puts "present-request from ${setOffset}" set toGet [expr $setMax - $setOffset + 1] if {$toGet > 3} { set toGet 3 @@ -938,32 +1118,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} { @@ -978,20 +1158,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 @@ -1008,8 +1194,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 @@ -1017,8 +1206,6 @@ proc delete-database {target} { } proc protocol-setup {target} { - set w .setup-$target - global profile global csRadioType global protocolRadioType @@ -1026,10 +1213,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 @@ -1059,13 +1248,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] @@ -1087,9 +1276,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 @@ -1144,7 +1333,8 @@ 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 } proc database-select-action {} { @@ -1209,11 +1399,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 {}] } } } @@ -1221,7 +1411,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] } } } @@ -1230,22 +1420,37 @@ 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 } } +proc save-geometry {} { + global windowGeometry + + set windowGeometry(.) [wm geometry .] + + set f [open "clientg.tcl" w] + + foreach n [array names windowGeometry] { + puts -nonewline $f "set \{windowGeometry($n)\} \{" + puts -nonewline $f $windowGeometry($n) + puts $f "\}" + } + close $f +} + proc save-settings {} { global hotTargets global profile @@ -1253,13 +1458,13 @@ proc save-settings {} { global queryTypes global queryButtons global queryInfo - + 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 "\}" } @@ -1274,7 +1479,6 @@ proc save-settings {} { puts -nonewline $f "set queryInfo \{" puts -nonewline $f $queryInfo puts $f "\}" - close $f set settingsChanged 0 } @@ -1306,6 +1510,7 @@ proc alert-action {} { proc exit-action {} { global settingsChanged + save-geometry if {$settingsChanged} { set a [alert "you havent saved your settings. Do you wish to save?"] if {$a} { @@ -1692,6 +1897,15 @@ proc search-fields {w buttondefs} { $w.0 configure -background red } +if {[info exists windowGeometry(.)]} { + set g $windowGeometry(.) + if {$g != ""} { + wm geometry . $g + } +} + +read-formats + frame .top -border 1 -relief raised frame .lines -border 1 -relief raised frame .mid -border 1 -relief raised @@ -1704,11 +1918,8 @@ 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 -.top.file.m add command -label "About" -command {about-origin} menubutton .top.target -text "Target" -underline 0 -menu .top.target.m menu .top.target.m @@ -1727,37 +1938,52 @@ 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 +.top.options.m add cascade -label "Format" -menu .top.options.m.formats + +menu .top.options.m.slist +menu .top.options.m.clist +menu .top.options.m.formats cascade-query-list +set i 0 +foreach f $displayFormats { + .top.options.m.formats add radiobutton -label $f \ + -command [list set-display-format $i] + incr i +} menubutton .top.help -text "Help" -menu .top.help.m menu .top.help.m .top.help.m add command -label "Help on help" \ -command {tkerror "Help on help not available. Sorry"} -.top.help.m add command -label "About" \ - -command {tkerror "About not available. Sorry"} +.top.help.m add command -label "About" -command {about-origin} -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 @@ -1765,7 +1991,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 @@ -1773,11 +1999,20 @@ 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 -scrollbar .data.scroll -orient vertical -border 1 -pack .data.list -side left -fill both -expand yes +text .data.record -height 2 -width 20 -wrap none \ + -yscrollcommand [list .data.scroll set] +scrollbar .data.scroll -command [list .data.record yview] pack .data.scroll -side right -fill y -.data.scroll config -command {.data.list yview} +pack .data.record -expand yes -fill both + +if {[tk colormodel .] == "color"} { + .data.record tag configure marc-tag -foreground blue + .data.record tag configure marc-id -foreground red +} else { + .data.record tag configure marc-tag -foreground black + .data.record tag configure marc-id -foreground black +} +.data.record tag configure marc-data -foreground black button .bot.logo -bitmap @book1 -command cancel-operation frame .bot.a @@ -1788,7 +2023,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 @@ -1797,12 +2032,11 @@ 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} +#bind . {focus .lines.0.e} ir z39 -z39 options search present scan namedResultSets triggerResourceCtrl -puts [z39 options] +.top.options.m.formats invoke $displayFormat + show-logo 1