started by Richard Suchenwirth - Here are some code samples that expose interesting Tcl features which may be of no practical use. These snippets were initially conceived in a debate on how Tcl can equivalently be translated to e.g. C. Enjoy! Comment! Contribute! (click Edit Braintwisters at bottom right)
Suicidal procedure: can be called once, deletes itself then. Further calls produce an "invalid command name" error:
proc once {args} {
puts "Only once.."
rename once {}
}DGP: It's a bit more robust to discover the proc name using info level, rather than hard-coding it in. Then others can rename once yet it still works as desired:
proc once {args} {
puts "Only once.."
rename [lindex [info level 0] 0] {}
}Twice: this one deletes itself after the second call:
proc twice args {
puts onemore
proc [lindex [info level 0] 0] args {
puts last
rename [lindex [info level 0] 0] {}
}
}eventually: this one deletes itself when it feels like it:
proc eventually args {
if { ! [ expr {[clock clicks]%31} ] } {
puts -nonewline !
rename [lindex [info level 0] 0] {}
} else {
puts -nonewline .
}
} ;# PSE with bows to RS. that's bows, not bows.and here's a script to test it! (but it might not...):
time { eventually } 100A better when: Sorry to reuse that name, PSE, but I feel this little goodie just must be called 'when':
proc when {cond body} {
if {[eval $cond]} {eval $body} else {
after 1000 [list when $cond $body]
}
} ;# RSIt waits in the background until $cond is true, and then evaluates $body. Usage example:
when {file exists /home/foo/bin/killerapp} bellOK Richard, so I changed mine to "eventually".
intgen: unique integer ID generator, at first call gives 1, then 2, 3, ... Note how the proc rewrites its own seed default, so no global variable is needed:
proc intgen {{seed 0}} {
set self [lindex [info level 0] 0]
proc $self "{seed [incr seed]}" [info body $self]
set seed
} ;# RSThis has practical use in generating numbered handles like "file4", "image15", without having to resort to a global variable or a namespace.
Generalized accessor: This proc with the fancy name $ returns part of a compound object (element or slice of a list passed by name or by value, or element of an array passed by name):
proc $ {_L from {to {}}} {
# sugared lindex/lrange: [$ list 2] == [lindex $list 2]
if {$to=={}} {set to $from}
if {[uplevel 1 [list info exists $_L]]} {
upvar 1 $_L L
if {[array exists L]} {return $L($from)}
} else { set L $_L}
lrange $L $from $to
}But I admit [$ foo bar] is no advancement against $foo(bar) ;-)
No twister, but still fun at 99 bottles of beer; see Gadgets for minimalist OO, Basic in Tcl for nostalgics, Salt and sugar for superficial twisters ;-)
Code that obfuscates Tcl code deserves a page of its own; see Obfuscation.
For still more fun, see the Quines page, which is about self-reproducing programs.
Awk-style field variables: Just a mild twister, since anything goes in Tcl anyway (except braces in comments ;-), but here's how to split a string into variables named 1 .. $NF, and NF holds the number of fields:
proc awksplit {text {split default}} {
set no 0
if {$split!="default"} {
set t [split $text $split]
} else {
eval set t [list $text]
}
uplevel 1 [list set NF [llength $t]]
foreach i $t {uplevel 1 [list set [incr no] $i]}
uplevel 1 [list set 0 $t]
} ;# -- RSNumbers are legal variable names in Tcl. Note that to assign to a field, don't write the dollar; $NF gives you the number of fields, [set $NF] returns the last field:
% awksplit "foo bar baz"
foo bar baz ;#--- default: split on whitespace sequences
% set 2 [string toupper $2]
BARDKF - Modified the above to put the list of words into the variable 0 for greater AWK compatability. :^)
RS - Yeah, thought of that too, but the behavior of $0 is more complex: if you don't modify $1..NF, it remains the original input ("text" above), whitespace etc. preserved; once you touch one of $1..NF, and be it "$1=$1;", $0 is reconstructed by joining $1..NF with FS. This can be had by adding the following lines before the last in awksplit above (joining with space via lappend):
uplevel {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]}
}
}
u {rename 0 {} ;# leave no traces of the trace..}
}
}Now if you modify a field, $0 updates itself when referenced:
% awksplit "this is a test" this is a test % set 3 another another % puts $0 this is another test
Dynamic variables: A generalization of the $0 (cheap ;-) trick above is a variable that has a body which is executed every time the variable value is read. But setting it to a value is intercepted:
proc dynvar {name body} {
upvar $name var
catch {unset var}; set var {}
uplevel [list trace variable $name r $name!]
proc $name! {_name index op} [list uplevel set $name \[eval $body\]]
uplevel [list trace variable $name u dynvar:remove]
uplevel [list trace variable $name w dynvar:set]
} ;# RS
proc dynvar:remove {name index op} {rename $name! {}}
proc dynvar:set {name index op} {return -code error "dynamic variable"}
dynvar time {clock format [clock seconds] -format %H:%M:%S}
% puts $time
17:07:20
% puts $time
17:07:24
% set time now
can't set "time": dynamic variableMore comfort: replace the top line of proc dynvar with the following for the added feature dynvar names, which returns a list of your presently defined dynvars:
proc dynvar {name {body {}}} {
if {$name=="names" && $body=={}} {
regsub -all ! [info proc *!] "" res
return $res
}
#------- continued as above (should be the "upvar" line)Discussion: Fancy as this looks, the functionality is as mighty as a proc without arguments:
proc Time {} {clock format [clock seconds] -format %H:%M:%S}
puts [Time]is equivalent and costs no overhead. The advantage of dynvar may be in positions where you need a variable (-textvar ?), or the cleaning up - the proc is removed when the variable dies.
Bob Techentin proposed a major improvement in news:comp.lang.tcl : How about a version that embeds the $body right into the trace, so that we don't have to pollute the global name space with procs. (This also eliminates the need to trace unset.) I've also included array element support and a twist on a little tidbit from the Wiki that allows you to list the code associated with a dynamic variable.
proc dynavar {name {body {}}} {
if {[string equal $body {}]} {
set tinfo [uplevel trace vinfo $name]
return [lindex [lindex [lindex $tinfo 0] 1] 1]
}
upvar $name var
catch {unset var}; set var {}
trace variable var rw "dynavarAccess [list $body]"
}
proc dynavarAccess { body name1 name2 op } {
switch -- $op {
r {
if {[string equal $name2 {}]} {
upvar $name1 var
set var [uplevel $body]
} else {
upvar ${name1}($name2) var
set var [uplevel $body]
}
}
w {return -code error {dynamic variable}}
}
}Bryan Oakley (improved by Donal Fellows) has a minimalist one-liner dynvar for the $time problem:
trace variable ::time r {set ::time [clock format [clock seconds]] ;#}The trailing comment here is another mini-twister that consumes the arguments name1 name2 op that are appended to the trace command ;-)
See also Deferred evaluation for a compact implementation of dynamic variables, willset.
Resourcery: the following innocent line creates a proc named like the source file, which when called re-sources it:
proc [file tail [info script]] {} "source [info script]"Usage: include this line in files you're currently editing. Call the file name (without path) interactively (e.g. from a console) when you saved a major improvement (;-) to your file. RS
... and a twist on that: autoupdate Imagine you edit a file foo.tcl that does fancy things in your Tk application. Order once
uptodate foo.tcl
and have it automatically re-sourced whenever you saved to disk:
proc uptodate {filename {time 0}} {
set filename [file join [pwd] $filename]
set mtime [file mtime $filename]
if {$mtime > $time} {source $filename}
after 1000 [list uptodate $filename $mtime]
} ;#RSDKF: Fixed to use 'absolute' paths (this is not necessarily an advantage with some automounters...) RS: Right. The file join has an effect (if any) only the first time around, since it doesn't modify an absolute pathname. All other calls to uptodate will keep the constant absolute pathname. Thank you!
Global list as manipulated proc body: You can maintain a list (e.g. of Gadgets names) visible from everywhere without need for a global variable, by specifying access functions that rewrite the body of an accessor proc:
proc X {} {list} ;# initially, return an empty list
proc X+ name {proc X {} [concat [info body X] $name]}
proc X- name {
set body [info body X]
set where [lsearch -exact $body $name]
proc X {} [lreplace $body $where $where]
} ;#RS
X
X+ foo
X+ bar
X => foo bar
X- foo
X => barNo error checking yet, so X+ appends to end even if name was there already. In X-, lreplacing with -1 (if name is not in list) does no harm. But "X- list" spells trouble... so better make sure "list" is not one of the words listed.
Calling Tcl procs in C style: See Playing C for how to write a proc that can be called (with equal results) like
sum $a $b sum(a,b);
Empty interpreter: David Gravereaux wrote in comp.lang.tcl: I know you could never really have a bare empty interpreter, as the language is initialized for you... Donald Porter replied: A challenge!
set cmds [info commands]
set idx [lsearch -exact $cmds rename]
foreach cmd [lreplace $cmds $idx $idx] {
rename $cmd {}
}
rename rename {}
# I am now an interp with 0 commands -- the ultimate safe interp!DGP back again with a much simpler solution:
namespace delete ::
throw: The logical opposite to catching is throwing. Tcl has no throw command, but still you can call it. And guess what, it ends up in the hands of catch.. see Tricky catch, where Kevin Kenny uses it to break out of several loops at once. Now is this the Zen of Tcl, or what?
A more general way of breaking out of several loops at once is breakeval, which can be found on the return page.