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.5 1998-04-02 14:32:01 adam
10 # Minor changes to EXPLAIN driver.
12 # Revision 1.4 1998/02/12 13:32:42 adam
13 # Updated configuration system.
15 # Revision 1.3 1998/01/30 13:30:50 adam
16 # Name of target database is irtdb.tcl instead of clientrc.tcl.
18 # Revision 1.2 1997/11/19 11:20:57 adam
19 # New target profile format - associative arrrays instead of LONG lists.
21 # Revision 1.1 1996/09/13 10:54:25 adam
22 # Started work on Explain in client.
25 proc print-date {w msg date} {
27 pack $w -side top -fill x
31 if {[string length $date]} {
32 label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
34 label $w.b -text Never
39 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
43 set label ${parent}.${field}.label
44 set entry ${parent}.${field}.entry
45 label $label -text [lindex $tlist $i]
46 entry $entry -relief sunken -border 1 -width $width
47 pack $label -side left
48 pack $entry -side right
52 bind-fields $alist $returnAction $escapeAction
55 proc protocol-setup {target} {
56 global profileS profile
58 foreach n [array names profile $target,*] {
59 set profileS($n) $profile($n)
61 target-setup $target 0 0
64 proc protocol-setup-action {target} {
65 global profileS profile settingsChanged
67 set timedef $profileS($target,timeDefine)
68 if {![string length $timedef]} {
69 set timedef [clock seconds]
72 foreach n [array names profileS $target,*] {
73 set profile($n) $profileS($n)
79 delete-target-hotlist $target
82 proc target-setup-delete {target category dir} {
84 if {![string compare $target Default]} return
85 set a [alert "Are you sure you want to delete the target \
86 definition $target ?"]
88 target-setup $target $category $dir
92 proc target-setup {target category dir} {
93 global profile settingsChanged
95 set w .setup-$profile($target,windowNumber)
98 target-setup-leave-$category $target $w
101 foreach n [array names profile $target,*] {
104 set settingsChanged 1
106 delete-target-hotlist $target
109 } elseif {$dir == 2} {
110 protocol-setup-action $target
115 if {[winfo exists $w]} {
120 wm geometry $w 430x370
127 [list {Ok} [list target-setup $target $category 2] \
128 {Previous} [list target-setup $target $category -1] \
129 {Next} [list target-setup $target $category 1] \
130 {Delete} [list target-setup-delete $target $category 3] \
131 {Cancel} [list destroy $w]] 0
132 if {$category == 0} {
133 $w.bot.2 configure -state disabled
135 if {$category == 2} {
136 $w.bot.4 configure -state disabled
138 target-setup-enter-$category $target $w
143 proc target-setup-leave-0 {target w} {
146 set y $w.top.hostport
150 proc target-setup-enter-0 {target w} {
153 wm title $w "$target - Initial Information"
156 set y $w.top.hostport
157 frame $y -relief ridge -border 2
158 pack $y -padx 2 -pady 2 -side top -fill x
161 frame $y.idAuthentication
163 pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
165 entry-fieldsx 34 $y \
166 {host port idAuthentication} \
167 {{Host:} {Port:} {Id Authentication:}} \
168 [list target-setup $target 0 2] [list destroy $w]
170 $y.host.entry configure -textvariable \
171 profileS($target,host)
172 $y.port.entry configure -textvariable \
173 profileS($target,port)
174 $y.idAuthentication.entry configure -textvariable \
175 profileS($target,idAuthentication)
179 frame $w.top.name -relief ridge -border 2
180 pack $w.top.name -pady 2 -padx 2 -side bottom -fill both -expand yes
182 label $w.top.name.label -text "Databases"
183 pack $w.top.name.label -side top -fill x
185 frame $w.top.name.buttons -border 2
186 pack $w.top.name.buttons -side right
188 button $w.top.name.buttons.add -text "Add" -command \
189 [list target-setup-db-add $target $w]
190 button $w.top.name.buttons.remove -text "Remove" -state disabled \
191 -command [list target-setup-db-remove $target $w]
192 button $w.top.name.buttons.configure -text "Configure" -state disabled
193 pack $w.top.name.buttons.add -side top -fill x
194 pack $w.top.name.buttons.remove -side top -fill x
195 pack $w.top.name.buttons.configure -side top -fill x
197 scrollbar $w.top.name.scroll -orient vertical -border 1
198 listbox $w.top.name.list -border 1 -height 5 -yscrollcommand \
199 [list $w.top.name.scroll set]
200 pack $w.top.name.list -side left -padx 2 -pady 2 -fill both -expand yes
201 pack $w.top.name.scroll -side right -padx 2 -pady 2 -fill y
202 $w.top.name.scroll config -command [list $w.top.name.list yview]
204 target-setup-dblist-update $target $w
209 frame $y -relief ridge -border 2
210 pack $y -pady 2 -padx 2 -side left -fill both -expand yes
212 label $y.label -text "Dates"
213 pack $y.label -side top -fill x
214 print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
215 print-date $w.top.dates.b {Last Access:} $profileS($target,timeLastInit)
216 print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
220 set y $w.top.protocol
222 frame $y -relief ridge -border 2
223 pack $y -pady 2 -padx 2 -side right -fill both
225 label $y.label -text "Protocol"
226 radiobutton $y.z39v2 -text "Z39.50" -anchor w \
227 -variable profileS($target,protocol) -value Z39
228 radiobutton $y.sr -text "SR" -anchor w \
229 -variable profileS($target,protocol) -value SR
231 pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
233 # transport/comstack . . .
235 set y $w.top.comstack
236 frame $y -relief ridge -border 2
238 pack $y -pady 2 -padx 2 -side right -fill both
240 label $y.label -text "Transport"
241 radiobutton $y.tcpip -text "TCP/IP" -anchor w \
242 -variable profileS($target,comstack) -value tcpip
243 radiobutton $y.mosi -text "MOSI" -anchor w\
244 -variable profileS($target,comstack) -value mosi
245 pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
249 proc target-setup-leave-1 {target w} {
254 set profileS($target,targetInfoName) \
255 [string trim [$y.name.text get 0.0 end]]
256 set profileS($target,recentNews) \
257 [string trim [$y.recentNews.text get 0.0 end]]
258 set profileS($target,description) \
259 [string trim [$y.description.text get 0.0 end]]
260 set profileS($target,welcomeMessage) \
261 [string trim [$y.welcome.text get 0.0 end]]
266 proc target-setup-enter-1 {target w} {
269 wm title $w "$target - Target Information"
271 # Name, Recent News . . .
273 frame $y -relief ridge -border 2
274 pack $y -side top -padx 2 -pady 2 -fill x
281 pack $y.name $y.recentNews $y.description $y.welcome \
282 -side top -fill x -pady 2 -expand yes
284 label $y.name.label -text "Name" -width 15
285 pack $y.name.label -side left
286 text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
288 TextEditable $y.name.text
289 $y.name.text insert end $profileS($target,targetInfoName)
290 pack $y.name.text -side right -fill x -expand yes
292 label $y.recentNews.label -text "Recent News" -width 15
293 pack $y.recentNews.label -side left
294 text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
296 TextEditable $y.recentNews.text
297 $y.recentNews.text insert end $profileS($target,recentNews)
298 pack $y.recentNews.text -side right -fill x -expand yes
300 label $y.description.label -text "Description" -width 15
301 pack $y.description.label -side left
302 text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
304 TextEditable $y.description.text
305 $y.description.text insert end $profileS($target,description)
306 pack $y.description.text -side right -fill x -expand yes
308 label $y.welcome.label -text "Welcome Message" -width 15
309 pack $y.welcome.label -side left
310 text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
312 TextEditable $y.welcome.text
313 $y.welcome.text insert end $profileS($target,welcomeMessage)
314 pack $y.welcome.text -side right -fill x -expand yes
316 # Result Sets Size, numbers, etc. . . .
319 frame $y -relief ridge -border 2
320 pack $y -side left -padx 2 -pady 2 -fill y
322 frame $y.maxResultSets
323 frame $y.maxResultSize
326 pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
327 -side top -fill x -pady 2
329 entry-fieldsx 10 $y \
330 {maxResultSets maxResultSize maxTerms} \
331 {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
332 [list target-setup $target 1 2] [list destroy $w]
334 $y.maxResultSets.entry configure \
335 -textvariable profileS($target,targetMaxResultSets)
336 $y.maxResultSize.entry configure \
337 -textvariable profileS($target,targetMaxResultSize)
338 $y.maxTerms.entry configure \
339 -textvariable profileS($target,targetMaxTerms)
344 frame $y -relief ridge -border 2
345 pack $y -side right -padx 2 -pady 2 -fill both -expand yes
347 checkbutton $y.resultSets -text "Named Result Sets" \
348 -anchor n -variable profileS($target,namedResultSets)
350 checkbutton $y.multipleDatabases -text "Multiple Database Search" \
351 -anchor n -variable profileS($target,multipleDatabases)
353 pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
357 proc target-setup-2-dbselect {menu e} {
358 $menu configure -text $e
361 proc target-setup-leave-2 {target w} {
365 proc target-setup-db-add {target wp} {
366 set w .database-select
374 frame $w.top.database
376 pack $w.top.database -side top -anchor e -pady 2
378 entry-fields $w.top {database} \
379 {{Database to add:}} \
380 [list target-setup-db-add-action $target $wp] \
383 top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
387 proc target-setup-db-add-action {target wp} {
390 set w .database-select
392 set db [$w.top.database.entry get]
393 lappend profileS($target,databases) $db
396 target-setup-dblist-update $target $wp
399 proc target-setup-db-remove {target wp} {
405 set db [$wp.top.name.list get active]
407 set a [alert "Are you sure you want to remove the database ${db}?"]
409 set i [lsearch -exact $profileS($target,databases) $db]
411 set profileS($target,databases) \
412 [lreplace $profileS($target,databases) $i $i]
414 target-setup-dblist-update $target $wp
415 if {![llength $profileS($target,databases)]} {
416 unset profileS($target,databases)
421 proc target-setup-dblist-update {target w} {
426 $w.top.name.list delete 0 end
427 if {[info exists profileS($target,databases)]} {
428 foreach db $profileS($target,databases) {
429 $w.top.name.list insert end $db
431 $w.top.name.buttons.remove configure -state normal
432 $w.top.name.list see 0
433 $w.top.name.list select set 0
435 $w.top.name.buttons.remove configure -state disabled
439 proc target-setup-add {target w} {
444 proc target-setup-enter-2 {target w} {
447 wm title $w "$target - Other Information (not yet completed)"
449 frame $w.top.data -relief ridge -border 2
450 pack $w.top.data -pady 2 -padx 2 -side top -fill x
452 frame $w.top.data.avRecordSize
453 frame $w.top.data.maxRecordSize
455 pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
456 -side top -fill x -pady 2
458 entry-fieldsx 14 $w.top.data \
459 {avRecordSize maxRecordSize} \
460 {{Average Record Size:} {Max Record Size:}} \
461 [list target-setup $target 2 2] [list destroy $w]