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