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