client.tcl

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