# hooks.tcl --
#
#       This file is a part of the Tkabber XMPP client. It implements the
#       hooks infrastructure.

namespace eval hook {}

proc hook::add {hook func {seq 50}} {
    variable F
    variable $hook

    if {![info exists F(flags,$hook)]} {
        set F(flags,$hook) {}
    }

    lappend $hook [list $func $seq]
    set $hook [lsort -real -index 1 [lsort -unique [set $hook]]]
}

proc hook::remove {hook func {seq ""}} {
    variable $hook

    if {$seq ne ""} {
        set idx [lsearch -exact [set $hook] [list $func $seq]]
        set $hook [lreplace [set $hook] $idx $idx]
    } else {
        foreach idx [lsearch -all -exact -index 0 [set $hook] $func] {
            set $hook [lreplace [set $hook] $idx $idx]
        }
    }
}

proc hook::is_empty {hook} {
    variable $hook

    if {![info exists $hook] || [llength [set $hook]] == 0} {
        return 1
    } else {
        return 0
    }
}

proc hook::set_flag {hook flag} {
    variable F

    if {![info exists F(flags,$hook)]} {
        set F(flags,$hook) {}
    }

    set idx [lsearch -exact $F(flags,$hook) $flag]
    set F(flags,$hook) [lreplace $F(flags,$hook) $idx $idx]
}

proc hook::unset_flag {hook flag} {
    variable F

    if {![info exists F(flags,$hook)]} {
        set F(flags,$hook) {}
    }

    if {$flag ni $F(flags,$hook)} {
        lappend F(flags,$hook) $flag
    }
}

proc hook::is_flag {hook flag} {
    variable F

    if {![info exists F(flags,$hook)]} {
        set F(flags,$hook) {}
    }

    return [expr {$flag ni $F(flags,$hook)}]
}

proc hook::run {hook args} {
    variable F
    variable $hook

    if {![info exists $hook]} {
        return
    }

    set F(flags,$hook) {}

    foreach func_prio [set $hook] {
        set func [lindex $func_prio 0]
        set code [catch { eval $func $args } state]

        debugmsg hook "$hook: $func -> $state (code $code)"

        if {$code == 1} {
            # return -code error (which would be weird) or just error

            ::bgerror [format "Hook %s failed\nProcedure %s returned code\
                               %s\n%s" $hook $func $code $state]
        }
        if {$code == 3 || ($code == 0 && [string equal $state stop])} {
            # return -code break or return stop

            break
        }
    }
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et
