client.tcl

   1 # IR toolkit for tcl/tk
   2 # (c) Index Data 1995
   3 # See the file LICENSE for details.
   4 # Sebastian Hammer, Adam Dickmeiss
   5 #
   6 # $Log: client.tcl,v $
   7 # Revision 1.54  1995-06-27 14:41:03  adam
   8 # Bug fix in search-response. Didn't always observe non-surrogate diagnostics.
   9 #
  10 # Revision 1.53  1995/06/26  12:40:09  adam
  11 # Client defines its own tkerror.
  12 # User may specify 'no preferredRecordSyntax'.
  13 #
  14 # Revision 1.52  1995/06/22  13:14:59  adam
  15 # Feature: SUTRS. Setting getSutrs implemented.
  16 # Work on display formats.
  17 # Preferred record syntax can be set by the user.
  18 #
  19 # Revision 1.51  1995/06/21  11:11:00  adam
  20 # Bug fix: libdir undefined in about-origin.
  21 #
  22 # Revision 1.50  1995/06/21  11:04:48  adam
  23 # Uses GNU autoconf 2.3.
  24 # Install procedure implemented.
  25 # boook bitmaps moved to sub directory bitmaps.
  26 #
  27 # Revision 1.49  1995/06/20  14:16:42  adam
  28 # More work on cancel mechanism.
  29 #
  30 # Revision 1.48  1995/06/20  08:07:23  adam
  31 # New setting: failInfo.
  32 # Working on better cancel mechanism.
  33 #
  34 # Revision 1.47  1995/06/19  14:05:29  adam
  35 # Bug fix: asked for SUTRS.
  36 #
  37 # Revision 1.46  1995/06/19  13:06:06  adam
  38 # New define: IR_TCL_VERSION.
  39 #
  40 # Revision 1.45  1995/06/19  08:08:44  adam
  41 # client.tcl: hotTargets now contain both database and target name.
  42 # ir-tcl.c: setting protocol edited. Errors in callbacks are logged
  43 # by logf(LOG_WARN, ...) calls.
  44 #
  45 # Revision 1.44  1995/06/16  14:55:18  adam
  46 # Book logo mirrored.
  47 #
  48 # Revision 1.43  1995/06/16  14:41:05  adam
  49 # Scan line entries can be copied to a search entry.
  50 #
  51 # Revision 1.42  1995/06/16  12:28:13  adam
  52 # Implemented preferredRecordSyntax.
  53 # Minor changes in diagnostic handling.
  54 # Record list deleted when connection closes.
  55 #
  56 # Revision 1.41  1995/06/14  15:07:59  adam
  57 # Bug fix in cascade-target-list. Uses yaz-version.h.
  58 #
  59 # Revision 1.40  1995/06/14  13:37:17  adam
  60 # Setting recordType implemented.
  61 # Setting implementationVersion implemented.
  62 # Settings implementationId / implementationName edited.
  63 #
  64 # Revision 1.39  1995/06/14  12:16:22  adam
  65 # hotTargets, textWrap and displayFormat saved in clientg.tcl.
  66 #
  67 # Revision 1.38  1995/06/14  07:22:45  adam
  68 # Target definitions can be deleted.
  69 # Listbox used in the query definition dialog.
  70 #
  71 # Revision 1.37  1995/06/13  14:37:59  adam
  72 # Work on query setup.
  73 # Better about origin/target.
  74 # Better presentation formats.
  75 #
  76 # Revision 1.36  1995/06/13  07:42:14  adam
  77 # Bindings removed from text widgets.
  78 #
  79 # Revision 1.35  1995/06/12  15:17:31  adam
  80 # Text widget used in main window (instead of listbox) to support
  81 # better presentation formats.
  82 #
  83 # Revision 1.34  1995/06/12  07:59:07  adam
  84 # More work on geometry handling.
  85 #
  86 # Revision 1.33  1995/06/09  11:17:35  adam
  87 # Start work on geometry management.
  88 #
  89 # Revision 1.32  1995/06/07  09:16:37  adam
  90 # New presentation format.
  91 #
  92 # Revision 1.31  1995/06/06  16:31:09  adam
  93 # Bug fix: target names couldn't contain blanks.
  94 # Bug fix: scan.
  95 #
  96 # Revision 1.30  1995/06/06  11:35:41  adam
  97 # Work on scan. Display of old sets.
  98 #
  99 # Revision 1.29  1995/06/05  14:11:18  adam
 100 # Bug fix in present-more.
 101 #
 102 # Revision 1.28  1995/06/02  14:52:13  adam
 103 # Minor changes really.
 104 #
 105 # Revision 1.27  1995/06/02  14:29:42  adam
 106 # Work on scan interface - up/down buttons.
 107 #
 108 # Revision 1.26  1995/06/01  16:36:46  adam
 109 # About buttons. Minor bug fixes.
 110 #
 111 # Revision 1.25  1995/05/31  13:09:57  adam
 112 # Client searches/presents may be interrupted.
 113 # New moving book-logo.
 114 #
 115 # Revision 1.24  1995/05/31  08:36:24  adam
 116 # Bug fix in client.tcl: didn't save options on clientrc.tcl.
 117 # New method: referenceId. More work on scan.
 118 #
 119 # Revision 1.23  1995/05/29  10:33:41  adam
 120 # README and rename of startup script.
 121 #
 122 # Revision 1.22  1995/05/26  11:44:09  adam
 123 # Bugs fixed. More work on MARC utilities and queries. Test
 124 # client is up-to-date again.
 125 #
 126 # Revision 1.21  1995/05/11  15:34:46  adam
 127 # Scan request changed a bit. This version works with RLG.
 128 #
 129 # Revision 1.20  1995/04/21  16:31:57  adam
 130 # New radiobutton: protocol (z39v2/SR).
 131 #
 132 # Revision 1.19  1995/04/18  16:11:50  adam
 133 # First version of graphical Scan. Some work on query-by-form.
 134 #
 135 # Revision 1.18  1995/04/10  10:50:22  adam
 136 # Result-set name defaults to suffix of ir-set name.
 137 # Started working on scan. Not finished at this point.
 138 #
 139 # Revision 1.17  1995/03/31  09:34:57  adam
 140 # Search-button disabled when there is no connection.
 141 #
 142 # Revision 1.16  1995/03/31  08:56:36  adam
 143 # New button "Search".
 144 #
 145 # Revision 1.15  1995/03/28  12:45:22  adam
 146 # New ir method failback: called on disconnect/protocol error.
 147 # New ir set/get method: protocol: SR / Z3950.
 148 # Simple popup and disconnect when failback is invoked.
 149 #
 150 # Revision 1.14  1995/03/22  16:07:55  adam
 151 # Minor changes.
 152 #
 153 # Revision 1.13  1995/03/21  17:27:26  adam
 154 # Short-hand keys in setup.
 155 #
 156 # Revision 1.12  1995/03/21  13:41:03  adam
 157 # Comstack cs_create not used too often. Non-blocking connect.
 158 #
 159 # Revision 1.11  1995/03/21  10:39:06  adam
 160 # Diagnostic error message displayed with tkerror.
 161 #
 162 # Revision 1.10  1995/03/20  15:24:06  adam
 163 # Diagnostic records saved on searchResponse.
 164 #
 165 # Revision 1.9  1995/03/17  18:26:16  adam
 166 # Non-blocking i/o used now. Database names popup as cascade items.
 167 #
 168 # Revision 1.8  1995/03/17  15:45:00  adam
 169 # Improved target/database setup.
 170 #
 171 # Revision 1.7  1995/03/16  17:54:03  adam
 172 # Minor changes really.
 173 #
 174 # Revision 1.6  1995/03/15  19:10:20  adam
 175 # Database setup in protocol-setup (rather target setup).
 176 #
 177 # Revision 1.5  1995/03/15  13:59:23  adam
 178 # Minor changes.
 179 #
 180 # Revision 1.4  1995/03/14  17:32:29  adam
 181 # Presentation of full Marc record in popup window.
 182 #
 183 # Revision 1.3  1995/03/12  19:31:52  adam
 184 # Pattern matching implemented when retrieving MARC records. More
 185 # diagnostic functions.
 186 #
 187 # Revision 1.2  1995/03/10  18:00:15  adam
 188 # Actual presentation in line-by-line format. RPN query support.
 189 #
 190 # Revision 1.1  1995/03/09  16:15:07  adam
 191 # First presentRequest attempts. Hot-target list.
 192 #
 193 #
 194
 195 set libdir LIBDIR
 196 if {[file readable clientrc.tcl]} {
 197         set libdir .
 198 }
 199 set hotTargets {}
 200 set hotInfo {}
 201 set busy 0
 202
 203 set profile(Default) {{} {} {210} {} 16384 8192 tcpip {} 1 {} {} Z39}
 204 set hostid Default
 205 set settingsChanged 0
 206 set setNo 0
 207 set lastSetNo 0
 208 set cancelFlag 0
 209 set scanEnable 0
 210 set fullMarcSeq 0
 211 set displayFormat 1
 212 set popupMarcdf 0
 213 set textWrap word
 214 set recordSyntax None
 215 set delayRequest {}
 216
 217 set queryTypes {Simple}
 218 set queryButtons { { {I 0} {I 1} {I 2} } }
 219 set queryInfo { { {Title {1=4 4=1}} {Author {1=1}} \
 220         {Subject {1=21}} {Any {1=1016}} } }
 221 wm minsize . 0 0
 222
 223 set setOffset 0
 224 set setMax 0
 225
 226 proc tkerror err {
 227     set w .tkerrorw
 228
 229     if {[winfo exists $w]} {
 230         destroy $w
 231     }
 232     toplevel $w
 233     wm title $w "Error"
 234
 235     place-force $w .
 236     top-down-window $w
 237
 238     label $w.top.b -bitmap error
 239     message $w.top.t -aspect 300 -text "Error: $err" \
 240             -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
 241     pack $w.top.b $w.top.t -side left -padx 10 -pady 10
 242
 243     bottom-buttons $w [list {Close} [list destroy $w]] 0
 244 }
 245
 246 proc read-formats {} {
 247     global displayFormats
 248     global libdir
 249     set formats [glob -nocomplain ${libdir}/formats/*.tcl]
 250     foreach f $formats {
 251         if {[file readable $f]} {
 252             source $f
 253             set l [string length $f]
 254             set f [string range $f [string length "${libdir}/formats/"] \
 255                     [expr $l - 5]]
 256             lappend displayFormats $f
 257         }
 258     }
 259 }
 260
 261 proc set-wrap {m} {
 262     global textWrap
 263
 264     set textWrap $m
 265     .data.record configure -wrap $m
 266 }
 267
 268 proc dputs {m} {
 269 #    puts $m
 270 }
 271
 272 proc set-display-format {f} {
 273     global displayFormat
 274     global setNo
 275     global busy
 276
 277     set displayFormat $f
 278     if {$setNo == 0} {
 279         return
 280     }
 281     if {!$busy} {
 282         .bot.a.status configure -text "Reformatting"
 283     }
 284     update idletasks
 285     add-title-lines -1 10000 1
 286     if {!$busy} {
 287         .bot.a.status configure -text "Ready"
 288     }
 289 }
 290
 291 proc initBindings {} {
 292     set w Text
 293     bind $w <1> {}
 294     bind $w <Double-1> {}
 295     bind $w <Triple-1> {}
 296     bind $w <B1-Motion> {}
 297     bind $w <Shift-1> {}
 298     bind $w <Shift-B1-Motion> {}
 299     bind $w <2> {}
 300     bind $w <B2-Motion> {}
 301     bind $w <Any-KeyPress> {}
 302     bind $w <Return> {}
 303     bind $w <BackSpace> {}
 304     bind $w <Delete> {}
 305     bind $w <Control-h> {}
 306     bind $w <Control-d> {}
 307     bind $w <Control-v> {}
 308
 309     set w Listbox
 310     bind $w <B1-Motion> {}
 311     bind $w <Shift-B1-Motion> {}
 312
 313     set w Entry
 314 }
 315
 316 proc post-menu {wbutton wmenu} {
 317     $wmenu activate none
 318     focus $wmenu
 319     $wmenu post [winfo rootx $wbutton] \
 320             [expr [winfo rooty $wbutton]+[winfo height $wbutton]]
 321
 322 }
 323
 324 proc destroyGW {w} {
 325     global windowGeometry
 326     set windowGeometry($w) [wm geometry $w]
 327 }
 328 proc toplevelG {w} {
 329     global windowGeometry
 330
 331     toplevel $w
 332     if {[info exists windowGeometry($w)]} {
 333         set g $windowGeometry($w)
 334         if {$g != ""} {
 335             wm geometry $w $g
 336         }
 337     }
 338     bind $w <Destroy> [list destroyGW $w]
 339 }
 340
 341 if {[file readable "${libdir}/clientrc.tcl"]} {
 342     source "${libdir}/clientrc.tcl"
 343 }
 344
 345 if {[file readable "~/.clientrc.tcl"]} {
 346     source "~/.clientrc.tcl"
 347 }
 348
 349 set queryButtonsFind [lindex $queryButtons 0]
 350 set queryInfoFind [lindex $queryInfo 0]
 351
 352 proc top-down-window {w} {
 353     frame $w.top -relief raised -border 1
 354     frame $w.bot -relief raised -border 1
 355
 356     pack  $w.top -side top -fill both -expand yes
 357     pack  $w.bot -fill both
 358 }
 359
 360 proc top-down-ok-cancel {w ok-action g} {
 361     frame $w.bot.left -relief sunken -border 1
 362     pack $w.bot.left -side left -expand yes -ipadx 2 -ipady 2 -padx 5 -pady 5
 363     button $w.bot.left.ok -width 6 -text {Ok} \
 364             -command ${ok-action}
 365     pack $w.bot.left.ok -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3
 366     button $w.bot.cancel -width 6 -text {Cancel} \
 367             -command [list destroy $w]
 368     pack $w.bot.cancel -side left -expand yes
 369
 370     if {$g} {
 371         grab $w
 372         tkwait window $w
 373     }
 374 }
 375
 376 proc bottom-buttons {w buttonList g} {
 377     set i 0
 378     set l [llength $buttonList]
 379
 380     frame $w.bot.$i -relief sunken -border 1
 381     pack $w.bot.$i -side left -expand yes -padx 5 -pady 5
 382     button $w.bot.$i.ok -text [lindex $buttonList $i] \
 383             -command [lindex $buttonList [expr $i+1]]
 384     pack $w.bot.$i.ok -expand yes -ipadx 3 -ipady 2 -padx 3 -pady 3 -side left
 385
 386     incr i 2
 387     while {$i < $l} {
 388         button $w.bot.$i -text [lindex $buttonList $i] \
 389                 -command [lindex $buttonList [expr $i+1]]
 390         pack $w.bot.$i -expand yes -ipadx 2 -ipady 2 -padx 3 -pady 3 -side left
 391         incr i 2
 392     }
 393     if {$g} {
 394         # Grab ...
 395         grab $w
 396         tkwait window $w
 397     }
 398 }
 399
 400 proc cancel-operation {} {
 401     global cancelFlag
 402     global busy
 403     global delayRequest
 404
 405     if {$busy} {
 406         set cancelFlag 1
 407         set delayRequest {}
 408         show-status Cancel 0 1
 409     }
 410 }
 411
 412 proc show-target {target base} {
 413     global profile
 414
 415     if {$target == ""} {
 416         .bot.a.target configure -text ""
 417         return
 418     }
 419     if {$base == ""} {
 420          .bot.a.target configure -text "$target"
 421     } else {
 422          .bot.a.target configure -text "$target - $base"
 423     }
 424 }
 425
 426 proc show-logo {v1} {
 427     global busy
 428     global libdir
 429
 430     if {$busy != 0} {
 431         incr v1
 432         if {$v1==10} {
 433             set v1 1
 434         }
 435         .bot.logo configure -bitmap @${libdir}/bitmaps/book${v1}
 436         after 140 [list show-logo $v1]
 437         return
 438     }
 439     while {1} {
 440         .bot.logo configure -bitmap @${libdir}/bitmaps/book1
 441         tkwait variable busy
 442         if {$busy} {
 443             show-logo 1
 444             return
 445         }
 446     }
 447 }
 448
 449 proc show-status {status b sb} {
 450     global busy
 451     global scanEnable
 452     global setOffset
 453     global setMax
 454     global setNo
 455
 456     .bot.a.status configure -text "$status"
 457     if {$b == 1} {
 458         if {$busy == 0} {set busy 1}
 459     } else {
 460         set busy 0
 461     }
 462     if {$sb == {}} {
 463         return
 464     }
 465     if {$sb} {
 466         .top.service configure -state normal
 467         .mid.search configure -state normal
 468         if {$scanEnable} {
 469             .mid.scan configure -state normal
 470         }
 471         if {$setNo == 0} {
 472             .top.service.m disable 1
 473         } elseif {$setOffset > 0 && $setOffset <= [z39.$setNo resultCount]} {
 474             .top.service.m enable 1
 475             .mid.present configure -state normal
 476         } else {
 477             .top.service.m disable 1
 478         }
 479         if {[winfo exists .scan-window]} {
 480             .scan-window.bot.2 configure -state normal
 481             .scan-window.bot.4 configure -state normal
 482         }
 483     } else {
 484         .top.service configure -state disabled
 485         .mid.search configure -state disabled
 486         .mid.scan configure -state disabled
 487         .mid.present configure -state disabled
 488
 489         if {[winfo exists .scan-window]} {
 490             .scan-window.bot.2 configure -state disabled
 491             .scan-window.bot.4 configure -state disabled
 492         }
 493     }
 494 }
 495
 496 proc show-message {msg} {
 497     .bot.a.message configure -text "$msg"
 498 }
 499
 500 proc insertWithTags {w text args} {
 501     set start [$w index insert]
 502     $w insert insert $text
 503     foreach tag [$w tag names $start] {
 504         $w tag remove $tag $start insert
 505     }
 506     foreach i $args {
 507         $w tag add $i $start insert
 508     }
 509 }
 510
 511 proc popup-license {} {
 512     global libdir
 513     set w .popup-licence
 514     toplevel $w
 515
 516     wm title $w "License"
 517
 518     wm minsize $w 0 0
 519
 520     top-down-window $w
 521
 522     text $w.top.t -width 80 -height 10 -wrap word \
 523         -yscrollcommand [list $w.top.s set]
 524     scrollbar $w.top.s -command [list $w.top.t yview]
 525
 526     pack $w.top.s -side right -fill y
 527     pack $w.top.t -expand yes -fill both
 528
 529     if {[file readable "${libdir}/LICENSE"]} {
 530         set f [open "${libdir}/LICENSE" r]
 531         while {[gets $f buf] != -1} {
 532             $w.top.t insert end $buf
 533             $w.top.t insert end "\n"
 534         }
 535         close $f
 536     }
 537     bottom-buttons $w [list {Close} [list destroy $w]] 1
 538 }
 539
 540 proc about-target {} {
 541     set w .about-target-w
 542     global hostid
 543
 544     toplevel $w
 545
 546     wm title $w "About target"
 547     place-force $w .
 548     top-down-window $w
 549
 550     frame $w.top.a -relief ridge -border 2
 551     frame $w.top.p -relief ridge -border 2
 552
 553     pack $w.top.a $w.top.p -side top -fill x
 554
 555     label $w.top.a.about -text "About"
 556     label $w.top.a.irtcl -text $hostid \
 557             -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
 558     pack $w.top.a.about $w.top.a.irtcl -side top
 559
 560     set i [z39 targetImplementationName]
 561     label $w.top.p.in -text "Implementation name: $i"
 562     set i [z39 targetImplementationId]
 563     label $w.top.p.ii -text "Implementation id: $i"
 564     set i [z39 targetImplementationVersion]
 565     label $w.top.p.iv -text "Implementation version: $i"
 566     set i [z39 options]
 567     label $w.top.p.op -text "Protocol options: $i"
 568
 569     pack $w.top.p.in $w.top.p.ii $w.top.p.iv $w.top.p.op -side top -anchor nw
 570
 571     bottom-buttons $w [list {Close} [list destroy $w]] 1
 572 }
 573
 574 proc about-origin-logo {n} {
 575     global libdir
 576     set w .about-origin-w
 577     if {![winfo exists $w]} {
 578         return
 579     }
 580     incr n
 581     if {$n==10} {
 582         set n 1
 583     }
 584     $w.top.a.logo configure -bitmap @${libdir}/bitmaps/book$n
 585     after 140 [list about-origin-logo $n]
 586 }
 587
 588 proc about-origin {} {
 589     set w .about-origin-w
 590     global libdir
 591
 592     if {[winfo exists $w]} {
 593         destroy $w
 594     }
 595     toplevel $w
 596
 597     wm title $w "About IrTcl"
 598     place-force $w .
 599     top-down-window $w
 600
 601     frame $w.top.a -relief ridge -border 2
 602     frame $w.top.p -relief ridge -border 2
 603
 604     pack $w.top.a $w.top.p -side top -fill x
 605
 606     label $w.top.a.irtcl -text "IrTcl" \
 607             -font -Adobe-Helvetica-Bold-R-Normal-*-240-*
 608     label $w.top.a.logo -bitmap @${libdir}/bitmaps/book1
 609     pack $w.top.a.irtcl $w.top.a.logo -side left -expand yes
 610
 611     set i [z39 implementationName]
 612     label $w.top.p.in -text "Implementation name: $i"
 613     set i [z39 implementationId]
 614     label $w.top.p.ii -text "Implementation id: $i"
 615     set i [z39 implementationVersion]
 616     label $w.top.p.iv -text "Implementation version: $i"
 617
 618     pack $w.top.p.in $w.top.p.ii $w.top.p.iv -side top -anchor nw
 619
 620     about-origin-logo 1
 621     bottom-buttons $w [list {Close} [list destroy $w] \
 622                             {License} [list popup-license]] 0
 623 }
 624
 625 proc popup-marc {sno no b df} {
 626     global fullMarcSeq
 627     global displayFormats
 628     global popupMarcdf
 629
 630     if {[z39.$sno type $no] != "DB"} {
 631         return
 632     }
 633     if {$b} {
 634         set w .full-marc-$fullMarcSeq
 635         incr fullMarcSeq
 636         set df $popupMarcdf
 637     } else {
 638         set w .full-marc
 639         set df $popupMarcdf
 640     }
 641     if {[winfo exists $w]} {
 642         set new 0
 643     } else {
 644
 645         toplevelG $w
 646
 647         wm minsize $w 0 0
 648
 649         frame $w.top -relief raised -border 1
 650         frame $w.bot -relief raised -border 1
 651
 652         pack  $w.top -side top -fill both -expand yes
 653         pack  $w.bot -fill both
 654
 655         text $w.top.record -width 60 -height 5 -wrap word \
 656                 -yscrollcommand [list $w.top.s set]
 657         scrollbar $w.top.s -command [list $w.top.record yview]
 658
 659         if {[tk colormodel .] == "color"} {
 660             $w.top.record tag configure marc-tag -foreground blue
 661             $w.top.record tag configure marc-id -foreground red
 662         } else {
 663             $w.top.record tag configure marc-tag -foreground black
 664             $w.top.record tag configure marc-id -foreground black
 665         }
 666         $w.top.record tag configure marc-data -foreground black
 667         set new 1
 668     }
 669     $w.top.record delete 0.0 end
 670     set recordType [z39.$sno recordType $no]
 671     wm title $w "$recordType record #$no"
 672
 673     if {$new} {
 674         bind $w.top.record <Return> {destroy .full-marc}
 675
 676         pack $w.top.s -side right -fill y
 677         pack $w.top.record -expand yes -fill both
 678
 679         if {$b} {
 680             bottom-buttons $w [list \
 681                 {Close} [list destroy $w]] 0
 682         } else {
 683             bottom-buttons $w [list \
 684                     {Close} [list destroy $w] \
 685                     {Duplicate} [list popup-marc $sno $no 1 0]] 0
 686             menubutton $w.bot.formats -text "Format" -menu $w.bot.formats.m
 687             menu $w.bot.formats.m
 688             set i 0
 689             foreach f $displayFormats {
 690                 $w.bot.formats.m add radiobutton -label $f \
 691                         -variable popupMarcdf -value $i \
 692                         -command [list display-$f $sno $no $w.top.record 0]
 693                 incr i
 694             }
 695             pack $w.bot.formats -expand yes -ipadx 2 -ipady 2 \
 696                     -padx 3 -pady 3 -side left
 697         }
 698     } else {
 699         set i 0
 700         foreach f $displayFormats {
 701             $w.bot.formats.m entryconfigure $i \
 702                     -command [list display-$f $sno $no $w.top.record 0]
 703             incr i
 704         }
 705     }
 706     set ffunc [lindex $displayFormats $df]
 707     set ffunc "display-$ffunc"
 708
 709     $ffunc $sno $no $w.top.record 0
 710 }
 711
 712 proc update-target-hotlist {target base} {
 713     global hotTargets
 714
 715     set len [llength $hotTargets]
 716     if {$len > 0} {
 717         .top.target.m delete 6 [expr 6+[llength $hotTargets]]
 718     }
 719     set i 0
 720     foreach e $hotTargets {
 721         if {$target == [lindex $e 0] && $base == [lindex $e 1]} {
 722             set hotTargets [lreplace $hotTargets $i $i]
 723             break
 724         }
 725         incr i
 726     }
 727     set hotTargets [linsert $hotTargets 0 [list $target $base]]
 728     set-target-hotlist
 729 }
 730
 731 proc set-target-hotlist {} {
 732     global hotTargets
 733
 734     set i 1
 735     foreach e $hotTargets {
 736         set target [lindex $e 0]
 737         set base [lindex $e 1]
 738         if {$base == ""} {
 739             .top.target.m add command -label "$i $target" -command \
 740                 [list reopen-target $target {}]
 741         } else {
 742             .top.target.m add command -label "$i $target - $base" -command \
 743                 [list reopen-target $target $base]
 744         }
 745         incr i
 746         if {$i > 8} {
 747              break
 748         }
 749     }
 750 }
 751
 752 proc reopen-target {target base} {
 753     close-target
 754     open-target $target $base
 755     update-target-hotlist $target $base
 756 }
 757
 758 proc define-target-action {} {
 759     global profile
 760
 761     set target [.target-define.top.target.entry get]
 762     if {$target == ""} {
 763         return
 764     }
 765     foreach n [array names profile] {
 766         if {$n == $target} {
 767             protocol-setup $n
 768             return
 769         }
 770     }
 771     set seq [lindex $profile(Default) 12]
 772     dputs "seq=${seq}"
 773     set profile($target) $profile(Default)
 774     set profile(Default) [lreplace $profile(Default) 12 12 [incr seq]]
 775
 776     protocol-setup $target
 777     destroy .target-define
 778 }
 779
 780 proc fail-response {target} {
 781     set c [lindex [z39 failInfo] 0]
 782     set m [lindex [z39 failInfo] 1]
 783     close-target
 784     tkerror "$m ($c)"
 785 }
 786
 787 proc connect-response {target base} {
 788     dputs "connect-response"
 789     show-target $target $base
 790     init-request
 791 }
 792
 793 proc open-target {target base} {
 794     global profile
 795     global hostid
 796
 797     z39 disconnect
 798     z39 comstack [lindex $profile($target) 6]
 799     z39 protocol [lindex $profile($target) 11]
 800     z39 idAuthentication [lindex $profile($target) 3]
 801     z39 maximumRecordSize [lindex $profile($target) 4]
 802     z39 preferredMessageSize [lindex $profile($target) 5]
 803     dputs "maximumRecordSize="
 804     dputs [z39 maximumRecordSize]
 805     dputs "preferredMessageSize="
 806     dputs [z39 preferredMessageSize]
 807     show-status {Connecting} 1 0
 808     if {$base == ""} {
 809         z39 databaseNames [lindex [lindex $profile($target) 7] 0]
 810     } else {
 811         z39 databaseNames $base
 812     }
 813     z39 failback [list fail-response $target]
 814     z39 callback [list connect-response $target $base]
 815     update idletasks
 816     set err [catch {
 817         z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2]
 818         } errorMessage]
 819     if {$err} {
 820         tkerror $errorMessage
 821         show-status Ready 0 {}
 822         return
 823     }
 824     set hostid $target
 825     .top.target.m disable 0
 826     .top.target.m enable 1
 827     .top.target.m enable 2
 828 }
 829
 830 proc close-target {} {
 831     global hostid
 832     global cancelFlag
 833     global setNo
 834
 835     set cancelFlag 0
 836     set setNo 0
 837     .bot.a.set configure -text ""
 838     set hostid Default
 839     z39 disconnect
 840     show-target {} {}
 841     show-status {Not connected} 0 0
 842     init-title-lines
 843     show-message {}
 844     .top.target.m disable 1
 845     .top.target.m disable 2
 846     .top.target.m enable 0
 847 }
 848
 849 proc load-set-action {} {
 850     global setNo
 851
 852     incr setNo
 853     ir-set z39.$setNo z39
 854
 855     set fname [.load-set.top.filename.entry get]
 856     destroy .load-set
 857     if {$fname != ""} {
 858         show-status {Loading} 1 {}
 859         update
 860         z39.$setNo loadFile $fname
 861
 862         set no [z39.$setNo numberOfRecordsReturned]
 863         add-title-lines $setNo $no 1
 864     }
 865     set l [format "%-4d %7d" $setNo $no]
 866     .top.rset.m add command -label $l \
 867             -command [list add-title-lines $setNo 10000 1]
 868     show-status {Ready} 0 {}
 869 }
 870
 871 proc load-set {} {
 872     set w .load-set
 873
 874     set oldFocus [focus]
 875     toplevel $w
 876
 877     place-force $w .
 878     top-down-window $w
 879
 880     frame $w.top.filename
 881     pack $w.top.filename -side top -anchor e -pady 2
 882
 883     entry-fields $w.top {filename} \
 884             {{Filename:}} \
 885             {load-set-action} {destroy .load-set}
 886
 887     top-down-ok-cancel $w {load-set-action} 1
 888     focus $oldFocus
 889 }
 890
 891 proc init-request {} {
 892     global setNo
 893     global cancelFlag
 894
 895     if {$cancelFlag} {
 896         close-target
 897         return
 898     }
 899     z39 callback {init-response}
 900     show-status {Initializing} 1 {}
 901     set err [catch {z39 init} errorMessage]
 902     if {$err} {
 903         tkerror $errorMessage
 904         show-status Ready 0 {}
 905     }
 906 }
 907
 908 proc init-response {} {
 909     global cancelFlag
 910     global scanEnable
 911
 912     if {$cancelFlag} {
 913         close-target
 914         return
 915     }
 916     if {![z39 initResult]} {
 917         show-status {Ready} 0 1
 918         set u [z39 userInformationField]
 919         close-target
 920         tkerror "Connection rejected by target: $u"
 921     } else {
 922         if {[lsearch [z39 options] scan] >= 0} {
 923             set scanEnable 1
 924         } else {
 925             set scanEnable 0
 926         }
 927         show-status {Ready} 0 1
 928     }
 929 }
 930
 931 proc search-request {bflag} {
 932     global setNo
 933     global profile
 934     global hostid
 935     global busy
 936     global cancelFlag
 937     global delayRequest
 938     global recordSyntax
 939
 940     set target $hostid
 941
 942     dputs "search-request"
 943     show-message {}
 944     if {!$bflag && $busy} {
 945         dputs "busy: search-request ignored"
 946         return
 947     }
 948     if {$cancelFlag} {
 949         dputs "cancelFlag"
 950         show-status {Searching} 1 0
 951         set delayRequest {search-request 1}
 952         return
 953     }
 954     set delayRequest {}
 955
 956     set query [index-query]
 957     if {$query==""} {
 958         return
 959     }
 960     incr setNo
 961     ir-set z39.$setNo z39
 962
 963     if {[lindex $profile($target) 10] == 1} {
 964         z39.$setNo setName $setNo
 965         dputs "setName=${setNo}"
 966     } else {
 967         z39.$setNo setName Default
 968         dputs "setName=Default"
 969     }
 970     if {[lindex $profile($target) 8] == 1} {
 971         z39.$setNo queryType rpn
 972     }
 973     if {[lindex $profile($target) 9] == 1} {
 974         z39.$setNo queryType ccl
 975     }
 976     dputs Setting
 977     dputs $recordSyntax
 978     if {$recordSyntax == "None" } {
 979         z39.$setNo preferredRecordSyntax {}
 980     } else {
 981         z39.$setNo preferredRecordSyntax $recordSyntax
 982     }
 983     z39 callback {search-response}
 984     z39.$setNo search $query
 985     show-status {Searching} 1 0
 986 }
 987
 988 proc scan-copy {y entry} {
 989     set w .scan-window
 990     set no [$w.top.list nearest $y]
 991     dputs "no=$no"
 992     .lines.$entry.e delete 0 end
 993     .lines.$entry.e insert 0 [string range [$w.top.list get $no] 8 end]
 994 }
 995
 996 proc scan-request {} {
 997     set w .scan-window
 998
 999     global profile
1000     global hostid
1001     global scanView
1002     global scanTerm
1003     global curIndexEntry
1004     global queryButtonsFind
1005     global queryInfoFind
1006     global cancelFlag
1007     global delayRequest
1008
1009     dputs "scan-request"
1010     if {$cancelFlag} {
1011         dputs "cancelFlag"
1012         show-status {Scanning} 1 0
1013         set delayRequest scan-request
1014         return
1015     }
1016     set delayRequest {}
1017
1018     set target $hostid
1019     set scanView 0
1020     set scanTerm {}
1021
1022     set b [lindex $queryButtonsFind $curIndexEntry]
1023     set attr {}
1024     foreach a [lrange [lindex $queryInfoFind [lindex $b 1]] 1 end] {
1025         set attr "@attr $a $attr"
1026     }
1027     set title [lindex [lindex $queryInfoFind [lindex $b 1]] 0]
1028     ir-scan z39.scan z39
1029
1030     if {![winfo exists $w]} {
1031         toplevelG $w
1032
1033         wm minsize $w 0 0
1034
1035         top-down-window $w
1036
1037         entry $w.top.entry -relief sunken
1038         pack $w.top.entry -fill x -padx 4 -pady 2
1039         bind $w.top.entry <KeyRelease> [list scan-term-h $attr]
1040         if {1} {
1041             listbox $w.top.list -yscrollcommand [list $w.top.scroll set] \
1042                     -font fixed
1043             scrollbar $w.top.scroll -orient vertical -border 1
1044             pack $w.top.list -side left -fill both -expand yes
1045             pack $w.top.scroll -side right -fill y
1046             $w.top.scroll config -command [list $w.top.list yview]
1047         } else {
1048             listbox $w.top.list -font fixed -geometry 60x14
1049             pack $w.top.list -side left -fill both -expand yes
1050         }
1051
1052         bottom-buttons $w [list {Close} [list destroy $w] \
1053                 {Up} [list scan-up $attr] \
1054                 {Down} [list scan-down $attr]] 0
1055         bind $w.top.list <Up> [list scan-up $attr]
1056         bind $w.top.list <Down> [list scan-down $attr]
1057     }
1058     bind $w.top.list <Double-Button-1> [list scan-copy %y $curIndexEntry]
1059     wm title $w "Scan $title"
1060
1061     z39 callback [list scan-response $attr 0 35]
1062     z39.scan numberOfTermsRequested 5
1063     z39.scan preferredPositionInResponse 1
1064     z39.scan scan "${attr} 0"
1065
1066     show-status {Scanning} 1 0
1067 }
1068
1069 proc scan-term-h {attr} {
1070     global busy
1071     global scanTerm
1072
1073     if {$busy} {
1074         return
1075     }
1076     set w .scan-window
1077     set nScanTerm [$w.top.entry get]
1078     if {$nScanTerm == $scanTerm} {
1079         return
1080     }
1081     set scanTerm $nScanTerm
1082     z39 callback [list scan-response $attr 0 35]
1083     z39.scan numberOfTermsRequested 5
1084     z39.scan preferredPositionInResponse 1
1085     dputs "${attr} \{${scanTerm}\}"
1086     if {$scanTerm == ""} {
1087         z39.scan scan "${attr} 0"
1088     } else {
1089         z39.scan scan "${attr} \{${scanTerm}\}"
1090     }
1091     show-status {Scanning} 1 0
1092 }
1093
1094 proc scan-response {attr start toget} {
1095     global cancelFlag
1096     global delayRequest
1097     global scanTerm
1098     global scanView
1099
1100     set w .scan-window
1101     dputs "In scan-response"
1102     set m [z39.scan numberOfEntriesReturned]
1103     dputs $m
1104     dputs attr=$attr
1105     dputs start=$start
1106     dputs toget=$toget
1107
1108     if {![winfo exists .scan-window]} {
1109         if {$cancelFlag} {
1110             set cancelFlag 0
1111             dputs "Handling cancel"
1112             if {$delayRequest != ""} {
1113                 eval $delayRequest
1114             }
1115             return
1116         }
1117         show-status {Ready} 0 1
1118         return
1119     }
1120     set nScanTerm [$w.top.entry get]
1121     if {$nScanTerm != $scanTerm} {
1122         z39 callback [list scan-response $attr 0 35]
1123         z39.scan numberOfTermsRequested 5
1124         z39.scan preferredPositionInResponse 1
1125         set scanTerm $nScanTerm
1126         dputs "${attr} \{${scanTerm}\}"
1127         if {$scanTerm == ""} {
1128             z39.scan scan "${attr} 0"
1129         } else {
1130             z39.scan scan "${attr} \{${scanTerm}\}"
1131         }
1132         show-status {Scanning} 1 0
1133         return
1134     }
1135     set status [z39.scan scanStatus]
1136     if {$status == 6} {
1137         tkerror "Scan fail"
1138         show-status {Ready} 0 1
1139         set cancelFlag 0
1140         return
1141     }
1142     if {$toget < 0} {
1143         for {set i 0} {$i < $m} {incr i} {
1144             set term [lindex [z39.scan scanLine $i] 1]
1145             set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]]
1146             $w.top.list insert $i "$nostr $term"
1147         }
1148         incr scanView $m
1149         $w.top.list yview $scanView
1150     } else {
1151         $w.top.list delete $start end
1152         for {set i 0} {$i < $m} {incr i} {
1153             set term [lindex [z39.scan scanLine $i] 1]
1154             set nostr [format " %-6d" [lindex [z39.scan scanLine $i] 2]]
1155             $w.top.list insert end "$nostr $term"
1156         }
1157     }
1158     if {$cancelFlag} {
1159         dputs "Handling cancel"
1160         set cancelFlag 0
1161         if {$delayRequest != ""} {
1162             eval $delayRequest
1163         }
1164         return
1165     }
1166     set delayRequest {}
1167     if {$toget > 0 && $m > 1 && $m < $toget} {
1168         set ntoget [expr $toget - $m + 1]
1169         dputs ntoget=$ntoget
1170         z39 callback [list scan-response $attr [expr $start + $m - 1] $ntoget]
1171         set q $term
1172         dputs "down continue: $q"
1173         if {$ntoget > 10} {
1174             z39.scan numberOfTermsRequested 10
1175         } else {
1176             z39.scan numberOfTermsRequested $ntoget
1177         }
1178         z39.scan preferredPositionInResponse 1
1179         dputs "${attr} \{$q\}"
1180         z39.scan scan "${attr} \{$q\}"
1181         return
1182     }
1183     if {$toget < 0 && $m > 1 && $m < [expr - $toget]} {
1184         set ntoget [expr - $toget - $m]
1185         dputs ntoget=$ntoget
1186         z39 callback [list scan-response $attr 0 -$ntoget]
1187         set q [string range [$w.top.list get 0] 8 end]
1188         dputs "up continue: $q"
1189         if {$ntoget > 10} {
1190             z39.scan numberOfTermsRequested 10
1191             z39.scan preferredPositionInResponse 11
1192         } else {
1193             z39.scan numberOfTermsRequested $ntoget
1194             z39.scan preferredPositionInResponse [incr ntoget]
1195         }
1196         dputs "${attr} \{$q\}"
1197         z39.scan scan "${attr} \{$q\}"
1198         return
1199     }
1200     show-status {Ready} 0 1
1201 }
1202
1203 proc scan-down {attr} {
1204     global scanView
1205     global cancelFlag
1206     global delayRequest
1207
1208     dputs {scan-down}
1209     if {$cancelFlag} {
1210         dputs "cancelFlag"
1211         show-status {Scanning down} 1 0
1212         set delayRequest [list scan-down $attr]
1213         return
1214     }
1215     set delayRequest {}
1216
1217     set w .scan-window
1218     set scanView [expr $scanView + 5]
1219     set s [$w.top.list size]
1220     if {$scanView > $s} {
1221         z39 callback [list scan-response $attr [expr $s - 1] 25]
1222         set q [string range [$w.top.list get [expr $s - 1]] 8 end]
1223         dputs "down: $q"
1224         z39.scan numberOfTermsRequested 10
1225         z39.scan preferredPositionInResponse 1
1226         show-status {Scanning} 1 0
1227         dputs "${attr} \{$q\}"
1228         z39.scan scan "${attr} \{$q\}"
1229         return
1230     }
1231     $w.top.list yview $scanView
1232 }
1233
1234 proc scan-up {attr} {
1235     global scanView
1236     global cancelFlag
1237     global delayRequest
1238
1239     dputs {scan-up}
1240     if {$cancelFlag} {
1241         dputs "cancelFlag"
1242         show-status {Scanning up} 1 0
1243         set delayRequest [list scan-up $attr]
1244         return
1245     }
1246     set delayRequest {}
1247
1248     set w .scan-window
1249     set scanView [expr $scanView - 5]
1250     if {$scanView < 0} {
1251         z39 callback [list scan-response $attr 0 -25]
1252         set q [string range [$w.top.list get 0] 8 end]
1253         dputs "up: $q"
1254         z39.scan numberOfTermsRequested 10
1255         z39.scan preferredPositionInResponse 11
1256         show-status {Scanning} 1 0
1257         z39.scan scan "${attr} \{$q\}"
1258         return
1259     }
1260     $w.top.list yview $scanView
1261 }
1262
1263 proc search-response {} {
1264     global setNo
1265     global setOffset
1266     global setMax
1267     global cancelFlag
1268     global busy
1269     global delayRequest
1270
1271     dputs "In search-response"
1272     if {$cancelFlag} {
1273         dputs "Handling cancel"
1274         set cancelFlag 0
1275         if {$delayRequest != ""} {
1276             eval $delayRequest
1277         }
1278         return
1279     }
1280     set delayRequest {}
1281     init-title-lines
1282     set setMax [z39.$setNo resultCount]
1283     show-status {Ready} 0 1
1284     set status [z39.$setNo responseStatus]
1285     if {[lindex $status 0] == "NSD"} {
1286         set setOffset 0
1287         set code [lindex $status 1]
1288         set msg [lindex $status 2]
1289         set addinfo [lindex $status 3]
1290         tkerror "NSD$code: $msg: $addinfo"
1291         return
1292     }
1293     if {$setMax > 20} {
1294         set setMax 20
1295     }
1296     show-message "${setMax} hits"
1297     set setOffset 1
1298     show-status {Ready} 0 1
1299     set l [format "%-4d %7d" $setNo $setMax]
1300     .top.rset.m add command -label $l \
1301             -command [list add-title-lines $setNo 10000 1]
1302     z39 callback {present-response}
1303     z39.$setNo present $setOffset 1
1304     show-status {Retrieving} 1 0
1305 }
1306
1307 proc present-more {number} {
1308     global setNo
1309     global setOffset
1310     global setMax
1311     global busy
1312     global cancelFlag
1313     global delayRequest
1314
1315     dputs "present-more"
1316     if {$cancelFlag} {
1317         show-status {Retrieving} 1 0
1318         set delayRequest "present-more $number"
1319         return
1320     }
1321     set delayRequest {}
1322
1323     if {$setNo == 0} {
1324         dputs "setNo=$setNo"
1325         return
1326     }
1327     set max [z39.$setNo resultCount]
1328     if {$max <= $setOffset} {
1329         dputs "max=$max"
1330         dputs "setOffset=$setOffset"
1331         return
1332     }
1333     if {$number == ""} {
1334         set setMax $max
1335     } else {
1336         incr setMax $number
1337         if {$setMax > $max} {
1338             set setMax $max
1339         }
1340     }
1341     z39 callback {present-response}
1342
1343     set toGet [expr $setMax - $setOffset + 1]
1344     if {$toGet <= 0} {
1345         return
1346     }
1347     if {$toGet > 3} {
1348         set toGet 3
1349     }
1350     z39.$setNo present $setOffset $toGet
1351     show-status {Retrieving} 1 0
1352 }
1353
1354 proc init-title-lines {} {
1355     .data.record delete 0.0 end
1356 }
1357
1358 proc title-press {y setno} {
1359     show-full-marc $setno [expr 1 + [.data.list nearest $y]] 0
1360 }
1361
1362 proc add-title-lines {setno no offset} {
1363     global displayFormats
1364     global displayFormat
1365     global lastSetNo
1366
1367     if {$setno == -1} {
1368         set setno $lastSetNo
1369     } else {
1370         set lastSetNo $setno
1371     }
1372     if {$offset == 1} {
1373         .bot.a.set configure -text $setno
1374         .data.record delete 0.0 end
1375     }
1376     set ffunc [lindex $displayFormats $displayFormat]
1377     dputs "ffunc=$ffunc"
1378     set ffunc "display-$ffunc"
1379     for {set i 0} {$i < $no} {incr i} {
1380         set o [expr $i + $offset]
1381         set type [z39.$setno type $o]
1382         if {$type == ""} {
1383             break
1384         }
1385         .data.record tag bind r$o <Any-Enter> {}
1386         .data.record tag bind r$o <Any-Leave> {}
1387         set insert0 [.data.record index insert]
1388         $ffunc $setno $o .data.record 1
1389         .data.record tag add r$o $insert0 insert
1390         .data.record tag bind r$o <1> \
1391                 [list popup-marc $setno $o 0 0]
1392         update idletasks
1393     }
1394 }
1395
1396 proc present-response {} {
1397     global setNo
1398     global setOffset
1399     global setMax
1400     global cancelFlag
1401     global delayRequest
1402
1403     dputs "In present-response"
1404     set no [z39.$setNo numberOfRecordsReturned]
1405     dputs "Returned $no records, setOffset $setOffset"
1406     add-title-lines $setNo $no $setOffset
1407     set setOffset [expr $setOffset + $no]
1408     if {$cancelFlag} {
1409         dputs "Handling cancel"
1410         set cancelFlag 0
1411         if {$delayRequest != ""} {
1412             eval $delayRequest
1413         }
1414         return
1415     }
1416     set status [z39.$setNo responseStatus]
1417     if {[lindex $status 0] == "NSD"} {
1418         show-status {Ready} 0 1
1419         set code [lindex $status 1]
1420         set msg [lindex $status 2]
1421         set addinfo [lindex $status 3]
1422         tkerror "NSD$code: $msg: $addinfo"
1423         return
1424     }
1425     if {$no > 0 && $setOffset <= $setMax} {
1426         dputs "present-request from ${setOffset}"
1427         set toGet [expr $setMax - $setOffset + 1]
1428         if {$toGet > 3} {
1429             set toGet 3
1430         }
1431         z39.$setNo present $setOffset $toGet
1432     } else {
1433         show-status {Ready} 0 1
1434     }
1435 }
1436
1437 proc left-cursor {w} {
1438     set i [$w index insert]
1439     if {$i > 0} {
1440         incr i -1
1441         $w icursor $i
1442     }
1443 }
1444
1445 proc right-cursor {w} {
1446     set i [$w index insert]
1447     incr i
1448     $w icursor $i
1449 }
1450
1451 proc bind-fields {list returnAction escapeAction} {
1452     set max [expr [llength $list]-1]
1453     for {set i 0} {$i < $max} {incr i} {
1454         bind [lindex $list $i] <Return> $returnAction
1455         bind [lindex $list $i] <Escape> $escapeAction
1456         bind [lindex $list $i] <Tab> [list focus [lindex $list [expr $i+1]]]
1457         bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
1458         bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
1459     }
1460     bind [lindex $list $i] <Return> $returnAction
1461     bind [lindex $list $i] <Escape> $escapeAction
1462     bind [lindex $list $i] <Tab>    [list focus [lindex $list 0]]
1463     bind [lindex $list $i] <Left> [list left-cursor [lindex $list $i]]
1464     bind [lindex $list $i] <Right> [list right-cursor [lindex $list $i]]
1465     focus [lindex $list 0]
1466 }
1467
1468 proc entry-fields {parent list tlist returnAction escapeAction} {
1469     set alist {}
1470     set i 0
1471     foreach field $list {
1472         set label ${parent}.${field}.label
1473         set entry ${parent}.${field}.entry
1474         label $label -text [lindex $tlist $i] -anchor e
1475         entry $entry -width 32 -relief sunken
1476         pack $label -side left
1477         pack $entry -side right
1478         lappend alist $entry
1479         incr i
1480     }
1481     bind-fields $alist $returnAction $escapeAction
1482 }
1483
1484 proc define-target-dialog {} {
1485     set w .target-define
1486
1487     toplevel $w
1488     place-force $w .
1489     top-down-window $w
1490     frame $w.top.target
1491     pack $w.top.target \
1492             -side top -anchor e -pady 2
1493     entry-fields $w.top {target} \
1494             {{Target:}} \
1495             {define-target-action} {destroy .target-define}
1496     top-down-ok-cancel $w {define-target-action} 1
1497 }
1498
1499 proc protocol-setup-delete {target} {
1500     global profile
1501     global settingsChanged
1502
1503     set a [alert "Are you sure you want to delete the target \
1504 definition $target ?"]
1505     if {$a} {
1506         set wno [lindex $profile($target) 12]
1507         set w .setup-${wno}
1508         destroy $w
1509         unset profile($target)
1510         set settingsChanged 1
1511         cascade-target-list
1512     }
1513 }
1514
1515 proc protocol-setup-action {target} {
1516     global profile
1517     global csRadioType
1518     global protocolRadioType
1519     global settingsChanged
1520     global RPNCheck
1521     global CCLCheck
1522     global ResultSetCheck
1523
1524     set wno [lindex $profile($target) 12]
1525     set w .setup-${wno}
1526
1527     set b {}
1528     set settingsChanged 1
1529     set len [$w.top.databases.list size]
1530     for {set i 0} {$i < $len} {incr i} {
1531         lappend b [$w.top.databases.list get $i]
1532     }
1533     set profile($target) [list [$w.top.description.entry get] \
1534             [$w.top.host.entry get] \
1535             [$w.top.port.entry get] \
1536             [$w.top.idAuthentication.entry get] \
1537             [$w.top.maximumRecordSize.entry get] \
1538             [$w.top.preferredMessageSize.entry get] \
1539             $csRadioType \
1540             $b \
1541             $RPNCheck \
1542             $CCLCheck \
1543             $ResultSetCheck \
1544             $protocolRadioType \
1545             $wno]
1546
1547     cascade-target-list
1548     dputs $profile($target)
1549     destroy $w
1550 }
1551
1552 proc place-force {window parent} {
1553     set g [wm geometry $parent]
1554
1555     set p1 [string first + $g]
1556     set p2 [string last + $g]
1557
1558     set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]]
1559     set y [expr 60+[string range $g [expr $p2 +1] end]]
1560     wm geometry $window +${x}+${y}
1561 }
1562
1563 proc add-database-action {target} {
1564     global profile
1565
1566     set wno [lindex $profile($target) 12]
1567     set w .setup-${wno}
1568
1569     $w.top.databases.list insert end \
1570             [.database-select.top.database.entry get]
1571     destroy .database-select
1572 }
1573
1574 proc add-database {target} {
1575     global profile
1576
1577     set w .database-select
1578
1579     set oldFocus [focus]
1580     toplevel $w
1581
1582     set wno [lindex $profile($target) 12]
1583     place-force $w .setup-${wno}
1584
1585     top-down-window $w
1586
1587     frame $w.top.database
1588
1589     pack $w.top.database -side top -anchor e -pady 2
1590
1591     entry-fields $w.top {database} \
1592             {{Database to add:}} \
1593             [list add-database-action $target] {destroy .database-select}
1594
1595     top-down-ok-cancel $w [list add-database-action $target] 1
1596     focus $oldFocus
1597 }
1598
1599 proc delete-database {target} {
1600     global profile
1601
1602     set wno [lindex $profile($target) 12]
1603     set w .setup-${wno}
1604     set l {}
1605     foreach i [$w.top.databases.list curselection] {
1606         set b [$w.top.databases.list get $i]
1607         set l "$l $b"
1608     }
1609     set a [alert "Are you sure you want to remove the database(s)${l}?"]
1610     if {$a} {
1611         foreach i [lsort -decreasing \
1612                 [$w.top.databases.list curselection]] {
1613             $w.top.databases.list delete $i
1614         }
1615     }
1616 }
1617
1618 proc protocol-setup {target} {
1619     global profile
1620     global csRadioType
1621     global protocolRadioType
1622     global RPNCheck
1623     global CCLCheck
1624     global ResultSetCheck
1625
1626     set wno [lindex $profile($target) 12]
1627     set w .setup-${wno}
1628
1629     toplevelG $w
1630
1631     wm title $w "Setup $target"
1632
1633     top-down-window $w
1634
1635     if {$target == ""} {
1636         set target Default
1637     }
1638     dputs target
1639     dputs $profile($target)
1640
1641     frame $w.top.host
1642     frame $w.top.port
1643     frame $w.top.description
1644     frame $w.top.idAuthentication
1645     frame $w.top.maximumRecordSize
1646     frame $w.top.preferredMessageSize
1647     frame $w.top.cs-type -relief ridge -border 2
1648     frame $w.top.protocol -relief ridge -border 2
1649     frame $w.top.query -relief ridge -border 2
1650     frame $w.top.databases -relief ridge -border 2
1651
1652     # Maximum/preferred/idAuth ...
1653     pack $w.top.description $w.top.host $w.top.port \
1654             $w.top.idAuthentication $w.top.maximumRecordSize \
1655             $w.top.preferredMessageSize -side top -anchor e -pady 2
1656
1657     entry-fields $w.top {description host port idAuthentication \
1658             maximumRecordSize preferredMessageSize} \
1659             {{Description:} {Host:} {Port:} {Id Authentication:} \
1660             {Maximum Record Size:} {Preferred Message Size:}} \
1661             [list protocol-setup-action $target] [list destroy $w]
1662
1663     foreach sub {description host port idAuthentication \
1664             maximumRecordSize preferredMessageSize} {
1665         dputs $sub
1666         bind $w.top.$sub.entry <Control-a> [list add-database $target]
1667         bind $w.top.$sub.entry <Control-d> [list delete-database $target]
1668     }
1669     $w.top.description.entry insert 0 [lindex $profile($target) 0]
1670     $w.top.host.entry insert 0 [lindex $profile($target) 1]
1671     $w.top.port.entry insert 0 [lindex $profile($target) 2]
1672     $w.top.idAuthentication.entry insert 0 [lindex $profile($target) 3]
1673     $w.top.maximumRecordSize.entry insert 0 [lindex $profile($target) 4]
1674     $w.top.preferredMessageSize.entry insert 0 [lindex $profile($target) 5]
1675     set csRadioType [lindex $profile($target) 6]
1676     set RPNCheck [lindex $profile($target) 8]
1677     set CCLCheck [lindex $profile($target) 9]
1678     set ResultSetCheck [lindex $profile($target) 10]
1679     set protocolRadioType [lindex $profile($target) 11]
1680     if {$protocolRadioType == ""} {
1681         set protocolRadioType Z39
1682     }
1683
1684     # Databases ....
1685     pack $w.top.databases -side left -pady 4 -padx 4 -expand yes -fill both
1686
1687     label $w.top.databases.label -text "Databases"
1688     button $w.top.databases.add -text "Add" \
1689             -command [list add-database $target]
1690     button $w.top.databases.delete -text "Delete" \
1691             -command [list delete-database $target]
1692     listbox $w.top.databases.list -geometry 20x6 \
1693             -yscrollcommand "$w.top.databases.scroll set"
1694     scrollbar $w.top.databases.scroll -orient vertical -border 1
1695     pack $w.top.databases.label -side top -fill x \
1696             -padx 2 -pady 2
1697     pack $w.top.databases.add $w.top.databases.delete -side top -fill x \
1698             -padx 2 -pady 2
1699     pack $w.top.databases.list -side left -fill both -expand yes \
1700             -padx 2 -pady 2
1701     pack $w.top.databases.scroll -side right -fill y \
1702             -padx 2 -pady 2
1703     $w.top.databases.scroll config -command "$w.top.databases.list yview"
1704
1705     foreach b [lindex $profile($target) 7] {
1706         $w.top.databases.list insert end $b
1707     }
1708
1709     # Transport ...
1710     pack $w.top.cs-type -pady 4 -padx 4 -side top -fill x
1711
1712     label $w.top.cs-type.label -text "Transport"
1713     radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \
1714             -variable csRadioType -value tcpip
1715     radiobutton $w.top.cs-type.mosi -text "MOSI" -anchor w\
1716             -variable csRadioType -value mosi
1717
1718     pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \
1719             -padx 4 -side top -fill x
1720
1721     # Protocol ...
1722     pack $w.top.protocol -pady 4 -padx 4 -side top -fill x
1723
1724     label $w.top.protocol.label -text "Protocol"
1725     radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \
1726             -variable protocolRadioType -value Z39
1727     radiobutton $w.top.protocol.sr -text "SR" -anchor w \
1728             -variable protocolRadioType -value SR
1729
1730     pack $w.top.protocol.label $w.top.protocol.z39v2 $w.top.protocol.sr \
1731             -padx 4 -side top -fill x
1732
1733     # Query ...
1734     pack $w.top.query -pady 4 -padx 4 -side top -fill x
1735
1736     label $w.top.query.label -text "Query support"
1737     checkbutton $w.top.query.c1 -text "RPN query" -anchor w -variable RPNCheck
1738     checkbutton $w.top.query.c2 -text "CCL query" -anchor w -variable CCLCheck
1739     checkbutton $w.top.query.c3 -text "Result sets" -anchor w -variable ResultSetCheck
1740
1741     pack $w.top.query.label -side top
1742     pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \
1743             -padx 4 -side top -fill x
1744
1745     # Ok-cancel
1746     bottom-buttons $w [list {Ok} [list protocol-setup-action $target] \
1747             {Delete} [list protocol-setup-delete $target] \
1748             {Cancel} [list destroy $w]] 0
1749 }
1750
1751 proc database-select-action {} {
1752     set w .database-select.top
1753     set b {}
1754     foreach indx [$w.databases.list curselection] {
1755         lappend b [$w.databases.list get $indx]
1756     }
1757     if {$b != ""} {
1758         z39 databaseNames $b
1759     }
1760     destroy .database-select
1761 }
1762
1763 proc database-select {} {
1764     set w .database-select
1765     global profile
1766     global hostid
1767
1768     toplevel $w
1769
1770     place-force $w .
1771
1772     top-down-window $w
1773
1774     frame $w.top.databases -relief ridge -border 2
1775
1776     pack $w.top.databases -side left -pady 6 -padx 6 -expand yes -fill x
1777
1778     label $w.top.databases.label -text "List"
1779     listbox $w.top.databases.list -geometry 20x6 \
1780             -yscrollcommand "$w.top.databases.scroll set"
1781     scrollbar $w.top.databases.scroll -orient vertical -border 1
1782     pack $w.top.databases.label -side top -fill x \
1783             -padx 2 -pady 2
1784     pack $w.top.databases.list -side left -fill both -expand yes \
1785             -padx 2 -pady 2
1786     pack $w.top.databases.scroll -side right -fill y \
1787             -padx 2 -pady 2
1788     $w.top.databases.scroll config -command "$w.top.databases.list yview"
1789
1790     foreach b [lindex $profile($hostid) 7] {
1791         $w.top.databases.list insert end $b
1792     }
1793     top-down-ok-cancel $w {database-select-action} 1
1794 }
1795
1796 proc cascade-target-list {} {
1797     global profile
1798
1799     foreach sub [winfo children .top.target.m.clist] {
1800         destroy $sub
1801     }
1802     .top.target.m.clist delete 0 last
1803     foreach n [array names profile] {
1804         if {$n != "Default"} {
1805             set nl [lindex $profile($n) 12]
1806             if {[llength [lindex $profile($n) 7]] > 1} {
1807                 .top.target.m.clist add cascade -label $n \
1808                         -menu .top.target.m.clist.$nl
1809                 menu .top.target.m.clist.$nl
1810                 foreach b [lindex $profile($n) 7] {
1811                     .top.target.m.clist.$nl add command -label $b \
1812                             -command [list reopen-target $n $b]
1813                 }
1814             } else {
1815                 .top.target.m.clist add command -label $n \
1816                         -command [list reopen-target $n {}]
1817             }
1818         }
1819     }
1820     .top.target.m.slist delete 0 last
1821     foreach n [array names profile] {
1822         if {$n != "Default"} {
1823             .top.target.m.slist add command -label $n \
1824                     -command [list protocol-setup $n]
1825         }
1826     }
1827 }
1828
1829 proc query-select {i} {
1830     global queryButtonsFind
1831     global queryInfoFind
1832     global queryButtons
1833     global queryInfo
1834
1835     set queryInfoFind [lindex $queryInfo $i]
1836     set queryButtonsFind [lindex $queryButtons $i]
1837
1838     index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
1839 }
1840
1841 proc query-new-action {} {
1842     global queryTypes
1843     global queryButtons
1844     global queryInfo
1845     global settingsChanged
1846
1847     set settingsChanged 1
1848     lappend queryTypes [.query-new.top.index.entry get]
1849     lappend queryButtons {}
1850     lappend queryInfo {}
1851
1852     destroy .query-new
1853     cascade-query-list
1854 }
1855
1856 proc query-new {} {
1857     set w .query-new
1858
1859     toplevel $w
1860     place-force $w .
1861     top-down-window $w
1862     frame $w.top.index
1863     pack $w.top.index \
1864             -side top -anchor e -pady 2
1865     entry-fields $w.top index \
1866             {{Query Name:}} \
1867             query-new-action {destroy .query-new}
1868     top-down-ok-cancel $w query-new-action 1
1869 }
1870
1871 proc query-delete-action {queryNo} {
1872     global queryTypes
1873     global queryButtons
1874     global queryInfo
1875     global settingsChanged
1876
1877     set settingsChanged 1
1878
1879     set queryTypes [lreplace $queryTypes $queryNo $queryNo]
1880     set queryButtons [lreplace $queryButtons $queryNo $queryNo]
1881     set queryInfo [lreplace $queryInfo $queryNo $queryNo]
1882     destroy .query-delete
1883     cascade-query-list
1884 }
1885
1886 proc query-delete {queryNo} {
1887     global queryTypes
1888
1889     set w .query-delete
1890
1891     toplevel $w
1892     place-force $w .
1893     top-down-window $w
1894     set n [lindex $queryTypes $queryNo]
1895
1896     label $w.top.warning -bitmap warning
1897     message $w.top.quest -text "Are you sure you want to delete the \
1898 query type $n ?"  -aspect 200
1899     pack $w.top.warning $w.top.quest -side left -expand yes -padx 10 -pady 5
1900     bottom-buttons $w [list {Ok} [list query-delete-action $queryNo] \
1901                             {Cancel} [list destroy $w]] 1
1902 }
1903
1904 proc cascade-query-list {} {
1905     global queryTypes
1906     set w .top.options.m.query
1907
1908     set i 0
1909     $w.slist delete 0 last
1910     foreach n $queryTypes {
1911         $w.slist add command -label $n -command [list query-setup $i]
1912         incr i
1913     }
1914
1915     set i 0
1916     $w.clist delete 0 last
1917     foreach n $queryTypes {
1918         $w.clist add command -label $n -command [list query-select $i]
1919         incr i
1920     }
1921     set i 0
1922     $w.dlist delete 0 last
1923     foreach n $queryTypes {
1924         $w.dlist add command -label $n -command [list query-delete $i]
1925         incr i
1926     }
1927 }
1928
1929 proc save-geometry {} {
1930     global windowGeometry
1931     global hotTargets
1932     global textWrap
1933     global displayFormat
1934     global popupMarcdf
1935     global recordSyntax
1936
1937     set windowGeometry(.) [wm geometry .]
1938
1939     set f [open "~/.clientrc.tcl" w]
1940
1941     puts $f "set hotTargets \{ $hotTargets \}"
1942     puts $f "set textWrap $textWrap"
1943     puts $f "set displayFormat $displayFormat"
1944     puts $f "set popupMarcdf $popupMarcdf"
1945     puts $f "set recordSyntax $recordSyntax"
1946     foreach n [array names windowGeometry] {
1947         puts -nonewline $f "set \{windowGeometry($n)\} \{"
1948         puts -nonewline $f $windowGeometry($n)
1949         puts $f "\}"
1950     }
1951     close $f
1952 }
1953
1954 proc save-settings {} {
1955     global profile
1956     global libdir
1957     global settingsChanged
1958     global queryTypes
1959     global queryButtons
1960     global queryInfo
1961
1962     if {![file writable "${libdir}/clientrc.tcl"]} {
1963         return
1964     }
1965     set f [open "${libdir}/clientrc.tcl" w]
1966     puts $f "# Setup file"
1967
1968     foreach n [array names profile] {
1969         puts -nonewline $f "set \{profile($n)\} \{"
1970         puts -nonewline $f $profile($n)
1971         puts $f "\}"
1972     }
1973     puts -nonewline $f "set queryTypes \{"
1974     puts -nonewline $f $queryTypes
1975     puts $f "\}"
1976
1977     puts -nonewline $f "set queryButtons \{"
1978     puts -nonewline $f $queryButtons
1979     puts $f "\}"
1980
1981     puts -nonewline $f "set queryInfo \{"
1982     puts -nonewline $f $queryInfo
1983     puts $f "\}"
1984     close $f
1985     set settingsChanged 0
1986 }
1987
1988 proc alert {ask} {
1989     set w .alert
1990
1991     global alertAnswer
1992
1993     toplevel $w
1994     place-force $w .
1995     top-down-window $w
1996
1997     label $w.top.warning -bitmap warning
1998     message $w.top.message -text $ask -aspect 200 \
1999             -font -Adobe-Times-Medium-R-Normal-*-180-*
2000
2001     pack $w.top.warning $w.top.message -side left -pady 5 -padx 10 -expand yes
2002
2003     set alertAnswer 0
2004     top-down-ok-cancel $w {alert-action} 1
2005     return $alertAnswer
2006 }
2007
2008 proc alert-action {} {
2009     global alertAnswer
2010     set alertAnswer 1
2011     destroy .alert
2012 }
2013
2014 proc exit-action {} {
2015     global settingsChanged
2016
2017     if {$settingsChanged} {
2018         set a [alert "you haven't saved your settings. Do you wish to save?"]
2019         if {$a} {
2020             save-settings
2021         }
2022     }
2023     save-geometry
2024     exit 0
2025 }
2026
2027 proc listbuttonaction {w name h user i} {
2028     $w configure -text [lindex $name 0]
2029     $h [lindex $name 1] $user $i
2030 }
2031
2032 proc listbuttonx {button no names handle user} {
2033     if {[winfo exists $button]} {
2034         $button configure -text [lindex [lindex $names $no] 0]
2035         ${button}.m delete 0 last
2036     } else {
2037         menubutton $button -text [lindex [lindex $names $no] 0] \
2038                 -width 10 -menu ${button}.m -relief raised -border 1
2039         menu ${button}.m
2040     }
2041     set i 0
2042     foreach name $names {
2043         ${button}.m add command -label [lindex $name 0] \
2044                 -command [list listbuttonaction ${button} $name \
2045                 $handle $user $i]
2046         incr i
2047     }
2048 }
2049
2050 proc listbutton {button no names} {
2051     menubutton $button -text [lindex $names $no] -width 10 -menu ${button}.m \
2052             -relief raised -border 1
2053     menu ${button}.m
2054     foreach name $names {
2055         ${button}.m add command -label $name \
2056                 -command [list ${button} configure -text $name]
2057     }
2058 }
2059
2060 proc listbuttonv-action {button var names i} {
2061     global $var
2062
2063     set $var [lindex $names [expr $i+1]]
2064     $button configure -text [lindex $names $i]
2065 }
2066
2067 proc listbuttonv {button var names} {
2068     global $var
2069
2070     set n "-"
2071     eval "set val $$var"
2072     set l [llength $names]
2073     for {set i 1} {$i < $l} {incr i 2} {
2074         if {$val == [lindex $names $i]} {
2075             incr i -1
2076             set n [lindex $names $i]
2077             break
2078         }
2079     }
2080     if {[winfo exists $button]} {
2081         $button configure -text $n
2082         return
2083     }
2084     menubutton $button -text $n -menu ${button}.m \
2085             -relief raised -border 1
2086     menu ${button}.m
2087     for {set i 0} {$i < $l} {incr i 2} {
2088         ${button}.m add command -label [lindex $names $i] \
2089                 -command [list listbuttonv-action $button $var $names $i]
2090     }
2091 }
2092
2093 proc query-add-index-action {queryNo} {
2094     set w .query-setup
2095
2096     global queryInfoTmp
2097     global queryButtonsTmp
2098
2099     set newI [.query-add-index.top.index.entry get]
2100     lappend queryInfoTmp [list $newI {}]
2101     $w.top.index.list insert end $newI
2102     destroy .query-add-index
2103     #destroy $w.top.lines
2104     #frame $w.top.lines -relief ridge -border 2
2105     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
2106     #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
2107 }
2108
2109 proc query-add-line {queryNo} {
2110     set w .query-setup
2111
2112     global queryInfoTmp
2113     global queryButtonsTmp
2114
2115     lappend queryButtonsTmp {I 0}
2116
2117     #destroy $w.top.lines
2118     #frame $w.top.lines -relief ridge -border 2
2119     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
2120     #pack $w.top.lines -side left -pady 6 -padx 6 -fill y
2121 }
2122
2123 proc query-del-line {queryNo} {
2124     set w .query-setup
2125
2126     global queryInfoTmp
2127     global queryButtonsTmp
2128
2129     set l [llength $queryButtonsTmp]
2130     if {$l <= 0} {
2131         return
2132     }
2133     incr l -1
2134     set queryButtonsTmp [lreplace $queryButtonsTmp $l $l]
2135     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
2136 }
2137
2138 proc query-add-index {queryNo} {
2139     set w .query-add-index
2140
2141     toplevel $w
2142     place-force $w .query-setup
2143     top-down-window $w
2144     frame $w.top.index
2145     pack $w.top.index \
2146             -side top -anchor e -pady 2
2147     entry-fields $w.top {index} \
2148             {{Index Name:}} \
2149             [list query-add-index-action $queryNo] [list destroy $w]
2150     top-down-ok-cancel $w [list query-add-index-action $queryNo] 1
2151 }
2152
2153 proc query-setup-action {queryNo} {
2154     global queryButtons
2155     global queryInfo
2156     global queryButtonsTmp
2157     global queryInfoTmp
2158     global queryButtonsFind
2159     global queryInfoFind
2160
2161     global settingsChanged
2162
2163     set settingsChanged 1
2164
2165     set queryInfo [lreplace $queryInfo $queryNo $queryNo \
2166             $queryInfoTmp]
2167     set queryButtons [lreplace $queryButtons $queryNo $queryNo \
2168             $queryButtonsTmp]
2169     set queryInfoFind $queryInfoTmp
2170     set queryButtonsFind $queryButtonsTmp
2171
2172     destroy .query-setup
2173     index-lines .lines 1 $queryButtonsFind $queryInfoFind activate-index
2174 }
2175
2176 proc activate-e-index {value no i} {
2177     global queryButtonsTmp
2178     global queryIndexTmp
2179
2180     set queryButtonsTmp [lreplace $queryButtonsTmp $no $no [list I $i]]
2181     dputs $queryButtonsTmp
2182     set queryIndexTmp $i
2183 }
2184
2185 proc activate-index {value no i} {
2186     global queryButtonsFind
2187
2188     set queryButtonsFind [lreplace $queryButtonsFind $no $no [list I $i]]
2189
2190     dputs "queryButtonsFind $queryButtonsFind"
2191 }
2192
2193 proc update-attr {} {
2194     set w .index-setup
2195     listbuttonv $w.top.relation.b relationTmpValue\
2196             {{None} 0 {Less than} 1 {Greater than or equal} 2 {Equal} 3 \
2197             {Greater than or equal} 4 {Greater than} 5 {Not equal} 6 \
2198             {Phonetic} 100 {Stem} 101 {Relevance} 102 {AlwaysMatches} 103}
2199     listbuttonv $w.top.position.b positionTmpValue {{None} 0 \
2200             {First in field} 1 {First in subfield} 2 {Any position in field} 3}
2201     listbuttonv $w.top.structure.b structureTmpValue {{None} 0 {Phrase} 1 \
2202             {Word} 2 {Key} 3 {Year} 4 {Date (norm)} 5 {Word list}  6 \
2203             {Date (un-norm)} 100 {Name (norm)} 101 {Date (un-norm)} 102 \
2204             {Structure} 103 {urx} 104 {free-form} 105 {doc-text} 106 \
2205             {local-number} 107 {string} 108 {numeric string} 109}
2206     listbuttonv $w.top.truncation.b truncationTmpValue {{Auto} 0 {Right} 1 \
2207             {Left} 2 {Left and right} 3 {No truncation} 100 \
2208             {Process #} 101 {Re-1} 102 {Re-2} 103}
2209     listbuttonv $w.top.completeness.b completenessTmpValue {{None} 0 \
2210             {Incomplete subfield} 1 {Complete subfield} 2 {Complete field} 3}
2211 }
2212
2213 proc use-attr {init} {
2214     set attr {
2215         {None}                           0
2216         {Personal name}                  1
2217         {Corporate name}                 2
2218         {Conference name}                3
2219         {Title}                          4
2220         {Title-series}                   5
2221         {Title-uniform}                  6
2222         {ISBN}                           7
2223         {ISSN}                           8
2224         {LC card number}                 9
2225         {BNB card number}                10
2226         {BGF(sic) number}                11
2227         {Local number}                   12
2228         {Dewey classification}           13
2229         {UDC classification}             14
2230         {Bliss classification}           15
2231         {LC call number}                 16
2232         {NLM call number}                17
2233         {NAL call number}                18
2234         {MOS call number}                19
2235         {Local classification}           20
2236         {Subject heading}                21
2237         {Subject-RAMEAU}                 22
2238         {BDI-index-subject}              23
2239         {INSPEC-subject}                 24
2240         {MESH-subject}                   25
2241         {PA-subject}                     26
2242         {LC-subject-heading}             27
2243         {RVM-subject-heading}            28
2244         {Local subject index}            29
2245         {Date}                           30
2246         {Date of publication}            31
2247         {Date of acquisition}            32
2248         {Title-key}                      33
2249         {Title-collective}               34
2250         {Title-parallel}                 35
2251         {Title-cover}                    36
2252         {Title-added-title-page}         37
2253         {Title-caption}                  38
2254         {Title-running}                  39
2255         {Title-spine}                    40
2256         {Title-other-variant}            41
2257         {Title-former}                   42
2258         {Title-abbreviated}              43
2259         {Title-expanded}                 44
2260         {Subject-PRECIS}                 45
2261         {Subject-RSWK}                   46
2262         {Subject-subdivision}            47
2263         {Number-natl-bibliography}       48
2264         {Number-legal-deposit}           49
2265         {Number-govt-publication}        50
2266         {Number-publisher-for-music}     51
2267         {Number-DB}                      52
2268         {Number-local-call}              53
2269         {Code-language}                  54
2270         {Code-geographic-area}           55
2271         {Code-institution}               56
2272         {Name and title}                 57
2273         {Name-geographic}                58
2274         {Place-publication}              59
2275         {CODEN}                          60
2276         {Microform-generation}           61
2277         {Abstract}                       62
2278         {Note}                           63
2279         {Author-title}                 1000
2280         {Record type}                  1001
2281         {Name}                         1002
2282         {Author}                       1003
2283         {Author-name-personal}         1004
2284         {Author-name-corporate}        1005
2285         {Author-name-conference}       1006
2286         {Identifier-standard}          1007
2287         {Subject-LC-children's}        1008
2288         {Subject-name-personal}        1009
2289         {Body of text}                 1010
2290         {Date/time added to database}  1011
2291         {Date/time last modified}      1012
2292         {Authority/format identifier}  1013
2293         {Concept-text}                 1014
2294         {Concept-reference}            1015
2295         {Any}                          1016
2296         {Server choice}                1017
2297         {Publisher}                    1018
2298         {Record source}                1019
2299         {Editor}                       1020
2300         {Bib-level}                    1021
2301         {Geographic class}             1022
2302         {Indexed by}                   1023
2303         {Map scale}                    1024
2304         {Music key}                    1025
2305         {Related periodical}           1026
2306         {Report number}                1027
2307         {Stock number}                 1028
2308         {Thematic number}              1030
2309         {Material type}                1031
2310         {Doc ID}                       1032
2311         {Host item}                    1033
2312         {Content type}                 1034
2313         {Anywhere}                     1035
2314     }
2315     set w .index-setup
2316     global useTmpValue
2317     set l [llength $attr]
2318
2319     if {$init} {
2320         set s 0
2321         set lno 0
2322         for {set i 0} {$i < $l} {incr i} {
2323             $w.top.use.list insert end [lindex $attr $i]
2324             incr i
2325             if {$useTmpValue == [lindex $attr $i]} {
2326                 set s $lno
2327             }
2328             incr lno
2329         }
2330         $w.top.use.list select from $s
2331         $w.top.use.list select to $s
2332         incr s -3
2333         if {$s < 0} {
2334             set s 0
2335         }
2336         $w.top.use.list yview $s
2337     } else {
2338         set lno [lindex [$w.top.use.list curselection] 0]
2339         set i [expr $lno+$lno+1]
2340         set useTmpValue [lindex $attr $i]
2341         dputs "useTmpValue=$useTmpValue"
2342     }
2343 }
2344
2345 proc index-setup-action {oldAttr queryNo indexNo} {
2346     set attr [lindex $oldAttr 0]
2347
2348     global useTmpValue
2349     global relationTmpValue
2350     global structureTmpValue
2351     global truncationTmpValue
2352     global completenessTmpValue
2353     global positionTmpValue
2354     global queryInfoTmp
2355
2356     use-attr 0
2357
2358     dputs "index-setup-action"
2359     dputs "queryNo $queryNo"
2360     dputs "indexNo $indexNo"
2361     if {$useTmpValue > 0} {
2362         lappend attr "1=$useTmpValue"
2363     }
2364     if {$relationTmpValue > 0} {
2365         lappend attr "2=$relationTmpValue"
2366     }
2367     if {$positionTmpValue > 0} {
2368         lappend attr "3=$positionTmpValue"
2369     }
2370     if {$structureTmpValue > 0} {
2371         lappend attr "4=$structureTmpValue"
2372     }
2373     if {$truncationTmpValue > 0} {
2374         lappend attr "5=$truncationTmpValue"
2375     }
2376     if {$completenessTmpValue > 0} {
2377         lappend attr "6=$completenessTmpValue"
2378     }
2379     dputs "new attr $attr"
2380     set queryInfoTmp [lreplace $queryInfoTmp $indexNo $indexNo $attr]
2381     destroy .index-setup
2382 }
2383
2384 proc index-setup {attr queryNo indexNo} {
2385     set w .index-setup
2386
2387     global relationTmpValue
2388     global structureTmpValue
2389     global truncationTmpValue
2390     global completenessTmpValue
2391     global positionTmpValue
2392     global useTmpValue
2393     set relationTmpValue 0
2394     set truncationTmpValue 0
2395     set structureTmpValue 0
2396     set positionTmpValue 0
2397     set completenessTmpValue 0
2398     set useTmpValue 0
2399
2400     set len [llength $attr]
2401     for {set i 1} {$i < $len} {incr i} {
2402         set q [lindex $attr $i]
2403         set l [string first = $q]
2404         if {$l > 0} {
2405             set t [string range $q 0 [expr $l - 1]]
2406             set v [string range $q [expr $l + 1] end]
2407             switch $t {
2408                 1
2409                 { set useTmpValue $v }
2410                 2
2411                 { set relationTmpValue $v }
2412                 3
2413                 { set positionTmpValue $v }
2414                 4
2415                 { set structureTmpValue $v }
2416                 5
2417                 { set truncationTmpValue $v }
2418                 6
2419                 { set completenessTmpValue $v }
2420             }
2421         }
2422     }
2423     if {[winfo exists $w]} {
2424         destroy $w
2425     }
2426     toplevelG $w
2427
2428     set n [lindex $attr 0]
2429     wm title $w "Index setup $n"
2430
2431     top-down-window $w
2432
2433     frame $w.top.use -relief ridge -border 2
2434     frame $w.top.relation -relief ridge -border 2
2435     frame $w.top.position -relief ridge -border 2
2436     frame $w.top.structure -relief ridge -border 2
2437     frame $w.top.truncation -relief ridge -border 2
2438     frame $w.top.completeness -relief ridge -border 2
2439
2440     update-attr
2441
2442     # Use Attributes
2443
2444     pack $w.top.use -side left -pady 6 -padx 6 -fill y
2445
2446     label $w.top.use.label -text "Use"
2447     listbox $w.top.use.list -geometry 26x10 \
2448             -yscrollcommand "$w.top.use.scroll set"
2449     scrollbar $w.top.use.scroll -orient vertical -border 1
2450     pack $w.top.use.label -side top -fill x \
2451             -padx 2 -pady 2
2452     pack $w.top.use.list -side left -fill both -expand yes \
2453             -padx 2 -pady 2
2454     pack $w.top.use.scroll -side right -fill y \
2455             -padx 2 -pady 2
2456     $w.top.use.scroll config -command "$w.top.use.list yview"
2457
2458     use-attr 1
2459
2460     # Relation Attributes
2461
2462     pack $w.top.relation -pady 6 -padx 6 -side top
2463     label $w.top.relation.label -text "Relation" -width 18
2464
2465     pack $w.top.relation.label $w.top.relation.b -fill x
2466
2467     # Position Attributes
2468
2469     pack $w.top.position -pady 6 -padx 6 -side top
2470     label $w.top.position.label -text "Position" -width 18
2471
2472     pack $w.top.position.label $w.top.position.b -fill x
2473
2474     # Structure Attributes
2475
2476     pack $w.top.structure -pady 6 -padx 6 -side top
2477     label $w.top.structure.label -text "Structure" -width 18
2478
2479     pack $w.top.structure.label $w.top.structure.b -fill x
2480
2481     # Truncation Attributes
2482
2483     pack $w.top.truncation -pady 6 -padx 6 -side top
2484     label $w.top.truncation.label -text "Truncation" -width 18
2485
2486     pack $w.top.truncation.label $w.top.truncation.b -fill x
2487
2488     # Completeness Attributes
2489
2490     pack $w.top.completeness -pady 6 -padx 6 -side top
2491     label $w.top.completeness.label -text "Completeness" -width 18
2492
2493     pack $w.top.completeness.label $w.top.completeness.b -fill x
2494
2495     # Ok-cancel
2496     bottom-buttons $w [list \
2497             {Ok} [list index-setup-action $attr $queryNo $indexNo] \
2498             {Cancel} [list destroy $w]] 0
2499
2500 }
2501
2502 proc query-edit-index {queryNo} {
2503     global queryInfoTmp
2504     set w .query-setup
2505
2506     set i [lindex [$w.top.index.list curselection] 0]
2507     if {$i == ""} {
2508         return
2509     }
2510     set attr [lindex $queryInfoTmp $i]
2511     dputs "Editing no $i $attr"
2512     index-setup $attr $queryNo $i
2513 }
2514
2515 proc query-delete-index {queryNo} {
2516     global queryInfoTmp
2517     global queryButtonsTmp
2518     set w .query-setup
2519
2520     set i [lindex [$w.top.index.list curselection] 0]
2521     if {$i == ""} {
2522         return
2523     }
2524     set queryInfoTmp [lreplace $queryInfoTmp $i $i]
2525     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
2526     $w.top.index.list delete $i
2527 }
2528
2529 proc query-setup {queryNo} {
2530     set w .query-setup
2531
2532     global queryTypes
2533     global queryButtons
2534     global queryInfo
2535     global queryButtonsTmp
2536     global queryInfoTmp
2537     global queryIndexTmp
2538
2539     set queryIndexTmp 0
2540     set queryName [lindex $queryTypes $queryNo]
2541     set queryInfoTmp [lindex $queryInfo $queryNo]
2542     set queryButtonsTmp [lindex $queryButtons $queryNo]
2543
2544     toplevelG $w
2545
2546     wm minsize $w 0 0
2547     wm title $w "Query setup $queryName"
2548
2549     top-down-window $w
2550
2551     frame $w.top.lines -relief ridge -border 2
2552
2553     pack $w.top.lines -side left -pady 6 -padx 6 -fill y
2554
2555     # Index Lines
2556
2557     index-lines $w.top.lines 0 $queryButtonsTmp $queryInfoTmp activate-e-index
2558
2559     button $w.top.lines.add -text "Add" \
2560             -command [list query-add-line $queryNo]
2561     button $w.top.lines.del -text "Remove" \
2562             -command [list query-del-line $queryNo]
2563
2564     pack $w.top.lines.del -fill x -side bottom
2565     pack $w.top.lines.add -fill x -pady 10 -side bottom
2566
2567     # Indexes
2568
2569     frame $w.top.index -relief ridge -border 2
2570     pack $w.top.index -pady 6 -padx 6 -side right -fill y
2571
2572     listbox $w.top.index.list -yscrollcommand [list $w.top.index.scroll set]
2573     scrollbar $w.top.index.scroll -orient vertical -border 1 \
2574         -command [list $w.top.index.list yview]
2575     bind $w.top.index.list <2> [list query-edit-index $queryNo]
2576
2577     pack $w.top.index.list -side left -fill both -expand yes -padx 2 -pady 2
2578     pack $w.top.index.scroll -side right -fill y -padx 2 -pady 2
2579
2580     $w.top.index.list select from 0
2581     $w.top.index.list select to 0
2582
2583     foreach x $queryInfoTmp {
2584         $w.top.index.list insert end [lindex $x 0]
2585     }
2586     # Bottom
2587     bottom-buttons $w [list \
2588             {Ok} [list query-setup-action $queryNo] \
2589             {Add index} [list query-add-index $queryNo] \
2590             {Edit index} [list query-edit-index $queryNo] \
2591             {Delete index} [list query-delete-index $queryNo] \
2592             {Cancel} [list destroy $w]] 0
2593 }
2594
2595 proc index-clear {} {
2596     global queryButtonsFind
2597
2598     set i 0
2599     foreach b $queryButtonsFind {
2600         .lines.$i.e delete 0 end
2601         incr i
2602     }
2603 }
2604
2605 proc index-query {} {
2606     global queryButtonsFind
2607     global queryInfoFind
2608
2609     set i 0
2610     set qs {}
2611
2612     foreach b $queryButtonsFind {
2613         set term [string trim [.lines.$i.e get]]
2614         if {$term != ""} {
2615             set attr [lrange [lindex $queryInfoFind [lindex $b 1]] 1 end]
2616
2617             set len [string length $term]
2618             incr len -1
2619             set left 0
2620             set right 0
2621             if {[string index $term $len] == "?"} {
2622                 set right 1
2623                 set term [string range $term 0 [expr $len - 1]]
2624             }
2625             if {[string index $term 0] == "?"} {
2626                 set left 1
2627                 set term [string range $term 1 end]
2628             }
2629             set term "\{${term}\}"
2630             if {$right && $left} {
2631                 set term "@attr 5=3 ${term}"
2632             } elseif {$right} {
2633                 set term "@attr 5=1 ${term}"
2634             } elseif {$left} {
2635                 set term "@attr 5=2 ${term}"
2636             }
2637             foreach a $attr {
2638                 set term "@attr $a ${term}"
2639             }
2640             if {$qs != ""} {
2641                 set qs "@and ${qs} ${term}"
2642             } else {
2643                 set qs $term
2644             }
2645         }
2646         incr i
2647     }
2648     dputs "qs=  $qs"
2649     return $qs
2650 }
2651
2652 proc index-focus-in {w i} {
2653     global curIndexEntry
2654
2655     $w.$i configure -background red
2656     set curIndexEntry $i
2657 }
2658
2659 proc index-lines {w realOp buttonInfo queryInfo handle} {
2660     set i 0
2661     foreach b $buttonInfo {
2662         if {! [winfo exists $w.$i]} {
2663             frame $w.$i -background white -border 1
2664         }
2665         listbuttonx $w.$i.l [lindex $b 1] $queryInfo $handle $i
2666
2667         if {$realOp} {
2668             if {! [winfo exists $w.$i.e]} {
2669                 entry $w.$i.e -width 32 -relief sunken -border 1
2670                 bind $w.$i.e <FocusIn> [list index-focus-in $w $i]
2671                 bind $w.$i.e <FocusOut> [list $w.$i configure \
2672                         -background white]
2673                 pack $w.$i.l -side left
2674                 pack $w.$i.e -side left -fill x -expand yes
2675                 pack $w.$i -side top -fill x -padx 2 -pady 2
2676                 bind $w.$i.e <Left> [list left-cursor $w.$i.e]
2677                 bind $w.$i.e <Right> [list right-cursor $w.$i.e]
2678                 bind $w.$i.e <Return> {search-request 0}
2679             }
2680         } else {
2681             pack $w.$i.l -side left
2682             pack $w.$i -side top -fill x -padx 2 -pady 2
2683         }
2684         incr i
2685     }
2686     set j $i
2687     while {[winfo exists $w.$j]} {
2688         destroy $w.$j
2689         incr j
2690     }
2691     if {! $realOp} {
2692         return
2693     }
2694     set j 0
2695     incr i -1
2696     while {$j < $i} {
2697         set k [expr $j+1]
2698         bind $w.$j.e <Tab> "focus $w.$k.e"
2699         set j $k
2700     }
2701     if {$i >= 0} {
2702         bind $w.$i.e <Tab> "focus $w.0.e"
2703         focus $w.0.e
2704     }
2705 }
2706
2707 proc search-fields {w buttondefs} {
2708     set i 0
2709     foreach buttondef $buttondefs {
2710         frame $w.$i -background white
2711
2712         listbutton $w.$i.l 0 $buttondef
2713         entry $w.$i.e -width 32 -relief sunken
2714
2715         pack $w.$i.l -side left
2716         pack $w.$i.e -side left -fill x -expand yes
2717
2718         pack $w.$i -side top -fill x -padx 2 -pady 2
2719
2720         bind $w.$i.e <Left> [list left-cursor $w.$i.e]
2721         bind $w.$i.e <Right> [list right-cursor $w.$i.e]
2722
2723         incr i
2724     }
2725     set j 0
2726     incr i -1
2727     while {$j < $i} {
2728         set k [expr $j+1]
2729         bind $w.$j.e <Tab> "focus $w.$k.e \n
2730         $w.$k configure -background red \n
2731         $w.$j configure -background white"
2732         set j $k
2733     }
2734     bind $w.$i.e <Tab> "focus $w.0.e \n
2735         $w.0 configure -background red \n
2736         $w.$i configure -background white"
2737     focus $w.0.e
2738     $w.0 configure -background red
2739 }
2740
2741 if {[info exists windowGeometry(.)]} {
2742     set g $windowGeometry(.)
2743     if {$g != ""} {
2744         wm geometry . $g
2745     }
2746 }
2747
2748 read-formats
2749
2750 frame .top  -border 1 -relief raised
2751 frame .lines  -border 1 -relief raised
2752 frame .mid  -border 1 -relief raised
2753 frame .data -border 1 -relief raised
2754 frame .bot  -border 1 -relief raised
2755 pack .top .lines .mid -side top -fill x
2756 pack .data -side top -fill both -expand yes
2757 pack .bot -fill x
2758
2759 menubutton .top.file -text "File" -menu .top.file.m
2760 menu .top.file.m
2761 .top.file.m add command -label "Save settings" -command {save-settings}
2762 .top.file.m add separator
2763 .top.file.m add command -label "Exit" -command {exit-action}
2764
2765 menubutton .top.target -text "Target" -menu .top.target.m
2766 menu .top.target.m
2767 .top.target.m add cascade -label "Connect" -menu .top.target.m.clist
2768 .top.target.m add command -label "Disconnect" -command {close-target}
2769 .top.target.m add command -label "About" -command {about-target}
2770 .top.target.m add cascade -label "Setup" -menu .top.target.m.slist
2771 .top.target.m add command -label "Setup new" -command {define-target-dialog}
2772 .top.target.m add separator
2773 set-target-hotlist
2774
2775 .top.target.m disable 1
2776 .top.target.m disable 2
2777
2778 menu .top.target.m.clist
2779 menu .top.target.m.slist
2780 cascade-target-list
2781
2782 menubutton .top.service -text "Service" -menu .top.service.m
2783 menu .top.service.m
2784 .top.service.m add command -label "Database" -command {database-select}
2785 .top.service.m add cascade -label "Present" -menu .top.service.m.present
2786 menu .top.service.m.present
2787 .top.service.m.present add command -label "10 More" \
2788         -command [list present-more 10]
2789 .top.service.m.present add command -label "All" \
2790         -command [list present-more {}]
2791 .top.service.m add command -label "Search" -command {search-request 0}
2792 .top.service.m add command -label "Scan" -command {scan-request}
2793
2794 .top.service configure -state disabled
2795
2796 menubutton .top.rset -text "Set" -menu .top.rset.m
2797 menu .top.rset.m
2798 .top.rset.m add command -label "Load" -command {load-set}
2799 .top.rset.m add separator
2800
2801 menubutton .top.options -text "Options" -menu .top.options.m
2802 menu .top.options.m
2803 .top.options.m add cascade -label "Query" -menu .top.options.m.query
2804 .top.options.m add cascade -label "Format" -menu .top.options.m.formats
2805 .top.options.m add cascade -label "Wrap" -menu .top.options.m.wrap
2806 .top.options.m add cascade -label "Syntax" -menu .top.options.m.syntax
2807
2808 menu .top.options.m.query
2809 .top.options.m.query add cascade -label "Select" \
2810         -menu .top.options.m.query.clist
2811 .top.options.m.query add cascade -label "Edit" \
2812         -menu .top.options.m.query.slist
2813 .top.options.m.query add command -label "New" \
2814         -command {query-new}
2815 .top.options.m.query add cascade -label "Delete" \
2816         -menu .top.options.m.query.dlist
2817
2818 menu .top.options.m.query.slist
2819 menu .top.options.m.query.clist
2820 menu .top.options.m.query.dlist
2821 cascade-query-list
2822
2823 menu .top.options.m.formats
2824 set i 0
2825 foreach f $displayFormats {
2826     .top.options.m.formats add radiobutton -label $f -value $i \
2827             -command [list set-display-format $i] -variable displayFormat
2828     incr i
2829 }
2830
2831 menu .top.options.m.wrap
2832 .top.options.m.wrap add radiobutton -label "Character" \
2833         -value char -variable textWrap -command {set-wrap char}
2834 .top.options.m.wrap add radiobutton -label "Word" \
2835         -value word -variable textWrap -command {set-wrap word}
2836 .top.options.m.wrap add radiobutton -label "None" \
2837         -value none -variable textWrap -command {set-wrap none}
2838
2839 menu .top.options.m.syntax
2840 .top.options.m.syntax add radiobutton -label "None" \
2841         -value None -variable recordSyntax
2842 .top.options.m.syntax add separator
2843 .top.options.m.syntax add radiobutton -label "USMARC" \
2844         -value USMARC -variable recordSyntax
2845 .top.options.m.syntax add radiobutton -label "UNIMARC" \
2846         -value UNIMARC -variable recordSyntax
2847 .top.options.m.syntax add radiobutton -label "UKMARC" \
2848         -value UKMARC -variable recordSyntax
2849 .top.options.m.syntax add radiobutton -label "DANMARC" \
2850         -value DANMARC -variable recordSyntax
2851 .top.options.m.syntax add radiobutton -label "FINMARC" \
2852         -value FINMARC -variable recordSyntax
2853 .top.options.m.syntax add radiobutton -label "NORMARC" \
2854         -value NORMARC -variable recordSyntax
2855 .top.options.m.syntax add radiobutton -label "PICAMARC" \
2856         -value PICAMARC -variable recordSyntax
2857 .top.options.m.syntax add separator
2858 .top.options.m.syntax add radiobutton -label "SUTRS" \
2859         -value SUTRS -variable recordSyntax
2860
2861 menubutton .top.help -text "Help" -menu .top.help.m
2862 menu .top.help.m
2863
2864 .top.help.m add command -label "Help on help" \
2865         -command {tkerror "Help on help not available. Sorry"}
2866 .top.help.m add command -label "About" -command {about-origin}
2867
2868 pack .top.file .top.target .top.service .top.rset .top.options -side left
2869 pack .top.help -side right
2870
2871 index-lines .lines 1 $queryButtonsFind [lindex $queryInfo 0] activate-index
2872
2873 button .mid.search -width 7 -text {Search} -command {search-request 0} \
2874         -state disabled
2875 button .mid.scan -width 7 -text {Scan} \
2876         -command scan-request -state disabled
2877 button .mid.present -width 7 -text {Present} -command [list present-more 10] \
2878         -state disabled
2879
2880 button .mid.clear -width 7 -text {Clear} -command index-clear
2881 pack .mid.search .mid.scan .mid.present .mid.clear -side left \
2882         -fill y -padx 5 -pady 3
2883
2884 text .data.record -height 2 -width 20 -wrap none \
2885         -yscrollcommand [list .data.scroll set] -wrap $textWrap
2886 scrollbar .data.scroll -command [list .data.record yview]
2887 pack .data.scroll -side right -fill y
2888 pack .data.record -expand yes -fill both
2889 initBindings
2890
2891 if {[tk colormodel .] == "color"} {
2892     .data.record tag configure marc-tag -foreground blue
2893     .data.record tag configure marc-id -foreground red
2894 } else {
2895     .data.record tag configure marc-tag -foreground black
2896     .data.record tag configure marc-id -foreground black
2897 }
2898 .data.record tag configure marc-data -foreground black
2899
2900 button .bot.logo  -bitmap @${libdir}/bitmaps/book1 -command cancel-operation
2901 frame .bot.a
2902 pack .bot.a -side left -fill x
2903 pack .bot.logo -side right -padx 2 -pady 2
2904
2905 message .bot.a.target -text "" -aspect 1000 -border 1
2906
2907 label .bot.a.status -text "Not connected" -width 15 -relief \
2908         sunken -anchor w -border 1
2909 label .bot.a.set -text "" -width 5 -relief \
2910         sunken -anchor w -border 1
2911 label .bot.a.message -text "" -width 15 -relief \
2912         sunken -anchor w -border 1
2913
2914 pack .bot.a.target -side top -anchor nw -padx 2 -pady 2
2915 pack .bot.a.status .bot.a.set .bot.a.message \
2916         -side left -padx 2 -pady 2
2917
2918 ir z39
2919
2920 show-logo 1
2921