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.
NEW:
Arabic from ASCII transliteration (Buckwalter) to Unicode, from abstract characters to glyphs - see A simple Arabic renderer
Array preserving order of elements: if you want to keep a history in what sequence array elements were added, have a look at Numbered arrays
ASCII map No algorithm at all, but may come in handy ;-)
proc ascii {} {return { 00 nul 01 soh 02 stx 03 etx 04 eot 05 enq 06 ack 07 bel 08 bs 09 ht 0a nl 0b vt 0c np 0d cr 0e so 0f si 10 dle 11 dc1 12 dc2 13 dc3 14 dc4 15 nak 16 syn 17 etb 18 can 19 em 1a sub 1b esc 1c fs 1d gs 1e rs 1f us 20 sp 21 ! 22 " 23 # 24 $ 25 % 26 & 27 ' 28 ( 29 ) 2a * 2b + 2c , 2d - 2e . 2f / 30 0 31 1 32 2 33 3 34 4 35 5 36 6 37 7 38 8 39 9 3a : 3b ; 3c < 3d = 3e > 3f ? 40 @ 41 A 42 B 43 C 44 D 45 E 46 F 47 G 48 H 49 I 4a J 4b K 4c L 4d M 4e N 4f O 50 P 51 Q 52 R 53 S 54 T 55 U 56 V 57 W 58 X 59 Y 5a Z 5b [ 5c \ 5d ] 5e ^ 5f _ 60 ` 61 a 62 b 63 c 64 d 65 e 66 f 67 g 68 h 69 i 6a j 6b k 6c l 6d m 6e n 6f o 70 p 71 q 72 r 73 s 74 t 75 u 76 v 77 w 78 x 79 y 7a z 7b { 7c | 7d } 7e ~ 7f del }} ;#RS
Assertions 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" exit } } ;# JCW
And of course disabled simply by overriding the above definition with "proc Assert {x} {}".
automatic .bak files automatically backs up files N levels deep to avoid overwrites
Average (arithmetic mean) of a list of numbers:
proc average L {expr ([join $L +])/[llength $L].}
Note that empty lists produce a syntax error. The dot behind llength casts it to double (not dangerous here, as llength will always return a non-negative integer) -- RS
Base 64 encode/decode shamelessly stolen from Steve Uhler and Brent Welch
1-Bits in a positive int: count the number of bits of value 1 in an integer (sign-extended for negatives, so better use positives only):
proc nbits n { set f [format %X $n] set res 0 foreach nybble {0 1 2 3 4 5 6 7 8 9 A B C D E F} \ bits {0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4} { set res [expr $res+$bits*[regsub -all $nybble $f - -]] } set res } ;# RS
More than 30 times faster, and works for negative numbers too:
proc popcount { i } { # count the population of ones in the integer i set pop 0 while { $i != 0 } { incr pop set i [expr { $i & ( $i - 1 ) }] } return $pop } ;# kbk [http://titania.crd.ge.com/people/kennykb.html]
Character frequency counts, see tally: a string counter gadget
Compact integer list to list {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
Country name server, CH <-> Switzerland.. see Language/Country name servers
Credit card check digit validation: see Validating credit card check digits
Cross sum of a digit sequence, e.g. an integer:
proc cross_sum {s} {expr [join [split $s ""] +]} ;# RS
Beautiful shimmering: s goes from string to list to string to int ;-)
csv strings: comma-separated values, as exported e.g. by Excel, see Parsing csv strings
Date and time in a handy format 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
Date scanning: clock scan can handle lots of formats, but regrettably not the frequent (ISO-standardized) 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] }
Debugging Aid For Production Code -PSE
Disk free capacity, in Kilobytes:
proc df-k {{dir .}} { switch $::tcl_platform(os) { FreeBSD - Linux - OSF1 - SunOS {lindex [lindex [split [exec df -k $dir] \n] end] 3} 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 #http://developer.apple.com/techpubs/mac/Files/Files-96.html # explains use of PBHGetVInfo() to do something analogous # for MacOS. } default {error "don't know how to df-k on $::tcl_platform(os)"} } } ;#RS
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 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. See also do...until in Tcl
Drive letters 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, e.g. en:num 29 => twenty-nine, see Bag of number/time spellers
Event loop magic can your scripting language do this?
#!/bin/sh # the next line restarts using -*-Tcl-*-sh \ exec tclsh "$0" ${1+"$@"} ;## 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 suppposed to be a good feature of Tcl? Hmmm...)
Executable scripts: 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.
#!/tools/bin/tclsh
but this requires adaptation to the local situation. More flexible is the following, which finds the way itself:
#!/bin/sh # 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 exit } 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 \ :EOF
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
expandOpts Option Parser
expr: see Importing expr functions - expr problems with int
File mode, Unix style returns something like drwxr--r--
proc file:mode fn { file stat $fn t if [file isdirectory $fn] { set prefix "d" } else { set prefix "-" } set s [format %o [expr $t(mode)%512]] foreach i { 0 1 2 3 4 5 6 7} \ j {--- --x -w- -wx r-- r-x rw- rwx} { regsub -all $i $s $j s } return $prefix$s } ;#RS
File line termination CR and/or LF? Donal Fellows shows the way:
proc file:lineterm {filename} { set fd1 [open $filename r] set fd2 [open $filename r];# Avoids most synch problems... fconfigure $fd2 -translation binary set EOLidx [string length [gets $fd1]] close $fd1 read $fd2 $EOLidx set EOLchars [read $fd2 2] close $fd2 if {[string equal $EOLchars "\r\n"]} { return "crlf" ;# DOS/Windows } elseif {[string equal [string index $EOLchars 0] "\r"]} { return "cr" ;# Mac } elseif {[string equal [string index $EOLchars 0] "\n"]} { return "lf" ;# Unix } else { return "unknown" } }
File reader: takes a filename, returns the lines of that file as a list. Trivial algorithm, but note the "whitespace sugar": mentions of a variable are vertically aligned to indicate data flow ;-)
proc file:lines {fn} { set f [open $fn r] set t [read $f [file size $fn]] close $f split $t \n } ;#RS
Files and sockets in use, by Phil Ehrens <[email protected]> Sorry, 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 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)
But see Fraction Math -- kbk [L2 ]
Freeing memory the Tcl way! Permits evaluation of code in a manner which does NOT cause the interpreter to permanently allocate heaps of heap. freeMem
French number speller fr:num 99 => quatrevingt dix-neuf, see Bag of number/time spellers
German number speller, see Bag of number/time spellers
German time speller: 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
Globbing globals: 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 8.2.2
GPS/UTC Time Conversion Functions
Greeklish turns a strict ASCII transliteration into Greek Unicodes. Heblish turns a strict ASCII transliteration into Hebrew Unicodes.
hotgrep it beats as it sweeps as it cleans!
Greatest common denominator now on its own page
IEEE binary float to string conversion
Integer, see whether variable has an i. value:
proc is_int x {expr {![catch {incr x 0}]}} proc is_no_int x {catch {incr x 0}}
Since Tcl 8.1.1, the built-in string is int does the same for a value.
Integer maximum (MAXINT): determine biggest positive signed integer (by Jeffrey Hobbs):
proc largest_int {} { set int 1 set exp 7; # assume we get at least 8 bits while {$int > 0} { set int [expr {1 << [incr exp]}] } expr {$int-1} }
Integer width in bits (by Jeffrey Hobbs):
proc int_bits {} { set int 1 set exp 7; # assume we get at least 8 bits while {$int > 0} { set int [expr {1 << [incr exp]}] } # pop up one more, since we start at 0 incr exp }
Interrupting loops: how to introduce a "stop button" for runaway code
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}} { proc intgen "{seed [incr seed]}" [info body intgen] set seed } ;# RS
IP address: find out your own. This beauty came from [email protected] (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, see Reading JPEG image dimensions
Language name server, zh <-> Chinese ... see Language/Country name servers
Line Counting see Counting a million lines
List Frequency Counts see Counting Elements in a List
List spread to scalar vars, e.g. lspread {1 2 3} to a b {c 0}
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) - 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:
proc luniq {L} { # removes duplicates without sorting the input list set t {} foreach i $L {if {[lsearch -exact $t $i]==-1} {lappend t $i}} return $t } ;# RS
ls: make glob look more like the Unix thing
proc ls {{fn *}} {lsort [glob -nocomplain $fn .$fn]} ;#RS
Also see ls -l in Tcl....
Mail sender (minimalist, Unix only):
proc mailto {name subj text} { set f [open "|mail $name" w] puts $f "Subject: $subj\n\n$text" close $f }
Cf. http://starbase.neosoft.com/~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:
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.
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:
proc max {a args} {foreach i $args {if {$i>$a} {set a $i}};return $a} proc min {a args} {foreach i $args {if {$i<$a} {set a $i}};return $a}
Works with whatever < and > can compare (strings included). Or how about (float numbers only):
proc max args {lindex [lsort -real $args] end} proc min args {lindex [lsort -real $args] 0}
Or, use -dictionary to handle strings, ints, real.... and also allow to be called with a single list arg (FYI, it's actually a bit faster to use the sort method)
proc min args { if {[llength $args] == 1} {set args [lindex $args 0]} lindex [lsort -dict $args] 0 } proc max args { if {[llength $args] == 1} {set args [lindex $args 0]} lindex [lsort -dict $args] end }
RS: ... only that you get lsort results like
{-1 -5 -10 0 5 10}
if you use the -dict mode of lsort. Numeric max/min should rather use -integer or -float. Max/min of strings must be left to dedicated procs, if ever needed.
Morse en/decoder: works both ways ASCII <-> Morse, see Bag of number/time spellers - yah, well, it has to go somewhere... JC
N-gram frequency counts, see tally: a string counter gadget
Namespace variables listed local names of variables as defined in a namespace:
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:
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):
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
Option Parser expandOpts
proc Instrumentation
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] }
proc validity in context: 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. validProc
Proc name, know your own: 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, see UIC vehicle number validator
Random numbers: Of course, since 8.0 just say
expr {rand()}
. Jeffrey Hobbs has this substitute for pre-8.0 Tcl:
set _ran [clock seconds] proc random {range} { global _ran set _ran [expr ($_ran * 9301 + 49297) % 233280] return [expr int($range * ($_ran / double(233280)))] }
Pass in an int and it returns a number 0..int). Also, the Wiki page on "[rand" has more on the subject.
Random selection from a list
proc random:select list { lindex $list [expr int(rand()*[llength $list])] } ;#RS
Roman numbers from integer, and Roman numbers parsed into integer, see Bag of number/time spellers
SCCS control string bypass: 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: In a Tcl script that is sourced by other files, it's nice to have some code for standalone testing (feeding only this file to a tclsh/wish, double-clicking on Windows, where you even get a free console for seeing stdout ;-). Just brace the self-test code with
ifstandalone {#test what you want...} proc ifstandalone body { global argv0 if { [info exists argv0] && \ ![string compare [file tail [info script]] [file tail $argv0]] } { catch {console show} uplevel $body } }
Set operations, see A set of Set operations
Shuffle a list -- various ways of permuting a list into (pseudo-)random sequence.
Simple Arbitrary Precision Math Procedures - DKF
Size of running Tcl process (Unix only) now on a page of its own...
Sort on String Length / Password Generator
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"
Stack operations on lists: lpush prepends, lpop removes first element. 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 (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".
String to list: [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] ?
subcommands -- value-added switch, FREE error message ;-)
Tabs to spaces, and back: courtesy Jeffrey Hobbs
# 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 }
tailf tail -f piped to egrep, in pure tcl
telnet - client and server... but not exactly as in RFC854.
timers.tcl - benchmarking/timing package
UIC vehicle number validator - as used on European railways
Unicode char to \\u sequence: simple, but handy when examining Unicode output:
proc u2x {u} {scan $u %c t; format "\\u%04.4X" $t} ;#RS
Unit converter -- Does km/h <-> mph, DM <-> EUR, C <-> F ...
UTC -- see GPS/UTC Time Conversion Functions
Validating credit card check digits
Word frequency counts, see tally: a string counter gadget
Plain string substitution 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).
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.