Version 16 of owh - a fileless tclsh

Updated 2004-11-02 18:26:48 by lwv

Richard Suchenwirth -- Here's a tiny script (executable for Unix) that takes 1..3 Tcl scripts (not files - literal code!) as arguments and evaluates

  • the first (if more than one - may be an empty string) in the beginning
  • the second (or first if only one) for each line from stdin
  • the third (if present) in the end: after eof on stdin

This is of course modeled after the 'BEGIN{this}{that}END{finally}' pattern of awk scripts, but I didn't want to introduce special keywords. To make it more awk-like, I however introduced special variables FS (field separator), OFS (output field separator), NF (number of fields in current line), NR (number of records - lines - so far), 0 (the whole input line), 1..$NF (fields as split by FS; you get the last field with [set $NF]).

I use this script for short Tcl tasks that I don't want to write a program file for, e.g.

  owh '' 'lappend t $0' 'puts [join [lsort -index end -integer -decreasing $t] \n]'

to sort output of a pipe the way I want it, but it can be used simply like

 owh 'puts [string toupper $0]'
 owh 'set n 0' 'incr n' 'puts $n' <infile ;# substitutes 'wc -l'
 owh '' '' 'set NR' <infile               ;# ditto, just more compact
 owh 'if $NR>10 break; puts $0' <infile   ;# substitutes 'head'

As for awk, the scripts should be single-quoted so the shell doesn't see all those dollars, brackets etc. These single quotes are not seen by tclsh.

 #!/usr/bin/env tclsh

 if {[llength $argv]<1} {
        puts "usage: owh ?init? body ?exit?
        performs body (in Tcl) for each line (\$0) from stdin
        owh: Ousterhout - Welch - Hobbs, to name a few"
        exit -1
 }
 proc awksplit {text {split default}} {
    set no 0
    if {$split!="default"} {
        set t [split $text $split]
    } else {
        eval set t [list $text]
    }
    uplevel 1 [list set NF [llength $t]]
    foreach i $t {uplevel 1 [list set [incr no] $i]}
    uplevel 1 {set 0 "";trace variable 0 ru 0}
 }
 proc 0 {_name index op} {
    switch $op {
        r {
            uplevel {
                set 0 ""
                for {set i 1} {$i<=$NF} {incr i} {lappend 0 [set $i]}
                set 0 [join $0 $OFS]
            }
        }
        u {rename 0 {} ;# leave no traces of the trace..}
    }
 } 
 proc print s {if [catch {puts $s}] exit} ;# good for broken pipe

 set FS default
 set OFS " "

 if {[llength $argv]>1} {
    eval [lindex $argv 0]
    set _body [lindex $argv 1] ;# strip outer braces
    set _exit [lindex $argv 2]
 } else {
    set _body [lindex $argv 0] ;# strip outer braces
    set _exit {}
 }

 set NR 1
 while 1 {
    gets stdin line
    if [eof stdin] break
    awksplit $line $FS
    eval $_body
    incr NR
 }
 set res [eval $_exit]
 if [string length $res] {puts $res}

Okay Richard, just to prove that I really am on it, here's the current state of perlytcl (gimme a coupla days to finish!):

 #!/bin/sh
 # use -*-Tcl-*- \
 exec tclsh "$0" "$@"
 set awk   0
 set print 1
 set bak   {}
 foreach arg $args {
   # if we are doing in-place edits, get the bak pattern
   regexp {^(-[an]*i)\.?(.+)?} $arg -> arg bak 
   switch -exact -- $arg {
     -an -
     -na -
      -a -
      -n { # default will be to print, so we won't support p
            if { [ regexp {a} $arg ] } {
               set awk 1
            }
            if { [ regexp {n} $arg ] } {
               set print 0
            }
         }
    -ani -
    -nai -
      -i {
         }
    -ane -
    -nae -
      -e { # script follows! then filenames
         }
 default {
            if { [ string match $switch -e ] } {
               set cmd $arg
               set switch {}   
            # sorry, we silently lose non-existent files
            } elseif { [ file exists $arg ] } {
               lappend files $arg
            }   
         }
   } # end of switch   
 }

 foreach file $files {
 }

 <Csan>
 A little patch which adds

  llindex list index ?index? ...

 Here it is:

 # diff -Naur ./owh.tcl~ ./owh.tcl
 --- ./owh.tcl~ Fri Oct 19 15:11:46 2001
 +++ ./owh.tcl  Fri Oct 19 15:40:00 2001
 @@ -31,6 +31,12 @@
          u {rename 0 {} ;# leave no traces of the trace..}
      }
   }
 + proc llindex {list args} {
 +   foreach index $args {
 +     append indices [lindex $list $index]
 +   }
 +   return $indices
 + }

   set FS default
   set OFS " "

So, what is the benefit of the llindex addition here?


Here's a simple zsh macro that allows a quick call to Tcl with a single command:

 suchenwi@jaguar% tcl () { echo "puts [eval $*]" | tclsh } 
 suchenwi@jaguar% tcl expr 17/4.
 4.25
 suchenwi@jaguar% tcl "puts [llength {1 2 3}]; set _ hello"
 3
 hello
 suchenwi@jaguar%

I get similar functionality in ksh when I type:

 $ tcl()
 {
 echo "puts [eval $*]" | tclsh
 } 

This can actually be accomplished in Windoze too with help of the DosKey command. Put the following line in a text file:

 tcl=echo puts [eval $*] | tclsh

Activate the command with

 doskey/macrofile=<filename>

Then run (it will of course only work interactively as all DosKey commands, but I guess that was what we wanted too. :)

 C:\> tcl expr 17/4.
 4.25
 C:\> tcl puts [llength {1 2 3}]; set _ hello
 3
 hello

Category Application