#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/On.tcl,v $
# $Date: 1998/08/27 12:15:29 $
# $Revision: 1.18.1.15 $
#
package provide zircon 1.18
#
# ON condition support code
#
proc on {action pattern code} {
    global currentNet
    upvar #0 OnCode$currentNet OnCode
    switch [set action [string toupper $action]] \
      NICK	{ set action NICKNAME } \
      CONNECT	{ set action STARTUP } \
      NOTIFY_SIGNON { set action ISON } \
      NOTIFY_SIGNOFF { set action ISOFF }
    set pat {}
    foreach p $pattern { lappend pat [string tolower $p] }
    lappend OnCode([string toupper $action]) [list $pat $code]
}
#
proc handleOn {net action pattern} {
    global zircon defaultNet
    upvar #0 OnCode$net OnCode OnCode$defaultNet Default
    if {!$zircon(o)} {
	catch {foreach act $OnCode($action) {
	    if {[checkOn $net $act $pattern] && ![$net multion]} return
	}}
	if {[notDefaultNet]} {
	    catch {foreach act $Default($action) {
		if {[checkOn $net $act $pattern] && ![$net multion]} return
	    }}
	}
    }
}
#
proc checkOn {net act pattern} {
    foreach pat $pattern up [lindex $act 0] {
	switch -- $up {} { set up .*}
	if {![regexp -nocase -- $up $pat]} { return 0 }
    }
    uplevel #0 set net $net
    set i 0
    foreach pat $pattern {
	uplevel #0 set $i [list $pat]
	incr i
    }
    if {[catch {uplevel #0 [lindex $act 1]} msg]} {
	tellError {} {On Command Error} \
"Error when executing on command \"[lindex $act 1]\": $msg"
    }
    uplevel #0 "safeUnset net [info globals [0-9]*]"
    return 1
}
#
proc operator {chan} {
    global net
     return [[Channel :: find $chan $net] operator]
}
