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