options.tcl at [dd646f0636]

Not logged in

File options.tcl artifact aa2c7ac2b2 part of check-in dd646f0636


# -*- tcl -*- Copyright (c) 2012 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Option handling

# # ## ### ##### ######## ############# #####################
## Export (internals - recipe definitions, other utilities)

namespace eval ::kettle::option {
    namespace export {[a-z]*}
    namespace ensemble create

    namespace import ::kettle::path
    namespace import ::kettle::io
}

# # ## ### ##### ######## ############# #####################
## State

namespace eval ::kettle::option {
    # Dictionary, map option names to values.
    variable config {}
}

# # ## ### ##### ######## ############# #####################
## API

proc ::kettle::option::define {o arguments script args} {
    variable config

    io trace {DEF'option $o}

    if {[dict exists $config $o]} {
	return -code error "Illegal redefinition of option $o."
    }

    lappend arguments option old new

    dict set config $o value {}
    dict set config $o user  0
    dict set config $o setter \
	[lambda@ ::kettle::option $arguments $script {*}$args]
    return
}

proc ::kettle::option::exists {o} {
    variable config
    return [dict exists $config $o]
}

proc ::kettle::option::names {} {
    variable config
    return [dict keys $config --*]
}

# set value, user choice
proc ::kettle::option::set {o value} {
    variable config

    if {[dict exists $config $o] && [dict exists $config $o value]} {
	::set old [dict get $config $o value]
    } else {
	::set old {}
    }  

    dict set config $o value $value
    dict set config $o user 1

    # Propagate choice, if possible
    if {![dict exists $config $o setter]} return
    {*}[dict get $config $o setter] $o $old $value
    return
}

# set value, system choice, new default. ignored if a user has chosen
# a value for the option.
proc ::kettle::option::setd {o value} {
    variable config

    if {![dict exists $config $o]} {
	return -code error "Unable to set default of undefined option $o."
    }

    if {[dict get $config $o user]} return

    ::set old [dict get $config $o value]
    dict set config $o value $value
    # Propagate new default.
    {*}[dict get $config $o setter] $o $old $value
    return
}

# set value, override anything, no propagation
proc ::kettle::option::set! {o v} {
    variable config
    dict set config $o value $v
    return
}

proc ::kettle::option::unset {o} {
    variable config
    dict unset config $o
    return
}

proc ::kettle::option::get {o} {
    variable config

    if {![dict exists $config $o]} {
	return -code error "Unable to retrieve unknown option $o."
    }

    return [dict get $config $o value]
}

# # ## ### ##### ######## ############# #####################
## Initialization

apply {{} {
    global tcl_platform
    variable config

    define --exec-prefix {} {
	# Implied arguments: option old new
	setd --prefix  $new
	setd --bin-dir $new/bin
	setd --lib-dir $new/lib
    }

    define --bin-dir {} {}
    define --lib-dir {} {}

    define --prefix {} {
	# Implied arguments: option old new
	setd --man-dir  $new/man
	setd --html-dir $new/html
    }

    define --man-dir  {} {}
    define --html-dir {} {}

    setd --exec-prefix [file dirname [file dirname [info library]]]
    # -> bin, lib, prefix -> man, html

    setd --bin-dir [file dirname [path norm [info nameofexecutable]]]
    setd --lib-dir [info library]

    define --ignore-glob {} {}
    setd --ignore-glob {
	*~ _FOSSIL_ .fslckout .fos .git .svn CVS .hg RCS SCCS
	*.bak *.bzr *.cdv *.pc _MTN _build _darcs _sgbak blib
	autom4te.cache cover_db ~.dep ~.dot ~.nib ~.plst
    }

    # Default file action: Do
    define --dry {} {}
    setd   --dry 0

    # Default goals
    if {$tcl_platform(platform) eq "windows"} {
	set @goals gui
    } else {
	set @goals help
    }
} ::kettle::option}

# # ## ### ##### ######## ############# #####################
return