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.2 1997-11-19 11:20:57 adam
8 # New target profile format - associative arrrays instead of LONG lists.
10 # Revision 1.1 1996/09/13 10:54:25 adam
11 # Started work on Explain in client.
14 proc print-date {w msg date} {
16 pack $w -side top -fill x
20 if {[string length $date]} {
21 label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
23 label $w.b -text Never
28 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
32 set label ${parent}.${field}.label
33 set entry ${parent}.${field}.entry
34 label $label -text [lindex $tlist $i]
35 entry $entry -relief sunken -border 1 -width $width
36 pack $label -side left
37 pack $entry -side right
41 bind-fields $alist $returnAction $escapeAction
44 proc protocol-setup {target} {
45 global profileS profile
47 foreach n [array names profile $target,*] {
48 set profileS($n) $profile($n)
50 target-setup $target 0 0
53 proc protocol-setup-action {target} {
54 global profileS profile settingsChanged
56 set timedef $profileS($target,timeDefine)
57 if {![string length $timedef]} {
58 set timedef [clock seconds]
61 foreach n [array names profileS $target,*] {
62 set profile($n) $profileS($n)
68 delete-target-hotlist $target
71 proc target-setup {target category dir} {
75 target-setup-leave-$category $target
78 protocol-setup-action $target
83 if {[winfo exists $w]} {
88 wm geometry $w 430x400
94 bottom-buttons $w [list \
95 {Ok} [list target-setup $target $category 2] \
96 {Previous} [list target-setup $target $category -1] \
97 {Next} [list target-setup $target $category 1] \
98 {Cancel} [list destroy $w]] 0
100 $w.bot.2 configure -state disabled
102 if {$category == 2} {
103 $w.bot.4 configure -state disabled
105 target-setup-enter-$category $target
109 proc target-setup-leave-0 {target} {
113 set y $w.top.hostport
117 proc target-setup-enter-0 {target} {
122 wm title $w "$target - Initial Information"
125 set y $w.top.hostport
126 frame $y -relief ridge -border 2
127 pack $y -padx 2 -pady 2 -side top -fill x
130 frame $y.idAuthentication
132 pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
134 entry-fieldsx 34 $y \
135 {host port idAuthentication} \
136 {{Host:} {Port:} {Id Authentication:}} \
137 [list target-setup $target 0 2] [list destroy $w]
139 $y.host.entry configure -textvariable \
140 profileS($target,host)
141 $y.port.entry configure -textvariable \
142 profileS($target,port)
143 $y.idAuthentication.entry configure -textvariable \
144 profileS($target,idAuthentication)
151 pack $y -side bottom -fill both -expand yes
156 frame $y -relief ridge -border 2
157 pack $y -pady 2 -padx 2 -side left -fill both -expand yes
159 label $y.label -text "Dates"
160 pack $y.label -side top -fill x
161 print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine)
162 print-date $w.top.dates.b {Last Access:} $profileS($target,timeLastInit)
163 print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
167 set y $w.top.protocol
169 frame $y -relief ridge -border 2
170 pack $y -pady 2 -padx 2 -side right -fill both
172 label $y.label -text "Protocol"
173 radiobutton $y.z39v2 -text "Z39.50" -anchor w \
174 -variable profileS($target,protocol) -value Z39
175 radiobutton $y.sr -text "SR" -anchor w \
176 -variable profileS($target,protocol) -value SR
178 pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
180 # transport/comstack . . .
182 set y $w.top.comstack
183 frame $y -relief ridge -border 2
185 pack $y -pady 2 -padx 2 -side right -fill both
187 label $y.label -text "Transport"
188 radiobutton $y.tcpip -text "TCP/IP" -anchor w \
189 -variable profileS($target,comstack) -value tcpip
190 radiobutton $y.mosi -text "MOSI" -anchor w\
191 -variable profileS($target,comstack) -value mosi
192 pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
195 proc target-setup-leave-1 {target} {
201 set profileS($target,targetInfoName) [$y.name.text get 0.0 end]
202 set profileS($target,recentNews) [$y.recentNews.text get 0.0 end]
203 set profileS($target,description) [$y.description.text get 0.0 end]
204 set profileS($target,welcomeMessage) [$y.welcome.text get 0.0 end]
209 proc target-setup-enter-1 {target} {
214 wm title $w "$target - Target Information"
216 # Name, Recent News . . .
218 frame $y -relief ridge -border 2
219 pack $y -side top -padx 2 -pady 2 -fill x
226 pack $y.name $y.recentNews $y.description $y.welcome \
227 -side top -fill x -pady 2 -expand yes
229 label $y.name.label -text "Name" -width 15
230 pack $y.name.label -side left
231 text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
233 TextEditable $y.name.text
234 $y.name.text insert end $profileS($target,targetInfoName)
235 pack $y.name.text -side right -fill x -expand yes
237 label $y.recentNews.label -text "Recent News" -width 15
238 pack $y.recentNews.label -side left
239 text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
241 TextEditable $y.recentNews.text
242 $y.recentNews.text insert end $profileS($target,recentNews)
243 pack $y.recentNews.text -side right -fill x -expand yes
245 label $y.description.label -text "Description" -width 15
246 pack $y.description.label -side left
247 text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
249 TextEditable $y.description.text
250 $y.description.text insert end $profileS($target,description)
251 pack $y.description.text -side right -fill x -expand yes
253 label $y.welcome.label -text "Welcome Message" -width 15
254 pack $y.welcome.label -side left
255 text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
257 TextEditable $y.welcome.text
258 $y.welcome.text insert end $profileS($target,welcomeMessage)
259 pack $y.welcome.text -side right -fill x -expand yes
261 # Result Sets Size, numbers, etc. . . .
264 frame $y -relief ridge -border 2
265 pack $y -side left -padx 2 -pady 2 -fill y
267 frame $y.maxResultSets
268 frame $y.maxResultSize
271 pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
272 -side top -fill x -pady 2
274 entry-fieldsx 10 $y \
275 {maxResultSets maxResultSize maxTerms} \
276 {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
277 [list target-setup $target 1 2] [list destroy $w]
279 $y.maxResultSets.entry configure \
280 -textvariable profileS($target,targetMaxResultSets)
281 $y.maxResultSize.entry configure \
282 -textvariable profileS($target,targetMaxResultSize)
283 $y.maxTerms.entry configure \
284 -textvariable profileS($target,targetMaxTerms)
289 frame $y -relief ridge -border 2
290 pack $y -side right -padx 2 -pady 2 -fill both -expand yes
292 checkbutton $y.resultSets -text "Named Result Sets" \
293 -anchor n -variable profileS($target,namedResultSets)
295 checkbutton $y.multipleDatabases -text "Multiple Database Search" \
296 -anchor n -variable profileS($target,multipleDatabases)
298 pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
302 proc target-setup-2-dbselect {menu e} {
303 $menu configure -text $e
306 proc target-setup-leave-2 {target} {
310 proc target-setup-db-add {target wp} {
311 set w .database-select
319 frame $w.top.database
321 pack $w.top.database -side top -anchor e -pady 2
323 entry-fields $w.top {database} \
324 {{Database to add:}} \
325 [list target-setup-db-add-action $target $wp] \
328 top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
332 proc target-setup-db-add-action {target wp} {
335 set w .database-select
337 set db [$w.top.database.entry get]
338 lappend profileS($target,databases) $db
341 target-setup-dblist-update $target
344 proc target-setup-db-remove {target wp} {
350 set db [$y.data cget -text]
351 set a [alert "Are you sure you want to remove the database ${db}?"]
353 set i [lsearch -exact $profileS($target,databases) $db]
355 set profileS($target,databases) \
356 [lreplace $profileS($target,databases) $i $i]
358 target-setup-dblist-update $target
359 if {![llength $profileS($target,databases)]} {
360 unset profileS($target,databases)
366 proc target-setup-dblist-update {target} {
373 if {[info exists profileS($target,databases)]} {
374 set databaseList $profileS($target,databases)
375 $y.data configure -text [lindex $databaseList 0]
376 $y.data.m delete 0 100
377 foreach d $databaseList {
378 $y.data.m add command -label $d -command \
379 [list target-setup-2-dbselect $y.data $d]
384 $y.remove configure -state disabled
386 $y.remove configure -state normal
390 proc target-setup-enter-2 {target} {
395 wm title $w "$target - Database Information"
397 frame $w.top.name -border 2
398 pack $w.top.name -pady 2 -padx 2 -side top -fill x
400 label $w.top.name.label -text "Database Name"
402 pack $w.top.name.label -side left
403 menubutton $w.top.name.data -menu $w.top.name.data.m -relief raised
404 irmenu $w.top.name.data.m
406 pack $w.top.name.data -side left
408 button $w.top.name.add -text "Add" -command \
409 [list target-setup-db-add $target $w]
410 pack $w.top.name.add -side right
412 button $w.top.name.remove -text "Remove" -command \
413 [list target-setup-db-remove $target $w]
414 pack $w.top.name.remove -side right
416 frame $w.top.data -relief ridge -border 2
417 pack $w.top.data -pady 2 -padx 2 -side top -fill x
419 target-setup-dblist-update $target
421 frame $w.top.data.avRecordSize
422 frame $w.top.data.maxRecordSize
424 pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
425 -side top -fill x -pady 2
427 entry-fieldsx 14 $w.top.data \
428 {avRecordSize maxRecordSize} \
429 {{Average Record Size:} {Max Record Size:}} \
430 [list target-setup $target 2 2] [list destroy $w]