1 # IR toolkit for tcl/tk
2 # (c) Index Data 1995-1996
3 # See the file LICENSE for details.
4 # Sebastian Hammer, Adam Dickmeiss
7 # Revision 1.1 1996-09-13 10:54:25 adam
8 # Started work on Explain in client.
12 set pref(font,h1) {-Adobe-Helvetica-Bold-R-Normal-*-240-*}
13 set pref(font,h2) {-Adobe-Helvetica-Bold-R-Normal-*-180-*}
14 set pref(font,h3) {-Adobe-Helvetica-Bold-R-Normal-*-140-*}
15 set pref(font,h4) {-Adobe-Helvetica-Bold-R-Normal-*-120-*}
17 set pref(font,s1) {-Adobe-Helvetica-Bold-R-Normal-*-100-*}
18 set pref(font,s2) {-Adobe-Helvetica-Bold-R-Normal-*-80-*}
20 proc print-date {w msg date} {
22 pack $w -side top -fill x
26 if {[string length $date]} {
27 label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
29 label $w.b -text Never
34 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
38 set label ${parent}.${field}.label
39 set entry ${parent}.${field}.entry
40 label $label -text [lindex $tlist $i]
41 entry $entry -relief sunken -border 1 -width $width
42 pack $label -side left
43 pack $entry -side right
47 bind-fields $alist $returnAction $escapeAction
50 proc protocol-setup {target} {
51 global profileS profile
53 set tinfo $profile($target)
55 set profileS($target,targetDescription) [lindex $tinfo 0]
56 set profileS($target,host) [lindex $tinfo 1]
57 set profileS($target,port) [lindex $tinfo 2]
58 set profileS($target,idAuthentication) [lindex $tinfo 3]
59 set profileS($target,targetMRS) [lindex $tinfo 4]
61 set profileS($target,targetPMS) [lindex $tinfo 5]
62 set profileS($target,comstack) [lindex $tinfo 6]
63 set profileS($target,databases) [lindex $tinfo 7]
64 set profileS($target,targetResultSets) [lindex $tinfo 8]
65 set profileS($target,RPN) [lindex $tinfo 9]
66 set profileS($target,CCL) [lindex $tinfo 10]
68 set profileS($target,protocolType) [lindex $tinfo 11]
69 set profileS($target,wno) [lindex $tinfo 12]
70 set profileS($target,LSLB) [lindex $tinfo 13]
71 set profileS($target,SSUB) [lindex $tinfo 14]
73 set profileS($target,MSPN) [lindex $tinfo 15]
74 set profileS($target,PresentChunk) [lindex $tinfo 16]
75 set profileS($target,timeDefine) [lindex $tinfo 17]
76 set profileS($target,timeInit) [lindex $tinfo 18]
77 set profileS($target,timeExplain) [lindex $tinfo 19]
79 set profileS($target,targetName) [lindex $tinfo 20]
80 set profileS($target,targetRecentNews) [lindex $tinfo 21]
81 set profileS($target,targetMaxResultSets) [lindex $tinfo 22]
82 set profileS($target,targetMaxResultSize) [lindex $tinfo 23]
83 set profileS($target,targetMaxTerms) [lindex $tinfo 24]
85 set profileS($target,spare) [lindex $tinfo 25]
86 set profileS($target,targetMultipleDatabases) [lindex $tinfo 26]
87 set profileS($target,targetWelcome) [lindex $tinfo 27]
89 target-setup $target 0 0
92 proc protocol-setup-action {target} {
93 global profileS profile settingsChanged
95 set timedef $profileS($target,timeDefine)
96 if {![string length $timedef]} {
97 set timedef [clock seconds]
99 set profile($target) [list \
100 $profileS($target,targetDescription) \
101 $profileS($target,host) \
102 $profileS($target,port) \
103 $profileS($target,idAuthentication) \
104 $profileS($target,targetMRS) \
105 $profileS($target,targetPMS) \
106 $profileS($target,comstack) \
107 $profileS($target,databases) \
108 $profileS($target,targetResultSets) \
109 $profileS($target,RPN) \
110 $profileS($target,CCL) \
111 $profileS($target,protocolType) \
112 $profileS($target,wno) \
113 $profileS($target,LSLB) \
114 $profileS($target,SSUB) \
115 $profileS($target,MSPN) \
116 $profileS($target,PresentChunk) \
117 $profileS($target,timeDefine) \
118 $profileS($target,timeInit) \
119 $profileS($target,timeExplain) \
120 $profileS($target,targetName) \
121 $profileS($target,targetRecentNews) \
122 $profileS($target,targetMaxResultSets) \
123 $profileS($target,targetMaxResultSize) \
124 $profileS($target,targetMaxTerms) \
125 $profileS($target,spare) \
126 $profileS($target,targetMultipleDatabases) \
127 $profileS($target,targetWelcome) \
130 set settingsChanged 1
133 delete-target-hotlist $target
136 proc target-setup {target category dir} {
140 target-setup-leave-$category $target
143 protocol-setup-action $target
148 if {[winfo exists $w]} {
153 wm geometry $w 430x400
159 bottom-buttons $w [list \
160 {Ok} [list target-setup $target $category 2] \
161 {Previous} [list target-setup $target $category -1] \
162 {Next} [list target-setup $target $category 1] \
163 {Cancel} [list destroy $w]] 0
164 if {$category == 0} {
165 $w.bot.2 configure -state disabled
167 if {$category == 2} {
168 $w.bot.4 configure -state disabled
170 target-setup-enter-$category $target
174 proc target-setup-leave-0 {target} {
178 set y $w.top.hostport
180 set profileS($target,host) [$y.host.entry get]
181 set profileS($target,port) [$y.port.entry get]
182 set profileS($target,idAuthentication) [$y.idAuthentication.entry get]
185 proc target-setup-enter-0 {target} {
190 wm title $w "$target - Initial Information"
193 set y $w.top.hostport
194 frame $y -relief ridge -border 2
195 pack $y -padx 2 -pady 2 -side top -fill x
198 frame $y.idAuthentication
200 pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
202 entry-fieldsx 34 $y \
203 {host port idAuthentication} \
204 {{Host:} {Port:} {Id Authentication:}} \
205 [list target-setup $target 0 2] [list destroy $w]
207 $y.host.entry insert 0 $profileS($target,host)
208 $y.port.entry insert 0 $profileS($target,port)
209 $y.idAuthentication.entry insert 0 $profileS($target,idAuthentication)
216 pack $y -side bottom -fill both -expand yes
221 frame $y -relief ridge -border 2
222 pack $y -pady 2 -padx 2 -side left -fill both -expand yes
224 label $y.label -text "Dates"
225 pack $y.label -side top -fill x
226 print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
227 print-date $w.top.dates.b {Last Access:} $profileS($target,timeInit)
228 print-date $w.top.dates.c {Last Explain:} $profileS($target,timeExplain)
232 set y $w.top.protocol
234 frame $y -relief ridge -border 2
235 pack $y -pady 2 -padx 2 -side right -fill both
237 label $y.label -text "Protocol"
238 radiobutton $y.z39v2 -text "Z39.50" -anchor w \
239 -variable profileS($target,protocolType) -value Z39
240 radiobutton $y.sr -text "SR" -anchor w \
241 -variable profileS($target,protocolType) -value SR
243 pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
245 # transport/comstack . . .
247 set y $w.top.comstack
248 frame $y -relief ridge -border 2
250 pack $y -pady 2 -padx 2 -side right -fill both
252 label $y.label -text "Transport"
253 radiobutton $y.tcpip -text "TCP/IP" -anchor w \
254 -variable profileS($target,comstack) -value tcpip
255 radiobutton $y.mosi -text "MOSI" -anchor w\
256 -variable profileS($target,comstack) -value mosi
257 pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
260 proc target-setup-leave-1 {target} {
266 set profileS($target,targetName) [$y.name.text get 0.0 end]
267 set profileS($target,targetRecentNews) [$y.recentNews.text get 0.0 end]
268 set profileS($target,targetDescription) [$y.description.text get 0.0 end]
272 set profileS($target,targetMaxResultSets) [$y.maxResultSets.entry get]
273 set profileS($target,targetMaxResultSize) [$y.maxResultSize.entry get]
274 set profileS($target,targetMaxTerms) [$y.maxTerms.entry get]
277 proc target-setup-enter-1 {target} {
282 wm title $w "$target - Target Information"
284 # Name, Recent News . . .
286 frame $y -relief ridge -border 2
287 pack $y -side top -padx 2 -pady 2 -fill x
294 pack $y.name $y.recentNews $y.description $y.welcome \
295 -side top -fill x -pady 2 -expand yes
297 label $y.name.label -text "Name" -width 15
298 pack $y.name.label -side left
299 text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
301 TextEditable $y.name.text
302 $y.name.text insert end $profileS($target,targetName)
303 pack $y.name.text -side right -fill x -expand yes
305 label $y.recentNews.label -text "Recent News" -width 15
306 pack $y.recentNews.label -side left
307 text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
309 TextEditable $y.recentNews.text
310 $y.recentNews.text insert end $profileS($target,targetRecentNews)
311 pack $y.recentNews.text -side right -fill x -expand yes
313 label $y.description.label -text "Description" -width 15
314 pack $y.description.label -side left
315 text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
317 TextEditable $y.description.text
318 $y.description.text insert end $profileS($target,targetDescription)
319 pack $y.description.text -side right -fill x -expand yes
321 label $y.welcome.label -text "Welcome Message" -width 15
322 pack $y.welcome.label -side left
323 text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
325 TextEditable $y.welcome.text
326 $y.welcome.text insert end $profileS($target,targetWelcome)
327 pack $y.welcome.text -side right -fill x -expand yes
329 # Result Sets Size, numbers, etc. . . .
332 frame $y -relief ridge -border 2
333 pack $y -side left -padx 2 -pady 2 -fill y
335 frame $y.maxResultSets
336 frame $y.maxResultSize
339 pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
340 -side top -fill x -pady 2
342 entry-fieldsx 10 $y \
343 {maxResultSets maxResultSize maxTerms} \
344 {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
345 [list target-setup $target 1 2] [list destroy $w]
347 $y.maxResultSets.entry insert 0 $profileS($target,targetMaxResultSets)
348 $y.maxResultSize.entry insert 0 $profileS($target,targetMaxResultSize)
349 $y.maxTerms.entry insert 0 $profileS($target,targetMaxTerms)
354 frame $y -relief ridge -border 2
355 pack $y -side right -padx 2 -pady 2 -fill both -expand yes
357 checkbutton $y.resultSets -text "Named Result Sets" \
358 -anchor n -variable profileS($target,targetResultSets)
360 checkbutton $y.multipleDatabases -text "Multiple Database Search" \
361 -anchor n -variable profileS($target,targetMultipleDatabases)
363 pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
367 proc target-setup-2-dbselect {menu e} {
368 $menu configure -text $e
371 proc target-setup-leave-2 {target} {
375 proc target-setup-db-add {target wp} {
376 set w .database-select
384 frame $w.top.database
386 pack $w.top.database -side top -anchor e -pady 2
388 entry-fields $w.top {database} \
389 {{Database to add:}} \
390 [list target-setup-db-add-action $target $wp] \
393 top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
397 proc target-setup-db-add-action {target wp} {
400 set w .database-select
402 set db [$w.top.database.entry get]
403 if {![string length [lindex $profileS($target,databases) 0]]} {
404 set profileS($target,databases) $db
406 lappend profileS($target,databases) $db
409 target-setup-dblist-update $target
412 proc target-setup-db-remove {target wp} {
418 set db [$y.data cget -text]
419 set a [alert "Are you sure you want to remove the database ${db}?"]
421 set i [lsearch -exact $profileS($target,databases) $db]
423 set profileS($target,databases) \
424 [lreplace $profileS($target,databases) $i $i]
426 target-setup-dblist-update $target
430 proc target-setup-dblist-update {target} {
437 set databaseList $profileS($target,databases)
438 $y.data configure -text [lindex $databaseList 0]
439 $y.data.m delete 0 100
440 foreach d $databaseList {
441 $y.data.m add command -label $d -command \
442 [list target-setup-2-dbselect $y.data $d]
446 $y.remove configure -state disabled
448 $y.remove configure -state normal
452 proc target-setup-enter-2 {target} {
457 set databaseList $profileS($target,databases)
459 wm title $w "$target - Database Information"
461 frame $w.top.name -border 2
462 pack $w.top.name -pady 2 -padx 2 -side top -fill x
464 label $w.top.name.label -text "Database Name"
466 pack $w.top.name.label -side left
467 menubutton $w.top.name.data -menu $w.top.name.data.m -relief raised
468 menu $w.top.name.data.m
470 pack $w.top.name.data -side left
472 button $w.top.name.add -text "Add" -command \
473 [list target-setup-db-add $target $w]
474 pack $w.top.name.add -side right
476 button $w.top.name.remove -text "Remove" -command \
477 [list target-setup-db-remove $target $w]
478 pack $w.top.name.remove -side right
480 frame $w.top.data -relief ridge -border 2
481 pack $w.top.data -pady 2 -padx 2 -side top -fill x
483 target-setup-dblist-update $target
485 frame $w.top.data.avRecordSize
486 frame $w.top.data.maxRecordSize
488 pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
489 -side top -fill x -pady 2
491 entry-fieldsx 14 $w.top.data \
492 {avRecordSize maxRecordSize} \
493 {{Average Record Size:} {Max Record Size:}} \
494 [list target-setup $target 2 2] [list destroy $w]