## ********************************************************
 ##
 ## tail.tcl version 1.0
 ##
 ## provides facilities like the UNIX tail function, in Tcl.
 ##
 ## ********************************************************
 
 ;#barecode
 package provide tail 1.0
 ;#end
 
 ## ******************************************************** 
 ##
 ## Name: tail
 ##
 ## Description:
 ## A combination of tail -f and egrep.
 ## Loops forever on a file NAME.
 ## If the file doesn't exist it will wait for it to appear
 ## and then work on it.
 ##
 ## Parameters:
 ## file - a filename
 ## rx - a regular expression pattern to filter the lines on
 ##
 ## Usage:
 ##       tail filename [ regex pattern ] [ delay in ms ]
 ##
 ## If the file disappears or is replaced by a new file with the
 ## same name it is handled transparently.
 ##
 ## The behaviour of this function is based upon tail in the gnu
 ## fileutils alpha release 4.0 package.
 ##
 ## Comments:
 ## Only the filename argument is required.  If a regex pattern is
 ## given as the second argument, it will be used to filter the
 ## lines.
 ## auto-cancel if $var is deleted
 
 proc tail { file { rx .+ } { delay 2000 } { var "" } { stats "" } { fid "" } } {
      
      set inode {}
      set size  {}
      set mtime {}
      foreach { inode size mtime } $stats { break }
 
      if { [ string length $var ] > 0 } {
         if  { ! [ info exist $var ] } {
             catch { unset ${var}_tailId } err
             return
         }
     } else {
         ;## default var name 
         set var ::tail_$file
     }
     if  { ! [ regexp {^::} $var ] } {
             set var "::$var"
     }
      ;## if the file exists at this iteration, tail it
      if { [ file exists $file ] } {
         file stat $file fstat
         set _inode $fstat(ino)
         set _size  $fstat(size)
         set _mtime $fstat(mtime)
 
         ;## if the inode has changed since the last iteration,
         ;## reopen the file.  this is from tail v4.0 in the
         ;## gnu fileutils package.
         if { $_inode != $inode } {
            catch { close $fid; set fid {} }
         } else {
            if { $_size < $size } {
               catch { seek $fid 0 }
            }
            if { $_size == $size && $_mtime != $mtime } {
               catch { seek $fid 0 }
            }
         }
 
         ;## if the file is not open, open it!
         if { ! [ string length $fid ] } {
            set fid [ open $file r ]
            fconfigure $fid -blocking off
            fconfigure $fid -buffering line
         }
  
         set inode $_inode
         set size  $_size
         set mtime $_mtime
  
         ;## set a variable with the content of the
         ;## regex filtered line.
         ;## use a temp var to store variable
         ;## until all lines are read
         ;## then set the global var
         ;## so trace function is not called for every line
         set temp {}
         
         while { [ gets $fid line ] >= 0 } {
            if { [ regexp -- $rx $line match ] } {
               ;## put a trace on variable to
               ;## read the tail output.
               append temp "$line\n"
            }
         }
         
         ;## setting this will invoke trace function
         if { [ string length $temp ] } {
            set $var $temp
         }
         
      ;## if the file doesn't exist, make sure we aren't
      ;## creating an NFS orphan.
      } else {
         ;## maybe the file got nuked? Handle it!
         if { [ string length $fid ] } {
            catch { close $fid; set fid {} }
         }
      }
      
      ;## lather, rinse, repeat.  This is NOT recursion!
      set stats \{[ list $inode $size $mtime ]\}
      set ${var}_tailId [ after $delay tail $file $rx $delay $var $stats $fid ]
 }
 ## ******************************************************** 

 ## ******************************************************** 
 ##
 ## Name: cancelTail
 ##
 ## Description:
 ## Removes the trce associated with am invocation of "tail"
 ## Parameters:
 ## file - filename being tailed
 ## cmd - command handling the trace
 ##
 ## Usage:
 ##  cancelTail filename [ command ]
 ##
 ## Comments:
 ## see the man page for "trace"
 
 proc cancelTail { file { var "" } { cmd "" } } {
 
     if  { [ catch {
         if  { ! [ string length $var ] } {
             set var ::tail_$file
             set aftervar ${var}_tailId 
         } else {
         set aftervar ${var}_tailId
         }
         catch { after cancel [ set $aftervar ] }
         if { ! [ string length $cmd ] } { 
            catch { set cmd [ eval lindex [ trace vinfo $var ] 1 ] } 
         }
         catch { trace vdelete $var w $cmd }
     } err ] } {
         return -code error $err
     }
 }
 ## ******************************************************** 
 
 ## ******************************************************** 
 ##
 ## Name: htmlFilter
 ##
 ## Description:
 ## Convenience function for cleaning up html lines
 ## Have your trace handler function call this to
 ## pretty-print html.
 ##
 ## Parameters:
 ##
 ## Usage:
 ##
 ## Comments:
 ## Very simpleminded.  Fairly quick.
 
 proc htmlFilter { text } {
      
      ;## table of escape characters
      array set esc {
      lt     <    gt     >    quot   \"   ob     \x7b  cb    \x7d
      nbsp   \xa0 iexcl  \xa1 cent   \xa2 pound  \xa3 curren \xa4
      yen    \xa5 brvbar \xa6 sect   \xa7 uml    \xa8 copy   \xa9
      ordf   \xaa laquo  \xab not    \xac shy    \xad reg    \xae
      hibar  \xaf deg    \xb0 plusmn \xb1 sup2   \xb2 sup3   \xb3
      acute  \xb4 micro  \xb5 para   \xb6 middot \xb7 cedil  \xb8
      sup1   \xb9 ordm   \xba raquo  \xbb frac14 \xbc frac12 \xbd
      frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc  \xc2
      Atilde \xc3 Auml   \xc4 Aring  \xc5 AElig  \xc6 Ccedil \xc7
      Egrave \xc8 Eacute \xc9 Ecirc  \xca Euml   \xcb Igrave \xcc
      Iacute \xcd Icirc  \xce Iuml   \xcf ETH    \xd0 Ntilde \xd1
      Ograve \xd2 Oacute \xd3 Ocirc  \xd4 Otilde \xd5 Ouml   \xd6
      times  \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc  \xdb
      Uuml   \xdc Yacute \xdd THORN  \xde szlig  \xdf agrave \xe0
      aacute \xe1 acirc  \xe2 atilde \xe3 auml   \xe4 aring  \xe5
      aelig  \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc  \xea
      euml   \xeb igrave \xec iacute \xed icirc  \xee iuml   \xef
      eth    \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc  \xf4
      otilde \xf5 ouml   \xf6 divide \xf7 oslash \xf8 ugrave \xf9
      uacute \xfa ucirc  \xfb uuml   \xfc yacute \xfd thorn  \xfe
      yuml   \xff amp    &	 #013	\n	  
      }
 
      ;## special handler for list items
      regsub -all {<[Ll][Ii]>}          $text {  * } text
      ;## and for images
      regsub -all {<[Ii][Mm][Gg][^>]+>} $text {* }   text
      ;## all other tags just GO AWAY
      regsub -all {<[^>]+>}             $text {}     text
      ;## escape curlies properly
      regsub -all {\\\}}                $text \}     text
      regsub -all {\\\{}                $text \{     text
      ;## maybe we are rendering something with embedded
      ;## tcl code -- declaw it!
      regsub -all {\$}                  $text {\\$}  text
      regsub -all {\[}                  $text {\\[}  text
      regsub -all {\]}                  $text {\\]}  text
      ;## replace html escape sequences with literals
      regsub -all -nocase {&([0-9a-z#]*);} $text {$esc(\1)} text
      ;## this line causes the $esc() to be evaluated
      set text [ subst $text ]
 
      ;## and ship it back!
      return $text
 }
 ## ******************************************************** 
 
 ;#barecode
 ## ******************************************************** 
 ;## USAGE EXAMPLE ##
 ;## (filename is foo, callback "handle" provided):
 
 ;## uncomment the next four lines and just source this file
 ;## for a live demo.
 ;## proc handle { args } {
 ;##      puts -nonewline [ set [ lindex $args 0 ] ]
 ;##  }
 ;## set ::tail_foo {}
 ;## trace variable ::tail_foo w handle
 ;## tail foo
 ;## vwait enter-mainloop ;## or run in "wish".
 
 ;## now go ahead and start echo'ing stuff into a file
 ;## named "foo"; delete it, reopen it, truncate it...
 ;## tail will follow!
 ## ********************************************************