[Sarnold]: The following snippet defines a '''xbody''' command, which takes a code body as argument, and transforms it, putting math expressions inside expr calls.

For example:
 xbody {puts ={$x+1}}
returns:
 {puts [expr {$x+1}]}

The [if], [while], [foreach] and [for] bodies are treated as nested bodies, and substitutions occur inside them. (see TESTS at the bottom of this page)

You may extend Tcl's syntax by using this command and xbody::register.

See also [expr shorthand for Tcl9].
----
======
xbody::xbody string
  Returns the body string in which brace expressions prefixed by some prefixes are processed.
xbody::register prefix command ?immediate?
  When "prefix" is followed by a braced expression (like "{$x+1}"),
  the whole expression is replaced with an invokation of "command" upon the braced expression.
  For example, ={$x+1} is replaced with [expr {$x+1}].
  When "immediate" is "true", the hook "command" is invoked immediately upon the braced expression.
  Each name can be bound to exactly one hook.
======
----
======
namespace eval xbody {
        namespace export xbody
        variable hooks {}
        
        proc register {name cmd {immediate no}} {
                dict set ::xbody::hooks $name [list $cmd $immediate]
        }
        
        proc scriptSplit body {
                set commands {}
                set chunk ""
                foreach line [split $body "\n"] {
                        append chunk $line
                        if {[info complete "$chunk\n"]} {
                                # $chunk ends in a complete Tcl command, and none of the
                                # newlines within it end a complete Tcl command.  If there
                                # are multiple Tcl commands in $chunk, they must be
                                # separated by semi-colons.
                                set cmd ""
                                foreach part [split $chunk ";"] {
                                        append cmd $part
                                        if {[info complete "$cmd\n"]} {
                                                set cmd [string trimleft $cmd]
                                                # Drop empty commands and comments
                                                if {![string match {} $cmd] \
                                                                && ![string match \#* $cmd]} {
                                                        lappend commands $cmd
                                                }
                                                if {[string match \#* $cmd]} {
                                                        set cmd "\#;"
                                                } else {
                                                        set cmd ""
                                                }
                                        } else {
                                                # No complete command yet.
                                                # Replace semicolon and continue
                                                append cmd ";"
                                        }
                                }
                                set chunk ""
                        } else {
                                # No end of command yet.  Put the newline back and continue
                                append chunk "\n"
                        }
                }
                 if {[string trimright $chunk] ne ""} {
                        return -code error "Can't parse body into a sequence of commands.\n\tIncomplete\
                                        command:\n-----\n$chunk\n-----"
                }
                return $commands
        }
            
        proc wordSplit {command} {
                if {![info complete $command]} {error "non complete command"}
                set res ""; # the list of words
                set chunk ""
                foreach word [split $command " \t"] {
                        # testing each word until the word being tested makes the
                        # command up to it complete
                        # example:
                        # set "a b"
                        # set -> complete, 1 word
                        # set "a -> not complete
                        # set "a b" -> complete, 2 words
                        append chunk $word
                        if {[info complete "$res $chunk"]} {
                                lappend res $chunk
                                set chunk ""
                        } else {
                                append chunk " "
                        }
                }
                set res
        }

        proc xbody {body} {
                # eol safety
                set body [string map {\r \n} [string map {\r\n \n} $body]]
                # list of commands for the result
                set commands {}
                # current command (temp)
                set line {}
                # the dictionary of hooks
                variable hooks
                foreach cmd [scriptSplit $body] {
                        set line ""
                        foreach word [wordSplit $cmd] {
                                foreach {name hook} $hooks {
                                        if {[string first $name\{ $word]==0} {
                                                set word [hook $hook [string range $word [string length $name] end]]
                                        }
                                }
                                lappend line $word
                        }
                        if {[lindex $line 0] in {if while for foreach}} {
                                # process bodies embedded
                                set line [xcontrol_[lindex $cmd 0] {*}[lrange $cmd 1 end]]
                        }
                        lappend commands [join $line]
                }
                join $commands \n
        }
        
        proc hook {hook arg} {
                lassign $hook cmd immediate
                if {$immediate} {return [$cmd $arg]}
                return "\[$cmd $arg\]"
        }
        
        proc xcontrol_if {cond body args} {
                lappend result if $cond [_body $body]
                while {[llength $args]>=3} {
                        set args [lassign $args word cond body]
                        lappend result $word $cond [_body $body]
                }
                if {[llength $args] != 2} {return $result}
                lassign $args word body
                lappend result $word [_body $body]
        }
        
        proc xcontrol_while {cond body} {list while $cond [_body $body]}
        proc xcontrol_for {initial cond step body} {list for [_body $initial] $cond [_body $step] [_body $body]}
        proc xcontrol_foreach {args} {linsert [lreplace $args end [_body [lindex $args end]]] 0 foreach}
        
        proc _body body {
                if {[string index $body 0] eq "\{"} {set body [string range $body 1 end-1]}
                return "{[xbody $body]}"
        }        
}
xbody::register = expr
puts [xbody {
        if {$x< 3} {
                puts ={$y+4}
                if {$y > 4} {
                        set l [lrange $l ={$y+1} end]
                }
        } elseif {$y} {$x add ={log($y)}} else break
}]
======
----
'''[jbr] - 2010-03-18 06:42:30'''

[Sugar] provides an extensible framework for this type of syntax adjustment.

<<categories>>Syntax