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