[Koen Van Damme] -- This is the implementation of a simple buffer
in which text can be stored, removed, changed, or inserted before
finally being sent to output.  I sometimes use this for [Code Generation],
so that I can create fragments of code and tinker with them before
giving them to ''puts''. I call such buffers '''clipboards'''.
A clipboard contains named '''plugs''' in which text or other plugs
can be added.
The plugs can be retrieved by their unique name within a clipboard.  
The current implementation is not robust at all, but it is simple.  
I like simple.

First, an example:
 # A procedure that creates a new clipboard for me,
 # containing the declaration of a class.
 proc make_class {name base} {
    clip $name {
       cb_puts "class $name : public $base\n\{\n"
       plug CLASS_BODY {
          cb_puts "public:\n"
          plug PUBLIC
          cb_puts "private:\n"
          plug PRIVATE
       }
       cb_puts "\};\n"
    }
 }
 
 # Create a class, then fill in its plugs with code.
 make_class A B
 add A PUBLIC {
    cb_puts "   A()   // Default constructor\n"
    cb_puts "   \{\n"
    cb_puts "      i= 5;\n"
    cb_puts "   \}\n"
 }
 
 add A PRIVATE {cb_puts "   int i;   // Some member variable\n"}
 
 # Send result to output.
 cb_output A
The procedure ''clip'' creates a new clipboard.  
Its final argument is like the body of an "if" or 
other control statement: it gets executed in the caller's scope.  
That's how you can nest plugs and text in a clipboard.  
The call to ''plug'' adds a new plug to the current clipboard, 
given the plug's name and again a body of statements to execute.  
Note how I can add code to the existing class body at a later time using ''add''.

The intended output of the above code is this:
 class A : public B
 {
 public:
    A()   // Default constructor
    {
       i= 5;
    }
 private:
    int i;   // Some member variable
 };
but you probably guessed that :-)

The power of these clipboards comes from
   * their text-only approach.  They do not know anything about C++, they just contain freeform text.  That makes them very flexible.
   * the buffering of text so that you can change it over and over before outputting it.
   * the simple interface.

The rest of this page describes the code: first the clipboards themselves,
then the interface procedures to access the clipboards in a very intuitive way.
A clipboard is an array, in which each entry is the name of a plug, and the associated
value is a list of tuples in which 't' is for freeform text, 'p' is a plug,
and 'r' is a reference to another plug (useful for code snippets that need to be
produced over and over again).  The default plug of a new clipboard is called MAIN.
The top plugs of all clipboards are stored in the global array ''cb__start''.

-------

 # Create new clipboard called $name, with top plug called $plug_name
 proc cb_new {name {plug_name MAIN}} {
    global cb__start
    set cb__start($name) $plug_name
 
    set cb_name "cb_${name}"
    upvar #0 $cb_name the_cb
 
    # A clipboard is an array
    set the_cb($plug_name) [list]
 
    return $cb_name
 }
 
 # Remove a clipboard.  I know, This can be automated with 'trace'
 proc cb_delete {name} {
    set cb_name "cb_${name}"
    upvar #0 $cb_name the_cb
    unset the_cb
 }
 
 # Add a new tuple to plug $where of clipboard $name.
 # The tuple can be text ($what == "t"), a new plug
 # ($what == "p") or a reference to another plug ($what == "r").
 # $content is the text content, or the plug name,
 # or the referenced clipboard name. 
 proc cb_add {name where what content} {
 
    set cb_name "cb_${name}"
    upvar #0 $cb_name the_cb
 
    if { ![info exists the_cb] } {
       return
    }
 
    if { $what == "p" } {
       if { [info exists the_cb($content)] } {
          # Plug with that name already exists
          return
       }
       set the_cb($content) [list]
    }
 
    lappend the_cb($where) [list $what $content]
 }
 
 # Remove contents of plug $where of clipboard $name
 proc cb_clear {name where} {
    set cb_name "cb_${name}"
    upvar #0 $cb_name the_cb
 
    if { ![info exists the_cb] } {
       return
    }
    set the_cb($where) [list]
 }
 
 # Does clipboard $name have a plug called $where ?
 proc cb_exists {name where} {
    set cb_name "cb_${name}"
    upvar #0 $cb_name the_cb
 
    if { ![info exists the_cb] } {
       return 0
    }
    return [info exists the_cb($where)]
 }
 
 # Output the entire clipboard $name to a file
 proc cb_output {name {fid stdout}} {
    set cb_name "cb_${name}"
    upvar #0 $cb_name the_cb
 
    if { ![info exists the_cb] } {
       return
    }
 
    global cb__start
    set start $cb__start($name)
 
    cb__output $cb_name $start $fid
 }
 
 proc cb__output {cb_name pt fid} {
    upvar #0 $cb_name the_cb
    foreach elt $the_cb($pt) {
       if { [lindex $elt 0] == "t" } {
          puts -nonewline $fid "[lindex $elt 1]"
       } elseif { [lindex $elt 0] == "r" } {
          cb_output [lindex $elt 1] $fid
       } elseif { [lindex $elt 0] == "p" } {
          cb__output $cb_name [lindex $elt 1] $fid
       }
    }
 }

-------

Interface procedures:

 set cb_curr_clip ""
 set cb_curr_plug ""

 # Write text to current plug of current clipboard
 proc cb_puts {txt} {
    global cb_curr_clip cb_curr_plug
    cb_add $cb_curr_clip $cb_curr_plug t $txt
 }
 
 # New clipboard.
 proc clip {clipname args} {
    set plugname "MAIN"
    if { [llength $args] > 1 } {
       set plugname [lindex $args 0]
    }
 
    cb_new $clipname $plugname
 
    global cb_curr_clip
    set tmp_clip $cb_curr_clip
    set cb_curr_clip $clipname
 
    global cb_curr_plug
    set tmp_plug $cb_curr_plug
    set cb_curr_plug $plugname
 
    uplevel [lindex $args end]
 
    set cb_curr_clip $tmp_clip
    set cb_curr_plug $tmp_plug
 }
 
 # New plug in current clipboard
 proc plug {plugname args} {
    global cb_curr_clip
    global cb_curr_plug
 
    cb_add $cb_curr_clip $cb_curr_plug p $plugname
 
    if { [llength $args] == 0 } {
       return
    }
 
    set tmp_plug $cb_curr_plug
    set cb_curr_plug $plugname
 
    uplevel [lindex $args end]
 
    set cb_curr_plug $tmp_plug
 }
 
 # At current plug of current clipboard, insert references
 # to other clipboards.
 proc ref {args} {
    global cb_curr_clip
    global cb_curr_plug
 
    foreach othername $args {
       cb_add $cb_curr_clip $cb_curr_plug r $othername
    }
 }
 
 # Add new text to an existing plug of a clipboard.
 proc add {clipname args} {
    set plugname "MAIN"
    if { [llength $args] > 1 } {
       set plugname [lindex $args 0]
    }
 
    global cb_curr_clip
    set tmp_clip $cb_curr_clip
    set cb_curr_clip $clipname
 
    global cb_curr_plug
    set tmp_plug $cb_curr_plug
    set cb_curr_plug $plugname
 
    uplevel [lindex $args end]
 
    set cb_curr_clip $tmp_clip
    set cb_curr_plug $tmp_plug
 }
 
 # Add new plug to an existing plug of a clipboard.
 # Take that plug as the new default.
 proc add_plug {clipname args} {
    set plugname "MAIN"
    set newname [lindex $args 0]
    if { [llength $args] > 2 } {
       set plugname [lindex $args 0]
       set newname [lindex $args 1]
    }
 
    cb_add $clipname $plugname p $newname
 
    global cb_curr_clip
    set tmp_clip $cb_curr_clip
    set cb_curr_clip $clipname
 
    global cb_curr_plug
    set tmp_plug $cb_curr_plug
    set cb_curr_plug $newname
 
    uplevel [lindex $args end]
 
    set cb_curr_clip $tmp_clip
    set cb_curr_plug $tmp_plug
 }
 
 # Replace existing text in a plug by something new.
 proc replace {clipname args} {
    set plugname "MAIN"
    if { [llength $args] > 1 } {
       set plugname [lindex $args 0]
    }
 
    cb_clear $clipname $plugname
 
    global cb_curr_clip
    set tmp_clip $cb_curr_clip
    set cb_curr_clip $clipname
 
    global cb_curr_plug
    set tmp_plug $cb_curr_plug
    set cb_curr_plug $plugname
 
    uplevel [lindex $args end]
 
    set cb_curr_clip $tmp_clip
    set cb_curr_plug $tmp_plug
 }

----
[Category String Processing]