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
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:
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.
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
To provide a filename with your commands instead of a long string in the command line, you can do:
Example:
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
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
#!/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 add variable 0 {read unset} 0}
}
proc 0 {_name index op} {
switch $op {
read {
uplevel {
set 0 {}
for {set i 1} {$i <= $NF} {incr i} {lappend 0 [set $i]}
set 0 [join $0 $OFS]
}
}
unset {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}| What | owh fork |
| Where | https://gitlab.com/dbohdan/owh |
| Prerequisites | Tcl 8.5 through 9 or recent Jim Tcl. Experimental support for JTcl. |
| Updated | 2020-09 |
| License | Same as Tcl |
| Contact | dbohdan |
dbohdan 2020-10-02: I have forked and modified owh to give it a syntax closer to Awk's. For example, with my fork you can do things like this:
$ # Find the maximum number of fields per record in the file "foo".
$ owh 'BEGIN { set max 0 } { $NF > $max } { set max $NF } END { print $max }' foo
101You'll find more examples in tests.tcl in the repository.
Unknown 2001-10-19: 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 {
}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
helloIn bash you can do:
function tcl () { echo "puts [eval $*]" | tclsh; };AM 2009-02-20: Reading 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
}