'''LEGO PROC:''' - Manipulate parts of a proc's body and args at runtime
  ###### pgetlist
  # 1. It returns a list of all id's in a proc with lindex relative to its code
  # 2. Creates a list to varname with the body of a proc split at prior id's
  # 3. If the proc has no pinsert id's it tags the existing body with null
  #   This means you can easily refer to the initial code in a proc by using id null
  ######
  proc pgetlist {name {varname ""}} {
    set c1 [format %c 1]
    set code [split [string trim [info body $name]] \n]
    set pattern "\#$c1\*$c1\#"
    lappend code $pattern
    set newlist [list]
    set idlist [list]
    set tmp [list]
    foreach {line} $code {
      if {[string match $pattern $line]} {
         set tmp [join $tmp \n]
         lappend idlist [string map [list $c1 "" "\#" ""] $line]
         if {$tmp != {}} { lappend newlist $tmp }
         set tmp [list]
      }
      lappend tmp $line
    }
    if {[llength $idlist] == 1} {
      set id "null"
      set newlist [linsert $newlist 0 "\#$c1$id$c1\#"]
      set idlist [linsert $idlist 0 $id]
    }
    if {$varname != ""} { uplevel 1 [list set $varname $newlist] }
    return [lrange $idlist 0 [expr [llength $idlist] - 2]]
  }
  ###
  
  ###### pinsert
  #  Inserts code at index position under id
  # if proc does not exist it creates it.
  # returns 1 if id already exists
  ######
  proc pinsert {name index id code} {
   set c1 [format %c 1]
   if {![llength [info procs $name]]} {
     set bodylist [list]
     set idlist [list]
     set pargs {}
     } else {
       set idlist [pgetlist $name bodylist]
       set pargs [info args $name]
    }
    foreach {oid} $idlist { if { [string match $oid $id] } { return 1 } }
    set code "\#$c1$id$c1\#\n[string trim $code \n\r]"
    set bodylist [linsert $bodylist $index $code]
    proc ::$name $pargs [join $bodylist \n]
    return 0
  }
  ###
  
  
  ##### preplace
  # removes id from proc optionally replaces it with a new id and newcode
  # if newcode is specified and newid is "" it reuses the old id
  #####
  proc preplace {name id {newid ""} {newcode ""}} {
    set c1 [format %c 1]
    set idlist [pgetlist $name bodylist]
    set pargs [info args $name]
    set tmp [lsearch $idlist "$id"]
    if { $tmp < 0 } { return 1 }
    if {$newid == ""} { set newid $id }
    if {$newcode == ""} { 
     set bodylist [lreplace $bodylist $tmp $tmp] 
    } else {
     if {$newid != $id && [lsearch $idlist $newid] >= 0} { return 1 }
     set code "\#$c1$newid$c1\#\n[string trim $newcode \n\r]"
     set bodylist [lreplace $bodylist $tmp $tmp $code]
    }
  proc ::$name $pargs [join $bodylist \n]
   return 0
  }


  ###### pargs
  # Sets the args of a proc
  ######
  proc pargs {name parg} { 
    if {[llength [info procs $name]]} { proc ::$name $parg [info body $name] } 
  }
  ###


  ############ for debug
  #! DEBUG
    proc proc_view {name} {
      set tmp [split [info body $name] \n]
      set tmpa [info args $name]
      set tmpres "proc $name \{$tmpa\} \{\n"
      foreach {line} $tmp { set tmpres "$tmpres   $line\n" }
      set tmpres "$tmpres\}\n"
      puts "\n############################\n### DEBUG - proc view ###"
      puts "$tmpres"
      puts "#Tags: [join [pgetlist MyProc] " & "]\n###########################\n"
    }
  #####
----
'''Syntax:'''

'''pinsert''' ''proc_name index id script''

- Inserts script at a list index position tagged as id. It creates the proc if it doesnt exist.
If proc exists it returns 1 if id is already in use. If proc was created by other means it tags all script in it as "null". An ID can be virtually any string as long as it doesnt start or end with # or char /001 

'''pgetlist''' ''proc_name ?varname?''

- Returns a list of all id's in a proc. Optionally sets varname to a list where each list item is a id tag with its script.

'''preplace''' ''proc_name id ?newid? ?newscript?''

- Replaces, Removes, script under id. If newid is "" it uses old id when replacing.

'''proc_view''' ''not all that useful, heh, just something i'm using to show what i got.''

'''Example:''' - Create and manipulate ''MyProc''

Create proc MyProc and insert some code into it
   pinsert MyProc end mycode1 {puts "First Added"}
   pinsert MyProc end mycode2 {puts "Second Added"}

Notice linsert functionality, lets go between our first two
   pinsert MyProc 1 mycode3 {puts "Third Added"}

Replace a chunk of script but use the same id
   preplace MyProc mycode1 "" {puts "Hello world"}
Replace a chunk of script with a new id
notice an id can be any string, providing it doesnt start with pound or char 1
   preplace MyProc mycode1 "king of the mountain" {puts "I WIN"}
Lets try it out
   proc_view MyProc
   MyProc
Add some args to the proc
   pargs MyProc {x y}
Get a list of all the procs id's
   set myIDs [pgetlist MyProc]
Search for an ID and use its index
   set i [lsearch $myIDs "king of the mountain"]
   set myCode {
    puts "$x is FUN"
    puts "$y"
   }
   if {[pinsert MyProc $i mycode2 $myCode]} { puts "mycode2 exists use preplace for that" }
   if {![pinsert MyProc $i newking $myCode]} { puts "newking works" }
With pgetlist you can get pretty advanced, using either an items index or the id itself
   set i 0
   foreach {id} [pgetlist MyProc] {
     if {$id != "newking"} { preplace MyProc $id }
   }
   proc_view MyProc
   MyProc "TCL" "THE END"
This could be used for alot of things. I'll be using it for a tcl irc bot, all my added script is evaluated in one proc. This will make it easy for me to load/unload script from it. It'll also make it easy to keep track of it because i can use the file it came from to tag it.
If anybody's interested in doing something similar this is about what it'll cosist of.

  proc loadscript {file} {
     set fsize [file size $file]
     set fin [open $file r]
     set script [read $fin $fsize]
     close $fin
     if {[pinsert ScriptEval end $file $script]} { 
       puts "$file has been loaded" 
     } else { 
      puts "Error: $file is already loaded" }
   }
  
  loadscript "LuckyNumber.tcl"

file: LuckyNumber.tcl

   if {$event == "PRIVMSG" && [string toupper $text] == "!LUCKYNUMBERS"} {
      set n 0
      while {$n < 10} { set lucky "$lucky [expr {int(rand()*9)}]" ; incr n }
      puts $ircSocket "PRIVMSG $chan :$nick's LuCkYnUmBeRs - $lucky"
   }

I hope somebody finds this as nifty as I do.
- ''xonecubed aka David Myers''