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. But see Arrays as cached functions for a rough equivalent to procs witharguments, implemented with read trace on an array...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 ;-)RS 2006-08-24: Similarly, an auto-incrementing variable: % proc autoIncr _var {trace var ::$_var r "incr $_var ;#"}
% autoIncr ID
% set ID 0
0
% puts $ID,$ID,$ID
1,2,3kruzalex versions of auto-incrementing variable: proc autoIncr _var {
upvar $_var varname
trace var varname r "incr $_var;#"
set varname $_var
}
autoIncr ID
set ID 0
puts $ID,$ID,$ID
or
proc autoIncr {name body} {
uplevel [list trace variable $name r $name!]
proc $name! {_name index op} [list uplevel set $name \[eval $body\]]
}
autoIncr ID {incr ID}
set ID 0
puts $ID,$ID,$ID
or
proc autoIncr {name body} {
uplevel [list trace variable $name r "set $name \[$body\];#"]
}
autoIncr ID {incr ID}
set ID 0
puts $ID,$ID,$ID
or
proc autoIncr {name} {
upvar $name var
trace variable var r "dynavarAccess [list [list incr ID]]"
proc dynavarAccess { body n1 n2 op } {uplevel $body}
}
autoIncr ID
set ID 0
puts $ID,$ID,$IDSee 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. RSRo This is amazing! By using this I've sped up development considerably. It beats the pants off of the edit-save-run scripting cycle. Now I edit the file I'm working on, save it, run my program once, then whenever I update the file I'm working on, I hit the ` key, which changes procs and namespaces that are loaded in my interpreter. Here is the code I insert into the file I'm working on: ########## q u i c k l o a d ##############
bind . <KeyPress-`> [list source [info script]]
puts "-=> sourcing [file tail [info script]]"
###############################################Tcl's introspective capabilities astound me.... 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.tcland 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? APN As an aside, 8.6 does in fact have a throw command. Not that it invalidates the basic point the OP is making.A more general way of breaking out of several loops at once is breakeval, which can be found on the return page.
A completely useless example, but definitely a braintwister which came about while thinking about the command "set set set":-
set unset set [set unset] [set unset] unset [[set unset] [set unset]] [set set] [set set] setThe third line has many possibly variants...
[set [set unset]] [set [set unset]]or
[set set] [set set]or...I found myself getting confused enough during playing with these types of statement that I had to type them in a tkcon running info vars between each command. MNOMaybe there are some more interesting usages of this idiom.
AM It seems all programming languages allow one to produce self-replicating programs: when run, the output is the code of the program itself. Here is one in Tcl: (you will need to strip off the first space!)
proc self {} {
puts "proc self {} \{[info body self]\}"
puts "self"
}
self(Undoubtledly, there are others around, but I could not find any with my feeble effort!)RS has this (side effect free, no puts): proc self {} {
return "proc self {} \{[info body self]\}"
}DKF wonders why not this: proc self {} {list proc self {} [info body self]}If you want a variation that is closer to AM's code above, try this: proc self {} {format [list proc self {} [info body self]]\;self};selfSetok Would this not be more complete: proc self {} {puts "proc [lindex...Does anyone intend to complete this code? -FWA completely different way to tackle this problem which only works if the code is saved to a file, is:
fcopy [open [info script]] stdoutSee Quines for more on this type of program, including ones that manage to be a quine without reading their own code. -FW
See also If we had no ifSee also If we had no expr
