3 # Revision 1.29 1995-06-05 14:11:18 adam
4 # Bug fix in present-more.
6 # Revision 1.28 1995/06/02 14:52:13 adam
7 # Minor changes really.
9 # Revision 1.27 1995/06/02 14:29:42 adam
10 # Work on scan interface - up/down buttons.
12 # Revision 1.26 1995/06/01 16:36:46 adam
13 # About buttons. Minor bug fixes.
15 # Revision 1.25 1995/05/31 13:09:57 adam
16 # Client searches/presents may be interrupted.
17 # New moving book-logo.
19 # Revision 1.24 1995/05/31 08:36:24 adam
20 # Bug fix in client.tcl: didn't save options on clientrc.tcl.
21 # New method: referenceId. More work on scan.
23 # Revision 1.23 1995/05/29 10:33:41 adam
24 # README and rename of startup script.
26 # Revision 1.22 1995/05/26 11:44:09 adam
27 # Bugs fixed. More work on MARC utilities and queries. Test
28 # client is up-to-date again.
30 # Revision 1.21 1995/05/11 15:34:46 adam
31 # Scan request changed a bit. This version works with RLG.
33 # Revision 1.20 1995/04/21 16:31:57 adam
34 # New radiobutton: protocol (z39v2/SR).
36 # Revision 1.19 1995/04/18 16:11:50 adam
37 # First version of graphical Scan. Some work on query-by-form.
39 # Revision 1.18 1995/04/10 10:50:22 adam
40 # Result-set name defaults to suffix of ir-set name.
41 # Started working on scan. Not finished at this point.
43 # Revision 1.17 1995/03/31 09:34:57 adam
44 # Search-button disabled when there is no connection.
46 # Revision 1.16 1995/03/31 08:56:36 adam
47 # New button "Search".
49 # Revision 1.15 1995/03/28 12:45:22 adam
50 # New ir method failback: called on disconnect/protocol error.
51 # New ir set/get method: protocol: SR / Z3950.
52 # Simple popup and disconnect when failback is invoked.
54 # Revision 1.14 1995/03/22 16:07:55 adam
57 # Revision 1.13 1995/03/21 17:27:26 adam
58 # Short-hand keys in setup.
60 # Revision 1.12 1995/03/21 13:41:03 adam
61 # Comstack cs_create not used too often. Non-blocking connect.
63 # Revision 1.11 1995/03/21 10:39:06 adam
64 # Diagnostic error message displayed with tkerror.
66 # Revision 1.10 1995/03/20 15:24:06 adam
67 # Diagnostic records saved on searchResponse.
69 # Revision 1.9 1995/03/17 18:26:16 adam
70 # Non-blocking i/o used now. Database names popup as cascade items.
72 # Revision 1.8 1995/03/17 15:45:00 adam
73 # Improved target/database setup.
75 # Revision 1.7 1995/03/16 17:54:03 adam
76 # Minor changes really.
78 # Revision 1.6 1995/03/15 19:10:20 adam
79 # Database setup in protocol-setup (rather target setup).
81 # Revision 1.5 1995/03/15 13:59:23 adam
84 # Revision 1.4 1995/03/14 17:32:29 adam
85 # Presentation of full Marc record in popup window.
87 # Revision 1.3 1995/03/12 19:31:52 adam
88 # Pattern matching implemented when retrieving MARC records. More
89 # diagnostic functions.
91 # Revision 1.2 1995/03/10 18:00:15 adam
92 # Actual presentation in line-by-line format. RPN query support.
94 # Revision 1.1 1995/03/09 16:15:07 adam
95 # First presentRequest attempts. Hot-target list.
102 set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} z39v2}
104 set settingsChanged 0
110 set queryTypes {Simple}
111 set queryButtons { { {I 0} {I 1} {I 2} } }
112 set queryInfo { { {Title {1=4}} {Author {1=1}} \
113 {Subject {1=21}} {Any {1=1016}} } }
117 if {[file readable "clientrc.tcl"]} {
118 source "clientrc.tcl"
121 set queryButtonsFind [lindex $queryButtons 0]
122 set queryInfoFind [lindex $queryInfo 0]
124 proc top-down-window {w} {
125 frame $w.top -relief raised -border 1
126 frame $w.bot -relief raised -border 1
128 pack $w.top -side top -fill both -expand yes
129 pack $w.bot -fill both
132 proc top-down-ok-cancel {w ok-action g} {
133 frame $w.bot.left -relief sunken -border 1
134 pack $w.bot.left -side left -expand yes -ipadx 2 -ipady 2 -padx 5 -pady 5
135 button $w.bot.left.ok -width 6 -text {Ok} \
136 -command ${ok-action}
137 pack $w.bot.left.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3
138 button $w.bot.cancel -width 6 -text {Cancel} \
139 -command "destroy $w"
140 pack $w.bot.cancel -side left -expand yes
148 proc bottom-buttons {w buttonList g} {
150 set l [llength $buttonList]
152 frame $w.bot.$i -relief sunken -border 1
153 pack $w.bot.$i -side left -expand yes -padx 5 -pady 5
154 button $w.bot.$i.ok -text [lindex $buttonList $i] \
155 -command [lindex $buttonList [expr $i+1]]
156 pack $w.bot.$i.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
160 button $w.bot.$i -text [lindex $buttonList $i] \
161 -command [lindex $buttonList [expr $i+1]]
162 pack $w.bot.$i -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
172 proc cancel-operation {} {
178 show-status Cancelled 0 {}
182 proc show-target {target} {
183 .bot.a.target configure -text "$target"
186 proc show-logo {v1} {
193 .bot.logo configure -bitmap @book${v1}
194 after 140 [list show-logo $v1]
198 .bot.logo configure -bitmap @book1
207 proc show-status {status b sb} {
211 .bot.a.status configure -text "$status"
213 if {$busy == 0} {set busy 1}
221 .top.service configure -state normal
222 .mid.search configure -state normal
223 .mid.scan configure -state normal
224 .mid.present configure -state normal
225 if {[winfo exists .scan-window]} {
226 .scan-window.bot.2 configure -state normal
227 .scan-window.bot.4 configure -state normal
231 .top.service configure -state disabled
232 .mid.search configure -state disabled
233 .mid.scan configure -state disabled
234 .mid.present configure -state disabled
236 if {[winfo exists .scan-window]} {
237 .scan-window.bot.2 configure -state disabled
238 .scan-window.bot.4 configure -state disabled
244 proc show-message {msg} {
245 .bot.a.message configure -text "$msg"
248 proc insertWithTags {w text args} {
249 set start [$w index insert]
250 $w insert insert $text
251 foreach tag [$w tag names $start] {
252 $w tag remove $tag $start insert
255 $w tag add $i $start insert
259 proc about-target {} {
260 set w .about-target-w
264 wm title $w "About target"
268 set i [z39 targetImplementationName]
269 label $w.top.in -text "Implementation name: $i"
270 set i [z39 targetImplementationId]
271 label $w.top.ii -text "Implementation id: $i"
272 set i [z39 targetImplementationVersion]
273 label $w.top.iv -text "Implementation version: $i"
275 label $w.top.op -text "Protocol options: $i"
277 pack $w.top.in $w.top.ii $w.top.iv $w.top.op -side top -anchor nw
279 bottom-buttons $w [list {Close} [list destroy $w]] 1
282 proc about-origin {} {
283 set w .about-origin-w
287 wm title $w "About IrTcl"
291 set i [z39 implementationName]
292 label $w.top.in -text "Implementation name: $i"
293 set i [z39 implementationId]
294 label $w.top.ii -text "Implementation id: $i"
296 pack $w.top.in $w.top.ii -side top -anchor nw
298 bottom-buttons $w [list {Close} [list destroy $w]] 1
301 proc show-full-marc {sno no b} {
304 if {[z39.$sno type $no] != "DB"} {
308 set w .full-marc-$fullMarcSeq
313 if {[winfo exists $w]} {
314 $w.top.record delete 0.0 end
322 frame $w.top -relief raised -border 1
323 frame $w.bot -relief raised -border 1
325 pack $w.top -side top -fill both -expand yes
326 pack $w.bot -fill both
328 text $w.top.record -width 60 -height 12 -wrap word \
329 -yscrollcommand [list $w.top.s set]
330 scrollbar $w.top.s -command [list $w.top.record yview]
334 set r [z39.$sno getMarc $no list * * *]
336 $w.top.record tag configure marc-tag -foreground blue
337 $w.top.record tag configure marc-data -foreground black
338 $w.top.record tag configure marc-id -foreground red
341 set tag [lindex $line 0]
342 set indicator [lindex $line 1]
343 set fields [lindex $line 2]
345 if {$indicator != ""} {
346 insertWithTags $w.top.record "$tag $indicator" marc-tag
348 insertWithTags $w.top.record "$tag " marc-tag
350 foreach field $fields {
351 set id [lindex $field 0]
352 set data [lindex $field 1]
354 insertWithTags $w.top.record " $id " marc-id
356 set start [$w.top.record index insert]
357 insertWithTags $w.top.record $data {}
359 $w.top.record insert end "\n"
362 bind $w <Return> {destroy .full-marc}
364 pack $w.top.s -side right -fill y
365 pack $w.top.record -expand yes -fill both
367 bottom-buttons $w [list \
368 {Close} [list destroy $w] \
369 {Duplicate} [list show-full-marc $sno $no 1]] 0
373 proc update-target-hotlist {target} {
376 set len [llength $hotTargets]
378 .top.target.m delete 6 [expr 6+[llength $hotTargets]]
380 set indx [lsearch $hotTargets $target]
382 set hotTargets [lreplace $hotTargets $indx $indx]
384 set hotTargets [linsert $hotTargets 0 $target]
388 proc set-target-hotlist {} {
392 foreach target $hotTargets {
393 .top.target.m add command -label "$i $target" -command \
394 "reopen-target $target {}"
402 proc reopen-target {target base} {
404 open-target $target $base
405 update-target-hotlist $target
408 proc define-target-action {} {
411 set target [.target-define.top.target.entry get]
415 update-target-hotlist $target
416 foreach n [array names profile] {
422 set profile($target) $profile(Default)
423 protocol-setup $target
424 destroy .target-define
427 proc fail-response {target} {
429 tkerror "Target connection closed or protocol error"
432 proc connect-response {target} {
433 puts "connect-response"
438 proc open-target {target base} {
443 z39 comstack [lindex $profile($target) 6]
444 z39 idAuthentication [lindex $profile($target) 3]
445 z39 maximumRecordSize [lindex $profile($target) 4]
446 z39 preferredMessageSize [lindex $profile($target) 5]
447 puts -nonewline "maximumRecordSize="
448 puts [z39 maximumRecordSize]
449 puts -nonewline "preferredMessageSize="
450 puts [z39 preferredMessageSize]
451 show-status {Connecting} 0 0
453 z39 databaseNames [lindex [lindex $profile($target) 7] 0]
455 z39 databaseNames $base
457 z39 failback [list fail-response $target]
458 z39 callback [list connect-response $target]
459 z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
460 z39 options search present scan namedResultSets triggerResourceCtrl
461 show-status {Connecting} 1 {}
463 .top.target.m disable 0
464 .top.target.m enable 1
465 .top.target.m enable 2
468 proc close-target {} {
476 show-status {Not connected} 0 0
478 .top.target.m disable 1
479 .top.target.m disable 2
480 .top.target.m enable 0
483 proc load-set-action {} {
487 ir-set z39.$setNo z39
489 set fname [.load-set.top.filename.entry get]
494 show-status {Loading} 1 {}
495 z39.$setNo loadFile $fname
497 set no [z39.$setNo numberOfRecordsReturned]
498 add-title-lines $setNo $no 1
500 show-status {Ready} 0 {}
513 frame $w.top.filename
515 pack $w.top.filename -side top -anchor e -pady 2
517 entry-fields $w.top {filename} \
519 {load-set-action} {destroy .load-set}
521 top-down-ok-cancel $w {load-set-action} 1
525 proc init-request {} {
533 z39 callback {init-response}
534 show-status {Initializing} 1 {}
538 proc init-response {} {
545 show-status {Ready} 0 1
546 if {![z39 initResult]} {
547 set u [z39 userInformationField]
549 tkerror "Connection rejected by target: $u"
553 proc search-request {} {
563 if {$searchEnable == 0} {
566 set query [index-query]
571 ir-set z39.$setNo z39
573 if {[lindex $profile($target) 10] == 1} {
574 z39.$setNo setName $setNo
575 puts "setName=${setNo}"
577 z39.$setNo setName Default
578 puts "setName=Default"
580 if {[lindex $profile($target) 8] == 1} {
581 z39.$setNo queryType rpn
583 if {[lindex $profile($target) 9] == 1} {
584 z39.$setNo queryType ccl
586 z39 callback {search-response}
587 z39.$setNo search $query
588 show-status {Search} 1 0
591 proc scan-request {attr} {
603 z39 callback [list scan-response $attr 0 25]
604 if {![winfo exists $w]} {
614 listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \
615 -font fixed -geometry 50x14
616 scrollbar $w.top.scroll -orient vertical -border 1
617 pack $w.top.list -side left -fill both -expand yes
618 pack $w.top.scroll -side right -fill y
619 $w.top.scroll config -command [list $w.top.list yview]
621 listbox $w.top.list -font fixed -geometry 60x14
622 pack $w.top.list -side left -fill both -expand yes
625 bottom-buttons $w [list {Close} [list destroy $w] \
626 {Up} [list scan-up $attr] \
627 {Down} [list scan-down $attr]] 0
628 bind $w.top.list <Up> [list scan-up $attr]
629 bind $w.top.list <Down> [list scan-down $attr]
632 z39.scan numberOfTermsRequested 5
633 z39.scan preferredPositionInResponse 1
634 z39.scan scan "${attr} b"
636 show-status {Scan} 1 0
640 proc scan-response {attr start toget} {
644 puts "In scan-response"
645 set m [z39.scan numberOfEntriesReturned]
651 if {![winfo exists .scan-window]} {
652 show-status {Ready} 0 1
657 for {set i 0} {$i < $m} {incr i} {
658 set term [lindex [z39.scan scanLine $i] 1]
659 set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]]
660 $w.top.list insert $i "$nostr $term"
663 $w.top.list delete $start end
664 for {set i 0} {$i < $m} {incr i} {
665 set term [lindex [z39.scan scanLine $i] 1]
666 set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]]
667 $w.top.list insert end "$nostr $term"
671 show-status {Ready} 0 1
675 if {$toget > 0 && $m > 1 && $m < $toget} {
676 set ntoget [expr $toget - $m + 1]
678 z39 callback [list scan-response $attr [expr $start + $m - 1] $ntoget]
680 puts "down continue: $q"
682 z39.scan numberOfTermsRequested 10
684 z39.scan numberOfTermsRequested $ntoget
686 z39.scan preferredPositionInResponse 1
687 z39.scan scan "${attr} \{$q\}"
690 if {$toget < 0 && $m > 1 && $m < [expr - $toget]} {
691 set ntoget [expr - $toget - $m]
693 z39 callback [list scan-response $attr 0 -$ntoget]
694 set q [string range [$w.top.list get 0] 7 end]
695 puts "up continue: $q"
697 z39.scan numberOfTermsRequested 10
698 z39.scan preferredPositionInResponse 11
700 z39.scan numberOfTermsRequested $ntoget
701 z39.scan preferredPositionInResponse [incr ntoget]
703 z39.scan scan "${attr} \{$q\}"
706 show-status {Ready} 0 1
709 proc scan-down {attr} {
713 set scanView [expr $scanView + 5]
714 set s [$w.top.list size]
715 if {$scanView > $s} {
716 z39 callback [list scan-response $attr [expr $s - 1] 30]
717 set q [string range [$w.top.list get [expr $s - 1]] 7 end]
719 z39.scan numberOfTermsRequested 10
720 z39.scan preferredPositionInResponse 1
721 show-status {Scan} 1 0
722 z39.scan scan "${attr} \{$q\}"
725 $w.top.list yview $scanView
728 proc scan-up {attr} {
733 z39 callback [list scan-response $attr 0 -30]
734 set q [string range [$w.top.list get 0] 7 end]
736 z39.scan numberOfTermsRequested 10
737 z39.scan preferredPositionInResponse 11
738 show-status {Scan} 1 0
739 z39.scan scan "${attr} \{$q\}"
742 set scanView [expr $scanView - 5]
743 $w.top.list yview $scanView
746 proc search-response {} {
753 puts "In search-response"
755 show-status {Ready} 0 1
756 show-message "[z39.$setNo resultCount] hits"
757 set setMax [z39.$setNo resultCount]
759 set status [z39.$setNo responseStatus]
760 if {[lindex $status 0] == "NSD"} {
761 set code [lindex $status 1]
762 set msg [lindex $status 2]
763 set addinfo [lindex $status 3]
764 tkerror "NSD$code: $msg: $addinfo"
776 z39 callback {present-response}
777 z39.$setNo present $setOffset 1
778 show-status {Retrieve} 1 0
781 proc present-more {number} {
786 puts "setOffset=$setOffset"
792 set max [z39.$setNo resultCount]
793 if {$max <= $setOffset} {
795 puts "setOffset=$setOffset"
802 if {$setMax > $max} {
806 z39 callback {present-response}
808 set toGet [expr $setMax - $setOffset + 1]
815 z39.$setNo present $setOffset $toGet
816 show-status {Retrieve} 1 0
819 proc init-title-lines {} {
820 .data.list delete 0 end
823 proc title-press {y setno} {
824 show-full-marc $setno [expr 1 + [.data.list nearest $y]] 0
827 proc add-title-lines {setno no offset} {
828 bind .data.list <Double-Button-1> [list title-press %y $setno]
829 for {set i 0} {$i < $no} {incr i} {
830 set o [expr $i + $offset]
831 set type [z39.$setno type $o]
833 set title [lindex [z39.$setno getMarc $o field 245 * a] 0]
834 set year [lindex [z39.$setno getMarc $o field 260 * c] 0]
835 set nostr [format "%5d" $o]
836 .data.list insert end "$nostr $title - $year"
837 } elseif {$type == "SD"} {
838 set err [lindex [z39.$setno diag $o] 1]
839 set add [lindex [z39.$setno diag $o] 2]
843 .data.list insert end "Error ${err}${add}"
844 } elseif {$type == ""} {
845 .data.list insert end "empty"
850 proc present-response {} {
856 puts "In present-response"
857 set no [z39.$setNo numberOfRecordsReturned]
858 puts "Returned $no records, setOffset $setOffset"
859 add-title-lines $setNo $no $setOffset
860 set setOffset [expr $setOffset + $no]
861 set status [z39.$setNo responseStatus]
862 if {[lindex $status 0] == "NSD"} {
863 show-status {Ready} 0 1
864 set code [lindex $status 1]
865 set msg [lindex $status 2]
866 set addinfo [lindex $status 3]
867 tkerror "NSD$code: $msg: $addinfo"
871 show-status {Ready} 0 1
875 if {$no > 0 && $setOffset <= $setMax} {
876 puts "present from ${setOffset}"
877 set toGet [expr $setMax - $setOffset + 1]
881 z39.$setNo present $setOffset $toGet
883 show-status {Finished} 0 1
887 proc left-cursor {w} {
888 set i [$w index insert]
895 proc right-cursor {w} {
896 set i [$w index insert]
901 proc bind-fields {list returnAction escapeAction} {
902 set max [expr [llength $list]-1]
903 for {set i 0} {$i < $max} {incr i} {
904 bind [lindex $list $i] <Return> $returnAction
905 bind [lindex $list $i] <Escape> $escapeAction
906 bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
907 bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
908 bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
910 bind [lindex $list $i] <Return> $returnAction
911 bind [lindex $list $i] <Escape> $escapeAction
912 bind [lindex $list $i] <Tab> [list focus [lindex $list 0]]
913 bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
914 bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
915 focus [lindex $list 0]
918 proc entry-fields {parent list tlist returnAction escapeAction} {
921 foreach field $list {
922 set label ${parent}.${field}.label
923 set entry ${parent}.${field}.entry
924 label $label -text [lindex $tlist $i] -anchor e
925 entry $entry -width 32 -relief sunken
926 pack $label -side left
927 pack $entry -side right
931 bind-fields $alist $returnAction $escapeAction
934 proc define-target-dialog {} {
942 -side top -anchor e -pady 2
943 entry-fields $w.top {target} \
945 {define-target-action} {destroy .target-define}
946 top-down-ok-cancel $w {define-target-action} 1
949 proc protocol-setup-action {target} {
952 global protocolRadioType
953 global settingsChanged
956 global ResultSetCheck
958 set w .setup-${target}.top
960 #set w .protocol-setup.top
963 set settingsChanged 1
964 set len [$w.databases.list size]
965 for {set i 0} {$i < $len} {incr i} {
966 lappend b [$w.databases.list get $i]
968 set profile($target) [list [$w.description.entry get] \
969 [$w.host.entry get] \
970 [$w.port.entry get] \
971 [$w.idAuthentication.entry get] \
972 [$w.maximumRecordSize.entry get] \
973 [$w.preferredMessageSize.entry get] \
982 puts $profile($target)
983 destroy .setup-${target}
986 proc place-force {window parent} {
987 set g [wm geometry $parent]
989 set p1 [string first + $g]
990 set p2 [string last + $g]
992 set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
993 set y [expr 60+[string range $g [expr $p2 +1] end]]
994 wm geometry $window +${x}+${y}
997 proc add-database-action {target} {
998 set w .setup-${target}
1000 ${w}.top.databases.list insert end \
1001 [.database-select.top.database.entry get]
1002 destroy .database-select
1005 proc add-database {target} {
1006 set w .database-select
1008 set oldFocus [focus]
1011 place-force $w .setup-${target}
1015 frame $w.top.database
1017 pack $w.top.database -side top -anchor e -pady 2
1019 entry-fields $w.top {database} \
1020 {{Database to add:}} \
1021 [list add-database-action $target] {destroy .database-select}
1023 top-down-ok-cancel $w [list add-database-action $target] 1
1027 proc delete-database {target} {
1028 set w .setup-${target}
1030 foreach i [lsort -decreasing \
1031 [$w.top.databases.list curselection]] {
1032 $w.top.databases.list delete $i
1036 proc protocol-setup {target} {
1037 set w .setup-$target
1041 global protocolRadioType
1044 global ResultSetCheck
1048 wm title $w "Setup $target"
1053 if {$target == ""} {
1057 puts $profile($target)
1061 frame $w.top.description
1062 frame $w.top.idAuthentication
1063 frame $w.top.maximumRecordSize
1064 frame $w.top.preferredMessageSize
1065 frame $w.top.cs-type -relief ridge -border 2
1066 frame $w.top.protocol -relief ridge -border 2
1067 frame $w.top.query -relief ridge -border 2
1068 frame $w.top.databases -relief ridge -border 2
1070 # Maximum/preferred/idAuth ...
1071 pack $w.top.description $w.top.host $w.top.port \
1072 $w.top.idAuthentication $w.top.maximumRecordSize \
1073 $w.top.preferredMessageSize -side top -anchor e -pady 2
1075 entry-fields $w.top {description host port idAuthentication \
1076 maximumRecordSize preferredMessageSize} \
1077 {{Description:} {Host:} {Port:} {Id Authentication:} \
1078 {Maximum Record Size:} {Preferred Message Size:}} \
1079 [list protocol-setup-action $target] [list destroy $w]
1081 foreach sub {description host port idAuthentication \
1082 maximumRecordSize preferredMessageSize} {
1084 bind $w.top.$sub.entry <Control-a> "add-database $target"
1085 bind $w.top.$sub.entry <Control-d> "delete-database $target"
1087 $w.top.description.entry insert 0 [lindex $profile($target) 0]
1088 $w.top.host.entry insert 0 [lindex $profile($target) 1]
1089 $w.top.port.entry insert 0 [lindex $profile($target) 2]
1090 $w.top.idAuthentication.entry insert 0 [lindex $profile($target) 3]
1091 $w.top.maximumRecordSize.entry insert 0 [lindex $profile($target) 4]
1092 $w.top.preferredMessageSize.entry insert 0 [lindex $profile($target) 5]
1093 set csRadioType [lindex $profile($target) 6]
1094 set RPNCheck [lindex $profile($target) 8]
1095 set CCLCheck [lindex $profile($target) 9]
1096 set ResultSetCheck [lindex $profile($target) 10]
1097 set protocolRadioType [lindex $profile($target) 11]
1098 if {$protocolRadioType == ""} {
1099 set protocolRadioType z39v2
1103 pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill both
1105 label $w.top.databases.label -text "Databases"
1106 button $w.top.databases.add -text "Add" \
1107 -command "add-database $target"
1108 button $w.top.databases.delete -text "Delete" \
1109 -command "delete-database $target"
1110 listbox $w.top.databases.list -geometry 20x6 \
1111 -yscrollcommand "$w.top.databases.scroll set"
1112 scrollbar $w.top.databases.scroll -orient vertical -border 1
1113 pack $w.top.databases.label -side top -fill x \
1115 pack $w.top.databases.add $w.top.databases.delete -side top -fill x \
1117 pack $w.top.databases.list -side left -fill both -expand yes \
1119 pack $w.top.databases.scroll -side right -fill y \
1121 $w.top.databases.scroll config -command "$w.top.databases.list yview"
1123 foreach b [lindex $profile($target) 7] {
1124 $w.top.databases.list insert end $b
1128 pack $w.top.cs-type -pady 6 -padx 6 -side top -fill x
1130 label $w.top.cs-type.label -text "Transport"
1131 radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \
1132 -command {puts tcp/ip} -variable csRadioType -value tcpip
1133 radiobutton $w.top.cs-type.mosi -text "MOSI" -anchor w\
1134 -command {puts mosi} -variable csRadioType -value mosi
1136 pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
1137 -padx 4 -side top -fill x
1140 pack $w.top.protocol -pady 6 -padx 6 -side top -fill x
1142 label $w.top.protocol.label -text "Protocol"
1143 radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \
1144 -command {puts z39v2} -variable protocolRadioType -value z39v2
1145 radiobutton $w.top.protocol.sr -text "SR" -anchor w \
1146 -command {puts sr} -variable protocolRadioType -value sr
1148 pack $w.top.protocol.label $w.top.protocol.z39v2 $w.top.protocol.sr \
1149 -padx 4 -side top -fill x
1152 pack $w.top.query -pady 6 -padx 6 -side top -fill x
1154 label $w.top.query.label -text "Query support"
1155 checkbutton $w.top.query.c1 -text "RPN query" -anchor w -variable RPNCheck
1156 checkbutton $w.top.query.c2 -text "CCL query" -anchor w -variable CCLCheck
1157 checkbutton $w.top.query.c3 -text "Result sets" -anchor w -variable ResultSetCheck
1159 pack $w.top.query.label -side top
1160 pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
1161 -padx 4 -side top -fill x
1164 top-down-ok-cancel $w [list protocol-setup-action $target] 0
1167 proc database-select-action {} {
1168 set w .database-select.top
1170 foreach indx [$w.databases.list curselection] {
1171 lappend b [$w.databases.list get $indx]
1174 z39 databaseNames $b
1176 destroy .database-select
1179 proc database-select {} {
1180 set w .database-select
1190 frame $w.top.databases -relief ridge -border 2
1192 pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
1194 label $w.top.databases.label -text "List"
1195 listbox $w.top.databases.list -geometry 20x6 \
1196 -yscrollcommand "$w.top.databases.scroll set"
1197 scrollbar $w.top.databases.scroll -orient vertical -border 1
1198 pack $w.top.databases.label -side top -fill x \
1200 pack $w.top.databases.list -side left -fill both -expand yes \
1202 pack $w.top.databases.scroll -side right -fill y \
1204 $w.top.databases.scroll config -command "$w.top.databases.list yview"
1206 foreach b [lindex $profile($hostid) 7] {
1207 $w.top.databases.list insert end $b
1209 top-down-ok-cancel $w {database-select-action} 1
1212 proc cascade-target-list {} {
1215 foreach sub [winfo children .top.target.m.clist] {
1216 puts "deleting $sub"
1219 .top.target.m.clist delete 0 last
1220 foreach n [array names profile] {
1221 if {$n != "Default"} {
1222 set nl [string tolower $n]
1223 if {[llength [lindex $profile($n) 7]] > 1} {
1224 .top.target.m.clist add cascade -label $n \
1225 -menu .top.target.m.clist.$nl
1226 menu .top.target.m.clist.$nl
1227 foreach b [lindex $profile($n) 7] {
1228 .top.target.m.clist.$nl add command -label $b \
1229 -command "reopen-target $n $b"
1232 .top.target.m.clist add command -label $n \
1233 -command "reopen-target $n {}"
1237 .top.target.m.slist delete 0 last
1238 foreach n [array names profile] {
1239 if {$n != "Default"} {
1240 .top.target.m.slist add command -label $n \
1241 -command "protocol-setup $n"
1246 proc cascade-query-list {} {
1250 .top.query.m.slist delete 0 last
1251 foreach n $queryTypes {
1252 .top.query.m.slist add command -label $n \
1253 -command [list query-setup $i]
1258 .top.query.m.clist delete 0 last
1259 foreach n $queryTypes {
1260 .top.query.m.clist add command -label $n \
1261 -command [list query-select $i]
1266 proc save-settings {} {
1269 global settingsChanged
1274 set f [open "clientrc.tcl" w]
1275 puts $f "# Setup file"
1276 puts $f "set hotTargets \{ $hotTargets \}"
1278 foreach n [array names profile] {
1279 puts -nonewline $f "set profile($n) \{"
1280 puts -nonewline $f $profile($n)
1283 puts -nonewline $f "set queryTypes \{"
1284 puts -nonewline $f $queryTypes
1287 puts -nonewline $f "set queryButtons \{"
1288 puts -nonewline $f $queryButtons
1291 puts -nonewline $f "set queryInfo \{"
1292 puts -nonewline $f $queryInfo
1296 set settingsChanged 0
1308 message $w.top.message -text $ask
1310 pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
1313 top-down-ok-cancel $w {alert-action} 1
1317 proc alert-action {} {
1323 proc exit-action {} {
1324 global settingsChanged
1326 if {$settingsChanged} {
1327 set a [alert "you havent saved your settings. Do you wish to save?"]
1335 proc listbuttonaction {w name h user i} {
1336 $w configure -text [lindex $name 0]
1337 $h [lindex $name 1] $user $i
1340 proc listbuttonx {button no names handle user} {
1341 if {[winfo exists $button]} {
1342 $button configure -text [lindex [lindex $names $no] 0]
1343 ${button}.m delete 0 last
1345 menubutton $button -text [lindex [lindex $names $no] 0] \
1346 -width 10 -menu ${button}.m -relief raised -border 1
1350 foreach name $names {
1351 ${button}.m add command -label [lindex $name 0] \
1352 -command [list listbuttonaction ${button} $name \
1358 proc listbutton {button no names} {
1359 menubutton $button -text [lindex $names $no] -width 10 -menu ${button}.m \
1360 -relief raised -border 1
1362 foreach name $names {
1363 ${button}.m add command -label $name \
1364 -command [list ${button} configure -text $name]
1368 proc query-add-index-action {queryNo} {
1369 set w .setup-query-$queryNo
1372 global queryButtonsTmp
1374 lappend queryInfoTmp [list [.query-add-index.top.index.entry get] {}]
1376 destroy .query-add-index
1377 #destroy $w.top.lines
1378 #frame $w.top.lines -relief ridge -border 2
1379 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1380 #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1383 proc query-add-line {queryNo} {
1384 set w .setup-query-$queryNo
1387 global queryButtonsTmp
1389 lappend queryButtonsTmp {I 0}
1391 #destroy $w.top.lines
1392 #frame $w.top.lines -relief ridge -border 2
1393 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1394 #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1397 proc query-del-line {queryNo} {
1398 set w .setup-query-$queryNo
1401 global queryButtonsTmp
1403 set l [llength $queryButtonsTmp]
1408 set queryButtonsTmp [lreplace $queryButtonsTmp $l $l]
1409 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1412 proc query-add-index {queryNo} {
1413 set w .query-add-index
1416 place-force $w .setup-query-$queryNo
1420 -side top -anchor e -pady 2
1421 entry-fields $w.top {index} \
1423 [list query-add-index-action $queryNo] {destroy .query-add-index}
1424 top-down-ok-cancel $w [list query-add-index-action $queryNo] 1
1427 proc query-setup-action {queryNo} {
1430 global queryButtonsTmp
1432 global queryButtonsFind
1433 global queryInfoFind
1435 set queryInfo [lreplace $queryInfo $queryNo $queryNo \
1437 set queryButtons [lreplace $queryButtons $queryNo $queryNo \
1439 set queryInfoFind $queryInfoTmp
1440 set queryButtonsFind $queryButtonsTmp
1444 destroy .setup-query-$queryNo
1446 index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
1449 proc activate-e-index {value no i} {
1450 global queryButtonsTmp
1452 puts $queryButtonsTmp
1453 set queryButtonsTmp [lreplace $queryButtonsTmp $no $no [list I $i]]
1454 puts $queryButtonsTmp
1460 proc activate-index {value no i} {
1461 global queryButtonsFind
1463 set queryButtonsFind [lreplace $queryButtonsFind $no $no [list I $i]]
1465 puts "queryButtonsFind $queryButtonsFind"
1471 proc query-setup {queryNo} {
1472 set w .setup-query-$queryNo
1474 set queryTypes {Simple}
1477 global queryButtonsTmp
1480 set queryName [lindex $queryTypes $queryNo]
1481 set queryInfoTmp [lindex $queryInfo $queryNo]
1482 set queryButtonsTmp [lindex $queryButtons $queryNo]
1484 #set queryButtons { {I 0 I 1 I 2} }
1485 #set queryInfo { { {Title ti} {Author au} {Subject sh} } }
1489 wm title $w "Query setup $queryName"
1494 frame $w.top.lines -relief ridge -border 2
1495 frame $w.top.use -relief ridge -border 2
1496 frame $w.top.relation -relief ridge -border 2
1497 frame $w.top.position -relief ridge -border 2
1498 frame $w.top.structure -relief ridge -border 2
1499 frame $w.top.truncation -relief ridge -border 2
1500 frame $w.top.completeness -relief ridge -border 2
1504 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1506 pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1509 pack $w.top.use -side left -pady 6 -padx 6 -fill y
1511 label $w.top.use.label -text "Use"
1512 listbox $w.top.use.list -geometry 20x10 \
1513 -yscrollcommand "$w.top.use.scroll set"
1514 scrollbar $w.top.use.scroll -orient vertical -border 1
1515 pack $w.top.use.label -side top -fill x \
1517 pack $w.top.use.list -side left -fill both -expand yes \
1519 pack $w.top.use.scroll -side right -fill y \
1521 $w.top.use.scroll config -command "$w.top.use.list yview"
1523 foreach u {{Personal name} {Corporate name}} {
1524 $w.top.use.list insert end $u
1526 # Relation Attributes
1527 pack $w.top.relation -pady 6 -padx 6 -side top
1529 label $w.top.relation.label -text "Relation" -width 18
1531 listbutton $w.top.relation.b 0\
1532 {{None} {Less than} {Greater than or equal} \
1533 {Equal} {Greater than or equal} {Greater than} {Not equal} \
1535 {Stem} {Relevance} {AlwaysMatches}}
1537 pack $w.top.relation.label $w.top.relation.b -fill x
1539 # Position Attributes
1540 pack $w.top.position -pady 6 -padx 6 -side top
1542 label $w.top.position.label -text "Position" -width 18
1544 listbutton $w.top.position.b 0 {{None} {First in field} {First in subfield}
1545 {Any position in field}}
1547 pack $w.top.position.label $w.top.position.b -fill x
1549 # Structure Attributes
1551 pack $w.top.structure -pady 6 -padx 6 -side top
1553 label $w.top.structure.label -text "Structure" -width 18
1555 listbutton $w.top.structure.b 0 {{None} {Phrase} {Word} {Key} {Year}
1556 {Date (norm)} {Word list} {Date (un-norm)} {Name (norm)} {Date (un-norm)}
1557 {Structure} {urx} {free-form} {doc-text} {local-number} {string}
1560 pack $w.top.structure.label $w.top.structure.b -fill x
1562 # Truncation Attributes
1564 pack $w.top.truncation -pady 6 -padx 6 -side top
1566 label $w.top.truncation.label -text "Truncation" -width 18
1568 listbutton $w.top.truncation.b 0 {{Auto} {Right} {Left} {Left and right} \
1569 {No truncation} {Process #} {Re-1} {Re-2}}
1570 pack $w.top.truncation.label $w.top.truncation.b -fill x
1572 # Completeness Attributes
1574 pack $w.top.completeness -pady 6 -padx 6 -side top
1576 label $w.top.completeness.label -text "Truncation" -width 18
1578 listbutton $w.top.completeness.b 0 {{None} {Incomplete subfield} \
1579 {Complete subfield} {Complete field}}
1580 pack $w.top.completeness.label $w.top.completeness.b -fill x
1583 bottom-buttons $w [list \
1584 {Ok} [list query-setup-action $queryNo] \
1585 {Add index} [list query-add-index $queryNo] \
1586 {Add line} [list query-add-line $queryNo] \
1587 {Delete line} [list query-del-line $queryNo] \
1588 {Cancel} [list destroy $w]] 0
1591 proc index-clear {} {
1592 global queryButtonsFind
1595 foreach b $queryButtonsFind {
1596 .lines.$i.e delete 0 end
1601 proc index-query {} {
1602 global queryButtonsFind
1603 global queryInfoFind
1608 foreach b $queryButtonsFind {
1609 set term [string trim [.lines.$i.e get]]
1611 set attr [lindex [lindex $queryInfoFind [lindex $b 1]] 1]
1613 set term "\{${term}\}"
1615 set term "@attr $a ${term}"
1618 set qs "@and ${qs} ${term}"
1629 proc index-lines {w realOp buttonInfo queryInfo handle} {
1631 foreach b $buttonInfo {
1632 if {! [winfo exists $w.$i]} {
1633 frame $w.$i -background white -border 1
1635 listbuttonx $w.$i.l [lindex $b 1] $queryInfo $handle $i
1638 if {! [winfo exists $w.$i.e]} {
1639 entry $w.$i.e -width 32 -relief sunken -border 1
1640 bind $w.$i.e <FocusIn> [list $w.$i configure \
1642 bind $w.$i.e <FocusOut> [list $w.$i configure \
1644 pack $w.$i.l -side left
1645 pack $w.$i.e -side left -fill x -expand yes
1646 pack $w.$i -side top -fill x -padx 2 -pady 2
1647 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
1648 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
1649 bind $w.$i.e <Return> search-request
1652 pack $w.$i.l -side left
1653 pack $w.$i -side top -fill x -padx 2 -pady 2
1658 while {[winfo exists $w.$j]} {
1669 bind $w.$j.e <Tab> "focus $w.$k.e"
1673 bind $w.$i.e <Tab> "focus $w.0.e"
1678 proc search-fields {w buttondefs} {
1680 foreach buttondef $buttondefs {
1681 frame $w.$i -background white
1683 listbutton $w.$i.l 0 $buttondef
1684 entry $w.$i.e -width 32 -relief sunken
1686 pack $w.$i.l -side left
1687 pack $w.$i.e -side left -fill x -expand yes
1689 pack $w.$i -side top -fill x -padx 2 -pady 2
1691 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
1692 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
1700 bind $w.$j.e <Tab> "focus $w.$k.e \n
1701 $w.$k configure -background red \n
1702 $w.$j configure -background white"
1705 bind $w.$i.e <Tab> "focus $w.0.e \n
1706 $w.0 configure -background red \n
1707 $w.$i configure -background white"
1709 $w.0 configure -background red
1712 frame .top -border 1 -relief raised
1713 frame .lines -border 1 -relief raised
1714 frame .mid -border 1 -relief raised
1715 frame .data -border 1 -relief raised
1716 frame .bot -border 1 -relief raised
1717 pack .top .lines .mid -side top -fill x
1718 pack .data -side top -fill both -expand yes
1721 menubutton .top.file -text "File" -underline 0 -menu .top.file.m
1723 .top.file.m add command -label "Save settings" -command {save-settings}
1724 .top.file.m add command -label "Load Set" -command {load-set}
1725 .top.file.m add separator
1726 .top.file.m add command -label "Exit" -command {exit-action}
1727 .top.file.m add separator
1728 .top.file.m add command -label "About" -command {about-origin}
1730 menubutton .top.target -text "Target" -underline 0 -menu .top.target.m
1732 .top.target.m add cascade -label "Connect" -menu .top.target.m.clist
1733 .top.target.m add command -label "Disconnect" -command {close-target}
1734 .top.target.m add command -label "About" -command {about-target}
1735 .top.target.m add cascade -label "Setup" -menu .top.target.m.slist
1736 .top.target.m add command -label "Setup new" -command {define-target-dialog}
1737 .top.target.m add separator
1740 .top.target.m disable 1
1741 .top.target.m disable 2
1743 menu .top.target.m.clist
1744 menu .top.target.m.slist
1747 menubutton .top.service -text "Service" -underline 0 -menu .top.service.m
1749 .top.service.m add command -label "Database" -command {database-select}
1750 .top.service.m add cascade -label "Query type" -menu .top.service.m.querytype
1751 menu .top.service.m.querytype
1752 .top.service.m.querytype add radiobutton -label "RPN"
1753 .top.service.m.querytype add radiobutton -label "CCL"
1754 .top.service.m add cascade -label "Present" -menu .top.service.m.present
1755 menu .top.service.m.present
1756 .top.service.m.present add command -label "More" \
1757 -command [list present-more 10]
1758 .top.service.m.present add command -label "All" \
1759 -command [list present-more {}]
1760 .top.service configure -state disabled
1762 menubutton .top.rset -text "Set" -menu .top.rset.m
1764 .top.rset.m add cascade -label "Select" -menu .top.rset.m.list
1765 .top.rset.m add command -label "Load" -command {load-set}
1766 menu .top.rset.m.list
1768 menubutton .top.query -text "Query" -underline 0 -menu .top.query.m
1770 .top.query.m add cascade -label "Choose" -menu .top.query.m.clist
1771 .top.query.m add command -label "Define" -command {new-query-dialog}
1772 .top.query.m add cascade -label "Edit" -menu .top.query.m.slist
1773 menu .top.query.m.clist
1774 menu .top.query.m.slist
1777 menubutton .top.help -text "Help" -menu .top.help.m
1780 .top.help.m add command -label "Help on help" \
1781 -command {tkerror "Help on help not available. Sorry"}
1782 .top.help.m add command -label "About" \
1783 -command {tkerror "About not available. Sorry"}
1785 pack .top.file .top.target .top.rset .top.query .top.service -side left
1786 pack .top.help -side right
1788 index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
1790 button .mid.search -width 7 -text {Search} -command search-request \
1792 button .mid.scan -width 7 -text {Scan} \
1793 -command [list scan-request "@attr 1=4"] -state disabled
1794 button .mid.present -width 7 -text {Present} -command [list present-more 10] \
1797 button .mid.clear -width 7 -text {Clear} -command index-clear
1798 pack .mid.search .mid.scan .mid.present .mid.clear -side left \
1799 -fill y -padx 5 -pady 3
1801 listbox .data.list -yscrollcommand {.data.scroll set} -font fixed -geometry 20x2
1802 scrollbar .data.scroll -orient vertical -border 1
1803 pack .data.list -side left -fill both -expand yes
1804 pack .data.scroll -side right -fill y
1805 .data.scroll config -command {.data.list yview}
1807 button .bot.logo -bitmap @book1 -command cancel-operation
1809 pack .bot.a -side left -fill x
1810 pack .bot.logo -side right -padx 2 -pady 2
1812 message .bot.a.target -text "" -aspect 1000 -border 1
1814 label .bot.a.status -text "Not connected" -width 15 -relief \
1815 sunken -anchor w -border 1
1816 label .bot.a.set -textvariable setNo -width 5 -relief \
1817 sunken -anchor w -border 1
1818 label .bot.a.message -text "" -width 15 -relief \
1819 sunken -anchor w -border 1
1821 pack .bot.a.target -side top -anchor nw -padx 2 -pady 2
1822 pack .bot.a.status .bot.a.set .bot.a.message \
1823 -side left -padx 2 -pady 2