client.tcl

   1 #
   2 # $Log: client.tcl,v $
   3 # Revision 1.8  1995-03-17 15:45:00  adam
   4 # Improved target/database setup.
   5 #
   6 # Revision 1.7  1995/03/16  17:54:03  adam
   7 # Minor changes really.
   8 #
   9 # Revision 1.6  1995/03/15  19:10:20  adam
  10 # Database setup in protocol-setup (rather target setup).
  11 #
  12 # Revision 1.5  1995/03/15  13:59:23  adam
  13 # Minor changes.
  14 #
  15 # Revision 1.4  1995/03/14  17:32:29  adam
  16 # Presentation of full Marc record in popup window.
  17 #
  18 # Revision 1.3  1995/03/12  19:31:52  adam
  19 # Pattern matching implemented when retrieving MARC records. More
  20 # diagnostic functions.
  21 #
  22 # Revision 1.2  1995/03/10  18:00:15  adam
  23 # Actual presentation in line-by-line format. RPN query support.
  24 #
  25 # Revision 1.1  1995/03/09  16:15:07  adam
  26 # First presentRequest attempts. Hot-target list.
  27 #
  28 #
  29 set hotTargets {}
  30 set hotInfo {}
  31 set busy 0
  32
  33 set profile(Default) {{} {} {210} {} 16384 8192 tcpip {}}
  34 set hostid Default
  35 set settingsChanged 0
  36 set setNo 0
  37
  38 wm minsize . 360 200
  39
  40 if {[file readable "~/.tk-c"]} {
  41     source "~/.tk-c"
  42 }
  43
  44 proc top-down-window {w} {
  45     frame $w.top -relief raised -border 1
  46     frame $w.bot -relief raised -border 1
  47
  48     pack  $w.top $w.bot -side top -fill both -expand yes
  49 }
  50
  51 proc top-down-ok-cancel {w ok-action} {
  52     frame $w.bot.left -relief sunken -border 1
  53     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
  54     button $w.bot.left.ok -width 6 -text {Ok} \
  55             -command ${ok-action}
  56     pack $w.bot.left.ok -expand yes -padx 3 -pady 3
  57     button $w.bot.cancel -width 6 -text {Cancel} \
  58             -command "destroy $w"
  59     pack $w.bot.cancel -side left -expand yes
  60
  61     # Grab ...
  62     grab $w
  63
  64     tkwait window $w
  65 }
  66
  67 proc show-target {target} {
  68     .bot.target configure -text "$target"
  69 }
  70
  71 proc show-busy {v1 v2} {
  72     global busy
  73     if {$busy != 0} {
  74         .bot.status configure -fg $v1
  75         after 200 [list show-busy $v2 $v1]
  76     }
  77 }
  78
  79 proc show-status {status b} {
  80     global busy
  81     global statusbg
  82     .bot.status configure -text "$status"
  83     .bot.status configure -fg black
  84     if {$b != 0} {
  85         if {$busy == 0} {
  86             set busy $b
  87             show-busy red blue
  88         }
  89         #        . config -cursor {watch black white}
  90     } else {
  91         #        . config -cursor {top_left_arrow black white}
  92         puts "Normal"
  93     }
  94     set busy $b
  95 }
  96
  97 proc show-message {msg} {
  98     .bot.message configure -text "$msg"
  99 }
 100
 101 proc insertWithTags {w text args} {
 102     set start [$w index insert]
 103     $w insert insert $text
 104     foreach tag [$w tag names $start] {
 105         $w tag remove $tag $start insert
 106     }
 107     foreach i $args {
 108         $w tag add $i $start insert
 109     }
 110 }
 111
 112 proc show-full-marc {no} {
 113     global setNo
 114
 115     set w .full-marc
 116
 117     if {[winfo exists $w]} {
 118         $w.top.record delete 0.0 end
 119         set new 0
 120     } else {
 121
 122         toplevel $w
 123
 124         wm minsize $w 200 200
 125
 126         frame $w.top -relief raised -border 1
 127         frame $w.bot -relief raised -border 1
 128
 129         #        pack  $w.top $w.bot -side top -fill both -expand yes
 130         pack  $w.top -side top -fill both -expand yes
 131         pack  $w.bot -fill both
 132
 133         text $w.top.record -width 60 -height 10 \
 134                 -yscrollcommand [list $w.top.s set]
 135         scrollbar $w.top.s -command [list $w.top.record yview]
 136
 137         set new 1
 138     }
 139     incr no
 140
 141     set r [z39.$setNo recordMarc $no line * * *]
 142
 143     $w.top.record tag configure marc-tag -foreground blue
 144     $w.top.record tag configure marc-data -foreground black
 145     $w.top.record tag configure marc-id -foreground red
 146
 147     foreach line $r {
 148         set tag [lindex $line 0]
 149         set indicator [lindex $line 1]
 150         set fields [lindex $line 2]
 151
 152         if {$indicator != ""} {
 153             insertWithTags $w.top.record "$tag $indicator" marc-tag
 154         } else {
 155             insertWithTags $w.top.record "$tag    " marc-tag
 156         }
 157         foreach field $fields {
 158             set id [lindex $field 0]
 159             set data [lindex $field 1]
 160             if {$id != ""} {
 161                 insertWithTags $w.top.record " $id " marc-id
 162             }
 163             set start [$w.top.record index insert]
 164             insertWithTags $w.top.record $data {}
 165         }
 166         $w.top.record insert end "\n"
 167     }
 168     if {$new} {
 169         bind $w <Return> {destroy .full-marc}
 170
 171         pack $w.top.s -side right -fill y
 172         pack $w.top.record -expand yes -fill both
 173
 174         frame $w.bot.left -relief sunken -border 1
 175         pack $w.bot.left -side left -expand yes -padx 5 -pady 5
 176         button $w.bot.left.close -width 6 -text {Close} \
 177                 -command {destroy .full-marc}
 178         pack $w.bot.left.close -expand yes -padx 3 -pady 3
 179         button $w.bot.edit -width 6 -text {Edit} \
 180                 -command {destroy .full-marc}
 181         pack $w.bot.edit -side left -expand yes
 182     }
 183 }
 184
 185 proc update-target-hotlist {target} {
 186     global hotTargets
 187
 188     set len [llength $hotTargets]
 189     if {$len > 0} {
 190         .top.target.m delete 5 [expr 5+[llength $hotTargets]]
 191     }
 192     set indx [lsearch $hotTargets $target]
 193     if {$indx >= 0} {
 194         set hotTargets [lreplace $hotTargets $indx $indx]
 195     }
 196     set hotTargets [linsert $hotTargets 0 $target]
 197     set-target-hotlist
 198 }
 199
 200 proc set-target-hotlist {} {
 201     global hotTargets
 202
 203     set i 1
 204     foreach target $hotTargets {
 205         .top.target.m add command -label "$i $target" -command \
 206                 "menu-open-target $target {}"
 207         incr i
 208         if {$i > 8} {
 209              break
 210         }
 211     }
 212 }
 213
 214 proc menu-open-target {target base} {
 215     open-target $target $base
 216     update-target-hotlist $target
 217 }
 218
 219 proc define-target-action {} {
 220     global profile
 221
 222     set target [.target-define.top.target.entry get]
 223     if {$target == ""} {
 224         return
 225     }
 226     update-target-hotlist $target
 227     foreach n [array names profile] {
 228         if {$n == $target} {
 229             protocol-setup $n
 230             return
 231         }
 232     }
 233     set profile($target) $profile(Default)
 234     protocol-setup $target
 235     destroy .target-define
 236 }
 237
 238 proc open-target {target base} {
 239     global profile
 240
 241     z39 disconnect
 242     z39 comstack [lindex $profile($target) 6]
 243     # z39 idAuthentication [lindex $profile($target) 3]
 244     z39 maximumRecordSize [lindex $profile($target) 4]
 245     z39 preferredMessageSize [lindex $profile($target) 5]
 246     puts -nonewline "maximumRecordSize="
 247     puts [z39 maximumRecordSize]
 248     puts -nonewline "preferredMessageSize="
 249     puts [z39 preferredMessageSize]
 250     if {$base == ""} {
 251         z39 databaseNames [lindex [lindex $profile($target) 7] 0]
 252     } else {
 253         z39 databaseNames $base
 254     }
 255     show-target $target
 256     z39 connect  [lindex $profile($target) 1]:[lindex $profile($target) 2]
 257     init-request
 258 }
 259
 260 proc load-set-action {} {
 261     global setNo
 262
 263     incr setNo
 264     ir-set z39.$setNo
 265
 266     set fname [.load-set.top.filename.entry get]
 267     destroy .load-set
 268     if {$fname != ""} {
 269         .data.list delete 0 end
 270
 271         show-status {Loading} 1
 272         z39.$setNo loadFile $fname
 273
 274         set no [z39.$setNo numberOfRecordsReturned]
 275         add-title-lines $no 1
 276     }
 277     show-status {Ready} 0
 278 }
 279
 280 proc load-set {} {
 281     set w .load-set
 282
 283     toplevel $w
 284
 285     place-force $w .
 286
 287     top-down-window $w
 288
 289     frame $w.top.filename
 290
 291     pack $w.top.filename -side top -anchor e -pady 2
 292
 293     entry-fields $w.top {filename} \
 294             {{Filename:}} \
 295             {load-set-action} {destroy .load-set}
 296
 297     top-down-ok-cancel $w {load-set-action}
 298 }
 299
 300 proc init-request {} {
 301     global setNo
 302
 303     z39 callback {init-response}
 304     z39 init
 305     show-status {Initializing} 1
 306     set setNo 0
 307 }
 308
 309 proc init-response {} {
 310     show-status {Ready} 0
 311     pack .mid.searchlabel .mid.searchentry -side left
 312     bind .mid.searchentry <Return> search-request
 313     focus .mid.searchentry
 314 }
 315
 316 proc search-request {} {
 317     global setNo
 318
 319     incr setNo
 320     ir-set z39.$setNo
 321
 322     z39 callback {search-response}
 323     z39.$setNo search [.mid.searchentry get]
 324     show-status {Search} 1
 325 }
 326
 327 proc search-response {} {
 328     global setNo
 329     global setOffset
 330     global setMax
 331
 332     .data.list delete 0 end
 333     show-status {Ready} 0
 334     show-message "[z39.$setNo resultCount] hits"
 335     set setMax [z39.$setNo resultCount]
 336     puts $setMax
 337     if {$setMax == 0} {
 338         return
 339     }
 340     if {$setMax > 20} {
 341         set setMax 20
 342     }
 343     z39 callback {present-response}
 344     set setOffset 1
 345     z39.$setNo present 1 $setMax
 346     show-status {Retrieve} 1
 347 }
 348
 349 proc add-title-lines {no offset} {
 350     global setNo
 351
 352     for {set i 0} {$i < $no} {incr i} {
 353         set o [expr $i + $offset]
 354         set title [lindex [z39.$setNo recordMarc $o field 245 * a] 0]
 355         set year  [lindex [z39.$setNo recordMarc $o field 260 * c] 0]
 356         set nostr [format "%3d" $o]
 357         .data.list insert end "$nostr $title - $year"
 358     }
 359 }
 360
 361 proc present-response {} {
 362     global setNo
 363     global setOffset
 364     global setMax
 365
 366     puts "In present-response"
 367     set no [z39.$setNo numberOfRecordsReturned]
 368     puts "Returned $no records, setOffset $setOffset"
 369     add-title-lines $no $setOffset
 370     set setOffset [expr $setOffset + $no]
 371     if { $setOffset <= $setMax} {
 372         z39.$setNo present $setOffset [expr $setMax - $setOffset + 1]
 373     } else {
 374         show-status {Finished} 0
 375     }
 376 }
 377
 378 proc bind-fields {list returnAction escapeAction} {
 379     set max [expr [llength $list]-1]
 380     for {set i 0} {$i < $max} {incr i} {
 381         bind [lindex $list $i] <Return> $returnAction
 382         bind [lindex $list $i] <Escape> $escapeAction
 383         bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
 384     }
 385     bind [lindex $list $i] <Return> $returnAction
 386     bind [lindex $list $i] <Escape> $escapeAction
 387     bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
 388     focus [lindex $list 0]
 389 }
 390
 391 proc entry-fields {parent list tlist returnAction escapeAction} {
 392     set alist {}
 393     set i 0
 394     foreach field $list {
 395         set label ${parent}.${field}.label
 396         set entry ${parent}.${field}.entry
 397         label $label -text [lindex $tlist $i] -anchor e
 398         entry $entry -width 26 -relief sunken
 399         pack $label -side left
 400         pack $entry -side right
 401         lappend alist $entry
 402         incr i
 403     }
 404     bind-fields $alist $returnAction $escapeAction
 405 }
 406
 407 proc define-target-dialog {} {
 408     set w .target-define
 409
 410     toplevel $w
 411
 412     place-force $w .
 413
 414     top-down-window $w
 415
 416     frame $w.top.target
 417
 418     pack $w.top.target \
 419             -side top -anchor e -pady 2
 420
 421     entry-fields $w.top {target} \
 422             {{Target:}} \
 423             {define-target-action} {destroy .target-define}
 424
 425     top-down-ok-cancel $w {define-target-action}
 426 }
 427
 428 proc close-target {} {
 429     pack forget .mid.searchlabel .mid.searchentry
 430     z39 disconnect
 431     show-target {None}
 432     show-status {Not connected} 0
 433     show-message {}
 434 }
 435
 436 proc protocol-setup-action {target} {
 437     global profile
 438     global csRadioType
 439     global settingsChanged
 440
 441     set w .protocol-setup.top
 442
 443     set b {}
 444     set settingsChanged 1
 445     set len [$w.databases.list size]
 446     for {set i 0} {$i < $len} {incr i} {
 447         lappend b [$w.databases.list get $i]
 448     }
 449     set profile($target) [list [$w.description.entry get] \
 450             [$w.host.entry get] \
 451             [$w.port.entry get] \
 452             [$w.idAuthentication.entry get] \
 453             [$w.maximumRecordSize.entry get] \
 454             [$w.preferredMessageSize.entry get] \
 455             $csRadioType \
 456             $b]
 457
 458     cascade-target-list
 459     puts $profile($target)
 460     destroy .protocol-setup
 461 }
 462
 463
 464 proc place-force {window parent} {
 465     set g [wm geometry $parent]
 466
 467     set p1 [string first + $g]
 468     set p2 [string last + $g]
 469
 470     set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
 471     set y [expr 60+[string range $g [expr $p2 +1] end]]
 472     wm geometry $window +${x}+${y}
 473 }
 474
 475
 476 proc add-database-action {} {
 477     .protocol-setup.top.databases.list insert end \
 478             [.database-select.top.database.entry get]
 479     destroy .database-select
 480 }
 481
 482 proc add-database {} {
 483     set w .database-select
 484
 485     toplevel $w
 486
 487     place-force $w .protocol-setup
 488
 489     top-down-window $w
 490
 491     frame $w.top.database
 492
 493     pack $w.top.database -side top -anchor e -pady 2
 494
 495     entry-fields $w.top {database} \
 496             {{Database to add:}} \
 497             {add-database-action} {destroy .database-select}
 498
 499     top-down-ok-cancel $w {add-database-action}
 500 }
 501
 502 proc delete-database {} {
 503     foreach i [lsort -decreasing \
 504             [.protocol-setup.top.databases.list curselection]] {
 505         .protocol-setup.top.databases.list delete $i
 506     }
 507 }
 508
 509 proc protocol-setup {target} {
 510     set w .protocol-setup
 511
 512     global profile
 513     global csRadioType
 514
 515     toplevel $w
 516
 517     wm title $w "Setup $target"
 518     place-force $w .
 519
 520     top-down-window $w
 521
 522     if {$target == ""} {
 523         set target Default
 524     }
 525     puts target
 526     puts $profile($target)
 527
 528     frame $w.top.host
 529     frame $w.top.port
 530     frame $w.top.description
 531     frame $w.top.idAuthentication
 532     frame $w.top.maximumRecordSize
 533     frame $w.top.preferredMessageSize
 534     frame $w.top.cs-type -relief ridge -border 2
 535     frame $w.top.query -relief ridge -border 2
 536     frame $w.top.databases -relief ridge -border 2
 537
 538     # Maximum/preferred/idAuth ...
 539     pack $w.top.description $w.top.host $w.top.port \
 540             $w.top.idAuthentication $w.top.maximumRecordSize \
 541             $w.top.preferredMessageSize -side top -anchor e -pady 2
 542     #-anchor e
 543
 544     entry-fields $w.top {description host port idAuthentication \
 545             maximumRecordSize preferredMessageSize} \
 546             {{Description:} {Host:} {Port:} {Id Authentification:} \
 547             {Maximum Record Size:} {Preferred Message Size:}} \
 548             [list protocol-setup-action $target] {destroy .protocol-setup}
 549
 550     $w.top.description.entry insert 0 [lindex $profile($target) 0]
 551     $w.top.host.entry insert 0 [lindex $profile($target) 1]
 552     $w.top.port.entry insert 0 [lindex $profile($target) 2]
 553     $w.top.idAuthentication.entry insert 0 [lindex $profile($target) 3]
 554     $w.top.maximumRecordSize.entry insert 0 [lindex $profile($target) 4]
 555     $w.top.preferredMessageSize.entry insert 0 [lindex $profile($target) 5]
 556
 557     # Databases ....
 558     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
 559
 560     label $w.top.databases.label -text "Databases"
 561     button $w.top.databases.add -text "Add" -command {add-database}
 562     button $w.top.databases.delete -text "Delete" -command {delete-database}
 563     listbox $w.top.databases.list -geometry 20x6 \
 564             -yscrollcommand "$w.top.databases.scroll set"
 565     scrollbar $w.top.databases.scroll -orient vertical -border 1
 566     pack $w.top.databases.label -side top -fill x \
 567             -padx 2 -pady 2
 568     pack $w.top.databases.add $w.top.databases.delete -side top -fill x \
 569             -padx 2 -pady 2
 570     pack $w.top.databases.list -side left -fill both -expand yes \
 571             -padx 2 -pady 2
 572     pack $w.top.databases.scroll -side right -fill y \
 573             -padx 2 -pady 2
 574     $w.top.databases.scroll config -command "$w.top.databases.list yview"
 575
 576     foreach b [lindex $profile($target) 7] {
 577         $w.top.databases.list insert end $b
 578     }
 579
 580     # Transport ...
 581     set csRadioType [lindex $profile($target) 6]
 582
 583     pack $w.top.cs-type -pady 6 -padx 6 -side top
 584
 585     label $w.top.cs-type.label -text "Transport"
 586     radiobutton $w.top.cs-type.tcpip -text "TCP/IP" \
 587             -command {puts tcp/ip} -variable csRadioType -value tcpip
 588     radiobutton $w.top.cs-type.mosi -text "MOSI" \
 589             -command {puts mosi} -variable csRadioType -value mosi
 590
 591     pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
 592             -padx 4 -side top -fill x
 593
 594     # Query ...
 595     pack $w.top.query -pady 6 -padx 6 -side top
 596
 597     label $w.top.query.label -text "Query support" -anchor e
 598     checkbutton $w.top.query.c1 -text "CCL query"
 599     checkbutton $w.top.query.c2 -text "RPN query"
 600     checkbutton $w.top.query.c3 -text "Result sets"
 601
 602     pack $w.top.query.label -side top
 603     pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
 604             -padx 4 -side top -fill x
 605
 606     top-down-ok-cancel $w [list protocol-setup-action $target]
 607 }
 608
 609 proc database-select-action {} {
 610     set w .database-select.top
 611     set b {}
 612     foreach indx [$w.databases.list curselection] {
 613         lappend b [$w.databases.list get $indx]
 614     }
 615     if {$b != ""} {
 616         z39 databaseNames $b
 617     }
 618     destroy .database-select
 619 }
 620
 621 proc database-select {} {
 622     set w .database-select
 623     global profile
 624     global hostid
 625
 626     toplevel $w
 627
 628     place-force $w .
 629
 630     top-down-window $w
 631
 632     if {$hostid == ""} {
 633         set hostid Default
 634     }
 635
 636     frame $w.top.databases -relief ridge -border 2
 637
 638     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
 639
 640     label $w.top.databases.label -text "List"
 641     listbox $w.top.databases.list -geometry 20x6 \
 642             -yscrollcommand "$w.top.databases.scroll set"
 643     scrollbar $w.top.databases.scroll -orient vertical -border 1
 644     pack $w.top.databases.label -side top -fill x \
 645             -padx 2 -pady 2
 646     pack $w.top.databases.list -side left -fill both -expand yes \
 647             -padx 2 -pady 2
 648     pack $w.top.databases.scroll -side right -fill y \
 649             -padx 2 -pady 2
 650     $w.top.databases.scroll config -command "$w.top.databases.list yview"
 651
 652     foreach b [lindex $profile($hostid) 7] {
 653         $w.top.databases.list insert end $b
 654     }
 655     top-down-ok-cancel $w {database-select-action}
 656 }
 657
 658 proc cascade-target-list {} {
 659     global profile
 660
 661     foreach sub [winfo children .top.target.m.clist] {
 662         puts "deleting $sub"
 663         destroy $sub
 664     }
 665     .top.target.m.clist delete 0 last
 666     foreach n [array names profile] {
 667         if {$n != "Default"} {
 668             set nl [string tolower $n]
 669             if {[llength [lindex $profile($n) 7]] > 1} {
 670                 .top.target.m.clist add cascade -label $n \
 671                         -menu .top.target.m.clist.$nl
 672                 menu .top.target.m.clist.$nl
 673                 foreach b [lindex $profile($n) 7] {
 674                     .top.target.m.clist.$nl add command -label $b \
 675                             -command "menu-open-target $n $b"
 676                 }
 677             } else {
 678                 .top.target.m.clist add command -label $n \
 679                         -command "menu-open-target $n {}"
 680             }
 681         }
 682     }
 683     .top.target.m.slist delete 0 last
 684     foreach n [array names profile] {
 685         if {$n != "Default"} {
 686             .top.target.m.slist add command -label $n \
 687                     -command "protocol-setup $n"
 688         }
 689     }
 690 }
 691
 692 proc save-settings {} {
 693     global hotTargets
 694     global profile
 695     global settingsChanged
 696
 697     set f [open "~/.tk-c" w]
 698     puts $f "# Setup file"
 699     puts $f "set hotTargets \{ $hotTargets \}"
 700
 701     foreach n [array names profile] {
 702         puts -nonewline $f "set profile($n) \{"
 703         puts -nonewline $f $profile($n)
 704         puts $f "\}"
 705     }
 706     close $f
 707     set settingsChanged 0
 708 }
 709
 710 proc alert {ask} {
 711     set w .alert
 712
 713     global alertAnswer
 714
 715     toplevel $w
 716     place-force $w .
 717     top-down-window $w
 718
 719     message $w.top.message -text $ask
 720
 721     pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
 722
 723     set alertAnswer 0
 724     top-down-ok-cancel $w {alert-action}
 725     return $alertAnswer
 726 }
 727
 728 proc alert-action {} {
 729     global alertAnswer
 730     set alertAnswer 1
 731     destroy .alert
 732 }
 733
 734 proc exit-action {} {
 735     global settingsChanged
 736
 737     if {$settingsChanged} {
 738         set a [alert "you havent saved your settings. Do you wish to save?"]
 739         if {$a} {
 740             save-settings
 741         }
 742     }
 743     destroy .
 744 }
 745
 746 frame .top  -border 1 -relief raised
 747 frame .mid  -border 1 -relief raised
 748 frame .data -border 1 -relief raised
 749 frame .bot  -border 1 -relief raised
 750 pack .top .mid -side top -fill x
 751 pack .data      -side top -fill both -expand yes
 752 pack .bot      -fill x
 753
 754 menubutton .top.file -text "File" -menu .top.file.m
 755 menu .top.file.m
 756 .top.file.m add command -label "Save settings" -command {save-settings}
 757 .top.file.m add command -label "Load Set" -command {load-set}
 758 .top.file.m add separator
 759 .top.file.m add command -label "Exit" -command {exit-action}
 760
 761 menubutton .top.target -text "Target" -menu .top.target.m
 762 menu .top.target.m
 763 .top.target.m add cascade -label "Connect" -menu .top.target.m.clist
 764 .top.target.m add command -label "Disconnect" -command {close-target}
 765 #.top.target.m add command -label "Initialize" -command {init-request}
 766 .top.target.m add cascade -label "Setup" -menu .top.target.m.slist
 767 .top.target.m add command -label "Setup new" -command {define-target-dialog}
 768 .top.target.m add separator
 769 set-target-hotlist
 770
 771 menu .top.target.m.clist
 772 menu .top.target.m.slist
 773 cascade-target-list
 774
 775 menubutton .top.database -text "Database" -menu .top.database.m
 776 menu .top.database.m
 777 .top.database.m add command -label "Select ..." -command {database-select}
 778 .top.database.m add command -label "Add ..." -command {puts "Add"}
 779
 780 menubutton .top.help -text "Help" -menu .top.help.m
 781 menu .top.help.m
 782
 783 .top.help.m add command -label "Help on help" -command {puts "Help on help"}
 784 .top.help.m add command -label "About" -command {puts "About"}
 785
 786 pack .top.file .top.target .top.database -side left
 787 pack .top.help -side right
 788
 789 label .mid.searchlabel -text {Search:}
 790 entry .mid.searchentry -width 40 -relief sunken
 791
 792 listbox .data.list -yscrollcommand {.data.scroll set}
 793 scrollbar .data.scroll -orient vertical -border 1
 794 pack .data.list -side left -fill both -expand yes
 795 pack .data.scroll -side right -fill y
 796 .data.scroll config -command {.data.list yview}
 797
 798 message .bot.target -text "None" -aspect 1000 -relief sunken -border 1
 799 label .bot.status -text "Not connected" -width 12 -relief \
 800     sunken -anchor w -border 1
 801 label .bot.message -text "" -width 20 -relief \
 802     sunken -anchor w -border 1
 803 pack .bot.target .bot.status .bot.message -anchor nw -side left -padx 2 -pady 2
 804
 805 bind .data.list <Double-Button-1> {set indx [.data.list nearest %y]
 806 show-full-marc $indx}
 807
 808 ir z39
 809 z39 comstack tcpip