[Richard Suchenwirth] 2000-11-21 - 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.

======none
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.

When launched in the DOS prompt, make sure you use double-quotes instead of single-quotes as follows:
 C:\Tcl\code\utils>tclsh owh.tcl "" "" "set NR" <owh.tcl
 64

Also, if you want to emulate the -f switch in awk and provide a file with your commands instead of a long string in the command line, you can do:
 C:\Tcl\code\utils>tclsh owh.tcl "set FS ," "source cmds.tcl" "" <input.csv

where the file cmds.tcl contains your commands multiline as usual.

Example:
 
   * file: cmds2.tcl

 if {$NR == 1} {
        puts "path: $0"
 }
 if {$NR>1} {
                if {[string match *proc* $0]} {
                        puts "proc $2, line # $NR"
                }
                if {$1 == "set"} {
                        puts "variable $2, line # $NR"
                }

 }

Then, launch owh as follows:

 C:\Tcl\code\utils>tclsh owh.tcl "" "source cmds2.tcl" "" <owh.tcl
 path: #!/usr/bin/env tclsh
 proc awksplit, line # 10
 variable no, line # 12
 variable t, line # 14
 variable t, line # 21
 proc 0, line # 27
 variable 0, line # 31
 variable 0, line # 33
 proc print, line # 40
 variable FS, line # 42
 variable OFS, line # 43
 variable OFS, line # 44
 variable _body, line # 47
 variable _exit, line # 48
 variable _body, line # 50
 variable _exit, line # 51
 variable NR, line # 54
 variable res, line # 62

** Changes **

[PYK] 2014-04-07:   fixed what looked like a bug:  With the default split behaviour there was an error on an input line that wasn't a list.

[JM] 2020-05-28: Years later, I found a bug when trying to use the special variable '''FS'''

The following command on proc awksplit
 set t [list $text $split]
Should read instead:
 set t [split $text $split]
I did not change it below, waiting for [RS] to confirm

** Code **

======
#!/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 eq "default"} {
        set t {}
        foreach string [split $text] {
            if {$string ne {}} {
                lappend t $string
            }
        }
    } else {
        set t [list $text $split]
    }
    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}
======

<<discussion>>

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:

======none
# 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:

======none
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:

======none
tcl=echo puts [eval $*] | tclsh
======

Activate the command with

======none
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. :)

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

----

In bash you can do:

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


----

[AM] 2009-02-20: Reading
[http://journal.dedasys.com/2006/03/06/ruby-vs-tcl%|%Ruby vs Tcl, part 1], by
[David Welton],  I was reminded of this page,
and I thought I'd have another go at a command-line utility. It is not at all
polished, just a proof of concept. As it's sometimes faster to write your own 
stuff than adapt existing code, I did so - with the intention of using the
code in this page for improving the program below:

======
# owhnew.tcl --
#     First experimental implementation of a command line utility
#     Note:
#     Use the OWH Wiki page for more AWK-like functionality
#

# analyseCommandLine --
#     Analyse the command line
#
# Arguments:
#     argv            List of command-line arguments
#
# Result:
#     List of files to handle
#
# Side effects:
#     Sets various global variables
#
proc analyseCommandLine {argv} {
    set ::mode   e
    set ::parse  0
    set ::regexp ""

    foreach arg $argv {
        switch -glob -- $arg {
            -- {
                 set argv [lrange $argv 1 end]
                 break
            }
            -e* {
                 set ::mode e
                 set ::cmd  [lindex $argv 1]
                 if { [string first {$0} $::cmd] < 0 } {
                     set ::cmd "$::cmd \$0"
                 }
                 if { [string match {$[0-9]} $::cmd] } {
                     set parse 1
                 }
                 set argv   [lrange $argv 1 end]
            }
            -p* {
                 set ::mode p
                 set ::cmd  [lindex $argv 1]
                 if {[string first {$0} $::cmd] < 0} {
                     set ::cmd "$::cmd \$0"
                 }
                 if {[string match {$[0-9]} $::cmd]} {
                     set parse 1
                 }
                 set argv [lrange $argv 1 end]
            }
            -r* {
                 set ::mode   r
                 set ::regexp [lindex $argv 1]
                 set argv     [lrange $argv 1 end]
            }
            -h {
                 printHelp
            }
            default {
                 break
            }
        }
        #
        # Remove this argument
        #
        set argv [lrange $argv 1 end]
    }
    return $argv
}

# parseLine --
#     Parse the line that was read
#
# Arguments:
#     line            Line to be parsed
#
# Result:
#     None
#
# Side effects:
#     Sets global variables 1, 2, 3, ...
#
proc parseLine {line} {

    set line [string map {\{ \\\{ \} \\\} \" \\\" \; \\\;} $line]

    set n 0
    foreach field [split $line] {
        incr n
        set ::$n $field
    }
}

# printHelp --
#     Print information on the use
#
# Arguments:
#     None
#
# Result:
#     None
#
proc printHelp {} {
    puts \
"Usage: [file tail $::script] -\[eprh] command file1 file2 ...
Examples:

To print the file in lower-case:
   [file tail $::script] -e 'string tolower' file.inp

To print the first word of each line:
   [file tail $::script] -e '\$1' file.inp

To print those lines that aer longer than 20 characters:
   [file tail $::script] -p '[string length \$0] > 20' file.inp

To find all lines containing \"list\" (or any regular expression):
   [file tail $::script] -r 'list' file.inp

Note: \$1, \$2, \$3, ... are the words on the line, \$0 is the complete line

Note on regular expressions:
Not all RE syntax works for mysterious reasons - backslashes fail for instance
"
}

# main --
#     Analyse the command-line arguments and act upon the result
#

set script [info script]
set argv [analyseCommandLine $argv]

foreach f $argv {
    set infile [open $f r]

    switch -- $mode {
        e {
            if {!$parse} {
                while {[gets $infile 0] >= 0} {
                    puts [eval $cmd]
                }
            } else {
                while {[gets $infile 0] >= 0} {
                    parseLine $0
                    puts [eval $cmd]
                }
            }
        }
        p {
            if {! $parse} {
                while {[gets $infile 0] >= 0} {
                    if $cmd {
                        puts $0
                    }
                }
            } else {
                while {[gets $infile 0] >= 0} {
                    parseLine $0
                    if $cmd {
                        puts $0
                    }
                }
            }
        }
        r {
            while {[gets $infile 0] >= 0} {
                if {[regexp $regexp $0]} {
                    puts $0
                }
            }
        }
    }
    close $infile
} 

======

<<categories>> Application | String Processing