1 # IR toolkit for tcl/tk
2 # (c) Index Data 1995-1998
3 # See the file LICENSE for details.
4 # Sebastian Hammer, Adam Dickmeiss
9 # Revision 1.4 1998-02-12 13:32:42 adam
10 # Updated configuration system.
12 # Revision 1.3 1998/01/30 13:30:50 adam
13 # Name of target database is irtdb.tcl instead of clientrc.tcl.
15 # Revision 1.2 1997/11/19 11:20:57 adam
16 # New target profile format - associative arrrays instead of LONG lists.
18 # Revision 1.1 1996/09/13 10:54:25 adam
19 # Started work on Explain in client.
22 proc print-date {w msg date} {
24 pack $w -side top -fill x
28 if {[string length $date]} {
29 label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
31 label $w.b -text Never
36 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
40 set label ${parent}.${field}.label
41 set entry ${parent}.${field}.entry
42 label $label -text [lindex $tlist $i]
43 entry $entry -relief sunken -border 1 -width $width
44 pack $label -side left
45 pack $entry -side right
49 bind-fields $alist $returnAction $escapeAction
52 proc protocol-setup {target} {
53 global profileS profile
55 foreach n [array names profile $target,*] {
56 set profileS($n) $profile($n)
58 target-setup $target 0 0
61 proc protocol-setup-action {target} {
62 global profileS profile settingsChanged
64 set timedef $profileS($target,timeDefine)
65 if {![string length $timedef]} {
66 set timedef [clock seconds]
69 foreach n [array names profileS $target,*] {
70 set profile($n) $profileS($n)
76 delete-target-hotlist $target
79 proc target-setup-delete {target category dir} {
81 if {![string compare $target Default]} return
82 set a [alert "Are you sure you want to delete the target \
83 definition $target ?"]
85 target-setup $target $category $dir
89 proc target-setup {target category dir} {
90 global profile settingsChanged
92 set w .setup-$profile($target,windowNumber)
95 target-setup-leave-$category $target $w
98 foreach n [array names profile $target,*] {
101 set settingsChanged 1
103 delete-target-hotlist $target
106 } elseif {$dir == 2} {
107 protocol-setup-action $target
112 if {[winfo exists $w]} {
117 wm geometry $w 430x370
124 [list {Ok} [list target-setup $target $category 2] \
125 {Previous} [list target-setup $target $category -1] \
126 {Next} [list target-setup $target $category 1] \
127 {Delete} [list target-setup-delete $target $category 3] \
128 {Cancel} [list destroy $w]] 0
129 if {$category == 0} {
130 $w.bot.2 configure -state disabled
132 if {$category == 2} {
133 $w.bot.4 configure -state disabled
135 target-setup-enter-$category $target $w
140 proc target-setup-leave-0 {target w} {
143 set y $w.top.hostport
147 proc target-setup-enter-0 {target w} {
150 wm title $w "$target - Initial Information"
153 set y $w.top.hostport
154 frame $y -relief ridge -border 2
155 pack $y -padx 2 -pady 2 -side top -fill x
158 frame $y.idAuthentication
160 pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
162 entry-fieldsx 34 $y \
163 {host port idAuthentication} \
164 {{Host:} {Port:} {Id Authentication:}} \
165 [list target-setup $target 0 2] [list destroy $w]
167 $y.host.entry configure -textvariable \
168 profileS($target,host)
169 $y.port.entry configure -textvariable \
170 profileS($target,port)
171 $y.idAuthentication.entry configure -textvariable \
172 profileS($target,idAuthentication)
176 frame $w.top.name -relief ridge -border 2
177 pack $w.top.name -pady 2 -padx 2 -side bottom -fill both -expand yes
179 label $w.top.name.label -text "Databases"
180 pack $w.top.name.label -side top -fill x
182 frame $w.top.name.buttons -border 2
183 pack $w.top.name.buttons -side right
185 button $w.top.name.buttons.add -text "Add" -command \
186 [list target-setup-db-add $target $w]
187 button $w.top.name.buttons.remove -text "Remove" -state disabled \
188 -command [list target-setup-db-remove $target $w]
189 button $w.top.name.buttons.configure -text "Configure" -state disabled
190 pack $w.top.name.buttons.add -side top -fill x
191 pack $w.top.name.buttons.remove -side top -fill x
192 pack $w.top.name.buttons.configure -side top -fill x
194 scrollbar $w.top.name.scroll -orient vertical -border 1
195 listbox $w.top.name.list -border 1 -height 5 -yscrollcommand \
196 [list $w.top.name.scroll set]
197 pack $w.top.name.list -side left -padx 2 -pady 2 -fill both -expand yes
198 pack $w.top.name.scroll -side right -padx 2 -pady 2 -fill y
199 $w.top.name.scroll config -command [list $w.top.name.list yview]
201 target-setup-dblist-update $target $w
206 frame $y -relief ridge -border 2
207 pack $y -pady 2 -padx 2 -side left -fill both -expand yes
209 label $y.label -text "Dates"
210 pack $y.label -side top -fill x
211 print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
212 print-date $w.top.dates.b {Last Access:} $profileS($target,timeLastInit)
213 print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
217 set y $w.top.protocol
219 frame $y -relief ridge -border 2
220 pack $y -pady 2 -padx 2 -side right -fill both
222 label $y.label -text "Protocol"
223 radiobutton $y.z39v2 -text "Z39.50" -anchor w \
224 -variable profileS($target,protocol) -value Z39
225 radiobutton $y.sr -text "SR" -anchor w \
226 -variable profileS($target,protocol) -value SR
228 pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
230 # transport/comstack . . .
232 set y $w.top.comstack
233 frame $y -relief ridge -border 2
235 pack $y -pady 2 -padx 2 -side right -fill both
237 label $y.label -text "Transport"
238 radiobutton $y.tcpip -text "TCP/IP" -anchor w \
239 -variable profileS($target,comstack) -value tcpip
240 radiobutton $y.mosi -text "MOSI" -anchor w\
241 -variable profileS($target,comstack) -value mosi
242 pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
246 proc target-setup-leave-1 {target w} {
251 set profileS($target,targetInfoName) \
252 [string trim [$y.name.text get 0.0 end]]
253 set profileS($target,recentNews) \
254 [string trim [$y.recentNews.text get 0.0 end]]
255 set profileS($target,description) \
256 [string trim [$y.description.text get 0.0 end]]
257 set profileS($target,welcomeMessage) \
258 [string trim [$y.welcome.text get 0.0 end]]
263 proc target-setup-enter-1 {target w} {
266 wm title $w "$target - Target Information"
268 # Name, Recent News . . .
270 frame $y -relief ridge -border 2
271 pack $y -side top -padx 2 -pady 2 -fill x
278 pack $y.name $y.recentNews $y.description $y.welcome \
279 -side top -fill x -pady 2 -expand yes
281 label $y.name.label -text "Name" -width 15
282 pack $y.name.label -side left
283 text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
285 TextEditable $y.name.text
286 $y.name.text insert end $profileS($target,targetInfoName)
287 pack $y.name.text -side right -fill x -expand yes
289 label $y.recentNews.label -text "Recent News" -width 15
290 pack $y.recentNews.label -side left
291 text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
293 TextEditable $y.recentNews.text
294 $y.recentNews.text insert end $profileS($target,recentNews)
295 pack $y.recentNews.text -side right -fill x -expand yes
297 label $y.description.label -text "Description" -width 15
298 pack $y.description.label -side left
299 text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
301 TextEditable $y.description.text
302 $y.description.text insert end $profileS($target,description)
303 pack $y.description.text -side right -fill x -expand yes
305 label $y.welcome.label -text "Welcome Message" -width 15
306 pack $y.welcome.label -side left
307 text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
309 TextEditable $y.welcome.text
310 $y.welcome.text insert end $profileS($target,welcomeMessage)
311 pack $y.welcome.text -side right -fill x -expand yes
313 # Result Sets Size, numbers, etc. . . .
316 frame $y -relief ridge -border 2
317 pack $y -side left -padx 2 -pady 2 -fill y
319 frame $y.maxResultSets
320 frame $y.maxResultSize
323 pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
324 -side top -fill x -pady 2
326 entry-fieldsx 10 $y \
327 {maxResultSets maxResultSize maxTerms} \
328 {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
329 [list target-setup $target 1 2] [list destroy $w]
331 $y.maxResultSets.entry configure \
332 -textvariable profileS($target,targetMaxResultSets)
333 $y.maxResultSize.entry configure \
334 -textvariable profileS($target,targetMaxResultSize)
335 $y.maxTerms.entry configure \
336 -textvariable profileS($target,targetMaxTerms)
341 frame $y -relief ridge -border 2
342 pack $y -side right -padx 2 -pady 2 -fill both -expand yes
344 checkbutton $y.resultSets -text "Named Result Sets" \
345 -anchor n -variable profileS($target,namedResultSets)
347 checkbutton $y.multipleDatabases -text "Multiple Database Search" \
348 -anchor n -variable profileS($target,multipleDatabases)
350 pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
354 proc target-setup-2-dbselect {menu e} {
355 $menu configure -text $e
358 proc target-setup-leave-2 {target w} {
362 proc target-setup-db-add {target wp} {
363 set w .database-select
371 frame $w.top.database
373 pack $w.top.database -side top -anchor e -pady 2
375 entry-fields $w.top {database} \
376 {{Database to add:}} \
377 [list target-setup-db-add-action $target $wp] \
380 top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
384 proc target-setup-db-add-action {target wp} {
387 set w .database-select
389 set db [$w.top.database.entry get]
390 lappend profileS($target,databases) $db
393 target-setup-dblist-update $target $wp
396 proc target-setup-db-remove {target wp} {
402 set db [$wp.top.name.list get active]
404 set a [alert "Are you sure you want to remove the database ${db}?"]
406 set i [lsearch -exact $profileS($target,databases) $db]
408 set profileS($target,databases) \
409 [lreplace $profileS($target,databases) $i $i]
411 target-setup-dblist-update $target $wp
412 if {![llength $profileS($target,databases)]} {
413 unset profileS($target,databases)
419 proc target-setup-dblist-update {target w} {
424 $w.top.name.list delete 0 end
425 if {[info exists profileS($target,databases)]} {
426 foreach db $profileS($target,databases) {
427 $w.top.name.list insert end $db
429 $w.top.name.buttons.remove configure -state normal
430 $w.top.name.list see 0
431 $w.top.name.list select set 0
433 $w.top.name.buttons.remove configure -state disabled
437 proc target-setup-add {target w} {
442 proc target-setup-enter-2 {target w} {
445 wm title $w "$target - Other Information (not yet completed)"
447 frame $w.top.data -relief ridge -border 2
448 pack $w.top.data -pady 2 -padx 2 -side top -fill x
450 frame $w.top.data.avRecordSize
451 frame $w.top.data.maxRecordSize
453 pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
454 -side top -fill x -pady 2
456 entry-fieldsx 14 $w.top.data \
457 {avRecordSize maxRecordSize} \
458 {{Average Record Size:} {Max Record Size:}} \
459 [list target-setup $target 2 2] [list destroy $w]