client.tcl

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