setup.tcl

   1 # IR toolkit for tcl/tk
   2 # (c) Index Data 1995-1998
   3 # See the file LICENSE for details.
   4 # Sebastian Hammer, Adam Dickmeiss
   5 #
   6 # Configuration Driver
   7 #
   8 # $Log: setup.tcl,v $
   9 # Revision 1.6  1999-12-12 00:25:59  adam
  10 # Updated list of preconfigure targets.
  11 #
  12 # Revision 1.5  1998/04/02 14:32:01  adam
  13 # Minor changes to EXPLAIN driver.
  14 #
  15 # Revision 1.4  1998/02/12 13:32:42  adam
  16 # Updated configuration system.
  17 #
  18 # Revision 1.3  1998/01/30 13:30:50  adam
  19 # Name of target database is irtdb.tcl instead of clientrc.tcl.
  20 #
  21 # Revision 1.2  1997/11/19 11:20:57  adam
  22 # New target profile format - associative arrrays instead of LONG lists.
  23 #
  24 # Revision 1.1  1996/09/13 10:54:25  adam
  25 # Started work on Explain in client.
  26 #
  27
  28 proc print-date {w msg date} {
  29     frame $w
  30     pack $w -side top -fill x
  31     label $w.a -text $msg
  32     pack $w.a -side left
  33
  34     if {[string length $date]} {
  35         label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
  36     } else {
  37         label $w.b -text Never
  38     }
  39     pack $w.b -side right
  40 }
  41
  42 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
  43     set alist {}
  44     set i 0
  45     foreach field $list {
  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
  52         lappend alist $entry
  53         incr i
  54     }
  55     bind-fields $alist $returnAction $escapeAction
  56 }
  57
  58 proc protocol-setup {target} {
  59     global profileS profile
  60
  61     foreach n [array names profile $target,*] {
  62         set profileS($n) $profile($n)
  63     }
  64     target-setup $target 0 0
  65 }
  66
  67 proc protocol-setup-action {target} {
  68     global profileS profile settingsChanged
  69
  70     set timedef $profileS($target,timeDefine)
  71     if {![string length $timedef]} {
  72         set profileS($target,timeDefine) [clock seconds]
  73     }
  74
  75     foreach n [array names profileS $target,*] {
  76         set profile($n) $profileS($n)
  77         unset profileS($n)
  78     }
  79     set settingsChanged 1
  80
  81     cascade-target-list
  82     delete-target-hotlist $target
  83 }
  84
  85 proc target-setup-delete {target category dir} {
  86
  87     if {![string compare $target Default]} return
  88     set a [alert "Are you sure you want to delete the target \
  89 definition $target ?"]
  90     if {$a} {
  91         target-setup $target $category $dir
  92     }
  93 }
  94
  95 proc target-setup {target category dir} {
  96     global profile settingsChanged
  97
  98     set w .setup-$profile($target,windowNumber)
  99
 100     if {$dir} {
 101         target-setup-leave-$category $target $w
 102     }
 103     if {$dir == 3} {
 104         foreach n [array names profile $target,*] {
 105             unset profile($n)
 106         }
 107         set settingsChanged 1
 108         cascade-target-list
 109         delete-target-hotlist $target
 110         destroy $w
 111         return
 112     } elseif {$dir == 2} {
 113         protocol-setup-action $target
 114         destroy $w
 115         return
 116     } else {
 117         incr category $dir
 118         if {[winfo exists $w]} {
 119             destroy $w.top
 120             destroy $w.bot
 121         } else {
 122             toplevelG $w
 123             wm geometry $w 430x370
 124         }
 125         if {$target == ""} {
 126             set target Default
 127         }
 128         top-down-window $w
 129         bottom-buttons $w \
 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
 137         }
 138         if {$category == 2} {
 139             $w.bot.4 configure -state disabled
 140         }
 141         target-setup-enter-$category $target $w
 142     }
 143 }
 144
 145
 146 proc target-setup-leave-0 {target w} {
 147     global profileS
 148
 149     set y $w.top.hostport
 150
 151 }
 152
 153 proc target-setup-enter-0 {target w} {
 154     global profileS
 155
 156     wm title $w "$target - Initial Information"
 157
 158     # host/port/id . . .
 159     set y $w.top.hostport
 160     frame $y -relief ridge -border 2
 161     pack $y -padx 2 -pady 2 -side top -fill x
 162     frame $y.host
 163     frame $y.port
 164     frame $y.idAuthentication
 165
 166     pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
 167
 168     entry-fieldsx 34 $y \
 169             {host port idAuthentication} \
 170             {{Host:} {Port:} {Id Authentication:}} \
 171             [list target-setup $target 0 2] [list destroy $w]
 172
 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)
 179
 180     # databases
 181
 182     frame $w.top.name -relief ridge -border 2
 183     pack $w.top.name -pady 2 -padx 2 -side bottom -fill both -expand yes
 184
 185     label $w.top.name.label -text "Databases"
 186     pack $w.top.name.label -side top -fill x
 187
 188     frame $w.top.name.buttons -border 2
 189     pack $w.top.name.buttons -side right
 190
 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
 199
 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]
 206
 207     target-setup-dblist-update $target $w
 208
 209     # misc. dates . . .
 210
 211     set y $w.top.dates
 212     frame $y -relief ridge -border 2
 213     pack $y -pady 2 -padx 2 -side left -fill both -expand yes
 214
 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)
 220
 221     # protocol . . .
 222
 223     set y $w.top.protocol
 224
 225     frame $y -relief ridge -border 2
 226     pack $y -pady 2 -padx 2 -side right -fill both
 227
 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
 233
 234     pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
 235
 236     # transport/comstack . . .
 237
 238     set y $w.top.comstack
 239     frame $y -relief ridge -border 2
 240
 241     pack $y -pady 2 -padx 2 -side right -fill both
 242
 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
 249
 250 }
 251
 252 proc target-setup-leave-1 {target w} {
 253     global profileS
 254
 255     set y $w.top.nr
 256
 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]]
 265
 266     set y $w.top.rs
 267 }
 268
 269 proc target-setup-enter-1 {target w} {
 270     global profileS
 271
 272     wm title $w "$target - Target Information"
 273
 274     # Name, Recent News . . .
 275     set y $w.top.nr
 276     frame $y -relief ridge -border 2
 277     pack $y -side top -padx 2 -pady 2 -fill x
 278
 279     frame $y.name
 280     frame $y.recentNews
 281     frame $y.description
 282     frame $y.welcome
 283
 284     pack $y.name $y.recentNews $y.description $y.welcome \
 285             -side top -fill x -pady 2  -expand yes
 286
 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 \
 290             -wrap word
 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
 294
 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 \
 298             -wrap word
 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
 302
 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 \
 306             -wrap word
 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
 310
 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 \
 314             -wrap word
 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
 318
 319     # Result Sets Size, numbers, etc. . . .
 320     set y $w.top.rs
 321
 322     frame $y -relief ridge -border 2
 323     pack $y -side left -padx 2 -pady 2 -fill y
 324
 325     frame $y.maxResultSets
 326     frame $y.maxResultSize
 327     frame $y.maxTerms
 328
 329     pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
 330             -side top -fill x -pady 2
 331
 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]
 336
 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)
 343
 344     # Checkbuttons . . .
 345     set y $w.top.ns
 346
 347     frame $y -relief ridge -border 2
 348     pack $y -side right -padx 2 -pady 2 -fill both -expand yes
 349
 350     checkbutton $y.resultSets -text "Named Result Sets" \
 351             -anchor n -variable profileS($target,namedResultSets)
 352
 353     checkbutton $y.multipleDatabases -text "Multiple Database Search" \
 354             -anchor n -variable profileS($target,multipleDatabases)
 355
 356     pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
 357
 358 }
 359
 360 proc target-setup-2-dbselect {menu e} {
 361     $menu configure -text $e
 362 }
 363
 364 proc target-setup-leave-2 {target w} {
 365     global profileS
 366 }
 367
 368 proc target-setup-db-add {target wp} {
 369     set w .database-select
 370     toplevel $w
 371     set oldFocus [focus]
 372
 373     place-force $w $wp
 374
 375     top-down-window $w
 376
 377     frame $w.top.database
 378
 379     pack $w.top.database -side top -anchor e -pady 2
 380
 381     entry-fields $w.top {database} \
 382             {{Database to add:}} \
 383             [list target-setup-db-add-action $target $wp] \
 384             [list destroy $w]
 385
 386     top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
 387     focus $oldFocus
 388 }
 389
 390 proc target-setup-db-add-action {target wp} {
 391     global profileS
 392
 393     set w .database-select
 394
 395     set db [$w.top.database.entry get]
 396     lappend profileS($target,databases) $db
 397
 398     destroy $w
 399     target-setup-dblist-update $target $wp
 400 }
 401
 402 proc target-setup-db-remove {target wp} {
 403     global profileS
 404
 405     set w .setup100
 406     set y $w.top.name
 407
 408     set db [$wp.top.name.list get active]
 409
 410     set a [alert "Are you sure you want to remove the database ${db}?"]
 411     if {$a} {
 412         set i [lsearch -exact $profileS($target,databases) $db]
 413         if {$i >= 0} {
 414             set profileS($target,databases) \
 415                     [lreplace $profileS($target,databases) $i $i]
 416         }
 417         target-setup-dblist-update $target $wp
 418         if {![llength $profileS($target,databases)]} {
 419             unset profileS($target,databases)
 420         }
 421     }
 422 }
 423
 424 proc target-setup-dblist-update {target w} {
 425     global profileS
 426
 427     set y $w.top.name
 428
 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
 433         }
 434         $w.top.name.buttons.remove configure -state normal
 435         $w.top.name.list see 0
 436         $w.top.name.list select set 0
 437     } else {
 438         $w.top.name.buttons.remove configure -state disabled
 439     }
 440 }
 441
 442 proc target-setup-add {target w} {
 443
 444
 445 }
 446
 447 proc target-setup-enter-2 {target w} {
 448     global profileS
 449
 450     wm title $w "$target - Other Information (not yet completed)"
 451
 452     frame $w.top.data -relief ridge -border 2
 453     pack $w.top.data -pady 2 -padx 2 -side top -fill x
 454
 455     frame $w.top.data.avRecordSize
 456     frame $w.top.data.maxRecordSize
 457
 458     pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
 459             -side top -fill x -pady 2
 460
 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]
 465 }