Code:

foreach [uplevel 1 {set args}] [uplevel 1 {set code}] break

Code:

namespace eval ::cbind {variable cfgvariable binds# create a new custom bind typeproc createType {type args mstr mtype stack hand chan} {variable cfgset all [lrange [info level 0] 2 end]# replace an existing type?if {[info exists cfg($type)]} {if {$cfg($type)==$all} {return 2} {variable bindsarray unset binds $type,*}}# generate code to produce the string that is matched against your# masks (command substitution is performed when the bind is invoked)set j [llength $args]set code {}for {set i 0} {$i<$j} {incr i} {lappend code "\[lindex \$args $i\]"}if {[catch {set cfg($type,mstr) [peval {foreach [uplevel 1 {set args}] [uplevel 1 {set code}] breaksubst -noc [string map {\\ \\\\ [ \\\\[ ] \\\\]} [uplevel 1 {set mstr}]]}]} err]} {error "invalid mstr: $err"}# generate code for matching and flag checking based on your settingsset code {}if {$hand>-1} {if {$chan>-1} {lappend code {($flags!="-"&&![matchattr $hand $flags $chan])}} {lappend code {($flags!="-"&&![matchattr $hand $flags])}}}switch -- $mtype {"-nocase"     {lappend code {![string eq -noc $mask $mstr]}}"-glob"       {lappend code {![string match $mask $mstr]}}"-globnocase" {lappend code {![string match -noc $mask $mstr]}}default       {lappend code {![string eq $mask $mstr]}}}if {[llength $code]} {set cfg($type,code) "if \{[join $code "||"]\} continue"} else {set cfg($type,code) ""}# store the rest of the settingsset cfg($type) $allset cfg($type,args) $argsset cfg($type,argn) $jset cfg($type,stack) $stackset cfg($type,hand) $handset cfg($type,chan) $chanset all}# guessproc bind {type flags mask command} {variable cfgvariable bindsif {![info exists cfg($type)]} {error "invalid type"}if {![string match {*[a-zA-Z0-9]*} $flags]} {set flags -}set name $type,$maskset bind [list $type $flags $mask $command]if {[info exists binds($name)]&&$cfg($type,stack)} {if {[lsearch -exact $binds($name) $bind]==-1} {lappend binds($name) $bind}} else {set binds($name) [list $bind]}set command}# guessproc unbind {type flags mask command} {variable bindsif {![string match {*[a-zA-Z0-9]*} $flags]} {set flags -}set name $type,$maskset bind [list $type $flags $mask $command]if {[info exists binds($name)]} {if {[set i [lsearch -exact $binds($name) $bind]]>-1} {if {[llength $binds($name)]>1} {set binds($name) [lreplace $binds($name) $i $i]} {unset binds($name)}return $command}}error "no such bind"}# make stuff happenproc invoke {type args} {variable cfgvariable bindsif {![info exists cfg($type)]} {error "invalid type \"$type\""}if {[llength $args]!=$cfg($type,argn)} {error "wrong # args for \"$type\" i want: $cfg($type,args)"}if {$cfg($type,hand)>-1} {set hand [lindex $args $cfg($type,hand)]set chan [lindex $args $cfg($type,chan)]}set mstr [subst $cfg($type,mstr)]set code $cfg($type,code)foreach name [array names binds $type,*] {foreach bind $binds($name) {foreach {. flags mask cmd} $bind breakeval $codeuplevel #0 [concat $cmd $args]}}}# a clean, temporary scope (used to generate the mstr code)proc peval code {eval [set code] [unset code]}}

Code:

"Manual" (i used the code tag to preserve formatting):::cbind::createType <type> <args> <mstr> <mtype> <stack> <hand> <chan>creates a new bind type based on your settingsarguments:type: the "name" of your new bindargs: the list of arguments required when invoking the bindmstr: a piece of "code" used to generate the string that your      bind masks are matched againstmtype: match type (-exact, -nocase, -glob or -globnocase)stack: stackable or not? (1/0)hand: if you want flag matching, give the position of the      handle in your argument list (index), or -1chan: if you want channel flag matching (like the above, but      to indicate the position of the channel name)::cbind::bind <type> <flags> <mask> <command>create a bind(you created the type, so you should know how it works :P)::cbind::unbind <type> <flags> <mask> <command>remove a bind::cbind::invoke <type> [arg1, arg2...argN]make stuff happen :)arguments:type: must be a valid typeargs: the remaining arguments must match the number of      arguments in the type's argument list      the values are used in different ways depending      on the settings you used when creating the type.

Code:

# create the new type:cbind::createType join {nick uhost hand chan} {$chan $nick!$uhost} -globnocase 1 2 3# a test bind + proccbind::bind join - * testproc test {n u h c} {putlog "$n!$u joined $c as $h"}# invoke the type and see what happenscbind::invoke join It seems@to.work * #chan

Code:

.tcl bind evnt - foo {putlog "foo event happened"}

Code:

.tcl callevent foo

Code:

# Raw Bindsbind raw - JOIN eqim_join_rawproc eqim_join_raw {src key chan} {global loglevset autoadd 0set module eqim_join_rawif {[do_debug $module]} {putloglev $loglev(debug) $chan "#$module# found src: $src key: $key chan: $chan"}set nick [lindex [split $src "!"] 0]if {[string match ":*" $chan]} {set chan [string range $chan 1 end]}if {[checkbans $src $chan]} {return 0}eqim-int_send_news $nick $chan $nick 2set hand [finduser $src]if {$hand == "*"} {if {$autoadd} {eqim-add_flagged_user $nick $chan noneset hand $nick} else {return 0}} if {![haschanrec $hand $chan]} {addchanrec $hand $chan}eqim_update_host $handsetuser $hand LASTON [clock seconds] $chanif {[channel get $chan greet]} {if {[do_debug $module]} {putloglev $loglev(debug) $chan "#$module# greeting $nick in $chan"}eqim-greet $nick $hand $chan}eqim-checkflags $nick $hand $chanreturn 0}

Code:

bind evnt <flags> <type> <proc>proc-name <type>Description: Description: triggered whenever one of these events happen; flags are ignored; valid events are:    sighup    called on a kill -HUP <pid>    sigterm    called on a kill -TERM <pid>    sigill    called on a kill -ILL <pid>    sigquit    called on a kill -QUIT <pid>    save    called when the userfile is saved    rehash    called just after a rehash    prerehash    called just before a rehash    prerestart    called just before a restart    logfile     called when the logs are switched daily    loaded    called when the bot is done loading    userfile-loaded    called after userfile has been loaded    connect-server    called just before we connect to an IRC server    init-server    called when we actually get on our IRC server    disconnect-server    called when we disconnect from our IRC serverModule: core