client2/setup.tcl

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