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