#!/bin/sh
# \
exec tclsh8.4 $0 $@

package require Tk

proc insert {fd tag} {
   if {![eof $fd]} {
      set line [gets $fd]
      .text insert end "$line\n" $tag
   }
   .text yview moveto 1
   update idletask
}

proc start {} {
   set hostname  [.host get]
   wm title . "ping \u00AB$hostname\u00BB"
   wm iconname . "ping"

   catch {close $::process}
   .text insert end "Start \u00AB$hostname\u00BB\n\n" error

   # Behandelt stderr
   set pipe [open "|cat " RDWR]
   fconfigure $pipe -blocking 0 -buffering line 
   fileevent $pipe readable [list insert $pipe red]

   # Startet ping, lenkt stderr um und behandelt stdout
   set ::process [open "|ping $hostname 2>@ $pipe" RDWR]
   fconfigure $::process -blocking 0 -buffering line 
   fileevent $::process readable [list insert $::process black]

   .update configure -text "\u258C\u258C" -command stop
}

proc stop {} {
   catch {close $::process}
   .update configure -text "\u25BA" -command start
   .text delete 0.0 end
   wm title . "ping"
}

proc gui {} {
   label .label -text "Host:"
   entry .host 
   .host insert 0 localhost
   button .update -text "\u25BA" -command start \
      -relief flat
   grid .label .host - .update -  -sticky ew

   text .text -bg white -height 10 \
      -yscrollcommand ".scroll set" 
   .text tag configure black -foreground black
   .text tag configure error -foreground red
   scrollbar .scroll -orient vertical
   grid .text - - - .scroll -sticky nesw

   grid columnconfigure . 0 -weight 0
   grid columnconfigure . 1 -weight 1
   grid columnconfigure . 2 -weight 1
   grid columnconfigure . 3 -weight 0
   grid columnconfigure . 4 -weight 0
   grid rowconfigure . 0 -weight 0
   grid rowconfigure . 1 -weight 1
}

gui