Updated 2017-11-23 22:31:25 by pooryorick

Here's some "few-liner" code examples, contributed by Richard Suchenwirth, <YOUR NAME HERE>, ... . Help yourself! Add comments when you know it better! Use the Edit link at bottom of page for contributing! Short procs (fitting between thumb and index finger ;-) go right here, longer ones get their own pages and are linked on this page.

1-Bits in a positive int  edit

See Bit Twiddling

ASCII map  edit

see Additional string functions

A simple Arabic renderer  edit

Arabic from ASCII transliteration (Buckwalter) to Unicode, from abstract characters to glyphs

Application home  edit

Find the real/exact/full path of the running script
proc app_home {} {
    set old_dir [pwd]
    set f      $::argv0
    set f_path [file dirname $f]
    set f_tail [file tail $f]
    cd  $f_path
    set f $f_tail
    while {![catch {file readlink $f} result]} {
        cd [file dirname $result]
        set f_path [pwd]   ;# pwd makes path absolute
        set f_file [file tail $result]
        set f [file join $f_path $f_file]
    cd $old_dir
    return $f_path

I can not remember where I took this originally from. Sorry Andreas Wilm

Lars H: Here is another approach to the above, which also returns the list of all "home" directories (a link may point to another link, and then to yet another, etc.)
proc app_homes {} {
    set res [list]
    set me [info script]
    catch {
       while {1} {
          set mydir [file dirname $me]
          lappend res $mydir
          set me [file join $mydir [file readlink $me]]
       }; # Eventually the [file readlink] errors
    return $res

It could probably do with some file normalizes. However, a comparison of $::argv0 and [info script] from a portability perspective could be interesting.

SG: I'm probably just missing something (I usually do) but what does any of this do that pwd doesn't?

Lars H: Lots of things. For one, the script might have been started as
% tclsh /full/path/to/script.tcl

For another, the script might have been marked executable and was found by a search along the PATH. There is no relation between the result of pwd and the script location in either of these cases.

Array-preserving Order of Elements  edit

if you want to keep a history in what sequence

array elements were added, have a look at Numbered arrays

Assertions  edit

can be implemented in millions of ways, here is one:
proc Assert {condition} {
    if {[catch {uplevel [list expr $condition]} n] || $n == "" || $n == 0} {
        Puts "Assertion failed (result $n), in:"
        set prefix ""
        for {set i [info level]} {$i} {incr i -1} {
            append prefix "  "
            puts "$prefix'[info level $i]'"
            # try to call a failure handler to collect more info
        if {![catch ::AssertionFailureHandler msg] && $msg != ""} {
            append condition " ($msg)"
        #error "Assertion failed: $condition"
        puts "Assertion failed: $condition"
} ;# JCW

And of course disabled simply by overriding the above definition with "proc Assert {x} {}".

AtExit Handlers  edit

cleanup on program exit for you.

Autokill  edit

kill an application after a resettable delay:
proc autokill {delay {id ""}} {
    if {$id != ""} {after cancel $id}
    set id [after [expr int($delay * 1000 * 60)] {exit}]
    proc autokill "[list delay [list id $id]]" [info body autokill]
autokill 30; #exit after a 30 minute delay

call it again, the same way to reset the timer. Useful in situations where an application uses a lot of network resources, and has the potential for a user to leave it running while not in use. -- AJB

automatic .bak files  edit

automatically backs up files N levels deep to avoid overwrites

Average  edit

See Additional math functions

Base 64 encode/decode  edit

shamelessly stolen from Steve Uhler and Brent Welch

Cartesian product of a list of lists  edit

Character frequency counts  edit

see tally: a string counter gadget

Clock clicks resolution  edit

Unlike most time-related things handled by Tcl, the unit of the value returned by clock clicks is documented to be platform-dependent (even though the microsecond is very frequent), so it might be good to check roughly how many clicks there are in a second. The following one-liner will do that:
expr {-[clock clicks] + [after 1000; clock clicks]}

configuration files  edit

this proc can be added to an application
proc configfile {name} {
    global $name
    set data [read [set fh [open [info script] r]]]
    close $fh
    array set $name $data
    catch {unset ${name}(configfile) ${name}(#)}
    return -code return

and then at the top of a file you wish to be loaded as a configuration file simply add configfile var

of course you must load the file
if {[catch {source myconfigfile} err]} {
    # some error occured

the contents of the file then end up in global variable var

an example file:
configfile options
setting value
setting2 {some large value}

this was developed for Easy User Configurable Menus

Compact integer list to list  edit

{1-4 6-8} => {1 2 3 4 6 7 8}
proc clist2list {clist} {
    #-- clist: compact integer list w.ranges, e.g. {1-5 7 9-11}
    set res {}
    foreach i $clist {
        if [regexp {([^-]+)-([^-]+)} $i -> from to] {
            for {set j [expr $from]} {$j<=[expr $to]} {incr j} {
                lappend res $j
        } else {lappend res [expr $i]}
    return $res
} ;#RS

Compact list to list  edit

{2-4 a c-e A C-E} => {2 3 4 a c d e A C D E}

As above, this one handles a-z and A-Z as well as the proposed 0-9.
proc clist2list {{args ""}} {
    if {[llength $args] != 1} {
        error {wrong # args: should be "clist2list clist"}
    set clist [lindex $args 0]
    # Ensure clist is in list format, if not then make it so.
    if {[catch {llength $clist}]} {set clist [split $clist]}
    array set map [list \
        a  1   b  2   c  3   d  4   e  5 \
        f  6   g  7   h  8   i  9   j 10 \
        k 11   l 12   m 13   n 14   o 15 \
        p 16   q 17   r 18   s 19   t 20 \
        u 21   v 22   w 23   x 24   y 25 \
        z 26                             \
         1 a    2 b    3 c    4 d    5 e \
         6 f    7 g    8 h    9 i   10 j \
        11 k   12 l   13 m   14 n   15 o \
        16 p   17 q   18 r   19 s   20 t \
        21 u   22 v   23 w   24 x   25 y \
        26 z]
    set re_syntax {^(([0-9]+-[0-9]+)|([A-Z]-[A-Z])|([a-z]-[a-z]))$}
    set res {}
    foreach i $clist {
        if {[regexp $re_syntax $i -> range a b c]} {
            set range [split $range -]
            set start [lindex $range 0]
            set stop  [lindex $range 1]
            switch -- [expr {($a!="")?1:($b!="")?2:($c!="")?3:4}] {
                1 {
                    for {set j $start} {$j <= $stop} {incr j} {
                        lappend res $j
                2 {
                    set j $map([string tolower $start])
                    for {} {$j <= $map([string tolower $stop])} {incr j} {
                        lappend res [string toupper $map($j)]
                3 {
                    for {set j $map($start)} {$j <= $map($stop)} {incr j} {
                        lappend res $map($j)
        }       else {lappend res $i}
    }; return $res
} ;# Carl M. Gregory, MC_8 -- http://mc.purehype.net/

Country name server  edit

CH <-> Switzerland.. see Language/Country name servers

Credit card check digit validation  edit

see Validating credit card check digits

Cross sum of a digit sequence  edit

see Additional math functions

csv strings  edit

comma-separated values, as exported e.g. by Excel, see Parsing csv strings

Date scanning  edit

clock scan older versions (pre 8.3?) did not handle the frequent (ISO-standardized) format YYYY-MM-DD hh:mm:ss. Here's a workaround by Hume Smith to be used in the place of clock scan for such cases:
proc yyyy-mm-dd {dtstring} {
    set time {} ;# this allows pure dates without time
    scan $dtstring %d-%d-%d%s year month day time
    clock scan "$month/$day/$year $time"
} ;# RS

and another by Bruce Gingery:
proc YYYYMMDD2MDY {dtstring} {
    set patt {^[1-2][0-9]([0-9][0-9])-([0-9][0-9]?)-([0-9][0-9]?)}
    set subs {\2/\3/\1}
    regsub $patt $dtstring $subs dtstring
    return $dtstring
# or return [clock scan $dtstring]

Date and Time in a Handy Format  edit

like 22.07.99,19:59:00
proc date,time {{when ""}} {
      if {$when == ""} {set when [clock seconds]}
      clock format $when -format "%d.%m.%y,%H:%M:%S"
} ;#RS

Debugging Aid For Production Code  edit


Disk free capacity  edit

in Kilobytes:
proc df-k {{dir .}} {
    switch $::tcl_platform(os) {
    FreeBSD -
    Linux -
    OSF1 -
    SunOS {
        # Use end-2 instead of 3 because long mountpoints can 
        # make the output to appear in two lines. There is df -k -P
        # to avoid this, but -P is Linux specific afaict
        lindex [lindex [split [exec df -k $dir] \n] end] end-2
    HP-UX {lindex [lindex [split [exec bdf   $dir] \n] end] 3}
    {Windows NT} {
        expr [lindex [lindex [split [exec cmd /c dir /-c $dir] \n] end] 0]/1024
            # CL notes that, someday when we want a bit more
            #    sophistication in this region, we can try
            #    something like
            #       secpercluster,bytespersector, \
            #       freeclusters,noclusters = \
            #            win32api.GetDiskFreeSpace(drive)
            #    Then multiply long(freeclusters), secpercluster,
            #    and bytespersector to get a total number of
            #    effective free bytes for the drive.
            # CL further notes that
            #    explains use of PBHGetVInfo() to do something analogous
            #    for MacOS.
    default {error "don't know how to df-k on $::tcl_platform(os)"}
} ;#RS

for Win9x replace cmd with command. Note that W98(SE)? may report as Windows 95. So,
   {Windows 95} {
        expr [lindex [lindex [split [exec command /c dir /-c $dir] \n] end] 0]/1024

Every time df comes up in clt, I think I should write one that works for us *poor souls* who are stuck in the world of win9x. So the other night...:
proc free_win { } {
    set res [eval exec [auto_execok dir]]
    set var [expr [llength $res] -3]
    set free_space [lrange $res $var end]
    return $free_space

This works on win95, 98 and NT, with tcl/tk 8.0 through 8.4a2. If anybody tests it with win2000 or ME, please let us know the result.

so 04/20/01

do ... while  edit

See also do...until in Tcl

do ... while loop structure, as in C

loop structure. By Morten Skaarup Jensen
proc do {cmds while expr} {
    uplevel  $cmds
    uplevel "while [list $expr] [list $cmds]"
# Example of use
set x 0
do {
    puts $x
    incr $x
} while {$x < 10}

This doesn't work 100% with breaks. Catch might be the best way to improve this.

Drive letters  edit

on Windows -- "file volumes" lists drives even if there's no medium in it. mailto:[email protected] contributed this code to list mapped and existing drives:
proc drives {} {
    foreach drive [list a b c d e f g h i j k l m n o p q r s t u v x y z] {
        if {[catch {file stat ${drive}: dummy}] == 0} {
            lappend drives $drive
    return $drives

English number speller  edit

e.g. en:num 29 => twenty-nine, see Bag of number/time spellers

Executable scripts  edit

Tcl scripts with initial magic can be called directly from a shell prompt. In UNIX, you can specify the path to tclsh (or wish, as you wish) in a special comment line, e.g.

but this requires adaptation to the local situation. More flexible is the following, which finds the way itself:
 # the next line restarts using -*-Tcl-*-sh \
 exec tclsh "$0" ${1+"$@"}

Tom Tromey explains the ${1+"$@"} bit in exec magic

The -*- stuff instructs emacs to treat this file in Tcl mode. In both cases, do a chmod +x filename for real availability.

For Win95, Rolf Schroedter reports the following to work: file foo.bat:
        ::set run_dos { ;# run tcl-script from BAT-file
        tclsh80 %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
        puts "Tcl $tcl_patchLevel"

Small addition: This has at least on NT the problem, that, when started from a CMD.EXE window that this window gets closed on the "exit" call. I cannot find any command to just terminate the running script, so I use:
        ::set run_dos { ;# run tcl-script from BAT-file
        tclsh80 %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
        goto EOF

        # your TCL code goes here
        # ...
        ::set run_dos \

Might get a problem if ":EOF" is a valid Proc in your program and gets called in the main program, though. - Michael Teske

This works for me on NT:
        ::set run_dos {
                @tclsh %~f0 %*
                exit /b

It has the added advantage that all command line arguments are given to tclsh ("%*") and that the tclsh gets the full path of the file to start ("%~f0") - Klaus Marius Hansen - See also DOS BAT magic

environment variables  edit

What are the values of my environment variables? I use this in a wish shell while writing programs in other languages.
foreach e [lsort [array names env]] { puts "$e = $env($e)" }

expr  edit

Files and sockets in use  edit

For Tcl 8.4 the file channels builtin command does this.

by Phil Ehrens <[email protected]>

UNIX only
proc countFilehandles {{limit 1024}} {
    set i 0; set socks {}; set files {}
    while {$i < $limit} {
        if ![catch {tell sock$i}] {lappend socks sock$i}
        if ![catch {tell file$i}] {lappend files file$i}
        incr i
    return [list $socks $files]

Fraction Math  edit

See Fraction Math -- kbk [2]

2.75 <-> 2-3/4. Not exact, resolution can be specified (default 1/8)
proc fracn2num {args} {
    if ![regexp {(([0-9]+)[ -])?([0-9]+)/([0-9]+)} $args -> - int num den] {
        return $args
    expr $int+double($num)/$den
proc num2fracn {n {r 8}} {
    if [set in [expr int($n)]]==$n {return $n}
    if $in {set res $in-} else {set res {}}
    return $res[join [simplify [expr int(round(($n-$in)*$r))] $r] /]
proc simplify {p q} {
    set g [gcd $p $q]
    list [expr $p/$g] [expr $q/$g]
} ;#RS (frac2num handling for things like '2 3/4' added by PSE)

offers some advances on the ''Fraction math' section.

freeMem: Freeing memory the Tcl way! edit

Permits evaluation of code in a manner which does NOT cause the interpreter to permanently allocate heaps of heap.

IEEE binary float to string conversion  edit

Integer Check  edit

See Additional math functions

Integer maximum  edit

see Additional math functions

Integer width  edit

in bits (by Jeffrey Hobbs):
proc int_bits {} {
    set int 1
    set exp 8; # Assuming a minimum of 8 bits
    while {$int > 0} { set int [expr {1 << [incr exp 8]}] }; # Increment in steps of 8 as integer length format is 8 bits, 16 bits, 32 bits, ....
    return $exp

Interrupting loops: how to introduce a "stop button" for runaway code  edit

intgen: unique integer ID generator, at first call gives 1, then 2, 3, ...  edit

Note how the proc rewrites its own seed default, so no global variable is needed:
proc intgen {{seed 0}} {
    proc intgen "{seed [incr seed]}" [info body intgen]
    set seed
} ;# RS

number speller, French edit

fr:num 99 => quatrevingt dix-neuf

see Bag of number/time spellers

German number speller  edit

see Bag of number/time spellers

time speller, German  edit

converts exact HH:MM times to fuzzy colloquial wording, optional Northern (viertel vor vier) or Southern style (dreiviertel vier) ;-)

see Bag of number/time spellers

money amount speller, Russian  edit

see Bag of number/time spellers

getPid  edit

map pids to prog names and vice-versa

gifBalls  edit

Globbing globals  edit

Want to import several globals in one go, with glob wildcards (similar to the public statement in VB)? This comes from David Cuthbert (mailto:[email protected]):
proc globalpat {args} {
    foreach pattern $args {
        set varnames [info globals $pattern]
        if {[llength $varnames] != 0} {
            uplevel 1 global $varnames

To use:
proc hello {} {
    globalpat *tcl*
    puts $tcl_patchLevel

% hello

GPS/UTC Time Conversion Functions  edit

Tcl implementation of Simpson's Rule numerical integration.

Greeklish  edit

turns a strict ASCII transliteration into Greek Unicodes

Greatest common denominator  edit

now on its own page

Heblish  edit

turns a strict ASCII transliteration into Hebrew Unicodes.

hotgrep  edit

it beats as it sweeps as it cleans!

integrate  edit

IP address: find out your own. This beauty came from [email protected]  edit

(note that xxx should be the name of a procedure which never gets called, so need not exist ;-):

[ip:adr used to be here.]

Many Tcl programmers wonder how to find my own IP address.

jpeg: Reading JPEG image dimensions  edit

Language name server, zh <-> Chinese ... see Language/Country name servers  edit

Line Counting see Counting a million lines  edit

List Frequency Counts  edit

see Counting Elements in a List

List spread to scalar vars, e.g. lspread {1 2 3} to a b {c 0}  edit

proc lspread {list "to" args} {
    foreach a $args v $list {
        upvar [lindex $a 0] var ;# name maybe in list with default
        if {$v==""} {set var [lindex $a 1]} else {set var $v}
} ;#RS

List well-formedness: check a string whether it could be parsed into a list (braces balanced, whitespace after closing braces)  edit

joint effort by Bob Techentin and Donald Porter in news:comp.lang.tcl:
proc islist {s} {
    expr ![catch {eval list $s}]
} ;# RS

Hmmm... let's think twice about this one. We want to test the list well-formedness of an unknown string, so we probably don't know much about $s. It's dangerous to [eval] something you don't know. Consider this:
set s {a; file delete -force ~}
islist $s    ;# Hope you have backups!

Try this instead:
proc islist {s} {expr ![catch {llength $s}]} ;# DGP

Indeed. The former returns bad values for most things containing '$', or [,] etc. The latter does what you want.

List with duplicates removed, and keeping the original order:  edit

proc luniq {L} {
    # removes duplicates without sorting the input list
    set t [list]
    foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}}
    return $t
} ;# RS
proc lun {L} {
    set t [list]
    foreach i $L {if { $i ni $t } { lappend t $i }}
    return $t
} ;# EE

ls -l in Tcl  edit

ls: make glob look more like the Unix thing  edit

proc ls {{fn *}} {
    lsort [glob -nocomplain $fn .$fn]
} ;#RS

Also see ls -l in Tcl....

Mail sender (minimalist, Unix only):  edit

proc mailto {name subj text} {
    set f [open "|mail $name" w]
    puts  $f "Subject: $subj\n\n$text"
    close $f

Cf. http://www.phaseit.net/claird/comp.lang.tcl/tcl-examples.html#mail

using tcllib: PT
 package require mime
 package require smtp

 set tok [mime::initialize -canonical text/plain -string "Hello, World!"]
 smtp::sendmessage $tok \
    -header {From "[email protected]"} \
    -header {To "You <[email protected]>"} \
    -header {Subject "Simple Tcllib mailing."}
 mime::finalize $tok

Mail checker, even more minimalist, Unix only:  edit

proc haveMail {} {
    expr [file size /var/mail/$::env(USER)]>0

yet another Tcl mail handler! (for UNIX)

map - the traditional list functional that applies an operation to every member of a list.  edit

proc map {command list} {
    set res [list]
    foreach item $list {
        lappend res [uplevel 1 [concat $command [list $item]]]
    set res

See also Steps towards functional programming for related discussions.

Maximum and minimum Everybody writes them himself, here's mine:  edit

see Additional math functions

Morse en/decoder: works both ways ASCII <-> Morse, see Bag of number/time spellers ''-  edit

yah, well, it has to go somewhere... JC''

N-gram frequency counts, see tally: a string counter gadget  edit

Namespace variables listed local names of variables as defined in a namespace:  edit

proc nsvars {ns} {
    regsub -all ::${ns}:: [info vars ${ns}::*] "" res
    set res
}  ;# RS

alternatively (requires map operator from elsewhere on this page) - DKF
proc nsvars {{ns {}}} {
    map [list namespace tail] [info vars ${ns}::*]

NUKE: delete a file when its descriptor is closed:  edit

proc NUKE { filename fid } {
     if { ! [ llength [ file channels $fid ] ] } {
         file delete $filename
     } else {
         after 1000 "NUKE $filename $fid"

DKF - Alternatively, rewrite the close and exit commands...
rename close orig_close_NUKE
rename exit orig_exit_NUKE
proc close {fid} {
    global NUKE errorInfo errorCode
    set code [catch {orig_close_NUKE $fid} msg]
    set ei $errorInfo
    set ec $errorCode
    if {[info exist NUKE($fid)]} {
        file delete $NUKE($fid)
        unset NUKE($fid)
    return -code $code -errorinfo $ei -errorcode $ec $msg

proc exit {{code 0}} {
    global NUKE
    foreach fid [array names NUKE] {catch {close $fid}}
    orig_exit_NUKE $code

proc NUKE {filename fid} {
    global NUKE
    set NUKE($fid) $filename

proc tmpfile {{tmpdir /tmp}} {
    global SEQID; if {![info exist SEQID]} {set SEQID 0}
    set basename [file rootname [file tail $::argv0]]
    set filename [file join $tmpdir ${basename}.[pid].[incr SEQID].tmp]
    set fid [open $filename w+]
    NUKE $filename $fid
    return $fid

Number commified (added culture-dependent thousands mark):  edit

proc number_commify {n {sign ,}} {
    # structure a decimal like 123,456.78 123'456.78, or 123.456,78
    if {$sign=="."} {regsub {[.]} $n "," n}
    set trg "\\1$sign\\2"
    while {[regsub {^ *([-+]?[0-9]+)([0-9][0-9][0-9])} $n $trg n]} {}
    return $n
} ;# added " *" to regexp, so leading blanks as from format work - RS

A one-liner alternative by Peter Spjuth (in the Tcl chatroom, 2004-10-05) uses modern regexp features:
proc commify number {
    regsub -all {\d(?=(\d{3})+($|\.))} $number {\0,}

See also Human readable file size formatting

Option Parser: expandOpts  edit

proc Instrumentation  edit

You can add code to every procedure in your Tcl application by redefining the proc command to include special code. Then each proc definition will include your code. This is commonly done for debuggers and profilers. For example, if you wanted to count each time your procedures are called, you could include code like this example, courtesy of Bryan Oakly on comp.lang.tcl.
rename proc _proc
_proc proc {name arglist body} {
    set body "incr ::proc_counter($name)\n$body"
    set ::proc_counter($name) 0
    uplevel [list _proc $name $arglist $body]

See also Printing proc sequence.

proc validity in context: validProc  edit

returns 1 if the procedure name or wildcard pattern exists in the current context (including all child namespaces), returns 0 if it does not. Sort of a [info commands]

for heavy namespace users.

Proc name: know your own  edit

this one-liner wraps introspection. Useful for generated widget handlers, whose name is like the widget pathname, so they know what their widget is called:
proc proc_name {} {
    lindex [info level -1] 0
} ;#RS

Railway vehicle number validation: UIC vehicle number validator  edit

Random Numbers  edit

see Additional math functions

Random selection from a list  edit

proc random_select list {
    lindex $list [expr int(rand()*[llength $list])]
} ;#RS

Roman Numbers  edit

Bag of number/time spellers

SCCS control string bypass  edit

When you ckeck in a file with SCCS, certain strings in the file are replaced, e.g. %H% with the current date, %M% with the current filename. This can cause problems if your code contains e.g. set now [clock format [clock seconds] -format %y%m%d-%H%M%S] but you can hide percent signs by replacing them with the equivalent \x25, so SCCS doesn't see them but the Tcl parser does (RS)
set now [clock format [clock seconds] -format %y%m%d-\x25H\x25M\x25S]

Here's my method - use append to build up the string:
append datestring %y %m %d - %H %M %S
set now [clock format [clock seconds] -format %datestring]

Marty Backe

Self-test code  edit

See main script.

Set operations: A set of Set operations  edit

Shuffle a list -- various ways of permuting a list into (pseudo-)random sequence.  edit

Silly Asynchronous Event Example  edit

# initialise our trigger variable
set foo {}

# a proc to call when the trigger variable is written
proc bye {args} { exit }

# some code to push into the event loop for 0.5 sec
# that produces visible output, and writes the trigger var
after 500 {
   puts "what a question!"
   set foo {}

# some other code that gets pushed into the loop for 0.2 sec
after 200 {
    puts "where did I come from?"

# some code that is executed immediately
puts "and then he asked:"

# set a trace on "foo", so that when it is written the
# procedure "bye" is called
trace variable foo w bye

# initiate an event loop (this is what "wish" does)
vwait enter-mainloop

(DKF: And this is supposed to be a good feature of Tcl? Hmmm...)

Simple Arbitrary Precision Math Procedures -- DKF  edit

Size of running Tcl process (Unix only)  edit

sleep  edit


Sort on String Length / Password Generator  edit

proc {lengthCompare} {w1 w2} {
    set sl1 [string length $w1]
    set sl2 [string length $w2]
    if {$sl1 > $sl2} {
        return 1
    } elseif {$sl1 == $sl2} {
        return 0
    } else {
        return -1

set data {asdf asdfasdf asdfa asd asdfasd}
# The following will sort the command by String Length
set data [lsort -command lengthCompare $data]

# More info -
# The following makes a password out of the data by using
# the word alone if it is 5 chars or more, (eg asdfasd)
# and by finding a match for it if it is less (eg asd-asdf)
# than 5 chars.  The password can be max of 8 chars in
# this example.

# This was used on a stripped-down version of the words
# file for the UNIX spell checker to generate random
# passwords.

set datalength [llength $data]

set word1 [lindex $data [expr {int([expr {rand()*$datalength}])}]]
set w1l [string length $word1]

if {$w1l < 5} {
    set pos [expr {int([expr {rand()*$datalength}])}]
    # This speedily decrements the random number generated
    # until the size is small enough to fit in an 8 char
    # field.
    while {[expr {8-$w1l-[string length [lindex $data $pos]]}] < 1} {
        set pos [expr {int([expr {rand()*$pos}])}]
    set word2 [lindex $data $pos]
    append word1 "-$word2"
    set word1 "$word1"

# Output the password
puts "${word1}\n"

String to list  edit

collapsing splitchar sequences

soundex  edit

Splitting strings into words  edit

Stack operations on lists: lpush prepends, lpop removes first element.  edit

lpop and lappend make a FIFO queue.
proc lpush {_list what} {
   upvar $_list L
   if ![info exists L] {set L {}}
   set L [concat [list $what] $L]
proc lpop {_list} {
   upvar $_list L
   if ![info exists L] {return ""}
   set t [lindex $L 0]
   set L [lrange $L 1 end]
   return $t
} ;#RS

also see: yet another stack package and the Chart of proposed list functionality

Stack trace: just sprinkle a few of these "probes" around to see the stack at that point  edit

shamelessly swiped from Cameron Laird
proc probe {} {
    puts "Stack trace:"
    for {set i [expr [info level] - 1]} {$i} {incr i -1} {
        puts "  Processing '[info level $i]'."
} ;# JCW

For more on this subject, see "Printing proc sequence".

Stats  edit

simple statistical functions (mean, stddev, cov)

String to list  edit

[split $s] alone operates on each instance of the splitchar (default:space), so sequences of spaces will produce empty list elements.

[eval list $s] collapses whitespace sequences in one, but errors on unbalanced braces etc. The following proc should join the best of both worlds:
proc string2list s {
    if [catch {eval list $s} res] {
        set res [list]
        foreach i [split $s] {
            if {$i!=""} {lappend res $i}
    set res
} ;#RS
% string2list {a   b c     d}
a b c d
% string2list "a   b c  {"
a b c \{
% string2list {unbalanced "}
unbalanced {"}

Note that this suffers from the same dangers as explained in the List well-formedness test above. Modifications for safety are left as an exercise for the reader (or the next Wiki visitor). You have been warned. - DGP

EE: This seems as good a place as any to ask this question... Is there any effective difference, in general, between catch {eval command $args} and catch [linsert $args 0 command] ?

Yes: The latter is more efficient. See pure list and many ways to eval for discussion.

DGP: Yes, see those pages, but efficiency differences are not the main point. Those two examples will process newlines in the arguments differently. Newlines are significant to eval but not necessarily preserved by list-processing commands.

Swap 2 values efficiently  edit

Swaps value of a with b without overhead of copying to a temporary variable:
foreach {a b} [list $b $a] break

Works for a and b as numbers, strings and lists but not arrays.

AMG: Here's a faster method that works using Tcl 8.5+.
lassign [list $b $a] a b

On my machine, [lassign] takes 3.2239 microseconds per iteration, whereas [foreach] takes 8.562 microseconds per iteration.

subcommands: value-added switch, FREE error message ;-)  edit

Tabs to spaces, and back: courtesy Jeffrey Hobbs  edit

# untabify --
#   removes tabs from a string, replacing with appropriate number of
#   spaces. Arguments:
#   str         input string
#   tablen      tab length, defaults to 8
# Returns:
#   string sans tabs
proc untabify {str {tablen 8}} {
    set out {}
    while {[set i [string first "\t" $str]] != -1} {
        set j [expr {$tablen-($i%$tablen)}]
        append out [string range $str 0 [incr i -1]][format %*s $j { }]
        set str [string range $str [incr i 2] end]
    return $out$str
# tabify --
#   converts excess spaces to tab chars. Arguments:
#   str         input string
#   tablen      tab length, defaults to 8
# Returns:
#   string with tabs replacing excess space where appropriate
proc tabify {str {tablen 8}} {
    ## We must first untabify so that \t is not interpreted to be 1 char
    set str [untabify $str]
    set out {}
    while {[set i [string first { } $str]] != -1} {
        ## Align i to the upper tablen boundary
        set i [expr {$i+$tablen-($i%$tablen)-1}]
        set s [string range $str 0 $i]
        if {[string match {* } $s]} {
            append out [string trimright $s { }]\t
        } else {
            append out $s
        set str [string range $str [incr i] end]
    return $out$str

AMG: The above [untabify] does not handle newlines. They are treated like any other character and do not reset the column count. If newlines can show up in the input, try this instead:
proc tabsToSpaces {str {tabStop 8}} {
    set result {}
    set newline {}
    foreach line [split $str \n] {
        set out {}
        while {[set i [string first \t $line]] != -1} {
            set j [expr {$tabStop - ($i % $tabStop)}]
            append out [string range $line 0 [incr i -1]][format %*s $j " "]
            set line [string range $line [incr i 2] end]
        append result $newline $out $line
        set newline \n
    return $result

tailf tail -f piped to egrep, in pure tcl  edit

try ... finally ...  edit

telnet  edit

Sort of

client and server... but not exactly as in RFC854.

timers.tcl - benchmarking/timing package  edit

UIC vehicle number validator - as used on European railways  edit

Unit converter -- Does km/h <-> mph, DM <-> EUR, C <-> F ...  edit

URI detector for arbitrary text as a regular expression  edit

UTC -- see GPS/UTC Time Conversion Functions  edit

Validating credit card check digits  edit

Visual Studio 2003 .sln file parser  edit

Word frequency counts, see tally: a string counter gadget  edit

Plain string substitution  edit

Prior to version 8.1.1, the only string substitution facility in the Tcl core uses regular expressions, which for substituting special text can be a pain. Here's a procedure to do a plain substition (with no extra features). See "string map" in newer versions.
proc plainsub {text item replacewith} {
    set len [expr [string length $item]-1]
    while {[set pos [string first $item $text]] != -1} {
        set text [string replace $text $pos [expr $pos+$len] $replacewith]
    return $text
} ;#FW

RS What's bad with the following?
set text [string map [list $item $replacewith] $text]

FW Nothing, I'm pretty much just starting out coding, for a second there I thought I'd made something useful ;) CL interrupts: Nah, the correct answer is that Richard's set text ..." is bad because "string map ..." only appeared with 8.1.1.

As bad things go, that's only a tiny badness.

Split on Punctuation  edit

FW: breaks a line of text into an alternating list of words and punctuation.

For example:
 (bin) 8 % break_text "A sentence, merely.  Move along."
 A { } sentence {, } merely {.  } Move { } along .

This would be used for most any language processing task, where you would break a sentence into words, perform operations on the words, then put it back together. Here it is:
proc break_text {text {splitchars {, .";!:}}} {
    # Escape all the split characters so brackets, ^ etc. will be accepted.
    set regexp "\[\\[join [split $splitchars ""] \\]\]+|$"
  set wp [list]
  set pos 0
  for {set pos 0} {$pos < [string length $text] && [regexp -indices -start $pos $regexp $text matches]}
      {set pos [expr {[lindex $matches 1] + 1}]} {

    lappend wp \
      [string range $text $pos [expr {[lindex $matches 0] - 1}]] \
      [eval string range [list $text] $matches]
  return $wp

update: Now you can break by a character set of your choice by the optional second argument. And returns a flat list rather than a list of lists, for better use by foreach, etc.

Sample Math Programs  edit