See Also [1]
First a sample of the new syntax (note that this is NOT standard Tcl!):
# A little package to deal with an alternate Tcl source code syntax,
# using optional indentation as a substitute for braces.
#
# by Jean-Claude Wippler, June 2002
package provide indentcl 0.3
namespace eval indentcl
namespace export iconvert ieval isource
namespace eval v
variable lb \{
variable rb \}
proc emit {line}
if {[llength $v::last] > 0}
lappend v::result [join $v::last " "]
foreach x $v::keep
lappend v::result $x
set v::keep {}
set v::last [list $line]
proc dedent {i}
while {$i < [lindex $v::levels end]}
set v::levels [lreplace $v::levels end end]
lappend v::last $v::rb
proc iconvert {text}
set v::last {}
set v::levels 0
set v::keep {}
set v::result {}
foreach x [split $text \n]
regexp {^(\s*)(.*)$} $x - a b
if {$b eq "" || [string index $b 0] eq "#"}
lappend v::keep $x
continue
set i 0
foreach y [split $a ""]
switch $y
" " { incr i }
\t { incr i [expr {8 - $i%8}] }
if {$i < [lindex $v::levels end]}
dedent $i
if {$i != [lindex $v::levels end] || [regsub {^(\s*)\\:} $x {\1} x]}
lappend v::last \\
\:elseif {$i > [lindex $v::levels end]}
lappend v::last $v::lb
lappend v::levels $i
emit $x
dedent 0
emit ""
set r [join $v::result \n]
while {[llength $r] == 1 && [lindex $r 0] ne $r}
set r [lindex $r 0] ;# strip top level indentation
return $r
proc ieval {script}
uplevel 1 [iconvert $script]
proc isource {file}
set fd [open $file]
set data [read $fd]
close $fd
set prev [info source]
info source $file
set result [uplevel 1 [iconvert $data]]
info source $prev
return $result
if {$argv0 eq [info script]}
if {[llength $argv] != 2}
puts "usage: $argv0 infile outfile"
exit
set fd [open [lindex $argv 0]]
set data [read $fd]
close $fd
set data [indentcl::iconvert $data]
set fd [open [lindex $argv 1] w]
puts -nonewline $fd $data
close $fdAnd here's the Tcl script that can deal with the above input file:
# A little package to deal with an alternate Tcl source code syntax,
# using optional indentation as a substitute for braces.
#
# by Jean-Claude Wippler, June 2002
package provide indentcl 0.3
namespace eval indentcl {
namespace export iconvert ieval isource
namespace eval v {
variable lb \{
variable rb \} }
proc emit {line} {
if {[llength $v::last] > 0} {
lappend v::result [join $v::last " "] }
foreach x $v::keep {
lappend v::result $x }
set v::keep {}
set v::last [list $line] }
proc dedent {i} {
while {$i < [lindex $v::levels end]} {
set v::levels [lreplace $v::levels end end]
lappend v::last $v::rb } }
proc iconvert {text} {
set v::last {}
set v::levels 0
set v::keep {}
set v::result {}
foreach x [split $text \n] {
regexp {^(\s*)(.*)$} $x - a b
if {$b eq "" || [string index $b 0] eq "#"} {
lappend v::keep $x
continue }
set i 0
foreach y [split $a ""] {
switch $y {
" " { incr i }
\t { incr i [expr {8 - $i%8}] } } }
if {$i < [lindex $v::levels end]} {
dedent $i
if {$i != [lindex $v::levels end] || [regsub {^(\s*)\\:} $x {\1} x]} {
lappend v::last \\ } } \
elseif {$i > [lindex $v::levels end]} {
lappend v::last $v::lb
lappend v::levels $i }
emit $x }
dedent 0
emit ""
set r [join $v::result "\n"]
while {[llength $r] == 1 && [lindex $r 0] ne $r} {
set r [lindex $r 0] ;# strip top level indentation }
return $r }
proc ieval {script} {
uplevel 1 [iconvert $script] }
proc isource {file} {
set fd [open $file]
set data [read $fd]
close $fd
set prev [info source]
info source $file
set result [uplevel 1 [iconvert $data]]
info source $prev
return $result } }
if {$argv0 eq [info script]} {
if {[llength $argv] != 2} {
puts "usage: $argv0 infile outfile"
exit }
set fd [open [lindex $argv 0]]
set data [read $fd]
close $fd
set data [indentcl::iconvert $data]
set fd [open [lindex $argv 1] w]
puts -nonewline $fd $data
close $fd }If you run that second script with the first as input file... you get the second script again :o)jcw 2003-04-14: Adjusted to deal with "re-indentation" by starting a line with "\:". There is one example of it in the above. It is needed to support mixed indents/dedents of the form:
if {...} {
...
} else {
...
}This can now be written as:if {...}
...
\:else
...In essence, \: means: "dedent, but keep on continuing last block". Ugly, but this gets around the issue. Note that \: is not just for else's.Larry Smith Might I suggest the method I like to use with Modula?if <test>
then
s1
s2
...
sn
else
s1
s2
...
sn
endHaving a closing marker for such things makes syntax a lot cleaner. This is why all the Wirth languages after Pascal were designed this way. The various members of the Modula family, Oberon and its spin-offs, and finally Component Pascal all use this method. CP has a non-Wirthian successor called Zonnon that also uses this feature.How's this for a twisted example:
package require indentcl
indentcl::ieval {
package require critcl
critcl::ccode fraction {int n} double
double f = 1;
while (--n >= 0)
f /= 2;
return f;
puts [fraction 6]
}jcw 2004-11-08: Heh, interesting one :)Here's another example I toyed with recently, using htmlgen to generate HTML code:proc do_html {}
global info cmds objs this desc sect
html
head
meta http-equiv=Content-type {content=text/html; charset=utf-8} - ""
title - $info(name) $info(version)
style type=text/css +
<!-- var {color:#44a} pre {background-color:#eef} -->
body
do_sect name
p - [b $info(name) - $info(title)]
do_sect synopsis
p ! $info(preamble)
foreach {type name} $info(calls)
do_call $type $name
br -
do_sect description
do_text $desc(~)
dl
foreach {type name} $info(calls)
dt
do_call $type $name
dd
do_text $desc($name)
foreach name $::info(sections)
do_sect $name
do_text $sect($name)
if {$info(examples) ne ""}
do_sect examples
foreach {x y} $info(examples)
set x [string trim $x]
if {$x ne ""}
do_text $x
regsub {^\n} $y {} y
set y [string trimright $y]
if {$y ne ""}
pre width=81n - " [esc $y]"
foreach x {author copyright bugs website see-also keywords}
if {$info($x) ne ""}
do_sect [string map {- " "} $x]
set y $info($x)
switch $x
author { p - Written by $y. }
copyright { p - Copyright {©} $y }
keywords { p - [join $y ", "] }
website { p - See [a href=$y $y]. }
default { p - $y }IL: Simply amazing.jblz: I freakin' love tcl.
