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