diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 8c375a5c..8d4877ff 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -4,7 +4,25 @@ package provide punk [namespace eval punk { set version 0.1 }] +#Punk - where radical modification is a craft and anti-patterns are another exploratory tool for the Pattern Punk. +#Built on Tcl of course - because it's the most powerful piece of under-appreciated and alternate-thinking engineering you can plug into. + + + + +#repltelemetry cooperation with other packages such as shellrun +#Maintenance warning: shellrun expects repltelemetry_emmitters to exist if punk namespace exists +namespace eval punk { + variable repltelemetry_emmitters + #don't stomp.. even if something created this namespace in advance and is 'cooperating' a bit early + if {![info exists repltelemetry_emitters]} { + set repltelemetry_emmitters [list] + } +} + + #globals... some minimal global var pollution +#punk's official silly test dictionary set punk_testd [dict create \ a0 a0val \ b0 [dict create \ @@ -12,30 +30,37 @@ set punk_testd [dict create \ b1 b0b1val \ c1 b0c1val \ d1 b0d1val \ - ]\ - c0 [dict create \ - a1 [dict create \ - a2 c0a1a2val \ - b2 c0a1b2val \ - c2 c0a1c2val \ - ] \ - b1 [dict create \ - a2 [dict create \ - a3 c0b1a2a3val \ - b3 c0b1a2b3val \ - ] \ - b2 [dict create \ - a3 c0b1b2a3val \ - b3 [dict create \ - a4 c0b1b2b3a4 \ - ] \ - c3 [dict create] \ - ] \ + ] \ + c0 [dict create] \ + d0 [dict create \ + a1 [dict create \ + a2 d0a1a2val \ + b2 d0a1b2val \ + c2 d0a1c2val \ ] \ - ] \ + b1 [dict create \ + a2 [dict create \ + a3 d0b1a2a3val \ + b3 d0b1a2b3val \ + ] \ + b2 [dict create \ + a3 d0b1b2a3val \ + bananas "in pyjamas" \ + c3 [dict create \ + po "in { }" \ + b4 ""\ + c4 "can go boom" \ + ] \ + d3 [dict create \ + a4 "-paper -cuts" \ + ] \ + e3 [dict create] \ + ] \ + ] \ + ] \ ] -#cooperative withe punk repl +#impolitely cooperative withe punk repl - todo - tone it down. namespace eval ::repl { variable running 0 } @@ -44,6 +69,7 @@ package require punk::config namespace eval punk { interp alias {} purelist {} lreplace x 0 0 ;#required by pipe system package require pattern + package require shellfilter package require punkapp package require funcl package require control @@ -79,10 +105,11 @@ namespace eval punk { debug header "dbg> " variable last_run_display [list] - variable ansi_disabled 0 + variable colour_disabled 0 variable ns_current "::" #variable re_headvar1 {([a-zA-Z:@.(),]+?)(?![^(]*\))(,.*)*$} - + + proc ::punk::K {x y} { return $x} proc ::punk::var {varname {= {}} args} { @@ -2504,7 +2531,11 @@ namespace eval punk { set ptype [string index $positionspecatomic 0] set index [string range $positionspecatomic 1 end] set isint [string is integer -strict $index] - if {$isint || [regexp {^(end|end[-+]{1,2}[0-9]+)$} $index]} { + if {$index eq "."} { + #blocking insertion-spec - explicit instruction not to pass this var in. + #most useful as just /. or data/. somevar/. is equivalent to leaving out the somevar insertionspec + #do nothing - no script + } elseif {$isint || [regexp {^(end|end[-+]{1,2}[0-9]+)$} $index]} { if {$ptype eq "@"} { #compare position to *possibly updated* list - note use of $index > $datalen rather than $index+1 > $datalen - (we allow 'insertion' at end of list by numeric index) if {$isint} { @@ -2682,17 +2713,18 @@ namespace eval punk { } debug.punk.pipe.rep {>> [rep_listname segmentargvals]} 4 + set ns [uplevel 1 {namespace current}] if {!$add_argsdata} { debug.punk.pipe {APPLY1: (args not set; not a list) segment vars:$segmentargnames} 4 #puts stderr " script: $script" #puts stderr " vals: $segmentargvals" - set evaluation [uplevel 1 [list apply [list $segmentargnames $script ::] {*}$segmentargvals]] + set evaluation [uplevel 1 [list apply [list $segmentargnames $script $ns] {*}$segmentargvals]] } else { debug.punk.pipe {APPLY2: (args is set)segment vars:$segmentargnames} 4 #puts stderr " script: $script" #puts stderr " vals: $segmentargvals $argsdatalist" #pipeline script context should be one below calling context - so upvar v v will work - set evaluation [uplevel 1 [list apply [list [concat $segmentargnames args] $script ::] {*}$segmentargvals {*}$argsdatalist]] + set evaluation [uplevel 1 [list apply [list [concat $segmentargnames args] $script $ns] {*}$segmentargvals {*}$argsdatalist]] } debug.punk.pipe.rep {script result, evaluation: [rep_listname evaluation]} 4 @@ -3473,29 +3505,31 @@ namespace eval punk { #https://metacpan.org/pod/Text::ANSI::Util #(saves up all ansi color codes since previus color reset and replays the saved codes after our highlighting is done) proc ansi+ {args} { - variable ansi_disabled - if {$ansi_disabled == 1} { + variable colour_disabled + if {$colour_disabled == 1} { return } tailcall ::shellfilter::ansi::+ {*}$args } - proc ansi {{onoff {}}} { - variable ansi_disabled + + proc colour {{onoff {}}} { + variable colour_disabled if {[string length $onoff]} { set onoff [string tolower $onoff] if {$onoff in [list 1 on true yes]} { interp alias "" a+ "" punk::ansi+ - set ansi_disabled 0 + set colour_disabled 0 } elseif {$onoff in [list 0 off false no]} { interp alias "" a+ "" control::no-op - set ansi_disabled 1 + set colour_disabled 1 } else { - error "punk::ansi expected 0|1|on|off|true|false|yes|no" + error "punk::colour expected 0|1|on|off|true|false|yes|no" } } catch {repl::reset_prompt} - return [expr {!$ansi_disabled}] + return [expr {!$colour_disabled}] } + proc scriptlibpath {{shortname {}} args} { upvar ::punk::config::running running_config set scriptlib [dict get $running_config scriptlib] @@ -3955,7 +3989,7 @@ namespace eval punk { set fqpath $ns_current } } - puts stderr ">>fqpath $fqpath" + #puts stderr ">>fqpath $fqpath" set nstail [namespace tail $glob] if {[string first ? $nstail] >= 0 || [string first * $nstail] >=0} { set location $fqpath @@ -4176,6 +4210,11 @@ namespace eval punk { } set is_absolute [string match ::* $a1] if {$is_absolute} { + if {![llength $atail] && ([string first * [namespace tail $a1]] >= 0 || [string first ? [namespace tail $a1]] >= 0)} { + set out [punk::nslist $a1] + append out "\n$a1" + return $out + } if {[namespace exists $a1]} { set ns_current $a1 tailcall punk::ns/ {*}$atail @@ -4187,6 +4226,13 @@ namespace eval punk { } else { set nsnext ${ns_current}::$a1 } + if {![llength $atail] && ([string first * [namespace tail $a1]] >= 0)} { + set out [punk::nslist $nsnext] + append out "\n$nsnext" + return $out + } + + if {[namespace exists $nsnext]} { set ns_current $nsnext tailcall punk::ns/ {*}$atail @@ -4801,7 +4847,8 @@ namespace eval punk { interp alias {} hide {} punkapp::hide_console ;#will only work if controllable toplevels exist - interp alias {} ansi {} punk::ansi + interp alias {} colour {} punk::colour + interp alias {} color {} punk::colour interp alias {} a+ {} punk::ansi+ #sh style 'test' and 'exitcode' (0 is false) @@ -4947,28 +4994,108 @@ namespace eval punk { interp alias {} listset {} punk::listset ;#identical to pipeset + #experimental + #is there ever any difference to {namespace curent}? + interp alias {} nsthis {} .= .= namespace code {namespace current} |> .=* <0/#| + interp alias {} nsthis2 {} .= namespace current <0/#| + - interp alias {} nscommands {} ,'ok'@0.= { + interp alias {} nscommands1 {} .= ,'ok'@0.= { upvar caseresult caseresult + inspect -label namespace_current [namespace current] + inspect -label nsthis [nsthis] + inspect -label nsthis2 [nsthis2] + inspect -label commandns $commandns + inspect -label info_procs [info procs] #by using pipeswitch instead of pipeswitchc - we give the ability* for the switch script block to affect vars in the calling scope # (*not a desirable feature from a functional point of view - but useful for debugging, and also potentially faster ) pipeswitch { #no glob chars present + if {![llength $ns]} { + set ns $commandns + } else { + if {![string match ::* $ns]} { + if {$commandns eq "::"} {set commandns ""} + set ns ${commandns}::$ns + } + } + inspect '$ns' pipecase \ caseresult= $ns |input> \ 1.= {expr {[string length [string map [list * "" ? ""] $data]] == [string length $data]}} |> { - uplevel #0 [list info commands ${input}::*] + #uplevel 1 [list info commands ${input}::*] + info commands ${input}::* } #pipecase1 ns has one or more of glob chars * or ? pipecase \ caseresult= $ns |input> { - uplevel #0 [list info commands ${input}] + #uplevel 1 [list info commands ${input}] + info commands ${input} } } + } |data@@ok/result> {lmap v $data {namespace tail $v}} |> lsort |> {join $data \n} [llength $colors]-1} { + set ci 0 + } + #by using pipeswitch instead of pipeswitchc - we give the ability* for the switch script block to affect vars in the calling scope + # (*not a desirable feature from a functional point of view - but useful for debugging, and also potentially faster ) + if {$ci == 0} { + set col "" + } else { + set col [a+ [lindex $colors $ci] bold] + } + set matchedcommands [pipeswitch { + #no glob chars present + if {![llength $ns]} { + set ns $commandns + } else { + if {![string match ::* $ns]} { + if {$commandns eq "::"} {set commandns ""} + set ns ${commandns}::$ns + } + } + #inspect '$ns' + pipecase \ + caseresult= $ns |input> \ + 1.= {expr {[string length [string map [list * "" ? ""] $data]] == [string length $data]}} |> { + #uplevel 1 [list info commands ${input}::*] + info commands ${input}::* + } - } |data@@ok/result> {lmap v $data {namespace tail $v}} |> lsort |> {join $data \n} { + #uplevel 1 [list info commands ${input}] + info commands ${input} + } + }] + #lappend commandlist {*}[@@ok/result= $matchedcommands] + set rawcmds [@@ok/result= $matchedcommands |> {lmap v $data {namespace tail $v}}] + foreach c $rawcmds { + lappend commandlist [list $c $col$c[a+]] + #lappend commandlist $c + } + incr ci ;#colourindex + } + list ok [list result $commandlist] + } |data@@ok/result> lsort -index 0 |> {lmap v $data {lindex $v 1}} |> {join $data \n}