1 files changed, 192 insertions, 0 deletions
diff --git a/examples/tip.tcl b/examples/tip.tcl
new file mode 100755
index 0000000..ff8b2fc
--- /dev/null
+++ b/examples/tip.tcl
@@ -0,0 +1,192 @@
+#!/usr/bin/env jimsh
+
+# tip.tcl is like a simple version of cu, written in pure Jim Tcl
+# It makes use of the new aio tty support
+
+# Note: On Mac OS X, be sure to open /dev/cu.* devices, not /dev/tty.* devices
+
+set USAGE \
+{Usage: tip ?settings? device
+    or tip help
+
+Where settings are as follows:
+1|2             stop bits   (default 1)
+5|6|7|8         data bits   (default 8)
+even|odd        parity      (default none)
+xonxoff|rtscts  handshaking (default none)
+<number>        baud rate   (default 115200)
+
+e.g. tip 9600 8 1 rtscts /dev/ttyUSB0}
+
+set settings {
+	baud 115200
+	stop 1
+	data 8
+	parity none
+	handshake none
+	input raw
+	output raw
+	vmin 1
+	vtime 1
+}
+
+set showhelp 0
+
+foreach i $argv {
+	if {[string match -h* $i] || [string match help* $i]} {
+		puts $USAGE
+		return 0
+	}
+	if {$i in {even odd}} {
+		set settings(parity) $i
+		continue
+	}
+	if {$i in {ixonixoff rtscts}} {
+		set settings(handshake) $i
+		continue
+	}
+	if {$i in {1 2}} {
+		set settings(stop) $i
+		continue
+	}
+	if {$i in {5 6 7 8}} {
+		set settings(data) $i
+		continue
+	}
+	if {[string is integer -strict $i]} {
+		set settings(baud) $i
+		continue
+	}
+	if {[file exists $i]} {
+		set device $i
+		continue
+	}
+	puts "Warning: unrecognised setting $i"
+}
+
+if {![exists device]} {
+	puts $USAGE
+	exit 1
+}
+
+# save stdin and stdout tty settings
+# note that stdin and stdout are probably the same file descriptor,
+# but it doesn't hurt to treat them independently
+set stdin_save [stdin tty]
+set stdout_save [stdout tty]
+
+try {
+	set f [open $device r+]
+} on error msg {
+	puts "Failed to open $device"
+	return 1
+}
+
+if {[$f lock] == 0} {
+	puts "Device is in use: $device"
+	return 1
+}
+
+try {
+	$f tty {*}$settings
+} on error msg {
+	puts "$device: $msg"
+	return 1
+}
+
+puts "\[$device\] Use ~. to exit"
+
+$f ndelay 1
+$f buffering none
+
+stdin tty input raw
+stdin ndelay 1
+
+stdout tty output raw
+stdout buffering none
+
+set status ""
+set tilde 0
+set tosend {}
+
+# To avoid sending too much data and blocking,
+# this sends str in chunks of 1000 bytes via writable
+proc output-on-writable {fh str} {
+	# Add it to the buffer to send
+	append ::tosend($fh) $str
+
+	if {[string length [$fh writable]] == 0} {
+		# Start the writable event handler
+		$fh writable [list output-is-writable $fh]
+	}
+}
+
+# This is the writable callback
+proc output-is-writable {fh} {
+	global tosend
+	set buf $tosend($fh)
+	if {[string bytelength $buf] >= 1000} {
+		set tosend($fh) [string byterange $buf 1000 end]
+		set buf [string byterange $buf 0 999]
+	} else {
+		set tosend($fh) {}
+		# All sent, so cancel the writable event handler
+		$fh writable {}
+	}
+	$fh puts -nonewline $buf
+}
+
+proc bgerror {args} {
+	set status $args
+	incr ::done
+}
+
+# I/O loop
+
+$f readable {
+	set c [$f read]
+	if {[$f eof]} {
+		set status "$device: disconnected"
+		incr done
+		break
+	}
+	output-on-writable stdout $c
+}
+
+proc tilde_timeout {} {
+	global tilde f
+	if {$tilde} {
+		output-on-writable $f ~
+		set tilde 0
+	}
+}
+
+stdin readable {
+	set c [stdin read]
+	# may receive more than one char here, but only need to consider
+	# ~. processing if we receive them as separate chars
+	if {$tilde == 0 && $c eq "~"} {
+		incr tilde
+		# Need ~. within 1 second of each other
+		after 1000 tilde_timeout
+	} else {
+		if {$tilde} {
+			after cancel tilde_timeout
+			set tilde 0
+			if {$c eq "."} {
+				incr done
+				return
+			}
+			output-on-writable $f ~
+		}
+		output-on-writable $f $c
+	}
+}
+
+vwait done
+
+# restore previous settings
+stdin tty {*}$stdin_save
+stdout tty {*}$stdout_save
+
+puts $status