3 # Revision 1.26 1995-06-01 16:36:46 adam
4 # About buttons. Minor bug fixes.
6 # Revision 1.25 1995/05/31 13:09:57 adam
7 # Client searches/presents may be interrupted.
8 # New moving book-logo.
10 # Revision 1.24 1995/05/31 08:36:24 adam
11 # Bug fix in client.tcl: didn't save options on clientrc.tcl.
12 # New method: referenceId. More work on scan.
14 # Revision 1.23 1995/05/29 10:33:41 adam
15 # README and rename of startup script.
17 # Revision 1.22 1995/05/26 11:44:09 adam
18 # Bugs fixed. More work on MARC utilities and queries. Test
19 # client is up-to-date again.
21 # Revision 1.21 1995/05/11 15:34:46 adam
22 # Scan request changed a bit. This version works with RLG.
24 # Revision 1.20 1995/04/21 16:31:57 adam
25 # New radiobutton: protocol (z39v2/SR).
27 # Revision 1.19 1995/04/18 16:11:50 adam
28 # First version of graphical Scan. Some work on query-by-form.
30 # Revision 1.18 1995/04/10 10:50:22 adam
31 # Result-set name defaults to suffix of ir-set name.
32 # Started working on scan. Not finished at this point.
34 # Revision 1.17 1995/03/31 09:34:57 adam
35 # Search-button disabled when there is no connection.
37 # Revision 1.16 1995/03/31 08:56:36 adam
38 # New button "Search".
40 # Revision 1.15 1995/03/28 12:45:22 adam
41 # New ir method failback: called on disconnect/protocol error.
42 # New ir set/get method: protocol: SR / Z3950.
43 # Simple popup and disconnect when failback is invoked.
45 # Revision 1.14 1995/03/22 16:07:55 adam
48 # Revision 1.13 1995/03/21 17:27:26 adam
49 # Short-hand keys in setup.
51 # Revision 1.12 1995/03/21 13:41:03 adam
52 # Comstack cs_create not used too often. Non-blocking connect.
54 # Revision 1.11 1995/03/21 10:39:06 adam
55 # Diagnostic error message displayed with tkerror.
57 # Revision 1.10 1995/03/20 15:24:06 adam
58 # Diagnostic records saved on searchResponse.
60 # Revision 1.9 1995/03/17 18:26:16 adam
61 # Non-blocking i/o used now. Database names popup as cascade items.
63 # Revision 1.8 1995/03/17 15:45:00 adam
64 # Improved target/database setup.
66 # Revision 1.7 1995/03/16 17:54:03 adam
67 # Minor changes really.
69 # Revision 1.6 1995/03/15 19:10:20 adam
70 # Database setup in protocol-setup (rather target setup).
72 # Revision 1.5 1995/03/15 13:59:23 adam
75 # Revision 1.4 1995/03/14 17:32:29 adam
76 # Presentation of full Marc record in popup window.
78 # Revision 1.3 1995/03/12 19:31:52 adam
79 # Pattern matching implemented when retrieving MARC records. More
80 # diagnostic functions.
82 # Revision 1.2 1995/03/10 18:00:15 adam
83 # Actual presentation in line-by-line format. RPN query support.
85 # Revision 1.1 1995/03/09 16:15:07 adam
86 # First presentRequest attempts. Hot-target list.
93 set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} z39v2}
101 set queryTypes {Simple}
102 set queryButtons { { {I 0} {I 1} {I 2} } }
103 set queryInfo { { {Title {1=4}} {Author {1=1}} \
104 {Subject {1=21}} {Any {1=1016}} } }
108 if {[file readable "clientrc.tcl"]} {
109 source "clientrc.tcl"
112 set queryButtonsFind [lindex $queryButtons 0]
113 set queryInfoFind [lindex $queryInfo 0]
115 proc top-down-window {w} {
116 frame $w.top -relief raised -border 1
117 frame $w.bot -relief raised -border 1
119 pack $w.top -side top -fill both -expand yes
120 pack $w.bot -fill both
123 proc top-down-ok-cancel {w ok-action g} {
124 frame $w.bot.left -relief sunken -border 1
125 pack $w.bot.left -side left -expand yes -ipadx 2 -ipady 2 -padx 5 -pady 5
126 button $w.bot.left.ok -width 6 -text {Ok} \
127 -command ${ok-action}
128 pack $w.bot.left.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3
129 button $w.bot.cancel -width 6 -text {Cancel} \
130 -command "destroy $w"
131 pack $w.bot.cancel -side left -expand yes
139 proc bottom-buttons {w buttonList g} {
141 set l [llength $buttonList]
143 frame $w.bot.$i -relief sunken -border 1
144 pack $w.bot.$i -side left -expand yes -padx 5 -pady 5
145 button $w.bot.$i.ok -text [lindex $buttonList $i] \
146 -command [lindex $buttonList [expr $i+1]]
147 pack $w.bot.$i.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
151 button $w.bot.$i -text [lindex $buttonList $i] \
152 -command [lindex $buttonList [expr $i+1]]
153 pack $w.bot.$i -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
163 proc cancel-operation {} {
169 show-status Cancelled 0 {}
173 proc show-target {target} {
174 .bot.a.target configure -text "$target"
177 proc show-logo {v1} {
184 .bot.logo configure -bitmap @book${v1}
185 after 140 [list show-logo $v1]
189 .bot.logo configure -bitmap @book1
198 proc show-status {status b sb} {
202 .bot.a.status configure -text "$status"
204 if {$busy == 0} {set busy 1}
212 .top.search configure -state normal
213 .mid.search configure -state normal
214 .mid.scan configure -state normal
215 .mid.present configure -state normal
218 .top.search configure -state disabled
219 .mid.search configure -state disabled
220 .mid.scan configure -state disabled
221 .mid.present configure -state disabled
226 proc show-message {msg} {
227 .bot.a.message configure -text "$msg"
230 proc insertWithTags {w text args} {
231 set start [$w index insert]
232 $w insert insert $text
233 foreach tag [$w tag names $start] {
234 $w tag remove $tag $start insert
237 $w tag add $i $start insert
241 proc about-target {} {
242 set w .about-target-w
246 wm title $w "About target"
250 set i [z39 targetImplementationName]
251 label $w.top.in -text "Implementation name: $i"
252 set i [z39 targetImplementationId]
253 label $w.top.ii -text "Implementation id: $i"
254 set i [z39 targetImplementationVersion]
255 label $w.top.iv -text "Implementation version: $i"
257 pack $w.top.in $w.top.ii $w.top.iv -side top -anchor nw
259 bottom-buttons $w [list {Close} [list destroy $w]] 1
262 proc about-origin {} {
263 set w .about-origin-w
267 wm title $w "About IrTcl"
271 set i [z39 implementationName]
272 label $w.top.in -text "Implementation name: $i"
273 set i [z39 implementationId]
274 label $w.top.ii -text "Implementation id: $i"
276 pack $w.top.in $w.top.ii -side top -anchor nw
278 bottom-buttons $w [list {Close} [list destroy $w]] 1
281 proc show-full-marc {no b} {
285 if {[z39.$setNo type $no] != "DB"} {
289 set w .full-marc-$fullMarcSeq
294 if {[winfo exists $w]} {
295 $w.top.record delete 0.0 end
303 frame $w.top -relief raised -border 1
304 frame $w.bot -relief raised -border 1
306 pack $w.top -side top -fill both -expand yes
307 pack $w.bot -fill both
309 text $w.top.record -width 60 -height 12 -wrap word \
310 -yscrollcommand [list $w.top.s set]
311 scrollbar $w.top.s -command [list $w.top.record yview]
315 set r [z39.$setNo getMarc $no list * * *]
317 $w.top.record tag configure marc-tag -foreground blue
318 $w.top.record tag configure marc-data -foreground black
319 $w.top.record tag configure marc-id -foreground red
322 set tag [lindex $line 0]
323 set indicator [lindex $line 1]
324 set fields [lindex $line 2]
326 if {$indicator != ""} {
327 insertWithTags $w.top.record "$tag $indicator" marc-tag
329 insertWithTags $w.top.record "$tag " marc-tag
331 foreach field $fields {
332 set id [lindex $field 0]
333 set data [lindex $field 1]
335 insertWithTags $w.top.record " $id " marc-id
337 set start [$w.top.record index insert]
338 insertWithTags $w.top.record $data {}
340 $w.top.record insert end "\n"
343 bind $w <Return> {destroy .full-marc}
345 pack $w.top.s -side right -fill y
346 pack $w.top.record -expand yes -fill both
348 bottom-buttons $w [list \
349 {Close} [list destroy $w] \
350 {Duplicate} [list show-full-marc $no 1]] 0
354 proc update-target-hotlist {target} {
357 set len [llength $hotTargets]
359 .top.target.m delete 6 [expr 6+[llength $hotTargets]]
361 set indx [lsearch $hotTargets $target]
363 set hotTargets [lreplace $hotTargets $indx $indx]
365 set hotTargets [linsert $hotTargets 0 $target]
369 proc set-target-hotlist {} {
373 foreach target $hotTargets {
374 .top.target.m add command -label "$i $target" -command \
375 "reopen-target $target {}"
383 proc reopen-target {target base} {
385 open-target $target $base
386 update-target-hotlist $target
389 proc define-target-action {} {
392 set target [.target-define.top.target.entry get]
396 update-target-hotlist $target
397 foreach n [array names profile] {
403 set profile($target) $profile(Default)
404 protocol-setup $target
405 destroy .target-define
408 proc fail-response {target} {
410 tkerror "Target connection closed or protocol error"
413 proc connect-response {target} {
414 puts "connect-response"
419 proc open-target {target base} {
424 z39 comstack [lindex $profile($target) 6]
425 z39 idAuthentication [lindex $profile($target) 3]
426 z39 maximumRecordSize [lindex $profile($target) 4]
427 z39 preferredMessageSize [lindex $profile($target) 5]
428 puts -nonewline "maximumRecordSize="
429 puts [z39 maximumRecordSize]
430 puts -nonewline "preferredMessageSize="
431 puts [z39 preferredMessageSize]
433 z39 databaseNames [lindex [lindex $profile($target) 7] 0]
435 z39 databaseNames $base
437 z39 failback [list fail-response $target]
438 z39 callback [list connect-response $target]
439 z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
440 show-status {Connecting} 1 0
442 .top.target.m disable 0
443 .top.target.m enable 1
444 .top.target.m enable 2
447 proc close-target {} {
455 show-status {Not connected} 0 0
457 .top.target.m disable 1
458 .top.target.m disable 2
459 .top.target.m enable 0
462 proc load-set-action {} {
466 ir-set z39.$setNo z39
468 set fname [.load-set.top.filename.entry get]
473 show-status {Loading} 1 {}
474 z39.$setNo loadFile $fname
476 set no [z39.$setNo numberOfRecordsReturned]
477 add-title-lines $setNo $no 1
479 show-status {Ready} 0 {}
492 frame $w.top.filename
494 pack $w.top.filename -side top -anchor e -pady 2
496 entry-fields $w.top {filename} \
498 {load-set-action} {destroy .load-set}
500 top-down-ok-cancel $w {load-set-action} 1
504 proc init-request {} {
512 z39 callback {init-response}
513 show-status {Initializing} 1 {}
517 proc init-response {} {
524 show-status {Ready} 0 1
525 if {![z39 initResult]} {
526 set u [z39 userInformationField]
528 tkerror "Connection rejected by target: $u"
532 proc search-request {} {
542 if {$searchEnable == 0} {
545 set query [index-query]
550 ir-set z39.$setNo z39
552 if {[lindex $profile($target) 10] == 1} {
553 z39.$setNo setName $setNo
554 puts "setName=${setNo}"
556 z39.$setNo setName Default
557 puts "setName=Default"
559 if {[lindex $profile($target) 8] == 1} {
560 z39.$setNo queryType rpn
562 if {[lindex $profile($target) 9] == 1} {
563 z39.$setNo queryType ccl
565 z39 callback {search-response}
566 z39.$setNo search $query
567 show-status {Search} 1 0
570 proc scan-request {} {
580 z39 callback {scan-response}
581 if {![winfo exists $w]} {
586 wm minsize $w 200 200
590 listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \
591 -font fixed -geometry 50x14
592 scrollbar $w.top.scroll -orient vertical -border 1
593 pack $w.top.list -side left -fill both -expand yes
594 pack $w.top.scroll -side right -fill y
595 $w.top.scroll config -command [list $w.top.list yview]
597 bottom-buttons $w [list {Close} [list destroy $w]] 0
599 z39.scan numberOfTermsRequested 100
600 z39.scan scan "@attr 1=4 0"
602 show-status {Scan} 1 0
605 proc scan-response {} {
607 set m [z39.scan numberOfEntriesReturned]
609 for {set i 0} {$i < $m} {incr i} {
610 set term [lindex [z39.scan scanLine $i] 1]
611 set nostr [format "%7d" [lindex [z39.scan scanLine $i] 2]]
613 $w.top.list insert end "$nostr $term"
615 show-status {Ready} 0 1
618 proc search-response {} {
625 puts "In search-response"
627 show-status {Ready} 0 1
628 show-message "[z39.$setNo resultCount] hits"
629 set setMax [z39.$setNo resultCount]
631 set status [z39.$setNo responseStatus]
632 if {[lindex $status 0] == "NSD"} {
633 set code [lindex $status 1]
634 set msg [lindex $status 2]
635 set addinfo [lindex $status 3]
636 tkerror "NSD$code: $msg: $addinfo"
648 z39 callback {present-response}
649 z39.$setNo present $setOffset 1
650 show-status {Retrieve} 1 0
653 proc present-more {number} {
662 set max [z39.$setNo resultCount]
663 if {$max <= $setMax} {
671 z39 callback {present-response}
673 set toGet [expr $setMax - $setOffset + 1]
677 z39.$setNo present $setOffset $toGet
678 show-status {Retrieve} 1 0
681 proc init-title-lines {} {
682 .data.list delete 0 end
685 proc add-title-lines {setno no offset} {
686 for {set i 0} {$i < $no} {incr i} {
687 set o [expr $i + $offset]
688 set type [z39.$setno type $o]
690 set title [lindex [z39.$setno getMarc $o field 245 * a] 0]
691 set year [lindex [z39.$setno getMarc $o field 260 * c] 0]
692 set nostr [format "%5d" $o]
693 .data.list insert end "$nostr $title - $year"
694 } elseif {$type == "SD"} {
695 set err [lindex [z39.$setno diag $o] 1]
696 set add [lindex [z39.$setno diag $o] 2]
700 .data.list insert end "Error ${err}${add}"
701 } elseif {$type == ""} {
702 .data.list insert end "empty"
707 proc present-response {} {
713 puts "In present-response"
714 set no [z39.$setNo numberOfRecordsReturned]
715 puts "Returned $no records, setOffset $setOffset"
716 add-title-lines $setNo $no $setOffset
717 set setOffset [expr $setOffset + $no]
718 set status [z39.$setNo responseStatus]
719 if {[lindex $status 0] == "NSD"} {
720 show-status {Ready} 0 1
721 set code [lindex $status 1]
722 set msg [lindex $status 2]
723 set addinfo [lindex $status 3]
724 tkerror "NSD$code: $msg: $addinfo"
728 show-status {Ready} 0 1
732 if {$no > 0 && $setOffset <= $setMax} {
733 puts "present from ${setOffset}"
734 set toGet [expr $setMax - $setOffset + 1]
738 z39.$setNo present $setOffset $toGet
740 show-status {Finished} 0 1
744 proc left-cursor {w} {
745 set i [$w index insert]
752 proc right-cursor {w} {
753 set i [$w index insert]
758 proc bind-fields {list returnAction escapeAction} {
759 set max [expr [llength $list]-1]
760 for {set i 0} {$i < $max} {incr i} {
761 bind [lindex $list $i] <Return> $returnAction
762 bind [lindex $list $i] <Escape> $escapeAction
763 bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
764 bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
765 bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
767 bind [lindex $list $i] <Return> $returnAction
768 bind [lindex $list $i] <Escape> $escapeAction
769 bind [lindex $list $i] <Tab> [list focus [lindex $list 0]]
770 bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
771 bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
772 focus [lindex $list 0]
775 proc entry-fields {parent list tlist returnAction escapeAction} {
778 foreach field $list {
779 set label ${parent}.${field}.label
780 set entry ${parent}.${field}.entry
781 label $label -text [lindex $tlist $i] -anchor e
782 entry $entry -width 32 -relief sunken
783 pack $label -side left
784 pack $entry -side right
788 bind-fields $alist $returnAction $escapeAction
791 proc define-target-dialog {} {
799 -side top -anchor e -pady 2
800 entry-fields $w.top {target} \
802 {define-target-action} {destroy .target-define}
803 top-down-ok-cancel $w {define-target-action} 1
806 proc protocol-setup-action {target} {
809 global protocolRadioType
810 global settingsChanged
813 global ResultSetCheck
815 set w .setup-${target}.top
817 #set w .protocol-setup.top
820 set settingsChanged 1
821 set len [$w.databases.list size]
822 for {set i 0} {$i < $len} {incr i} {
823 lappend b [$w.databases.list get $i]
825 set profile($target) [list [$w.description.entry get] \
826 [$w.host.entry get] \
827 [$w.port.entry get] \
828 [$w.idAuthentication.entry get] \
829 [$w.maximumRecordSize.entry get] \
830 [$w.preferredMessageSize.entry get] \
839 puts $profile($target)
840 destroy .setup-${target}
843 proc place-force {window parent} {
844 set g [wm geometry $parent]
846 set p1 [string first + $g]
847 set p2 [string last + $g]
849 set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
850 set y [expr 60+[string range $g [expr $p2 +1] end]]
851 wm geometry $window +${x}+${y}
854 proc add-database-action {target} {
855 set w .setup-${target}
857 ${w}.top.databases.list insert end \
858 [.database-select.top.database.entry get]
859 destroy .database-select
862 proc add-database {target} {
863 set w .database-select
868 place-force $w .setup-${target}
872 frame $w.top.database
874 pack $w.top.database -side top -anchor e -pady 2
876 entry-fields $w.top {database} \
877 {{Database to add:}} \
878 [list add-database-action $target] {destroy .database-select}
880 top-down-ok-cancel $w [list add-database-action $target] 1
884 proc delete-database {target} {
885 set w .setup-${target}
887 foreach i [lsort -decreasing \
888 [$w.top.databases.list curselection]] {
889 $w.top.databases.list delete $i
893 proc protocol-setup {target} {
898 global protocolRadioType
901 global ResultSetCheck
905 wm title $w "Setup $target"
914 puts $profile($target)
918 frame $w.top.description
919 frame $w.top.idAuthentication
920 frame $w.top.maximumRecordSize
921 frame $w.top.preferredMessageSize
922 frame $w.top.cs-type -relief ridge -border 2
923 frame $w.top.protocol -relief ridge -border 2
924 frame $w.top.query -relief ridge -border 2
925 frame $w.top.databases -relief ridge -border 2
927 # Maximum/preferred/idAuth ...
928 pack $w.top.description $w.top.host $w.top.port \
929 $w.top.idAuthentication $w.top.maximumRecordSize \
930 $w.top.preferredMessageSize -side top -anchor e -pady 2
932 entry-fields $w.top {description host port idAuthentication \
933 maximumRecordSize preferredMessageSize} \
934 {{Description:} {Host:} {Port:} {Id Authentication:} \
935 {Maximum Record Size:} {Preferred Message Size:}} \
936 [list protocol-setup-action $target] [list destroy $w]
938 foreach sub {description host port idAuthentication \
939 maximumRecordSize preferredMessageSize} {
941 bind $w.top.$sub.entry <Control-a> "add-database $target"
942 bind $w.top.$sub.entry <Control-d> "delete-database $target"
944 $w.top.description.entry insert 0 [lindex $profile($target) 0]
945 $w.top.host.entry insert 0 [lindex $profile($target) 1]
946 $w.top.port.entry insert 0 [lindex $profile($target) 2]
947 $w.top.idAuthentication.entry insert 0 [lindex $profile($target) 3]
948 $w.top.maximumRecordSize.entry insert 0 [lindex $profile($target) 4]
949 $w.top.preferredMessageSize.entry insert 0 [lindex $profile($target) 5]
950 set csRadioType [lindex $profile($target) 6]
951 set RPNCheck [lindex $profile($target) 8]
952 set CCLCheck [lindex $profile($target) 9]
953 set ResultSetCheck [lindex $profile($target) 10]
954 set protocolRadioType [lindex $profile($target) 11]
955 if {$protocolRadioType == ""} {
956 set protocolRadioType z39v2
960 pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill both
962 label $w.top.databases.label -text "Databases"
963 button $w.top.databases.add -text "Add" \
964 -command "add-database $target"
965 button $w.top.databases.delete -text "Delete" \
966 -command "delete-database $target"
967 listbox $w.top.databases.list -geometry 20x6 \
968 -yscrollcommand "$w.top.databases.scroll set"
969 scrollbar $w.top.databases.scroll -orient vertical -border 1
970 pack $w.top.databases.label -side top -fill x \
972 pack $w.top.databases.add $w.top.databases.delete -side top -fill x \
974 pack $w.top.databases.list -side left -fill both -expand yes \
976 pack $w.top.databases.scroll -side right -fill y \
978 $w.top.databases.scroll config -command "$w.top.databases.list yview"
980 foreach b [lindex $profile($target) 7] {
981 $w.top.databases.list insert end $b
985 pack $w.top.cs-type -pady 6 -padx 6 -side top -fill x
987 label $w.top.cs-type.label -text "Transport"
988 radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \
989 -command {puts tcp/ip} -variable csRadioType -value tcpip
990 radiobutton $w.top.cs-type.mosi -text "MOSI" -anchor w\
991 -command {puts mosi} -variable csRadioType -value mosi
993 pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
994 -padx 4 -side top -fill x
997 pack $w.top.protocol -pady 6 -padx 6 -side top -fill x
999 label $w.top.protocol.label -text "Protocol"
1000 radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \
1001 -command {puts z39v2} -variable protocolRadioType -value z39v2
1002 radiobutton $w.top.protocol.sr -text "SR" -anchor w \
1003 -command {puts sr} -variable protocolRadioType -value sr
1005 pack $w.top.protocol.label $w.top.protocol.z39v2 $w.top.protocol.sr \
1006 -padx 4 -side top -fill x
1009 pack $w.top.query -pady 6 -padx 6 -side top -fill x
1011 label $w.top.query.label -text "Query support"
1012 checkbutton $w.top.query.c1 -text "RPN query" -anchor w -variable RPNCheck
1013 checkbutton $w.top.query.c2 -text "CCL query" -anchor w -variable CCLCheck
1014 checkbutton $w.top.query.c3 -text "Result sets" -anchor w -variable ResultSetCheck
1016 pack $w.top.query.label -side top
1017 pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
1018 -padx 4 -side top -fill x
1021 top-down-ok-cancel $w [list protocol-setup-action $target] 0
1024 proc database-select-action {} {
1025 set w .database-select.top
1027 foreach indx [$w.databases.list curselection] {
1028 lappend b [$w.databases.list get $indx]
1031 z39 databaseNames $b
1033 destroy .database-select
1036 proc database-select {} {
1037 set w .database-select
1047 frame $w.top.databases -relief ridge -border 2
1049 pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
1051 label $w.top.databases.label -text "List"
1052 listbox $w.top.databases.list -geometry 20x6 \
1053 -yscrollcommand "$w.top.databases.scroll set"
1054 scrollbar $w.top.databases.scroll -orient vertical -border 1
1055 pack $w.top.databases.label -side top -fill x \
1057 pack $w.top.databases.list -side left -fill both -expand yes \
1059 pack $w.top.databases.scroll -side right -fill y \
1061 $w.top.databases.scroll config -command "$w.top.databases.list yview"
1063 foreach b [lindex $profile($hostid) 7] {
1064 $w.top.databases.list insert end $b
1066 top-down-ok-cancel $w {database-select-action} 1
1069 proc cascade-target-list {} {
1072 foreach sub [winfo children .top.target.m.clist] {
1073 puts "deleting $sub"
1076 .top.target.m.clist delete 0 last
1077 foreach n [array names profile] {
1078 if {$n != "Default"} {
1079 set nl [string tolower $n]
1080 if {[llength [lindex $profile($n) 7]] > 1} {
1081 .top.target.m.clist add cascade -label $n \
1082 -menu .top.target.m.clist.$nl
1083 menu .top.target.m.clist.$nl
1084 foreach b [lindex $profile($n) 7] {
1085 .top.target.m.clist.$nl add command -label $b \
1086 -command "reopen-target $n $b"
1089 .top.target.m.clist add command -label $n \
1090 -command "reopen-target $n {}"
1094 .top.target.m.slist delete 0 last
1095 foreach n [array names profile] {
1096 if {$n != "Default"} {
1097 .top.target.m.slist add command -label $n \
1098 -command "protocol-setup $n"
1103 proc cascade-query-list {} {
1107 .top.query.m.slist delete 0 last
1108 foreach n $queryTypes {
1109 .top.query.m.slist add command -label $n \
1110 -command [list query-setup $i]
1115 .top.query.m.clist delete 0 last
1116 foreach n $queryTypes {
1117 .top.query.m.clist add command -label $n \
1118 -command [list query-select $i]
1123 proc save-settings {} {
1126 global settingsChanged
1131 set f [open "clientrc.tcl" w]
1132 puts $f "# Setup file"
1133 puts $f "set hotTargets \{ $hotTargets \}"
1135 foreach n [array names profile] {
1136 puts -nonewline $f "set profile($n) \{"
1137 puts -nonewline $f $profile($n)
1140 puts -nonewline $f "set queryTypes \{"
1141 puts -nonewline $f $queryTypes
1144 puts -nonewline $f "set queryButtons \{"
1145 puts -nonewline $f $queryButtons
1148 puts -nonewline $f "set queryInfo \{"
1149 puts -nonewline $f $queryInfo
1153 set settingsChanged 0
1165 message $w.top.message -text $ask
1167 pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
1170 top-down-ok-cancel $w {alert-action} 1
1174 proc alert-action {} {
1180 proc exit-action {} {
1181 global settingsChanged
1183 if {$settingsChanged} {
1184 set a [alert "you havent saved your settings. Do you wish to save?"]
1192 proc listbuttonaction {w name h user i} {
1193 $w configure -text [lindex $name 0]
1194 $h [lindex $name 1] $user $i
1197 proc listbuttonx {button no names handle user} {
1198 if {[winfo exists $button]} {
1199 $button configure -text [lindex [lindex $names $no] 0]
1200 ${button}.m delete 0 last
1202 menubutton $button -text [lindex [lindex $names $no] 0] \
1203 -width 10 -menu ${button}.m -relief raised -border 1
1207 foreach name $names {
1208 ${button}.m add command -label [lindex $name 0] \
1209 -command [list listbuttonaction ${button} $name \
1215 proc listbutton {button no names} {
1216 menubutton $button -text [lindex $names $no] -width 10 -menu ${button}.m \
1217 -relief raised -border 1
1219 foreach name $names {
1220 ${button}.m add command -label $name \
1221 -command [list ${button} configure -text $name]
1225 proc query-add-index-action {queryNo} {
1226 set w .setup-query-$queryNo
1229 global queryButtonsTmp
1231 lappend queryInfoTmp [list [.query-add-index.top.index.entry get] {}]
1233 destroy .query-add-index
1234 #destroy $w.top.lines
1235 #frame $w.top.lines -relief ridge -border 2
1236 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1237 #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1240 proc query-add-line {queryNo} {
1241 set w .setup-query-$queryNo
1244 global queryButtonsTmp
1246 lappend queryButtonsTmp {I 0}
1248 #destroy $w.top.lines
1249 #frame $w.top.lines -relief ridge -border 2
1250 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1251 #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1254 proc query-del-line {queryNo} {
1255 set w .setup-query-$queryNo
1258 global queryButtonsTmp
1260 set l [llength $queryButtonsTmp]
1265 set queryButtonsTmp [lreplace $queryButtonsTmp $l $l]
1266 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1269 proc query-add-index {queryNo} {
1270 set w .query-add-index
1273 place-force $w .setup-query-$queryNo
1277 -side top -anchor e -pady 2
1278 entry-fields $w.top {index} \
1280 [list query-add-index-action $queryNo] {destroy .query-add-index}
1281 top-down-ok-cancel $w [list query-add-index-action $queryNo] 1
1284 proc query-setup-action {queryNo} {
1287 global queryButtonsTmp
1289 global queryButtonsFind
1290 global queryInfoFind
1292 set queryInfo [lreplace $queryInfo $queryNo $queryNo \
1294 set queryButtons [lreplace $queryButtons $queryNo $queryNo \
1296 set queryInfoFind $queryInfoTmp
1297 set queryButtonsFind $queryButtonsTmp
1301 destroy .setup-query-$queryNo
1303 index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
1306 proc activate-e-index {value no i} {
1307 global queryButtonsTmp
1309 puts $queryButtonsTmp
1310 set queryButtonsTmp [lreplace $queryButtonsTmp $no $no [list I $i]]
1311 puts $queryButtonsTmp
1317 proc activate-index {value no i} {
1318 global queryButtonsFind
1320 set queryButtonsFind [lreplace $queryButtonsFind $no $no [list I $i]]
1322 puts "queryButtonsFind $queryButtonsFind"
1328 proc query-setup {queryNo} {
1329 set w .setup-query-$queryNo
1331 set queryTypes {Simple}
1334 global queryButtonsTmp
1337 set queryName [lindex $queryTypes $queryNo]
1338 set queryInfoTmp [lindex $queryInfo $queryNo]
1339 set queryButtonsTmp [lindex $queryButtons $queryNo]
1341 #set queryButtons { {I 0 I 1 I 2} }
1342 #set queryInfo { { {Title ti} {Author au} {Subject sh} } }
1346 wm title $w "Query setup $queryName"
1351 frame $w.top.lines -relief ridge -border 2
1352 frame $w.top.use -relief ridge -border 2
1353 frame $w.top.relation -relief ridge -border 2
1354 frame $w.top.position -relief ridge -border 2
1355 frame $w.top.structure -relief ridge -border 2
1356 frame $w.top.truncation -relief ridge -border 2
1357 frame $w.top.completeness -relief ridge -border 2
1361 index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1363 pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1366 pack $w.top.use -side left -pady 6 -padx 6 -fill y
1368 label $w.top.use.label -text "Use"
1369 listbox $w.top.use.list -geometry 20x10 \
1370 -yscrollcommand "$w.top.use.scroll set"
1371 scrollbar $w.top.use.scroll -orient vertical -border 1
1372 pack $w.top.use.label -side top -fill x \
1374 pack $w.top.use.list -side left -fill both -expand yes \
1376 pack $w.top.use.scroll -side right -fill y \
1378 $w.top.use.scroll config -command "$w.top.use.list yview"
1380 foreach u {{Personal name} {Corporate name}} {
1381 $w.top.use.list insert end $u
1383 # Relation Attributes
1384 pack $w.top.relation -pady 6 -padx 6 -side top
1386 label $w.top.relation.label -text "Relation" -width 18
1388 listbutton $w.top.relation.b 0\
1389 {{None} {Less than} {Greater than or equal} \
1390 {Equal} {Greater than or equal} {Greater than} {Not equal} \
1392 {Stem} {Relevance} {AlwaysMatches}}
1394 pack $w.top.relation.label $w.top.relation.b -fill x
1396 # Position Attributes
1397 pack $w.top.position -pady 6 -padx 6 -side top
1399 label $w.top.position.label -text "Position" -width 18
1401 listbutton $w.top.position.b 0 {{None} {First in field} {First in subfield}
1402 {Any position in field}}
1404 pack $w.top.position.label $w.top.position.b -fill x
1406 # Structure Attributes
1408 pack $w.top.structure -pady 6 -padx 6 -side top
1410 label $w.top.structure.label -text "Structure" -width 18
1412 listbutton $w.top.structure.b 0 {{None} {Phrase} {Word} {Key} {Year}
1413 {Date (norm)} {Word list} {Date (un-norm)} {Name (norm)} {Date (un-norm)}
1414 {Structure} {urx} {free-form} {doc-text} {local-number} {string}
1417 pack $w.top.structure.label $w.top.structure.b -fill x
1419 # Truncation Attributes
1421 pack $w.top.truncation -pady 6 -padx 6 -side top
1423 label $w.top.truncation.label -text "Truncation" -width 18
1425 listbutton $w.top.truncation.b 0 {{Auto} {Right} {Left} {Left and right} \
1426 {No truncation} {Process #} {Re-1} {Re-2}}
1427 pack $w.top.truncation.label $w.top.truncation.b -fill x
1429 # Completeness Attributes
1431 pack $w.top.completeness -pady 6 -padx 6 -side top
1433 label $w.top.completeness.label -text "Truncation" -width 18
1435 listbutton $w.top.completeness.b 0 {{None} {Incomplete subfield} \
1436 {Complete subfield} {Complete field}}
1437 pack $w.top.completeness.label $w.top.completeness.b -fill x
1440 bottom-buttons $w [list \
1441 {Ok} [list query-setup-action $queryNo] \
1442 {Add index} [list query-add-index $queryNo] \
1443 {Add line} [list query-add-line $queryNo] \
1444 {Delete line} [list query-del-line $queryNo] \
1445 {Cancel} [list destroy $w]] 0
1448 proc index-clear {} {
1449 global queryButtonsFind
1452 foreach b $queryButtonsFind {
1453 .lines.$i.e delete 0 end
1458 proc index-query {} {
1459 global queryButtonsFind
1460 global queryInfoFind
1465 foreach b $queryButtonsFind {
1466 set term [string trim [.lines.$i.e get]]
1468 set attr [lindex [lindex $queryInfoFind [lindex $b 1]] 1]
1470 set term "\{${term}\}"
1472 set term "@attr $a ${term}"
1475 set qs "@and ${qs} ${term}"
1486 proc index-lines {w realOp buttonInfo queryInfo handle} {
1488 foreach b $buttonInfo {
1489 if {! [winfo exists $w.$i]} {
1490 frame $w.$i -background white -border 1
1492 listbuttonx $w.$i.l [lindex $b 1] $queryInfo $handle $i
1495 if {! [winfo exists $w.$i.e]} {
1496 entry $w.$i.e -width 32 -relief sunken -border 1
1497 bind $w.$i.e <FocusIn> [list $w.$i configure \
1499 bind $w.$i.e <FocusOut> [list $w.$i configure \
1501 pack $w.$i.l -side left
1502 pack $w.$i.e -side left -fill x -expand yes
1503 pack $w.$i -side top -fill x -padx 2 -pady 2
1504 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
1505 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
1506 bind $w.$i.e <Return> search-request
1509 pack $w.$i.l -side left
1510 pack $w.$i -side top -fill x -padx 2 -pady 2
1515 while {[winfo exists $w.$j]} {
1526 bind $w.$j.e <Tab> "focus $w.$k.e"
1530 bind $w.$i.e <Tab> "focus $w.0.e"
1535 proc search-fields {w buttondefs} {
1537 foreach buttondef $buttondefs {
1538 frame $w.$i -background white
1540 listbutton $w.$i.l 0 $buttondef
1541 entry $w.$i.e -width 32 -relief sunken
1543 pack $w.$i.l -side left
1544 pack $w.$i.e -side left -fill x -expand yes
1546 pack $w.$i -side top -fill x -padx 2 -pady 2
1548 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
1549 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
1557 bind $w.$j.e <Tab> "focus $w.$k.e \n
1558 $w.$k configure -background red \n
1559 $w.$j configure -background white"
1562 bind $w.$i.e <Tab> "focus $w.0.e \n
1563 $w.0 configure -background red \n
1564 $w.$i configure -background white"
1566 $w.0 configure -background red
1569 frame .top -border 1 -relief raised
1570 frame .lines -border 1 -relief raised
1571 frame .mid -border 1 -relief raised
1572 frame .data -border 1 -relief raised
1573 frame .bot -border 1 -relief raised
1574 pack .top .lines .mid -side top -fill x
1575 pack .data -side top -fill both -expand yes
1578 menubutton .top.file -text "File" -underline 0 -menu .top.file.m
1580 .top.file.m add command -label "Save settings" -command {save-settings}
1581 .top.file.m add command -label "Load Set" -command {load-set}
1582 .top.file.m add separator
1583 .top.file.m add command -label "Exit" -command {exit-action}
1584 .top.file.m add separator
1585 .top.file.m add command -label "About" -command {about-origin}
1587 menubutton .top.target -text "Target" -underline 0 -menu .top.target.m
1589 .top.target.m add cascade -label "Connect" -menu .top.target.m.clist
1590 .top.target.m add command -label "Disconnect" -command {close-target}
1591 .top.target.m add command -label "About" -command {about-target}
1592 .top.target.m add cascade -label "Setup" -menu .top.target.m.slist
1593 .top.target.m add command -label "Setup new" -command {define-target-dialog}
1594 .top.target.m add separator
1597 .top.target.m disable 1
1598 .top.target.m disable 2
1600 menu .top.target.m.clist
1601 menu .top.target.m.slist
1604 menubutton .top.search -text "Search" -underline 0 -menu .top.search.m
1606 .top.search.m add command -label "Database" -command {database-select}
1607 .top.search.m add cascade -label "Query type" -menu .top.search.m.querytype
1608 menu .top.search.m.querytype
1609 .top.search.m.querytype add radiobutton -label "RPN"
1610 .top.search.m.querytype add radiobutton -label "CCL"
1611 .top.search.m add cascade -label "Present" -menu .top.search.m.present
1612 menu .top.search.m.present
1613 .top.search.m.present add command -label "More" -command [list present-more 10]
1614 .top.search.m.present add command -label "All" -command [list present-more {}]
1615 .top.search configure -state disabled
1617 menubutton .top.query -text "Query" -underline 0 -menu .top.query.m
1619 .top.query.m add cascade -label "Choose" -menu .top.query.m.clist
1620 .top.query.m add command -label "Define" -command {new-query-dialog}
1621 .top.query.m add cascade -label "Edit" -menu .top.query.m.slist
1622 menu .top.query.m.clist
1623 menu .top.query.m.slist
1626 menubutton .top.help -text "Help" -menu .top.help.m
1629 .top.help.m add command -label "Help on help" \
1630 -command {tkerror "Help on help not available. Sorry"}
1631 .top.help.m add command -label "About" \
1632 -command {tkerror "About not available. Sorry"}
1634 pack .top.file .top.target .top.query .top.search -side left
1635 pack .top.help -side right
1637 index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
1639 button .mid.search -width 7 -text {Search} -command search-request \
1641 button .mid.scan -width 7 -text {Scan} -command scan-request \
1643 button .mid.present -width 7 -text {Present} -command [list present-more 10] \
1646 button .mid.clear -width 7 -text {Clear} -command index-clear
1647 pack .mid.search .mid.scan .mid.present .mid.clear -side left \
1648 -fill y -padx 5 -pady 3
1650 listbox .data.list -yscrollcommand {.data.scroll set} -font fixed
1651 scrollbar .data.scroll -orient vertical -border 1
1652 pack .data.list -side left -fill both -expand yes
1653 pack .data.scroll -side right -fill y
1654 .data.scroll config -command {.data.list yview}
1656 button .bot.logo -bitmap @book1 -command cancel-operation
1658 pack .bot.a -side left -fill x
1659 pack .bot.logo -side right -padx 2 -pady 2
1661 message .bot.a.target -text "" -aspect 1000 -border 1
1663 label .bot.a.status -text "Not connected" -width 15 -relief \
1664 sunken -anchor w -border 1
1665 label .bot.a.set -textvariable setNo -width 5 -relief \
1666 sunken -anchor w -border 1
1667 label .bot.a.message -text "" -width 15 -relief \
1668 sunken -anchor w -border 1
1670 pack .bot.a.target -side top -anchor nw -padx 2 -pady 2
1671 pack .bot.a.status .bot.a.set .bot.a.message \
1672 -side left -padx 2 -pady 2
1674 bind .data.list <Double-Button-1> {set indx [.data.list nearest %y]
1675 show-full-marc [incr indx] 0}