examples/tip.tcl

   1 #!/usr/bin/env jimsh
   2
   3 # tip.tcl is like a simple version of cu, written in pure Jim Tcl
   4 # It makes use of the new aio tty support
   5
   6 # Note: On Mac OS X, be sure to open /dev/cu.* devices, not /dev/tty.* devices
   7
   8 set USAGE \
   9 {Usage: tip ?settings? device
  10     or tip help
  11
  12 Where settings are as follows:
  13 1|2             stop bits   (default 1)
  14 5|6|7|8         data bits   (default 8)
  15 even|odd        parity      (default none)
  16 xonxoff|rtscts  handshaking (default none)
  17 <number>        baud rate   (default 115200)
  18
  19 e.g. tip 9600 8 1 rtscts /dev/ttyUSB0}
  20
  21 set settings {
  22         baud 115200
  23         stop 1
  24         data 8
  25         parity none
  26         handshake none
  27         input raw
  28         output raw
  29         vmin 1
  30         vtime 1
  31 }
  32
  33 set showhelp 0
  34
  35 foreach i $argv {
  36         if {[string match -h* $i] || [string match help* $i]} {
  37                 puts $USAGE
  38                 return 0
  39         }
  40         if {$i in {even odd}} {
  41                 set settings(parity) $i
  42                 continue
  43         }
  44         if {$i in {ixonixoff rtscts}} {
  45                 set settings(handshake) $i
  46                 continue
  47         }
  48         if {$i in {1 2}} {
  49                 set settings(stop) $i
  50                 continue
  51         }
  52         if {$i in {5 6 7 8}} {
  53                 set settings(data) $i
  54                 continue
  55         }
  56         if {[string is integer -strict $i]} {
  57                 set settings(baud) $i
  58                 continue
  59         }
  60         if {[file exists $i]} {
  61                 set device $i
  62                 continue
  63         }
  64         puts "Warning: unrecognised setting $i"
  65 }
  66
  67 if {![exists device]} {
  68         puts $USAGE
  69         exit 1
  70 }
  71
  72 # save stdin and stdout tty settings
  73 # note that stdin and stdout are probably the same file descriptor,
  74 # but it doesn't hurt to treat them independently
  75 set stdin_save [stdin tty]
  76 set stdout_save [stdout tty]
  77
  78 try {
  79         set f [open $device r+]
  80 } on error msg {
  81         puts "Failed to open $device"
  82         return 1
  83 }
  84
  85 if {[$f lock] == 0} {
  86         puts "Device is in use: $device"
  87         return 1
  88 }
  89
  90 try {
  91         $f tty {*}$settings
  92 } on error msg {
  93         puts "$device: $msg"
  94         return 1
  95 }
  96
  97 puts "\[$device\] Use ~. to exit"
  98
  99 $f ndelay 1
 100 $f buffering none
 101
 102 stdin tty input raw
 103 stdin ndelay 1
 104
 105 stdout tty output raw
 106 stdout buffering none
 107
 108 set status ""
 109 set tilde 0
 110 set tosend {}
 111
 112 # To avoid sending too much data and blocking,
 113 # this sends str in chunks of 1000 bytes via writable
 114 proc output-on-writable {fh str} {
 115         # Add it to the buffer to send
 116         append ::tosend($fh) $str
 117
 118         if {[string length [$fh writable]] == 0} {
 119                 # Start the writable event handler
 120                 $fh writable [list output-is-writable $fh]
 121         }
 122 }
 123
 124 # This is the writable callback
 125 proc output-is-writable {fh} {
 126         global tosend
 127         set buf $tosend($fh)
 128         if {[string bytelength $buf] >= 1000} {
 129                 set tosend($fh) [string byterange $buf 1000 end]
 130                 set buf [string byterange $buf 0 999]
 131         } else {
 132                 set tosend($fh) {}
 133                 # All sent, so cancel the writable event handler
 134                 $fh writable {}
 135         }
 136         $fh puts -nonewline $buf
 137 }
 138
 139 proc bgerror {args} {
 140         set status $args
 141         incr ::done
 142 }
 143
 144 # I/O loop
 145
 146 $f readable {
 147         set c [$f read]
 148         if {[$f eof]} {
 149                 set status "$device: disconnected"
 150                 incr done
 151                 break
 152         }
 153         output-on-writable stdout $c
 154 }
 155
 156 proc tilde_timeout {} {
 157         global tilde f
 158         if {$tilde} {
 159                 output-on-writable $f ~
 160                 set tilde 0
 161         }
 162 }
 163
 164 stdin readable {
 165         set c [stdin read]
 166         # may receive more than one char here, but only need to consider
 167         # ~. processing if we receive them as separate chars
 168         if {$tilde == 0 && $c eq "~"} {
 169                 incr tilde
 170                 # Need ~. within 1 second of each other
 171                 after 1000 tilde_timeout
 172         } else {
 173                 if {$tilde} {
 174                         after cancel tilde_timeout
 175                         set tilde 0
 176                         if {$c eq "."} {
 177                                 incr done
 178                                 return
 179                         }
 180                         output-on-writable $f ~
 181                 }
 182                 output-on-writable $f $c
 183         }
 184 }
 185
 186 vwait done
 187
 188 # restore previous settings
 189 stdin tty {*}$stdin_save
 190 stdout tty {*}$stdout_save
 191
 192 puts $status