From: Adam Dickmeiss Date: Mon, 19 Jun 1995 13:06:05 +0000 (+0000) Subject: New define: IR_TCL_VERSION. X-Git-Tag: IRTCL.1.4~264 X-Git-Url: http://jsfdemo.indexdata.com/cgi-bin?a=commitdiff_plain;h=a78acc150da77d8c6ef548642dc29622427687a0;p=ir-tcl-moved-to-github.git New define: IR_TCL_VERSION. --- diff --git a/README b/README index 6ec9e8a..761784a 100644 --- a/README +++ b/README @@ -3,10 +3,12 @@ * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss -$Revision: 1.3 $ +$Revision: 1.4 $ -Compilation and installation of IrTcl. -This is a very early alpha-release of IrTcl. +Quick notes about IrTcl. + +Prerequisites +------------- In order to compile you need: @@ -19,32 +21,52 @@ You may also need: o Tk version 3.6 o The XTI/mosi package -Compilation: - 1) Compile/install yaz/tcl, etc. +Compilation +----------- + + Compile/install yaz/tcl, etc. - 2) Edit Makefile (in current directory) - Set MOSI to 1/0 - Define include directory paths of yaz/tcl/tk - Define libraries of yaz/tcl/tk + Edit Makefile (in current directory) + Set MOSI to 1/0 + Define include directory paths and libraries - 3) Type 'make ir-tcl' to make the Tcl version or IrTcl. - Type 'make ir-tk' to make the Tk version of IrTcl. + Type 'make ir-tcl' to make the Tcl version or IrTcl. + Type 'make ir-tk' to make the Tk version of IrTcl. -Install/run: +Install/run +----------- - 4) The resulting files are: - ir-tcl Tcl version of IrTcl - ir-tk Tk version of IrTcl - marc.tcl/iterate.tcl small IrTcl scripts - client.tcl Tk graphical client - automatically - executed by ir-tk - clientrc.tcl Startup script - read by client.tcl - holds - user/target definitions. - book[1-9] Logo - when busy. + The resulting files are: + ir-tcl Tcl version of IrTcl + ir-tk Tk version of IrTcl. + Options: + -file + Tcl startup script. Default is client.tcl. + -geometry + X11 geometry of main window. + -display + X11 display. + -name + Name of top window. + -logLevel + log level. (fatal, debug, warn, log, all). + -logFile + log file. If omitted stderr is used. + formats/*.tcl Small IrTcl scripts to display + records in different formats. + client.tcl Tk graphical client - normally + executed by ir-tk. + clientrc.tcl Startup script - read by client.tcl - holds + user/target definitions. + clientg.tcl User preferrences - read by client.tcl. + Holds geometry of windows, current display + format, and hot targets. + book[1-9] book logo. + LICENSE License info - read by client.tcl. - 5) Type 'ir-tk' to run the Tk graphical client (client.tcl and - clientrc.tcl should be in current directory) + Type 'ir-tk' to run the Tk graphical client - client.tcl, + clientrc.tcl, book[1-9] and formats/*.tcl should exist! - Type 'ir-tcl' to run the Tcl client. Very similar to tclsh. + Type 'ir-tcl' to run the Tcl client. Very similar to tclsh. diff --git a/client.tcl b/client.tcl index 977b3d5..d6e3c33 100644 --- a/client.tcl +++ b/client.tcl @@ -4,7 +4,10 @@ # Sebastian Hammer, Adam Dickmeiss # # $Log: client.tcl,v $ -# Revision 1.45 1995-06-19 08:08:44 adam +# Revision 1.46 1995-06-19 13:06:06 adam +# New define: IR_TCL_VERSION. +# +# Revision 1.45 1995/06/19 08:08:44 adam # client.tcl: hotTargets now contain both database and target name. # ir-tcl.c: setting protocol edited. Errors in callbacks are logged # by logf(LOG_WARN, ...) calls. @@ -203,6 +206,10 @@ proc set-wrap {m} { .data.record configure -wrap $m } +proc dputs {m} { +# puts $m +} + proc set-display-format {f} { global displayFormat global setNo @@ -363,7 +370,7 @@ proc show-logo {v1} { set v1 1 } .bot.logo configure -bitmap @book${v1} - after 120 [list show-logo $v1] + after 140 [list show-logo $v1] return } while {1} { @@ -382,6 +389,7 @@ proc show-status {status b sb} { global scanEnable global setOffset global setMax + global setNo .bot.a.status configure -text "$status" if {$b == 1} { @@ -398,7 +406,9 @@ proc show-status {status b sb} { if {$scanEnable} { .mid.scan configure -state normal } - if {$setOffset > 0 && $setOffset <= $setMax} { + if {$setNo == 0} { + .top.service.m disable 1 + } elseif {$setOffset > 0 && $setOffset <= [z39.$setNo resultCount]} { .top.service.m enable 1 .mid.present configure -state normal } else { @@ -507,7 +517,7 @@ proc about-origin-logo {n} { set n 1 } $w.top.a.logo configure -bitmap @book$n - after 120 [list about-origin-logo $n] + after 140 [list about-origin-logo $n] } proc about-origin {} { @@ -694,7 +704,7 @@ proc define-target-action {} { } } set seq [lindex $profile(Default) 12] - puts "seq=${seq}" + dputs "seq=${seq}" set profile($target) $profile(Default) set profile(Default) [lreplace $profile(Default) 12 12 [incr seq]] @@ -708,7 +718,7 @@ proc fail-response {target} { } proc connect-response {target base} { - puts "connect-response" + dputs "connect-response" show-target $target $base init-request } @@ -723,10 +733,10 @@ proc open-target {target base} { z39 idAuthentication [lindex $profile($target) 3] z39 maximumRecordSize [lindex $profile($target) 4] z39 preferredMessageSize [lindex $profile($target) 5] - puts -nonewline "maximumRecordSize=" - puts [z39 maximumRecordSize] - puts -nonewline "preferredMessageSize=" - puts [z39 preferredMessageSize] + dputs "maximumRecordSize=" + dputs [z39 maximumRecordSize] + dputs "preferredMessageSize=" + dputs [z39 preferredMessageSize] show-status {Connecting} 1 0 if {$base == ""} { z39 databaseNames [lindex [lindex $profile($target) 7] 0] @@ -735,6 +745,7 @@ proc open-target {target base} { } z39 failback [list fail-response $target] z39 callback [list connect-response $target $base] + update idletasks set err [catch { z39 connect [lindex $profile($target) 1]:[lindex $profile($target) 2] } errorMessage] @@ -821,7 +832,11 @@ proc init-request {} { } z39 callback {init-response} show-status {Initializing} 1 {} - z39 init + set err [catch {z39 init} errorMessage] + if {$err} { + tkerror $errorMessage + show-status Ready 0 {} + } } proc init-response {} { @@ -870,10 +885,10 @@ proc search-request {} { if {[lindex $profile($target) 10] == 1} { z39.$setNo setName $setNo - puts "setName=${setNo}" + dputs "setName=${setNo}" } else { z39.$setNo setName Default - puts "setName=Default" + dputs "setName=Default" } if {[lindex $profile($target) 8] == 1} { z39.$setNo queryType rpn @@ -889,7 +904,7 @@ proc search-request {} { proc scan-copy {y entry} { set w .scan-window set no [$w.top.list nearest $y] - puts "no=$no" + dputs "no=$no" .lines.$entry.e delete 0 end .lines.$entry.e insert 0 [string range [$w.top.list get $no] 8 end] } @@ -972,7 +987,7 @@ proc scan-term-h {attr} { z39 callback [list scan-response $attr 0 35] z39.scan numberOfTermsRequested 5 z39.scan preferredPositionInResponse 1 - puts "${attr} \{${scanTerm}\}" + dputs "${attr} \{${scanTerm}\}" if {$scanTerm == ""} { z39.scan scan "${attr} 0" } else { @@ -987,12 +1002,12 @@ proc scan-response {attr start toget} { global scanView set w .scan-window - puts "In scan-response" + dputs "In scan-response" set m [z39.scan numberOfEntriesReturned] - puts $m - puts attr=$attr - puts start=$start - puts toget=$toget + dputs $m + dputs attr=$attr + dputs start=$start + dputs toget=$toget if {![winfo exists .scan-window]} { show-status {Ready} 0 1 @@ -1005,7 +1020,7 @@ proc scan-response {attr start toget} { z39.scan numberOfTermsRequested 5 z39.scan preferredPositionInResponse 1 set scanTerm $nScanTerm - puts "${attr} \{${scanTerm}\}" + dputs "${attr} \{${scanTerm}\}" if {$scanTerm == ""} { z39.scan scan "${attr} 0" } else { @@ -1044,26 +1059,26 @@ proc scan-response {attr start toget} { } if {$toget > 0 && $m > 1 && $m < $toget} { set ntoget [expr $toget - $m + 1] - puts ntoget=$ntoget + dputs ntoget=$ntoget z39 callback [list scan-response $attr [expr $start + $m - 1] $ntoget] set q $term - puts "down continue: $q" + dputs "down continue: $q" if {$ntoget > 10} { z39.scan numberOfTermsRequested 10 } else { z39.scan numberOfTermsRequested $ntoget } z39.scan preferredPositionInResponse 1 - puts "${attr} \{$q\}" + dputs "${attr} \{$q\}" z39.scan scan "${attr} \{$q\}" return } if {$toget < 0 && $m > 1 && $m < [expr - $toget]} { set ntoget [expr - $toget - $m] - puts ntoget=$ntoget + dputs ntoget=$ntoget z39 callback [list scan-response $attr 0 -$ntoget] set q [string range [$w.top.list get 0] 8 end] - puts "up continue: $q" + dputs "up continue: $q" if {$ntoget > 10} { z39.scan numberOfTermsRequested 10 z39.scan preferredPositionInResponse 11 @@ -1071,7 +1086,7 @@ proc scan-response {attr start toget} { z39.scan numberOfTermsRequested $ntoget z39.scan preferredPositionInResponse [incr ntoget] } - puts "${attr} \{$q\}" + dputs "${attr} \{$q\}" z39.scan scan "${attr} \{$q\}" return } @@ -1087,11 +1102,11 @@ proc scan-down {attr} { if {$scanView > $s} { z39 callback [list scan-response $attr [expr $s - 1] 25] set q [string range [$w.top.list get [expr $s - 1]] 8 end] - puts "down: $q" + dputs "down: $q" z39.scan numberOfTermsRequested 10 z39.scan preferredPositionInResponse 1 show-status {Scanning} 1 0 - puts "${attr} \{$q\}" + dputs "${attr} \{$q\}" z39.scan scan "${attr} \{$q\}" return } @@ -1106,7 +1121,7 @@ proc scan-up {attr} { if {$scanView < 0} { z39 callback [list scan-response $attr 0 -25] set q [string range [$w.top.list get 0] 8 end] - puts "up: $q" + dputs "up: $q" z39.scan numberOfTermsRequested 10 z39.scan preferredPositionInResponse 11 show-status {Scanning} 1 0 @@ -1123,7 +1138,7 @@ proc search-response {} { global cancelFlag global busy - puts "In search-response" + dputs "In search-response" init-title-lines set setMax [z39.$setNo resultCount] show-message "${setMax} hits" @@ -1160,16 +1175,16 @@ proc present-more {number} { global setOffset global setMax - puts "setOffset=$setOffset" - puts "present-more" + dputs "setOffset=$setOffset" + dputs "present-more" if {$setNo == 0} { - puts "setNo=$setNo" + dputs "setNo=$setNo" return } set max [z39.$setNo resultCount] if {$max <= $setOffset} { - puts "max=$max" - puts "setOffset=$setOffset" + dputs "max=$max" + dputs "setOffset=$setOffset" return } if {$number == ""} { @@ -1240,9 +1255,9 @@ proc present-response {} { global setMax global cancelFlag - puts "In present-response" + dputs "In present-response" set no [z39.$setNo numberOfRecordsReturned] - puts "Returned $no records, setOffset $setOffset" + dputs "Returned $no records, setOffset $setOffset" add-title-lines $setNo $no $setOffset set setOffset [expr $setOffset + $no] set status [z39.$setNo responseStatus] @@ -1260,7 +1275,7 @@ proc present-response {} { return } if {$no > 0 && $setOffset <= $setMax} { - puts "present-request from ${setOffset}" + dputs "present-request from ${setOffset}" set toGet [expr $setMax - $setOffset + 1] if {$toGet > 3} { set toGet 3 @@ -1382,7 +1397,7 @@ proc protocol-setup-action {target} { $wno] cascade-target-list - puts $profile($target) + dputs $profile($target) destroy $w } @@ -1472,8 +1487,8 @@ proc protocol-setup {target} { if {$target == ""} { set target Default } - puts target - puts $profile($target) + dputs target + dputs $profile($target) frame $w.top.host frame $w.top.port @@ -1499,7 +1514,7 @@ proc protocol-setup {target} { foreach sub {description host port idAuthentication \ maximumRecordSize preferredMessageSize} { - puts $sub + dputs $sub bind $w.top.$sub.entry [list add-database $target] bind $w.top.$sub.entry [list delete-database $target] } @@ -1548,9 +1563,9 @@ proc protocol-setup {target} { label $w.top.cs-type.label -text "Transport" radiobutton $w.top.cs-type.tcpip -text "TCP/IP" -anchor w \ - -command {puts tcp/ip} -variable csRadioType -value tcpip + -variable csRadioType -value tcpip radiobutton $w.top.cs-type.mosi -text "MOSI" -anchor w\ - -command {puts mosi} -variable csRadioType -value mosi + -variable csRadioType -value mosi pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \ -padx 4 -side top -fill x @@ -1560,9 +1575,9 @@ proc protocol-setup {target} { label $w.top.protocol.label -text "Protocol" radiobutton $w.top.protocol.z39v2 -text "Z39.50" -anchor w \ - -command {puts Z39} -variable protocolRadioType -value Z39 + -variable protocolRadioType -value Z39 radiobutton $w.top.protocol.sr -text "SR" -anchor w \ - -command {puts sr} -variable protocolRadioType -value SR + -variable protocolRadioType -value SR pack $w.top.protocol.label $w.top.protocol.z39v2 $w.top.protocol.sr \ -padx 4 -side top -fill x @@ -2009,7 +2024,7 @@ proc activate-e-index {value no i} { global queryIndexTmp set queryButtonsTmp [lreplace $queryButtonsTmp $no $no [list I $i]] - puts $queryButtonsTmp + dputs $queryButtonsTmp set queryIndexTmp $i } @@ -2018,7 +2033,7 @@ proc activate-index {value no i} { set queryButtonsFind [lreplace $queryButtonsFind $no $no [list I $i]] - puts "queryButtonsFind $queryButtonsFind" + dputs "queryButtonsFind $queryButtonsFind" } proc update-attr {} { @@ -2169,7 +2184,7 @@ proc use-attr {init} { set lno [lindex [$w.top.use.list curselection] 0] set i [expr $lno+$lno+1] set useTmpValue [lindex $attr $i] - puts "useTmpValue=$useTmpValue" + dputs "useTmpValue=$useTmpValue" } } @@ -2186,9 +2201,9 @@ proc index-setup-action {oldAttr queryNo indexNo} { use-attr 0 - puts "index-setup-action" - puts "queryNo $queryNo" - puts "indexNo $indexNo" + dputs "index-setup-action" + dputs "queryNo $queryNo" + dputs "indexNo $indexNo" if {$useTmpValue > 0} { lappend attr "1=$useTmpValue" } @@ -2207,7 +2222,7 @@ proc index-setup-action {oldAttr queryNo indexNo} { if {$completenessTmpValue > 0} { lappend attr "6=$completenessTmpValue" } - puts "new attr $attr" + dputs "new attr $attr" set queryInfoTmp [lreplace $queryInfoTmp $indexNo $indexNo $attr] destroy .index-setup } @@ -2339,7 +2354,7 @@ proc query-edit-index {queryNo} { return } set attr [lindex $queryInfoTmp $i] - puts "Editing no $i $attr" + dputs "Editing no $i $attr" index-setup $attr $queryNo $i } @@ -2476,7 +2491,7 @@ proc index-query {} { } incr i } - puts "qs= $qs" + dputs "qs= $qs" return $qs } diff --git a/clientrc.tcl b/clientrc.tcl index a9e19ee..5e2f9eb 100644 --- a/clientrc.tcl +++ b/clientrc.tcl @@ -7,14 +7,14 @@ set {profile(Nsrtest)} {{NSR in house.} localhost 4500 {} 16384 8192 mosi x 1 {} set {profile(Default)} {{} {} {210} {} 16384 8192 tcpip {} {} {} {} {} 24} set {profile(RLG)} {{Research Libraries group} rlg.stanford.edu 210 {} 4096 4096 tcpip {BKS AMC MAPS MDF REC SCO SER VIM NAF SAF AUT CATALOG ABI AVI DSA EIP FLP HAP HST NPA PAI PRA WLI} 1 {} {} Z39 5} set {profile(AT&T server)} {{AT&T Z39 Server} z3950.research.att.com 210 {} 16384 8192 tcpip Default {} {} {} Z39 21} -set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 Z39 6} +set {profile(LOC)} {{Library of Congress} IBM2.LOC.gov 2210 {} 16384 16384 tcpip {BOOKS NAMES} 1 {} 0 Z39 6} set {profile(IREG)} {{Internet Resource} frost.notis.com 210 {} 16384 8192 tcpip {IREG ERIC} 1 {} {} Z39 7} set {profile(DANBIB)} {{SR Target DANBIB} 0103/find2.denet.dk 4500 {} 8192 8192 mosi danbib 1 {} 1 SR 8} set {profile(OCLC)} {{OCLC First search engine} z3950.oclc.org 210 {} 16384 8192 tcpip {ArticleFirst BiographyIndex BusinessPeriodicalsIndex} 1 {} {} Z39 9} -set {profile(CARL)} {{CARL systems} Z39.50.carl.org 210 {} 16384 8192 tcpip {ACC AIC AUR BEM CUB DPL DNU EPL FRC LAW LCC MCC MIN MPL NJC NWC OCC PPC PUE RDR RGU SPL TCC TKU UNC WYO} 1 {} {} Z39 11} set {profile(Aleph)} {{Aleph at ram10.aleph.co.il:5555} localhost 9998 {} 16384 4096 tcpip {dem mar} 1 0 1 Z39 10} -set {profile(CLSI)} {CLSI inet-gw.clsi.uc.geac.com 210 {} 16384 8192 tcpip Cl 1 {} {} Z39 13} +set {profile(CARL)} {{CARL systems} Z39.50.carl.org 210 {} 16384 8192 tcpip {ACC AIC AUR BEM CUB DPL DNU EPL FRC LAW LCC MCC MIN MPL NJC NWC OCC PPC PUE RDR RGU SPL TCC TKU UNC WYO} 1 {} {} Z39 11} set {profile(Innovative)} {{Innovatives server: demo.iii.com} demo.iii.com 210 {} 16384 8192 tcpip DEFAULT 1 {} {} Z39 12} +set {profile(CLSI)} {CLSI inet-gw.clsi.uc.geac.com 210 {} 16384 8192 tcpip Cl 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 {} {} Z39 15} set queryTypes {Simple aaaaaaa phrase} diff --git a/ir-tcl.c b/ir-tcl.c index 942ad55..f49c97b 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -5,7 +5,10 @@ * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.42 1995-06-19 08:08:52 adam + * Revision 1.43 1995-06-19 13:06:08 adam + * New define: IR_TCL_VERSION. + * + * Revision 1.42 1995/06/19 08:08:52 adam * client.tcl: hotTargets now contain both database and target name. * ir-tcl.c: setting protocol edited. Errors in callbacks are logged * by logf(LOG_WARN, ...) calls. @@ -573,13 +576,8 @@ static int do_init_request (void *obj, Tcl_Interp *interp, static int do_protocolVersion (void *obj, Tcl_Interp *interp, int argc, char **argv) { - static struct ir_named_entry version_tab[] = { - { "1", 0 }, - { "2", 1 }, - { "3", 2 }, - { "4", 3 }, - { NULL,0} - }; + int version, i; + char buf[10]; IrTcl_Obj *p = obj; if (argc <= 0) @@ -589,8 +587,20 @@ static int do_protocolVersion (void *obj, Tcl_Interp *interp, ODR_MASK_SET (&p->protocolVersion, 1); return TCL_OK; } - return ir_named_bits (version_tab, &p->protocolVersion, - interp, argc-2, argv+2); + if (argc == 3) + { + if (Tcl_GetInt (interp, argv[2], &version)==TCL_ERROR) + return TCL_ERROR; + ODR_MASK_ZERO (&p->protocolVersion); + for (i = 0; iprotocolVersion, i); + } + for (i = 4; --i >= 0; ) + if (ODR_MASK_GET (&p->protocolVersion, i)) + break; + sprintf (buf, "%d", i+1); + interp->result = buf; + return TCL_OK; } /* @@ -725,7 +735,8 @@ static int do_implementationVersion (void *obj, Tcl_Interp *interp, IrTcl_Obj *p = obj; if (argc == 0) - return ir_strdup (interp, &p->implementationVersion, YAZ_VERSION); + return ir_strdup (interp, &p->implementationVersion, + "YAZ: " YAZ_VERSION " / IrTcl: " IR_TCL_VERSION); else if (argc == -1) return ir_strdel (interp, &p->implementationVersion); Tcl_AppendResult (interp, p->implementationVersion, (char*) NULL); @@ -954,6 +965,10 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, ODR_MASK_SET (&p->options, 1); ODR_MASK_SET (&p->options, 7); ODR_MASK_SET (&p->options, 14); + + ODR_MASK_ZERO (&p->protocolVersion); + ODR_MASK_SET (&p->protocolVersion, 0); + ODR_MASK_SET (&p->protocolVersion, 1); } assert (!p->cs_link); return TCL_OK; @@ -2787,7 +2802,10 @@ void ir_select_read (ClientData clientData) { r = cs_rcvconnect (p->cs_link); if (r == 1) + { + logf (LOG_WARN, "cs_rcvconnect returned 1"); return; + } p->connectFlag = 0; ir_select_remove_write (cs_fileno (p->cs_link), p); if (r < 0) diff --git a/ir-tcl.h b/ir-tcl.h index b89a437..f74bb2a 100644 --- a/ir-tcl.h +++ b/ir-tcl.h @@ -23,12 +23,11 @@ * LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE * OF THIS SOFTWARE. * - * IR toolkit for tcl/tk - * (c) Index Data 1995 - * Sebastian Hammer, Adam Dickmeiss - * * $Log: ir-tcl.h,v $ - * Revision 1.7 1995-05-29 08:44:23 adam + * Revision 1.8 1995-06-19 13:06:08 adam + * New define: IR_TCL_VERSION. + * + * Revision 1.7 1995/05/29 08:44:23 adam * Work on delete of objects. * * Revision 1.6 1995/05/23 15:34:49 adam @@ -50,6 +49,8 @@ #ifndef IR_TCL_H #define IR_TCL_H +#define IR_TCL_VERSION "0.1" + int ir_tcl_init (Tcl_Interp *interp); void ir_select_add (int fd, void *obj);