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.4  1998-02-12 13:32:42  adam
  10 # Updated configuration system.
  11 #
  12 # Revision 1.3  1998/01/30 13:30:50  adam
  13 # Name of target database is irtdb.tcl instead of clientrc.tcl.
  14 #
  15 # Revision 1.2  1997/11/19 11:20:57  adam
  16 # New target profile format - associative arrrays instead of LONG lists.
  17 #
  18 # Revision 1.1  1996/09/13 10:54:25  adam
  19 # Started work on Explain in client.
  20 #
  21
  22 proc print-date {w msg date} {
  23     frame $w
  24     pack $w -side top -fill x
  25     label $w.a -text $msg
  26     pack $w.a -side left
  27
  28     if {[string length $date]} {
  29         label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
  30     } else {
  31         label $w.b -text Never
  32     }
  33     pack $w.b -side right
  34 }
  35
  36 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
  37     set alist {}
  38     set i 0
  39     foreach field $list {
  40         set label ${parent}.${field}.label
  41         set entry ${parent}.${field}.entry
  42         label $label -text [lindex $tlist $i]
  43         entry $entry -relief sunken -border 1 -width $width
  44         pack $label -side left
  45         pack $entry -side right
  46         lappend alist $entry
  47         incr i
  48     }
  49     bind-fields $alist $returnAction $escapeAction
  50 }
  51
  52 proc protocol-setup {target} {
  53     global profileS profile
  54
  55     foreach n [array names profile $target,*] {
  56         set profileS($n) $profile($n)
  57     }
  58     target-setup $target 0 0
  59 }
  60
  61 proc protocol-setup-action {target} {
  62     global profileS profile settingsChanged
  63
  64     set timedef $profileS($target,timeDefine)
  65     if {![string length $timedef]} {
  66         set timedef [clock seconds]
  67     }
  68
  69     foreach n [array names profileS $target,*] {
  70         set profile($n) $profileS($n)
  71         unset profileS($n)
  72     }
  73     set settingsChanged 1
  74
  75     cascade-target-list
  76     delete-target-hotlist $target
  77 }
  78
  79 proc target-setup-delete {target category dir} {
  80
  81     if {![string compare $target Default]} return
  82     set a [alert "Are you sure you want to delete the target \
  83 definition $target ?"]
  84     if {$a} {
  85         target-setup $target $category $dir
  86     }
  87 }
  88
  89 proc target-setup {target category dir} {
  90     global profile settingsChanged
  91
  92     set w .setup-$profile($target,windowNumber)
  93
  94     if {$dir} {
  95         target-setup-leave-$category $target $w
  96     }
  97     if {$dir == 3} {
  98         foreach n [array names profile $target,*] {
  99             unset profile($n)
 100         }
 101         set settingsChanged 1
 102         cascade-target-list
 103         delete-target-hotlist $target
 104         destroy $w
 105         return
 106     } elseif {$dir == 2} {
 107         protocol-setup-action $target
 108         destroy $w
 109         return
 110     } else {
 111         incr category $dir
 112         if {[winfo exists $w]} {
 113             destroy $w.top
 114             destroy $w.bot
 115         } else {
 116             toplevelG $w
 117             wm geometry $w 430x370
 118         }
 119         if {$target == ""} {
 120             set target Default
 121         }
 122         top-down-window $w
 123         bottom-buttons $w \
 124             [list {Ok} [list target-setup $target $category 2] \
 125                  {Previous} [list target-setup $target $category -1] \
 126                  {Next} [list target-setup $target $category 1] \
 127                  {Delete} [list target-setup-delete $target $category 3] \
 128                  {Cancel} [list destroy $w]] 0
 129         if {$category == 0} {
 130             $w.bot.2 configure -state disabled
 131         }
 132         if {$category == 2} {
 133             $w.bot.4 configure -state disabled
 134         }
 135         target-setup-enter-$category $target $w
 136     }
 137 }
 138
 139
 140 proc target-setup-leave-0 {target w} {
 141     global profileS
 142
 143     set y $w.top.hostport
 144
 145 }
 146
 147 proc target-setup-enter-0 {target w} {
 148     global profileS
 149
 150     wm title $w "$target - Initial Information"
 151
 152     # host/port/id . . .
 153     set y $w.top.hostport
 154     frame $y -relief ridge -border 2
 155     pack $y -padx 2 -pady 2 -side top -fill x
 156     frame $y.host
 157     frame $y.port
 158     frame $y.idAuthentication
 159
 160     pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
 161
 162     entry-fieldsx 34 $y \
 163             {host port idAuthentication} \
 164             {{Host:} {Port:} {Id Authentication:}} \
 165             [list target-setup $target 0 2] [list destroy $w]
 166
 167     $y.host.entry configure -textvariable \
 168         profileS($target,host)
 169     $y.port.entry configure -textvariable \
 170         profileS($target,port)
 171     $y.idAuthentication.entry configure -textvariable \
 172         profileS($target,idAuthentication)
 173
 174     # databases
 175
 176     frame $w.top.name -relief ridge -border 2
 177     pack $w.top.name -pady 2 -padx 2 -side bottom -fill both -expand yes
 178
 179     label $w.top.name.label -text "Databases"
 180     pack $w.top.name.label -side top -fill x
 181
 182     frame $w.top.name.buttons -border 2
 183     pack $w.top.name.buttons -side right
 184
 185     button $w.top.name.buttons.add -text "Add" -command \
 186         [list target-setup-db-add $target $w]
 187     button $w.top.name.buttons.remove -text "Remove" -state disabled \
 188         -command [list target-setup-db-remove $target $w]
 189     button $w.top.name.buttons.configure -text "Configure" -state disabled
 190     pack $w.top.name.buttons.add -side top -fill x
 191     pack $w.top.name.buttons.remove -side top -fill x
 192     pack $w.top.name.buttons.configure -side top -fill x
 193
 194     scrollbar $w.top.name.scroll -orient vertical -border 1
 195     listbox $w.top.name.list -border 1 -height 5 -yscrollcommand \
 196         [list $w.top.name.scroll set]
 197     pack $w.top.name.list -side left -padx 2 -pady 2 -fill both -expand yes
 198     pack $w.top.name.scroll -side right -padx 2 -pady 2 -fill y
 199     $w.top.name.scroll config -command [list $w.top.name.list yview]
 200
 201     target-setup-dblist-update $target $w
 202
 203     # misc. dates . . .
 204
 205     set y $w.top.dates
 206     frame $y -relief ridge -border 2
 207     pack $y -pady 2 -padx 2 -side left -fill both -expand yes
 208
 209     label $y.label -text "Dates"
 210     pack $y.label -side top -fill x
 211     print-date $w.top.dates.a {Defined:}      $profileS($target,timeDefine)
 212     print-date $w.top.dates.b {Last Access:}  $profileS($target,timeLastInit)
 213     print-date $w.top.dates.c {Last Explain:} $profileS($target,timeLastExplain)
 214
 215     # protocol . . .
 216
 217     set y $w.top.protocol
 218
 219     frame $y -relief ridge -border 2
 220     pack $y -pady 2 -padx 2 -side right -fill both
 221
 222     label $y.label -text "Protocol"
 223     radiobutton $y.z39v2 -text "Z39.50" -anchor w \
 224             -variable profileS($target,protocol) -value Z39
 225     radiobutton $y.sr -text "SR" -anchor w \
 226             -variable profileS($target,protocol) -value SR
 227
 228     pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
 229
 230     # transport/comstack . . .
 231
 232     set y $w.top.comstack
 233     frame $y -relief ridge -border 2
 234
 235     pack $y -pady 2 -padx 2 -side right -fill both
 236
 237     label $y.label -text "Transport"
 238     radiobutton $y.tcpip -text "TCP/IP" -anchor w \
 239             -variable profileS($target,comstack) -value tcpip
 240     radiobutton $y.mosi -text "MOSI" -anchor w\
 241             -variable profileS($target,comstack) -value mosi
 242     pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x
 243
 244 }
 245
 246 proc target-setup-leave-1 {target w} {
 247     global profileS
 248
 249     set y $w.top.nr
 250
 251     set profileS($target,targetInfoName) \
 252         [string trim [$y.name.text get 0.0 end]]
 253     set profileS($target,recentNews) \
 254         [string trim [$y.recentNews.text get 0.0 end]]
 255     set profileS($target,description) \
 256         [string trim [$y.description.text get 0.0 end]]
 257     set profileS($target,welcomeMessage) \
 258         [string trim [$y.welcome.text get 0.0 end]]
 259
 260     set y $w.top.rs
 261 }
 262
 263 proc target-setup-enter-1 {target w} {
 264     global profileS
 265
 266     wm title $w "$target - Target Information"
 267
 268     # Name, Recent News . . .
 269     set y $w.top.nr
 270     frame $y -relief ridge -border 2
 271     pack $y -side top -padx 2 -pady 2 -fill x
 272
 273     frame $y.name
 274     frame $y.recentNews
 275     frame $y.description
 276     frame $y.welcome
 277
 278     pack $y.name $y.recentNews $y.description $y.welcome \
 279             -side top -fill x -pady 2  -expand yes
 280
 281     label $y.name.label -text "Name" -width 15
 282     pack $y.name.label -side left
 283     text $y.name.text -width 40 -height 2 -relief sunken -border 1 \
 284             -wrap word
 285     TextEditable $y.name.text
 286     $y.name.text insert end $profileS($target,targetInfoName)
 287     pack $y.name.text -side right -fill x -expand yes
 288
 289     label $y.recentNews.label -text "Recent News" -width 15
 290     pack $y.recentNews.label -side left
 291     text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \
 292             -wrap word
 293     TextEditable $y.recentNews.text
 294     $y.recentNews.text insert end $profileS($target,recentNews)
 295     pack $y.recentNews.text -side right -fill x -expand yes
 296
 297     label $y.description.label -text "Description" -width 15
 298     pack $y.description.label -side left
 299     text $y.description.text -width 40 -height 4 -relief sunken -border 1 \
 300             -wrap word
 301     TextEditable $y.description.text
 302     $y.description.text insert end $profileS($target,description)
 303     pack $y.description.text -side right -fill x -expand yes
 304
 305     label $y.welcome.label -text "Welcome Message" -width 15
 306     pack $y.welcome.label -side left
 307     text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \
 308             -wrap word
 309     TextEditable $y.welcome.text
 310     $y.welcome.text insert end $profileS($target,welcomeMessage)
 311     pack $y.welcome.text -side right -fill x -expand yes
 312
 313     # Result Sets Size, numbers, etc. . . .
 314     set y $w.top.rs
 315
 316     frame $y -relief ridge -border 2
 317     pack $y -side left -padx 2 -pady 2 -fill y
 318
 319     frame $y.maxResultSets
 320     frame $y.maxResultSize
 321     frame $y.maxTerms
 322
 323     pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
 324             -side top -fill x -pady 2
 325
 326     entry-fieldsx 10 $y \
 327             {maxResultSets maxResultSize maxTerms} \
 328             {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \
 329             [list target-setup $target 1 2] [list destroy $w]
 330
 331     $y.maxResultSets.entry configure \
 332         -textvariable profileS($target,targetMaxResultSets)
 333     $y.maxResultSize.entry configure \
 334         -textvariable profileS($target,targetMaxResultSize)
 335     $y.maxTerms.entry configure \
 336         -textvariable profileS($target,targetMaxTerms)
 337
 338     # Checkbuttons . . .
 339     set y $w.top.ns
 340
 341     frame $y -relief ridge -border 2
 342     pack $y -side right -padx 2 -pady 2 -fill both -expand yes
 343
 344     checkbutton $y.resultSets -text "Named Result Sets" \
 345             -anchor n -variable profileS($target,namedResultSets)
 346
 347     checkbutton $y.multipleDatabases -text "Multiple Database Search" \
 348             -anchor n -variable profileS($target,multipleDatabases)
 349
 350     pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
 351
 352 }
 353
 354 proc target-setup-2-dbselect {menu e} {
 355     $menu configure -text $e
 356 }
 357
 358 proc target-setup-leave-2 {target w} {
 359     global profileS
 360 }
 361
 362 proc target-setup-db-add {target wp} {
 363     set w .database-select
 364     toplevel $w
 365     set oldFocus [focus]
 366
 367     place-force $w $wp
 368
 369     top-down-window $w
 370
 371     frame $w.top.database
 372
 373     pack $w.top.database -side top -anchor e -pady 2
 374
 375     entry-fields $w.top {database} \
 376             {{Database to add:}} \
 377             [list target-setup-db-add-action $target $wp] \
 378             [list destroy $w]
 379
 380     top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
 381     focus $oldFocus
 382 }
 383
 384 proc target-setup-db-add-action {target wp} {
 385     global profileS
 386
 387     set w .database-select
 388
 389     set db [$w.top.database.entry get]
 390     lappend profileS($target,databases) $db
 391
 392     destroy $w
 393     target-setup-dblist-update $target $wp
 394 }
 395
 396 proc target-setup-db-remove {target wp} {
 397     global profileS
 398
 399     set w .setup100
 400     set y $w.top.name
 401
 402     set db [$wp.top.name.list get active]
 403
 404     set a [alert "Are you sure you want to remove the database ${db}?"]
 405     if {$a} {
 406         set i [lsearch -exact $profileS($target,databases) $db]
 407         if {$i >= 0} {
 408             set profileS($target,databases) \
 409                     [lreplace $profileS($target,databases) $i $i]
 410         }
 411         target-setup-dblist-update $target $wp
 412         if {![llength $profileS($target,databases)]} {
 413             unset profileS($target,databases)
 414             puts removed
 415         }
 416     }
 417 }
 418
 419 proc target-setup-dblist-update {target w} {
 420     global profileS
 421
 422     set y $w.top.name
 423
 424     $w.top.name.list delete 0 end
 425     if {[info exists profileS($target,databases)]} {
 426         foreach db $profileS($target,databases) {
 427             $w.top.name.list insert end $db
 428         }
 429         $w.top.name.buttons.remove configure -state normal
 430         $w.top.name.list see 0
 431         $w.top.name.list select set 0
 432     } else {
 433         $w.top.name.buttons.remove configure -state disabled
 434     }
 435 }
 436
 437 proc target-setup-add {target w} {
 438
 439
 440 }
 441
 442 proc target-setup-enter-2 {target w} {
 443     global profileS
 444
 445     wm title $w "$target - Other Information (not yet completed)"
 446
 447     frame $w.top.data -relief ridge -border 2
 448     pack $w.top.data -pady 2 -padx 2 -side top -fill x
 449
 450     frame $w.top.data.avRecordSize
 451     frame $w.top.data.maxRecordSize
 452
 453     pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
 454             -side top -fill x -pady 2
 455
 456     entry-fieldsx 14 $w.top.data \
 457             {avRecordSize maxRecordSize} \
 458             {{Average Record Size:} {Max Record Size:}} \
 459             [list target-setup $target 2 2] [list destroy $w]
 460 }