Text Clipboard

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