# $Id: hooks.tcl 2103 2014-01-26 17:03:59Z sergei $

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 50}} {
    variable $hook

    set idx [lsearch -exact [set $hook] [list $func $seq]]
    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 {[lsearch -exact $F(flags,$hook) $flag] < 0} {
	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 {[lsearch -exact $F(flags,$hook) $flag] < 0}]
}

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
	}
    }
}

