X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-utils.git;a=blobdiff_plain;f=scripts%2Fhexterm;h=9a1b0475bdb4ce05fe84c0a3a8681a8e074ff000;hp=848312e98e93f9e9595552bfacdaf98a121a454a;hb=0858876b9824c1ad47b63d27df25b38a743cfe71;hpb=e624bfae0656bbd04532a0e65c05a9f1db4f6904 diff --git a/scripts/hexterm b/scripts/hexterm index 848312e..9a1b047 100755 --- a/scripts/hexterm +++ b/scripts/hexterm @@ -1,25 +1,311 @@ #!/usr/bin/tclsh8.4 +set comment { +# +Use of the screen: +0 1 2 3 4 5 6 7 +xxxE hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh hh_| abcd e_.. .... ...._| +} +# Display: +# | is a vertical delimiter +# E is either | to mean echo is on or ' to mean it is off +# hh are hex digits of output: +# 00-ff actual hex data (bold for stuff we entered) +# 0-f under cursor: one digit entered, need the next +# abcde_.... are ASCII output: +# . things we can't print including SPC and _ +# in both, we may see +# space we haven't yet filled +# _ cursor when in other tab +# xxx number of bytes read/written so far +# Keystrokes: +# TAB switch between hex and literal mode +# ^C, ^D quit +# ^Z suspend +# Keystrokes in hex mode only: +# RET move to a new line; if already at start of line, +# set count to 0 +# DEL clear any entered hex digit +# SPC send 00 +# ' toggle echo +# nyi: +# G-Z record last bytes we transmitted and store in memory +# if we were halfway through a hex byte, first digit +# is length of string to record +# g-z play back memory + + +# Copyright 2005 Ian Jackson +# +# This script and its documentation (if any) are free software; you +# can redistribute it and/or modify them under the terms of the GNU +# General Public License as published by the Free Software Foundation; +# either version 3, or (at your option) any later version. +# +# chiark-named-conf and its manpage are distributed in the hope that +# it will be useful, but WITHOUT ANY WARRANTY; without even the +# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +# PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, consult the Free Software Foundation's +# website at www.fsf.org, or the GNU Project website at www.gnu.org. + if {[llength $argv] != 1} { error "need serial port arg" } set port [lindex $argv 0] -set port_stty [exec stty -F $port -g] -set term_stty [exec stty -g] +set count 0 +set lit 0 ;# 1 means literal (ASCII) entry mode +set echo 1 + +proc p {s} { + puts -nonewline $s +} + +proc tput {args} { + global tput + if {[catch { set s $tput($args) }]} { + set s [eval exec tput $args] + set tput($args) $s + } + p $s +} + +proc csr_pos {lit bytenum} { + set x [expr { + (!$lit ? (3*$bytenum) : 53+$bytenum) + + ($bytenum>>2) - (2-$lit)*($bytenum==16) + + 5 + }] + tput hpa $x +} + +proc csr_this {} { global lit x; csr_pos $lit $x } +proc csr_other {} { global lit x; csr_pos [expr {!$lit}] $x } +proc csrs_erase {} { csr_this; p " "; csr_other; p " " } +proc csr_this_show {} { + global h1 + csr_this; if {[info exists h1]} { p $h1; p "\b" } +} +proc csrs_show {} { + csr_other; p _ + csr_this_show +} + +proc echop {} { + global echo + return [expr {$echo ? "|" : "'"}] +} + +proc newline {} { + global x echo count + if {[info exists x]} { csrs_erase; p "\r\n" } + set x 0 + p [format "%3x%s%*s|%*s|" $count [echop] 52 "" 21 ""] + csrs_show +} + +proc p_ch_spaces {} { + global x lit + if {$x==15} return + if {$lit} { p " " } + if {($x & 3) != 3} return + p " " +} + +proc p_rmso {smso} { + if {[string length $smso]} { tput sgr0 } +} + +proc ch {d smso} { + global lit x count + if {$x == 16} newline + if {[string length $smso]} { tput $smso } + set h [format %02x [expr {$d & 0xff}]] + set c [format %c [expr {($d > 33 && $d < 127 && $d != 95) ? $d : 46}]] + if {$lit} { + p $c; csr_other; p $h + p_ch_spaces + p_rmso $smso + p _ + } else { + p $h; csr_other; p $c + p_ch_spaces + p_rmso $smso + p _ + } + incr x + set count [expr {($count+1) & 0xfff}] + csr_this_show +} + +proc onreadp {} { + global p + while 1 { + set c [read $p 1] + binary scan $c c* d + if {![llength $d]} { + if {[eof $p]} { error "eof on device" } + return + } + ch $d {} + } +} + +proc transmit {d} { + global p echo + puts -nonewline $p [format %c $d] + if {$echo} { ch $d bold } +} + +proc k_echo {} { + global echo + set echo [expr {!$echo}] + tput hpa 3 + p [echop] + csr_this +} + +proc k_newline {} { + global count x + if {$x} { + newline + } else { + set count 0 + p "\r" + p [format %3x $count] + csr_this + } +} + +proc k_switch {} { + global lit h1 + csrs_erase + catch { unset h1 } + set lit [expr {!$lit}] + csrs_show +} + +proc k_stop {} { + restore + exit 0 +} -set e [catch { - exec stty min 0 time 0 -istrip -ocrnl -onlcr -onocr -opost \ - -ctlecho -echo -echoe -echok -echonl -iexten -isig - exec stty -F $port min 0 time 0 -istrip -ocrnl -onlcr -onocr -opost \ +proc k_suspend {} { + restore + exec kill -TSTP [info pid] + setup +} + +proc k_noparthex {} { + global h1 + csrs_erase + catch { unset h1 } + csrs_show +} + +proc k_hexdigit {c} { + global h1 echo + if {![info exists h1]} { set h1 $c; p $c; p "\b"; return } + set d [expr 0x${h1}${c}] + unset h1 + transmit $d + if {!$echo} { p " \b" } +} + +proc onreadk {} { + global lit + while 1 { + set c [read stdin 1] + binary scan $c c* d + if {![llength $d]} { + if {[eof stdin]} { error "eof on stdin" } + return + } + switch -exact $d { + 9 { k_switch; continue } + 3 - 4 { k_stop; continue } + 26 { k_suspend; continue } + } + if {$lit} { transmit $d; continue } + switch -exact $d { + 13 { k_newline; continue } + 32 { transmit 0; continue } + 39 { k_echo; continue } + 127 { k_noparthex; continue } + } + if {$d >= 48 && $d <= 57} { k_hexdigit $c; continue } + set kl [expr {$d | 32}] + if {$d >= 97 && $d <= 102} { k_hexdigit $c; continue } + p "\a" + } +} + +proc try {script} { + if {[catch { uplevel 1 $script } emsg]} { + catch { puts stderr "(warning: $emsg)" } + } +} + +proc tryv {variable script} { + upvar #0 $variable var + if {![info exists var]} return + uplevel 1 " + global $variable + $script + " + unset var +} + +proc restore {} { + tryv x { puts "\r\n" } + try { fconfigure stdin -blocking true } + try { fconfigure stdout -blocking true } + tryv term_stty { exec stty $term_stty } + tryv p { close $p } +} + +proc setup {} { + global term_stty port p + + set term_stty [exec stty -g] + + set p [open $port {RDWR NONBLOCK} 0] + + exec stty min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \ -ctlecho -echo -echoe -echok -echonl -iexten -isig \ + -icanon -icrnl + exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \ + -ctlecho -echo -echoe -echok -echonl -iexten -isig \ + -icanon -icrnl \ 9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \ - -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc -onlcr - set p [open $port {RDWR|NONBLOCK} 0] - fconfigure $p -blocking false -buffering none - fconfigure stdin -blocking false -buffering none - fconfigure stdin -blocking false -buffering none -}] - -fconfigure stdin -blocking true -exec stty $term_stty -exec stty -F $port $port_stty + -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc + + fconfigure $p -blocking false -buffering none -encoding binary \ + -translation binary + + fconfigure stdin -blocking false -buffering none -translation binary + fconfigure stdout -blocking false -buffering none -translation binary + + newline + + fileevent stdin readable onreadk + fileevent $p readable onreadp +} + +proc bgerror {m} { + try { + restore + global errorInfo errorCode + puts stderr "$m\n$errorCode\n$errorInfo" + } + exit 127 +} + +if {[catch setup emsg]} { + restore + error $emsg $errorInfo $errorCode +} + +vwait quit