client.tcl

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