client.tcl

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