client.tcl

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