This is a page for code that would be too long to paste in the [Tcl Chatroom] or #Tcl.

Copy and Paste: A coder's best friend. This technique can save a coder hours maybe even days worth of time, but at what cost? The coder will miss the opportunity to go through all the frustrations, discoveries, thrills, struggles, and break throughs that the original coder went through

Another resource you might consider using for this is http://www.nomorepasting.com

----
 /* Copyright 2003 George Peter Staplin
  * Revision 2 
  */

 #include <stdio.h>
 #include <stdlib.h>

 #define check_malloc(s) ({void *r = malloc(s); \
  if (NULL == r) { perror ("unable to malloc"); exit (EXIT_FAILURE); } \
  r; })

 typedef struct pig_s {
  struct pig_s *ar[256];
  int val;
 } Pig;

 Pig *create_pig () {
  Pig *p = check_malloc (sizeof (Pig));
  memset (p, 0, sizeof (Pig));
  return p;
 }

 int pig_get (Pig *p, char *key) {
  while ('\0' != *key) {
   if (NULL == p->ar[*key]) {
    return 0;
   }
   p = p->ar[*key];
   ++key;
  }
  return p->val;
 }

 void pig_insert (Pig *p, char *key, int val) {
  while ('\0' != *key) {
   if (NULL == p->ar[*key]) {
    p->ar[*key] = create_pig();
   }
   p = p->ar[*key];
   ++key;
  }
  p->val = val;
 }

 int main () {
  Pig *p; 
 
  p = create_pig (); 

  pig_insert (p, "abc", 123);
  pig_insert (p, "def", 456);
  pig_insert (p, "abc xyz", 444);

  printf ("1 %d 2 %d 3 %d\n", 
   pig_get (p, "abc"), 
   pig_get (p, "def"), 
   pig_get (p, "abc xyz"));

  return EXIT_SUCCESS; 
 }
----

[AM] A quick hack for automatically creating a parser from the grammar -- 22 dec


 # Experiment with parser generation
 #
 # Simple example:
 # names := name names
 # name := first_name last_name 
 # first_name := STRING
 # last_name  := STRING
 #
 # The input to "parse" is a list of "lexemes"
 #
 proc define { name dependents } {
    global definitions 

    set definitions($name) $dependents
 }

 proc rule { name } {
    global definitions 
    global lexeme
    global end   

    if { $end } return
 
    foreach dep $definitions($name) {
       if { $dep != "STRING" } { 
          rule $dep 
       } else {
          puts "$name: $dep = $lexeme"
          nextLexeme
       }
    }
 }

 proc nextLexeme {} {
    global count
    global input
    global lexeme
    global end

    incr count
    if { $count < [llength $input] } { 
       set lexeme [lindex $input $count]
    } else {
       set end 1
    }
 }
   
 # main --
 #   Just let it happen ...
 #
 global end 
 global count
 global input
 global lexeme

 set end    0
 set count -1
 set input {Arjen Markus My colleague Co Tclers}

 define names {name names}
 define name {first_name last_name} 
 define first_name STRING
 define last_name STRING
 nextLexeme
 rule names
 
----

[GPS]: Here's an example of SMTP via Tcl:

 -- Dec, Tue 16 1:44 gps ~ --   
 $ tclsh8.4
 % set s [socket mail.xmission.com 25]
 sock3
 % fconfigure $s -buffering line     
 % puts $s "MAIL FROM: GeorgePS@XMission.com"
 % gets $s 
 220 mgr1.xmission.com ESMTP Exim 3.35 #1 Tue, 16 Dec 2003 01:44:38 -0700
 % puts $s "RCPT TO: <GeorgePS@XMission.com>"
 % gets $s
 250 <GeorgePS@XMission.com> is syntactically correct
 % puts $s DATA
 % puts $s "I like magic elves and trolls."
 % puts $s ".\nQUIT"
 % flush $s
 % gets $s
 250 <GeorgePS@XMission.com> is syntactically correct
 % close $s
----

 #GPS
 proc blink.me {win i} {
  set cur [$win curselection]
  set fg [$win cget -foreground]
  set bg [$win cget -background] 

  foreach {bg fg} [list $fg $bg] break
  $win configure -foreground $fg
  $win configure -background $bg
  incr i 
  if {$i > 5} return
  after 50 [list blink.me $win $i] 
 }
 pack [listbox .l]; .l insert end Hello World
 bind .l <<ListboxSelect>> {blink.me %W 0}

hmm...  Now that was a little annoying.  It flashes too much.  Let's make it only flash 2 colors or maybe even 3 and then reset.  I think passing it a list of colors might work better.

 #GPS
 proc blink.this {win colList i} {
  set cur [$win curselection]
  foreach {bg fg} $colList break
  $win itemconfigure $cur -selectforeground $fg -selectbackground $bg
  incr i 
  if {$i > 5} {
   $win itemconfigure $cur -selectforeground {} -selectbackground {}
   return
  }
  after 50 [list blink.this $win [list $fg $bg] $i]
 }

 pack [listbox .l]; .l insert end Hello World this is George!
 bind .l <<ListboxSelect>> {blink.this %W {red blue} 0}

----
Abhishek I hope this helps:

 #! /bin/wish8.3
 proc toolbar:make {win arPtr} {
        upvar $arPtr ar
        set i 0; 
        foreach {name mem} [array get ar] {
                set img [lindex $mem 0]
                set cmd [lindex $mem 1]
                pack [button $win.$name -image $img -command $cmd] -side left
                incr i
        }
 }

 proc toolbar:disable {win arPtr key disFile} {
        upvar $arPtr ar
        set img [lindex $ar($key) 0]
        $img read ./$disFile
        $win.$key config -state disabled
 }

 pack [frame .f -relief groove -bd 1]
 set ar(hello) [list [image create photo -file ./hello.gif] {puts "Hello World"}]
 set ar(goodbye) [list [image create photo -file ./goodbye.gif] exit]
 toolbar:make .f ar


 pack [button .b -text "Disable Hello" -command {toolbar:disable .f ar hello ./goodbye.gif}]


----
[jmn] 2003-08-27
Proc size performance


 set bigStuff ""
 for {set i 0} {$i <= 700} {incr i} {
        append bigStuff "set x$i v$i ;\n"
 }
 proc small {args} {
        set v1 [lindex $args 0]
        if {$v1 eq "goFast"} {   v$i ;\n"
                return $v1;
        } else {
                return "slow"
        }
 }
 proc big {args} [string map "@bigStuff@ [list $bigStuff]" {
        set v1 [lindex $args 0]
        if {$v1 eq "goFast"} {  igStuff@ [list $bigStuff]" {
                return $v1;
        } else {
                @bigStuff@
                return "slow"
        }
 }]
 small goFast v1 v2
 small goSlow v1 v2
 big goFast v1 v2
 big goSlow v1 v2
 proc dotimes {{n 1000}} {
        puts "small goFast: [time {small        goFast val1 val2} $n]"
        puts "small goSlow: [time {small        goSlow val1 val2} $n]"
        puts "big   goFast: [time {big  goFast val1 val2} $n]"
        puts "big   goSlow: [time {big  goSlow val1 val2} $n]"
 }
----
[Category Example]