setup.tcl

   1 # IR toolkit for tcl/tk
   2 # (c) Index Data 1995-1996
   3 # See the file LICENSE for details.
   4 # Sebastian Hammer, Adam Dickmeiss
   5 #
   6 # $Log: setup.tcl,v $
   7 # Revision 1.2  1997-11-19 11:20:57  adam
   8 # New target profile format - associative arrrays instead of LONG lists.
   9 #
  10 # Revision 1.1  1996/09/13 10:54:25  adam
  11 # Started work on Explain in client.
  12 #
  13
  14 proc print-date {w msg date} {
  15     frame $w
  16     pack $w -side top -fill x
  17     label $w.a -text $msg
  18     pack $w.a -side left
  19
  20     if {[string length $date]} {
  21         label $w.b -text [clock format $date -format "%b %d %y %H:%M "]
  22     } else {
  23         label $w.b -text Never
  24     }
  25     pack $w.b -side right
  26 }
  27
  28 proc entry-fieldsx {width parent list tlist returnAction escapeAction} {
  29     set alist {}
  30     set i 0
  31     foreach field $list {
  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
  38         lappend alist $entry
  39         incr i
  40     }
  41     bind-fields $alist $returnAction $escapeAction
  42 }
  43
  44 proc protocol-setup {target} {
  45     global profileS profile
  46
  47     foreach n [array names profile $target,*] {
  48         set profileS($n) $profile($n)
  49     }
  50     target-setup $target 0 0
  51 }
  52
  53 proc protocol-setup-action {target} {
  54     global profileS profile settingsChanged
  55
  56     set timedef $profileS($target,timeDefine)
  57     if {![string length $timedef]} {
  58         set timedef [clock seconds]
  59     }
  60
  61     foreach n [array names profileS $target,*] {
  62         set profile($n) $profileS($n)
  63         unset profileS($n)
  64     }
  65     set settingsChanged 1
  66
  67     cascade-target-list
  68     delete-target-hotlist $target
  69 }
  70
  71 proc target-setup {target category dir} {
  72
  73     set w .setup100
  74     if {$dir} {
  75         target-setup-leave-$category $target
  76     }
  77     if {$dir == 2} {
  78         protocol-setup-action $target
  79         destroy $w
  80         return
  81     }
  82     incr category $dir
  83     if {[winfo exists $w]} {
  84         destroy $w.top
  85         destroy $w.bot
  86     } else {
  87         toplevel $w
  88         wm geometry $w 430x400
  89     }
  90     if {$target == ""} {
  91         set target Default
  92     }
  93     top-down-window $w
  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
  99     if {$category == 0} {
 100         $w.bot.2 configure -state disabled
 101     }
 102     if {$category == 2} {
 103         $w.bot.4 configure -state disabled
 104     }
 105     target-setup-enter-$category $target
 106 }
 107
 108
 109 proc target-setup-leave-0 {target} {
 110     global profileS
 111
 112     set w .setup100
 113     set y $w.top.hostport
 114
 115 }
 116
 117 proc target-setup-enter-0 {target} {
 118     global profileS
 119
 120     set w .setup100
 121
 122     wm title $w "$target - Initial Information"
 123
 124     # host/port/id . . .
 125     set y $w.top.hostport
 126     frame $y -relief ridge -border 2
 127     pack $y -padx 2 -pady 2 -side top -fill x
 128     frame $y.host
 129     frame $y.port
 130     frame $y.idAuthentication
 131
 132     pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2
 133
 134     entry-fieldsx 34 $y \
 135             {host port idAuthentication} \
 136             {{Host:} {Port:} {Id Authentication:}} \
 137             [list target-setup $target 0 2] [list destroy $w]
 138
 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)
 145
 146     # bottom
 147
 148     set y $w.top.bottom
 149
 150     frame $y
 151     pack $y -side bottom -fill both -expand yes
 152
 153     # misc. dates . . .
 154
 155     set y $w.top.dates
 156     frame $y -relief ridge -border 2
 157     pack $y -pady 2 -padx 2 -side left -fill both -expand yes
 158
 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)
 164
 165     # protocol . . .
 166
 167     set y $w.top.protocol
 168
 169     frame $y -relief ridge -border 2
 170     pack $y -pady 2 -padx 2 -side right -fill both
 171
 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
 177
 178     pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x
 179
 180     # transport/comstack . . .
 181
 182     set y $w.top.comstack
 183     frame $y -relief ridge -border 2
 184
 185     pack $y -pady 2 -padx 2 -side right -fill both
 186
 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
 193 }
 194
 195 proc target-setup-leave-1 {target} {
 196     global profileS
 197
 198     set w .setup100
 199     set y $w.top.nr
 200
 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]
 205
 206     set y $w.top.rs
 207 }
 208
 209 proc target-setup-enter-1 {target} {
 210     global profileS
 211
 212     set w .setup100
 213
 214     wm title $w "$target - Target Information"
 215
 216     # Name, Recent News . . .
 217     set y $w.top.nr
 218     frame $y -relief ridge -border 2
 219     pack $y -side top -padx 2 -pady 2 -fill x
 220
 221     frame $y.name
 222     frame $y.recentNews
 223     frame $y.description
 224     frame $y.welcome
 225
 226     pack $y.name $y.recentNews $y.description $y.welcome \
 227             -side top -fill x -pady 2  -expand yes
 228
 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 \
 232             -wrap word
 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
 236
 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 \
 240             -wrap word
 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
 244
 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 \
 248             -wrap word
 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
 252
 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 \
 256             -wrap word
 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
 260
 261     # Result Sets Size, numbers, etc. . . .
 262     set y $w.top.rs
 263
 264     frame $y -relief ridge -border 2
 265     pack $y -side left -padx 2 -pady 2 -fill y
 266
 267     frame $y.maxResultSets
 268     frame $y.maxResultSize
 269     frame $y.maxTerms
 270
 271     pack $y.maxResultSets $y.maxResultSize $y.maxTerms \
 272             -side top -fill x -pady 2
 273
 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]
 278
 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)
 285
 286     # Checkbuttons . . .
 287     set y $w.top.ns
 288
 289     frame $y -relief ridge -border 2
 290     pack $y -side right -padx 2 -pady 2 -fill both -expand yes
 291
 292     checkbutton $y.resultSets -text "Named Result Sets" \
 293             -anchor n -variable profileS($target,namedResultSets)
 294
 295     checkbutton $y.multipleDatabases -text "Multiple Database Search" \
 296             -anchor n -variable profileS($target,multipleDatabases)
 297
 298     pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2
 299
 300 }
 301
 302 proc target-setup-2-dbselect {menu e} {
 303     $menu configure -text $e
 304 }
 305
 306 proc target-setup-leave-2 {target} {
 307     global profileS
 308 }
 309
 310 proc target-setup-db-add {target wp} {
 311     set w .database-select
 312     toplevel $w
 313     set oldFocus [focus]
 314
 315     place-force $w $wp
 316
 317     top-down-window $w
 318
 319     frame $w.top.database
 320
 321     pack $w.top.database -side top -anchor e -pady 2
 322
 323     entry-fields $w.top {database} \
 324             {{Database to add:}} \
 325             [list target-setup-db-add-action $target $wp] \
 326             [list destroy $w]
 327
 328     top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1
 329     focus $oldFocus
 330 }
 331
 332 proc target-setup-db-add-action {target wp} {
 333     global profileS
 334
 335     set w .database-select
 336
 337     set db [$w.top.database.entry get]
 338     lappend profileS($target,databases) $db
 339
 340     destroy $w
 341     target-setup-dblist-update $target
 342 }
 343
 344 proc target-setup-db-remove {target wp} {
 345     global profileS
 346
 347     set w .setup100
 348     set y $w.top.name
 349
 350     set db [$y.data cget -text]
 351     set a [alert "Are you sure you want to remove the database ${db}?"]
 352     if {$a} {
 353         set i [lsearch -exact $profileS($target,databases) $db]
 354         if {$i >= 0} {
 355             set profileS($target,databases) \
 356                     [lreplace $profileS($target,databases) $i $i]
 357         }
 358         target-setup-dblist-update $target
 359         if {![llength $profileS($target,databases)]} {
 360             unset profileS($target,databases)
 361             puts removed
 362         }
 363     }
 364 }
 365
 366 proc target-setup-dblist-update {target} {
 367     global profileS
 368
 369     set w .setup100
 370     set y $w.top.name
 371
 372     set no 0
 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]
 380             incr no
 381         }
 382     }
 383     if {$no == 0} {
 384         $y.remove configure -state disabled
 385     } else {
 386         $y.remove configure -state normal
 387     }
 388 }
 389
 390 proc target-setup-enter-2 {target} {
 391     global profileS
 392
 393     set w .setup100
 394
 395     wm title $w "$target - Database Information"
 396
 397     frame $w.top.name -border 2
 398     pack $w.top.name -pady 2 -padx 2 -side top -fill x
 399
 400     label $w.top.name.label -text "Database Name"
 401
 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
 405
 406     pack $w.top.name.data -side left
 407
 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
 411
 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
 415
 416     frame $w.top.data -relief ridge -border 2
 417     pack $w.top.data -pady 2 -padx 2 -side top -fill x
 418
 419     target-setup-dblist-update $target
 420
 421     frame $w.top.data.avRecordSize
 422     frame $w.top.data.maxRecordSize
 423
 424     pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \
 425             -side top -fill x -pady 2
 426
 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]
 431 }