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