client.tcl

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