client.tcl

   1 #
   2 # $Log: client.tcl,v $
   3 # Revision 1.20  1995-04-21 16:31:57  adam
   4 # New radiobutton: protocol (z39v2/SR).
   5 #
   6 # Revision 1.19  1995/04/18  16:11:50  adam
   7 # First version of graphical Scan. Some work on query-by-form.
   8 #
   9 # Revision 1.18  1995/04/10  10:50:22  adam
  10 # Result-set name defaults to suffix of ir-set name.
  11 # Started working on scan. Not finished at this point.
  12 #
  13 # Revision 1.17  1995/03/31  09:34:57  adam
  14 # Search-button disabled when there is no connection.
  15 #
  16 # Revision 1.16  1995/03/31  08:56:36  adam
  17 # New button "Search".
  18 #
  19 # Revision 1.15  1995/03/28  12:45:22  adam
  20 # New ir method failback: called on disconnect/protocol error.
  21 # New ir set/get method: protocol: SR / Z3950.
  22 # Simple popup and disconnect when failback is invoked.
  23 #
  24 # Revision 1.14  1995/03/22  16:07:55  adam
  25 # Minor changes.
  26 #
  27 # Revision 1.13  1995/03/21  17:27:26  adam
  28 # Short-hand keys in setup.
  29 #
  30 # Revision 1.12  1995/03/21  13:41:03  adam
  31 # Comstack cs_create not used too often. Non-blocking connect.
  32 #
  33 # Revision 1.11  1995/03/21  10:39:06  adam
  34 # Diagnostic error message displayed with tkerror.
  35 #
  36 # Revision 1.10  1995/03/20  15:24:06  adam
  37 # Diagnostic records saved on searchResponse.
  38 #
  39 # Revision 1.9  1995/03/17  18:26:16  adam
  40 # Non-blocking i/o used now. Database names popup as cascade items.
  41 #
  42 # Revision 1.8  1995/03/17  15:45:00  adam
  43 # Improved target/database setup.
  44 #
  45 # Revision 1.7  1995/03/16  17:54:03  adam
  46 # Minor changes really.
  47 #
  48 # Revision 1.6  1995/03/15  19:10:20  adam
  49 # Database setup in protocol-setup (rather target setup).
  50 #
  51 # Revision 1.5  1995/03/15  13:59:23  adam
  52 # Minor changes.
  53 #
  54 # Revision 1.4  1995/03/14  17:32:29  adam
  55 # Presentation of full Marc record in popup window.
  56 #
  57 # Revision 1.3  1995/03/12  19:31:52  adam
  58 # Pattern matching implemented when retrieving MARC records. More
  59 # diagnostic functions.
  60 #
  61 # Revision 1.2  1995/03/10  18:00:15  adam
  62 # Actual presentation in line-by-line format. RPN query support.
  63 #
  64 # Revision 1.1  1995/03/09  16:15:07  adam
  65 # First presentRequest attempts. Hot-target list.
  66 #
  67 #
  68 set hotTargets {}
  69 set hotInfo {}
  70 set busy 0
  71
  72 set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} z39v2}
  73 set hostid Default
  74 set settingsChanged 0
  75 set setNo 0
  76
  77 set queryTypes {Simple}
  78 set queryButtons { { {I 0} {I 1} {I 2} } }
  79 set queryInfo { { {Title ti} {Author au} {Subject sh} {Any any} } }
  80
  81 wm minsize . 300 250
  82
  83 if {[file readable "~/.tk-c"]} {
  84     source "~/.tk-c"
  85 }
  86
  87 set queryButtonsFind [lindex $queryButtons 0]
  88 set queryInfoFind [lindex $queryInfo 0]
  89
  90 proc top-down-window {w} {
  91     frame $w.top -relief raised -border 1
  92     frame $w.bot -relief raised -border 1
  93
  94     pack  $w.top $w.bot -side top -fill both -expand yes
  95 }
  96
  97 proc top-down-ok-cancel {w ok-action g} {
  98     frame $w.bot.left -relief sunken -border 1
  99     pack $w.bot.left -side left -expand yes -padx 5 -pady 5
 100     button $w.bot.left.ok -width 6 -text {Ok} \
 101             -command ${ok-action}
 102     pack $w.bot.left.ok -expand yes -padx 3 -pady 3
 103     button $w.bot.cancel -width 6 -text {Cancel} \
 104             -command "destroy $w"
 105     pack $w.bot.cancel -side left -expand yes
 106
 107     if {$g} {
 108         # Grab ...
 109         grab $w
 110         tkwait window $w
 111     }
 112 }
 113
 114 proc top-down-ok-cancelx {w buttonList g} {
 115     set i 0
 116     set l [llength $buttonList]
 117
 118     frame $w.bot.$i -relief sunken -border 1
 119     pack $w.bot.$i -side left -expand yes -padx 5 -pady 5
 120     button $w.bot.$i.ok -text [lindex $buttonList $i] \
 121             -command [lindex $buttonList [expr $i+1]]
 122     pack $w.bot.$i.ok -expand yes -padx 3 -pady 3 -side left
 123
 124     incr i 2
 125     while {$i < $l} {
 126         button $w.bot.$i -text [lindex $buttonList $i] \
 127                 -command [lindex $buttonList [expr $i+1]]
 128         pack $w.bot.$i -expand yes -padx 3 -pady 3 -side left
 129         incr i 2
 130     }
 131     button $w.bot.cancel -width 6 -text {Cancel} \
 132             -command "destroy $w"
 133     pack $w.bot.cancel -side left -expand yes
 134
 135     if {$g} {
 136         # Grab ...
 137         grab $w
 138         tkwait window $w
 139     }
 140 }
 141
 142 proc show-target {target} {
 143     .bot.target configure -text "$target"
 144 }
 145
 146 proc show-busy {v1 v2} {
 147     global busy
 148     if {$busy != 0} {
 149         .bot.status configure -fg $v1
 150         after 200 [list show-busy $v2 $v1]
 151     }
 152 }
 153
 154 proc show-status {status b} {
 155     global busy
 156     global statusbg
 157     .bot.status configure -text "$status"
 158     .bot.status configure -fg black
 159     if {$b != 0} {
 160         if {$busy == 0} {
 161             set busy $b
 162             show-busy red blue
 163         }
 164         #        . config -cursor {watch black white}
 165     } else {
 166         #        . config -cursor {top_left_arrow black white}
 167         puts "Normal"
 168     }
 169     set busy $b
 170 }
 171
 172 proc show-message {msg} {
 173     .bot.message configure -text "$msg"
 174 }
 175
 176 proc insertWithTags {w text args} {
 177     set start [$w index insert]
 178     $w insert insert $text
 179     foreach tag [$w tag names $start] {
 180         $w tag remove $tag $start insert
 181     }
 182     foreach i $args {
 183         $w tag add $i $start insert
 184     }
 185 }
 186
 187 proc show-full-marc {no} {
 188     global setNo
 189
 190     set w .full-marc
 191
 192     if {[winfo exists $w]} {
 193         $w.top.record delete 0.0 end
 194         set new 0
 195     } else {
 196
 197         toplevel $w
 198
 199         wm minsize $w 200 200
 200
 201         frame $w.top -relief raised -border 1
 202         frame $w.bot -relief raised -border 1
 203
 204         pack  $w.top -side top -fill both -expand yes
 205         pack  $w.bot -fill both
 206
 207         text $w.top.record -width 60 -height 12 -wrap word \
 208                 -yscrollcommand [list $w.top.s set]
 209         scrollbar $w.top.s -command [list $w.top.record yview]
 210
 211         set new 1
 212     }
 213     incr no
 214
 215     set r [z39.$setNo recordMarc $no line * * *]
 216
 217     $w.top.record tag configure marc-tag -foreground blue
 218     $w.top.record tag configure marc-data -foreground black
 219     $w.top.record tag configure marc-id -foreground red
 220
 221     foreach line $r {
 222         set tag [lindex $line 0]
 223         set indicator [lindex $line 1]
 224         set fields [lindex $line 2]
 225
 226         if {$indicator != ""} {
 227             insertWithTags $w.top.record "$tag $indicator" marc-tag
 228         } else {
 229             insertWithTags $w.top.record "$tag    " marc-tag
 230         }
 231         foreach field $fields {
 232             set id [lindex $field 0]
 233             set data [lindex $field 1]
 234             if {$id != ""} {
 235                 insertWithTags $w.top.record " $id " marc-id
 236             }
 237             set start [$w.top.record index insert]
 238             insertWithTags $w.top.record $data {}
 239         }
 240         $w.top.record insert end "\n"
 241     }
 242     if {$new} {
 243         bind $w <Return> {destroy .full-marc}
 244
 245         pack $w.top.s -side right -fill y
 246         pack $w.top.record -expand yes -fill both
 247
 248         frame $w.bot.left -relief sunken -border 1
 249         pack $w.bot.left -side left -expand yes -padx 5 -pady 5
 250         button $w.bot.left.close -width 6 -text {Close} \
 251                 -command {destroy .full-marc}
 252         pack $w.bot.left.close -expand yes -padx 3 -pady 3
 253         button $w.bot.edit -width 6 -text {Edit} \
 254                 -command {destroy .full-marc}
 255         pack $w.bot.edit -side left -expand yes
 256     }
 257 }
 258
 259 proc update-target-hotlist {target} {
 260     global hotTargets
 261
 262     set len [llength $hotTargets]
 263     if {$len > 0} {
 264         .top.target.m delete 5 [expr 5+[llength $hotTargets]]
 265     }
 266     set indx [lsearch $hotTargets $target]
 267     if {$indx >= 0} {
 268         set hotTargets [lreplace $hotTargets $indx $indx]
 269     }
 270     set hotTargets [linsert $hotTargets 0 $target]
 271     set-target-hotlist
 272 }
 273
 274 proc set-target-hotlist {} {
 275     global hotTargets
 276
 277     set i 1
 278     foreach target $hotTargets {
 279         .top.target.m add command -label "$i $target" -command \
 280                 "reopen-target $target {}"
 281         incr i
 282         if {$i > 8} {
 283              break
 284         }
 285     }
 286 }
 287
 288 proc reopen-target {target base} {
 289     close-target
 290     open-target $target $base
 291     update-target-hotlist $target
 292 }
 293
 294 proc define-target-action {} {
 295     global profile
 296
 297     set target [.target-define.top.target.entry get]
 298     if {$target == ""} {
 299         return
 300     }
 301     update-target-hotlist $target
 302     foreach n [array names profile] {
 303         if {$n == $target} {
 304             protocol-setup $n
 305             return
 306         }
 307     }
 308     set profile($target) $profile(Default)
 309     protocol-setup $target
 310     destroy .target-define
 311 }
 312
 313 proc fail-response {target} {
 314     close-target
 315     tkerror "Target connection closed or protocol error"
 316 }
 317
 318 proc connect-response {target} {
 319     puts "connect-response"
 320     show-target $target
 321     init-request
 322 }
 323
 324 proc open-target {target base} {
 325     global profile
 326     global hostid
 327
 328     z39 disconnect
 329     z39 comstack [lindex $profile($target) 6]
 330     # z39 idAuthentication [lindex $profile($target) 3]
 331     z39 maximumRecordSize [lindex $profile($target) 4]
 332     z39 preferredMessageSize [lindex $profile($target) 5]
 333     puts -nonewline "maximumRecordSize="
 334     puts [z39 maximumRecordSize]
 335     puts -nonewline "preferredMessageSize="
 336     puts [z39 preferredMessageSize]
 337     if {$base == ""} {
 338         z39 databaseNames [lindex [lindex $profile($target) 7] 0]
 339     } else {
 340         z39 databaseNames $base
 341     }
 342     z39 failback [list fail-response $target]
 343     z39 callback [list connect-response $target]
 344     z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
 345     show-status {Connecting} 1
 346     set hostid $target
 347     .top.target.m disable 0
 348     .top.target.m enable 1
 349 }
 350
 351 proc close-target {} {
 352     global hostid
 353
 354     set hostid Default
 355     z39 disconnect
 356     show-target {None}
 357     show-status {Not connected} 0
 358     show-message {}
 359     .top.target.m disable 1
 360     .top.target.m enable 0
 361     .top.search configure -state disabled
 362     .mid.search configure -state disabled
 363     .mid.scan configure -state disabled
 364 }
 365
 366 proc load-set-action {} {
 367     global setNo
 368
 369     incr setNo
 370     ir-set z39.$setNo
 371
 372     set fname [.load-set.top.filename.entry get]
 373     destroy .load-set
 374     if {$fname != ""} {
 375         init-title-lines
 376
 377         show-status {Loading} 1
 378         z39.$setNo loadFile $fname
 379
 380         set no [z39.$setNo numberOfRecordsReturned]
 381         add-title-lines $setNo $no 1
 382     }
 383     show-status {Ready} 0
 384 }
 385
 386 proc load-set {} {
 387     set w .load-set
 388
 389     set oldFocus [focus]
 390     toplevel $w
 391
 392     place-force $w .
 393
 394     top-down-window $w
 395
 396     frame $w.top.filename
 397
 398     pack $w.top.filename -side top -anchor e -pady 2
 399
 400     entry-fields $w.top {filename} \
 401             {{Filename:}} \
 402             {load-set-action} {destroy .load-set}
 403
 404     top-down-ok-cancel $w {load-set-action} 1
 405     focus $oldFocus
 406 }
 407
 408 proc init-request {} {
 409     global setNo
 410
 411     z39 callback {init-response}
 412     z39 init
 413     show-status {Initializing} 1
 414 }
 415
 416 proc init-response {} {
 417     show-status {Ready} 0
 418     .top.search configure -state normal
 419     .mid.search configure -state normal
 420     .mid.scan configure -state normal
 421 }
 422
 423 proc search-request {} {
 424     global setNo
 425     global profile
 426     global hostid
 427
 428     set target $hostid
 429
 430     set query [index-query]
 431     if {$query==""} {
 432         return
 433     }
 434     incr setNo
 435     ir-set z39.$setNo
 436
 437
 438     if {[lindex $profile($target) 10] != ""} {
 439         z39.$setNo setName $setNo
 440     } else {
 441         z39.$setNo setName Default
 442     }
 443     if {[lindex $profile($target) 8] != ""} {
 444         z39 query rpn
 445     }
 446     if {[lindex $profile($target) 9] != ""} {
 447         z39 query ccl
 448     }
 449     z39 callback {search-response}
 450     z39.$setNo search $query
 451     show-status {Search} 1
 452 }
 453
 454 proc scan-request {} {
 455     set w .scan-window
 456
 457     global profile
 458     global hostid
 459
 460     set target $hostid
 461
 462     ir-scan z39.scan
 463
 464     z39 callback {scan-response}
 465     if {![winfo exists $w]} {
 466         toplevel $w
 467
 468         wm title $w "Scan"
 469
 470         wm minsize $w 200 200
 471
 472         top-down-window $w
 473
 474         listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \
 475                 -font fixed -geometry 50x14
 476         scrollbar $w.top.scroll -orient vertical -border 1
 477         pack $w.top.list -side left -fill both -expand yes
 478         pack $w.top.scroll -side right -fill y
 479         $w.top.scroll config -command [list $w.top.list yview]
 480
 481         top-down-ok-cancelx $w [list {Close} [list destroy $w]] 0
 482     }
 483     z39.scan scan 0
 484
 485     show-status {Scan} 1
 486 }
 487
 488 proc scan-response {} {
 489     set w .scan-window
 490     set m [z39.scan numberOfEntriesReturned]
 491     puts $m
 492     for {set i 0} {$i < $m} {incr i} {
 493         set term [lindex [z39.scan scanLine $i] 1]
 494         set nostr [format "%7d" [lindex [z39.scan scanLine $i] 2]]
 495
 496         $w.top.list insert end "$nostr $term"
 497     }
 498     show-status {Ready} 0
 499 }
 500
 501 proc search-response {} {
 502     global setNo
 503     global setOffset
 504     global setMax
 505
 506     init-title-lines
 507     show-status {Ready} 0
 508     show-message "[z39.$setNo resultCount] hits"
 509     set setMax [z39.$setNo resultCount]
 510     puts $setMax
 511     if {$setMax == 0} {
 512         set status [z39.$setNo responseStatus]
 513         if {[lindex $status 0] == "NSD"} {
 514             set code [lindex $status 1]
 515             set msg [lindex $status 2]
 516             set addinfo [lindex $status 3]
 517             tkerror "NSD$code: $msg: $addinfo"
 518         }
 519         return
 520     }
 521     if {$setMax > 4} {
 522         set setMax 4
 523     }
 524     z39 callback {present-response}
 525     set setOffset 1
 526     z39.$setNo present $setOffset $setMax
 527     show-status {Retrieve} 1
 528 }
 529
 530 proc present-more {number} {
 531     global setNo
 532     global setOffset
 533     global setMax
 534
 535     puts "present-more"
 536     if {$setNo == 0} {
 537         return
 538     }
 539     set max [z39.$setNo resultCount]
 540     if {$max <= $setMax} {
 541         return
 542     }
 543     puts "max=$max"
 544     puts "setOffset=$setOffset"
 545     if {$number == ""} {
 546         set setMax $max
 547     } else {
 548         incr setMax $number
 549     }
 550     z39 callback {present-response}
 551     z39.$setNo present $setOffset [expr $setMax - $setOffset + 1]
 552     show-status {Retrieve} 1
 553 }
 554
 555 proc init-title-lines {} {
 556     .data.list delete 0 end
 557 }
 558
 559 proc add-title-lines {setno no offset} {
 560     for {set i 0} {$i < $no} {incr i} {
 561         set o [expr $i + $offset]
 562         set title [lindex [z39.$setno recordMarc $o field 245 * a] 0]
 563         set year  [lindex [z39.$setno recordMarc $o field 260 * c] 0]
 564         set nostr [format "%5d" $o]
 565         .data.list insert end "$nostr $title - $year"
 566     }
 567 }
 568
 569 proc present-response {} {
 570     global setNo
 571     global setOffset
 572     global setMax
 573
 574     puts "In present-response"
 575     set no [z39.$setNo numberOfRecordsReturned]
 576     puts "Returned $no records, setOffset $setOffset"
 577     add-title-lines $setNo $no $setOffset
 578     set setOffset [expr $setOffset + $no]
 579     set status [z39.$setNo responseStatus]
 580     if {[lindex $status 0] == "NSD"} {
 581         show-status {Ready} 0
 582         set code [lindex $status 1]
 583         set msg [lindex $status 2]
 584         set addinfo [lindex $status 3]
 585         tkerror "NSD$code: $msg: $addinfo"
 586         return
 587     }
 588     if {$no > 0 && $setOffset <= $setMax} {
 589         z39.$setNo present $setOffset [expr $setMax - $setOffset + 1]
 590     } else {
 591         show-status {Finished} 0
 592     }
 593 }
 594
 595 proc left-cursor {w} {
 596     set i [$w index insert]
 597     if {$i > 0} {
 598         incr i -1
 599         $w icursor $i
 600     }
 601 }
 602
 603 proc right-cursor {w} {
 604     set i [$w index insert]
 605     incr i
 606     $w icursor $i
 607 }
 608
 609 proc bind-fields {list returnAction escapeAction} {
 610     set max [expr [llength $list]-1]
 611     for {set i 0} {$i < $max} {incr i} {
 612         bind [lindex $list $i] <Return> $returnAction
 613         bind [lindex $list $i] <Escape> $escapeAction
 614         bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
 615         bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
 616         bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
 617     }
 618     bind [lindex $list $i] <Return> $returnAction
 619     bind [lindex $list $i] <Escape> $escapeAction
 620     bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
 621     bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
 622     bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
 623     focus [lindex $list 0]
 624 }
 625
 626 proc entry-fields {parent list tlist returnAction escapeAction} {
 627     set alist {}
 628     set i 0
 629     foreach field $list {
 630         set label ${parent}.${field}.label
 631         set entry ${parent}.${field}.entry
 632         label $label -text [lindex $tlist $i] -anchor e
 633         entry $entry -width 32 -relief sunken
 634         pack $label -side left
 635         pack $entry -side right
 636         lappend alist $entry
 637         incr i
 638     }
 639     bind-fields $alist $returnAction $escapeAction
 640 }
 641
 642 proc define-target-dialog {} {
 643     set w .target-define
 644
 645     toplevel $w
 646     place-force $w .
 647     top-down-window $w
 648     frame $w.top.target
 649     pack $w.top.target \
 650             -side top -anchor e -pady 2
 651     entry-fields $w.top {target} \
 652             {{Target:}} \
 653             {define-target-action} {destroy .target-define}
 654     top-down-ok-cancel $w {define-target-action} 1
 655 }
 656
 657 proc protocol-setup-action {target} {
 658     global profile
 659     global csRadioType
 660     global protocolRadioType
 661     global settingsChanged
 662     global RPNCheck
 663     global CCLCheck
 664     global ResultSetCheck
 665
 666     set w .setup-${target}.top
 667
 668     #set w .protocol-setup.top
 669
 670     set b {}
 671     set settingsChanged 1
 672     set len [$w.databases.list size]
 673     for {set i 0} {$i < $len} {incr i} {
 674         lappend b [$w.databases.list get $i]
 675     }
 676     set profile($target) [list [$w.description.entry get] \
 677             [$w.host.entry get] \
 678             [$w.port.entry get] \
 679             [$w.idAuthentication.entry get] \
 680             [$w.maximumRecordSize.entry get] \
 681             [$w.preferredMessageSize.entry get] \
 682             $csRadioType \
 683             $b \
 684             $RPNCheck \
 685             $CCLCheck \
 686             $ResultSetCheck \
 687             $protocolRadioType ]
 688
 689     cascade-target-list
 690     puts $profile($target)
 691     destroy .setup-${target}
 692 }
 693
 694 proc place-force {window parent} {
 695     set g [wm geometry $parent]
 696
 697     set p1 [string first + $g]
 698     set p2 [string last + $g]
 699
 700     set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
 701     set y [expr 60+[string range $g [expr $p2 +1] end]]
 702     wm geometry $window +${x}+${y}
 703 }
 704
 705 proc add-database-action {target} {
 706     set w .setup-${target}
 707
 708     ${w}.top.databases.list insert end \
 709             [.database-select.top.database.entry get]
 710     destroy .database-select
 711 }
 712
 713 proc add-database {target} {
 714     set w .database-select
 715
 716     set oldFocus [focus]
 717     toplevel $w
 718
 719     place-force $w .setup-${target}
 720
 721     top-down-window $w
 722
 723     frame $w.top.database
 724
 725     pack $w.top.database -side top -anchor e -pady 2
 726
 727     entry-fields $w.top {database} \
 728             {{Database to add:}} \
 729             [list add-database-action $target] {destroy .database-select}
 730
 731     top-down-ok-cancel $w [list add-database-action $target] 1
 732     focus $oldFocus
 733 }
 734
 735 proc delete-database {target} {
 736     set w .setup-${target}
 737
 738     foreach i [lsort -decreasing \
 739             [$w.top.databases.list curselection]] {
 740         $w.top.databases.list delete $i
 741     }
 742 }
 743
 744 proc protocol-setup {target} {
 745     set w .setup-$target
 746
 747     global profile
 748     global csRadioType
 749     global protocolRadioType
 750     global RPNCheck
 751     global CCLCheck
 752     global ResultSetCheck
 753
 754     toplevel $w
 755
 756     wm title $w "Setup $target"
 757     place-force $w .
 758
 759     top-down-window $w
 760
 761     if {$target == ""} {
 762         set target Default
 763     }
 764     puts target
 765     puts $profile($target)
 766
 767     frame $w.top.host
 768     frame $w.top.port
 769     frame $w.top.description
 770     frame $w.top.idAuthentication
 771     frame $w.top.maximumRecordSize
 772     frame $w.top.preferredMessageSize
 773     frame $w.top.cs-type -relief ridge -border 2
 774     frame $w.top.protocol -relief ridge -border 2
 775     frame $w.top.query -relief ridge -border 2
 776     frame $w.top.databases -relief ridge -border 2
 777
 778     # Maximum/preferred/idAuth ...
 779     pack $w.top.description $w.top.host $w.top.port \
 780             $w.top.idAuthentication $w.top.maximumRecordSize \
 781             $w.top.preferredMessageSize -side top -anchor e -pady 2
 782
 783     entry-fields $w.top {description host port idAuthentication \
 784             maximumRecordSize preferredMessageSize} \
 785             {{Description:} {Host:} {Port:} {Id Authentication:} \
 786             {Maximum Record Size:} {Preferred Message Size:}} \
 787             [list protocol-setup-action $target] [list destroy $w]
 788
 789     foreach sub {description host port idAuthentication \
 790             maximumRecordSize preferredMessageSize} {
 791         puts $sub
 792         bind $w.top.$sub.entry <Control-a> "add-database $target"
 793         bind $w.top.$sub.entry <Control-d> "delete-database $target"
 794     }
 795     $w.top.description.entry insert 0 [lindex $profile($target) 0]
 796     $w.top.host.entry insert 0 [lindex $profile($target) 1]
 797     $w.top.port.entry insert 0 [lindex $profile($target) 2]
 798     $w.top.idAuthentication.entry insert 0 [lindex $profile($target) 3]
 799     $w.top.maximumRecordSize.entry insert 0 [lindex $profile($target) 4]
 800     $w.top.preferredMessageSize.entry insert 0 [lindex $profile($target) 5]
 801     set csRadioType [lindex $profile($target) 6]
 802     set RPNCheck [lindex $profile($target) 8]
 803     set CCLCheck [lindex $profile($target) 9]
 804     set ResultSetCheck [lindex $profile($target) 10]
 805     set protocolRadioType [lindex $profile($target) 11]
 806     if {$protocolRadioType == ""} {
 807         set protocolRadioType z39v2
 808     }
 809
 810     # Databases ....
 811     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill both
 812
 813     label $w.top.databases.label -text "Databases"
 814     button $w.top.databases.add -text "Add" \
 815             -command "add-database $target"
 816     button $w.top.databases.delete -text "Delete" \
 817             -command "delete-database $target"
 818     listbox $w.top.databases.list -geometry 20x6 \
 819             -yscrollcommand "$w.top.databases.scroll set"
 820     scrollbar $w.top.databases.scroll -orient vertical -border 1
 821     pack $w.top.databases.label -side top -fill x \
 822             -padx 2 -pady 2
 823     pack $w.top.databases.add $w.top.databases.delete -side top -fill x \
 824             -padx 2 -pady 2
 825     pack $w.top.databases.list -side left -fill both -expand yes \
 826             -padx 2 -pady 2
 827     pack $w.top.databases.scroll -side right -fill y \
 828             -padx 2 -pady 2
 829     $w.top.databases.scroll config -command "$w.top.databases.list yview"
 830
 831     foreach b [lindex $profile($target) 7] {
 832         $w.top.databases.list insert end $b
 833     }
 834
 835     # Transport ...
 836     pack $w.top.cs-type -pady 6 -padx 6 -side top -fill x
 837
 838     label $w.top.cs-type.label -text "Transport"
 839     radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \
 840             -command {puts tcp/ip} -variable csRadioType -value tcpip
 841     radiobutton $w.top.cs-type.mosi -text "MOSI" -anchor w\
 842             -command {puts mosi} -variable csRadioType -value mosi
 843
 844     pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
 845             -padx 4 -side top -fill x
 846
 847     # Protocol ...
 848     pack $w.top.protocol -pady 6 -padx 6 -side top -fill x
 849
 850     label $w.top.protocol.label -text "Protocol"
 851     radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \
 852             -command {puts z39v2} -variable protocolRadioType -value z39v2
 853     radiobutton $w.top.protocol.sr -text "SR" -anchor w \
 854             -command {puts sr} -variable protocolRadioType -value sr
 855
 856     pack $w.top.protocol.label $w.top.protocol.z39v2 $w.top.protocol.sr \
 857             -padx 4 -side top -fill x
 858
 859     # Query ...
 860     pack $w.top.query -pady 6 -padx 6 -side top -fill x
 861
 862     label $w.top.query.label -text "Query support"
 863     checkbutton $w.top.query.c1 -text "RPN query" -anchor w -variable RPNCheck
 864     checkbutton $w.top.query.c2 -text "CCL query" -anchor w -variable CCLCheck
 865     checkbutton $w.top.query.c3 -text "Result sets" -anchor w -variable ResultSetCheck
 866
 867     pack $w.top.query.label -side top
 868     pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
 869             -padx 4 -side top -fill x
 870
 871     # Ok-cancel
 872     top-down-ok-cancel $w [list protocol-setup-action $target] 0
 873 }
 874
 875 proc database-select-action {} {
 876     set w .database-select.top
 877     set b {}
 878     foreach indx [$w.databases.list curselection] {
 879         lappend b [$w.databases.list get $indx]
 880     }
 881     if {$b != ""} {
 882         z39 databaseNames $b
 883     }
 884     destroy .database-select
 885 }
 886
 887 proc database-select {} {
 888     set w .database-select
 889     global profile
 890     global hostid
 891
 892     toplevel $w
 893
 894     place-force $w .
 895
 896     top-down-window $w
 897
 898     frame $w.top.databases -relief ridge -border 2
 899
 900     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
 901
 902     label $w.top.databases.label -text "List"
 903     listbox $w.top.databases.list -geometry 20x6 \
 904             -yscrollcommand "$w.top.databases.scroll set"
 905     scrollbar $w.top.databases.scroll -orient vertical -border 1
 906     pack $w.top.databases.label -side top -fill x \
 907             -padx 2 -pady 2
 908     pack $w.top.databases.list -side left -fill both -expand yes \
 909             -padx 2 -pady 2
 910     pack $w.top.databases.scroll -side right -fill y \
 911             -padx 2 -pady 2
 912     $w.top.databases.scroll config -command "$w.top.databases.list yview"
 913
 914     foreach b [lindex $profile($hostid) 7] {
 915         $w.top.databases.list insert end $b
 916     }
 917     top-down-ok-cancel $w {database-select-action} 1
 918 }
 919
 920 proc cascade-target-list {} {
 921     global profile
 922
 923     foreach sub [winfo children .top.target.m.clist] {
 924         puts "deleting $sub"
 925         destroy $sub
 926     }
 927     .top.target.m.clist delete 0 last
 928     foreach n [array names profile] {
 929         if {$n != "Default"} {
 930             set nl [string tolower $n]
 931             if {[llength [lindex $profile($n) 7]] > 1} {
 932                 .top.target.m.clist add cascade -label $n \
 933                         -menu .top.target.m.clist.$nl
 934                 menu .top.target.m.clist.$nl
 935                 foreach b [lindex $profile($n) 7] {
 936                     .top.target.m.clist.$nl add command -label $b \
 937                             -command "reopen-target $n $b"
 938                 }
 939             } else {
 940                 .top.target.m.clist add command -label $n \
 941                         -command "reopen-target $n {}"
 942             }
 943         }
 944     }
 945     .top.target.m.slist delete 0 last
 946     foreach n [array names profile] {
 947         if {$n != "Default"} {
 948             .top.target.m.slist add command -label $n \
 949                     -command "protocol-setup $n"
 950         }
 951     }
 952 }
 953
 954 proc cascade-query-list {} {
 955     global queryTypes
 956
 957     set i 0
 958     .top.query.m.slist delete 0 last
 959     foreach n $queryTypes {
 960         .top.query.m.slist add command -label $n \
 961                 -command [list query-setup $i]
 962         incr i
 963     }
 964
 965     set i 0
 966     .top.query.m.clist delete 0 last
 967     foreach n $queryTypes {
 968         .top.query.m.clist add command -label $n \
 969                 -command [list query-select $i]
 970         incr i
 971     }
 972 }
 973
 974 proc save-settings {} {
 975     global hotTargets
 976     global profile
 977     global settingsChanged
 978     global queryTypes
 979     global queryButtons
 980     global queryInfo
 981
 982     set f [open "~/.tk-c" w]
 983     puts $f "# Setup file"
 984     puts $f "set hotTargets \{ $hotTargets \}"
 985
 986     foreach n [array names profile] {
 987         puts -nonewline $f "set profile($n) \{"
 988         puts -nonewline $f $profile($n)
 989         puts $f "\}"
 990     }
 991     puts -nonewline $f "set queryTypes \{"
 992     puts -nonewline $f $queryTypes
 993     puts $f "\}"
 994
 995     puts -nonewline $f "set queryButtons \{"
 996     puts -nonewline $f $queryButtons
 997     puts $f "\}"
 998
 999     puts -nonewline $f "set queryInfo \{"
1000     puts -nonewline $f $queryInfo
1001     puts $f "\}"
1002
1003     close $f
1004     set settingsChanged 0
1005 }
1006
1007 proc alert {ask} {
1008     set w .alert
1009
1010     global alertAnswer
1011
1012     toplevel $w
1013     place-force $w .
1014     top-down-window $w
1015
1016     message $w.top.message -text $ask
1017
1018     pack $w.top.message -side left -pady 6 -padx 20 -expand yes -fill x
1019
1020     set alertAnswer 0
1021     top-down-ok-cancel $w {alert-action} 1
1022     return $alertAnswer
1023 }
1024
1025 proc alert-action {} {
1026     global alertAnswer
1027     set alertAnswer 1
1028     destroy .alert
1029 }
1030
1031 proc exit-action {} {
1032     global settingsChanged
1033
1034     if {$settingsChanged} {
1035         set a [alert "you havent saved your settings. Do you wish to save?"]
1036         if {$a} {
1037             save-settings
1038         }
1039     }
1040     destroy .
1041 }
1042
1043 proc listbuttonaction {w name h user i} {
1044     $w configure -text [lindex $name 0]
1045     $h [lindex $name 1] $user $i
1046 }
1047
1048 proc listbuttonx {button no names handle user} {
1049     if {[winfo exists $button]} {
1050         $button configure -text [lindex [lindex $names $no] 0]
1051         ${button}.m delete 0 last
1052     } else {
1053         menubutton $button -text [lindex [lindex $names $no] 0] \
1054                 -width 10 -menu ${button}.m -relief raised -border 1
1055         menu ${button}.m
1056     }
1057     set i 0
1058     foreach name $names {
1059         ${button}.m add command -label [lindex $name 0] \
1060                 -command [list listbuttonaction ${button} $name \
1061                 $handle $user $i]
1062         incr i
1063     }
1064 }
1065
1066 proc listbutton {button no names} {
1067     menubutton $button -text [lindex $names $no] -width 10 -menu ${button}.m \
1068             -relief raised -border 1
1069     menu ${button}.m
1070     foreach name $names {
1071         ${button}.m add command -label $name \
1072                 -command [list ${button} configure -text $name]
1073     }
1074 }
1075
1076 proc query-add-index-action {queryNo} {
1077     set w .setup-query-$queryNo
1078
1079     global queryInfoTmp
1080     global queryButtonsTmp
1081
1082     lappend queryInfoTmp [list [.query-add-index.top.index.entry get] {}]
1083
1084     destroy .query-add-index
1085     #destroy $w.top.lines
1086     #frame $w.top.lines -relief ridge -border 2
1087     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1088     #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1089 }
1090
1091 proc query-add-line {queryNo} {
1092     set w .setup-query-$queryNo
1093
1094     global queryInfoTmp
1095     global queryButtonsTmp
1096
1097     lappend queryButtonsTmp {I 0}
1098
1099     #destroy $w.top.lines
1100     #frame $w.top.lines -relief ridge -border 2
1101     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1102     #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1103 }
1104
1105 proc query-del-line {queryNo} {
1106     set w .setup-query-$queryNo
1107
1108     global queryInfoTmp
1109     global queryButtonsTmp
1110
1111     set l [llength $queryButtonsTmp]
1112     if {$l <= 0} {
1113         return
1114     }
1115     incr l -1
1116     set queryButtonsTmp [lreplace $queryButtonsTmp $l $l]
1117     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1118 }
1119
1120 proc query-add-index {queryNo} {
1121     set w .query-add-index
1122
1123     toplevel $w
1124     place-force $w .setup-query-$queryNo
1125     top-down-window $w
1126     frame $w.top.index
1127     pack $w.top.index \
1128             -side top -anchor e -pady 2
1129     entry-fields $w.top {index} \
1130             {{Index Name:}} \
1131             [list query-add-index-action $queryNo] {destroy .query-add-index}
1132     top-down-ok-cancel $w [list query-add-index-action $queryNo] 1
1133 }
1134
1135 proc query-setup-action {queryNo} {
1136     global queryButtons
1137     global queryInfo
1138     global queryButtonsTmp
1139     global queryInfoTmp
1140     global queryButtonsFind
1141     global queryInfoFind
1142
1143     set queryInfo [lreplace $queryInfo $queryNo $queryNo \
1144             $queryInfoTmp]
1145     set queryButtons [lreplace $queryButtons $queryNo $queryNo \
1146             $queryButtonsTmp]
1147     set queryInfoFind $queryInfoTmp
1148     set queryButtonsFind $queryButtonsTmp
1149
1150     puts $queryInfo
1151     puts $queryButtons
1152     destroy .setup-query-$queryNo
1153
1154     index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
1155 }
1156
1157 proc activate-e-index {value no i} {
1158     global queryButtonsTmp
1159
1160     puts $queryButtonsTmp
1161     set queryButtonsTmp [lreplace $queryButtonsTmp $no $no [list I $i]]
1162     puts $queryButtonsTmp
1163     puts "value $value"
1164     puts "no $no"
1165     puts "i $i"
1166 }
1167
1168 proc activate-index {value no i} {
1169     global queryButtonsFind
1170
1171     set queryButtonsFind [lreplace $queryButtonsFind $no $no [list I $i]]
1172
1173     puts "queryButtonsFind $queryButtonsFind"
1174     puts "value $value"
1175     puts "no $no"
1176     puts "i $i"
1177 }
1178
1179 proc query-setup {queryNo} {
1180     set w .setup-query-$queryNo
1181     global queryTypes
1182     set queryTypes {Simple}
1183     global queryButtons
1184     global queryInfo
1185     global queryButtonsTmp
1186     global queryInfoTmp
1187
1188     set queryName [lindex $queryTypes $queryNo]
1189     set queryInfoTmp [lindex $queryInfo $queryNo]
1190     set queryButtonsTmp [lindex $queryButtons $queryNo]
1191
1192     #set queryButtons { {I 0 I 1 I 2} }
1193     #set queryInfo { { {Title ti} {Author au} {Subject sh} } }
1194
1195     toplevel $w
1196
1197     wm title $w "Query setup $queryName"
1198     place-force $w .
1199
1200     top-down-window $w
1201
1202     frame $w.top.lines -relief ridge -border 2
1203     frame $w.top.use -relief ridge -border 2
1204     frame $w.top.relation -relief ridge -border 2
1205     frame $w.top.position -relief ridge -border 2
1206     frame $w.top.structure -relief ridge -border 2
1207     frame $w.top.truncation -relief ridge -border 2
1208     frame $w.top.completeness -relief ridge -border 2
1209
1210     # Index Lines
1211
1212     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
1213
1214     pack $w.top.lines -side left -pady 6 -padx 6 -fill y
1215
1216     # Use Attributes
1217     pack $w.top.use -side left -pady 6 -padx 6 -fill y
1218
1219     label $w.top.use.label -text "Use"
1220     listbox $w.top.use.list -geometry 20x10 \
1221             -yscrollcommand "$w.top.use.scroll set"
1222     scrollbar $w.top.use.scroll -orient vertical -border 1
1223     pack $w.top.use.label -side top -fill x \
1224             -padx 2 -pady 2
1225     pack $w.top.use.list -side left -fill both -expand yes \
1226             -padx 2 -pady 2
1227     pack $w.top.use.scroll -side right -fill y \
1228             -padx 2 -pady 2
1229     $w.top.use.scroll config -command "$w.top.use.list yview"
1230
1231     foreach u {{Personal name} {Corporate name}} {
1232         $w.top.use.list insert end $u
1233     }
1234     # Relation Attributes
1235     pack $w.top.relation -pady 6 -padx 6 -side top
1236
1237     label $w.top.relation.label -text "Relation" -width 18
1238
1239     listbutton $w.top.relation.b 0\
1240             {{None} {Less than} {Greater than or equal} \
1241             {Equal} {Greater than or equal} {Greater than} {Not equal} \
1242             {Phonetic} \
1243             {Stem} {Relevance} {AlwaysMatches}}
1244
1245     pack $w.top.relation.label $w.top.relation.b -fill x
1246
1247     # Position Attributes
1248     pack $w.top.position -pady 6 -padx 6 -side top
1249
1250     label $w.top.position.label -text "Position" -width 18
1251
1252     listbutton $w.top.position.b 0 {{None} {First in field} {First in subfield}
1253     {Any position in field}}
1254
1255     pack $w.top.position.label $w.top.position.b -fill x
1256
1257     # Structure Attributes
1258
1259     pack $w.top.structure -pady 6 -padx 6 -side top
1260
1261     label $w.top.structure.label -text "Structure" -width 18
1262
1263     listbutton $w.top.structure.b 0 {{None} {Phrase} {Word} {Key} {Year}
1264     {Date (norm)} {Word list} {Date (un-norm)} {Name (norm)} {Date (un-norm)}
1265     {Structure} {urx} {free-form} {doc-text} {local-number} {string}
1266     {numeric string}}
1267
1268     pack $w.top.structure.label $w.top.structure.b -fill x
1269
1270     # Truncation Attributes
1271
1272     pack $w.top.truncation -pady 6 -padx 6 -side top
1273
1274     label $w.top.truncation.label -text "Truncation" -width 18
1275
1276     listbutton $w.top.truncation.b 0 {{Auto} {Right} {Left} {Left and right} \
1277             {No truncation} {Process #} {Re-1} {Re-2}}
1278     pack $w.top.truncation.label $w.top.truncation.b -fill x
1279
1280     # Completeness Attributes
1281
1282     pack $w.top.completeness -pady 6 -padx 6 -side top
1283
1284     label $w.top.completeness.label -text "Truncation" -width 18
1285
1286     listbutton $w.top.completeness.b 0 {{None} {Incomplete subfield} \
1287             {Complete subfield} {Complete field}}
1288     pack $w.top.completeness.label $w.top.completeness.b -fill x
1289
1290     # Ok-cancel
1291     top-down-ok-cancelx $w [list \
1292             {Ok} [list query-setup-action $queryNo] \
1293             {Add index} [list query-add-index $queryNo] \
1294             {Add line} [list query-add-line $queryNo] \
1295             {Delete line} [list query-del-line $queryNo]] 0
1296 }
1297
1298 proc index-clear {} {
1299     global queryButtonsFind
1300
1301     set i 0
1302     foreach b $queryButtonsFind {
1303         .lines.$i.e delete 0 end
1304         incr i
1305     }
1306 }
1307
1308 proc index-query {} {
1309     global queryButtonsFind
1310     global queryInfoFind
1311
1312     set i 0
1313     set qs {}
1314
1315     foreach b $queryButtonsFind {
1316         set term [string trim [.lines.$i.e get]]
1317         if {$term != ""} {
1318             set attr [lindex [lindex $queryInfoFind [lindex $b 1]] 1]
1319             if {$qs != ""} {
1320                 set qs "${qs} and "
1321             }
1322             if {$attr != ""} {
1323                 set qs "${qs}${attr}="
1324             }
1325             set qs "${qs}(${term})"
1326         }
1327         incr i
1328     }
1329     puts "qs=  $qs"
1330     return $qs
1331 }
1332
1333 proc index-lines {w realOp buttonInfo queryInfo handle} {
1334     set i 0
1335     foreach b $buttonInfo {
1336         if {! [winfo exists $w.$i]} {
1337             frame $w.$i -background white -border 1
1338         }
1339         listbuttonx $w.$i.l [lindex $b 1] $queryInfo $handle $i
1340
1341         if {$realOp} {
1342             if {! [winfo exists $w.$i.e]} {
1343                 entry $w.$i.e -width 32 -relief sunken -border 1
1344                 bind $w.$i.e <FocusIn> [list $w.$i configure \
1345                         -background red]
1346                 bind $w.$i.e <FocusOut> [list $w.$i configure \
1347                         -background white]
1348                 pack $w.$i.l -side left
1349                 pack $w.$i.e -side left -fill x -expand yes
1350                 pack $w.$i -side top -fill x -padx 2 -pady 2
1351                 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
1352                 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
1353                 bind $w.$i.e <Return> search-request
1354             }
1355         } else {
1356             pack $w.$i.l -side left
1357             pack $w.$i -side top -fill x -padx 2 -pady 2
1358         }
1359         incr i
1360     }
1361     set j $i
1362     while {[winfo exists $w.$j]} {
1363         destroy $w.$j
1364         incr j
1365     }
1366     if {! $realOp} {
1367         return
1368     }
1369     set j 0
1370     incr i -1
1371     while {$j < $i} {
1372         set k [expr $j+1]
1373         bind $w.$j.e <Tab> "focus $w.$k.e"
1374         set j $k
1375     }
1376     if {$i >= 0} {
1377         bind $w.$i.e <Tab> "focus $w.0.e"
1378         focus $w.0.e
1379     }
1380 }
1381
1382 proc search-fields {w buttondefs} {
1383     set i 0
1384     foreach buttondef $buttondefs {
1385         frame $w.$i -background white
1386
1387         listbutton $w.$i.l 0 $buttondef
1388         entry $w.$i.e -width 32 -relief sunken
1389
1390         pack $w.$i.l -side left
1391         pack $w.$i.e -side left -fill x -expand yes
1392
1393         pack $w.$i -side top -fill x -padx 2 -pady 2
1394
1395         bind $w.$i.e <Left> [list left-cursor $w.$i.e]
1396         bind $w.$i.e <Right> [list right-cursor $w.$i.e]
1397
1398         incr i
1399     }
1400     set j 0
1401     incr i -1
1402     while {$j < $i} {
1403         set k [expr $j+1]
1404         bind $w.$j.e <Tab> "focus $w.$k.e \n
1405         $w.$k configure -background red \n
1406         $w.$j configure -background white"
1407         set j $k
1408     }
1409     bind $w.$i.e <Tab> "focus $w.0.e \n
1410         $w.0 configure -background red \n
1411         $w.$i configure -background white"
1412     focus $w.0.e
1413     $w.0 configure -background red
1414 }
1415
1416 frame .top  -border 1 -relief raised
1417 frame .lines  -border 1 -relief raised
1418 frame .mid  -border 1 -relief raised
1419 frame .data -border 1 -relief raised
1420 frame .bot  -border 1 -relief raised
1421 pack .top .lines .mid -side top -fill x
1422 pack .data -side top -fill both -expand yes
1423 pack .bot -fill x
1424
1425 menubutton .top.file -text "File" -underline 0 -menu .top.file.m
1426 menu .top.file.m
1427 .top.file.m add command -label "Save settings" -command {save-settings}
1428 .top.file.m add command -label "Load Set" -command {load-set}
1429 .top.file.m add separator
1430 .top.file.m add command -label "Exit" -command {exit-action}
1431
1432 menubutton .top.target -text "Target" -underline 0 -menu .top.target.m
1433 menu .top.target.m
1434 .top.target.m add cascade -label "Connect" -menu .top.target.m.clist
1435 .top.target.m add command -label "Disconnect" -command {close-target}
1436 #.top.target.m add command -label "Initialize" -command {init-request}
1437 .top.target.m add cascade -label "Setup" -menu .top.target.m.slist
1438 .top.target.m add command -label "Setup new" -command {define-target-dialog}
1439 .top.target.m add separator
1440 set-target-hotlist
1441
1442 .top.target.m disable 1
1443
1444 menu .top.target.m.clist
1445 menu .top.target.m.slist
1446 cascade-target-list
1447
1448 menubutton .top.search -text "Search" -underline 0 -menu .top.search.m
1449 menu .top.search.m
1450 .top.search.m add command -label "Database" -command {database-select}
1451 .top.search.m add cascade -label "Query type" -menu .top.search.m.querytype
1452 menu .top.search.m.querytype
1453 .top.search.m.querytype add radiobutton -label "RPN"
1454 .top.search.m.querytype add radiobutton -label "CCL"
1455 .top.search.m add cascade -label "Present" -menu .top.search.m.present
1456 menu .top.search.m.present
1457 .top.search.m.present add command -label "More" -command [list present-more 10]
1458 .top.search.m.present add command -label "All" -command [list present-more {}]
1459 .top.search configure -state disabled
1460
1461 menubutton .top.query -text "Query" -underline 0 -menu .top.query.m
1462 menu .top.query.m
1463 .top.query.m add cascade -label "Choose" -menu .top.query.m.clist
1464 .top.query.m add command -label "Define" -command {new-query-dialog}
1465 .top.query.m add cascade -label "Edit" -menu .top.query.m.slist
1466 menu .top.query.m.clist
1467 menu .top.query.m.slist
1468 cascade-query-list
1469
1470 menubutton .top.help -text "Help" -menu .top.help.m
1471 menu .top.help.m
1472
1473 .top.help.m add command -label "Help on help" -command {puts "Help on help"}
1474 .top.help.m add command -label "About" -command {puts "About"}
1475
1476 pack .top.file .top.target .top.query .top.search -side left
1477 pack .top.help -side right
1478
1479 index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
1480
1481 button .mid.search -width 6 -text {Search} -command search-request \
1482         -state disabled
1483 button .mid.scan -width 6 -text {Scan} -command scan-request \
1484         -state disabled
1485 button .mid.clear -width 6 -text {Clear} -command index-clear
1486 pack .mid.search .mid.scan .mid.clear -side left -padx 5 -pady 3
1487
1488 listbox .data.list -yscrollcommand {.data.scroll set} -font fixed
1489 scrollbar .data.scroll -orient vertical -border 1
1490 pack .data.list -side left -fill both -expand yes
1491 pack .data.scroll -side right -fill y
1492 .data.scroll config -command {.data.list yview}
1493
1494 message .bot.target -text "None" -aspect 1000 -relief sunken -border 1
1495 label .bot.status -text "Not connected" -width 12 -relief \
1496         sunken -anchor w -border 1
1497 label .bot.set -textvariable setNo -width 5 -relief \
1498         sunken -anchor w -border 1
1499 label .bot.message -text "" -width 14 -relief \
1500         sunken -anchor w -border 1
1501 pack .bot.target .bot.status .bot.set .bot.message -anchor nw \
1502         -side left -padx 2 -pady 2
1503
1504 bind .data.list <Double-Button-1> {set indx [.data.list nearest %y]
1505 show-full-marc $indx}
1506
1507 ir z39