#! /bin/env tclsh
package require ycl::context
namespace import [yclprefix]::context::context
package require ycl::proc
namespace import [yclprefix]::proc::checkargs
package require ycl::ns
namespace import [yclprefix]::ns::nsnormalize
namespace eval doc {}
variable doc::program {
description {
insantiate a new program
}
args {
cmd {
description {
The name of the command to create
}
}
pkg {
description {
The name of the package for the program, relative to ycl::programs
}
default {
#automatically determined if name is provided
}
}
name {
description {
The name of the new program
}
default {
#automatically determined if pkg is provided
}
}
path {
description {
The path of the new program
}
default {
#automatically determined later
}
}
}
}
proc program {args} {
variable program
checkargs doc::program args
if {[info exists pkg] && ![info exists name]} {
set name $pkg
}
if {[info exists name] && ![info exists pkg]} {
set pkg $name
}
if {![info exists path]} {
if {[info exists name]} {
set path $name
} elseif {[info exists pkg]} {
set path $pkg
}
}
set cmd [nsnormalize [uplevel namespace current] $cmd]
context program[incr program]
program$program $ path [auto_execok $path]
program$program $ configure [dict create]
program$program $ depends [dict create]
program$program $ features [dict create]
program$program $ enabled [dict create]
program$program method depend
program$program method require
program$program method inquire
if {![info exists pkg]} {
set pkg ycl::programs::$name
}
package require ycl::programs::$pkg
set cmd [${name}::$name program$program $cmd]
trace add command $cmd delete [list apply {{program args} {
namespace delete $program
}} [namespace current]::program$program]
return $cmd
}
variable doc::require {
description {
require a certain feature
}
args {
see doc::inquire::args
}
}
proc require {ctxt args} {
if {![$ctxt inquire $args]} {
return -code error "inquiry failed"
}
}
variable doc::inquire {
description {
inquire about a certain feature
}
args {
feature {
description {
name of the feature to inquire about
}
}
version {
description {
version to inquire about, in the format {VERSION REQIREMENT}
where REQUIREMENT has the same semantics as the [package vsatisfies] command
}
default {
#unset
}
}
}
}
proc inquire {ctxt args} {
checkargs doc::inquire args
if {![dict exists [$ctxt dict configure] $feature]} {
set res [$ctxt configure feature]
if {[dict get $res status]} {
$ctxt eval [list dict set features $feature 1]
} else {
$ctxt eval [list dict set configure $feature 1]
}
}
if {[dict exists [$ctxt dict features] $feature]} {
return 1
} else {
return 0
}
}
variable doc::depend {
description {
register one feature as depending on another
}
args {
feature {
description {
the feature that has the dependency
}
}
on {
description {
what the feature depends on
}
default {
#unset
}
}
}
}
proc depend {ctxt args} {
checkargs doc::depend args
if {[info exists on]} {
set depends [$ctxt dict depends]
if {[dict exists $depends $on]} {
#look for cyclic dependencies
set levels [list]
set indexes [list]
}
$ctxt eval [list dict set depends $feature $on {}]
} else {
if {[dict exists [$ctxt $ depends] $feature]} {
return [dict get [$ctxt $ depends] $feature]
}
}
}
proc enable {ctxt feature} {
if {[$ctxt inquire feature $feature]} {
$ctxt eval [list dict set enabled $feature]
} else {
return -code error "feature not present"
}
}
variable program