diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 04efdc83..6908f4c3 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -5192,7 +5192,7 @@ namespace eval punk { #lappend idlist_stderr [shellfilter::stack::add stderr ansiwrap -settings {-colour {red bold}}] #lappend idlist_stdout [shellfilter::stack::add stdout tee_to_var -action float -settings {-varname ::shellrun::runout}] - if {[dict get $::punk::config::running auto_exec_mechanism] eq "experimental"} { + if {[punk::config::configure running auto_exec_mechanism] eq "experimental"} { #TODO - something cross-platform that allows us to maintain a separate console(s) with an additional set of IO channels to drive it #not a trivial task @@ -5993,8 +5993,7 @@ namespace eval punk { proc scriptlibpath {{shortname {}} args} { - upvar ::punk::config::running running_config - set scriptlib [dict get $running_config scriptlib] + set scriptlib [punk::config::configure running scriptlib] if {[string match "lib::*" $shortname]} { set relpath [string map [list "lib::" "" "::" "/"] $shortname] set relpath [string trimleft $relpath "/"] diff --git a/src/modules/punk/aliascore-999999.0a1.0.tm b/src/modules/punk/aliascore-999999.0a1.0.tm index 1f335109..4d5dcb1c 100644 --- a/src/modules/punk/aliascore-999999.0a1.0.tm +++ b/src/modules/punk/aliascore-999999.0a1.0.tm @@ -103,7 +103,9 @@ tcl::namespace::eval punk::aliascore { #use absolute ns ie must be prefixed with :: #single element commands are imported if source command already exists, otherwise aliased. multi element commands are aliased - #functions must be in export list of their source namespace + #functions should generally be covered by one of the export patterns of their source namespace + # - if they are not - e.g (separately loaded ensemble command ?) + # the aliascore::init will temporarily extend the exports list to do the import, and then reset the exports to how they were. set aliases [tcl::dict::create\ val ::punk::pipe::val\ aliases ::punk::lib::aliases\ @@ -122,8 +124,8 @@ tcl::namespace::eval punk::aliascore { stripansi ::punk::ansi::ansistrip\ ansiwrap ::punk::ansi::ansiwrap\ colour ::punk::console::colour\ - ansi ::punk::console::ansi\ color ::punk::console::colour\ + ansi ::punk::console::ansi\ a? ::punk::console::code_a?\ A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ @@ -132,6 +134,7 @@ tcl::namespace::eval punk::aliascore { A {::punk::console::code_a forcecolour}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ + config ::punk::config\ ] #*** !doctools @@ -153,6 +156,35 @@ tcl::namespace::eval punk::aliascore { # return "ok" #} + proc _is_exported {ns cmd} { + set exports [::tcl::namespace::eval $ns [list namespace export]] + set is_exported 0 + foreach p $exports { + if {[string match $p $cmd]} { + set is_exported 1 + break + } + } + return $is_exported + } + + #_nsprefix accepts entire command - not just an existing namespace for which we want the parent + proc _nsprefix {{nspath {}}} { + #maintenance: from punk::ns::nsprefix - (without unnecessary nstail) + #normalize the common case of :::: + set nspath [string map {:::: ::} $nspath] + set rawprefix [string range $nspath 0 end-[string length [namespace tail $nspath]]] + if {$rawprefix eq "::"} { + return $rawprefix + } else { + if {[string match *:: $rawprefix]} { + return [string range $rawprefix 0 end-2] + } else { + return $rawprefix + } + } + } + #todo - options as to whether we should raise an error if collisions found, undo aliases etc? proc init {args} { set defaults {-force 0} @@ -195,6 +227,7 @@ tcl::namespace::eval punk::aliascore { error "punk::aliascore::init declined to create any aliases or imports because -force == 0 and conflicts found:$conflicts" } + set failed [list] set tempns ::temp_[info cmdcount] ;#temp ns for renames dict for {a cmd} $aliases { #puts "aliascore $a -> $cmd" @@ -206,16 +239,36 @@ tcl::namespace::eval punk::aliascore { } else { if {[tcl::info::commands $cmd] ne ""} { #todo - ensure exported? noclobber? - if {[tcl::namespace::tail $a] eq [tcl::namespace::tail $cmd]} { + set container_ns [_nsprefix $cmd] + set cmdtail [tcl::namespace::tail $cmd] + set was_exported 1 ;#assumption + if {![_is_exported $container_ns $cmdtail]} { + set was_exported 0 + set existing_exports [tcl::namespace::eval $container_ns [list ::namespace export]] + tcl::namespace::eval $container_ns [list ::namespace export $cmdtail] + } + if {[tcl::namespace::tail $a] eq $cmdtail} { #puts stderr "importing $cmd" - tcl::namespace::eval :: [list namespace import $cmd] + try { + tcl::namespace::eval :: [list ::namespace import $cmd] + } trap {} {emsg eopts} { + lappend failed [list alias $a target $cmd errormsg $emsg] + } } else { #target command name differs from exported name #e.g stripansi -> punk::ansi::ansistrip #import and rename #puts stderr "importing $cmd (with rename to ::$a)" - tcl::namespace::eval $tempns [list namespace import $cmd] - catch {rename ${tempns}::[namespace tail $cmd] ::$a} + try { + tcl::namespace::eval $tempns [list ::namespace import $cmd] + } trap {} {emsg eopst} { + lappend failed [list alias $a target $cmd errormsg $emsg] + } + catch {rename ${tempns}::$cmdtail ::$a} + } + #restore original exports + if {!$was_exported} { + tcl::namespace::eval $container_ns [list ::namespace export -clear {*}$existing_exports] } } else { interp alias {} $a {} {*}$cmd @@ -223,7 +276,7 @@ tcl::namespace::eval punk::aliascore { } } #tcl::namespace::delete $tempns - return [dict create aliases [dict keys $aliases] unchanged $ignore_aliases changed $conflicts] + return [dict create aliases [dict keys $aliases] existing $existing ignored $ignore_aliases changed $conflicts failed $failed] } diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index c48ce5ee..ccfa009c 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -3357,9 +3357,20 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu lappend PUNKARGS [list { @id -id ::punk::ansi::ansiwrap @cmd -name punk::ansi::ansiwrap -help\ - "Wrap a string with ANSI codes from + {Wrap a string with ANSI codes from supplied codelist(s) followed by trailing - ANSI reset. + ANSI reset. The wrapping is done such that + after every reset in the supplied text, the + default goes back to the supplied codelist. + e.g1 in the following + ansiwrap red bold "rrr[a+ green]ggg[a]rrr" + both strings rrr will be red & bold + + e.g2 bolding and underlining specific text whilst dimming the rest + ansiwrap dim [string map [list test [ansiwrap bold underline test]] "A test string"] + + e.g3 reverse render a complex ansi substring + ansiwrap reverse [textblock::periodic] Codes are numbers or strings as indicated in the output of the colour information @@ -3372,41 +3383,172 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu For finer control use the a+ and a functions eg - set x \"[a+ red]text [a+ bold]etc[a]\" - " + set x "[a+ red]text [a+ bold]etc[a]" + } @leaders -min 0 -max -1 codelist -multiple 1 -default {} -type list -help\ "ANSI names/ints as understood by 'a?' (Not actual ANSI as output by a+) These can be supplied individually or as a list or lists" + @opts + -rawansi -type ansi -default "" + -resetcodes -type list -default {reset} + -rawresets -type ansi -default "" + -fullcodemerge -type boolean -default 0 -help\ + "experimental" + -overridecodes -type list -default {} @values -min 1 -max 1 text -type string -help\ "String to wrap with ANSI (SGR)" }] - #proc ansiwrap {codes text} { - # return [a {*}$codes]$text[a] - #} - proc ansiwrap2 {args} { - set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] - set codelists [dict get $argd leaders codelist] - set text [dict get $argd values text] - set codes [concat {*}$codelists] ;#flatten - return [a {*}$codes]$text[a] - } proc ansiwrap {args} { if {[llength $args] < 1} { - #minimal args parsing - unhappy path only + #throw to args::parse to get friendly error/usage display punk::args::parse $args withid ::punk::ansi::ansiwrap return } - set text [lindex $args end] - set codelists [lrange $args 0 end-1] + #we know there are no valid codes that start with - + if {[lsearch [lrange $args 0 end-1] -*] == -1} { + #no opts + set text [lindex $args end] + set codelists [lrange $args 0 end-1] + set R [a] ;#plain ansi reset + set rawansi "" + set rawresets "" + set fullmerge 0 + set overrides "" + } else { + set argd [punk::args::parse $args withid ::punk::ansi::ansiwrap] + lassign [dict values $argd] leaders opts values received solos + set codelists [dict get $leaders codelist] + set text [dict get $values text] + set rawansi [dict get $opts -rawansi] + set R [a+ {*}[dict get $opts -resetcodes]] + set rawresets [dict get $opts -rawresets] + set fullmerge [dict get $opts -fullcodemerge] + set overrides [punk::ansi::ta::get_codes_single [a+ {*}[dict get $opts -overridecodes]]] + } + + #note that the result of any sgr_merge or sgr_merge_singles is not necessarily a single Ansi escape sequence. + #there can be SGR unmergeables (due to enhanced underlines) as well as non SGR codes set codes [concat {*}$codelists] ;#flatten - return [a {*}$codes]$text[a] - } + set base [a+ {*}$codes] + if {$rawansi ne ""} { + set rawcodes [punk::ansi::ta::get_codes_single $rawansi] ;#caller may have supplied as [a+ xxx][a+ yyy] + if {$fullmerge} { + set base [punk::ansi::codetype::sgr_merge [list $base {*}$rawcodes]] + } else { + set base [punk::ansi::codetype::sgr_merge_singles [list $base {*}$rawcodes]] + } + } + if {$rawresets ne ""} { + set rawresetcodes [punk::ansi::ta::get_codes_single $rawresets] + if {$fullmerge} { + set R [punk::ansi::codetype::sgr_merge [list $R {*}$rawresetcodes]] + } else { + set R [punk::ansi::codetype::sgr_merge_singles [list $R {*}$rawresetcodes]] + } + } + set codestack [list] + if {[punk::ansi::ta::detect $text]} { + set emit "" + set parts [punk::ansi::ta::split_codes $text] + foreach {pt code} $parts { + switch -- [llength $codestack] { + 0 { + append emit $base$pt$R + } + 1 { + if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} { + append emit $base$pt$R + set codestack [list] + } else { + #append emit [lindex $o_codestack 0]$pt + if {$fullmerge} { + append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R + } else { + append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R + } + } + } + default { + if {$fullmerge} { + append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R + } else { + append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R + } + } + } + #parts ends on a pt - last code always empty string + if {$code ne ""} { + set c1c2 [tcl::string::range $code 0 1] + set leadernorm [tcl::string::range [tcl::string::map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] + switch -- $leadernorm { + 7CSI - 8CSI { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set codestack [list $code] + } elseif {[punk::ansi::codetype::is_sgr $code]} { + #todo - make caching is_sgr method + set dup_posns [lsearch -all -exact $codestack $code] + set codestack [lremove $codestack {*}$dup_posns] + lappend codestack $code + } else { + } + } + 7GFX { + switch -- [tcl::string::index $code 2] { + "0" { + set o_gx_state on + } + "B" { + set o_gx_state off + } + } + } + default { + #other ansi codes + } + } + append emit $code + } + } + return $emit$R + } else { + return $base$text$R + } + } + proc ansiwrap_naive {codes text} { + return [a_ {*}$codes]$text[a] + } + + #a silly trick... temporary? probably - todo - tests and work on sgr_merge + sgr_merge_singles before relying on this + #when we use sgr_merge_singles on a 'single' containing a non SGR code e.g [5h (inverse) it puts this code at the end of the list + #furthermore - it carries any SGR codes along with it (Can/should we rely on this behaviour??? probably not) REVIEW + #P% ansistring VIEW $s1 + #- ␛[31m␛[?5h + #P% ansistring VIEW [punk::ansi::codetype::sgr_merge_singles [list $s1 [a+ cyan]]] + #- ␛[36m␛[31m␛[?5h + #P% ansistring VIEW [punk::ansi::codetype::sgr_merge [list $s1 [a+ cyan]]] + #- ␛[36m␛[?5h + #we can use this trick to override background and/or foreground colours using ansiwrap - which uses sgr_merge_singles + #Note - this trick is not composable - e.g ansioverride Red [ansiioverride Green [textblock::periodic]] doesn't work as expected. + proc ansioverride2 {args} { + set text [lindex $args end] + set codes [lrange $args 0 end-1] + ansiwrap {*}$codes -rawansi [punk::ansi::enable_inverse] -rawresets [punk::ansi::disable_inverse] $text + } + proc ansireverse {text} { + ansioverride2 normal reverse $text + } proc get_code_name {code} { #*** !doctools @@ -4491,6 +4633,77 @@ tcl::namespace::eval punk::ansi { return 0 } } + + #e.g has_any_effective $str bg fg + proc has_any_effective {str args} { + set singlecodes [punk::ansi::ta::get_codes_single $str] + set mergeinfo [punk::ansi::codetype::sgr_merge_singles $singlecodes -info 1] + foreach t $args { + switch -- $t { + sgr - unmergeable - othercodes { + if {[dict get $mergeinfo $t] ne ""} { + return 1 + } + } + intensity - italic - underline - underextended - blink - reverse - hide - strike - font - gothic - doubleunderline + - proportional - frame_or_circle - ideogram_underline - ideogram_doubleunderline - ideogram_clear - overline - underlinecolour - superscript - subscript + - nosupersub - fg - bg { + if {[dict get $mergeinfo codestate $t] ne ""} { + return 1 + } + } + bold { + if {[dict get $mergeinfo codestate intensity] eq "1"} { + return 1 + } + } + dim { + if {[dict get $mergeinfo codestate intensity] eq "2"} { + return 1 + } + } + default { + error "punk::ansi::ta::has_any_effective invalid type '$t' specified" + } + } + } + return 0 + } + proc has_all_effective {str args} { + set singlecodes [punk::ansi::ta::get_codes_single $str] + set mergeinfo [punk::ansi::codetype::sgr_merge_singles $singlecodes -info 1] + foreach t $args { + switch -- $t { + sgr - unmergeable - othercodes { + if {[dict get $mergeinfo $t] eq ""} { + return 0 + } + } + intensity - italic - underline - underextended - blink - reverse - hide - strike - font - gothic - doubleunderline + - proportional - frame_or_circle - ideogram_underline - ideogram_doubleunderline - ideogram_clear - overline - underlinecolour - superscript - subscript + - nosupersub - fg - bg { + if {[dict get $mergeinfo codestate $t] eq ""} { + return 0 + } + } + bold { + if {[dict get $mergeinfo codestate intensity] ne "1"} { + return 0 + } + } + dim { + if {[dict get $mergeinfo codestate intensity] ne "2"} { + return 0 + } + } + default { + error "punk::ansi::ta::has_any_effective invalid type '$t' specified" + } + } + } + return 1 + } + proc is_gx {code} { #g0 {(?:\x1b\(0)(?:(?!\x1b\(B).)*\x1b\(B} #g1 {(?:\x1b\)0)(?:(?!\x1b\)B).)*\x1b\)B} @@ -4513,6 +4726,7 @@ tcl::namespace::eval punk::ansi { set codestate_empty [tcl::dict::create] tcl::dict::set codestate_empty rst "" ;#0 (or empty) tcl::dict::set codestate_empty intensity "" ;#1 bold, 2 dim, 22 normal + tcl::dict::set codestate_empty shadowed "" ; tcl::dict::set codestate_empty italic "" ;#3 on 23 off tcl::dict::set codestate_empty underline "" ;#4 on 24 off diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 46e0b453..74de69f7 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -3226,7 +3226,36 @@ tcl::namespace::eval punk::args { form1: parse $arglist ?-flag val?... withid $id form2: parse $arglist ?-flag val?... withdef $def ?$def? - see punk::args::define" + see punk::args::define + + Returns a dict of information regarding the parsed arguments + example of basic usage for single option only: + punk::args::define { + @id -id ::myns::myfunc + @cmd -name myns::myfunc + @leaders -min 0 -max 0 + @opts + -configfile -type existingfile + #type none makes it a solo flag + -verbose -type none + @values -min 0 -max 0 + } + proc myfunc {args} { + set argd [punk::args::parse $args withid ::myns::myfunc] + lassign [dict values $argd] leaders opts values received solos + if {[dict exists $received] -configfile} { + puts \"have option for existing file [dict get $opts -configfile]\" + } + } + The leaders, opts, values keys in the parse result dict are proper dicts. + The received key is dict-like but can have repeated keys for arguments than can + accept multiples. The value for each received element is the ordinal position. + The solos key refers to a list of solo flags received (those specified with + -type none). This is generally only useful to assist in passing arguments on + to another procedure which also requires solos, because the opts dict contains + solo flags with a 1 value or a list of 1's if it was a solo with -multiple true + specified. + " @form -form {withid withdef} @leaders -min 1 -max 1 arglist -type list -optional 0 -help\ diff --git a/src/modules/punk/args/tclcore-999999.0a1.0.tm b/src/modules/punk/args/tclcore-999999.0a1.0.tm index 6141d7e7..6e7521a9 100644 --- a/src/modules/punk/args/tclcore-999999.0a1.0.tm +++ b/src/modules/punk/args/tclcore-999999.0a1.0.tm @@ -750,26 +750,6 @@ tcl::namespace::eval punk::args::tclcore { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ############################################################################################################################################################ - # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - punk::args::define { - @id -id ::lrange - @cmd -name "builtin: lrange" -help\ - "return one or more adjacent elements from a list. - The new list returned consists of elements first through last, inclusive. - The index values first and last are interpreted the same as index values - for the command 'string index', supporting simple index arithmetic and - indices relative to the end of the list. - e.g lrange {a b c} 0 end-1 - " - @values -min 3 -max 3 - list -type list -help\ - "tcl list as a value" - first -help\ - "index expression for first element" - last -help\ - "index expression for last element" - } "@doc -name Manpage: -url [manpage_tcl lrange]" - # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -802,26 +782,60 @@ tcl::namespace::eval punk::args::tclcore { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { - @id -id ::lremove - @cmd -name "builtin: lremove" -help\ - "Remove elements from a list by index - lremove returns a new list formed by simultaneously removing zero or - more elements of list at each of the indices given by an arbitrary - number of index arguments. The indices may be in any order and may be - repeated; the element at index will only be removed once. The index - values are interpreted the same as index values for the command - 'string index', supporting simple index arithmetic and indices relative - to the end of the list. 0 refers to the first element of the list, and - end refers to the last element of the list." + @id -id ::lindex + @cmd -name "builtin: lindex" -help\ + "Retrieve an element from a list + " @values -min 1 -max -1 list -type list -help\ "tcl list as a value" - index -type indexexpression -multiple 1 -optional 1 + index -type indexexpression -multiple 1 -optional 1 -help\ + "When no index is supplied or a single index is supplied as an empty list, + the value of the entire list is simply returned. + + If a single index is supplied and is a list of indices - this list is used + as a sequence of nested indices. + The command, + lindex $a 1 2 3 + or + lindex $l {1 2 3} + is synonymous with + lindex [lindex [lindex $a 1] 2] 3 + + When presented with a single indes, the lindex command treats list as a Tcl list + and returns the index'th element from it (0 refers to the first element of the + list). In extracting the element, lindex observes the same rules concerning + braces and quotes and backslashes as the Tcl command interpreter; however, + variable substution and command substitution do not occur. If index is negative + or greater than or equal to the number of elements in 'list', then an empty + string is returned. The interpretation of each simple index value is the same + as for the command 'string index', supporting simple index arithmetic and + indices relative to the end of the list. - @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} - } "@doc -name Manpage: -url [manpage_tcl lremove]" + If additional index arguments are supplied, then each argument is used in turn + to select an element from the previous indexing operation, allowing the script + to select elements from sublists." + } "@doc -name Manpage: -url [manpage_tcl lindex]" # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::list + @cmd -name "builtin: list" -help\ + "Create a list + + This command returns a list comprised of all the args, or an empty string + if no args are specified. Braces and backslashes get added as necessary, + so that the lindex command may be used on the result to re-extract the + original arguments, and also so that eval may be used to execute the + resulting list, with arg1 comprising the command's name and the other args + comprising its arguments. List produces slightly different results than + concat: concat removes one level of grouping before forming the list, + while list works directly from the original arguments." + @values -min 0 -max -1 + arg -type any -optional 1 -multiple 1 + } "@doc -name Manpage: -url [manpage_tcl list]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lpop @@ -842,6 +856,51 @@ tcl::namespace::eval punk::args::tclcore { previous indexing operation, allowing the script to remove elements in sublists, similar to lindex and lset." } "@doc -name Manpage: -url [manpage_tcl lpop]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lrange + @cmd -name "builtin: lrange" -help\ + "return one or more adjacent elements from a list. + The new list returned consists of elements first through last, inclusive. + The index values first and last are interpreted the same as index values + for the command 'string index', supporting simple index arithmetic and + indices relative to the end of the list. + e.g lrange {a b c} 0 end-1 + " + @values -min 3 -max 3 + list -type list -help\ + "tcl list as a value" + first -help\ + "index expression for first element" + last -help\ + "index expression for last element" + } "@doc -name Manpage: -url [manpage_tcl lrange]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + punk::args::define { + @id -id ::lremove + @cmd -name "builtin: lremove" -help\ + "Remove elements from a list by index + lremove returns a new list formed by simultaneously removing zero or + more elements of list at each of the indices given by an arbitrary + number of index arguments. The indices may be in any order and may be + repeated; the element at index will only be removed once. The index + values are interpreted the same as index values for the command + 'string index', supporting simple index arithmetic and indices relative + to the end of the list. 0 refers to the first element of the list, and + end refers to the last element of the list." + @values -min 1 -max -1 + list -type list -help\ + "tcl list as a value" + index -type indexexpression -multiple 1 -optional 1 + + @seealso -commands {list lappend lassign ledit lindex linsert llength lmap lpop lrange lrepeat lreplace lreverse lsearch lseq lset lsort} + } "@doc -name Manpage: -url [manpage_tcl lremove]" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- punk::args::define { @id -id ::lrange diff --git a/src/modules/punk/basictelnet-999999.0a1.0.tm b/src/modules/punk/basictelnet-999999.0a1.0.tm index 6af02972..f2392b62 100644 --- a/src/modules/punk/basictelnet-999999.0a1.0.tm +++ b/src/modules/punk/basictelnet-999999.0a1.0.tm @@ -478,6 +478,13 @@ namespace eval punk::basictelnet { set tmode [dict get $argd opts -mode] set mouse [dict get $argd opts -mouse] + if {[info commands ::colour] ne ""} { + #The ansiwrap filter on stdout/stderr slows rendering significantly e.g on max headroom ansi vid at server: 1984.ws + #TODO - just disable the channel filters - not all ansi colour. + set priorcolourstate [::colour] + ::colour off + } + #todo - check for vt52 and don't try DEC queries if {[info commands ::mode] eq ""} { puts stderr "::mode command for terminal is unavailable - please set line/raw mode manually on the terminal" @@ -540,6 +547,12 @@ namespace eval punk::basictelnet { vwait ::punk::basictelnet::closed($sock) unset closed($sock) chan conf stdin -blocking 1 + + + if {[info commands ::colour] ne ""} { + ::colour $priorcolourstate + } + if {[info commands ::mode] ne ""} { ::mode $priormode } diff --git a/src/modules/punk/config-0.1.tm b/src/modules/punk/config-0.1.tm index 5532cb80..e278d99f 100644 --- a/src/modules/punk/config-0.1.tm +++ b/src/modules/punk/config-0.1.tm @@ -1,23 +1,109 @@ tcl::namespace::eval punk::config { - variable loaded - variable startup ;#include env overrides - variable running + variable configdata [dict create] ;#key on config names. At least default, startup, running + + #variable startup ;#include env overrides + #variable running + variable punk_env_vars variable other_env_vars variable vars namespace export {[a-z]*} + namespace ensemble create + namespace eval punk {namespace export config} + + proc _homedir {} { + if {[info exists ::env(HOME)]} { + set home [file normalize $::env(HOME)] + } else { + #not available on 8.6? ok will error out here. + set home [file tildeexpand ~] + } + return $home + } + + lappend PUNKARGS [list { + @id -id ::punk::config::dir + @cmd -name punk::config::dir -help\ + "Get the path for the default config folder + Config files are in toml format. + + The XDG_CONFIG_HOME env var is the preferred + choice of location. + A folder under the user's home directory, + at .config/punk/shell is chosen if + XDG_CONFIG_HOME is not configured. + " + @leaders -min 0 -max 0 + @opts + -quiet -type none -help\ + "Suppress warning given when the folder does + not yet exist" + @values -min 0 -max 0 + }] + proc dir {args} { + if {"-quiet" in $args} { + set be_quiet [dict exists $received -quiet] + } + + set was_noisy 0 + + set config_home [punk::config::configure running xdg_config_home] + + set config_dir [file join $config_home punk shell] + + if {!$be_quiet && ![file exists $config_dir]} { + set msg "punk::shell data storage folder at $config_dir does not yet exist." + puts stderr $msg + set was_noisy 1 + } + + if {!$be_quiet && $was_noisy} { + puts stderr "punk::config::dir - call with -quiet option to suppress these messages" + } + return $config_dir + + #if {[info exists ::env(XDG_CONFIG_HOME)]} { + # set config_home $::env(XDG_CONFIG_HOME) + #} else { + # set config_home [file join [_homedir] .config] + # if {!$be_quiet} { + # puts stderr "Environment variable XDG_CONFIG_HOME does not exist - consider setting it if $config_home is not a suitable location" + # set was_noisy 1 + # } + #} + #if {!$be_quiet && ![file exists $config_home]} { + # #parent folder for 'punk' config dir doesn't exist + # set msg "configuration location (XDG_CONFIG_HOME or ~/.config) $config_home does not yet exist" + # append msg \n " - please create it and/or set XDG_CONFIG_HOME env var." + # puts stderr $msg + # set was_noisy 1 + #} + #set config_dir [file join $config_home punk shell] + #if {!$be_quiet && ![file exists $config_dir]} { + # set msg "punk::shell data storage folder at $config_dir does not yet exist." + # append msg \n " It will be created if api_context_save is called without specifying an alternate location." + # puts stderr $msg + # set was_noisy 1 + #} + #if {!$be_quiet && $was_noisy} { + # puts stderr "punk::config::dir - call with -quiet option to suppress these messages" + #} + #return [file join $configdir config.toml] + } #todo - XDG_DATA_HOME etc #https://specifications.freedesktop.org/basedir-spec/latest/ # see also: http://hiphish.github.io/blog/2020/08/30/dotfiles-were-a-mistake/ proc init {} { - variable defaults - variable startup - variable running + variable configdata + + #variable defaults + #variable startup + #variable running variable punk_env_vars variable punk_env_vars_config variable other_env_vars @@ -108,12 +194,14 @@ tcl::namespace::eval punk::config { #we have a choice of LOCALAPPDATA vs APPDATA (local to machine vs potentially roaming/redirected in a corporate environment) #using the roaming location should not impact users who aren't using a domain controller but is potentially much more convenient for those who do. if {[info exists ::env(APPDATA)]} { + #Typical existing/default value for env(APPDATA) on windows is c:\Users\\AppData\Roaming set default_xdg_config_home $::env(APPDATA) - set default_xdg_data_home $::env(APPDATA) } #The xdg_cache_home should be kept local if {[info exists ::env(LOCALAPPDATA)]} { + #Typical existing/default value for env(APPDATA) on windows is c:\Users\\AppData\Local + set default_xdg_data_home $::env(LOCALAPPDATA) set default_xdg_cache_home $::env(LOCALAPPDATA) set default_xdg_state_home $::env(LOCALAPPDATA) } @@ -133,10 +221,10 @@ tcl::namespace::eval punk::config { } } - set defaults [dict create\ + dict set configdata defaults [dict create\ apps $default_apps\ - config ""\ - configset ".punkshell"\ + config "startup"\ + configset "main"\ scriptlib $default_scriptlib\ color_stdout $default_color_stdout\ color_stdout_repl $default_color_stdout_repl\ @@ -160,7 +248,7 @@ tcl::namespace::eval punk::config { posh_themes_path ""\ ] - set startup $defaults + dict set configdata startup [dict get $configdata defaults] #load values from saved config file - $xdg_config_home/punk/punk.config ? #typically we want env vars to override the stored config - as env vars conventionally used on some commandlines. #that's possibly ok for the PUNK_ vars @@ -219,9 +307,9 @@ tcl::namespace::eval punk::config { lappend final $p } } - tcl::dict::set startup $varname $final + tcl::dict::set configdata startup $varname $final } else { - tcl::dict::set startup $varname $f + tcl::dict::set configdata startup $varname $f } } } @@ -273,29 +361,46 @@ tcl::namespace::eval punk::config { lappend final $p } } - tcl::dict::set startup $varname $final + tcl::dict::set configdata startup $varname $final } else { - tcl::dict::set startup $varname $f + tcl::dict::set configdata startup $varname $f } } } } + set config_home [dict get $configdata startup xdg_config_home] + + if {![file exists $config_home]} { + puts stderr "punk::config::init creating punk shell config dir: $config_home" + if {[catch {file mkdir $config_home} errM]} { + puts stderr "punk::config::init failed to create dir at $config_home\n$errM" + } + } + + set configset [dict get $configdata defaults configset] + set config [dict get $configdata defaults config] + + set startupfile [file join $config_home $configset $config.toml] + if {![file exists $startupfile]} { + puts stderr "punk::config::init creating punk shell config file: $config for configset: $configset" + puts stderr "(todo)" + } #unset -nocomplain vars #todo set running [tcl::dict::create] - set running [tcl::dict::merge $running $startup] + dict set configdata running [tcl::dict::merge $running [dict get $configdata startup]] } - init #todo proc Apply {config} { + variable configdata puts stderr "punk::config::Apply partially implemented" set configname [string map {-config ""} $config] if {$configname in {startup running}} { - upvar ::punk::config::$configname applyconfig + set applyconfig [dict get $configdata $configname] if {[dict exists $applyconfig auto_noexec]} { set auto [dict get $applyconfig auto_noexec] @@ -315,67 +420,128 @@ tcl::namespace::eval punk::config { } return "apply done" } - Apply startup #todo - consider how to divide up settings, categories, 'devices', decks etc proc get_running_global {varname} { - variable running + variable configdata + set running [dict get $configdata running] if {[dict exists $running $varname]} { return [dict get $running $varname] } error "No such global configuration item '$varname' found in running config" } proc get_startup_global {varname} { - variable startup + variable configdata + set startup [dict get $configdata startup] if {[dict exists $startup $varname]} { return [dict get $startup $varname] } error "No such global configuration item '$varname' found in startup config" } - proc get {whichconfig {globfor *}} { - variable startup - variable running + lappend PUNKARGS [list { + @id -id ::punk::config::get + @cmd -name punk::config::get -help\ + "Get configuration values from a config. + Accepts globs eg XDG*" + @leaders -min 1 -max 1 + whichconfig -type string -choices {config startup-configuration running-configuration} + @values -min 0 -max -1 + globkey -type string -default * -optional 1 -multiple 1 + }] + proc get {args} { + set argd [punk::args::parse $args withid ::punk::config::get] + lassign [dict values $argd] leaders opts values received solos + set whichconfig [dict get $leaders whichconfig] + set globs [dict get $values globkey] ;#list + + variable configdata + switch -- $whichconfig { - config - startup - startup-config - startup-configuration { + config - startup-configuration { + #review 'config' ?? #show *startup* config - different behaviour may be confusing to those used to router startup and running configs - set configdata $startup + set configrecords [dict get $configdata startup] } - running - running-config - running-configuration { - set configdata $running + running-configuration { + set configrecords [dict get $configdata running] } default { error "Unknown config name '$whichconfig' - try startup or running" } } - if {$globfor eq "*"} { - return $configdata + if {"*" in $globs} { + return $configrecords } else { - set keys [dict keys $configdata [string tolower $globfor]] + set keys [list] + foreach g $globs { + lappend keys {*}[dict keys $configrecords [string tolower $g]] ;#review tolower? + } + set filtered [dict create] foreach k $keys { - dict set filtered $k [dict get $configdata $k] + dict set filtered $k [dict get $configrecords $k] } return $filtered } } + lappend PUNKARGS [list { + @id -id ::punk::config::configure + @cmd -name punk::config::configure -help\ + "Get/set configuration values from a config" + @leaders -min 1 -max 1 + whichconfig -type string -choices {defaults startup-configuration running-configuration} + @values -min 0 -max 2 + key -type string -optional 1 + newvalue -optional 1 + }] proc configure {args} { - set argdef { - @id -id ::punk::config::configure - @cmd -name punk::config::configure -help\ - "UNIMPLEMENTED" - @values -min 1 -max 1 - whichconfig -type string -choices {startup running stop} + set argd [punk::args::parse $args withid ::punk::config::configure] + lassign [dict values $argd] leaders opts values received solos + set whichconfig [dict get $argd leaders whichconfig] + variable configdata + if {"running" ni [dict keys $configdata]} { + init + Apply startup } - set argd [punk::args::get_dict $argdef $args] - return "unimplemented - $argd" + switch -- $whichconfig { + defaults { + set configrecords [dict get $configdata defaults] + } + startup-configuration { + set configrecords [dict get $configdata startup] + } + running-configuration { + set configrecords [dict get $configdata running] + } + } + if {![dict exists $received key]} { + return $configrecords + } + set key [dict get $values key] + if {![dict exists $received newvalue]} { + return [dict get $configrecords $key] + } + error "setting value not implemented" } - proc show {whichconfig {globfor *}} { + lappend PUNKARGS [list { + @dynamic + @id -id ::punk::config::show + @cmd -name punk::config::get -help\ + "Display configuration values from a config. + Accepts globs eg XDG*" + @leaders -min 1 -max 1 + }\ + {${[punk::args::resolved_def -types leaders ::punk::config::get]}}\ + "@values -min 0 -max -1"\ + {${[punk::args::resolved_def -types values ::punk::config::get]}}\ + ] + proc show {args} { #todo - tables for console - set configdata [punk::config::get $whichconfig $globfor] - return [punk::lib::showdict $configdata] + set configrecords [punk::config::get {*}$args] + return [punk::lib::showdict $configrecords] } @@ -459,27 +625,35 @@ tcl::namespace::eval punk::config { ::tcl::namespace::eval punk::config { #todo - something better - 'previous' rather than reverting to startup proc channelcolors {{onoff {}}} { - variable running - variable startup + variable configdata + #variable running + #variable startup if {![string length $onoff]} { - return [list stdout [dict get $running color_stdout] stderr [dict get $running color_stderr]] + return [list stdout [dict get $configdata running color_stdout] stderr [dict get $configdata running color_stderr]] } else { if {![string is boolean $onoff]} { error "channelcolors: invalid value $onoff - expected boolean: true|false|on|off|1|0|yes|no" } if {$onoff} { - dict set running color_stdout [dict get $startup color_stdout] - dict set running color_stderr [dict get $startup color_stderr] + dict set configdata running color_stdout [dict get $startup color_stdout] + dict set configdata running color_stderr [dict get $startup color_stderr] } else { - dict set running color_stdout "" - dict set running color_stderr "" + dict set configdata running color_stdout "" + dict set configdata running color_stderr "" } } - return [list stdout [dict get $running color_stdout] stderr [dict get $running color_stderr]] + return [list stdout [dict get $configdata running color_stdout] stderr [dict get $configdata running color_stderr]] } + } +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::config +} + + package provide punk::config [tcl::namespace::eval punk::config { variable version set version 0.1 diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 63bd422e..8c85abaf 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -584,10 +584,10 @@ namespace eval punk::console { channel's response to a query placed on the output channel. Usually this means a write to stdout with a response on stdin. - This function uses a 'chan event' read handler function + This function uses a 'chan event' read handler function ::punk::console::internal::ansi_response_handler_regex to read the input channel character by character to ensure it - doesn't overconsume input. + doesn't overconsume input. It can run cooperatively with the punk::repl stdin reader or other readers if done carefully. @@ -609,7 +609,7 @@ namespace eval punk::console { "dict with keys prefix,response,payload,all" } -help\ "Return format" - + -terminal -default {stdin stdout} -type list -help\ "terminal (currently list of in/out channels) (todo - object?)" -expected_ms -default 100 -type integer -help\ diff --git a/src/modules/punk/mod-0.1.tm b/src/modules/punk/mod-0.1.tm index 26ed2f2e..8f1ba266 100644 --- a/src/modules/punk/mod-0.1.tm +++ b/src/modules/punk/mod-0.1.tm @@ -33,8 +33,7 @@ namespace eval punk::mod::cli { return $basehelp } proc getraw {appname} { - upvar ::punk::config::running running_config - set app_folders [dict get $running_config apps] + set app_folders [punk::config::configure running apps] #todo search each app folder set bases [::list] set versions [::list] @@ -86,8 +85,7 @@ namespace eval punk::mod::cli { } proc list {{glob *}} { - upvar ::punk::config::running running_config - set apps_folder [dict get $running_config apps] + set apps_folder [punk::config::configure running apps] if {[file exists $apps_folder]} { if {[file exists $apps_folder/$glob]} { #tailcall source $apps_folder/$glob/main.tcl diff --git a/src/modules/punk/netbox-999999.0a1.0.tm b/src/modules/punk/netbox-999999.0a1.0.tm index e55cabe1..78ff9e44 100644 --- a/src/modules/punk/netbox-999999.0a1.0.tm +++ b/src/modules/punk/netbox-999999.0a1.0.tm @@ -562,10 +562,19 @@ tcl::namespace::eval punk::netbox { used when an explicit path is not given by the caller to the api_context load/save functions. This file is in toml format. + + On any platform the XDG_DATA_HOME env var + can be used to override the location, but + on Windows the LOCALAPPDATA env var will + specifiy the location if XDG_DATA_HOME is + not set. + Interfacing with a proper secret store + should be considered as an alternative. + + On non Windows platforms: The XDG_DATA_HOME env var is the preferred - choice of location - considered more secure - than XDG_CONFIG_HOME, although not as good - as a proper secret store. + choice of location - considered slightly more + secure than XDG_CONFIG_HOME. A folder under the user's home directory, at .local/share/punk/netbox is chosen if XDG_DATA_HOME is not configured. @@ -586,16 +595,20 @@ tcl::namespace::eval punk::netbox { if {[info exists ::env(XDG_DATA_HOME)]} { set data_home $::env(XDG_DATA_HOME) } else { - set data_home [file join [_homedir] .local share] - if {!$be_quiet} { - puts stderr "Environment variable XDG_DATA_HOME does not exist - consider setting it if $data_home is not a suitable location" - set was_noisy 1 + if {$::tcl_platform(platform) eq "windows"} { + set data_home $::env(LOCALAPPDATA) + } else { + set data_home [file join [_homedir] .local share] + if {!$be_quiet} { + puts stderr "Environment variable XDG_DATA_HOME does not exist - consider setting it if $data_home is not a suitable location" + set was_noisy 1 + } } } if {!$be_quiet && ![file exists $data_home]} { #parent folder for 'punk' config dir doesn't exist - set msg "configuration location (XDG_DATA_HOME or ~/.local/share) $data_home does not yet exist" - append msg \n " - please create it and/or set XDG_DATA_HOME env var." + set msg "configuration location XDG_DATA_HOME or ~/.local/share (or LOCALAPPDATA on windows) at path '$data_home' does not yet exist" + append msg \n " - please create it and/or set the appropriate env var." puts stderr $msg set was_noisy 1 } diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index f3d3cdf6..b6999d15 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -375,7 +375,9 @@ tcl::namespace::eval punk::ns { #This is because :x (or even just : ) can in theory be the name of a command and we may need to see it (although it is not a good idea) #and a namespace can exist with leading colon - but is even worse - as default Tcl commands will misreport e.g namespace current within namespace eval #The view is taken that a namespace with leading/trailing colons is so error-prone that even introspection is unreliable so we will rule that out. - # + # + #nsprefix is *somewhat* like 'namespace parent' execept that it is string based - ie no requirement for the namespaces to actually exist + # - this is an important usecase even if the handling of 'unwise' command names isn't so critical. proc nsprefix {{nspath ""}} { #normalize the common case of :::: set nspath [string map {:::: ::} $nspath] @@ -394,10 +396,12 @@ tcl::namespace::eval punk::ns { #namespace tail which handles :::cmd ::x:::y ::x:::/y etc in a specific manner for string processing #review - consider making -strict raise an error for unexpected sequences such as :::: or any situation with more than 2 colons together. + #This is only necessary in the context of requirement to browse namespaces with 'unwisely' named commands + #For most purposes 'namespace tail' is fine. proc nstail {nspath args} { #normalize the common case of :::: set nspath [string map {:::: ::} $nspath] - set mapped [string map {:: \u0FFF} $nspath] + set mapped [string map {:: \u0FFF} $nspath] set parts [split $mapped \u0FFF] set defaults [list -strict 0] @@ -2018,7 +2022,7 @@ tcl::namespace::eval punk::ns { } proc arginfo {args} { lassign [dict values [punk::args::parse $args withid ::punk::ns::arginfo]] leaders opts values received - + set nscaller [uplevel 1 [list ::namespace current]] #review - setting this afterwards is an architecture smell - we should be able to override the default in the dynamic part #todo - enable retrieving by id just the record_opts part - so we can treat as a dict directly, as well as easily apply it as a different flag name. if {![dict exists $received -scheme]} { @@ -2081,16 +2085,18 @@ tcl::namespace::eval punk::ns { } } else { #namespace as relative to current doesn't seem to exist - #Tcl would also attempt to resolve as global + #Tcl would also attempt to resolve as global - #set numvals [expr {[llength $queryargs]+1}] + #set numvals [expr {[llength $queryargs]+1}] ##puts "THROWBACK: namespace eval :: [list punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$queryargs]" #return [namespace eval :: [list punk::ns::arginfo {*}[lrange $args 0 end-$numvals] $querycommand {*}$queryargs]] - return [namespace eval :: [list punk::ns::arginfo {*}$opts $querycommand {*}$queryargs]] + if {$nscaller ne "::"} { + return [namespace eval :: [list punk::ns::arginfo {*}$opts $querycommand {*}$queryargs]] + } + + set origin $querycommand + set resolved $querycommand - #set origin $querycommand - #set resolved $querycommand - } } } @@ -2098,7 +2104,7 @@ tcl::namespace::eval punk::ns { #check for a direct match first if {[info commands ::punk::args::id_exists] ne ""} { if {![llength $queryargs]} { - punk::args::update_definitions [list [namespace qualifiers $origin]] + punk::args::update_definitions [list [namespace qualifiers $origin]] if {[punk::args::id_exists $origin]} { return [uplevel 1 [list punk::args::usage {*}$opts $origin]] } diff --git a/src/modules/punk/repl-999999.0a1.0.tm b/src/modules/punk/repl-999999.0a1.0.tm index 21bf3ab7..2842c627 100644 --- a/src/modules/punk/repl-999999.0a1.0.tm +++ b/src/modules/punk/repl-999999.0a1.0.tm @@ -1722,7 +1722,8 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config # --- variable reading variable id_outstack - upvar ::punk::config::running running_config + #upvar ::punk::config::configdata configd + #set running_config [dict get $configd running] try { #catch {puts stderr "xx--->[rep $::arglej]"} @@ -2794,21 +2795,28 @@ namespace eval repl { interp eval code [list apply {docolour { #adjust channel transform stack if {!$docolour} { - set s [lindex $::codeinterp::outstack end] - if {$s ne ""} { - shellfilter::stack::remove stdout $s + set stackinfo [dict get [shellfilter::stack item stdout] stack] + set topstack [lindex $stackinfo 0] + if {[string match *::ansiwrap [dict get $topstack -transform]]} { + set sid [dict get $topstack -id] + shellfilter::stack::remove stdout $sid } - set s [lindex $::codeinterp::errstack end] - if {$s ne ""} { - shellfilter::stack::remove stderr $s + set stackinfo [dict get [shellfilter::stack item stderr] stack] + set topstack [lindex $stackinfo 0] + if {[string match *::ansiwrap [dict get $topstack -transform]]} { + set sid [dict get $topstack -id] + shellfilter::stack::remove stderr $sid } + } else { - set running_config $::punk::config::running - if {[string length [dict get $running_config color_stdout]]} { - lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + set configd $::punk::config::configdata + if {[string length [dict get $configd running color_stdout]]} { + #lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $configd running color_stdout]] } - if {[string length [dict get $running_config color_stderr]]} { - lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + if {[string length [dict get $configd running color_stderr]]} { + #lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $configd running color_stderr]] } } @@ -3273,12 +3281,12 @@ namespace eval repl { package require shellfilter ;#requires: shellthread,Thread apply {running_config { if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]] } if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]] } - }} $::punk::config::running + }} [punk::config::configure running] } errM]} { puts stderr "========================" @@ -3352,6 +3360,7 @@ namespace eval repl { #puts stderr ----- if {[catch { + package require punk::args package require punk::config package require punk::ns #puts stderr "loading natsort" @@ -3360,19 +3369,19 @@ namespace eval repl { package require natsort #catch {package require packageTrace} package require punk - package require punk::args + #package require punk::args package require punk::args::tclcore package require shellrun package require shellfilter #set running_config $::punk::config::running apply {running_config { if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]] } if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]] } - }} $::punk::config::running + }} [punk::config::configure running] package require textblock } errM]} { @@ -3393,6 +3402,7 @@ namespace eval repl { code alias quit ::repl::interphelpers::quit code alias editbuf ::repl::interphelpers::editbuf code alias colour ::repl::interphelpers::colour + code alias color ::repl::interphelpers::colour code alias mode ::repl::interphelpers::mode code alias vt52 ::repl::interphelpers::vt52 #code alias after ::repl::interphelpers::do_after diff --git a/src/modules/punk/repl/codethread-999999.0a1.0.tm b/src/modules/punk/repl/codethread-999999.0a1.0.tm index 23f94eb5..3f99deee 100644 --- a/src/modules/punk/repl/codethread-999999.0a1.0.tm +++ b/src/modules/punk/repl/codethread-999999.0a1.0.tm @@ -175,13 +175,13 @@ tcl::namespace::eval punk::repl::codethread { set outstack [list] set errstack [list] - upvar ::punk::config::running running_config - if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { + set config_running [::punk::config::configure running] + if {[string length [dict get $config_running color_stdout_repl]] && [interp eval code punk::console::colour]} { lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] - if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { + if {[string length [dict get $config_running color_stderr_repl]] && [interp eval code punk::console::colour]} { lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } diff --git a/src/modules/shellfilter-0.1.9.tm b/src/modules/shellfilter-0.1.9.tm index 92b214d8..73ea752c 100644 --- a/src/modules/shellfilter-0.1.9.tm +++ b/src/modules/shellfilter-0.1.9.tm @@ -674,6 +674,9 @@ namespace eval shellfilter::chan { #todo - track when in sixel,iterm,kitty graphics data - can be very large method Trackcodes {chunk} { + #note - caller can use 2 resets in a single unit to temporarily reset to no sgr (override ansiwrap filter) + #e.g [a+ reset reset] (0;0m vs 0;m) + #puts stdout "===[ansistring VIEW -lf 1 $o_buffered]" set buf $o_buffered$chunk set emit "" @@ -686,12 +689,29 @@ namespace eval shellfilter::chan { #process all pt/code pairs except for trailing pt foreach {pt code} [lrange $parts 0 end-1] { #puts "<==[ansistring VIEW -lf 1 $pt]==>" - if {( ![llength $o_codestack] || ([llength $o_codestack] == 1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]))} { - append emit $o_do_colour$pt$o_do_normal - #append emit $pt - } else { - append emit $pt + switch -- [llength $o_codestack] { + 0 { + append emit $o_do_colour$pt$o_do_normal + } + 1 { + if {[punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]} { + append emit $o_do_colour$pt$o_do_normal + set o_codestack [list] + } else { + #append emit [lindex $o_codestack 0]$pt + append emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$pt + } + } + default { + append emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$pt + } } + #if {( ![llength $o_codestack] || ([llength $o_codestack] == 1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]))} { + # append emit $o_do_colour$pt$o_do_normal + # #append emit $pt + #} else { + # append emit $pt + #} set c1c2 [tcl::string::range $code 0 1] set leadernorm [tcl::string::range [tcl::string::map [list\ @@ -732,7 +752,7 @@ namespace eval shellfilter::chan { } - set trailing_pt [lindex $parts end] + set trailing_pt [lindex $parts end] if {[string first \x1b $trailing_pt] >= 0} { #puts stdout "...[ansistring VIEW -lf 1 $trailing_pt]...buffered:<[ansistring VIEW $o_buffered]> '[ansistring VIEW -lf 1 $emit]'" #may not be plaintext after all @@ -740,15 +760,32 @@ namespace eval shellfilter::chan { #puts stdout "=-=[ansistring VIEWCODES $o_buffered]" } else { #puts [a+ yellow]???[ansistring VIEW "'$o_buffered'<+>'$trailing_pt'"]???[a] - if {![llength $o_codestack] || ([llength $o_codestack] ==1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]])} { - append emit $o_do_colour$trailing_pt$o_do_normal - } else { - append emit $trailing_pt + switch -- [llength $o_codestack] { + 0 { + append emit $o_do_colour$trailing_pt$o_do_normal + } + 1 { + if {[punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]} { + append emit $o_do_colour$trailing_pt$o_do_normal + set o_codestack [list] + } else { + #append emit [lindex $o_codestack 0]$trailing_pt + append emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$trailing_pt + } + } + default { + append emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$trailing_pt + } } + #if {![llength $o_codestack] || ([llength $o_codestack] ==1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]])} { + # append emit $o_do_colour$trailing_pt$o_do_normal + #} else { + # append emit $trailing_pt + #} #the previous o_buffered formed the data we emitted - nothing new to buffer because we emitted all parts including the trailing plaintext set o_buffered "" } - + } else { #REVIEW - this holding a buffer without emitting as we go is ugly. @@ -759,11 +796,14 @@ namespace eval shellfilter::chan { #puts "-->esc but no detect" #no complete ansi codes - but at least one esc is present - if {[string last \x1b $buf] == [string length $buf]-1} { - #only esc is last char in buf + if {[string index $buf end] eq "\x1b" && [string first \x1b $buf] == [string length $buf]-1} { + #string index in first part of && clause to avoid some unneeded scans of whole string for this test + #we can't use 'string last' - as we need to know only esc is last char in buf #puts ">>trailing-esc<<" set o_buffered \x1b - set emit [string range $buf 0 end-1] + set emit $o_do_colour[string range $buf 0 end-1]$o_do_normal + #set emit [string range $buf 0 end-1] + set buf "" } else { set emit_anyway 0 #todo - ensure non-ansi escapes in middle of chunks don't lead to ever growing buffer @@ -774,15 +814,18 @@ namespace eval shellfilter::chan { if {$st_partial_len < 1001} { append o_buffered $chunk set emit "" + set buf "" } else { set emit_anyway 1 - } + set o_buffered "" + } } else { set possible_code_len [expr {[string length $buf] - [string last \x1b $buf]}] ;#length of possible code #most opening sequences are 1,2 or 3 chars - review? set open_sequence_detected [punk::ansi::ta::detect_open $buf] if {$possible_code_len > 10 && !$open_sequence_detected} { set emit_anyway 1 + set o_buffered "" } else { #could be composite sequence with params - allow some reasonable max sequence length #todo - configurable max sequence length @@ -790,39 +833,74 @@ namespace eval shellfilter::chan { # - allow some headroom for redundant codes when the caller didn't merge. if {$possible_code_len < 101} { append o_buffered $chunk + set buf "" set emit "" } else { #allow a little more grace if we at least have an opening ansi sequence of any type.. if {$open_sequence_detected && $possible_code_len < 151} { append o_buffered $chunk + set buf "" set emit "" } else { set emit_anyway 1 + set o_buffered "" } } } } if {$emit_anyway} { - #looked ansi-like - but we've given enough length without detecting close.. + #assert: any time emit_anyway == 1 buf already contains all of previous o_buffered and o_buffered has been cleared. + + #looked ansi-like - but we've given enough length without detecting close.. #treat as possible plain text with some esc or unrecognised ansi sequence - if {( ![llength $o_codestack] || ([llength $o_codestack] == 1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]))} { - set emit $o_do_colour$buf$o_do_normal - } else { - set emit $buf + switch -- [llength $o_codestack] { + 0 { + set emit $o_do_colour$buf$o_do_normal + } + 1 { + if {[punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]} { + set emit $o_do_colour$buf$o_do_normal + set o_codestack [list] + } else { + #set emit [lindex $o_codestack 0]$buf + set emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$buf + } + } + default { + #set emit [punk::ansi::codetype::sgr_merge_singles $o_codestack]$buf + set emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$buf + } } + #if {( ![llength $o_codestack] || ([llength $o_codestack] == 1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]))} { + # set emit $o_do_colour$buf$o_do_normal + #} else { + # set emit $buf + #} } } - } + } } else { #no esc #puts stdout [a+ yellow]...[a] #test! - if {( ![llength $o_codestack] || ([llength $o_codestack] == 1 && [punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]))} { - set emit $o_do_colour$buf$o_do_normal - } else { - set emit $buf + switch -- [llength $o_codestack] { + 0 { + set emit $o_do_colour$buf$o_do_normal + } + 1 { + if {[punk::ansi::codetype::is_sgr_reset [lindex $o_codestack 0]]} { + set emit $o_do_colour$buf$o_do_normal + set o_codestack [list] + } else { + #set emit [lindex $o_codestack 0]$buf + set emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$buf + } + } + default { + #set emit [punk::ansi::codetype::sgr_merge_singles $o_codestack]$buf + set emit [punk::ansi::codetype::sgr_merge_singles [list $o_do_colour {*}$o_codestack]]$buf + } } - #set emit $buf set o_buffered "" } return [dict create emit $emit stacksize [llength $o_codestack]] @@ -849,20 +927,29 @@ namespace eval shellfilter::chan { #puts stdout "" set emit [tcl::encoding::convertto $o_enc $o_buffered] set o_buffered "" - return $emit + return $emit return } method write {transform_handle bytes} { set instring [tcl::encoding::convertfrom $o_enc $bytes] set streaminfo [my Trackcodes $instring] set emit [dict get $streaminfo emit] - if {[dict get $streaminfo stacksize] == 0} { - #no ansi on the stack - we can wrap - #review - set outstring "$o_do_colour$emit$o_do_normal" - } else { - set outstring $emit - } + + #review - wrapping already done in Trackcodes + #if {[dict get $streaminfo stacksize] == 0} { + # #no ansi on the stack - we can wrap + # #review + # set outstring "$o_do_colour$emit$o_do_normal" + #} else { + #} + #if {[llength $o_codestack]} { + # set outstring [punk::ansi::codetype::sgr_merge_singles $o_codestack]$emit + #} else { + # set outstring $emit + #} + + set outstring $emit + #puts stdout "decoded >>>[ansistring VIEWCODES $outstring]<<<" #puts stdout "re-encoded>>>[ansistring VIEW [tcl::encoding::convertto $o_enc $outstring]]<<<" return [tcl::encoding::convertto $o_enc $outstring] @@ -2260,7 +2347,7 @@ namespace eval shellfilter { # if {!$is_script} { set experiment 0 - if $experiment { + if {$experiment} { try { set results [exec {*}$commandlist] set exitinfo [list exitcode 0] diff --git a/src/modules/shellrun-0.1.1.tm b/src/modules/shellrun-0.1.1.tm index bb820f68..8365c100 100644 --- a/src/modules/shellrun-0.1.1.tm +++ b/src/modules/shellrun-0.1.1.tm @@ -21,12 +21,12 @@ namespace eval shellrun { #some ugly coupling with punk/punk::config for now #todo - something better - if {[info exists ::punk::config::running]} { - upvar ::punk::config::running conf - set syslog_stdout [dict get $conf syslog_stdout] - set syslog_stderr [dict get $conf syslog_stderr] - set logfile_stdout [dict get $conf logfile_stdout] - set logfile_stderr [dict get $conf logfile_stderr] + if {[info exists ::punk::config::configdata]} { + set conf_running [punk::config::configure running] + set syslog_stdout [dict get $conf_running syslog_stdout] + set syslog_stderr [dict get $conf_running syslog_stderr] + set logfile_stdout [dict get $conf_running logfile_stdout] + set logfile_stderr [dict get $conf_running logfile_stderr] } else { lassign [list "" "" "" ""] syslog_stdout syslog_stderr logfile_stdout logfile_stderr } diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 2a097fd2..b9dd4f9f 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -4301,7 +4301,7 @@ tcl::namespace::eval textblock { if {[dict get $opts -frame]} { #set output [textblock::frame -ansiborder [a+ {*}$fc Black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Black] Periodic Table " [$t print]] #set output [textblock::frame -ansiborder [a+ {*}$fc Black term-deepskyblue2] -type heavy -title "[a+ {*}$fc Black] Periodic Table " [$t print]] - set output [textblock::frame -checkargs 0 -ansiborder [a+ {*}$fc Black cyan] -type heavy -title "[a+ {*}$fc Black] Periodic Table " [$t print]] + set output [textblock::frame -checkargs 0 -ansiborder [a+ {*}$fc Black cyan] -type heavy -title "[a+ {*}$fc Black] Periodic Table [a]" [$t print]] } else { set output [$t print] }