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