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.6 1999-12-12 00:25:59 adam
10 # Updated list of preconfigure targets.
12 # Revision 1.5 1998/04/02 14:32:01 adam
13 # Minor changes to EXPLAIN driver.
15 # Revision 1.4 1998/02/12 13:32:42 adam
16 # Updated configuration system.
18 # Revision 1.3 1998/01/30 13:30:50 adam
19 # Name of target database is irtdb.tcl instead of clientrc.tcl.
21 # Revision 1.2 1997/11/19 11:20:57 adam
22 # New target profile format - associative arrrays instead of LONG lists.
24 # Revision 1.1 1996/09/13 10:54:25 adam
25 # Started work on Explain in client.
28 proc print-date {w msg date} {
30 pack $w -side top -fill x
34 if {[string length $date]} {
35 label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
37 label $w.b -text Never
42 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
46 set label ${parent}.${field}.label
47 set entry ${parent}.${field}.entry
48 label $label -text [lindex $tlist $i]
49 entry $entry -relief sunken -border 1 -width $width
50 pack $label -side left
51 pack $entry -side right
55 bind-fields $alist $returnAction $escapeAction
58 proc protocol-setup {target} {
59 global profileS profile
61 foreach n [array names profile $target,*] {
62 set profileS($n) $profile($n)
64 target-setup $target 0 0
67 proc protocol-setup-action {target} {
68 global profileS profile settingsChanged
70 set timedef $profileS($target,timeDefine)
71 if {![string length $timedef]} {
72 set profileS($target,timeDefine) [clock seconds]
75 foreach n [array names profileS $target,*] {
76 set profile($n) $profileS($n)
82 delete-target-hotlist $target
85 proc target-setup-delete {target category dir} {
87 if {![string compare $target Default]} return
88 set a [alert "Are you sure you want to delete the target \
89 definition $target ?"]
91 target-setup $target $category $dir
95 proc target-setup {target category dir} {
96 global profile settingsChanged
98 set w .setup-$profile($target,windowNumber)
101 target-setup-leave-$category $target $w
104 foreach n [array names profile $target,*] {
107 set settingsChanged 1
109 delete-target-hotlist $target
112 } elseif {$dir == 2} {
113 protocol-setup-action $target
118 if {[winfo exists $w]} {
123 wm geometry $w 430x370
130 [list {Ok} [list target-setup $target $category 2] \
131 {Previous} [list target-setup $target $category -1] \
132 {Next} [list target-setup $target $category 1] \
133 {Delete} [list target-setup-delete $target $category 3] \
134 {Cancel} [list destroy $w]] 0
135 if {$category == 0} {
136 $w.bot.2 configure -state disabled
138 if {$category == 2} {
139 $w.bot.4 configure -state disabled
141 target-setup-enter-$category $target $w
146 proc target-setup-leave-0 {target w} {
149 set y $w.top.hostport
153 proc target-setup-enter-0 {target w} {
156 wm title $w "$target - Initial Information"
159 set y $w.top.hostport
160 frame $y -relief ridge -border 2
161 pack $y -padx 2 -pady 2 -side top -fill x
164 frame $y.idAuthentication
166 pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
168 entry-fieldsx 34 $y \
169 {host port idAuthentication} \
170 {{Host:} {Port:} {Id Authentication:}} \
171 [list target-setup $target 0 2] [list destroy $w]
173 $y.host.entry configure -textvariable \
174 profileS($target,host)
175 $y.port.entry configure -textvariable \
176 profileS($target,port)
177 $y.idAuthentication.entry configure -textvariable \
178 profileS($target,idAuthentication)
182 frame $w.top.name -relief ridge -border 2
183 pack $w.top.name -pady 2 -padx 2 -side bottom -fill both -expand yes
185 label $w.top.name.label -text "Databases"
186 pack $w.top.name.label -side top -fill x
188 frame $w.top.name.buttons -border 2
189 pack $w.top.name.buttons -side right
191 button $w.top.name.buttons.add -text "Add" -command \
192 [list target-setup-db-add $target $w]
193 button $w.top.name.buttons.remove -text "Remove" -state disabled \
194 -command [list target-setup-db-remove $target $w]
195 button $w.top.name.buttons.configure -text "Configure" -state disabled
196 pack $w.top.name.buttons.add -side top -fill x
197 pack $w.top.name.buttons.remove -side top -fill x
198 pack $w.top.name.buttons.configure -side top -fill x
200 scrollbar $w.top.name.scroll -orient vertical -border 1
201 listbox $w.top.name.list -border 1 -height 5 -yscrollcommand \
202 [list $w.top.name.scroll set]
203 pack $w.top.name.list -side left -padx 2 -pady 2 -fill both -expand yes
204 pack $w.top.name.scroll -side right -padx 2 -pady 2 -fill y
205 $w.top.name.scroll config -command [list $w.top.name.list yview]
207 target-setup-dblist-update $target $w
212 frame $y -relief ridge -border 2
213 pack $y -pady 2 -padx 2 -side left -fill both -expand yes
215 label $y.label -text "Dates"
216 pack $y.label -side top -fill x
217 print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
218 print-date $w.top.dates.b {Last Access:} $profileS($target,timeLastInit)
219 print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
223 set y $w.top.protocol
225 frame $y -relief ridge -border 2
226 pack $y -pady 2 -padx 2 -side right -fill both
228 label $y.label -text "Protocol"
229 radiobutton $y.z39v2 -text "Z39.50" -anchor w \
230 -variable profileS($target,protocol) -value Z39
231 radiobutton $y.sr -text "SR" -anchor w \
232 -variable profileS($target,protocol) -value SR
234 pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
236 # transport/comstack . . .
238 set y $w.top.comstack
239 frame $y -relief ridge -border 2
241 pack $y -pady 2 -padx 2 -side right -fill both
243 label $y.label -text "Transport"
244 radiobutton $y.tcpip -text "TCP/IP" -anchor w \
245 -variable profileS($target,comstack) -value tcpip
246 radiobutton $y.mosi -text "MOSI" -anchor w\
247 -variable profileS($target,comstack) -value mosi
248 pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
252 proc target-setup-leave-1 {target w} {
257 set profileS($target,targetInfoName) \
258 [string trim [$y.name.text get 0.0 end]]
259 set profileS($target,recentNews) \
260 [string trim [$y.recentNews.text get 0.0 end]]
261 set profileS($target,description) \
262 [string trim [$y.description.text get 0.0 end]]
263 set profileS($target,welcomeMessage) \
264 [string trim [$y.welcome.text get 0.0 end]]
269 proc target-setup-enter-1 {target w} {
272 wm title $w "$target - Target Information"
274 # Name, Recent News . . .
276 frame $y -relief ridge -border 2
277 pack $y -side top -padx 2 -pady 2 -fill x
284 pack $y.name $y.recentNews $y.description $y.welcome \
285 -side top -fill x -pady 2 -expand yes
287 label $y.name.label -text "Name" -width 15
288 pack $y.name.label -side left
289 text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
291 TextEditable $y.name.text
292 $y.name.text insert end $profileS($target,targetInfoName)
293 pack $y.name.text -side right -fill x -expand yes
295 label $y.recentNews.label -text "Recent News" -width 15
296 pack $y.recentNews.label -side left
297 text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
299 TextEditable $y.recentNews.text
300 $y.recentNews.text insert end $profileS($target,recentNews)
301 pack $y.recentNews.text -side right -fill x -expand yes
303 label $y.description.label -text "Description" -width 15
304 pack $y.description.label -side left
305 text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
307 TextEditable $y.description.text
308 $y.description.text insert end $profileS($target,description)
309 pack $y.description.text -side right -fill x -expand yes
311 label $y.welcome.label -text "Welcome Message" -width 15
312 pack $y.welcome.label -side left
313 text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
315 TextEditable $y.welcome.text
316 $y.welcome.text insert end $profileS($target,welcomeMessage)
317 pack $y.welcome.text -side right -fill x -expand yes
319 # Result Sets Size, numbers, etc. . . .
322 frame $y -relief ridge -border 2
323 pack $y -side left -padx 2 -pady 2 -fill y
325 frame $y.maxResultSets
326 frame $y.maxResultSize
329 pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
330 -side top -fill x -pady 2
332 entry-fieldsx 10 $y \
333 {maxResultSets maxResultSize maxTerms} \
334 {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
335 [list target-setup $target 1 2] [list destroy $w]
337 $y.maxResultSets.entry configure \
338 -textvariable profileS($target,targetMaxResultSets)
339 $y.maxResultSize.entry configure \
340 -textvariable profileS($target,targetMaxResultSize)
341 $y.maxTerms.entry configure \
342 -textvariable profileS($target,targetMaxTerms)
347 frame $y -relief ridge -border 2
348 pack $y -side right -padx 2 -pady 2 -fill both -expand yes
350 checkbutton $y.resultSets -text "Named Result Sets" \
351 -anchor n -variable profileS($target,namedResultSets)
353 checkbutton $y.multipleDatabases -text "Multiple Database Search" \
354 -anchor n -variable profileS($target,multipleDatabases)
356 pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
360 proc target-setup-2-dbselect {menu e} {
361 $menu configure -text $e
364 proc target-setup-leave-2 {target w} {
368 proc target-setup-db-add {target wp} {
369 set w .database-select
377 frame $w.top.database
379 pack $w.top.database -side top -anchor e -pady 2
381 entry-fields $w.top {database} \
382 {{Database to add:}} \
383 [list target-setup-db-add-action $target $wp] \
386 top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
390 proc target-setup-db-add-action {target wp} {
393 set w .database-select
395 set db [$w.top.database.entry get]
396 lappend profileS($target,databases) $db
399 target-setup-dblist-update $target $wp
402 proc target-setup-db-remove {target wp} {
408 set db [$wp.top.name.list get active]
410 set a [alert "Are you sure you want to remove the database ${db}?"]
412 set i [lsearch -exact $profileS($target,databases) $db]
414 set profileS($target,databases) \
415 [lreplace $profileS($target,databases) $i $i]
417 target-setup-dblist-update $target $wp
418 if {![llength $profileS($target,databases)]} {
419 unset profileS($target,databases)
424 proc target-setup-dblist-update {target w} {
429 $w.top.name.list delete 0 end
430 if {[info exists profileS($target,databases)]} {
431 foreach db $profileS($target,databases) {
432 $w.top.name.list insert end $db
434 $w.top.name.buttons.remove configure -state normal
435 $w.top.name.list see 0
436 $w.top.name.list select set 0
438 $w.top.name.buttons.remove configure -state disabled
442 proc target-setup-add {target w} {
447 proc target-setup-enter-2 {target w} {
450 wm title $w "$target - Other Information (not yet completed)"
452 frame $w.top.data -relief ridge -border 2
453 pack $w.top.data -pady 2 -padx 2 -side top -fill x
455 frame $w.top.data.avRecordSize
456 frame $w.top.data.maxRecordSize
458 pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
459 -side top -fill x -pady 2
461 entry-fieldsx 14 $w.top.data \
462 {avRecordSize maxRecordSize} \
463 {{Average Record Size:} {Max Record Size:}} \
464 [list target-setup $target 2 2] [list destroy $w]