# lib_clip.tcl


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
}


proc cb_delete {name} {
   set cb_name "cb_${name}"
   upvar #0 $cb_name the_cb
   unset the_cb
}


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]
}


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]
}


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)]
}


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
      }
   }
}