Here's what i came up with to create and manipulate parts of a proc's body by setting tags for each part of the body. Setting these tags allows me to split up the list accordingly and treat and change parts like changing list items.
Functions:
##### _pgetid
# Creates a 10 digit id greater than 0
#####
proc _pgetid {checklist} {
set z 0
while {$z < 1} {
set y [expr { int( rand() * 9 ) }]
set w [expr { int( rand() * 9 ) }]
set r [expr { int( rand() * 9 ) }]
set b [expr { int( rand() * 9 ) }]
set g [expr { int( rand() * 9 ) }]
set l [expr { int( rand() * 9 ) }]
set p [expr { int( rand() * 9 ) }]
set d [expr { int( rand() * 9 ) }]
set q [expr { int( rand() * 9 ) }]
set s 1
set n "$y$w$r$b$g$l$p$d$q$s"
if {[lsearch $checklist $n] < 0} {set z 1}
}
return $n
}
###
###### pinsert
# Inserts code at id'd index position and returns the new codes id, id will be 0000000000 -
# if proc does not exist
######
proc pinsert {name index code} {
set c1 [format %c 1]
if {![llength [info procs $name]]} {
set id 0000000000
set bodylist [list]
set pargs { }
} else {
set idlist [pgetlist $name bodylist]
set id [_pgetid $idlist]
set pargs [info args $name]
}
set code "\#$c1$id$c1\#\n$code\n\#$c1$id$c1\#"
set bodylist [linsert $bodylist $index $code]
uplevel #0 [list proc $name $pargs [join $bodylist \n]]
return $id
}
###
###### preplace
# Removes or replace id's code
# if code is specefied it will have the previous codes id
# else id is removed as well
######
proc preplace {name id {code 0}} {
set idlist [pgetlist $name bodylist]
set tmp [lsearch $idlist $id]
set pargs [info args $name]
if {$tmp >= 0} {
if {$code == 0} {
set bodylist [lreplace $bodylist $tmp $tmp]
} else {
set c1 [format %c 1]
set code "\#$c1$id$c1\#\n$code\n\#$c1$id$c1\#"
set bodylist [lreplace $bodylist $tmp $tmp $code]
}
uplevel #0 [list proc $name $pargs [join $bodylist \n]]
}
}
###
###### pargs
# Sets the args of a proc
######
proc pargs {name parg} {
if {[llength [info procs $name]]} { uplevel #0 [list proc $name $parg [info body $name]] }
}
###
###### 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 0000000000
# This means you can easily refer to the initial code in a proc
######
proc pgetlist {name {varname ""}} {
set c1 [format %c 1]
set code [info body $name]
set tmp [string length [string trim $code]]
set code [split $code \n]
set pattern "\#$c1\??????????$c1\#"
set codepos [lsearch -all $code $pattern]
if {[llength $codepos] == 0 && $tmp != 0} {
set id 0000000000
lappend codepos 0 end
set code [linsert $code 0 "\#$c1$id$c1\#"]
lappend code "\#$c1$id$c1\#"
}
set codelist [list]
set idlist [list]
foreach {start end} $codepos {
lappend codelist [join [lrange $code $start $end] \n]
set chunk [lindex $code $start]
lappend idlist [string range $chunk 2 [expr [string length $chunk] - 3]]
}
if {$varname != ""} { uplevel 1 [list set $varname $codelist] }
return $idlist
}
###
############ 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\###########################\n"
}
#####Functions work almost like the list functions with similar name. Main difference is that code is taged with a 10 digit random id number instead of a list index. If i think of an easy way to maintain ease of use and efficiencty, or if somebody makes a suggestion, I may use some other type of separation id and keep an actual index count like a list. The main problem i saw with this is that when inserting into it causes the other items to change. It would be hard to keep track of what code is where.
Example:
#############################################
#### LETS TRY IT OUT - create/manipulate "sayit"
#############################################
set code(0) {set say "$say IS"}
set code(1) {set say "$say FUN"}
set code(2) {set say "$say\."}
set code(3) {puts "YOU SAY: [string trim $say]"}
### these will contain the id tags to locate our code
set codeID(0) [pinsert sayit end $code(0)]
set codeID(1) [pinsert sayit end $code(1)]
set codeID(2) [pinsert sayit end $code(2)]
set codeID(3) [pinsert sayit end $code(3)]
pargs sayit {say}
proc_view sayit
sayit "TCL"
### lets change it
preplace sayit $codeID(3) {return [string trim $say]}
puts "- [sayit "THIS"]"
preplace sayit $codeID(0) {set say "$say ARE"}
puts "- [sayit "PUPPIES"]"
### just a tad more technical
## I want to add a word in a specific place,
## so i need to get an Index from an ID
set tmp [pgetlist sayit]
set x [lsearch $tmp $codeID(1)]
set codeID(4) [pinsert sayit $x {set say "$say PROCS"}]
set codeID(5) [pinsert sayit $x {set say "$say TCL"}]
puts "- I THINK: [sayit "THESE"]"
### Removing code
## I realize to do the following i could just proc again, this is just for show
foreach {id} [pgetlist sayit] {
preplace sayit $id
}
proc_view sayit
### lets make it a calculator
set codeID(0) [pinsert sayit 0 {puts "- $args = [expr $args]"}]
pargs sayit {args}
proc_view sayit
sayit (3 + 3 * 2) * 10I'm not as familiar with TCL as some of you fellow wikians. Therefor Suggestions and Corrections are well appreciated. Thanks.
- David Myers aka xonecubed
AM Some comments, as I promised:
The series of assignments:
set y [expr { int( rand() * 9 ) }]
set w [expr { int( rand() * 9 ) }]
set r [expr { int( rand() * 9 ) }]
...can be made more compact:
foreach var {y w r ...} {
set $var [expr {int(rand()*9)}]
}and I do not think it is necessary to use:
uplevel #0 [list proc $name ...]
The command:
proc ::$name ...
will give the same effect.
Just a few remarks :)
Thanks AM, I changed it.
I reworked the whole thing some, I think it's alot more functional now. Got rid of the random id's now they are specified. I'll leave that up there in case somebody likes it, but i think the following is much better.
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"
}- xonecubed - I hope somebody finds this as nifty as I do.