davidw:

#! /bin/env wish package require Tk pack [label .x];pack [button .b -text Quit -command exit];set s "GUIs in Tk are Easy " while 1 { set s [string range $s 1 end][string index $s 0];.x configure -text $s ; update ; after 100 }I expect to see Richard Suchenwirth come up with something brilliant for this space:-)RS: Well, first a simplification of yours, using -textvar:

#! /bin/env tclsh package require Tk pack [label .x -textv s] pack [button .b -text Quit -comm exit] set s "GUIs in Tk are Easy " while 1 { set s [string ra $s 1 end][string in $s 0] update after 100 }This variation cycles through the bytes from 33 to 255, in hex and character (rs):

#! /bin/env tclsh package require Tk pack [label .x -textv s] pack [button .b -text Quit -comm exit] while 1 { for {set i 33} {$i<256} {incr i} { set s [format %X:%c $i $i];update;after 250 } }Digital clock (rs):

#! /bin/env tclsh package require Tk pack [label .x -textv s] pack [button .b -text Quit -comm exit] while 1 { set s [clock form [clock sec] -form %H:%M:%S];update;after 1000 }AM I could not resist:

#! /bin/env tclsh package require Tk pack [canvas .c -bg white] -fill both .c create rectangle 50 50 70 70 -fill blue -tag R eval [set M { .c move R [expr {5*(rand()-0.5)}] [expr {5*(rand()-0.5)} ] ; after 10 $M}]RS: The mysterious shrinking window:

#! /bin/env tclsh package require Tk update regexp {(.+)x.+[+](.+)[+](.+)} [wm geo .] > g x y while {$g>0} { wm geo . [incr g -1]x[incr g -1]+$x+$y;update;after 100 } exitor

#! /bin/env tclsh package require Tk update regexp {(.+)x} [wm geo .] > g while {$g>0} { wm geo . [incr g -1]x[incr g -1] update after 100 } exitAM: The psychedelic window:

#! /bin/env tclsh package require Tk pack [canvas .c -bg white] -fill both eval [set M { .c configure -bg [lindex {white black red blue green orange brown purple yellow} [expr {int(rand()*9)}]]; after 20 $M}]Shorter, by rs:

#! /bin/env tclsh package require Tk eval [set M { . configure -bg [lindex {white black red blue green orange brown purple yellow} [expr {int(rand()*9)}]]; after 100 $M}]][wildye]: The psychadelic window, even shorter and with more random colors. I used something similar to this as a popup alert, to get my attention when someone was trying to contact me.

#! /bin/env tclsh package require Tk eval [set M {. co -bg [format \#%06x [expr {int(rand()*0xFFFFFF)}]];after 99 $M}]PT: Blocks:

#! /bin/env tclsh package require Tk proc S {} { expr {int(rand()*256)} } proc C {} { format #%02x%02x%02x [S] [S] [S]} proc D {} { .c create rectangle [S] [S] [S] [S] -fill [C]; after 100 D } pack [canvas .c] DPT: Frightened window:

#! /bin/env tclsh package require Tk proc S {} { expr {int(rand() * 100) - 49} } pack [canvas .c] -expand 1 -fill both frame .f -bg red -width 50 -height 50 bind .f <Enter> { .c move 1 [S] [S] } .c create window 200 200 -window .fAM: Uncertain polka dot:

#! /bin/env tclsh package require Tk pack [canvas .c -bg white] -fill both proc A x { .c move all [expr {sin(0.016*$x)}] [expr {cos(0.013*[incr x])}] ; after 10 A $x } .c create oval 100 100 120 120 -fill red A 1MSW: Tcl-grep looping over argument-files:

#! /bin/env tclsh proc 1 {} { return true } foreach f [lrange $argv 1 end] { for {set fp [open $f]} {!([eof $fp] && [close $fp;1])} { expr {[regexp [lindex $argv 0] "[set l [gets $fp]]"] && [puts $l; 1]}} {} }TV: List all items in the Tk hierarchy (and define ilist):

#! /bin/env tclsh package require Tk proc ilist {{begin {.}} {listf {winfo children}} {maxdepth {100}} {ident {0}}} { if {$maxdepth <1} return set de {} set o {} for {set i 0} {$i < $ident} {incr i} { append de " " } foreach i [eval "$listf $begin"] { append o "$i "; append o [ilist $i $listf [expr $maxdepth-1] [expr $ident +1]] } return $o } ilistTV: List all -text containing items in an application TV (requires ilist):

#! /bin/env tclsh package require Tk foreach i [ilist .] { if ![catch {$i cget -text} t1] { if ![catch {$i cget -textvar} t2] { if {$t1 != "$t2"} { puts "$i [winfo class $i] [list [$i cget -text]]" } } } }TV: Enlarge all common fonts on all text containing widgets (excepting special defs) a bit:

#! /bin/env tclsh package require Tk foreach i [ilist] { if ![catch {set t [$i conf -font]}] { set t [lindex $t end] $i conf -font "[lreplace $t 1 1 [expr int(0.5+1.2*[lindex $t 1])]]" } }A logarithmic version could also be good. Change 1.2 to get another factor (for instance 0.8). Only works for widgets in the actual hierarchy, not for those not yet instantiated.KBK: It isn't useful, but it has quite the Perl flavor to it:

#! /bin/env tclsh puts [string map {a { P} b { a} c { c} d { T} e ck f cl g ha h od i th j {l } k no l {g } m in n Ju o st p er} nobkipapjgepchmlmdf]GPS: Incrementally display a string:

#! /bin/env tclsh package require Tk set s "Hello World" pack [button .b] set i 1 while 1 { .b config -text [string range $s 0 $i] after [expr {int(rand() * 3000)}] [list incr i] tkwait variable i if {$i >= [string length $s]} break }GPS: Print a list of packages loaded:

#! /bin/env tclsh package require Tk proc packages.loaded? {} { foreach p [package names] { if {![catch {package present $p}]} { puts "$p loaded"} } }RS: Enumerations can be done cutely with aliases:

interp alias {} colornum {} lsearch {red green blue black white} interp alias {} numcolor {} lindex {red green blue black white}GPS: A variation on the enumerations above (RS and I were chatting):

proc enum {type body} { set l [list] set i 0 foreach arg $body { lappend l $arg $i; incr i } interp alias {} $type {} $l }GPS: Choose a color and store what the user has selected in a label:

set i 0 while 1 { set col [tk_chooseColor] if {{} == $col} break pack [label .f$i -bg $col -text $col] incr i }GPS: A mkstemp/tmpname replacement in Tcl:

proc get.unique.file.channel namePtr { upvar $namePtr n while 1 { set n [file join $::env(TEMP) [clock clicks].tmp]] if {![catch {open $n "CREAT EXCL RDWR" } fd]} { return $fd } } }willdye Generate a unique global variable name. Note that in threaded/re-entrant environments, a name clash is still possible (albeit rare). If you're worried about threads, consider "[thread::id]_[clock seconds]_[clock clicks -milliseconds]_[clock clicks]_[expr rand()]''', but I'm not an expert on threading. See also Generating a unique name.

proc tmpVar {{name "tmpVar"}} { while {[info exists ::$name]} { append name _[clock clicks] } set ::$name {} return ::$name }willdye The answer (and question!) to Life, the Universe, and Everything:

#! /bin/env tclsh set Six 1+5 set Nine 8+1 set Life $Six*$Nine puts AnswerToQuestion=[expr $Life](Note: since this wiki is intended for a wide audience, I'll risk spoiling the joke by pointing out that the above program is indeed a joke. See [1] for details.)MEd: The "floating button", press it to fill the "fish tank" with water (works even with a "full-screen tank")

#! /bin/env tclsh package require Tk set x 0.0 place [frame .f -bg blue] -rely 1 -relw 1 -anchor sw place [button .b -text "Fill the Fish Tank" -command {while {$x < 0.85} { set x [expr $x+0.005] place .f -relh $x place .b -rely [expr 1-$x] update after 30 }}] -relx 0.5 -rely 1 -anchor sMEd: Another one liner using the place command. Quite similar to to PT's

*frightened window*, but the button can not "run away" by leaving the window.

place [button .b -text "Click Me" -command {tk_messageBox -message "Got me!"}] -relx 0.5 -rely 0.5 -anchor c bind .b <Enter> {place .b -relx [expr rand()] -rely [expr rand()]}AM: Just a play with words, but the nice thing is there are no special syntactic characters, except for a semicolon in this one:

proc proc exit exit proc exit(It was too early in the morning to try when I concocted this, but perhaps it is possible to make it longer and still not use ", {, [ ...)slebetman: Here's a

**"real"**one-liner. This doesn't cheat by using ";". A one-line slurp:

foreach data [list [read [set f [open $filename]]]] {close $f}Another way of doing it is:

for {set data [read [set f [open $filename]]]} {[close $f]==2} {} {}Yet another way without cheating:

if {[string length [set data [read [set f [open $filename]]]]]} {close $f} {close $f}Or in fact the most straight forward, exploiting the fact that [close] returns an empty string:

set data [read [set f [open $filename]]][close $f]

Here are one line procedures for log to any base.

#Logarithm to any base: proc log {base x} {expr {log($x)/log($base)}} ;# RS #A faster logarithm to base two: proc ld x "expr {log(\$x)/[expr log(2)]}" ;#RS

gold: Here is a one line procedure for the factorial.

proc factorial n { expr {$n < 2 ? 1 : $n * [factorial [incr n -1]]} }; #[RS] recursion limited

Here is a one line procedure for testing a prime number. (See primes)

proc isprime x { expr {$x>1 && ![regexp {^(oo+?)\1+$} [string repeat o $x]]} } #[SMH] returns 1 if prime and zero if not.

JPT: Here's a recursive one-liner that could certainly be optimized:

proc to.binary n {expr {!$n ? 0 : "[to.binary [expr {$n>>1}]][expr {$n&1}]"} } # alternate notation: proc binary n {expr {!$n ? 0 : "[binary [expr {$n>>1}]][expr {$n&1}]"} } # decimal number to binary examples, binary 9 results in 1001, binary 2 results in 10 # also example of recursive procedureOther ways of converting to binary can be found on the binary representation of numbers page.

JCE: So why not just this:

proc sumto n { expr $n * ($n + 1) / 2 }sum of positive numbers to N or sum( 1 2 3 4 ... N) (see Sample Math Programs)alternate notation:

`proc sumit n { expr $n * ($n + 1) / 2}`

gold: Here is a one line procedure for linear interpolation. Where (xx1,yy1) and (xx3,yy3) are picked from a line. An intermediate point is picked at xx2. Solution is for yy2.

proc interlinear {xx1 xx2 xx3 yy1 yy3} { return [expr {((($xx2-$xx1)*($yy3-$yy1))/($xx3-$xx1))+ $yy1 }] }

[gold:] I've transferred some wordy code on pi to the Oneliner's Pie in the Sky.

AMG: I would have done it this way: gold Your solution is more concise.

proc pi {} {expr acos(-1)}AMG: Here's another implementation, using expr's ?: operator instead of if:

proc fib {n} {expr {$n < 2 ? $n : [fib [expr {$n - 1}]] + [fib [expr {$n - 2}]]}}

willdye gave us (in the chat) links to OneLiners in awk [2] and sed [3]. Thanks.