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