www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.38 1996/03/11 17:40:49 adam Exp $
   3 #
   4 proc saveState {} {
   5     uplevel #0 {
   6     set f [open "tcl.state.${sessionId}" w]
   7     foreach var [info globals] {
   8         if {$var == "f"} continue
   9         if {$var == "sessionId"} continue
  10         if {$var == "errorInfo"} continue
  11         if {[catch {set names [array names $var]}]} {
  12             eval "set v \$${var}"
  13             puts $f "set ${var} \{$v\}"
  14         } else {
  15             foreach n $names {
  16                 eval "set v \$${var}(\$n)"
  17                 puts $f "set ${var}($n) \{$v\}"
  18             }
  19             catch {
  20                 eval "set v \$${var}"
  21                 puts $f "set ${var} \{$v\}"
  22             }
  23         }
  24     }
  25     close $f
  26     }
  27 }
  28
  29 proc search-response {zz} {
  30     global sessionWait
  31
  32     set status [$zz responseStatus]
  33     if {[lindex $status 0] == "NSD"} {
  34         $zz nextResultSetPosition 0
  35         set code [lindex $status 1]
  36         set msg [lindex $status 2]
  37         set addinfo [lindex $status 3]
  38         displayError "Diagnostic message" \
  39                 "$msg: $addinfo<br>\n(error code $code)"
  40         set sessionWait -2
  41     } else {
  42         set sessionWait 1
  43     }
  44 }
  45
  46 proc scan-response {zz} {
  47     global sessionWait
  48
  49     set status [$zz scanStatus]
  50     if {$status == 6} {
  51         displayError "Scan fail" ""
  52         set sessionWait -2
  53     } else {
  54         set sessionWait 1
  55     }
  56 }
  57
  58 proc ok-response {} {
  59     global sessionWait
  60     set sessionWait 1
  61 }
  62
  63 proc fail-response {} {
  64     global sessionWait
  65     set sessionWait -1
  66 }
  67
  68 proc display-medium {zset no setNo targetNo} {
  69     global env
  70     global sessionId
  71
  72     html {<li>}
  73     set type [$zset type $no]
  74     if {$type == "SD"} {
  75         set err [lindex [$zset diag $no] 1]
  76         set add [lindex [$zset diag $no] 2]
  77         if {$add != {}} {
  78             set add " :${add}"
  79         }
  80         html "${no} Error ${err}${add} <br>\n"
  81         return
  82     }
  83     if {$type != "DB"} {
  84         return
  85     }
  86     set rtype [$zset recordType $no]
  87     switch $rtype {
  88         SUTRS {
  89             html { <a href="http:} $env(SCRIPT_NAME) / $sessionId
  90             html {/showfull.egw/} $setNo + $targetNo + $no + full {">}
  91             html [join [$zset getSutrs $no]]
  92             html "</a><br>\n"
  93             return
  94         }
  95         WAIS {
  96             html { <a href="http:} $env(SCRIPT_NAME) / $sessionId
  97             html {/showfull.egw/} $setNo + $targetNo + $no + full {">}
  98             html [join [$zset getWAIS $no headline]]
  99             html {</a>}
 100             html "<br>\n"
 101             html {Score: } [$zset getWAIS $no score]
 102             set lines [$zset getWAIS $no lines]
 103             if {$lines > 0} {
 104                 html {, } $lines { lines}
 105             }
 106             html "<br>\n"
 107             return
 108         }
 109     }
 110     if {![catch {
 111         set author [$zset getMarc $no field 100 * a]
 112         set corp [$zset getMarc $no field 110 * a]
 113         set meet [$zset getMarc $no field 111 * a]
 114         set title [$zset getMarc $no field 245 * a]
 115         if {[llength $author] == 0} {
 116             set cover [$zset getMarc $no field 245 * {[bc]}]
 117         } else {
 118             set cover [$zset getMarc $no field 245 * b]
 119         }
 120         set location [$zset getMarc $no field 260 * a]
 121         set publisher [$zset getMarc $no field 260 * b]
 122         set year [$zset getMarc $no field 260 * c]
 123     } dispError ] } {
 124         html { <a href="http:} $env(SCRIPT_NAME) /
 125         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 126         set p 0
 127         foreach a $author {
 128             if {$p} {
 129                 html ", "
 130             }
 131             html $a
 132             set p 1
 133         }
 134         foreach a $corp {
 135             if {$p} {
 136                 html ", "
 137             }
 138             html $a
 139             set p 1
 140         }
 141         foreach a $meet {
 142             if {$p} {
 143                 html ", "
 144             }
 145             html $a
 146             set p 1
 147         }
 148         if {$p} {
 149             html ": "
 150         }
 151         set nope 1
 152         foreach v $title {
 153             html $v
 154             set nope 0
 155         }
 156         set v [join $cover ""]
 157         if {[string length $v] > 0} {
 158             set nope 0
 159             html $v
 160         } elseif {$nope} {
 161             html "No Title"
 162         }
 163         html {</a> }
 164     } else {
 165         html { <a href="http:} $env(SCRIPT_NAME) /
 166         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 167         html {No Title}
 168         html {</a> }
 169         html "Error: " $dispError "\n"
 170     }
 171     html "<br>\n"
 172 }
 173
 174 proc display-brief {zset no setNo targetNo} {
 175     global env
 176     global sessionId
 177
 178     set type [$zset type $no]
 179     if {$type == "SD"} {
 180         set err [lindex [$zset diag $no] 1]
 181         set add [lindex [$zset diag $no] 2]
 182         if {$add != {}} {
 183             set add " :${add}"
 184         }
 185         html "${no} Error ${err}${add} <br>\n"
 186         return
 187     }
 188     if {$type != "DB"} {
 189         return
 190     }
 191     set rtype [$zset recordType $no]
 192     switch $rtype {
 193         SUTRS {
 194             html { <a href="http:} $env(SCRIPT_NAME) / $sessionId
 195             html {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 196             html [string range [join [$zset getSutrs $no]] 0 70]
 197             html "</a><br>\n"
 198             return
 199         }
 200         WAIS {
 201             html { <a href="http:} $env(SCRIPT_NAME) / $sessionId
 202             html {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 203             html [string range [join [$zset getWAIS $no headline]] 0 70]
 204
 205             html {</a>}
 206             set score [$zset getWAIS $no score]
 207             html { Score } $score
 208             html "<br>\n"
 209             return
 210         }
 211     }
 212     if {![catch {
 213         set author [$zset getMarc $no field 100 * a]
 214         set corp [$zset getMarc $no field 110 * a]
 215         set meet [$zset getMarc $no field 111 * a]
 216         set title [$zset getMarc $no field 245 * a]
 217         if {[llength $author] == 0} {
 218             set cover [$zset getMarc $no field 245 * {[bc]}]
 219         } else {
 220             set cover [$zset getMarc $no field 245 * b]
 221         }
 222         set location [$zset getMarc $no field 260 * a]
 223         set publisher [$zset getMarc $no field 260 * b]
 224         set year [$zset getMarc $no field 260 * c]
 225     } dispError ] } {
 226         html { <a href="http:} $env(SCRIPT_NAME) /
 227         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 228         set p 0
 229         foreach a $author {
 230             if {$p} {
 231                 html ", "
 232             }
 233             html $a
 234             set p 1
 235         }
 236         foreach a $corp {
 237             if {$p} {
 238                 html ", "
 239             }
 240             html $a
 241             set p 1
 242         }
 243         foreach a $meet {
 244             if {$p} {
 245                 html ", "
 246             }
 247             html $a
 248             set p 1
 249         }
 250         if {$p} {
 251             html ": "
 252         }
 253         html {<it>}
 254         set nope 1
 255         foreach v $title {
 256             html $v
 257             set nope 0
 258         }
 259         html {</it>}
 260         if {$nope} {
 261             set v [join $cover ""]
 262             if {[string length $v] > 40} {
 263                 set nope 0
 264                 html [string range $v 0 38] "..."
 265             } elseif {[string length $v] > 0} {
 266                 set nope 0
 267                 html $v
 268             } else {
 269                 html "No Title"
 270             }
 271         }
 272         html {</a> }
 273     } else {
 274         html { <a href="http:} $env(SCRIPT_NAME) /
 275         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 276         html {No Title}
 277         html {</a> }
 278         html "Error: " $dispError "\n"
 279     }
 280     html "<br>\n"
 281 }
 282
 283 proc display-raw {zset no setNo targetNo} {
 284     set type [$zset type $no]
 285     switch $type {
 286         SD {
 287             set err [lindex [$zset diag $no] 1]
 288             set add [lindex [$zset diag $no] 2]
 289             if {$add != {}} {
 290                 set add " :${add}"
 291             }
 292             html "<h3>${no}</h3>\n"
 293             html "Error ${err}${add} <br>\n"
 294             return
 295         }
 296         DB {
 297         }
 298         default {
 299             return
 300         }
 301     }
 302     set rtype [$zset recordType $no]
 303     switch $rtype {
 304         SUTRS {
 305             html "<xmp>\n" [join [$zset getSutrs $no]] "\n</xmp>\n"
 306             return
 307         }
 308         WAIS {
 309             html "<xmp>\n" [join [$zset getWAIS $no text]] "\n</xmp>\n"
 310             return
 311         }
 312     }
 313     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 314         html "Unknown record type: $rtype <br>\n"
 315         return
 316     }
 317     foreach line $r {
 318         set tag [lindex $line 0]
 319         set indicator [lindex $line 1]
 320         set fields [lindex $line 2]
 321         set l [string length $indicator]
 322         html "<tt>$tag "
 323         if {$l > 0} {
 324             for {set i 0} {$i < $l} {incr i} {
 325                 if {[string index $indicator $i] == " "} {
 326                     html "-"
 327                 } else {
 328                     html [string index $tag $i]
 329                 }
 330             }
 331         }
 332         html "</tt>"
 333         foreach field $fields {
 334             set id [lindex $field 0]
 335             set data [lindex $field 1]
 336             if {$id != ""} {
 337                 html " <b>\$$id</b> "
 338             }
 339             html $data
 340         }
 341         html "<br>\n"
 342     }
 343 }
 344
 345 proc put-marc-contents {cc} {
 346     set ref ""
 347     if {[string first :// $cc] > 0} {
 348         foreach urltype {gopher http ftp mailto} {
 349             if {[string first ${urltype}:// $cc] == 0} {
 350                 set ref $urltype
 351                 break
 352             }
 353         }
 354     }
 355     if {$ref != ""} {
 356         html {<a href="}
 357     }
 358     html $cc
 359     if {$ref != ""} {
 360         html {">} $cc {</a>}
 361     }
 362 }
 363
 364 proc dl-marc-field {zset no tag id la lb sep} {
 365     set n 0
 366     set c [$zset getMarc $no field $tag * $id]
 367     set len [llength $c]
 368     if {$len == 0} {
 369         return 0
 370     }
 371     if {$len > 1 && "x$lb" != "x"} {
 372         html "<dt><b>$lb</b>\n<dd>"
 373     } else {
 374         html "<dt><b>$la</b>\n<dd>"
 375     }
 376     foreach cc $c {
 377         if {$n > 0} {
 378             html $sep
 379         }
 380         put-marc-contents $cc
 381         incr n
 382     }
 383     return $n
 384 }
 385
 386 proc dd-marc-field {zset no tag id start stop} {
 387     set n 0
 388     set c [$zset getMarc $no field $tag * $id]
 389     set len [llength $c]
 390     if {$len == 0} {
 391         return 0
 392     }
 393     foreach cc $c {
 394         html $start
 395         put-marc-contents $cc
 396         html $stop
 397         incr n
 398     }
 399     return $n
 400 }
 401
 402 proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
 403     set n 0
 404     set lines [$zset getMarc $no line $tag * *]
 405     foreach line $lines {
 406         foreach field [lindex $line 2] {
 407             if {$n == 0} {
 408                 html "<dt><b>$lead</b>"
 409                 html "\n<dd>"
 410             }
 411             set id [lindex $field 0]
 412             if {$id == $startid} {
 413                 if {$n > 0} {
 414                     html $stop
 415                 }
 416                 html $start
 417                 incr n
 418                 html [lindex $field 1]
 419             } else {
 420                 html $sep
 421                 html [lindex $field 1]
 422             }
 423         }
 424     }
 425     if {$n > 0} {
 426         html $stop
 427     }
 428 }
 429
 430 proc display-full-marc {zset no setNo targetNo} {
 431     global env
 432     global hist
 433     global sessionId
 434
 435     html "<dl>\n"
 436     set n [dl-marc-field $zset $no 700 a "Author" "Authors" "<br>\n"]
 437     if {$n == 0} {
 438         set n [dl-marc-field $zset $no 100 a "Author" "Authors" "<br>\n"]
 439     }
 440     set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
 441     if {$n == 0} {
 442         set n [dl-marc-field $zset $no 110 a "Corporate Name" {} ", "]
 443     }
 444     set n [dl-marc-field $zset $no 711 a "Meeting Name" {} ", "]
 445     if {$n > 0} {
 446         dd-marc-field $zset $no 711 {[bndc]} " " ""
 447     } else {
 448         set n [dl-marc-field $zset $no 111 a "Meeting Name" {} ", "]
 449         if {$n > 0} {
 450             dd-marc-field $zset $no 111 {[bndc]} " " " "
 451         }
 452     }
 453     set n [dl-marc-field $zset $no 245 {a} "Title" {} " "]
 454     if {$n > 0} {
 455         dd-marc-field $zset $no 245 b "<em>" "</em>"
 456         dd-marc-field $zset $no 245 c " " ""
 457     } else {
 458         dl-marc-field $zset $no 245 {[ab]} "Title" {} " "
 459     }
 460     dl-marc-field $zset $no 520 a "Abstract" {} ", "
 461     dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", "
 462     dl-marc-field $zset $no 650 * "Subject" {} ", "
 463     dl-marc-field $zset $no 260 * "Publisher" {} " "
 464     dl-marc-field $zset $no 300 * "Physical Description" {} " "
 465
 466     dl-marc-field-rec $zset $no 500 "Notes" "" "<br>\n" "a" ", "
 467
 468     dl-marc-field-rec $zset $no 510 "References" "" "<br>\n" "a" ", "
 469
 470     dl-marc-field-rec $zset $no 511 "Participant note" "" "<br>\n" "a" ", "
 471
 472     dl-marc-field $zset $no 513 a "Report type" {} ", "
 473     dl-marc-field $zset $no 513 b "Period covered" {} ", "
 474     dl-marc-field-rec $zset $no 515 "Numbering notes" "" "<br>\n" "a" ", "
 475     dl-marc-field-rec $zset $no 516 "Data notes" "" "<br>\n" "a" ", "
 476     dl-marc-field-rec $zset $no 518 "Date/time notes" "" "<br>\n" "a" ", "
 477
 478     dl-marc-field $zset $no 350 a "Price" {} ", "
 479     dl-marc-field $zset $no 362 a "Dates of publication" {} ", "
 480     dl-marc-field $zset $no 850 a "Holdings" {} ", "
 481
 482     dl-marc-field-rec $zset $no 270 "Contact name" "" "<br>\n" p ", "
 483     if {0} {
 484         set n [dl-marc-field $zset $no 270 p "Contact name" {} ", "]
 485         if {$n > 0} {
 486             html "\n<dl>\n"
 487
 488             if {0} {
 489                 dl-marc-field $zset $no 270 a "Street" {} ", "
 490                 dl-marc-field $zset $no 270 b "City" {} ", "
 491                 dl-marc-field $zset $no 270 c "State" {} ", "
 492                 dl-marc-field $zset $no 270 e "Zip code" {} ", "
 493                 dl-marc-field $zset $no 270 d "Country" {} ", "
 494                 dl-marc-field $zset $no 270 m "Network address" {} ", "
 495                 dl-marc-field $zset $no 301 a "Service hours" {} ", "
 496                 dl-marc-field $zset $no 270 k "Phone" {} ", "
 497                 dl-marc-field $zset $no 270 l "Fax" {} ", "
 498             } else {
 499                 dl-marc-field $zset $no 270 {[abcedmakl]} "Address" {} "<br>\n"
 500             }
 501
 502             html "\n</dl>\n"
 503         }
 504     }
 505     dl-marc-field $zset $no 010 a "LC control number" {} ", "
 506     dl-marc-field $zset $no 010 b "NUCMC control number" {} ", "
 507     dl-marc-field $zset $no 020 a "ISBN" {} ", "
 508     dl-marc-field $zset $no 022 a "ISSN" {} ", "
 509     set url [$zset getMarc $no field 856 * u]
 510     set sp [$zset getMarc $no field 856 * 3]
 511     if {"x$url" != "x"} {
 512         html "<dt><b>URL</b>\n"
 513         if {"x$sp" == "x"} {
 514             set sp $url
 515         }
 516         html {<dd><a href="} [join $url] {">} [join $sp] "</a>\n"
 517     }
 518     dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "<br>\n"
 519     dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "<br>\n"
 520     dl-marc-field $zset $no 537 * "Source of data" {} "<br>\n"
 521     dl-marc-field $zset $no 538 * "System details" {} "<br>\n"
 522     dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "<br>\n"
 523     dl-marc-field $zset $no 001 * "Local control number" {} ", "
 524     html "</dl>\n"
 525 }
 526
 527 proc display-full-wais {zset no setNo targetNo} {
 528     global env
 529     global hist
 530     global sessionId
 531
 532     set i 0
 533     set element junk
 534     htmlToken l [join [$zset getWAIS $no text]] {
 535         if {[string compare [string index $l 0] {<}]} {
 536             if {[info exist data($element)]} {
 537                 set data($element) $data($element)$l
 538             } else {
 539                 set data($element) $l
 540             }
 541             continue
 542         }
 543         switch -- $l {
 544             <ti> {
 545                 set element title
 546             }
 547             <dm> {
 548                 set element dateOfLastModification
 549             }
 550             <ci> {
 551                 set element controlIdentifier
 552             }
 553             <lc> {
 554                 set element lastChecked
 555             }
 556             <by> {
 557                 set element bytes
 558             }
 559             <avli> {
 560                 set element linkage
 561             }
 562             <cr> {
 563                 incr i
 564             }
 565             <li> {
 566                 set element "$i,linkage"
 567             }
 568             <cp> {
 569                 set element "$i,title"
 570             }
 571             <ip> {
 572                 set element ip
 573             }
 574             default {
 575                 set element junk
 576             }
 577         }
 578     }
 579     if {![info exists data(title)] || ![info exists data(linkage)]} {
 580         set nwi 0
 581     } else {
 582         set nwi 1
 583     }
 584     if {$nwi} {
 585         html {Title: <a href="} $data(linkage) {">} $data(title) "</a><br>\n"
 586         html {URL: } $data(linkage) "<br>\n"
 587     } else {
 588         html {Title: } [join [$zset getWAIS $no headline]] "<br>\n"
 589     }
 590     html {Score: } [$zset getWAIS $no score] "<br>\n"
 591     set lines [$zset getWAIS $no lines]
 592     if {$lines > 0} {
 593         html {Lines: } $lines "<br>\n"
 594     }
 595     if {!$nwi} {
 596         html "<pre>\n" [join [$zset getWAIS $no text]] "\n</pre>\n"
 597         return
 598     }
 599     if {[info exists data(bytes)]} {
 600         html {Bytes: } $data(bytes) "<br>\n"
 601     }
 602     if {[info exists data(dateOfLastModification)]} {
 603         html {Last modified: } $data(dateOfLastModification) "<br>\n"
 604     }
 605     if {[info exists data(lastChecked)]} {
 606         html {Last checked: } $data(lastChecked) "<br>\n"
 607     }
 608     if {[info exists data(ip)]} {
 609         html {<dl><dt>Initial text<dd>} $data(ip) "</dl><br>\n"
 610     }
 611
 612     html {<a href="} $env(SCRIPT_NAME) / $sessionId {/sameas.egw/}
 613     html $setNo + $targetNo + 1 + $hist($setNo,maxPresent) +
 614     html [egw_enc [$zset getWAIS $no documentID]] {">}
 615     html {Similar WAIS record</a><br>}
 616     html "<dl><dt>References\n<dd>\n"
 617     for {set i 1} {[info exists data($i,linkage)]} {incr i} {
 618         html {<a href="} $data($i,linkage) {">}
 619         if {[info exists data($i,title)]} {
 620             html $data($i,title)
 621         } else {
 622             html Untitled
 623         }
 624         html "</a><br>\n"
 625     }
 626     html "</dl>\n"
 627 }
 628
 629 proc display-full {zset no setNo targetNo} {
 630     set type [$zset type $no]
 631     switch $type {
 632         SD {
 633             set err [lindex [$zset diag $no] 1]
 634             set add [lindex [$zset diag $no] 2]
 635             if {$add != {}} {
 636                 set add " :${add}"
 637             }
 638             html "Error ${err}${add} <br>\n"
 639             return
 640         }
 641         DB {
 642         }
 643         default {
 644             return
 645         }
 646     }
 647     set rtype [$zset recordType $no]
 648     switch $rtype {
 649         SUTRS {
 650             html "<pre>" [join [$zset getSutrs $no]] "</pre><br>\n"
 651             return
 652         }
 653         WAIS {
 654             display-full-wais $zset $no $setNo $targetNo
 655             return
 656         }
 657     }
 658     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 659         html "Unknown record type: $rtype <br>\n"
 660         return
 661     }
 662     display-full-marc $zset $no $setNo $targetNo
 663 }
 664
 665
 666 proc display-rec {from to dfunc setNo targetNo} {
 667     while {$from <= $to} {
 668         eval "$dfunc z39${targetNo}.${setNo} $from $setNo $targetNo"
 669         incr from
 670     }
 671 }
 672
 673 proc build-scan {t i} {
 674     global targets
 675
 676     set term [egw_form entry$i]
 677     if {$term != ""} {
 678         set field [join [egw_form menu$i]]
 679         set attr {Title}
 680         foreach x [lindex $targets($t) 2] {
 681             if {[lindex $x 0] == $field} {
 682                 set attr [lindex $x 1]
 683             }
 684         }
 685         return [list $term $attr]
 686     }
 687     return ""
 688 }
 689
 690 proc build-query {t ilines} {
 691     global targets
 692
 693     set op {}
 694     set q {}
 695     for {set i 1} {$i <= $ilines} {incr i} {
 696         set term [join [egw_form entry$i]]
 697         if {![string compare [lindex $targets($t) 1] WAIS]} {
 698             if {[string length $op] == 0} {
 699                 set q $term
 700             } else {
 701                 set q "$term $q"
 702             }
 703             set op [egw_form logic$i]
 704             continue
 705         }
 706         if {[string length $term] > 0} {
 707             set field [join [egw_form menu$i]]
 708             catch {unset attr}
 709             foreach x [lindex $targets($t) 2] {
 710                 if {![string compare [lindex $x 0] $field]} {
 711                     set attr [lindex $x 1]
 712                 }
 713             }
 714             if {![info exists attr]} {
 715                 egw_log debug "attr failed for $t"
 716                 set attr [lindex [lindex [lindex $targets($t) 2] 0] 1]
 717             }
 718             switch $op {
 719             And
 720                 { set q "@and $q ${attr} \"${term}\"" }
 721             Or
 722                 { set q "@or $q ${attr} \"${term}\"" }
 723             {And not}
 724                 { set q "@not $q ${attr} \"${term}\"" }
 725             {}
 726                 { set q "${attr} \"${term}\"" }
 727             }
 728             set op [egw_form logic$i]
 729         }
 730     }
 731     return $q
 732 }
 733
 734 proc z39scan {setNo scanNo tno scanLines scanPos cache} {
 735     global hist
 736     global sessionWait
 737     global targets
 738
 739     set zz z39$tno
 740     set host $hist($setNo,$tno,host)
 741     set idAuth $hist($setNo,$tno,idAuthentication)
 742     set database $hist($setNo,$tno,database)
 743     set scanAttr $hist($setNo,scanAttr)
 744     set scanTerm $hist($setNo,$scanNo,scanTerm)
 745
 746     mkAssoc $zz $host
 747     if {[catch [list set oldHost [$zz connect]]]} {
 748         set oldHost ""
 749     }
 750     set zs $zz.s$scanNo.$setNo
 751     $zz callback ok-response
 752     $zz failback fail-response
 753     set thisHost [splitHostSpec $host]
 754     if {[string compare $oldHost $thisHost]} {
 755         catch [list $zz disconnect]
 756
 757         set sessionWait 0
 758         if {[catch [list $zz connect $thisHost]]} {
 759             displayError "Cannot connect to target" $thisHost
 760             return 0
 761         } elseif {$sessionWait == 0} {
 762             if {[catch {egw_wait sessionWait 300}]} {
 763                 $zz disconnect
 764                 displayError "Cannot connect to target" $thisHost
 765                 return 0
 766             }
 767             if {$sessionWait != 1} {
 768                 displayError "Cannot connect to target" $thisHost
 769                 return 0
 770             }
 771         }
 772         $zz idAuthentication $idAuth
 773         set sessionWait 0
 774         if {[catch {$zz init}]} {
 775             displayError "Cannot initialize target" $thisHost
 776             $zz disconnect
 777             return 0
 778         }
 779         if {[catch {egw_wait sessionWait 60}]} {
 780             displayError "Cannot initialize target" $thisHost
 781             $zz disconnect
 782             return 0
 783         }
 784         if {$sessionWait != "1"} {
 785             displayError "Cannot initialize target" $thisHost
 786             $zz disconnect
 787             return 0
 788         }
 789         if {![$zz initResult]} {
 790             set u [$zz userInformationField]
 791             $zz disconnect
 792             displayError "Cannot initialize target $thisHost" $u
 793             return 0
 794         }
 795     } else {
 796         if {$cache && ![catch [list $zs numberOfTermsRequested 5]]} {
 797             return 1
 798         }
 799     }
 800     eval $zz databaseNames $database
 801
 802     ir-scan $zs $zz
 803
 804     $zs numberOfTermsRequested $scanLines
 805     $zs preferredPositionInResponse $scanPos
 806
 807     $zz callback [list scan-response $zs]
 808
 809     egw_log debug "scan: ${scanAttr} ${scanTerm}"
 810     set sessionWait 0
 811     $zs scan "${scanAttr} ${scanTerm}"
 812
 813     if {[catch {egw_wait sessionWait 60}]} {
 814         egw_log debug "timeout/cancel in scan"
 815         displayError "Timeout in scan" {}
 816         html "</body></html>\n"
 817         $zz disconnect
 818         return 0
 819     }
 820     if {$sessionWait == -1} {
 821         displayError "Scan fail" "Connection closed"
 822         html "</body></html>\n"
 823         $zz disconnect
 824     }
 825     if {$sessionWait != 1} {
 826         return 0
 827     }
 828     return 1
 829 }
 830
 831 proc display-scan {setNo scanNo tno} {
 832     global hist
 833     global targets
 834     global env
 835     global sessionId
 836
 837     set zz z39$tno
 838     set zs $zz.s$scanNo.$setNo
 839     set m [$zs numberOfEntriesReturned]
 840
 841     if {$m > 0} {
 842         set t [lindex [$zs scanLine 0] 1]
 843         if {$tno > 0} {
 844             set hist($setNo,$tno,[expr $scanNo - 1],scanTerm) $t
 845         } else {
 846             set hist($setNo,[expr $scanNo - 1],scanTerm) $t
 847         }
 848         set t [lindex [$zs scanLine [expr $m - 1]] 1]
 849         if {$tno > 0} {
 850             set hist($setNo,$tno,[expr $scanNo + 1],scanTerm) $t
 851         } else {
 852             set hist($setNo,[expr $scanNo + 1],scanTerm) $t
 853         }
 854     }
 855     html {<table width=500 border=0><tr>}
 856     html {<td align=left><b>Scan term</b>}
 857     html {<td align=right><b>Hits</b>}
 858     html {<tr>} \n
 859
 860     for {set i 0} {$i < $m} {incr i} {
 861         html {<td align=left>}
 862         if {0} {
 863             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
 864             html {<a href="http:} $env(SCRIPT_NAME)
 865             html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo +
 866             html $hist($setNo,scan) +  $tterm {">}
 867         } else {
 868             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
 869             html {<a href="http:} $env(SCRIPT_NAME)
 870             html / $sessionId {/search.egw/} $setNo + $tno +
 871             html hyper + $tterm {">}
 872         }
 873         html [lindex [$zs scanLine $i] 1]
 874         html {</a>}
 875         html {<td align=right>}
 876         html [lindex [$zs scanLine $i] 2]
 877         html {<tr>} \n
 878     }
 879     html {</table} \n
 880 }
 881
 882 proc z39search {setNo piggy tno elements} {
 883     global hist
 884     global sessionWait
 885     global targets
 886
 887     set zz z39$tno
 888     set host $hist($setNo,$tno,host)
 889     set idAuth $hist($setNo,$tno,idAuthentication)
 890     set database $hist($setNo,$tno,database)
 891     set query $hist($setNo,$tno,query)
 892     catch {set docId $hist($setNo,$tno,queryId)}
 893
 894     mkAssoc $zz $host
 895     if {[catch [list set oldHost [$zz connect]]]} {
 896         set oldHost ""
 897     }
 898     $zz callback ok-response
 899     $zz failback fail-response
 900     set thisHost [splitHostSpec $host]
 901     if {[string compare $oldHost $thisHost]} {
 902         catch [list $zz disconnect]
 903
 904         set sessionWait 0
 905         if {[catch [list $zz connect $thisHost]]} {
 906             displayError "Cannot connect to target" $thisHost
 907             return 0
 908         } elseif {$sessionWait == 0} {
 909             if {[catch {egw_wait sessionWait 300}]} {
 910                 $zz disconnect
 911                 displayError "Cannot connect to target" $thisHost
 912                 return 0
 913             }
 914             if {$sessionWait != 1} {
 915                 displayError "Cannot connect to target" $thisHost
 916                 return 0
 917             }
 918         }
 919         $zz idAuthentication $idAuth
 920         set sessionWait 0
 921         if {[catch {$zz init}]} {
 922             displayError "Cannot initialize target" $thisHost
 923             $zz disconnect
 924             return 0
 925         }
 926         if {$sessionWait == 0 && [catch {egw_wait sessionWait 60}]} {
 927             displayError "Cannot initialize target" $thisHost
 928             $zz disconnect
 929             return 0
 930         }
 931         if {$sessionWait != "1"} {
 932             displayError "Cannot initialize target" $thisHost
 933             $zz disconnect
 934             return 0
 935         }
 936         if {![$zz initResult]} {
 937             set u [$zz userInformationField]
 938             $zz disconnect
 939             displayError "Cannot initialize target $thisHost" $u
 940             return 0
 941         }
 942     } elseif {![catch  [list $zz.$setNo smallSetUpperBound 0]]} {
 943         if {$tno > 0} {
 944             if {[info exists hist($setNo,$tno,hits)]} {
 945                 return 1
 946             }
 947         } else {
 948             if {[info exists hist($setNo,hits)]} {
 949                 return 1
 950             }
 951         }
 952     }
 953
 954     if {![string compare [lindex $targets($host) 1] WAIS]} {
 955         wais-set $zz.$setNo $zz
 956     } else {
 957         ir-set $zz.$setNo $zz
 958         $zz.$setNo preferredRecordSyntax [lindex $targets($host) 1]
 959         egw_log debug "set syntax to [lindex $targets($host) 1]"
 960     }
 961     if {![lindex $targets($host) 5]} {
 962         set elements {}
 963     }
 964     $zz.$setNo smallSetElementSetNames $elements
 965     $zz.$setNo mediumSetElementSetNames $elements
 966     $zz.$setNo recordElements $elements
 967
 968     egw_log debug "database=$database"
 969     eval $zz.$setNo databaseNames $database
 970
 971     $zz callback [list search-response $zz.$setNo]
 972     if {$piggy} {
 973         $zz.$setNo largeSetLowerBound 999999
 974         $zz.$setNo smallSetUpperBound 0
 975         $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 976     } else {
 977         $zz.$setNo largeSetLowerBound 2
 978         $zz.$setNo smallSetUpperBound 0
 979         $zz.$setNo mediumSetPresentNumber 0
 980     }
 981     set sessionWait 0
 982     egw_log debug "search: $query"
 983
 984     if {[info exists docId]} {
 985         $zz.$setNo search $query $docId
 986     } else {
 987         $zz.$setNo search $query
 988     }
 989
 990     if {!$sessionWait && [catch {egw_wait sessionWait 60}]} {
 991         egw_log debug "timeout/cancel in search"
 992         displayError "Timeout in search" {}
 993         html "</body></html>\n"
 994         $zz disconnect
 995         return 0
 996     }
 997
 998     if {$sessionWait == -1} {
 999         displayError "Search fail" "Connection closed"
1000         html "</body></html>\n"
1001         $zz disconnect
1002     }
1003     if {$sessionWait != 1} {
1004         return 0
1005     }
1006     set hist($setNo,hits) [$zz.$setNo resultCount]
1007     return 1
1008 }
1009
1010 proc init-m-response {i} {
1011     global zstatus
1012     global zleft
1013
1014     egw_log debug "init-m-response"
1015
1016     incr zleft -1
1017     if {![z39$i initResult]} {
1018         set zstatus($i) -1
1019         z39$i disconnect
1020         return
1021     }
1022     set zstatus($i) 1
1023 }
1024
1025 proc connect-m-response {i} {
1026     global zstatus
1027     global zleft
1028
1029     egw_log debug "connect-m-response"
1030     z39$i callback [list init-m-response $i]
1031     if {[catch {z39$i init}]} {
1032         set zstatus($i) -1
1033         incr zleft -1
1034     }
1035 }
1036
1037 proc fail-m-response {i} {
1038     global zstatus
1039     global zleft
1040
1041     egw_log debug "fail-m-response"
1042     set zstatus($i) -1
1043     incr zleft -1
1044 }
1045
1046 proc search-m-response {setNo i start number} {
1047     global zleft
1048     global zstatus
1049     global hist
1050
1051     egw_log debug "search-m-response"
1052     set status [z39$i.$setNo responseStatus]
1053     egw_log debug "search-m-response1"
1054     if {[lindex $status 0] == "OK"} {
1055         set nor 0
1056     } elseif {[lindex $status 0] == "DBOSD"} {
1057         set nor [z39$i.$setNo numberOfRecordsReturned]
1058     } else {
1059         egw_log debug "search-m-response2"
1060         incr zleft -1
1061         set zstatus($i) 2
1062         return
1063     }
1064     set hist($setNo,$i,hits) [z39$i.$setNo resultCount]
1065     egw_log debug "search-m-response3"
1066     set hist($setNo,$i,offset) [expr $start + $nor -1]
1067     if {[expr $nor + $start] > [z39$i.$setNo resultCount]} {
1068         egw_log debug "search-m-response4"
1069         incr zleft -1
1070         set zstatus($i) 2
1071         return
1072     }
1073     egw_log debug "search-m-response5"
1074     if {$nor >= $number} {
1075         egw_log debug "search-m-response6 nor=$nor number=$number"
1076         incr zleft -1
1077         set zstatus($i) 2
1078         return
1079     }
1080     egw_log debug "search-m-response7"
1081     set start [expr $start + $nor]
1082     set number [expr $number - $nor]
1083     if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
1084         set number [expr [z39$i.$setNo resultCount] - $start + 1]
1085     }
1086     z39$i callback [list search-m-response $setNo $i $start $number]
1087     egw_log debug "mpresent start=$number number=$number"
1088     z39$i.$setNo present $start $number
1089 }
1090
1091 proc z39msearch {setNo elements start number cache} {
1092     global zleft
1093     global zstatus
1094     global hist
1095     global targets
1096     global debug
1097
1098     set not $hist($setNo,0,host)
1099
1100     egw_log debug "z39msearch start=$start number=$number elements=$elements"
1101     for {set i 1} {$i <= $not} {incr i} {
1102         set host $hist($setNo,$i,host)
1103         mkAssoc z39$i $host
1104         set oldHost [z39$i connect]
1105         set thisHost [splitHostSpec $host]
1106         if {[string compare $oldHost $thisHost]} {
1107             catch {z39$i disconnect}
1108         }
1109         z39$i callback [list connect-m-response $i]
1110         z39$i failback [list fail-m-response $i]
1111     }
1112     set zleft 0
1113     for {set i 1} {$i <= $not} {incr i} {
1114         set oldHost [z39$i connect]
1115         set host $hist($setNo,$i,host)
1116         set thisHost [splitHostSpec $host]
1117         if {![string compare $oldHost $thisHost]} {
1118             continue
1119         }
1120         egw_log debug "old=$oldHost this=$thisHost"
1121         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
1122         html "Connecting to target " $thisHost " <br>\n"
1123         set zstatus($i) -1
1124         if {![catch {z39$i connect $thisHost}]} {
1125             incr zleft
1126         }
1127     }
1128     while {$zleft > 0} {
1129         egw_log debug "Waiting for init response"
1130         if {[catch {egw_wait zleft 20}]} {
1131             break
1132         }
1133     }
1134     set zleft 0
1135     for {set i 1} {$i <= $not} {incr i} {
1136         set host $hist($setNo,$i,host)
1137         if {$debug} {
1138             html "host " [splitHostSpec $host] ": "
1139         }
1140         egw_log debug "i=$i zstatus=$zstatus($i)"
1141         if {$zstatus($i) < 1} {
1142             if {$debug} {
1143                 html "fail<br>\n"
1144             }
1145             continue
1146         }
1147         if {[catch [list z39$i.$setNo preferredRecordSyntax]]} {
1148             if {$debug} {
1149                 html "ok<br>\n"
1150             }
1151
1152             if {![string compare [lindex $targets($host) 1] WAIS]} {
1153                 wais-set z39$i.$setNo z39$i
1154             } else {
1155                 ir-set z39$i.$setNo z39$i
1156                 z39$i.$setNo preferredRecordSyntax [lindex $targets($host) 1]
1157                 egw_log debug "set syntax to [lindex $targets($host) 1]"
1158             }
1159             set hist($setNo,$i,offset) 0
1160             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
1161
1162             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1163                 set thisElements {}
1164             } else {
1165                 set thisElements $elements
1166             }
1167             z39$i.$setNo smallSetElementSetNames $thisElements
1168             z39$i.$setNo mediumSetElementSetNames $thisElements
1169             z39$i.$setNo elementSetNames $thisElements
1170             z39$i.$setNo recordElements $thisElements
1171
1172             z39$i callback [list search-m-response $setNo $i $start $number]
1173
1174             if {$start == 1} {
1175                 z39$i.$setNo largeSetLowerBound 999999
1176                 z39$i.$setNo smallSetUpperBound 0
1177                 z39$i.$setNo mediumSetPresentNumber $number
1178             } else {
1179                 z39$i.$setNo largeSetLowerBound 2
1180                 z39$i.$setNo smallSetUpperBound 0
1181                 z39$i.$setNo mediumSetPresentNumber 0
1182             }
1183             set zstatus($i) 1
1184             incr zleft
1185             egw_log debug "msearch host=" $hist($setNo,$i,host)
1186             egw_log debug "setNo=$setNo query=" $hist($setNo,$i,query) "="
1187             if {[catch {z39$i.$setNo search $hist($setNo,$i,query)}]} {
1188                 set zstatus($i) -1
1189                 incr zleft -1
1190             }
1191         } elseif {[z39$i.$setNo resultCount] >= $start} {
1192             if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
1193                 set tnumber [expr [z39$i.$setNo resultCount] - $start + 1]
1194             } else {
1195                 set tnumber $number
1196             }
1197             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1198                 set thisElements {}
1199             } else {
1200                 set thisElements $elements
1201             }
1202             z39$i.$setNo smallSetElementSetNames $thisElements
1203             z39$i.$setNo mediumSetElementSetNames $thisElements
1204             z39$i.$setNo elementSetNames $thisElements
1205             z39$i.$setNo recordElements $thisElements
1206
1207             for {set n 0} {$n < $tnumber} {incr n} {
1208                 if {[z39$i.$setNo recordType [expr $start + $n]] == ""} {
1209                     if {$n > 0} {
1210                         egw_log debug "failed on $n"
1211                     }
1212                     if {$debug} {
1213                         html "no record at #" [expr $start + $n]
1214                         html " el=-" $thisElements "-"
1215                     }
1216                     break
1217                 }
1218             }
1219             if {$n == $tnumber} {
1220                 if {$debug} {
1221                     html "cached<br>\n"
1222                 }
1223                 continue
1224             }
1225
1226             html "present<br>\n"
1227             z39$i callback [list search-m-response $setNo $i $start $tnumber]
1228             incr zleft
1229             egw_log debug "mpresent start=$start number=$tnumber"
1230             z39$i.$setNo present $start $tnumber
1231         } else {
1232             if {$debug} {
1233                 html "ok<br>\n"
1234             }
1235         }
1236     }
1237     while {$zleft > 0} {
1238         egw_log debug "Waiting for search/present response"
1239         if {[catch {egw_wait zleft 60}]} {
1240             break
1241         }
1242     }
1243     for {set i 1} {$i <= $not} {incr i} {
1244         if {$zstatus($i) != 2} continue
1245         set status [z39$i.$setNo responseStatus]
1246         if {0 && [lindex $status 0] != "NSD"} {
1247             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
1248         }
1249     }
1250 }
1251
1252 proc z39present {setNo tno setOffset setMax dfunc elements} {
1253     global hist
1254     global sessionWait
1255     global targets
1256
1257     set zz z39$tno
1258     set host $hist($setNo,$tno,host)
1259
1260     if {![lindex $targets($host) 5]} {
1261         set elements {}
1262     }
1263
1264     $zz.$setNo elementSetNames $elements
1265     $zz.$setNo recordElements $elements
1266     set toGet [expr 1 + $setMax - $setOffset]
1267
1268     $zz callback [list search-response $zz.$setNo]
1269
1270     while {$setMax > 0 && $toGet > 0} {
1271         for {set got 0} {$got < $toGet} {incr got} {
1272             if {[$zz.$setNo recordType [expr $setOffset + $got]] == ""} {
1273                 break
1274             }
1275         }
1276         if {$got < $toGet} {
1277             set sessionWait 0
1278             $zz.$setNo present $setOffset $toGet
1279             if {[catch {egw_wait sessionWait 300}]} {
1280                 egw_log debug "timeout/cancel in present"
1281                 $zz disconnect
1282                 break
1283             }
1284             if {$sessionWait == "0"} {
1285                 $zz disconnect
1286             }
1287             if {$sessionWait != "1"} {
1288                 break
1289             }
1290             set got [$zz.$setNo numberOfRecordsReturned]
1291             if {$got <= 0} {
1292                 break
1293             }
1294         }
1295         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $setNo $tno
1296         set setOffset [expr $got + $setOffset]
1297         set toGet [expr 1 + $setMax - $setOffset]
1298         egw_flush
1299     }
1300 }
1301
1302 proc buttons-result-set-s {setNo targetNo setMax startPos after} {
1303     global sessionId
1304     global useIcons
1305     global env
1306     global hist
1307
1308     set zz z39$targetNo
1309     html "<p>\n"
1310     button-europagate
1311     if {$setMax > 0 && $setMax < [$zz.$setNo resultCount]} {
1312         html {<a href="http:} $env(SCRIPT_NAME)
1313         html / $sessionId {/search.egw/} $setNo + $targetNo +
1314         html [expr $setMax + 1] + [expr $setMax + $hist($setNo,maxPresent)]
1315         if {$useIcons} {
1316             html {"><img src="/egwgif/button-next-records.gif" alt="Next Records"}
1317             html { border=0></a>}
1318         } else {
1319             html {">Next Records</a>} " | \n"
1320         }
1321     }
1322     if {$setMax > 0 && $startPos != "" && $startPos != "1"} {
1323         html {<a href="http:} $env(SCRIPT_NAME)
1324         html / $sessionId {/search.egw/} $setNo + $targetNo
1325         html + [expr $startPos - $hist($setNo,maxPresent)]
1326         html + [expr $startPos - 1]
1327         if {$useIcons} {
1328             html {"><img src="/egwgif/button-previous-records.gif" }
1329             html {alt="Previous Records" border=0></a>}
1330         } else {
1331             html {">Previous Records</a>} " | \n"
1332         }
1333     }
1334     button-new-query 1 $setNo
1335     button-new-target 1
1336     button-view-history 0
1337
1338     html "<p>\n"
1339 }
1340
1341 proc score-sort {l r} {
1342     return [expr [lindex $r 0] - [lindex $l 0]]
1343 }
1344
1345 proc display-result-set-m-score {setNo} {
1346     global hist
1347     global useIcons
1348     global zstatus
1349     global targets
1350
1351     set not $hist($setNo,0,host)
1352     for {set i 1} {$i <= $not} {incr i} {
1353         if {$zstatus($i) != 2} continue
1354         set status [z39$i.$setNo responseStatus]
1355         if {[lindex $status 0] != "DBOSD"} continue
1356         if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} {
1357             set nor $hist($setNo,maxPresent)
1358         } else {
1359             set nor $hist($setNo,$i,offset)
1360         }
1361         for {set j 1} {$j <= $nor} {incr j} {
1362             if {![string compare [z39$i.$setNo recordType $j] WAIS]} {
1363                 set score [z39$i.$setNo getWAIS $j score]
1364                 if {$score > 0} {
1365                     lappend scoreArray [list $score $i $j]
1366                 }
1367             } else {
1368                 lappend scoreArray [list 10 $i $j]
1369             }
1370         }
1371     }
1372     if {![info exists scoreArray]} {
1373         html "<br><h3>Search produced no result</h3><br>\n"
1374         return
1375     }
1376     set scoreSorted [lsort -command score-sort $scoreArray]
1377
1378     html "<ul>\n"
1379     foreach r $scoreSorted {
1380         set i [lindex $r 1]
1381         set j [lindex $r 2]
1382         display-$hist($setNo,format) z39$i.$setNo $j $setNo $i
1383     }
1384     html "</ul><br>\n"
1385 }
1386
1387 proc display-result-set-m-server {setNo} {
1388     global hist
1389     global useIcons
1390     global zstatus
1391     global targets
1392
1393     set not $hist($setNo,0,host)
1394     html "<dl>\n"
1395     for {set i 1} {$i <= $not} {incr i} {
1396         if {$zstatus($i) != 2} continue
1397         html "<dt><h3>" [lindex $targets($hist($setNo,$i,host)) 0] ": "
1398         set status [z39$i.$setNo responseStatus]
1399         if {[lindex $status 0] == "NSD"} {
1400             z39$i.$setNo nextResultSetPosition 0
1401             set code [lindex $status 1]
1402             set msg [lindex $status 2]
1403             set addinfo [lindex $status 3]
1404             html "Error</h3>\n<dd>NSD$code: $msg: $addinfo"
1405         } else {
1406             set r [z39$i.$setNo resultCount]
1407             html "$r hits</h3>\n<dd>\n"
1408
1409             if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} {
1410                 set nor $hist($setNo,maxPresent)
1411             } else {
1412                 set nor $hist($setNo,$i,offset)
1413             }
1414             display-rec 1 $nor display-$hist($setNo,format) $setNo $i
1415         }
1416         html "\n"
1417     }
1418     html "</dl>\n"
1419 }
1420
1421 proc display-result-set-m {setNo} {
1422     global hist
1423     global useIcons
1424     global zstatus
1425     global targets
1426
1427     egw_log debug "sort=$hist($setNo,sort)"
1428     switch $hist($setNo,sort) {
1429         score {
1430             display-result-set-m-score $setNo
1431         }
1432         default {
1433             display-result-set-m-server $setNo
1434         }
1435     }
1436 }
1437
1438 proc display-result-set-s {setNo targetNo startPos endPos} {
1439     global hist
1440     global useIcons
1441
1442     set zz z39$targetNo
1443     set host $hist($setNo,$targetNo,host)
1444     set idAuth $hist($setNo,$targetNo,idAuthentication)
1445     set database $hist($setNo,$targetNo,database)
1446     set query $hist($setNo,$targetNo,query)
1447
1448     set useIcons 1
1449
1450     if {$startPos == ""} {
1451         if {[z39search $setNo 1 $targetNo B] != "1"} {
1452             return
1453         }
1454         set r [$zz.$setNo resultCount]
1455
1456         set setMax [$zz.$setNo resultCount]
1457         if {$setMax > $hist($setNo,maxPresent)} {
1458             set setMax $hist($setNo,maxPresent)
1459         }
1460         buttons-result-set-s $setNo $targetNo $setMax $startPos 0
1461
1462         set setOffset [$zz.$setNo numberOfRecordsReturned]
1463         if {$setMax > 0} {
1464             html {<h3> Records 1-} $setMax " out of $r</h3>\n"
1465         } else {
1466             html "<h3> No hits</h3>\n"
1467         }
1468         egw_flush
1469         html "<ul>\n"
1470         display-rec 1 $setMax display-brief $setNo $targetNo
1471         incr setOffset
1472
1473     } else {
1474         if {[z39search $setNo 0 $targetNo B] != "1"} {
1475             return
1476         }
1477         set r [$zz.$setNo resultCount]
1478         set setOffset $startPos
1479         set setMax [$zz.$setNo resultCount]
1480         if {$setMax > $endPos} {
1481             set setMax $endPos
1482         }
1483         buttons-result-set-s $setNo $targetNo $setMax $startPos 0
1484         if {$setMax > 0} {
1485             html {<h3> Records } $startPos {-} $setMax " out of $r</h3>\n"
1486         } else {
1487             html "<h3> No hits</h3>\n"
1488         }
1489         egw_flush
1490         html "<ul>\n"
1491     }
1492     if {$setMax > 0} {
1493         z39present $setNo $targetNo $setOffset $setMax display-brief B
1494     }
1495     html "</ul>\n"
1496     set useIcons 0
1497     buttons-result-set-s $setNo $targetNo $setMax $startPos 1
1498 }
1499
1500 proc z39history {} {
1501     global nextSetNo
1502     global hist
1503     global env
1504     global sessionId
1505     global targets
1506     global html3
1507
1508     set targetNo 0
1509     if {![info exists nextSetNo]} {
1510         return
1511     }
1512     html "<h2>History</h2><br>\n"
1513     if {$html3} {
1514         html {<table width=500 border=1><tr>}
1515         html {<td align=center><b>Target</b>}
1516         html {<td align=center><b>Database</b>}
1517         html {<td align=center><b>Hits</b>}
1518         html {<td align=center><b>Query</b>}
1519         html {<tr>} "\n"
1520     } else {
1521         html {<dl>} "\n"
1522     }
1523     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
1524         if {$hist($setNo,scan) > 0} continue
1525         set host $hist($setNo,0,host)
1526         if {$html3} {
1527             html {<td align=left>}
1528         } else {
1529             html {<dt> }
1530         }
1531         html [lindex $targets($host) 0]
1532         if {$html3} {
1533             html {<td align=left>} [join $hist($setNo,0,database)]
1534         } else {
1535             if {[llength [lindex $targets($host) 1]] > 1} {
1536                 html ": "
1537                 foreach b $hist($setNo,0,database) {
1538                     html " $b"
1539                 }
1540             }
1541             html {. }
1542         }
1543         if {$html3} {
1544             html {<td align=right>}
1545         }
1546         if {[info exists hist($setNo,hits)]} {
1547             html { <a href="http:} $env(SCRIPT_NAME)
1548             html / $sessionId {/search.egw/} $setNo + $targetNo + 1
1549             html + $hist($setNo,maxPresent)
1550             if {1} {
1551                 html {">} $hist($setNo,hits) {</a>}
1552             } else {
1553                 html {">Result</a>: } $hist($setNo,hits) { hits.}
1554             }
1555         } else {
1556             if {$html3} {
1557                 html {Failed}
1558             } else {
1559                 html {Search failed.}
1560             }
1561         }
1562         if {$html3} {
1563             html {<td align=left>}
1564         } else {
1565             html "<dd>\n"
1566         }
1567         html { <a href="http:} $env(SCRIPT_NAME)
1568         html / $sessionId {/query.egw/} $host + $setNo
1569         if {$html3} {
1570             html {">}
1571         } else {
1572             html {">Query</a>: }
1573         }
1574         set op {}
1575         for {set i 1} {$i <= 3} {incr i} {
1576             if {[string length $hist($setNo,form,entry$i)] > 0} {
1577                 html " <b>" [join $op " "] "</b> "
1578                 html [join $hist($setNo,form,menu$i)] "="
1579                 html $hist($setNo,form,entry$i)
1580                 set op $hist($setNo,form,logic$i)
1581             }
1582         }
1583         if {$html3} {
1584             html {</a><tr>} "\n"
1585         }
1586     }
1587     if {$html3} {
1588         html {</table><p>}
1589     } else {
1590         html {</dl>}
1591     }
1592     html "\n"
1593 }
1594
1595 proc displayError {msga msgb} {
1596     html "<p><center>\n"
1597     html {<img src="/egwgif/noway.gif" alt="Error">}
1598     html "<h2>" $msga "</h2>\n"
1599     if {$msgb != ""} {
1600         html "<h3>" $msgb "</h3>\n"
1601     }
1602     html "</center><p>\n"
1603 }
1604
1605 proc button-europagate {} {
1606     global useIcons
1607     html {<a href="http://europagate.dtv.dk/">}
1608     if {$useIcons} {
1609         html {<img src="/egwgif/button-egw.gif" alt="Europagate" border=0></a>}
1610     } else {
1611         html {Europagate</a> | }
1612     }
1613 }
1614
1615 proc button-define-target {more} {
1616     global useIcons
1617     global env
1618     global sessionId
1619
1620     html {<a href="http:} $env(SCRIPT_NAME)
1621     html / $sessionId {/tform.egw}
1622     if {$useIcons} {
1623         html {"><img src="/egwgif/button-define-target.gif" }
1624         html {alt="Define Target" border=0></a>}
1625     } else {
1626         html {">Define Target</a>}
1627         if {$more} {
1628             html " | \n"
1629         } else {
1630             html "\n"
1631         }
1632     }
1633 }
1634
1635 proc button-new-target {more} {
1636     global useIcons
1637     global env
1638     global sessionId
1639     global mMode
1640
1641     html {<a href="http:} $env(SCRIPT_NAME)
1642     html / $sessionId
1643     if {$mMode} {
1644         html {/mtargets.egw}
1645     } else {
1646         html {/targets.egw}
1647     }
1648     if {$useIcons} {
1649         html {"><img src="/egwgif/button-new-target.gif" }
1650         html {alt="New Target" border=0></a>}
1651     } else {
1652         html {">New Target</a>}
1653         if {$more} {
1654             html " | \n"
1655         } else {
1656             html "\n"
1657         }
1658     }
1659 }
1660
1661 proc button-view-history {more} {
1662     global useIcons
1663     global env
1664     global sessionId
1665     global nextSetNo
1666
1667     html {<a href="http:} $env(SCRIPT_NAME)
1668     html / $sessionId {/history.egw;}
1669     catch { html "/" $nextSetNo}
1670     if {$useIcons} {
1671         html {"><img src="/egwgif/button-view-history.gif" alt="View History" }
1672         html {border=0></a>}
1673     } else {
1674         html {">View History</a>}
1675         if {$more} {
1676             html " | \n"
1677         } else {
1678             html "\n"
1679         }
1680     }
1681 }
1682
1683 proc button-new-query {more setNo} {
1684     global useIcons
1685     global env
1686     global sessionId
1687     global hist
1688     global mMode
1689
1690     html {<a href="http:} $env(SCRIPT_NAME)
1691     html / $sessionId
1692     if {$mMode} {
1693         html {/mquery.egw/} $setNo
1694     } else {
1695         html {/query.egw/} $hist($setNo,0,host) + $setNo
1696     }
1697     html {">}
1698     if {$useIcons} {
1699         html {<img src="/egwgif/button-new-query.gif" }
1700         html {alt="New Query" border=0></a>}
1701     } else {
1702         html {New Query</a>}
1703         if {$more} {
1704             html " | \n"
1705         } else {
1706             html "\n"
1707         }
1708     }
1709 }
1710
1711 proc button-scan-window {more setNo} {
1712     global useIcons
1713     global env
1714     global sessionId
1715     global hist
1716
1717     set targetNo 0
1718     html {<a href="http:} $env(SCRIPT_NAME)
1719     html / $sessionId {/search.egw/} $setNo + $targetNo + {scan} {">}
1720     if {$useIcons} {
1721         html {<img src="/egwgif/button-scan-window.gif" }
1722         html {alt="Scan" border=0></a>}
1723     } else {
1724         html {Scan</a>}
1725         if {$more} {
1726             html " | \n"
1727         } else {
1728             html "\n"
1729         }
1730     }
1731 }
1732
1733 proc maintenance {} {
1734     html {<hr>This page is maintained by }
1735     html {<a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.}
1736     html {Last modified 29. january 1996. <br>}
1737     html {<em> This and the following pages are under construction and }
1738     html {will continue to be so until the end of January 1996.</em>}
1739 }
1740
1741 proc splitHostSpec {host} {
1742     set i [string first / $host]
1743     if {$i > 1} {
1744         incr i -1
1745         return [string range $host 0 $i]
1746     }
1747     return $host
1748 }
1749
1750 proc splitDatabaseSpec {host} {
1751     set i [string first / $host]
1752     if {$i > 1} {
1753         incr i
1754         regsub -all -- - [string range $host $i end] { } res
1755         return $res
1756     }
1757     regsub -all -- - $host {} res
1758     return $res
1759 }
1760
1761 proc mergeHostSpec {host databases} {
1762     return ${host}.[join $databases -]
1763 }
1764
1765 proc mkAssoc {assoc host} {
1766     global targets
1767
1768     if {[catch {$assoc failback fail-response}]} {
1769         if {![string compare [lindex $targets($host) 1] WAIS]} {
1770             wais $assoc
1771         } else {
1772             ir $assoc
1773         }
1774     } else {
1775         if {![string compare [lindex $targets($host) 1] WAIS]} {
1776             if {[$assoc comstack] == "wais"} return
1777             wais $assoc
1778         } else {
1779             if {[$assoc comstack] == "tcpip"} return
1780             ir $assoc
1781         }
1782     }
1783 }