From: Adam Dickmeiss Date: Fri, 13 Sep 1996 10:54:22 +0000 (+0000) Subject: Started work on Explain in client. X-Git-Tag: IRTCL.1.4~87 X-Git-Url: http://lists.indexdata.com/cgi-bin?a=commitdiff_plain;h=1bf7f7dd79d70efaa29e01b2a0ba911b40547154;p=ir-tcl-moved-to-github.git Started work on Explain in client. --- diff --git a/client.tcl b/client.tcl index 2092bc6..9a3565f 100644 --- a/client.tcl +++ b/client.tcl @@ -4,7 +4,10 @@ # Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.96 1996-08-09 15:30:18 adam +# Revision 1.97 1996-09-13 10:54:22 adam +# Started work on Explain in client. +# +# Revision 1.96 1996/08/09 15:30:18 adam # Procedure destroyGW modified to handle multiple calls - probably an # error introduced by tk4.1 patch level 1. # @@ -375,6 +378,12 @@ if {[tk4]} { set noFocus {} } +# Define dummy clock function if it is not there. +if {[catch {clock seconds}]} { + proc clock {args} { + return {} + } +} # Set monoFlag to 1 if screen is known not to support colors; otherwise # set monoFlag to 0 if {![tk4]} { @@ -411,6 +420,43 @@ set hotTargets {} set hotInfo {} set busy 0 +# profile: associative array with target profiles. +#indx exp description +# +# 0 T Target description +# 1 Host +# 2 Port +# 3 Authentication +# 4 Maximum Record Size +# 5 Preferred Messages Size +# 6 Comstack +# 7 D Databases available +# 8 T Result Sets support +# 9 RPN-Query support +# 10 CCL-Query support +# 11 Protocol (Z39/SR) +# 12 Window Number +# 13 LSLB Large Set Lower Bound +# 14 SSUB Small Set Upper Bound +# 15 MSPN Medium Set Present Number +# 16 Present Chunk - number of records to fetch in each present +# 17 Time of first define +# 18 Time of last init +# 19 Time of last explain +# 20 T Name in TargetInfo +# 21 T Recent News +# 22 T Max Result Sets +# 23 T Max Result Size +# 24 T Max Terms +# 25 D List of database info records +# 26 T Multiple Databases +# 27 T Welcome message +# +# +# Legend: +# T TargetInfo explain +# D DatabaseInfo explain + set profile(Default) {{} {} {210} {} 50000 30000 tcpip {} 1 {} {} Z39 1 2 0 0 4} set hostid Default set settingsChanged 0 @@ -438,7 +484,7 @@ set setMax 0 # Procedure tkerror {err} # err error message # Override the Tk error handler function. -proc tkerror err { +proc tkerrorx err { set w .tkerrorw if {[winfo exists $w]} { @@ -470,6 +516,15 @@ if {[file readable "clientrc.tcl"]} { source "${libdir}/clientrc.tcl" } +# Make old definitions up-to-date. +foreach n [array names profile] { + set l [llength $profile($n)] + while {$l < 29} { + lappend profile($n) {} + incr l + } +} + # Read the user configuration file. if {[file readable "~/.clientrc.tcl"]} { source "~/.clientrc.tcl" @@ -584,23 +639,12 @@ proc set-display-format {f} { # Procedure initBindings # Disables various default bindings for Text and Listbox widgets. proc initBindings {} { - set w Text - bind $w <1> {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} - bind $w <2> {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} - bind $w {} + global TextBinding + foreach e [bind Text] { + set TextBinding($e) [bind Text $e] + bind Text $e {} + } set w Listbox bind $w {} bind $w {} @@ -608,6 +652,16 @@ proc initBindings {} { set w Entry } +# Procedure TextEditable +# Apply "standard" events to a text widget. It should be editable now. +proc TextEditable {w} { + global TextBinding + + foreach e [array names TextBinding] { + bind $w $e $TextBinding($e) + } +} + # Procedure post-menu {wbutton wmenu} # wbutton button widget # wmenu menu widget @@ -742,11 +796,11 @@ proc cancel-operation {} { proc show-target {target base} { global profile - if {$target == ""} { + if {![string length $target]} { .bot.a.target configure -text "" return } - if {$base == ""} { + if {![string length $base]} { .bot.a.target configure -text "$target" } else { .bot.a.target configure -text "$target - $base" @@ -810,6 +864,8 @@ proc show-status {status b sb} { .mid.search configure -state normal if {$scanEnable} { .mid.scan configure -state normal + } else { + configure-disable-e .top.service.m 3 } if {$setNo == 0} { configure-disable-e .top.service.m 1 @@ -1156,7 +1212,7 @@ proc set-target-hotlist {olen} { foreach e $hotTargets { set target [lindex $e 0] set base [lindex $e 1] - if {$base == ""} { + if {![string length $base]} { .top.target.m add command -label "$i $target" -command \ [list reopen-target $target {}] } else { @@ -1190,7 +1246,7 @@ proc define-target-action {} { global profile set target [.target-define.top.target.entry get] - if {$target == ""} { + if {![string length $target]} { return } foreach n [array names profile] { @@ -1233,8 +1289,7 @@ proc fail-response {target} { # IrTcl connect response handler. proc connect-response {target base} { dputs "connect-response" - show-target $target $base - init-request + init-request $target $base } # Procedure open-target {target base} @@ -1246,54 +1301,58 @@ proc open-target {target base} { global hostid global presentChunk + set desc [lindex $profile($target) 0] + if {[string length $desc]} { + .data.record insert end $desc + } else { + .data.record insert end $target + } + .data.record insert end "\n\n" + z39 disconnect z39 comstack [lindex $profile($target) 6] z39 protocol [lindex $profile($target) 11] - z39 idAuthentication [lindex $profile($target) 3] + eval z39 idAuthentication [lindex $profile($target) 3] z39 maximumRecordSize [lindex $profile($target) 4] z39 preferredMessageSize [lindex $profile($target) 5] - dputs "maximumRecordSize=" - dputs [z39 maximumRecordSize] - dputs "preferredMessageSize=" - dputs [z39 preferredMessageSize] + dputs "maximumRecordSize=[z39 maximumRecordSize]" + dputs "preferredMessageSize=[z39 preferredMessageSize]" show-status Connecting 1 0 - if {$base == ""} { - z39 databaseNames [lindex [lindex $profile($target) 7] 0] - } else { - z39 databaseNames $base - } set x [lindex $profile($target) 13] - if {$x == ""} { + if {![string length $x]} { set x 2 } z39 largeSetLowerBound $x - + set x [lindex $profile($target) 14] - if {$x == ""} { + if {![string length $x]} { set x 0 } z39 smallSetUpperBound $x - + set x [lindex $profile($target) 15] - if {$x == ""} { + if {![string length $x]} { set x 0 } z39 mediumSetPresentNumber $x set presentChunk [lindex $profile($target) 16] - if {$presentChunk == ""} { + if {![string length $presentChunk]} { set presentChunk 4 } z39 failback [list fail-response $target] z39 callback [list connect-response $target $base] + show-target $target $base update idletasks set err [catch { z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2] } errorMessage] if {$err} { + set hostid Default tkerror $errorMessage show-status "Not connected" 0 {} + show-target {} {} return } set hostid $target @@ -1380,14 +1439,14 @@ proc load-set {} { # Procedure init-request # Sends an initialize request to the target. This procedure is called # when a connect has been established. -proc init-request {} { +proc init-request {target base} { global cancelFlag if {$cancelFlag} { close-target return } - z39 callback {init-response} + z39 callback [list init-response $target $base] show-status Initializing 1 {} set err [catch {z39 init} errorMessage] if {$err} { @@ -1400,28 +1459,61 @@ proc init-request {} { # Handles and incoming init-response. The service buttons # are enabled. The global $scanEnable indicates whether the target # supports scan. -proc init-response {} { - global cancelFlag - global scanEnable +proc init-response {target base} { + global cancelFlag profile + global scanEnable settingsChanged - dputs {init-reponse} + dputs {init-response} apduDump if {$cancelFlag} { close-target return } if {![z39 initResult]} { - show-status Ready 0 1 set u [z39 userInformationField] close-target tkerror "Connection rejected by target: $u" } else { - if {[lsearch [z39 options] scan] >= 0} { - set scanEnable 1 - } else { - set scanEnable 0 - } - show-status Ready 0 1 + explain-check $target [list ready-response $base] + } +} + +# Procedure explain-check +# Stub function to check explain. May be overwritten later. +proc explain-check {target response} { + eval $response [list $target] +} + +# Procedure ready-response +# Called after a target has been initialized and, possibly, explained +proc ready-response {base target} { + global profile settingsChanged scanEnable + + if {![string length $base]} { + set base [lindex [lindex $profile($target) 7] 0] + } + if {![string length $base]} { + set base Default + } + z39 databaseNames $base + set profile($target) [lreplace $profile($target) 18 18 [clock seconds]] + set settingsChanged 1 + if {[lsearch [z39 options] scan] >= 0} { + set scanEnable 1 + } else { + set scanEnable 0 + } + cascade-dblist $target $base + show-target $target $base + show-message {} + show-status Ready 0 1 + + .data.record insert end [lindex $profile($target) 27] + .data.record insert end "\n" + set data [lindex $profile($target) 21] + if {[string length $data]} { + .data.record insert end "News:\n" + .data.record insert end "$data\n" } } @@ -1443,8 +1535,8 @@ proc search-request {bflag} { global elementSetNames set target $hostid - - if {[z39 connect] == ""} { + + if {![string length [z39 connect]]} { return } dputs "search-request" @@ -1462,7 +1554,7 @@ proc search-request {bflag} { set delayRequest {} set query [index-query] - if {$query==""} { + if {![string length $query]} { return } incr setNoLast @@ -1484,12 +1576,12 @@ proc search-request {bflag} { } dputs Setting dputs $recordSyntax - if {$recordSyntax == "None" } { + if {![string compare $recordSyntax None]} { z39.$setNo preferredRecordSyntax {} } else { z39.$setNo preferredRecordSyntax $recordSyntax } - if {$elementSetNames == "None" } { + if {![string compare $elementSetNames None]} { z39.$setNo elementSetNames {} z39.$setNo smallSetElementSetNames {} z39.$setNo mediumSetElementSetNames {} @@ -1610,7 +1702,7 @@ proc scan-term-h {attr} { z39.scan numberOfTermsRequested 5 z39.scan preferredPositionInResponse 1 dputs "${attr} \{${scanTerm}\}" - if {$scanTerm == ""} { + if {![string length $scanTerm]} { z39.scan scan "${attr} 0" } else { z39.scan scan "${attr} \{${scanTerm}\}" @@ -1662,7 +1754,7 @@ proc scan-response {attr start toget} { z39.scan preferredPositionInResponse 1 set scanTerm $nScanTerm dputs "${attr} \{${scanTerm}\}" - if {$scanTerm == ""} { + if {![string length $scanTerm]} { z39.scan scan "${attr} 0" } else { z39.scan scan "${attr} \{${scanTerm}\}" @@ -1840,7 +1932,7 @@ proc search-response {} { set setMax [z39.$setNo resultCount] show-status Ready 0 1 set status [z39.$setNo responseStatus] - if {[lindex $status 0] == "NSD"} { + if {![string compare [lindex $status 0] NSD]} { z39.$setNo nextResultSetPosition 0 set code [lindex $status 1] set msg [lindex $status 2] @@ -1916,7 +2008,7 @@ proc present-more {number} { show-status Ready 0 1 return } - if {$number == ""} { + if {![string length $number]} { set setMax $max } else { incr setMax $number @@ -1925,7 +2017,7 @@ proc present-more {number} { } } z39 callback {present-response} - + set toGet [expr $setMax - $setOffset + 1] if {$toGet <= 0} { return @@ -1978,7 +2070,7 @@ proc add-title-lines {setno no offset} { for {set i 0} {$i < $no} {incr i} { set o [expr $i + $offset] set type [z39.$setno type $o] - if {$type == ""} { + if {![string length $type]} { dputs "no more at $o" break } @@ -2023,7 +2115,7 @@ proc present-response {} { return } set status [z39.$setNo responseStatus] - if {[lindex $status 0] == "NSD"} { + if {![string compare [lindex $status 0] NSD]} { show-status Ready 0 1 set code [lindex $status 1] set msg [lindex $status 2] @@ -2170,11 +2262,17 @@ proc protocol-setup-action {target w} { lappend dataBases [$w.top.databases.list get $i] } set wno [lindex $profile($target) 12] + set timedef [lindex $profile($target) 17] + if {![string length $timedef]} { + set timedef [clock seconds] + } + + set idauth [$w.top.idAuthentication.entry get] set profile($target) [list [$w.top.description.entry get] \ [$w.top.host.entry get] \ [$w.top.port.entry get] \ - [$w.top.idAuthentication.entry get] \ + $idauth \ $targetS($target,MRS) \ $targetS($target,PMS) \ $targetS($target,csType) \ @@ -2187,7 +2285,10 @@ proc protocol-setup-action {target w} { $targetS($target,LSLB) \ $targetS($target,SSUB) \ $targetS($target,MSPN) \ - $targetS($target,presentChunk) ] + $targetS($target,presentChunk) \ + $timedef \ + {} \ + {} ] cascade-target-list delete-target-hotlist $target @@ -2250,6 +2351,7 @@ proc add-database {target wp} { focus $oldFocus } + # Procedure delete-database {target w} # target target to be defined # w top level widget for the target definition @@ -2293,7 +2395,7 @@ proc protocol-setup {target} { top-down-window $w - if {$target == ""} { + if {![string length $target]} { set target Default } dputs target @@ -2303,6 +2405,7 @@ proc protocol-setup {target} { frame $w.top.host frame $w.top.port frame $w.top.idAuthentication + frame $w.top.cs-type -relief ridge -border 2 frame $w.top.protocol -relief ridge -border 2 frame $w.top.query -relief ridge -border 2 @@ -2330,7 +2433,7 @@ proc protocol-setup {target} { set targetS($target,CCL) [lindex $profile($target) 9] set targetS($target,ResultSets) [lindex $profile($target) 10] set targetS($target,protocolType) [lindex $profile($target) 11] - if {$targetS($target,protocolType) == ""} { + if {![string length $targetS($target,protocolType)]} { set targetS($target,protocolType) Z39 } set targetS($target,LSLB) [lindex $profile($target) 13] @@ -2339,6 +2442,7 @@ proc protocol-setup {target} { set targetS($target,presentChunk) [lindex $profile($target) 16] set targetS($target,MRS) [lindex $profile($target) 4] set targetS($target,PMS) [lindex $profile($target) 5] + # Databases .... pack $w.top.databases -side left -pady 2 -padx 2 -expand yes -fill both @@ -2432,7 +2536,7 @@ proc advanced-setup {target b} { top-down-window $w - if {$target == ""} { + if {![string length $target]} { set target Default } dputs target @@ -2539,6 +2643,25 @@ proc database-select {} { focus $oldFocus } +# Procedure cascase-dblist-select +proc cascade-dblist-select {target db} { + show-target $target $db + z39 databaseNames $db +} + +# Procedure cascade-dblist +# Makes the Service/database list with proper databases for the target +proc cascade-dblist {target base} { + global profile + + set w .top.service.m.dblist + $w delete 0 200 + foreach db [lindex $profile($target) 7] { + $w add command -label $db \ + -command [list cascade-dblist-select $target $db] + } +} + # Procedure cascade-target-list # Makes all target/databases available in the Target|Connect # menu as well as all targets in the Target|Setup menu. @@ -2760,9 +2883,11 @@ proc save-settings {} { puts $f "# Setup file" foreach n [array names profile] { + puts -nonewline $f "set \{profile($n)\} \{" puts -nonewline $f $profile($n) puts $f "\}" + puts $f {} } puts -nonewline $f "set queryTypes \{" puts -nonewline $f $queryTypes @@ -2815,16 +2940,12 @@ proc alert-action {} { } # Procedure exit-action -# This procedure is called if the user tries to exit without saving the -# system settings. +# This procedure is called if the user exists the application proc exit-action {} { global settingsChanged if {$settingsChanged} { - set a [alert "you haven't saved your settings. Do you wish to save?"] - if {$a} { - save-settings - } + save-settings } save-geometry exit 0 @@ -3423,7 +3544,7 @@ proc query-edit-index {queryNo} { set w .query-setup set i [lindex [$w.top.index.list curselection] 0] - if {$i == ""} { + if {![string length $i]} { return } set attr [lindex $queryInfoTmp $i] @@ -3441,7 +3562,7 @@ proc query-delete-index {queryNo} { set w .query-setup set i [lindex [$w.top.index.list curselection] 0] - if {$i == ""} { + if {![string length $i]} { return } set queryInfoTmp [lreplace $queryInfoTmp $i $i] @@ -3793,7 +3914,7 @@ cascade-target-list # Init: Definition of Service menu. menubutton .top.service -text Service -menu .top.service.m menu .top.service.m -.top.service.m add command -label Database -command {database-select} +.top.service.m add cascade -label Database -menu .top.service.m.dblist .top.service.m add cascade -label Present -menu .top.service.m.present menu .top.service.m.present .top.service.m.present add command -label {10 More} \ @@ -3805,6 +3926,8 @@ menu .top.service.m.present .top.service configure -state disabled +menu .top.service.m.dblist + menubutton .top.rset -text Set -menu .top.rset.m menu .top.rset.m .top.rset.m add command -label Load -command {load-set} @@ -3916,13 +4039,14 @@ pack .mid.search .mid.scan .mid.present .mid.clear -side left \ -fill y -pady 1 # Init: Define record area in main window. -text .data.record -font fixed -height 2 -width 20 -wrap none -borderwidth 0 -relief flat \ - -yscrollcommand [list .data.scroll set] -wrap $textWrap +text .data.record -font fixed -height 2 -width 20 -wrap none -borderwidth 0 \ + -relief flat -yscrollcommand [list .data.scroll set] -wrap $textWrap scrollbar .data.scroll -command [list .data.record yview] if {[tk4]} { .data.record configure -takefocus 0 .data.scroll configure -takefocus 0 } + pack .data.scroll -side right -fill y pack .data.record -expand yes -fill both initBindings @@ -3984,12 +4108,20 @@ if {[catch {ir z39}]} { puts "ok" } +if {[file exists ${libdir}/explain.tcl]} { + source ${libdir}/explain.tcl +} + +if {[file exists ${libdir}/setup.tcl]} { + source ${libdir}/setup.tcl +} + # Init: Uncomment this line if you wan't to enable logging. #z39 logLevel all # Init: If hostid is a valid target, a new connection will be established # immediately. -if {$hostid != "Default"} { +if {[string compare $hostid Default]} { catch {open-target $hostid $hostbase} } diff --git a/clientrc.tcl b/clientrc.tcl index b9e9aed..8a490fd 100644 --- a/clientrc.tcl +++ b/clientrc.tcl @@ -1,18 +1,34 @@ # Setup file -set {profile(Penn)} {{Penn State's Library} 128.118.88.200 210 {} 16384 8192 tcpip CATALOG 1 {} {} Z39 2} -set {profile(DanBib, SR)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 SR 8 {} {} {} {}} -set {profile(AGRICOLA)} {AGRICOLA Tikal.dev.oclc.org 210 {} 50000 30000 tcpip AGRICOLA 1 {} {} Z39 31 2 0 0 4} -set {profile(madison)} {{University of Wisconsin-Madison} z3950.adp.wisc.edu 210 {} 16384 8192 tcpip madison 1 {} {} Z39 22} -set {profile(bibsys)} {{BIBSYS Target (YAZ-based)} z3950.bibsys.no 2100 {} 16384 8192 tcpip BIBSYS 1 {} 1 Z39 27} -set {profile(Default)} {{} {} {210} {} 50000 30000 tcpip {} 1 {} {} {} 33 2 0 0 4} -set {profile(RLG)} {{Research Libraries group} rlg.stanford.edu 210 {} 32768 32768 tcpip {DEM} 1 {} 1 Z39 5} -set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 90000 90000 tcpip Default 1 {} {} Z39 21 {} {} {} {}} -set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 2210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 Z39 6 {} {} {} {}} -set {profile(DanBib)} {{Danish Union Catalogue} ir.dbc.bib.dk 2008 {} 50000 30000 tcpip danbib 1 {} {} Z39 32 2 0 0 4} -set {profile(CARL)} {{CARL systems} z3950.marmot.org 210 {} 32768 32768 tcpip {ADA ASP CMC CNW DUR EAG LEW MST MPL MPS MON PTH PTK SWL VAI PVS COR SUM THR GAR SMG BUD CRM DEL GUN} 1 {} {} Z39 11} -set {profile(CLSI)} {CLSI inet-gw.clsi.us.geac.com 210 {} 16384 8192 tcpip cl_default 1 {} {} Z39 13} -set {profile(AULS)} {{Acadia university} auls.acadiau.ca 210 {} 16384 8192 tcpip AULS 1 {} {} Z39 14} -set {profile(dranet)} {dranet dranet.dra.com 210 {} 16384 16384 tcpip drewdb 1 {} 1 Z39 15} +set {profile(Penn)} {{Penn State's Library} 128.118.88.200 210 {} 16384 8192 tcpip CATALOG 1 {} {} Z39 2 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(DanBib, SR)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 SR 8 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(AGRICOLA)} {AGRICOLA Tikal.dev.oclc.org 210 {} 50000 30000 tcpip AGRICOLA 1 {} {} Z39 31 2 0 0 4 {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(madison)} {{University of Wisconsin-Madison} z3950.adp.wisc.edu 210 {} 16384 8192 tcpip madison 1 {} {} Z39 22 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(bibsys)} {{BIBSYS Target (YAZ-based)} z3950.bibsys.no 2100 {} 16384 8192 tcpip BIBSYS 1 {} 1 Z39 27 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(Default)} {{} {} {210} {} 50000 30000 tcpip {} 1 {} {} Z39 34 2 0 0 4 {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(RLG)} {{Research Libraries group} rlg.stanford.edu 210 {} 32768 32768 tcpip {DEM} 1 {} 1 Z39 5 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(ztest9999)} {{YAZ server on localhost} localhost 9999 {} 50000 30000 tcpip Default {} {} {} Z39 33 2 0 0 4 842607655 842611277 842611107 {} {} {} {} {} {} {} {} {}} + +set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 90000 90000 tcpip {explain books gils netlib ftp z39dbs ahd books books books factbook russian outside-marc} 1 {} {} Z39 21 {} {} {} {} {} 842605350 842605239 {Lucent Technologies Research Server} {} 100 600000 {} {} 0 {Salutations - this is Lucent Technologies experimental Z39.50 server. No guarentees, but free and unlimited access!} {}} + +set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 2210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 Z39 6 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(DanBib)} {{Danish Union Catalogue} ir.dbc.bib.dk 2008 {} 50000 30000 tcpip danbib 1 {} {} Z39 32 2 0 0 4 {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(CARL)} {{CARL systems} z3950.marmot.org 210 {} 32768 32768 tcpip {ADA ASP CMC CNW DUR EAG LEW MST MPL MPS MON PTH PTK SWL VAI PVS COR SUM THR GAR SMG BUD CRM DEL GUN} 1 {} {} Z39 11 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(CLSI)} {CLSI inet-gw.clsi.us.geac.com 210 {} 16384 8192 tcpip cl_default 1 {} {} Z39 13 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(AULS)} {{Acadia university} auls.acadiau.ca 210 {} 16384 8192 tcpip AULS 1 {} {} Z39 14 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + +set {profile(dranet)} {dranet dranet.dra.com 210 {} 16384 16384 tcpip drewdb 1 {} 1 Z39 15 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {}} + set queryTypes {Simple phrase} set queryButtons {{{I 3} {I 0} {I 0}} {{I 0} {I 1} {I 0}}} set queryInfo {{ {Title {1=4}} {Author {1=1}} {Subject {1=21}} {Any {1=1016}} {Query 1=1016 2=102} {Title-rank 1=4 2=102} {Date/time 1=1012} {Title-regular 1=4 2=3 4=2 5=102}} {{Title 1=4 4=1 6=2} {Author 1=1003 4=1 6=2} {ISBN 1=7} {ISSN 1=8} {Year 1=30 4=4 6=2} {Any {}}}} diff --git a/explain.tcl b/explain.tcl new file mode 100644 index 0000000..9c45458 --- /dev/null +++ b/explain.tcl @@ -0,0 +1,143 @@ + +proc explain-search {target zz category finish response fresponse} { + z39 callback [list explain-search-r $target $zz $category $finish \ + $response $fresponse] + ir-set $zz z39 + $zz databaseNames IR-Explain-1 + $zz preferredRecordSyntax explain + $zz search "@attrset exp1 @attr 1=1 $category" +} + +proc explain-search-r {target zz category finish response fresponse} { + global cancelFlag + + apduDump + if {$cancelFlag} { + close-target + return + } + set status [$zz responseStatus] + if {![string compare [lindex $status 0] NSD]} { + $fresponse $target $zz $category $finish + return + } + set cnt [$zz resultCount] + if {$cnt <= 0} { + $fresponse $target $zz $category $finish + return + } + set rr [$zz numberOfRecordsReturned] + set cnt [expr $cnt - $rr] + if {$cnt <= 0} { + $response $target $zz $category $finish + return + } + z39 callback [list $response $target $zz $category $finish] + incr rr + $zz present $rr $cnt +} + +proc explain-check {target finish} { + global profile + + set time [clock seconds] + set etime [lindex $profile($target) 19] + if {[string length $etime]} { + # Check last explain. If 1 day since last explain do explain egain. + # 1 day = 86400 + if {$time > [expr 180 + $etime]} { + explain-start $target $finish + return + } + } else { + # Check last init. If never init or 1 week after do explain anyway. + # 1 week = 604800 + set etime [lindex $profile($target) 18] + if {![string length $etime]} { + explain-start $target $finish + return + } elseif {$time > [expr 604800 + $etime]} { + explain-start $target $finish + return + } + } + eval $finish [list $target] +} + +proc explain-start {target finish} { + show-status Explaining 1 0 + show-message TargetInfo + explain-search $target z39.targetInfo TargetInfo $finish \ + explain-check-1 explain-check-1f +} + +proc explain-check-1f {target zz category finish} { + eval $finish [list $target] +} + +proc explain-check-1 {target zz category finish} { + show-status Explaining 1 0 + show-message DatabaseInfo + explain-search $target z39.databaseInfo DatabaseInfo $finish \ + explain-check-2 explain-check-1f +} + +proc explain-check-2 {target zz category finish} { + global profile settingsChanged + + set trec [z39.targetInfo getExplain 1 targetInfo] + puts "--- targetInfo" + puts $trec + set no 1 + while {1} { + if {[catch {set rec \ + [z39.databaseInfo getExplain $no databaseInfo]}]} break + puts "--- databaseInfo $no" + puts $rec + + lappend dbRecs $rec + set db [lindex [lindex $rec 1] 1] + if {![string length $db]} break + lappend dbList $db + incr no + } + if {[info exists dbList]} { + set profile($target) [lreplace $profile($target) 7 7 $dbList] + set profile($target) [lreplace $profile($target) 25 25 {}] + } + cascade-target-list + + set data [lindex [lindex [lindex [lindex [lindex $trec 12] 1] 1] 1] 1] + if {[string length $data]} { + set profile($target) [lreplace $profile($target) 0 0 $data] + } + + set l [llength $profile($target)] + while {$l < 29} { + lappend profile($target) {} + incr l + } + + set profile($target) [lreplace $profile($target) 8 8 \ + [lindex [lindex $trec 4] 1]] + set profile($target) [lreplace $profile($target) 19 19 \ + [clock seconds]] + set profile($target) [lreplace $profile($target) 20 20 \ + [lindex [lindex $trec 1] 1]] + set profile($target) [lreplace $profile($target) 21 21 \ + [lindex [lindex $trec 2] 1]] + set profile($target) [lreplace $profile($target) 22 22 \ + [lindex [lindex $trec 6] 1]] + set profile($target) [lreplace $profile($target) 23 23 \ + [lindex [lindex $trec 7] 1]] + set profile($target) [lreplace $profile($target) 24 24 \ + [lindex [lindex $trec 8] 1]] + set profile($target) [lreplace $profile($target) 26 26 \ + [lindex [lindex $trec 5] 1]] + set profile($target) [lreplace $profile($target) 27 27 \ + [lindex [lindex [lindex [lindex [lindex $trec 10] 1] 1] 1] 1]] + + set settingsChanged 1 + + eval $finish [list $target] +} diff --git a/setup.tcl b/setup.tcl new file mode 100644 index 0000000..5696cb7 --- /dev/null +++ b/setup.tcl @@ -0,0 +1,495 @@ +# IR toolkit for tcl/tk +# (c) Index Data 1995-1996 +# See the file LICENSE for details. +# Sebastian Hammer, Adam Dickmeiss +# +# $Log: setup.tcl,v $ +# Revision 1.1 1996-09-13 10:54:25 adam +# Started work on Explain in client. +# +# + +set pref(font,h1) {-Adobe-Helvetica-Bold-R-Normal-*-240-*} +set pref(font,h2) {-Adobe-Helvetica-Bold-R-Normal-*-180-*} +set pref(font,h3) {-Adobe-Helvetica-Bold-R-Normal-*-140-*} +set pref(font,h4) {-Adobe-Helvetica-Bold-R-Normal-*-120-*} + +set pref(font,s1) {-Adobe-Helvetica-Bold-R-Normal-*-100-*} +set pref(font,s2) {-Adobe-Helvetica-Bold-R-Normal-*-80-*} + +proc print-date {w msg date} { + frame $w + pack $w -side top -fill x + label $w.a -text $msg + pack $w.a -side left + + if {[string length $date]} { + label $w.b -text [clock format $date -format "%b %d %y %H:%M "] + } else { + label $w.b -text Never + } + pack $w.b -side right +} + +proc entry-fieldsx {width parent list tlist returnAction escapeAction} { + set alist {} + set i 0 + foreach field $list { + set label ${parent}.${field}.label + set entry ${parent}.${field}.entry + label $label -text [lindex $tlist $i] + entry $entry -relief sunken -border 1 -width $width + pack $label -side left + pack $entry -side right + lappend alist $entry + incr i + } + bind-fields $alist $returnAction $escapeAction +} + +proc protocol-setup {target} { + global profileS profile + + set tinfo $profile($target) + + set profileS($target,targetDescription) [lindex $tinfo 0] + set profileS($target,host) [lindex $tinfo 1] + set profileS($target,port) [lindex $tinfo 2] + set profileS($target,idAuthentication) [lindex $tinfo 3] + set profileS($target,targetMRS) [lindex $tinfo 4] + + set profileS($target,targetPMS) [lindex $tinfo 5] + set profileS($target,comstack) [lindex $tinfo 6] + set profileS($target,databases) [lindex $tinfo 7] + set profileS($target,targetResultSets) [lindex $tinfo 8] + set profileS($target,RPN) [lindex $tinfo 9] + set profileS($target,CCL) [lindex $tinfo 10] + + set profileS($target,protocolType) [lindex $tinfo 11] + set profileS($target,wno) [lindex $tinfo 12] + set profileS($target,LSLB) [lindex $tinfo 13] + set profileS($target,SSUB) [lindex $tinfo 14] + + set profileS($target,MSPN) [lindex $tinfo 15] + set profileS($target,PresentChunk) [lindex $tinfo 16] + set profileS($target,timeDefine) [lindex $tinfo 17] + set profileS($target,timeInit) [lindex $tinfo 18] + set profileS($target,timeExplain) [lindex $tinfo 19] + + set profileS($target,targetName) [lindex $tinfo 20] + set profileS($target,targetRecentNews) [lindex $tinfo 21] + set profileS($target,targetMaxResultSets) [lindex $tinfo 22] + set profileS($target,targetMaxResultSize) [lindex $tinfo 23] + set profileS($target,targetMaxTerms) [lindex $tinfo 24] + + set profileS($target,spare) [lindex $tinfo 25] + set profileS($target,targetMultipleDatabases) [lindex $tinfo 26] + set profileS($target,targetWelcome) [lindex $tinfo 27] + + target-setup $target 0 0 +} + +proc protocol-setup-action {target} { + global profileS profile settingsChanged + + set timedef $profileS($target,timeDefine) + if {![string length $timedef]} { + set timedef [clock seconds] + } + set profile($target) [list \ + $profileS($target,targetDescription) \ + $profileS($target,host) \ + $profileS($target,port) \ + $profileS($target,idAuthentication) \ + $profileS($target,targetMRS) \ + $profileS($target,targetPMS) \ + $profileS($target,comstack) \ + $profileS($target,databases) \ + $profileS($target,targetResultSets) \ + $profileS($target,RPN) \ + $profileS($target,CCL) \ + $profileS($target,protocolType) \ + $profileS($target,wno) \ + $profileS($target,LSLB) \ + $profileS($target,SSUB) \ + $profileS($target,MSPN) \ + $profileS($target,PresentChunk) \ + $profileS($target,timeDefine) \ + $profileS($target,timeInit) \ + $profileS($target,timeExplain) \ + $profileS($target,targetName) \ + $profileS($target,targetRecentNews) \ + $profileS($target,targetMaxResultSets) \ + $profileS($target,targetMaxResultSize) \ + $profileS($target,targetMaxTerms) \ + $profileS($target,spare) \ + $profileS($target,targetMultipleDatabases) \ + $profileS($target,targetWelcome) \ + ] + + set settingsChanged 1 + + cascade-target-list + delete-target-hotlist $target +} + +proc target-setup {target category dir} { + + set w .setup100 + if {$dir} { + target-setup-leave-$category $target + } + if {$dir == 2} { + protocol-setup-action $target + destroy $w + return + } + incr category $dir + if {[winfo exists $w]} { + destroy $w.top + destroy $w.bot + } else { + toplevel $w + wm geometry $w 430x400 + } + if {$target == ""} { + set target Default + } + top-down-window $w + bottom-buttons $w [list \ + {Ok} [list target-setup $target $category 2] \ + {Previous} [list target-setup $target $category -1] \ + {Next} [list target-setup $target $category 1] \ + {Cancel} [list destroy $w]] 0 + if {$category == 0} { + $w.bot.2 configure -state disabled + } + if {$category == 2} { + $w.bot.4 configure -state disabled + } + target-setup-enter-$category $target +} + + +proc target-setup-leave-0 {target} { + global profileS + + set w .setup100 + set y $w.top.hostport + + set profileS($target,host) [$y.host.entry get] + set profileS($target,port) [$y.port.entry get] + set profileS($target,idAuthentication) [$y.idAuthentication.entry get] +} + +proc target-setup-enter-0 {target} { + global profileS + + set w .setup100 + + wm title $w "$target - Initial Information" + + # host/port/id . . . + set y $w.top.hostport + frame $y -relief ridge -border 2 + pack $y -padx 2 -pady 2 -side top -fill x + frame $y.host + frame $y.port + frame $y.idAuthentication + + pack $y.host $y.port $y.idAuthentication -side top -fill x -pady 2 + + entry-fieldsx 34 $y \ + {host port idAuthentication} \ + {{Host:} {Port:} {Id Authentication:}} \ + [list target-setup $target 0 2] [list destroy $w] + + $y.host.entry insert 0 $profileS($target,host) + $y.port.entry insert 0 $profileS($target,port) + $y.idAuthentication.entry insert 0 $profileS($target,idAuthentication) + + # bottom + + set y $w.top.bottom + + frame $y + pack $y -side bottom -fill both -expand yes + + # misc. dates . . . + + set y $w.top.dates + frame $y -relief ridge -border 2 + pack $y -pady 2 -padx 2 -side left -fill both -expand yes + + label $y.label -text "Dates" + pack $y.label -side top -fill x + print-date $w.top.dates.a {Defined:} $profileS($target,timeDefine) + print-date $w.top.dates.b {Last Access:} $profileS($target,timeInit) + print-date $w.top.dates.c {Last Explain:} $profileS($target,timeExplain) + + # protocol . . . + + set y $w.top.protocol + + frame $y -relief ridge -border 2 + pack $y -pady 2 -padx 2 -side right -fill both + + label $y.label -text "Protocol" + radiobutton $y.z39v2 -text "Z39.50" -anchor w \ + -variable profileS($target,protocolType) -value Z39 + radiobutton $y.sr -text "SR" -anchor w \ + -variable profileS($target,protocolType) -value SR + + pack $y.label $y.z39v2 $y.sr -padx 2 -side top -fill x + + # transport/comstack . . . + + set y $w.top.comstack + frame $y -relief ridge -border 2 + + pack $y -pady 2 -padx 2 -side right -fill both + + label $y.label -text "Transport" + radiobutton $y.tcpip -text "TCP/IP" -anchor w \ + -variable profileS($target,comstack) -value tcpip + radiobutton $y.mosi -text "MOSI" -anchor w\ + -variable profileS($target,comstack) -value mosi + pack $y.label $y.tcpip $y.mosi -padx 2 -side top -fill x +} + +proc target-setup-leave-1 {target} { + global profileS + + set w .setup100 + set y $w.top.nr + + set profileS($target,targetName) [$y.name.text get 0.0 end] + set profileS($target,targetRecentNews) [$y.recentNews.text get 0.0 end] + set profileS($target,targetDescription) [$y.description.text get 0.0 end] + + set y $w.top.rs + + set profileS($target,targetMaxResultSets) [$y.maxResultSets.entry get] + set profileS($target,targetMaxResultSize) [$y.maxResultSize.entry get] + set profileS($target,targetMaxTerms) [$y.maxTerms.entry get] +} + +proc target-setup-enter-1 {target} { + global profileS + + set w .setup100 + + wm title $w "$target - Target Information" + + # Name, Recent News . . . + set y $w.top.nr + frame $y -relief ridge -border 2 + pack $y -side top -padx 2 -pady 2 -fill x + + frame $y.name + frame $y.recentNews + frame $y.description + frame $y.welcome + + pack $y.name $y.recentNews $y.description $y.welcome \ + -side top -fill x -pady 2 -expand yes + + label $y.name.label -text "Name" -width 15 + pack $y.name.label -side left + text $y.name.text -width 40 -height 2 -relief sunken -border 1 \ + -wrap word + TextEditable $y.name.text + $y.name.text insert end $profileS($target,targetName) + pack $y.name.text -side right -fill x -expand yes + + label $y.recentNews.label -text "Recent News" -width 15 + pack $y.recentNews.label -side left + text $y.recentNews.text -width 40 -height 2 -relief sunken -border 1 \ + -wrap word + TextEditable $y.recentNews.text + $y.recentNews.text insert end $profileS($target,targetRecentNews) + pack $y.recentNews.text -side right -fill x -expand yes + + label $y.description.label -text "Description" -width 15 + pack $y.description.label -side left + text $y.description.text -width 40 -height 4 -relief sunken -border 1 \ + -wrap word + TextEditable $y.description.text + $y.description.text insert end $profileS($target,targetDescription) + pack $y.description.text -side right -fill x -expand yes + + label $y.welcome.label -text "Welcome Message" -width 15 + pack $y.welcome.label -side left + text $y.welcome.text -width 40 -height 4 -relief sunken -border 1 \ + -wrap word + TextEditable $y.welcome.text + $y.welcome.text insert end $profileS($target,targetWelcome) + pack $y.welcome.text -side right -fill x -expand yes + + # Result Sets Size, numbers, etc. . . . + set y $w.top.rs + + frame $y -relief ridge -border 2 + pack $y -side left -padx 2 -pady 2 -fill y + + frame $y.maxResultSets + frame $y.maxResultSize + frame $y.maxTerms + + pack $y.maxResultSets $y.maxResultSize $y.maxTerms \ + -side top -fill x -pady 2 + + entry-fieldsx 10 $y \ + {maxResultSets maxResultSize maxTerms} \ + {{Max Result Sets:} {Max Result Size:} {Max Terms:}} \ + [list target-setup $target 1 2] [list destroy $w] + + $y.maxResultSets.entry insert 0 $profileS($target,targetMaxResultSets) + $y.maxResultSize.entry insert 0 $profileS($target,targetMaxResultSize) + $y.maxTerms.entry insert 0 $profileS($target,targetMaxTerms) + + # Checkbuttons . . . + set y $w.top.ns + + frame $y -relief ridge -border 2 + pack $y -side right -padx 2 -pady 2 -fill both -expand yes + + checkbutton $y.resultSets -text "Named Result Sets" \ + -anchor n -variable profileS($target,targetResultSets) + + checkbutton $y.multipleDatabases -text "Multiple Database Search" \ + -anchor n -variable profileS($target,targetMultipleDatabases) + + pack $y.resultSets $y.multipleDatabases -side top -padx 2 -pady 2 + +} + +proc target-setup-2-dbselect {menu e} { + $menu configure -text $e +} + +proc target-setup-leave-2 {target} { + global profileS +} + +proc target-setup-db-add {target wp} { + set w .database-select + toplevel $w + set oldFocus [focus] + + place-force $w $wp + + top-down-window $w + + frame $w.top.database + + pack $w.top.database -side top -anchor e -pady 2 + + entry-fields $w.top {database} \ + {{Database to add:}} \ + [list target-setup-db-add-action $target $wp] \ + [list destroy $w] + + top-down-ok-cancel $w [list target-setup-db-add-action $target $wp] 1 + focus $oldFocus +} + +proc target-setup-db-add-action {target wp} { + global profileS + + set w .database-select + + set db [$w.top.database.entry get] + if {![string length [lindex $profileS($target,databases) 0]]} { + set profileS($target,databases) $db + } else { + lappend profileS($target,databases) $db + } + destroy $w + target-setup-dblist-update $target +} + +proc target-setup-db-remove {target wp} { + global profileS + + set w .setup100 + set y $w.top.name + + set db [$y.data cget -text] + set a [alert "Are you sure you want to remove the database ${db}?"] + if {$a} { + set i [lsearch -exact $profileS($target,databases) $db] + if {$i >= 0} { + set profileS($target,databases) \ + [lreplace $profileS($target,databases) $i $i] + } + target-setup-dblist-update $target + } +} + +proc target-setup-dblist-update {target} { + global profileS + + set w .setup100 + set y $w.top.name + + set no 0 + set databaseList $profileS($target,databases) + $y.data configure -text [lindex $databaseList 0] + $y.data.m delete 0 100 + foreach d $databaseList { + $y.data.m add command -label $d -command \ + [list target-setup-2-dbselect $y.data $d] + incr no + } + if {$no == 0} { + $y.remove configure -state disabled + } else { + $y.remove configure -state normal + } +} + +proc target-setup-enter-2 {target} { + global profileS + + set w .setup100 + + set databaseList $profileS($target,databases) + + wm title $w "$target - Database Information" + + frame $w.top.name -border 2 + pack $w.top.name -pady 2 -padx 2 -side top -fill x + + label $w.top.name.label -text "Database Name" + + pack $w.top.name.label -side left + menubutton $w.top.name.data -menu $w.top.name.data.m -relief raised + menu $w.top.name.data.m + + pack $w.top.name.data -side left + + button $w.top.name.add -text "Add" -command \ + [list target-setup-db-add $target $w] + pack $w.top.name.add -side right + + button $w.top.name.remove -text "Remove" -command \ + [list target-setup-db-remove $target $w] + pack $w.top.name.remove -side right + + frame $w.top.data -relief ridge -border 2 + pack $w.top.data -pady 2 -padx 2 -side top -fill x + + target-setup-dblist-update $target + + frame $w.top.data.avRecordSize + frame $w.top.data.maxRecordSize + + pack $w.top.data $w.top.data.avRecordSize $w.top.data.maxRecordSize \ + -side top -fill x -pady 2 + + entry-fieldsx 14 $w.top.data \ + {avRecordSize maxRecordSize} \ + {{Average Record Size:} {Max Record Size:}} \ + [list target-setup $target 2 2] [list destroy $w] +}