diff --git a/src/bootsupport/include_modules.config b/src/bootsupport/include_modules.config index 694efa4b..1ba6c227 100644 --- a/src/bootsupport/include_modules.config +++ b/src/bootsupport/include_modules.config @@ -8,6 +8,9 @@ set bootsupport_modules [list\ modules punkcheck\ modules punk::ns\ modules punk::cap\ + modules punk::cap::handlers::caphandler\ + modules punk::cap::handlers::scriptlibs\ + modules punk::cap::handlers::templates\ modules punk::du\ modules punk::mix\ modules punk::mix::base\ diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 37529a9d..4e4dc6d4 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -7159,7 +7159,8 @@ namespace eval punk { } package require punk::mod -punk::mod::cli set_alias pmod +#punk::mod::cli set_alias pmod +punk::mod::cli set_alias app package require punk::mix punk::mix::cli set_alias pmix diff --git a/src/modules/punk/cap-999999.0a1.0.tm b/src/modules/punk/cap-999999.0a1.0.tm index bf36180c..948dd6d9 100644 --- a/src/modules/punk/cap-999999.0a1.0.tm +++ b/src/modules/punk/cap-999999.0a1.0.tm @@ -35,9 +35,9 @@ namespace eval punk::cap { variable pkgcapsdeclared [dict create] variable pkgcapsaccepted [dict create] variable caps [dict create] - if {[info commands [namespace current]::callbackbase] eq ""} { - oo::class create [namespace current]::callbackbase { - method pkg_register {pkg capdict fullcapabilitylist} { + if {[info commands [namespace current]::interface_caphandler.registry] eq ""} { + oo::class create [namespace current]::interface_caphandler.registry { + method pkg_register {pkg capname capdict fullcapabilitylist} { #handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid #overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes. return 1 ;#default to permit @@ -46,6 +46,20 @@ namespace eval punk::cap { return ;#unregistration return is ignored - review } } + + oo::class create [namespace current]::interface_capprovider.registration { + method get_declarations {} { + error "interface_capprovider.registration not implemented by provider" + } + } + oo::class create [namespace current]::interface_capprovider.provider { + method register {{capabilityname_glob *}} { + + } + method capabilities {} { + + } + } } #Not all capabilities have to be registered. #A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler). @@ -74,7 +88,7 @@ namespace eval punk::cap { } if {[llength [set providers [dict get $caps $capname providers]]]} { #some provider(s) were in place before the handler was registered - if {[set cb [get_handler_callback $capname]] ne ""} { + if {[set capreg [get_caphandler_registry $capname]] ne ""} { foreach pkg $providers { set fullcapabilitylist [dict get $pkgcapsdeclared $pkg] foreach capspec $fullcapabilitylist { @@ -82,7 +96,7 @@ namespace eval punk::cap { if {$cn ne $capname} { continue } - set do_register [$cb pkg_register $pkg $capdict $fullcapabilitylist] + set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist] set list_accepted [dict get $pkgcapsaccepted $pkg] if {$do_register} { if {$capspec ni $list_accepted} { @@ -120,6 +134,10 @@ namespace eval punk::cap { variable caps return [dict exists $caps $capname] } + proc has_handler {capname} { + variable caps + return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}] + } proc get_handler {capname} { variable caps if {[dict exists $caps $capname]} { @@ -127,12 +145,27 @@ namespace eval punk::cap { } return "" } - proc get_handler_callback {capname} { - set ns [get_handler $capname] - if {[namespace exists $ns]} { - if {[info exists ${ns}::callback]} { - if {[info object isa object ${ns}::callback]} { - return ${ns}::callback + + #dispatch + #proc call_handler {capname args} { + # if {[set handler [get_handler $capname]] eq ""} { + # error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" + # } + # ${handler}::[lindex $args 0] {*}[lrange $args 1 end] + #} + proc call_handler {capname args} { + if {[set handler [get_handler $capname]] eq ""} { + error "punk::cap::call_handler $capname $args - no handler registered for capability $capname" + } + set obj ${handler}::$capname + $obj [lindex $args 0] {*}[lrange $args 1 end] + } + proc get_caphandler_registry {capname} { + set ns [get_handler $capname]::capsystem + if {[namespace exists ${ns}]} { + if {[info command ${ns}::caphandler.registry] ne ""} { + if {[info object isa object ${ns}::caphandler.registry]} { + return ${ns}::caphandler.registry } } } @@ -172,11 +205,11 @@ namespace eval punk::cap { dict set caps $capname [dict create handler "" providers [list]] set cap_pkgs [list] } - #todo - if there's a cap handler - call it's init/validation callback for the pkg + #todo - if there's a caphandler - call it's init/validation callback for the pkg set do_register 1 ;#default assumption unless vetoed by handler - if {[set cb [get_handler_callback $capname]] ne ""} { - #Note that callback must be able to handle multiple calls for same pkg - set do_register [$cb pkg_register $pkg $capdict $capabilitylist] + if {[set capreg [get_caphandler_registry $capname]] ne ""} { + #Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg + set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist] } if {$do_register} { if {$pkg ni $cap_pkgs} { @@ -186,7 +219,15 @@ namespace eval punk::cap { dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry } } - dict set pkgcapsdeclared $pkg $capabilitylist + #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append + #dict lappend pkgcapsdeclared $pkg $capabilitylist + if {[dict exists $pkgcapsdeclared $pkg]} { + set caps [dict get $pkgcapsdeclared $pkg] + lappend caps {*}$capabilitylist + dict set pkgcapsdeclared $pkg $caps + } else { + dict set pkgcapsdeclared $pkg $capabilitylist + } } proc unregister_package {pkg} { variable pkgcapsdeclared @@ -204,13 +245,13 @@ namespace eval punk::cap { set pkglist [dict get $cap_info providers] set posn [lsearch $pkglist $pkg] if {$posn >= 0} { - if {[set cb [get_handler_callback $capname]] ne ""} { + if {[set capreg [get_caphandler_registry $capname]] ne ""} { #review # it seems not useful to allow the callback to block this unregister action #the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter #vetoing unregister would make this more complex for no particular advantage #if per capability deregistration required this should probably be a separate thing (e.g disable_capability?) - $cb pkg_unregister $pkg + $capreg pkg_unregister $pkg } set pkglist [lreplace $pkglist $posn $posn] dict set caps $capname providers $pkglist @@ -319,6 +360,13 @@ namespace eval punk::cap { return $result } + proc capability {capname} { + variable caps + if {[dict exists $caps $capname]} { + return [dict get $caps $capname] + } + return "" + } proc capabilities {{glob *}} { variable caps set capnames [lsort [dict keys $caps $glob]] diff --git a/src/modules/punk/cap/handlers/caphandler-999999.0a1.0.tm b/src/modules/punk/cap/handlers/caphandler-999999.0a1.0.tm new file mode 100644 index 00000000..8fa45211 --- /dev/null +++ b/src/modules/punk/cap/handlers/caphandler-999999.0a1.0.tm @@ -0,0 +1,52 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2023 +# +# @@ Meta Begin +# Application punk::cap::handlers::caphandler 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +##e.g package require frobz + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::cap::handlers::caphandler { + + + + +} + + + + + + + + + + + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::cap::handlers::caphandler [namespace eval punk::cap::handlers::caphandler { + variable pkg punk::cap::handlers::caphandler + variable version + set version 999999.0a1.0 +}] +return \ No newline at end of file diff --git a/src/modules/punk/cap/scriptlibs-buildversion.txt b/src/modules/punk/cap/handlers/caphandler-buildversion.txt similarity index 100% rename from src/modules/punk/cap/scriptlibs-buildversion.txt rename to src/modules/punk/cap/handlers/caphandler-buildversion.txt diff --git a/src/modules/punk/cap/scriptlibs-999999.0a1.0.tm b/src/modules/punk/cap/handlers/scriptlibs-999999.0a1.0.tm similarity index 75% rename from src/modules/punk/cap/scriptlibs-999999.0a1.0.tm rename to src/modules/punk/cap/handlers/scriptlibs-999999.0a1.0.tm index 7d97b548..b66518a1 100644 --- a/src/modules/punk/cap/scriptlibs-999999.0a1.0.tm +++ b/src/modules/punk/cap/handlers/scriptlibs-999999.0a1.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::cap::scriptlibs 999999.0a1.0 +# Application punk::cap::handlers::scriptlibs 999999.0a1.0 # Meta platform tcl # Meta license # @@ Meta End @@ -22,7 +22,7 @@ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::cap::scriptlibs { +namespace eval punk::cap::handlers::scriptlibs { @@ -44,8 +44,8 @@ namespace eval punk::cap::scriptlibs { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready -package provide punk::cap::scriptlibs [namespace eval punk::cap::scriptlibs { - variable pkg punk::cap::scriptlibs +package provide punk::cap::handlers::scriptlibs [namespace eval punk::cap::handlers::scriptlibs { + variable pkg punk::cap::handlers::scriptlibs variable version set version 999999.0a1.0 }] diff --git a/src/modules/punk/cap/templates-buildversion.txt b/src/modules/punk/cap/handlers/scriptlibs-buildversion.txt similarity index 100% rename from src/modules/punk/cap/templates-buildversion.txt rename to src/modules/punk/cap/handlers/scriptlibs-buildversion.txt diff --git a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm new file mode 100644 index 00000000..aa1cfde0 --- /dev/null +++ b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm @@ -0,0 +1,127 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2023 +# +# @@ Meta Begin +# Application punk::cap::handlers::templates 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +##e.g package require frobz + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#register using: +# punk::cap::register_capabilityname templates ::punk::cap::handlers::templates + +#By convention and for consistency, we don't register here during package loading - but require the calling app to do it. +# (even if it tends to be done immediately after package require anyway) +# registering capability handlers can involve validating existing provider data and is best done explicitly as required. +# It is also possible for a capability handler to be registered to handle more than one capabilityname + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::cap::handlers::templates { + namespace eval capsystem { + #interfaces for punk::cap to call into + if {[info commands caphandler.registry] eq ""} { + punk::cap::interface_caphandler.registry create caphandler.registry + oo::objdefine caphandler.registry { + method pkg_register {pkg capname capdict caplist} { + #caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?) + if {![dict exists $capdict relpath]} { + puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of 'templates' capability, but is missing 'relpath' key" + return 0 + } + set provide_statement [package ifneeded $pkg [package require $pkg]] + set tmfile [lindex $provide_statement end] + if {![file exists $tmfile]} { + puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of 'templates' capability" + return 0 + } + set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder + if {![file isdirectory $tpath]} { + puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to determine relpath location [dict get $capdict relpath] for package '$pkg' which is attempting to register with punk::cap as a provider of 'templates' capability" + } + if {$capname ni $::punk::cap::handlers::templates::handled_caps} { + lappend ::punk::cap::handlers::templates::handled_caps $capname + } + if {[info commands punk::cap::handlers::templates::$capname] eq ""} { + punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname + } + set cname [string map [list . _] $capname] + upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders + dict lappend pfolders $pkg $tpath + return 1 + } + method pkg_unregister {pkg} { + upvar ::punk::cap::handlers::templates::handled_caps hcaps + foreach capname $hcaps { + set cname [string map [list . _] $capname] + upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders + dict unset pfolders $pkg + #destroy api objects? + } + } + } + } + } + + variable handled_caps [list] + #variable pkg_folders [dict create] + + # -- --- --- --- --- --- --- + #handler api for clients of this capability - called via punk::cap::call_handler ?args? + # -- --- --- --- --- --- --- + namespace export * + + oo::class create api { + #return a dict keyed on folder with source pkg as value + constructor {capname} { + variable capabilityname + variable cname + set cname [string map [list . _] $capname] + set capabilityname $capname + } + method folders {} { + variable capabilityname + variable cname + upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders + package require punk::cap + set capinfo [punk::cap::capability $capabilityname] + # e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} + + #use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package + set pkgs [dict get $capinfo providers] + set folderdict [dict create] + foreach pkg $pkgs { + foreach pfolder [dict get $pkg_folders $pkg] { + dict set folderdict $pfolder [list source $pkg sourcetype package] + } + } + return $folderdict + } + } + + +} + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::cap::handlers::templates [namespace eval punk::cap::handlers::templates { + variable pkg punk::cap::handlers::templates + variable version + set version 999999.0a1.0 +}] +return \ No newline at end of file diff --git a/src/modules/punk/cap/handlers/templates-buildversion.txt b/src/modules/punk/cap/handlers/templates-buildversion.txt new file mode 100644 index 00000000..f47d01c8 --- /dev/null +++ b/src/modules/punk/cap/handlers/templates-buildversion.txt @@ -0,0 +1,3 @@ +0.1.0 +#First line must be a semantic version number +#all other lines are ignored. diff --git a/src/modules/punk/cap/templates-999999.0a1.0.tm b/src/modules/punk/cap/templates-999999.0a1.0.tm deleted file mode 100644 index 85d61284..00000000 --- a/src/modules/punk/cap/templates-999999.0a1.0.tm +++ /dev/null @@ -1,102 +0,0 @@ -# -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt -# -# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. -# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# (C) 2023 -# -# @@ Meta Begin -# Application punk::cap::templates 999999.0a1.0 -# Meta platform tcl -# Meta license -# @@ Meta End - - - -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Requirements -##e.g package require frobz - - - - -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -#register using: -# punk::cap::register_capabilityname templates ::punk::cap::templates - -#By convention and for consistency, we don't register here during package loading - but require the calling app to do it. -# (even if it tends to be done immediately after package require anyway) -# registering capability handlers can involve validating existing provider data and is best done explicitly as required. -# It is also possible for a capability handler to be registered to handle more than one capabilityname - -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -namespace eval punk::cap::templates { - variable callback - set callback [namespace current]::callback - if {[info commands $callback] eq ""} { - punk::cap::callbackbase create $callback - oo::objdefine $callback { - method pkg_register {pkg capdict fullcaplist} { - if {![dict exists $capdict relpath]} { - return 0 - } - return 1 - } - method pkg_unregister {pkg} { - - } - } - } - #return a dict keyed on folder with source pkg as value - proc folders {} { - package require punk::cap - set caplist [punk::cap::capabilities templates] - # e.g {templates {punk::mix::templates ::somepkg}} - set templates_record [lindex $caplist 0] - set pkgs [dict get [lindex $templates_record 1] providers] - - set folderdict [dict create] - foreach pkg $pkgs { - set provide_statement [package ifneeded $pkg [package require $pkg]] - set tmfile [lindex $provide_statement end] - if {![file exists $tmfile]} { - puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::cap as a provider of 'templates' capability" - continue - } - - set caplist [dict get [punk::cap::pkgcap $pkg] accepted] - set templates_entries [lsearch -all -inline -index 0 $caplist templates] ;#we generally expect only one - but if multiple exist - use them - foreach templates_info $templates_entries { - lassign $templates_info _templates templates_dict - if {[dict exists $templates_dict relpath]} { - #set tmdir [file dirname [lindex $provide_statement end]] - set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder - #relpath relative to file is important for tm files that are zip/tar based containers - if {[file isdirectory $tpath]} { - dict set folderdict $tpath [list source $pkg sourcetype package] - } else { - puts stderr "punk::cap::templates::folders WARNING - unable to determine relpath location [dict get $templates_dict relpath] for package '$pkg' which is registered with punk::cap as a provider of 'templates' capability" - } - } else { - puts stderr "punk::cap::templates::folders WARNING - registered pkg '$pkg' has capability 'templates' but has an entry with no 'relpath' key - unable to use as source of templates" - } - } - } - return $folderdict - } - - -} - - - - -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready -package provide punk::cap::templates [namespace eval punk::cap::templates { - variable pkg punk::cap::templates - variable version - set version 999999.0a1.0 -}] -return \ No newline at end of file diff --git a/src/modules/punk/mix-0.2.tm b/src/modules/punk/mix-0.2.tm index 2bb4e096..d09dfca8 100644 --- a/src/modules/punk/mix-0.2.tm +++ b/src/modules/punk/mix-0.2.tm @@ -1,8 +1,11 @@ package require punk::cap -package require punk::cap::templates ;#handler for templates cap -# punk::cap::register_capabilityname templates ::punk::cap::templates -package require punk::mix::templates ;#registers as provider pkg for 'templates' capability with punk::cap + +package require punk::cap::handlers::templates ;#handler for templates cap +punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates + +package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap +#punk::mix::templates::provider register * package require punk::mix::base package require punk::mix::cli diff --git a/src/modules/punk/mix/base-0.1.tm b/src/modules/punk/mix/base-0.1.tm index 656bda72..fcfaf56b 100644 --- a/src/modules/punk/mix/base-0.1.tm +++ b/src/modules/punk/mix/base-0.1.tm @@ -362,9 +362,13 @@ namespace eval punk::mix::base { proc get_template_basefolders {{scriptpath ""}} { #1 lowest precedence - templates from packages (ordered by order in which packages registered with punk::cap) set folderdict [dict create] - set template_folder_dict [punk::cap::templates::folders] - dict for {dir folderinfo} $template_folder_dict { - dict set folderdict $dir $folderinfo + + package require punk::cap + if {[punk::cap::has_handler punk.templates]} { + set template_folder_dict [punk::cap::call_handler punk.templates folders] + dict for {dir folderinfo} $template_folder_dict { + dict set folderdict $dir $folderinfo + } } #2 middle precedence - mixtemplates folder relative to cwd diff --git a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm index bb370510..9dc3190d 100644 --- a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm @@ -73,7 +73,7 @@ namespace eval punk::mix::commandset::layout { set glob * } set layouts [list] - #set tplfolderdict [punk::cap::templates::folders] + #set tplfolderdict [punk::cap::call_handler punk.templates folders] set tplfolderdict [punk::mix::base::lib::get_template_basefolders] dict for {tdir folderinfo} $tplfolderdict { set layout_base $tdir/layouts diff --git a/src/modules/punk/mix/templates-999999.0a1.0.tm b/src/modules/punk/mix/templates-999999.0a1.0.tm index 34f23a5c..f8ae512f 100644 --- a/src/modules/punk/mix/templates-999999.0a1.0.tm +++ b/src/modules/punk/mix/templates-999999.0a1.0.tm @@ -23,12 +23,43 @@ package require punk::cap # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::mix::templates { + variable pkg punk::mix::templates + variable cap_provider + punk::cap::register_package punk::mix::templates [list\ - {templates {relpath ../templates}}\ - {templates {relpath ../templates2}}\ - {templates {boguskey ../templates}}\ + {punk.templates {relpath ../templates}}\ ] - + namespace eval capsystem { + if {[info commands capprovider.registration] eq ""} { + punk::cap::interface_capprovider.registration create capprovider.registration + oo::objdefine capprovider.registration { + method get_declarations {} { + set decls [list] + lappend decls punk.templates {relpath ../templates} + lappend decls punk.templates {relpath ../templates2} + return $decls + } + } + } + } + + if {[info commands provider] eq ""} { + punk::cap::interface_capprovider.provider create provider + oo::objdefine provider { + method register {{capabilityname_glob *}} { + #puts registering punk::mix::templates $capabilityname + next + } + method capabilities {} { + next + } + } + } + + # -- --- + #provider api + # -- --- + #none - declarations only } diff --git a/src/modules/punk/mod-0.1.tm b/src/modules/punk/mod-0.1.tm index 5ffa4855..5c211781 100644 --- a/src/modules/punk/mod-0.1.tm +++ b/src/modules/punk/mod-0.1.tm @@ -57,8 +57,6 @@ namespace eval punk::mod::cli { puts stderr "punk::apps::app missing apps_folder:'$containerfolder' Ensure apps_folder is set in punk::config" } } - dict set appinfo bases $bases - dict set appinfo mains $mains dict set appinfo versions $versions #todo - natsort! set sorted_versions [lsort $versions] @@ -67,6 +65,9 @@ namespace eval punk::mod::cli { set latest [lindex $sorted_versions 1 } dict set appinfo latest $latest + + dict set appinfo bases $bases + dict set appinfo mains $mains return $appinfo } @@ -96,13 +97,29 @@ namespace eval punk::mod::cli { } } - - proc run {appname} { + #todo - way to launch as separate process + # solo-opts only before appname - args following appname are passed to the app + proc run {args} { + set nameposn [lsearch -not $args -*] + if {$nameposn < 0} { + error "punkapp::run unable to determine application name" + } + set appname [lindex $args $nameposn] + set controlargs [lrange $args 0 $nameposn-1] + set appargs [lrange $args $nameposn+1 end] + set appinfo [punk::mod::cli::getraw $appname] if {[llength [dict get $appinfo versions]]} { set ver [dict get $appinfo latest] puts stdout "info: $appinfo" - tailcall source [dict get $appinfo mains $ver] + set ::argc [llength $appargs] + set ::argv $appargs + source [dict get $appinfo mains $ver] + if {"-hideconsole" in $controlargs} { + puts stderr "attempting console hide" + #todo - something better - a callback when window mapped? + after 500 {::punkapp::hide_console} + } return $appinfo } else { error "punk::mod::cli unable to run '$appname'. main.tcl not found in [dict get $appinfo bases]" diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 1583dd97..5deca02c 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -644,13 +644,18 @@ proc repl::get_prompt_config {} { } return [list resultprompt $resultprompt nlprompt $nlprompt infoprompt $infoprompt debugprompt $debugprompt] } -proc repl::start {inchan} { +proc repl::start {inchan args} { variable commandstr variable running variable reading variable done variable startinstance variable loopinstance + if {[namespace exists ::punkapp]} { + if {[dict exists $args -defaultresult]} { + set ::punkapp::default_result [dict get $args -defaultresult] + } + } incr startinstance set loopinstance 0 set running 1 @@ -663,6 +668,18 @@ proc repl::start {inchan} { #todo - override exit? after 0 ::repl::post_operations vwait repl::post_operations_done + if {[namespace exists ::punkapp]} { + #todo check and get punkapp::result array - but what key? + if {[info exists ::punkapp::result(shell)]} { + set temp $::punkapp::result(shell) + unset ::punkapp::result(shell) + return $temp + } elseif {[info exists ::punkapp::default_result]} { + set temp $::punkapp::default_result + unset ::punkapp::default_result + return $temp + } + } return 0 } proc repl::post_operations {} { diff --git a/src/modules/punkapp-0.1.tm b/src/modules/punkapp-0.1.tm index d20319c6..baf01254 100644 --- a/src/modules/punkapp-0.1.tm +++ b/src/modules/punkapp-0.1.tm @@ -6,6 +6,7 @@ package provide punkapp [namespace eval punkapp { }] namespace eval punkapp { + variable result variable waiting "no" proc hide_dot_window {} { #alternative to wm withdraw . @@ -49,6 +50,8 @@ namespace eval punkapp { } proc exit {{toplevel ""}} { variable waiting + variable result + variable default_result set toplevels [get_toplevels] if {[string length $toplevel]} { set wposn [lsearch $toplevels $toplevel] @@ -64,7 +67,13 @@ namespace eval punkapp { } else { puts stderr "punkapp::exit called without toplevel - exiting" if {$waiting ne "no"} { - set waiting "done" + if {[info exists result(shell)]} { + set temp [set result(shell)] + unset result(shell) + set waiting $temp + } else { + set waiting "" + } } else { ::exit } @@ -78,7 +87,21 @@ namespace eval punkapp { show_console } else { if {$waiting ne "no"} { - set waiting "done" + if {[info exists result(shell)]} { + set temp [set result(shell)] + unset result(shell) + set waiting $temp + } elseif {[info exists result($toplevel)]} { + set temp [set result($toplevel)] + unset result($toplevel) + set waiting $temp + } elseif {[info exists default_result]} { + set temp $default_result + unset default_result + set waiting $temp + } else { + set waiting "" + } } else { ::exit } @@ -92,8 +115,12 @@ namespace eval punkapp { } destroy $toplevel } - proc wait {{msg "waiting"}} { + proc wait {args} { variable waiting + variable default_result + if {[dict exists $args -defaultresult]} { + set default_result [dict get $args -defaultresult] + } foreach t [punkapp::get_toplevels] { if {[wm protocol $t WM_DELETE_WINDOW] eq ""} { wm protocol $t WM_DELETE_WINDOW [list punkapp::close_window $t] @@ -103,8 +130,9 @@ namespace eval punkapp { puts stderr "repl eventloop seems to be running - punkapp::wait not required" } else { if {$waiting eq "no"} { - set waiting $msg + set waiting "waiting" vwait ::punkapp::waiting + return $::punkapp::waiting } } } @@ -165,10 +193,23 @@ namespace eval punkapp { } } if {$::tcl_platform(platform) eq "windows"} { + #hide won't work for certain consoles cush as conemu,wezterm - and doesn't really make sense for tabbed windows anyway. + #It would be nice if we could tell the console window to hide just the relevant tab - or the whole window if only one tab present - but this is unlikely to be possible in any standard way. + #an ordinary cmd.exe or pwsh.exe or powershell.exe window can be hidden ok though. + #(but with wezterm - process is cmd.exe - but it has style popup and can't be hidden with a twapi::hide_window call) package require twapi set h [twapi::get_console_window] - twapi::hide_window $h - return 1 + set pid [twapi::get_window_process $h] + set pinfo [twapi::get_process_info $pid -name] + set pname [dict get $pinfo -name] + set wstyle [twapi::get_window_style $h] + if {$pname in [list cmd.exe pwsh.exe powershell.exe] && "popup" ni $wstyle} { + twapi::hide_window $h + return 1 + } else { + puts stderr "punkapp::hide_console unable to hide this type of console window" + return 0 + } } else { #todo puts stderr "punkapp::hide_console unimplemented on this platform (todo)" diff --git a/src/modules/shellfilter-0.1.8.tm b/src/modules/shellfilter-0.1.8.tm index 66e1194b..33999fbc 100644 --- a/src/modules/shellfilter-0.1.8.tm +++ b/src/modules/shellfilter-0.1.8.tm @@ -1012,7 +1012,10 @@ namespace eval shellfilter::stack { variable pipelines return [dict keys $pipelines] } - + proc item {pipename} { + variable pipelines + return [dict get $pipelines $pipename] + } proc status {{pipename *} args} { variable pipelines @@ -1039,7 +1042,11 @@ namespace eval shellfilter::stack { foreach k [dict keys $pipelines $pipename] { set lc [dict get $pipelines $k device localchan] - set tid [dict get $pipelines $k device workertid] + if {[dict exists $k device workertid]} { + set tid [dict get $pipelines $k device workertid] + } else { + set tid "" + } set col1 [overtype::left $ac1 $k] @@ -1253,7 +1260,6 @@ namespace eval shellfilter::stack { dict set pipelines $pipename stack $stack } show_pipeline $pipename -note "after_remove $remove_id" - return 1 } diff --git a/src/modules/shellrun-0.1.tm b/src/modules/shellrun-0.1.tm index 2e4b0f98..b05afaf4 100644 --- a/src/modules/shellrun-0.1.tm +++ b/src/modules/shellrun-0.1.tm @@ -30,10 +30,18 @@ namespace eval shellrun { } else { lassign [list "" "" "" ""] syslog_stdout syslog_stderr logfile_stdout logfile_stderr } - set outdevice [shellfilter::stack::new punkshout -settings [list -tag "punkshout" -buffering none -raw 1 -syslog $syslog_stdout -file $logfile_stdout]] - set out [dict get $outdevice localchan] - set errdevice [shellfilter::stack::new punksherr -settings [list -tag "punksherr" -buffering none -raw 1 -syslog $syslog_stderr -file $logfile_stderr]] - set err [dict get $errdevice localchan] + if {"punkshout" ni [shellfilter::stack::items]} { + set outdevice [shellfilter::stack::new punkshout -settings [list -tag "punkshout" -buffering none -raw 1 -syslog $syslog_stdout -file $logfile_stdout]] + set out [dict get $outdevice localchan] + } else { + set out [dict get [shellfilter::stack::item punkshout] device localchan] + } + if {"punksherr" ni [shellfilter::stack::items]} { + set errdevice [shellfilter::stack::new punksherr -settings [list -tag "punksherr" -buffering none -raw 1 -syslog $syslog_stderr -file $logfile_stderr]] + set err [dict get $errdevice localchan] + } else { + set err [dict get [shellfilter::stack::item punksherr] device localchan] + } namespace import ::punk::ansi::a+ namespace import ::punk::ansi::a diff --git a/src/punk86.vfs/lib/app-shellspy/shellspy.tcl b/src/punk86.vfs/lib/app-shellspy/shellspy.tcl index 6b0232bb..790ed94a 100644 --- a/src/punk86.vfs/lib/app-shellspy/shellspy.tcl +++ b/src/punk86.vfs/lib/app-shellspy/shellspy.tcl @@ -134,6 +134,9 @@ foreach p $original_tm_list { set ::testconfig 5 namespace eval shellspy { + variable chanstack_stderr_redir + variable chanstack_stdout_redir + variable commands proc clock_sec {} { return [expr {[clock millis]/1000.0}] @@ -163,7 +166,9 @@ namespace eval shellspy { #redir on the shellfilter stack with no log or syslog specified acts to suppress output of stdout & stderr. #todo - fix shellfilter code to make this noop more efficient (avoid creating corresponding logging thread and filter?) #JMN - lassign [shellfilter::redir_output_to_log "SUPPRESS"] id_stdout_redir id_stderr_redir + #set redirconfig {-settings {-syslog 127.0.0.1:514 -file ""}} + set redirconfig {} + lassign [shellfilter::redir_output_to_log "SUPPRESS" {*}$redirconfig] chanstack_stdout_redir chanstack_stderr_redir shellfilter::log::write $shellspy_status_log "shellfilter::redir_output_to_log SUPPRESS DONE [clock_sec]" @@ -371,8 +376,15 @@ namespace eval shellspy { } return [dict create result $result] } + + + #punk86 -tk example: + # punk86 -tk eval "button .tk.b -text doit -command {set ::punkapp::result(shell) guiresult;punkapp::close_window .tk}; pack .tk.b;return somedefaultvalue" proc do_tclline {flavour args} { - if {$flavour eq "punk"} { + variable chanstack_stderr_redir + variable chanstack_stdout_redir + + if {$flavour in [list "punk" "punkshell"]} { namespace eval :: {package require punk;package require shellrun} } elseif {$flavour in [list "tk" "tkshell"]} { namespace eval :: { @@ -386,20 +398,39 @@ namespace eval shellspy { wm protocol .tk WM_DELETE_WINDOW [list punkapp::close_window .tk] } } + #remove SUPPRESS redirection if it was in place so that shell output is visible + catch { + shellfilter::stack::remove stderr $chanstack_stderr_redir + shellfilter::stack::remove stdout $chanstack_stdout_redir + } + set result_is_error 0 if {[catch {apply [list {arglist} {namespace eval :: $arglist} ::] $args} result]} { - return [dict create error $result] + set result_is_error 1 } - if {$flavour eq "tk"} { - namespace eval :: {punkapp::wait} - #todo - better return value e.g from dialog? - } elseif {$flavour eq "tkshell"} { - namespace eval :: { + if {$flavour in [list "punkshell" "tkshell"]} { + set result [namespace eval :: [string map [list %e% $chanstack_stderr_redir %o% $chanstack_stdout_redir %r% $result] { + package require punk + package require shellrun package require punk::repl - repl::start stdin + puts stdout "quit to exit" + repl::start stdin -defaultresult %r% + }]] + } + + #todo - better exit? + if {$result_is_error} { + if {$flavour eq "tk"} { + return [dict create error [namespace eval :: [list punkapp::wait -defaultresult $result]]] + #todo - better return value e.g from dialog? } - #todo - better exit? + return [dict create error $result] + } else { + if {$flavour eq "tk"} { + return [dict create result [namespace eval :: [list punkapp::wait -defaultresult $result]]] + #todo - better return value e.g from dialog? + } + return [dict create result $result] } - return [dict create result $result] } proc set_punkd {args} { variable shellspy_status_log @@ -704,6 +735,8 @@ source [file normalize $scriptname] set params [do_callback_parameters script] dict set params -tclscript 1 ;#don't give callback a chance to omit/break this dict set params -teehandle shellspy + #dict set params -teehandle punksh + set params [dict merge $params [get_channel_config $::testconfig]] @@ -769,11 +802,11 @@ source [file normalize $scriptname] } return $exitinfo } - proc do_wsl {dist args} { + proc do_wsl {distdefault args} { variable shellspy_status_log - shellfilter::log::write $shellspy_status_log "do_wsl $dist got '$args' [llength $args]" + shellfilter::log::write $shellspy_status_log "do_wsl $distdefault got '$args' [llength $args]" set args [do_callback wsl {*}$args] ;#use dist? - shellfilter::log::write $shellspy_status_log "do_wsl $dist xgot '$args'" + shellfilter::log::write $shellspy_status_log "do_wsl $distdefault xgot '$args'" set params [do_callback_parameters wsl] dict set params -debug 0 @@ -783,14 +816,14 @@ source [file normalize $scriptname] set id_out [shellfilter::stack::add stdout towindows -action sink-aside-locked -junction 1 -settings {}] dict set params -teehandle shellspy ;#shellspyout shellspyerr must exist - set exitinfo [shellfilter::run [concat wsl -d $dist -e [shellescape $args]] {*}$params] + set exitinfo [shellfilter::run [concat wsl -d $distdefault -e [shellescape $args]] {*}$params] shellfilter::stack::remove stdout $id_out if {[lindex $exitinfo 0] eq "exitcode"} { - shellfilter::log::write $shellspy_status_log "do_wsl $dist returning $exitinfo" + shellfilter::log::write $shellspy_status_log "do_wsl $distdefault returning $exitinfo" } return $exitinfo } @@ -890,7 +923,7 @@ source [file normalize $scriptname] lappend commands [list runcmduc [list sub word$i singleopts {any}]] } #cmd with bracked args () e.g with vim shellxquote set to "(" - lappend commands [list runcmdb [list match {^cmdb$} dispatch [list shellspy::do_in_cmdshellb %matched%] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any} pairopts {any}]] + lappend commands [list runcmdb [list match {^cmdb$} dispatch [list shellspy::do_in_cmdshellb] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any} pairopts {any}]] for {set i 0} {$i < 25} {incr i} { lappend commands [list runcmdb [list sub word$i singleopts {any} longopts {any} pairopts {any}]] } @@ -920,6 +953,10 @@ source [file normalize $scriptname] for {set i 0} {$i < 25} {incr i} { lappend commands [list tkshellline [list sub word$i singleopts {any}]] } + lappend commands [list punkshellline [list match {^-punkshell$} dispatch [list shellspy::do_tclline punkshell] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] + for {set i 0} {$i < 25} {incr i} { + lappend commands [list punkshellline [list sub word$i singleopts {any}]] + } lappend commands [list help [list match [list {^-help$} {^--help$} {^help$} {^/\?}] dispatch [list shellspy::do_help] dispatchtype raw dispatchglobal 1 singleopts {any} longopts {any}]] @@ -928,6 +965,9 @@ source [file normalize $scriptname] } ############################################################################################ + #todo -noexit flag + + #echo raw args to diverted stderr before running the argument analysis puts -nonewline stderr "exe:[info nameofexecutable] script:[info script] shellspy-rawargs: $::argv\n" set i 1 @@ -982,8 +1022,8 @@ source [file normalize $scriptname] #lassign [shellfilter::redir_output_to_log "SUPPRESS"] id_stdout_redir id_stderr_redir catch { - shellfilter::stack::remove stderr $id_stderr_redir - shellfilter::stack::remove stdout $id_stdout_redir + shellfilter::stack::remove stderr $chanstack_stderr_redir + shellfilter::stack::remove stdout $chanstack_stdout_redir } #shellfilter::log::write $shellspy_status_log "logtidyup -done- $tidyinfo" @@ -1083,7 +1123,7 @@ source [file normalize $scriptname] } } - foreach tclscript_flavour [list tclline punkline tkline tkshellline libscript help] { + foreach tclscript_flavour [list tclline punkline punkshellline tkline tkshellline libscript help] { if {[dict exists $arglist dispatch $tclscript_flavour result error]} { catch { set colour [punk::ansi::a+ yellow bold]; set reset [punk::ansi::a] @@ -1102,7 +1142,7 @@ source [file normalize $scriptname] if {[dict exists $arglist errorCode]} { exit [dict get $arglist errorCode] } - foreach tclscript_flavour [list tclline punkline tkline tkshellline libscript help] { + foreach tclscript_flavour [list tclline punkline punkshellline tkline tkshellline libscript help] { if {[dict exists $arglist dispatch $tclscript_flavour result result]} { puts -nonewline stdout [dict get $arglist dispatch $tclscript_flavour result result] exit 0