client.tcl

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