6 xxxE hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh_| abcd e_.. .... ...._|
9 # | is a vertical delimiter
10 # E is either | to mean echo is on or ' to mean it is off
11 # hh are hex digits of output:
12 # 00-ff actual hex data (bold for stuff we entered)
13 # 0-f under cursor: one digit entered, need the next
14 # abcde_.... are ASCII output:
15 # . things we can't print including SPC and _
17 # space we haven't yet filled
18 # _ cursor when in other tab
19 # xxx number of bytes read/written so far
21 # TAB switch between hex and literal mode
24 # Keystrokes in hex mode only:
25 # RET move to a new line; if already at start of line,
27 # DEL clear any entered hex digit
31 # G-Z record last bytes we transmitted and store in memory
32 # if we were halfway through a hex byte, first digit
33 # is length of string to record
34 # g-z play back memory
37 # Copyright 2005 Ian Jackson <ian@chiark.greenend.org.uk>
39 # This script and its documentation (if any) are free software; you
40 # can redistribute it and/or modify them under the terms of the GNU
41 # General Public License as published by the Free Software Foundation;
42 # either version 3, or (at your option) any later version.
44 # chiark-named-conf and its manpage are distributed in the hope that
45 # it will be useful, but WITHOUT ANY WARRANTY; without even the
46 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
47 # PURPOSE. See the GNU General Public License for more details.
49 # You should have received a copy of the GNU General Public License along
50 # with this program; if not, consult the Free Software Foundation's
51 # website at www.fsf.org, or the GNU Project website at www.gnu.org.
54 if {[llength $argv] != 1} { error "need serial port arg" }
56 set port [lindex $argv 0]
59 set lit 0 ;# 1 means literal (ASCII) entry mode
68 if {[catch { set s $tput($args) }]} {
69 set s [eval exec tput $args]
75 proc csr_pos {lit bytenum} {
77 (!$lit ? (3*$bytenum) : 53+$bytenum)
78 + ($bytenum>>2) - (2-$lit)*($bytenum==16)
84 proc csr_this {} { global lit x; csr_pos $lit $x }
85 proc csr_other {} { global lit x; csr_pos [expr {!$lit}] $x }
86 proc csrs_erase {} { csr_this; p " "; csr_other; p " " }
87 proc csr_this_show {} {
89 csr_this; if {[info exists h1]} { p $h1; p "\b" }
98 return [expr {$echo ? "|" : "'"}]
103 if {[info exists x]} { csrs_erase; p "\r\n" }
105 p [format "%3x%s%*s|%*s|" $count [echop] 52 "" 21 ""]
109 proc p_ch_spaces {} {
113 if {($x & 3) != 3} return
118 if {[string length $smso]} { tput sgr0 }
123 if {$x == 16} newline
124 if {[string length $smso]} { tput $smso }
125 set h [format %02x [expr {$d & 0xff}]]
126 set c [format %c [expr {($d > 33 && $d < 127 && $d != 95) ? $d : 46}]]
128 p $c; csr_other; p $h
133 p $h; csr_other; p $c
139 set count [expr {($count+1) & 0xfff}]
149 if {[eof $p]} { error "eof on device" }
158 puts -nonewline $p [format %c $d]
159 if {$echo} { ch $d bold }
164 set echo [expr {!$echo}]
177 p [format %3x $count]
186 set lit [expr {!$lit}]
197 exec kill -TSTP [info pid]
201 proc k_noparthex {} {
208 proc k_hexdigit {c} {
210 if {![info exists h1]} { set h1 $c; p $c; p "\b"; return }
211 set d [expr 0x${h1}${c}]
214 if {!$echo} { p " \b" }
223 if {[eof stdin]} { error "eof on stdin" }
227 9 { k_switch; continue }
228 3 - 4 { k_stop; continue }
229 26 { k_suspend; continue }
231 if {$lit} { transmit $d; continue }
233 13 { k_newline; continue }
234 32 { transmit 0; continue }
235 39 { k_echo; continue }
236 127 { k_noparthex; continue }
238 if {$d >= 48 && $d <= 57} { k_hexdigit $c; continue }
239 set kl [expr {$d | 32}]
240 if {$d >= 97 && $d <= 102} { k_hexdigit $c; continue }
246 if {[catch { uplevel 1 $script } emsg]} {
247 catch { puts stderr "(warning: $emsg)" }
251 proc tryv {variable script} {
252 upvar #0 $variable var
253 if {![info exists var]} return
262 tryv x { puts "\r\n" }
263 try { fconfigure stdin -blocking true }
264 try { fconfigure stdout -blocking true }
265 tryv term_stty { exec stty $term_stty }
270 global term_stty port p
272 set term_stty [exec stty -g]
274 set p [open $port {RDWR NONBLOCK} 0]
276 exec stty min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
277 -ctlecho -echo -echoe -echok -echonl -iexten -isig \
279 exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
280 -ctlecho -echo -echoe -echok -echonl -iexten -isig \
282 9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
283 -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
285 fconfigure $p -blocking false -buffering none -encoding binary \
288 fconfigure stdin -blocking false -buffering none -translation binary
289 fconfigure stdout -blocking false -buffering none -translation binary
293 fileevent stdin readable onreadk
294 fileevent $p readable onreadp
300 global errorInfo errorCode
301 puts stderr "$m\n$errorCode\n$errorInfo"
306 if {[catch setup emsg]} {
308 error $emsg $errorInfo $errorCode