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