summaryrefslogtreecommitdiff
path: root/examples/tip.tcl
blob: ff8b2fc7c7d79dfb2ec3c74e6d8a90fe6b381667 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
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