Error processing request

Parameters

Body

Error

Unknow state transition: LINE -> END

-code

1

-level

0

-errorstack

INNER {returnImm {Unknow state transition: LINE -> END} {}} CALL {my render_wikit {Bag of algorithms} Here's\ some\ \"few-liner\"\ code\ examples,\ contributed\ by\ \[Richard\ Suchenwirth\],\ <YOUR\ NAME\ HERE>,\ ...\ .\ \nHelp\ yourself!\ Add\ comments\ when\ you\ know\ it\ better!\ \nUse\ the\ `Edit`\ link\ at\ bottom\ of\ page\ for\ contributing!\ \nShort\ procs\ (fitting\ between\ thumb\ and\ index\ finger\ \;-)\ go\ right\ here,\ \nlonger\ ones\ get\ their\ own\ pages\ and\ are\ linked\ on\ this\ page.\n\ \ \ *\ Tk\ stuff\ has\ now\ been\ moved\ out\ to\ \[Bag\ of\ Tk\ algorithms\].\n\ \ \ *\ See\ also\ \[Donal\ Fellows\]'\ Tcl\ Archive:\ \[http://www.man.ac.uk/~zzcgudf/tcl/\]\n\ \ \ *\ Also\ moved\ some\ of\ Richard's\ language-related\ stuff\ into\ \[Bag\ of\ number/time\ spellers\]\ (JC)\n\ \ \ *\ You\ may\ also\ be\ interested\ in\ the\ \[Example\ Scripts\ Everybody\ Should\ Have\]\ (DKF)\ and\ \[Regular\ Expression\ Examples\]\ (RWT)\n\ \ \ *\ See\ also\ \[Braintwisters\]\ for\ more\ esoteric\ snippets\ (\[FW\])\n\n<<TOC>>\n\n**\ 1-Bits\ in\ a\ positive\ int\ **\n\nSee\ \[Bit\ Twiddling\]\n\n**\ ASCII\ map\ **\n\nsee\ \[Additional\ string\ functions\]\n\n\n**\ \[A\ simple\ Arabic\ renderer\]\ **\n\n'''Arabic'''\ from\ ASCII\ transliteration\ (Buckwalter)\ to\ Unicode,\ from\ abstract\ characters\ to\ glyphs\n\n**\ Application\ home\ **\n\nFind\ the\ real/exact/full\ path\ of\ the\ running\ script\n\n======\nproc\ app_home\ \{\}\ \{\n\ \ \ \ set\ old_dir\ \[pwd\]\n\ \ \ \ set\ f\ \ \ \ \ \ \$::argv0\n\ \ \ \ set\ f_path\ \[file\ dirname\ \$f\]\n\ \ \ \ set\ f_tail\ \[file\ tail\ \$f\]\n\ \ \ \ cd\ \ \$f_path\n\ \ \ \ set\ f\ \$f_tail\n\ \ \ \ while\ \{!\[catch\ \{file\ readlink\ \$f\}\ result\]\}\ \{\n\ \ \ \ \ \ \ \ cd\ \[file\ dirname\ \$result\]\n\ \ \ \ \ \ \ \ set\ f_path\ \[pwd\]\ \ \ \;#\ pwd\ makes\ path\ absolute\n\ \ \ \ \ \ \ \ set\ f_file\ \[file\ tail\ \$result\]\n\ \ \ \ \ \ \ \ set\ f\ \[file\ join\ \$f_path\ \$f_file\]\n\ \ \ \ \}\n\ \ \ \ cd\ \$old_dir\n\ \ \ \ return\ \$f_path\n\}\n======\n''I\ can\ not\ remember\ where\ I\ took\ this\ originally\ from.\ Sorry''\n\[Andreas\ Wilm\]\n\n\[Lars\ H\]:\ Here\ is\ another\ approach\ to\ the\ above,\ which\ also\ returns\ the\ list\ \nof\ all\ \"home\"\ directories\ (a\ link\ may\ point\ to\ another\ link,\ and\ then\ to\ yet\ \nanother,\ etc.)\n\n======\nproc\ app_homes\ \{\}\ \{\n\ \ \ \ set\ res\ \[list\]\n\ \ \ \ set\ me\ \[info\ script\]\n\ \ \ \ catch\ \{\n\ \ \ \ \ \ \ while\ \{1\}\ \{\n\ \ \ \ \ \ \ \ \ \ set\ mydir\ \[file\ dirname\ \$me\]\n\ \ \ \ \ \ \ \ \ \ lappend\ res\ \$mydir\n\ \ \ \ \ \ \ \ \ \ set\ me\ \[file\ join\ \$mydir\ \[file\ readlink\ \$me\]\]\n\ \ \ \ \ \ \ \}\;\ #\ Eventually\ the\ \[file\ readlink\]\ errors\n\ \ \ \ \}\n\ \ \ \ return\ \$res\n\}\n======\nIt\ could\ probably\ do\ with\ some\ \[file\ normalize\]s.\ However,\ a\ comparison\ of\ \n\$::argv0\ and\ \[\[info\ script\]\]\ from\ a\ portability\ perspective\ could\ be\ interesting.\n\n\[SG\]:\ I'm\ probably\ just\ missing\ something\ (I\ usually\ do)\ but\ what\ does\ any\ of\nthis\ do\ that\ \[pwd\]\ doesn't?\n\n\[Lars\ H\]:\ Lots\ of\ things.\ For\ one,\ the\ script\ might\ have\ been\ started\ as\n======none\n%\ tclsh\ /full/path/to/script.tcl\n======\n\nFor\ 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.\n\n**\ Array-preserving\ Order\ of\ Elements\ **\n\nif\ you\ want\ to\ keep\ a\ history\ in\ what\ sequence\n\narray\ elements\ were\ added,\ have\ a\ look\ at\ \[Numbered\ arrays\]\n\n**\ Assertions\ **\n\ncan\ be\ implemented\ in\ millions\ of\ ways,\ here\ is\ one:\n\n======\nproc\ Assert\ \{condition\}\ \{\n\ \ \ \ if\ \{\[catch\ \{uplevel\ \[list\ expr\ \$condition\]\}\ n\]\ ||\ \$n\ ==\ \"\"\ ||\ \$n\ ==\ 0\}\ \{\n\ \ \ \ \ \ \ \ Puts\ \"Assertion\ failed\ (result\ \$n),\ in:\"\n\ \ \ \ \ \ \ \ set\ prefix\ \"\"\n\ \ \ \ \ \ \ \ for\ \{set\ i\ \[info\ level\]\}\ \{\$i\}\ \{incr\ i\ -1\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ prefix\ \"\ \ \"\n\ \ \ \ \ \ \ \ \ \ \ \ puts\ \"\$prefix'\[info\ level\ \$i\]'\"\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ #\ try\ to\ call\ a\ failure\ handler\ to\ collect\ more\ info\n\ \ \ \ \ \ \ \ if\ \{!\[catch\ ::AssertionFailureHandler\ msg\]\ &&\ \$msg\ !=\ \"\"\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ condition\ \"\ (\$msg)\"\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ #error\ \"Assertion\ failed:\ \$condition\"\n\ \ \ \ \ \ \ \ puts\ \"Assertion\ failed:\ \$condition\"\n\ \ \ \ \ \ \ \ exit\n\ \ \ \ \}\n\}\ \;#\ JCW\n======\n\nAnd\ of\ course\ disabled\ simply\ by\ overriding\ the\ above\ definition\ with\ \"proc\ Assert\ \{x\}\ \{\}\".\n\n**\ \[AtExit\ Handlers\]\ **\n\ncleanup\ on\ program\ exit\ for\ you.\n\n**\ Autokill\ **\n\nkill\ an\ application\ after\ a\ resettable\ delay:\n\n======\nproc\ autokill\ \{delay\ \{id\ \"\"\}\}\ \{\n\ \ \ \ if\ \{\$id\ !=\ \"\"\}\ \{after\ cancel\ \$id\}\n\ \ \ \ set\ id\ \[after\ \[expr\ int(\$delay\ *\ 1000\ *\ 60)\]\ \{exit\}\]\n\ \ \ \ proc\ autokill\ \"\[list\ delay\ \[list\ id\ \$id\]\]\"\ \[info\ body\ autokill\]\n\}\nautokill\ 30\;\ #exit\ after\ a\ 30\ minute\ delay\n======\n\ncall\ it\ again,\ the\ same\ way\ to\ reset\ the\ timer.\nUseful\ in\ situations\ where\ an\ application\ uses\ a\ lot\ of\ network\ resources,\ \nand\ has\ the\ potential\ for\ a\ user\ to\ leave\ it\ running\ while\ not\ in\ use.\ --\ \[AJB\]\n\n**\ \[automatic\ .bak\ files\]\ **\n\nautomatically\ backs\ up\ files\ N\ levels\ deep\ to\ avoid\ overwrites\n\n**\ Average\ **\n\nSee\ \[Additional\ math\ functions\]\n\n**\ \[Base\ 64\ encode/decode\]\ **\n\n'''shamelessly\ stolen\ from\ Steve\ Uhler\ and\ Brent\ Welch'''\n\n**\ \[Cartesian\ product\ of\ a\ list\ of\ lists\]\ **\n\n**\ Character\ frequency\ counts\ **\n\nsee\ \[tally:\ a\ string\ counter\ gadget\]\n\n**\ Clock\ clicks\ resolution\ **\n\nUnlike\ 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:\n\n======\nexpr\ \{-\[clock\ clicks\]\ +\ \[after\ 1000\;\ clock\ clicks\]\}\n======\n\n**\ configuration\ files\ **\n\nthis\ proc\ can\ be\ added\ to\ an\ application\n\n======\nproc\ configfile\ \{name\}\ \{\n\ \ \ \ global\ \$name\n\ \ \ \ set\ data\ \[read\ \[set\ fh\ \[open\ \[info\ script\]\ r\]\]\]\n\ \ \ \ close\ \$fh\n\ \ \ \ array\ set\ \$name\ \$data\n\ \ \ \ catch\ \{unset\ \$\{name\}(configfile)\ \$\{name\}(#)\}\n\ \ \ \ return\ -code\ return\n\}\n======\n\nand\ then\ at\ the\ top\ of\ a\ file\ you\ wish\ to\ be\ loaded\ as\ a\ configuration\ file\nsimply\ add\ configfile\ var\n\nof\ course\ you\ must\ load\ the\ file\n======\nif\ \{\[catch\ \{source\ myconfigfile\}\ err\]\}\ \{\n\ \ \ \ #\ some\ error\ occured\n\}\n======\n\nthe\ contents\ of\ the\ file\ then\ end\ up\ in\ global\ variable\ var\n\nan\ example\ file:\n\n======none\nconfigfile\ options\nsetting\ value\nsetting2\ \{some\ large\ value\}\n======\n\nthis\ was\ developed\ for\ \[Easy\ User\ Configurable\ Menus\]\n\n\n**\ Compact\ integer\ list\ to\ list\ **\n\n\{1-4\ 6-8\}\ =>\ \{1\ 2\ 3\ 4\ 6\ 7\ 8\}\n\n======\nproc\ clist2list\ \{clist\}\ \{\n\ \ \ \ #--\ clist:\ compact\ integer\ list\ w.ranges,\ e.g.\ \{1-5\ 7\ 9-11\}\n\ \ \ \ set\ res\ \{\}\n\ \ \ \ foreach\ i\ \$clist\ \{\n\ \ \ \ \ \ \ \ if\ \[regexp\ \{(\[^-\]+)-(\[^-\]+)\}\ \$i\ ->\ from\ to\]\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ for\ \{set\ j\ \[expr\ \$from\]\}\ \{\$j<=\[expr\ \$to\]\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \$j\n\ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \}\ else\ \{lappend\ res\ \[expr\ \$i\]\}\n\ \ \ \ \}\n\ \ \ \ return\ \$res\n\}\ \;#RS\n======\n\n**\ Compact\ list\ to\ list\ **\n\n\{2-4\ a\ c-e\ A\ C-E\}\ =>\ \{2\ 3\ 4\ a\ c\ d\ e\ A\ C\ D\ E\}\n\nAs\ above,\ this\ one\ handles\ a-z\ and\ A-Z\ as\ well\ as\ the\ proposed\ 0-9.\n\n======\nproc\ clist2list\ \{\{args\ \"\"\}\}\ \{\n\ \ \ \ if\ \{\[llength\ \$args\]\ !=\ 1\}\ \{\n\ \ \ \ \ \ \ \ error\ \{wrong\ #\ args:\ should\ be\ \"clist2list\ clist\"\}\n\ \ \ \ \}\n\ \ \ \ set\ clist\ \[lindex\ \$args\ 0\]\n\ \n\ \ \ \ #\ Ensure\ clist\ is\ in\ list\ format,\ if\ not\ then\ make\ it\ so.\n\ \ \ \ if\ \{\[catch\ \{llength\ \$clist\}\]\}\ \{set\ clist\ \[split\ \$clist\]\}\n\ \n\ \ \ \ array\ set\ map\ \[list\ \\\n\ \ \ \ \ \ \ \ a\ \ 1\ \ \ b\ \ 2\ \ \ c\ \ 3\ \ \ d\ \ 4\ \ \ e\ \ 5\ \\\n\ \ \ \ \ \ \ \ f\ \ 6\ \ \ g\ \ 7\ \ \ h\ \ 8\ \ \ i\ \ 9\ \ \ j\ 10\ \\\n\ \ \ \ \ \ \ \ k\ 11\ \ \ l\ 12\ \ \ m\ 13\ \ \ n\ 14\ \ \ o\ 15\ \\\n\ \ \ \ \ \ \ \ p\ 16\ \ \ q\ 17\ \ \ r\ 18\ \ \ s\ 19\ \ \ t\ 20\ \\\n\ \ \ \ \ \ \ \ u\ 21\ \ \ v\ 22\ \ \ w\ 23\ \ \ x\ 24\ \ \ y\ 25\ \\\n\ \ \ \ \ \ \ \ z\ 26\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \\\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \\\n\ \ \ \ \ \ \ \ \ 1\ a\ \ \ \ 2\ b\ \ \ \ 3\ c\ \ \ \ 4\ d\ \ \ \ 5\ e\ \\\n\ \ \ \ \ \ \ \ \ 6\ f\ \ \ \ 7\ g\ \ \ \ 8\ h\ \ \ \ 9\ i\ \ \ 10\ j\ \\\n\ \ \ \ \ \ \ \ 11\ k\ \ \ 12\ l\ \ \ 13\ m\ \ \ 14\ n\ \ \ 15\ o\ \\\n\ \ \ \ \ \ \ \ 16\ p\ \ \ 17\ q\ \ \ 18\ r\ \ \ 19\ s\ \ \ 20\ t\ \\\n\ \ \ \ \ \ \ \ 21\ u\ \ \ 22\ v\ \ \ 23\ w\ \ \ 24\ x\ \ \ 25\ y\ \\\n\ \ \ \ \ \ \ \ 26\ z\]\n\ \n\ \ \ \ set\ re_syntax\ \{^((\[0-9\]+-\[0-9\]+)|(\[A-Z\]-\[A-Z\])|(\[a-z\]-\[a-z\]))\$\}\n\ \ \ \ set\ res\ \{\}\n\ \ \ \ foreach\ i\ \$clist\ \{\n\ \ \ \ \ \ \ \ if\ \{\[regexp\ \$re_syntax\ \$i\ ->\ range\ a\ b\ c\]\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ set\ range\ \[split\ \$range\ -\]\n\ \ \ \ \ \ \ \ \ \ \ \ set\ start\ \[lindex\ \$range\ 0\]\n\ \ \ \ \ \ \ \ \ \ \ \ set\ stop\ \ \[lindex\ \$range\ 1\]\n\ \ \ \ \ \ \ \ \ \ \ \ switch\ --\ \[expr\ \{(\$a!=\"\")?1:(\$b!=\"\")?2:(\$c!=\"\")?3:4\}\]\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 1\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ for\ \{set\ j\ \$start\}\ \{\$j\ <=\ \$stop\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \$j\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 2\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ set\ j\ \$map(\[string\ tolower\ \$start\])\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ for\ \{\}\ \{\$j\ <=\ \$map(\[string\ tolower\ \$stop\])\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \[string\ toupper\ \$map(\$j)\]\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 3\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ for\ \{set\ j\ \$map(\$start)\}\ \{\$j\ <=\ \$map(\$stop)\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \$map(\$j)\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \}\ \ \ \ \ \ \ else\ \{lappend\ res\ \$i\}\n\ \ \ \ \}\;\ return\ \$res\n\}\ \;#\ Carl\ M.\ Gregory,\ MC_8\ --\ http://mc.purehype.net/\n======\n\n**\ Country\ name\ server\ **\n\nCH\ <->\ Switzerland..\ see\ \[Language/Country\ name\ servers\]\n\n**\ Credit\ card\ check\ digit\ validation\ **\n\nsee\ \[Validating\ credit\ card\ check\ digits\]\n\n**\ Cross\ sum\ of\ a\ digit\ sequence\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ csv\ strings\ **\n\ncomma-separated\ values,\ as\ exported\ e.g.\ by\ Excel,\ see\ \[Parsing\ csv\ strings\]\n\n**\ Date\ scanning\ **\n\n''clock\ scan''\ older\ versions\ (pre\ 8.3?)\ did\ not\ handle\nthe\ frequent\ (ISO-standardized)\ format\ YYYY-MM-DD\ hh:mm:ss.\nHere's\ a\ workaround\ by\ \[Hume\ Smith\]\ to\ be\ used\ in\ the\ place\ of\ clock\ scan\ for\ such\ cases:\n\n======\nproc\ yyyy-mm-dd\ \{dtstring\}\ \{\n\ \ \ \ set\ time\ \{\}\ \;#\ this\ allows\ pure\ dates\ without\ time\n\ \ \ \ scan\ \$dtstring\ %d-%d-%d%s\ year\ month\ day\ time\n\ \ \ \ clock\ scan\ \"\$month/\$day/\$year\ \$time\"\n\}\ \;#\ RS\n======\n\nand\ another\ by\ \[Bruce\ Gingery\]:\n\n======\nproc\ YYYYMMDD2MDY\ \{dtstring\}\ \{\n\ \ \ \ set\ patt\ \{^\[1-2\]\[0-9\](\[0-9\]\[0-9\])-(\[0-9\]\[0-9\]?)-(\[0-9\]\[0-9\]?)\}\n\ \ \ \ set\ subs\ \{\\2/\\3/\\1\}\n\ \ \ \ regsub\ \$patt\ \$dtstring\ \$subs\ dtstring\n\ \ \ \ return\ \$dtstring\n#\ or\ return\ \[clock\ scan\ \$dtstring\]\n\}\n======\n\n**\ Date\ and\ Time\ in\ a\ Handy\ Format\ **\n\nlike\ 22.07.99,19:59:00\n\n======\nproc\ date,time\ \{\{when\ \"\"\}\}\ \{\n\ \ \ \ \ \ if\ \{\$when\ ==\ \"\"\}\ \{set\ when\ \[clock\ seconds\]\}\n\ \ \ \ \ \ clock\ format\ \$when\ -format\ \"%d.%m.%y,%H:%M:%S\"\n\}\ \;#RS\n======\n\n**\ \[Debugging\ Aid\ For\ Production\ Code\]\ **\n\n-PSE\n\n**\ Disk\ free\ capacity\ **\n\nin\ Kilobytes:\n\n======\nproc\ df-k\ \{\{dir\ .\}\}\ \{\n\ \ \ \ switch\ \$::tcl_platform(os)\ \{\n\ \ \ \ FreeBSD\ -\n\ \ \ \ Linux\ -\n\ \ \ \ OSF1\ -\n\ \ \ \ SunOS\ \{\n\ \ \ \ \ \ \ \ #\ Use\ end-2\ instead\ of\ 3\ because\ long\ mountpoints\ can\ \n\ \ \ \ \ \ \ \ #\ make\ the\ output\ to\ appear\ in\ two\ lines.\ There\ is\ df\ -k\ -P\n\ \ \ \ \ \ \ \ #\ to\ avoid\ this,\ but\ -P\ is\ Linux\ specific\ afaict\n\ \ \ \ \ \ \ \ lindex\ \[lindex\ \[split\ \[exec\ df\ -k\ \$dir\]\ \\n\]\ end\]\ end-2\n\ \ \ \ \}\n\ \ \ \ HP-UX\ \{lindex\ \[lindex\ \[split\ \[exec\ bdf\ \ \ \$dir\]\ \\n\]\ end\]\ 3\}\n\ \ \ \ \{Windows\ NT\}\ \{\n\ \ \ \ \ \ \ \ expr\ \[lindex\ \[lindex\ \[split\ \[exec\ cmd\ /c\ dir\ /-c\ \$dir\]\ \\n\]\ end\]\ 0\]/1024\n\ \ \ \ \ \ \ \ \ \ \ \ #\ CL\ notes\ that,\ someday\ when\ we\ want\ a\ bit\ more\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ sophistication\ in\ this\ region,\ we\ can\ try\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ something\ like\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ \ \ \ secpercluster,bytespersector,\ \\\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ \ \ \ freeclusters,noclusters\ =\ \\\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ \ \ \ \ \ \ \ \ win32api.GetDiskFreeSpace(drive)\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ Then\ multiply\ long(freeclusters),\ secpercluster,\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ and\ bytespersector\ to\ get\ a\ total\ number\ of\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ effective\ free\ bytes\ for\ the\ drive.\n\ \ \ \ \ \ \ \ \ \ \ \ #\ CL\ further\ notes\ that\n\ \ \ \ \ \ \ \ \ \ \ \ #http://developer.apple.com/techpubs/mac/Files/Files-96.html\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ explains\ use\ of\ PBHGetVInfo()\ to\ do\ something\ analogous\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ for\ MacOS.\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ default\ \{error\ \"don't\ know\ how\ to\ df-k\ on\ \$::tcl_platform(os)\"\}\n\ \ \ \ \}\n\}\ \;#RS\n======\n\nfor\ Win9x\ replace\ cmd\ with\ command.\ Note\ that\ W98(SE)?\ may\ report\ as\ Windows\ 95.\nSo,\n\ \ \ \{Windows\ 95\}\ \{\n\ \ \ \ \ \ \ \ expr\ \[lindex\ \[lindex\ \[split\ \[exec\ command\ /c\ dir\ /-c\ \$dir\]\ \\n\]\ end\]\ 0\]/1024\n\ \ \ \}\n----\nEvery\ time\ df\ comes\ up\ in\ clt,\ I\ think\ I\ should\ write\ one\ that\ works\nfor\ us\ *poor\ souls*\ who\ are\ stuck\ in\ the\ world\ of\ win9x.\ \ So\ the\nother\ night...:\n----\n\n======\nproc\ free_win\ \{\ \}\ \{\n\ \ \ \ set\ res\ \[eval\ exec\ \[auto_execok\ dir\]\]\n\ \ \ \ set\ var\ \[expr\ \[llength\ \$res\]\ -3\]\n\ \ \ \ set\ free_space\ \[lrange\ \$res\ \$var\ end\]\n\ \ \ \ return\ \$free_space\n\}\n======\n\nThis\ works\ on\ win95,\ 98\ and\ NT,\ with\ tcl/tk\ 8.0\ through\ 8.4a2.\nIf\ anybody\ tests\ it\ with\ win2000\ or\ ME,\ please\ let\ us\ know\nthe\ result.\n\n''so''\ 04/20/01\n\n**\ do\ ...\ while\ **\n\nSee\ also\ \[do...until\ in\ Tcl\]\n\ndo\ ...\ while\ loop\ structure,\ as\ in\ C\n\nloop\ structure.\ By\ Morten\ Skaarup\ Jensen\n\n======\nproc\ do\ \{cmds\ while\ expr\}\ \{\n\ \ \ \ uplevel\ \ \$cmds\n\ \ \ \ uplevel\ \"while\ \[list\ \$expr\]\ \[list\ \$cmds\]\"\n\}\n======\n\n======\n#\ Example\ of\ use\nset\ x\ 0\ndo\ \{\n\ \ \ \ puts\ \$x\n\ \ \ \ incr\ \$x\n\}\ while\ \{\$x\ <\ 10\}\n======\n\nThis\ doesn't\ work\ 100%\ with\ breaks.\ Catch\ might\ be\ the\ best\ way\ to\ improve\ this.\ \n\n**\ Drive\ letters\ **\n\non\ Windows\ --\ \"file\ volumes\"\ lists\ drives\ even\ if\ there's\ no\ medium\ in\ it.\nmailto:[email protected]\ contributed\ this\ code\ to\ list\ mapped\ and\nexisting\ drives:\n\n======\nproc\ drives\ \{\}\ \{\n\ \ \ \ 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\]\ \{\n\ \ \ \ \ \ \ \ if\ \{\[catch\ \{file\ stat\ \$\{drive\}:\ dummy\}\]\ ==\ 0\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ lappend\ drives\ \$drive\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \}\n\ \ \ \ return\ \$drives\n\}\n======\n\n**\ English\ number\ speller\ **\n\ne.g.\ en:num\ 29\ =>\ twenty-nine,\ see\ \[Bag\ of\ number/time\ spellers\]\n\n**\ Executable\ scripts\ **\n\nTcl\ scripts\ with\ initial\ magic\ can\ be\ called\ directly\ from\ a\ shell\ prompt.\nIn\ UNIX,\ you\ can\ specify\ the\ path\ to\ tclsh\ (or\ wish,\ as\ you\ wish)\ in\ a\ special\ comment\ line,\ e.g.\n\ #!/tools/bin/tclsh\nbut\ this\ requires\ adaptation\ to\ the\ local\ situation.\ More\ flexible\ is\nthe\ following,\ which\ finds\ the\ way\ itself:\n\ #!/bin/sh\n\ #\ the\ next\ line\ restarts\ using\ -*-Tcl-*-sh\ \\\n\ exec\ tclsh\ \"\$0\"\ \$\{1+\"\$@\"\}\n\nTom\ Tromey\ explains\ the\ \$\{1+\"\$@\"\}\ bit\ in\ \[exec\ magic\]\n\nThe\ -*-\ stuff\ instructs\ emacs\ to\ treat\ this\ file\ in\ Tcl\ mode.\nIn\ both\ cases,\ do\ a\ ''chmod\ +x\ filename''\ for\ real\ availability.\n\nFor\ Win95,\ \[Rolf\ Schroedter\]\ reports\ the\ following\ to\ work:\nfile\ foo.bat:\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \{\ \;#\ run\ tcl-script\ from\ BAT-file\n\ \ \ \ \ \ \ \ tclsh80\ %0\ %1\ %2\ %3\ %4\ %5\ %6\ %7\ %8\ %9\n\ \ \ \ \ \ \ \ exit\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ puts\ \"Tcl\ \$tcl_patchLevel\"\n\nSmall\ 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.\nI\ cannot\ find\ any\ command\ to\ just\ terminate\ the\ running\ script,\ so\nI\ use:\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \{\ \;#\ run\ tcl-script\ from\ BAT-file\n\ \ \ \ \ \ \ \ tclsh80\ %0\ %1\ %2\ %3\ %4\ %5\ %6\ %7\ %8\ %9\n\ \ \ \ \ \ \ \ goto\ EOF\n\ \ \ \ \ \ \ \ \}\n\n\ \ \ \ \ \ \ \ #\ your\ TCL\ code\ goes\ here\n\ \ \ \ \ \ \ \ #\ ...\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \\\n\ \ \ \ \ \ \ :EOF\n\n\nMight\ get\ a\ problem\ if\ \":EOF\"\ is\ a\ valid\ Proc\ in\ your\ program\ and\ gets\ called\ in\ the\ main\ program,\ though.\ -\ Michael\ Teske\n\nThis\ works\ for\ me\ on\ NT:\n\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ @tclsh\ %~f0\ %*\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ exit\ /b\n\ \ \ \ \ \ \ \ \}\n\nIt\ has\ the\ added\ advantage\ that\ all\ command\ line\ arguments\ are\ given\ to\ tclsh\ (\"%*\")\ and\ \nthat\ the\ tclsh\ gets\ the\ full\ path\ of\ the\ file\ to\ start\ (\"%~f0\")\ -\ Klaus\ Marius\ Hansen\ -\ \nSee\ also\ \[DOS\ BAT\ magic\]\n\n**\ expr\ **\n\n\ \ \ *\ \[Importing\ expr\ functions\]\n\ \ \ *\ \[expr\ problems\ with\ int\]\n\n**\ File\ line\ termination\ **\n\nCR\ and/or\ LF?\ \[Donal\ Fellows\]\ shows\ the\ way:\n\n======\nproc\ file_lineterm\ \{filename\}\ \{\n\ \ \ \ set\ fd1\ \[open\ \$filename\ r\]\n\ \ \ \ set\ fd2\ \[open\ \$filename\ r\]\;#\ Avoids\ most\ synch\ problems...\n\ \ \ \ fconfigure\ \$fd2\ -translation\ binary\n\ \ \ \ set\ EOLidx\ \[string\ length\ \[gets\ \$fd1\]\]\n\ \ \ \ close\ \$fd1\n\ \ \ \ read\ \$fd2\ \$EOLidx\n\ \ \ \ set\ EOLchars\ \[read\ \$fd2\ 2\]\n\ \ \ \ close\ \$fd2\n\ \ \ \ if\ \{\[string\ equal\ \$EOLchars\ \"\\r\\n\"\]\}\ \{\n\ \ \ \ \ \ \ \ return\ \"crlf\"\ \;#\ DOS/Windows\n\ \ \ \ \}\ elseif\ \{\[string\ equal\ \[string\ index\ \$EOLchars\ 0\]\ \"\\r\"\]\}\ \{\n\ \ \ \ \ \ \ \ return\ \"cr\"\ \ \ \;#\ Mac\n\ \ \ \ \}\ elseif\ \{\[string\ equal\ \[string\ index\ \$EOLchars\ 0\]\ \"\\n\"\]\}\ \{\n\ \ \ \ \ \ \ \ return\ \"lf\"\ \ \ \;#\ Unix\n\ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ return\ \"unknown\"\n\ \ \ \ \}\n\}\n======\n\n\[Lars\ H\],\ 27\ Feb\ 2003:\ Doesn't\ that\ --\ rather\ than\ determining\ what\ is\ the\nline\ terminator\ in\ the\ specified\ file\ --\ determine\ what\ Tcl\ considers\ to\ be\nthe\ line\ terminator?\n''Answering\ myself\ 9\ Sep\ 2004:''\ Yes\ it\ does,\ but\ the\ default\ for\ Tcl\ \nreading\ files\ is\ to\ treat\ '''all'''\ of\ lf,\ cr,\ and\ crlf\ as\ a\ line\ termination,\ \nso\ you\ really\ get\ the\ wanted\ information\ about\ which\ one\ of\ those\ three\ it\ \nis\ in\ this\ file.\n\n**\ File\ mode\ **\n\nUnix\ style\n\nreturns\ something\ like\ drwxr--r--\n======\nproc\ file_mode\ fn\ \{\n\ \ \ \ file\ stat\ \$fn\ t\n\ \ \ \ if\ \[file\ isdirectory\ \$fn\]\ \{\n\ \ \ \ \ \ \ \ set\ prefix\ \"d\"\n\ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ set\ prefix\ \"-\"\n\ \ \ \ \}\n\ \ \ \ set\ s\ \[format\ %03o\ \[expr\ \$t(mode)%512\]\]\n\ \ \ \ foreach\ i\ \{\ \ 0\ \ \ 1\ \ \ 2\ \ \ 3\ \ \ 4\ \ \ 5\ \ \ 6\ \ \ 7\}\ \\\n\ \ \ \ \ \ \ \ j\ \{---\ --x\ -w-\ -wx\ r--\ r-x\ rw-\ rwx\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ regsub\ -all\ \$i\ \$s\ \$j\ s\n\ \ \ \ \}\n\ \ \ \ return\ \$prefix\$s\n\}\ \;#RS\n======\n\n**\ File\ reader\ **\ntakes\ a\ filename,\ returns\ the\ lines\ of\ that\ file\ as\ \ a\ list.\nTrivial\ algorithm,\ but\ note\ the\ \"whitespace\ sugar\":\ \nmentions\ of\ a\ variable\ are\ vertically\ aligned\ to\ indicate\ data\ flow\ \;-)\n\n======\nproc\ file_lines\ \{fn\}\ \{\n\ \ \ \ set\ f\ \[open\ \$fn\ r\]\n\ \ \ \ set\ t\ \[read\ \$f\ \[file\ size\ \$fn\]\]\n\ \ \ \ close\ \$f\n\ \ \ \ split\ \$t\ \\n\n\}\ \;#RS\n======\n\n**\ Files\ and\ sockets\ in\ use\ **\n\nFor\ Tcl\ 8.4\ the\ '''file\ channels'''\ builtin\ command\ does\ this.\n\nby\ \[Phil\ Ehrens\]\ <[email protected]>\n\nUNIX\ only\n\n======\nproc\ countFilehandles\ \{\{limit\ 1024\}\}\ \{\n\ \ \ \ set\ i\ 0\;\ set\ socks\ \{\}\;\ set\ files\ \{\}\n\ \ \ \ while\ \{\$i\ <\ \$limit\}\ \{\n\ \ \ \ \ \ \ \ if\ !\[catch\ \{tell\ sock\$i\}\]\ \{lappend\ socks\ sock\$i\}\n\ \ \ \ \ \ \ \ if\ !\[catch\ \{tell\ file\$i\}\]\ \{lappend\ files\ file\$i\}\n\ \ \ \ \ \ \ \ incr\ i\n\ \ \ \ \}\n\ \ \ \ return\ \[list\ \$socks\ \$files\]\n\}\n======\n\n**\ \[Fraction\ Math\]\ **\n\nSee\ \[Fraction\ Math\]\ --\ kbk\ \[http://titania.crd.ge.com/people/kennykb.html\]\n\n2.75\ <->\ 2-3/4.\ Not\ exact,\ resolution\ can\ be\ specified\ (default\ 1/8)\n\n======\nproc\ fracn2num\ \{args\}\ \{\n\ \ \ \ if\ !\[regexp\ \{((\[0-9\]+)\[\ -\])?(\[0-9\]+)/(\[0-9\]+)\}\ \$args\ ->\ -\ int\ num\ den\]\ \{\n\ \ \ \ \ \ \ \ return\ \$args\n\ \ \ \ \}\n\ \ \ \ expr\ \$int+double(\$num)/\$den\n\}\nproc\ num2fracn\ \{n\ \{r\ 8\}\}\ \{\n\ \ \ \ if\ \[set\ in\ \[expr\ int(\$n)\]\]==\$n\ \{return\ \$n\}\n\ \ \ \ if\ \$in\ \{set\ res\ \$in-\}\ else\ \{set\ res\ \{\}\}\n\ \ \ \ return\ \$res\[join\ \[simplify\ \[expr\ int(round((\$n-\$in)*\$r))\]\ \$r\]\ /\]\n\}\nproc\ simplify\ \{p\ q\}\ \{\n\ \ \ \ set\ g\ \[gcd\ \$p\ \$q\]\n\ \ \ \ list\ \[expr\ \$p/\$g\]\ \[expr\ \$q/\$g\]\n\}\ \;#RS\ (frac2num\ handling\ for\ things\ like\ '2\ 3/4'\ added\ by\ PSE)\n======\n\noffers\ some\ advances\ on\ the\ ''Fraction\ math'\ section.\n\n**\ \[freeMem%|%freeMem:\ Freeing\ memory\ the\ Tcl\ way!%|%\]**\n\nPermits\ evaluation\ of\ code\ in\ a\ manner\ which\ does\ NOT\ cause\ the\ interpreter\ to\npermanently\ allocate\ heaps\ of\ heap.\n\n**\ \[IEEE\ binary\ float\ to\ string\ conversion\]\ **\n\n**\ Integer\ Check\ **\n\nSee\ \[Additional\ math\ functions\]\n\n**\ Integer\ maximum\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ Integer\ width\ **\nin\ bits\ (by\ \[Jeffrey\ Hobbs\]):\n======\nproc\ int_bits\ \{\}\ \{\n\ \ \ \ set\ int\ 1\n\ \ \ \ set\ exp\ 8\;\ #\ Assuming\ a\ minimum\ of\ 8\ bits\n\ \ \ \ 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,\ ....\n\ \ \ \ return\ \$exp\n\}\n======\n\n**\ \[Interrupting\ loops\]:\ how\ to\ introduce\ a\ \"stop\ button\"\ for\ runaway\ code\ **\n\n**\ intgen:\ unique\ integer\ ID\ generator,\ at\ first\ call\ gives\ 1,\ then\ 2,\ 3,\ ...\ **\nNote\ how\ the\ proc\ rewrites\ its\ own\ seed\ default,\ so\ no\ global\ variable\ is\ needed:\n\n======\nproc\ intgen\ \{\{seed\ 0\}\}\ \{\n\ \ \ \ proc\ intgen\ \"\{seed\ \[incr\ seed\]\}\"\ \[info\ body\ intgen\]\n\ \ \ \ set\ seed\n\}\ \;#\ RS\n======\n\n**\ number\ speller\ ,French**\n\nfr:num\ 99\ =>\ quatrevingt\ dix-neuf\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ German\ number\ speller\ **\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ time\ speller\ ,German\ **\n\nconverts\ exact\ HH:MM\ times\ to\ fuzzy\ colloquial\ wording,\ optional\ Northern\ (viertel\ vor\ vier)\ or\ Southern\ style\ (dreiviertel\ vier)\ \;-)\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ money\ amount\ speller\ ,Russian\ **\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ \[getPid\]\ **\n\nmap\ pids\ to\ prog\ names\ and\ vice-versa\n\n**\ \[gifBalls\]\ **\n\n**\ Globbing\ globals\ **\n\nWant\ to\ import\ several\ globals\ in\ one\ go,\ with\ glob\ wildcards\n(similar\ to\ the\ public\ statement\ in\ VB)?\ This\ comes\ from\ David\ Cuthbert\ (mailto:[email protected]):\n\n======\nproc\ globalpat\ \{args\}\ \{\n\ \ \ \ foreach\ pattern\ \$args\ \{\n\ \ \ \ \ \ \ \ set\ varnames\ \[info\ globals\ \$pattern\]\n\ \ \ \ \ \ \ \ if\ \{\[llength\ \$varnames\]\ !=\ 0\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ uplevel\ 1\ global\ \$varnames\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \}\n\}\n======\nTo\ use:\n\n\n======\nproc\ hello\ \{\}\ \{\n\ \ \ \ globalpat\ *tcl*\n\ \ \ \ puts\ \$tcl_patchLevel\n\}\n\n%\ hello\n8.2.2\n======\n\n**\ \[GPS/UTC\ Time\ Conversion\ Functions\]\ **\n\nTcl\ implementation\ of\ Simpson's\ Rule\ numerical\ integration.\n\n**\ \[Greeklish\]\ **\nturns\ a\ strict\ ASCII\ transliteration\ into\ Greek\ Unicodes\n\n**\ \[Greatest\ common\ denominator\]\ **\n\nnow\ on\ its\ own\ page\n\n**\ \[Heblish\]\ **\n\nturns\ a\ strict\ ASCII\ transliteration\ into\ Hebrew\ Unicodes.\n\n**\ \[hotgrep\]\ **\n\nit\ beats\ as\ it\ sweeps\ as\ it\ cleans!\n\n**\ \[integrate\]\ **\n\n**\ IP\ address:\ find\ out\ your\ own.\ This\ beauty\ came\ from\ [email protected]\ **\ \n(note\ that\ ''xxx''\ should\ be\ the\ name\ of\ a\ procedure\ which\ never\ gets\ called,\ so\ need\ not\ exist\ \;-):\n\n\[\[ip:adr\ used\ to\ be\ here.\]\]\n\nMany\ Tcl\ programmers\ wonder\ \[how\ to\ find\ my\ own\ IP\ address\].\n\n**\ jpeg:\ \[Reading\ JPEG\ image\ dimensions\]\ **\n\n**\ Language\ name\ server,\ zh\ <->\ Chinese\ ...\ see\ \[Language/Country\ name\ servers\ \]\ **\n\n**\ Line\ Counting\ see\ \[Counting\ a\ million\ lines\]\ **\n\n**\ List\ Frequency\ Counts\ **\n\nsee\ \[Counting\ Elements\ in\ a\ List\]\n\n**\ List\ spread\ to\ scalar\ vars,\ e.g.\ lspread\ \{1\ 2\ 3\}\ to\ a\ b\ \{c\ 0\}\ **\n\n======\nproc\ lspread\ \{list\ \"to\"\ args\}\ \{\n\ \ \ \ foreach\ a\ \$args\ v\ \$list\ \{\n\ \ \ \ \ \ \ \ upvar\ \[lindex\ \$a\ 0\]\ var\ \;#\ name\ maybe\ in\ list\ with\ default\n\ \ \ \ \ \ \ \ if\ \{\$v==\"\"\}\ \{set\ var\ \[lindex\ \$a\ 1\]\}\ else\ \{set\ var\ \$v\}\n\ \ \ \ \}\n\}\ \;#RS\n======\n\n**\ List\ well-formedness:\ check\ a\ string\ whether\ it\ could\ be\ parsed\ into\ a\ list\ (braces\ balanced,\ whitespace\ after\ closing\ braces)\ **\n\njoint\ effort\ by\ \[Bob\ Techentin\]\ and\ \[Donald\ Porter\]\nin\ news:comp.lang.tcl\ :\n======\nproc\ islist\ \{s\}\ \{\n\ \ \ \ expr\ !\[catch\ \{eval\ list\ \$s\}\]\n\}\ \;#\ RS\n======\n\nHmmm...\ let's\ think\ twice\ about\ this\ one.\ \ We\ want\ to\ test\ the\nlist\ well-formedness\ of\ an\ unknown\ string,\ so\ we\ probably\ don't\ know\nmuch\ about\ \$s.\ \ It's\ dangerous\ to\ \[\[eval\]\]\ something\ you\ don't\ know.\nConsider\ this:\n======\nset\ s\ \{a\;\ file\ delete\ -force\ ~\}\nislist\ \$s\ \ \ \ \;#\ Hope\ you\ have\ backups!\n======\nTry\ this\ instead:\n\n======\nproc\ islist\ \{s\}\ \{expr\ !\[catch\ \{llength\ \$s\}\]\}\ \;#\ DGP\n======\n\nIndeed.\ \ The\ former\ returns\ bad\ values\ for\ most\ things\ containing\ '\$',\ or\ \[\[,\ \]\]\ etc.\ \ \nThe\ latter\ does\ what\ you\ want.\n\n**\ List\ with\ duplicates\ removed,\ and\ keeping\ the\ original\ order:\ **\n\n======\nproc\ luniq\ \{L\}\ \{\n\ \ \ \ #\ removes\ duplicates\ without\ sorting\ the\ input\ list\n\ \ \ \ set\ t\ \{\}\n\ \ \ \ foreach\ i\ \$L\ \{if\ \{\[lsearch\ -exact\ \$t\ \$i\]==-1\}\ \{lappend\ t\ \$i\}\}\n\ \ \ \ return\ \$t\n\}\ \;#\ RS\n======\n\n**\ \[ls\ -l\ in\ Tcl\]\ **\n\n**\ ls:\ make\ glob\ look\ more\ like\ the\ Unix\ thing\ **\n\n======\nproc\ ls\ \{\{fn\ *\}\}\ \{\n\ \ \ \ lsort\ \[glob\ -nocomplain\ \$fn\ .\$fn\]\n\}\ \;#RS\n======\n\nAlso\ see\ \[ls\ -l\ in\ Tcl\]....\n\n**\ Mail\ sender\ (minimalist,\ Unix\ only):\ **\n\n======\nproc\ mailto\ \{name\ subj\ text\}\ \{\n\ \ \ \ set\ f\ \[open\ \"|mail\ \$name\"\ w\]\n\ \ \ \ puts\ \ \$f\ \"Subject:\ \$subj\\n\\n\$text\"\n\ \ \ \ close\ \$f\n\}\n======\n\nCf.\ http://www.phaseit.net/claird/comp.lang.tcl/tcl-examples.html#mail\n\nusing\ tcllib:\ \ \[PT\]\n\n======\n\ package\ require\ mime\n\ package\ require\ smtp\n\n\ set\ tok\ \[mime::initialize\ -canonical\ text/plain\ -string\ \"Hello,\ World!\"\]\n\ smtp::sendmessage\ \$tok\ \\\n\ \ \ \ -header\ \{From\ \"[email protected]\"\}\ \\\n\ \ \ \ -header\ \{To\ \"You\ <[email protected]>\"\}\ \\\n\ \ \ \ -header\ \{Subject\ \"Simple\ Tcllib\ mailing.\"\}\n\ mime::finalize\ \$tok\n======\n\n**\ Mail\ checker,\ even\ more\ minimalist,\ Unix\ only:\ **\n\n======\nproc\ haveMail\ \{\}\ \{\n\ \ \ \ expr\ \[file\ size\ /var/mail/\$::env(USER)\]>0\n\}\n======\n\n\[yet\ another\ Tcl\ mail\ handler!\ (for\ UNIX)\]\n\n**\ map\ -\ the\ traditional\ list\ functional\ that\ applies\ an\ operation\ to\ every\ member\ of\ a\ list.\ **\n\n======\nproc\ map\ \{command\ list\}\ \{\n\ \ \ \ set\ res\ \[list\]\n\ \ \ \ foreach\ item\ \$list\ \{\n\ \ \ \ \ \ \ \ lappend\ res\ \[uplevel\ 1\ \[concat\ \$command\ \[list\ \$item\]\]\]\n\ \ \ \ \}\n\ \ \ \ set\ res\n\}\n======\n''See\ also\ \[Steps\ towards\ functional\ programming\]\ for\ related\ discussions.''\n\n**\ Maximum\ and\ minimum\ Everybody\ writes\ them\ himself,\ here's\ mine:\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ Morse\ en/decoder:\ works\ both\ ways\ ASCII\ <->\ Morse,\ see\ \[Bag\ of\ number/time\ spellers\]\ ''-\ \ **\n\nyah,\ well,\ it\ has\ to\ go\ somewhere...\ JC''\n\n**\ N-gram\ frequency\ counts,\ see\ \[tally:\ a\ string\ counter\ gadget\]\ **\n\n**\ Namespace\ variables\ listed\ local\ names\ of\ variables\ as\ defined\ in\ a\ namespace:\ **\n\n======\nproc\ nsvars\ \{ns\}\ \{\n\ \ \ \ regsub\ -all\ ::\$\{ns\}::\ \[info\ vars\ \$\{ns\}::*\]\ \"\"\ res\n\ \ \ \ set\ res\n\}\ \ \;#\ RS\n======\n\nalternatively\ (requires\ ''map''\ operator\ from\ elsewhere\ on\ this\ page)\ -\ ''DKF''\n\n======\nproc\ nsvars\ \{\{ns\ \{\}\}\}\ \{\n\ \ \ \ map\ \[list\ namespace\ tail\]\ \[info\ vars\ \$\{ns\}::*\]\n\}\n======\n\n**\ NUKE:\ delete\ a\ file\ when\ its\ descriptor\ is\ closed:\ **\n\n======\nproc\ NUKE\ \{\ filename\ fid\ \}\ \{\n\ \ \ \ \ if\ \{\ !\ \[\ llength\ \[\ file\ channels\ \$fid\ \]\ \]\ \}\ \{\n\ \ \ \ \ \ \ \ \ file\ delete\ \$filename\n\ \ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ \ after\ 1000\ \"NUKE\ \$filename\ \$fid\"\n\ \ \ \ \ \}\n\}\n======\n\n''DKF''\ -\ Alternatively,\ rewrite\ the\ ''close''\ and\ ''exit''\ commands...\n======\nrename\ close\ orig_close_NUKE\nrename\ exit\ orig_exit_NUKE\nproc\ close\ \{fid\}\ \{\n\ \ \ \ global\ NUKE\ errorInfo\ errorCode\n\ \ \ \ set\ code\ \[catch\ \{orig_close_NUKE\ \$fid\}\ msg\]\n\ \ \ \ set\ ei\ \$errorInfo\n\ \ \ \ set\ ec\ \$errorCode\n\ \ \ \ if\ \{\[info\ exist\ NUKE(\$fid)\]\}\ \{\n\ \ \ \ \ \ \ \ file\ delete\ \$NUKE(\$fid)\n\ \ \ \ \ \ \ \ unset\ NUKE(\$fid)\n\ \ \ \ \}\n\ \ \ \ return\ -code\ \$code\ -errorinfo\ \$ei\ -errorcode\ \$ec\ \$msg\n\}\n\nproc\ exit\ \{\{code\ 0\}\}\ \{\n\ \ \ \ global\ NUKE\n\ \ \ \ foreach\ fid\ \[array\ names\ NUKE\]\ \{catch\ \{close\ \$fid\}\}\n\ \ \ \ orig_exit_NUKE\ \$code\n\}\n\nproc\ NUKE\ \{filename\ fid\}\ \{\n\ \ \ \ global\ NUKE\n\ \ \ \ set\ NUKE(\$fid)\ \$filename\n\}\n\nproc\ tmpfile\ \{\{tmpdir\ /tmp\}\}\ \{\n\ \ \ \ global\ SEQID\;\ if\ \{!\[info\ exist\ SEQID\]\}\ \{set\ SEQID\ 0\}\n\ \ \ \ set\ basename\ \[file\ rootname\ \[file\ tail\ \$::argv0\]\]\n\ \ \ \ set\ filename\ \[file\ join\ \$tmpdir\ \$\{basename\}.\[pid\].\[incr\ SEQID\].tmp\]\n\ \ \ \ set\ fid\ \[open\ \$filename\ w+\]\n\ \ \ \ NUKE\ \$filename\ \$fid\n\ \ \ \ return\ \$fid\n\}\n======\n\n**\ Number\ commified\ (added\ culture-dependent\ thousands\ mark):\ **\n\n======\nproc\ number_commify\ \{n\ \{sign\ ,\}\}\ \{\n\ \ \ \ #\ structure\ a\ decimal\ like\ 123,456.78\ 123'456.78,\ or\ 123.456,78\n\ \ \ \ if\ \{\$sign==\".\"\}\ \{regsub\ \{\[.\]\}\ \$n\ \",\"\ n\}\n\ \ \ \ set\ trg\ \"\\\\1\$sign\\\\2\"\n\ \ \ \ while\ \{\[regsub\ \{^\ *(\[-+\]?\[0-9\]+)(\[0-9\]\[0-9\]\[0-9\])\}\ \$n\ \$trg\ n\]\}\ \{\}\n\ \ \ \ return\ \$n\n\}\ \;#\ added\ \"\ *\"\ to\ regexp,\ so\ leading\ blanks\ as\ from\ format\ work\ -\ RS\n======\nA\ one-liner\ alternative\ by\ \ \[Peter\ Spjuth\]\ (in\ the\ \[Tcl\ chatroom\],\ 2004-10-05)\nuses\ modern\ \[regexp\]\ features:\n\n======\nproc\ commify\ number\ \{\n\ \ \ \ regsub\ -all\ \{\\d(?=(\\d\{3\})+(\$|\\.))\}\ \$number\ \{\\0,\}\n\}\n======\n\n\n\nSee\ also\ \[Human\ readable\ file\ size\ formatting\]\n\n======\n\n**\ Option\ Parser:\ \[expandOpts\]\ **\n\n**\ proc\ Instrumentation\ **\n\nYou\ can\ add\ code\ to\ every\ procedure\ in\ your\ Tcl\ application\ by\ redefining\ the\ ''proc''\ command\ \nto\ include\ special\ code.\ \ Then\ each\ proc\ definition\ will\ include\ your\ code.\ \ \nThis\ is\ commonly\ done\ for\ debuggers\ and\ profilers.\ \ \nFor\ example,\ if\ you\ wanted\ to\ count\ each\ time\ your\ procedures\ are\ called,\ \nyou\ could\ include\ code\ like\ this\ example,\ courtesy\ of\ Bryan\ Oakly\ on\ comp.lang.tcl.\n\n======\nrename\ proc\ _proc\n_proc\ proc\ \{name\ arglist\ body\}\ \{\n\ \ \ \ set\ body\ \"incr\ ::proc_counter(\$name)\\n\$body\"\n\ \ \ \ set\ ::proc_counter(\$name)\ 0\n\ \ \ \ uplevel\ \[list\ _proc\ \$name\ \$arglist\ \$body\]\n\}\n======\n\nSee\ also\ \[Printing\ proc\ sequence\].\n\n**\ proc\ validity\ in\ context:\ \[validProc\]\ \ **\n\nreturns\ ''1''\ if\ the\ procedure\ name\ or\ wildcard\ pattern\ exists\ in\ the\ current\ncontext\ (including\ all\ child\ namespaces),\ returns\ ''0''\ if\ it\ does\ not.\ \ Sort\nof\ a\ \[\[\[info\ commands\]\]\]\n\nfor\ heavy\ namespace\ users.\n\n**\ Proc\ name:\ know\ your\ own\ **\n\nthis\ one-liner\ wraps\ introspection.\ Useful\ for\ generated\ widget\ handlers,\ whose\nname\ is\ like\ the\ widget\ pathname,\ so\ they\ know\ what\ their\ widget\ is\ called:\n\n======\nproc\ proc_name\ \{\}\ \{\n\ \ \ \ lindex\ \[info\ level\ -1\]\ 0\n\}\ \;#RS\n======\n\n**\ Railway\ vehicle\ number\ validation:\ \[UIC\ vehicle\ number\ validator\]\ **\n\n**\ Random\ Numbers\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ Random\ selection\ from\ a\ list\ **\n\n======\nproc\ random_select\ list\ \{\n\ \ \ \ lindex\ \$list\ \[expr\ int(rand()*\[llength\ \$list\])\]\n\}\ \;#RS\n======\n\n**\ Roman\ Numbers\ **\n\n\[Bag\ of\ number/time\ spellers\]\n\n**\ SCCS\ control\ string\ bypass\ **\n\nWhen\ you\ ckeck\ in\ a\ file\ with\ SCCS,\ certain\ strings\ in\ the\ file\ are\ replaced,\ne.g.\ %H%\ with\ the\ current\ date,\ %M%\ with\ the\ current\ filename.\ \ This\ can\ cause\nproblems\ if\ your\ code\ contains\ e.g.\ \ set\ now\ \[clock\ format\ \[clock\ seconds\]\n-format\ %y%m%d-%H%M%S\]\ but\ you\ can\ hide\ percent\ signs\ by\ replacing\ them\ with\nthe\ equivalent\ \\x25,\ so\ SCCS\ doesn't\ see\ them\ but\ the\ Tcl\ parser\ does\ (RS)\n\n======\nset\ now\ \[clock\ format\ \[clock\ seconds\]\ -format\ %y%m%d-\\x25H\\x25M\\x25S\]\n======\n\nHere's\ my\ method\ -\ use\ append\ to\ build\ up\ the\ string:\n======\nappend\ datestring\ %y\ %m\ %d\ -\ %H\ %M\ %S\nset\ now\ \[clock\ format\ \[clock\ seconds\]\ -format\ %datestring\]\n======\n\nMarty\ Backe\n\n**\ Self-test\ code\ **\n\nevaluated\ only\ when\ executed,\ not\ when\ sourced\n\nIn\ a\ Tcl\ script\ that\ is\ sourced\ by\ other\ files,\ it's\ nice\ to\ have\ some\ code\ for\nstandalone\ testing\ (feeding\ only\ this\ file\ to\ a\ tclsh/wish,\ double-clicking\ on\nWindows,\ where\ you\ even\ get\ a\ free\ console\ for\ seeing\ stdout\ \;-).\ Just\ brace\nthe\ self-test\ code\ with\n\n======\nifstandalone\ \{#test\ what\ you\ want...\}\n======\n\n======\nproc\ ifstandalone\ body\ \{\n\ \ \ \ global\ argv0\n\ \ \ \ if\ \{\ \[info\ exists\ argv0\]\ &&\ \\\n\ \ \ \ \ \ \ \ !\[string\ compare\ \[file\ tail\ \[info\ script\]\]\ \[file\ tail\ \$argv0\]\]\ \}\ \{\n\n\ \ \ \ \ \ \ \ catch\ \{console\ show\}\n\ \ \ \ \ \ \ \ uplevel\ \$body\n\ \ \ \ \}\n\}\n======\n\n**\ Set\ operations:\ \[A\ set\ of\ Set\ operations\]\ **\n\n**\ \[Shuffle\ a\ list\]\ --\ various\ ways\ of\ permuting\ a\ list\ into\ (pseudo-)random\ sequence.\ **\n\n**\ Silly\ Asynchronous\ Event\ Example\ **\n\n======\n#\ initialise\ our\ trigger\ variable\nset\ foo\ \{\}\n\n#\ a\ proc\ to\ call\ when\ the\ trigger\ variable\ is\ written\nproc\ bye\ \{args\}\ \{\ exit\ \}\n\n#\ some\ code\ to\ push\ into\ the\ event\ loop\ for\ 0.5\ sec\n#\ that\ produces\ visible\ output,\ and\ writes\ the\ trigger\ var\nafter\ 500\ \{\n\ \ \ puts\ \"what\ a\ question!\"\n\ \ \ set\ foo\ \{\}\n\}\n\n#\ some\ other\ code\ that\ gets\ pushed\ into\ the\ loop\ for\ 0.2\ sec\nafter\ 200\ \{\n\ \ \ \ puts\ \"where\ did\ I\ come\ from?\"\n\}\n\n#\ some\ code\ that\ is\ executed\ immediately\nputs\ \"and\ then\ he\ asked:\"\n\n#\ set\ a\ trace\ on\ \"foo\",\ so\ that\ when\ it\ is\ written\ the\n#\ procedure\ \"bye\"\ is\ called\ntrace\ variable\ foo\ w\ bye\n\n#\ initiate\ an\ event\ loop\ (this\ is\ what\ \"wish\"\ does)\nvwait\ enter-mainloop\n======\n\n''(DKF:\ And\ this\ is\ supposed\ to\ be\ a\ ''good''\ feature\ of\ Tcl?\ \ Hmmm...)''\n\n**\ Simple\ \[Arbitrary\ Precision\ Math\ Procedures\]\ --\ \[DKF\]\ **\n\n**\ \[Size\ of\ running\ Tcl\ process\]\ (Unix\ only)\ **\n\n**\ \[sleep\]\ **\n\nunix-like\n\n**\ Sort\ on\ String\ Length\ /\ Password\ Generator\ **\n\n======\nproc\ \{lengthCompare\}\ \{w1\ w2\}\ \{\n\ \ \ \ set\ sl1\ \[string\ length\ \$w1\]\n\ \ \ \ set\ sl2\ \[string\ length\ \$w2\]\n\ \ \ \ if\ \{\$sl1\ >\ \$sl2\}\ \{\n\ \ \ \ \ \ \ \ return\ 1\n\ \ \ \ \}\ elseif\ \{\$sl1\ ==\ \$sl2\}\ \{\n\ \ \ \ \ \ \ \ return\ 0\n\ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ return\ -1\n\ \ \ \ \}\n\}\n\nset\ data\ \{asdf\ asdfasdf\ asdfa\ asd\ asdfasd\}\n#\ The\ following\ will\ sort\ the\ command\ by\ String\ Length\nset\ data\ \[lsort\ -command\ lengthCompare\ \$data\]\n\n#\ More\ info\ -\n#\ The\ following\ makes\ a\ password\ out\ of\ the\ data\ by\ using\n#\ the\ word\ alone\ if\ it\ is\ 5\ chars\ or\ more,\ (eg\ asdfasd)\n#\ and\ by\ finding\ a\ match\ for\ it\ if\ it\ is\ less\ (eg\ asd-asdf)\n#\ than\ 5\ chars.\ \ The\ password\ can\ be\ max\ of\ 8\ chars\ in\n#\ this\ example.\n\n#\ This\ was\ used\ on\ a\ stripped-down\ version\ of\ the\ words\n#\ file\ for\ the\ UNIX\ spell\ checker\ to\ generate\ random\n#\ passwords.\n\nset\ datalength\ \[llength\ \$data\]\n\nset\ word1\ \[lindex\ \$data\ \[expr\ \{int(\[expr\ \{rand()*\$datalength\}\])\}\]\]\nset\ w1l\ \[string\ length\ \$word1\]\n\nif\ \{\$w1l\ <\ 5\}\ \{\n\ \ \ \ set\ pos\ \[expr\ \{int(\[expr\ \{rand()*\$datalength\}\])\}\]\n\ \ \ \ #\ This\ speedily\ decrements\ the\ random\ number\ generated\n\ \ \ \ #\ until\ the\ size\ is\ small\ enough\ to\ fit\ in\ an\ 8\ char\n\ \ \ \ #\ field.\n\ \ \ \ while\ \{\[expr\ \{8-\$w1l-\[string\ length\ \[lindex\ \$data\ \$pos\]\]\}\]\ <\ 1\}\ \{\n\ \ \ \ \ \ \ \ set\ pos\ \[expr\ \{int(\[expr\ \{rand()*\$pos\}\])\}\]\n\ \ \ \ \}\n\ \ \ \ set\ word2\ \[lindex\ \$data\ \$pos\]\n\ \ \ \ append\ word1\ \"-\$word2\"\n\ \ \ \ set\ word1\ \"\$word1\"\n\}\n\n#\ Output\ the\ password\nputs\ \"\$\{word1\}\\n\"\n======\n\n**\ String\ to\ list\ **\n\ncollapsing\ splitchar\ sequences\n\n**\ \[soundex\]\ **\n\n**\ \[Splitting\ strings\ into\ words\]\ **\n\n**\ Stack\ operations\ on\ lists:\ lpush\ prepends,\ lpop\ removes\ first\ element.\ \ **\n\nlpop\ and\ lappend\ make\ a\ FIFO\ queue.\n======\nproc\ lpush\ \{_list\ what\}\ \{\n\ \ \ upvar\ \$_list\ L\n\ \ \ if\ !\[info\ exists\ L\]\ \{set\ L\ \{\}\}\n\ \ \ set\ L\ \[concat\ \[list\ \$what\]\ \$L\]\n\}\nproc\ lpop\ \{_list\}\ \{\n\ \ \ upvar\ \$_list\ L\n\ \ \ if\ !\[info\ exists\ L\]\ \{return\ \"\"\}\n\ \ \ set\ t\ \[lindex\ \$L\ 0\]\n\ \ \ set\ L\ \[lrange\ \$L\ 1\ end\]\n\ \ \ return\ \$t\n\}\ \;#RS\n\n======\nalso\ see:\ \[yet\ another\ stack\ package\]\ and\ the\ \[Chart\ of\ proposed\ list\ functionality\]\n\n**\ Stack\ trace:\ just\ sprinkle\ a\ few\ of\ these\ \"probes\"\ around\ to\ see\ the\ stack\ at\ that\ point\ **\n\nshamelessly\ swiped\ from\ \[Cameron\ Laird\]\n\n======\nproc\ probe\ \{\}\ \{\n\ \ \ \ puts\ \"Stack\ trace:\"\n\ \ \ \ for\ \{set\ i\ \[expr\ \[info\ level\]\ -\ 1\]\}\ \{\$i\}\ \{incr\ i\ -1\}\ \{\n\ \ \ \ \ \ \ \ puts\ \"\ \ Processing\ '\[info\ level\ \$i\]'.\"\n\ \ \ \ \}\n\}\ \;#\ JCW\n======\n\nFor\ more\ on\ this\ subject,\ see\ \"\[Printing\ proc\ sequence\]\".\n\n**\ \[Stats\]\ **\n\nsimple\ statistical\ functions\ (mean,\ stddev,\ cov)\n\n**\ String\ to\ list\ **\n\n\[\[split\ \$s\]\]\ alone\ operates\ on\ each\ instance\ of\ the\ splitchar\n(default:space),\ so\ sequences\ of\ spaces\ will\ produce\ empty\ list\ elements.\ \n\n\[\[eval\ list\ \$s\]\]\ \ collapses\ whitespace\ sequences\ in\ one,\ but\ errors\ on\ unbalanced\ braces\ etc.\ \nThe\ following\ proc\ should\ join\ the\ best\ of\ both\ worlds:\n\n======\nproc\ string2list\ s\ \{\n\ \ \ \ if\ \[catch\ \{eval\ list\ \$s\}\ res\]\ \{\n\ \ \ \ \ \ \ \ set\ res\ \[list\]\n\ \ \ \ \ \ \ \ foreach\ i\ \[split\ \$s\]\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ if\ \{\$i!=\"\"\}\ \{lappend\ res\ \$i\}\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \}\n\ \ \ \ set\ res\n\}\ \;#RS\n%\ string2list\ \{a\ \ \ b\ c\ \ \ \ \ d\}\na\ b\ c\ d\n%\ string2list\ \"a\ \ \ b\ c\ \ \{\"\na\ b\ c\ \\\{\n%\ string2list\ \{unbalanced\ \"\}\nunbalanced\ \{\"\}\n======\n\nNote\ that\ this\ suffers\ from\ the\ same\ dangers\ as\ explained\ in\ the\n'''List\ well-formedness'''\ test\ above.\ \ Modifications\ for\ safety\nare\ left\ as\ an\ exercise\ for\ the\ reader\ (or\ the\ next\ Wiki\ visitor).\nYou\ have\ been\ warned.\ -\ '''DGP'''\n\n'''EE''':\ This\ seems\ as\ good\ a\ place\ as\ any\ to\ ask\ this\nquestion...\ Is\ there\ any\ effective\ difference,\ in\ general,\nbetween\ '''catch\ \{eval\ command\ \$args\}'''\nand\ '''catch\ \[\[linsert\ \$args\ 0\ command\]\]'''\ ?\n\nYes:\ The\ latter\ is\ more\ efficient.\ See\ \[pure\ list\]\ and\ \[many\ ways\ to\ eval\]\ for\ discussion.\n\n'''\[DGP\]''':\ Yes,\ see\ those\ pages,\ but\ efficiency\ differences\ are\nnot\ the\ main\ point.\ \ Those\ two\ examples\ will\ process\ newlines\ \nin\ the\ arguments\ differently.\ \ Newlines\ are\ significant\ to\ \[eval\]\nbut\ not\ necessarily\ preserved\ by\ list-processing\ commands.\n\n**\ Swap\ 2\ values\ efficiently\ **\n\nSwaps\ value\ of\ a\ with\ b\ without\ overhead\ of\ copying\ to\ a\ temporary\ variable:\n\n======\nforeach\ \{a\ b\}\ \[list\ \$b\ \$a\]\ break\n======\n\nWorks\ for\ a\ and\ b\ as\ numbers,\ strings\ and\ lists\ but\ not\ arrays.\n\n\[AMG\]:\ Here's\ a\ faster\ method\ that\ works\ using\ Tcl\ 8.5+.\n\n======\nlassign\ \[list\ \$b\ \$a\]\ a\ b\n======\n\nOn\ my\ machine,\ \[\[\[lassign\]\]\]\ takes\ 3.2239\ microseconds\ per\ iteration,\ whereas\ \[\[\[foreach\]\]\]\ takes\ 8.562\ microseconds\ per\ iteration.\n\n**\ \[subcommands\]:\ value-added\ switch,\ FREE\ error\ message\ \;-)\ **\n\n**\ Tabs\ to\ spaces,\ and\ back:\ courtesy\ \[Jeffrey\ Hobbs\]\ **\n\n======\n#\ untabify\ --\n#\ \ \ removes\ tabs\ from\ a\ string,\ replacing\ with\ appropriate\ number\ of\n#\ \ \ spaces.\ Arguments:\n#\ \ \ str\ \ \ \ \ \ \ \ \ input\ string\n#\ \ \ tablen\ \ \ \ \ \ tab\ length,\ defaults\ to\ 8\n#\ Returns:\n#\ \ \ string\ sans\ tabs\n#\nproc\ untabify\ \{str\ \{tablen\ 8\}\}\ \{\n\ \ \ \ set\ out\ \{\}\n\ \ \ \ while\ \{\[set\ i\ \[string\ first\ \"\\t\"\ \$str\]\]\ !=\ -1\}\ \{\n\ \ \ \ \ \ \ \ set\ j\ \[expr\ \{\$tablen-(\$i%\$tablen)\}\]\n\ \ \ \ \ \ \ \ append\ out\ \[string\ range\ \$str\ 0\ \[incr\ i\ -1\]\]\[format\ %*s\ \$j\ \{\ \}\]\n\ \ \ \ \ \ \ \ set\ str\ \[string\ range\ \$str\ \[incr\ i\ 2\]\ end\]\n\ \ \ \ \}\n\ \ \ \ return\ \$out\$str\n\}\n#\ tabify\ --\n#\ \ \ converts\ excess\ spaces\ to\ tab\ chars.\ Arguments:\n#\ \ \ str\ \ \ \ \ \ \ \ \ input\ string\n#\ \ \ tablen\ \ \ \ \ \ tab\ length,\ defaults\ to\ 8\n#\ Returns:\n#\ \ \ string\ with\ tabs\ replacing\ excess\ space\ where\ appropriate\n#\nproc\ tabify\ \{str\ \{tablen\ 8\}\}\ \{\n\ \ \ \ ##\ We\ must\ first\ untabify\ so\ that\ \\t\ is\ not\ interpreted\ to\ be\ 1\ char\n\ \ \ \ set\ str\ \[untabify\ \$str\]\n\ \ \ \ set\ out\ \{\}\n\ \ \ \ while\ \{\[set\ i\ \[string\ first\ \{\ \}\ \$str\]\]\ !=\ -1\}\ \{\n\ \ \ \ \ \ \ \ ##\ Align\ i\ to\ the\ upper\ tablen\ boundary\n\ \ \ \ \ \ \ \ set\ i\ \[expr\ \{\$i+\$tablen-(\$i%\$tablen)-1\}\]\n\ \ \ \ \ \ \ \ set\ s\ \[string\ range\ \$str\ 0\ \$i\]\n\ \ \ \ \ \ \ \ if\ \{\[string\ match\ \{*\ \}\ \$s\]\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ out\ \[string\ trimright\ \$s\ \{\ \}\]\\t\n\ \ \ \ \ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ out\ \$s\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ set\ str\ \[string\ range\ \$str\ \[incr\ i\]\ end\]\n\ \ \ \ \}\n\ \ \ \ return\ \$out\$str\n\}\n======\n\n**\ \[tailf\]\ tail\ -f\ piped\ to\ egrep,\ in\ pure\ tcl\ **\n\n**\ \[try\ ...\ finally\ ...\]\ **\n\n**\ \[telnet\]\ **\n\nSort\ of\n\nclient\ and\ server...\ but\ not\ exactly\ as\ in\ RFC854.\n\n**\ \[timers\].tcl\ -\ benchmarking/timing\ package\ **\n\n**\ \[UIC\ vehicle\ number\ validator\]\ -\ as\ used\ on\ European\ railways\ **\n\n**\ Unicode\ char\ to\ \\u\ sequence:\ simple,\ but\ handy\ when\ examining\ Unicode\ output:\ **\n\n======\nproc\ u2x\ \{u\}\ \{\n\ \ \ \ scan\ \$u\ %c\ t\;\ format\ \"\\\\u%04.4X\"\ \$t\n\}\ \;#RS\n======\n\n**\ \[Unit\ converter\]\ --\ Does\ km/h\ <->\ mph,\ DM\ <->\ EUR,\ C\ <->\ F\ ...\ **\n\n**\ \[URI\ detector\ for\ arbitrary\ text\ as\ a\ regular\ expression\]\ **\n\n**\ UTC\ --\ see\ \[GPS/UTC\ Time\ Conversion\ Functions\]\ **\n\n**\ \[Validating\ credit\ card\ check\ digits\]\ **\n\n**\ \[Visual\ Studio\ 2003\ .sln\ file\ parser\]\ **\n\n**\ Word\ frequency\ counts,\ see\ \[tally:\ a\ string\ counter\ gadget\]\ **\n\n**\ Plain\ string\ substitution\ **\n\nPrior\ to\ version\ 8.1.1,\ the\ only\ string\ substitution\ facility\ in\ the\ Tcl\ core\nuses\ regular\ expressions,\ which\ for\ substituting\ special\ text\ can\ be\ a\ pain.\nHere's\ a\ procedure\ to\ do\ a\ plain\ substition\ (with\ no\ extra\ features).\ See\n\"string\ map\"\ in\ newer\ versions.\n\n======\nproc\ plainsub\ \{text\ item\ replacewith\}\ \{\n\ \ \ \ set\ len\ \[expr\ \[string\ length\ \$item\]-1\]\n\ \ \ \ while\ \{\[set\ pos\ \[string\ first\ \$item\ \$text\]\]\ !=\ -1\}\ \{\n\ \ \ \ \ \ \ \ set\ text\ \[string\ replace\ \$text\ \$pos\ \[expr\ \$pos+\$len\]\ \$replacewith\]\n\ \ \ \ \}\n\ \ \ \ return\ \$text\n\}\ \;#FW\n======\n\n\[RS\]\ What's\ bad\ with\ the\ following?\n\n======\nset\ text\ \[string\ map\ \[list\ \$item\ \$replacewith\]\ \$text\]\n======\n\n\[FW\]\ Nothing,\ I'm\ pretty\ much\ just\ starting\ out\ coding,\ for\ a\ second\ there\ I\nthought\ I'd\ made\ something\ useful\ \;)\ \ \[CL\]\ interrupts:\ \ Nah,\ the\ correct\ answer\nis\ that\ Richard's\ set\ text\ ...\"\ is\ bad\ because\ \"\[string\ map\]\ ...\"\ only\ appeared\nwith\ 8.1.1.\n\nAs\ bad\ things\ go,\ that's\ only\ a\ tiny\ badness.\n\n**\ Split\ on\ Punctuation\ **\n\n\[FW\]:\ breaks\ a\ line\ of\ text\ into\ an\ alternating\ list\ of\ words\ and\ punctuation.\n\nFor\ example:\n\ (bin)\ 8\ %\ break_text\ \"A\ sentence,\ merely.\ \ Move\ along.\"\n\ A\ \{\ \}\ sentence\ \{,\ \}\ merely\ \{.\ \ \}\ Move\ \{\ \}\ along\ .\n\nThis\ would\ be\ used\ for\ most\ any\ language\ processing\ task,\ where\ you\ would\ break\na\ sentence\ into\ words,\ perform\ operations\ on\ the\ words,\ then\ put\ it\ back\ntogether.\ \ Here\ it\ is:\n\n======\nproc\ break_text\ \{text\ \{splitchars\ \{,\ .\"\;!:\}\}\}\ \{\n\ \ \ \ #\ Escape\ all\ the\ split\ characters\ so\ brackets,\ ^\ etc.\ will\ be\ accepted.\n\ \ \ \ set\ regexp\ \"\\\[\\\\\[join\ \[split\ \$splitchars\ \"\"\]\ \\\\\]\\\]+|\$\"\n\ \ set\ wp\ \[list\]\n\ \ set\ pos\ 0\n\ \ for\ \{set\ pos\ 0\}\ \{\$pos\ <\ \[string\ length\ \$text\]\ &&\ \[regexp\ -indices\ -start\ \$pos\ \$regexp\ \$text\ matches\]\}\n\ \ \ \ \ \ \{set\ pos\ \[expr\ \{\[lindex\ \$matches\ 1\]\ +\ 1\}\]\}\ \{\n\n\ \ \ \ lappend\ wp\ \\\n\ \ \ \ \ \ \[string\ range\ \$text\ \$pos\ \[expr\ \{\[lindex\ \$matches\ 0\]\ -\ 1\}\]\]\ \\\n\ \ \ \ \ \ \[eval\ string\ range\ \[list\ \$text\]\ \$matches\]\n\ \ \}\n\ \ return\ \$wp\n\}\n======\n''update:\ Now\ you\ can\ break\ by\ a\ character\ set\ of\ your\ choice\ by\ the\ optional\ second\ argument.\ \ \nAnd\ returns\ a\ flat\ list\ rather\ than\ a\ list\ of\ lists,\ for\ better\ use\ by\ foreach,\ etc.''\n\n**\ \[Sample\ Math\ Programs\]\ **\n\n<<categories>>\ Algorithm\ |\ Example\ |\ Arts\ and\ crafts\ of\ Tcl-Tk\ programming regexp2} CALL {my render {Bag of algorithms} Here's\ some\ \"few-liner\"\ code\ examples,\ contributed\ by\ \[Richard\ Suchenwirth\],\ <YOUR\ NAME\ HERE>,\ ...\ .\ \nHelp\ yourself!\ Add\ comments\ when\ you\ know\ it\ better!\ \nUse\ the\ `Edit`\ link\ at\ bottom\ of\ page\ for\ contributing!\ \nShort\ procs\ (fitting\ between\ thumb\ and\ index\ finger\ \;-)\ go\ right\ here,\ \nlonger\ ones\ get\ their\ own\ pages\ and\ are\ linked\ on\ this\ page.\n\ \ \ *\ Tk\ stuff\ has\ now\ been\ moved\ out\ to\ \[Bag\ of\ Tk\ algorithms\].\n\ \ \ *\ See\ also\ \[Donal\ Fellows\]'\ Tcl\ Archive:\ \[http://www.man.ac.uk/~zzcgudf/tcl/\]\n\ \ \ *\ Also\ moved\ some\ of\ Richard's\ language-related\ stuff\ into\ \[Bag\ of\ number/time\ spellers\]\ (JC)\n\ \ \ *\ You\ may\ also\ be\ interested\ in\ the\ \[Example\ Scripts\ Everybody\ Should\ Have\]\ (DKF)\ and\ \[Regular\ Expression\ Examples\]\ (RWT)\n\ \ \ *\ See\ also\ \[Braintwisters\]\ for\ more\ esoteric\ snippets\ (\[FW\])\n\n<<TOC>>\n\n**\ 1-Bits\ in\ a\ positive\ int\ **\n\nSee\ \[Bit\ Twiddling\]\n\n**\ ASCII\ map\ **\n\nsee\ \[Additional\ string\ functions\]\n\n\n**\ \[A\ simple\ Arabic\ renderer\]\ **\n\n'''Arabic'''\ from\ ASCII\ transliteration\ (Buckwalter)\ to\ Unicode,\ from\ abstract\ characters\ to\ glyphs\n\n**\ Application\ home\ **\n\nFind\ the\ real/exact/full\ path\ of\ the\ running\ script\n\n======\nproc\ app_home\ \{\}\ \{\n\ \ \ \ set\ old_dir\ \[pwd\]\n\ \ \ \ set\ f\ \ \ \ \ \ \$::argv0\n\ \ \ \ set\ f_path\ \[file\ dirname\ \$f\]\n\ \ \ \ set\ f_tail\ \[file\ tail\ \$f\]\n\ \ \ \ cd\ \ \$f_path\n\ \ \ \ set\ f\ \$f_tail\n\ \ \ \ while\ \{!\[catch\ \{file\ readlink\ \$f\}\ result\]\}\ \{\n\ \ \ \ \ \ \ \ cd\ \[file\ dirname\ \$result\]\n\ \ \ \ \ \ \ \ set\ f_path\ \[pwd\]\ \ \ \;#\ pwd\ makes\ path\ absolute\n\ \ \ \ \ \ \ \ set\ f_file\ \[file\ tail\ \$result\]\n\ \ \ \ \ \ \ \ set\ f\ \[file\ join\ \$f_path\ \$f_file\]\n\ \ \ \ \}\n\ \ \ \ cd\ \$old_dir\n\ \ \ \ return\ \$f_path\n\}\n======\n''I\ can\ not\ remember\ where\ I\ took\ this\ originally\ from.\ Sorry''\n\[Andreas\ Wilm\]\n\n\[Lars\ H\]:\ Here\ is\ another\ approach\ to\ the\ above,\ which\ also\ returns\ the\ list\ \nof\ all\ \"home\"\ directories\ (a\ link\ may\ point\ to\ another\ link,\ and\ then\ to\ yet\ \nanother,\ etc.)\n\n======\nproc\ app_homes\ \{\}\ \{\n\ \ \ \ set\ res\ \[list\]\n\ \ \ \ set\ me\ \[info\ script\]\n\ \ \ \ catch\ \{\n\ \ \ \ \ \ \ while\ \{1\}\ \{\n\ \ \ \ \ \ \ \ \ \ set\ mydir\ \[file\ dirname\ \$me\]\n\ \ \ \ \ \ \ \ \ \ lappend\ res\ \$mydir\n\ \ \ \ \ \ \ \ \ \ set\ me\ \[file\ join\ \$mydir\ \[file\ readlink\ \$me\]\]\n\ \ \ \ \ \ \ \}\;\ #\ Eventually\ the\ \[file\ readlink\]\ errors\n\ \ \ \ \}\n\ \ \ \ return\ \$res\n\}\n======\nIt\ could\ probably\ do\ with\ some\ \[file\ normalize\]s.\ However,\ a\ comparison\ of\ \n\$::argv0\ and\ \[\[info\ script\]\]\ from\ a\ portability\ perspective\ could\ be\ interesting.\n\n\[SG\]:\ I'm\ probably\ just\ missing\ something\ (I\ usually\ do)\ but\ what\ does\ any\ of\nthis\ do\ that\ \[pwd\]\ doesn't?\n\n\[Lars\ H\]:\ Lots\ of\ things.\ For\ one,\ the\ script\ might\ have\ been\ started\ as\n======none\n%\ tclsh\ /full/path/to/script.tcl\n======\n\nFor\ 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.\n\n**\ Array-preserving\ Order\ of\ Elements\ **\n\nif\ you\ want\ to\ keep\ a\ history\ in\ what\ sequence\n\narray\ elements\ were\ added,\ have\ a\ look\ at\ \[Numbered\ arrays\]\n\n**\ Assertions\ **\n\ncan\ be\ implemented\ in\ millions\ of\ ways,\ here\ is\ one:\n\n======\nproc\ Assert\ \{condition\}\ \{\n\ \ \ \ if\ \{\[catch\ \{uplevel\ \[list\ expr\ \$condition\]\}\ n\]\ ||\ \$n\ ==\ \"\"\ ||\ \$n\ ==\ 0\}\ \{\n\ \ \ \ \ \ \ \ Puts\ \"Assertion\ failed\ (result\ \$n),\ in:\"\n\ \ \ \ \ \ \ \ set\ prefix\ \"\"\n\ \ \ \ \ \ \ \ for\ \{set\ i\ \[info\ level\]\}\ \{\$i\}\ \{incr\ i\ -1\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ prefix\ \"\ \ \"\n\ \ \ \ \ \ \ \ \ \ \ \ puts\ \"\$prefix'\[info\ level\ \$i\]'\"\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ #\ try\ to\ call\ a\ failure\ handler\ to\ collect\ more\ info\n\ \ \ \ \ \ \ \ if\ \{!\[catch\ ::AssertionFailureHandler\ msg\]\ &&\ \$msg\ !=\ \"\"\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ condition\ \"\ (\$msg)\"\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ #error\ \"Assertion\ failed:\ \$condition\"\n\ \ \ \ \ \ \ \ puts\ \"Assertion\ failed:\ \$condition\"\n\ \ \ \ \ \ \ \ exit\n\ \ \ \ \}\n\}\ \;#\ JCW\n======\n\nAnd\ of\ course\ disabled\ simply\ by\ overriding\ the\ above\ definition\ with\ \"proc\ Assert\ \{x\}\ \{\}\".\n\n**\ \[AtExit\ Handlers\]\ **\n\ncleanup\ on\ program\ exit\ for\ you.\n\n**\ Autokill\ **\n\nkill\ an\ application\ after\ a\ resettable\ delay:\n\n======\nproc\ autokill\ \{delay\ \{id\ \"\"\}\}\ \{\n\ \ \ \ if\ \{\$id\ !=\ \"\"\}\ \{after\ cancel\ \$id\}\n\ \ \ \ set\ id\ \[after\ \[expr\ int(\$delay\ *\ 1000\ *\ 60)\]\ \{exit\}\]\n\ \ \ \ proc\ autokill\ \"\[list\ delay\ \[list\ id\ \$id\]\]\"\ \[info\ body\ autokill\]\n\}\nautokill\ 30\;\ #exit\ after\ a\ 30\ minute\ delay\n======\n\ncall\ it\ again,\ the\ same\ way\ to\ reset\ the\ timer.\nUseful\ in\ situations\ where\ an\ application\ uses\ a\ lot\ of\ network\ resources,\ \nand\ has\ the\ potential\ for\ a\ user\ to\ leave\ it\ running\ while\ not\ in\ use.\ --\ \[AJB\]\n\n**\ \[automatic\ .bak\ files\]\ **\n\nautomatically\ backs\ up\ files\ N\ levels\ deep\ to\ avoid\ overwrites\n\n**\ Average\ **\n\nSee\ \[Additional\ math\ functions\]\n\n**\ \[Base\ 64\ encode/decode\]\ **\n\n'''shamelessly\ stolen\ from\ Steve\ Uhler\ and\ Brent\ Welch'''\n\n**\ \[Cartesian\ product\ of\ a\ list\ of\ lists\]\ **\n\n**\ Character\ frequency\ counts\ **\n\nsee\ \[tally:\ a\ string\ counter\ gadget\]\n\n**\ Clock\ clicks\ resolution\ **\n\nUnlike\ 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:\n\n======\nexpr\ \{-\[clock\ clicks\]\ +\ \[after\ 1000\;\ clock\ clicks\]\}\n======\n\n**\ configuration\ files\ **\n\nthis\ proc\ can\ be\ added\ to\ an\ application\n\n======\nproc\ configfile\ \{name\}\ \{\n\ \ \ \ global\ \$name\n\ \ \ \ set\ data\ \[read\ \[set\ fh\ \[open\ \[info\ script\]\ r\]\]\]\n\ \ \ \ close\ \$fh\n\ \ \ \ array\ set\ \$name\ \$data\n\ \ \ \ catch\ \{unset\ \$\{name\}(configfile)\ \$\{name\}(#)\}\n\ \ \ \ return\ -code\ return\n\}\n======\n\nand\ then\ at\ the\ top\ of\ a\ file\ you\ wish\ to\ be\ loaded\ as\ a\ configuration\ file\nsimply\ add\ configfile\ var\n\nof\ course\ you\ must\ load\ the\ file\n======\nif\ \{\[catch\ \{source\ myconfigfile\}\ err\]\}\ \{\n\ \ \ \ #\ some\ error\ occured\n\}\n======\n\nthe\ contents\ of\ the\ file\ then\ end\ up\ in\ global\ variable\ var\n\nan\ example\ file:\n\n======none\nconfigfile\ options\nsetting\ value\nsetting2\ \{some\ large\ value\}\n======\n\nthis\ was\ developed\ for\ \[Easy\ User\ Configurable\ Menus\]\n\n\n**\ Compact\ integer\ list\ to\ list\ **\n\n\{1-4\ 6-8\}\ =>\ \{1\ 2\ 3\ 4\ 6\ 7\ 8\}\n\n======\nproc\ clist2list\ \{clist\}\ \{\n\ \ \ \ #--\ clist:\ compact\ integer\ list\ w.ranges,\ e.g.\ \{1-5\ 7\ 9-11\}\n\ \ \ \ set\ res\ \{\}\n\ \ \ \ foreach\ i\ \$clist\ \{\n\ \ \ \ \ \ \ \ if\ \[regexp\ \{(\[^-\]+)-(\[^-\]+)\}\ \$i\ ->\ from\ to\]\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ for\ \{set\ j\ \[expr\ \$from\]\}\ \{\$j<=\[expr\ \$to\]\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \$j\n\ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \}\ else\ \{lappend\ res\ \[expr\ \$i\]\}\n\ \ \ \ \}\n\ \ \ \ return\ \$res\n\}\ \;#RS\n======\n\n**\ Compact\ list\ to\ list\ **\n\n\{2-4\ a\ c-e\ A\ C-E\}\ =>\ \{2\ 3\ 4\ a\ c\ d\ e\ A\ C\ D\ E\}\n\nAs\ above,\ this\ one\ handles\ a-z\ and\ A-Z\ as\ well\ as\ the\ proposed\ 0-9.\n\n======\nproc\ clist2list\ \{\{args\ \"\"\}\}\ \{\n\ \ \ \ if\ \{\[llength\ \$args\]\ !=\ 1\}\ \{\n\ \ \ \ \ \ \ \ error\ \{wrong\ #\ args:\ should\ be\ \"clist2list\ clist\"\}\n\ \ \ \ \}\n\ \ \ \ set\ clist\ \[lindex\ \$args\ 0\]\n\ \n\ \ \ \ #\ Ensure\ clist\ is\ in\ list\ format,\ if\ not\ then\ make\ it\ so.\n\ \ \ \ if\ \{\[catch\ \{llength\ \$clist\}\]\}\ \{set\ clist\ \[split\ \$clist\]\}\n\ \n\ \ \ \ array\ set\ map\ \[list\ \\\n\ \ \ \ \ \ \ \ a\ \ 1\ \ \ b\ \ 2\ \ \ c\ \ 3\ \ \ d\ \ 4\ \ \ e\ \ 5\ \\\n\ \ \ \ \ \ \ \ f\ \ 6\ \ \ g\ \ 7\ \ \ h\ \ 8\ \ \ i\ \ 9\ \ \ j\ 10\ \\\n\ \ \ \ \ \ \ \ k\ 11\ \ \ l\ 12\ \ \ m\ 13\ \ \ n\ 14\ \ \ o\ 15\ \\\n\ \ \ \ \ \ \ \ p\ 16\ \ \ q\ 17\ \ \ r\ 18\ \ \ s\ 19\ \ \ t\ 20\ \\\n\ \ \ \ \ \ \ \ u\ 21\ \ \ v\ 22\ \ \ w\ 23\ \ \ x\ 24\ \ \ y\ 25\ \\\n\ \ \ \ \ \ \ \ z\ 26\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \\\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \\\n\ \ \ \ \ \ \ \ \ 1\ a\ \ \ \ 2\ b\ \ \ \ 3\ c\ \ \ \ 4\ d\ \ \ \ 5\ e\ \\\n\ \ \ \ \ \ \ \ \ 6\ f\ \ \ \ 7\ g\ \ \ \ 8\ h\ \ \ \ 9\ i\ \ \ 10\ j\ \\\n\ \ \ \ \ \ \ \ 11\ k\ \ \ 12\ l\ \ \ 13\ m\ \ \ 14\ n\ \ \ 15\ o\ \\\n\ \ \ \ \ \ \ \ 16\ p\ \ \ 17\ q\ \ \ 18\ r\ \ \ 19\ s\ \ \ 20\ t\ \\\n\ \ \ \ \ \ \ \ 21\ u\ \ \ 22\ v\ \ \ 23\ w\ \ \ 24\ x\ \ \ 25\ y\ \\\n\ \ \ \ \ \ \ \ 26\ z\]\n\ \n\ \ \ \ set\ re_syntax\ \{^((\[0-9\]+-\[0-9\]+)|(\[A-Z\]-\[A-Z\])|(\[a-z\]-\[a-z\]))\$\}\n\ \ \ \ set\ res\ \{\}\n\ \ \ \ foreach\ i\ \$clist\ \{\n\ \ \ \ \ \ \ \ if\ \{\[regexp\ \$re_syntax\ \$i\ ->\ range\ a\ b\ c\]\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ set\ range\ \[split\ \$range\ -\]\n\ \ \ \ \ \ \ \ \ \ \ \ set\ start\ \[lindex\ \$range\ 0\]\n\ \ \ \ \ \ \ \ \ \ \ \ set\ stop\ \ \[lindex\ \$range\ 1\]\n\ \ \ \ \ \ \ \ \ \ \ \ switch\ --\ \[expr\ \{(\$a!=\"\")?1:(\$b!=\"\")?2:(\$c!=\"\")?3:4\}\]\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 1\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ for\ \{set\ j\ \$start\}\ \{\$j\ <=\ \$stop\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \$j\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 2\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ set\ j\ \$map(\[string\ tolower\ \$start\])\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ for\ \{\}\ \{\$j\ <=\ \$map(\[string\ tolower\ \$stop\])\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \[string\ toupper\ \$map(\$j)\]\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 3\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ for\ \{set\ j\ \$map(\$start)\}\ \{\$j\ <=\ \$map(\$stop)\}\ \{incr\ j\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ lappend\ res\ \$map(\$j)\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ \}\ \ \ \ \ \ \ else\ \{lappend\ res\ \$i\}\n\ \ \ \ \}\;\ return\ \$res\n\}\ \;#\ Carl\ M.\ Gregory,\ MC_8\ --\ http://mc.purehype.net/\n======\n\n**\ Country\ name\ server\ **\n\nCH\ <->\ Switzerland..\ see\ \[Language/Country\ name\ servers\]\n\n**\ Credit\ card\ check\ digit\ validation\ **\n\nsee\ \[Validating\ credit\ card\ check\ digits\]\n\n**\ Cross\ sum\ of\ a\ digit\ sequence\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ csv\ strings\ **\n\ncomma-separated\ values,\ as\ exported\ e.g.\ by\ Excel,\ see\ \[Parsing\ csv\ strings\]\n\n**\ Date\ scanning\ **\n\n''clock\ scan''\ older\ versions\ (pre\ 8.3?)\ did\ not\ handle\nthe\ frequent\ (ISO-standardized)\ format\ YYYY-MM-DD\ hh:mm:ss.\nHere's\ a\ workaround\ by\ \[Hume\ Smith\]\ to\ be\ used\ in\ the\ place\ of\ clock\ scan\ for\ such\ cases:\n\n======\nproc\ yyyy-mm-dd\ \{dtstring\}\ \{\n\ \ \ \ set\ time\ \{\}\ \;#\ this\ allows\ pure\ dates\ without\ time\n\ \ \ \ scan\ \$dtstring\ %d-%d-%d%s\ year\ month\ day\ time\n\ \ \ \ clock\ scan\ \"\$month/\$day/\$year\ \$time\"\n\}\ \;#\ RS\n======\n\nand\ another\ by\ \[Bruce\ Gingery\]:\n\n======\nproc\ YYYYMMDD2MDY\ \{dtstring\}\ \{\n\ \ \ \ set\ patt\ \{^\[1-2\]\[0-9\](\[0-9\]\[0-9\])-(\[0-9\]\[0-9\]?)-(\[0-9\]\[0-9\]?)\}\n\ \ \ \ set\ subs\ \{\\2/\\3/\\1\}\n\ \ \ \ regsub\ \$patt\ \$dtstring\ \$subs\ dtstring\n\ \ \ \ return\ \$dtstring\n#\ or\ return\ \[clock\ scan\ \$dtstring\]\n\}\n======\n\n**\ Date\ and\ Time\ in\ a\ Handy\ Format\ **\n\nlike\ 22.07.99,19:59:00\n\n======\nproc\ date,time\ \{\{when\ \"\"\}\}\ \{\n\ \ \ \ \ \ if\ \{\$when\ ==\ \"\"\}\ \{set\ when\ \[clock\ seconds\]\}\n\ \ \ \ \ \ clock\ format\ \$when\ -format\ \"%d.%m.%y,%H:%M:%S\"\n\}\ \;#RS\n======\n\n**\ \[Debugging\ Aid\ For\ Production\ Code\]\ **\n\n-PSE\n\n**\ Disk\ free\ capacity\ **\n\nin\ Kilobytes:\n\n======\nproc\ df-k\ \{\{dir\ .\}\}\ \{\n\ \ \ \ switch\ \$::tcl_platform(os)\ \{\n\ \ \ \ FreeBSD\ -\n\ \ \ \ Linux\ -\n\ \ \ \ OSF1\ -\n\ \ \ \ SunOS\ \{\n\ \ \ \ \ \ \ \ #\ Use\ end-2\ instead\ of\ 3\ because\ long\ mountpoints\ can\ \n\ \ \ \ \ \ \ \ #\ make\ the\ output\ to\ appear\ in\ two\ lines.\ There\ is\ df\ -k\ -P\n\ \ \ \ \ \ \ \ #\ to\ avoid\ this,\ but\ -P\ is\ Linux\ specific\ afaict\n\ \ \ \ \ \ \ \ lindex\ \[lindex\ \[split\ \[exec\ df\ -k\ \$dir\]\ \\n\]\ end\]\ end-2\n\ \ \ \ \}\n\ \ \ \ HP-UX\ \{lindex\ \[lindex\ \[split\ \[exec\ bdf\ \ \ \$dir\]\ \\n\]\ end\]\ 3\}\n\ \ \ \ \{Windows\ NT\}\ \{\n\ \ \ \ \ \ \ \ expr\ \[lindex\ \[lindex\ \[split\ \[exec\ cmd\ /c\ dir\ /-c\ \$dir\]\ \\n\]\ end\]\ 0\]/1024\n\ \ \ \ \ \ \ \ \ \ \ \ #\ CL\ notes\ that,\ someday\ when\ we\ want\ a\ bit\ more\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ sophistication\ in\ this\ region,\ we\ can\ try\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ something\ like\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ \ \ \ secpercluster,bytespersector,\ \\\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ \ \ \ freeclusters,noclusters\ =\ \\\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ \ \ \ \ \ \ \ \ win32api.GetDiskFreeSpace(drive)\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ Then\ multiply\ long(freeclusters),\ secpercluster,\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ and\ bytespersector\ to\ get\ a\ total\ number\ of\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ effective\ free\ bytes\ for\ the\ drive.\n\ \ \ \ \ \ \ \ \ \ \ \ #\ CL\ further\ notes\ that\n\ \ \ \ \ \ \ \ \ \ \ \ #http://developer.apple.com/techpubs/mac/Files/Files-96.html\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ explains\ use\ of\ PBHGetVInfo()\ to\ do\ something\ analogous\n\ \ \ \ \ \ \ \ \ \ \ \ #\ \ \ \ for\ MacOS.\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ default\ \{error\ \"don't\ know\ how\ to\ df-k\ on\ \$::tcl_platform(os)\"\}\n\ \ \ \ \}\n\}\ \;#RS\n======\n\nfor\ Win9x\ replace\ cmd\ with\ command.\ Note\ that\ W98(SE)?\ may\ report\ as\ Windows\ 95.\nSo,\n\ \ \ \{Windows\ 95\}\ \{\n\ \ \ \ \ \ \ \ expr\ \[lindex\ \[lindex\ \[split\ \[exec\ command\ /c\ dir\ /-c\ \$dir\]\ \\n\]\ end\]\ 0\]/1024\n\ \ \ \}\n----\nEvery\ time\ df\ comes\ up\ in\ clt,\ I\ think\ I\ should\ write\ one\ that\ works\nfor\ us\ *poor\ souls*\ who\ are\ stuck\ in\ the\ world\ of\ win9x.\ \ So\ the\nother\ night...:\n----\n\n======\nproc\ free_win\ \{\ \}\ \{\n\ \ \ \ set\ res\ \[eval\ exec\ \[auto_execok\ dir\]\]\n\ \ \ \ set\ var\ \[expr\ \[llength\ \$res\]\ -3\]\n\ \ \ \ set\ free_space\ \[lrange\ \$res\ \$var\ end\]\n\ \ \ \ return\ \$free_space\n\}\n======\n\nThis\ works\ on\ win95,\ 98\ and\ NT,\ with\ tcl/tk\ 8.0\ through\ 8.4a2.\nIf\ anybody\ tests\ it\ with\ win2000\ or\ ME,\ please\ let\ us\ know\nthe\ result.\n\n''so''\ 04/20/01\n\n**\ do\ ...\ while\ **\n\nSee\ also\ \[do...until\ in\ Tcl\]\n\ndo\ ...\ while\ loop\ structure,\ as\ in\ C\n\nloop\ structure.\ By\ Morten\ Skaarup\ Jensen\n\n======\nproc\ do\ \{cmds\ while\ expr\}\ \{\n\ \ \ \ uplevel\ \ \$cmds\n\ \ \ \ uplevel\ \"while\ \[list\ \$expr\]\ \[list\ \$cmds\]\"\n\}\n======\n\n======\n#\ Example\ of\ use\nset\ x\ 0\ndo\ \{\n\ \ \ \ puts\ \$x\n\ \ \ \ incr\ \$x\n\}\ while\ \{\$x\ <\ 10\}\n======\n\nThis\ doesn't\ work\ 100%\ with\ breaks.\ Catch\ might\ be\ the\ best\ way\ to\ improve\ this.\ \n\n**\ Drive\ letters\ **\n\non\ Windows\ --\ \"file\ volumes\"\ lists\ drives\ even\ if\ there's\ no\ medium\ in\ it.\nmailto:[email protected]\ contributed\ this\ code\ to\ list\ mapped\ and\nexisting\ drives:\n\n======\nproc\ drives\ \{\}\ \{\n\ \ \ \ 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\]\ \{\n\ \ \ \ \ \ \ \ if\ \{\[catch\ \{file\ stat\ \$\{drive\}:\ dummy\}\]\ ==\ 0\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ lappend\ drives\ \$drive\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \}\n\ \ \ \ return\ \$drives\n\}\n======\n\n**\ English\ number\ speller\ **\n\ne.g.\ en:num\ 29\ =>\ twenty-nine,\ see\ \[Bag\ of\ number/time\ spellers\]\n\n**\ Executable\ scripts\ **\n\nTcl\ scripts\ with\ initial\ magic\ can\ be\ called\ directly\ from\ a\ shell\ prompt.\nIn\ UNIX,\ you\ can\ specify\ the\ path\ to\ tclsh\ (or\ wish,\ as\ you\ wish)\ in\ a\ special\ comment\ line,\ e.g.\n\ #!/tools/bin/tclsh\nbut\ this\ requires\ adaptation\ to\ the\ local\ situation.\ More\ flexible\ is\nthe\ following,\ which\ finds\ the\ way\ itself:\n\ #!/bin/sh\n\ #\ the\ next\ line\ restarts\ using\ -*-Tcl-*-sh\ \\\n\ exec\ tclsh\ \"\$0\"\ \$\{1+\"\$@\"\}\n\nTom\ Tromey\ explains\ the\ \$\{1+\"\$@\"\}\ bit\ in\ \[exec\ magic\]\n\nThe\ -*-\ stuff\ instructs\ emacs\ to\ treat\ this\ file\ in\ Tcl\ mode.\nIn\ both\ cases,\ do\ a\ ''chmod\ +x\ filename''\ for\ real\ availability.\n\nFor\ Win95,\ \[Rolf\ Schroedter\]\ reports\ the\ following\ to\ work:\nfile\ foo.bat:\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \{\ \;#\ run\ tcl-script\ from\ BAT-file\n\ \ \ \ \ \ \ \ tclsh80\ %0\ %1\ %2\ %3\ %4\ %5\ %6\ %7\ %8\ %9\n\ \ \ \ \ \ \ \ exit\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ puts\ \"Tcl\ \$tcl_patchLevel\"\n\nSmall\ 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.\nI\ cannot\ find\ any\ command\ to\ just\ terminate\ the\ running\ script,\ so\nI\ use:\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \{\ \;#\ run\ tcl-script\ from\ BAT-file\n\ \ \ \ \ \ \ \ tclsh80\ %0\ %1\ %2\ %3\ %4\ %5\ %6\ %7\ %8\ %9\n\ \ \ \ \ \ \ \ goto\ EOF\n\ \ \ \ \ \ \ \ \}\n\n\ \ \ \ \ \ \ \ #\ your\ TCL\ code\ goes\ here\n\ \ \ \ \ \ \ \ #\ ...\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \\\n\ \ \ \ \ \ \ :EOF\n\n\nMight\ get\ a\ problem\ if\ \":EOF\"\ is\ a\ valid\ Proc\ in\ your\ program\ and\ gets\ called\ in\ the\ main\ program,\ though.\ -\ Michael\ Teske\n\nThis\ works\ for\ me\ on\ NT:\n\n\ \ \ \ \ \ \ \ ::set\ run_dos\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ @tclsh\ %~f0\ %*\n\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ exit\ /b\n\ \ \ \ \ \ \ \ \}\n\nIt\ has\ the\ added\ advantage\ that\ all\ command\ line\ arguments\ are\ given\ to\ tclsh\ (\"%*\")\ and\ \nthat\ the\ tclsh\ gets\ the\ full\ path\ of\ the\ file\ to\ start\ (\"%~f0\")\ -\ Klaus\ Marius\ Hansen\ -\ \nSee\ also\ \[DOS\ BAT\ magic\]\n\n**\ expr\ **\n\n\ \ \ *\ \[Importing\ expr\ functions\]\n\ \ \ *\ \[expr\ problems\ with\ int\]\n\n**\ File\ line\ termination\ **\n\nCR\ and/or\ LF?\ \[Donal\ Fellows\]\ shows\ the\ way:\n\n======\nproc\ file_lineterm\ \{filename\}\ \{\n\ \ \ \ set\ fd1\ \[open\ \$filename\ r\]\n\ \ \ \ set\ fd2\ \[open\ \$filename\ r\]\;#\ Avoids\ most\ synch\ problems...\n\ \ \ \ fconfigure\ \$fd2\ -translation\ binary\n\ \ \ \ set\ EOLidx\ \[string\ length\ \[gets\ \$fd1\]\]\n\ \ \ \ close\ \$fd1\n\ \ \ \ read\ \$fd2\ \$EOLidx\n\ \ \ \ set\ EOLchars\ \[read\ \$fd2\ 2\]\n\ \ \ \ close\ \$fd2\n\ \ \ \ if\ \{\[string\ equal\ \$EOLchars\ \"\\r\\n\"\]\}\ \{\n\ \ \ \ \ \ \ \ return\ \"crlf\"\ \;#\ DOS/Windows\n\ \ \ \ \}\ elseif\ \{\[string\ equal\ \[string\ index\ \$EOLchars\ 0\]\ \"\\r\"\]\}\ \{\n\ \ \ \ \ \ \ \ return\ \"cr\"\ \ \ \;#\ Mac\n\ \ \ \ \}\ elseif\ \{\[string\ equal\ \[string\ index\ \$EOLchars\ 0\]\ \"\\n\"\]\}\ \{\n\ \ \ \ \ \ \ \ return\ \"lf\"\ \ \ \;#\ Unix\n\ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ return\ \"unknown\"\n\ \ \ \ \}\n\}\n======\n\n\[Lars\ H\],\ 27\ Feb\ 2003:\ Doesn't\ that\ --\ rather\ than\ determining\ what\ is\ the\nline\ terminator\ in\ the\ specified\ file\ --\ determine\ what\ Tcl\ considers\ to\ be\nthe\ line\ terminator?\n''Answering\ myself\ 9\ Sep\ 2004:''\ Yes\ it\ does,\ but\ the\ default\ for\ Tcl\ \nreading\ files\ is\ to\ treat\ '''all'''\ of\ lf,\ cr,\ and\ crlf\ as\ a\ line\ termination,\ \nso\ you\ really\ get\ the\ wanted\ information\ about\ which\ one\ of\ those\ three\ it\ \nis\ in\ this\ file.\n\n**\ File\ mode\ **\n\nUnix\ style\n\nreturns\ something\ like\ drwxr--r--\n======\nproc\ file_mode\ fn\ \{\n\ \ \ \ file\ stat\ \$fn\ t\n\ \ \ \ if\ \[file\ isdirectory\ \$fn\]\ \{\n\ \ \ \ \ \ \ \ set\ prefix\ \"d\"\n\ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ set\ prefix\ \"-\"\n\ \ \ \ \}\n\ \ \ \ set\ s\ \[format\ %03o\ \[expr\ \$t(mode)%512\]\]\n\ \ \ \ foreach\ i\ \{\ \ 0\ \ \ 1\ \ \ 2\ \ \ 3\ \ \ 4\ \ \ 5\ \ \ 6\ \ \ 7\}\ \\\n\ \ \ \ \ \ \ \ j\ \{---\ --x\ -w-\ -wx\ r--\ r-x\ rw-\ rwx\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ regsub\ -all\ \$i\ \$s\ \$j\ s\n\ \ \ \ \}\n\ \ \ \ return\ \$prefix\$s\n\}\ \;#RS\n======\n\n**\ File\ reader\ **\ntakes\ a\ filename,\ returns\ the\ lines\ of\ that\ file\ as\ \ a\ list.\nTrivial\ algorithm,\ but\ note\ the\ \"whitespace\ sugar\":\ \nmentions\ of\ a\ variable\ are\ vertically\ aligned\ to\ indicate\ data\ flow\ \;-)\n\n======\nproc\ file_lines\ \{fn\}\ \{\n\ \ \ \ set\ f\ \[open\ \$fn\ r\]\n\ \ \ \ set\ t\ \[read\ \$f\ \[file\ size\ \$fn\]\]\n\ \ \ \ close\ \$f\n\ \ \ \ split\ \$t\ \\n\n\}\ \;#RS\n======\n\n**\ Files\ and\ sockets\ in\ use\ **\n\nFor\ Tcl\ 8.4\ the\ '''file\ channels'''\ builtin\ command\ does\ this.\n\nby\ \[Phil\ Ehrens\]\ <[email protected]>\n\nUNIX\ only\n\n======\nproc\ countFilehandles\ \{\{limit\ 1024\}\}\ \{\n\ \ \ \ set\ i\ 0\;\ set\ socks\ \{\}\;\ set\ files\ \{\}\n\ \ \ \ while\ \{\$i\ <\ \$limit\}\ \{\n\ \ \ \ \ \ \ \ if\ !\[catch\ \{tell\ sock\$i\}\]\ \{lappend\ socks\ sock\$i\}\n\ \ \ \ \ \ \ \ if\ !\[catch\ \{tell\ file\$i\}\]\ \{lappend\ files\ file\$i\}\n\ \ \ \ \ \ \ \ incr\ i\n\ \ \ \ \}\n\ \ \ \ return\ \[list\ \$socks\ \$files\]\n\}\n======\n\n**\ \[Fraction\ Math\]\ **\n\nSee\ \[Fraction\ Math\]\ --\ kbk\ \[http://titania.crd.ge.com/people/kennykb.html\]\n\n2.75\ <->\ 2-3/4.\ Not\ exact,\ resolution\ can\ be\ specified\ (default\ 1/8)\n\n======\nproc\ fracn2num\ \{args\}\ \{\n\ \ \ \ if\ !\[regexp\ \{((\[0-9\]+)\[\ -\])?(\[0-9\]+)/(\[0-9\]+)\}\ \$args\ ->\ -\ int\ num\ den\]\ \{\n\ \ \ \ \ \ \ \ return\ \$args\n\ \ \ \ \}\n\ \ \ \ expr\ \$int+double(\$num)/\$den\n\}\nproc\ num2fracn\ \{n\ \{r\ 8\}\}\ \{\n\ \ \ \ if\ \[set\ in\ \[expr\ int(\$n)\]\]==\$n\ \{return\ \$n\}\n\ \ \ \ if\ \$in\ \{set\ res\ \$in-\}\ else\ \{set\ res\ \{\}\}\n\ \ \ \ return\ \$res\[join\ \[simplify\ \[expr\ int(round((\$n-\$in)*\$r))\]\ \$r\]\ /\]\n\}\nproc\ simplify\ \{p\ q\}\ \{\n\ \ \ \ set\ g\ \[gcd\ \$p\ \$q\]\n\ \ \ \ list\ \[expr\ \$p/\$g\]\ \[expr\ \$q/\$g\]\n\}\ \;#RS\ (frac2num\ handling\ for\ things\ like\ '2\ 3/4'\ added\ by\ PSE)\n======\n\noffers\ some\ advances\ on\ the\ ''Fraction\ math'\ section.\n\n**\ \[freeMem%|%freeMem:\ Freeing\ memory\ the\ Tcl\ way!%|%\]**\n\nPermits\ evaluation\ of\ code\ in\ a\ manner\ which\ does\ NOT\ cause\ the\ interpreter\ to\npermanently\ allocate\ heaps\ of\ heap.\n\n**\ \[IEEE\ binary\ float\ to\ string\ conversion\]\ **\n\n**\ Integer\ Check\ **\n\nSee\ \[Additional\ math\ functions\]\n\n**\ Integer\ maximum\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ Integer\ width\ **\nin\ bits\ (by\ \[Jeffrey\ Hobbs\]):\n======\nproc\ int_bits\ \{\}\ \{\n\ \ \ \ set\ int\ 1\n\ \ \ \ set\ exp\ 8\;\ #\ Assuming\ a\ minimum\ of\ 8\ bits\n\ \ \ \ 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,\ ....\n\ \ \ \ return\ \$exp\n\}\n======\n\n**\ \[Interrupting\ loops\]:\ how\ to\ introduce\ a\ \"stop\ button\"\ for\ runaway\ code\ **\n\n**\ intgen:\ unique\ integer\ ID\ generator,\ at\ first\ call\ gives\ 1,\ then\ 2,\ 3,\ ...\ **\nNote\ how\ the\ proc\ rewrites\ its\ own\ seed\ default,\ so\ no\ global\ variable\ is\ needed:\n\n======\nproc\ intgen\ \{\{seed\ 0\}\}\ \{\n\ \ \ \ proc\ intgen\ \"\{seed\ \[incr\ seed\]\}\"\ \[info\ body\ intgen\]\n\ \ \ \ set\ seed\n\}\ \;#\ RS\n======\n\n**\ number\ speller\ ,French**\n\nfr:num\ 99\ =>\ quatrevingt\ dix-neuf\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ German\ number\ speller\ **\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ time\ speller\ ,German\ **\n\nconverts\ exact\ HH:MM\ times\ to\ fuzzy\ colloquial\ wording,\ optional\ Northern\ (viertel\ vor\ vier)\ or\ Southern\ style\ (dreiviertel\ vier)\ \;-)\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ money\ amount\ speller\ ,Russian\ **\n\nsee\ \[Bag\ of\ number/time\ spellers\]\n\n**\ \[getPid\]\ **\n\nmap\ pids\ to\ prog\ names\ and\ vice-versa\n\n**\ \[gifBalls\]\ **\n\n**\ Globbing\ globals\ **\n\nWant\ to\ import\ several\ globals\ in\ one\ go,\ with\ glob\ wildcards\n(similar\ to\ the\ public\ statement\ in\ VB)?\ This\ comes\ from\ David\ Cuthbert\ (mailto:[email protected]):\n\n======\nproc\ globalpat\ \{args\}\ \{\n\ \ \ \ foreach\ pattern\ \$args\ \{\n\ \ \ \ \ \ \ \ set\ varnames\ \[info\ globals\ \$pattern\]\n\ \ \ \ \ \ \ \ if\ \{\[llength\ \$varnames\]\ !=\ 0\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ uplevel\ 1\ global\ \$varnames\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \}\n\}\n======\nTo\ use:\n\n\n======\nproc\ hello\ \{\}\ \{\n\ \ \ \ globalpat\ *tcl*\n\ \ \ \ puts\ \$tcl_patchLevel\n\}\n\n%\ hello\n8.2.2\n======\n\n**\ \[GPS/UTC\ Time\ Conversion\ Functions\]\ **\n\nTcl\ implementation\ of\ Simpson's\ Rule\ numerical\ integration.\n\n**\ \[Greeklish\]\ **\nturns\ a\ strict\ ASCII\ transliteration\ into\ Greek\ Unicodes\n\n**\ \[Greatest\ common\ denominator\]\ **\n\nnow\ on\ its\ own\ page\n\n**\ \[Heblish\]\ **\n\nturns\ a\ strict\ ASCII\ transliteration\ into\ Hebrew\ Unicodes.\n\n**\ \[hotgrep\]\ **\n\nit\ beats\ as\ it\ sweeps\ as\ it\ cleans!\n\n**\ \[integrate\]\ **\n\n**\ IP\ address:\ find\ out\ your\ own.\ This\ beauty\ came\ from\ [email protected]\ **\ \n(note\ that\ ''xxx''\ should\ be\ the\ name\ of\ a\ procedure\ which\ never\ gets\ called,\ so\ need\ not\ exist\ \;-):\n\n\[\[ip:adr\ used\ to\ be\ here.\]\]\n\nMany\ Tcl\ programmers\ wonder\ \[how\ to\ find\ my\ own\ IP\ address\].\n\n**\ jpeg:\ \[Reading\ JPEG\ image\ dimensions\]\ **\n\n**\ Language\ name\ server,\ zh\ <->\ Chinese\ ...\ see\ \[Language/Country\ name\ servers\ \]\ **\n\n**\ Line\ Counting\ see\ \[Counting\ a\ million\ lines\]\ **\n\n**\ List\ Frequency\ Counts\ **\n\nsee\ \[Counting\ Elements\ in\ a\ List\]\n\n**\ List\ spread\ to\ scalar\ vars,\ e.g.\ lspread\ \{1\ 2\ 3\}\ to\ a\ b\ \{c\ 0\}\ **\n\n======\nproc\ lspread\ \{list\ \"to\"\ args\}\ \{\n\ \ \ \ foreach\ a\ \$args\ v\ \$list\ \{\n\ \ \ \ \ \ \ \ upvar\ \[lindex\ \$a\ 0\]\ var\ \;#\ name\ maybe\ in\ list\ with\ default\n\ \ \ \ \ \ \ \ if\ \{\$v==\"\"\}\ \{set\ var\ \[lindex\ \$a\ 1\]\}\ else\ \{set\ var\ \$v\}\n\ \ \ \ \}\n\}\ \;#RS\n======\n\n**\ List\ well-formedness:\ check\ a\ string\ whether\ it\ could\ be\ parsed\ into\ a\ list\ (braces\ balanced,\ whitespace\ after\ closing\ braces)\ **\n\njoint\ effort\ by\ \[Bob\ Techentin\]\ and\ \[Donald\ Porter\]\nin\ news:comp.lang.tcl\ :\n======\nproc\ islist\ \{s\}\ \{\n\ \ \ \ expr\ !\[catch\ \{eval\ list\ \$s\}\]\n\}\ \;#\ RS\n======\n\nHmmm...\ let's\ think\ twice\ about\ this\ one.\ \ We\ want\ to\ test\ the\nlist\ well-formedness\ of\ an\ unknown\ string,\ so\ we\ probably\ don't\ know\nmuch\ about\ \$s.\ \ It's\ dangerous\ to\ \[\[eval\]\]\ something\ you\ don't\ know.\nConsider\ this:\n======\nset\ s\ \{a\;\ file\ delete\ -force\ ~\}\nislist\ \$s\ \ \ \ \;#\ Hope\ you\ have\ backups!\n======\nTry\ this\ instead:\n\n======\nproc\ islist\ \{s\}\ \{expr\ !\[catch\ \{llength\ \$s\}\]\}\ \;#\ DGP\n======\n\nIndeed.\ \ The\ former\ returns\ bad\ values\ for\ most\ things\ containing\ '\$',\ or\ \[\[,\ \]\]\ etc.\ \ \nThe\ latter\ does\ what\ you\ want.\n\n**\ List\ with\ duplicates\ removed,\ and\ keeping\ the\ original\ order:\ **\n\n======\nproc\ luniq\ \{L\}\ \{\n\ \ \ \ #\ removes\ duplicates\ without\ sorting\ the\ input\ list\n\ \ \ \ set\ t\ \{\}\n\ \ \ \ foreach\ i\ \$L\ \{if\ \{\[lsearch\ -exact\ \$t\ \$i\]==-1\}\ \{lappend\ t\ \$i\}\}\n\ \ \ \ return\ \$t\n\}\ \;#\ RS\n======\n\n**\ \[ls\ -l\ in\ Tcl\]\ **\n\n**\ ls:\ make\ glob\ look\ more\ like\ the\ Unix\ thing\ **\n\n======\nproc\ ls\ \{\{fn\ *\}\}\ \{\n\ \ \ \ lsort\ \[glob\ -nocomplain\ \$fn\ .\$fn\]\n\}\ \;#RS\n======\n\nAlso\ see\ \[ls\ -l\ in\ Tcl\]....\n\n**\ Mail\ sender\ (minimalist,\ Unix\ only):\ **\n\n======\nproc\ mailto\ \{name\ subj\ text\}\ \{\n\ \ \ \ set\ f\ \[open\ \"|mail\ \$name\"\ w\]\n\ \ \ \ puts\ \ \$f\ \"Subject:\ \$subj\\n\\n\$text\"\n\ \ \ \ close\ \$f\n\}\n======\n\nCf.\ http://www.phaseit.net/claird/comp.lang.tcl/tcl-examples.html#mail\n\nusing\ tcllib:\ \ \[PT\]\n\n======\n\ package\ require\ mime\n\ package\ require\ smtp\n\n\ set\ tok\ \[mime::initialize\ -canonical\ text/plain\ -string\ \"Hello,\ World!\"\]\n\ smtp::sendmessage\ \$tok\ \\\n\ \ \ \ -header\ \{From\ \"[email protected]\"\}\ \\\n\ \ \ \ -header\ \{To\ \"You\ <[email protected]>\"\}\ \\\n\ \ \ \ -header\ \{Subject\ \"Simple\ Tcllib\ mailing.\"\}\n\ mime::finalize\ \$tok\n======\n\n**\ Mail\ checker,\ even\ more\ minimalist,\ Unix\ only:\ **\n\n======\nproc\ haveMail\ \{\}\ \{\n\ \ \ \ expr\ \[file\ size\ /var/mail/\$::env(USER)\]>0\n\}\n======\n\n\[yet\ another\ Tcl\ mail\ handler!\ (for\ UNIX)\]\n\n**\ map\ -\ the\ traditional\ list\ functional\ that\ applies\ an\ operation\ to\ every\ member\ of\ a\ list.\ **\n\n======\nproc\ map\ \{command\ list\}\ \{\n\ \ \ \ set\ res\ \[list\]\n\ \ \ \ foreach\ item\ \$list\ \{\n\ \ \ \ \ \ \ \ lappend\ res\ \[uplevel\ 1\ \[concat\ \$command\ \[list\ \$item\]\]\]\n\ \ \ \ \}\n\ \ \ \ set\ res\n\}\n======\n''See\ also\ \[Steps\ towards\ functional\ programming\]\ for\ related\ discussions.''\n\n**\ Maximum\ and\ minimum\ Everybody\ writes\ them\ himself,\ here's\ mine:\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ Morse\ en/decoder:\ works\ both\ ways\ ASCII\ <->\ Morse,\ see\ \[Bag\ of\ number/time\ spellers\]\ ''-\ \ **\n\nyah,\ well,\ it\ has\ to\ go\ somewhere...\ JC''\n\n**\ N-gram\ frequency\ counts,\ see\ \[tally:\ a\ string\ counter\ gadget\]\ **\n\n**\ Namespace\ variables\ listed\ local\ names\ of\ variables\ as\ defined\ in\ a\ namespace:\ **\n\n======\nproc\ nsvars\ \{ns\}\ \{\n\ \ \ \ regsub\ -all\ ::\$\{ns\}::\ \[info\ vars\ \$\{ns\}::*\]\ \"\"\ res\n\ \ \ \ set\ res\n\}\ \ \;#\ RS\n======\n\nalternatively\ (requires\ ''map''\ operator\ from\ elsewhere\ on\ this\ page)\ -\ ''DKF''\n\n======\nproc\ nsvars\ \{\{ns\ \{\}\}\}\ \{\n\ \ \ \ map\ \[list\ namespace\ tail\]\ \[info\ vars\ \$\{ns\}::*\]\n\}\n======\n\n**\ NUKE:\ delete\ a\ file\ when\ its\ descriptor\ is\ closed:\ **\n\n======\nproc\ NUKE\ \{\ filename\ fid\ \}\ \{\n\ \ \ \ \ if\ \{\ !\ \[\ llength\ \[\ file\ channels\ \$fid\ \]\ \]\ \}\ \{\n\ \ \ \ \ \ \ \ \ file\ delete\ \$filename\n\ \ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ \ after\ 1000\ \"NUKE\ \$filename\ \$fid\"\n\ \ \ \ \ \}\n\}\n======\n\n''DKF''\ -\ Alternatively,\ rewrite\ the\ ''close''\ and\ ''exit''\ commands...\n======\nrename\ close\ orig_close_NUKE\nrename\ exit\ orig_exit_NUKE\nproc\ close\ \{fid\}\ \{\n\ \ \ \ global\ NUKE\ errorInfo\ errorCode\n\ \ \ \ set\ code\ \[catch\ \{orig_close_NUKE\ \$fid\}\ msg\]\n\ \ \ \ set\ ei\ \$errorInfo\n\ \ \ \ set\ ec\ \$errorCode\n\ \ \ \ if\ \{\[info\ exist\ NUKE(\$fid)\]\}\ \{\n\ \ \ \ \ \ \ \ file\ delete\ \$NUKE(\$fid)\n\ \ \ \ \ \ \ \ unset\ NUKE(\$fid)\n\ \ \ \ \}\n\ \ \ \ return\ -code\ \$code\ -errorinfo\ \$ei\ -errorcode\ \$ec\ \$msg\n\}\n\nproc\ exit\ \{\{code\ 0\}\}\ \{\n\ \ \ \ global\ NUKE\n\ \ \ \ foreach\ fid\ \[array\ names\ NUKE\]\ \{catch\ \{close\ \$fid\}\}\n\ \ \ \ orig_exit_NUKE\ \$code\n\}\n\nproc\ NUKE\ \{filename\ fid\}\ \{\n\ \ \ \ global\ NUKE\n\ \ \ \ set\ NUKE(\$fid)\ \$filename\n\}\n\nproc\ tmpfile\ \{\{tmpdir\ /tmp\}\}\ \{\n\ \ \ \ global\ SEQID\;\ if\ \{!\[info\ exist\ SEQID\]\}\ \{set\ SEQID\ 0\}\n\ \ \ \ set\ basename\ \[file\ rootname\ \[file\ tail\ \$::argv0\]\]\n\ \ \ \ set\ filename\ \[file\ join\ \$tmpdir\ \$\{basename\}.\[pid\].\[incr\ SEQID\].tmp\]\n\ \ \ \ set\ fid\ \[open\ \$filename\ w+\]\n\ \ \ \ NUKE\ \$filename\ \$fid\n\ \ \ \ return\ \$fid\n\}\n======\n\n**\ Number\ commified\ (added\ culture-dependent\ thousands\ mark):\ **\n\n======\nproc\ number_commify\ \{n\ \{sign\ ,\}\}\ \{\n\ \ \ \ #\ structure\ a\ decimal\ like\ 123,456.78\ 123'456.78,\ or\ 123.456,78\n\ \ \ \ if\ \{\$sign==\".\"\}\ \{regsub\ \{\[.\]\}\ \$n\ \",\"\ n\}\n\ \ \ \ set\ trg\ \"\\\\1\$sign\\\\2\"\n\ \ \ \ while\ \{\[regsub\ \{^\ *(\[-+\]?\[0-9\]+)(\[0-9\]\[0-9\]\[0-9\])\}\ \$n\ \$trg\ n\]\}\ \{\}\n\ \ \ \ return\ \$n\n\}\ \;#\ added\ \"\ *\"\ to\ regexp,\ so\ leading\ blanks\ as\ from\ format\ work\ -\ RS\n======\nA\ one-liner\ alternative\ by\ \ \[Peter\ Spjuth\]\ (in\ the\ \[Tcl\ chatroom\],\ 2004-10-05)\nuses\ modern\ \[regexp\]\ features:\n\n======\nproc\ commify\ number\ \{\n\ \ \ \ regsub\ -all\ \{\\d(?=(\\d\{3\})+(\$|\\.))\}\ \$number\ \{\\0,\}\n\}\n======\n\n\n\nSee\ also\ \[Human\ readable\ file\ size\ formatting\]\n\n======\n\n**\ Option\ Parser:\ \[expandOpts\]\ **\n\n**\ proc\ Instrumentation\ **\n\nYou\ can\ add\ code\ to\ every\ procedure\ in\ your\ Tcl\ application\ by\ redefining\ the\ ''proc''\ command\ \nto\ include\ special\ code.\ \ Then\ each\ proc\ definition\ will\ include\ your\ code.\ \ \nThis\ is\ commonly\ done\ for\ debuggers\ and\ profilers.\ \ \nFor\ example,\ if\ you\ wanted\ to\ count\ each\ time\ your\ procedures\ are\ called,\ \nyou\ could\ include\ code\ like\ this\ example,\ courtesy\ of\ Bryan\ Oakly\ on\ comp.lang.tcl.\n\n======\nrename\ proc\ _proc\n_proc\ proc\ \{name\ arglist\ body\}\ \{\n\ \ \ \ set\ body\ \"incr\ ::proc_counter(\$name)\\n\$body\"\n\ \ \ \ set\ ::proc_counter(\$name)\ 0\n\ \ \ \ uplevel\ \[list\ _proc\ \$name\ \$arglist\ \$body\]\n\}\n======\n\nSee\ also\ \[Printing\ proc\ sequence\].\n\n**\ proc\ validity\ in\ context:\ \[validProc\]\ \ **\n\nreturns\ ''1''\ if\ the\ procedure\ name\ or\ wildcard\ pattern\ exists\ in\ the\ current\ncontext\ (including\ all\ child\ namespaces),\ returns\ ''0''\ if\ it\ does\ not.\ \ Sort\nof\ a\ \[\[\[info\ commands\]\]\]\n\nfor\ heavy\ namespace\ users.\n\n**\ Proc\ name:\ know\ your\ own\ **\n\nthis\ one-liner\ wraps\ introspection.\ Useful\ for\ generated\ widget\ handlers,\ whose\nname\ is\ like\ the\ widget\ pathname,\ so\ they\ know\ what\ their\ widget\ is\ called:\n\n======\nproc\ proc_name\ \{\}\ \{\n\ \ \ \ lindex\ \[info\ level\ -1\]\ 0\n\}\ \;#RS\n======\n\n**\ Railway\ vehicle\ number\ validation:\ \[UIC\ vehicle\ number\ validator\]\ **\n\n**\ Random\ Numbers\ **\n\nsee\ \[Additional\ math\ functions\]\n\n**\ Random\ selection\ from\ a\ list\ **\n\n======\nproc\ random_select\ list\ \{\n\ \ \ \ lindex\ \$list\ \[expr\ int(rand()*\[llength\ \$list\])\]\n\}\ \;#RS\n======\n\n**\ Roman\ Numbers\ **\n\n\[Bag\ of\ number/time\ spellers\]\n\n**\ SCCS\ control\ string\ bypass\ **\n\nWhen\ you\ ckeck\ in\ a\ file\ with\ SCCS,\ certain\ strings\ in\ the\ file\ are\ replaced,\ne.g.\ %H%\ with\ the\ current\ date,\ %M%\ with\ the\ current\ filename.\ \ This\ can\ cause\nproblems\ if\ your\ code\ contains\ e.g.\ \ set\ now\ \[clock\ format\ \[clock\ seconds\]\n-format\ %y%m%d-%H%M%S\]\ but\ you\ can\ hide\ percent\ signs\ by\ replacing\ them\ with\nthe\ equivalent\ \\x25,\ so\ SCCS\ doesn't\ see\ them\ but\ the\ Tcl\ parser\ does\ (RS)\n\n======\nset\ now\ \[clock\ format\ \[clock\ seconds\]\ -format\ %y%m%d-\\x25H\\x25M\\x25S\]\n======\n\nHere's\ my\ method\ -\ use\ append\ to\ build\ up\ the\ string:\n======\nappend\ datestring\ %y\ %m\ %d\ -\ %H\ %M\ %S\nset\ now\ \[clock\ format\ \[clock\ seconds\]\ -format\ %datestring\]\n======\n\nMarty\ Backe\n\n**\ Self-test\ code\ **\n\nevaluated\ only\ when\ executed,\ not\ when\ sourced\n\nIn\ a\ Tcl\ script\ that\ is\ sourced\ by\ other\ files,\ it's\ nice\ to\ have\ some\ code\ for\nstandalone\ testing\ (feeding\ only\ this\ file\ to\ a\ tclsh/wish,\ double-clicking\ on\nWindows,\ where\ you\ even\ get\ a\ free\ console\ for\ seeing\ stdout\ \;-).\ Just\ brace\nthe\ self-test\ code\ with\n\n======\nifstandalone\ \{#test\ what\ you\ want...\}\n======\n\n======\nproc\ ifstandalone\ body\ \{\n\ \ \ \ global\ argv0\n\ \ \ \ if\ \{\ \[info\ exists\ argv0\]\ &&\ \\\n\ \ \ \ \ \ \ \ !\[string\ compare\ \[file\ tail\ \[info\ script\]\]\ \[file\ tail\ \$argv0\]\]\ \}\ \{\n\n\ \ \ \ \ \ \ \ catch\ \{console\ show\}\n\ \ \ \ \ \ \ \ uplevel\ \$body\n\ \ \ \ \}\n\}\n======\n\n**\ Set\ operations:\ \[A\ set\ of\ Set\ operations\]\ **\n\n**\ \[Shuffle\ a\ list\]\ --\ various\ ways\ of\ permuting\ a\ list\ into\ (pseudo-)random\ sequence.\ **\n\n**\ Silly\ Asynchronous\ Event\ Example\ **\n\n======\n#\ initialise\ our\ trigger\ variable\nset\ foo\ \{\}\n\n#\ a\ proc\ to\ call\ when\ the\ trigger\ variable\ is\ written\nproc\ bye\ \{args\}\ \{\ exit\ \}\n\n#\ some\ code\ to\ push\ into\ the\ event\ loop\ for\ 0.5\ sec\n#\ that\ produces\ visible\ output,\ and\ writes\ the\ trigger\ var\nafter\ 500\ \{\n\ \ \ puts\ \"what\ a\ question!\"\n\ \ \ set\ foo\ \{\}\n\}\n\n#\ some\ other\ code\ that\ gets\ pushed\ into\ the\ loop\ for\ 0.2\ sec\nafter\ 200\ \{\n\ \ \ \ puts\ \"where\ did\ I\ come\ from?\"\n\}\n\n#\ some\ code\ that\ is\ executed\ immediately\nputs\ \"and\ then\ he\ asked:\"\n\n#\ set\ a\ trace\ on\ \"foo\",\ so\ that\ when\ it\ is\ written\ the\n#\ procedure\ \"bye\"\ is\ called\ntrace\ variable\ foo\ w\ bye\n\n#\ initiate\ an\ event\ loop\ (this\ is\ what\ \"wish\"\ does)\nvwait\ enter-mainloop\n======\n\n''(DKF:\ And\ this\ is\ supposed\ to\ be\ a\ ''good''\ feature\ of\ Tcl?\ \ Hmmm...)''\n\n**\ Simple\ \[Arbitrary\ Precision\ Math\ Procedures\]\ --\ \[DKF\]\ **\n\n**\ \[Size\ of\ running\ Tcl\ process\]\ (Unix\ only)\ **\n\n**\ \[sleep\]\ **\n\nunix-like\n\n**\ Sort\ on\ String\ Length\ /\ Password\ Generator\ **\n\n======\nproc\ \{lengthCompare\}\ \{w1\ w2\}\ \{\n\ \ \ \ set\ sl1\ \[string\ length\ \$w1\]\n\ \ \ \ set\ sl2\ \[string\ length\ \$w2\]\n\ \ \ \ if\ \{\$sl1\ >\ \$sl2\}\ \{\n\ \ \ \ \ \ \ \ return\ 1\n\ \ \ \ \}\ elseif\ \{\$sl1\ ==\ \$sl2\}\ \{\n\ \ \ \ \ \ \ \ return\ 0\n\ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ return\ -1\n\ \ \ \ \}\n\}\n\nset\ data\ \{asdf\ asdfasdf\ asdfa\ asd\ asdfasd\}\n#\ The\ following\ will\ sort\ the\ command\ by\ String\ Length\nset\ data\ \[lsort\ -command\ lengthCompare\ \$data\]\n\n#\ More\ info\ -\n#\ The\ following\ makes\ a\ password\ out\ of\ the\ data\ by\ using\n#\ the\ word\ alone\ if\ it\ is\ 5\ chars\ or\ more,\ (eg\ asdfasd)\n#\ and\ by\ finding\ a\ match\ for\ it\ if\ it\ is\ less\ (eg\ asd-asdf)\n#\ than\ 5\ chars.\ \ The\ password\ can\ be\ max\ of\ 8\ chars\ in\n#\ this\ example.\n\n#\ This\ was\ used\ on\ a\ stripped-down\ version\ of\ the\ words\n#\ file\ for\ the\ UNIX\ spell\ checker\ to\ generate\ random\n#\ passwords.\n\nset\ datalength\ \[llength\ \$data\]\n\nset\ word1\ \[lindex\ \$data\ \[expr\ \{int(\[expr\ \{rand()*\$datalength\}\])\}\]\]\nset\ w1l\ \[string\ length\ \$word1\]\n\nif\ \{\$w1l\ <\ 5\}\ \{\n\ \ \ \ set\ pos\ \[expr\ \{int(\[expr\ \{rand()*\$datalength\}\])\}\]\n\ \ \ \ #\ This\ speedily\ decrements\ the\ random\ number\ generated\n\ \ \ \ #\ until\ the\ size\ is\ small\ enough\ to\ fit\ in\ an\ 8\ char\n\ \ \ \ #\ field.\n\ \ \ \ while\ \{\[expr\ \{8-\$w1l-\[string\ length\ \[lindex\ \$data\ \$pos\]\]\}\]\ <\ 1\}\ \{\n\ \ \ \ \ \ \ \ set\ pos\ \[expr\ \{int(\[expr\ \{rand()*\$pos\}\])\}\]\n\ \ \ \ \}\n\ \ \ \ set\ word2\ \[lindex\ \$data\ \$pos\]\n\ \ \ \ append\ word1\ \"-\$word2\"\n\ \ \ \ set\ word1\ \"\$word1\"\n\}\n\n#\ Output\ the\ password\nputs\ \"\$\{word1\}\\n\"\n======\n\n**\ String\ to\ list\ **\n\ncollapsing\ splitchar\ sequences\n\n**\ \[soundex\]\ **\n\n**\ \[Splitting\ strings\ into\ words\]\ **\n\n**\ Stack\ operations\ on\ lists:\ lpush\ prepends,\ lpop\ removes\ first\ element.\ \ **\n\nlpop\ and\ lappend\ make\ a\ FIFO\ queue.\n======\nproc\ lpush\ \{_list\ what\}\ \{\n\ \ \ upvar\ \$_list\ L\n\ \ \ if\ !\[info\ exists\ L\]\ \{set\ L\ \{\}\}\n\ \ \ set\ L\ \[concat\ \[list\ \$what\]\ \$L\]\n\}\nproc\ lpop\ \{_list\}\ \{\n\ \ \ upvar\ \$_list\ L\n\ \ \ if\ !\[info\ exists\ L\]\ \{return\ \"\"\}\n\ \ \ set\ t\ \[lindex\ \$L\ 0\]\n\ \ \ set\ L\ \[lrange\ \$L\ 1\ end\]\n\ \ \ return\ \$t\n\}\ \;#RS\n\n======\nalso\ see:\ \[yet\ another\ stack\ package\]\ and\ the\ \[Chart\ of\ proposed\ list\ functionality\]\n\n**\ Stack\ trace:\ just\ sprinkle\ a\ few\ of\ these\ \"probes\"\ around\ to\ see\ the\ stack\ at\ that\ point\ **\n\nshamelessly\ swiped\ from\ \[Cameron\ Laird\]\n\n======\nproc\ probe\ \{\}\ \{\n\ \ \ \ puts\ \"Stack\ trace:\"\n\ \ \ \ for\ \{set\ i\ \[expr\ \[info\ level\]\ -\ 1\]\}\ \{\$i\}\ \{incr\ i\ -1\}\ \{\n\ \ \ \ \ \ \ \ puts\ \"\ \ Processing\ '\[info\ level\ \$i\]'.\"\n\ \ \ \ \}\n\}\ \;#\ JCW\n======\n\nFor\ more\ on\ this\ subject,\ see\ \"\[Printing\ proc\ sequence\]\".\n\n**\ \[Stats\]\ **\n\nsimple\ statistical\ functions\ (mean,\ stddev,\ cov)\n\n**\ String\ to\ list\ **\n\n\[\[split\ \$s\]\]\ alone\ operates\ on\ each\ instance\ of\ the\ splitchar\n(default:space),\ so\ sequences\ of\ spaces\ will\ produce\ empty\ list\ elements.\ \n\n\[\[eval\ list\ \$s\]\]\ \ collapses\ whitespace\ sequences\ in\ one,\ but\ errors\ on\ unbalanced\ braces\ etc.\ \nThe\ following\ proc\ should\ join\ the\ best\ of\ both\ worlds:\n\n======\nproc\ string2list\ s\ \{\n\ \ \ \ if\ \[catch\ \{eval\ list\ \$s\}\ res\]\ \{\n\ \ \ \ \ \ \ \ set\ res\ \[list\]\n\ \ \ \ \ \ \ \ foreach\ i\ \[split\ \$s\]\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ if\ \{\$i!=\"\"\}\ \{lappend\ res\ \$i\}\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \}\n\ \ \ \ set\ res\n\}\ \;#RS\n%\ string2list\ \{a\ \ \ b\ c\ \ \ \ \ d\}\na\ b\ c\ d\n%\ string2list\ \"a\ \ \ b\ c\ \ \{\"\na\ b\ c\ \\\{\n%\ string2list\ \{unbalanced\ \"\}\nunbalanced\ \{\"\}\n======\n\nNote\ that\ this\ suffers\ from\ the\ same\ dangers\ as\ explained\ in\ the\n'''List\ well-formedness'''\ test\ above.\ \ Modifications\ for\ safety\nare\ left\ as\ an\ exercise\ for\ the\ reader\ (or\ the\ next\ Wiki\ visitor).\nYou\ have\ been\ warned.\ -\ '''DGP'''\n\n'''EE''':\ This\ seems\ as\ good\ a\ place\ as\ any\ to\ ask\ this\nquestion...\ Is\ there\ any\ effective\ difference,\ in\ general,\nbetween\ '''catch\ \{eval\ command\ \$args\}'''\nand\ '''catch\ \[\[linsert\ \$args\ 0\ command\]\]'''\ ?\n\nYes:\ The\ latter\ is\ more\ efficient.\ See\ \[pure\ list\]\ and\ \[many\ ways\ to\ eval\]\ for\ discussion.\n\n'''\[DGP\]''':\ Yes,\ see\ those\ pages,\ but\ efficiency\ differences\ are\nnot\ the\ main\ point.\ \ Those\ two\ examples\ will\ process\ newlines\ \nin\ the\ arguments\ differently.\ \ Newlines\ are\ significant\ to\ \[eval\]\nbut\ not\ necessarily\ preserved\ by\ list-processing\ commands.\n\n**\ Swap\ 2\ values\ efficiently\ **\n\nSwaps\ value\ of\ a\ with\ b\ without\ overhead\ of\ copying\ to\ a\ temporary\ variable:\n\n======\nforeach\ \{a\ b\}\ \[list\ \$b\ \$a\]\ break\n======\n\nWorks\ for\ a\ and\ b\ as\ numbers,\ strings\ and\ lists\ but\ not\ arrays.\n\n\[AMG\]:\ Here's\ a\ faster\ method\ that\ works\ using\ Tcl\ 8.5+.\n\n======\nlassign\ \[list\ \$b\ \$a\]\ a\ b\n======\n\nOn\ my\ machine,\ \[\[\[lassign\]\]\]\ takes\ 3.2239\ microseconds\ per\ iteration,\ whereas\ \[\[\[foreach\]\]\]\ takes\ 8.562\ microseconds\ per\ iteration.\n\n**\ \[subcommands\]:\ value-added\ switch,\ FREE\ error\ message\ \;-)\ **\n\n**\ Tabs\ to\ spaces,\ and\ back:\ courtesy\ \[Jeffrey\ Hobbs\]\ **\n\n======\n#\ untabify\ --\n#\ \ \ removes\ tabs\ from\ a\ string,\ replacing\ with\ appropriate\ number\ of\n#\ \ \ spaces.\ Arguments:\n#\ \ \ str\ \ \ \ \ \ \ \ \ input\ string\n#\ \ \ tablen\ \ \ \ \ \ tab\ length,\ defaults\ to\ 8\n#\ Returns:\n#\ \ \ string\ sans\ tabs\n#\nproc\ untabify\ \{str\ \{tablen\ 8\}\}\ \{\n\ \ \ \ set\ out\ \{\}\n\ \ \ \ while\ \{\[set\ i\ \[string\ first\ \"\\t\"\ \$str\]\]\ !=\ -1\}\ \{\n\ \ \ \ \ \ \ \ set\ j\ \[expr\ \{\$tablen-(\$i%\$tablen)\}\]\n\ \ \ \ \ \ \ \ append\ out\ \[string\ range\ \$str\ 0\ \[incr\ i\ -1\]\]\[format\ %*s\ \$j\ \{\ \}\]\n\ \ \ \ \ \ \ \ set\ str\ \[string\ range\ \$str\ \[incr\ i\ 2\]\ end\]\n\ \ \ \ \}\n\ \ \ \ return\ \$out\$str\n\}\n#\ tabify\ --\n#\ \ \ converts\ excess\ spaces\ to\ tab\ chars.\ Arguments:\n#\ \ \ str\ \ \ \ \ \ \ \ \ input\ string\n#\ \ \ tablen\ \ \ \ \ \ tab\ length,\ defaults\ to\ 8\n#\ Returns:\n#\ \ \ string\ with\ tabs\ replacing\ excess\ space\ where\ appropriate\n#\nproc\ tabify\ \{str\ \{tablen\ 8\}\}\ \{\n\ \ \ \ ##\ We\ must\ first\ untabify\ so\ that\ \\t\ is\ not\ interpreted\ to\ be\ 1\ char\n\ \ \ \ set\ str\ \[untabify\ \$str\]\n\ \ \ \ set\ out\ \{\}\n\ \ \ \ while\ \{\[set\ i\ \[string\ first\ \{\ \}\ \$str\]\]\ !=\ -1\}\ \{\n\ \ \ \ \ \ \ \ ##\ Align\ i\ to\ the\ upper\ tablen\ boundary\n\ \ \ \ \ \ \ \ set\ i\ \[expr\ \{\$i+\$tablen-(\$i%\$tablen)-1\}\]\n\ \ \ \ \ \ \ \ set\ s\ \[string\ range\ \$str\ 0\ \$i\]\n\ \ \ \ \ \ \ \ if\ \{\[string\ match\ \{*\ \}\ \$s\]\}\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ out\ \[string\ trimright\ \$s\ \{\ \}\]\\t\n\ \ \ \ \ \ \ \ \}\ else\ \{\n\ \ \ \ \ \ \ \ \ \ \ \ append\ out\ \$s\n\ \ \ \ \ \ \ \ \}\n\ \ \ \ \ \ \ \ set\ str\ \[string\ range\ \$str\ \[incr\ i\]\ end\]\n\ \ \ \ \}\n\ \ \ \ return\ \$out\$str\n\}\n======\n\n**\ \[tailf\]\ tail\ -f\ piped\ to\ egrep,\ in\ pure\ tcl\ **\n\n**\ \[try\ ...\ finally\ ...\]\ **\n\n**\ \[telnet\]\ **\n\nSort\ of\n\nclient\ and\ server...\ but\ not\ exactly\ as\ in\ RFC854.\n\n**\ \[timers\].tcl\ -\ benchmarking/timing\ package\ **\n\n**\ \[UIC\ vehicle\ number\ validator\]\ -\ as\ used\ on\ European\ railways\ **\n\n**\ Unicode\ char\ to\ \\u\ sequence:\ simple,\ but\ handy\ when\ examining\ Unicode\ output:\ **\n\n======\nproc\ u2x\ \{u\}\ \{\n\ \ \ \ scan\ \$u\ %c\ t\;\ format\ \"\\\\u%04.4X\"\ \$t\n\}\ \;#RS\n======\n\n**\ \[Unit\ converter\]\ --\ Does\ km/h\ <->\ mph,\ DM\ <->\ EUR,\ C\ <->\ F\ ...\ **\n\n**\ \[URI\ detector\ for\ arbitrary\ text\ as\ a\ regular\ expression\]\ **\n\n**\ UTC\ --\ see\ \[GPS/UTC\ Time\ Conversion\ Functions\]\ **\n\n**\ \[Validating\ credit\ card\ check\ digits\]\ **\n\n**\ \[Visual\ Studio\ 2003\ .sln\ file\ parser\]\ **\n\n**\ Word\ frequency\ counts,\ see\ \[tally:\ a\ string\ counter\ gadget\]\ **\n\n**\ Plain\ string\ substitution\ **\n\nPrior\ to\ version\ 8.1.1,\ the\ only\ string\ substitution\ facility\ in\ the\ Tcl\ core\nuses\ regular\ expressions,\ which\ for\ substituting\ special\ text\ can\ be\ a\ pain.\nHere's\ a\ procedure\ to\ do\ a\ plain\ substition\ (with\ no\ extra\ features).\ See\n\"string\ map\"\ in\ newer\ versions.\n\n======\nproc\ plainsub\ \{text\ item\ replacewith\}\ \{\n\ \ \ \ set\ len\ \[expr\ \[string\ length\ \$item\]-1\]\n\ \ \ \ while\ \{\[set\ pos\ \[string\ first\ \$item\ \$text\]\]\ !=\ -1\}\ \{\n\ \ \ \ \ \ \ \ set\ text\ \[string\ replace\ \$text\ \$pos\ \[expr\ \$pos+\$len\]\ \$replacewith\]\n\ \ \ \ \}\n\ \ \ \ return\ \$text\n\}\ \;#FW\n======\n\n\[RS\]\ What's\ bad\ with\ the\ following?\n\n======\nset\ text\ \[string\ map\ \[list\ \$item\ \$replacewith\]\ \$text\]\n======\n\n\[FW\]\ Nothing,\ I'm\ pretty\ much\ just\ starting\ out\ coding,\ for\ a\ second\ there\ I\nthought\ I'd\ made\ something\ useful\ \;)\ \ \[CL\]\ interrupts:\ \ Nah,\ the\ correct\ answer\nis\ that\ Richard's\ set\ text\ ...\"\ is\ bad\ because\ \"\[string\ map\]\ ...\"\ only\ appeared\nwith\ 8.1.1.\n\nAs\ bad\ things\ go,\ that's\ only\ a\ tiny\ badness.\n\n**\ Split\ on\ Punctuation\ **\n\n\[FW\]:\ breaks\ a\ line\ of\ text\ into\ an\ alternating\ list\ of\ words\ and\ punctuation.\n\nFor\ example:\n\ (bin)\ 8\ %\ break_text\ \"A\ sentence,\ merely.\ \ Move\ along.\"\n\ A\ \{\ \}\ sentence\ \{,\ \}\ merely\ \{.\ \ \}\ Move\ \{\ \}\ along\ .\n\nThis\ would\ be\ used\ for\ most\ any\ language\ processing\ task,\ where\ you\ would\ break\na\ sentence\ into\ words,\ perform\ operations\ on\ the\ words,\ then\ put\ it\ back\ntogether.\ \ Here\ it\ is:\n\n======\nproc\ break_text\ \{text\ \{splitchars\ \{,\ .\"\;!:\}\}\}\ \{\n\ \ \ \ #\ Escape\ all\ the\ split\ characters\ so\ brackets,\ ^\ etc.\ will\ be\ accepted.\n\ \ \ \ set\ regexp\ \"\\\[\\\\\[join\ \[split\ \$splitchars\ \"\"\]\ \\\\\]\\\]+|\$\"\n\ \ set\ wp\ \[list\]\n\ \ set\ pos\ 0\n\ \ for\ \{set\ pos\ 0\}\ \{\$pos\ <\ \[string\ length\ \$text\]\ &&\ \[regexp\ -indices\ -start\ \$pos\ \$regexp\ \$text\ matches\]\}\n\ \ \ \ \ \ \{set\ pos\ \[expr\ \{\[lindex\ \$matches\ 1\]\ +\ 1\}\]\}\ \{\n\n\ \ \ \ lappend\ wp\ \\\n\ \ \ \ \ \ \[string\ range\ \$text\ \$pos\ \[expr\ \{\[lindex\ \$matches\ 0\]\ -\ 1\}\]\]\ \\\n\ \ \ \ \ \ \[eval\ string\ range\ \[list\ \$text\]\ \$matches\]\n\ \ \}\n\ \ return\ \$wp\n\}\n======\n''update:\ Now\ you\ can\ break\ by\ a\ character\ set\ of\ your\ choice\ by\ the\ optional\ second\ argument.\ \ \nAnd\ returns\ a\ flat\ list\ rather\ than\ a\ list\ of\ lists,\ for\ better\ use\ by\ foreach,\ etc.''\n\n**\ \[Sample\ Math\ Programs\]\ **\n\n<<categories>>\ Algorithm\ |\ Example\ |\ Arts\ and\ crafts\ of\ Tcl-Tk\ programming} CALL {my revision {Bag of algorithms}} CALL {::oo::Obj589316 process revision/Bag+of+algorithms} CALL {::oo::Obj589314 process}

-errorcode

NONE

-errorinfo

Unknow state transition: LINE -> END
    while executing
"error $msg"
    (class "::Wiki" method "render_wikit" line 6)
    invoked from within
"my render_$default_markup $N $C $mkup_rendering_engine"
    (class "::Wiki" method "render" line 8)
    invoked from within
"my render $name $C"
    (class "::Wiki" method "revision" line 31)
    invoked from within
"my revision $page"
    (class "::Wiki" method "process" line 56)
    invoked from within
"$server process [string trim $uri /]"

-errorline

4