#! /bin/env tclsh
package require {ycl exec}
package require {ycl ns}
namespace import [yclprefix]::exec::exec
package require {ycl proc}
namespace import [yclprefix]::proc::checkargs
namespace import [yclprefix]::proc::checkspec
package require {ycl shelf}
namespace import [yclprefix]::shelf
package require {ycl var}
namespace import [yclprefix]::var::util::unvar
shelf new [namespace current]
variable doc::configure {
description {
}
args {
_ {
description {
the object to configure
}
}
execname {
description {
name of executable
}
default {}
process {
$_ $ execname $execname
$_ $ execpath [auto_execok [$_ $ execname]]
return $execname
}
}
require {
description {
what features to require
}
default {
lindex {}
}
}
request {
description {
what features to request
}
default {
lindex {}
}
}
}
}
proc configure {*}[[namespace current] asmethod {{args} {execpath required requested} {} {
checkargs doc::configure
set probenames [dict keys [$_ $ probes]]
foreach levelname {request require} edname {requested required} {
if {![info exists $edname]} {
set $edname {}
}
upvar 0 $levelname level
upvar 0 $edname ed
foreach feature $level {
if {$feature ni $probenames} {
error "unknown feature: $feature"
}
if {$feature ni $ed} {
lappend ed $feature
}
}
}
}}]
[namespace current] method configure
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
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 disable {*}[[namespace current] asmethod {{feature} {disabled enabled probes} {} {
if {$feature ni [dict keys $probes]} {
error "no such feature: $feature"
}
dict unset enabled $feature
dict set disabled $feature 1
}}]
[namespace current] method disable
proc enable {_ feature} {
if {[$_ inquire feature $feature]} {
$_ eval [list dict set enabled $feature]
} else {
return -code error "feature not present"
}
}
[namespace current] method enable
proc enable {*}[[namespace current] asmethod {{feature} {disabled enabled} {} {
set features [$_ $ features]
if {$feature ni [dict keys $features]} {
error "no such feature: $feature"
}
dict set enabled $feature 1
dict unset disabled $feature
}}]
proc feature {_ args} {
dict get [$_ $ features] {*}$args
}
variable doc::find {
description {
}
args {
_ {
description {
This instance.
positional
}
}
}
}
checkspec $doc::find
proc find {*}[[namespace current] asmethod {
args {execname execpath features required} {} {
checkargs doc::find
set found {}
set failed {}
if {![$_ $.exists execnames]} {
error "if program name is not provided, execnames must be provided!"
}
foreach execname [$_ $ execnames] {
set execpath [auto_execok $execname]
$_ probes
set success 1
set featurenames [dict keys $features]
foreach requirement $required {
if {$requirement ni $required} {
set success 0
break
}
}
if {!$success} {
return -code error [list {no matching program found}]
}
}
}}]
[namespace current] method find
variable doc::init {
description {
an interface to an external program
} args {
_ {
description {
the object to configure as a program
}
}
name {
description {
The name of the new program
Automatically determined if pkg is provided
}
default {}
}
path {
description {
The path of the new program
}
default {
#automatically determined later
}
}
} attributes {
execpath {
description {
the path to the executable
}
}
}
}
dict set doc::init args [dict merge [dict get $doc::configure args] [
dict get $doc::init args]]
proc init {_ args} {
checkargs doc::init
$_ $ type program
foreach varname {disabled enabled execargs execparams execres failed
features found preexec probe probes required requested stdin
stderr stdout success val} {
$_ $ $varname {}
}
$_ $ configure [dict create]
$_ $ depends [dict create]
$_ $ features [dict create]
$_ $ enabled [dict create]
$_ method depend
$_ method require
$_ method inquire
return $_
$_ configure {*}[lrange [unvar args] 1 end]
}
[namespace current] method init
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, using the same semantics as the
[package vsatisfies] command
}
default {
#unset
}
}
}
}
proc inquire {_ args} {
checkargs doc::inquire
if {![dict exists [$_ dict configure] $feature]} {
set res [$_ configure feature]
if {[dict get $res status]} {
$_ eval [list dict set features $feature 1]
} else {
$_ eval [list dict set configure $feature 1]
}
}
if {[dict exists [$_ dict features] $feature]} {
return 1
} else {
return 0
}
}
[namespace current] method inquire
variable doc::probe {
description {
Probe the program for some feature and record the results in the
"features" attribute of the object, a dictionary of dictionaries keyed
by the name of the probe, and containing the following items for each
probe: {
success {
description {
a boolean value indicating whether the probe succeeded
}
}
execres {
description {
a dictionary with the following keys {
status {
description {
the exit code from the execution
}
}
val {
description {
the output from the execution
}
}
}
}
}
opts {
description {
the return options from the execution
}
}
}
}
}
proc probe {*}[[namespace current] asmethod {{probe args} {
execargs execres failed features probes success} {} {
set success 0
set probes [$_ $ probes]
puts [list garbage $probes]
if {$probe ni $probes} {
return -code error "no such probe: $probe"
}
$_ {*}[dict get $probes $probe] {*}$args
set res [dict create success $success execargs $execargs execres $execres]
if {$success} {
dict unset failed $probe
dict set features $probe $res
} else {
dict unset features $probe
dict set failed $probe $res
}
return $success
}}]
[namespace current] method probe
proc preexec {*}[[namespace current] asmethod {{} {} {} {
}}]
[namespace current] method preexec
proc probes {*}[[namespace current] asmethod {{} {probes required requested} {} {
foreach level {required requested} {
foreach probe1 [set $level] {
$_ probe $probe1
}
}
}}]
[namespace current] method probes
proc qualified {*}[[namespace current] asmethod {{} {required features} {} {
set featurenames [dict keys $features]
foreach name $required {
if {$name ni $featurenames} {
return 0
}
}
return 1
}}]
[namespace current] method qualified
proc resolve _ {
$_ path [auto_execok $path]
}
[namespace current] method resolve
variable doc::run {
description {
runs the program and stores the results in $execstatus, $execval,
and $execopts
}
}
proc run {*}[[namespace current] asmethod {args {
disabled enable enabled execargs execpath execres preexec stdin stdout stderr} {} {
foreach toenable [dict keys $enabled] {
if {$toenable in $disabled} {
continue
}
$_ {*}[dict get $enable $toenable]
}
foreach preexec1 $preexec {
$_ {*}$preexec1
}
set stdchans {}
foreach stdchan {stdin stdout stderr} {
if {[set $stdchan] ne {}} {
lappend stdchans [set $stdchan]
}
}
set execres [exec | [
list [$_ $ execpath] {*}$execargs {*}$args] {*}$stdchans]
return [dict get $execres out]
}}]
[namespace current] method run
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"
}
}
# name of executable
[namespace current] attribute execname