1 # IR toolkit for tcl/tk
2 # (c) Index Data 1995-1998
3 # See the file LICENSE for details.
4 # Sebastian Hammer, Adam Dickmeiss
7 # Revision 1.3 1998-01-30 13:30:50 adam
8 # Name of target database is irtdb.tcl instead of clientrc.tcl.
10 # Revision 1.2 1997/11/19 11:20:57 adam
11 # New target profile format - associative arrrays instead of LONG lists.
13 # Revision 1.1 1996/09/13 10:54:25 adam
14 # Started work on Explain in client.
17 proc print-date {w msg date} {
19 pack $w -side top -fill x
23 if {[string length $date]} {
24 label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
26 label $w.b -text Never
31 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
35 set label ${parent}.${field}.label
36 set entry ${parent}.${field}.entry
37 label $label -text [lindex $tlist $i]
38 entry $entry -relief sunken -border 1 -width $width
39 pack $label -side left
40 pack $entry -side right
44 bind-fields $alist $returnAction $escapeAction
47 proc protocol-setup {target} {
48 global profileS profile
50 foreach n [array names profile $target,*] {
51 set profileS($n) $profile($n)
53 target-setup $target 0 0
56 proc protocol-setup-action {target} {
57 global profileS profile settingsChanged
59 set timedef $profileS($target,timeDefine)
60 if {![string length $timedef]} {
61 set timedef [clock seconds]
64 foreach n [array names profileS $target,*] {
65 set profile($n) $profileS($n)
71 delete-target-hotlist $target
74 proc target-setup {target category dir} {
78 target-setup-leave-$category $target
81 protocol-setup-action $target
86 if {[winfo exists $w]} {
91 wm geometry $w 430x400
97 bottom-buttons $w [list \
98 {Ok} [list target-setup $target $category 2] \
99 {Previous} [list target-setup $target $category -1] \
100 {Next} [list target-setup $target $category 1] \
101 {Cancel} [list destroy $w]] 0
102 if {$category == 0} {
103 $w.bot.2 configure -state disabled
105 if {$category == 2} {
106 $w.bot.4 configure -state disabled
108 target-setup-enter-$category $target
112 proc target-setup-leave-0 {target} {
116 set y $w.top.hostport
120 proc target-setup-enter-0 {target} {
125 wm title $w "$target - Initial Information"
128 set y $w.top.hostport
129 frame $y -relief ridge -border 2
130 pack $y -padx 2 -pady 2 -side top -fill x
133 frame $y.idAuthentication
135 pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
137 entry-fieldsx 34 $y \
138 {host port idAuthentication} \
139 {{Host:} {Port:} {Id Authentication:}} \
140 [list target-setup $target 0 2] [list destroy $w]
142 $y.host.entry configure -textvariable \
143 profileS($target,host)
144 $y.port.entry configure -textvariable \
145 profileS($target,port)
146 $y.idAuthentication.entry configure -textvariable \
147 profileS($target,idAuthentication)
154 pack $y -side bottom -fill both -expand yes
159 frame $y -relief ridge -border 2
160 pack $y -pady 2 -padx 2 -side left -fill both -expand yes
162 label $y.label -text "Dates"
163 pack $y.label -side top -fill x
164 print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
165 print-date $w.top.dates.b {Last Access:} $profileS($target,timeLastInit)
166 print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
170 set y $w.top.protocol
172 frame $y -relief ridge -border 2
173 pack $y -pady 2 -padx 2 -side right -fill both
175 label $y.label -text "Protocol"
176 radiobutton $y.z39v2 -text "Z39.50" -anchor w \
177 -variable profileS($target,protocol) -value Z39
178 radiobutton $y.sr -text "SR" -anchor w \
179 -variable profileS($target,protocol) -value SR
181 pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
183 # transport/comstack . . .
185 set y $w.top.comstack
186 frame $y -relief ridge -border 2
188 pack $y -pady 2 -padx 2 -side right -fill both
190 label $y.label -text "Transport"
191 radiobutton $y.tcpip -text "TCP/IP" -anchor w \
192 -variable profileS($target,comstack) -value tcpip
193 radiobutton $y.mosi -text "MOSI" -anchor w\
194 -variable profileS($target,comstack) -value mosi
195 pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
198 proc target-setup-leave-1 {target} {
204 set profileS($target,targetInfoName) \
205 [string trim [$y.name.text get 0.0 end]]
206 set profileS($target,recentNews) \
207 [string trim [$y.recentNews.text get 0.0 end]]
208 set profileS($target,description) \
209 [string trim [$y.description.text get 0.0 end]]
210 set profileS($target,welcomeMessage) \
211 [string trim [$y.welcome.text get 0.0 end]]
216 proc target-setup-enter-1 {target} {
221 wm title $w "$target - Target Information"
223 # Name, Recent News . . .
225 frame $y -relief ridge -border 2
226 pack $y -side top -padx 2 -pady 2 -fill x
233 pack $y.name $y.recentNews $y.description $y.welcome \
234 -side top -fill x -pady 2 -expand yes
236 label $y.name.label -text "Name" -width 15
237 pack $y.name.label -side left
238 text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
240 TextEditable $y.name.text
241 $y.name.text insert end $profileS($target,targetInfoName)
242 pack $y.name.text -side right -fill x -expand yes
244 label $y.recentNews.label -text "Recent News" -width 15
245 pack $y.recentNews.label -side left
246 text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
248 TextEditable $y.recentNews.text
249 $y.recentNews.text insert end $profileS($target,recentNews)
250 pack $y.recentNews.text -side right -fill x -expand yes
252 label $y.description.label -text "Description" -width 15
253 pack $y.description.label -side left
254 text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
256 TextEditable $y.description.text
257 $y.description.text insert end $profileS($target,description)
258 pack $y.description.text -side right -fill x -expand yes
260 label $y.welcome.label -text "Welcome Message" -width 15
261 pack $y.welcome.label -side left
262 text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
264 TextEditable $y.welcome.text
265 $y.welcome.text insert end $profileS($target,welcomeMessage)
266 pack $y.welcome.text -side right -fill x -expand yes
268 # Result Sets Size, numbers, etc. . . .
271 frame $y -relief ridge -border 2
272 pack $y -side left -padx 2 -pady 2 -fill y
274 frame $y.maxResultSets
275 frame $y.maxResultSize
278 pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
279 -side top -fill x -pady 2
281 entry-fieldsx 10 $y \
282 {maxResultSets maxResultSize maxTerms} \
283 {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
284 [list target-setup $target 1 2] [list destroy $w]
286 $y.maxResultSets.entry configure \
287 -textvariable profileS($target,targetMaxResultSets)
288 $y.maxResultSize.entry configure \
289 -textvariable profileS($target,targetMaxResultSize)
290 $y.maxTerms.entry configure \
291 -textvariable profileS($target,targetMaxTerms)
296 frame $y -relief ridge -border 2
297 pack $y -side right -padx 2 -pady 2 -fill both -expand yes
299 checkbutton $y.resultSets -text "Named Result Sets" \
300 -anchor n -variable profileS($target,namedResultSets)
302 checkbutton $y.multipleDatabases -text "Multiple Database Search" \
303 -anchor n -variable profileS($target,multipleDatabases)
305 pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
309 proc target-setup-2-dbselect {menu e} {
310 $menu configure -text $e
313 proc target-setup-leave-2 {target} {
317 proc target-setup-db-add {target wp} {
318 set w .database-select
326 frame $w.top.database
328 pack $w.top.database -side top -anchor e -pady 2
330 entry-fields $w.top {database} \
331 {{Database to add:}} \
332 [list target-setup-db-add-action $target $wp] \
335 top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
339 proc target-setup-db-add-action {target wp} {
342 set w .database-select
344 set db [$w.top.database.entry get]
345 lappend profileS($target,databases) $db
348 target-setup-dblist-update $target
351 proc target-setup-db-remove {target wp} {
357 set db [$y.data cget -text]
358 set a [alert "Are you sure you want to remove the database ${db}?"]
360 set i [lsearch -exact $profileS($target,databases) $db]
362 set profileS($target,databases) \
363 [lreplace $profileS($target,databases) $i $i]
365 target-setup-dblist-update $target
366 if {![llength $profileS($target,databases)]} {
367 unset profileS($target,databases)
373 proc target-setup-dblist-update {target} {
380 if {[info exists profileS($target,databases)]} {
381 set databaseList $profileS($target,databases)
382 $y.data configure -text [lindex $databaseList 0]
383 $y.data.m delete 0 100
384 foreach d $databaseList {
385 $y.data.m add command -label $d -command \
386 [list target-setup-2-dbselect $y.data $d]
391 $y.remove configure -state disabled
393 $y.remove configure -state normal
397 proc target-setup-enter-2 {target} {
402 wm title $w "$target - Database Information"
404 frame $w.top.name -border 2
405 pack $w.top.name -pady 2 -padx 2 -side top -fill x
407 label $w.top.name.label -text "Database Name"
409 pack $w.top.name.label -side left
410 menubutton $w.top.name.data -menu $w.top.name.data.m -relief raised
411 irmenu $w.top.name.data.m
413 pack $w.top.name.data -side left
415 button $w.top.name.add -text "Add" -command \
416 [list target-setup-db-add $target $w]
417 pack $w.top.name.add -side right
419 button $w.top.name.remove -text "Remove" -command \
420 [list target-setup-db-remove $target $w]
421 pack $w.top.name.remove -side right
423 frame $w.top.data -relief ridge -border 2
424 pack $w.top.data -pady 2 -padx 2 -side top -fill x
426 target-setup-dblist-update $target
428 frame $w.top.data.avRecordSize
429 frame $w.top.data.maxRecordSize
431 pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
432 -side top -fill x -pady 2
434 entry-fieldsx 14 $w.top.data \
435 {avRecordSize maxRecordSize} \
436 {{Average Record Size:} {Max Record Size:}} \
437 [list target-setup $target 2 2] [list destroy $w]