# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package stubs::gen::header 1
# Meta as::build::date 2015-03-24
# Meta platform        tcl
# Meta require         {Tcl 8.4}
# Meta require         stubs::container
# Meta require         stubs::gen
# Meta require         stubs::gen::decl
# Meta require         stubs::gen::macro
# Meta require         stubs::gen::slot
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.4
package require stubs::container
package require stubs::gen
package require stubs::gen::decl
package require stubs::gen::macro
package require stubs::gen::slot

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide stubs::gen::header 1

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# -*- tcl -*-
# STUBS handling -- Code generation: Writing the stub headers.
#
# (c) 2011 Andreas Kupries http://wiki.tcl.tk/andreas%20kupries

# A stubs table is represented by a dictionary value.
# A gen is a variable holding a stubs table value.

# # ## ### ##### ######## #############
## Requisites

package require Tcl 8.4
package require stubs::gen
package require stubs::container
package require stubs::gen::slot
package require stubs::gen::macro
package require stubs::gen::decl
# critcl, only user, ensured presence of a dict command.
# lassign84, ditto

namespace eval ::stubs::gen::header::g {
    namespace import ::stubs::gen::*
}
namespace eval ::stubs::gen::header::c {
    namespace import ::stubs::container::*
}
namespace eval ::stubs::gen::header::s {
    namespace import ::stubs::gen::slot::*
}
namespace eval ::stubs::gen::header::m {
    namespace import ::stubs::gen::macro::*
}
namespace eval ::stubs::gen::header::d {
    namespace import ::stubs::gen::decl::*
}

# # ## ### ##### ######## #############
## Implementation.

proc ::stubs::gen::header::multiline {{flag 1}} {
    return [m::multiline $flag]
}

proc ::stubs::gen::header::gen {table name} {
    set capName [g::cap $name]

    set epoch [c::epoch? $table]
    if {$epoch ne ""} {
	set CAPName [string toupper $name]
	append text "\n"
	append text "#define ${CAPName}_STUBS_EPOCH $epoch\n"
	append text "#define ${CAPName}_STUBS_REVISION [c::revision? $table]\n"
    }

    # declarations...
    append text [d::gen $table $name]

    if {[c::hooks? $table $name]} {
	append text "\ntypedef struct ${capName}StubHooks {\n"
	foreach hook [c::hooksof $table $name] {
	    set capHook [g::cap $hook]
	    append text "    const struct ${capHook}Stubs *${hook}Stubs;\n"
	}
	append text "} ${capName}StubHooks;\n"
    }

    # stub table type definition, including field definitions aka slots...
    append text "\ntypedef struct ${capName}Stubs {\n"
    append text "    int magic;\n"
    if {$epoch ne ""} {
	append text "    int epoch;\n"
	append text "    int revision;\n"
    }
    append text "    const struct ${capName}StubHooks *hooks;\n\n"
    append text [s::gen $table $name]
    append text "} ${capName}Stubs;\n"

    # stub table global variable
    append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
    append text "extern const ${capName}Stubs *${name}StubsPtr;\n"
    append text "#ifdef __cplusplus\n}\n#endif\n"

    # last, the series of macros for stub users which will route
    # function calls through the table.
    append text [m::gen $table $name]

    return $text
}

proc ::stubs::gen::header::rewrite@ {basedir table name} {
    rewrite [path $basedir $name] $table $name    
}

proc ::stubs::gen::header::rewrite {path table name} {
    g::rewrite $path [gen $table $name]
}

proc ::stubs::gen::header::path {basedir name} {
    return [file join $basedir ${name}Decls.h]
}

# # ## ### #####
## Internal helpers.

# # ## ### #####
namespace eval ::stubs::gen::header {
    namespace export gen multiline rewrite@ rewrite path
}

# # ## ### ##### ######## #############
package provide stubs::gen::header 1
return