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