upgrade xpa

1 files changed, 0 insertions, 261 deletions

diff --git a/xpa/test.tcl b/xpa/test.tcl
deleted file mode 100644
index bfc413c..0000000
--- a/xpa/test.tcl
+++ /dev/null
@@ -1,261 +0,0 @@
-lappend auto_path .
-
-package require tclxpa 2.1
-
-# set rmode "fillbuf=false"
-set rmode ""
-set imode ""
-
-set smode ""
-set sbuf "initial message\n"
-set slen  [string length $sbuf]
-set schan ""
-
-set n 0
-
-proc DoIt {xpa cdata param buf len} {
-    puts [format "entering %s" $cdata]
-    tk_messageBox -parent . -type ok -message "$cdata"
-    puts [format "exiting  %s" $cdata]
-}
-
-proc reccb { xpa client_data paramlist buf len }\
-{
-  global sbuf slen rmode n
-  global sfile sfilebuf schan
-  puts " "
-  puts [format "Entering receive callback routine %s" $n]
-  puts [format "xpa class: %s" [xparec $xpa class]]
-  puts [format "xpa name: %s" [xparec $xpa name]]
-  puts [format "xpa method: %s" [xparec $xpa method]]
-  puts [format "xpa cmdfd: %s" [xparec $xpa cmdfd]]
-  puts [format "xpa cmdchan: %s" [xparec $xpa cmdchan]]
-  puts [format "xpa datafd: %s" [xparec $xpa datafd]]
-  puts [format "xpa datachan: %s" [xparec $xpa datachan]]
-  puts [format "xpa sendian: %s" [xparec $xpa sendian]]
-  puts [format "xpa cendian: %s" [xparec $xpa cendian]]
-  puts [format "client_data: %s" $client_data]
-  puts [format "paramlist:   %s" $paramlist]
-  incr n
-  
-  if { $rmode == "fillbuf=false" } {
-    set dchan [xparec $xpa datachan]
-    fconfigure $dchan -translation binary
-    set mybuf [read $dchan]
-    set mylen [string length $mybuf]
-    puts [format "read %s bytes" $mylen]
-    set sbuf $mybuf
-    set slen $mylen
-    if { $mylen < 512 } {
-      puts $mybuf
-    } else {
-	xpaerror $xpa [format "Jeez! %s is too many bytes" $mylen]
-	return -code error
-    }
-  } else {
-    puts [format "entering with %s bytes" $len]
-    if { $len < 512 } {
-      puts $buf
-    }
-    set sbuf $buf
-    set slen $len
-  }
-  if { $paramlist == "open" } {
-    if { $schan != "" } {
-      close $schan
-    }
-    set sfile [string trimright $sbuf]
-    set schan [open $sfile r]
-    set sfilebuf [read $schan]
-    puts [format "read %d bytes from '%s'" [string length $sfilebuf] $sfile]
-  }
-}
-
-proc sendcb { xpa client_data paramlist }\
-{
-  global sbuf slen n
-  puts " "
-  puts [format "Entering send callback routine %s for %s" $n $xpa]
-  puts [format "xpa class: %s" [xparec $xpa class]]
-  puts [format "xpa name: %s" [xparec $xpa name]]
-  puts [format "xpa method: %s" [xparec $xpa method]]
-  puts [format "xpa cmdfd: %s" [xparec $xpa cmdfd]]
-  puts [format "xpa cmdchan: %s" [xparec $xpa cmdchan]]
-  puts [format "xpa datafd: %s" [xparec $xpa datafd]]
-  puts [format "xpa datachan: %s" [xparec $xpa datachan]]
-  puts [format "xpa sendian: %s" [xparec $xpa sendian]]
-  puts [format "xpa cendian: %s" [xparec $xpa cendian]]
-  puts [format "client_data: %s" $client_data]
-  puts [format "paramlist: %s" $paramlist]
-  incr n
-
-  if { $slen > 0 } {
-    puts [format "sending %s bytes of data" $slen]
-    xpasetbuf $xpa $sbuf $slen
-  } else {
-   xpaerror $xpa [format "no data to send from %s\n" $client_data]
-   return -code error
-  }
-}
-
-proc infocb { xpa client_data paramlist }\
-{
-  puts " "
-  puts "Entering info callback routine"
-  puts [format "xpa class: %s" [xparec $xpa class]]
-  puts [format "xpa name: %s" [xparec $xpa name]]
-  puts [format "xpa method: %s" [xparec $xpa method]]
-  puts [format "xpa sendian: %s" [xparec $xpa sendian]]
-  puts [format "xpa cendian: %s" [xparec $xpa cendian]]
-  puts [format "client_data: %s" $client_data]
-  puts [format "paramlist: %s" $paramlist]
-}
-
-if { [info exists class] == 0 } {
-  set class "XPA"
-}
-puts [format "class: %s" $class]
-
-if { [info exists name] == 0 } {
-  set name "xpa"
-}
-puts [format "name: %s" $name]
-
-if { [info exists initxpa] } {
-
-puts "initializing xpa access points ..."
-
-set xpa  [xpanew [format "%s" $class] [format "%s" $name] "xpa1 help" \
-	  sendcb "xpa1" $smode reccb "xpa1" $rmode]
-puts [format "xpa=%s" $xpa]
-
-set xpa1 [xpanew [format "%s" $class]  [format "%s1" $name] "xpa1a help" \
-	  sendcb "xpa1a" $smode reccb "xpa1a" $rmode]
-puts [format "xpa1=%s" $xpa1]
-
-set xpac [xpacmdnew [format "%s" $class] [format "%sc" $name]]
-puts [format "xpac=%s" $xpac]
-
-set cmd1 [xpacmdadd $xpac "cmd1" "cmd1 help" \
-	  sendcb "xpac/cmd1" $smode reccb "xpac/cmd1" $rmode]
-puts [format "cmd1=%s" $cmd1]
-
-set cmd2 [xpacmdadd $xpac "cmd2" "cmd2 help" \
-	  sendcb "xpac/cmd2" $smode reccb "xpac/cmd2" $rmode]
-puts [format "cmd2=%s" $cmd2]
-
-set cmd3 [xpacmdadd $xpac cmd3 "help cmd 3" "" "" "" DoIt "cmd 3" ""]
-puts [format "cmd3=%s" $cmd3]
-
-set cmd4 [xpacmdadd $xpac cmd4 "help cmd 4" "" "" "" DoIt "cmd 4" ""]
-puts [format "cmd4=%s" $cmd4]
-
-set xpai [xpainfonew XPA [format "%si" $name] infocb "xpai" $imode]
-puts [format "xpai=%s" $xpai]
-
-}
-
-proc getloop { xpa loops } {
-  for {set i 0} {$i < $loops} {incr i} {
-    set got [xpaget "" $xpa [format "testing xpaget %s" $i] \
-	    "" bufs lens names errs 10]
-    for {set j 0} {$j < $got} {incr j} {
-	set err [lindex $errs $j]
-	if { $err != "" } {
-	    puts $err
-	} else {
-	    set buf [lindex $bufs $j]
-	    puts [format "return buf %s: %s" $j $buf]
-	}
-    }
-  } 
-}
-
-proc setloop { loops } {
-  for {set i 0} {$i < $loops} {incr i} {
-    set got [xpaset "" "xpa*" [format "testing xpaset %s" $i] \
-	    "" "dummy buffer" "" names errs 10]
-    puts $names
-  } 
-}
-
-proc infoloop { loops } {
-  for {set i 0} {$i < $loops} {incr i} {
-    set got [xpainfo "" "i_xpa" [format "testing xpainfo %s" $i] \
-	    "" names errs 10]
-    puts $names
-  } 
-}
-
-if { 0 } {
-  set got [xpaget "" "xpa1" "this is a test" "" bufs lens names errs 10]
-  puts $got
-  puts $lens
-  puts $bufs
-
-  set got [xpaset "" "xpa1" "test" "" "this is a test" "" names errs 10]
-  puts $got
-  puts $errs
-
-  set got [xpainfo "" "i_xpa" "info test" "" names errs 10]
-  puts $got
-  puts $errs
-
-  set got [xpaaccess "" "xpa*" "" "" names errs 10]
-  puts $got
-  puts $names
-  puts $errs
-
-  set xpa [xpaopen ""]
-  set got [xpaset $xpa "xpa1" "test" "" "this is a test" "" names errs 10]
-  set got [xpainfo $xpa xpai "info test" "" names errs 10]
-  xpaclose $xpa
-
-  set wchan1 [open foo1.log w+]
-  set wchan2 [open foo2.log w+]
-  set wchans [list $wchan1 $wchan2]
-  set got [xpagetfd "" "xpa1" "this is a test" "" $wchans names errs 10]
-  set got [xpasetfd "" "xpa1" "this is a test" "" $rchan names errs 10]
-  set got [xpanslookup "xpa1" "" classes names methods]
-}
-
-proc wsbuf { fname } {
-  global sbuf
-  set fid [open $fname w 0600]
-  puts -nonewline $fid $sbuf
-  close $fid
-}
-
-set _xpakeepalive 1
-proc xpakeepalive { xpa sec {type 0} } {
-    global _xpakeepalive
-    if { $_xpakeepalive > 0 } {
-      puts "sending keepalive ..."
-      xpanskeepalive $xpa $type
-      after [expr $sec * 1000] xpakeepalive $xpa $sec $type
-    }
-}
-
-proc katest { host sec {type 0} } {
-  global xpa
-  xparemote $xpa $host + -proxy
-  after [expr $sec * 1000] xpakeepalive $xpa $sec $type
-}
-
-if { 0 } {
-  puts "You can now execute:"
-  puts " "
-  puts "    katest bynars.harvard.edu:28571 60"
-  puts "    (if this is tclsh, you need to run vwait)"
-  # katest bynars.harvard.edu:28571 60
-  puts " "
-  puts "or:"
-  puts " "
-  puts "    xparemote $xpa bynars.harvard.edu:28571 + -proxy"
-  puts " "
-  # xparemote $xpa bynars.harvard.edu:28571 + -proxy
-}
-
-# vwait forever
-
-