[NEM] 2008-01-21: A rather long title for a simple page. This is a simple backwards-compatible replacement for the built-in [proc] command that generalises the ''procName'' argument to be optional or to consist of several words. If no ''procName'' is given then the command constructs and returns an anonymous procedure (based on [apply]) that can be used with [eval] or [uplevel] and various callbacks. With multiple ''procName'' arguments, the command creates a series of [namespace ensemble]s automatically for the command. Some examples of use: ===proc foo {a b} { expr {$a + $b} }=== Works as now. ===set a [proc {a b} { expr {$a + $b} }]; eval $a 1 2=== Anonymous procedure/[lambda]. ===proc mycmd foo {a b} { expr {$a + $b} }; mycmd foo 1 2=== Ensembles. **Code** ====== # proc.tcl -- # # A compatible replacement for [proc] that supports both creating # anonymous procedures and for creating namespace ensembles, by # generalising the name parameter to accept 0 or more arguments. For # instance: # # proc foo {args} { ... } ;# as now # set a [proc {args} { ... }] ;# lambda # proc mydict foo {args} { ... } ;# ensemble # # Author: Neil Madden, 2008. # This software is placed in the public domain. # package provide proc 1.0 # Move original into the ::tcl namespace if {[llength [info commands ::tcl::proc]] == 0} { rename ::proc ::tcl::proc } ::tcl::proc ::proc args { if {[llength $args] < 2} { error "wrong # args: should be \"proc ?name...? params body\"" } if {[llength $args] == 2} { # Lambda lassign $args params body set ns [uplevel 1 { namespace current }] return [list ::apply [list $params $body $ns]] } else { set name [lrange $args 0 end-2] set params [lindex $args end-1] set body [lindex $args end] set cmd [list ::tcl::proc [lindex $name end] $params $body] foreach ns [lreverse [lrange $name 0 end-1]] { set cmd [list namespace eval $ns $cmd] } # Define the procedure uplevel 1 $cmd # Now define all the necessary ensembles set cmd {namespace export %s; namespace ensemble create} for {set i 0} {$i < [llength $name]-1} {incr i} { set ns [join [lrange $name 0 $i] ::] set cm [list namespace eval $ns [format $cmd [lindex $name $i+1]]] uplevel 1 $cm } } } ====== ---- !!!!!! %| enter categories here |% !!!!!!