diff --git a/src/bootsupport/include_modules.config b/src/bootsupport/include_modules.config index ca03f8d..cd46f83 100644 --- a/src/bootsupport/include_modules.config +++ b/src/bootsupport/include_modules.config @@ -19,6 +19,7 @@ set bootsupport_modules [list\ src/vendormodules md5\ src/vendormodules sha1\ modules punkcheck\ + modules natsort\ modules punk::ansi\ modules punk::assertion\ modules punk::args\ diff --git a/src/bootsupport/modules/README.md b/src/bootsupport/modules/README.md index 89dc0de..ed6e967 100644 --- a/src/bootsupport/modules/README.md +++ b/src/bootsupport/modules/README.md @@ -6,12 +6,12 @@ The .tm modules here may be required for your build script if it intended the in The modules here are loaded by your initialisation scripts and so can be a snapshot of different versions than those in your project src. The modules can be your own, or 3rd party such as individual items from tcllib. -You can copy modules from a running punk shell to this location using the pmix command. +You can copy modules from a running punk shell to this location using the dev command. e.g ->pmix visible_lib_copy_to_modulefolder some::module::lib bootsupport +dev lib.copyasmodule some::module::lib bootsupport -The pmix command will help you pick the latest version, and will create any necessary file structure matching the namespace of the package. +The dev command will help you pick the latest version, and will create any necessary file structure matching the namespace of the package. e.g the result might be a file such as /src/bootsupport/some/module/lib-0.1.tm diff --git a/src/bootsupport/modules/natsort-0.1.1.6.tm b/src/bootsupport/modules/natsort-0.1.1.6.tm new file mode 100644 index 0000000..9d4f8a9 --- /dev/null +++ b/src/bootsupport/modules/natsort-0.1.1.6.tm @@ -0,0 +1,1912 @@ +#! /usr/bin/env tclsh + + +package require flagfilter +namespace import ::flagfilter::check_flags + +namespace eval natsort { + proc scriptdir {} { + set possibly_linked_script [file dirname [file normalize [file join [info script] ...]]] + if {[file isdirectory $possibly_linked_script]} { + return $possibly_linked_script + } else { + return [file dirname $possibly_linked_script] + } + } + if {![interp issafe]} { + tcl::tm::add [scriptdir] + } +} + + +namespace eval natsort { + variable stacktrace_on 0 + + proc do_error {msg {then error}} { + #note we exit or error out even if debug selected - as every do_error call is meant to interrupt code processing at the site of call + #this is not just a 'logging' call even though it has log-like descriptors + lassign $then type code + if {$code eq ""} { + set code 1 + } + set type [string tolower $type] + set levels [list debug info notice warn error critical] + if {$type in [concat $levels exit]} { + puts stderr "|$type> $msg" + } else { + puts stderr "|>natsort_call_err> unable to interpret 2nd argument to do_error: '$then' should be one of '$levels' or 'exit '" + } + if {$::tcl_interactive} { + #may not always be desirable - but assumed to be more useful not to exit despite request, to aid in debugging + if {[string tolower $type] eq "exit"} { + puts stderr " (exit suppressed due to tcl_interactive - raising error instead)" + if {![string is digit -strict $code]} { + puts stderr "|>natsort_call_err> unable to interpret 2nd argument to do_error: '$then' should be: 'exit '" + } + } + return -code error $msg + } else { + if {$type ne "exit"} { + return -code error $msg + } else { + if {[string is digit -strict $code]} { + exit $code + } else { + puts stderr "|>natsort_call_err> unable to interpret 2nd argument to do_error: '$then' should be 'error' or 'exit '" + return -code error $msg + } + } + } + } + + + + + + + variable debug 0 + variable testlist + set testlist { + 00.test-firstposition.txt + 0001.blah.txt + 1.test-sorts-after-all-leadingzero-number-one-equivs.txt + 1010.thousand-and-ten.second.txt + 01010.thousand-and-ten.first.txt + 0001.aaa.txt + 001.zzz.txt + 08.octal.txt-last-octal + 008.another-octal-first-octal.txt + 08.again-second-octal.txt + 001.a.txt + 0010.reconfig.txt + 010.etc.txt + 005.etc.01.txt + 005.Etc.02.txt + 005.123.abc.txt + 200.somewhere.txt + 2zzzz.before-somewhere.txt + 00222-after-somewhere.txt + 005.00010.abc.txt + 005.a3423bc.00010.abc.txt + 005.001.abc.txt + 005.etc.1010.txt + 005.etc.010.txt + 005.etc.10.txt + " 005.etc.10.txt" + 005.etc.001.txt + 20.somewhere.txt + 4611686018427387904999999999-bignum.txt + 4611686018427387903-bigishnum.txt + 9223372036854775807-bigint.txt + etca-a + etc-a + etc2-a + a0001blah.txt + a010.txt + winlike-sort-difference-0.1.txt + winlike-sort-difference-0.1.1.txt + a1.txt + b1-a0001blah.txt + b1-a010.txt + b1-a1.txt + -a1.txt + --a1.txt + --a10.txt + 2.high-two.yml + 02.higher-two.yml + reconfig.txt + _common.stuff.txt + CASETEST.txt + casetest.txt + something.txt + some~thing.txt + someathing.txt + someThing.txt + thing.txt + thing_revised.txt + thing-revised.txt + "thing revised.txt" + "spacetest.txt" + " spacetest.txt" + " spacetest.txt" + "spacetest2.txt" + "spacetest 2.txt" + "spacetest02.txt" + name.txt + name2.txt + "name .txt" + "name2 .txt" + blah.txt + combined.txt + a001.txt + .test + .ssh + "Feb 10.txt" + "Feb 8.txt" + 1ab23v23v3r89ad8a8a8a9d.txt + "Folder (10)/file.tar.gz" + "Folder/file.tar.gz" + "Folder (1)/file (1).tar.gz" + "Folder (1)/file.tar.gz" + "Folder (01)/file.tar.gz" + "Folder1/file.tar.gz" + "Folder(1)/file.tar.gz" + + } + lappend testlist "Some file.txt" + lappend testlist " Some extra file1.txt" + lappend testlist " Some extra file01.txt" + lappend testlist " some extra file1.txt" + lappend testlist " Some extra file003.txt" + lappend testlist " Some file.txt" + lappend testlist "Some extra file02.txt" + lappend testlist "Program Files (x86)" + lappend testlist "01999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999991-bigger-pathologically-bignum.txt" + lappend testlist "199999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-pathologically-bignum.txt" + lappend testlist "29999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-smaller-pathologically-bignum.txt" + lappend testlist "199999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-pathologically-bignum.txt with (more 1.txt" + lappend testlist "199999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-pathologically-bignum.txt with (more 01.txt" + lappend testlist "a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1.pathological-num-nonnum-swapping-leadzero-should-be-first.txt" + lappend testlist "a1a1a1a1a1a1a1a1a1a1a1a01a1a1a1a1a1a1a1a1a1a1a1a1.pathological-num-nonnum-swapping-leadzero-should-be-first.txt" + lappend testlist "b1b1b1b1.txt" + lappend testlist "b1b01z1z1.txt" + lappend testlist "c1c111c1.txt" + lappend testlist "c1c1c1c1.txt" + + namespace eval overtype { + proc right {args} { + # @d !todo - implement overflow, length checks etc + + if {[llength $args] < 2} { + error {usage: ?-overflow [1|0]? undertext overtext} + } + foreach {undertext overtext} [lrange $args end-1 end] break + + set opt(-overflow) 0 + array set opt [lrange $args 0 end-2] + + + set olen [string length $overtext] + set ulen [string length $undertext] + + if {$opt(-overflow)} { + return [string range $undertext 0 end-$olen]$overtext + } else { + if {$olen > $ulen} { + set diff [expr {$olen - $ulen}] + return [string range $undertext 0 end-$olen][string range $overtext 0 end-$diff] + } else { + return [string range $undertext 0 end-$olen]$overtext + } + } + } + proc left {args} { + # @c overtype starting at left (overstrike) + # @c can/should we use something like this?: 'format "%-*s" $len $overtext + + if {[llength $args] < 2} { + error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} + } + foreach {undertext overtext} [lrange $args end-1 end] break + + set opt(-ellipsis) 0 + set opt(-ellipsistext) {...} + set opt(-overflow) 0 + array set opt [lrange $args 0 end-2] + + + set len [string length $undertext] + set overlen [string length $overtext] + set diff [expr {$overlen - $len}] + + #puts stdout "====================>overtype: datalen:$len overlen:$overlen diff:$diff" + #puts stdout "====================>overtype: data: $overtext" + if {$diff > 0} { + if {$opt(-overflow)} { + return $overtext + } else { + if {$opt(-ellipsis)} { + return [overtype::left [string range $overtext 0 [expr {$len -1}]] $opt(-ellipsistext)] + } else { + return [string range $overtext 0 [expr {$len -1}]] + } + } + } else { + return "$overtext[string range $undertext $overlen end]" + } + } + + } + + #considered using hex to make large numbers more compact for viewing in debug output - but it's not that much shorter and probably obscures more than it helps. + proc hex2dec {largeHex} { + #todo - use punk::lib::hex2dec - (scan supports ll so can do larger hex values directly) + set res 0 + set largeHex [string map [list _ ""] $largeHex] + if {[string length $largeHex] <=7} { + #scan can process up to FFFFFFF and does so quickly + return [scan $largeHex %x] + } + foreach hexDigit [split $largeHex {}] { + set new 0x$hexDigit + set res [expr {16*$res + $new}] + } + return $res + } + proc dec2hex {decimalNumber} { + format %4.4llX $decimalNumber + } + + #punk::lib::trimzero + proc trimzero {number} { + set trimmed [string trimleft $number 0] + if {[string length $trimmed] == 0} { + set trimmed 0 + } + return $trimmed + } + #todo - consider human numeric split + #e.g consider SI suffixes k|KMGTPEZY in that order + + #in this context, for natural sorting - numeric segments don't contain underscores or other punctuation such as . - + etc. + #review - what about unicode equivalents such as wide numerals \UFF10 to \UFF19? unicode normalization? + proc split_numeric_segments {name} { + set segments [list] + while {[string length $name]} { + if {[scan $name {%[0-9]%n} chunk len] == 2} { + lappend segments $chunk + set name [string range $name $len end] + } + if {[scan $name {%[^0-9]%n} chunk len] == 2} { + lappend segments $chunk + set name [string range $name $len end] + } + } + return $segments + } + + proc padleft {str count {ch " "}} { + set val [string repeat $ch $count] + append val $str + set diff [expr {max(0,$count - [string length $str])}] + set offset [expr {max(0,$count - $diff)}] + set val [string range $val $offset end] + } + + + # Sqlite may have limited collation sequences available in default builds. + # with custom builds - there may be others such as 'natsort' - see https://sqlite.org/forum/forumpost/e4dc6f3331 + # This is of limited use with the few builtin collations available in 2023 ie binary,nocase & rtrim + # but may provide a quicker,flexible sort option, especially if/when more collation sequences are added to sqlite + # There are also prebuilt packages such as sqlite3-icu which allows things like "SELECT icu_load_collation('en_AU', 'australian');" + proc sort_sqlite {stringlist args} { + package require sqlite3 + + + set args [check_flags -caller natsort_sqlite -defaults [list -db :memory: -collate nocase -winlike 0 -topchars "\uFFFF" -debug 0 -splitchars [list / . - _] -extras {all}] -values $args] + set db [string trim [dict get $args -db]] + set collate [string trim [dict get $args -collate]] + set debug [string trim [dict get $args -debug]] + set topchars [string trim [dict get $args -topchars]] + + set topdot [expr {"." in $topchars}] + set topunderscore [expr {"_" in $topchars}] + + + sqlite3 db_sort_basic $db + set orderedlist [list] + db_sort_basic eval [string map [list %collate% $collate] {create table sqlitesort(index0 text COLLATE %collate%, name text COLLATE %collate%)}] + foreach nm $stringlist { + set segments [split_numeric_segments $nm] + set index "" + set s 0 + foreach seg $segments { + if {($s == 0) && ![string length [string trim $seg]]} { + #don't index leading space + } elseif {($s == 0) && ($topunderscore) && [string match _* [string trim $seg]]} { + append index "[padleft "0" 5]-d -100 topunderscore " + append index [string trim $seg] + } elseif {($s == 0) && ($topdot) && [string match .* [string trim $seg]]} { + append index "[padleft "0" 5]-d -50 topdot " + append index [string trim $seg] + } else { + if {[string is digit [string trim $seg]]} { + set basenum [trimzero [string trim $seg]] + set lengthindex "[padleft [string length $basenum] 5]-d" + append index "$lengthindex " + #append index [padleft $basenum 40] + append index $basenum + } else { + append index [string trim $seg] + } + } + incr s + } + puts stdout ">>$index" + db_sort_basic eval {insert into sqlitesort values($index,$nm)} + } + db_sort_basic eval [string map [list %collate% $collate] {select name from sqlitesort order by index0 COLLATE %collate% ASC, name COLLATE %collate% ASC }] { + lappend orderedlist $name + } + db_sort_basic close + return $orderedlist + } + + proc get_leading_char_count {str char} { + #todo - something more elegant? regex? + set count 0 + foreach c [split $str "" ] { + if {$c eq $char} { + incr count + } else { + break + } + } + return $count + } + proc stacktrace {} { + set stack "Stack trace:\n" + for {set i 1} {$i < [info level]} {incr i} { + set lvl [info level -$i] + set pname [lindex $lvl 0] + append stack [string repeat " " $i]$pname + + if {![catch {info args $pname} pargs]} { + foreach value [lrange $lvl 1 end] arg $pargs { + + if {$value eq ""} { + if {$arg != 0} { + info default $pname $arg value + } + } + append stack " $arg='$value'" + } + } else { + append stack " !unknown vars for $pname" + } + + append stack \n + } + return $stack + } + + proc get_char_count {str char} { + #faster than lsearch on split for str of a few K + expr {[string length $str]-[string length [string map [list $char {}] $str]]} + } + + proc build_key {chunk splitchars topdict tagconfig debug} { + variable stacktrace_on + if {$stacktrace_on} { + puts stderr "+++>[stacktrace]" + } + + set index_map [list - "" _ ""] + #e.g - need to maintain the order + #a b.txt + #a book.txt + #ab.txt + #abacus.txt + + + set original_splitchars [dict get $tagconfig original_splitchars] + + # tag_dashes test moved from loop - review + set tag_dashes 0 + if {![string length [dict get $tagconfig last_part_text_tag]]} { + #winlike + set tag_dashes 1 + } + if {("-" ni $original_splitchars)} { + set tag_dashes 1 + } + if {$debug >= 3} { + puts stdout "START build_key chunk : $chunk" + puts stdout "START build_key splitchars : $splitchars $topdict $tagconfig NO tag dashes" + } + + + ## index_map will have no effect if we've already split on the char anyway(?) + #foreach m [dict keys $index_map] { + # if {$m in $original_splitchars} { + # dict unset index_map $m + # } + #} + + #if {![string length $chunk]} return + + set result "" + if {![llength $splitchars]} { + #no more structural splits - but we need to examine numeric/non-numeric segments at the lowest level. + # we are at a leaf in the recursive split hierarchy + + set s "" ;#we never actually split on "" (unless that was put in splitchars.. but it probably shouldn't be) + set parts [list $chunk] ;#important to treat as list or leading/trailing whitespace lost + + + } else { + set s [lindex $splitchars 0] + if {"spudbucket$s" in "[split $chunk {}]"} { + error "dead-branch spudbucket" + set partindex [build_key $chunk [lrange $splitchars 1 end] $topdict $tagconfig $debug] + if {[dict get $tagconfig showsplits]} { + set pfx "(1${s}=)" ;# = sorts before _ + set partindex ${pfx}$partindex + } + + return $partindex + } else { + set parts_below_index "" + + if {$s ni [split $chunk ""]} { + #$s can be an empty string + set parts [list $chunk] + } else { + set parts [split $chunk $s] ;#whitespace preserved - even if splitting on s that is not in string. + } + #assert - we have a splitchar $s that is in the chunk - so at least one part + if {(![string length $s] || [llength $parts] == 0)} { + error "buld_key assertion false empty split char and/or no parts" + } + + set pnum 1 ;# 1 based for clarity of reading index in debug output + set subpart_count [llength $parts] + + set sub_splits [lrange $splitchars 1 end] ;#pass same splitchars to each subpart + foreach p $parts { + set partindex [build_key $p $sub_splits $topdict $tagconfig $debug] + set lastpart [expr {$pnum == $subpart_count}] + + + ####################### + set showsplits [dict get $tagconfig showsplits] + #split prefixing experiment - maybe not suitable for general use - as it affects sort order + #note that pfx must be consistent until last one, no matter how many partnumbers there are in total. + # we don't want to influence sort order before reaching end. + #e.g for: + #(1.=)... + #(1._)...(2._)...(3.=) + #(1._)...(2.=) + #Note that this is probably more suitable for highly structure dependant sorts where the results are maybe less.. natural. + if {$showsplits} { + if {$lastpart} { + set pfx "(${pnum}${s}_" + #set pfx "(${pnum}${s}=)" ;# = sorts before _ + } else { + set pfx "(${pnum}${s}_" + } + append parts_below_index $pfx + } + ####################### + + if {$lastpart} { + if {[string length $p] && [string is digit $p]} { + set last_part_tag "<22${s}>" + } else { + set last_part_tag "<33${s}>" + } + + set last_part_text_tag [dict get $tagconfig last_part_text_tag] + #for -winlike 1 there is no tag configured. Windows explorer likes to put things in the order: + # module-0.1.1.tm + # module-0.1.1.2.tm + # module-0.1.tm + # arguably -winlike 0 is more natural/human + # module-0.1.tm + # module-0.1.1.tm + # module-0.1.1.2.tm + + if {[string length $last_part_text_tag]} { + #replace only the first text-tag (<30>) from the subpart_index + if {[string match "<30?>*" $partindex]} { + #give textual string index a specific tag for last part in split only. e.g <130> for lower than integers + set partindex "<130>[string range $partindex 5 end]" + } + #append parts_below_index $last_part_tag + } + #set partindex $last_part_tag$partindex + + + } + append parts_below_index $partindex + + + + if {$showsplits} { + if {$lastpart} { + set suffix "${pnum}${s}=)" ;# = sorts before _ + } else { + set suffix "${pnum}${s}_)" + } + append parts_below_index $suffix + } + + + incr pnum + } + append parts_below_index "" ;# don't add anything at the tail that may perturb sort order + + if {$debug >= 3} { + set pad [string repeat " " 20] + puts stdout "END build_key chunk : $chunk " + puts stdout "END build_key splitchars : $splitchars $topdict $tagconfig NO tag dashes" + puts stdout "END build_key ret below_index: $parts_below_index" + } + return $parts_below_index + + + } + } + + + + #puts stdout ">>>chunk:'$chunk'<<< split-on:$s parts: '$parts' splitchars: $splitchars -topdict:$topdict" + + + + + + #if {$chunk eq ""} { + # puts "___________________________________________!!!____" + #} + #puts stdout "-->chunk:$chunk $s parts:$parts" + + #puts stdout "---chunk:'$chunk' part:'$part' parts:'$parts' s:'$s'" + + + + + set segments [split_numeric_segments $chunk] ;#! + set stringindex "" + set segnum 0 + foreach seg $segments { + #puts stdout "=================---->seg:$seg segments:$segments" + #-strict ? + if {[string length $seg] && [string is digit $seg]} { + set basenum [trimzero [string trim $seg]] + set lengthindex "[padleft [string length $basenum] 4]d" + #append stringindex "<20>$lengthindex $basenum $seg" + } else { + set c1 [string range $seg 0 0] + #puts stdout "==============> c1'$c1' topdict: $topdict stringindex:$stringindex" + + if {$c1 in [dict keys $topdict]} { + set tag [dict get $topdict $c1] + #append stringindex "${tag}$c1" + #set seg [string range $seg 1 end] + } + #textindex + set leader "<30>" + set idx $seg + set idx [string trim $idx] + set idx [string tolower $idx] + set idx [string map $index_map $idx] + + + + + + #set the X-c count to match the length of the index - not the raw data + set lengthindex "[padleft [string length $idx] 4]c" + + #append stringindex "${leader}$idx $lengthindex $texttail" + } + } + + if {[llength $parts] != 1} { + error "build_key assertion fail llength parts != 1 parts:$parts" + } + + set segtail_clearance_buffer " " ;#space to clear other split indicators if using showsplits + set segtail $segtail_clearance_buffer + append segtail "\[" + set grouping "" + set pnum 0 + foreach p $parts { + set sublen_list [list] + set subsegments [split_numeric_segments $p] + set i 0 + + set partsorter "" + foreach sub $subsegments { + ##don't trim spaces here - it would be inconsistent. Some subs are pure whitespace - others have internal whitespace. e.g "a4 400b a b2" becomes "a 4 { } 400 {b a b} 2" + #mapping away all whitespace would be consistent, but not necessarily desirable. If it's in the index_map it'll happen anyway - so we don't do it manually here except for evaluating conditions. + set test_trim [string trim $sub] + set str $sub + set str [string tolower $str] + set str [string map $index_map $str] + if {[string length $test_trim] && [string is digit $test_trim]} { + append partsorter [trimzero $str] + } else { + append partsorter "$str" + } + append partsorter + } + + + foreach sub $subsegments { + + if {[string length $sub] && [string is digit $sub]} { + set basenum [trimzero [string trim $sub]] + set subequivs $basenum + set lengthindex "[padleft [string length $subequivs] 4]d " + set idx "$lengthindex [padleft $basenum 10]" ;#todo - cycle through data and determine longest + set tail [overtype::left [string repeat " " 10] $sub] + #set tail "" + } else { + set idx "" + + + set lookahead [lindex $subsegments $i+1] + if {![string length $lookahead]} { + set zeronum "[padleft 0 4]d0" + } else { + set zeronum "" + } + set subequivs $sub + #set subequivs [string trim $subequivs] + set subequivs [string tolower $subequivs] + set subequivs [string map $index_map $subequivs] + + append idx $subequivs + append idx $zeronum + + set idx $subequivs + + + # + + set ch "-" + if {$tag_dashes} { + #puts stdout "____TAG DASHES" + #winlike + set numleading [get_leading_char_count $seg $ch] + if {$numleading > 0} { + set texttail "<31-leading[padleft $numleading 4]$ch>" + } else { + set texttail "<30>" + } + set numothers [expr {[get_char_count $seg $ch] - $numleading}] + if {$debug >= 2} { + puts stdout "____dashcount: [get_char_count $seg $ch] numothers: $numothers" + } + if {$numothers > 0} { + append texttail "<31-others[padleft $numothers 4]$ch>" + } else { + append textail "<30>" + } + } else { + set texttail "<30>" + } + + + + + #set idx $partsorter + set tail "" + #set tail [string tolower $sub] ;#raw + #set tail $partsorter + #append tail ":[string tolower $p]" ;#we need the whole part - even though it makes the index much larger. !todo - tagconfig switch to toggle case sensitive sorting + } + + append grouping "$idx $tail|$s" + incr i + } + + + + + + if {$p eq ""} { + # no subsegments.. + set zeronum "[padleft 0 4]d0" + #append grouping "\u000$zerotail" + append grouping ".$zeronum" + } + + #append grouping | + #append grouping $s + #foreach len $sublen_list { + # append segtail "<[padleft $len 3]>" + #} + incr pnum + } + set grouping [string trimright $grouping $s] + append grouping "[padleft [llength $parts] 4]" + append segtail $grouping + + + #append segtail " <[padleft [llength $parts] 4]>" + + append segtail "\]" + + + #if {[string length $seg] && [string is digit $seg]} { + # append segtail "<20>" + #} else { + # append segtail "<30>" + #} + append stringindex $segtail + + incr segnum + + + + + lappend indices $stringindex + + if {[llength $indices] > 1} { + puts stderr "INDICES [llength $indices]: $stringindex" + error "build_key assertion error deadconcept indices" + } + + #topchar handling on splitter characters + #set c1 [string range $chunk 0 0] + if {$s in [dict keys $topdict]} { + set tag [dict get $topdict $s] + set joiner [string map [list ">" "$s>"] ${tag}] + #we have split on this character $s so if the first part is empty string then $s was a leading character + # we need to bring a tag out front for this, or it will be dominated by the leading sections-remaing tag + # (since the empty string produces no tag of it's own - ?) + if {[string length [lindex $parts 0]] == 0} { + set prefix ${joiner} + } else { + set prefix "" + } + } else { + #use standard character-data positioning tag if no override from topdict + set joiner "<30J>$s" + set prefix "" + } + + + set contentindex $prefix[join $indices $joiner] + if {[string length $s]} { + set split_indicator "" + } else { + set split_indicator "" + + } + if {![string length $s]} { + set s ~ + } + + #return "[overtype::left [string repeat { } 80] $contentindex][overtype::left [string repeat { } 10] [list $s $chunk]]" + #return $contentindex$split_indicator + #return [overtype::left [string repeat - 40] $contentindex] + + if {$debug >= 3} { + puts stdout "END build_key chunk : $chunk" + puts stdout "END build_key splitchars : $splitchars $topdict $tagconfig NO tag dashes" + puts stdout "END build_key ret contentidx : $contentindex" + } + return $contentindex + } + + #---------------------------------------- + #line-processors - data always last argument - opts can be empty string + #all processor should accept empty opts and ignore opts if they don't use them + proc _lineinput_as_tcl1 {opts line} { + set out "" + foreach i $line { + append out "$i " + } + set out [string range $out 0 end-1] + return $out + } + #should be equivalent to above + proc _lineinput_as_tcl {opts line} { + return [concat {*}$line] + } + #will put extra tcl quoting if it was already tcl-shaped e.g text "a" -> {"a"} + proc _lineoutput_as_tcl {opts line} { + return [regexp -inline -all {\S+} $line] + } + + proc _lineinput_as_raw {opts line} { + return $line + } + proc _lineoutput_as_raw {opts line} { + return $line + } + + #words is opposite of tcl + proc _lineinput_as_words {opts line} { + #wordlike_parts + return [regexp -inline -all {\S+} $line] + } + proc _lineoutput_as_words {opts line} { + return [concat {*}$line] + } + + #opts same as tcllib csv::split - except without the 'line' element + #?-alternate? ?sepChar? ?delChar? + proc _lineinput_as_csv {opts line} { + package require csv + if {[lindex $opts 0] eq "-alternate"} { + return [csv::split -alternate $line {*}[lrange $opts 1 end]] + } else { + return [csv::split $line {*}$opts] + } + } + #opts same as tcllib csv::join + #?sepChar? ?delChar? ?delMode? + proc _lineoutput_as_csv {opts line} { + package require csv + return [csv::join $line {*}$opts] + } + #---------------------------------------- + proc sort {stringlist args} { + #puts stdout "natsort::sort args: $args" + variable debug + if {![llength $stringlist]} return + + #allow pass through of the check_flags flag -debugargs so it can be set by the caller + set debugargs 0 + if {[set posn [lsearch $args -debugargs]] >=0} { + if {$posn == [llength $args]-1} { + #-debugargs at tail of list + set debugargs 1 + } else { + set debugargs [lindex $args $posn+1] + } + } + + #-return flagged|defaults doesn't work Review. + #flagfilter global processor/allocator not working 2023-08 + set args [check_flags \ + -caller natsort::sort \ + -return supplied|defaults \ + -debugargs $debugargs \ + -defaults [list -collate nocase \ + -winlike 0 \ + -splits "\uFFFF" \ + -topchars {. _} \ + -showsplits 1 \ + -sortmethod ascii \ + -collate "\uFFFF" \ + -inputformat raw \ + -inputformatapply {index data} \ + -inputformatoptions "" \ + -outputformat raw \ + -outputformatoptions "" \ + -cols "\uFFFF" \ + -debug 0 -db "" -stacktrace 0 -splits "\uFFFF" -showsplits 0] \ + -required {all} \ + -extras {none} \ + -commandprocessors {} \ + -values $args] + + #csv unimplemented + + set winlike [dict get $args -winlike] + set topchars [dict get $args -topchars] + set cols [dict get $args -cols] + set debug [dict get $args -debug] + set stacktrace [dict get $args -stacktrace] + set showsplits [dict get $args -showsplits] + set splits [dict get $args -splits] + set sortmethod [dict get $args -sortmethod] + set opt_collate [dict get $args -collate] + set opt_inputformat [dict get $args -inputformat] + set opt_inputformatapply [dict get $args -inputformatapply] + set opt_inputformatoptions [dict get $args -inputformatoptions] + set opt_outputformat [dict get $args -outputformat] + set opt_outputformatoptions [dict get $args -outputformatoptions] + dict unset args -showsplits + dict unset args -splits + if {$debug} { + puts stdout "natsort::sort processed_args: $args" + if {$debug == 1} { + puts stdout "natsort::sort - try also -debug 2, -debug 3" + } + } + + #set sortmethod "-dictionary" ;# sorts a2b before a001b - possibly other strangenesses that are hard to reason about + switch -- $sortmethod { + dictionary - ascii { + set sortmethod "-$sortmethod" + # -ascii is default for tcl lsort. + } + default { + set sortmethod "-ascii" + } + } + + set allowed_collations [list nocase] + if {$opt_collate ne "\uFFFF"} { + if {$opt_collate ni $allowed_collations} { + error "natsort::sort unknown value for -collate option. Only acceptable value(s): $allowed_collations" + } + set nocaseopt "-$opt_collate" + } else { + set nocaseopt "" + } + set allowed_inputformats [list tcl raw csv words] + switch -- $opt_inputformat { + tcl - raw - csv - words {} + default { + error "natsort::sort unknown value for -inputformat option. Only acceptable value(s): $allowed_inputformats" + } + } + set allowed_outputformats [list tcl raw csv words] + switch -- $opt_outputformat { + tcl - raw - csv - words {} + default { + error "natsort::sort unknown value for -outputformat option. Only acceptable value(s): $allowed_outputformats" + } + } + + # + set winsplits [list / . _] + set commonsplits [list / . _ -] + #set commonsplits [list] + + set tagconfig [dict create] + dict set tagconfig last_part_text_tag "<19>" + if {$winlike} { + set splitchars $winsplits + #windows explorer sorts leading spaces at the top - which doesn't seem very helpful for keeping things together - but the explorer doesn't seem able to create leading spaces anyway. + set wintop [list "(" ")" { } {.} {_}] ;#windows specific order + foreach t $topchars { + if {$t ni $wintop} { + lappend wintop $t + } + } + set topchars $wintop + dict set tagconfig last_part_text_tag "" + } else { + set splitchars $commonsplits + } + if {$splits ne "\uFFFF"} { + set splitchars $splits + } + dict set tagconfig original_splitchars $splitchars + dict set tagconfig showsplits $showsplits + + #create topdict + set i 0 + set topdict [dict create] + foreach c $topchars { + incr i ;#start at 01 so that 00 reserved for final-split tag (allows x-0.1.txt to sort above x-0.1.1.txt by default. Use tagconfig to change, or choose -winlike 1 for explorer-like sorting) + dict set topdict $c "<0$i>" + } + set keylist [list] + + switch -- $opt_inputformat { + tcl { + set lineinput_transform [list _lineinput_as_tcl $opt_inputformatoptions] + } + csv { + set lineinput_transform [list _lineinput_as_csv $opt_inputformatoptions] + } + raw { + set lineinput_transform [list _lineinput_as_raw $opt_inputformatoptions] + } + words { + set lineinput_transform [list _lineinput_as_words $opt_inputformatoptions] + } + } + switch -- $opt_outputformat { + tcl { + set lineoutput_transform [list _lineoutput_as_tcl $opt_outputformatoptions] + } + csv { + set lineoutput_transform [list _lineoutput_as_csv $opt_outputformatoptions] + } + raw { + set lineoutput_transform [list _lineoutput_as_raw $opt_outputformatoptions] + } + words { + set lineoutput_transform [list _lineoutput_as_words $opt_outputformatoptions] + } + } + + if {("data" in $opt_inputformatapply) || ("index" in $opt_inputformatapply)} { + if {$opt_inputformat eq "raw"} { + set tf_stringlist $stringlist + } else { + set tf_stringlist [list] + foreach v $stringlist { + lappend tf_stringlist [{*}$lineinput_transform $v] + } + } + if {"data" in $opt_inputformatapply} { + set tf_data_stringlist $tf_stringlist + } else { + set tf_data_stringlist $stringlist + } + if {"index" in $opt_inputformatapply} { + set tf_index_stringlist $tf_stringlist + } else { + set tf_index_stringlist $stringlist + } + } else { + set tf_data_stringlist $stringlist + set tf_index_stringlist $stringlist + } + + + + if {$stacktrace} { + puts stdout [natsort::stacktrace] + set natsort::stacktrace_on 1 + } + if {$cols eq "\uFFFF"} { + set colkeys [lmap v $stringlist {}] + } else { + set colkeys [list] + foreach v $tf_index_stringlist { + set lineparts $v + set k [list] + foreach c $cols { + lappend k [lindex $lineparts $c] + } + lappend colkeys [join $k "_"] ;#use a common-split char - Review + } + } + #puts stdout "colkeys: $colkeys" + + if {$opt_inputformat eq "raw"} { + #no inputformat was applied - can just use stringlist + foreach value $stringlist ck $colkeys { + set contentindex [build_key $value $splitchars $topdict $tagconfig $debug] + set colindex [build_key $ck $splitchars $topdict $tagconfig $debug] + lappend keylist ${colindex}-${contentindex}-$value ;#note: entire raw value used for final sort disambiguation (can be whitespace that was ignored in indexing) + } + } else { + foreach keyinput $tf_index_stringlist datavalue $tf_data_stringlist ck $colkeys { + #data may or may not have been transformed + #column index may or may not have been built with transformed data + + set contentindex [build_key $keyinput $splitchars $topdict $tagconfig $debug] + set colindex [build_key $ck $splitchars $topdict $tagconfig $debug] + lappend keylist ${colindex}-${contentindex}-$datavalue ;#note: entire value used for final sort disambiguation (can be whitespace that was ignored in indexing) + } + } + #puts stderr "keylist: $keylist" + + ################################################################################################### + # Use the generated keylist to do the actual sorting + # select either the transformed or raw data as the corresponding output + ################################################################################################### + if {[string length $nocaseopt]} { + set sortcommand [list lsort $sortmethod $nocaseopt -indices $keylist] + } else { + set sortcommand [list lsort $sortmethod -indices $keylist] + } + if {$opt_outputformat eq "raw"} { + #raw output means no further transformations - it doesn't mean there wasn't a transform applied on the input side + #use the tf_data_stringlist in the output - which will be the same as the input stringlist if no input transform applied for data. + #(Also - it may or may not have been *sorted* on transformed data depending on whether 'index' was in $opt_inputformatapply) + foreach idx [{*}$sortcommand] { + lappend result [lindex $tf_data_stringlist $idx] + } + } else { + #we need to apply an output format + #The data may or may not have been transformed at input + foreach idx [{*}$sortcommand] { + lappend result [{*}$lineoutput_transform [lindex $tf_data_stringlist $idx]] + } + } + ################################################################################################### + + + + + + if {$debug >= 2} { + set screen_width 250 + set max_val 0 + set max_idx 0 + ##### calculate colum widths + foreach i [{*}$sortcommand] { + set len_val [string length [lindex $stringlist $i]] + if {$len_val > $max_val} { + set max_val $len_val + } + set len_idx [string length [lindex $keylist $i]] + if {$len_idx > $max_idx} { + set max_idx $len_idx + } + } + #### + set l_width [expr {$max_val + 1}] + set leftcol [string repeat " " $l_width] + set r_width [expr {$screen_width - $l_width - 1}] + set rightcol [string repeat " " $r_width] + set str [overtype::left $leftcol RAW] + puts stdout " $str Index with possibly transformed data at tail" + foreach i [{*}$sortcommand] { + #puts stdout "|d> [overtype::left $leftcol [lindex $stringlist $i] ] [lindex $keylist $i]" + set index [lindex $keylist $i] + set len_idx [string length $index] + set rowcount [expr {$len_idx / $r_width}] + if {($len_idx % $r_width) > 0} { + incr rowcount + } + set rows [list] + for {set r 0} {$r < $rowcount} {incr r} { + lappend rows [string range $index 0 $r_width-$r] + set index [string range $index $r_width end] + } + + set r 0 + foreach idxpart $rows { + if {$r == 0} { + #use the untransformed stringlist + set str [overtype::left $leftcol [lindex $stringlist $i]] + } else { + set str [overtype::left $leftcol ...]] + } + puts stdout " $str $idxpart" + incr r + } + #puts stdout "|> '[lindex $stringlist $i]'" + #puts stdout "|> [lindex $keylist $i]" + } + + puts stdout "|debug> topdict: $topdict" + puts stdout "|debug> splitchars: $splitchars" + } + return $result + } + + + + #Note that although leading whitespace isn't a commonly used feature of filesystem names - it's possible at least on FreeBSD,windows and linux so we should try to handle it sensibly. + proc sort_experiment {stringlist args} { + package require sqlite3 + + variable debug + set args [check_flags -caller natsort::sort \ + -defaults [dict create -db :memory: -collate nocase -nullvalue "->NULL<" -winlike 0 -topchars [list] -debug 0] \ + -extras {all} \ + -values $args] + set db [string trim [dict get $args -db]] + set collate [string trim [dict get $args -collate]] + set winlike [string trim [dict get $args -winlike]] + set debug [string trim [dict get $args -debug]] + set nullvalue [string trim [dict get $args -nullvalue]] + + + set topchars [string trim [dict get $args -topchars]] + + set topdot [expr {"." in $topchars}] + set topunderscore [expr {"_" in $topchars}] + + + sqlite3 db_natsort2 $db + #-- + #our table must handle the name with the greatest number of numeric/non-numeric splits. + #This means a single list member with pathological naming e.g a1a1a1a1a1a1a1a1a1a1a1.txt could greatly extend the number of columns and indices and affect performance. + #review: could be optimised to aggregate the tail into a single index, as the the extra columns won't assist in ordering, but make the table and query bigger. + # we should probably determine the longest common sequence of splits in the input list and add only one more index for the segment after that. + set maxsegments 0 + #-- + set prefix "idx" + + #note - there will be more columns in the sorting table than segments. + # (a segment equals one of the numeric & non-numeric string portions returned from 'split_numeric_sgements') + #--------------------------- + # consider + # a123b.v1.2.txt + # a123b.v1.3beta1.txt + # these have the following segments: + # a 123 b.v 1 . 2 .txt + # a 123 b.v 1 . 3 beta 1 .txt + #--------------------------- + # The first string has 7 segments (numbered 0 to 6) + # the second string has 9 segments + # + # for example when the data has any elements in a segment position that are numeric (e.g 0001 123) + # - then an index column with numeric equivalents will be created (e.g 0001 becomes 1), and any non-numeric values in that column will get mapped to a negative value (for special cases) or a high value such as NULL (with NULLS LAST sql support) + # + # when a segment + + #cycle through all strings - we cannot build tabledef as we go because the column type depends on whether all segments for a particular column are text vs int-equivalent. + array set segmentinfo {} + foreach nm $stringlist { + set segments [split_numeric_segments $nm] + if {![string length [string trim [lindex $segments 0]]]} { + if {[string is digit [string trim [lindex $segments 1]]]} { + #name is whitespace followed by a digit - special case - ignore the whitespace for numbers only. (whitespace still goes through to name column though) + set segments [lrange $segments 1 end] + } + } + + + set c 0 ;#start of index columns + if {[llength $segments] > $maxsegments} { + set maxsegments [llength $segments] + } + foreach seg $segments { + set seg [string trim $seg] + set column_exists [info exists segmentinfo($c,type)] + if {[string is digit $seg]} { + if {$column_exists} { + #override it (may currently be text or int) + set segmentinfo($c,type) "int" + } else { + #new column + set segmentinfo($c,name) ${prefix}$c + set segmentinfo($c,type) "int" + } + } else { + #text never overrides int + if {!$column_exists} { + set segmentinfo($c,name) ${prefix}$c + set segmentinfo($c,type) "text" + } + } + incr c + } + } + if {$debug} { + puts stdout "Largest number of num/non-num segments in data: $maxsegments" + #parray segmentinfo + } + + # + set tabledef "" + set ordered_column_names [list] + set ordered_segmentinfo_tags [lsort -dictionary [array names segmentinfo *]] + foreach k $ordered_segmentinfo_tags { + lassign [split $k ,] c tag + if {$tag eq "type"} { + set type [set segmentinfo($k)] + if {$type eq "int"} { + append tabledef "$segmentinfo($c,name) int," + } else { + append tabledef "$segmentinfo($c,name) text COLLATE $collate," + } + append tabledef "raw$c text COLLATE $collate," + lappend ordered_column_names $segmentinfo($c,name) + lappend ordered_column_names raw$c ;#additional index column not in segmentinfo + } + if {$tag eq "name"} { + #lappend ordered_column_names $segmentinfo($k) + } + } + append tabledef "name text" + + #puts stdout "tabledef:$tabledef" + + + db_natsort2 eval [string map [list %tabledef% $tabledef] {create table natsort(%tabledef%)}] + + + foreach nm $stringlist { + array unset intdata + array set intdata {} + array set rawdata {} + #init array and build sql values string + set sql_insert "insert into natsort values(" + for {set i 0} {$i < $maxsegments} {incr i} { + set intdata($i) "" + set rawdata($i) "" + append sql_insert "\$intdata($i),\$rawdata($i)," + } + append sql_insert "\$nm" ;#don't manipulate name value in any way - e.g must leave all whitespace as the sort must return exactly the same elements as in the original list. + append sql_insert ")" + + set segments [split_numeric_segments $nm] + if {![string length [string trim [lindex $segments 0]]]} { + if {[string is digit [string trim [lindex $segments 1]]]} { + #name is whitespace followed by a digit - special case - ignore the whitespace for numbers only. (whitespace still goes through to name column though) + set segments [lrange $segments 1 end] + } + } + set values "" + set c 0 + foreach seg $segments { + if {[set segmentinfo($c,type)] eq "int"} { + if {[string is digit [string trim $seg]]} { + set intdata($c) [trimzero [string trim $seg]] + } else { + catch {unset intdata($c)} ;#set NULL - sorts last + if {($c == 0) && ($topunderscore) && [string match _* [string trim $seg]]} { + set intdata($c) -100 + } + if {($c == 0) && ($topdot) && [string match .* [string trim $seg]]} { + set intdata($c) -50 + } + } + set rawdata($c) [string trim $seg] + } else { + #pure text column + #set intdata($c) [string trim $seg] ;#ignore leading/trailing whitespace - we sort first on trimmed version, then refine with the sort on rawdata index + #catch {unset indata($c)} + set indata($c) [string trim $seg] + set rawdata($c) $seg + } + #set rawdata($c) [string trim $seg]# + #set rawdata($c) $seg + incr c + } + db_natsort2 eval $sql_insert + } + + set orderedlist [list] + + if {$debug} { + db_natsort2 eval {select * from pragma_table_info('natsort')} rowdata { + parray rowdata + } + } + set orderby "order by " + + foreach cname $ordered_column_names { + if {[string match "idx*" $cname]} { + append orderby "$cname ASC NULLS LAST," + } else { + append orderby "$cname ASC," + } + } + append orderby " name ASC" + #append orderby " NULLS LAST" ;#?? + + #e.g "order by idx0 ASC, raw0 ASC, idx1 ASC .... name ASC" + if {$debug} { + puts stdout "orderby clause: $orderby" + } + db_natsort2 eval [string map [list %orderby% $orderby] {select * from natsort %orderby%}] rowdata { + set line "- " + #parray rowdata + set columnnames $rowdata(*) + #puts stdout "columnnames: $columnnames" + #[lsort -dictionary [array names rowdata] + append line "$rowdata(name) \n" + foreach nm $columnnames { + if {$nm ne "name"} { + append line "$nm: $rowdata($nm) " + } + } + #puts stdout $line + #puts stdout "$rowdata(name)" + lappend orderedlist $rowdata(name) + } + + db_natsort2 close + return $orderedlist + } +} + + +#application section e.g this file might be linked from /usr/local/bin/natsort +namespace eval natsort { + namespace import ::flagfilter::check_flags + + proc called_directly_namematch {} { + global argv0 + #see https://wiki.tcl-lang.org/page/main+script + #trailing ... let's us resolve symlinks in last component of the path (could be something else like ___ but ... seems unlikely to collide with anything in the filesystem) + if {[info exists argv0] + && + [file dirname [file normalize [file join [info script] ...]]] + eq + [file dirname [file normalize [file join $argv0 ...]]] + } { + return 1 + } else { + #puts stdout "norm info script: [file dirname [file normalize [file join [info script] ...]]]" + #puts stdout "norm argv0 : [file dirname [file normalize [file join $argv0 ...]]]" + return 0 + } + } + #Review issues around comparing names vs using inodes (esp with respect to samba shares) + proc called_directly_inodematch {} { + global argv0 + if {[info exists argv0] + && [file exists [info script]] && [file exists $argv0]} { + file stat $argv0 argv0Info + file stat [info script] scriptInfo + expr {$argv0Info(dev) == $scriptInfo(dev) + && $argv0Info(ino) == $scriptInfo(ino)} + } else { + return 0 + } + } + + set is_namematch [called_directly_namematch] + set is_inodematch [called_directly_inodematch] + #### + #review - reliability of mechanisms to determine direct calls + # we don't want application being called when being used as a library, but we need it to run if called directly or from symlinks etc + #-- choose a policy and leave the others commented. + #set is_called_directly $is_namematch + #set is_called_directly $is_inodematch + set is_called_directly [expr {$is_namematch || $is_inodematch}] + #set is_called_directly [expr {$is_namematch && $is_inodematch}] + ### + + + #puts stdout "called_directly_name: [called_directly_namematch] called_directly_inode: [called_directly_inodematch]" + + + # + + + proc test_pass_fail_message {pass {additional ""}} { + variable test_fail_msg + variable test_pass_msg + if {$pass} { + puts stderr $test_pass_msg + } else { + puts stderr $test_fail_msg + } + puts stderr $additional + } + + variable test_fail_msg "XXXXXXXXXXXX FAIL XXXXXXXXXXXXX" + variable test_pass_msg "------------ PASS -------------" + proc test_sort_1 {args} { + package require struct::list + puts stderr "---$args" + set args [check_flags -caller natsort:test_sort_1 -defaults [list -collate nocase -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 ] -values $args] + + puts stderr "test_sort_1 got args: $args" + + set unsorted_input { + 2.2.2 + 2.2.2.2 + 1a.1.1 + 1a.2.1.1 + 1.12.1 + 1.2.1.1 + 1.02.1.1 + 1.002b.1.1 + 1.1.1.2 + 1.1.1.1 + } + set input { +1.1.1 +1.1.1.2 +1.002b.1.1 +1.02.1.1 +1.2.1.1 +1.12.1 +1a.1.1 +1a.2.1.1 +2.2.2 +2.2.2.2 + } + + set sorted [natsort::sort $input {*}$args] + set is_match [struct::list equal $input $sorted] + + set msg "windows-explorer order" + + test_pass_fail_message $is_match $msg + puts stdout [string repeat - 40] + puts stdout INPUT + puts stdout [string repeat - 40] + foreach item $input { + puts stdout $item + } + puts stdout [string repeat - 40] + puts stdout OUTPUT + puts stdout [string repeat - 40] + foreach item $sorted { + puts stdout $item + } + test_pass_fail_message $is_match $msg + return [expr {!$is_match}] + } + proc test_sort_showsplits {args} { + package require struct::list + + set args [check_flags -caller natsort:test_sort_1 \ + -defaults [list -collate nocase -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 1 ] \ + -extras {all} \ + -values $args] + + set input1 { + a-b.txt + a.b.c.txt + b.c-txt + } + + + set input2 { + a.b.c.txt + a-b.txt + b.c-text + } + + foreach {msg testlist } [list "custom-order" $input1 "windows-explorer (should work with -winlike 1)" $input2] { + set sorted [natsort::sort $testlist {*}$args] + set is_match [struct::list equal $testlist $sorted] + + test_pass_fail_message $is_match $msg + puts stderr "INPUT" + puts stderr "[string repeat - 40]" + foreach item $testlist { + puts stdout $item + } + puts stderr "[string repeat - 40]" + puts stderr "OUTPUT" + puts stderr "[string repeat - 40]" + foreach item $sorted { + puts stdout $item + } + + test_pass_fail_message $is_match $msg + } + + #return [expr {!$is_match}] + + } + + #tcl proc dispatch order - non flag items up front + #trailing flags are paired even if supplied as solo flags e.g -l becomes -l 1 + proc commandline_ls {args} { + set operands [list] + set posn 0 + foreach a $args { + if {![string match -* $a]} { + lappend operands $a + } else { + set flag1_posn $posn + break + } + incr posn + } + set args [lrange $args $flag1_posn end] + + + set debug 0 + set posn [lsearch $args -debug] + if {$posn > 0} { + if {[lindex $args $posn+1]} { + set debug [lindex $args $posn+1] + } + } + if {$debug} { + puts stderr "|debug>commandline_ls got $args" + } + + #if first operand not supplied - replace it with current working dir + if {[lindex $operands 0] eq "\uFFFF"} { + lset operands 0 [pwd] + } + + set targets [list] + foreach op $operands { + if {$op ne "\uFFFF"} { + set opchars [split [file tail $op] ""] + if {"?" in $opchars || "*" in $opchars} { + lappend targets $op + } else { + #actual file or dir + set targetitem $op + set targetitem [file normalize $op] + if {![file exists $targetitem]} { + if {$debug} { + puts stderr "|debug>commandline_ls Unable to access path '$targetitem'" + } + } + lappend targets $targetitem + if {$debug} { + puts stderr "|debug>commandline_ls listing for $targetitem" + } + } + } + } + set args [check_flags -caller commandline_ls \ + -return flagged|defaults \ + -debugargs 0 \ + -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 -algorithm sort] \ + -required {all} \ + -extras {all} \ + -soloflags {-v -l} \ + -commandprocessors {} \ + -values $args ] + if {$debug} { + puts stderr "|debug>args: $args" + } + + + set algorithm [dict get $args -algorithm] + dict unset args -algorithm + + set allfolders [list] + set allfiles [list] + foreach item $targets { + if {[file exists $item]} { + if {[file type $item] eq "directory"} { + set dotfolders [glob -nocomplain -directory $item -type {d} -tail .*] + set folders [glob -nocomplain -directory $item -type {d} -tail *] + set allfolders [concat $allfolders $dotfolders $folders] + + set dotfiles [glob -nocomplain -directory $item -type {f} -tail .*] + set files [glob -nocomplain -directory $item -type {f} -tail *] + set allfiles [concat $allfiles $dotfiles $files] + } else { + #file (or link?) + set files [glob -nocomplain -directory [file dirname $item] -tail [file tail $item]] + set allfiles [concat $allfiles $files] + } + } else { + set folders [glob -nocomplain -directory $item -type {d} -tail [file tail $item]] + set allfolders [concat $allfolders $folders] + set files [glob -nocomplain -directory [file dirname $item] -tail [file tail $item]] + set allfiles [concat $allfiles $files] + } + } + + + set sorted_folders [natsort::sort $allfolders {*}$args] + set sorted_files [natsort::sort $allfiles {*}$args] + + foreach fold $sorted_folders { + puts stdout $fold + } + foreach file $sorted_files { + puts stdout $file + } + + return "-- ok printed to stdout [llength $sorted_folders] folders and [llength $sorted_files] files --" + } + + package require argp + argp::registerArgs commandline_test { + { -showsplits boolean 0} + { -stacktrace boolean 0} + { -debug boolean 0} + { -winlike boolean 0} + { -db string ":memory:"} + { -collate string "nocase"} + { -algorithm string "sort"} + { -topchars string "\uFFFF"} + { -testlist string {10 1 30 3}} + } + argp::setArgsNeeded commandline_test {-stacktrace} + proc commandline_test {test args} { + variable testlist + puts stdout "commandline_test got $args" + argp::parseArgs opts + puts stdout "commandline_test got [array get opts]" + set args [check_flags -caller natsort_commandline \ + -return flagged|defaults \ + -defaults [list -db :memory: -collate nocase -testlist $testlist -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] \ + -values $args] + + if {[string tolower $test] in [list "1" "true"]} { + set test "sort" + } else { + if {![llength [info commands $test]]} { + error "test $test not found" + } + } + dict unset args -test + set stacktrace [dict get $args -stacktrace] + # dict unset args -stacktrace + + set argtestlist [dict get $args -testlist] + dict unset args -testlist + + + set debug [dict get $args -debug] + + set collate [dict get $args -collate] + set db [dict get $args -db] + set winlike [dict get $args -winlike] + set topchars [dict get $args -topchars] + + + puts stderr "|test>-----start natsort::$test--- input list size : [llength $argtestlist]" + #set resultlist [$test $argtestlist -db $db -collate $collate -topchars $topchars -winlike $winlike] + set resultlist [$test $argtestlist {*}$args] + foreach nm $resultlist { + puts stdout $nm + } + puts stdout "|test>-----end natsort::$test--- sorted list size: [llength $resultlist]" + return "test end" + } + proc commandline_runtests {runtests args} { + set argvals [check_flags -caller commandline_runtests \ + -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits "\uFFFF" -runtests 1] \ + -values $args] + + puts stderr "runtests args: $argvals" + + #set runtests [dict get $argvals -runtests] + dict unset argvals -runtests + dict unset argvals -algorithm + + puts stderr "runtests args: $argvals" + #exit 0 + + set test_prefix "::natsort::test_sort_" + + if {$runtests eq "1"} { + set runtests "*" + } + + + set testcommands [info commands ${test_prefix}${runtests}] + if {![llength $testcommands]} { + puts stderr "No test commands matched -runtests argument '$runtests'" + puts stderr "Use 1 to run all tests" + set alltests [info commands ${test_prefix}*] + puts stderr "Valid tests are:" + + set prefixlen [string length $test_prefix] + foreach t $alltests { + set shortname [string range $t $prefixlen end] + puts stderr "$t = -runtests $shortname" + } + + } else { + foreach cmd $testcommands { + puts stderr [string repeat - 40] + puts stderr "calling $cmd with args: '$argvals'" + puts stderr [string repeat - 40] + $cmd {*}$argvals + } + } + exit 0 + } + proc help {args} { + puts stdout "natsort::help got '$args'" + return "Help not implemented" + } + proc natsort_pipe {args} { + #PIPELINE to take input list on stdin and write sorted list to stdout + #strip - from arglist + #set args [check_flags -caller natsort_pipeline \ + # -return all \ + # -defaults [list -db :memory: -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] \ + # -values $args] + + + set debug [dict get $args -debug] + if {$debug} { + puts stderr "|debug> natsort_pipe got args:'$args'" + } + set algorithm [dict get $args -algorithm] + dict unset args -algorithm + + set proclist [info commands ::natsort::sort*] + set algos [list] + foreach p $proclist { + lappend algos [namespace tail $p] + } + if {$algorithm ni [list {*}$proclist {*}$algos]} { + do_error "valid sort mechanisms: $algos" 2 + } + + + set input_list [list] + while {![eof stdin]} { + if {[gets stdin line] > 0} { + lappend input_list $line + } else { + if {[eof stdin]} { + + } else { + after 10 + } + } + } + + if {$debug} { + puts stderr "|debug> received [llength $input_list] list elements" + } + + set resultlist [$algorithm $input_list {*}$args] + if {$debug} { + puts stderr "|debug> returning [llength $resultlist] list elements" + } + foreach r $resultlist { + puts stdout $r + } + #exit 0 + + } + if {($is_called_directly)} { + set cmdprocessors { + {helpfinal {match "^help$" dispatch natsort::help}} + {helpfinal {sub -topic default "NONE"}} + } + #set args [check_flags \ + # -caller test1 \ + # -debugargs 2 \ + # -return arglist \ + # -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] \ + # -required {none} \ + # -extras {all} \ + # -commandprocessors $cmdprocessors \ + # -values $::argv ] + interp alias {} do_filter {} ::flagfilter::check_flags + + #mashopts are generally single-letter opts that can be run together e.g -l -d as -ld + set cmdprocessors { + {helpcmd {match "^help$" dispatch natsort::help singleopts {-v}}} + {helpcmd {sub -operand default \uFFFF singleopts {-l}}} + {lscmd {match "^ls$" dispatch natsort::commandline_ls dispatchtype tcl dispatchglobal 1 mashopts {-l -a} singleopts {-l -a} pairopts {} longopts {--color=always}}} + {lscmd {sub dir default "\uFFFF"}} + {lscmd {sub dir2 default "\uFFFF"}} + {lscmd {sub dir3 default "\uFFFF"}} + {lscmd {sub dir4 default "\uFFFF"}} + {lscmd {sub dir5 default "\uFFFF"}} + {lscmd {sub dir6 default "\uFFFF"}} + {runtests {match "^-tests$" dispatch natsort::commandline_runtests singleopts {-l}}} + {runtests {sub testname default "1" singleopts {-l}}} + {pipecmd {match "^-$" dispatch natsort::natsort_pipe dispatchtype tcl}} + } + set arglist [do_filter \ + -debugargs 0 \ + -debugargsonerror 2 \ + -caller cline_dispatch1 \ + -return all \ + -soloflags {-v -x} \ + -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 ] \ + -required {all} \ + -extras {all} \ + -commandprocessors $cmdprocessors \ + -values $::argv ] + + + #mashopts are generally single-letter opts that can be run together e.g -l -d as -ld + set cmdprocessors { + {testcmd {match "^test$" dispatch natsort::commandline_test singleopts {-l}}} + {testcmd {sub testname default "1" singleopts {-l}}} + } + set arglist [check_flags \ + -debugargs 0 \ + -caller cline_dispatch2 \ + -return all \ + -soloflags {-v -l} \ + -defaults [list -collate nocase -algorithm sort -testlist "1 2 3 10" -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 ] \ + -required {all} \ + -extras {all} \ + -commandprocessors $cmdprocessors \ + -values $::argv ] + + + + + #set cmdprocessors [list] + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors $cmdprocessors -values $::argv ] + + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors {-cmd {-cmd -cmdarg1 -default "."} {-cmd -cmdarg2 -default j}} -values $::argv ] + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors {{-cmd -default help} {-cmd -cmdarg1 -default "."} {-cmd -cmdarg2 -default j}} -values $::argv ] + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors {ls {ls lsdir -default "\uFFFF"}} -values $::argv ] + + exit 0 + + if {$::argc} { + + } + } +} + + +package provide natsort [namespace eval natsort { + variable version + set version 0.1.1.6 +}] + + diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index e236511..647da08 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -141,19 +141,20 @@ namespace eval punk::ansi::class { if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" } - set defaults [dict create\ + set opts [dict create\ -dimensions 80x24\ -minus 0\ ] dict for {k v} $arglist { switch -- $k { - -dimensions - -minus { } + -dimensions - -minus { + dict set opts $k $v + } default { puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x" } } } - set opts [dict merge $defaults $arglist] set opt_dimensions [dict get $opts -dimensions] set opt_minus [dict get $opts -minus] lassign [split $opt_dimensions x] w h @@ -221,15 +222,17 @@ namespace eval punk::ansi::class { -vt 0\ -width "auto"\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -lf - -vt - -width {} + -lf - -vt - -width { + dict set opts $k $v + } default { error "viewcodes unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set opts_lf [dict get $opts -lf] set opts_vt [dict get $opts -vt] set opts_width [dict get $opts -width] @@ -249,15 +252,17 @@ namespace eval punk::ansi::class { set defaults [list\ -width "auto"\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -width {} + -width { + dict set opts $k $v + } default { error "viewchars unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set opts_width [dict get $opts -width] if {$opts_width eq ""} { return [punk::ansi::stripansiraw [$o_ansistringobj get]] @@ -275,15 +280,17 @@ namespace eval punk::ansi::class { set defaults [list\ -width "auto"\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -width {} + -width { + dict set opts $k $v + } default { error "viewstyle unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set opts_width [dict get $opts -width] if {$opts_width eq ""} { return [ansistring VIEWSTYLE [$o_ansistringobj get]] @@ -1423,16 +1430,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourmap1 {args} { - set defaults {-bg Web-white -forcecolour 0} - dict for {k v} $args { + set opts {-bg Web-white -forcecolour 0} + foreach {k v} $args { switch -- $k { - -bg - -forcecolour {} + -bg - -forcecolour { + dict set opts $k $v + } default { - error "colourmap1 unrecognised option $k. Known-options: [dict keys $defaults] + error "colourmap1 unrecognised option $k. Known-options: [dict keys $opts] } } } - set opts [dict merge $defaults $args] if {[dict get $opts -forcecolour]} { set fc "forcecolour" } else { @@ -1815,16 +1823,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # $WEB_colour_map_gray\ #] proc colourtable_web {args} { - set defaults {-forcecolour 0 -groups *} + set opts {-forcecolour 0 -groups *} foreach {k v} $args { switch -- $k { - -groups - -forcecolour {} + -groups - -forcecolour { + dict set opts $k $v + } default { error "colourtable_web unrecognised option '$k'. Known-options: [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set fc "" if {[dict get $opts -forcecolour]} { set fc "forcecolour" @@ -1894,19 +1903,20 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc colourtable_x11diff {args} { variable X11_colour_map_diff variable WEB_colour_map - set defaults [dict create\ + set opts [dict create\ -forcecolour 0\ -return "string"\ ] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { - -return - -forcecolour {} + -return - -forcecolour { + dict set opts $k $v + } default { - error "colourtable_x11diff unrecognised option '$k'. Known options [dict keys $defaults]" + error "colourtable_x11diff unrecognised option '$k'. Known options [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set fc "" if {[dict get $opts -forcecolour]} { set fc "forcecolour" @@ -3698,20 +3708,21 @@ namespace eval punk::ansi { variable codestate_empty set othercodes [list] - set defaults [dict create\ + set opts [dict create\ -filter_fg 0\ -filter_bg 0\ -filter_reset 0\ ] dict for {k v} $args { switch -- $k { - -filter_fg - -filter_bg - -filter_reset {} + -filter_fg - -filter_bg - -filter_reset { + dict set opts $k $v + } default { - error "sgr_merge unknown option '$k'. Known options [dict keys $defaults]" + error "sgr_merge unknown option '$k'. Known options [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set codestate $codestate_empty set codestate_initial $codestate_empty ;#keep a copy for resets. @@ -4331,6 +4342,39 @@ namespace eval punk::ansi::ta { } return [lappend list [string range $text $start end]] } + + #experiment for coroutine generator + proc _perlish_split_yield {re text} { + if {[string length $text] == 0} { + yield {} + } + set list [list] + set start 0 + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + yield [string range $text $start $matchStart-1] + yield [string index $text $matchStart] + incr start + if {$start >= [string length $text]} { + break + } + continue + } + yield [string range $text $start $matchStart-1] + yield [string range $text $matchStart $matchEnd] + set start [expr {$matchEnd+1}] + #? + if {$start >= [string length $text]} { + break + } + } + #return [lappend list [string range $text $start end]] + yield [string range $text $start end] + } proc _perlish_split2 {re text} { if {[string length $text] == 0} { return {} @@ -4399,7 +4443,7 @@ namespace eval punk::ansi::class { error {usage: ?-width ? ?-wrap [1|0]? ?-overflow [1|0]? from_ansistring to_ansistring} } lassign [lrange $args end-1 end] from_ansistring to_ansistring - set defaults [dict create\ + set opts [dict create\ -width \uFFEF\ -wrap 1\ -overflow 0\ @@ -4411,17 +4455,17 @@ namespace eval punk::ansi::class { ] puts "[info object class [self]] renderer [self] constructor from ansistring $from_ansistring to ansistring $to_ansistring" set argsflags [lrange $args 0 end-2] - dict for {k v} $argsflags { + foreach {k v} $argsflags { switch -- $k { - -width - -wrap - -overflow - -appendlines - -looplimit - -experimental {} + -width - -wrap - -overflow - -appendlines - -looplimit - -experimental { + dict set opts $k $v + } default { - set known_opts [dict keys $defaults] #don't use [self class] - or we'll get the superclass - error "[info object class [self]] unknown option '$k'. Known options: $known_opts" + error "[info object class [self]] unknown option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $argsflags] set o_width [dict get $opts -width] set o_wrap [dict get $opts -wrap] set o_overflow [dict get $opts -overflow] diff --git a/src/bootsupport/modules/punk/args-0.1.0.tm b/src/bootsupport/modules/punk/args-0.1.0.tm index 6884662..cd4a9fa 100644 --- a/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/bootsupport/modules/punk/args-0.1.0.tm @@ -21,7 +21,7 @@ #[manpage_begin punkshell_module_punk::args 0 0.1.0] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] -#[moddesc {args to option-value dict and values dict}] [comment {-- Description at end of page heading --}] +#[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] #[require punk::args] #[keywords module proc args arguments parse] #[description] @@ -31,46 +31,156 @@ #*** !doctools #[section Overview] +#[para] There are many ways to parse arguments and many (too many?) packages to do it (see below for a discussion of packages and pure-tcl mechanisms). #[para] overview of punk::args #[subsection Concepts] #[para]There are 2 main conventions for parsing a proc args list #[list_begin enumerated] #[enum] -#[para]leading option-value pairs followed by a list of values (Tk style) +#[para]leading option-value pairs and flags followed by a list of values (Tcl style) #[enum] -#[para]leading list of values followed by option-value pairs (Tcl style) +#[para]leading list of values followed by option-value pairs and flags (Tk style) #[list_end] -#[para]punk::args is focused on the 1st convention (Tk style): parsing of args in leading option-value pair style - even for non-Tk usage. +#[para]There are exceptions in both Tcl and Tk commands regarding this ordering +#[para]punk::args is focused on the 1st convention (Tcl style): parsing of the 'args' variable in leading option-value pairs (and/or solo flags) style #[para]The proc can still contain some leading required values e.g [example "proc dostuff {arg1 arg2 args} {...}}"] -#[para]but having the core values elements at the end of args is more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style. -#[para]The basic principle is that a call to punk::args::opts_vals is made near the beginning of the proc e.g -#[example_begin] +#[para]but having the core values elements at the end of args is arguably more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style. +#[para] +#[para]The basic principle is that a call to punk::args::get_dict is made near the beginning of the proc with a cacheable first argument defining the parameters e.g +#[example { # proc dofilestuff {args} { -# lassign [lb]dict values [lb]punk::args { +# lassign [dict values [punk::args::get_dict { +# *proc -help "do some stuff with files e.g dofilestuff " +# *opts -type string +# #comment lines ok # -directory -default "" # -translation -default binary -# } $args[rb][rb] opts values +# #setting -type none indicates a flag that doesn't take a value (solo flag) +# -nocomplain -type none +# *values -min 1 -max -1 +# } $args]] opts values # -# puts "translation is [lb]dict get $opts -translation[rb]" -# foreach f [lb]dict values $values[rb] { +# puts "translation is [dict get $opts -translation]" +# foreach f [dict values $values] { # puts "doing stuff with file: $f" # } # } -#[example_end] +#}] +#[para]The lines beginning with * are optional in most cases and can be used to set defaults and some extra controls +#[para] - the above example would work just fine with only the - lines, but would allow zero filenames to be supplied as no -min value is set for *values +#[para]valid * lines being with *proc *opts *values +#[para]lines beginning with a dash define options - a name can optionally be given to each trailing positional argument. +#[para]If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero. +#[para]e.g the result from the punk::args call above may be something like: +#[para] opts {-translation binary -directory "" -nocomplain 0} values {0 file1.txt 1 file2.txt 2 file3.txt} +#[para]Here is an example that requires the number of values supplied to be exactly 2 and names the positional arguments +#[para]It also demonstrates an inital argument 'category' that is outside of the scope for punk::args processing - allowing leading and trailing positional arguments +#[example { +# proc dofilestuff {category args} { +# lassign [dict values [punk::args::get_dict { +# -directory -default "" +# -translation -default binary +# -nocomplain -type none +# *values -min 2 -max 2 +# fileA -type existingfile 1 +# fileB -type existingfile 1 +# } $args]] opts values +# puts "$category fileA: [dict get $values fileA]" +# puts "$category fileB: [dict get $values fileB]" +# } +#}] +#[para]By using standard tcl proc named arguments prior to args, and setting *values -min 0 -max 0 +#[para]a Tk-style ordering can be acheived, where punk::args is only handling the trailing flags and the values element of the returned dict can be ignored +#[para]This use of leading positional arguments means the type validation features can't be applied to them. It can be done manually as usual, +#[para] or an additional call could be made to punk::args e.g +#[example { +# punk::args::get_dict { +# category -choices {cat1 cat2 cat3} +# another_leading_arg -type boolean +# } [list $category $another_leading_arg] +#}] #*** !doctools #[subsection Notes] -#[para]There are alternative args parsing packages such as: +#[para]For internal functions not requiring features such as solo flags, prefix matching, type checking etc - a well crafted switch statement will be the fastest pure-tcl solution. +#[para] +#When functions are called often and/or in inner loops, a switch based solution generally makes the most sense. +#For functions that are part of an API a package may be more suitable. +#[para]The following example shows a switch-based solution that is highly performant (sub microsecond for the no-args case) +#[example { +# proc test_switch {args} { +# set opts [dict create\\ +# -return "object"\\ +# -frametype "heavy"\\ +# -show_edge 1\\ +# -show_seps 0\\ +# -x a\\ +# -y b\\ +# -z c\\ +# -1 1\\ +# -2 2\\ +# -3 3\\ +# ] +# foreach {k v} $args { +# switch -- $k { +# -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { +# dict set opts $k $v +# } +# default { +# error "unrecognised option '$k'. Known options [dict keys $opts]" +# } +# } +# } +# return $opts +# } +#}] +#[para]Note that the switch statement uses literals so that the compiler produces a jump-table for best performance. +#[para] +# Attempting to build the switch branch using the values from dict keys $opts will stop the jump table being built. +# To create the faster switch statement without repeating the key names, the proc body would need to be built using string map. +#[para]use punk::lib::show_jump_tables to verify that a jump table exists. +#[para]Nearly as performant due to the c-coded tcl::prefix::match function built into Tcl is the following example - which also allows shortened option names if they are unambiguous +#[example { +# proc test_prefix {args} { +# set opts [dict create\ +# -return string\ +# -frametype \uFFEF\ +# -show_edge \uFFEF\ +# -show_seps \uFFEF\ +# -x a\ +# -y b\ +# -z c\ +# -1 1\ +# -2 2\ +# -3 3\ +# ] +# if {[llength $args]} { +# set knownflags [dict keys $opts] +# } +# foreach {k v} $args { +# dict set opts [tcl::prefix::match -message "test_prefix option $k" $knownflags $k] $v +# } +# return $opts +# } +#}] +#[para]There are many alternative args parsing packages a few of which are listed here. #[list_begin enumerated] -#[enum]argp -#[enum]The tcllib set of TEPAM modules +#[enum]argp (pure tcl) +#[enum]parse_args (c implementation) +#[enum]argparse (pure tcl *) +#[enum]cmdline (pure tcl) +#[enum]opt (pure tcl) distributed with Tcl but considered deprecated +#[enum]The tcllib set of TEPAM modules (pure tcl) #[para]TEPAM requires an alternative procedure declaration syntax instead of proc - but has support for Tk and documentation generation. #[list_end] +#[para] (* c implementation planned/proposed) #[para]punk::args was designed initially without specific reference to TEPAM - and to handle some edge cases in specific projects where TEPAM wasn't suitable. #[para]In subsequent revisions of punk::args - some features were made to operate in a way that is similar to TEPAM - to avoid gratuitous differences where possible, but of course there are differences #[para]and those used TEPAM or mixing TEPAM and punk::args should take care to assess the differences. #[para]TEPAM is a mature solution and is widely available as it is included in tcllib. -#[para]Serious consideration should be given to using TEPAM if suitable for your project. +#[para]Serious consideration should be given to using TEPAM or one of the other packages, if suitable for your project. +#[para]punk::args is relatively performant for a pure-tcl package solution - with the parsing of the argument specification block occuring only on the first run - after which a cached version of the spec is used. +#[para]punk::args is not limited to procs. It can be used in apply or coroutine situations for example. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements @@ -134,414 +244,804 @@ namespace eval punk::args::class { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::args { - namespace export * - #variable xyz + namespace export {[a-z]*} + variable argspec_cache + variable argspecs + variable id_counter + set argspec_cache [dict create] + set argspecs [dict create] + set id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] #[para] Core API functions for punk::args #[list_begin definitions] - - #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values - #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. - #only supports -flag val pairs, not solo options - #If an option is supplied multiple times - only the last value is used. - proc opts_values {optionspecs rawargs args} { - #*** !doctools - #[call [fun opts_values] [arg optionspecs] [arg rawargs] [opt {option value...}]] - #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values - #[para]Returns a dict of the form: opts values - #[para]ARGUMENTS: - #[list_begin arguments] - #[arg_def multiline-string optionspecs] - #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced - #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values - #[para]Each optionspec line must be of the form: - #[para]-optionname -key val -key2 val2... - #[para]where the valid keys for each option specification are: -default -type -range -choices -optional - #[arg_def list rawargs] - #[para] This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc - #[list_end] - #[para] - - #consider line-processing example below for we need info complete to determine record boundaries - #punk::args::opt_values { - # -opt1 -default {} - # -opt2 -default { - # etc - # } -multiple 1 - #} $args + proc Get_argspecs {optionspecs args} { + variable argspec_cache + variable argspecs + #ideally we would use a fast hash algorithm to produce a short key with low collision probability. + #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. + #review - check if there is a built-into-tcl way to do this quickly + #for now we will just key using the whole string + set cache_key $optionspecs + if {[dict exists $argspec_cache $cache_key]} { + return [dict get $argspec_cache $cache_key] + } set optionspecs [string map [list \r\n \n] $optionspecs] set optspec_defaults [dict create\ + -type string\ -optional 1\ -allow_ansi 1\ -validate_without_ansi 0\ -strip_ansi 0\ -nocase 0\ + -multiple 0\ ] - set required_opts [list] - set required_vals [list] + set valspec_defaults [dict create\ + -type string\ + -optional 0\ + -allow_ansi 1\ + -validate_without_ansi 0\ + -strip_ansi 0\ + -multiple 0\ + ] + #checks with no default + #-minlen -maxlen -range + + + #default -allow_ansi to 1 and -validate_without_ansi to 0 and -strip_ansi 0 - it takes time to strip ansi + #todo - detect if anything in the spec uses -allow_ansi 0, -validate_without_ansi 1 or -strip_ansi 1 and set a flag indicating if punk::ansi::ta::detect should be run on the argslist + set opt_required [list] + set val_required [list] set arg_info [dict create] - set defaults_dict_opts [dict create] - set defaults_dict_values [dict create] + set opt_defaults [dict create] + set opt_names [list] ;#defined opts + set val_defaults [dict create] + set opt_solos [list] #first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end - set value_names [list] + set val_names [list] set records [list] set linebuild "" - foreach rawline [split $optionspecs \n] { + + set linelist [split $optionspecs \n] + set lastindent "" + foreach ln $linelist { + if {[string trim $ln] eq ""} {continue} + regexp {(\s*).*} $ln _all lastindent + break ;#break at first non-empty + } + #puts "indent1:[ansistring VIEW $lastindent]" + set in_record 0 + foreach rawline $linelist { set recordsofar [string cat $linebuild $rawline] if {![info complete $recordsofar]} { - append linebuild [string trimleft $rawline] \n + #append linebuild [string trimleft $rawline] \n + if {$in_record} { + if {[string length $lastindent]} { + #trim only the whitespace corresponding to last indent - not all whitespace on left + if {[string first $lastindent $rawline] == 0} { + set trimmedline [string range $rawline [string length $lastindent] end] + append linebuild $trimmedline \n + } else { + append linebuild $rawline \n + } + } else { + append linebuild $rawline \n + } + } else { + set in_record 1 + regexp {(\s*).*} $rawline _all lastindent + #puts "indent: [ansistring VIEW -lf 1 $lastindent]" + #puts "indent from rawline:$rawline " + append linebuild $rawline \n + } } else { - lappend records [string cat $linebuild $rawline] + set in_record 0 + if {[string length $lastindent]} { + #trim only the whitespace corresponding to last indent - not all whitespace on left + if {[string first $lastindent $rawline] == 0} { + set trimmedline [string range $rawline [string length $lastindent] end] + append linebuild $trimmedline + } else { + append linebuild $rawline + } + } else { + append linebuild $rawline + } + lappend records $linebuild set linebuild "" } } - + set proc_info {} + set opt_any 0 + set val_min 0 + set val_max -1 ;#-1 for no limit + set spec_id "" foreach ln $records { set trimln [string trim $ln] switch -- [string index $trimln 0] { "" - # {continue} } - set argname [lindex $trimln 0] - set argspecs [lrange $trimln 1 end] - if {[string match -* $argname]} { + set linespecs [lassign $trimln argname] + if {$argname ne "*id" && [llength $linespecs] %2 != 0} { + error "punk::args::get_dict - bad optionspecs line for record '$argname' Remaining items on line must be in paired option-value format - received '$linespecs'" + } + set firstchar [string index $argname 0] + set secondchar [string index $argname 1] + if {$firstchar eq "*" && $secondchar ne "*"} { + set starspecs $linespecs + switch -- [string range $argname 1 end] { + id { + #id line must have single entry - a unique id assigned by the user - an id will be allocated if no id line present or the value is "auto" + if {[llength $starspecs] != 1} { + error "punk::args::Get_argspecs - *id line must have a single entry following *id." + } + if {$spec_id ne ""} { + #disallow duplicate *id line + error "punk::args::Get_argspecs - *id already set. Existing value $spec_id" + } + set spec_id $starspecs + } + proc { + #allow arbitrary + set proc_info $starspecs + } + opts { + foreach {k v} $starspecs { + switch -- $k { + -any - + -anyopts { + set opt_any $v + } + -minlen - -maxlen - -range - -choices - -choicelabels { + #review - only apply to certain types? + dict set optspec_defaults $k $v + } + -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + dict unset optspec_defaults $k + } + -type - + -optional - + -allow_ansi - + -validate_without_ansi - + -strip_ansi - + -multiple { + #allow overriding of defaults for options that occur later + dict set optspec_defaults $k $v + } + default { + error "punk::args::Get_argspecs - unrecognised key '$k' in *opts line. Known keys: -anyopts" + } + } + } + } + values { + foreach {k v} $starspecs { + switch -- $k { + -min - + -minvalues { + set val_min $v + } + -max - + -maxvalues { + set val_max $v + } + -minlen - -maxlen - -range - -choices - -choicelabels { + #review - only apply to certain types? + dict set valspec_defaults $k $v + } + -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + dict unset valspec_defaults $k + } + -type - + -allow_ansi - + -validate_without_ansi - + -strip_ansi - + -multiple { + dict set valspec_defaults $k $v + } + default { + error "punk::args::Get_argspecs - unrecognised key '$k' in *opts line. Known keys: -anyopts" + } + } + } + + } + default { + error "punk::args::Get_argspecs - unrecognised * line in. Expected *proc *opts or *values - use **name if paramname needs to be *name" + } + } + continue + } elseif {$firstchar eq "-"} { + set argspecs $linespecs dict set argspecs -ARGTYPE option + lappend opt_names $argname set is_opt 1 } else { + if {$firstchar eq "*"} { + #allow basic ** escaping for literal argname that begins with * + set argname [string range $argname 1 end] + } + set argspecs $linespecs dict set argspecs -ARGTYPE value - lappend value_names $argname + lappend val_names $argname set is_opt 0 } - if {[llength $argspecs] %2 != 0} { - error "punk::args::opts_values - bad optionspecs line for argument '$argname' Remaining items on line must be in paired option-value format - received '$argspecs'" - } - dict for {spec specval} $argspecs { + #assert - we only get here if it is a value or flag specification line. + #assert argspecs has been set to the value of linespecs + set merged $optspec_defaults + foreach {spec specval} $argspecs { #literal-key switch - bytecompiled to jumpTable switch -- $spec { - -default - -type - -range - -choices - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -ARGTYPE {} + -type { + #normalize here so we don't have to test during actual args parsing in main function + switch -- [string tolower $specval] { + int - integer { + dict set merged -type int + } + bool - boolean { + dict set merged -type bool + } + char - character { + dict set merged -type char + } + "" - none { + if {$is_opt} { + dict set merged -type none + dict set merged -default 0 ;#-default 0 can still be overridden if -default appears after -type - we'll allow it. + lappend opt_solos $argname + } else { + #-solo only valid for flags + error "punk::args::get_dict - invalid -type 'none' for positional argument positional argument '$argname'" + } + } + default { + dict set merged -type [string tolower $specval] + } + } + } + -default - -solo - -range - -choices - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -help - -ARGTYPE { + dict set merged $spec $specval + } default { - set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi] - error "punk::args::opts_values - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" + set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -help] + error "punk::args::get_dict - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } } } - set argspecs [dict merge $optspec_defaults $argspecs] - dict set arg_info $argname $argspecs + set argspecs $merged + #if {$is_opt} { + set argchecks [dict remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen + #} else { + # set argchecks [dict remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen + #} + dict set arg_info $argname $argspecs + dict set arg_checks $argname $argchecks if {![dict get $argspecs -optional]} { if {$is_opt} { - lappend required_opts $argname + lappend opt_required $argname } else { - lappend required_vals $argname + lappend val_required $argname } } - if {[dict exists $arg_info $argname -default]} { + if {[dict exists $argspecs -default]} { if {$is_opt} { - dict set defaults_dict_opts $argname [dict get $arg_info $argname -default] + dict set opt_defaults $argname [dict get $argspecs -default] } else { - dict set defaults_dict_values $argname [dict get $arg_info $argname -default] + dict set val_defaults $argname [dict get $argspecs -default] } } } - #puts "--> [info frame -2] <--" - set cmdinfo [dict get [info frame -2] cmd] - #we can't treat cmdinfo as a list - it may be something like {command {*}$args} in which case lindex $cmdinfo 0 won't work - #hopefully first word is a plain proc name if this function was called in the normal manner - directly from a proc - #we will break at first space and assume the lhs of that will give enough info to be reasonable - (alternatively we could use entire cmdinfo - but it might be big and ugly) - set caller [regexp -inline {\S+} $cmdinfo] + #confirm any valnames before last don't have -multiple key + foreach valname [lrange $val_names 0 end-1] { + if {[dict get $arg_info $valname -multiple]} { + error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" + } + } + if {$spec_id eq "" || [string tolower $spec_id] eq "auto"} { + variable id_counter + set spec_id "autoid_[incr id_counter]" + } + + set result [dict create\ + id $spec_id\ + arg_info $arg_info\ + arg_checks $arg_checks\ + opt_defaults $opt_defaults\ + opt_required $opt_required\ + opt_names $opt_names\ + opt_any $opt_any\ + opt_solos $opt_solos\ + optspec_defaults $optspec_defaults\ + valspec_defaults $valspec_defaults\ + val_defaults $val_defaults\ + val_required $val_required\ + val_names $val_names\ + val_min $val_min\ + val_max $val_max\ + valspec_defaults $valspec_defaults\ + proc_info $proc_info\ + ] + dict set argspec_cache $cache_key $result + dict set argspecs $spec_id $optionspecs + return $result + } + + proc get_spec {id} { + variable argspecs + if {[dict exists $argspecs $id]} { + return [dict get $argspecs $id] + } + return + } + proc get_spec_ids {{match *}} { + variable argspecs + return [dict keys $argspecs $match] + } - #if called from commandline or some other contexts such as outside of a proc in a namespace - caller may just be "namespace" + #for use within get_dict only + #This mechanism gets less-than-useful results for oo methods + #e.g {$obj} + proc Get_caller {} { + set cmdinfo [dict get [info frame -3] cmd] + #puts "-->$cmdinfo" + set caller [regexp -inline {\S+} $cmdinfo] if {$caller eq "namespace"} { - set caller "punk::args::opts_values called from namespace" + set caller "punk::args::get_dict called from namespace" } + return $caller + } - # ------------------------------ - if {$caller ne "punk::args::opts_values"} { - #check our own args - lassign [punk::args::opts_values "-anyopts -default 0\n -minvalues -default 0\n -maxvalues -default -1" $args] _o ownopts _v ownvalues - if {[llength $ownvalues] > 0} { - error "punk::args::opts_values expected: a multiline text block of option-specifications, a list of args and at most three option pairs -minvalues , -maxvalues , -anyopts true|false - got extra arguments: '$ownvalues'" - } - set opt_minvalues [dict get $ownopts -minvalues] - set opt_maxvalues [dict get $ownopts -maxvalues] - set opt_anyopts [dict get $ownopts -anyopts] + proc err {msg args} { + + } + + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values + #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. + #only supports -flag val pairs, not solo options + #If an option is supplied multiple times - only the last value is used. + proc get_dict {optionspecs args} { + #*** !doctools + #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values + #[para]Returns a dict of the form: opts values + #[para]ARGUMENTS: + #[list_begin arguments] + #[arg_def multiline-string optionspecs] + #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced + #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values + #[para]Each optionspec line defining a flag must be of the form: + #[para]-optionname -key val -key2 val2... + #[para]where the valid keys for each option specification are: -default -type -range -choices -optional + #[para]Each optionspec line defining a positional argument is of the form: + #[para]argumentname -key val -ky2 val2... + #[para]where the valid keys for each option specification are: -default -type -range -choices + #[para]comment lines begining with # are ignored and can be placed anywhere except within a multiline value where it would become part of that value + #[para]lines beginning with *proc *opts or *values also take -key val pairs and can be used to set defaults and control settings. + #[para]*opts or *values lines can appear multiple times with defaults affecting flags/values that follow. + #[arg_def list rawargs] + #[para] This is a list of the arguments to parse. Usually it will be the $args value from the containing proc, + #but it could be a manually constructed list of values made for example from positional args defined in the proc. + #[list_end] + #[para] + + #consider line-processing example below for which we need info complete to determine record boundaries + #punk::args::get_dict { + # *opts + # -opt1 -default {} + # -opt2 -default { + # etc + # } + # *values -multiple 1 + #} $args + + if {[llength $args] == 0} { + set rawargs [list] + } elseif {[llength $args] ==1} { + set rawargs [lindex $args 0] ;#default tcl style } else { - #don't check our own args if we called ourself - set opt_minvalues 0 - set opt_maxvalues 0 - set opt_anyopts 0 + #todo - can we support tk style vals before flags? + #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + error "unsupported" + set inopt 0 + set k "" + set i 0 + foreach a $args { + switch -- $f { + -opts { + + } + -vals { + + } + -optvals { + #tk style + + } + -valopts { + #tcl style + set rawargs [lindex $args $i+1] + incr i + } + default { + + } + } + incr i + } } - # ------------------------------ - if {[set eopts [lsearch $rawargs "--"]] >= 0} { + + set argspecs [Get_argspecs $optionspecs] + dict with argspecs {} ;#turn keys into vars + #puts "-arg_info->$arg_info" + set flagsreceived [list] + + set opts $opt_defaults + if {[set eopts [lsearch -exact $rawargs "--"]] >= 0} { set values [lrange $rawargs $eopts+1 end] set arglist [lrange $rawargs 0 $eopts-1] + set maxidx [expr {[llength $arglist]-1}] + for {set i 0} {$i <= $maxidx} {incr i} { + set a [lindex $arglist $i] + if {![string match -* $a]} { + #we can't treat as first positional arg - as it comes before the eopt indicator -- + error "punk::args::get_dict bad options for [Get_caller]. Expected flag (leading -) at position $i got:$rawargs" + } + #TODO! + if {[dict get $arg_info $a -type] ne "none"} { + if {[incr i] > $maxidx} { + error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $a which is not marked with -solo 1" + } + } + lappend flagsreceived $a ;#dups ok + } } else { if {[lsearch $rawargs -*] >= 0} { - #to support option values with leading dash e.g -offset -1 , we can't just take the last flagindex - set i 0 - foreach {k v} $rawargs { - if {![string match -* $k]} { + #no -- end of opts indicator + #to support option values with leading dash e.g -offset -1 , we can't just use the last flagindex to determine start of positional args. + #we break on first non-flag looking argument that isn't in an option's value position and use that index as the division. + #The caller should use -- if the first positional arg is likely or has the potential to start with a dash. + + set maxidx [expr {[llength $rawargs]-1}] + for {set i 0} {$i <= $maxidx} {incr i} { + set a [lindex $rawargs $i] + if {![string match -* $a]} { + #assume beginning of positional args + incr i -1 break - } - if {$i+1 >= [llength $rawargs]} { - #no value for last flag - error "bad options for $caller. No value supplied for last option $k" } - incr i 2 + + if {![catch {tcl::prefix match -message "options for %caller%. Unexpected option" $opt_names $a } fullopt]} { + if {[dict get $arg_info $fullopt -type] ne "none"} { + #non-solo + set flagval [lindex $rawargs $i+1] + if {[dict get $arg_info $fullopt -multiple]} { + dict lappend opts $fullopt $flagval + } else { + dict set opts $fullopt $flagval + } + #incr i to skip flagval + if {[incr i] > $maxidx} { + error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" + } + } else { + #type none (solo-flag) + if {[dict get $arg_info $fullopt -multiple]} { + if {[dict get $opts $fullopt] == 0} { + #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + dict set opts $fullopt 1 + } else { + dict lappend opts $fullopt 1 + } + } else { + dict set opts $fullopt 1 + } + } + lappend flagsreceived $fullopt ;#dups ok + } else { + if {$opt_any} { + set newval [lindex $rawargs $i+1] + #opt was unspecified but is allowed due to *opt -any 1 - 'adhoc/passthrough' option + dict set arg_info $a $optspec_defaults ;#use default settings for unspecified opt + if {[dict get $arg_info $a -type] ne "none"} { + if {[dict get $arg_info $a -multiple]} { + dict lappend opts $a $newval + } else { + dict set opts $a $newval + } + lappend flagsreceived $a ;#adhoc flag as supplied + if {[incr i] > $maxidx} { + error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" + } + } else { + #review -we can't provide a way to allow unspecified -type none flags through reliably/unambiguously unless all remaining unspecified options are -type none + if {[dict get $arg_info $a -multiple]} { + if {![dict exists $opts $a]} { + dict set opts $a 1 + } else { + dict lappend opts $a 1 + } + } else { + dict set opts $a 1 + } + } + } else { + #delay Get_caller so only called in the unhappy path + set errmsg [string map [list %caller% [Get_caller]] $fullopt] + error $errmsg + } + } } - set arglist [lrange $rawargs 0 $i-1] - set values [lrange $rawargs $i end] + set arglist [lrange $rawargs 0 $i] + set values [lrange $rawargs $i+1 end] + #puts "$i--->arglist:$arglist" + #puts "$i--->values:$values" } else { set values $rawargs ;#no -flags detected set arglist [list] } } - #confirm any valnames before last don't have -multiple key - foreach valname [lrange $value_names 0 end-1] { - if {[dict exists $arg_info $valname -multiple ]} { - error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" - } - } - set values_dict [dict create] set validx 0 set in_multiple "" - foreach valname $value_names val $values { - if {$validx+1 > [llength $values]} { + set valnames_received [list] + set values_dict $val_defaults + set num_values [llength $values] + foreach valname $val_names val $values { + if {$validx+1 > $num_values} { break } if {$valname ne ""} { - if {[dict exists $arg_info $valname -multiple] && [dict get $arg_info $valname -multiple]} { + if {[dict get $arg_info $valname -multiple]} { dict lappend values_dict $valname $val set in_multiple $valname } else { dict set values_dict $valname $val } + lappend valnames_received $valname } else { if {$in_multiple ne ""} { dict lappend values_dict $in_multiple $val + #name already seen } else { dict set values_dict $validx $val + dict set arg_info $validx $valspec_defaults + lappend valnames_received $validx } } incr validx } - if {$opt_maxvalues == -1} { + if {$val_max == -1} { #only check min - if {[llength $values] < $opt_minvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected at least $opt_minvalues" + if {$num_values < $val_min} { + error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected at least $val_min" } } else { - if {[llength $values] < $opt_minvalues || [llength $values] > $opt_maxvalues} { - if {$opt_minvalues == $opt_maxvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected exactly $opt_minvalues" + if {$num_values < $val_min || $num_values > $val_max} { + if {$val_min == $val_max} { + error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected exactly $val_min" } else { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected between $opt_minvalues and $opt_maxvalues inclusive" + error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected between $val_min and $val_max inclusive" } } } + + #assertion - opts keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options + + #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - foreach r $required_opts { - if {$r ni [dict keys $arglist]} { - error "Required option missing for $caller. '$r' is marked with -optional false - so must be present in its full-length form" - } + if {[llength [set missing [struct::set difference $opt_required $flagsreceived]]]} { + error "Required option missing for [Get_caller]. missing flags $missing are marked with -optional false - so must be present in full-length form" } - foreach r $required_vals { - if {$r ni [dict keys $values_dict]} { - error "Required value missing for $caller. '$r' is marked with -optional false - so must be present" - } - } - if {!$opt_anyopts} { - set checked_args [dict create] - for {set i 0} {$i < [llength $arglist]} {incr i} { - #allow this to error out with message indicating expected flags - set val [lindex $arglist $i+1] - set fullopt [tcl::prefix match -message "options for $caller. Unexpected option" [dict keys $arg_info] [lindex $arglist $i]] - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $val - } else { - dict set checked_args $fullopt $val - } - incr i ;#skip val - } - } else { - #still need to use tcl::prefix match to normalize - but don't raise an error - set checked_args [dict create] - dict for {k v} $arglist { - if {![catch {tcl::prefix::match [dict keys $arg_info] $k} fullopt]} { - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $v - } else { - dict set checked_args $fullopt $v - } - } else { - #opt was unspecified - dict set checked_args $k $v - } - } + if {[llength [set missing [struct::set difference $val_required $valnames_received]]]} { + error "Required value missing for [Get_caller]. missing values $missing marked with -optional false - so must be present" } - set opts [dict merge $defaults_dict_opts $checked_args] - #assertion - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options - - set values [dict merge $defaults_dict_values $values_dict] - #todo - allow defaults outside of choices/ranges #check types,ranges,choices - set opts_and_values [concat $opts $values] - set combined_defaults [concat $defaults_dict_values $defaults_dict_opts] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash - dict for {o v} $opts_and_values { - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - set vlist $v - } else { - set vlist [list $v] + set opts_and_values [dict merge $opts $values_dict] + #set combined_defaults [dict merge $val_defaults $opt_defaults] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash + #puts "---opts_and_values:$opts_and_values" + #puts "---arg_info:$arg_info" + dict for {argname v} $opts_and_values { + set thisarg [dict get $arg_info $argname] + #set thisarg_keys [dict keys $thisarg] + set thisarg_checks [dict get $arg_checks $argname] + set is_multiple [dict get $thisarg -multiple] + set is_allow_ansi [dict get $thisarg -allow_ansi] + set is_validate_without_ansi [dict get $thisarg -validate_without_ansi] + set is_strip_ansi [dict get $thisarg -strip_ansi] + set has_default [dict exists $thisarg -default] + if {$has_default} { + set defaultval [dict get $thisarg -default] } + set type [dict get $thisarg -type] + set has_choices [dict exists $thisarg -choices] - if {[dict exists $arg_info $o -validate_without_ansi] && [dict get $arg_info $o -validate_without_ansi]} { - set validate_without_ansi 1 - package require punk::ansi + if {$is_multiple} { + set vlist $v } else { - set validate_without_ansi 0 + set vlist [list $v] } - if {[dict exists $arg_info $o -allow_ansi] && [dict get $arg_info $o -allow_ansi]} { - set allow_ansi 1 - } else { + if {!$is_allow_ansi} { + #allow_ansi 0 package require punk::ansi - set allow_ansi 0 - } - - foreach e $vlist { - if {!$allow_ansi} { + foreach e $vlist { if {[punk::ansi::ta::detect $e]} { - error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'" + error "Option $argname for [Get_caller] contains ansi - but -allow_ansi is false. Received: '$e'" } } } - - set vlist_check [list] - foreach e $vlist { - if {$validate_without_ansi} { + if {$is_validate_without_ansi} { + #validate_without_ansi 1 + package require punk::ansi + set vlist_check [list] + foreach e $vlist { lappend vlist_check [punk::ansi::stripansi $e] - } else { - lappend vlist_check $e - } + } + } else { + #validate_without_ansi 0 + set vlist_check $vlist } set is_default 0 - foreach e $vlist e_check $vlist_check { - if {[dict exists $combined_defaults $o] && ($e_check eq [dict get $combined_defaults $o])} { - incr is_default + if {$has_default} { + foreach e_check $vlist_check { + if {$e_check eq $defaultval} { + incr is_default + } + } + if {$is_default eq [llength $vlist]} { + set is_default 1 } } - if {$is_default eq [llength $vlist]} { - set is_default true - } + #puts "argname:$argname v:$v is_default:$is_default" #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. - if {!$is_default} { - if {[dict exists $arg_info $o -type]} { - set type [dict get $arg_info $o -type] - switch -- [string tolower $type] { - int - - integer - - double { - if {[string tolower $type] in {int integer}} { - foreach e $vlist e_check $vlist_check { - if {![string is integer -strict $e_check]} { - error "Option $o for $caller requires type 'integer'. Received: '$e'" - } - } - } elseif {[string tolower $type] in {double}} { - foreach e $vlist e_check $vlist_check { - if {![string is double -strict $e_check]} { - error "Option $o for $caller requires type 'double'. Received: '$e'" - } - } - } - - #todo - small-value double comparisons with error-margin? review - if {[dict exists $arg_info $o -range]} { - lassign [dict get $arg_info $o -range] low high - foreach e $vlist e_check $vlist_check { - if {$e_check < $low || $e_check > $high} { - error "Option $o for $caller must be between $low and $high. Received: '$e'" + if {$is_default == 0} { + switch -- $type { + any {} + string { + if {[dict size $thisarg_checks]} { + foreach e_check $vlist_check { + dict for {checkopt checkval} $thisarg_checks { + switch -- $checkopt { + -minlen { + # -1 for disable is as good as zero + if {[string length $e_check] < $checkval} { + error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[string length $e_check] value:'$e_check'" + } + } + -maxlen { + if {$checkval ne "-1"} { + if {[string length $e_check] > $checkval} { + error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[string length $e_check] value:'$e_check'" + } + } + } } } } } - bool - - boolean { + } + ansistring { + package require ansi + } + int { + if {[dict exists $thisarg -range]} { + lassign [dict get $thisarg -range] low high foreach e $vlist e_check $vlist_check { - if {![string is boolean -strict $e_check]} { - error "Option $o for $caller requires type 'boolean'. Received: '$e'" + if {![string is integer -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" + } + if {$e_check < $low || $e_check > $high} { + error "Option $argname for [Get_caller] must be integer between $low and $high. Received: '$e'" } } + } else { + foreach e_check $vlist_check { + if {![string is integer -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" + } + } } - alnum - - alpha - - ascii - - control - - digit - - graph - - lower - - print - - punct - - space - - upper - - wordchar - - xdigit { - foreach e $vlist e_check $vlist_check { - if {![string is [string tolower $type] $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e'" + } + double { + foreach e $vlist e_check $vlist_check { + if {![string is double -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'double'. Received: '$e'" + } + if {[dict size $thisarg_checks]} { + dict for {checkopt checkval} $thisarg_checks { + switch -- $checkopt { + -range { + #todo - small-value double comparisons with error-margin? review + lassign $checkval low high + if {$e_check < $low || $e_check > $high} { + error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" + } + } + } } } } - file - - directory - - existingfile - - existingdirectory { + } + bool { + foreach e_check $vlist_check { + if {![string is boolean -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" + } + } + } + alnum - + alpha - + ascii - + control - + digit - + graph - + lower - + print - + punct - + space - + upper - + wordchar - + xdigit { + foreach e $vlist e_check $vlist_check { + if {![string is $type $e_check]} { + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + } + } + } + file - + directory - + existingfile - + existingdirectory { + foreach e $vlist e_check $vlist_check { + if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { + #what about special file names e.g on windows NUL ? + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" + } + } + if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { - if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which doesn't look like it could be a file or directory" + if {![file exists $e_check]} { + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" } } - if {[string tolower $type] in {existingfile}} { - foreach e $vlist e_check $vlist_check { - if {![file exists $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing file" - } - } - } elseif {[string tolower $type] in {existingdirectory}} { - foreach e $vlist e_check $vlist_check { - if {![file isdirectory $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing directory" - } + } elseif {$type eq "existingdirectory"} { + foreach e $vlist e_check $vlist_check { + if {![file isdirectory $e_check]} { + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" } } } - char - - character { - foreach e $vlist e_check $vlist_check { - if {[string length != 1]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not a single character" - } + } + char { + foreach e $vlist e_check $vlist_check { + if {[string length $e_check] != 1} { + error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" } } } } - if {[dict exists $arg_info $o -choices]} { - set choices [dict get $arg_info $o -choices] - set nocase [dict get $arg_info $o -nocase] + if {$has_choices} { + #todo -choicelabels + set choices [dict get $thisarg -choices] + set nocase [dict get $thisarg -nocase] foreach e $vlist e_check $vlist_check { if {$nocase} { set casemsg "(case insensitive)" @@ -553,34 +1053,31 @@ namespace eval punk::args { set choices_test $choices } if {$v_test ni $choices_test} { - error "Option $o for $caller must be one of the listed values $choices $casemsg. Received: '$e'" + error "Option $argname for [Get_caller] must be one of the listed values $choices $casemsg. Received: '$e'" } } } } - if {[dict exists $arg_info $o -strip_ansi] && [dict get $arg_info $o -strip_ansi]} { - set stripped_list [list] - foreach e $vlist { - lappend stripped_list [punk::ansi::stripansi $e] - } - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o $stripped_list + if {$is_strip_ansi} { + set stripped_list [lmap e $vlist {punk::ansi::stripansi $e}] ;#no faster or slower, but more concise than foreach + if {[dict get $thisarg -multiple]} { + if {[dict get $thisarg -ARGTYPE] eq "option"} { + dict set opts $argname $stripped_list } else { - dict set values $o $stripped_list + dict set values_dict $argname $stripped_list } } else { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o [lindex $stripped_list 0] + if {[dict get $thisarg -ARGTYPE] eq "option"} { + dict set opts $argname [lindex $stripped_list 0] } else { - dict set values [lindex $stripped_list 0] + dict set values_dict [lindex $stripped_list 0] } } } } #maintain order of opts $opts values $values as caller may use lassign. - return [dict create opts $opts values $values] + return [dict create opts $opts values $values_dict] } #proc sample1 {p1 args} { diff --git a/src/bootsupport/modules/punk/cap-0.1.0.tm b/src/bootsupport/modules/punk/cap-0.1.0.tm index 3f3556f..8488bbc 100644 --- a/src/bootsupport/modules/punk/cap-0.1.0.tm +++ b/src/bootsupport/modules/punk/cap-0.1.0.tm @@ -350,15 +350,19 @@ namespace eval punk::cap { variable pkgcapsdeclared variable pkgcapsaccepted variable caps - set defaults [dict create\ + set opts [dict create\ -nowarnings false ] - dict for {k v} $args { - if {$k ni $defaults} { - error "Unrecognized option $k. Known options [dict keys $defaults]" + foreach {k v} $args { + switch -- $k { + -nowarnings { + dict set opts $k $v + } + default { + error "Unrecognized option $k. Known options [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] set warnings [expr {! [dict get $opts -nowarnings]}] if {[string match ::* $pkg]} { @@ -433,13 +437,14 @@ namespace eval punk::cap { #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append - but check not already present #dict lappend pkgcapsdeclared $pkg $capabilitylist if {[dict exists $pkgcapsdeclared $pkg]} { - set capspecs [dict get $pkgcapsdeclared $pkg] - foreach spec $capspecs { - if {$spec ni $capspecs} { - lappend capspecs $spec + #review - untested + set mergecapspecs [dict get $pkgcapsdeclared $pkg] + foreach spec $capabilitylist { + if {$spec ni $mergecapspecs} { + lappend mergecapspecs $spec } } - dict set pkgcapsdeclared $pkg $capspecs + dict set pkgcapsdeclared $pkg $mergecapspecs } else { dict set pkgcapsdeclared $pkg $capabilitylist } diff --git a/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm b/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm index f3e75ea..ab101e1 100644 --- a/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm +++ b/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm @@ -242,9 +242,12 @@ namespace eval punk::cap::handlers::templates { set capabilityname $capname } method folders {args} { - lassign [punk::args::opts_values { + set argd [punk::args::get_dict { -startdir -default "" - } $args -maxvalues 0] _o opts + *values -max 0 + } $args] + set opts [dict get $argd opts] + set opt_startdir [dict get $opts -startdir] if {$opt_startdir eq ""} { set startdir [pwd] @@ -456,11 +459,14 @@ namespace eval punk::cap::handlers::templates { return $folderdict } method get_itemdict_projectlayouts {args} { - lassign [punk::args::opts_values { - -startdir -default "" + set argd [punk::args::get_dict { + *opts -anyopts 1 #peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here - } $args -maxvalues -1 -anyopts 1] _o opts _v values - set opt_startdir [dict get $opts -startdir] + -startdir -default "" + *values -maxvalues -1 + } $args] + set opt_startdir [dict get $argd opts -startdir] + if {$opt_startdir eq ""} { set searchbase [pwd] } else { @@ -628,15 +634,18 @@ namespace eval punk::cap::handlers::templates { #and a file selection mechanism command -command_get_items_from_base #and a name determining command -command_get_item_name method _get_itemdict {args} { - lassign [punk::args::opts_values { - -startdir -default "" - -templatefolder_subdir -optional 0 - -command_get_items_from_base -optional 0 - -command_get_item_name -optional 0 - -not -default "" -multiple 1 + set argd [punk::args::get_dict { + *opts -anyopts 0 + -startdir -default "" + -templatefolder_subdir -optional 0 + -command_get_items_from_base -optional 0 + -command_get_item_name -optional 0 + -not -default "" -multiple 1 + *values -maxvalues -1 globsearches -default * -multiple 1 - } $args -maxvalues -1] _o opts _v values - set globsearches [dict get $values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results + } $args] + set opts [dict get $argd opts] + set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results # -- --- --- --- --- --- --- --- --- set opt_startdir [dict get $opts -startdir] set opt_templatefolder_subdir [dict get $opts -templatefolder_subdir] diff --git a/src/bootsupport/modules/punk/char-0.1.0.tm b/src/bootsupport/modules/punk/char-0.1.0.tm index 43c449c..d4bd4c4 100644 --- a/src/bootsupport/modules/punk/char-0.1.0.tm +++ b/src/bootsupport/modules/punk/char-0.1.0.tm @@ -1205,22 +1205,25 @@ namespace eval punk::char { } proc char_info_dec {dec args} { set dec_char [expr {$dec}] - set defaults [dict create\ + set opts [dict create\ -fields {default}\ -except {}\ ] - set known_opts [dict keys $defaults] #testwidth is so named because it peforms an actual test on the console using ansi escapes - and the name gives a hint that it is a little slow set known_fields [list all default dec hex desc short testwidth char memberof] ;#maint fields from charinfo 'desc' 'short' #todo - unicode properties # tclwhitespace (different to unicode concept of whitespace. review ) foreach {k v} $args { - if {![dict exists $defaults $k]} { - error "char_info unrecognised option '$k'. Known options:'$known_opts' known_fields: $known_fields usage: char_info ?-fields {}? ?-except {}?" + switch -- $k { + -fields - -except { + dict set opts $k $v + } + default { + error "char_info unrecognised option '$k'. Known options:'[dict keys $opts]' known_fields: $known_fields usage: char_info ?-fields {}? ?-except {}?" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- set opt_fields [dict get $opts -fields] set opt_except [dict get $opts -except] @@ -1569,6 +1572,7 @@ namespace eval punk::char { if {$name_or_glob eq "*"} { return [lsort [dict keys $charsets]] } + #dict keys $dict doesn't have option for case insensitive searches return [lsort [lsearch -all -inline -nocase [dict keys $charsets] $name_or_glob]] } } diff --git a/src/bootsupport/modules/punk/console-0.1.1.tm b/src/bootsupport/modules/punk/console-0.1.1.tm index 158368c..7697288 100644 --- a/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/bootsupport/modules/punk/console-0.1.1.tm @@ -671,7 +671,7 @@ namespace eval punk::console { } else { #! todo? for now, emit a clue as to what's happening. puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload cannot trigger existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - if {$::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[eof $input]} { puts stdout "restarting repl" repl::reopen_stdin @@ -682,7 +682,7 @@ namespace eval punk::console { #Note - we still may be in_repl_handler here (which disables its own reader while executing commandlines) #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? - } elseif {$::repl::running} { + } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy @@ -1030,10 +1030,29 @@ namespace eval punk::console { #todo - determine cursor on/off state before the call to restore properly. May only be possible proc get_size {{inoutchannels {stdin stdout}}} { lassign $inoutchannels in out + #we can't reliably use [chan names] for stdin,stdout. There could be stacked channels and they may have a names such as file22fb27fe810 + #chan eof is faster whether chan exists or not than + if {[catch {chan eof $in} is_eof]} { + error "punk::console::get_size input channel $in seems to be closed ([info level 1])" + } else { + if {$is_eof} { + error "punk::console::get_size eof on input channel $in ([info level 1])" + } + } + if {[catch {chan eof $out} is_eof]} { + error "punk::console::get_size output channel $out seems to be closed ([info level 1])" + } else { + if {$is_eof} { + error "punk::console::get_size eof on output channel $out ([info level 1])" + } + } + + #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + lassign [get_cursor_pos_list $inoutchannels] start_row start_col + if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - lassign [get_cursor_pos_list $inoutchannels] start_row start_col puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout @@ -1251,7 +1270,7 @@ namespace eval punk::console { return [exec {*}$cmd1] } else { puts stderr "infocmp doesn't seem to be present" - if {$::tcl_platform(os) eq "FreeBSD"} { + if {$::tcl_platform(platform) eq "FreeBSD"} { puts stderr "For FreeBSD - install ncurses to get infocmp and related binaries and also install terminfo-db" } set tcmd [auto_execok tput] @@ -1395,6 +1414,9 @@ namespace eval punk::console { namespace import ansi::insert_lines namespace import ansi::delete_lines + interp alias {} smcup {} ::punk::console::enable_alt_screen + interp alias {} rmcup {} ::punk::console::disable_alt_screen + #experimental proc rhs_prompt {col text} { package require textblock @@ -1784,11 +1806,13 @@ namespace eval punk::console { - - - - - +interp alias {} colour {} punk::console::colour +interp alias {} ansi {} punk::console::ansi +interp alias {} color {} punk::console::colour +interp alias {} a+ {} punk::console::code_a+ +interp alias {} a= {} punk::console::code_a +interp alias {} a {} punk::console::code_a +interp alias {} a? {} punk::console::code_a? diff --git a/src/bootsupport/modules/punk/du-0.1.0.tm b/src/bootsupport/modules/punk/du-0.1.0.tm index 987ade3..121f1fb 100644 --- a/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/src/bootsupport/modules/punk/du-0.1.0.tm @@ -25,8 +25,10 @@ namespace eval punk::du { variable has_twapi 0 } if {"windows" eq $::tcl_platform(platform)} { - package require zzzload - zzzload::pkg_require twapi + if {![interp issafe]} { + package require zzzload + zzzload::pkg_require twapi + } if {[catch {package require twapi}]} { puts stderr "Warning: punk::du - unable to load twapi. Disk operations may be much slower on windows without the twapi package" @@ -818,19 +820,22 @@ namespace eval punk::du { #this is the cross-platform pure-tcl version - which calls glob multiple times to make sure it gets everythign it needs and can ignore everything it needs to. #These repeated calls to glob will be a killer for performance - especially on a network share or when walking a large directory structure proc du_dirlisting_generic {folderpath args} { - set defaults [dict create\ + set opts [dict create\ -glob *\ -with_sizes 0\ -with_times 0\ ] set errors [dict create] - set known_opts [dict keys $defaults] - dict for {k -} $args { - if {$k ni $known_opts} { - error "du_dirlisting_generic unknown-option $k" + foreach {k v} $args { + switch -- $k { + -glob - -with_sizes - -with_times { + dict set opts $k $v + } + default { + error "du_dirlisting_generic unknown-option '$k'. Known-options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- diff --git a/src/bootsupport/modules/punk/fileline-0.1.0.tm b/src/bootsupport/modules/punk/fileline-0.1.0.tm index 44b1f9c..54c693d 100644 --- a/src/bootsupport/modules/punk/fileline-0.1.0.tm +++ b/src/bootsupport/modules/punk/fileline-0.1.0.tm @@ -1,4 +1,4 @@ -# -*- tcl -*- +# -*- 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. @@ -275,7 +275,7 @@ namespace eval punk::fileline::class { #[call class::textinfo [method chunk_boundary_display]] #[para]Returns a string displaying the boundaries at chunksize bytes between chunkstart and chunkend #[para]Defaults to using ansi colour if punk::ansi module is available. Use -ansi 0 to disable colour - set defaults [dict create\ + set opts [dict create\ -ansi $::punk::fileline::ansi::enabled\ -offset 0\ -displaybytes 200\ @@ -292,11 +292,15 @@ namespace eval punk::fileline::class { ] set known_opts [dict keys $defaults] foreach {k v} $args { - if {$k ni $known_opts} { - error "[self]::chunk_boundary error: unknown option '$k'. Known options: $known_opts" + switch -- $k { + -ansi - -offset - -displaybytes - -truncatedmark - -completemark - -moremark - -continuemark - -linemaxwidth - -linebase - -limit - -boundaries - -showconfig - -boundaryheader { + dict set opts $k $v + } + default { + error "[self]::chunk_boundary error: unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- set opt_ansi [dict get $opts -ansi] set opt_offset [dict get $opts -offset] @@ -612,20 +616,23 @@ namespace eval punk::fileline::class { #[para]This is true even if only a single square bracket is being searched for. e.g {*[lb]file*} will not find the word file followed by a left square-bracket - even though the search didn't close the square brackets. #[para]In the above case - the literal search should be {*\[lb]file*} - set defaults [dict create\ + set opts [dict create\ -limit 0\ -strategy 1\ -start 0\ -end end\ -limitfrom start\ ] - set known_opts [dict keys $defaults] - dict for {k v} $args { - if {$k ni $known_opts} { - error "linepayload_find_glob unknown option '$k'. Known options: $known_opts" + foreach {k v} $args { + switch -- $k { + -limit - -strategy - -start - -end - -limitfrom { + dict set opts $k $v + } + default { + error "linepayload_find_glob unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_limit [dict get $opts -limit] if {![string is integer -strict $opt_limit] || $opt_limit < 0} { @@ -1261,13 +1268,14 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding binary if this isn't suitable and you need to do your own processing of the raw data. - set defaults { + set argument_specification { -file -default {} -type existingfile -translation -default binary -encoding -default "\uFFFF" -includebom -default 0 + *values -min 0 -max 1 } - lassign [dict values [punk::args::opts_values $defaults $args -minvalues 0 -maxvalues 1]] opts values + lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] @@ -1591,16 +1599,19 @@ namespace eval punk::fileline::system { #much faster when resultant boundary size is large (at least when offset 0) proc _range_spans_chunk_boundaries_lseq {start end chunksize args} { if {$chunksize < 1} {error "chunksize must be > 0"} ;#sanitycheck in case called directly - set defaults [dict create\ + set opts [dict create\ -offset 0\ ] - set known_opts [dict keys $defaults] foreach {k v} $args { - if {$k ni $known_opts} { - error "unknown option '$k'. Known options: $known_opts" + switch -- $k { + -offset { + dict set opts $k $v + } + default { + error "unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- set opt_offset [dict get $opts -offset] # -- --- --- --- diff --git a/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/bootsupport/modules/punk/lib-0.1.1.tm index 7a3e98a..c257178 100644 --- a/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -96,6 +96,57 @@ namespace eval punk::lib::class { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::lib::ensemble { + #wiki.tcl-lang.org/page/ensemble+extend + # extend an ensemble-like routine with the routines in some namespace + proc extend {routine extension} { + if {![string match ::* $routine]} { + set resolved [uplevel 1 [list ::namespace which $routine]] + if {$resolved eq {}} { + error [list {no such routine} $routine] + } + set routine $resolved + } + set routinens [namespace qualifiers $routine] + if {$routinens eq {::}} { + set routinens {} + } + set routinetail [namespace tail $routine] + + if {![string match ::* $extension]} { + set extension [uplevel 1 [ + list [namespace which namespace] current]]::$extension + } + + if {![namespace exists $extension]} { + error [list {no such namespace} $extension] + } + + set extension [namespace eval $extension [ + list [namespace which namespace] current]] + + namespace eval $extension [ + list [namespace which namespace] export *] + + while 1 { + set renamed ${routinens}::${routinetail}_[info cmdcount] + if {[namespace which $renamed] eq {}} break + } + + rename $routine $renamed + + namespace eval $extension [ + list namespace ensemble create -command $routine -unknown [ + list apply {{renamed ensemble routine args} { + list $renamed $routine + }} $renamed + ] + ] + + return $routine + } +} + namespace eval punk::lib::compat { #*** !doctools #[subsection {Namespace punk::lib::compat}] @@ -228,6 +279,46 @@ namespace eval punk::lib::compat { return $result } + #tcl8.7/9 compatibility for 8.6 + if {[info commands ::tcl::string::insert] eq ""} { + #https://wiki.tcl-lang.org/page/string+insert + # Pure Tcl implementation of [string insert] command. + proc ::tcl::string::insert {string index insertString} { + # Convert end-relative and TIP 176 indexes to simple integers. + if {[regexp -expanded { + ^(end(?![\t\n\v\f\r ]) # "end" is never followed by whitespace + |[\t\n\v\f\r ]*[+-]?\d+) # m, with optional leading whitespace + (?:([+-]) # op, omitted when index is "end" + ([+-]?\d+))? # n, omitted when index is "end" + [\t\n\v\f\r ]*$ # optional whitespace (unless "end") + } $index _ m op n]} { + # Convert first index to an integer. + switch $m { + end {set index [string length $string]} + default {scan $m %d index} + } + + # Add or subtract second index, if provided. + switch $op { + + {set index [expr {$index + $n}]} + - {set index [expr {$index - $n}]} + } + } elseif {![string is integer -strict $index]} { + # Reject invalid indexes. + return -code error "bad index \"$index\": must be\ + integer?\[+-\]integer? or end?\[+-\]integer?" + } + + # Concatenate the pre-insert, insertion, and post-insert strings. + string cat [string range $string 0 [expr {$index - 1}]] $insertString\ + [string range $string $index end] + } + + # Bind [string insert] to [::tcl::string::insert]. + namespace ensemble configure string -map [dict replace\ + [namespace ensemble configure string -map]\ + insert ::tcl::string::insert] + } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::compat ---}] } @@ -244,6 +335,28 @@ namespace eval punk::lib { #[para] Core API functions for punk::lib #[list_begin definitions] + proc range {from to args} { + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster for larger ranges + return [lseq $from $to] + } + set count [expr {($to -$from) + 1}] + incr from -1 + return [lmap v [lrepeat $count 0] {incr from}] + } + proc is_list_all_in_list {small large} { + package require struct::list + package require struct::set + set small_in_large [lsort [struct::set intersect [lsort -unique $small] $large ]] + return [struct::list equal [lsort $small] $small_in_large] + } + proc is_list_all_ni_list {a b} { + package require struct::set + set i [struct::set intersect $a $b] + return [expr {[llength $i] == 0}] + } + + #The closure-like behaviour is *very* slow especially when called from a context such as the global namespace with lots of vars and large arrays such as ::env proc lmapflat_closure {varnames list script} { set result [list] @@ -548,16 +661,14 @@ namespace eval punk::lib { if {[llength $argopts]%2 !=0} { error "[namespace current]::hex2dec arguments prior to list_largeHex must be option/value pairs - received '$argopts'" } - set defaults [dict create\ + set opts [dict create\ -validate 1\ -empty_as_hex "INVALID set -empty_as_hex to a hex string e.g FF if empty values should be replaced"\ ] - set known_opts [dict keys $defaults] - set fullopts [dict create] - dict for {k v} $argopts { - dict set fullopts [tcl::prefix match -message "options for hex2dec. Unexpected option" $known_opts $k] $v + set known_opts [dict keys $opts] + foreach {k v} $argopts { + dict set opts [tcl::prefix match -message "options for hex2dec. Unexpected option" $known_opts $k] $v } - set opts [dict merge $defaults $fullopts] # -- --- --- --- set opt_validate [dict get $opts -validate] set opt_empty [dict get $opts -empty_as_hex] @@ -606,7 +717,7 @@ namespace eval punk::lib { ] set known_opts [dict keys $defaults] set fullopts [dict create] - dict for {k v} $argopts { + foreach {k v} $argopts { dict set fullopts [tcl::prefix match -message "options for [namespace current]::dec2hex. Unexpected option" $known_opts $k] $v } set opts [dict merge $defaults $fullopts] @@ -1050,10 +1161,13 @@ namespace eval punk::lib { return [join $lines $joinchar] } proc list_as_lines2 {args} { - #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible - lassign [dict values [punk::lib::opts_values -minvalues 1 -maxvalues 1 { + #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible? + lassign [dict values [punk::args::get_dict { -joinchar -default \n + *values -min 1 -max 1 } $args]] opts values + puts "opts:$opts" + puts "values:$values" return [join [dict get $values 0] [dict get $opts -joinchar]] } @@ -1089,7 +1203,8 @@ namespace eval punk::lib { #-anyopts 1 avoids having to know what to say if odd numbers of options passed etc #we don't have to decide what is an opt vs a value #even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block) - lassign [dict values [punk::lib::opts_values -anyopts 1 { + lassign [dict values [punk::args::get_dict { + *opts -any 1 -block -default {} } $args]] opts valuedict tailcall linelist {*}$opts {*}[dict values $valuedict] @@ -1107,22 +1222,23 @@ namespace eval punk::lib { set text [string map [list \r\n \n] $text] ;#review - option? set arglist [lrange $args 0 end-1] - set defaults [dict create\ + set opts [dict create\ -block {trimhead1 trimtail1}\ -line {}\ -commandprefix ""\ -ansiresets auto\ -ansireplays 0\ ] - dict for {o v} $arglist { + foreach {o v} $arglist { switch -- $o { - -block - -line - -commandprefix - -ansiresets - -ansireplays {} + -block - -line - -commandprefix - -ansiresets - -ansireplays { + dict set opts $o $v + } default { error "linelist: Unrecognized option '$o' usage:$usage" } } } - set opts [dict merge $defaults $arglist] # -- --- --- --- --- --- set opt_block [dict get $opts -block] if {[llength $opt_block]} { @@ -1157,9 +1273,20 @@ namespace eval punk::lib { # -- --- --- --- --- --- set opt_line [dict get $opts -line] + set tl_left 0 + set tl_right 0 + set tl_both 0 foreach lo $opt_line { switch -- $lo { - trimline - trimleft - trimright {} + trimline { + set tl_both 1 + } + trimleft { + set tl_left 1 + } + trimright { + set tl_right 1 + } default { set known_lineopts [list trimline trimleft trimright] error "linelist: unknown -line option value: $lo known values: $known_lineopts" @@ -1167,8 +1294,9 @@ namespace eval punk::lib { } } #normalize trimleft trimright combo - if {"trimleft" in $opt_line && "trimright" in $opt_line} { + if {$tl_left && $tl_right} { set opt_line [list "trimline"] + set tl_both 1 } # -- --- --- --- --- --- set opt_commandprefix [dict get $opts -commandprefix] @@ -1192,14 +1320,18 @@ namespace eval punk::lib { set linelist $nlsplit #lappend linelist {*}$nlsplit } else { - foreach ln $nlsplit { - #already normalized trimleft+trimright to trimline - if {"trimline" in $opt_line} { - lappend linelist [string trim $ln] - } elseif {"trimleft" in $opt_line} { + #already normalized trimleft+trimright to trimline + if {$tl_both} { + foreach ln $nlsplit { + lappend linelist [string trim $ln] + } + } elseif {$tl_left} { + foreach ln $nlsplit { lappend linelist [string trimleft $ln] - } elseif {"trimright" in $opt_line} { - lappend linelist [string trimright $ln] + } + } elseif {$tl_right} { + foreach ln $nlsplit { + lappend linelist [string trimright $ln] } } } @@ -1397,544 +1529,6 @@ namespace eval punk::lib { return $linelist } - #maintenance - take over from punk::args - or put back in punk::args once fixed to support pipeline argument order - #possible improvements - after the 1st call, replace the callsite in the calling proc with an inline script to process and validate the arguments as specified in optionspecs - #This would require a tcl parser .. and probably lots of other work - #It would also probably only be practical if there are no dynamic entries in the optionspecs. An option for opts_values to indicate the caller wants this optimisation would probably be best. - - #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values - #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. - #only supports -flag val pairs, not solo options - #If an option is supplied multiple times - only the last value is used. - proc opts_values {args} { - #*** !doctools - #[call [fun opts_values] [opt {option value...}] [arg optionspecs] [arg rawargs] ] - #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values - #[para]Returns a dict of the form: opts values - #[para]ARGUMENTS: - #[list_begin arguments] - #[arg_def multiline-string optionspecs] - #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced - #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values - #[para]Each optionspec line must be of the form: - #[para]-optionname -key val -key2 val2... - #[para]where the valid keys for each option specification are: -default -type -range -choices -optional - #[arg_def list rawargs] - #[para] This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc - #[list_end] - #[para] - - #consider line-processing example below for we need info complete to determine record boundaries - #punk::lib::opt_values { - # -opt1 -default {} - # -opt2 -default { - # etc - # } -multiple 1 - #} $args - - #-- cannot be used to allow opts_values itself to accept rawargs as separate values - so it doesn't serve much purpose other than as an indicator of intention - #For consistency we support it anyway. - #we have to be careful with end-of-options flag -- - #It may legitimately be the only value in the rawargs list (which is a bit odd - but possible) or it may occur immediately before optionspecs and rawargs - #if there is more than one entry in rawargs - we won't find it anyway - so that's ok - set eopts_posn [lsearch $args --] - if {$eopts_posn == ([llength $args]-1)} { - #sole argument in rawargs - not the one we're looking for - set eopts_posn -1 - } - if {$eopts_posn >= 0} { - set ov_opts [lrange $args 0 $eopts_posn-1] - set ov_vals [lrange $args $eopts_posn+1 end] - } else { - set ov_opts [lrange $args 0 end-2] - set ov_vals [lrange $args end-1 end] - } - if {[llength $ov_vals] < 2 || [llength $ov_opts] %2 != 0} { - error "opts_args wrong # args: should be opts_values ?opt val?... optionspecs rawargs_as_list - } - set optionspecs [lindex $ov_vals 0] - set optionspecs [string map [list \r\n \n] $optionspecs] - - set rawargs [lindex $ov_vals 1] - - set optspec_defaults [dict create\ - -optional 1\ - -allow_ansi 1\ - -validate_without_ansi 0\ - -strip_ansi 0\ - -nocase 0\ - ] - set required_opts [list] - set required_vals [list] - set arg_info [dict create] - set defaults_dict_opts [dict create] - set defaults_dict_values [dict create] - #first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end - set value_names [list] - - set records [list] - set linebuild "" - foreach rawline [split $optionspecs \n] { - set recordsofar [string cat $linebuild $rawline] - if {![info complete $recordsofar]} { - append linebuild [string trimleft $rawline] \n - } else { - lappend records [string cat $linebuild $rawline] - set linebuild "" - } - } - - foreach ln $records { - set trimln [string trim $ln] - switch -- [string index $trimln 0] { - "" - # {continue} - } - set argname [lindex $trimln 0] - set argspecs [lrange $trimln 1 end] - if {[llength $argspecs] %2 != 0} { - error "punk::lib::opts_values - bad optionspecs line for argument '$argname' Remaining items on line must be in paired option-value format - received '$argspecs'" - } - if {[string match -* $argname]} { - dict set argspecs -ARGTYPE option - set is_opt 1 - } else { - dict set argspecs -ARGTYPE value - lappend value_names $argname - set is_opt 0 - } - dict for {spec specval} $argspecs { - switch -- $spec { - -default - -type - -range - -choices - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -ARGTYPE {} - default { - set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -ARGTYPE] - error "punk::lib::opts_values - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" - } - } - } - set argspecs [dict merge $optspec_defaults $argspecs] - dict set arg_info $argname $argspecs - if {![dict get $argspecs -optional]} { - if {$is_opt} { - lappend required_opts $argname - } else { - lappend required_vals $argname - } - } - if {[dict exists $arg_info $argname -default]} { - if {$is_opt} { - dict set defaults_dict_opts $argname [dict get $arg_info $argname -default] - } else { - dict set defaults_dict_values $argname [dict get $arg_info $argname -default] - } - } - } - - #puts "--> [info frame -2] <--" - set cmdinfo [dict get [info frame -2] cmd] - #we can't treat cmdinfo as a list - it may be something like {command {*}$args} in which case lindex $cmdinfo 0 won't work - #hopefully first word is a plain proc name if this function was called in the normal manner - directly from a proc - #we will break at first space and assume the lhs of that will give enough info to be reasonable - (alternatively we could use entire cmdinfo - but it might be big and ugly) - set caller [regexp -inline {\S+} $cmdinfo] - - #if called from commandline or some other contexts such as outside of a proc in a namespace - caller may just be "namespace" - if {$caller eq "namespace"} { - set caller "punk::lib::opts_values called from namespace" - } - - # ------------------------------ - if {$caller ne "punk::lib::opts_values"} { - #1) check our caller's call to us - recursive version - perhaps more elegant to eat our own dogfood - but maybe too much overhead for a script-based args processor which is already quite heavy :/ - #lassign [punk::lib::opts_values "-anyopts -default 0 -type integer\n -minvalues -default 0 -type integer\n -maxvalues -default -1 -type integer" $args] _o ownopts _v ownvalues - #if {[dict size $ownvalues] != 2} { - # error "punk::lib::opts_values expected: a multiline text block of option-specifications, a list of args and at most three option pairs -minvalues , -maxvalues , -anyopts true|false - got extra arguments: '$ownvalues'" - #} - #set opt_minvalues [dict get $ownopts -minvalues] - #set opt_maxvalues [dict get $ownopts -maxvalues] - #set opt_anyopts [dict get $ownopts -anyopts] - - #2) Quick and dirty - but we don't need much validation - set defaults [dict create\ - -minvalues 0\ - -maxvalues -1\ - -anyopts 0\ - ] - dict for {k v} $ov_opts { - if {$k ni {-minvalues -maxvalues -anyopts}} { - error "punk::lib::opts_values unrecognised option $k. Known values [dict keys $defaults]" - } - if {![string is integer -strict $v]} { - error "punk::lib::opts_values argument $k must be of type integer" - } - } - set ov_opts [dict merge $defaults $ov_opts] - set opt_minvalues [dict get $ov_opts -minvalues] - set opt_maxvalues [dict get $ov_opts -maxvalues] - set opt_anyopts [dict get $ov_opts -anyopts] - } else { - #don't recurse ie don't check our own args if we called ourself - set opt_minvalues 2 - set opt_maxvalues 2 - set opt_anyopts 0 - } - # ------------------------------ - - if {[set eopts [lsearch $rawargs "--"]] >= 0} { - set values [lrange $rawargs $eopts+1 end] - set arglist [lrange $rawargs 0 $eopts-1] - } else { - if {[lsearch $rawargs -*] >= 0} { - #to support option values with leading dash e.g -offset -1 , we can't just take the last flagindex - set i 0 - foreach {k v} $rawargs { - if {![string match -* $k]} { - break - } - if {$i+1 >= [llength $rawargs]} { - #no value for last flag - error "bad options for $caller. No value supplied for last option $k" - } - incr i 2 - } - set arglist [lrange $rawargs 0 $i-1] - set values [lrange $rawargs $i end] - } else { - set arglist [list] - set values $rawargs ;#no -flags detected - } - } - #confirm any valnames before last don't have -multiple key - foreach valname [lrange $value_names 0 end-1] { - if {[dict exists $arg_info $valname -multiple ]} { - error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" - } - } - set values_dict [dict create] - set validx 0 - set in_multiple "" - foreach valname $value_names val $values { - if {$validx+1 > [llength $values]} { - break - } - if {$valname ne ""} { - if {[dict exists $arg_info $valname -multiple] && [dict get $arg_info $valname -multiple]} { - dict lappend values_dict $valname $val - set in_multiple $valname - } else { - dict set values_dict $valname $val - } - } else { - if {$in_multiple ne ""} { - dict lappend values_dict $in_multiple $val - } else { - dict set values_dict $validx $val - } - } - incr validx - } - - if {$opt_maxvalues == -1} { - #only check min - if {[llength $values] < $opt_minvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected at least $opt_minvalues" - } - } else { - if {[llength $values] < $opt_minvalues || [llength $values] > $opt_maxvalues} { - if {$opt_minvalues == $opt_maxvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected exactly $opt_minvalues" - } else { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected between $opt_minvalues and $opt_maxvalues inclusive" - } - } - } - #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) - #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW - #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. - #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level - #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - set argnamespresent [dict keys $arglist] - foreach r $required_opts { - if {$r ni $argspresent} { - error "Required option missing for $caller. '$r' is marked with -optional false - so must be present in its full-length form" - } - } - set valuenamespresent [dict keys $values_dict] - foreach r $required_vals { - if {$r ni $valuenamespresent} { - error "Required value missing for $caller. '$r' is marked with -optional false - so must be present" - } - } - if {!$opt_anyopts} { - set checked_args [dict create] - for {set i 0} {$i < [llength $arglist]} {incr i} { - #allow this to error out with message indicating expected flags - set val [lindex $arglist $i+1] - set fullopt [tcl::prefix match -message "options for $caller. Unexpected option" [dict keys $arg_info] [lindex $arglist $i]] - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $val - } else { - dict set checked_args $fullopt $val - } - incr i ;#skip val - } - } else { - #still need to use tcl::prefix match to normalize - but don't raise an error - set checked_args [dict create] - dict for {k v} $arglist { - if {![catch {tcl::prefix::match [dict keys $arg_info] $k} fullopt]} { - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $v - } else { - dict set checked_args $fullopt $v - } - } else { - #opt was unspecified - dict set checked_args $k $v - } - } - } - set opts [dict merge $defaults_dict_opts $checked_args] - #assertion - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options - - set values [dict merge $defaults_dict_values $values_dict] - - #todo - allow defaults outside of choices/ranges - - #check types,ranges,choices - set opts_and_values [concat $opts $values] - set combined_defaults [concat $defaults_dict_values $defaults_dict_opts] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash - dict for {o v} $opts_and_values { - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - set vlist $v - } else { - set vlist [list $v] - } - - if {[dict exists $arg_info $o -validate_without_ansi] && [dict get $arg_info $o -validate_without_ansi]} { - set validate_without_ansi 1 - package require punk::ansi - } else { - set validate_without_ansi 0 - } - if {[dict exists $arg_info $o -allow_ansi] && [dict get $arg_info $o -allow_ansi]} { - set allow_ansi 1 - } else { - #ironically - we need punk::ansi to detect and disallow - but we don't need it if ansi is allowed - package require punk::ansi - set allow_ansi 0 - } - if {!$allow_ansi} { - #detect should work fine directly on whole list - if {[punk::ansi::ta::detect $vlist]} { - error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: [ansistring VIEW $vlist]" - } - #foreach e $vlist { - # if {[punk::ansi::ta::detect $e]} { - # error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'" - # } - #} - } - - set vlist_check [list] - foreach e $vlist { - #could probably stripansi entire list safely in one go? - review - if {$validate_without_ansi} { - lappend vlist_check [punk::ansi::stripansi $e] - } else { - lappend vlist_check $e - } - } - - set is_default 0 - foreach e $vlist e_check $vlist_check { - if {[dict exists $combined_defaults $o] && ($e_check eq [dict get $combined_defaults $o])} { - incr is_default - } - } - if {$is_default eq [llength $vlist]} { - set is_default true - } - #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value - #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. - if {!$is_default} { - if {[dict exists $arg_info $o -type]} { - set type [dict get $arg_info $o -type] - set ltype [string tolower $type] - switch -- $type { - int - - integer - - double { - switch -- $ltype { - int - - integer { - foreach e $vlist e_check $vlist_check { - if {![string is integer -strict $e_check]} { - error "Option $o for $caller requires type 'integer'. Received: '$e'" - } - } - } - double { - foreach e $vlist e_check $vlist_check { - if {![string is double -strict $e_check]} { - error "Option $o for $caller requires type 'double'. Received: '$e'" - } - } - } - } - #todo - small-value double comparisons with error-margin? review - if {[dict exists $arg_info $o -range]} { - lassign [dict get $arg_info $o -range] low high - foreach e $vlist e_check $vlist_check { - if {$e_check < $low || $e_check > $high} { - error "Option $o for $caller must be between $low and $high. Received: '$e'" - } - } - } - } - bool - - boolean { - foreach e $vlist e_check $vlist_check { - if {![string is boolean -strict $e_check]} { - error "Option $o for $caller requires type 'boolean'. Received: '$e'" - } - } - } - alnum - - alpha - - ascii - - control - - digit - - graph - - lower - - print - - punct - - space - - upper - - wordchar - - xdigit { - foreach e $vlist e_check $vlist_check { - if {![string is [string tolower $type] $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e'" - } - } - } - file - - directory - - existingfile - - existingdirectory { - foreach e $vlist e_check $vlist_check { - if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which doesn't look like it could be a file or directory" - } - } - if {[string tolower $type] in {existingfile}} { - foreach e $vlist e_check $vlist_check { - if {![file exists $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing file" - } - } - } elseif {[string tolower $type] in {existingdirectory}} { - foreach e $vlist e_check $vlist_check { - if {![file isdirectory $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing directory" - } - } - } - } - char - - character { - foreach e $vlist e_check $vlist_check { - if {[string length != 1]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not a single character" - } - } - } - } - } - if {[dict exists $arg_info $o -choices]} { - set choices [dict get $arg_info $o -choices] - set nocase [dict get $arg_info $o -nocase] - foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg "(case insensitive)" - set choices_test [string tolower $choices] - set v_test [string tolower $e_check] - } else { - set casemsg "(case sensitive)" - set v_test $e_check - set choices_test $choices - } - if {$v_test ni $choices_test} { - error "Option $o for $caller must be one of the listed values $choices $casemsg. Received: '$e'" - } - } - } - } - if {[dict exists $arg_info $o -strip_ansi] && [dict get $arg_info $o -strip_ansi]} { - set stripped_list [list] - foreach e $vlist { - lappend stripped_list [punk::ansi::stripansi $e] - } - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o $stripped_list - } else { - dict set values $o $stripped_list - } - } else { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o [lindex $stripped_list 0] - } else { - dict set values [lindex $stripped_list 0] - } - } - } - } - - #maintain order of opts $opts values $values as caller may use lassign. - return [dict create opts $opts values $values] - } - - #tcl8.7/9 compatibility for 8.6 - if {[info commands ::tcl::string::insert] eq ""} { - #https://wiki.tcl-lang.org/page/string+insert - # Pure Tcl implementation of [string insert] command. - proc ::tcl::string::insert {string index insertString} { - # Convert end-relative and TIP 176 indexes to simple integers. - if {[regexp -expanded { - ^(end(?![\t\n\v\f\r ]) # "end" is never followed by whitespace - |[\t\n\v\f\r ]*[+-]?\d+) # m, with optional leading whitespace - (?:([+-]) # op, omitted when index is "end" - ([+-]?\d+))? # n, omitted when index is "end" - [\t\n\v\f\r ]*$ # optional whitespace (unless "end") - } $index _ m op n]} { - # Convert first index to an integer. - switch $m { - end {set index [string length $string]} - default {scan $m %d index} - } - - # Add or subtract second index, if provided. - switch $op { - + {set index [expr {$index + $n}]} - - {set index [expr {$index - $n}]} - } - } elseif {![string is integer -strict $index]} { - # Reject invalid indexes. - return -code error "bad index \"$index\": must be\ - integer?\[+-\]integer? or end?\[+-\]integer?" - } - - # Concatenate the pre-insert, insertion, and post-insert strings. - string cat [string range $string 0 [expr {$index - 1}]] $insertString\ - [string range $string $index end] - } - - # Bind [string insert] to [::tcl::string::insert]. - namespace ensemble configure string -map [dict replace\ - [namespace ensemble configure string -map]\ - insert ::tcl::string::insert] - } interp alias {} errortime {} punk::lib::errortime proc errortime {script groupsize {iters 2}} { @@ -2051,6 +1645,26 @@ namespace eval punk::lib::system { #[para] Internal functions that are not part of the API #[list_begin definitions] + proc has_script_var_bug {} { + set script {set j [list spud] ; list} + append script \n + uplevel #0 $script + set rep1 [tcl::unsupported::representation $::j] + set script "" + set rep2 [tcl::unsupported::representation $::j] + + set nostring1 [string match "*no string" $rep1] + set nostring2 [string match "*no string" $rep2] + + #we assume it should have no string rep in either case + #Review: check Tcl versions for behaviour/consistency + if {!$nostring2} { + return true + } else { + return false + } + } + proc mostFactorsBelow {n} { ##*** !doctools #[call [fun mostFactorsBelow] [arg n]] diff --git a/src/bootsupport/modules/punk/mix/base-0.1.tm b/src/bootsupport/modules/punk/mix/base-0.1.tm index a80dd99..0a13ad3 100644 --- a/src/bootsupport/modules/punk/mix/base-0.1.tm +++ b/src/bootsupport/modules/punk/mix/base-0.1.tm @@ -740,7 +740,7 @@ namespace eval punk::mix::base { proc cksum_filter_opts {args} { set ck_opt_names [dict keys [cksum_default_opts]] set ck_opts [dict create] - dict for {k v} $args { + foreach {k v} $args { if {$k in $ck_opt_names} { dict set ck_opts $k $v } diff --git a/src/bootsupport/modules/punk/mix/cli-0.3.tm b/src/bootsupport/modules/punk/mix/cli-0.3.tm index 13d75d7..3e941e4 100644 --- a/src/bootsupport/modules/punk/mix/cli-0.3.tm +++ b/src/bootsupport/modules/punk/mix/cli-0.3.tm @@ -24,7 +24,8 @@ package require punkcheck ;#checksum and/or timestamp records # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ - +#review +#deck - rename to dev namespace eval punk::mix::cli { namespace eval temp_import { } @@ -101,11 +102,6 @@ namespace eval punk::mix::cli { #interp alias {} ::punk::mix::cli::project.new {} ::punk::mix::cli::new - - - - - proc make {args} { set startdir [pwd] set project_base "" ;#empty for unknown @@ -209,17 +205,20 @@ namespace eval punk::mix::cli { } proc validate_modulename {modulename args} { - set defaults [list\ + set opts [list\ -errorprefix validate_modulename\ ] if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} - set known_opts [dict keys $defaults] - foreach k [dict keys $args] { - if {$k ni $known_opts} { - error "validate_modulename error: unknown option $k. known options: $known_opts" + foreach {k v} $args { + switch -- $k { + -errorprefix { + dict set opts $k $v + } + default { + error "validate_modulename error: unknown option '$k'. known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_errorprefix [dict get $opts -errorprefix] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -264,17 +263,20 @@ namespace eval punk::mix::cli { return $projectname } proc validate_name_not_empty_or_spaced {name args} { - set defaults [list\ + set opts [list\ -errorprefix projectname\ ] - if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} - set known_opts [dict keys $defaults] - foreach k [dict keys $args] { - if {$k ni $known_opts} { - error "validate_modulename error: unknown option $k. known options: $known_opts" + if {[llength $args] %2 != 0} {error "validate_name_not_empty_or_spaced args must be name-value pairs: received '$args'"} + foreach {k v} $args { + switch -- $k { + -errorprefix { + dict set opts $k $v + } + default { + error "validate_name_not_empty_or_spaced error: unknown option $k. known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_errorprefix [dict get $opts -errorprefix] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -759,24 +761,27 @@ namespace eval punk::mix::cli { } proc kettle_call {calltype args} { variable kettle_reset_bodies - if {$calltype ni [list lib shell]} { - error "deck kettle_call 1st argument must be one of: 'lib' for direct use of kettle module or 'shell' to call as separate process" - } - if {$calltype eq "shell"} { - set kettleappfile [file dirname [info nameofexecutable]]/kettle - set kettlebatfile [file dirname [info nameofexecutable]]/kettle.bat - - if {(![file exists $kettleappfile]) && (![file exists $kettlebatfile])} { - error "deck kettle_call unable to find installed kettle application file '$kettleappfile' (or '$kettlebatfile' if on windows)" - } - if {[file exists $kettleappfile]} { - set kettlescript $kettleappfile - } - if {$::tcl_platform(platform) eq "windows"} { - if {[file exists $kettlebatfile]} { - set kettlescript $kettlebatfile + switch -- $calltype { + lib {} + shell { + set kettleappfile [file dirname [info nameofexecutable]]/kettle + set kettlebatfile [file dirname [info nameofexecutable]]/kettle.bat + + if {(![file exists $kettleappfile]) && (![file exists $kettlebatfile])} { + error "deck kettle_call unable to find installed kettle application file '$kettleappfile' (or '$kettlebatfile' if on windows)" + } + if {[file exists $kettleappfile]} { + set kettlescript $kettleappfile + } + if {$::tcl_platform(platform) eq "windows"} { + if {[file exists $kettlebatfile]} { + set kettlescript $kettlebatfile + } } } + default { + error "deck kettle_call 1st argument must be one of: 'lib' for direct use of kettle module or 'shell' to call as separate process" + } } set startdir [pwd] if {![file exists $startdir/build.tcl]} { @@ -901,7 +906,12 @@ namespace eval punk::mix::cli { variable default_command help package require punk::mix::base package require punk::overlay - punk::overlay::custom_from_base [namespace current] ::punk::mix::base + if {[catch { + punk::overlay::custom_from_base [namespace current] ::punk::mix::base + } errM]} { + puts stderr "punk::mix::cli load error: Failed to overlay punk::mix::base $errM" + error "punk::mix::cli error: $errM" + } } diff --git a/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm index 9534338..d3b0585 100644 --- a/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm @@ -33,6 +33,7 @@ namespace eval punk::mix::commandset::doc { puts "documentation subsystem" puts "commands: doc.build" puts " build documentation from src/doc to src/embedded using the kettle build tool" + puts "commands: doc.status" } proc build {} { diff --git a/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index 013c3bb..794faf0 100644 --- a/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -354,10 +354,10 @@ namespace eval punk::mix::commandset::module { #it is nevertheless useful information - and not the only way developer-machine/build-machine paths can leak #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern - #Don't put litera %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens + #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] set strmap [list] - dict for {tag val} $tagnames { + foreach {tag val} $tagnames { lappend strmap %$tag% $val } set template_filedata [string map $strmap $template_filedata] diff --git a/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm index 58aa079..862bbf0 100644 --- a/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm @@ -390,7 +390,7 @@ namespace eval punk::mix::commandset::project { set tagmap [list [lib::template_tag project] $projectname] if {[llength $templatefiles]} { puts stdout "Filling template file placeholders with the following tag map:" - dict for {placeholder value} $tagmap { + foreach {placeholder value} $tagmap { puts stdout " $placeholder -> $value" } } @@ -586,25 +586,39 @@ namespace eval punk::mix::commandset::project { set col6_dupids [list] set col7_pdescs [list] set codes [dict create] + set file_idx 0 foreach dbfile $col1_dbfiles { set project_name "" set project_code "" set project_desc "" - sqlite3 dbp $dbfile - dbp eval {select name,value from config where name like 'project-%';} r { - if {$r(name) eq "project-name"} { - set project_name $r(value) - } elseif {$r(name) eq "project-code"} { - set project_code $r(value) - } elseif {$r(name) eq "project-description"} { - set project_desc $r(value) + set db_error "" + if {[file exists $dbfile]} { + if {[catch { + sqlite3 dbp $dbfile + dbp eval {select name,value from config where name like 'project-%';} r { + if {$r(name) eq "project-name"} { + set project_name $r(value) + } elseif {$r(name) eq "project-code"} { + set project_code $r(value) + } elseif {$r(name) eq "project-description"} { + set project_desc $r(value) + } + } + } errM]} { + set db_error $errM } + catch {dbp close} + } else { + set db_error "fossil file $dbfile missing" } - dbp close lappend col4_pnames $project_name lappend col5_pcodes $project_code dict lappend codes $project_code $dbfile lappend col7_pdescs $project_desc + if {$db_error ne ""} { + lset col1_dbfiles $file_idx "[a+ web-red]$dbfile[a]" + } + incr file_idx } set setid 1 diff --git a/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm index 8ea2489..9ac7896 100644 --- a/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm @@ -117,18 +117,21 @@ namespace eval punk::mix::commandset::scriptwrap { } set crlf_lf_replacements [list \uFFFF \uFFFE] ;#defaults - if already exist in file - error out with message # -ignore_rems 1 allows testing of alignment state if rems were stripped - todo - lf/crlf-preserving rem strip function - set defaults [dict create\ + set opts [dict create\ -ignore_rems 0\ -substitutionmap {}\ -crlf_lf_replacements $crlf_lf_replacements\ ] - set known_opts [dict keys $defaults] foreach {k v} $args { - if {$k ni $known_opts} { - error "checkfile error - unknown option '$k'. Known options: $known_opts" + switch -- $k { + -ignore_rems - -substitutionmap - -crlf_lf_replacements { + dict set opts $k $v + } + default { + error "checkfile error - unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- set opt_ignore_rems [dict get $opts -ignore_rems] set opt_substitutionmap [dict get $opts -substitutionmap] @@ -756,20 +759,25 @@ namespace eval punk::mix::commandset::scriptwrap { #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf proc multishell {filepath_or_scriptset args} { - set defaults [dict create\ + set opts [dict create\ -askme 1\ -outputfolder "\uFFFF"\ -template "\uFFFF"\ -returnextra 0\ -force 0\ ] - set known_opts [dict keys $defaults] - dict for {k v} $args { - if {$k ni $known_opts} { - - error "punk::mix::commandset::scriptwrap error. Unrecognized option '$k'. Known-options: $known_opts" + #set known_opts [dict keys $defaults] + foreach {k v} $args { + switch -- $k { + -askme - -outputfolder - -template - -returnextra - -force { + dict set opts $k $v + } + default { + error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" + } } } + set usage "" append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n @@ -779,7 +787,6 @@ namespace eval punk::mix::commandset::scriptwrap { puts stderr $usage return false } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- set opt_askme [dict get $opts -askme] set opt_template [dict get $opts -template] @@ -1190,11 +1197,22 @@ namespace eval punk::mix::commandset::scriptwrap { proc get_wrapper_folders {args} { - set opts [dict get [punk::get_leading_opts_and_values { - -scriptpath "" - } $args -maxvalues 0] opts] + set argd [punk::args::get_dict { + #*** !doctools + #[call [fun get_wrapper_folders] [arg args] ] + #[para] Return list of dicts representing wrapper folders. keys: basefolder sourceinfo + #[para] Arguments: + # [list_begin arguments] + # [arg_def string args] name-value pairs -scriptpath + # [list_end] + *proc -name get_wrapper_folders + *opts -anyopts 0 + -scriptpath -default "" + *values -minvalues 0 -maxvalues 0 + } $args] + # -- --- --- --- --- --- --- --- --- - set opt_scriptpath [dict get $opts -scriptpath] + set opt_scriptpath [dict get $argd opts -scriptpath] # -- --- --- --- --- --- --- --- --- set wrapper_template_bases [list] diff --git a/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/bootsupport/modules/punk/ns-0.1.0.tm index da9fa09..5dbacbc 100644 --- a/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -591,7 +591,7 @@ namespace eval punk::ns { #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects] + set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ -types $known_types\ @@ -605,9 +605,9 @@ namespace eval punk::ns { set types $requested_types if {"all" in $requested_types} { - foreach t $known_types { - if {$t ni $types} { - lappend types $t + foreach known $known_types { + if {$known ni $types} { + lappend types $known } } } @@ -618,13 +618,20 @@ namespace eval punk::ns { if {"ooobjects" ni $types} { lappend types "ooobjects" } + if {"ooprivateobjects" ni $types} { + lappend types "ooprivateobjects" + } + if {"ooprivateclasses" ni $types} { + lappend types "ooprivateclasses" + } } foreach t $types { - if {$t in [list "oo" "all"]} { - continue - } - if {$t ni $known_types} { - error "Unrecognised namespace member type: $t known types: $known_types" + switch -- $t { + oo - all - + children - commands - exported - imported - aliases - procs - ensembles - ooclasses - ooobjects - ooprivateobjects - ooprivateclasses - native - coroutines - interps - zlibstreams {} + default { + error "Unrecognised namespace member type: $t known types: $known_types oo all" + } } } @@ -636,15 +643,21 @@ namespace eval punk::ns { #NOTE aliases may not be commands in current namespace - but we want to show them (marked red and with R) # - set children [list] - set commands [list] - set exported [list] - set imported [list] - set aliases [list] - set procs [list] - set ensembles [list] - set ooclasses [list] - set ooobjects [list] + set children [list] + set commands [list] + set exported [list] + set imported [list] + set aliases [list] + set procs [list] + set ensembles [list] + set ooclasses [list] + set ooobjects [list] + set ooprivateobjects [list] + set ooprivateclasses [list] + set native [list] + set interps [list] + set coroutines [list] + set zlibstreams [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -678,26 +691,48 @@ namespace eval punk::ns { } if {"commands" in $types} { set commands [dict get $contents commands] - if {"exported" in $types} { - set exported [dict get $contents exported] - } - if {"imported" in $types} { - set imported [dict get $contents imported] - } - if {"aliases" in $types} { - set aliases [dict get $contents aliases] - } - if {"procs" in $types} { - set procs [dict get $contents procs] - } - if {"ensembles" in $types} { - set ensembles [dict get $contents ensembles] - } - if {"ooclasses" in $types} { - set ooclasses [dict get $contents ooclasses] - } - if {"ooobjects" in $types} { - set ooobjects [dict get $contents ooobjects] + foreach t $types { + switch -- $t { + exported { + set exported [dict get $contents exported] + } + imported { + set imported [dict get $contents imported] + } + aliases { + set aliases [dict get $contents aliases] + } + procs { + set procs [dict get $contents procs] + } + ensembles { + set ensembles [dict get $contents ensembles] + } + ooclasses { + set ooclasses [dict get $contents ooclasses] + } + ooobjects { + set ooobjects [dict get $contents ooobjects] + } + ooprivateobjects { + set ooprivateobjects [dict get $contents ooprivateobjects] + } + ooprivateclasses { + set ooprivateclasses [dict get $contents ooprivateclasses] + } + native { + set native [dict get $contents native] + } + interps { + set interps [dict get $contents interps] + } + coroutines { + set coroutines [dict get $contents coroutines] + } + zlibstreams { + set zlibstreams [dict get $contents zlibstreams] + } + } } } @@ -719,11 +754,12 @@ namespace eval punk::ns { set seencmds [list] set masked [list] ;# + set cmdsets [concat $procs $ensembles $ooclasses $ooobjects $ooprivateobjects $ooprivateclasses $native $interps $coroutines $zlibstreams] foreach a $aliases { if {[list c $a] in $elements} { #possibly an ordinary alias - or a renamed alias that is masked by a proc/ensemble/oo #we can detect masking by proc/ensemble/oo - but not by a binary extension loaded after the rename: REVIEW - if {$a in [concat $procs $ensembles $ooclasses $ooobjects]} { + if {$a in $cmdsets} { #we have an alias that is also a known other command-type lappend elements [list c $a] ;#add in twice so we can display both. lappend masked $a @@ -776,10 +812,17 @@ namespace eval punk::ns { set col3 [string repeat " " [expr {$cmdwidest1 + 8}]] set col4 [string repeat " " [expr {$cmdwidest2 + 8}]] set col5 [string repeat " " [expr {$cmdwidest3 + 8}]] - set a [a+ purple bold] - set e [a+ yellow bold] - set o [a+ cyan bold] - set p [a+ white bold] + set a [a+ bold purple] + set e [a+ bold yellow] + set p [a+ bold white] + set c_nat [a+ web-gray] ;#native + set c_int [a+ web-orange] ;#interps + set c_cor [a+ web-hotpink] ;#coroutines + set c_ooo [a+ bold cyan] ;#object + set c_ooc [a+ web-aquamarine] ;#class + set c_ooO [a+ web-dodgerblue] ;#privateObject + set c_ooC [a+ web-lightskyblue] ;#privateClass + set c_zst [a+ web-yellow] ;#zlibstreams set a1 [a][a+ cyan] foreach ch1 $children1 ch2 $children2 cmd1 $elements1 cmd2 $elements2 cmd3 $elements3 cmd4 $elements4 { @@ -804,6 +847,7 @@ namespace eval punk::ns { if {$cmd in $exported} { set c [a+ green bold] } + #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias #assertion member of masked - but we use seencmds instead to detect. @@ -812,14 +856,26 @@ namespace eval punk::ns { set prefix [overtype::right $prefix "-R"] } elseif {$cmd in $procs} { set prefix "${p}prc " + } elseif {$cmd in $native} { + set prefix "${c_nat}nat " } elseif {$cmd in $ensembles} { set prefix "${e}ens " } elseif {$cmd in $ooclasses} { - set prefix "${o}ooc " + set prefix "${c_ooc}ooc " + } elseif {$cmd in $ooprivateobjects} { + set prefix "${c_ooO}ooO " + } elseif {$cmd in $ooprivateclasses} { + set prefix "${c_ooC}ooC " } elseif {$cmd in $ooobjects} { - set prefix "${o}ooo " + set prefix "${c_ooo}ooo " } elseif {$cmd in $aliases} { set prefix "${a}als " + } elseif {$cmd in $interps} { + set prefix "${c_int}int " + } elseif {$cmd in $coroutines} { + set prefix "${c_cor}cor " + } elseif {$cmd in $zlibstreams} { + set prefix "${c_zst}zst " } else { } if {$cmd in $imported} { @@ -937,6 +993,14 @@ namespace eval punk::ns { return [get_ns_dicts $ns_absolute {*}$args] } + #info cmdtype available in 8.7+ + proc cmdtype {cmd} { + if {[info commands ::tcl::info::cmdtype] ne ""} { + tailcall info cmdtype $cmd + } + #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + return na + } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob #returns a list of dicts even if only one ns matched #glob chars at last segment match contents/children of namespaces @@ -1042,9 +1106,15 @@ namespace eval punk::ns { #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] + set allnative [list] set allensembles [list] + set allinterps [list] + set allcoroutines [list] + set allzlibstreams [list] set allooobjects [list] set allooclasses [list] + set allooprivateobjects [list] + set allooprivateclasses [list] set allimported [list] set allundetermined [list] set interp_aliases [interp aliases ""] @@ -1070,32 +1140,93 @@ namespace eval punk::ns { # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} + set ctype [cmdtype ${location}::$cmd] + switch -- $ctype { + na { + #tcl 8.6 (info cmdtype unavailable) + #todo - use catch tcl::unsupported::corotype to see if coroutine + if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { + lappend allensembles $cmd + } elseif {[info object isa object ${location}::$cmd]} { + lappend allooobjects $cmd + if {[info object isa class ${location}::$cmd]} { + lappend allooclasses $cmd + } + } + if {[catch { + if {$cmd eq ""} { + #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. + set nsorigin [namespace origin ${location}::] + } elseif {[string match :* $cmd]} { + set nsorigin [nseval $location "::namespace origin $cmd"] + } else { + set nsorigin [namespace origin [nsjoin $location $cmd]] + } + } errM]} { + puts stderr "get_ns_dicts failed to determine origin of command '$cmd' adding to 'undetermined'" + puts stderr "error message: $errM" + lappend allundetermined $cmd + } else { + if {[nsprefix $nsorigin] ne $location} { + lappend allimported $cmd + } + } + } + default { + if {$ctype eq "imported"} { + set cmdorigin [namespace origin [nsjoin $location $cmd]] + #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source + #ie we don't need to follow a chain of 'imported' results. + set mixedtype i-[info cmdtype $cmdorigin] + } else { + set mixedtype $ctype + } + #assert ctype != imported + #review - we don't have a way to mark as both native and ensemble + switch -- $ctype { + i-native - native { + lappend allnative $cmd + } + i-ensemble - ensemble { + lappend allensembles $cmd + } + i-alias - alias { + #review + lappend allaliases $cmd + } + i-object - object { + if {[info object isa object ${location}::$cmd]} { + lappend allooobjects $cmd + if {[info object isa class ${location}::$cmd]} { + lappend allooclasses $cmd + } + } + } + i-privateObject - privateObject { + lappend allooobjects $cmd + lappend allooprivateobjects $cmd + } + i-privateClass - privateClass { + lappend allooobjects $cmd + lappend allooprivateclasses $cmd + } + i-interp - interp { + lappend allinterps $cmd + } + i-coroutine - coroutine { + lappend allcoroutines $cmd + } + i-zlibStream - zlibStream { + lappend allzlibstreams $cmd + } + default { + #there may be other registered types + #(extensible with Tcl_RegisterCommandTypeName) + lappend allothers $cmd + } - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd - } - } + } - if {[catch { - if {$cmd eq ""} { - #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. - set nsorigin [namespace origin ${location}::] - } elseif {[string match :* $cmd]} { - set nsorigin [nseval $location "::namespace origin $cmd"] - } else { - set nsorigin [namespace origin [nsjoin $location $cmd]] - } - } errM]} { - puts stderr "get_ns_dicts failed to determine origin of command '$cmd' adding to 'undetermined'" - puts stderr "error message: $errM" - lappend allundetermined $cmd - } else { - if {[nsprefix $nsorigin] ne $location} { - lappend allimported $cmd } } } @@ -1107,6 +1238,12 @@ namespace eval punk::ns { set procs [lsearch -all -inline $allprocs $glob] #set aliases [lsearch -all -inline $allaliases $glob] set ensembles [lsearch -all -inline $allensembles $glob] + set native [lsearch -all -inline $allnative $glob] + set coroutines [lsearch -all -inline $allcoroutines $glob] + set interps [lsearch -all -inline $allinterps $glob] + set zlibstreams [lsearch -all -inline $allzlibstreams $glob] + set ooprivateobjects [lsearch -all -inline $allooprivateobjects $glob] + set ooprivateclasses [lsearch -all -inline $allooprivateclasses $glob] set ooobjects [lsearch -all -inline $allooobjects $glob] set ooclasses [lsearch -all -inline $allooclasses $glob] set imported [lsearch -all -inline $allimported $glob] @@ -1118,8 +1255,14 @@ namespace eval punk::ns { set procs $allprocs #set aliases $allaliases set ensembles $allensembles + set native $allnative + set coroutines $allcoroutines + set interps $allinterps + set zlibstreams $allzlibstreams set ooobjects $allooobjects set ooclasses $allooclasses + set ooprivateobjects $allooprivateobjects + set ooprivateclasses $allooprivateclasses set imported $allimported set undetermined $allundetermined } @@ -1150,8 +1293,14 @@ namespace eval punk::ns { imported $imported\ aliases $aliases\ ensembles $ensembles\ + native $native\ + coroutines $coroutines\ + interps $interps\ + zlibstreams $zlibstreams\ ooobjects $ooobjects\ ooclasses $ooclasses\ + ooprivateobjects $ooprivateobjects\ + ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ namespacepath $nspathdict\ @@ -1644,9 +1793,10 @@ namespace eval punk::ns { set argspecs { -targetnamespace -default "" -optional 1 -prefix -default "" -optional 1 + *values -min 1 -max 1 sourcepattern -type string -optional 0 } - lassign [punk::args::opts_values $argspecs $args -minvalues 1 -maxvalues 1] _o opts _v values + lassign [dict values [punk::args::get_dict $argspecs $args]] opts values set sourcepattern [dict get $values sourcepattern] set source_ns [namespace qualifiers $sourcepattern] diff --git a/src/bootsupport/modules/punk/path-0.1.0.tm b/src/bootsupport/modules/punk/path-0.1.0.tm index f7abf16..9868219 100644 --- a/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/bootsupport/modules/punk/path-0.1.0.tm @@ -156,14 +156,17 @@ namespace eval punk::path { #[para] ie - the driveletter alone in paths such as c:/etc will still be case insensitive. (ie c:/ETC/* will match C:/ETC/blah but not C:/etc/blah) #[para] Explicitly specifying -nocase 0 will require the entire case to match including the driveletter. - set defaults [dict create\ + set opts [dict create\ -nocase \uFFFF\ ] - set known_opts [dict keys $defaults] - set opts [dict merge $defaults $args] - dict for {k v} $args { - if {$k ni $known_opts} { - error "Unrecognised options $k - known options: $known_opts" + foreach {k v} $args { + switch -- $k { + -nocase { + dict set opts $k $v + } + default { + error "Unrecognised option '$k'. Known-options: [dict keys $opts]" + } } } # -- --- --- --- --- --- diff --git a/src/bootsupport/modules/punk/repo-0.1.1.tm b/src/bootsupport/modules/punk/repo-0.1.1.tm index b25f75e..9a3a7f4 100644 --- a/src/bootsupport/modules/punk/repo-0.1.1.tm +++ b/src/bootsupport/modules/punk/repo-0.1.1.tm @@ -134,9 +134,13 @@ namespace eval punk::repo { } interp alias "" fossil "" punk::repo::fossil_proxy + #safe interps can't call auto_execok + #At least let them load the package even though much of it may be unusable depending on the safe configuration + catch { if {[auto_execok fossil] ne ""} { interp alias "" FOSSIL "" {*}[auto_execok fossil] } + } proc askuser {question} { if {![catch {package require punk::lib}]} { @@ -841,7 +845,7 @@ namespace eval punk::repo { } } proc fossil_get_repository_folder_for_project {projectname args} { - set defaults [list\ + set opts [list\ -parentfolder \uFFFF\ -extrachoices \uFFFF\ -askpath 0\ @@ -852,12 +856,16 @@ namespace eval punk::repo { if {[llength $args] % 2 != 0} { error "fossil_get_repository_folder requires args to be option-value pairs. Received '$args'" } - dict for {k v} $args { - if {$k ni [dict keys $defaults]} { - error "fossil_get_repository_folder unrecognised option $k. Known options: [dict keys $defaults]" + foreach {k v} $args { + switch -- $k { + -parentfolder - -extrachoices - -askpath - -ansi - -ansi_prompt - -ansi_warning { + dict set opts $k $v + } + default { + error "fossil_get_repository_folder unrecognised option $k. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- set opt_parentfolder [dict get $opts -parentfolder] if {$opt_parentfolder eq "\uFFFF"} { diff --git a/src/bootsupport/modules/punkcheck-0.1.0.tm b/src/bootsupport/modules/punkcheck-0.1.0.tm index 86b174a..8175ac0 100644 --- a/src/bootsupport/modules/punkcheck-0.1.0.tm +++ b/src/bootsupport/modules/punkcheck-0.1.0.tm @@ -1937,7 +1937,7 @@ namespace eval punkcheck { error "file_record_set_defaults bad file_record: tag not FILEINFO" } set defaults [list -keep_installrecords 3 -keep_skipped 1 -keep_inprogress 2] - dict for {k v} $defaults { + foreach {k v} $defaults { if {![dict exists $file_record $k]} { dict set file_record $k $v } diff --git a/src/bootsupport/modules/textblock-0.1.1.tm b/src/bootsupport/modules/textblock-0.1.1.tm index 0c9ce48..c597e96 100644 --- a/src/bootsupport/modules/textblock-0.1.1.tm +++ b/src/bootsupport/modules/textblock-0.1.1.tm @@ -17,7 +17,6 @@ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz -#package require punk package require punk::args package require punk::char package require punk::ansi @@ -70,6 +69,23 @@ namespace eval textblock { -minwidth ""\ -maxwidth ""\ ] + variable opts_column_defaults + set opts_column_defaults [dict create\ + -headers [list]\ + -header_colspans [list]\ + -footers [list]\ + -defaultvalue ""\ + -ansibase ""\ + -ansireset "\uFFEF"\ + -minwidth ""\ + -maxwidth ""\ + -blockalign centre\ + -textalign left\ + ] + #initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only + + + #for 'L' shaped table building pattern (tables bigger than 4x4 will be mostly 'L' patterns) #ie only vll,blc,hlb used for cells except top row and right column #top right cell uses all 'O' shape, other top cells use 'C' shape (hlt,tlc,vll,blc,hlb) @@ -216,7 +232,17 @@ namespace eval textblock { # [para] [emph {handler_classes}] # [list_begin enumerated] - oo::class create [namespace current]::table { + #this makes new table objects a little faster when multiple opts specified as well as to configure + #as tables are a heavyweight thing, but handy to nest sometimes - we'll take what we can get + set topt_keys [dict keys $::textblock::class::opts_table_defaults] + set switch_keys_valid_topts [punk::lib::lmapflat v $topt_keys {list $v -}] + set switch_keys_valid_topts [lrange $switch_keys_valid_topts 0 end-1] ;#remove last dash + + set copt_keys [dict keys $::textblock::class::opts_column_defaults] + set switch_keys_valid_copts [punk::lib::lmapflat v $copt_keys {list $v -}] + set switch_keys_valid_copts [lrange $switch_keys_valid_copts 0 end-1] + + oo::class create [namespace current]::table [string map [list %topt_keys% $topt_keys %topt_switchkeys% $switch_keys_valid_topts %copt_keys% $copt_keys %copt_switchkeys% $switch_keys_valid_copts] { #*** !doctools #[enum] CLASS [class interface_caphandler.registry] #[list_begin definitions] @@ -239,26 +265,47 @@ namespace eval textblock { variable TSUB ;#make configurable so user isn't stopped from using our default PUA-unicode char in content (nerdfonts overlap) variable o_calculated_column_widths variable o_column_width_algorithm + + constructor {args} { #*** !doctools #[call class::table [method constructor] [arg args]] - upvar ::textblock::class::opts_table_defaults tdefaults - set o_opts_table_defaults $tdefaults + set o_opts_table_defaults $::textblock::class::opts_table_defaults + set o_opts_column_defaults $::textblock::class::opts_column_defaults + + if {[llength $args] == 1} { set args [list -title [lindex $args 0]] } if {[llength $args] %2 !=0} { error "[namespace current]::table constructor - unexpected argument count. Require single value being title, or name value pairs" } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_table_defaults]} { - error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + + set o_opts_table $o_opts_table_defaults + set o_opts_table_effective $o_opts_table_defaults + + ##todo - test with punk::lib::show_jump_tables - how? + foreach {k v} $args { + switch -- $k { + %topt_switchkeys% { + dict set o_opts_table $k $v + } + default { + error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } } } + my configure {*}$o_opts_table + + #foreach {k v} $args { + # #todo - convert to literal switch using string map so we don't have to define o_opts_table_defaults here. + # if {$k ni [dict keys $o_opts_table_defaults]} { + # error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + # } + #} #set o_opts_table [dict merge $o_opts_table_defaults $args] - set o_opts_table $o_opts_table_defaults - set o_opts_table_effective $o_opts_table_defaults - my configure {*}[dict merge $o_opts_table_defaults $args] + #my configure {*}[dict merge $o_opts_table_defaults $args] + set o_columndefs [dict create] set o_columndata [dict create] ;#we store data by column even though it is often added row by row set o_columnstates [dict create] ;#store the maxwidthbodyseen etc as we add rows and maxwidthheaderseen etc as we add headers - it is needed often and expensive to calculate repeatedly @@ -282,7 +329,7 @@ namespace eval textblock { return $o_column_width_algorithm } if {$alg ne $o_column_width_algorithm} { - #invlidate cached widths + #invalidate cached widths set o_calculated_column_widths [list] } set o_column_width_algorithm $alg @@ -404,7 +451,7 @@ namespace eval textblock { return $o_opts_table } if {[llength $args] == 1} { - if {[lindex $args 0] in [dict keys $o_opts_table_defaults]} { + if {[lindex $args 0] in [list %topt_keys%]} { #query single option set k [lindex $args 0] set val [dict get $o_opts_table $k] @@ -428,13 +475,19 @@ namespace eval textblock { if {[llength $args] %2 != 0} { error "[namespace current]::table configure - unexpected argument count. Require name value pairs" } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_table_defaults]} { - error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + foreach {k v} $args { + switch -- $k { + %topt_switchkeys% {} + default { + error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } } + #if {$k ni [dict keys $o_opts_table_defaults]} { + # error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + #} } set checked_opts [list] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder-body - -ansiborder_footer { set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" @@ -557,7 +610,7 @@ namespace eval textblock { #all options checked - ok to update o_opts_table and o_opts_table_effective #set o_opts_table [dict merge $o_opts_table $checked_opts] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -framemap_header - -framemap_body { #framemaps don't require setting every key to update. @@ -583,11 +636,12 @@ namespace eval textblock { switch -- $k { -framemap_body - -framemap_header { set existing [dict get $o_opts_table_effective $k] - set updated $existing - dict for {subk subv} $v { - dict set updated $subk $subv - } - dict set o_opts_table_effective $k $updated + #set updated $existing + #dict for {subk subv} $v { + # dict set updated $subk $subv + #} + #dict set o_opts_table_effective $k $updated + dict set o_opts_table_effective $k [dict merge $existing $v] } -framelimits_body - -framelimits_header { #my Set_effective_framelimits @@ -641,33 +695,30 @@ namespace eval textblock { method add_column {args} { #*** !doctools #[call class::table [method add_column] [arg args]] - set defaults [dict create\ - -headers [list]\ - -header_colspans [list]\ - -footers [list]\ - -defaultvalue ""\ - -ansibase ""\ - -ansireset "\uFFEF"\ - -minwidth ""\ - -maxwidth ""\ - -blockalign centre\ - -textalign left\ - ] - #initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only - set o_opts_column_defaults $defaults + + if {[llength $args] %2 != 0} { - error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" + error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: %copt_keys%" } - dict for {k v} $args { - if {$k ni [dict keys $defaults]} { - error "[namespace current]::table::add_column unknown option '$k'. Known options: [dict keys $defaults]" + set opts $o_opts_column_defaults + foreach {k v} $args { + switch -- $k { + %copt_switchkeys% { + dict set opts $k $v + } + default { + error "[namespace current]::table::add_column unknown option '$k'. Known options: %copt_keys%" + } } } - set opts [dict merge $defaults $args] set colcount [dict size $o_columndefs] + dict set o_columndata $colcount [list] - dict set o_columndefs $colcount $defaults ;#ensure record exists + #dict set o_columndefs $colcount $defaults ;#ensure record exists + dict set o_columndefs $colcount $o_opts_column_defaults ;#ensure record exists + + dict set o_columnstates $colcount [dict create minwidthbodyseen 0 maxwidthbodyseen 0 maxwidthheaderseen 0] set prev_calculated_column_widths $o_calculated_column_widths if {[catch { @@ -707,7 +758,7 @@ namespace eval textblock { return [dict get $o_columndefs $cidx] } else { if {[llength $args] == 1} { - if {[lindex $args 0] in [dict keys $o_opts_column_defaults]} { + if {[lindex $args 0] in [list %copt_keys%]} { #query single option set k [lindex $args 0] set val [dict get $o_columndefs $cidx $k] @@ -721,23 +772,30 @@ namespace eval textblock { dict set returndict info $infodict return $returndict } else { - error "textblock::table configure_column - unrecognised option '[lindex $args 0]'. Known values [dict keys $o_opts_column_defaults]" + error "textblock::table configure_column - unrecognised option '[lindex $args 0]'. Known values %copt_keys%" } } if {[llength $args] %2 != 0} { - error "textblock::table configure_column unexpected argument count. Require name value pairs. Known options: [dict keys $o_opts_column_defaults]" + error "textblock::table configure_column unexpected argument count. Require name value pairs. Known options: %copt_keys%" } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_column_defaults]} { - error "[namespace current]::table configure_column unknown option '$k'. Known options: [dict keys $o_opts_column_defaults]" + foreach {k v} $args { + switch -- $k { + %copt_switchkeys% {} + default { + error "[namespace current]::table configure_column unknown option '$k'. Known options: %copt_keys%" + } } } - set checked_opts [list] + set checked_opts [dict get $o_columndefs $cidx] ;#copy of current state + set hstates $o_headerstates ;#operate on a copy set colstate [dict get $o_columnstates $cidx] - dict for {k v} $args { + set args_got_headers 0 + set args_got_header_colspans 0 + foreach {k v} $args { switch -- $k { -headers { + set args_got_headers 1 set i 0 set maxseen 0 ;#don't compare with cached colstate maxwidthheaderseen - we have all the headers for the column right here and need to refresh the colstate maxwidthheaderseen values completely. foreach hdr $v { @@ -761,9 +819,10 @@ namespace eval textblock { dict set colstate maxwidthheaderseen $maxseen #review - we could avoid some recalcs if we check current width range compared to previous set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -header_colspans { + set args_got_header_colspans 1 #check columns to left to make sure each new colspan for this column makes sense in the overall context #user may have to adjust colspans in order left to right to avoid these check errors #note that 'all' represents span all up to the next non-zero defined colspan. @@ -835,15 +894,15 @@ namespace eval textblock { } #todo - avoid recalc if no change set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -minwidth { set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -maxwidth { set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -ansibase { set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" @@ -858,11 +917,11 @@ namespace eval textblock { } } set col_ansibase [punk::ansi::codetype::sgr_merge_singles $col_ansibase_items] - lappend checked_opts $k $col_ansibase + dict set checked_opts $k $col_ansibase } -ansireset { if {$v eq "\uFFEF"} { - lappend checked_opts $k "\x1b\[m" ;# [a] + dict set checked_opts $k "\x1b\[m" ;# [a] } else { error "textblock::table::configure_column -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" } @@ -870,26 +929,25 @@ namespace eval textblock { -blockalign - -textalign { switch -- $v { left - right { - lappend checked_opts $k $v + dict set checked_opts $k $v } centre - centre { - lappend checked_opts $k centre + dict set checked_opts $k centre } } } default { - lappend checked_opts $k $v + dict set checked_opts $k $v } } } #args checked - ok to update headerstates and columndefs and columnstates + dict set o_columndefs $cidx $checked_opts + set o_headerstates $hstates dict set o_columnstates $cidx $colstate - set current_opts [dict get $o_columndefs $cidx] - set opts [dict merge $current_opts $checked_opts] - dict set o_columndefs $cidx $opts - if {"-headers" in [dict keys $args]} { + if {$args_got_headers} { #if the headerlist length for this column has shrunk,and it was the longest - we may now have excess entries in o_headerstates set zero_heights [list] dict for {hidx _v} $o_headerstates { @@ -902,7 +960,7 @@ namespace eval textblock { dict unset o_headerstates $zidx } } - if {"-headers" in [dict keys $args] || "-header_colspans" in [dict keys $args]} { + if {$args_got_headers || $args_got_header_colspans} { #check and adjust header_colspans for all columns } @@ -1525,19 +1583,20 @@ namespace eval textblock { method get_column_by_index {index_expression args} { #puts "+++> get_column_by_index $index_expression $args [namespace current]" #index_expression may be something like end-1 or 2+2 - we can't directly use it as a lookup for dicts. - set defaults [dict create\ + set opts [dict create\ -position "inner"\ -return "string"\ ] dict for {k v} $args { switch -- $k { - -position - -return {} + -position - -return { + dict set opts $k $v + } default { - error "[namespace current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + error "[namespace current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_posn [dict get $opts -position] set opt_return [dict get $opts -return] @@ -2665,7 +2724,7 @@ namespace eval textblock { } method column_datawidth {index_expression args} { - set defaults [dict create\ + set opts [dict create\ -headers 0\ -footers 0\ -colspan *\ @@ -2675,13 +2734,14 @@ namespace eval textblock { #-colspan is relevant to header/footer data only dict for {k v} $args { switch -- $k { - -headers - -footers - -colspan - -data - -cached {} + -headers - -footers - -colspan - -data - -cached { + dict set opts $k $v + } default { - error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" + error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_colspan [dict get $opts -colspan] @@ -3017,21 +3077,22 @@ namespace eval textblock { method calculate_column_widths {args} { set column_count [dict size $o_columndefs] - set defaults [dict create\ + set opts [dict create\ -algorithm $o_column_width_algorithm\ ] dict for {k v} $args { switch -- $k { - -algorithm {} + -algorithm { + dict set opts $k $v + } default { - error "Unknown option '$k'. Known options: [dict keys $defaults]" + error "Unknown option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_algorithm [dict get $opts -algorithm] #puts stderr "--- recalculating column widths -algorithm $opt_algorithm" - set known_algorithms [list basic simplistic span] + set known_algorithms [list basic simplistic span span2] switch -- $opt_algorithm { basic { #basic column by column - This allocates extra space to first span/column as they're encountered. @@ -3062,7 +3123,7 @@ namespace eval textblock { set o_calculated_column_widths [dict get $calcresult colwidths] } default { - error "calculate_column_widths unknown algorithm $opt_algorithm" + error "calculate_column_widths unknown algorithm $opt_algorithm. Known algorithms: $known_algorithms" } } #remember the last algorithm used @@ -3191,7 +3252,7 @@ namespace eval textblock { #*** !doctools #[list_end] - } + }] #*** !doctools # [list_end] [comment {- end enumeration provider_classes }] #[list_end] [comment {- end itemized list textblock::class groupings -}] @@ -3251,20 +3312,21 @@ namespace eval textblock { #For an impressive interactive terminal app (javascript) # see: https://github.com/spirometaxas/periodic-table-cli - set defaults [dict create\ + set opts [dict create\ -return "string"\ -compact 1\ -forcecolour 0\ ] dict for {k v} $args { switch -- $k { - -return - -compact - -forcecolour {} + -return - -compact - -forcecolour { + dict set opts $k $v + } default { - "textblock::periodic unknown option '$k'. Known options: [dict keys $defaults]" + "textblock::periodic unknown option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_return [dict get $opts -return] if {[dict get $opts -forcecolour]} { set fc forcecolour @@ -3291,63 +3353,73 @@ namespace eval textblock { set ecat [dict create] set cat_alkaline_earth [list Be Mg Ca Sr Ba Ra] - set ansi [a+ {*}$fc Web-gold web-black] + set ansi [a+ {*}$fc web-black Web-gold] + set val [list ansi $ansi cat alkaline_earth] foreach e $cat_alkaline_earth { - dict set ecat $e [list ansi $ansi cat alkaline_earth] + dict set ecat $e $val } set cat_reactive_nonmetal [list H C N O F P S Cl Se Br I] - set ansi [a+ {*}$fc Web-lightgreen web-black] + set ansi [a+ {*}$fc web-black Web-lightgreen] + set val [list ansi $ansi cat reactive_nonmetal] foreach e $cat_reactive_nonmetal { - dict set ecat $e [list ansi $ansi cat reactive_nonmetal] + dict set ecat $e $val } set cat [list Li Na K Rb Cs Fr] - set ansi [a+ {*}$fc Web-Khaki web-black] + set ansi [a+ {*}$fc web-black Web-Khaki] + set val [list ansi $ansi cat alkali_metals] foreach e $cat { - dict set ecat $e [list ansi $ansi cat alkali_metals] + dict set ecat $e $val } set cat [list Sc Ti V Cr Mn Fe Co Ni Cu Zn Y Zr Nb Mo Tc Ru Rh Pd Ag Cd Hf Ta W Re Os Ir Pt Au Hg Rf Db Sg Bh Hs] - set ansi [a+ {*}$fc Web-lightsalmon web-black] + set ansi [a+ {*}$fc web-black Web-lightsalmon] + set val [list ansi $ansi cat transition_metals] foreach e $cat { - dict set ecat $e [list ansi $ansi cat transition_metals] + dict set ecat $e $val } set cat [list Al Ga In Sn Tl Pb Bi Po] - set ansi [a+ {*}$fc Web-lightskyblue web-black] + set ansi [a+ {*}$fc web-black Web-lightskyblue] + set val [list ansi $ansi cat post_transition_metals] foreach e $cat { - dict set ecat $e [list ansi $ansi cat post_transition_metals] + dict set ecat $e $val } set cat [list B Si Ge As Sb Te At] - set ansi [a+ {*}$fc Web-turquoise web-black] + set ansi [a+ {*}$fc web-black Web-turquoise] + set val [list ansi $ansi cat metalloids] foreach e $cat { - dict set ecat $e [list ansi $ansi cat metalloids] + dict set ecat $e $val } set cat [list He Ne Ar Kr Xe Rn] - set ansi [a+ {*}$fc Web-orchid web-black] + set ansi [a+ {*}$fc web-black Web-orchid] + set val [list ansi $ansi cat noble_gases] foreach e $cat { - dict set ecat $e [list ansi $ansi cat noble_gases] + dict set ecat $e $val } set cat [list Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr] - set ansi [a+ {*}$fc Web-plum web-black] + set ansi [a+ {*}$fc web-black Web-plum] + set val [list ansi $ansi cat actinoids] foreach e $cat { - dict set ecat $e [list ansi $ansi cat actinoids] + dict set ecat $e $val } set cat [list La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu] - set ansi [a+ {*}$fc Web-tan web-black] + set ansi [a+ {*}$fc web-black Web-tan] + set val [list ansi $ansi cat lanthanoids] foreach e $cat { - dict set ecat $e [list ansi $ansi cat lanthanoids] + dict set ecat $e $val } set cat [list Mt Ds Rg Cn Nh Fl Mc Lv Ts Og] - set ansi [a+ {*}$fc Web-whitesmoke web-black] + set ansi [a+ {*}$fc web-black Web-whitesmoke] + set val [list ansi $ansi cat other] foreach e $cat { - dict set ecat $e [list ansi $ansi cat other] + dict set ecat $e $val } set elements1 [list] @@ -3372,25 +3444,24 @@ namespace eval textblock { $t configure_column $c -headers [list $h] -minwidth 2 incr c } - for {set c 0} {$c < [$t column_count]} {incr c} { + set ccount [$t column_count] + for {set c 0} {$c < $ccount} {incr c} { $t configure_column $c -minwidth 3 } if {[dict get $opts -compact]} { - $t configure -show_hseps 0 - $t configure -show_header 0 - $t configure -show_edge 0 + $t configure -show_hseps 0 -show_header 0 -show_edge 0 } else { $t configure -show_header 1 } if {$opt_return eq "string"} { - $t configure -frametype_header light - $t configure -ansiborder_header [a+ {*}$fc web-white] - $t configure -ansibase_header [a+ {*}$fc Web-black] - $t configure -ansibase_body [a+ {*}$fc Web-black] - $t configure -ansiborder_body [a+ {*}$fc web-black] - $t configure -frametype block - + $t configure \ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc web-white]\ + -ansibase_header [a+ {*}$fc Web-black]\ + -ansibase_body [a+ {*}$fc Web-black]\ + -ansiborder_body [a+ {*}$fc web-black]\ + -frametype block set output [textblock::frame -ansiborder [a+ {*}$fc Web-black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Web-black] Periodic Table " [$t print]] return $output @@ -3398,7 +3469,6 @@ namespace eval textblock { return $t } - proc list_as_table {table_or_colcount datalist args} { set defaults [dict create\ -return string\ @@ -3406,15 +3476,17 @@ namespace eval textblock { -show_edge \uFFEF\ -show_seps \uFFEF\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -return - -show_edge - -show_seps - -frametype {} + -return - -show_edge - -show_seps - -frametype { + dict set opts $k $v + } default { error "unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set count [llength $datalist] @@ -3555,7 +3627,7 @@ namespace eval textblock { - set chars [concat [punk::range 1 9] A B C D E F] + set chars [concat [punk::lib::range 1 9] A B C D E F] set charsubset [lrange $chars 0 $size-1] if {"noreset" in $colour} { set RST "" @@ -3725,7 +3797,7 @@ namespace eval textblock { #pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- |? ?-which right|left|centre? ?-width auto|? ?-within_ansi 1|0?" foreach {k v} $args { switch -- $k { - -padchar - -which - -width - -overflow - -within_ansi {} + -padchar - -which - -width - -overflow - -within_ansi { + dict set opts $k $v + } default { error "textblock::pad unrecognised option '$k'. Usage: $usage" } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- set padchar [dict get $opts -padchar] #if padchar width (screen width) > 1 - length calculations will not be correct @@ -4001,19 +4074,20 @@ namespace eval textblock { } proc pad_test_blocklist {blocklist args} { - set defaults [dict create\ + set opts [dict create\ -description ""\ -blockheaders ""\ ] foreach {k v} $args { switch -- $k { - -description - -blockheaders {} + -description - -blockheaders { + dict set opts $k $v + } default { - error "pad_test_blocklist unrecognised option '$k'. Known options: [dict keys $defaults]" + error "pad_test_blocklist unrecognised option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_blockheaders [dict get $opts -blockheaders] set bheaders [dict create] if {$opt_blockheaders ne ""} { @@ -4148,7 +4222,7 @@ namespace eval textblock { proc ::textblock::join1 {args} { - lassign [punk::args::opts_values { + lassign [punk::args::get_dict { -ansiresets -default 1 -type integer blocks -type string -multiple 1 } $args] _o opts _v values @@ -4175,10 +4249,11 @@ namespace eval textblock { #for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed #they may however still be 'ragged' ie differing line lengths proc ::textblock::join {args} { - #lassign [punk::lib::opts_values { + #set argd [punk::args::get_dict { # blocks -type string -multiple 1 - #} $args] _o opts _v values - #set blocks [dict get $values blocks] + #} $args] + #set opts [dict get $argd opts] + #set blocks [dict get $argd values blocks] #-ansireplays is always on (if ansi detected) @@ -4212,8 +4287,8 @@ namespace eval textblock { set fordata [list] set colindices [list] foreach b $blocks { - set c($idx) [string repeat " " [width $b]] set w($idx) [width $b] ;#we need the width of a rendered block for per-row renderline calls + #set c($idx) [string repeat " " [set w($idx)]] #fairly commonly a block may be a vertical list of chars e.g something like 1\n2\n3 or -\n-\n-\n- #for determining a shortcut to avoid unnecessary ta::detect - (e.g width <=1) we can't use result of textblock::width as it strips ansi. #testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway. @@ -4254,16 +4329,17 @@ namespace eval textblock { # >} punk::lib::list_as_lines U+F8FF - although this is commonly used for example by nerdfonts @@ -5875,13 +5953,13 @@ namespace eval textblock { #this occurs commonly in table building with colspans - review - if {$actual_contentwidth > $frame_inner_width || $actual_contentheight != $frame_inner_height} { + if {($actual_contentwidth > $frame_inner_width) || ($actual_contentheight != $frame_inner_height)} { set usecache 0 #set buildcache 0 ;#comment out for debug/analysis so we can see #puts "--->> frame_inner_width:$frame_inner_width actual_contentwidth:$actual_contentwidth contents: '$contents'" set cache_key [a+ Web-red web-white]$cache_key[a] } - if {$buildcache && $actual_contentwidth < $frame_inner_width} { + if {$buildcache && ($actual_contentwidth < $frame_inner_width)} { #colourise cache_key to warn if {$actual_contentwidth == 0} { #we can still substitute with right length @@ -5891,7 +5969,7 @@ namespace eval textblock { if {[dict exists $frame_cache $cache_key]} { set cache_patternwidth [dict get $frame_cache $cache_key patternwidth] } else { - set cache_patternwidth [$actual_contentwidth] + set cache_patternwidth $actual_contentwidth } if {$actual_contentwidth < $cache_patternwidth} { set usecache 0 diff --git a/src/embedded/man/files/_module_argparsingtest-0.1.0.tm.n b/src/embedded/man/files/_module_argparsingtest-0.1.0.tm.n new file mode 100644 index 0000000..2c8bd01 --- /dev/null +++ b/src/embedded/man/files/_module_argparsingtest-0.1.0.tm.n @@ -0,0 +1,318 @@ +'\" +'\" Generated from file '_module_argparsingtest-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "shellspy_module_argparsingtest" 0 0\&.1\&.0 doc "-" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +shellspy_module_argparsingtest \- Module API +.SH SYNOPSIS +package require \fBargparsingtest \fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of argparsingtest +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by argparsingtest +.IP \(bu +\fBTcl 8\&.6\fR +.PP +.SH API +.SS "NAMESPACE ARGPARSINGTEST::CLASS" +.PP +class definitions +.PP +.SS "NAMESPACE ARGPARSINGTEST" +.PP +Core API functions for argparsingtest +.PP +.SS "NAMESPACE ARGPARSINGTEST::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +.SS "NAMESPACE ARGPARSINGTEST::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/_module_overtype-1.6.3.tm.n b/src/embedded/man/files/_module_overtype-1.6.3.tm.n new file mode 100644 index 0000000..46fb1ef --- /dev/null +++ b/src/embedded/man/files/_module_overtype-1.6.3.tm.n @@ -0,0 +1,354 @@ +'\" +'\" Generated from file '_module_overtype-1\&.6\&.3\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "overtype_module_overtype" 0 1\&.6\&.3 doc "overtype text layout" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +overtype_module_overtype \- overtype text layout - ansi aware +.SH SYNOPSIS +package require \fBovertype \fR +.sp +\fBovertype::renderspace\fR \fIargs\fR +.sp +\fBovertype::renderline\fR \fIargs\fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of overtype +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by overtype +.IP \(bu +\fBTcl 8\&.6\fR +.IP \(bu +\fBtextutil\fR +.IP \(bu +\fBpunk::ansi\fR +.sp +- required to detect, split, strip and calculate lengths of text possibly containing ansi codes +.IP \(bu +\fBpunk::char\fR +.sp +- box drawing - and also unicode character width determination for proper layout of text with double-column-width chars +.PP +.SH API +.SS "NAMESPACE OVERTYPE" +.PP +Core API functions for overtype +.TP +\fBovertype::renderspace\fR \fIargs\fR +.sp +usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext \&.\&.\&.? undertext overtext +.TP +\fBovertype::renderline\fR \fIargs\fR +.sp +renderline is the core engine for overtype string processing (frames & textblocks), and the raw mode commandline repl for the Tcl Punk Shell +.sp +It is also a central part of an ansi (micro) virtual terminal-emulator of sorts +.sp +This system does a half decent job at rendering 90's ANSI art to manipulable colour text blocks that can be joined & framed for layout display within a unix or windows terminal +.sp +Renderline helps maintain ANSI text styling reset/replay codes so that the styling of one block doesn't affect another\&. +.sp +Calling on the punk::ansi library - it can coalesce codes to keep the size down\&. +.sp +It is a giant mess of doing exactly what common wisdom says not to do\&.\&.\&. lots at once\&. +.sp +renderline is part of the Unicode and ANSI aware Overtype system which 'renders' a block of text onto a static underlay +.sp +The underlay is generally expected to be an ordered set of lines or a rectangular text block analogous to a terminal screen - but it can also be ragged in line length, or just blank\&. +.sp +The overlay couuld be similar - in which case it may often be used to overwrite a column or section of the underlay\&. +.sp +The overlay could however be a sequence of ANSI-laden text that jumps all over the place\&. +.sp +renderline itself only deals with a single line - or sometimes a single character\&. It is generally called from a loop that does further terminal-like or textblock processing\&. +.sp +By suppyling the -info 1 option - it can return various fields indicating the state of the render\&. +.sp +The main 3 are the result, overflow_right, and unapplied\&. +.sp +Renderline handles cursor movements from either keystrokes or ANSI sequences but for a full system the aforementioned loop will need to be in place to manage the set of lines under manipulation\&. +.PP +.SH KEYWORDS +ansi, module, text +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/punk/_module_aliascore-0.1.0.tm.n b/src/embedded/man/files/punk/_module_aliascore-0.1.0.tm.n new file mode 100644 index 0000000..5f34178 --- /dev/null +++ b/src/embedded/man/files/punk/_module_aliascore-0.1.0.tm.n @@ -0,0 +1,318 @@ +'\" +'\" Generated from file '_module_aliascore-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "shellspy_module_punk::aliascore" 0 0\&.1\&.0 doc "-" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +shellspy_module_punk::aliascore \- Module API +.SH SYNOPSIS +package require \fBpunk::aliascore \fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of punk::aliascore +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::aliascore +.IP \(bu +\fBTcl 8\&.6\fR +.PP +.SH API +.SS "NAMESPACE PUNK::ALIASCORE::CLASS" +.PP +class definitions +.PP +.SS "NAMESPACE PUNK::ALIASCORE" +.PP +Core API functions for punk::aliascore +.PP +.SS "NAMESPACE PUNK::ALIASCORE::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +.SS "NAMESPACE PUNK::ALIASCORE::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n b/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n index aa11d89..3c7054d 100644 --- a/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n +++ b/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n @@ -286,8 +286,6 @@ package require \fBpunk::ansi \fR .sp \fBa\fR ?ansicode\&.\&.\&.? .sp -\fBa\fR ?ansicode\&.\&.\&.? -.sp \fBget_code_name\fR \fIcode\fR .sp \fBreset\fR @@ -430,6 +428,13 @@ Return a string with ansi codes stripped out Alternate graphics modes will be stripped - exposing the raw characters as they appear without graphics mode\&. .sp ie instead of a horizontal line you may see: qqqqqq +e\&.g who is to know that 'Rabbit Paws', 'Forbidden Thrill' and 'Tarsier' refer to a particular shade of pinky-red? (code 95) +Perhaps it's an indication that colour naming once we get to 256 colours or more is a fool's errand anyway\&. +The xterm names are boringly unimaginative - and also have some oddities such as: +DarkSlateGray1 which looks much more like cyan\&.\&. +The greyxx names are spelt with an e - but the darkslategrayX variants use an a\&. Perhaps that's because they are more cyan than grey and the a is a hint? +there is no gold or gold2 - but there is gold1 and gold3 +but in general the names bear some resemblance to the colours and are at least somewhat intuitive\&. .TP \fBa?\fR ?ansicode\&.\&.\&.? .sp @@ -465,22 +470,6 @@ punk::ansi::a Red .sp see \fBpunk::ansi::a?\fR to display a list of codes .TP -\fBa\fR ?ansicode\&.\&.\&.? -.sp -Returns the ansi code to reset any current settings and apply those from the supplied list -.sp -by calling punk::ansi::a with no arguments - the result is a reset to plain text -.sp -e\&.g to set foreground red and bold -.sp -punk::ansi::a red bold -.sp -to set background red -.sp -punk::ansi::a Red -.sp -see \fBpunk::ansi::a?\fR to display a list of codes -.TP \fBget_code_name\fR \fIcode\fR .sp for example diff --git a/src/embedded/man/files/punk/_module_args-0.1.0.tm.n b/src/embedded/man/files/punk/_module_args-0.1.0.tm.n index 2dfc509..40e094f 100644 --- a/src/embedded/man/files/punk/_module_args-0.1.0.tm.n +++ b/src/embedded/man/files/punk/_module_args-0.1.0.tm.n @@ -276,7 +276,7 @@ punkshell_module_punk::args \- args parsing .SH SYNOPSIS package require \fBpunk::args \fR .sp -\fBopts_values\fR \fIoptionspecs\fR \fIrawargs\fR ?option value\&.\&.\&.? +\fBget_dict\fR \fIoptionspecs\fR \fIrawargs\fR ?option value\&.\&.\&.? .sp .BE .SH DESCRIPTION @@ -290,13 +290,15 @@ overview of punk::args There are 2 main conventions for parsing a proc args list .IP [1] .sp -leading option-value pairs followed by a list of values (Tk style) +leading option-value pairs followed by a list of values (Tcl style) .IP [2] .sp -leading list of values followed by option-value pairs (Tcl style) +leading list of values followed by option-value pairs (Tk style) .PP .PP -punk::args is focused on the 1st convention (Tk style): parsing of args in leading option-value pair style - even for non-Tk usage\&. +There are exceptions in both Tcl and Tk commands regarding this ordering +.PP +punk::args is focused on the 1st convention (Tcl style): parsing of the 'args' variable in leading option-value pair style .PP The proc can still contain some leading required values e\&.g .CS @@ -304,7 +306,8 @@ The proc can still contain some leading required values e\&.g proc dostuff {arg1 arg2 args} {\&.\&.\&.}} .CE .PP -but having the core values elements at the end of args is more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style\&. +but having the core values elements at the end of args is arguably more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style\&. +.PP .PP The basic principle is that a call to punk::args::opts_vals is made near the beginning of the proc e\&.g .CS @@ -312,8 +315,14 @@ The basic principle is that a call to punk::args::opts_vals is made near the beg proc dofilestuff {args} { lassign [dict values [punk::args { + *proc -help "do some stuff with files e\&.g dofilestuff " + *opts -type string + #comment lines ok -directory -default "" -translation -default binary + #setting -type none indicates a flag that doesn't take a value (solo flag) + -nocomplain -type none + *values -min 1 -max -1 } $args]] opts values puts "translation is [dict get $opts -translation]" @@ -322,18 +331,124 @@ The basic principle is that a call to punk::args::opts_vals is made near the beg } } +.CE +.PP +The lines beginning with * are optional in most cases and can be used to set defaults and some extra controls +.PP +- the above example would work just fine with only the - lines, but would allow zero filenames to be supplied as no -min value is set for *values +.PP +valid * lines being with *proc *opts *values +.PP +lines beginning with a dash define options - a name can optionally be given to each trailing positional argument\&. +.PP +If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero\&. +.PP +e\&.g the result from the punk::args call above may be something like: +.PP +opts {-translation binary -directory "" -nocomplain 0} values {0 file1\&.txt 1 file2\&.txt 2 file3\&.txt} +.PP +Here is an example that requires the number of values supplied to be exactly 2 and names the positional arguments +.PP +It also demonstrates an inital argument 'category' that is outside of the scope for punk::args processing - allowing leading and trailing positional arguments +.CS + + + proc dofilestuff {category args} { + lassign [dict values [punk::args { + -directory -default "" + -translation -default binary + -nocomplain -type none + *values -min 2 -max 2 + fileA -existingfile 1 + fileB -existingfile 1 + } $args]] opts values + puts "$category fileA: [dict get $values fileA]" + puts "$category fileB: [dict get $values fileB]" + } + +.CE +.PP +By using standard tcl proc named arguments prior to args, and setting *values -min 0 -max 0 +.PP +a Tk-style ordering can be acheived, where punk::args is only handling the trailing flags and the values element of the returned dict can be ignored +.PP +This use of leading positional arguments means the type validation features can't be applied to them\&. It can be done manually as usual, +.PP +or an additional call could be made to punk::args e\&.g +.CS + + + punk::args { + category -choices {cat1 cat2 cat3} + another_leading_arg -type boolean + } [list $category $another_leading_arg] + .CE .SS NOTES .PP -There are alternative args parsing packages such as: +For internal functions not requiring features such as solo flags, prefix matching, type checking etc - a well crafted switch statement will be the fastest pure-tcl solution\&. +.PP +When functions are called often and/or in inner loops, a switch based solution generally makes the most sense\&. +For functions that are part of an API a package may be more suitable\&. +.PP +The following example shows a switch-based solution that is highly performant (sub microsecond for the no-args case) +.CS + + + proc test1_switch {args} { + set opts [dict create\\ + -return "object"\\ + -frametype "heavy"\\ + -show_edge 1\\ + -show_seps 0\\ + -x a\\ + -y b\\ + -z c\\ + -1 1\\ + -2 2\\ + -3 3\\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'\&. Known options [dict keys $opts]" + } + } + } + return $opts + } + +.CE +.PP +Note that the switch statement uses literals so that the compiler produces a jump-table for best performance\&. +.PP +Attempting to build the switch branch using the values from dict keys $opts will stop the jump table being built\&. +To create the faster switch statement without repeating the key names, the proc body would need to be built using string map\&. +.PP +use punk::lib::show_jump_tables to verify that a jump table exists\&. +.PP +There are many alternative args parsing packages a few of which are listed here\&. .IP [1] -argp +argp (pure tcl) .IP [2] -The tcllib set of TEPAM modules +parse_args (c implementation) +.IP [3] +argparse (pure tcl *) +.IP [4] +cmdline (pure tcl) +.IP [5] +opt (pure tcl) distributed with Tcl but considered deprecated +.IP [6] +The tcllib set of TEPAM modules (pure tcl) .sp TEPAM requires an alternative procedure declaration syntax instead of proc - but has support for Tk and documentation generation\&. .PP .PP +(* c implementation planned/proposed) +.PP punk::args was designed initially without specific reference to TEPAM - and to handle some edge cases in specific projects where TEPAM wasn't suitable\&. .PP In subsequent revisions of punk::args - some features were made to operate in a way that is similar to TEPAM - to avoid gratuitous differences where possible, but of course there are differences @@ -342,7 +457,11 @@ and those used TEPAM or mixing TEPAM and punk::args should take care to assess t .PP TEPAM is a mature solution and is widely available as it is included in tcllib\&. .PP -Serious consideration should be given to using TEPAM if suitable for your project\&. +Serious consideration should be given to using TEPAM or one of the other packages, if suitable for your project\&. +.PP +punk::args is relatively performant for a pure-tcl solution - with the parsing of the argument specification block occuring only on the first run - after which a cached version of the spec is used\&. +.PP +punk::args is not limited to procs\&. It can be used in apply or coroutine situations for example\&. .SS DEPENDENCIES .PP packages used by punk::args @@ -358,7 +477,7 @@ class definitions .PP Core API functions for punk::args .TP -\fBopts_values\fR \fIoptionspecs\fR \fIrawargs\fR ?option value\&.\&.\&.? +\fBget_dict\fR \fIoptionspecs\fR \fIrawargs\fR ?option value\&.\&.\&.? .sp Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values .sp @@ -373,15 +492,28 @@ This a block of text with records delimited by newlines (lf or crlf) - but with .sp \'info complete' is used to determine if a record spans multiple lines due to multiline values .sp -Each optionspec line must be of the form: +Each optionspec line defining a flag must be of the form: .sp -optionname -key val -key2 val2\&.\&.\&. .sp where the valid keys for each option specification are: -default -type -range -choices -optional +.sp +Each optionspec line defining a positional argument is of the form: +.sp +argumentname -key val -ky2 val2\&.\&.\&. +.sp +where the valid keys for each option specification are: -default -type -range -choices +.sp +comment lines begining with # are ignored and can be placed anywhere except within a multiline value where it would become part of that value +.sp +lines beginning with *proc *opts or *values also take -key val pairs and can be used to set defaults and control settings\&. +.sp +*opts or *values lines can appear multiple times with defaults affecting flags/values that follow\&. .TP list \fIrawargs\fR .sp -This is a list of the arguments to parse\&. Usually it will be the \\$args value from the containing proc +This is a list of the arguments to parse\&. Usually it will be the $args value from the containing proc, +but it could be a manually constructed list of values made for example from positional args defined in the proc\&. .RE .sp .PP diff --git a/src/embedded/man/files/punk/_module_island-0.1.0.tm.n b/src/embedded/man/files/punk/_module_island-0.1.0.tm.n new file mode 100644 index 0000000..73b3742 --- /dev/null +++ b/src/embedded/man/files/punk/_module_island-0.1.0.tm.n @@ -0,0 +1,490 @@ +'\" +'\" Generated from file '_module_island-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "shellspy_module_punk::island" 0 0\&.1\&.0 doc "punk::island for safe interps" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +shellspy_module_punk::island \- filesystem islands for safe interps +.SH SYNOPSIS +package require \fBpunk::island \fR +.sp +\fBadd\fR \fIchild\fR \fIpath\fR +.sp +\fBreset\fR \fIchild\fR +.sp +\fBAllowed\fR \fIchild\fR \fIfname\fR +.sp +\fBFile\fR \fIchild\fR \fIcmd\fR \fIargs\fR +.sp +\fBOpen\fR \fIchild\fR \fIargs\fR +.sp +\fBExpose\fR \fIchild\fR \fIcmd\fR \fIargs\fR +.sp +\fBGlob\fR \fIchild\fR \fIargs\fR +.sp +\fBInit\fR \fIchild\fR +.sp +.BE +.SH DESCRIPTION +.PP +Package to a allow a safe interpreter to access islands of the +.PP +filesystem only, i\&.e\&. restricted directory trees within the +.PP +filesystem\&. The package brings back file, open and glob to the child interp +.PP +interpreter, though in a restricted manner\&. +.PP +JN Warning: +.PP +This mechanism can have interactions with package loading from auto_path - needs review\&. +.SH OVERVIEW +.PP +overview of punk::island +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::island +.IP \(bu +\fBTcl 8\&.6\fR +.PP +.SH API +.SS "NAMESPACE PUNK::ISLAND::CLASS" +.PP +class definitions +.PP +.SS "NAMESPACE PUNK::ISLAND::INTERPS" +.PP +hosts information for interpreters +.PP +.SS "NAMESPACE PUNK::ISLAND" +.PP +Core API functions for punk::island +.TP +\fBadd\fR \fIchild\fR \fIpath\fR +.sp +Add a path to the list of paths that are explicitely allowed for access +.sp +to a child interpreter\&. Access to any path that has not been explicitely +.sp +allowed will be denied\&. Paths that are added to the list of allowed +.sp +islands are always fully normalized\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter to control +.RE +.TP +\fBreset\fR \fIchild\fR +.sp +Remove all access path allowance and arrange for the interpreter to be +.sp +able to return to the regular safe state\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.RE +.PP +.SS "NAMESPACE PUNK::ISLAND::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +.SS "NAMESPACE PUNK::ISLAND::SYSTEM" +.PP +Internal functions that are not part of the API +.TP +\fBAllowed\fR \fIchild\fR \fIfname\fR +.sp +Check that the file name passed as an argument is within the islands of +.sp +the filesystem that have been registered through the add command for a +.sp +given (safe) interpreter\&. The path is fully normalized before testing +.sp +against the islands, which themselves are fully normalized\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.TP +string \fIfname\fR +(relative) path to the file to test +.RE +.TP +\fBFile\fR \fIchild\fR \fIcmd\fR \fIargs\fR +.sp +Parses the options and arguments to the file command to discover which +.sp +paths it tries to access and only return the results of its execution +.sp +when these path are within the allowed islands of the filesystem\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.TP +string \fIcmd\fR +Subcommand of the file command +.TP +string \fIargs\fR +Arguments to the file subcommand +.RE +.TP +\fBOpen\fR \fIchild\fR \fIargs\fR +.sp +Parses the options and arguments to the open command to discover which +.sp +paths it tries to access and only return the results of its execution +.sp +when these path are within the allowed islands of the filesystem\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.TP +string \fIargs\fR +Arguments to the open subcommand +.RE +.TP +\fBExpose\fR \fIchild\fR \fIcmd\fR \fIargs\fR +.sp +This procedure allows to callback a command that would typically have +.sp +been hidden from a child interpreter\&. It does not "interp expose" but +.sp +rather calls the hidden command, so we can easily revert back\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.TP +string \fIcmd\fR +Hidden command to call +.TP +string \fIargs\fR +Arguments to the command +.RE +.TP +\fBGlob\fR \fIchild\fR \fIargs\fR +.sp +Parses the options and arguments to the glob command to discover which +.sp +paths it tries to access and only return the results of its execution +.sp +when these path are within the allowed islands of the filesystem\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.TP +string \fIargs\fR +Arguments to the glob command +.RE +.TP +\fBInit\fR \fIchild\fR +.sp +Initialise child interpreter so that it will be able to perform some +.sp +file operations, but only within some islands of the filesystem\&. +.sp +Arguments: +.RS +.TP +string \fIchild\fR +Identifier of the child interpreter +.RE +.PP +.SH KEYWORDS +filesystem, interp, module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n b/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n index a8505f5..52b339f 100644 --- a/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n +++ b/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n @@ -330,8 +330,6 @@ package require \fBpunk::lib \fR .sp \fBlines_as_list\fR ?option value \&.\&.\&.? \fItext\fR .sp -\fBopts_values\fR ?option value\&.\&.\&.? \fIoptionspecs\fR \fIrawargs\fR -.sp .BE .SH DESCRIPTION .PP @@ -395,7 +393,7 @@ lindex_resolve will parse the index expression and return -1 if the supplied ind .sp Otherwise it will return an integer corresponding to the position in the list\&. .sp -Like Tcl list commands - it will produce an error if the form of the +Like Tcl list commands - it will produce an error if the form of the index is not acceptable .TP \fBK\fR \fIx\fR \fIy\fR .sp @@ -625,33 +623,6 @@ Returns a list of possibly trimmed lines depeding on options The concept of lines is raw lines from splitting on newline after crlf is mapped to lf .sp - not console lines which may be entirely different due to control characters such as vertical tabs or ANSI movements -.TP -\fBopts_values\fR ?option value\&.\&.\&.? \fIoptionspecs\fR \fIrawargs\fR -.sp -Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values -.sp -Returns a dict of the form: opts values -.sp -ARGUMENTS: -.RS -.TP -multiline-string \fIoptionspecs\fR -.sp -This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced -.sp -\'info complete' is used to determine if a record spans multiple lines due to multiline values -.sp -Each optionspec line must be of the form: -.sp --optionname -key val -key2 val2\&.\&.\&. -.sp -where the valid keys for each option specification are: -default -type -range -choices -optional -.TP -list \fIrawargs\fR -.sp -This is a list of the arguments to parse\&. Usually it will be the \\$args value from the containing proc -.RE -.sp .PP .SH INTERNAL .SS "NAMESPACE PUNK::LIB::SYSTEM" diff --git a/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n b/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n new file mode 100644 index 0000000..fe187d5 --- /dev/null +++ b/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n @@ -0,0 +1,318 @@ +'\" +'\" Generated from file '_module_codethread-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "shellspy_module_punk::repl::codethread" 0 0\&.1\&.0 doc "-" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +shellspy_module_punk::repl::codethread \- Module API +.SH SYNOPSIS +package require \fBpunk::repl::codethread \fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of punk::repl::codethread +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::repl::codethread +.IP \(bu +\fBTcl 8\&.6\fR +.PP +.SH API +.SS "NAMESPACE PUNK::REPL::CODETHREAD::CLASS" +.PP +class definitions +.PP +.SS "NAMESPACE PUNK::REPL::CODETHREAD" +.PP +Core API functions for punk::repl::codethread +.PP +.SS "NAMESPACE PUNK::REPL::CODETHREAD::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +.SS "NAMESPACE PUNK::REPL::CODETHREAD::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/index.n b/src/embedded/man/index.n index dcd1a48..ce925f6 100644 --- a/src/embedded/man/index.n +++ b/src/embedded/man/index.n @@ -284,6 +284,9 @@ ansi \fBfiles/_module_overtype-1\&.6\&.2\&.tm\&.n\fR overtype_module_overtype .TP +\fBfiles/_module_overtype-1\&.6\&.3\&.tm\&.n\fR +overtype_module_overtype +.TP \fBfiles/punk/_module_ansi-0\&.1\&.1\&.tm\&.n\fR punkshell_module_punk::ansi .RE @@ -367,6 +370,15 @@ filesystem .TP \fBfiles/punk/_module_path-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::path +.TP +\fBfiles/punk/_module_island-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_punk::island +.RE +interp +.RS +.TP +\fBfiles/punk/_module_island-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_punk::island .RE lib .RS @@ -380,6 +392,9 @@ module \fBfiles/_module_overtype-1\&.6\&.2\&.tm\&.n\fR overtype_module_overtype .TP +\fBfiles/_module_overtype-1\&.6\&.3\&.tm\&.n\fR +overtype_module_overtype +.TP \fBfiles/punk/_module_ansi-0\&.1\&.1\&.tm\&.n\fR punkshell_module_punk::ansi .TP @@ -407,12 +422,24 @@ punkshell_module_punk::lib \fBfiles/punk/_module_path-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::path .TP +\fBfiles/_module_argparsingtest-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_argparsingtest +.TP +\fBfiles/punk/_module_aliascore-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_punk::aliascore +.TP \fBfiles/punk/_module_assertion-0\&.1\&.0\&.tm\&.n\fR shellspy_module_punk::assertion .TP \fBfiles/punk/_module_basictelnet-0\&.1\&.0\&.tm\&.n\fR shellspy_module_punk::basictelnet .TP +\fBfiles/punk/_module_island-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_punk::island +.TP +\fBfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_punk::repl::codethread +.TP \fBfiles/punk/_module_sshrun-0\&.1\&.0\&.tm\&.n\fR shellspy_module_punk::sshrun .TP @@ -506,6 +533,9 @@ text \fBfiles/_module_overtype-1\&.6\&.2\&.tm\&.n\fR overtype_module_overtype .TP +\fBfiles/_module_overtype-1\&.6\&.3\&.tm\&.n\fR +overtype_module_overtype +.TP \fBfiles/punk/_module_fileline-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::fileline .RE diff --git a/src/embedded/man/toc.n b/src/embedded/man/toc.n index cc70ef0..8f84cc6 100644 --- a/src/embedded/man/toc.n +++ b/src/embedded/man/toc.n @@ -276,6 +276,9 @@ doc \fBovertype_module_overtype\fR \fIfiles/_module_overtype-1\&.6\&.2\&.tm\&.n\fR: overtype text layout - ansi aware .TP +\fBovertype_module_overtype\fR +\fIfiles/_module_overtype-1\&.6\&.3\&.tm\&.n\fR: overtype text layout - ansi aware +.TP \fBpunkshell\fR \fIfiles/main\&.n\fR: punkshell - Core .TP @@ -315,12 +318,24 @@ doc \fBpunkshell_module_punk::path\fR \fIfiles/punk/_module_path-0\&.1\&.0\&.tm\&.n\fR: Filesystem path utilities .TP +\fBshellspy_module_argparsingtest\fR +\fIfiles/_module_argparsingtest-0\&.1\&.0\&.tm\&.n\fR: Module API +.TP +\fBshellspy_module_punk::aliascore\fR +\fIfiles/punk/_module_aliascore-0\&.1\&.0\&.tm\&.n\fR: Module API +.TP \fBshellspy_module_punk::assertion\fR \fIfiles/punk/_module_assertion-0\&.1\&.0\&.tm\&.n\fR: assertion alternative to control::assert .TP \fBshellspy_module_punk::basictelnet\fR \fIfiles/punk/_module_basictelnet-0\&.1\&.0\&.tm\&.n\fR: basic telnet client - DKF/Wiki .TP +\fBshellspy_module_punk::island\fR +\fIfiles/punk/_module_island-0\&.1\&.0\&.tm\&.n\fR: filesystem islands for safe interps +.TP +\fBshellspy_module_punk::repl::codethread\fR +\fIfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR: Module API +.TP \fBshellspy_module_punk::sshrun\fR \fIfiles/punk/_module_sshrun-0\&.1\&.0\&.tm\&.n\fR: Tcl procedures to execute tcl scripts in remote hosts .TP diff --git a/src/embedded/md/.doc/tocdoc b/src/embedded/md/.doc/tocdoc index 7b01f6f..5f2eae0 100644 --- a/src/embedded/md/.doc/tocdoc +++ b/src/embedded/md/.doc/tocdoc @@ -1,5 +1,6 @@ [toc_begin {Table Of Contents} doc] [item doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype {overtype text layout - ansi aware}] +[item doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype {overtype text layout - ansi aware}] [item doc/files/main.md punkshell {punkshell - Core}] [item doc/files/project_changes.md punkshell__project_changes {punkshell Changes}] [item doc/files/project_intro.md punkshell__project_intro {Introduction to punkshell}] @@ -13,8 +14,12 @@ [item doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib {punk general utility functions}] [item doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md punkshell_module_punk::mix::commandset::project {dec commandset - project}] [item doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path {Filesystem path utilities}] +[item doc/files/_module_argparsingtest-0.1.0.tm.md shellspy_module_argparsingtest {Module API}] +[item doc/files/punk/_module_aliascore-0.1.0.tm.md shellspy_module_punk::aliascore {Module API}] [item doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion {assertion alternative to control::assert}] [item doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet {basic telnet client - DKF/Wiki}] +[item doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island {filesystem islands for safe interps}] +[item doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread {Module API}] [item doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}] [item doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc {Module API}] [toc_end] diff --git a/src/embedded/md/.idx b/src/embedded/md/.idx index 67f92cf..7d7161e 100644 --- a/src/embedded/md/.idx +++ b/src/embedded/md/.idx @@ -1 +1 @@ -{file {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} assertion {{doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion}} console {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} repl {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} utility {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib}} text {{doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} arguments {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} experimental {{doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion}} encoding {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} shell {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} changelog {{doc/files/project_changes.md punkshell__project_changes}} capability {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} ansi {{doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} parse {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} terminal {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} proc {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} filesystem {{doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} path {{doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} args {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} punk {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} module {{doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} {doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} {doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} {doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} lib {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} string {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}}} {{changelog doc/files/project_changes.md punkshell__project_changes} . {text doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {shell doc/files/main.md punkshell} . {string doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {filesystem doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {module doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {ansi doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} . {module doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {module doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} . {module doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc} . {debug doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {file doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {arguments doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {shell doc/files/project_changes.md punkshell__project_changes} . {repl doc/files/project_intro.md punkshell__project_intro} . {module doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {path doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {args doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {module doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {module doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {punk doc/files/main.md punkshell} . {module doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {encodings doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {repl doc/files/project_changes.md punkshell__project_changes} . {utility doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {module doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {parse doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {proc doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {plugin doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet} . {shell doc/files/project_intro.md punkshell__project_intro} . {module doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun} . {punk doc/files/project_changes.md punkshell__project_changes} . {module doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {module doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {repl doc/files/main.md punkshell} . {experimental doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {module doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {console doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {parse doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {lib doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {punk doc/files/project_intro.md punkshell__project_intro} . {assert doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {capability doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun} . {text doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} .} 29 {assertion assertion file file assert assert encodings encodings repl repl console console utility utility text text ssh ssh experimental experimental BOM bom arguments arguments debug debug encoding encoding shell shell changelog changelog capability capability ansi ansi parse parse terminal terminal proc proc filesystem filesystem path path args args module module punk punk lib lib plugin plugin string string} \ No newline at end of file +{file {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} assertion {{doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion}} console {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} repl {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} utility {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib}} text {{doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} {doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} arguments {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} experimental {{doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion}} encoding {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} shell {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} changelog {{doc/files/project_changes.md punkshell__project_changes}} interp {{doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island}} capability {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} ansi {{doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} {doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} parse {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} terminal {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} proc {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} filesystem {{doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} path {{doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} args {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} punk {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} module {{doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} {doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} {doc/files/_module_argparsingtest-0.1.0.tm.md shellspy_module_argparsingtest} {doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype} {doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun} {doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island} {doc/files/punk/_module_aliascore-0.1.0.tm.md shellspy_module_punk::aliascore} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} {doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} lib {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} string {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}}} {{module doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype} . {changelog doc/files/project_changes.md punkshell__project_changes} . {text doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {shell doc/files/main.md punkshell} . {string doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {interp doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island} . {filesystem doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {module doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {ansi doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} . {module doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {module doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} . {module doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread} . {module doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc} . {debug doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {arguments doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {file doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {shell doc/files/project_changes.md punkshell__project_changes} . {repl doc/files/project_intro.md punkshell__project_intro} . {module doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {args doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {path doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {module doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {module doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {module doc/files/_module_argparsingtest-0.1.0.tm.md shellspy_module_argparsingtest} . {punk doc/files/main.md punkshell} . {module doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {encodings doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {repl doc/files/project_changes.md punkshell__project_changes} . {module doc/files/punk/_module_aliascore-0.1.0.tm.md shellspy_module_punk::aliascore} . {utility doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {parse doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {module doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {proc doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {plugin doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet} . {punk doc/files/project_changes.md punkshell__project_changes} . {shell doc/files/project_intro.md punkshell__project_intro} . {module doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun} . {module doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island} . {module doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {module doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {repl doc/files/main.md punkshell} . {experimental doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {console doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {parse doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {text doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype} . {lib doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {assert doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion} . {punk doc/files/project_intro.md punkshell__project_intro} . {filesystem doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island} . {ansi doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {capability doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun} . {text doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} .} 30 {assertion assertion file file assert assert encodings encodings repl repl console console utility utility text text ssh ssh experimental experimental BOM bom arguments arguments debug debug encoding encoding shell shell changelog changelog interp interp capability capability ansi ansi parse parse terminal terminal proc proc filesystem filesystem path path args args module module punk punk lib lib plugin plugin string string} \ No newline at end of file diff --git a/src/embedded/md/.toc b/src/embedded/md/.toc index 7557140..a4e72fe 100644 --- a/src/embedded/md/.toc +++ b/src/embedded/md/.toc @@ -1 +1 @@ -doc {doc/toc {{doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.md punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/main.md punkshell {punkshell - Core}} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib {flib experimental}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline {file line-handling utilities}} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args {args parsing}} {doc/files/project_changes.md punkshell__project_changes {punkshell Changes}} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char {character-set and unicode utilities}}}} \ No newline at end of file +doc {doc/toc {{doc/files/punk/_module_uc-0.1.0.tm.md shellspy_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_assertion-0.1.0.tm.md shellspy_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.md punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_overtype-1.6.2.tm.md overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/_module_argparsingtest-0.1.0.tm.md shellspy_module_argparsingtest {Module API}} {doc/files/_module_overtype-1.6.3.tm.md overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::island {filesystem islands for safe interps}} {doc/files/punk/_module_aliascore-0.1.0.tm.md shellspy_module_punk::aliascore {Module API}} {doc/files/main.md punkshell {punkshell - Core}} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib {flib experimental}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline {file line-handling utilities}} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread {Module API}} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args {args parsing}} {doc/files/project_changes.md punkshell__project_changes {punkshell Changes}} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char {character-set and unicode utilities}}}} \ No newline at end of file diff --git a/src/embedded/md/.xrf b/src/embedded/md/.xrf index 96899fb..b4ec9b2 100644 --- a/src/embedded/md/.xrf +++ b/src/embedded/md/.xrf @@ -1 +1 @@ -assertion {index.md assertion} kw,capability {index.md capability} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md assert {index.md assert} kw,proc {index.md proc} sa,shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md kw,lib {index.md lib} punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md {punkshell Changes} doc/files/project_changes.md debug {index.md debug} kw,encodings {index.md encodings} {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.md {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md {Introduction to punkshell} doc/files/project_intro.md proc {index.md proc} sa,punkshell(n) doc/files/main.md punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md filesystem {index.md filesystem} sa,punkshell doc/files/main.md kw,shell {index.md shell} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.md sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md kw,parse {index.md parse} sa,shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell__project_changes(n) doc/files/project_changes.md kw,terminal {index.md terminal} sa,shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md kw,args {index.md args} kw,path {index.md path} utility {index.md utility} kw,module {index.md module} punkshell(n) doc/files/main.md punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md kw,string {index.md string} kw,plugin {index.md plugin} punkshell doc/files/main.md kw,file {index.md file} ssh {index.md ssh} sa,shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md kw,assert {index.md assert} changelog {index.md changelog} sa,shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md punkshell__project_changes(n) doc/files/project_changes.md kw,utility {index.md utility} shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell__project_changes doc/files/project_changes.md kw,arguments {index.md arguments} kw,experimental {index.md experimental} kw,ssh {index.md ssh} terminal {index.md terminal} args {index.md args} path {index.md path} sa,shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md file {index.md file} shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md {args parsing} doc/files/punk/_module_args-0.1.0.tm.md sa,shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md encodings {index.md encodings} sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.md punkshell__project_changes doc/files/project_changes.md sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md kw,filesystem {index.md filesystem} sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md kw,assertion {index.md assertion} experimental {index.md experimental} {Module API} doc/files/punk/_module_uc-0.1.0.tm.md sa,overtype_module_overtype doc/files/_module_overtype-1.6.2.tm.md sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md shell {index.md shell} {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.md sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.2.tm.md {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.2.tm.md punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md kw,repl {index.md repl} shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md capability {index.md capability} punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md kw,text {index.md text} parse {index.md parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.md {punkshell - Core} doc/files/main.md punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md kw,encoding {index.md encoding} kw,debug {index.md debug} overtype_module_overtype doc/files/_module_overtype-1.6.2.tm.md punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md overtype_module_overtype(0) doc/files/_module_overtype-1.6.2.tm.md kw,ansi {index.md ansi} {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.md sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md console {index.md console} repl {index.md repl} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md kw,punk {index.md punk} sa,punkshell__project_intro(n) doc/files/project_intro.md text {index.md text} sa,punkshell__project_intro doc/files/project_intro.md {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.md arguments {index.md arguments} BOM {index.md bom} encoding {index.md encoding} sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md kw,console {index.md console} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md ansi {index.md ansi} {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.md kw,BOM {index.md bom} punkshell__project_intro(n) doc/files/project_intro.md punkshell__project_intro doc/files/project_intro.md {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.md kw,changelog {index.md changelog} module {index.md module} punk {index.md punk} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md string {index.md string} plugin {index.md plugin} lib {index.md lib} \ No newline at end of file +assertion {index.md assertion} kw,capability {index.md capability} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md assert {index.md assert} kw,proc {index.md proc} sa,shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.md shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.md sa,shellspy_module_punk::island doc/files/punk/_module_island-0.1.0.tm.md sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md kw,lib {index.md lib} shellspy_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md {punkshell Changes} doc/files/project_changes.md debug {index.md debug} kw,encodings {index.md encodings} {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.md {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.md shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md {Introduction to punkshell} doc/files/project_intro.md proc {index.md proc} shellspy_module_punk::island doc/files/punk/_module_island-0.1.0.tm.md sa,punkshell(n) doc/files/main.md punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md filesystem {index.md filesystem} sa,punkshell doc/files/main.md kw,shell {index.md shell} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.md kw,interp {index.md interp} sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md kw,parse {index.md parse} sa,shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell__project_changes(n) doc/files/project_changes.md kw,terminal {index.md terminal} sa,shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md kw,args {index.md args} kw,path {index.md path} utility {index.md utility} kw,module {index.md module} punkshell(n) doc/files/main.md punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md kw,string {index.md string} kw,plugin {index.md plugin} sa,shellspy_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.md punkshell doc/files/main.md kw,file {index.md file} ssh {index.md ssh} sa,shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md kw,assert {index.md assert} changelog {index.md changelog} sa,shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md punkshell__project_changes(n) doc/files/project_changes.md kw,utility {index.md utility} shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell__project_changes doc/files/project_changes.md kw,arguments {index.md arguments} kw,experimental {index.md experimental} kw,ssh {index.md ssh} terminal {index.md terminal} sa,shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.md args {index.md args} path {index.md path} shellspy_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.md sa,shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md sa,shellspy_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.md shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md file {index.md file} shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md {args parsing} doc/files/punk/_module_args-0.1.0.tm.md sa,shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md encodings {index.md encodings} sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.md punkshell__project_changes doc/files/project_changes.md sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md kw,filesystem {index.md filesystem} sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md sa,shellspy_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.md shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.md kw,assertion {index.md assertion} experimental {index.md experimental} sa,shellspy_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.md {Module API} doc/files/punk/repl/_module_codethread-0.1.0.tm.md sa,overtype_module_overtype doc/files/_module_overtype-1.6.3.tm.md sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md shell {index.md shell} {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.md sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.3.tm.md {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.3.tm.md punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md kw,repl {index.md repl} shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md capability {index.md capability} punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md kw,text {index.md text} parse {index.md parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.md {punkshell - Core} doc/files/main.md punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md shellspy_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.md kw,encoding {index.md encoding} kw,debug {index.md debug} {filesystem islands for safe interps} doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.md overtype_module_overtype doc/files/_module_overtype-1.6.3.tm.md punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md overtype_module_overtype(0) doc/files/_module_overtype-1.6.3.tm.md kw,ansi {index.md ansi} {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.md sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md console {index.md console} repl {index.md repl} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md kw,punk {index.md punk} sa,punkshell__project_intro(n) doc/files/project_intro.md text {index.md text} sa,punkshell__project_intro doc/files/project_intro.md {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.md arguments {index.md arguments} BOM {index.md bom} encoding {index.md encoding} sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md kw,console {index.md console} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md interp {index.md interp} ansi {index.md ansi} sa,shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.md {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.md kw,BOM {index.md bom} punkshell__project_intro(n) doc/files/project_intro.md punkshell__project_intro doc/files/project_intro.md sa,shellspy_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.md {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.md kw,changelog {index.md changelog} module {index.md module} punk {index.md punk} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md string {index.md string} plugin {index.md plugin} lib {index.md lib} \ No newline at end of file diff --git a/src/embedded/md/doc/files/_module_argparsingtest-0.1.0.tm.md b/src/embedded/md/doc/files/_module_argparsingtest-0.1.0.tm.md new file mode 100644 index 0000000..957608e --- /dev/null +++ b/src/embedded/md/doc/files/_module_argparsingtest-0.1.0.tm.md @@ -0,0 +1,87 @@ + +[//000000001]: # (shellspy\_module\_argparsingtest \- \-) +[//000000002]: # (Generated from file '\_module\_argparsingtest\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (shellspy\_module\_argparsingtest\(0\) 0\.1\.0 doc "\-") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +shellspy\_module\_argparsingtest \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace argparsingtest::class](#subsection3) + + - [Namespace argparsingtest](#subsection4) + + - [Namespace argparsingtest::lib](#subsection5) + + - [Internal](#section4) + + - [Namespace argparsingtest::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require argparsingtest + +# DESCRIPTION + +\- + +# Overview + +overview of argparsingtest + +## Concepts + +\- + +## dependencies + +packages used by argparsingtest + + - __Tcl 8\.6__ + +# API + +## Namespace argparsingtest::class + +class definitions + +## Namespace argparsingtest + +## Namespace argparsingtest::lib + +# Internal + +## Namespace argparsingtest::system + +# KEYWORDS + +[module](\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/_module_overtype-1.6.3.tm.md b/src/embedded/md/doc/files/_module_overtype-1.6.3.tm.md new file mode 100644 index 0000000..22a32e7 --- /dev/null +++ b/src/embedded/md/doc/files/_module_overtype-1.6.3.tm.md @@ -0,0 +1,139 @@ + +[//000000001]: # (overtype\_module\_overtype \- overtype text layout) +[//000000002]: # (Generated from file '\_module\_overtype\-1\.6\.3\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (overtype\_module\_overtype\(0\) 1\.6\.3 doc "overtype text layout") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +overtype\_module\_overtype \- overtype text layout \- ansi aware + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace overtype](#subsection3) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require overtype + +[__overtype::renderspace__ *args*](#1) +[__overtype::renderline__ *args*](#2) + +# DESCRIPTION + +\- + +# Overview + +overview of overtype + +## Concepts + +\- + +## dependencies + +packages used by overtype + + - __Tcl 8\.6__ + + - __textutil__ + + - __punk::ansi__ + + \- required to detect, split, strip and calculate lengths of text possibly + containing ansi codes + + - __punk::char__ + + \- box drawing \- and also unicode character width determination for proper + layout of text with double\-column\-width chars + +# API + +## Namespace overtype + +Core API functions for overtype + + - __overtype::renderspace__ *args* + + usage: ?\-transparent \[0|1\]? ?\-overflow \[1|0\]? ?\-ellipsis \[1|0\]? + ?\-ellipsistext \.\.\.? undertext overtext + + - __overtype::renderline__ *args* + + renderline is the core engine for overtype string processing \(frames & + textblocks\), and the raw mode commandline repl for the Tcl Punk Shell + + It is also a central part of an ansi \(micro\) virtual terminal\-emulator of + sorts + + This system does a half decent job at rendering 90's ANSI art to manipulable + colour text blocks that can be joined & framed for layout display within a + unix or windows terminal + + Renderline helps maintain ANSI text styling reset/replay codes so that the + styling of one block doesn't affect another\. + + Calling on the punk::ansi library \- it can coalesce codes to keep the size + down\. + + It is a giant mess of doing exactly what common wisdom says not to do\.\.\. + lots at once\. + + renderline is part of the Unicode and ANSI aware Overtype system which + 'renders' a block of text onto a static underlay + + The underlay is generally expected to be an ordered set of lines or a + rectangular text block analogous to a terminal screen \- but it can also be + ragged in line length, or just blank\. + + The overlay couuld be similar \- in which case it may often be used to + overwrite a column or section of the underlay\. + + The overlay could however be a sequence of ANSI\-laden text that jumps all + over the place\. + + renderline itself only deals with a single line \- or sometimes a single + character\. It is generally called from a loop that does further + terminal\-like or textblock processing\. + + By suppyling the \-info 1 option \- it can return various fields indicating + the state of the render\. + + The main 3 are the result, overflow\_right, and unapplied\. + + Renderline handles cursor movements from either keystrokes or ANSI sequences + but for a full system the aforementioned loop will need to be in place to + manage the set of lines under manipulation\. + +# KEYWORDS + +[ansi](\.\./\.\./index\.md\#ansi), [module](\.\./\.\./index\.md\#module), +[text](\.\./\.\./index\.md\#text) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/punk/_module_aliascore-0.1.0.tm.md b/src/embedded/md/doc/files/punk/_module_aliascore-0.1.0.tm.md new file mode 100644 index 0000000..90e9a01 --- /dev/null +++ b/src/embedded/md/doc/files/punk/_module_aliascore-0.1.0.tm.md @@ -0,0 +1,87 @@ + +[//000000001]: # (shellspy\_module\_punk::aliascore \- \-) +[//000000002]: # (Generated from file '\_module\_aliascore\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (shellspy\_module\_punk::aliascore\(0\) 0\.1\.0 doc "\-") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +shellspy\_module\_punk::aliascore \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::aliascore::class](#subsection3) + + - [Namespace punk::aliascore](#subsection4) + + - [Namespace punk::aliascore::lib](#subsection5) + + - [Internal](#section4) + + - [Namespace punk::aliascore::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::aliascore + +# DESCRIPTION + +\- + +# Overview + +overview of punk::aliascore + +## Concepts + +\- + +## dependencies + +packages used by punk::aliascore + + - __Tcl 8\.6__ + +# API + +## Namespace punk::aliascore::class + +class definitions + +## Namespace punk::aliascore + +## Namespace punk::aliascore::lib + +# Internal + +## Namespace punk::aliascore::system + +# KEYWORDS + +[module](\.\./\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md b/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md index db5d954..c93ac44 100644 --- a/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md +++ b/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md @@ -49,55 +49,54 @@ package require punk::ansi [__a?__ ?ansicode\.\.\.?](#3) [__a\+__ ?ansicode\.\.\.?](#4) [__a__ ?ansicode\.\.\.?](#5) -[__a__ ?ansicode\.\.\.?](#6) -[__get\_code\_name__ *code*](#7) -[__reset__](#8) -[__reset\_soft__](#9) -[__reset\_colour__](#10) -[__clear__](#11) -[__clear\_above__](#12) -[__clear\_below__](#13) -[__cursor\_on__](#14) -[__cursor\_off__](#15) -[__move__ *row* *col*](#16) -[__move\_emit__ *row* *col* *data* ?row col data\.\.\.?](#17) -[__move\_forward__ *n*](#18) -[__move\_back__ *n*](#19) -[__move\_up__ *n*](#20) -[__move\_down__ *n*](#21) -[__move\_column__ *col*](#22) -[__move\_row__ *row*](#23) -[__cursor\_save__](#24) -[__cursor\_restore__](#25) -[__cursor\_save\_dec__](#26) -[__cursor\_restore\_attributes__](#27) -[__enable\_line\_wrap__](#28) -[__disable\_line\_wrap__](#29) -[__query\_mode\_line\_wrap__](#30) -[__erase\_line__](#31) -[__erase\_sol__](#32) -[__erase\_eol__](#33) -[__scroll\_up__ *n*](#34) -[__scroll\_down__ *n*](#35) -[__insert\_spaces__ *count*](#36) -[__delete\_characters__ *count*](#37) -[__erase\_characters__ *count*](#38) -[__insert\_lines__ *count*](#39) -[__delete\_lines__ *count*](#40) -[__cursor\_pos__](#41) -[__request\_cursor\_information__](#42) -[__request\_tabstops__](#43) -[__titleset__ *windowtitles*](#44) -[__is\_sgr\_reset__ *code*](#45) -[__has\_sgr\_leadingreset__ *code*](#46) -[__detect__ *text*](#47) -[__detect\_csi__ *text*](#48) -[__detect\_sgr__ *text*](#49) -[__strip__ *text*](#50) -[__length__ *text*](#51) -[__VIEW__ *string*](#52) -[__COUNT__ *string*](#53) -[__index__ *string* *index*](#54) +[__get\_code\_name__ *code*](#6) +[__reset__](#7) +[__reset\_soft__](#8) +[__reset\_colour__](#9) +[__clear__](#10) +[__clear\_above__](#11) +[__clear\_below__](#12) +[__cursor\_on__](#13) +[__cursor\_off__](#14) +[__move__ *row* *col*](#15) +[__move\_emit__ *row* *col* *data* ?row col data\.\.\.?](#16) +[__move\_forward__ *n*](#17) +[__move\_back__ *n*](#18) +[__move\_up__ *n*](#19) +[__move\_down__ *n*](#20) +[__move\_column__ *col*](#21) +[__move\_row__ *row*](#22) +[__cursor\_save__](#23) +[__cursor\_restore__](#24) +[__cursor\_save\_dec__](#25) +[__cursor\_restore\_attributes__](#26) +[__enable\_line\_wrap__](#27) +[__disable\_line\_wrap__](#28) +[__query\_mode\_line\_wrap__](#29) +[__erase\_line__](#30) +[__erase\_sol__](#31) +[__erase\_eol__](#32) +[__scroll\_up__ *n*](#33) +[__scroll\_down__ *n*](#34) +[__insert\_spaces__ *count*](#35) +[__delete\_characters__ *count*](#36) +[__erase\_characters__ *count*](#37) +[__insert\_lines__ *count*](#38) +[__delete\_lines__ *count*](#39) +[__cursor\_pos__](#40) +[__request\_cursor\_information__](#41) +[__request\_tabstops__](#42) +[__titleset__ *windowtitles*](#43) +[__is\_sgr\_reset__ *code*](#44) +[__has\_sgr\_leadingreset__ *code*](#45) +[__detect__ *text*](#46) +[__detect\_csi__ *text*](#47) +[__detect\_sgr__ *text*](#48) +[__strip__ *text*](#49) +[__length__ *text*](#50) +[__VIEW__ *string*](#51) +[__COUNT__ *string*](#52) +[__index__ *string* *index*](#53) # DESCRIPTION @@ -154,7 +153,16 @@ Core API functions for punk::ansi Alternate graphics modes will be stripped \- exposing the raw characters as they appear without graphics mode\. - ie instead of a horizontal line you may see: qqqqqq + ie instead of a horizontal line you may see: qqqqqq e\.g who is to know that + 'Rabbit Paws', 'Forbidden Thrill' and 'Tarsier' refer to a particular shade + of pinky\-red? \(code 95\) Perhaps it's an indication that colour naming once + we get to 256 colours or more is a fool's errand anyway\. The xterm names are + boringly unimaginative \- and also have some oddities such as: DarkSlateGray1 + which looks much more like cyan\.\. The greyxx names are spelt with an e \- but + the darkslategrayX variants use an a\. Perhaps that's because they are more + cyan than grey and the a is a hint? there is no gold or gold2 \- but there is + gold1 and gold3 but in general the names bear some resemblance to the + colours and are at least somewhat intuitive\. - __a?__ ?ansicode\.\.\.? @@ -194,25 +202,7 @@ Core API functions for punk::ansi see __punk::ansi::a?__ to display a list of codes - - __a__ ?ansicode\.\.\.? - - Returns the ansi code to reset any current settings and apply those from the - supplied list - - by calling punk::ansi::a with no arguments \- the result is a reset to plain - text - - e\.g to set foreground red and bold - - punk::ansi::a red bold - - to set background red - - punk::ansi::a Red - - see __punk::ansi::a?__ to display a list of codes - - - __get\_code\_name__ *code* + - __get\_code\_name__ *code* for example @@ -220,33 +210,33 @@ Core API functions for punk::ansi get\_code\_name 31 will return red - - __reset__ + - __reset__ reset console - - __reset\_soft__ + - __reset\_soft__ - - __reset\_colour__ + - __reset\_colour__ reset colour only - - __clear__ + - __clear__ - - __clear\_above__ + - __clear\_above__ - - __clear\_below__ + - __clear\_below__ - - __cursor\_on__ + - __cursor\_on__ - - __cursor\_off__ + - __cursor\_off__ - - __move__ *row* *col* + - __move__ *row* *col* Return an ansi sequence to move to row,col aka cursor home - - __move\_emit__ *row* *col* *data* ?row col data\.\.\.? + - __move\_emit__ *row* *col* *data* ?row col data\.\.\.? Return an ansi string representing a move to row col with data appended @@ -282,21 +272,21 @@ Core API functions for punk::ansi an intuitive manner compared to other punk::ansi move functions \- so is deliberately omitted\. - - __move\_forward__ *n* + - __move\_forward__ *n* - - __move\_back__ *n* + - __move\_back__ *n* - - __move\_up__ *n* + - __move\_up__ *n* - - __move\_down__ *n* + - __move\_down__ *n* - - __move\_column__ *col* + - __move\_column__ *col* - - __move\_row__ *row* + - __move\_row__ *row* VPA \- Vertical Line Position Absolute - - __cursor\_save__ + - __cursor\_save__ equivalent term::ansi::code::ctrl::sc @@ -305,25 +295,25 @@ Core API functions for punk::ansi On many terminals either will work \- but cursor\_save\_dec is shorter and perhaps more widely supported - - __cursor\_restore__ + - __cursor\_restore__ equivalent term::ansi::code::ctrl::rc ANSI/SCO \- see also cursor\_restore\_dec for the DECRC version - - __cursor\_save\_dec__ + - __cursor\_save\_dec__ equivalent term::ansi::code::ctrl::sca DECSC - - __cursor\_restore\_attributes__ + - __cursor\_restore\_attributes__ equivalent term::ansi::code::ctrl::rca DECRC - - __enable\_line\_wrap__ + - __enable\_line\_wrap__ enable automatic line wrapping when characters entered beyond rightmost column @@ -332,41 +322,41 @@ Core API functions for punk::ansi This is DECAWM \- and is the same sequence output by 'tput smam' - - __disable\_line\_wrap__ + - __disable\_line\_wrap__ disable automatic line wrapping reset DECAWM \- same sequence output by 'tput rmam' tput rmam - - __query\_mode\_line\_wrap__ + - __query\_mode\_line\_wrap__ DECRQM to query line\-wrap state The punk::ansi::query\_mode\_ functions just emit the ansi query sequence\. - - __erase\_line__ + - __erase\_line__ - - __erase\_sol__ + - __erase\_sol__ Erase to start of line, leaving cursor position alone\. - - __erase\_eol__ + - __erase\_eol__ - - __scroll\_up__ *n* + - __scroll\_up__ *n* - - __scroll\_down__ *n* + - __scroll\_down__ *n* - - __insert\_spaces__ *count* + - __insert\_spaces__ *count* - - __delete\_characters__ *count* + - __delete\_characters__ *count* - - __erase\_characters__ *count* + - __erase\_characters__ *count* - - __insert\_lines__ *count* + - __insert\_lines__ *count* - - __delete\_lines__ *count* + - __delete\_lines__ *count* - - __cursor\_pos__ + - __cursor\_pos__ cursor\_pos unlikely to be useful on it's own like this as when written to the terminal, this sequence causes the terminal to emit the row;col sequence @@ -384,7 +374,7 @@ Core API functions for punk::ansi The punk::ansi::cursor\_pos function is used by punk::console::get\_cursor\_pos and punk::console::get\_cursor\_pos\_list - - __request\_cursor\_information__ + - __request\_cursor\_information__ DECRQPSR \(DEC Request Presentation State Report\) for DECCCIR Cursor Information report @@ -394,7 +384,7 @@ Core API functions for punk::ansi A stdin readloop will need to be in place to read this information - - __request\_tabstops__ + - __request\_tabstops__ DECRQPSR \(DEC Request Presentation State Report\) for DECTABSR Tab stop report @@ -402,7 +392,7 @@ Core API functions for punk::ansi When written to the terminal, this sequence causes the terminal to emit tabstop information to stdin - - __titleset__ *windowtitles* + - __titleset__ *windowtitles* Returns the code to set the title of the terminal window to windowtitle @@ -414,7 +404,7 @@ API functions for punk::ansi::codetype Utility functions for processing ansi code sequences - - __is\_sgr\_reset__ *code* + - __is\_sgr\_reset__ *code* Return a boolean indicating whether this string has a trailing pure SGR reset @@ -425,7 +415,7 @@ Utility functions for processing ansi code sequences This is primarily intended for testing a single ansi code sequence, but code can be any string where the trailing SGR code is to be tested\. - - __has\_sgr\_leadingreset__ *code* + - __has\_sgr\_leadingreset__ *code* The reset must be the very first item in code to be detected\. Trailing strings/codes ignored\. @@ -438,11 +428,11 @@ based on but not identical to the Perl Text Ansi module: https://github\.com/perlancar/perl\-Text\-ANSI\-Util/blob/master/lib/Text/ANSI/BaseUtil\.pm - - __detect__ *text* + - __detect__ *text* Return a boolean indicating whether Ansi codes were detected in text - - __detect\_csi__ *text* + - __detect\_csi__ *text* Return a boolean indicating whether an Ansi Control Sequence Introducer \(CSI\) was detected in text @@ -459,7 +449,7 @@ https://github\.com/perlancar/perl\-Text\-ANSI\-Util/blob/master/lib/Text/ANSI/B \(This function is not in perl ta\) - - __detect\_sgr__ *text* + - __detect\_sgr__ *text* Return a boolean indicating whether an ansi Select Graphics Rendition code was detected\. @@ -474,13 +464,13 @@ https://github\.com/perlancar/perl\-Text\-ANSI\-Util/blob/master/lib/Text/ANSI/B \(This function is not in perl ta\) - - __strip__ *text* + - __strip__ *text* Return text stripped of Ansi codes This is a tailcall to punk::ansi::stripansi - - __length__ *text* + - __length__ *text* Return the character length after stripping ansi codes \- not the printing length @@ -495,7 +485,7 @@ codes is always going to be significantly slower than working with plain strings Just as working with other forms of markup such as HTML \- you simply need to be aware of the tradeoffs and design accordingly\. - - __VIEW__ *string* + - __VIEW__ *string* Return a string with specific ANSI control characters substituted with visual equivalents frome the appropriate unicode C0 and C1 visualisation @@ -512,7 +502,7 @@ aware of the tradeoffs and design accordingly\. As punkshell uses linefeed where possible in preference to crlf even on windows, cr is mapped to \\\\U240D '\\U240D' \- but lf is left as is\. - - __COUNT__ *string* + - __COUNT__ *string* Returns the count of visible graphemes and non\-ansi control characters @@ -534,7 +524,7 @@ aware of the tradeoffs and design accordingly\. To get the width, use punk::ansi::printing\_length instead, which is also ansi aware\. - - __index__ *string* *index* + - __index__ *string* *index* Takes a string that possibly contains ansi codes such as colour,underline etc \(SGR codes\) diff --git a/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md b/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md index 412d50f..04aa07f 100644 --- a/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md +++ b/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md @@ -48,7 +48,7 @@ punkshell\_module\_punk::args \- args parsing package require punk::args -[__opts\_values__ *optionspecs* *rawargs* ?option value\.\.\.?](#1) +[__get\_dict__ *optionspecs* *rawargs* ?option value\.\.\.?](#1) # DESCRIPTION @@ -62,28 +62,36 @@ overview of punk::args There are 2 main conventions for parsing a proc args list - 1. leading option\-value pairs followed by a list of values \(Tk style\) + 1. leading option\-value pairs followed by a list of values \(Tcl style\) - 1. leading list of values followed by option\-value pairs \(Tcl style\) + 1. leading list of values followed by option\-value pairs \(Tk style\) -punk::args is focused on the 1st convention \(Tk style\): parsing of args in -leading option\-value pair style \- even for non\-Tk usage\. +There are exceptions in both Tcl and Tk commands regarding this ordering + +punk::args is focused on the 1st convention \(Tcl style\): parsing of the 'args' +variable in leading option\-value pair style The proc can still contain some leading required values e\.g proc dostuff {arg1 arg2 args} {...}} -but having the core values elements at the end of args is more generally useful -\- especially in cases where the number of trailing values is unknown and/or the -proc is to be called in a functional 'pipeline' style\. +but having the core values elements at the end of args is arguably more +generally useful \- especially in cases where the number of trailing values is +unknown and/or the proc is to be called in a functional 'pipeline' style\. The basic principle is that a call to punk::args::opts\_vals is made near the beginning of the proc e\.g proc dofilestuff {args} { lassign [dict values [punk::args { + *proc -help "do some stuff with files e.g dofilestuff " + *opts -type string + #comment lines ok -directory -default "" -translation -default binary + #setting -type none indicates a flag that doesn't take a value (solo flag) + -nocomplain -type none + *values -min 1 -max -1 } $args]] opts values puts "translation is [dict get $opts -translation]" @@ -92,17 +100,127 @@ beginning of the proc e\.g } } +The lines beginning with \* are optional in most cases and can be used to set +defaults and some extra controls + +\- the above example would work just fine with only the \- lines, but +would allow zero filenames to be supplied as no \-min value is set for \*values + +valid \* lines being with \*proc \*opts \*values + +lines beginning with a dash define options \- a name can optionally be given to +each trailing positional argument\. + +If no names are defined for positional arguments, they will end up in the values +key of the dict with numerical keys starting at zero\. + +e\.g the result from the punk::args call above may be something like: + +opts \{\-translation binary \-directory "" \-nocomplain 0\} values \{0 file1\.txt 1 +file2\.txt 2 file3\.txt\} + +Here is an example that requires the number of values supplied to be exactly 2 +and names the positional arguments + +It also demonstrates an inital argument 'category' that is outside of the scope +for punk::args processing \- allowing leading and trailing positional arguments + + proc dofilestuff {category args} { + lassign [dict values [punk::args { + -directory -default "" + -translation -default binary + -nocomplain -type none + *values -min 2 -max 2 + fileA -existingfile 1 + fileB -existingfile 1 + } $args]] opts values + puts "$category fileA: [dict get $values fileA]" + puts "$category fileB: [dict get $values fileB]" + } + +By using standard tcl proc named arguments prior to args, and setting \*values +\-min 0 \-max 0 + +a Tk\-style ordering can be acheived, where punk::args is only handling the +trailing flags and the values element of the returned dict can be ignored + +This use of leading positional arguments means the type validation features +can't be applied to them\. It can be done manually as usual, + +or an additional call could be made to punk::args e\.g + + punk::args { + category -choices {cat1 cat2 cat3} + another_leading_arg -type boolean + } [list $category $another_leading_arg] + ## Notes -There are alternative args parsing packages such as: +For internal functions not requiring features such as solo flags, prefix +matching, type checking etc \- a well crafted switch statement will be the +fastest pure\-tcl solution\. + +When functions are called often and/or in inner loops, a switch based solution +generally makes the most sense\. For functions that are part of an API a package +may be more suitable\. + +The following example shows a switch\-based solution that is highly performant +\(sub microsecond for the no\-args case\) + + proc test1_switch {args} { + set opts [dict create\ + -return "object"\ + -frametype "heavy"\ + -show_edge 1\ + -show_seps 0\ + -x a\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + +Note that the switch statement uses literals so that the compiler produces a +jump\-table for best performance\. + +Attempting to build the switch branch using the values from dict keys $opts will +stop the jump table being built\. To create the faster switch statement without +repeating the key names, the proc body would need to be built using string map\. + +use punk::lib::show\_jump\_tables to verify that a jump table exists\. + +There are many alternative args parsing packages a few of which are listed here\. + + 1. argp \(pure tcl\) + + 1. parse\_args \(c implementation\) + + 1. argparse \(pure tcl \*\) + + 1. cmdline \(pure tcl\) - 1. argp + 1. opt \(pure tcl\) distributed with Tcl but considered deprecated - 1. The tcllib set of TEPAM modules + 1. The tcllib set of TEPAM modules \(pure tcl\) TEPAM requires an alternative procedure declaration syntax instead of proc \- but has support for Tk and documentation generation\. +\(\* c implementation planned/proposed\) + punk::args was designed initially without specific reference to TEPAM \- and to handle some edge cases in specific projects where TEPAM wasn't suitable\. @@ -115,8 +233,15 @@ the differences\. TEPAM is a mature solution and is widely available as it is included in tcllib\. -Serious consideration should be given to using TEPAM if suitable for your -project\. +Serious consideration should be given to using TEPAM or one of the other +packages, if suitable for your project\. + +punk::args is relatively performant for a pure\-tcl solution \- with the parsing +of the argument specification block occuring only on the first run \- after which +a cached version of the spec is used\. + +punk::args is not limited to procs\. It can be used in apply or coroutine +situations for example\. ## dependencies @@ -132,7 +257,7 @@ class definitions ## Namespace punk::args - - __opts\_values__ *optionspecs* *rawargs* ?option value\.\.\.? + - __get\_dict__ *optionspecs* *rawargs* ?option value\.\.\.? Parse rawargs as a sequence of zero or more option\-value pairs followed by zero or more values @@ -149,17 +274,35 @@ class definitions 'info complete' is used to determine if a record spans multiple lines due to multiline values - Each optionspec line must be of the form: + Each optionspec line defining a flag must be of the form: \-optionname \-key val \-key2 val2\.\.\. where the valid keys for each option specification are: \-default \-type \-range \-choices \-optional + Each optionspec line defining a positional argument is of the form: + + argumentname \-key val \-ky2 val2\.\.\. + + where the valid keys for each option specification are: \-default \-type + \-range \-choices + + comment lines begining with \# are ignored and can be placed anywhere + except within a multiline value where it would become part of that value + + lines beginning with \*proc \*opts or \*values also take \-key val pairs and + can be used to set defaults and control settings\. + + \*opts or \*values lines can appear multiple times with defaults affecting + flags/values that follow\. + * list *rawargs* - This is a list of the arguments to parse\. Usually it will be the \\$args - value from the containing proc + This is a list of the arguments to parse\. Usually it will be the $args + value from the containing proc, but it could be a manually constructed + list of values made for example from positional args defined in the + proc\. ## Namespace punk::args::lib diff --git a/src/embedded/md/doc/files/punk/_module_island-0.1.0.tm.md b/src/embedded/md/doc/files/punk/_module_island-0.1.0.tm.md new file mode 100644 index 0000000..494686d --- /dev/null +++ b/src/embedded/md/doc/files/punk/_module_island-0.1.0.tm.md @@ -0,0 +1,254 @@ + +[//000000001]: # (shellspy\_module\_punk::island \- punk::island for safe interps) +[//000000002]: # (Generated from file '\_module\_island\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (shellspy\_module\_punk::island\(0\) 0\.1\.0 doc "punk::island for safe interps") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +shellspy\_module\_punk::island \- filesystem islands for safe interps + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::island::class](#subsection3) + + - [Namespace punk::island::interps](#subsection4) + + - [Namespace punk::island](#subsection5) + + - [Namespace punk::island::lib](#subsection6) + + - [Internal](#section4) + + - [Namespace punk::island::system](#subsection7) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::island + +[__add__ *child* *path*](#1) +[__reset__ *child*](#2) +[__Allowed__ *child* *fname*](#3) +[__File__ *child* *cmd* *args*](#4) +[__Open__ *child* *args*](#5) +[__Expose__ *child* *cmd* *args*](#6) +[__Glob__ *child* *args*](#7) +[__Init__ *child*](#8) + +# DESCRIPTION + +Package to a allow a safe interpreter to access islands of the + +filesystem only, i\.e\. restricted directory trees within the + +filesystem\. The package brings back file, open and glob to the child interp + +interpreter, though in a restricted manner\. + +JN Warning: + +This mechanism can have interactions with package loading from auto\_path \- needs +review\. + +# Overview + +overview of punk::island + +## Concepts + +\- + +## dependencies + +packages used by punk::island + + - __Tcl 8\.6__ + +# API + +## Namespace punk::island::class + +class definitions + +## Namespace punk::island::interps + +## Namespace punk::island + + - __add__ *child* *path* + + Add a path to the list of paths that are explicitely allowed for access + + to a child interpreter\. Access to any path that has not been explicitely + + allowed will be denied\. Paths that are added to the list of allowed + + islands are always fully normalized\. + + Arguments: + + * string *child* + + Identifier of the child interpreter to control + + - __reset__ *child* + + Remove all access path allowance and arrange for the interpreter to be + + able to return to the regular safe state\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + +## Namespace punk::island::lib + +Secondary functions that are part of the API + +# Internal + +## Namespace punk::island::system + + - __Allowed__ *child* *fname* + + Check that the file name passed as an argument is within the islands of + + the filesystem that have been registered through the add command for a + + given \(safe\) interpreter\. The path is fully normalized before testing + + against the islands, which themselves are fully normalized\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + + * string *fname* + + \(relative\) path to the file to test + + - __File__ *child* *cmd* *args* + + Parses the options and arguments to the file command to discover which + + paths it tries to access and only return the results of its execution + + when these path are within the allowed islands of the filesystem\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + + * string *cmd* + + Subcommand of the file command + + * string *args* + + Arguments to the file subcommand + + - __Open__ *child* *args* + + Parses the options and arguments to the open command to discover which + + paths it tries to access and only return the results of its execution + + when these path are within the allowed islands of the filesystem\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + + * string *args* + + Arguments to the open subcommand + + - __Expose__ *child* *cmd* *args* + + This procedure allows to callback a command that would typically have + + been hidden from a child interpreter\. It does not "interp expose" but + + rather calls the hidden command, so we can easily revert back\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + + * string *cmd* + + Hidden command to call + + * string *args* + + Arguments to the command + + - __Glob__ *child* *args* + + Parses the options and arguments to the glob command to discover which + + paths it tries to access and only return the results of its execution + + when these path are within the allowed islands of the filesystem\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + + * string *args* + + Arguments to the glob command + + - __Init__ *child* + + Initialise child interpreter so that it will be able to perform some + + file operations, but only within some islands of the filesystem\. + + Arguments: + + * string *child* + + Identifier of the child interpreter + +# KEYWORDS + +[filesystem](\.\./\.\./\.\./index\.md\#filesystem), +[interp](\.\./\.\./\.\./index\.md\#interp), [module](\.\./\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md b/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md index 8fbe9b7..fd67c43 100644 --- a/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md +++ b/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md @@ -73,7 +73,6 @@ package require punk::lib [__linesort__ ?sortoption ?val?\.\.\.? *textblock*](#25) [__list\_as\_lines__ ?\-joinchar char? *linelist*](#26) [__lines\_as\_list__ ?option value \.\.\.? *text*](#27) -[__opts\_values__ ?option value\.\.\.? *optionspecs* *rawargs*](#28) # DESCRIPTION @@ -146,7 +145,8 @@ Core API functions for punk::lib Otherwise it will return an integer corresponding to the position in the list\. - Like Tcl list commands \- it will produce an error if the form of the + Like Tcl list commands \- it will produce an error if the form of the index + is not acceptable - __K__ *x* *y* @@ -425,35 +425,6 @@ Core API functions for punk::lib \- not console lines which may be entirely different due to control characters such as vertical tabs or ANSI movements - - __opts\_values__ ?option value\.\.\.? *optionspecs* *rawargs* - - Parse rawargs as a sequence of zero or more option\-value pairs followed by - zero or more values - - Returns a dict of the form: opts values - - ARGUMENTS: - - * multiline\-string *optionspecs* - - This a block of text with records delimited by newlines \(lf or crlf\) \- - but with multiline values allowed if properly quoted/braced - - 'info complete' is used to determine if a record spans multiple lines - due to multiline values - - Each optionspec line must be of the form: - - \-optionname \-key val \-key2 val2\.\.\. - - where the valid keys for each option specification are: \-default \-type - \-range \-choices \-optional - - * list *rawargs* - - This is a list of the arguments to parse\. Usually it will be the \\$args - value from the containing proc - # Internal ## Namespace punk::lib::system diff --git a/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md b/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md new file mode 100644 index 0000000..95c3ef9 --- /dev/null +++ b/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md @@ -0,0 +1,87 @@ + +[//000000001]: # (shellspy\_module\_punk::repl::codethread \- \-) +[//000000002]: # (Generated from file '\_module\_codethread\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (shellspy\_module\_punk::repl::codethread\(0\) 0\.1\.0 doc "\-") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +shellspy\_module\_punk::repl::codethread \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::repl::codethread::class](#subsection3) + + - [Namespace punk::repl::codethread](#subsection4) + + - [Namespace punk::repl::codethread::lib](#subsection5) + + - [Internal](#section4) + + - [Namespace punk::repl::codethread::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::repl::codethread + +# DESCRIPTION + +\- + +# Overview + +overview of punk::repl::codethread + +## Concepts + +\- + +## dependencies + +packages used by punk::repl::codethread + + - __Tcl 8\.6__ + +# API + +## Namespace punk::repl::codethread::class + +class definitions + +## Namespace punk::repl::codethread + +## Namespace punk::repl::codethread::lib + +# Internal + +## Namespace punk::repl::codethread::system + +# KEYWORDS + +[module](\.\./\.\./\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/toc.md b/src/embedded/md/doc/toc.md index 9ae2b3c..7dd3b85 100644 --- a/src/embedded/md/doc/toc.md +++ b/src/embedded/md/doc/toc.md @@ -5,6 +5,8 @@ - [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) overtype text layout \- ansi aware + - [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.3\.tm\.md) overtype text layout \- ansi aware + - [punkshell](doc/files/main\.md) punkshell \- Core - [punkshell\_\_project\_changes](doc/files/project\_changes\.md) punkshell Changes @@ -31,10 +33,18 @@ - [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) Filesystem path utilities + - [shellspy\_module\_argparsingtest](doc/files/\_module\_argparsingtest\-0\.1\.0\.tm\.md) Module API + + - [shellspy\_module\_punk::aliascore](doc/files/punk/\_module\_aliascore\-0\.1\.0\.tm\.md) Module API + - [shellspy\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) assertion alternative to control::assert - [shellspy\_module\_punk::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) basic telnet client \- DKF/Wiki + - [shellspy\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) filesystem islands for safe interps + + - [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) Module API + - [shellspy\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) Tcl procedures to execute tcl scripts in remote hosts - [shellspy\_module\_punk::uc](doc/files/punk/\_module\_uc\-0\.1\.0\.tm\.md) Module API diff --git a/src/embedded/md/index.md b/src/embedded/md/index.md index 62c1698..b5bc9b8 100644 --- a/src/embedded/md/index.md +++ b/src/embedded/md/index.md @@ -5,7 +5,7 @@ ---- -[A](#cA) · [B](#cB) · [C](#cC) · [D](#cD) · [E](#cE) · [F](#cF) · [L](#cL) · [M](#cM) · [P](#cP) · [R](#cR) · [S](#cS) · [T](#cT) · [U](#cU) +[A](#cA) · [B](#cB) · [C](#cC) · [D](#cD) · [E](#cE) · [F](#cF) · [I](#cI) · [L](#cL) · [M](#cM) · [P](#cP) · [R](#cR) · [S](#cS) · [T](#cT) · [U](#cU) ---- @@ -13,7 +13,7 @@ ||| |---|---| -|ansi|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md)| +|ansi|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) · [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.3\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md)| |args|[punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md)| |arguments|[punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md)| |assert|[shellspy\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md)| @@ -57,7 +57,14 @@ ||| |---|---| |file|[punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md)| -|filesystem|[punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md)| +|filesystem|[punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md)| + + +#### Keywords: I + +||| +|---|---| +|interp|[shellspy\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md)| #### Keywords: L @@ -71,7 +78,7 @@ ||| |---|---| -|module|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::cap](doc/files/punk/\_module\_cap\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::char](doc/files/punk/\_module\_char\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::encmime](doc/files/punk/\_module\_encmime\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::flib](doc/files/punk/\_module\_flib\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::lib](doc/files/punk/\_module\_lib\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::uc](doc/files/punk/\_module\_uc\-0\.1\.0\.tm\.md)| +|module|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) · [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.3\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::cap](doc/files/punk/\_module\_cap\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::char](doc/files/punk/\_module\_char\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::encmime](doc/files/punk/\_module\_encmime\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::flib](doc/files/punk/\_module\_flib\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::lib](doc/files/punk/\_module\_lib\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) · [shellspy\_module\_argparsingtest](doc/files/\_module\_argparsingtest\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::aliascore](doc/files/punk/\_module\_aliascore\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::uc](doc/files/punk/\_module\_uc\-0\.1\.0\.tm\.md)| #### Keywords: P @@ -106,7 +113,7 @@ ||| |---|---| |terminal|[punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md)| -|text|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md)| +|text|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) · [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.3\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md)| #### Keywords: U diff --git a/src/embedded/md/toc.md b/src/embedded/md/toc.md index 9ae2b3c..7dd3b85 100644 --- a/src/embedded/md/toc.md +++ b/src/embedded/md/toc.md @@ -5,6 +5,8 @@ - [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.2\.tm\.md) overtype text layout \- ansi aware + - [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.3\.tm\.md) overtype text layout \- ansi aware + - [punkshell](doc/files/main\.md) punkshell \- Core - [punkshell\_\_project\_changes](doc/files/project\_changes\.md) punkshell Changes @@ -31,10 +33,18 @@ - [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) Filesystem path utilities + - [shellspy\_module\_argparsingtest](doc/files/\_module\_argparsingtest\-0\.1\.0\.tm\.md) Module API + + - [shellspy\_module\_punk::aliascore](doc/files/punk/\_module\_aliascore\-0\.1\.0\.tm\.md) Module API + - [shellspy\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) assertion alternative to control::assert - [shellspy\_module\_punk::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) basic telnet client \- DKF/Wiki + - [shellspy\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) filesystem islands for safe interps + + - [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) Module API + - [shellspy\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) Tcl procedures to execute tcl scripts in remote hosts - [shellspy\_module\_punk::uc](doc/files/punk/\_module\_uc\-0\.1\.0\.tm\.md) Module API diff --git a/src/embedded/www/.doc/tocdoc b/src/embedded/www/.doc/tocdoc index 617cd83..15f4125 100644 --- a/src/embedded/www/.doc/tocdoc +++ b/src/embedded/www/.doc/tocdoc @@ -1,5 +1,6 @@ [toc_begin {Table Of Contents} doc] [item doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype {overtype text layout - ansi aware}] +[item doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype {overtype text layout - ansi aware}] [item doc/files/main.html punkshell {punkshell - Core}] [item doc/files/project_changes.html punkshell__project_changes {punkshell Changes}] [item doc/files/project_intro.html punkshell__project_intro {Introduction to punkshell}] @@ -13,8 +14,12 @@ [item doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib {punk general utility functions}] [item doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html punkshell_module_punk::mix::commandset::project {dec commandset - project}] [item doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path {Filesystem path utilities}] +[item doc/files/_module_argparsingtest-0.1.0.tm.html shellspy_module_argparsingtest {Module API}] +[item doc/files/punk/_module_aliascore-0.1.0.tm.html shellspy_module_punk::aliascore {Module API}] [item doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion {assertion alternative to control::assert}] [item doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet {basic telnet client - DKF/Wiki}] +[item doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island {filesystem islands for safe interps}] +[item doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread {Module API}] [item doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}] [item doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc {Module API}] [toc_end] diff --git a/src/embedded/www/.idx b/src/embedded/www/.idx index 05c1a0d..4a5ab9a 100644 --- a/src/embedded/www/.idx +++ b/src/embedded/www/.idx @@ -1 +1 @@ -{file {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} assertion {{doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char}} repl {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} console {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} utility {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib}} text {{doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} experimental {{doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun}} arguments {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion}} encoding {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} changelog {{doc/files/project_changes.html punkshell__project_changes}} shell {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} capability {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} ansi {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype}} parse {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} proc {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} terminal {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} args {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} path {{doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path}} filesystem {{doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path}} module {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} {doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} {doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} {doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} {doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} punk {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} string {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} lib {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib}}} {{ssh doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {changelog doc/files/project_changes.html punkshell__project_changes} . {shell doc/files/main.html punkshell} . {string doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {proc doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {args doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {plugin doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {path doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {punk doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {module doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} . {debug doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} . {repl doc/files/project_changes.html punkshell__project_changes} . {arguments doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {punk doc/files/project_intro.html punkshell__project_intro} . {capability doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {text doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {utility doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {shell doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {module doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {shell doc/files/project_intro.html punkshell__project_intro} . {module doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc} . {module doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {lib doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {repl doc/files/main.html punkshell} . {file doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {text doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {module doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun} . {module doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} . {encodings doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {assert doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} . {experimental doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {parse doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {repl doc/files/project_intro.html punkshell__project_intro} . {filesystem doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {ansi doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet} . {console doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {module doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {punk doc/files/main.html punkshell} . {parse doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} .} 29 {assertion assertion file file encodings encodings assert assert console console repl repl utility utility text text arguments arguments ssh ssh experimental experimental BOM bom debug debug encoding encoding changelog changelog shell shell capability capability ansi ansi parse parse terminal terminal proc proc filesystem filesystem path path args args module module punk punk plugin plugin string string lib lib} \ No newline at end of file +{file {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} assertion {{doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char}} repl {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} console {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} utility {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib}} text {{doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} {doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} experimental {{doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun}} arguments {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion}} encoding {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} changelog {{doc/files/project_changes.html punkshell__project_changes}} shell {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} capability {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} interp {{doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island}} ansi {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} {doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype}} parse {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} proc {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} terminal {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} args {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} path {{doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path}} filesystem {{doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island}} module {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} {doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} {doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} {doc/files/_module_argparsingtest-0.1.0.tm.html shellspy_module_argparsingtest} {doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype} {doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun} {doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island} {doc/files/punk/_module_aliascore-0.1.0.tm.html shellspy_module_punk::aliascore} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} {doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} punk {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} string {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} lib {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib}}} {{ansi doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {module doc/files/punk/_module_aliascore-0.1.0.tm.html shellspy_module_punk::aliascore} . {changelog doc/files/project_changes.html punkshell__project_changes} . {shell doc/files/main.html punkshell} . {interp doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island} . {proc doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {string doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {plugin doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {path doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {args doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {module doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {punk doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {module doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} . {debug doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} . {repl doc/files/project_changes.html punkshell__project_changes} . {arguments doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {punk doc/files/project_intro.html punkshell__project_intro} . {capability doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {text doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {utility doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {shell doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {module doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {shell doc/files/project_intro.html punkshell__project_intro} . {text doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype} . {module doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc} . {module doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {lib doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {file doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {repl doc/files/main.html punkshell} . {text doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {module doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun} . {module doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island} . {module doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread} . {module doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} . {encodings doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {experimental doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {assert doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} . {filesystem doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island} . {module doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype} . {repl doc/files/project_intro.html punkshell__project_intro} . {parse doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {filesystem doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {ansi doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet} . {module doc/files/_module_argparsingtest-0.1.0.tm.html shellspy_module_argparsingtest} . {module doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {console doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {punk doc/files/main.html punkshell} . {parse doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion} .} 30 {assertion assertion file file encodings encodings assert assert console console repl repl utility utility text text arguments arguments ssh ssh experimental experimental BOM bom debug debug encoding encoding changelog changelog shell shell capability capability interp interp ansi ansi parse parse terminal terminal proc proc filesystem filesystem path path args args module module punk punk plugin plugin string string lib lib} \ No newline at end of file diff --git a/src/embedded/www/.toc b/src/embedded/www/.toc index 0b0b5d4..37fa6a5 100644 --- a/src/embedded/www/.toc +++ b/src/embedded/www/.toc @@ -1 +1 @@ -doc {doc/toc {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args {args parsing}} {doc/files/project_changes.html punkshell__project_changes {punkshell Changes}} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char {character-set and unicode utilities}} {doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.html punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/main.html punkshell {punkshell - Core}} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib {flib experimental}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline {file line-handling utilities}}}} \ No newline at end of file +doc {doc/toc {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread {Module API}} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args {args parsing}} {doc/files/project_changes.html punkshell__project_changes {punkshell Changes}} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char {character-set and unicode utilities}} {doc/files/punk/_module_uc-0.1.0.tm.html shellspy_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_assertion-0.1.0.tm.html shellspy_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.html punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/_module_argparsingtest-0.1.0.tm.html shellspy_module_argparsingtest {Module API}} {doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::island {filesystem islands for safe interps}} {doc/files/punk/_module_aliascore-0.1.0.tm.html shellspy_module_punk::aliascore {Module API}} {doc/files/main.html punkshell {punkshell - Core}} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib {flib experimental}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline {file line-handling utilities}}}} \ No newline at end of file diff --git a/src/embedded/www/.xrf b/src/embedded/www/.xrf index f3c128a..a976fef 100644 --- a/src/embedded/www/.xrf +++ b/src/embedded/www/.xrf @@ -1 +1 @@ -assertion {index.html assertion} kw,capability {index.html capability} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html assert {index.html assert} kw,proc {index.html proc} sa,shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html kw,lib {index.html lib} punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html {punkshell Changes} doc/files/project_changes.html debug {index.html debug} kw,encodings {index.html encodings} {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.html {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html {Introduction to punkshell} doc/files/project_intro.html proc {index.html proc} sa,punkshell(n) doc/files/main.html punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html filesystem {index.html filesystem} sa,punkshell doc/files/main.html kw,shell {index.html shell} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html kw,parse {index.html parse} sa,punkshell__project_changes(n) doc/files/project_changes.html sa,shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html kw,terminal {index.html terminal} sa,shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html kw,path {index.html path} kw,args {index.html args} utility {index.html utility} kw,module {index.html module} punkshell(n) doc/files/main.html punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html kw,plugin {index.html plugin} kw,string {index.html string} punkshell doc/files/main.html kw,file {index.html file} ssh {index.html ssh} punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html sa,shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html kw,assert {index.html assert} changelog {index.html changelog} punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html sa,shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell__project_changes(n) doc/files/project_changes.html shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html kw,utility {index.html utility} sa,punkshell__project_changes doc/files/project_changes.html shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html kw,experimental {index.html experimental} kw,ssh {index.html ssh} kw,arguments {index.html arguments} terminal {index.html terminal} path {index.html path} args {index.html args} sa,shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html file {index.html file} sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html {args parsing} doc/files/punk/_module_args-0.1.0.tm.html shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html sa,shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html encodings {index.html encodings} {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.html punkshell__project_changes doc/files/project_changes.html sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html kw,filesystem {index.html filesystem} sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html kw,assertion {index.html assertion} experimental {index.html experimental} sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html {Module API} doc/files/punk/_module_uc-0.1.0.tm.html sa,overtype_module_overtype doc/files/_module_overtype-1.6.2.tm.html shell {index.html shell} punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.html sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.2.tm.html {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.2.tm.html kw,repl {index.html repl} shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html capability {index.html capability} punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html kw,text {index.html text} parse {index.html parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.html {punkshell - Core} doc/files/main.html punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html kw,encoding {index.html encoding} kw,debug {index.html debug} punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html overtype_module_overtype doc/files/_module_overtype-1.6.2.tm.html overtype_module_overtype(0) doc/files/_module_overtype-1.6.2.tm.html kw,ansi {index.html ansi} {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.html sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html repl {index.html repl} console {index.html console} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html kw,punk {index.html punk} sa,punkshell__project_intro(n) doc/files/project_intro.html text {index.html text} {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell__project_intro doc/files/project_intro.html BOM {index.html bom} arguments {index.html arguments} encoding {index.html encoding} sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html kw,console {index.html console} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html ansi {index.html ansi} {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.html kw,BOM {index.html bom} punkshell__project_intro(n) doc/files/project_intro.html punkshell__project_intro doc/files/project_intro.html {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.html kw,changelog {index.html changelog} punk {index.html punk} module {index.html module} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html lib {index.html lib} plugin {index.html plugin} string {index.html string} \ No newline at end of file +assertion {index.html assertion} kw,capability {index.html capability} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html assert {index.html assert} kw,proc {index.html proc} sa,shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.html shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.html sa,shellspy_module_punk::island doc/files/punk/_module_island-0.1.0.tm.html sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html kw,lib {index.html lib} shellspy_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html {punkshell Changes} doc/files/project_changes.html debug {index.html debug} kw,encodings {index.html encodings} {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.html {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.html shellspy_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html {Introduction to punkshell} doc/files/project_intro.html proc {index.html proc} shellspy_module_punk::island doc/files/punk/_module_island-0.1.0.tm.html sa,punkshell(n) doc/files/main.html punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html filesystem {index.html filesystem} sa,punkshell doc/files/main.html kw,shell {index.html shell} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.html kw,interp {index.html interp} sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html kw,parse {index.html parse} sa,punkshell__project_changes(n) doc/files/project_changes.html sa,shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html kw,terminal {index.html terminal} sa,shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html kw,path {index.html path} kw,args {index.html args} utility {index.html utility} kw,module {index.html module} punkshell(n) doc/files/main.html punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html kw,plugin {index.html plugin} kw,string {index.html string} sa,shellspy_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.html punkshell doc/files/main.html kw,file {index.html file} ssh {index.html ssh} punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html sa,shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html kw,assert {index.html assert} changelog {index.html changelog} punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html sa,shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell__project_changes(n) doc/files/project_changes.html shellspy_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html kw,utility {index.html utility} sa,punkshell__project_changes doc/files/project_changes.html shellspy_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html kw,experimental {index.html experimental} kw,ssh {index.html ssh} kw,arguments {index.html arguments} terminal {index.html terminal} sa,shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.html path {index.html path} args {index.html args} shellspy_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.html sa,shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html sa,shellspy_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.html shellspy_module_punk::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html file {index.html file} sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html {args parsing} doc/files/punk/_module_args-0.1.0.tm.html shellspy_module_punk::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html sa,shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html encodings {index.html encodings} {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.html punkshell__project_changes doc/files/project_changes.html sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html kw,filesystem {index.html filesystem} sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.html sa,shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html sa,shellspy_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.html shellspy_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.html kw,assertion {index.html assertion} experimental {index.html experimental} sa,shellspy_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.html sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html {Module API} doc/files/punk/_module_aliascore-0.1.0.tm.html sa,overtype_module_overtype doc/files/_module_overtype-1.6.3.tm.html shell {index.html shell} punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.html sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.3.tm.html {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.3.tm.html kw,repl {index.html repl} shellspy_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html capability {index.html capability} punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html kw,text {index.html text} parse {index.html parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.html {punkshell - Core} doc/files/main.html punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html shellspy_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html shellspy_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.html kw,encoding {index.html encoding} kw,debug {index.html debug} {filesystem islands for safe interps} doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html overtype_module_overtype doc/files/_module_overtype-1.6.3.tm.html overtype_module_overtype(0) doc/files/_module_overtype-1.6.3.tm.html kw,ansi {index.html ansi} {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.html sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html repl {index.html repl} console {index.html console} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html kw,punk {index.html punk} sa,punkshell__project_intro(n) doc/files/project_intro.html text {index.html text} {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell__project_intro doc/files/project_intro.html BOM {index.html bom} arguments {index.html arguments} encoding {index.html encoding} sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html kw,console {index.html console} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html interp {index.html interp} ansi {index.html ansi} sa,shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.html {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.html kw,BOM {index.html bom} punkshell__project_intro(n) doc/files/project_intro.html punkshell__project_intro doc/files/project_intro.html sa,shellspy_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.html {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.html kw,changelog {index.html changelog} punk {index.html punk} module {index.html module} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html lib {index.html lib} plugin {index.html plugin} string {index.html string} \ No newline at end of file diff --git a/src/embedded/www/doc/files/_module_argparsingtest-0.1.0.tm.html b/src/embedded/www/doc/files/_module_argparsingtest-0.1.0.tm.html new file mode 100644 index 0000000..51f8f65 --- /dev/null +++ b/src/embedded/www/doc/files/_module_argparsingtest-0.1.0.tm.html @@ -0,0 +1,187 @@ + +shellspy_module_argparsingtest - - + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

shellspy_module_argparsingtest(0) 0.1.0 doc "-"

+

Name

+

shellspy_module_argparsingtest - Module API

+
+ +

Synopsis

+
+
    +
  • package require argparsingtest
    • +
+
+
+ +

Overview

+

overview of argparsingtest

+ +

dependencies

+

packages used by argparsingtest

+
    +

  • Tcl 8.6

    • +
+
+
+

API

+

Namespace argparsingtest::class

+

class definitions

+
    +
+
+

Namespace argparsingtest

+

Core API functions for argparsingtest

+
+
+
+

Namespace argparsingtest::lib

+

Secondary functions that are part of the API

+
+
+
+
+

Internal

+

Namespace argparsingtest::system

+

Internal functions that are not part of the API

+
+
+ + +
diff --git a/src/embedded/www/doc/files/_module_overtype-1.6.3.tm.html b/src/embedded/www/doc/files/_module_overtype-1.6.3.tm.html new file mode 100644 index 0000000..3718e1b --- /dev/null +++ b/src/embedded/www/doc/files/_module_overtype-1.6.3.tm.html @@ -0,0 +1,191 @@ + +overtype_module_overtype - overtype text layout + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

overtype_module_overtype(0) 1.6.3 doc "overtype text layout"

+

Name

+

overtype_module_overtype - overtype text layout - ansi aware

+
+ +

Synopsis

+
+
    +
  • package require overtype
    • +
+ +
+
+ +

Overview

+

overview of overtype

+ +

dependencies

+

packages used by overtype

+
    +

  • Tcl 8.6

    • +

  • textutil

    • +

  • punk::ansi

    +

    - required to detect, split, strip and calculate lengths of text possibly containing ansi codes

    • +

  • punk::char

    +

    - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars

    • +
+
+
+

API

+

Namespace overtype

+

Core API functions for overtype

+
+
overtype::renderspace args
+

usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext

+
overtype::renderline args
+

renderline is the core engine for overtype string processing (frames & textblocks), and the raw mode commandline repl for the Tcl Punk Shell

+

It is also a central part of an ansi (micro) virtual terminal-emulator of sorts

+

This system does a half decent job at rendering 90's ANSI art to manipulable colour text blocks that can be joined & framed for layout display within a unix or windows terminal

+

Renderline helps maintain ANSI text styling reset/replay codes so that the styling of one block doesn't affect another.

+

Calling on the punk::ansi library - it can coalesce codes to keep the size down.

+

It is a giant mess of doing exactly what common wisdom says not to do... lots at once.

+

renderline is part of the Unicode and ANSI aware Overtype system which 'renders' a block of text onto a static underlay

+

The underlay is generally expected to be an ordered set of lines or a rectangular text block analogous to a terminal screen - but it can also be ragged in line length, or just blank.

+

The overlay couuld be similar - in which case it may often be used to overwrite a column or section of the underlay.

+

The overlay could however be a sequence of ANSI-laden text that jumps all over the place.

+

renderline itself only deals with a single line - or sometimes a single character. It is generally called from a loop that does further terminal-like or textblock processing.

+

By suppyling the -info 1 option - it can return various fields indicating the state of the render.

+

The main 3 are the result, overflow_right, and unapplied.

+

Renderline handles cursor movements from either keystrokes or ANSI sequences but for a full system the aforementioned loop will need to be in place to manage the set of lines under manipulation.

+
+
+
+ + +
diff --git a/src/embedded/www/doc/files/punk/_module_aliascore-0.1.0.tm.html b/src/embedded/www/doc/files/punk/_module_aliascore-0.1.0.tm.html new file mode 100644 index 0000000..3535318 --- /dev/null +++ b/src/embedded/www/doc/files/punk/_module_aliascore-0.1.0.tm.html @@ -0,0 +1,187 @@ + +shellspy_module_punk::aliascore - - + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

shellspy_module_punk::aliascore(0) 0.1.0 doc "-"

+

Name

+

shellspy_module_punk::aliascore - Module API

+
+ +

Synopsis

+
+
    +
  • package require punk::aliascore
    • +
+
+
+ +

Overview

+

overview of punk::aliascore

+ +

dependencies

+

packages used by punk::aliascore

+
    +

  • Tcl 8.6

    • +
+
+
+

API

+

Namespace punk::aliascore::class

+

class definitions

+
    +
+
+

Namespace punk::aliascore

+

Core API functions for punk::aliascore

+
+
+
+

Namespace punk::aliascore::lib

+

Secondary functions that are part of the API

+
+
+
+
+

Internal

+

Namespace punk::aliascore::system

+

Internal functions that are not part of the API

+
+
+ + +
diff --git a/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html b/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html index f4a0118..ed29a1b 100644 --- a/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html +++ b/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html @@ -141,55 +141,54 @@
  • a? ?ansicode...?
  • a+ ?ansicode...?
  • a ?ansicode...?
    • -
  • a ?ansicode...?
    • -
  • get_code_name code
    • -
  • reset
    • -
  • reset_soft
    • -
  • reset_colour
    • -
  • clear
    • -
  • clear_above
    • -
  • clear_below
    • -
  • cursor_on
    • -
  • cursor_off
    • -
  • move row col
    • -
  • move_emit row col data ?row col data...?
    • -
  • move_forward n
    • -
  • move_back n
    • -
  • move_up n
    • -
  • move_down n
    • -
  • move_column col
    • -
  • move_row row
    • -
  • cursor_save
    • -
  • cursor_restore
    • -
  • cursor_save_dec
    • -
  • cursor_restore_attributes
    • -
  • enable_line_wrap
    • -
  • disable_line_wrap
    • -
  • query_mode_line_wrap
    • -
  • erase_line
    • -
  • erase_sol
    • -
  • erase_eol
    • -
  • scroll_up n
    • -
  • scroll_down n
    • -
  • insert_spaces count
    • -
  • delete_characters count
    • -
  • erase_characters count
    • -
  • insert_lines count
    • -
  • delete_lines count
    • -
  • cursor_pos
    • -
  • request_cursor_information
    • -
  • request_tabstops
    • -
  • titleset windowtitles
    • -
  • is_sgr_reset code
    • -
  • has_sgr_leadingreset code
    • -
  • detect text
    • -
  • detect_csi text
    • -
  • detect_sgr text
    • -
  • strip text
    • -
  • length text
    • -
  • VIEW string
    • -
  • COUNT string
    • -
  • index string index
    • +
  • get_code_name code
    • +
  • reset
    • +
  • reset_soft
    • +
  • reset_colour
    • +
  • clear
    • +
  • clear_above
    • +
  • clear_below
    • +
  • cursor_on
    • +
  • cursor_off
    • +
  • move row col
    • +
  • move_emit row col data ?row col data...?
    • +
  • move_forward n
    • +
  • move_back n
    • +
  • move_up n
    • +
  • move_down n
    • +
  • move_column col
    • +
  • move_row row
    • +
  • cursor_save
    • +
  • cursor_restore
    • +
  • cursor_save_dec
    • +
  • cursor_restore_attributes
    • +
  • enable_line_wrap
    • +
  • disable_line_wrap
    • +
  • query_mode_line_wrap
    • +
  • erase_line
    • +
  • erase_sol
    • +
  • erase_eol
    • +
  • scroll_up n
    • +
  • scroll_down n
    • +
  • insert_spaces count
    • +
  • delete_characters count
    • +
  • erase_characters count
    • +
  • insert_lines count
    • +
  • delete_lines count
    • +
  • cursor_pos
    • +
  • request_cursor_information
    • +
  • request_tabstops
    • +
  • titleset windowtitles
    • +
  • is_sgr_reset code
    • +
  • has_sgr_leadingreset code
    • +
  • detect text
    • +
  • detect_csi text
    • +
  • detect_sgr text
    • +
  • strip text
    • +
  • length text
    • +
  • VIEW string
    • +
  • COUNT string
    • +
  • index string index
    • @@ -224,7 +223,14 @@
    stripansi text

    Return a string with ansi codes stripped out

    Alternate graphics modes will be stripped - exposing the raw characters as they appear without graphics mode.

    -

    ie instead of a horizontal line you may see: qqqqqq

    +

    ie instead of a horizontal line you may see: qqqqqq +e.g who is to know that 'Rabbit Paws', 'Forbidden Thrill' and 'Tarsier' refer to a particular shade of pinky-red? (code 95) +Perhaps it's an indication that colour naming once we get to 256 colours or more is a fool's errand anyway. +The xterm names are boringly unimaginative - and also have some oddities such as: + DarkSlateGray1 which looks much more like cyan.. + The greyxx names are spelt with an e - but the darkslategrayX variants use an a. Perhaps that's because they are more cyan than grey and the a is a hint? + there is no gold or gold2 - but there is gold1 and gold3 +but in general the names bear some resemblance to the colours and are at least somewhat intuitive.

    a? ?ansicode...?

    Return an ansi string representing a table of codes and a panel showing the colours

    a+ ?ansicode...?
    @@ -242,38 +248,30 @@

    to set background red

    punk::ansi::a Red

    see punk::ansi::a? to display a list of codes

    -
    a ?ansicode...?
    -

    Returns the ansi code to reset any current settings and apply those from the supplied list

    -

    by calling punk::ansi::a with no arguments - the result is a reset to plain text

    -

    e.g to set foreground red and bold

    -

    punk::ansi::a red bold

    -

    to set background red

    -

    punk::ansi::a Red

    -

    see punk::ansi::a? to display a list of codes

    -
    get_code_name code
    +
    get_code_name code

    for example

    get_code_name red will return 31

    get_code_name 31 will return red

    -
    reset
    +
    reset

    reset console

    -
    reset_soft
    +
    reset_soft
    -
    reset_colour
    +
    reset_colour

    reset colour only

    -
    clear
    +
    clear
    -
    clear_above
    +
    clear_above
    -
    clear_below
    +
    clear_below
    -
    cursor_on
    +
    cursor_on
    -
    cursor_off
    +
    cursor_off
    -
    move row col
    +
    move row col

    Return an ansi sequence to move to row,col

    aka cursor home

    -
    move_emit row col data ?row col data...?
    +
    move_emit row col data ?row col data...?

    Return an ansi string representing a move to row col with data appended

    row col data can be repeated any number of times to return a string representing the output of the data elements at all those points

    Compare to punk::console::move_emit which calls this function - but writes it to stdout

    @@ -285,76 +283,76 @@

    The following example shows how to do this manually, emitting the string blah at screen position 10,10 and emitting DONE back at the line we started:

    punk::ansi::move_emit 10 10 blah {*}[punk::console::get_cursor_pos_list] DONE

    A string created by any move_emit_return for punk::ansi would not behave in an intuitive manner compared to other punk::ansi move functions - so is deliberately omitted.

    -
    move_forward n
    +
    move_forward n
    -
    move_back n
    +
    move_back n
    -
    move_up n
    +
    move_up n
    -
    move_down n
    +
    move_down n
    -
    move_column col
    +
    move_column col
    -
    move_row row
    +
    move_row row

    VPA - Vertical Line Position Absolute

    -
    cursor_save
    +
    cursor_save

    equivalent term::ansi::code::ctrl::sc

    This is the ANSI/SCO cursor save as opposed to the DECSC version

    On many terminals either will work - but cursor_save_dec is shorter and perhaps more widely supported

    -
    cursor_restore
    +
    cursor_restore

    equivalent term::ansi::code::ctrl::rc

    ANSI/SCO - see also cursor_restore_dec for the DECRC version

    -
    cursor_save_dec
    +
    cursor_save_dec

    equivalent term::ansi::code::ctrl::sca

    DECSC

    -
    cursor_restore_attributes
    +
    cursor_restore_attributes

    equivalent term::ansi::code::ctrl::rca

    DECRC

    -
    enable_line_wrap
    +
    enable_line_wrap

    enable automatic line wrapping when characters entered beyond rightmost column

    This will also allow forward movements to move to subsequent lines

    This is DECAWM - and is the same sequence output by 'tput smam'

    -
    disable_line_wrap
    +
    disable_line_wrap

    disable automatic line wrapping

    reset DECAWM - same sequence output by 'tput rmam' tput rmam

    -
    query_mode_line_wrap
    +
    query_mode_line_wrap

    DECRQM to query line-wrap state

    The punk::ansi::query_mode_ functions just emit the ansi query sequence.

    -
    erase_line
    +
    erase_line
    -
    erase_sol
    +
    erase_sol

    Erase to start of line, leaving cursor position alone.

    -
    erase_eol
    +
    erase_eol
    -
    scroll_up n
    +
    scroll_up n
    -
    scroll_down n
    +
    scroll_down n
    -
    insert_spaces count
    +
    insert_spaces count
    -
    delete_characters count
    +
    delete_characters count
    -
    erase_characters count
    +
    erase_characters count
    -
    insert_lines count
    +
    insert_lines count
    -
    delete_lines count
    +
    delete_lines count
    -
    cursor_pos
    +
    cursor_pos

    cursor_pos unlikely to be useful on it's own like this as when written to the terminal, this sequence causes the terminal to emit the row;col sequence to stdin

    The output on screen will look something like ^[[47;3R

    Use punk::console::get_cursor_pos or punk::console::get_cursor_pos_list instead.

    These functions will emit the code - but read it in from stdin so that it doesn't display, and then return the row and column as a colon-delimited string or list respectively.

    The punk::ansi::cursor_pos function is used by punk::console::get_cursor_pos and punk::console::get_cursor_pos_list

    -
    request_cursor_information
    +
    request_cursor_information

    DECRQPSR (DEC Request Presentation State Report) for DECCCIR Cursor Information report

    When written to the terminal, this sequence causes the terminal to emit cursor information to stdin

    A stdin readloop will need to be in place to read this information

    -
    request_tabstops
    +
    request_tabstops

    DECRQPSR (DEC Request Presentation State Report) for DECTABSR Tab stop report

    When written to the terminal, this sequence causes the terminal to emit tabstop information to stdin

    -
    titleset windowtitles
    +
    titleset windowtitles

    Returns the code to set the title of the terminal window to windowtitle

    This may not work on terminals which have multiple panes/windows

    @@ -363,11 +361,11 @@ tput rmam

    API functions for punk::ansi::codetype

    Utility functions for processing ansi code sequences

    -
    is_sgr_reset code
    +
    is_sgr_reset code

    Return a boolean indicating whether this string has a trailing pure SGR reset

    Note that if the reset is not the very last item in the string - it will not be detected.

    This is primarily intended for testing a single ansi code sequence, but code can be any string where the trailing SGR code is to be tested.

    -
    has_sgr_leadingreset code
    +
    has_sgr_leadingreset code

    The reset must be the very first item in code to be detected. Trailing strings/codes ignored.

    @@ -376,25 +374,25 @@ tput rmam

    based on but not identical to the Perl Text Ansi module:

    https://github.com/perlancar/perl-Text-ANSI-Util/blob/master/lib/Text/ANSI/BaseUtil.pm

    -
    detect text
    +
    detect text

    Return a boolean indicating whether Ansi codes were detected in text

    -
    detect_csi text
    +
    detect_csi text

    Return a boolean indicating whether an Ansi Control Sequence Introducer (CSI) was detected in text

    The csi is often represented in code as \x1b or \033 followed by a left bracket [

    The initial byte or escape is commonly referenced as ESC in Ansi documentation

    There is also a multi-byte escape sequence \u009b

    This is less commonly used but is also detected here

    (This function is not in perl ta)

    -
    detect_sgr text
    +
    detect_sgr text

    Return a boolean indicating whether an ansi Select Graphics Rendition code was detected.

    This is the set of CSI sequences ending in 'm'

    This is most commonly an Ansi colour code - but also things such as underline and italics

    An SGR with empty or a single zero argument is a reset of the SGR features - this is also detected.

    (This function is not in perl ta)

    -
    strip text
    +
    strip text

    Return text stripped of Ansi codes

    This is a tailcall to punk::ansi::stripansi

    -
    length text
    +
    length text

    Return the character length after stripping ansi codes - not the printing length

    @@ -403,12 +401,12 @@ tput rmam

    Working with strings containing ansi in a way that preserves/understands the codes is always going to be significantly slower than working with plain strings

    Just as working with other forms of markup such as HTML - you simply need to be aware of the tradeoffs and design accordingly.

    -
    VIEW string
    +
    VIEW string

    Return a string with specific ANSI control characters substituted with visual equivalents frome the appropriate unicode C0 and C1 visualisation sets

    For debugging purposes, certain other standard control characters are converted to visual representation, for example backspace (mapped to \\U2408 '\U2408')

    Horizontal tab is mapped to \\U2409 '\U2409'. For many of the punk terminal text operations, tabs have already been mapped to the appropriate number of spaces using textutil::tabify functions

    As punkshell uses linefeed where possible in preference to crlf even on windows, cr is mapped to \\U240D '\U240D' - but lf is left as is.

    -
    COUNT string
    +
    COUNT string

    Returns the count of visible graphemes and non-ansi control characters

    Incomplete! grapheme clustering support not yet implemented - only diacritics are currently clustered to count as one grapheme.

    This will not count strings hidden inside a 'privacy message' or other ansi codes which may have content between their opening escape and their termination sequence.

    @@ -416,7 +414,7 @@ tput rmam

    Note that this returns the number of characters in the payload (after applying combiners) It is not always the same as the width of the string as rendered on a terminal due to 2wide Unicode characters and the usual invisible control characters such as \r and \n

    To get the width, use punk::ansi::printing_length instead, which is also ansi aware.

    -
    index string index
    +
    index string index

    Takes a string that possibly contains ansi codes such as colour,underline etc (SGR codes)

    Returns the character (with applied ansi effect) at position index

    The string could contain non SGR ansi codes - and these will (mostly) be ignored, so shouldn't affect the output.

    diff --git a/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html b/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html index 8ac6ee9..4aed095 100644 --- a/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html +++ b/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html @@ -141,7 +141,7 @@
  • package require punk::args
    • @@ -153,19 +153,26 @@

    Concepts

    There are 2 main conventions for parsing a proc args list

      -

    1. leading option-value pairs followed by a list of values (Tk style)

      2. -

    2. leading list of values followed by option-value pairs (Tcl style)

      3. +

    3. leading option-value pairs followed by a list of values (Tcl style)

      4. +

    4. leading list of values followed by option-value pairs (Tk style)

    -

    punk::args is focused on the 1st convention (Tk style): parsing of args in leading option-value pair style - even for non-Tk usage.

    +

    There are exceptions in both Tcl and Tk commands regarding this ordering

    +

    punk::args is focused on the 1st convention (Tcl style): parsing of the 'args' variable in leading option-value pair style

    The proc can still contain some leading required values e.g

    proc dostuff {arg1 arg2 args} {...}}
    -

    but having the core values elements at the end of args is more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style.

    +

    but having the core values elements at the end of args is arguably more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style.

    The basic principle is that a call to punk::args::opts_vals is made near the beginning of the proc e.g

        proc dofilestuff {args} {
        lassign [dict values [punk::args {
+           *proc -help "do some stuff with files e.g dofilestuff <file1> <file2> <file3>"
+           *opts -type string
+           #comment lines ok
            -directory   -default ""
            -translation -default binary
+           #setting -type none indicates a flag that doesn't take a value (solo flag)
+           -nocomplain -type none
+           *values -min 1 -max -1
        } $args]] opts values
        puts "translation is [dict get $opts -translation]"
        foreach f [dict values $values] {
@@ -173,19 +180,94 @@
        }
    }
    +

    The lines beginning with * are optional in most cases and can be used to set defaults and some extra controls

    +

    - the above example would work just fine with only the -<optionname> lines, but would allow zero filenames to be supplied as no -min value is set for *values

    +

    valid * lines being with *proc *opts *values

    +

    lines beginning with a dash define options - a name can optionally be given to each trailing positional argument.

    +

    If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero.

    +

    e.g the result from the punk::args call above may be something like:

    +

    opts {-translation binary -directory "" -nocomplain 0} values {0 file1.txt 1 file2.txt 2 file3.txt}

    +

    Here is an example that requires the number of values supplied to be exactly 2 and names the positional arguments

    +

    It also demonstrates an inital argument 'category' that is outside of the scope for punk::args processing - allowing leading and trailing positional arguments

    +
    +   proc dofilestuff {category args} {
+       lassign [dict values [punk::args {
+           -directory   -default ""
+           -translation -default binary
+           -nocomplain -type none
+           *values -min 2 -max 2
+            fileA -existingfile 1
+            fileB -existingfile 1
+       } $args]] opts values
+       puts "$category fileA: [dict get $values fileA]"
+       puts "$category fileB: [dict get $values fileB]"
+   }
+
    +

    By using standard tcl proc named arguments prior to args, and setting *values -min 0 -max 0

    +

    a Tk-style ordering can be acheived, where punk::args is only handling the trailing flags and the values element of the returned dict can be ignored

    +

    This use of leading positional arguments means the type validation features can't be applied to them. It can be done manually as usual,

    +

    or an additional call could be made to punk::args e.g

    +
    +       punk::args {
+           category                -choices {cat1 cat2 cat3}
+           another_leading_arg     -type boolean
+       } [list $category $another_leading_arg]
+

    Notes

    -

    There are alternative args parsing packages such as:

    +

    For internal functions not requiring features such as solo flags, prefix matching, type checking etc - a well crafted switch statement will be the fastest pure-tcl solution.

    +

    When functions are called often and/or in inner loops, a switch based solution generally makes the most sense. +For functions that are part of an API a package may be more suitable.

    +

    The following example shows a switch-based solution that is highly performant (sub microsecond for the no-args case)

    +
    +    proc test1_switch {args} {
+        set opts [dict create\
+            -return "object"\
+            -frametype "heavy"\
+            -show_edge  1\
+            -show_seps  0\
+            -x a\
+            -y b\
+            -z c\
+            -1 1\
+            -2 2\
+            -3 3\
+        ]
+        foreach {k v} $args {
+            switch -- $k {
+                -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {
+                    dict set opts $k $v
+                }
+                default {
+                    error "unrecognised option '$k'. Known options [dict keys $opts]"
+                }
+            }
+        }
+        return $opts
+    }
+
    +

    Note that the switch statement uses literals so that the compiler produces a jump-table for best performance.

    +

    Attempting to build the switch branch using the values from dict keys $opts will stop the jump table being built. + To create the faster switch statement without repeating the key names, the proc body would need to be built using string map.

    +

    use punk::lib::show_jump_tables <procname> to verify that a jump table exists.

    +

    There are many alternative args parsing packages a few of which are listed here.

      -

    1. argp

      2. -

    2. The tcllib set of TEPAM modules

      +

    3. argp (pure tcl)

      4. +

    4. parse_args (c implementation)

      5. +

    5. argparse (pure tcl *)

      6. +

    6. cmdline (pure tcl)

      7. +

    7. opt (pure tcl) distributed with Tcl but considered deprecated

      8. +

    8. The tcllib set of TEPAM modules (pure tcl)

      TEPAM requires an alternative procedure declaration syntax instead of proc - but has support for Tk and documentation generation.

    +

    (* c implementation planned/proposed)

    punk::args was designed initially without specific reference to TEPAM - and to handle some edge cases in specific projects where TEPAM wasn't suitable.

    In subsequent revisions of punk::args - some features were made to operate in a way that is similar to TEPAM - to avoid gratuitous differences where possible, but of course there are differences

    and those used TEPAM or mixing TEPAM and punk::args should take care to assess the differences.

    TEPAM is a mature solution and is widely available as it is included in tcllib.

    -

    Serious consideration should be given to using TEPAM if suitable for your project.

    +

    Serious consideration should be given to using TEPAM or one of the other packages, if suitable for your project.

    +

    punk::args is relatively performant for a pure-tcl solution - with the parsing of the argument specification block occuring only on the first run - after which a cached version of the spec is used.

    +

    punk::args is not limited to procs. It can be used in apply or coroutine situations for example.

    dependencies

    packages used by punk::args

    @@ -203,7 +285,7 @@

    Namespace punk::args

    Core API functions for punk::args

    -
    opts_values optionspecs rawargs ?option value...?
    +
    get_dict optionspecs rawargs ?option value...?

    Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values

    Returns a dict of the form: opts <options_dict> values <values_dict>

    ARGUMENTS:

    @@ -211,11 +293,18 @@
    multiline-string optionspecs

    This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced

    'info complete' is used to determine if a record spans multiple lines due to multiline values

    -

    Each optionspec line must be of the form:

    +

    Each optionspec line defining a flag must be of the form:

    -optionname -key val -key2 val2...

    -

    where the valid keys for each option specification are: -default -type -range -choices -optional

    +

    where the valid keys for each option specification are: -default -type -range -choices -optional

    +

    Each optionspec line defining a positional argument is of the form:

    +

    argumentname -key val -ky2 val2...

    +

    where the valid keys for each option specification are: -default -type -range -choices

    +

    comment lines begining with # are ignored and can be placed anywhere except within a multiline value where it would become part of that value

    +

    lines beginning with *proc *opts or *values also take -key val pairs and can be used to set defaults and control settings.

    +

    *opts or *values lines can appear multiple times with defaults affecting flags/values that follow.

    list rawargs
    -

    This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc

    +

    This is a list of the arguments to parse. Usually it will be the $args value from the containing proc, +but it could be a manually constructed list of values made for example from positional args defined in the proc.

    diff --git a/src/embedded/www/doc/files/punk/_module_island-0.1.0.tm.html b/src/embedded/www/doc/files/punk/_module_island-0.1.0.tm.html new file mode 100644 index 0000000..ddffc27 --- /dev/null +++ b/src/embedded/www/doc/files/punk/_module_island-0.1.0.tm.html @@ -0,0 +1,304 @@ + +shellspy_module_punk::island - punk::island for safe interps + + + + + +
    [ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
    +
    +

    shellspy_module_punk::island(0) 0.1.0 doc "punk::island for safe interps"

    +

    Name

    +

    shellspy_module_punk::island - filesystem islands for safe interps

    +
    + + +

    Description

    +

    Package to a allow a safe interpreter to access islands of the

    +

    filesystem only, i.e. restricted directory trees within the

    +

    filesystem. The package brings back file, open and glob to the child interp

    +

    interpreter, though in a restricted manner.

    +

    JN Warning:

    +

    This mechanism can have interactions with package loading from auto_path - needs review.

    +
    +

    Overview

    +

    overview of punk::island

    + +

    dependencies

    +

    packages used by punk::island

    +
      +

    • Tcl 8.6

      • +
    +
    +
    +

    API

    +

    Namespace punk::island::class

    +

    class definitions

    +
      +
    +
    +

    Namespace punk::island::interps

    +

    hosts information for interpreters

    +
    +
    +
    +

    Namespace punk::island

    +

    Core API functions for punk::island

    +
    +
    add child path
    +

    Add a path to the list of paths that are explicitely allowed for access

    +

    to a child interpreter. Access to any path that has not been explicitely

    +

    allowed will be denied. Paths that are added to the list of allowed

    +

    islands are always fully normalized.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter to control

    +
    +
    reset child
    +

    Remove all access path allowance and arrange for the interpreter to be

    +

    able to return to the regular safe state.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    +
    +
    +

    Namespace punk::island::lib

    +

    Secondary functions that are part of the API

    +
    +
    +
    +
    +

    Internal

    +

    Namespace punk::island::system

    +

    Internal functions that are not part of the API

    +
    +
    Allowed child fname
    +

    Check that the file name passed as an argument is within the islands of

    +

    the filesystem that have been registered through the add command for a

    +

    given (safe) interpreter. The path is fully normalized before testing

    +

    against the islands, which themselves are fully normalized.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    string fname
    +

    (relative) path to the file to test

    +
    +
    File child cmd args
    +

    Parses the options and arguments to the file command to discover which

    +

    paths it tries to access and only return the results of its execution

    +

    when these path are within the allowed islands of the filesystem.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    string cmd
    +

    Subcommand of the file command

    +
    string args
    +

    Arguments to the file subcommand

    +
    +
    Open child args
    +

    Parses the options and arguments to the open command to discover which

    +

    paths it tries to access and only return the results of its execution

    +

    when these path are within the allowed islands of the filesystem.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    string args
    +

    Arguments to the open subcommand

    +
    +
    Expose child cmd args
    +

    This procedure allows to callback a command that would typically have

    +

    been hidden from a child interpreter. It does not "interp expose" but

    +

    rather calls the hidden command, so we can easily revert back.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    string cmd
    +

    Hidden command to call

    +
    string args
    +

    Arguments to the command

    +
    +
    Glob child args
    +

    Parses the options and arguments to the glob command to discover which

    +

    paths it tries to access and only return the results of its execution

    +

    when these path are within the allowed islands of the filesystem.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    string args
    +

    Arguments to the glob command

    +
    +
    Init child
    +

    Initialise child interpreter so that it will be able to perform some

    +

    file operations, but only within some islands of the filesystem.

    +

    Arguments:

    +
    + +
    string child
    +

    Identifier of the child interpreter

    +
    +
    +
    +
    + + +
    diff --git a/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html b/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html index 61ed29b..5d7fa65 100644 --- a/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html +++ b/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html @@ -167,7 +167,6 @@
  • linesort ?sortoption ?val?...? textblock
  • list_as_lines ?-joinchar char? linelist
  • lines_as_list ?option value ...? text
    • -
  • opts_values ?option value...? optionspecs rawargs
    • @@ -217,7 +216,7 @@

    We want to resolve the index used, without passing arbitrary expressions into the 'expr' function - which could have security risks.

    lindex_resolve will parse the index expression and return -1 if the supplied index expression is out of bounds for the supplied list.

    Otherwise it will return an integer corresponding to the position in the list.

    -

    Like Tcl list commands - it will produce an error if the form of the

    +

    Like Tcl list commands - it will produce an error if the form of the index is not acceptable

    K x y

    The K-combinator function - returns the first argument, x and discards y

    see https://wiki.tcl-lang.org/page/K

    @@ -336,20 +335,6 @@ but has the disadvantage of being slower for 'small' numbers and using more memo

    Returns a list of possibly trimmed lines depeding on options

    The concept of lines is raw lines from splitting on newline after crlf is mapped to lf

    - not console lines which may be entirely different due to control characters such as vertical tabs or ANSI movements

    -
    opts_values ?option value...? optionspecs rawargs
    -

    Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values

    -

    Returns a dict of the form: opts <options_dict> values <values_dict>

    -

    ARGUMENTS:

    -
    -
    multiline-string optionspecs
    -

    This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced

    -

    'info complete' is used to determine if a record spans multiple lines due to multiline values

    -

    Each optionspec line must be of the form:

    -

    -optionname -key val -key2 val2...

    -

    where the valid keys for each option specification are: -default -type -range -choices -optional

    -
    list rawargs
    -

    This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc

    -
    diff --git a/src/embedded/www/doc/files/punk/repl/_module_codethread-0.1.0.tm.html b/src/embedded/www/doc/files/punk/repl/_module_codethread-0.1.0.tm.html new file mode 100644 index 0000000..dddb91b --- /dev/null +++ b/src/embedded/www/doc/files/punk/repl/_module_codethread-0.1.0.tm.html @@ -0,0 +1,187 @@ + +shellspy_module_punk::repl::codethread - - + + + + + +
    [ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
    +
    +

    shellspy_module_punk::repl::codethread(0) 0.1.0 doc "-"

    +

    Name

    +

    shellspy_module_punk::repl::codethread - Module API

    +
    + +

    Synopsis

    +
    +
      +
    • package require punk::repl::codethread
      • +
    +
    +
    + +

    Overview

    +

    overview of punk::repl::codethread

    + +

    dependencies

    +

    packages used by punk::repl::codethread

    +
      +

    • Tcl 8.6

      • +
    +
    +
    +

    API

    + +

    Namespace punk::repl::codethread

    +

    Core API functions for punk::repl::codethread

    +
    +
    +
    +

    Namespace punk::repl::codethread::lib

    +

    Secondary functions that are part of the API

    +
    +
    +
    +
    +

    Internal

    +

    Namespace punk::repl::codethread::system

    +

    Internal functions that are not part of the API

    +
    +
    + + +
    diff --git a/src/embedded/www/doc/toc.html b/src/embedded/www/doc/toc.html index ee34b4b..5f026c5 100644 --- a/src/embedded/www/doc/toc.html +++ b/src/embedded/www/doc/toc.html @@ -17,70 +17,90 @@ overtype text layout - ansi aware +overtype_module_overtype +overtype text layout - ansi aware + + punkshell punkshell - Core - + punkshell__project_changes punkshell Changes - + punkshell__project_intro Introduction to punkshell - + punkshell_module_punk::ansi Ansi string functions - + punkshell_module_punk::args args parsing - + punkshell_module_punk::cap capability provider and handler plugin system - + punkshell_module_punk::char character-set and unicode utilities - + punkshell_module_punk::encmime mime encodings related subset of tcllib mime - + punkshell_module_punk::fileline file line-handling utilities - + punkshell_module_punk::flib flib experimental - + punkshell_module_punk::lib punk general utility functions - + punkshell_module_punk::mix::commandset::project dec commandset - project - + punkshell_module_punk::path Filesystem path utilities + +shellspy_module_argparsingtest +Module API + +shellspy_module_punk::aliascore +Module API + + shellspy_module_punk::assertion assertion alternative to control::assert - + shellspy_module_punk::basictelnet basic telnet client - DKF/Wiki + +shellspy_module_punk::island +filesystem islands for safe interps + +shellspy_module_punk::repl::codethread +Module API + + shellspy_module_punk::sshrun Tcl procedures to execute tcl scripts in remote hosts - + shellspy_module_punk::uc Module API diff --git a/src/embedded/www/index.html b/src/embedded/www/index.html index 33eee9a..06f50bf 100644 --- a/src/embedded/www/index.html +++ b/src/embedded/www/index.html @@ -13,7 +13,7 @@ ]

    Keyword Index

    - A · B · C · D · E · F · L · M · P · R · S · T · U + A · B · C · D · E · F · I · L · M · P · R · S · T · U
    @@ -107,12 +107,20 @@ + + + + - + - + - + - + - + - + - + - + - + - + - + - + - + + + + + - + - + - + - + - + - + - + - + - + - + - + - + + + + + + + + + - + + + + + + + + + - + diff --git a/src/modules/argparsingtest-999999.0a1.0.tm b/src/modules/argparsingtest-999999.0a1.0.tm new file mode 100644 index 0000000..044cf82 --- /dev/null +++ b/src/modules/argparsingtest-999999.0a1.0.tm @@ -0,0 +1,468 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# 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) 2024 +# +# @@ Meta Begin +# Application argparsingtest 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_argparsingtest 0 999999.0a1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require argparsingtest] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of argparsingtest +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by argparsingtest +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::class { + #*** !doctools + #[subsection {Namespace argparsingtest::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest { + namespace export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #*** !doctools + #[subsection {Namespace argparsingtest}] + #[para] Core API functions for argparsingtest + #[list_begin definitions] + + proc test1_switchmerge {args} { + set defaults [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x a\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {} + default { + error "unrecognised option '$k'. Known options [dict keys $defaults]" + } + } + } + set opts [dict merge $defaults $args] + } + #if we need to loop to test arg validity anyway - then dict set as we go is slightly faster than a dict merge at the end + proc test1_switch {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x a\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + switch -- $k { + -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { + dict set opts $k $v + } + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + } + return $opts + } + proc test1_switch2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x a\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + set switches [lmap v [dict keys $opts] {list $v -}] + set switches [concat {*}$switches] + set switches [lrange $switches 0 end-1] + foreach {k v} $args { + switch -- $k\ + {*}$switches { + dict set opts $k $v + }\ + default { + error "unrecognised option '$k'. Known options [dict keys $opts]" + } + } + return $opts + } + proc test1_prefix {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x a\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix option $k" {-return -frametype -show_edge -show_seps -x -y -z -1 -2 -3} $k] $v + } + return $opts + } + proc test1_prefix2 {args} { + set opts [dict create\ + -return string\ + -frametype \uFFEF\ + -show_edge \uFFEF\ + -show_seps \uFFEF\ + -x a\ + -y b\ + -z c\ + -1 1\ + -2 2\ + -3 3\ + ] + if {[llength $args]} { + set knownflags [dict keys $opts] + } + foreach {k v} $args { + dict set opts [tcl::prefix::match -message "test1_prefix2 option $k" $knownflags $k] $v + } + return $opts + } + + #punk::args is slower than argp - but comparable, and argp doesn't support solo flags + proc test1_punkargs {args} { + set argd [punk::args::get_dict { + *proc -name argtest4 -description "test of punk::args::get_dict comparative performance" + *opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default a -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + *values + } $args] + return [dict get $argd opts] + } + proc test1_punkargs_validate_without_ansi {args} { + set argd [punk::args::get_dict { + *proc -name argtest4 -description "test of punk::args::get_dict comparative performance" + *opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default a -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean -validate_without_ansi true + -2 -default 2 -type integer -validate_without_ansi true + -3 -default 3 -type integer -validate_without_ansi true + *values + } $args] + return [dict get $argd opts] + } + + package require opt + variable optlist + tcl::OptProc test1_opt { + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x a "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + } { + set opts [dict create] + foreach v [info locals] { + dict set opts $v [set $v] + } + return $opts + } + + package require cmdline + #cmdline::getoptions is much faster than typedGetoptions + proc test1_cmdline_untyped {args} { + set cmdlineopts_untyped { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg a "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.arg 1 "arg 1"} + {2.arg 2 "arg 2"} + {3.arg 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::getoptions args $cmdlineopts_untyped $usage] + } + proc test1_cmdline_typed {args} { + set cmdlineopts_typed { + {return.arg "string" "return val"} + {frametype.arg \uFFEF "frame type"} + {show_edge.arg \uFFEF "show table borders"} + {show_seps.arg \uFFEF "show table seps"} + {join "join the things"} + {x.arg a "arg x"} + {y.arg b "arg y"} + {z.arg c "arg z"} + {1.boolean 1 "arg 1"} + {2.integer 2 "arg 2"} + {3.integer 3 "arg 3"} + } + + set usage "usage etc" + return [::cmdline::typedGetoptions args $cmdlineopts_typed $usage] + } + + catch { + package require argp + argp::registerArgs test1_argp { + { -return string "string" } + { -frametype string \uFFEF } + { -show_edge string \uFFEF } + { -show_seps string \uFFEF } + { -x string a } + { -y string b } + { -z string c } + { -1 boolean 1 } + { -2 integer 2 } + { -3 integer 3 } + } + } + proc test1_argp {args} { + argp::parseArgs opts + return [array get opts] + } + + package require tepam + tepam::procedure {test1_tepam} { + -args { + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default a} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + } + } { + return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join] + } + + #multiline values use first line of each record to determine amount of indent to trim + proc test_multiline {args} { + set t3 [textblock::frame t3] + set argd [punk::args::get_dict [subst { + -template1 -default { + ****** + * t1 * + ****** + } + -template2 -default { ------ + ****** + * t2 * + ******} + -template3 -default {$t3} + #substituted or literal values with newlines - no autoindent applied - caller will have to pad appropriately + -template3b -default { + $t3 + ----------------- + $t3 + abc\ndef + } + -template4 -default "****** + * t4 * + ******" + -template5 -default " + + + " + -flag -default 0 -type boolean + }] $args] + return $argd + } + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval argparsingtest::lib { + namespace export {[a-z]*} ;# Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace argparsingtest::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace argparsingtest::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval argparsingtest::system { + #*** !doctools + #[subsection {Namespace argparsingtest::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide argparsingtest [namespace eval argparsingtest { + variable pkg argparsingtest + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/argparsingtest-buildversion.txt b/src/modules/argparsingtest-buildversion.txt new file mode 100644 index 0000000..f47d01c --- /dev/null +++ b/src/modules/argparsingtest-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/flagfilter-0.3.tm b/src/modules/flagfilter-0.3.tm index 8f6319b..6497be7 100644 --- a/src/modules/flagfilter-0.3.tm +++ b/src/modules/flagfilter-0.3.tm @@ -1881,17 +1881,18 @@ namespace eval flagfilter { - set cf_defaults [dict create] - dict set cf_defaults -caller $caller - dict set cf_defaults -return [list arglistremaining] - dict set cf_defaults -match [list] - dict set cf_defaults -commandprocessors [list] - dict set cf_defaults -soloflags [list] - dict set cf_defaults -extras [list] - dict set cf_defaults -defaults [list] - dict set cf_defaults -required [list] - dict set cf_defaults -values \uFFFF - dict set cf_defaults -debugargs 0 + set cf_defaults [dict create\ + -caller $caller\ + -return [list arglistremaining]\ + -match [list]\ + -commandprocessors [list]\ + -soloflags [list]\ + -extras [list]\ + -defaults [list]\ + -required [list]\ + -values \uFFFF\ + -debugargs 0\ + ] dict set cf_defaults -debugargsonerror 1 ;#error level to use when dispatch error occurs.. will not set lower than -debugargs @@ -1899,18 +1900,17 @@ namespace eval flagfilter { if {([llength $args] % 2) != 0} { do_error "check_flags error when called from '$caller' :check_flags must be called with even number of arguments of form: -flag value Valid flags are: '[dict keys $cf_defaults]' \n got: $args" } - set cf_invalid_flags [list] - foreach k [dict keys $args] { - if {$k ni [dict keys $cf_defaults]} { - lappend cf_invalid_flags $k + set cf_args $cf_defaults + foreach {k v} $args { + switch -- $k { + -caller - -return - -match - -commandprocessors - -soloflags - -extras - -defaults - -required - -values - -debugargs - -debugargsonerror { + dict set cf_args $k $v + } + default { + do_error "check_flags error when called from ${caller}: Unknown option '$k': must be one of '[dict keys $cf_defaults]' \nIf calling check_flags directly, put args being checked in -values {...}" + } } } - if {[llength $cf_invalid_flags]} { - do_error "check_flags error when called from ${caller}: Unknown or incompatible option(s)'$cf_invalid_flags': must be one of '[dict keys $cf_defaults]' \nIf calling check_flags directly, put args being checked in -values e.g -values [list {*}$cf_invalid_flags]" - } - - - set cf_args [dict merge $cf_defaults $args] unset args #################################################### #now look at -values etc that check_flags is checking @@ -2430,7 +2430,7 @@ namespace eval flagfilter { do_debug 1 $debugc "returnkeys '[dict keys $returnval]'" } do_debug 1 $debugc "[string repeat = 40]" - foreach {k v} $combined { + dict for {k v} $combined { set dlev [dict get $debugdict $k] switch -- $k { dispatch { diff --git a/src/modules/natsort-0.1.1.6.tm b/src/modules/natsort-0.1.1.6.tm new file mode 100644 index 0000000..9d4f8a9 --- /dev/null +++ b/src/modules/natsort-0.1.1.6.tm @@ -0,0 +1,1912 @@ +#! /usr/bin/env tclsh + + +package require flagfilter +namespace import ::flagfilter::check_flags + +namespace eval natsort { + proc scriptdir {} { + set possibly_linked_script [file dirname [file normalize [file join [info script] ...]]] + if {[file isdirectory $possibly_linked_script]} { + return $possibly_linked_script + } else { + return [file dirname $possibly_linked_script] + } + } + if {![interp issafe]} { + tcl::tm::add [scriptdir] + } +} + + +namespace eval natsort { + variable stacktrace_on 0 + + proc do_error {msg {then error}} { + #note we exit or error out even if debug selected - as every do_error call is meant to interrupt code processing at the site of call + #this is not just a 'logging' call even though it has log-like descriptors + lassign $then type code + if {$code eq ""} { + set code 1 + } + set type [string tolower $type] + set levels [list debug info notice warn error critical] + if {$type in [concat $levels exit]} { + puts stderr "|$type> $msg" + } else { + puts stderr "|>natsort_call_err> unable to interpret 2nd argument to do_error: '$then' should be one of '$levels' or 'exit '" + } + if {$::tcl_interactive} { + #may not always be desirable - but assumed to be more useful not to exit despite request, to aid in debugging + if {[string tolower $type] eq "exit"} { + puts stderr " (exit suppressed due to tcl_interactive - raising error instead)" + if {![string is digit -strict $code]} { + puts stderr "|>natsort_call_err> unable to interpret 2nd argument to do_error: '$then' should be: 'exit '" + } + } + return -code error $msg + } else { + if {$type ne "exit"} { + return -code error $msg + } else { + if {[string is digit -strict $code]} { + exit $code + } else { + puts stderr "|>natsort_call_err> unable to interpret 2nd argument to do_error: '$then' should be 'error' or 'exit '" + return -code error $msg + } + } + } + } + + + + + + + variable debug 0 + variable testlist + set testlist { + 00.test-firstposition.txt + 0001.blah.txt + 1.test-sorts-after-all-leadingzero-number-one-equivs.txt + 1010.thousand-and-ten.second.txt + 01010.thousand-and-ten.first.txt + 0001.aaa.txt + 001.zzz.txt + 08.octal.txt-last-octal + 008.another-octal-first-octal.txt + 08.again-second-octal.txt + 001.a.txt + 0010.reconfig.txt + 010.etc.txt + 005.etc.01.txt + 005.Etc.02.txt + 005.123.abc.txt + 200.somewhere.txt + 2zzzz.before-somewhere.txt + 00222-after-somewhere.txt + 005.00010.abc.txt + 005.a3423bc.00010.abc.txt + 005.001.abc.txt + 005.etc.1010.txt + 005.etc.010.txt + 005.etc.10.txt + " 005.etc.10.txt" + 005.etc.001.txt + 20.somewhere.txt + 4611686018427387904999999999-bignum.txt + 4611686018427387903-bigishnum.txt + 9223372036854775807-bigint.txt + etca-a + etc-a + etc2-a + a0001blah.txt + a010.txt + winlike-sort-difference-0.1.txt + winlike-sort-difference-0.1.1.txt + a1.txt + b1-a0001blah.txt + b1-a010.txt + b1-a1.txt + -a1.txt + --a1.txt + --a10.txt + 2.high-two.yml + 02.higher-two.yml + reconfig.txt + _common.stuff.txt + CASETEST.txt + casetest.txt + something.txt + some~thing.txt + someathing.txt + someThing.txt + thing.txt + thing_revised.txt + thing-revised.txt + "thing revised.txt" + "spacetest.txt" + " spacetest.txt" + " spacetest.txt" + "spacetest2.txt" + "spacetest 2.txt" + "spacetest02.txt" + name.txt + name2.txt + "name .txt" + "name2 .txt" + blah.txt + combined.txt + a001.txt + .test + .ssh + "Feb 10.txt" + "Feb 8.txt" + 1ab23v23v3r89ad8a8a8a9d.txt + "Folder (10)/file.tar.gz" + "Folder/file.tar.gz" + "Folder (1)/file (1).tar.gz" + "Folder (1)/file.tar.gz" + "Folder (01)/file.tar.gz" + "Folder1/file.tar.gz" + "Folder(1)/file.tar.gz" + + } + lappend testlist "Some file.txt" + lappend testlist " Some extra file1.txt" + lappend testlist " Some extra file01.txt" + lappend testlist " some extra file1.txt" + lappend testlist " Some extra file003.txt" + lappend testlist " Some file.txt" + lappend testlist "Some extra file02.txt" + lappend testlist "Program Files (x86)" + lappend testlist "01999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999991-bigger-pathologically-bignum.txt" + lappend testlist "199999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-pathologically-bignum.txt" + lappend testlist "29999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-smaller-pathologically-bignum.txt" + lappend testlist "199999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-pathologically-bignum.txt with (more 1.txt" + lappend testlist "199999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999-pathologically-bignum.txt with (more 01.txt" + lappend testlist "a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1a1.pathological-num-nonnum-swapping-leadzero-should-be-first.txt" + lappend testlist "a1a1a1a1a1a1a1a1a1a1a1a01a1a1a1a1a1a1a1a1a1a1a1a1.pathological-num-nonnum-swapping-leadzero-should-be-first.txt" + lappend testlist "b1b1b1b1.txt" + lappend testlist "b1b01z1z1.txt" + lappend testlist "c1c111c1.txt" + lappend testlist "c1c1c1c1.txt" + + namespace eval overtype { + proc right {args} { + # @d !todo - implement overflow, length checks etc + + if {[llength $args] < 2} { + error {usage: ?-overflow [1|0]? undertext overtext} + } + foreach {undertext overtext} [lrange $args end-1 end] break + + set opt(-overflow) 0 + array set opt [lrange $args 0 end-2] + + + set olen [string length $overtext] + set ulen [string length $undertext] + + if {$opt(-overflow)} { + return [string range $undertext 0 end-$olen]$overtext + } else { + if {$olen > $ulen} { + set diff [expr {$olen - $ulen}] + return [string range $undertext 0 end-$olen][string range $overtext 0 end-$diff] + } else { + return [string range $undertext 0 end-$olen]$overtext + } + } + } + proc left {args} { + # @c overtype starting at left (overstrike) + # @c can/should we use something like this?: 'format "%-*s" $len $overtext + + if {[llength $args] < 2} { + error {usage: ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} + } + foreach {undertext overtext} [lrange $args end-1 end] break + + set opt(-ellipsis) 0 + set opt(-ellipsistext) {...} + set opt(-overflow) 0 + array set opt [lrange $args 0 end-2] + + + set len [string length $undertext] + set overlen [string length $overtext] + set diff [expr {$overlen - $len}] + + #puts stdout "====================>overtype: datalen:$len overlen:$overlen diff:$diff" + #puts stdout "====================>overtype: data: $overtext" + if {$diff > 0} { + if {$opt(-overflow)} { + return $overtext + } else { + if {$opt(-ellipsis)} { + return [overtype::left [string range $overtext 0 [expr {$len -1}]] $opt(-ellipsistext)] + } else { + return [string range $overtext 0 [expr {$len -1}]] + } + } + } else { + return "$overtext[string range $undertext $overlen end]" + } + } + + } + + #considered using hex to make large numbers more compact for viewing in debug output - but it's not that much shorter and probably obscures more than it helps. + proc hex2dec {largeHex} { + #todo - use punk::lib::hex2dec - (scan supports ll so can do larger hex values directly) + set res 0 + set largeHex [string map [list _ ""] $largeHex] + if {[string length $largeHex] <=7} { + #scan can process up to FFFFFFF and does so quickly + return [scan $largeHex %x] + } + foreach hexDigit [split $largeHex {}] { + set new 0x$hexDigit + set res [expr {16*$res + $new}] + } + return $res + } + proc dec2hex {decimalNumber} { + format %4.4llX $decimalNumber + } + + #punk::lib::trimzero + proc trimzero {number} { + set trimmed [string trimleft $number 0] + if {[string length $trimmed] == 0} { + set trimmed 0 + } + return $trimmed + } + #todo - consider human numeric split + #e.g consider SI suffixes k|KMGTPEZY in that order + + #in this context, for natural sorting - numeric segments don't contain underscores or other punctuation such as . - + etc. + #review - what about unicode equivalents such as wide numerals \UFF10 to \UFF19? unicode normalization? + proc split_numeric_segments {name} { + set segments [list] + while {[string length $name]} { + if {[scan $name {%[0-9]%n} chunk len] == 2} { + lappend segments $chunk + set name [string range $name $len end] + } + if {[scan $name {%[^0-9]%n} chunk len] == 2} { + lappend segments $chunk + set name [string range $name $len end] + } + } + return $segments + } + + proc padleft {str count {ch " "}} { + set val [string repeat $ch $count] + append val $str + set diff [expr {max(0,$count - [string length $str])}] + set offset [expr {max(0,$count - $diff)}] + set val [string range $val $offset end] + } + + + # Sqlite may have limited collation sequences available in default builds. + # with custom builds - there may be others such as 'natsort' - see https://sqlite.org/forum/forumpost/e4dc6f3331 + # This is of limited use with the few builtin collations available in 2023 ie binary,nocase & rtrim + # but may provide a quicker,flexible sort option, especially if/when more collation sequences are added to sqlite + # There are also prebuilt packages such as sqlite3-icu which allows things like "SELECT icu_load_collation('en_AU', 'australian');" + proc sort_sqlite {stringlist args} { + package require sqlite3 + + + set args [check_flags -caller natsort_sqlite -defaults [list -db :memory: -collate nocase -winlike 0 -topchars "\uFFFF" -debug 0 -splitchars [list / . - _] -extras {all}] -values $args] + set db [string trim [dict get $args -db]] + set collate [string trim [dict get $args -collate]] + set debug [string trim [dict get $args -debug]] + set topchars [string trim [dict get $args -topchars]] + + set topdot [expr {"." in $topchars}] + set topunderscore [expr {"_" in $topchars}] + + + sqlite3 db_sort_basic $db + set orderedlist [list] + db_sort_basic eval [string map [list %collate% $collate] {create table sqlitesort(index0 text COLLATE %collate%, name text COLLATE %collate%)}] + foreach nm $stringlist { + set segments [split_numeric_segments $nm] + set index "" + set s 0 + foreach seg $segments { + if {($s == 0) && ![string length [string trim $seg]]} { + #don't index leading space + } elseif {($s == 0) && ($topunderscore) && [string match _* [string trim $seg]]} { + append index "[padleft "0" 5]-d -100 topunderscore " + append index [string trim $seg] + } elseif {($s == 0) && ($topdot) && [string match .* [string trim $seg]]} { + append index "[padleft "0" 5]-d -50 topdot " + append index [string trim $seg] + } else { + if {[string is digit [string trim $seg]]} { + set basenum [trimzero [string trim $seg]] + set lengthindex "[padleft [string length $basenum] 5]-d" + append index "$lengthindex " + #append index [padleft $basenum 40] + append index $basenum + } else { + append index [string trim $seg] + } + } + incr s + } + puts stdout ">>$index" + db_sort_basic eval {insert into sqlitesort values($index,$nm)} + } + db_sort_basic eval [string map [list %collate% $collate] {select name from sqlitesort order by index0 COLLATE %collate% ASC, name COLLATE %collate% ASC }] { + lappend orderedlist $name + } + db_sort_basic close + return $orderedlist + } + + proc get_leading_char_count {str char} { + #todo - something more elegant? regex? + set count 0 + foreach c [split $str "" ] { + if {$c eq $char} { + incr count + } else { + break + } + } + return $count + } + proc stacktrace {} { + set stack "Stack trace:\n" + for {set i 1} {$i < [info level]} {incr i} { + set lvl [info level -$i] + set pname [lindex $lvl 0] + append stack [string repeat " " $i]$pname + + if {![catch {info args $pname} pargs]} { + foreach value [lrange $lvl 1 end] arg $pargs { + + if {$value eq ""} { + if {$arg != 0} { + info default $pname $arg value + } + } + append stack " $arg='$value'" + } + } else { + append stack " !unknown vars for $pname" + } + + append stack \n + } + return $stack + } + + proc get_char_count {str char} { + #faster than lsearch on split for str of a few K + expr {[string length $str]-[string length [string map [list $char {}] $str]]} + } + + proc build_key {chunk splitchars topdict tagconfig debug} { + variable stacktrace_on + if {$stacktrace_on} { + puts stderr "+++>[stacktrace]" + } + + set index_map [list - "" _ ""] + #e.g - need to maintain the order + #a b.txt + #a book.txt + #ab.txt + #abacus.txt + + + set original_splitchars [dict get $tagconfig original_splitchars] + + # tag_dashes test moved from loop - review + set tag_dashes 0 + if {![string length [dict get $tagconfig last_part_text_tag]]} { + #winlike + set tag_dashes 1 + } + if {("-" ni $original_splitchars)} { + set tag_dashes 1 + } + if {$debug >= 3} { + puts stdout "START build_key chunk : $chunk" + puts stdout "START build_key splitchars : $splitchars $topdict $tagconfig NO tag dashes" + } + + + ## index_map will have no effect if we've already split on the char anyway(?) + #foreach m [dict keys $index_map] { + # if {$m in $original_splitchars} { + # dict unset index_map $m + # } + #} + + #if {![string length $chunk]} return + + set result "" + if {![llength $splitchars]} { + #no more structural splits - but we need to examine numeric/non-numeric segments at the lowest level. + # we are at a leaf in the recursive split hierarchy + + set s "" ;#we never actually split on "" (unless that was put in splitchars.. but it probably shouldn't be) + set parts [list $chunk] ;#important to treat as list or leading/trailing whitespace lost + + + } else { + set s [lindex $splitchars 0] + if {"spudbucket$s" in "[split $chunk {}]"} { + error "dead-branch spudbucket" + set partindex [build_key $chunk [lrange $splitchars 1 end] $topdict $tagconfig $debug] + if {[dict get $tagconfig showsplits]} { + set pfx "(1${s}=)" ;# = sorts before _ + set partindex ${pfx}$partindex + } + + return $partindex + } else { + set parts_below_index "" + + if {$s ni [split $chunk ""]} { + #$s can be an empty string + set parts [list $chunk] + } else { + set parts [split $chunk $s] ;#whitespace preserved - even if splitting on s that is not in string. + } + #assert - we have a splitchar $s that is in the chunk - so at least one part + if {(![string length $s] || [llength $parts] == 0)} { + error "buld_key assertion false empty split char and/or no parts" + } + + set pnum 1 ;# 1 based for clarity of reading index in debug output + set subpart_count [llength $parts] + + set sub_splits [lrange $splitchars 1 end] ;#pass same splitchars to each subpart + foreach p $parts { + set partindex [build_key $p $sub_splits $topdict $tagconfig $debug] + set lastpart [expr {$pnum == $subpart_count}] + + + ####################### + set showsplits [dict get $tagconfig showsplits] + #split prefixing experiment - maybe not suitable for general use - as it affects sort order + #note that pfx must be consistent until last one, no matter how many partnumbers there are in total. + # we don't want to influence sort order before reaching end. + #e.g for: + #(1.=)... + #(1._)...(2._)...(3.=) + #(1._)...(2.=) + #Note that this is probably more suitable for highly structure dependant sorts where the results are maybe less.. natural. + if {$showsplits} { + if {$lastpart} { + set pfx "(${pnum}${s}_" + #set pfx "(${pnum}${s}=)" ;# = sorts before _ + } else { + set pfx "(${pnum}${s}_" + } + append parts_below_index $pfx + } + ####################### + + if {$lastpart} { + if {[string length $p] && [string is digit $p]} { + set last_part_tag "<22${s}>" + } else { + set last_part_tag "<33${s}>" + } + + set last_part_text_tag [dict get $tagconfig last_part_text_tag] + #for -winlike 1 there is no tag configured. Windows explorer likes to put things in the order: + # module-0.1.1.tm + # module-0.1.1.2.tm + # module-0.1.tm + # arguably -winlike 0 is more natural/human + # module-0.1.tm + # module-0.1.1.tm + # module-0.1.1.2.tm + + if {[string length $last_part_text_tag]} { + #replace only the first text-tag (<30>) from the subpart_index + if {[string match "<30?>*" $partindex]} { + #give textual string index a specific tag for last part in split only. e.g <130> for lower than integers + set partindex "<130>[string range $partindex 5 end]" + } + #append parts_below_index $last_part_tag + } + #set partindex $last_part_tag$partindex + + + } + append parts_below_index $partindex + + + + if {$showsplits} { + if {$lastpart} { + set suffix "${pnum}${s}=)" ;# = sorts before _ + } else { + set suffix "${pnum}${s}_)" + } + append parts_below_index $suffix + } + + + incr pnum + } + append parts_below_index "" ;# don't add anything at the tail that may perturb sort order + + if {$debug >= 3} { + set pad [string repeat " " 20] + puts stdout "END build_key chunk : $chunk " + puts stdout "END build_key splitchars : $splitchars $topdict $tagconfig NO tag dashes" + puts stdout "END build_key ret below_index: $parts_below_index" + } + return $parts_below_index + + + } + } + + + + #puts stdout ">>>chunk:'$chunk'<<< split-on:$s parts: '$parts' splitchars: $splitchars -topdict:$topdict" + + + + + + #if {$chunk eq ""} { + # puts "___________________________________________!!!____" + #} + #puts stdout "-->chunk:$chunk $s parts:$parts" + + #puts stdout "---chunk:'$chunk' part:'$part' parts:'$parts' s:'$s'" + + + + + set segments [split_numeric_segments $chunk] ;#! + set stringindex "" + set segnum 0 + foreach seg $segments { + #puts stdout "=================---->seg:$seg segments:$segments" + #-strict ? + if {[string length $seg] && [string is digit $seg]} { + set basenum [trimzero [string trim $seg]] + set lengthindex "[padleft [string length $basenum] 4]d" + #append stringindex "<20>$lengthindex $basenum $seg" + } else { + set c1 [string range $seg 0 0] + #puts stdout "==============> c1'$c1' topdict: $topdict stringindex:$stringindex" + + if {$c1 in [dict keys $topdict]} { + set tag [dict get $topdict $c1] + #append stringindex "${tag}$c1" + #set seg [string range $seg 1 end] + } + #textindex + set leader "<30>" + set idx $seg + set idx [string trim $idx] + set idx [string tolower $idx] + set idx [string map $index_map $idx] + + + + + + #set the X-c count to match the length of the index - not the raw data + set lengthindex "[padleft [string length $idx] 4]c" + + #append stringindex "${leader}$idx $lengthindex $texttail" + } + } + + if {[llength $parts] != 1} { + error "build_key assertion fail llength parts != 1 parts:$parts" + } + + set segtail_clearance_buffer " " ;#space to clear other split indicators if using showsplits + set segtail $segtail_clearance_buffer + append segtail "\[" + set grouping "" + set pnum 0 + foreach p $parts { + set sublen_list [list] + set subsegments [split_numeric_segments $p] + set i 0 + + set partsorter "" + foreach sub $subsegments { + ##don't trim spaces here - it would be inconsistent. Some subs are pure whitespace - others have internal whitespace. e.g "a4 400b a b2" becomes "a 4 { } 400 {b a b} 2" + #mapping away all whitespace would be consistent, but not necessarily desirable. If it's in the index_map it'll happen anyway - so we don't do it manually here except for evaluating conditions. + set test_trim [string trim $sub] + set str $sub + set str [string tolower $str] + set str [string map $index_map $str] + if {[string length $test_trim] && [string is digit $test_trim]} { + append partsorter [trimzero $str] + } else { + append partsorter "$str" + } + append partsorter + } + + + foreach sub $subsegments { + + if {[string length $sub] && [string is digit $sub]} { + set basenum [trimzero [string trim $sub]] + set subequivs $basenum + set lengthindex "[padleft [string length $subequivs] 4]d " + set idx "$lengthindex [padleft $basenum 10]" ;#todo - cycle through data and determine longest + set tail [overtype::left [string repeat " " 10] $sub] + #set tail "" + } else { + set idx "" + + + set lookahead [lindex $subsegments $i+1] + if {![string length $lookahead]} { + set zeronum "[padleft 0 4]d0" + } else { + set zeronum "" + } + set subequivs $sub + #set subequivs [string trim $subequivs] + set subequivs [string tolower $subequivs] + set subequivs [string map $index_map $subequivs] + + append idx $subequivs + append idx $zeronum + + set idx $subequivs + + + # + + set ch "-" + if {$tag_dashes} { + #puts stdout "____TAG DASHES" + #winlike + set numleading [get_leading_char_count $seg $ch] + if {$numleading > 0} { + set texttail "<31-leading[padleft $numleading 4]$ch>" + } else { + set texttail "<30>" + } + set numothers [expr {[get_char_count $seg $ch] - $numleading}] + if {$debug >= 2} { + puts stdout "____dashcount: [get_char_count $seg $ch] numothers: $numothers" + } + if {$numothers > 0} { + append texttail "<31-others[padleft $numothers 4]$ch>" + } else { + append textail "<30>" + } + } else { + set texttail "<30>" + } + + + + + #set idx $partsorter + set tail "" + #set tail [string tolower $sub] ;#raw + #set tail $partsorter + #append tail ":[string tolower $p]" ;#we need the whole part - even though it makes the index much larger. !todo - tagconfig switch to toggle case sensitive sorting + } + + append grouping "$idx $tail|$s" + incr i + } + + + + + + if {$p eq ""} { + # no subsegments.. + set zeronum "[padleft 0 4]d0" + #append grouping "\u000$zerotail" + append grouping ".$zeronum" + } + + #append grouping | + #append grouping $s + #foreach len $sublen_list { + # append segtail "<[padleft $len 3]>" + #} + incr pnum + } + set grouping [string trimright $grouping $s] + append grouping "[padleft [llength $parts] 4]" + append segtail $grouping + + + #append segtail " <[padleft [llength $parts] 4]>" + + append segtail "\]" + + + #if {[string length $seg] && [string is digit $seg]} { + # append segtail "<20>" + #} else { + # append segtail "<30>" + #} + append stringindex $segtail + + incr segnum + + + + + lappend indices $stringindex + + if {[llength $indices] > 1} { + puts stderr "INDICES [llength $indices]: $stringindex" + error "build_key assertion error deadconcept indices" + } + + #topchar handling on splitter characters + #set c1 [string range $chunk 0 0] + if {$s in [dict keys $topdict]} { + set tag [dict get $topdict $s] + set joiner [string map [list ">" "$s>"] ${tag}] + #we have split on this character $s so if the first part is empty string then $s was a leading character + # we need to bring a tag out front for this, or it will be dominated by the leading sections-remaing tag + # (since the empty string produces no tag of it's own - ?) + if {[string length [lindex $parts 0]] == 0} { + set prefix ${joiner} + } else { + set prefix "" + } + } else { + #use standard character-data positioning tag if no override from topdict + set joiner "<30J>$s" + set prefix "" + } + + + set contentindex $prefix[join $indices $joiner] + if {[string length $s]} { + set split_indicator "" + } else { + set split_indicator "" + + } + if {![string length $s]} { + set s ~ + } + + #return "[overtype::left [string repeat { } 80] $contentindex][overtype::left [string repeat { } 10] [list $s $chunk]]" + #return $contentindex$split_indicator + #return [overtype::left [string repeat - 40] $contentindex] + + if {$debug >= 3} { + puts stdout "END build_key chunk : $chunk" + puts stdout "END build_key splitchars : $splitchars $topdict $tagconfig NO tag dashes" + puts stdout "END build_key ret contentidx : $contentindex" + } + return $contentindex + } + + #---------------------------------------- + #line-processors - data always last argument - opts can be empty string + #all processor should accept empty opts and ignore opts if they don't use them + proc _lineinput_as_tcl1 {opts line} { + set out "" + foreach i $line { + append out "$i " + } + set out [string range $out 0 end-1] + return $out + } + #should be equivalent to above + proc _lineinput_as_tcl {opts line} { + return [concat {*}$line] + } + #will put extra tcl quoting if it was already tcl-shaped e.g text "a" -> {"a"} + proc _lineoutput_as_tcl {opts line} { + return [regexp -inline -all {\S+} $line] + } + + proc _lineinput_as_raw {opts line} { + return $line + } + proc _lineoutput_as_raw {opts line} { + return $line + } + + #words is opposite of tcl + proc _lineinput_as_words {opts line} { + #wordlike_parts + return [regexp -inline -all {\S+} $line] + } + proc _lineoutput_as_words {opts line} { + return [concat {*}$line] + } + + #opts same as tcllib csv::split - except without the 'line' element + #?-alternate? ?sepChar? ?delChar? + proc _lineinput_as_csv {opts line} { + package require csv + if {[lindex $opts 0] eq "-alternate"} { + return [csv::split -alternate $line {*}[lrange $opts 1 end]] + } else { + return [csv::split $line {*}$opts] + } + } + #opts same as tcllib csv::join + #?sepChar? ?delChar? ?delMode? + proc _lineoutput_as_csv {opts line} { + package require csv + return [csv::join $line {*}$opts] + } + #---------------------------------------- + proc sort {stringlist args} { + #puts stdout "natsort::sort args: $args" + variable debug + if {![llength $stringlist]} return + + #allow pass through of the check_flags flag -debugargs so it can be set by the caller + set debugargs 0 + if {[set posn [lsearch $args -debugargs]] >=0} { + if {$posn == [llength $args]-1} { + #-debugargs at tail of list + set debugargs 1 + } else { + set debugargs [lindex $args $posn+1] + } + } + + #-return flagged|defaults doesn't work Review. + #flagfilter global processor/allocator not working 2023-08 + set args [check_flags \ + -caller natsort::sort \ + -return supplied|defaults \ + -debugargs $debugargs \ + -defaults [list -collate nocase \ + -winlike 0 \ + -splits "\uFFFF" \ + -topchars {. _} \ + -showsplits 1 \ + -sortmethod ascii \ + -collate "\uFFFF" \ + -inputformat raw \ + -inputformatapply {index data} \ + -inputformatoptions "" \ + -outputformat raw \ + -outputformatoptions "" \ + -cols "\uFFFF" \ + -debug 0 -db "" -stacktrace 0 -splits "\uFFFF" -showsplits 0] \ + -required {all} \ + -extras {none} \ + -commandprocessors {} \ + -values $args] + + #csv unimplemented + + set winlike [dict get $args -winlike] + set topchars [dict get $args -topchars] + set cols [dict get $args -cols] + set debug [dict get $args -debug] + set stacktrace [dict get $args -stacktrace] + set showsplits [dict get $args -showsplits] + set splits [dict get $args -splits] + set sortmethod [dict get $args -sortmethod] + set opt_collate [dict get $args -collate] + set opt_inputformat [dict get $args -inputformat] + set opt_inputformatapply [dict get $args -inputformatapply] + set opt_inputformatoptions [dict get $args -inputformatoptions] + set opt_outputformat [dict get $args -outputformat] + set opt_outputformatoptions [dict get $args -outputformatoptions] + dict unset args -showsplits + dict unset args -splits + if {$debug} { + puts stdout "natsort::sort processed_args: $args" + if {$debug == 1} { + puts stdout "natsort::sort - try also -debug 2, -debug 3" + } + } + + #set sortmethod "-dictionary" ;# sorts a2b before a001b - possibly other strangenesses that are hard to reason about + switch -- $sortmethod { + dictionary - ascii { + set sortmethod "-$sortmethod" + # -ascii is default for tcl lsort. + } + default { + set sortmethod "-ascii" + } + } + + set allowed_collations [list nocase] + if {$opt_collate ne "\uFFFF"} { + if {$opt_collate ni $allowed_collations} { + error "natsort::sort unknown value for -collate option. Only acceptable value(s): $allowed_collations" + } + set nocaseopt "-$opt_collate" + } else { + set nocaseopt "" + } + set allowed_inputformats [list tcl raw csv words] + switch -- $opt_inputformat { + tcl - raw - csv - words {} + default { + error "natsort::sort unknown value for -inputformat option. Only acceptable value(s): $allowed_inputformats" + } + } + set allowed_outputformats [list tcl raw csv words] + switch -- $opt_outputformat { + tcl - raw - csv - words {} + default { + error "natsort::sort unknown value for -outputformat option. Only acceptable value(s): $allowed_outputformats" + } + } + + # + set winsplits [list / . _] + set commonsplits [list / . _ -] + #set commonsplits [list] + + set tagconfig [dict create] + dict set tagconfig last_part_text_tag "<19>" + if {$winlike} { + set splitchars $winsplits + #windows explorer sorts leading spaces at the top - which doesn't seem very helpful for keeping things together - but the explorer doesn't seem able to create leading spaces anyway. + set wintop [list "(" ")" { } {.} {_}] ;#windows specific order + foreach t $topchars { + if {$t ni $wintop} { + lappend wintop $t + } + } + set topchars $wintop + dict set tagconfig last_part_text_tag "" + } else { + set splitchars $commonsplits + } + if {$splits ne "\uFFFF"} { + set splitchars $splits + } + dict set tagconfig original_splitchars $splitchars + dict set tagconfig showsplits $showsplits + + #create topdict + set i 0 + set topdict [dict create] + foreach c $topchars { + incr i ;#start at 01 so that 00 reserved for final-split tag (allows x-0.1.txt to sort above x-0.1.1.txt by default. Use tagconfig to change, or choose -winlike 1 for explorer-like sorting) + dict set topdict $c "<0$i>" + } + set keylist [list] + + switch -- $opt_inputformat { + tcl { + set lineinput_transform [list _lineinput_as_tcl $opt_inputformatoptions] + } + csv { + set lineinput_transform [list _lineinput_as_csv $opt_inputformatoptions] + } + raw { + set lineinput_transform [list _lineinput_as_raw $opt_inputformatoptions] + } + words { + set lineinput_transform [list _lineinput_as_words $opt_inputformatoptions] + } + } + switch -- $opt_outputformat { + tcl { + set lineoutput_transform [list _lineoutput_as_tcl $opt_outputformatoptions] + } + csv { + set lineoutput_transform [list _lineoutput_as_csv $opt_outputformatoptions] + } + raw { + set lineoutput_transform [list _lineoutput_as_raw $opt_outputformatoptions] + } + words { + set lineoutput_transform [list _lineoutput_as_words $opt_outputformatoptions] + } + } + + if {("data" in $opt_inputformatapply) || ("index" in $opt_inputformatapply)} { + if {$opt_inputformat eq "raw"} { + set tf_stringlist $stringlist + } else { + set tf_stringlist [list] + foreach v $stringlist { + lappend tf_stringlist [{*}$lineinput_transform $v] + } + } + if {"data" in $opt_inputformatapply} { + set tf_data_stringlist $tf_stringlist + } else { + set tf_data_stringlist $stringlist + } + if {"index" in $opt_inputformatapply} { + set tf_index_stringlist $tf_stringlist + } else { + set tf_index_stringlist $stringlist + } + } else { + set tf_data_stringlist $stringlist + set tf_index_stringlist $stringlist + } + + + + if {$stacktrace} { + puts stdout [natsort::stacktrace] + set natsort::stacktrace_on 1 + } + if {$cols eq "\uFFFF"} { + set colkeys [lmap v $stringlist {}] + } else { + set colkeys [list] + foreach v $tf_index_stringlist { + set lineparts $v + set k [list] + foreach c $cols { + lappend k [lindex $lineparts $c] + } + lappend colkeys [join $k "_"] ;#use a common-split char - Review + } + } + #puts stdout "colkeys: $colkeys" + + if {$opt_inputformat eq "raw"} { + #no inputformat was applied - can just use stringlist + foreach value $stringlist ck $colkeys { + set contentindex [build_key $value $splitchars $topdict $tagconfig $debug] + set colindex [build_key $ck $splitchars $topdict $tagconfig $debug] + lappend keylist ${colindex}-${contentindex}-$value ;#note: entire raw value used for final sort disambiguation (can be whitespace that was ignored in indexing) + } + } else { + foreach keyinput $tf_index_stringlist datavalue $tf_data_stringlist ck $colkeys { + #data may or may not have been transformed + #column index may or may not have been built with transformed data + + set contentindex [build_key $keyinput $splitchars $topdict $tagconfig $debug] + set colindex [build_key $ck $splitchars $topdict $tagconfig $debug] + lappend keylist ${colindex}-${contentindex}-$datavalue ;#note: entire value used for final sort disambiguation (can be whitespace that was ignored in indexing) + } + } + #puts stderr "keylist: $keylist" + + ################################################################################################### + # Use the generated keylist to do the actual sorting + # select either the transformed or raw data as the corresponding output + ################################################################################################### + if {[string length $nocaseopt]} { + set sortcommand [list lsort $sortmethod $nocaseopt -indices $keylist] + } else { + set sortcommand [list lsort $sortmethod -indices $keylist] + } + if {$opt_outputformat eq "raw"} { + #raw output means no further transformations - it doesn't mean there wasn't a transform applied on the input side + #use the tf_data_stringlist in the output - which will be the same as the input stringlist if no input transform applied for data. + #(Also - it may or may not have been *sorted* on transformed data depending on whether 'index' was in $opt_inputformatapply) + foreach idx [{*}$sortcommand] { + lappend result [lindex $tf_data_stringlist $idx] + } + } else { + #we need to apply an output format + #The data may or may not have been transformed at input + foreach idx [{*}$sortcommand] { + lappend result [{*}$lineoutput_transform [lindex $tf_data_stringlist $idx]] + } + } + ################################################################################################### + + + + + + if {$debug >= 2} { + set screen_width 250 + set max_val 0 + set max_idx 0 + ##### calculate colum widths + foreach i [{*}$sortcommand] { + set len_val [string length [lindex $stringlist $i]] + if {$len_val > $max_val} { + set max_val $len_val + } + set len_idx [string length [lindex $keylist $i]] + if {$len_idx > $max_idx} { + set max_idx $len_idx + } + } + #### + set l_width [expr {$max_val + 1}] + set leftcol [string repeat " " $l_width] + set r_width [expr {$screen_width - $l_width - 1}] + set rightcol [string repeat " " $r_width] + set str [overtype::left $leftcol RAW] + puts stdout " $str Index with possibly transformed data at tail" + foreach i [{*}$sortcommand] { + #puts stdout "|d> [overtype::left $leftcol [lindex $stringlist $i] ] [lindex $keylist $i]" + set index [lindex $keylist $i] + set len_idx [string length $index] + set rowcount [expr {$len_idx / $r_width}] + if {($len_idx % $r_width) > 0} { + incr rowcount + } + set rows [list] + for {set r 0} {$r < $rowcount} {incr r} { + lappend rows [string range $index 0 $r_width-$r] + set index [string range $index $r_width end] + } + + set r 0 + foreach idxpart $rows { + if {$r == 0} { + #use the untransformed stringlist + set str [overtype::left $leftcol [lindex $stringlist $i]] + } else { + set str [overtype::left $leftcol ...]] + } + puts stdout " $str $idxpart" + incr r + } + #puts stdout "|> '[lindex $stringlist $i]'" + #puts stdout "|> [lindex $keylist $i]" + } + + puts stdout "|debug> topdict: $topdict" + puts stdout "|debug> splitchars: $splitchars" + } + return $result + } + + + + #Note that although leading whitespace isn't a commonly used feature of filesystem names - it's possible at least on FreeBSD,windows and linux so we should try to handle it sensibly. + proc sort_experiment {stringlist args} { + package require sqlite3 + + variable debug + set args [check_flags -caller natsort::sort \ + -defaults [dict create -db :memory: -collate nocase -nullvalue "->NULL<" -winlike 0 -topchars [list] -debug 0] \ + -extras {all} \ + -values $args] + set db [string trim [dict get $args -db]] + set collate [string trim [dict get $args -collate]] + set winlike [string trim [dict get $args -winlike]] + set debug [string trim [dict get $args -debug]] + set nullvalue [string trim [dict get $args -nullvalue]] + + + set topchars [string trim [dict get $args -topchars]] + + set topdot [expr {"." in $topchars}] + set topunderscore [expr {"_" in $topchars}] + + + sqlite3 db_natsort2 $db + #-- + #our table must handle the name with the greatest number of numeric/non-numeric splits. + #This means a single list member with pathological naming e.g a1a1a1a1a1a1a1a1a1a1a1.txt could greatly extend the number of columns and indices and affect performance. + #review: could be optimised to aggregate the tail into a single index, as the the extra columns won't assist in ordering, but make the table and query bigger. + # we should probably determine the longest common sequence of splits in the input list and add only one more index for the segment after that. + set maxsegments 0 + #-- + set prefix "idx" + + #note - there will be more columns in the sorting table than segments. + # (a segment equals one of the numeric & non-numeric string portions returned from 'split_numeric_sgements') + #--------------------------- + # consider + # a123b.v1.2.txt + # a123b.v1.3beta1.txt + # these have the following segments: + # a 123 b.v 1 . 2 .txt + # a 123 b.v 1 . 3 beta 1 .txt + #--------------------------- + # The first string has 7 segments (numbered 0 to 6) + # the second string has 9 segments + # + # for example when the data has any elements in a segment position that are numeric (e.g 0001 123) + # - then an index column with numeric equivalents will be created (e.g 0001 becomes 1), and any non-numeric values in that column will get mapped to a negative value (for special cases) or a high value such as NULL (with NULLS LAST sql support) + # + # when a segment + + #cycle through all strings - we cannot build tabledef as we go because the column type depends on whether all segments for a particular column are text vs int-equivalent. + array set segmentinfo {} + foreach nm $stringlist { + set segments [split_numeric_segments $nm] + if {![string length [string trim [lindex $segments 0]]]} { + if {[string is digit [string trim [lindex $segments 1]]]} { + #name is whitespace followed by a digit - special case - ignore the whitespace for numbers only. (whitespace still goes through to name column though) + set segments [lrange $segments 1 end] + } + } + + + set c 0 ;#start of index columns + if {[llength $segments] > $maxsegments} { + set maxsegments [llength $segments] + } + foreach seg $segments { + set seg [string trim $seg] + set column_exists [info exists segmentinfo($c,type)] + if {[string is digit $seg]} { + if {$column_exists} { + #override it (may currently be text or int) + set segmentinfo($c,type) "int" + } else { + #new column + set segmentinfo($c,name) ${prefix}$c + set segmentinfo($c,type) "int" + } + } else { + #text never overrides int + if {!$column_exists} { + set segmentinfo($c,name) ${prefix}$c + set segmentinfo($c,type) "text" + } + } + incr c + } + } + if {$debug} { + puts stdout "Largest number of num/non-num segments in data: $maxsegments" + #parray segmentinfo + } + + # + set tabledef "" + set ordered_column_names [list] + set ordered_segmentinfo_tags [lsort -dictionary [array names segmentinfo *]] + foreach k $ordered_segmentinfo_tags { + lassign [split $k ,] c tag + if {$tag eq "type"} { + set type [set segmentinfo($k)] + if {$type eq "int"} { + append tabledef "$segmentinfo($c,name) int," + } else { + append tabledef "$segmentinfo($c,name) text COLLATE $collate," + } + append tabledef "raw$c text COLLATE $collate," + lappend ordered_column_names $segmentinfo($c,name) + lappend ordered_column_names raw$c ;#additional index column not in segmentinfo + } + if {$tag eq "name"} { + #lappend ordered_column_names $segmentinfo($k) + } + } + append tabledef "name text" + + #puts stdout "tabledef:$tabledef" + + + db_natsort2 eval [string map [list %tabledef% $tabledef] {create table natsort(%tabledef%)}] + + + foreach nm $stringlist { + array unset intdata + array set intdata {} + array set rawdata {} + #init array and build sql values string + set sql_insert "insert into natsort values(" + for {set i 0} {$i < $maxsegments} {incr i} { + set intdata($i) "" + set rawdata($i) "" + append sql_insert "\$intdata($i),\$rawdata($i)," + } + append sql_insert "\$nm" ;#don't manipulate name value in any way - e.g must leave all whitespace as the sort must return exactly the same elements as in the original list. + append sql_insert ")" + + set segments [split_numeric_segments $nm] + if {![string length [string trim [lindex $segments 0]]]} { + if {[string is digit [string trim [lindex $segments 1]]]} { + #name is whitespace followed by a digit - special case - ignore the whitespace for numbers only. (whitespace still goes through to name column though) + set segments [lrange $segments 1 end] + } + } + set values "" + set c 0 + foreach seg $segments { + if {[set segmentinfo($c,type)] eq "int"} { + if {[string is digit [string trim $seg]]} { + set intdata($c) [trimzero [string trim $seg]] + } else { + catch {unset intdata($c)} ;#set NULL - sorts last + if {($c == 0) && ($topunderscore) && [string match _* [string trim $seg]]} { + set intdata($c) -100 + } + if {($c == 0) && ($topdot) && [string match .* [string trim $seg]]} { + set intdata($c) -50 + } + } + set rawdata($c) [string trim $seg] + } else { + #pure text column + #set intdata($c) [string trim $seg] ;#ignore leading/trailing whitespace - we sort first on trimmed version, then refine with the sort on rawdata index + #catch {unset indata($c)} + set indata($c) [string trim $seg] + set rawdata($c) $seg + } + #set rawdata($c) [string trim $seg]# + #set rawdata($c) $seg + incr c + } + db_natsort2 eval $sql_insert + } + + set orderedlist [list] + + if {$debug} { + db_natsort2 eval {select * from pragma_table_info('natsort')} rowdata { + parray rowdata + } + } + set orderby "order by " + + foreach cname $ordered_column_names { + if {[string match "idx*" $cname]} { + append orderby "$cname ASC NULLS LAST," + } else { + append orderby "$cname ASC," + } + } + append orderby " name ASC" + #append orderby " NULLS LAST" ;#?? + + #e.g "order by idx0 ASC, raw0 ASC, idx1 ASC .... name ASC" + if {$debug} { + puts stdout "orderby clause: $orderby" + } + db_natsort2 eval [string map [list %orderby% $orderby] {select * from natsort %orderby%}] rowdata { + set line "- " + #parray rowdata + set columnnames $rowdata(*) + #puts stdout "columnnames: $columnnames" + #[lsort -dictionary [array names rowdata] + append line "$rowdata(name) \n" + foreach nm $columnnames { + if {$nm ne "name"} { + append line "$nm: $rowdata($nm) " + } + } + #puts stdout $line + #puts stdout "$rowdata(name)" + lappend orderedlist $rowdata(name) + } + + db_natsort2 close + return $orderedlist + } +} + + +#application section e.g this file might be linked from /usr/local/bin/natsort +namespace eval natsort { + namespace import ::flagfilter::check_flags + + proc called_directly_namematch {} { + global argv0 + #see https://wiki.tcl-lang.org/page/main+script + #trailing ... let's us resolve symlinks in last component of the path (could be something else like ___ but ... seems unlikely to collide with anything in the filesystem) + if {[info exists argv0] + && + [file dirname [file normalize [file join [info script] ...]]] + eq + [file dirname [file normalize [file join $argv0 ...]]] + } { + return 1 + } else { + #puts stdout "norm info script: [file dirname [file normalize [file join [info script] ...]]]" + #puts stdout "norm argv0 : [file dirname [file normalize [file join $argv0 ...]]]" + return 0 + } + } + #Review issues around comparing names vs using inodes (esp with respect to samba shares) + proc called_directly_inodematch {} { + global argv0 + if {[info exists argv0] + && [file exists [info script]] && [file exists $argv0]} { + file stat $argv0 argv0Info + file stat [info script] scriptInfo + expr {$argv0Info(dev) == $scriptInfo(dev) + && $argv0Info(ino) == $scriptInfo(ino)} + } else { + return 0 + } + } + + set is_namematch [called_directly_namematch] + set is_inodematch [called_directly_inodematch] + #### + #review - reliability of mechanisms to determine direct calls + # we don't want application being called when being used as a library, but we need it to run if called directly or from symlinks etc + #-- choose a policy and leave the others commented. + #set is_called_directly $is_namematch + #set is_called_directly $is_inodematch + set is_called_directly [expr {$is_namematch || $is_inodematch}] + #set is_called_directly [expr {$is_namematch && $is_inodematch}] + ### + + + #puts stdout "called_directly_name: [called_directly_namematch] called_directly_inode: [called_directly_inodematch]" + + + # + + + proc test_pass_fail_message {pass {additional ""}} { + variable test_fail_msg + variable test_pass_msg + if {$pass} { + puts stderr $test_pass_msg + } else { + puts stderr $test_fail_msg + } + puts stderr $additional + } + + variable test_fail_msg "XXXXXXXXXXXX FAIL XXXXXXXXXXXXX" + variable test_pass_msg "------------ PASS -------------" + proc test_sort_1 {args} { + package require struct::list + puts stderr "---$args" + set args [check_flags -caller natsort:test_sort_1 -defaults [list -collate nocase -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 ] -values $args] + + puts stderr "test_sort_1 got args: $args" + + set unsorted_input { + 2.2.2 + 2.2.2.2 + 1a.1.1 + 1a.2.1.1 + 1.12.1 + 1.2.1.1 + 1.02.1.1 + 1.002b.1.1 + 1.1.1.2 + 1.1.1.1 + } + set input { +1.1.1 +1.1.1.2 +1.002b.1.1 +1.02.1.1 +1.2.1.1 +1.12.1 +1a.1.1 +1a.2.1.1 +2.2.2 +2.2.2.2 + } + + set sorted [natsort::sort $input {*}$args] + set is_match [struct::list equal $input $sorted] + + set msg "windows-explorer order" + + test_pass_fail_message $is_match $msg + puts stdout [string repeat - 40] + puts stdout INPUT + puts stdout [string repeat - 40] + foreach item $input { + puts stdout $item + } + puts stdout [string repeat - 40] + puts stdout OUTPUT + puts stdout [string repeat - 40] + foreach item $sorted { + puts stdout $item + } + test_pass_fail_message $is_match $msg + return [expr {!$is_match}] + } + proc test_sort_showsplits {args} { + package require struct::list + + set args [check_flags -caller natsort:test_sort_1 \ + -defaults [list -collate nocase -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 1 ] \ + -extras {all} \ + -values $args] + + set input1 { + a-b.txt + a.b.c.txt + b.c-txt + } + + + set input2 { + a.b.c.txt + a-b.txt + b.c-text + } + + foreach {msg testlist } [list "custom-order" $input1 "windows-explorer (should work with -winlike 1)" $input2] { + set sorted [natsort::sort $testlist {*}$args] + set is_match [struct::list equal $testlist $sorted] + + test_pass_fail_message $is_match $msg + puts stderr "INPUT" + puts stderr "[string repeat - 40]" + foreach item $testlist { + puts stdout $item + } + puts stderr "[string repeat - 40]" + puts stderr "OUTPUT" + puts stderr "[string repeat - 40]" + foreach item $sorted { + puts stdout $item + } + + test_pass_fail_message $is_match $msg + } + + #return [expr {!$is_match}] + + } + + #tcl proc dispatch order - non flag items up front + #trailing flags are paired even if supplied as solo flags e.g -l becomes -l 1 + proc commandline_ls {args} { + set operands [list] + set posn 0 + foreach a $args { + if {![string match -* $a]} { + lappend operands $a + } else { + set flag1_posn $posn + break + } + incr posn + } + set args [lrange $args $flag1_posn end] + + + set debug 0 + set posn [lsearch $args -debug] + if {$posn > 0} { + if {[lindex $args $posn+1]} { + set debug [lindex $args $posn+1] + } + } + if {$debug} { + puts stderr "|debug>commandline_ls got $args" + } + + #if first operand not supplied - replace it with current working dir + if {[lindex $operands 0] eq "\uFFFF"} { + lset operands 0 [pwd] + } + + set targets [list] + foreach op $operands { + if {$op ne "\uFFFF"} { + set opchars [split [file tail $op] ""] + if {"?" in $opchars || "*" in $opchars} { + lappend targets $op + } else { + #actual file or dir + set targetitem $op + set targetitem [file normalize $op] + if {![file exists $targetitem]} { + if {$debug} { + puts stderr "|debug>commandline_ls Unable to access path '$targetitem'" + } + } + lappend targets $targetitem + if {$debug} { + puts stderr "|debug>commandline_ls listing for $targetitem" + } + } + } + } + set args [check_flags -caller commandline_ls \ + -return flagged|defaults \ + -debugargs 0 \ + -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 -algorithm sort] \ + -required {all} \ + -extras {all} \ + -soloflags {-v -l} \ + -commandprocessors {} \ + -values $args ] + if {$debug} { + puts stderr "|debug>args: $args" + } + + + set algorithm [dict get $args -algorithm] + dict unset args -algorithm + + set allfolders [list] + set allfiles [list] + foreach item $targets { + if {[file exists $item]} { + if {[file type $item] eq "directory"} { + set dotfolders [glob -nocomplain -directory $item -type {d} -tail .*] + set folders [glob -nocomplain -directory $item -type {d} -tail *] + set allfolders [concat $allfolders $dotfolders $folders] + + set dotfiles [glob -nocomplain -directory $item -type {f} -tail .*] + set files [glob -nocomplain -directory $item -type {f} -tail *] + set allfiles [concat $allfiles $dotfiles $files] + } else { + #file (or link?) + set files [glob -nocomplain -directory [file dirname $item] -tail [file tail $item]] + set allfiles [concat $allfiles $files] + } + } else { + set folders [glob -nocomplain -directory $item -type {d} -tail [file tail $item]] + set allfolders [concat $allfolders $folders] + set files [glob -nocomplain -directory [file dirname $item] -tail [file tail $item]] + set allfiles [concat $allfiles $files] + } + } + + + set sorted_folders [natsort::sort $allfolders {*}$args] + set sorted_files [natsort::sort $allfiles {*}$args] + + foreach fold $sorted_folders { + puts stdout $fold + } + foreach file $sorted_files { + puts stdout $file + } + + return "-- ok printed to stdout [llength $sorted_folders] folders and [llength $sorted_files] files --" + } + + package require argp + argp::registerArgs commandline_test { + { -showsplits boolean 0} + { -stacktrace boolean 0} + { -debug boolean 0} + { -winlike boolean 0} + { -db string ":memory:"} + { -collate string "nocase"} + { -algorithm string "sort"} + { -topchars string "\uFFFF"} + { -testlist string {10 1 30 3}} + } + argp::setArgsNeeded commandline_test {-stacktrace} + proc commandline_test {test args} { + variable testlist + puts stdout "commandline_test got $args" + argp::parseArgs opts + puts stdout "commandline_test got [array get opts]" + set args [check_flags -caller natsort_commandline \ + -return flagged|defaults \ + -defaults [list -db :memory: -collate nocase -testlist $testlist -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] \ + -values $args] + + if {[string tolower $test] in [list "1" "true"]} { + set test "sort" + } else { + if {![llength [info commands $test]]} { + error "test $test not found" + } + } + dict unset args -test + set stacktrace [dict get $args -stacktrace] + # dict unset args -stacktrace + + set argtestlist [dict get $args -testlist] + dict unset args -testlist + + + set debug [dict get $args -debug] + + set collate [dict get $args -collate] + set db [dict get $args -db] + set winlike [dict get $args -winlike] + set topchars [dict get $args -topchars] + + + puts stderr "|test>-----start natsort::$test--- input list size : [llength $argtestlist]" + #set resultlist [$test $argtestlist -db $db -collate $collate -topchars $topchars -winlike $winlike] + set resultlist [$test $argtestlist {*}$args] + foreach nm $resultlist { + puts stdout $nm + } + puts stdout "|test>-----end natsort::$test--- sorted list size: [llength $resultlist]" + return "test end" + } + proc commandline_runtests {runtests args} { + set argvals [check_flags -caller commandline_runtests \ + -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits "\uFFFF" -runtests 1] \ + -values $args] + + puts stderr "runtests args: $argvals" + + #set runtests [dict get $argvals -runtests] + dict unset argvals -runtests + dict unset argvals -algorithm + + puts stderr "runtests args: $argvals" + #exit 0 + + set test_prefix "::natsort::test_sort_" + + if {$runtests eq "1"} { + set runtests "*" + } + + + set testcommands [info commands ${test_prefix}${runtests}] + if {![llength $testcommands]} { + puts stderr "No test commands matched -runtests argument '$runtests'" + puts stderr "Use 1 to run all tests" + set alltests [info commands ${test_prefix}*] + puts stderr "Valid tests are:" + + set prefixlen [string length $test_prefix] + foreach t $alltests { + set shortname [string range $t $prefixlen end] + puts stderr "$t = -runtests $shortname" + } + + } else { + foreach cmd $testcommands { + puts stderr [string repeat - 40] + puts stderr "calling $cmd with args: '$argvals'" + puts stderr [string repeat - 40] + $cmd {*}$argvals + } + } + exit 0 + } + proc help {args} { + puts stdout "natsort::help got '$args'" + return "Help not implemented" + } + proc natsort_pipe {args} { + #PIPELINE to take input list on stdin and write sorted list to stdout + #strip - from arglist + #set args [check_flags -caller natsort_pipeline \ + # -return all \ + # -defaults [list -db :memory: -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] \ + # -values $args] + + + set debug [dict get $args -debug] + if {$debug} { + puts stderr "|debug> natsort_pipe got args:'$args'" + } + set algorithm [dict get $args -algorithm] + dict unset args -algorithm + + set proclist [info commands ::natsort::sort*] + set algos [list] + foreach p $proclist { + lappend algos [namespace tail $p] + } + if {$algorithm ni [list {*}$proclist {*}$algos]} { + do_error "valid sort mechanisms: $algos" 2 + } + + + set input_list [list] + while {![eof stdin]} { + if {[gets stdin line] > 0} { + lappend input_list $line + } else { + if {[eof stdin]} { + + } else { + after 10 + } + } + } + + if {$debug} { + puts stderr "|debug> received [llength $input_list] list elements" + } + + set resultlist [$algorithm $input_list {*}$args] + if {$debug} { + puts stderr "|debug> returning [llength $resultlist] list elements" + } + foreach r $resultlist { + puts stdout $r + } + #exit 0 + + } + if {($is_called_directly)} { + set cmdprocessors { + {helpfinal {match "^help$" dispatch natsort::help}} + {helpfinal {sub -topic default "NONE"}} + } + #set args [check_flags \ + # -caller test1 \ + # -debugargs 2 \ + # -return arglist \ + # -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] \ + # -required {none} \ + # -extras {all} \ + # -commandprocessors $cmdprocessors \ + # -values $::argv ] + interp alias {} do_filter {} ::flagfilter::check_flags + + #mashopts are generally single-letter opts that can be run together e.g -l -d as -ld + set cmdprocessors { + {helpcmd {match "^help$" dispatch natsort::help singleopts {-v}}} + {helpcmd {sub -operand default \uFFFF singleopts {-l}}} + {lscmd {match "^ls$" dispatch natsort::commandline_ls dispatchtype tcl dispatchglobal 1 mashopts {-l -a} singleopts {-l -a} pairopts {} longopts {--color=always}}} + {lscmd {sub dir default "\uFFFF"}} + {lscmd {sub dir2 default "\uFFFF"}} + {lscmd {sub dir3 default "\uFFFF"}} + {lscmd {sub dir4 default "\uFFFF"}} + {lscmd {sub dir5 default "\uFFFF"}} + {lscmd {sub dir6 default "\uFFFF"}} + {runtests {match "^-tests$" dispatch natsort::commandline_runtests singleopts {-l}}} + {runtests {sub testname default "1" singleopts {-l}}} + {pipecmd {match "^-$" dispatch natsort::natsort_pipe dispatchtype tcl}} + } + set arglist [do_filter \ + -debugargs 0 \ + -debugargsonerror 2 \ + -caller cline_dispatch1 \ + -return all \ + -soloflags {-v -x} \ + -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 ] \ + -required {all} \ + -extras {all} \ + -commandprocessors $cmdprocessors \ + -values $::argv ] + + + #mashopts are generally single-letter opts that can be run together e.g -l -d as -ld + set cmdprocessors { + {testcmd {match "^test$" dispatch natsort::commandline_test singleopts {-l}}} + {testcmd {sub testname default "1" singleopts {-l}}} + } + set arglist [check_flags \ + -debugargs 0 \ + -caller cline_dispatch2 \ + -return all \ + -soloflags {-v -l} \ + -defaults [list -collate nocase -algorithm sort -testlist "1 2 3 10" -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0 ] \ + -required {all} \ + -extras {all} \ + -commandprocessors $cmdprocessors \ + -values $::argv ] + + + + + #set cmdprocessors [list] + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors $cmdprocessors -values $::argv ] + + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors {-cmd {-cmd -cmdarg1 -default "."} {-cmd -cmdarg2 -default j}} -values $::argv ] + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors {{-cmd -default help} {-cmd -cmdarg1 -default "."} {-cmd -cmdarg2 -default j}} -values $::argv ] + #set args [check_flags -caller test1 -defaults [list -collate nocase -algorithm sort -topchars "\uFFFF" -winlike 0 -debug 0 -stacktrace 0 -showsplits 0] -required {all} -extras {none} -commandprocessors {ls {ls lsdir -default "\uFFFF"}} -values $::argv ] + + exit 0 + + if {$::argc} { + + } + } +} + + +package provide natsort [namespace eval natsort { + variable version + set version 0.1.1.6 +}] + + diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 9fc0951..b5df54d 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -72,10 +72,14 @@ set punk_testd [dict create \ ] #impolitely cooperative withe punk repl - todo - tone it down. -namespace eval ::repl { - variable running 0 -} +#namespace eval ::punk::repl::codethread { +# variable running 0 +#} package require punk::lib +package require punk::aliascore ;#mostly punk::lib aliases +punk::aliascore::init + +package require punk::repl::codethread package require punk::config package require punk::ansi #package require textblock @@ -156,6 +160,35 @@ namespace eval punk { #variable re_headvar1 {([a-zA-Z:@.(),]+?)(?![^(]*\))(,.*)*$} + proc get_repl_runid {} { + if {[tsv::exists repl runid]} { + return [tsv::get repl runid] + } else { + return 0 + } + } + + #ordinary emission of chunklist when no repl + proc emit_chunklist {chunklist} { + set result "" + foreach record $chunklist { + lassign $record type data + switch -- $type { + stdout { + puts stdout "$data" + } + stderr { + puts stderr $data + } + result {} + default { + puts stdout "$type $data" + } + } + } + return $result + } + #----------------------------------------------------------------------------------- #strlen is important for testing issues with string representationa and shimmering. #This specific implementation with append (as at 2023-09) is designed to ensure the original str representation isn't changed @@ -219,6 +252,12 @@ namespace eval punk { } return $stack } + + #review - there are various type of uuid - we should use something consistent across platforms + #twapi is used on windows because it's about 5 times faster - but is this more important than consistency? + #twapi is much slower to load in the first place (e.g 75ms vs 6ms if package names already loaded) - so for oneshots tcllib uuid is better anyway + #(counterpoint: in the case of punk - we currently need twapi anyway on windows) + #does tcllib's uuid use the same mechanisms on different platforms anyway? proc ::punk::uuid {} { set has_twapi 0 if 0 { @@ -239,7 +278,7 @@ namespace eval punk { } if {!$has_twapi} { if {[catch {package require uuid} errM]} { - error "Unable to load a package for uuid on this platform. Try tcllib's uuid (any platform) - twapi for windows" + error "Unable to load a package for uuid on this platform. Try installing tcllib's uuid (any platform) - or twapi for windows" } return [uuid::uuid generate] } else { @@ -357,56 +396,6 @@ namespace eval punk { dict set output len [dict get $inf len] return $output } - namespace eval ensemble { - #wiki.tcl-lang.org/page/ensemble+extend - # extend an ensemble-like routine with the routines in some namespace - proc extend {routine extension} { - if {![string match ::* $routine]} { - set resolved [uplevel 1 [list ::namespace which $routine]] - if {$resolved eq {}} { - error [list {no such routine} $routine] - } - set routine $resolved - } - set routinens [namespace qualifiers $routine] - if {$routinens eq {::}} { - set routinens {} - } - set routinetail [namespace tail $routine] - - if {![string match ::* $extension]} { - set extension [uplevel 1 [ - list [namespace which namespace] current]]::$extension - } - - if {![namespace exists $extension]} { - error [list {no such namespace} $extension] - } - - set extension [namespace eval $extension [ - list [namespace which namespace] current]] - - namespace eval $extension [ - list [namespace which namespace] export *] - - while 1 { - set renamed ${routinens}::${routinetail}_[info cmdcount] - if {[namespace which $renamed] eq {}} break - } - - rename $routine $renamed - - namespace eval $extension [ - list namespace ensemble create -command $routine -unknown [ - list apply {{renamed ensemble routine args} { - list $renamed $routine - }} $renamed - ] - ] - - return $routine - } - } #review - extending core commands could be a bit intrusive...although it can make sense in a pipeline. #e.g contrived pipeline example to only allow setting existing keys @@ -427,7 +416,7 @@ namespace eval punk { } - #punk::ensemble::extend dict ::punk::dictextension + #punk::lib::ensemble::extend dict ::punk::dictextension @@ -4218,6 +4207,306 @@ namespace eval punk { return [expr {$e - $s + 1}] } + # unknown -- + # This procedure is called when a Tcl command is invoked that doesn't + # exist in the interpreter. It takes the following steps to make the + # command available: + # + # 1. See if the autoload facility can locate the command in a + # Tcl script file. If so, load it and execute it. + # 2. If the command was invoked interactively at top-level: + # (a) see if the command exists as an executable UNIX program. + # If so, "exec" the command. + # (b) see if the command requests csh-like history substitution + # in one of the common forms !!, !, or ^old^new. If + # so, emulate csh's history substitution. + # (c) see if the command is a unique abbreviation for another + # command. If so, invoke the command. + # + # Arguments: + # args - A list whose elements are the words of the original + # command, including the command name. + + #review - we shouldn't really be doing this + #We need to work out if we can live with the real default unknown and just inject some special cases at the beginning before falling-back to the normal one + + proc ::unknown args { + #puts stderr "unk>$args" + variable ::tcl::UnknownPending + global auto_noexec auto_noload env tcl_interactive errorInfo errorCode + + if {[info exists errorInfo]} { + set savedErrorInfo $errorInfo + } + if {[info exists errorCode]} { + set savedErrorCode $errorCode + } + + set name [lindex $args 0] + if {![info exists auto_noload]} { + # + # Make sure we're not trying to load the same proc twice. + # + if {[info exists UnknownPending($name)]} { + return -code error "self-referential recursion\ + in \"unknown\" for command \"$name\"" + } + set UnknownPending($name) pending + set ret [catch { + auto_load $name [uplevel 1 {::namespace current}] + } msg opts] + unset UnknownPending($name) + if {$ret != 0} { + dict append opts -errorinfo "\n (autoloading \"$name\")" + return -options $opts $msg + } + if {![array size UnknownPending]} { + unset UnknownPending + } + if {$msg} { + if {[info exists savedErrorCode]} { + set ::errorCode $savedErrorCode + } else { + unset -nocomplain ::errorCode + } + if {[info exists savedErrorInfo]} { + set errorInfo $savedErrorInfo + } else { + unset -nocomplain errorInfo + } + set code [catch {uplevel 1 $args} msg opts] + if {$code == 1} { + # + # Compute stack trace contribution from the [uplevel]. + # Note the dependence on how Tcl_AddErrorInfo, etc. + # construct the stack trace. + # + set errInfo [dict get $opts -errorinfo] + set errCode [dict get $opts -errorcode] + set cinfo $args + if {[string length [encoding convertto utf-8 $cinfo]] > 150} { + set cinfo [string range $cinfo 0 150] + while {[string length [encoding convertto utf-8 $cinfo]] > 150} { + set cinfo [string range $cinfo 0 end-1] + } + append cinfo ... + } + set tail "\n (\"uplevel\" body line 1)\n invoked\ + from within\n\"uplevel 1 \$args\"" + set expect "$msg\n while executing\n\"$cinfo\"$tail" + if {$errInfo eq $expect} { + # + # The stack has only the eval from the expanded command + # Do not generate any stack trace here. + # + dict unset opts -errorinfo + dict incr opts -level + return -options $opts $msg + } + # + # Stack trace is nested, trim off just the contribution + # from the extra "eval" of $args due to the "catch" above. + # + set last [string last $tail $errInfo] + if {$last + [string length $tail] != [string length $errInfo]} { + # Very likely cannot happen + return -options $opts $msg + } + set errInfo [string range $errInfo 0 $last-1] + set tail "\"$cinfo\"" + set last [string last $tail $errInfo] + if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo $errInfo $msg + } + set errInfo [string range $errInfo 0 $last-1] + set tail "\n invoked from within\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + set tail "\n while executing\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + return -options $opts $msg + } else { + dict incr opts -level + return -options $opts $msg + } + } + } + #set isrepl [expr {[file tail [file rootname [info script]]] eq "repl"}] + set isrepl [punk::repl::codethread::is_running] ;#may not be reading though + if {$isrepl} { + #set ::tcl_interactive 1 + } + if {$isrepl || (([info level] == 1) && (([info script] eq "" ) ) + && ([info exists tcl_interactive] && $tcl_interactive))} { + if {![info exists auto_noexec]} { + set new [auto_execok $name] + if {$new ne ""} { + set redir "" + if {[namespace which -command console] eq ""} { + set redir ">&@stdout <@stdin" + } + + + #windows experiment todo - use twapi and named pipes + #twapi::namedpipe_server {\\.\pipe\something} + #Then override tcl 'exec' and replace all stdout/stderr/stdin with our fake ones + #These can be stacked with shellfilter and operate as OS handles - which we can't do with fifo2 etc + # + + if {[string first " " $new] > 0} { + set c1 $name + } else { + set c1 $new + } + + # -- --- --- --- --- + set idlist_stdout [list] + set idlist_stderr [list] + #set shellrun::runout "" + #when using exec with >&@stdout (to ensure process is connected to console) - the output unfortunately doesn't go via the shellfilter stacks + #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 exec_unknown]} { + #This runs external executables in a context in which they are not attached to a terminal + #VIM for example won't run, and various programs can't detect terminal dimensions etc and/or will default to ansi-free output + #ctrl-c propagation also needs to be considered + + set teehandle punksh + uplevel 1 [list ::catch \ + [list ::shellfilter::run [concat [list $new] [lrange $args 1 end]] -teehandle $teehandle -inbuffering line -outbuffering none ] \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + + if {[string trim $::tcl::UnknownResult] ne "exitcode 0"} { + dict set ::tcl::UnknownOptions -code error + set ::tcl::UnknownResult "Non-zero exit code from command '$args' $::tcl::UnknownResult" + } else { + #no point returning "exitcode 0" if that's the only non-error return. + #It is misleading. Better to return empty string. + set ::tcl::UnknownResult "" + } + } else { + set repl_runid [punk::get_repl_runid] + #set ::punk::last_run_display [list] + + set redir ">&@stdout <@stdin" + uplevel 1 [list ::catch [concat exec $redir $new [lrange $args 1 end]] ::tcl::UnknownResult ::tcl::UnknownOptions] + #we can't detect stdout/stderr output from the exec + #for now emit an extra \n on stderr + #todo - there is probably no way around this but to somehow exec in the context of a completely separate console + #This is probably a tricky problem - especially to do cross-platform + # + # - use [dict get $::tcl::UnknownOptions -code] (0|1) exit + if {[dict get $::tcl::UnknownOptions -code] == 0} { + set c green + set m "ok" + } else { + set c yellow + set m "errorCode $::errorCode" + } + set chunklist [list] + lappend chunklist [list "info" "[a $c]$m[a] " ] + if {$repl_runid != 0} { + tsv::lappend repl runchunks-$repl_runid {*}$chunklist + } + + } + + foreach id $idlist_stdout { + shellfilter::stack::remove stdout $id + } + foreach id $idlist_stderr { + shellfilter::stack::remove stderr $id + } + # -- --- --- --- --- + + + #uplevel 1 [list ::catch \ + # [concat exec $redir $new [lrange $args 1 end]] \ + # ::tcl::UnknownResult ::tcl::UnknownOptions] + + #puts "===exec with redir:$redir $::tcl::UnknownResult ==" + dict incr ::tcl::UnknownOptions -level + return -options $::tcl::UnknownOptions $::tcl::UnknownResult + } + } + + if {$name eq "!!"} { + set newcmd [history event] + } elseif {[regexp {^!(.+)$} $name -> event]} { + set newcmd [history event $event] + } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} { + set newcmd [history event -1] + catch {regsub -all -- $old $newcmd $new newcmd} + } + if {[info exists newcmd]} { + tclLog $newcmd + history change $newcmd 0 + uplevel 1 [list ::catch $newcmd \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + dict incr ::tcl::UnknownOptions -level + return -options $::tcl::UnknownOptions $::tcl::UnknownResult + } + + set ret [catch {set candidates [info commands $name*]} msg] + if {$name eq "::"} { + set name "" + } + if {$ret != 0} { + dict append opts -errorinfo \ + "\n (expanding command prefix \"$name\" in unknown)" + return -options $opts $msg + } + # Filter out bogus matches when $name contained + # a glob-special char [Bug 946952] + if {$name eq ""} { + # Handle empty $name separately due to strangeness + # in [string first] (See RFE 1243354) + set cmds $candidates + } else { + set cmds [list] + foreach x $candidates { + if {[string first $name $x] == 0} { + lappend cmds $x + } + } + } + + #punk - disable prefix match search + set default_cmd_search 0 + if {$default_cmd_search} { + if {[llength $cmds] == 1} { + uplevel 1 [list ::catch [lreplace $args 0 0 [lindex $cmds 0]] \ + ::tcl::UnknownResult ::tcl::UnknownOptions] + dict incr ::tcl::UnknownOptions -level + return -options $::tcl::UnknownOptions $::tcl::UnknownResult + } + if {[llength $cmds]} { + return -code error "ambiguous command name \"$name\": [lsort $cmds]" + } + } else { + #punk hacked version - report matches but don't run + if {[llength $cmds]} { + return -code error "unknown command name \"$name\": possible match(es) [lsort $cmds]" + } + + } + + + } + return -code error -errorcode [list TCL LOOKUP COMMAND $name] \ + "invalid command name \"$name\"" + } + + proc know {cond body} { set existing [info body ::unknown] #assuming we can't test on cond being present in existing unknown script - because it may be fairly simple and prone to false positives (?) @@ -4251,6 +4540,7 @@ namespace eval punk { return "($scr)" } } + proc configure_unknown {} { #----------------------------- #these are critical e.g core behaviour or important for repl displaying output correctly @@ -4265,8 +4555,9 @@ namespace eval punk { #can't use know - because we don't want to return before original unknown body is called. proc ::unknown {args} [string map [list] { package require base64 - set ::punk::last_run_display [list] - set ::repl::last_unknown [lindex $args 0] ;#jn + #set ::punk::last_run_display [list] + #set ::repl::last_unknown [lindex $args 0] ;#jn + tsv::set repl last_unknown [lindex $args 0] ;#REVIEW }][info body ::unknown] @@ -4286,17 +4577,8 @@ namespace eval punk { #know {[expr $args] || 1} {expr $args} know {[expr $args] || 1} {tailcall expr $args} - #it is significantly faster to call a proc like this than to inline it in the unknown proc - proc ::punk::range {from to args} { - if {[info commands lseq] ne ""} { - #tcl 8.7+ lseq significantly faster for larger ranges - return [lseq $from $to] - } - set count [expr {($to -$from) + 1}] - incr from -1 - return [lmap v [lrepeat $count 0] {incr from}] - } - know {[regexp {^([0-9]+)\.\.([0-9]+)$} [lindex $args 0 0] -> from to]} {punk::range $from $to} + #it is significantly faster to call a proc such as punk::lib::range like this than to inline it in the unknown proc + know {[regexp {^([0-9]+)\.\.([0-9]+)$} [lindex $args 0 0] -> from to]} {punk::lib:range $from $to} #NOTE: @@ -4517,7 +4799,7 @@ namespace eval punk { } #pipe initiator which will never raise an error *except for pipesyntax* , but always returns {ok {result something}} or {error {mismatch something}} or, for tcl errors {error {reason something}} - proc pipematch {args} { + proc pipematch {args} { #debug.punk.pipe {pipematch level [info level] levelinfo [info level 0]} 2 variable re_dot_assign variable re_assign @@ -5192,7 +5474,7 @@ namespace eval punk { } #------------------------------------------------------------------- - namespace export help aliases alias dirfiles dirfiles_dict exitcode % pipedata pipecase pipeline pipematch pipeswitch pipeswitchc pipecase linelist linesort inspect list_as_lines is_list_all_in_list is_list_all_ni_list val treemore + namespace export help aliases alias dirfiles dirfiles_dict exitcode % pipedata pipecase pipeline pipematch pipeswitch pipeswitchc pipecase linelist linesort inspect list_as_lines val treemore #namespace ensemble create @@ -6040,7 +6322,8 @@ namespace eval punk { #JMN set is_win [expr {"windows" eq $::tcl_platform(platform)}] - set ::punk::last_run_display [list] + set repl_runid [get_repl_runid] + #set ::punk::last_run_display [list] if {([llength $args]) && ([lindex $args 0] eq "")} { set args [lrange $args 1 end] @@ -6065,18 +6348,22 @@ namespace eval punk { set filebytes [tcl::mathop::+ {*}$filesizes] lappend result filebytes [format_number $filebytes] } - if {$::repl::running} { + if {[punk::repl::codethread::is_running]} { if {[llength [info commands ::punk::console::titleset]]} { ::punk::console::titleset [lrange $result 1 end] } - - set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] - #puts stdout $out - #puts stderr [a+ white]$out[a] - set chunklist [list] - lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"] - lappend chunklist [list result $result] - set ::punk::last_run_display $chunklist + } + set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] + set chunklist [list] + lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"] + lappend chunklist [list result $result] + if {$repl_runid != 0} { + if {![tsv::llength repl runchunks-$repl_runid]} { + #set ::punk::last_run_display $chunklist + tsv::lappend repl runchunks-$repl_runid {*}$chunklist + } + } else { + punk::emit_chunklist $chunklist } #puts stdout "-->[ansistring VIEW $result]" return $result @@ -6105,9 +6392,7 @@ namespace eval punk { set searchspec [lindex $args 0] set result "" - if {$::repl::running} { - set chunklist [list] - } + set chunklist [list] #Only merge results if location matches previous (caller can deliberately intersperse bogus globs to force split if desired) #TODO - remove duplicate file or dir items for overlapping patterns in same location!!! (at least for count, filebyte totals if not for display) @@ -6183,12 +6468,8 @@ namespace eval punk { dict incr this_result filebytes 0 ;#ensure key exists! } dict lappend this_result pattern [dict get $matchinfo opts -glob] - if {$::repl::running} { - set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] - lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"] - } - - + set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] + lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"] set last_location $location } @@ -6203,15 +6484,21 @@ namespace eval punk { } - - if {$::repl::running} { - set ::punk::last_run_display $chunklist + if {[punk::repl::codethread::is_running]} { + if {![tsv::llength repl runchunks-$repl_runid]} { + #set ::punk::last_run_display $chunklist + tsv::lappend repl runchunks-$repl_runid {*}$chunklist + } + } + if {$repl_runid == 0} { + punk::emit_chunklist $chunklist } return $result } } proc dd/ {args} { - set ::punk::last_run_display [list] + #set ::punk::last_run_display [list] + set repl_runid [get_repl_runid] if {![llength $args]} { set path .. } else { @@ -6232,17 +6519,24 @@ namespace eval punk { lappend result filebytes [format_number $filebytes] } - if {$::repl::running} { - set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] - #return $out\n[pwd] - set chunklist [list] - lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"] - lappend chunklist [list result $result] - set ::punk::last_run_display $chunklist + set out [punk::dirfiles_dict_as_lines -stripbase 1 $matchinfo] + #return $out\n[pwd] + set chunklist [list] + lappend chunklist [list stdout "[a+ brightwhite]$out[a]\n"] + lappend chunklist [list result $result] + + if {[punk::repl::codethread::is_running]} { + if {![tsv::llength repl runchunks-$repl_runid]} { + #set ::punk::last_run_display $chunklist + tsv::lappend repl runchunks-$repl_runid {*}$chunklist + } if {[llength [info commands ::punk::console::titleset]]} { ::punk::console::titleset [lrange $result 1 end] ;#strip location key } } + if {$repl_runid == 0} { + punk::emit_chunklist $chunklist + } return $result } @@ -6537,6 +6831,10 @@ namespace eval punk { return $result } } + + + + #linelistraw is essentially split $text \n so is only really of use for pipelines, where the argument order is more convenient #like linelist - but keeps leading and trailing empty lines #single \n produces {} {} #the result can be joined to reform the arg if a single arg supplied @@ -6931,8 +7229,8 @@ namespace eval punk { #todo - load from source code annotation? set cmdinfo [list] lappend cmdinfo [list help "This help. To see available subitems type: help topics"] - lappend cmdinfo [list deck "(ensemble command to make new projects/modules and to generate docs)"] - lappend cmdinfo [list a? "view ANSI colours"] + lappend cmdinfo [list dev "(ensemble command to make new projects/modules and to generate docs)"] + lappend cmdinfo [list a? "view ANSI colours\n e.g a? web"] lappend cmdinfo [list ./ "view/change directory"] lappend cmdinfo [list ../ "go up one directory"] lappend cmdinfo [list ./new "make new directory and switch to it"] @@ -6973,8 +7271,8 @@ namespace eval punk { if {$topic in [list tcl]} { - if {[punk::repl::has_script_var_bug]} { - append warningblock \n "minor warning: punk::repl::has_script_var_bug returned true! (string rep for list variable in script generated when script changed)" + if {[punk::lib::system::has_script_var_bug]} { + append warningblock \n "minor warning: punk::lib::system::has_script_var_bug returned true! (string rep for list variable in script generated when script changed)" } } @@ -7104,7 +7402,7 @@ namespace eval punk { tailcall ::punk::console::mode $raw_or_line } - #this hides cmds mode command - probably no big deal - anyone who needs it will know how to exec it. + #this hides windows cmd's mode command - probably no big deal - anyone who needs it will know how to exec it. interp alias {} mode {} punk::mode @@ -7149,6 +7447,7 @@ namespace eval punk { } proc alias {{aliasorglob ""} args} { + set nsthis [uplevel 1 {::namespace current}] ;#must use :: - we can find ourselves in a namespace with a different 'namespace' command if {[llength $args]} { if {$aliasorglob in [interp aliases ""]} { set existing [interp alias "" $aliasorglob] @@ -7224,13 +7523,6 @@ namespace eval punk { - interp alias {} colour {} punk::console::colour - interp alias {} ansi {} punk::console::ansi - interp alias {} color {} punk::console::colour - interp alias {} a+ {} punk::console::code_a+ - interp alias {} a= {} punk::console::code_a - interp alias {} a {} punk::console::code_a - interp alias {} a? {} punk::console::code_a? #interp alias {} c {} clear ;#external executable 'clear' may not always be available #todo - review @@ -7283,20 +7575,14 @@ namespace eval punk { #---------------------------------------------- interp alias {} linelistraw {} punk::linelistraw - interp alias {} linelist {} punk::lib::linelist ;#critical for = assignment features - interp alias {} linesort {} punk::lib::linesort # 'path' collides with kettle path in kettle::doc function - todo - patch kettle? interp alias {} PATH {} punk::path interp alias {} path_list {} punk::path_list - #interp alias {} list_as_lines {} punk::list_as_lines - interp alias {} list_as_lines {} punk::lib::list_as_lines - interp alias {} lines_as_list {} punk::lib::lines_as_list - interp alias {} ansistrip {} punk::ansi::stripansi ;#review interp alias {} list_filter_cond {} punk::list_filter_cond - interp alias {} is_list_all_in_list {} punk::is_list_all_in_list - interp alias {} is_list_all_ni_list {} punk::is_list_all_ni_list + + interp alias {} inspect {} punk::inspect interp alias {} ooinspect {} punk::ooinspect interp alias {} pdict {} punk::pdict @@ -7318,6 +7604,9 @@ namespace eval punk { interp alias {} listset {} punk::listset ;#identical to pipeset + #non-core aliases + interp alias {} is_list_all_in_list {} punk::lib::is_list_all_in_list + interp alias {} is_list_all_ni_list {} punk::libis_list_all_ni_list @@ -7369,6 +7658,10 @@ namespace eval punk { set has_powershell 0 } if {$has_powershell} { + #see also powershell runspaces etc: + # powershell runspaces e.g $rs=[RunspaceFactory]::CreateRunspace() + # $ps = [Powershell]::Create() + interp alias {} ps {} exec >@stdout pwsh -nolo -nop -c interp alias {} psx {} runx -n pwsh -nop -nolo -c interp alias {} psr {} run -n pwsh -nop -nolo -c @@ -7396,13 +7689,13 @@ namespace eval punk { proc repl {startstop} { switch -- $startstop { stop { - if {$::repl::running} { + if {[punk::repl::codethread::is_running]} { puts stdout "Attempting repl stop. Try ctrl-c or exit command to leave interpreter" set ::repl::done 1 } } start { - if {!$::repl::running} { + if {[punk::repl::codethread::is_running]} { repl::start stdin } } @@ -7417,10 +7710,12 @@ package require punk::mod #punk::mod::cli set_alias pmod punk::mod::cli set_alias app -#todo - change to punk::deck +#todo - change to punk::dev package require punk::mix -punk::mix::cli set_alias pmix -punk::mix::cli set_alias deck +punk::mix::cli set_alias dev +punk::mix::cli set_alias deck ;#deprecate! + +#todo - add punk::deck for managing cli modules and commandsets package require punkcheck::cli punkcheck::cli set_alias pcheck diff --git a/src/modules/punk/aliascore-999999.0a1.0.tm b/src/modules/punk/aliascore-999999.0a1.0.tm new file mode 100644 index 0000000..2fefe2b --- /dev/null +++ b/src/modules/punk/aliascore-999999.0a1.0.tm @@ -0,0 +1,221 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# 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) 2024 +# +# @@ Meta Begin +# Application punk::aliascore 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::aliascore 0 999999.0a1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::aliascore] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::aliascore +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::aliascore +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::aliascore::class { + #*** !doctools + #[subsection {Namespace punk::aliascore::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::aliascore { + namespace export {[a-z]*} ;# Convention: export all lowercase + variable aliases + set aliases [dict create\ + list_as_lines punk::lib::list_as_lines\ + lines_as_list punk::lib::lines_as_list\ + linelist punk::lib::linelist\ + linesort punk::lib::linesort\ + ansistrip punk::ansi::stripansi\ + ] + + #*** !doctools + #[subsection {Namespace punk::aliascore}] + #[para] Core API functions for punk::aliascore + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #todo - options as to whether we should raise an error if collisions found, undo aliases etc? + proc init {args} { + set defaults {-force 0} + set opts [dict merge $defaults $args] + set opt_force [dict get $opts -force] + + variable aliases + if {!$opt_force} { + set existing [list] + set conflicts [list] + foreach {a cmd} $aliases { + if {[info commands ::$a] ne ""} { + lappend existing $a + set existing_target [interp alias "" $a] + if {$existing_target ne $cmd} { + #command exists in global ns but is either an alias to something else, or some other type of command + lappend conflicts $a + } + } + } + if {[llength $conflicts]} { + error "punk::aliascore::init declined to create any aliases because -force == 0 and conflicts found:$conflicts" + } + } + dict for {a cmd} $aliases { + interp alias {} $a {} {*}$cmd + } + return [dict keys $aliases] + } + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::aliascore ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#interp alias {} list_as_lines {} punk::lib::list_as_lines +#interp alias {} lines_as_list {} punk::lib::lines_as_list +#interp alias {} ansistrip {} punk::ansi::stripansi ;#review +#interp alias {} linelist {} punk::lib::linelist ;#critical for = assignment features +#interp alias {} linesort {} punk::lib::linesort + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::aliascore::lib { + namespace export {[a-z]*} ;# Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace punk::aliascore::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::aliascore::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval punk::aliascore::system { + #*** !doctools + #[subsection {Namespace punk::aliascore::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::aliascore [namespace eval punk::aliascore { + variable pkg punk::aliascore + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/aliascore-buildversion.txt b/src/modules/punk/aliascore-buildversion.txt new file mode 100644 index 0000000..f47d01c --- /dev/null +++ b/src/modules/punk/aliascore-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/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 2492bb9..2a0cd5a 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -141,19 +141,20 @@ namespace eval punk::ansi::class { if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" } - set defaults [dict create\ + set opts [dict create\ -dimensions 80x24\ -minus 0\ ] dict for {k v} $arglist { switch -- $k { - -dimensions - -minus { } + -dimensions - -minus { + dict set opts $k $v + } default { puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x" } } } - set opts [dict merge $defaults $arglist] set opt_dimensions [dict get $opts -dimensions] set opt_minus [dict get $opts -minus] lassign [split $opt_dimensions x] w h @@ -221,15 +222,17 @@ namespace eval punk::ansi::class { -vt 0\ -width "auto"\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -lf - -vt - -width {} + -lf - -vt - -width { + dict set opts $k $v + } default { error "viewcodes unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set opts_lf [dict get $opts -lf] set opts_vt [dict get $opts -vt] set opts_width [dict get $opts -width] @@ -249,15 +252,17 @@ namespace eval punk::ansi::class { set defaults [list\ -width "auto"\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -width {} + -width { + dict set opts $k $v + } default { error "viewchars unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set opts_width [dict get $opts -width] if {$opts_width eq ""} { return [punk::ansi::stripansiraw [$o_ansistringobj get]] @@ -275,15 +280,17 @@ namespace eval punk::ansi::class { set defaults [list\ -width "auto"\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -width {} + -width { + dict set opts $k $v + } default { error "viewstyle unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set opts_width [dict get $opts -width] if {$opts_width eq ""} { return [ansistring VIEWSTYLE [$o_ansistringobj get]] @@ -1423,16 +1430,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } proc colourmap1 {args} { - set defaults {-bg Web-white -forcecolour 0} - dict for {k v} $args { + set opts {-bg Web-white -forcecolour 0} + foreach {k v} $args { switch -- $k { - -bg - -forcecolour {} + -bg - -forcecolour { + dict set opts $k $v + } default { - error "colourmap1 unrecognised option $k. Known-options: [dict keys $defaults] + error "colourmap1 unrecognised option $k. Known-options: [dict keys $opts] } } } - set opts [dict merge $defaults $args] if {[dict get $opts -forcecolour]} { set fc "forcecolour" } else { @@ -1815,16 +1823,17 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # $WEB_colour_map_gray\ #] proc colourtable_web {args} { - set defaults {-forcecolour 0 -groups *} + set opts {-forcecolour 0 -groups *} foreach {k v} $args { switch -- $k { - -groups - -forcecolour {} + -groups - -forcecolour { + dict set opts $k $v + } default { error "colourtable_web unrecognised option '$k'. Known-options: [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set fc "" if {[dict get $opts -forcecolour]} { set fc "forcecolour" @@ -1894,19 +1903,20 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu proc colourtable_x11diff {args} { variable X11_colour_map_diff variable WEB_colour_map - set defaults [dict create\ + set opts [dict create\ -forcecolour 0\ -return "string"\ ] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { - -return - -forcecolour {} + -return - -forcecolour { + dict set opts $k $v + } default { - error "colourtable_x11diff unrecognised option '$k'. Known options [dict keys $defaults]" + error "colourtable_x11diff unrecognised option '$k'. Known options [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set fc "" if {[dict get $opts -forcecolour]} { set fc "forcecolour" @@ -3698,20 +3708,21 @@ namespace eval punk::ansi { variable codestate_empty set othercodes [list] - set defaults [dict create\ + set opts [dict create\ -filter_fg 0\ -filter_bg 0\ -filter_reset 0\ ] dict for {k v} $args { switch -- $k { - -filter_fg - -filter_bg - -filter_reset {} + -filter_fg - -filter_bg - -filter_reset { + dict set opts $k $v + } default { - error "sgr_merge unknown option '$k'. Known options [dict keys $defaults]" + error "sgr_merge unknown option '$k'. Known options [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set codestate $codestate_empty set codestate_initial $codestate_empty ;#keep a copy for resets. @@ -4331,6 +4342,39 @@ namespace eval punk::ansi::ta { } return [lappend list [string range $text $start end]] } + + #experiment for coroutine generator + proc _perlish_split_yield {re text} { + if {[string length $text] == 0} { + yield {} + } + set list [list] + set start 0 + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + yield [string range $text $start $matchStart-1] + yield [string index $text $matchStart] + incr start + if {$start >= [string length $text]} { + break + } + continue + } + yield [string range $text $start $matchStart-1] + yield [string range $text $matchStart $matchEnd] + set start [expr {$matchEnd+1}] + #? + if {$start >= [string length $text]} { + break + } + } + #return [lappend list [string range $text $start end]] + yield [string range $text $start end] + } proc _perlish_split2 {re text} { if {[string length $text] == 0} { return {} @@ -4399,7 +4443,7 @@ namespace eval punk::ansi::class { error {usage: ?-width ? ?-wrap [1|0]? ?-overflow [1|0]? from_ansistring to_ansistring} } lassign [lrange $args end-1 end] from_ansistring to_ansistring - set defaults [dict create\ + set opts [dict create\ -width \uFFEF\ -wrap 1\ -overflow 0\ @@ -4411,17 +4455,17 @@ namespace eval punk::ansi::class { ] puts "[info object class [self]] renderer [self] constructor from ansistring $from_ansistring to ansistring $to_ansistring" set argsflags [lrange $args 0 end-2] - dict for {k v} $argsflags { + foreach {k v} $argsflags { switch -- $k { - -width - -wrap - -overflow - -appendlines - -looplimit - -experimental {} + -width - -wrap - -overflow - -appendlines - -looplimit - -experimental { + dict set opts $k $v + } default { - set known_opts [dict keys $defaults] #don't use [self class] - or we'll get the superclass - error "[info object class [self]] unknown option '$k'. Known options: $known_opts" + error "[info object class [self]] unknown option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $argsflags] set o_width [dict get $opts -width] set o_wrap [dict get $opts -wrap] set o_overflow [dict get $opts -overflow] diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 8df558c..71171ee 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -21,7 +21,7 @@ #[manpage_begin punkshell_module_punk::args 0 999999.0a1.0] #[copyright "2024"] #[titledesc {args parsing}] [comment {-- Name section and table of contents description --}] -#[moddesc {args to option-value dict and values dict}] [comment {-- Description at end of page heading --}] +#[moddesc {args to nested dict of opts and values}] [comment {-- Description at end of page heading --}] #[require punk::args] #[keywords module proc args arguments parse] #[description] @@ -31,46 +31,156 @@ #*** !doctools #[section Overview] +#[para] There are many ways to parse arguments and many (too many?) packages to do it (see below for a discussion of packages and pure-tcl mechanisms). #[para] overview of punk::args #[subsection Concepts] #[para]There are 2 main conventions for parsing a proc args list #[list_begin enumerated] #[enum] -#[para]leading option-value pairs followed by a list of values (Tk style) +#[para]leading option-value pairs and flags followed by a list of values (Tcl style) #[enum] -#[para]leading list of values followed by option-value pairs (Tcl style) +#[para]leading list of values followed by option-value pairs and flags (Tk style) #[list_end] -#[para]punk::args is focused on the 1st convention (Tk style): parsing of args in leading option-value pair style - even for non-Tk usage. +#[para]There are exceptions in both Tcl and Tk commands regarding this ordering +#[para]punk::args is focused on the 1st convention (Tcl style): parsing of the 'args' variable in leading option-value pairs (and/or solo flags) style #[para]The proc can still contain some leading required values e.g [example "proc dostuff {arg1 arg2 args} {...}}"] -#[para]but having the core values elements at the end of args is more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style. -#[para]The basic principle is that a call to punk::args::opts_vals is made near the beginning of the proc e.g -#[example_begin] +#[para]but having the core values elements at the end of args is arguably more generally useful - especially in cases where the number of trailing values is unknown and/or the proc is to be called in a functional 'pipeline' style. +#[para] +#[para]The basic principle is that a call to punk::args::get_dict is made near the beginning of the proc with a cacheable first argument defining the parameters e.g +#[example { # proc dofilestuff {args} { -# lassign [lb]dict values [lb]punk::args { +# lassign [dict values [punk::args::get_dict { +# *proc -help "do some stuff with files e.g dofilestuff " +# *opts -type string +# #comment lines ok # -directory -default "" # -translation -default binary -# } $args[rb][rb] opts values +# #setting -type none indicates a flag that doesn't take a value (solo flag) +# -nocomplain -type none +# *values -min 1 -max -1 +# } $args]] opts values # -# puts "translation is [lb]dict get $opts -translation[rb]" -# foreach f [lb]dict values $values[rb] { +# puts "translation is [dict get $opts -translation]" +# foreach f [dict values $values] { # puts "doing stuff with file: $f" # } # } -#[example_end] +#}] +#[para]The lines beginning with * are optional in most cases and can be used to set defaults and some extra controls +#[para] - the above example would work just fine with only the - lines, but would allow zero filenames to be supplied as no -min value is set for *values +#[para]valid * lines being with *proc *opts *values +#[para]lines beginning with a dash define options - a name can optionally be given to each trailing positional argument. +#[para]If no names are defined for positional arguments, they will end up in the values key of the dict with numerical keys starting at zero. +#[para]e.g the result from the punk::args call above may be something like: +#[para] opts {-translation binary -directory "" -nocomplain 0} values {0 file1.txt 1 file2.txt 2 file3.txt} +#[para]Here is an example that requires the number of values supplied to be exactly 2 and names the positional arguments +#[para]It also demonstrates an inital argument 'category' that is outside of the scope for punk::args processing - allowing leading and trailing positional arguments +#[example { +# proc dofilestuff {category args} { +# lassign [dict values [punk::args::get_dict { +# -directory -default "" +# -translation -default binary +# -nocomplain -type none +# *values -min 2 -max 2 +# fileA -type existingfile 1 +# fileB -type existingfile 1 +# } $args]] opts values +# puts "$category fileA: [dict get $values fileA]" +# puts "$category fileB: [dict get $values fileB]" +# } +#}] +#[para]By using standard tcl proc named arguments prior to args, and setting *values -min 0 -max 0 +#[para]a Tk-style ordering can be acheived, where punk::args is only handling the trailing flags and the values element of the returned dict can be ignored +#[para]This use of leading positional arguments means the type validation features can't be applied to them. It can be done manually as usual, +#[para] or an additional call could be made to punk::args e.g +#[example { +# punk::args::get_dict { +# category -choices {cat1 cat2 cat3} +# another_leading_arg -type boolean +# } [list $category $another_leading_arg] +#}] #*** !doctools #[subsection Notes] -#[para]There are alternative args parsing packages such as: +#[para]For internal functions not requiring features such as solo flags, prefix matching, type checking etc - a well crafted switch statement will be the fastest pure-tcl solution. +#[para] +#When functions are called often and/or in inner loops, a switch based solution generally makes the most sense. +#For functions that are part of an API a package may be more suitable. +#[para]The following example shows a switch-based solution that is highly performant (sub microsecond for the no-args case) +#[example { +# proc test_switch {args} { +# set opts [dict create\\ +# -return "object"\\ +# -frametype "heavy"\\ +# -show_edge 1\\ +# -show_seps 0\\ +# -x a\\ +# -y b\\ +# -z c\\ +# -1 1\\ +# -2 2\\ +# -3 3\\ +# ] +# foreach {k v} $args { +# switch -- $k { +# -return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 { +# dict set opts $k $v +# } +# default { +# error "unrecognised option '$k'. Known options [dict keys $opts]" +# } +# } +# } +# return $opts +# } +#}] +#[para]Note that the switch statement uses literals so that the compiler produces a jump-table for best performance. +#[para] +# Attempting to build the switch branch using the values from dict keys $opts will stop the jump table being built. +# To create the faster switch statement without repeating the key names, the proc body would need to be built using string map. +#[para]use punk::lib::show_jump_tables to verify that a jump table exists. +#[para]Nearly as performant due to the c-coded tcl::prefix::match function built into Tcl is the following example - which also allows shortened option names if they are unambiguous +#[example { +# proc test_prefix {args} { +# set opts [dict create\ +# -return string\ +# -frametype \uFFEF\ +# -show_edge \uFFEF\ +# -show_seps \uFFEF\ +# -x a\ +# -y b\ +# -z c\ +# -1 1\ +# -2 2\ +# -3 3\ +# ] +# if {[llength $args]} { +# set knownflags [dict keys $opts] +# } +# foreach {k v} $args { +# dict set opts [tcl::prefix::match -message "test_prefix option $k" $knownflags $k] $v +# } +# return $opts +# } +#}] +#[para]There are many alternative args parsing packages a few of which are listed here. #[list_begin enumerated] -#[enum]argp -#[enum]The tcllib set of TEPAM modules +#[enum]argp (pure tcl) +#[enum]parse_args (c implementation) +#[enum]argparse (pure tcl *) +#[enum]cmdline (pure tcl) +#[enum]opt (pure tcl) distributed with Tcl but considered deprecated +#[enum]The tcllib set of TEPAM modules (pure tcl) #[para]TEPAM requires an alternative procedure declaration syntax instead of proc - but has support for Tk and documentation generation. #[list_end] +#[para] (* c implementation planned/proposed) #[para]punk::args was designed initially without specific reference to TEPAM - and to handle some edge cases in specific projects where TEPAM wasn't suitable. #[para]In subsequent revisions of punk::args - some features were made to operate in a way that is similar to TEPAM - to avoid gratuitous differences where possible, but of course there are differences #[para]and those used TEPAM or mixing TEPAM and punk::args should take care to assess the differences. #[para]TEPAM is a mature solution and is widely available as it is included in tcllib. -#[para]Serious consideration should be given to using TEPAM if suitable for your project. +#[para]Serious consideration should be given to using TEPAM or one of the other packages, if suitable for your project. +#[para]punk::args is relatively performant for a pure-tcl package solution - with the parsing of the argument specification block occuring only on the first run - after which a cached version of the spec is used. +#[para]punk::args is not limited to procs. It can be used in apply or coroutine situations for example. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements @@ -134,414 +244,804 @@ namespace eval punk::args::class { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::args { - namespace export * - #variable xyz + namespace export {[a-z]*} + variable argspec_cache + variable argspecs + variable id_counter + set argspec_cache [dict create] + set argspecs [dict create] + set id_counter 0 #*** !doctools #[subsection {Namespace punk::args}] #[para] Core API functions for punk::args #[list_begin definitions] - - #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values - #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. - #only supports -flag val pairs, not solo options - #If an option is supplied multiple times - only the last value is used. - proc opts_values {optionspecs rawargs args} { - #*** !doctools - #[call [fun opts_values] [arg optionspecs] [arg rawargs] [opt {option value...}]] - #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values - #[para]Returns a dict of the form: opts values - #[para]ARGUMENTS: - #[list_begin arguments] - #[arg_def multiline-string optionspecs] - #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced - #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values - #[para]Each optionspec line must be of the form: - #[para]-optionname -key val -key2 val2... - #[para]where the valid keys for each option specification are: -default -type -range -choices -optional - #[arg_def list rawargs] - #[para] This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc - #[list_end] - #[para] - - #consider line-processing example below for we need info complete to determine record boundaries - #punk::args::opt_values { - # -opt1 -default {} - # -opt2 -default { - # etc - # } -multiple 1 - #} $args + proc Get_argspecs {optionspecs args} { + variable argspec_cache + variable argspecs + #ideally we would use a fast hash algorithm to produce a short key with low collision probability. + #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. + #review - check if there is a built-into-tcl way to do this quickly + #for now we will just key using the whole string + set cache_key $optionspecs + if {[dict exists $argspec_cache $cache_key]} { + return [dict get $argspec_cache $cache_key] + } set optionspecs [string map [list \r\n \n] $optionspecs] set optspec_defaults [dict create\ + -type string\ -optional 1\ -allow_ansi 1\ -validate_without_ansi 0\ -strip_ansi 0\ -nocase 0\ + -multiple 0\ ] - set required_opts [list] - set required_vals [list] + set valspec_defaults [dict create\ + -type string\ + -optional 0\ + -allow_ansi 1\ + -validate_without_ansi 0\ + -strip_ansi 0\ + -multiple 0\ + ] + #checks with no default + #-minlen -maxlen -range + + + #default -allow_ansi to 1 and -validate_without_ansi to 0 and -strip_ansi 0 - it takes time to strip ansi + #todo - detect if anything in the spec uses -allow_ansi 0, -validate_without_ansi 1 or -strip_ansi 1 and set a flag indicating if punk::ansi::ta::detect should be run on the argslist + set opt_required [list] + set val_required [list] set arg_info [dict create] - set defaults_dict_opts [dict create] - set defaults_dict_values [dict create] + set opt_defaults [dict create] + set opt_names [list] ;#defined opts + set val_defaults [dict create] + set opt_solos [list] #first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end - set value_names [list] + set val_names [list] set records [list] set linebuild "" - foreach rawline [split $optionspecs \n] { + + set linelist [split $optionspecs \n] + set lastindent "" + foreach ln $linelist { + if {[string trim $ln] eq ""} {continue} + regexp {(\s*).*} $ln _all lastindent + break ;#break at first non-empty + } + #puts "indent1:[ansistring VIEW $lastindent]" + set in_record 0 + foreach rawline $linelist { set recordsofar [string cat $linebuild $rawline] if {![info complete $recordsofar]} { - append linebuild [string trimleft $rawline] \n + #append linebuild [string trimleft $rawline] \n + if {$in_record} { + if {[string length $lastindent]} { + #trim only the whitespace corresponding to last indent - not all whitespace on left + if {[string first $lastindent $rawline] == 0} { + set trimmedline [string range $rawline [string length $lastindent] end] + append linebuild $trimmedline \n + } else { + append linebuild $rawline \n + } + } else { + append linebuild $rawline \n + } + } else { + set in_record 1 + regexp {(\s*).*} $rawline _all lastindent + #puts "indent: [ansistring VIEW -lf 1 $lastindent]" + #puts "indent from rawline:$rawline " + append linebuild $rawline \n + } } else { - lappend records [string cat $linebuild $rawline] + set in_record 0 + if {[string length $lastindent]} { + #trim only the whitespace corresponding to last indent - not all whitespace on left + if {[string first $lastindent $rawline] == 0} { + set trimmedline [string range $rawline [string length $lastindent] end] + append linebuild $trimmedline + } else { + append linebuild $rawline + } + } else { + append linebuild $rawline + } + lappend records $linebuild set linebuild "" } } - + set proc_info {} + set opt_any 0 + set val_min 0 + set val_max -1 ;#-1 for no limit + set spec_id "" foreach ln $records { set trimln [string trim $ln] switch -- [string index $trimln 0] { "" - # {continue} } - set argname [lindex $trimln 0] - set argspecs [lrange $trimln 1 end] - if {[string match -* $argname]} { + set linespecs [lassign $trimln argname] + if {$argname ne "*id" && [llength $linespecs] %2 != 0} { + error "punk::args::get_dict - bad optionspecs line for record '$argname' Remaining items on line must be in paired option-value format - received '$linespecs'" + } + set firstchar [string index $argname 0] + set secondchar [string index $argname 1] + if {$firstchar eq "*" && $secondchar ne "*"} { + set starspecs $linespecs + switch -- [string range $argname 1 end] { + id { + #id line must have single entry - a unique id assigned by the user - an id will be allocated if no id line present or the value is "auto" + if {[llength $starspecs] != 1} { + error "punk::args::Get_argspecs - *id line must have a single entry following *id." + } + if {$spec_id ne ""} { + #disallow duplicate *id line + error "punk::args::Get_argspecs - *id already set. Existing value $spec_id" + } + set spec_id $starspecs + } + proc { + #allow arbitrary + set proc_info $starspecs + } + opts { + foreach {k v} $starspecs { + switch -- $k { + -any - + -anyopts { + set opt_any $v + } + -minlen - -maxlen - -range - -choices - -choicelabels { + #review - only apply to certain types? + dict set optspec_defaults $k $v + } + -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + dict unset optspec_defaults $k + } + -type - + -optional - + -allow_ansi - + -validate_without_ansi - + -strip_ansi - + -multiple { + #allow overriding of defaults for options that occur later + dict set optspec_defaults $k $v + } + default { + error "punk::args::Get_argspecs - unrecognised key '$k' in *opts line. Known keys: -anyopts" + } + } + } + } + values { + foreach {k v} $starspecs { + switch -- $k { + -min - + -minvalues { + set val_min $v + } + -max - + -maxvalues { + set val_max $v + } + -minlen - -maxlen - -range - -choices - -choicelabels { + #review - only apply to certain types? + dict set valspec_defaults $k $v + } + -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + dict unset valspec_defaults $k + } + -type - + -allow_ansi - + -validate_without_ansi - + -strip_ansi - + -multiple { + dict set valspec_defaults $k $v + } + default { + error "punk::args::Get_argspecs - unrecognised key '$k' in *opts line. Known keys: -anyopts" + } + } + } + + } + default { + error "punk::args::Get_argspecs - unrecognised * line in. Expected *proc *opts or *values - use **name if paramname needs to be *name" + } + } + continue + } elseif {$firstchar eq "-"} { + set argspecs $linespecs dict set argspecs -ARGTYPE option + lappend opt_names $argname set is_opt 1 } else { + if {$firstchar eq "*"} { + #allow basic ** escaping for literal argname that begins with * + set argname [string range $argname 1 end] + } + set argspecs $linespecs dict set argspecs -ARGTYPE value - lappend value_names $argname + lappend val_names $argname set is_opt 0 } - if {[llength $argspecs] %2 != 0} { - error "punk::args::opts_values - bad optionspecs line for argument '$argname' Remaining items on line must be in paired option-value format - received '$argspecs'" - } - dict for {spec specval} $argspecs { + #assert - we only get here if it is a value or flag specification line. + #assert argspecs has been set to the value of linespecs + set merged $optspec_defaults + foreach {spec specval} $argspecs { #literal-key switch - bytecompiled to jumpTable switch -- $spec { - -default - -type - -range - -choices - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -ARGTYPE {} + -type { + #normalize here so we don't have to test during actual args parsing in main function + switch -- [string tolower $specval] { + int - integer { + dict set merged -type int + } + bool - boolean { + dict set merged -type bool + } + char - character { + dict set merged -type char + } + "" - none { + if {$is_opt} { + dict set merged -type none + dict set merged -default 0 ;#-default 0 can still be overridden if -default appears after -type - we'll allow it. + lappend opt_solos $argname + } else { + #-solo only valid for flags + error "punk::args::get_dict - invalid -type 'none' for positional argument positional argument '$argname'" + } + } + default { + dict set merged -type [string tolower $specval] + } + } + } + -default - -solo - -range - -choices - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -help - -ARGTYPE { + dict set merged $spec $specval + } default { - set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi] - error "punk::args::opts_values - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" + set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -help] + error "punk::args::get_dict - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } } } - set argspecs [dict merge $optspec_defaults $argspecs] - dict set arg_info $argname $argspecs + set argspecs $merged + #if {$is_opt} { + set argchecks [dict remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen + #} else { + # set argchecks [dict remove $argspecs -type -default -multiple -strip_ansi -validate_without_ansi -allow_ansi] ;#leave things like -range -minlen + #} + dict set arg_info $argname $argspecs + dict set arg_checks $argname $argchecks if {![dict get $argspecs -optional]} { if {$is_opt} { - lappend required_opts $argname + lappend opt_required $argname } else { - lappend required_vals $argname + lappend val_required $argname } } - if {[dict exists $arg_info $argname -default]} { + if {[dict exists $argspecs -default]} { if {$is_opt} { - dict set defaults_dict_opts $argname [dict get $arg_info $argname -default] + dict set opt_defaults $argname [dict get $argspecs -default] } else { - dict set defaults_dict_values $argname [dict get $arg_info $argname -default] + dict set val_defaults $argname [dict get $argspecs -default] } } } - #puts "--> [info frame -2] <--" - set cmdinfo [dict get [info frame -2] cmd] - #we can't treat cmdinfo as a list - it may be something like {command {*}$args} in which case lindex $cmdinfo 0 won't work - #hopefully first word is a plain proc name if this function was called in the normal manner - directly from a proc - #we will break at first space and assume the lhs of that will give enough info to be reasonable - (alternatively we could use entire cmdinfo - but it might be big and ugly) - set caller [regexp -inline {\S+} $cmdinfo] + #confirm any valnames before last don't have -multiple key + foreach valname [lrange $val_names 0 end-1] { + if {[dict get $arg_info $valname -multiple]} { + error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" + } + } + if {$spec_id eq "" || [string tolower $spec_id] eq "auto"} { + variable id_counter + set spec_id "autoid_[incr id_counter]" + } + + set result [dict create\ + id $spec_id\ + arg_info $arg_info\ + arg_checks $arg_checks\ + opt_defaults $opt_defaults\ + opt_required $opt_required\ + opt_names $opt_names\ + opt_any $opt_any\ + opt_solos $opt_solos\ + optspec_defaults $optspec_defaults\ + valspec_defaults $valspec_defaults\ + val_defaults $val_defaults\ + val_required $val_required\ + val_names $val_names\ + val_min $val_min\ + val_max $val_max\ + valspec_defaults $valspec_defaults\ + proc_info $proc_info\ + ] + dict set argspec_cache $cache_key $result + dict set argspecs $spec_id $optionspecs + return $result + } + + proc get_spec {id} { + variable argspecs + if {[dict exists $argspecs $id]} { + return [dict get $argspecs $id] + } + return + } + proc get_spec_ids {{match *}} { + variable argspecs + return [dict keys $argspecs $match] + } - #if called from commandline or some other contexts such as outside of a proc in a namespace - caller may just be "namespace" + #for use within get_dict only + #This mechanism gets less-than-useful results for oo methods + #e.g {$obj} + proc Get_caller {} { + set cmdinfo [dict get [info frame -3] cmd] + #puts "-->$cmdinfo" + set caller [regexp -inline {\S+} $cmdinfo] if {$caller eq "namespace"} { - set caller "punk::args::opts_values called from namespace" + set caller "punk::args::get_dict called from namespace" } + return $caller + } - # ------------------------------ - if {$caller ne "punk::args::opts_values"} { - #check our own args - lassign [punk::args::opts_values "-anyopts -default 0\n -minvalues -default 0\n -maxvalues -default -1" $args] _o ownopts _v ownvalues - if {[llength $ownvalues] > 0} { - error "punk::args::opts_values expected: a multiline text block of option-specifications, a list of args and at most three option pairs -minvalues , -maxvalues , -anyopts true|false - got extra arguments: '$ownvalues'" - } - set opt_minvalues [dict get $ownopts -minvalues] - set opt_maxvalues [dict get $ownopts -maxvalues] - set opt_anyopts [dict get $ownopts -anyopts] + proc err {msg args} { + + } + + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values + #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. + #only supports -flag val pairs, not solo options + #If an option is supplied multiple times - only the last value is used. + proc get_dict {optionspecs args} { + #*** !doctools + #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values + #[para]Returns a dict of the form: opts values + #[para]ARGUMENTS: + #[list_begin arguments] + #[arg_def multiline-string optionspecs] + #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced + #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values + #[para]Each optionspec line defining a flag must be of the form: + #[para]-optionname -key val -key2 val2... + #[para]where the valid keys for each option specification are: -default -type -range -choices -optional + #[para]Each optionspec line defining a positional argument is of the form: + #[para]argumentname -key val -ky2 val2... + #[para]where the valid keys for each option specification are: -default -type -range -choices + #[para]comment lines begining with # are ignored and can be placed anywhere except within a multiline value where it would become part of that value + #[para]lines beginning with *proc *opts or *values also take -key val pairs and can be used to set defaults and control settings. + #[para]*opts or *values lines can appear multiple times with defaults affecting flags/values that follow. + #[arg_def list rawargs] + #[para] This is a list of the arguments to parse. Usually it will be the $args value from the containing proc, + #but it could be a manually constructed list of values made for example from positional args defined in the proc. + #[list_end] + #[para] + + #consider line-processing example below for which we need info complete to determine record boundaries + #punk::args::get_dict { + # *opts + # -opt1 -default {} + # -opt2 -default { + # etc + # } + # *values -multiple 1 + #} $args + + if {[llength $args] == 0} { + set rawargs [list] + } elseif {[llength $args] ==1} { + set rawargs [lindex $args 0] ;#default tcl style } else { - #don't check our own args if we called ourself - set opt_minvalues 0 - set opt_maxvalues 0 - set opt_anyopts 0 + #todo - can we support tk style vals before flags? + #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + error "unsupported" + set inopt 0 + set k "" + set i 0 + foreach a $args { + switch -- $f { + -opts { + + } + -vals { + + } + -optvals { + #tk style + + } + -valopts { + #tcl style + set rawargs [lindex $args $i+1] + incr i + } + default { + + } + } + incr i + } } - # ------------------------------ - if {[set eopts [lsearch $rawargs "--"]] >= 0} { + + set argspecs [Get_argspecs $optionspecs] + dict with argspecs {} ;#turn keys into vars + #puts "-arg_info->$arg_info" + set flagsreceived [list] + + set opts $opt_defaults + if {[set eopts [lsearch -exact $rawargs "--"]] >= 0} { set values [lrange $rawargs $eopts+1 end] set arglist [lrange $rawargs 0 $eopts-1] + set maxidx [expr {[llength $arglist]-1}] + for {set i 0} {$i <= $maxidx} {incr i} { + set a [lindex $arglist $i] + if {![string match -* $a]} { + #we can't treat as first positional arg - as it comes before the eopt indicator -- + error "punk::args::get_dict bad options for [Get_caller]. Expected flag (leading -) at position $i got:$rawargs" + } + #TODO! + if {[dict get $arg_info $a -type] ne "none"} { + if {[incr i] > $maxidx} { + error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $a which is not marked with -solo 1" + } + } + lappend flagsreceived $a ;#dups ok + } } else { if {[lsearch $rawargs -*] >= 0} { - #to support option values with leading dash e.g -offset -1 , we can't just take the last flagindex - set i 0 - foreach {k v} $rawargs { - if {![string match -* $k]} { + #no -- end of opts indicator + #to support option values with leading dash e.g -offset -1 , we can't just use the last flagindex to determine start of positional args. + #we break on first non-flag looking argument that isn't in an option's value position and use that index as the division. + #The caller should use -- if the first positional arg is likely or has the potential to start with a dash. + + set maxidx [expr {[llength $rawargs]-1}] + for {set i 0} {$i <= $maxidx} {incr i} { + set a [lindex $rawargs $i] + if {![string match -* $a]} { + #assume beginning of positional args + incr i -1 break - } - if {$i+1 >= [llength $rawargs]} { - #no value for last flag - error "bad options for $caller. No value supplied for last option $k" } - incr i 2 + + if {![catch {tcl::prefix match -message "options for %caller%. Unexpected option" $opt_names $a } fullopt]} { + if {[dict get $arg_info $fullopt -type] ne "none"} { + #non-solo + set flagval [lindex $rawargs $i+1] + if {[dict get $arg_info $fullopt -multiple]} { + dict lappend opts $fullopt $flagval + } else { + dict set opts $fullopt $flagval + } + #incr i to skip flagval + if {[incr i] > $maxidx} { + error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" + } + } else { + #type none (solo-flag) + if {[dict get $arg_info $fullopt -multiple]} { + if {[dict get $opts $fullopt] == 0} { + #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + dict set opts $fullopt 1 + } else { + dict lappend opts $fullopt 1 + } + } else { + dict set opts $fullopt 1 + } + } + lappend flagsreceived $fullopt ;#dups ok + } else { + if {$opt_any} { + set newval [lindex $rawargs $i+1] + #opt was unspecified but is allowed due to *opt -any 1 - 'adhoc/passthrough' option + dict set arg_info $a $optspec_defaults ;#use default settings for unspecified opt + if {[dict get $arg_info $a -type] ne "none"} { + if {[dict get $arg_info $a -multiple]} { + dict lappend opts $a $newval + } else { + dict set opts $a $newval + } + lappend flagsreceived $a ;#adhoc flag as supplied + if {[incr i] > $maxidx} { + error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" + } + } else { + #review -we can't provide a way to allow unspecified -type none flags through reliably/unambiguously unless all remaining unspecified options are -type none + if {[dict get $arg_info $a -multiple]} { + if {![dict exists $opts $a]} { + dict set opts $a 1 + } else { + dict lappend opts $a 1 + } + } else { + dict set opts $a 1 + } + } + } else { + #delay Get_caller so only called in the unhappy path + set errmsg [string map [list %caller% [Get_caller]] $fullopt] + error $errmsg + } + } } - set arglist [lrange $rawargs 0 $i-1] - set values [lrange $rawargs $i end] + set arglist [lrange $rawargs 0 $i] + set values [lrange $rawargs $i+1 end] + #puts "$i--->arglist:$arglist" + #puts "$i--->values:$values" } else { set values $rawargs ;#no -flags detected set arglist [list] } } - #confirm any valnames before last don't have -multiple key - foreach valname [lrange $value_names 0 end-1] { - if {[dict exists $arg_info $valname -multiple ]} { - error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" - } - } - set values_dict [dict create] set validx 0 set in_multiple "" - foreach valname $value_names val $values { - if {$validx+1 > [llength $values]} { + set valnames_received [list] + set values_dict $val_defaults + set num_values [llength $values] + foreach valname $val_names val $values { + if {$validx+1 > $num_values} { break } if {$valname ne ""} { - if {[dict exists $arg_info $valname -multiple] && [dict get $arg_info $valname -multiple]} { + if {[dict get $arg_info $valname -multiple]} { dict lappend values_dict $valname $val set in_multiple $valname } else { dict set values_dict $valname $val } + lappend valnames_received $valname } else { if {$in_multiple ne ""} { dict lappend values_dict $in_multiple $val + #name already seen } else { dict set values_dict $validx $val + dict set arg_info $validx $valspec_defaults + lappend valnames_received $validx } } incr validx } - if {$opt_maxvalues == -1} { + if {$val_max == -1} { #only check min - if {[llength $values] < $opt_minvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected at least $opt_minvalues" + if {$num_values < $val_min} { + error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected at least $val_min" } } else { - if {[llength $values] < $opt_minvalues || [llength $values] > $opt_maxvalues} { - if {$opt_minvalues == $opt_maxvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected exactly $opt_minvalues" + if {$num_values < $val_min || $num_values > $val_max} { + if {$val_min == $val_max} { + error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected exactly $val_min" } else { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected between $opt_minvalues and $opt_maxvalues inclusive" + error "bad number of trailing values for [Get_caller]. Got $num_values values. Expected between $val_min and $val_max inclusive" } } } + + #assertion - opts keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options + + #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - foreach r $required_opts { - if {$r ni [dict keys $arglist]} { - error "Required option missing for $caller. '$r' is marked with -optional false - so must be present in its full-length form" - } + if {[llength [set missing [struct::set difference $opt_required $flagsreceived]]]} { + error "Required option missing for [Get_caller]. missing flags $missing are marked with -optional false - so must be present in full-length form" } - foreach r $required_vals { - if {$r ni [dict keys $values_dict]} { - error "Required value missing for $caller. '$r' is marked with -optional false - so must be present" - } - } - if {!$opt_anyopts} { - set checked_args [dict create] - for {set i 0} {$i < [llength $arglist]} {incr i} { - #allow this to error out with message indicating expected flags - set val [lindex $arglist $i+1] - set fullopt [tcl::prefix match -message "options for $caller. Unexpected option" [dict keys $arg_info] [lindex $arglist $i]] - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $val - } else { - dict set checked_args $fullopt $val - } - incr i ;#skip val - } - } else { - #still need to use tcl::prefix match to normalize - but don't raise an error - set checked_args [dict create] - dict for {k v} $arglist { - if {![catch {tcl::prefix::match [dict keys $arg_info] $k} fullopt]} { - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $v - } else { - dict set checked_args $fullopt $v - } - } else { - #opt was unspecified - dict set checked_args $k $v - } - } + if {[llength [set missing [struct::set difference $val_required $valnames_received]]]} { + error "Required value missing for [Get_caller]. missing values $missing marked with -optional false - so must be present" } - set opts [dict merge $defaults_dict_opts $checked_args] - #assertion - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options - - set values [dict merge $defaults_dict_values $values_dict] - #todo - allow defaults outside of choices/ranges #check types,ranges,choices - set opts_and_values [concat $opts $values] - set combined_defaults [concat $defaults_dict_values $defaults_dict_opts] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash - dict for {o v} $opts_and_values { - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - set vlist $v - } else { - set vlist [list $v] + set opts_and_values [dict merge $opts $values_dict] + #set combined_defaults [dict merge $val_defaults $opt_defaults] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash + #puts "---opts_and_values:$opts_and_values" + #puts "---arg_info:$arg_info" + dict for {argname v} $opts_and_values { + set thisarg [dict get $arg_info $argname] + #set thisarg_keys [dict keys $thisarg] + set thisarg_checks [dict get $arg_checks $argname] + set is_multiple [dict get $thisarg -multiple] + set is_allow_ansi [dict get $thisarg -allow_ansi] + set is_validate_without_ansi [dict get $thisarg -validate_without_ansi] + set is_strip_ansi [dict get $thisarg -strip_ansi] + set has_default [dict exists $thisarg -default] + if {$has_default} { + set defaultval [dict get $thisarg -default] } + set type [dict get $thisarg -type] + set has_choices [dict exists $thisarg -choices] - if {[dict exists $arg_info $o -validate_without_ansi] && [dict get $arg_info $o -validate_without_ansi]} { - set validate_without_ansi 1 - package require punk::ansi + if {$is_multiple} { + set vlist $v } else { - set validate_without_ansi 0 + set vlist [list $v] } - if {[dict exists $arg_info $o -allow_ansi] && [dict get $arg_info $o -allow_ansi]} { - set allow_ansi 1 - } else { + if {!$is_allow_ansi} { + #allow_ansi 0 package require punk::ansi - set allow_ansi 0 - } - - foreach e $vlist { - if {!$allow_ansi} { + foreach e $vlist { if {[punk::ansi::ta::detect $e]} { - error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'" + error "Option $argname for [Get_caller] contains ansi - but -allow_ansi is false. Received: '$e'" } } } - - set vlist_check [list] - foreach e $vlist { - if {$validate_without_ansi} { + if {$is_validate_without_ansi} { + #validate_without_ansi 1 + package require punk::ansi + set vlist_check [list] + foreach e $vlist { lappend vlist_check [punk::ansi::stripansi $e] - } else { - lappend vlist_check $e - } + } + } else { + #validate_without_ansi 0 + set vlist_check $vlist } set is_default 0 - foreach e $vlist e_check $vlist_check { - if {[dict exists $combined_defaults $o] && ($e_check eq [dict get $combined_defaults $o])} { - incr is_default + if {$has_default} { + foreach e_check $vlist_check { + if {$e_check eq $defaultval} { + incr is_default + } + } + if {$is_default eq [llength $vlist]} { + set is_default 1 } } - if {$is_default eq [llength $vlist]} { - set is_default true - } + #puts "argname:$argname v:$v is_default:$is_default" #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. - if {!$is_default} { - if {[dict exists $arg_info $o -type]} { - set type [dict get $arg_info $o -type] - switch -- [string tolower $type] { - int - - integer - - double { - if {[string tolower $type] in {int integer}} { - foreach e $vlist e_check $vlist_check { - if {![string is integer -strict $e_check]} { - error "Option $o for $caller requires type 'integer'. Received: '$e'" - } - } - } elseif {[string tolower $type] in {double}} { - foreach e $vlist e_check $vlist_check { - if {![string is double -strict $e_check]} { - error "Option $o for $caller requires type 'double'. Received: '$e'" - } - } - } - - #todo - small-value double comparisons with error-margin? review - if {[dict exists $arg_info $o -range]} { - lassign [dict get $arg_info $o -range] low high - foreach e $vlist e_check $vlist_check { - if {$e_check < $low || $e_check > $high} { - error "Option $o for $caller must be between $low and $high. Received: '$e'" + if {$is_default == 0} { + switch -- $type { + any {} + string { + if {[dict size $thisarg_checks]} { + foreach e_check $vlist_check { + dict for {checkopt checkval} $thisarg_checks { + switch -- $checkopt { + -minlen { + # -1 for disable is as good as zero + if {[string length $e_check] < $checkval} { + error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[string length $e_check] value:'$e_check'" + } + } + -maxlen { + if {$checkval ne "-1"} { + if {[string length $e_check] > $checkval} { + error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[string length $e_check] value:'$e_check'" + } + } + } } } } } - bool - - boolean { + } + ansistring { + package require ansi + } + int { + if {[dict exists $thisarg -range]} { + lassign [dict get $thisarg -range] low high foreach e $vlist e_check $vlist_check { - if {![string is boolean -strict $e_check]} { - error "Option $o for $caller requires type 'boolean'. Received: '$e'" + if {![string is integer -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" + } + if {$e_check < $low || $e_check > $high} { + error "Option $argname for [Get_caller] must be integer between $low and $high. Received: '$e'" } } + } else { + foreach e_check $vlist_check { + if {![string is integer -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" + } + } } - alnum - - alpha - - ascii - - control - - digit - - graph - - lower - - print - - punct - - space - - upper - - wordchar - - xdigit { - foreach e $vlist e_check $vlist_check { - if {![string is [string tolower $type] $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e'" + } + double { + foreach e $vlist e_check $vlist_check { + if {![string is double -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'double'. Received: '$e'" + } + if {[dict size $thisarg_checks]} { + dict for {checkopt checkval} $thisarg_checks { + switch -- $checkopt { + -range { + #todo - small-value double comparisons with error-margin? review + lassign $checkval low high + if {$e_check < $low || $e_check > $high} { + error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" + } + } + } } } } - file - - directory - - existingfile - - existingdirectory { + } + bool { + foreach e_check $vlist_check { + if {![string is boolean -strict $e_check]} { + error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" + } + } + } + alnum - + alpha - + ascii - + control - + digit - + graph - + lower - + print - + punct - + space - + upper - + wordchar - + xdigit { + foreach e $vlist e_check $vlist_check { + if {![string is $type $e_check]} { + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" + } + } + } + file - + directory - + existingfile - + existingdirectory { + foreach e $vlist e_check $vlist_check { + if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { + #what about special file names e.g on windows NUL ? + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" + } + } + if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { - if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which doesn't look like it could be a file or directory" + if {![file exists $e_check]} { + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" } } - if {[string tolower $type] in {existingfile}} { - foreach e $vlist e_check $vlist_check { - if {![file exists $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing file" - } - } - } elseif {[string tolower $type] in {existingdirectory}} { - foreach e $vlist e_check $vlist_check { - if {![file isdirectory $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing directory" - } + } elseif {$type eq "existingdirectory"} { + foreach e $vlist e_check $vlist_check { + if {![file isdirectory $e_check]} { + error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" } } } - char - - character { - foreach e $vlist e_check $vlist_check { - if {[string length != 1]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not a single character" - } + } + char { + foreach e $vlist e_check $vlist_check { + if {[string length $e_check] != 1} { + error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" } } } } - if {[dict exists $arg_info $o -choices]} { - set choices [dict get $arg_info $o -choices] - set nocase [dict get $arg_info $o -nocase] + if {$has_choices} { + #todo -choicelabels + set choices [dict get $thisarg -choices] + set nocase [dict get $thisarg -nocase] foreach e $vlist e_check $vlist_check { if {$nocase} { set casemsg "(case insensitive)" @@ -553,34 +1053,31 @@ namespace eval punk::args { set choices_test $choices } if {$v_test ni $choices_test} { - error "Option $o for $caller must be one of the listed values $choices $casemsg. Received: '$e'" + error "Option $argname for [Get_caller] must be one of the listed values $choices $casemsg. Received: '$e'" } } } } - if {[dict exists $arg_info $o -strip_ansi] && [dict get $arg_info $o -strip_ansi]} { - set stripped_list [list] - foreach e $vlist { - lappend stripped_list [punk::ansi::stripansi $e] - } - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o $stripped_list + if {$is_strip_ansi} { + set stripped_list [lmap e $vlist {punk::ansi::stripansi $e}] ;#no faster or slower, but more concise than foreach + if {[dict get $thisarg -multiple]} { + if {[dict get $thisarg -ARGTYPE] eq "option"} { + dict set opts $argname $stripped_list } else { - dict set values $o $stripped_list + dict set values_dict $argname $stripped_list } } else { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o [lindex $stripped_list 0] + if {[dict get $thisarg -ARGTYPE] eq "option"} { + dict set opts $argname [lindex $stripped_list 0] } else { - dict set values [lindex $stripped_list 0] + dict set values_dict [lindex $stripped_list 0] } } } } #maintain order of opts $opts values $values as caller may use lassign. - return [dict create opts $opts values $values] + return [dict create opts $opts values $values_dict] } #proc sample1 {p1 args} { diff --git a/src/modules/punk/basictelnet-999999.0a1.0.tm b/src/modules/punk/basictelnet-999999.0a1.0.tm index bb8cc27..70a01f0 100644 --- a/src/modules/punk/basictelnet-999999.0a1.0.tm +++ b/src/modules/punk/basictelnet-999999.0a1.0.tm @@ -45,7 +45,7 @@ #[para] packages used by punk::basictelnet #[list_begin itemized] -package require Tcl 8.6 +package require Tcl 8.6- #*** !doctools #[item] [package {Tcl 8.6}] @@ -492,6 +492,8 @@ namespace eval punk::basictelnet { proc toServer {sock} { variable server_option_state variable encoding_guess + #note that this punk::console namespace is likely to be in a different thread (codethread) to the punk::repl thread which will have it's own punk::console namespace + # - even though they may both be using the same stdin stdout. The repl readloop will be inactive during the call to telnet upvar ::punk::console::input_chunks_waiting input_chunks_waiting set nextwaiting "" @@ -821,6 +823,7 @@ namespace eval punk::basictelnet { catch {fileevent $sock readable {}} catch {close $sock} set closed($sock) 1 + fileevent stdin readable {} } proc write string { diff --git a/src/modules/punk/cap-999999.0a1.0.tm b/src/modules/punk/cap-999999.0a1.0.tm index 9d62ac1..7a3cf2a 100644 --- a/src/modules/punk/cap-999999.0a1.0.tm +++ b/src/modules/punk/cap-999999.0a1.0.tm @@ -350,15 +350,19 @@ namespace eval punk::cap { variable pkgcapsdeclared variable pkgcapsaccepted variable caps - set defaults [dict create\ + set opts [dict create\ -nowarnings false ] - dict for {k v} $args { - if {$k ni $defaults} { - error "Unrecognized option $k. Known options [dict keys $defaults]" + foreach {k v} $args { + switch -- $k { + -nowarnings { + dict set opts $k $v + } + default { + error "Unrecognized option $k. Known options [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] set warnings [expr {! [dict get $opts -nowarnings]}] if {[string match ::* $pkg]} { @@ -433,13 +437,14 @@ namespace eval punk::cap { #another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append - but check not already present #dict lappend pkgcapsdeclared $pkg $capabilitylist if {[dict exists $pkgcapsdeclared $pkg]} { - set capspecs [dict get $pkgcapsdeclared $pkg] - foreach spec $capspecs { - if {$spec ni $capspecs} { - lappend capspecs $spec + #review - untested + set mergecapspecs [dict get $pkgcapsdeclared $pkg] + foreach spec $capabilitylist { + if {$spec ni $mergecapspecs} { + lappend mergecapspecs $spec } } - dict set pkgcapsdeclared $pkg $capspecs + dict set pkgcapsdeclared $pkg $mergecapspecs } else { dict set pkgcapsdeclared $pkg $capabilitylist } diff --git a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm index 1b4509a..9646ed7 100644 --- a/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm +++ b/src/modules/punk/cap/handlers/templates-999999.0a1.0.tm @@ -242,9 +242,12 @@ namespace eval punk::cap::handlers::templates { set capabilityname $capname } method folders {args} { - lassign [punk::args::opts_values { + set argd [punk::args::get_dict { -startdir -default "" - } $args -maxvalues 0] _o opts + *values -max 0 + } $args] + set opts [dict get $argd opts] + set opt_startdir [dict get $opts -startdir] if {$opt_startdir eq ""} { set startdir [pwd] @@ -456,11 +459,14 @@ namespace eval punk::cap::handlers::templates { return $folderdict } method get_itemdict_projectlayouts {args} { - lassign [punk::args::opts_values { - -startdir -default "" + set argd [punk::args::get_dict { + *opts -anyopts 1 #peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here - } $args -maxvalues -1 -anyopts 1] _o opts _v values - set opt_startdir [dict get $opts -startdir] + -startdir -default "" + *values -maxvalues -1 + } $args] + set opt_startdir [dict get $argd opts -startdir] + if {$opt_startdir eq ""} { set searchbase [pwd] } else { @@ -628,15 +634,18 @@ namespace eval punk::cap::handlers::templates { #and a file selection mechanism command -command_get_items_from_base #and a name determining command -command_get_item_name method _get_itemdict {args} { - lassign [punk::args::opts_values { - -startdir -default "" - -templatefolder_subdir -optional 0 - -command_get_items_from_base -optional 0 - -command_get_item_name -optional 0 - -not -default "" -multiple 1 + set argd [punk::args::get_dict { + *opts -anyopts 0 + -startdir -default "" + -templatefolder_subdir -optional 0 + -command_get_items_from_base -optional 0 + -command_get_item_name -optional 0 + -not -default "" -multiple 1 + *values -maxvalues -1 globsearches -default * -multiple 1 - } $args -maxvalues -1] _o opts _v values - set globsearches [dict get $values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results + } $args] + set opts [dict get $argd opts] + set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results # -- --- --- --- --- --- --- --- --- set opt_startdir [dict get $opts -startdir] set opt_templatefolder_subdir [dict get $opts -templatefolder_subdir] diff --git a/src/modules/punk/char-999999.0a1.0.tm b/src/modules/punk/char-999999.0a1.0.tm index f36a2db..65be28a 100644 --- a/src/modules/punk/char-999999.0a1.0.tm +++ b/src/modules/punk/char-999999.0a1.0.tm @@ -1205,22 +1205,25 @@ namespace eval punk::char { } proc char_info_dec {dec args} { set dec_char [expr {$dec}] - set defaults [dict create\ + set opts [dict create\ -fields {default}\ -except {}\ ] - set known_opts [dict keys $defaults] #testwidth is so named because it peforms an actual test on the console using ansi escapes - and the name gives a hint that it is a little slow set known_fields [list all default dec hex desc short testwidth char memberof] ;#maint fields from charinfo 'desc' 'short' #todo - unicode properties # tclwhitespace (different to unicode concept of whitespace. review ) foreach {k v} $args { - if {![dict exists $defaults $k]} { - error "char_info unrecognised option '$k'. Known options:'$known_opts' known_fields: $known_fields usage: char_info ?-fields {}? ?-except {}?" + switch -- $k { + -fields - -except { + dict set opts $k $v + } + default { + error "char_info unrecognised option '$k'. Known options:'[dict keys $opts]' known_fields: $known_fields usage: char_info ?-fields {}? ?-except {}?" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- set opt_fields [dict get $opts -fields] set opt_except [dict get $opts -except] @@ -1569,6 +1572,7 @@ namespace eval punk::char { if {$name_or_glob eq "*"} { return [lsort [dict keys $charsets]] } + #dict keys $dict doesn't have option for case insensitive searches return [lsort [lsearch -all -inline -nocase [dict keys $charsets] $name_or_glob]] } } diff --git a/src/modules/punk/config-0.1.tm b/src/modules/punk/config-0.1.tm index 2b6c496..d7562ff 100644 --- a/src/modules/punk/config-0.1.tm +++ b/src/modules/punk/config-0.1.tm @@ -47,15 +47,24 @@ namespace eval punk::config { #default file logs to logs folder at same location as exe if writable, or empty string dict set startup logfile_stdout "" dict set startup logfile_stderr "" - set exefolder [file dirname [info nameofexecutable]] - set log_folder $exefolder/logs - dict set startup scriptlib $exefolder/scriptlib - dict set startup apps $exefolder/../../punkapps - if {[file exists $log_folder]} { - if {[file isdirectory $log_folder] && [file writable $log_folder]} { - dict set startup logfile_stdout $log_folder/repl-exec-stdout.txt - dict set startup logfile_stderr $log_folder/repl-exec-stderr.txt + + set exename [info nameofexecutable] + if {$exename ne ""} { + set exefolder [file dirname [info nameofexecutable]] + set log_folder $exefolder/logs + dict set startup scriptlib $exefolder/scriptlib + dict set startup apps $exefolder/../../punkapps + if {[file exists $log_folder]} { + if {[file isdirectory $log_folder] && [file writable $log_folder]} { + dict set startup logfile_stdout $log_folder/repl-exec-stdout.txt + dict set startup logfile_stderr $log_folder/repl-exec-stderr.txt + } } + } else { + #probably a safe interp - which cannot access info nameofexecutable even if access given to the location via punk::island + #review - todo? + dict set startup scriptlib "" + dict set startup apps "" } diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 5589468..7be0509 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -671,7 +671,7 @@ namespace eval punk::console { } else { #! todo? for now, emit a clue as to what's happening. puts stderr "[punk::ansi::a+ yellow bold]-->punk::console::get_ansi_response_payload cannot trigger existing handler $existing_handler while over-read data is in punk::console::input_chunks_waiting($input) instead of channel [ansistring VIEW $input_chunks_waiting($input)][punk::ansi::a]" - if {$::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[eof $input]} { puts stdout "restarting repl" repl::reopen_stdin @@ -682,7 +682,7 @@ namespace eval punk::console { #Note - we still may be in_repl_handler here (which disables its own reader while executing commandlines) #The input_chunks_waiting may really belong to the existing_handler we found - but if it doesn't consume them they will end up being read by the repl_handler when it eventually re-enables. #todo - some better structure than just a list of waiting chunks indexed by input channel, so repl/other handlers can determine the context in which these waiting chunks were generated? - } elseif {$::repl::running} { + } elseif {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[llength $input_chunks_waiting($input)]} { #don't trigger the repl handler manually - we will inevitably get things out of order - as it knows when to enable/disable itself based on whether chunks are waiting. #triggering it by putting it on the eventloop will potentially result in re-entrancy @@ -1030,10 +1030,29 @@ namespace eval punk::console { #todo - determine cursor on/off state before the call to restore properly. May only be possible proc get_size {{inoutchannels {stdin stdout}}} { lassign $inoutchannels in out + #we can't reliably use [chan names] for stdin,stdout. There could be stacked channels and they may have a names such as file22fb27fe810 + #chan eof is faster whether chan exists or not than + if {[catch {chan eof $in} is_eof]} { + error "punk::console::get_size input channel $in seems to be closed ([info level 1])" + } else { + if {$is_eof} { + error "punk::console::get_size eof on input channel $in ([info level 1])" + } + } + if {[catch {chan eof $out} is_eof]} { + error "punk::console::get_size output channel $out seems to be closed ([info level 1])" + } else { + if {$is_eof} { + error "punk::console::get_size eof on output channel $out ([info level 1])" + } + } + + #keep out of catch - no point in even trying a restore move if we can't get start position - just fail here. + lassign [get_cursor_pos_list $inoutchannels] start_row start_col + if {[catch { #some terminals (conemu on windows) scroll the viewport when we make a big move down like this - a move to 1 1 immediately after cursor_save doesn't seem to fix that. #This issue also occurs when switching back from the alternate screen buffer - so perhaps that needs to be addressed elsewhere. - lassign [get_cursor_pos_list $inoutchannels] start_row start_col puts -nonewline $out [punk::ansi::cursor_off][punk::ansi::move 2000 2000] lassign [get_cursor_pos_list $inoutchannels] lines cols puts -nonewline $out [punk::ansi::move $start_row $start_col][punk::console::cursor_on];flush stdout @@ -1251,7 +1270,7 @@ namespace eval punk::console { return [exec {*}$cmd1] } else { puts stderr "infocmp doesn't seem to be present" - if {$::tcl_platform(os) eq "FreeBSD"} { + if {$::tcl_platform(platform) eq "FreeBSD"} { puts stderr "For FreeBSD - install ncurses to get infocmp and related binaries and also install terminfo-db" } set tcmd [auto_execok tput] @@ -1395,6 +1414,9 @@ namespace eval punk::console { namespace import ansi::insert_lines namespace import ansi::delete_lines + interp alias {} smcup {} ::punk::console::enable_alt_screen + interp alias {} rmcup {} ::punk::console::disable_alt_screen + #experimental proc rhs_prompt {col text} { package require textblock @@ -1784,11 +1806,13 @@ namespace eval punk::console { - - - - - +interp alias {} colour {} punk::console::colour +interp alias {} ansi {} punk::console::ansi +interp alias {} color {} punk::console::colour +interp alias {} a+ {} punk::console::code_a+ +interp alias {} a= {} punk::console::code_a +interp alias {} a {} punk::console::code_a +interp alias {} a? {} punk::console::code_a? diff --git a/src/modules/punk/du-999999.0a1.0.tm b/src/modules/punk/du-999999.0a1.0.tm index 188a359..3470774 100644 --- a/src/modules/punk/du-999999.0a1.0.tm +++ b/src/modules/punk/du-999999.0a1.0.tm @@ -25,8 +25,10 @@ namespace eval punk::du { variable has_twapi 0 } if {"windows" eq $::tcl_platform(platform)} { - package require zzzload - zzzload::pkg_require twapi + if {![interp issafe]} { + package require zzzload + zzzload::pkg_require twapi + } if {[catch {package require twapi}]} { puts stderr "Warning: punk::du - unable to load twapi. Disk operations may be much slower on windows without the twapi package" @@ -818,19 +820,22 @@ namespace eval punk::du { #this is the cross-platform pure-tcl version - which calls glob multiple times to make sure it gets everythign it needs and can ignore everything it needs to. #These repeated calls to glob will be a killer for performance - especially on a network share or when walking a large directory structure proc du_dirlisting_generic {folderpath args} { - set defaults [dict create\ + set opts [dict create\ -glob *\ -with_sizes 0\ -with_times 0\ ] set errors [dict create] - set known_opts [dict keys $defaults] - dict for {k -} $args { - if {$k ni $known_opts} { - error "du_dirlisting_generic unknown-option $k" + foreach {k v} $args { + switch -- $k { + -glob - -with_sizes - -with_times { + dict set opts $k $v + } + default { + error "du_dirlisting_generic unknown-option '$k'. Known-options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- diff --git a/src/modules/punk/fileline-999999.0a1.0.tm b/src/modules/punk/fileline-999999.0a1.0.tm index 5d33688..19cfed6 100644 --- a/src/modules/punk/fileline-999999.0a1.0.tm +++ b/src/modules/punk/fileline-999999.0a1.0.tm @@ -1,4 +1,4 @@ -# -*- tcl -*- +# -*- 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. @@ -275,7 +275,7 @@ namespace eval punk::fileline::class { #[call class::textinfo [method chunk_boundary_display]] #[para]Returns a string displaying the boundaries at chunksize bytes between chunkstart and chunkend #[para]Defaults to using ansi colour if punk::ansi module is available. Use -ansi 0 to disable colour - set defaults [dict create\ + set opts [dict create\ -ansi $::punk::fileline::ansi::enabled\ -offset 0\ -displaybytes 200\ @@ -292,11 +292,15 @@ namespace eval punk::fileline::class { ] set known_opts [dict keys $defaults] foreach {k v} $args { - if {$k ni $known_opts} { - error "[self]::chunk_boundary error: unknown option '$k'. Known options: $known_opts" + switch -- $k { + -ansi - -offset - -displaybytes - -truncatedmark - -completemark - -moremark - -continuemark - -linemaxwidth - -linebase - -limit - -boundaries - -showconfig - -boundaryheader { + dict set opts $k $v + } + default { + error "[self]::chunk_boundary error: unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- set opt_ansi [dict get $opts -ansi] set opt_offset [dict get $opts -offset] @@ -612,20 +616,23 @@ namespace eval punk::fileline::class { #[para]This is true even if only a single square bracket is being searched for. e.g {*[lb]file*} will not find the word file followed by a left square-bracket - even though the search didn't close the square brackets. #[para]In the above case - the literal search should be {*\[lb]file*} - set defaults [dict create\ + set opts [dict create\ -limit 0\ -strategy 1\ -start 0\ -end end\ -limitfrom start\ ] - set known_opts [dict keys $defaults] - dict for {k v} $args { - if {$k ni $known_opts} { - error "linepayload_find_glob unknown option '$k'. Known options: $known_opts" + foreach {k v} $args { + switch -- $k { + -limit - -strategy - -start - -end - -limitfrom { + dict set opts $k $v + } + default { + error "linepayload_find_glob unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_limit [dict get $opts -limit] if {![string is integer -strict $opt_limit] || $opt_limit < 0} { @@ -1261,13 +1268,14 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding binary if this isn't suitable and you need to do your own processing of the raw data. - set defaults { + set argument_specification { -file -default {} -type existingfile -translation -default binary -encoding -default "\uFFFF" -includebom -default 0 + *values -min 0 -max 1 } - lassign [dict values [punk::args::opts_values $defaults $args -minvalues 0 -maxvalues 1]] opts values + lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] @@ -1591,16 +1599,19 @@ namespace eval punk::fileline::system { #much faster when resultant boundary size is large (at least when offset 0) proc _range_spans_chunk_boundaries_lseq {start end chunksize args} { if {$chunksize < 1} {error "chunksize must be > 0"} ;#sanitycheck in case called directly - set defaults [dict create\ + set opts [dict create\ -offset 0\ ] - set known_opts [dict keys $defaults] foreach {k v} $args { - if {$k ni $known_opts} { - error "unknown option '$k'. Known options: $known_opts" + switch -- $k { + -offset { + dict set opts $k $v + } + default { + error "unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- set opt_offset [dict get $opts -offset] # -- --- --- --- diff --git a/src/modules/punk/island-999999.0a1.0.tm b/src/modules/punk/island-999999.0a1.0.tm new file mode 100644 index 0000000..3b498b5 --- /dev/null +++ b/src/modules/punk/island-999999.0a1.0.tm @@ -0,0 +1,561 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# 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) 2024 +# +# @@ Meta Begin +# Application punk::island 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + +#This version of island has been namespaced as the package punk::island as it may need to diverge in functionality for the purposes of use in the punk::repl system. +#see: https://wiki.tcl-lang.org/page/island +################## +## Module Name -- island.tcl +## Original Author -- Emmanuel Frecon - efrecon@gmail.com +## Description: +## +## Package to a allow a safe interpreter to access islands of the +## filesystem only, i.e. restricted directory trees within the +## filesystem. The package brings back file, open and glob to the slave +## interpreter, though in a restricted manner. +## +################## + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::island 0 999999.0a1.0] +#[copyright "2024"] +#[titledesc {filesystem islands for safe interps}] [comment {-- Name section and table of contents description --}] +#[moddesc {punk::island for safe interps}] [comment {-- Description at end of page heading --}] +#[require punk::island] +#[keywords module interp filesystem] +#[description] +#[para] Package to a allow a safe interpreter to access islands of the +#[para] filesystem only, i.e. restricted directory trees within the +#[para] filesystem. The package brings back file, open and glob to the child interp +#[para] interpreter, though in a restricted manner. +#[para] JN Warning: +#[para] This mechanism can have interactions with package loading from auto_path - needs review. + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::island +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::island +#[list_begin itemized] + +package require Tcl 8.6- +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::island::class { + #*** !doctools + #[subsection {Namespace punk::island::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Will host information for interpreters +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::island::interps { + #*** !doctools + #[subsection {Namespace punk::island::interps}] + #[para] hosts information for interpreters + #[list_begin definitions] + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::island::interps ---}] +} + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::island { + namespace export {[a-z]*}; # Convention: export all lowercase + namespace ensemble create + + #*** !doctools + #[subsection {Namespace punk::island}] + #[para] Core API functions for punk::island + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def string p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + proc add { child path } { + #*** !doctools + #[call [fun add] [arg child] [arg path]] + #[para] Add a path to the list of paths that are explicitely allowed for access + #[para] to a child interpreter. Access to any path that has not been explicitely + #[para] allowed will be denied. Paths that are added to the list of allowed + #[para] islands are always fully normalized. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter to control + # [list_end] + set vname [namespace current]::interps::[string map {: _} $child] + if { ![info exists $vname]} { + system::Init $child + } + upvar \#0 $vname paths + lappend paths [::file dirname [::file normalize $path/___]] + } + + proc reset { child } { + #*** !doctools + #[call [fun reset] [arg child]] + #[para] Remove all access path allowance and arrange for the interpreter to be + #[para] able to return to the regular safe state. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [list_end] + set vname [namespace current]::interps::[string map {: _} $child] + if { [info exists $vname] } { + $child alias file {} + $child alias open {} + $child alias glob {} + $child alias fconfigure {} + unset $vname + } + } + + + ######################## + ## + ## Procedures below are internal to the implementation. + ## + ######################## + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::island ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::island::lib { + namespace export * + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace punk::island::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::island::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval punk::island::system { + #*** !doctools + #[subsection {Namespace punk::island::system}] + #[para] Internal functions that are not part of the API + #[list_begin definitions] + + proc Allowed { child fname } { + #*** !doctools + #[call [fun Allowed] [arg child] [arg fname]] + #[para] Check that the file name passed as an argument is within the islands of + #[para] the filesystem that have been registered through the add command for a + #[para] given (safe) interpreter. The path is fully normalized before testing + #[para] against the islands, which themselves are fully normalized. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [arg_def string fname] (relative) path to the file to test + # [list_end] + set vname ::punk::island::interps::[string map {: _} $child] + upvar \#0 $vname paths + + set abs_fname [::file dirname [::file normalize $fname/___]] + foreach path $paths { + if { [string first $path $abs_fname] == 0 } { + return 1 + } + } + return 0 + } + + + proc File { child cmd args } { + #*** !doctools + #[call [fun File] [arg child] [arg cmd] [arg args]] + #[para] Parses the options and arguments to the file command to discover which + #[para] paths it tries to access and only return the results of its execution + #[para] when these path are within the allowed islands of the filesystem. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [arg_def string cmd] Subcommand of the file command + # [arg_def string args] Arguments to the file subcommand + # [list_end] + + switch $cmd { + atime - + attributes - + executable - + exists - + isdirectory - + isfile - + lstat - + mtime - + normalize - + owned - + readable - + readlink - + size - + stat - + system - + type - + writable { + set fname [lindex $args 0] + if { [Allowed $child $fname] } { + return [uplevel [linsert $args 0 ::file $cmd]] + # file is highly restrictive in child interpreters, so we can't do the following. + return [uplevel [linsert $args 0 $child invokehidden ::file $cmd]] + } else { + #return -code error "Access to $fname denied." + return [uplevel [linsert $args 0 $child invokehidden ::file $cmd]] + #return [uplevel [list $child invokehidden tcl:file:$cmd {*}$args]] + } + } + channels - + dirname - + extension - + join - + nativename - + pathtype - + rootname - + separator - + split - + tail - + volumes { + return [uplevel [list ::file $cmd {*}$args]] + # file is highly restrictive in child interpreters, so we can't do the following. + # (result would be error: invalid hidden command name "file") + return [uplevel [linsert $args 0 $child invokehidden file $cmd]] + } + copy - + delete - + rename - + link { + set idx [lsearch $args "--"] + if { $idx >= 0 } { + set paths [lrange $args [expr {$idx+1}] end] + } else { + if { [string index [lindex $args 0] 0] eq "-" } { + set paths [lrange $args 1 end] + } else { + set paths $args + } + } + foreach path $paths { + if { ![Allowed $child $path] } { + return -code error "Access to $path denied." + } + } + return [uplevel [linsert $args 0 ::file $cmd]] + # file is highly restrictive in child interpreters, so we can't do the following. + return [uplevel [linsert $args 0 $child invokehidden file $cmd]] + } + mkdir { + foreach path $args { + if { ![Allowed $child $path] } { + return -code error "Access to $path denied." + } + } + return [uplevel [linsert $args 0 ::file $cmd]] + # file is highly restrictive in child interps, so we can't do the following. + return [uplevel [linsert $args 0 $child invokehidden file $cmd]] + } + } + } + + + proc Open { child args } { + #*** !doctools + #[call [fun Open] [arg child] [arg args]] + #[para] Parses the options and arguments to the open command to discover which + #[para] paths it tries to access and only return the results of its execution + #[para] when these path are within the allowed islands of the filesystem. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [arg_def string args] Arguments to the open subcommand + # [list_end] + + set fname [lindex $args 0] + if { [string index [string trim $fname] 0] eq "|" } { + return -code error "Execution of external programs disabled." + } + + if { [Allowed $child $fname] } { + return [uplevel [list $child invokehidden open {*}$args]] + } else { + return -code error "Access to $fname denied." + } + } + + proc Expose { child cmd args } { + #*** !doctools + #[call [fun Expose] [arg child] [arg cmd] [arg args]] + #[para] This procedure allows to callback a command that would typically have + #[para] been hidden from a child interpreter. It does not "interp expose" but + #[para] rather calls the hidden command, so we can easily revert back. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [arg_def string cmd] Hidden command to call + # [arg_def string args] Arguments to the command + # [list_end] + + return [uplevel 1 [list $child invokehidden $cmd {*}$args]] + } + + proc Glob { child args } { + #*** !doctools + #[call [fun Glob] [arg child] [arg args]] + #[para] Parses the options and arguments to the glob command to discover which + #[para] paths it tries to access and only return the results of its execution + #[para] when these path are within the allowed islands of the filesystem. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [arg_def string args] Arguments to the glob command + # [list_end] + + set noargs [list -join -nocomplain -tails ] + set within "" + set flags [list] + set is_join 0 ;#manually handle join + for {set i 0} {$i < [llength $args]} {incr i} { + set itm [lindex $args $i] + if { $itm eq "--" } { + incr i; break + } elseif { [string index $itm 0] eq "-" } { + # Segregates between options that take a value and options that + # have no arguments and are booleans. + if { [lsearch $noargs $itm] < 0 } { + incr i; # Jump over argument + switch -glob -- $itm { + "-dir*" { + set within [lindex $args $i] + append within / + #don't add to flags - will be added back in below if necessary + } + "-path*" { + set within [lindex $args $i] + #don't add to flags + } + default { + #e.g -type -types + lappend flags $itm [lindex $args $i] + } + } + } else { + if {[string match "-j*" $itm]} { + set is_join 1 + } else { + lappend flags [lindex $args $i] + } + } + } else { + break + } + } + + set paths [dict create] + set what [list] + if {$is_join} { + set patterns [list [join [lrange $args $i end] /]] + } else { + set patterns [lrange $args $i end] + } + foreach ptn $patterns { + set path ${within}$ptn + #look for leading safe tokens of form $p(:digits:) only and detokenize so island can test + set re {(\$p\(:[0-9]*:\))(.*)} + if {[regexp $re $path _all tok tailpattern]} { + set tailpattern [string trim $tailpattern {/}] ;#review + set detok [uplevel [list safe::DetokPath $child $tok]] + set fullpathpattern [string map [list $tok $detok] $path] + set dir $detok + } else { + set fullpathpattern $path + set dir $within + set tailpattern $ptn + set tok "" ;#doesn't apply - we could lookup to see if one happens to correspond? review + } + set island_allowed [Allowed $child $fullpathpattern] + dict set paths $path [list islandok [Allowed $child $fullpathpattern] fullpathpattern $fullpathpattern dir $dir tok $tok tailpattern $tailpattern] ;#store bool against each path for whether island allows + #if { ![Allowed $child $path] } { + # #return -code error "Access to $path denied." + #} + } + #return [uplevel [list safe::AliasGlob $child {*}$args]] + + #As at 2024, The safe::AliasGlob version of glob requires the -directory option. + #ie it doesn't support things like: glob {$p(:208:)/*} + #This would instead have to be glob -directory {$p(:208:)} * + #It also doesn't support shortened versions such as -dir instead of -directory + + set entries [list] + dict for {path pathinfo} $paths { + puts "------------->path: $path" + puts " >pathinfo: $pathinfo" + puts " >flags: $flags" + puts " >args: $args" + set islandok [dict get $pathinfo islandok] + if {$islandok} { + puts stderr "[a+ web-red]XXX ->[list $child invokehidden glob {*}$flags [dict get $pathinfo fullpathpattern]][a]" + #return spuds + #lappend entries [uplevel 1 [list $child invokehidden glob {*}$flags [dict get $pathinfo fullpathpattern]]] + lappend entries [uplevel 1 [list ::glob {*}$flags [dict get $pathinfo fullpathpattern]]] + } else { + #only pass paths with tokens to safe - or we will get in a loop + set tok [dict get $pathinfo tok] + if {$tok ne ""} { + puts stderr "============ tok:$tok tailpattern:[dict get $pathinfo tailpattern]" + #dir is detokenised - but we should use the token for safe::AliasGlob + lappend entries {*}[uplevel [list safe::AliasGlob $child {*}$flags -directory $tok [dict get $pathinfo tailpattern]]] + } else { + puts stderr "****============ no-token tailpattern:[dict get $pathinfo tailpattern]" + lappend entries [uplevel 1 [list $child invokehidden glob {*}$flags [dict get $pathinfo fullpathpattern]]] + } + } + } + #dedup? + if {$islandok} { + puts stderr "[a+ web-green]$entries[a]" + } + return $entries + #return [uplevel [list $child invokehidden glob {*}$args]] + } + + proc Init { child } { + #*** !doctools + #[call [fun Init] [arg child] ] + #[para] Initialise child interpreter so that it will be able to perform some + #[para] file operations, but only within some islands of the filesystem. + #[para] Arguments: + # [list_begin arguments] + # [arg_def string child] Identifier of the child interpreter + # [list_end] + $child alias file ::punk::island::system::File $child + $child alias glob ::punk::island::system::Glob $child + # Allow to open some of the files, and since we did, arrange to be able to + # fconfigure them once opened. + $child alias open ::punk::island::system::Open $child + $child alias fconfigure ::punk::island::system::Expose $child fconfigure + + $child alias pwd ::punk::island::system::Expose $child pwd + $child alias cd ::punk::island::system::Expose $child cd ;# warning: cd affects whole process - generally not something desirable in a safe interp + } + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::island::system ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::island [namespace eval punk::island { + variable pkg punk::island + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/island-buildversion.txt b/src/modules/punk/island-buildversion.txt new file mode 100644 index 0000000..f47d01c --- /dev/null +++ b/src/modules/punk/island-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/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 5360f93..004dd55 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -96,6 +96,57 @@ namespace eval punk::lib::class { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::lib::ensemble { + #wiki.tcl-lang.org/page/ensemble+extend + # extend an ensemble-like routine with the routines in some namespace + proc extend {routine extension} { + if {![string match ::* $routine]} { + set resolved [uplevel 1 [list ::namespace which $routine]] + if {$resolved eq {}} { + error [list {no such routine} $routine] + } + set routine $resolved + } + set routinens [namespace qualifiers $routine] + if {$routinens eq {::}} { + set routinens {} + } + set routinetail [namespace tail $routine] + + if {![string match ::* $extension]} { + set extension [uplevel 1 [ + list [namespace which namespace] current]]::$extension + } + + if {![namespace exists $extension]} { + error [list {no such namespace} $extension] + } + + set extension [namespace eval $extension [ + list [namespace which namespace] current]] + + namespace eval $extension [ + list [namespace which namespace] export *] + + while 1 { + set renamed ${routinens}::${routinetail}_[info cmdcount] + if {[namespace which $renamed] eq {}} break + } + + rename $routine $renamed + + namespace eval $extension [ + list namespace ensemble create -command $routine -unknown [ + list apply {{renamed ensemble routine args} { + list $renamed $routine + }} $renamed + ] + ] + + return $routine + } +} + namespace eval punk::lib::compat { #*** !doctools #[subsection {Namespace punk::lib::compat}] @@ -228,6 +279,46 @@ namespace eval punk::lib::compat { return $result } + #tcl8.7/9 compatibility for 8.6 + if {[info commands ::tcl::string::insert] eq ""} { + #https://wiki.tcl-lang.org/page/string+insert + # Pure Tcl implementation of [string insert] command. + proc ::tcl::string::insert {string index insertString} { + # Convert end-relative and TIP 176 indexes to simple integers. + if {[regexp -expanded { + ^(end(?![\t\n\v\f\r ]) # "end" is never followed by whitespace + |[\t\n\v\f\r ]*[+-]?\d+) # m, with optional leading whitespace + (?:([+-]) # op, omitted when index is "end" + ([+-]?\d+))? # n, omitted when index is "end" + [\t\n\v\f\r ]*$ # optional whitespace (unless "end") + } $index _ m op n]} { + # Convert first index to an integer. + switch $m { + end {set index [string length $string]} + default {scan $m %d index} + } + + # Add or subtract second index, if provided. + switch $op { + + {set index [expr {$index + $n}]} + - {set index [expr {$index - $n}]} + } + } elseif {![string is integer -strict $index]} { + # Reject invalid indexes. + return -code error "bad index \"$index\": must be\ + integer?\[+-\]integer? or end?\[+-\]integer?" + } + + # Concatenate the pre-insert, insertion, and post-insert strings. + string cat [string range $string 0 [expr {$index - 1}]] $insertString\ + [string range $string $index end] + } + + # Bind [string insert] to [::tcl::string::insert]. + namespace ensemble configure string -map [dict replace\ + [namespace ensemble configure string -map]\ + insert ::tcl::string::insert] + } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::compat ---}] } @@ -244,6 +335,28 @@ namespace eval punk::lib { #[para] Core API functions for punk::lib #[list_begin definitions] + proc range {from to args} { + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster for larger ranges + return [lseq $from $to] + } + set count [expr {($to -$from) + 1}] + incr from -1 + return [lmap v [lrepeat $count 0] {incr from}] + } + proc is_list_all_in_list {small large} { + package require struct::list + package require struct::set + set small_in_large [lsort [struct::set intersect [lsort -unique $small] $large ]] + return [struct::list equal [lsort $small] $small_in_large] + } + proc is_list_all_ni_list {a b} { + package require struct::set + set i [struct::set intersect $a $b] + return [expr {[llength $i] == 0}] + } + + #The closure-like behaviour is *very* slow especially when called from a context such as the global namespace with lots of vars and large arrays such as ::env proc lmapflat_closure {varnames list script} { set result [list] @@ -548,16 +661,14 @@ namespace eval punk::lib { if {[llength $argopts]%2 !=0} { error "[namespace current]::hex2dec arguments prior to list_largeHex must be option/value pairs - received '$argopts'" } - set defaults [dict create\ + set opts [dict create\ -validate 1\ -empty_as_hex "INVALID set -empty_as_hex to a hex string e.g FF if empty values should be replaced"\ ] - set known_opts [dict keys $defaults] - set fullopts [dict create] - dict for {k v} $argopts { - dict set fullopts [tcl::prefix match -message "options for hex2dec. Unexpected option" $known_opts $k] $v + set known_opts [dict keys $opts] + foreach {k v} $argopts { + dict set opts [tcl::prefix match -message "options for hex2dec. Unexpected option" $known_opts $k] $v } - set opts [dict merge $defaults $fullopts] # -- --- --- --- set opt_validate [dict get $opts -validate] set opt_empty [dict get $opts -empty_as_hex] @@ -606,7 +717,7 @@ namespace eval punk::lib { ] set known_opts [dict keys $defaults] set fullopts [dict create] - dict for {k v} $argopts { + foreach {k v} $argopts { dict set fullopts [tcl::prefix match -message "options for [namespace current]::dec2hex. Unexpected option" $known_opts $k] $v } set opts [dict merge $defaults $fullopts] @@ -1050,10 +1161,13 @@ namespace eval punk::lib { return [join $lines $joinchar] } proc list_as_lines2 {args} { - #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible - lassign [dict values [punk::lib::opts_values -minvalues 1 -maxvalues 1 { + #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible? + lassign [dict values [punk::args::get_dict { -joinchar -default \n + *values -min 1 -max 1 } $args]] opts values + puts "opts:$opts" + puts "values:$values" return [join [dict get $values 0] [dict get $opts -joinchar]] } @@ -1089,7 +1203,8 @@ namespace eval punk::lib { #-anyopts 1 avoids having to know what to say if odd numbers of options passed etc #we don't have to decide what is an opt vs a value #even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block) - lassign [dict values [punk::lib::opts_values -anyopts 1 { + lassign [dict values [punk::args::get_dict { + *opts -any 1 -block -default {} } $args]] opts valuedict tailcall linelist {*}$opts {*}[dict values $valuedict] @@ -1107,22 +1222,23 @@ namespace eval punk::lib { set text [string map [list \r\n \n] $text] ;#review - option? set arglist [lrange $args 0 end-1] - set defaults [dict create\ + set opts [dict create\ -block {trimhead1 trimtail1}\ -line {}\ -commandprefix ""\ -ansiresets auto\ -ansireplays 0\ ] - dict for {o v} $arglist { + foreach {o v} $arglist { switch -- $o { - -block - -line - -commandprefix - -ansiresets - -ansireplays {} + -block - -line - -commandprefix - -ansiresets - -ansireplays { + dict set opts $o $v + } default { error "linelist: Unrecognized option '$o' usage:$usage" } } } - set opts [dict merge $defaults $arglist] # -- --- --- --- --- --- set opt_block [dict get $opts -block] if {[llength $opt_block]} { @@ -1157,9 +1273,20 @@ namespace eval punk::lib { # -- --- --- --- --- --- set opt_line [dict get $opts -line] + set tl_left 0 + set tl_right 0 + set tl_both 0 foreach lo $opt_line { switch -- $lo { - trimline - trimleft - trimright {} + trimline { + set tl_both 1 + } + trimleft { + set tl_left 1 + } + trimright { + set tl_right 1 + } default { set known_lineopts [list trimline trimleft trimright] error "linelist: unknown -line option value: $lo known values: $known_lineopts" @@ -1167,8 +1294,9 @@ namespace eval punk::lib { } } #normalize trimleft trimright combo - if {"trimleft" in $opt_line && "trimright" in $opt_line} { + if {$tl_left && $tl_right} { set opt_line [list "trimline"] + set tl_both 1 } # -- --- --- --- --- --- set opt_commandprefix [dict get $opts -commandprefix] @@ -1192,14 +1320,18 @@ namespace eval punk::lib { set linelist $nlsplit #lappend linelist {*}$nlsplit } else { - foreach ln $nlsplit { - #already normalized trimleft+trimright to trimline - if {"trimline" in $opt_line} { - lappend linelist [string trim $ln] - } elseif {"trimleft" in $opt_line} { + #already normalized trimleft+trimright to trimline + if {$tl_both} { + foreach ln $nlsplit { + lappend linelist [string trim $ln] + } + } elseif {$tl_left} { + foreach ln $nlsplit { lappend linelist [string trimleft $ln] - } elseif {"trimright" in $opt_line} { - lappend linelist [string trimright $ln] + } + } elseif {$tl_right} { + foreach ln $nlsplit { + lappend linelist [string trimright $ln] } } } @@ -1397,544 +1529,6 @@ namespace eval punk::lib { return $linelist } - #maintenance - take over from punk::args - or put back in punk::args once fixed to support pipeline argument order - #possible improvements - after the 1st call, replace the callsite in the calling proc with an inline script to process and validate the arguments as specified in optionspecs - #This would require a tcl parser .. and probably lots of other work - #It would also probably only be practical if there are no dynamic entries in the optionspecs. An option for opts_values to indicate the caller wants this optimisation would probably be best. - - #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values - #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. - #only supports -flag val pairs, not solo options - #If an option is supplied multiple times - only the last value is used. - proc opts_values {args} { - #*** !doctools - #[call [fun opts_values] [opt {option value...}] [arg optionspecs] [arg rawargs] ] - #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values - #[para]Returns a dict of the form: opts values - #[para]ARGUMENTS: - #[list_begin arguments] - #[arg_def multiline-string optionspecs] - #[para] This a block of text with records delimited by newlines (lf or crlf) - but with multiline values allowed if properly quoted/braced - #[para]'info complete' is used to determine if a record spans multiple lines due to multiline values - #[para]Each optionspec line must be of the form: - #[para]-optionname -key val -key2 val2... - #[para]where the valid keys for each option specification are: -default -type -range -choices -optional - #[arg_def list rawargs] - #[para] This is a list of the arguments to parse. Usually it will be the \$args value from the containing proc - #[list_end] - #[para] - - #consider line-processing example below for we need info complete to determine record boundaries - #punk::lib::opt_values { - # -opt1 -default {} - # -opt2 -default { - # etc - # } -multiple 1 - #} $args - - #-- cannot be used to allow opts_values itself to accept rawargs as separate values - so it doesn't serve much purpose other than as an indicator of intention - #For consistency we support it anyway. - #we have to be careful with end-of-options flag -- - #It may legitimately be the only value in the rawargs list (which is a bit odd - but possible) or it may occur immediately before optionspecs and rawargs - #if there is more than one entry in rawargs - we won't find it anyway - so that's ok - set eopts_posn [lsearch $args --] - if {$eopts_posn == ([llength $args]-1)} { - #sole argument in rawargs - not the one we're looking for - set eopts_posn -1 - } - if {$eopts_posn >= 0} { - set ov_opts [lrange $args 0 $eopts_posn-1] - set ov_vals [lrange $args $eopts_posn+1 end] - } else { - set ov_opts [lrange $args 0 end-2] - set ov_vals [lrange $args end-1 end] - } - if {[llength $ov_vals] < 2 || [llength $ov_opts] %2 != 0} { - error "opts_args wrong # args: should be opts_values ?opt val?... optionspecs rawargs_as_list - } - set optionspecs [lindex $ov_vals 0] - set optionspecs [string map [list \r\n \n] $optionspecs] - - set rawargs [lindex $ov_vals 1] - - set optspec_defaults [dict create\ - -optional 1\ - -allow_ansi 1\ - -validate_without_ansi 0\ - -strip_ansi 0\ - -nocase 0\ - ] - set required_opts [list] - set required_vals [list] - set arg_info [dict create] - set defaults_dict_opts [dict create] - set defaults_dict_values [dict create] - #first process dashed and non-dashed argspecs without regard to whether non-dashed are at the beginning or end - set value_names [list] - - set records [list] - set linebuild "" - foreach rawline [split $optionspecs \n] { - set recordsofar [string cat $linebuild $rawline] - if {![info complete $recordsofar]} { - append linebuild [string trimleft $rawline] \n - } else { - lappend records [string cat $linebuild $rawline] - set linebuild "" - } - } - - foreach ln $records { - set trimln [string trim $ln] - switch -- [string index $trimln 0] { - "" - # {continue} - } - set argname [lindex $trimln 0] - set argspecs [lrange $trimln 1 end] - if {[llength $argspecs] %2 != 0} { - error "punk::lib::opts_values - bad optionspecs line for argument '$argname' Remaining items on line must be in paired option-value format - received '$argspecs'" - } - if {[string match -* $argname]} { - dict set argspecs -ARGTYPE option - set is_opt 1 - } else { - dict set argspecs -ARGTYPE value - lappend value_names $argname - set is_opt 0 - } - dict for {spec specval} $argspecs { - switch -- $spec { - -default - -type - -range - -choices - -nocase - -optional - -multiple - -validate_without_ansi - -allow_ansi - -strip_ansi - -ARGTYPE {} - default { - set known_argspecs [list -default -type -range -choices -nocase -optional -multiple -validate_without_ansi -allow_ansi -strip_ansi -ARGTYPE] - error "punk::lib::opts_values - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" - } - } - } - set argspecs [dict merge $optspec_defaults $argspecs] - dict set arg_info $argname $argspecs - if {![dict get $argspecs -optional]} { - if {$is_opt} { - lappend required_opts $argname - } else { - lappend required_vals $argname - } - } - if {[dict exists $arg_info $argname -default]} { - if {$is_opt} { - dict set defaults_dict_opts $argname [dict get $arg_info $argname -default] - } else { - dict set defaults_dict_values $argname [dict get $arg_info $argname -default] - } - } - } - - #puts "--> [info frame -2] <--" - set cmdinfo [dict get [info frame -2] cmd] - #we can't treat cmdinfo as a list - it may be something like {command {*}$args} in which case lindex $cmdinfo 0 won't work - #hopefully first word is a plain proc name if this function was called in the normal manner - directly from a proc - #we will break at first space and assume the lhs of that will give enough info to be reasonable - (alternatively we could use entire cmdinfo - but it might be big and ugly) - set caller [regexp -inline {\S+} $cmdinfo] - - #if called from commandline or some other contexts such as outside of a proc in a namespace - caller may just be "namespace" - if {$caller eq "namespace"} { - set caller "punk::lib::opts_values called from namespace" - } - - # ------------------------------ - if {$caller ne "punk::lib::opts_values"} { - #1) check our caller's call to us - recursive version - perhaps more elegant to eat our own dogfood - but maybe too much overhead for a script-based args processor which is already quite heavy :/ - #lassign [punk::lib::opts_values "-anyopts -default 0 -type integer\n -minvalues -default 0 -type integer\n -maxvalues -default -1 -type integer" $args] _o ownopts _v ownvalues - #if {[dict size $ownvalues] != 2} { - # error "punk::lib::opts_values expected: a multiline text block of option-specifications, a list of args and at most three option pairs -minvalues , -maxvalues , -anyopts true|false - got extra arguments: '$ownvalues'" - #} - #set opt_minvalues [dict get $ownopts -minvalues] - #set opt_maxvalues [dict get $ownopts -maxvalues] - #set opt_anyopts [dict get $ownopts -anyopts] - - #2) Quick and dirty - but we don't need much validation - set defaults [dict create\ - -minvalues 0\ - -maxvalues -1\ - -anyopts 0\ - ] - dict for {k v} $ov_opts { - if {$k ni {-minvalues -maxvalues -anyopts}} { - error "punk::lib::opts_values unrecognised option $k. Known values [dict keys $defaults]" - } - if {![string is integer -strict $v]} { - error "punk::lib::opts_values argument $k must be of type integer" - } - } - set ov_opts [dict merge $defaults $ov_opts] - set opt_minvalues [dict get $ov_opts -minvalues] - set opt_maxvalues [dict get $ov_opts -maxvalues] - set opt_anyopts [dict get $ov_opts -anyopts] - } else { - #don't recurse ie don't check our own args if we called ourself - set opt_minvalues 2 - set opt_maxvalues 2 - set opt_anyopts 0 - } - # ------------------------------ - - if {[set eopts [lsearch $rawargs "--"]] >= 0} { - set values [lrange $rawargs $eopts+1 end] - set arglist [lrange $rawargs 0 $eopts-1] - } else { - if {[lsearch $rawargs -*] >= 0} { - #to support option values with leading dash e.g -offset -1 , we can't just take the last flagindex - set i 0 - foreach {k v} $rawargs { - if {![string match -* $k]} { - break - } - if {$i+1 >= [llength $rawargs]} { - #no value for last flag - error "bad options for $caller. No value supplied for last option $k" - } - incr i 2 - } - set arglist [lrange $rawargs 0 $i-1] - set values [lrange $rawargs $i end] - } else { - set arglist [list] - set values $rawargs ;#no -flags detected - } - } - #confirm any valnames before last don't have -multiple key - foreach valname [lrange $value_names 0 end-1] { - if {[dict exists $arg_info $valname -multiple ]} { - error "bad key -multiple on argument spec for '$valname'. Only the last value argument specification can be marked -multiple" - } - } - set values_dict [dict create] - set validx 0 - set in_multiple "" - foreach valname $value_names val $values { - if {$validx+1 > [llength $values]} { - break - } - if {$valname ne ""} { - if {[dict exists $arg_info $valname -multiple] && [dict get $arg_info $valname -multiple]} { - dict lappend values_dict $valname $val - set in_multiple $valname - } else { - dict set values_dict $valname $val - } - } else { - if {$in_multiple ne ""} { - dict lappend values_dict $in_multiple $val - } else { - dict set values_dict $validx $val - } - } - incr validx - } - - if {$opt_maxvalues == -1} { - #only check min - if {[llength $values] < $opt_minvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected at least $opt_minvalues" - } - } else { - if {[llength $values] < $opt_minvalues || [llength $values] > $opt_maxvalues} { - if {$opt_minvalues == $opt_maxvalues} { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected exactly $opt_minvalues" - } else { - error "bad number of trailing values for $caller. Got [llength $values] values. Expected between $opt_minvalues and $opt_maxvalues inclusive" - } - } - } - #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) - #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW - #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. - #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level - #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - set argnamespresent [dict keys $arglist] - foreach r $required_opts { - if {$r ni $argspresent} { - error "Required option missing for $caller. '$r' is marked with -optional false - so must be present in its full-length form" - } - } - set valuenamespresent [dict keys $values_dict] - foreach r $required_vals { - if {$r ni $valuenamespresent} { - error "Required value missing for $caller. '$r' is marked with -optional false - so must be present" - } - } - if {!$opt_anyopts} { - set checked_args [dict create] - for {set i 0} {$i < [llength $arglist]} {incr i} { - #allow this to error out with message indicating expected flags - set val [lindex $arglist $i+1] - set fullopt [tcl::prefix match -message "options for $caller. Unexpected option" [dict keys $arg_info] [lindex $arglist $i]] - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $val - } else { - dict set checked_args $fullopt $val - } - incr i ;#skip val - } - } else { - #still need to use tcl::prefix match to normalize - but don't raise an error - set checked_args [dict create] - dict for {k v} $arglist { - if {![catch {tcl::prefix::match [dict keys $arg_info] $k} fullopt]} { - if {[dict exists $arg_info $fullopt -multiple] && [dict get $arg_info $fullopt -multiple]} { - dict lappend checked_args $fullopt $v - } else { - dict set checked_args $fullopt $v - } - } else { - #opt was unspecified - dict set checked_args $k $v - } - } - } - set opts [dict merge $defaults_dict_opts $checked_args] - #assertion - checked_args keys are full-length option names if -anyopts was false or if the supplied option as a shortname matched one of our defined options - - set values [dict merge $defaults_dict_values $values_dict] - - #todo - allow defaults outside of choices/ranges - - #check types,ranges,choices - set opts_and_values [concat $opts $values] - set combined_defaults [concat $defaults_dict_values $defaults_dict_opts] ;#can be no key collisions - we don't allow a value key beginning with dash - opt names must begin with dash - dict for {o v} $opts_and_values { - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - set vlist $v - } else { - set vlist [list $v] - } - - if {[dict exists $arg_info $o -validate_without_ansi] && [dict get $arg_info $o -validate_without_ansi]} { - set validate_without_ansi 1 - package require punk::ansi - } else { - set validate_without_ansi 0 - } - if {[dict exists $arg_info $o -allow_ansi] && [dict get $arg_info $o -allow_ansi]} { - set allow_ansi 1 - } else { - #ironically - we need punk::ansi to detect and disallow - but we don't need it if ansi is allowed - package require punk::ansi - set allow_ansi 0 - } - if {!$allow_ansi} { - #detect should work fine directly on whole list - if {[punk::ansi::ta::detect $vlist]} { - error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: [ansistring VIEW $vlist]" - } - #foreach e $vlist { - # if {[punk::ansi::ta::detect $e]} { - # error "Option $o for $caller contains ansi - but -allow_ansi is false. Received: '$e'" - # } - #} - } - - set vlist_check [list] - foreach e $vlist { - #could probably stripansi entire list safely in one go? - review - if {$validate_without_ansi} { - lappend vlist_check [punk::ansi::stripansi $e] - } else { - lappend vlist_check $e - } - } - - set is_default 0 - foreach e $vlist e_check $vlist_check { - if {[dict exists $combined_defaults $o] && ($e_check eq [dict get $combined_defaults $o])} { - incr is_default - } - } - if {$is_default eq [llength $vlist]} { - set is_default true - } - #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value - #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. - if {!$is_default} { - if {[dict exists $arg_info $o -type]} { - set type [dict get $arg_info $o -type] - set ltype [string tolower $type] - switch -- $type { - int - - integer - - double { - switch -- $ltype { - int - - integer { - foreach e $vlist e_check $vlist_check { - if {![string is integer -strict $e_check]} { - error "Option $o for $caller requires type 'integer'. Received: '$e'" - } - } - } - double { - foreach e $vlist e_check $vlist_check { - if {![string is double -strict $e_check]} { - error "Option $o for $caller requires type 'double'. Received: '$e'" - } - } - } - } - #todo - small-value double comparisons with error-margin? review - if {[dict exists $arg_info $o -range]} { - lassign [dict get $arg_info $o -range] low high - foreach e $vlist e_check $vlist_check { - if {$e_check < $low || $e_check > $high} { - error "Option $o for $caller must be between $low and $high. Received: '$e'" - } - } - } - } - bool - - boolean { - foreach e $vlist e_check $vlist_check { - if {![string is boolean -strict $e_check]} { - error "Option $o for $caller requires type 'boolean'. Received: '$e'" - } - } - } - alnum - - alpha - - ascii - - control - - digit - - graph - - lower - - print - - punct - - space - - upper - - wordchar - - xdigit { - foreach e $vlist e_check $vlist_check { - if {![string is [string tolower $type] $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e'" - } - } - } - file - - directory - - existingfile - - existingdirectory { - foreach e $vlist e_check $vlist_check { - if {!([string length $e_check]>0 && ![regexp {[\"*?<>\;]} $e_check])} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which doesn't look like it could be a file or directory" - } - } - if {[string tolower $type] in {existingfile}} { - foreach e $vlist e_check $vlist_check { - if {![file exists $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing file" - } - } - } elseif {[string tolower $type] in {existingdirectory}} { - foreach e $vlist e_check $vlist_check { - if {![file isdirectory $e_check]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not an existing directory" - } - } - } - } - char - - character { - foreach e $vlist e_check $vlist_check { - if {[string length != 1]} { - error "Option $o for $caller requires type '[string tolower $type]'. Received: '$e' which is not a single character" - } - } - } - } - } - if {[dict exists $arg_info $o -choices]} { - set choices [dict get $arg_info $o -choices] - set nocase [dict get $arg_info $o -nocase] - foreach e $vlist e_check $vlist_check { - if {$nocase} { - set casemsg "(case insensitive)" - set choices_test [string tolower $choices] - set v_test [string tolower $e_check] - } else { - set casemsg "(case sensitive)" - set v_test $e_check - set choices_test $choices - } - if {$v_test ni $choices_test} { - error "Option $o for $caller must be one of the listed values $choices $casemsg. Received: '$e'" - } - } - } - } - if {[dict exists $arg_info $o -strip_ansi] && [dict get $arg_info $o -strip_ansi]} { - set stripped_list [list] - foreach e $vlist { - lappend stripped_list [punk::ansi::stripansi $e] - } - if {[dict exists $arg_info $o -multiple] && [dict get $arg_info $o -multiple]} { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o $stripped_list - } else { - dict set values $o $stripped_list - } - } else { - if {[dict get $arg_info $o -ARGTYPE] eq "option"} { - dict set opts $o [lindex $stripped_list 0] - } else { - dict set values [lindex $stripped_list 0] - } - } - } - } - - #maintain order of opts $opts values $values as caller may use lassign. - return [dict create opts $opts values $values] - } - - #tcl8.7/9 compatibility for 8.6 - if {[info commands ::tcl::string::insert] eq ""} { - #https://wiki.tcl-lang.org/page/string+insert - # Pure Tcl implementation of [string insert] command. - proc ::tcl::string::insert {string index insertString} { - # Convert end-relative and TIP 176 indexes to simple integers. - if {[regexp -expanded { - ^(end(?![\t\n\v\f\r ]) # "end" is never followed by whitespace - |[\t\n\v\f\r ]*[+-]?\d+) # m, with optional leading whitespace - (?:([+-]) # op, omitted when index is "end" - ([+-]?\d+))? # n, omitted when index is "end" - [\t\n\v\f\r ]*$ # optional whitespace (unless "end") - } $index _ m op n]} { - # Convert first index to an integer. - switch $m { - end {set index [string length $string]} - default {scan $m %d index} - } - - # Add or subtract second index, if provided. - switch $op { - + {set index [expr {$index + $n}]} - - {set index [expr {$index - $n}]} - } - } elseif {![string is integer -strict $index]} { - # Reject invalid indexes. - return -code error "bad index \"$index\": must be\ - integer?\[+-\]integer? or end?\[+-\]integer?" - } - - # Concatenate the pre-insert, insertion, and post-insert strings. - string cat [string range $string 0 [expr {$index - 1}]] $insertString\ - [string range $string $index end] - } - - # Bind [string insert] to [::tcl::string::insert]. - namespace ensemble configure string -map [dict replace\ - [namespace ensemble configure string -map]\ - insert ::tcl::string::insert] - } interp alias {} errortime {} punk::lib::errortime proc errortime {script groupsize {iters 2}} { @@ -2051,6 +1645,26 @@ namespace eval punk::lib::system { #[para] Internal functions that are not part of the API #[list_begin definitions] + proc has_script_var_bug {} { + set script {set j [list spud] ; list} + append script \n + uplevel #0 $script + set rep1 [tcl::unsupported::representation $::j] + set script "" + set rep2 [tcl::unsupported::representation $::j] + + set nostring1 [string match "*no string" $rep1] + set nostring2 [string match "*no string" $rep2] + + #we assume it should have no string rep in either case + #Review: check Tcl versions for behaviour/consistency + if {!$nostring2} { + return true + } else { + return false + } + } + proc mostFactorsBelow {n} { ##*** !doctools #[call [fun mostFactorsBelow] [arg n]] diff --git a/src/modules/punk/mix-0.1.tm b/src/modules/punk/mix-0.1.tm index 3e61078..1e77b3d 100644 --- a/src/modules/punk/mix-0.1.tm +++ b/src/modules/punk/mix-0.1.tm @@ -1,9 +1,10 @@ -package provide punk::mix [namespace eval punk::mix { - variable version - set version 0.1 - -}] + + namespace eval punk::mix { +package require punk::lib + + +package require punk::mix_custom proc runcli {args} { if {![llength $args]} { tailcall punk::mix::clicommands help @@ -43,8 +44,6 @@ namespace eval punk::mix::clicommands { } } -package require punk -package require punk::mix_custom punk::ensemble::extend punk::mix::clicommands punk::mix_custom @@ -79,4 +78,10 @@ namespace eval punk::mix::clicommands { } return $helpstr } -} \ No newline at end of file +} + +package provide punk::mix [namespace eval punk::mix { + variable version + set version 0.1 + +}] \ No newline at end of file diff --git a/src/modules/punk/mix/base-0.1.tm b/src/modules/punk/mix/base-0.1.tm index a80dd99..0a13ad3 100644 --- a/src/modules/punk/mix/base-0.1.tm +++ b/src/modules/punk/mix/base-0.1.tm @@ -740,7 +740,7 @@ namespace eval punk::mix::base { proc cksum_filter_opts {args} { set ck_opt_names [dict keys [cksum_default_opts]] set ck_opts [dict create] - dict for {k v} $args { + foreach {k v} $args { if {$k in $ck_opt_names} { dict set ck_opts $k $v } diff --git a/src/modules/punk/mix/cli-0.3.tm b/src/modules/punk/mix/cli-0.3.tm index 13d75d7..3e941e4 100644 --- a/src/modules/punk/mix/cli-0.3.tm +++ b/src/modules/punk/mix/cli-0.3.tm @@ -24,7 +24,8 @@ package require punkcheck ;#checksum and/or timestamp records # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ - +#review +#deck - rename to dev namespace eval punk::mix::cli { namespace eval temp_import { } @@ -101,11 +102,6 @@ namespace eval punk::mix::cli { #interp alias {} ::punk::mix::cli::project.new {} ::punk::mix::cli::new - - - - - proc make {args} { set startdir [pwd] set project_base "" ;#empty for unknown @@ -209,17 +205,20 @@ namespace eval punk::mix::cli { } proc validate_modulename {modulename args} { - set defaults [list\ + set opts [list\ -errorprefix validate_modulename\ ] if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} - set known_opts [dict keys $defaults] - foreach k [dict keys $args] { - if {$k ni $known_opts} { - error "validate_modulename error: unknown option $k. known options: $known_opts" + foreach {k v} $args { + switch -- $k { + -errorprefix { + dict set opts $k $v + } + default { + error "validate_modulename error: unknown option '$k'. known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_errorprefix [dict get $opts -errorprefix] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -264,17 +263,20 @@ namespace eval punk::mix::cli { return $projectname } proc validate_name_not_empty_or_spaced {name args} { - set defaults [list\ + set opts [list\ -errorprefix projectname\ ] - if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} - set known_opts [dict keys $defaults] - foreach k [dict keys $args] { - if {$k ni $known_opts} { - error "validate_modulename error: unknown option $k. known options: $known_opts" + if {[llength $args] %2 != 0} {error "validate_name_not_empty_or_spaced args must be name-value pairs: received '$args'"} + foreach {k v} $args { + switch -- $k { + -errorprefix { + dict set opts $k $v + } + default { + error "validate_name_not_empty_or_spaced error: unknown option $k. known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_errorprefix [dict get $opts -errorprefix] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- @@ -759,24 +761,27 @@ namespace eval punk::mix::cli { } proc kettle_call {calltype args} { variable kettle_reset_bodies - if {$calltype ni [list lib shell]} { - error "deck kettle_call 1st argument must be one of: 'lib' for direct use of kettle module or 'shell' to call as separate process" - } - if {$calltype eq "shell"} { - set kettleappfile [file dirname [info nameofexecutable]]/kettle - set kettlebatfile [file dirname [info nameofexecutable]]/kettle.bat - - if {(![file exists $kettleappfile]) && (![file exists $kettlebatfile])} { - error "deck kettle_call unable to find installed kettle application file '$kettleappfile' (or '$kettlebatfile' if on windows)" - } - if {[file exists $kettleappfile]} { - set kettlescript $kettleappfile - } - if {$::tcl_platform(platform) eq "windows"} { - if {[file exists $kettlebatfile]} { - set kettlescript $kettlebatfile + switch -- $calltype { + lib {} + shell { + set kettleappfile [file dirname [info nameofexecutable]]/kettle + set kettlebatfile [file dirname [info nameofexecutable]]/kettle.bat + + if {(![file exists $kettleappfile]) && (![file exists $kettlebatfile])} { + error "deck kettle_call unable to find installed kettle application file '$kettleappfile' (or '$kettlebatfile' if on windows)" + } + if {[file exists $kettleappfile]} { + set kettlescript $kettleappfile + } + if {$::tcl_platform(platform) eq "windows"} { + if {[file exists $kettlebatfile]} { + set kettlescript $kettlebatfile + } } } + default { + error "deck kettle_call 1st argument must be one of: 'lib' for direct use of kettle module or 'shell' to call as separate process" + } } set startdir [pwd] if {![file exists $startdir/build.tcl]} { @@ -901,7 +906,12 @@ namespace eval punk::mix::cli { variable default_command help package require punk::mix::base package require punk::overlay - punk::overlay::custom_from_base [namespace current] ::punk::mix::base + if {[catch { + punk::overlay::custom_from_base [namespace current] ::punk::mix::base + } errM]} { + puts stderr "punk::mix::cli load error: Failed to overlay punk::mix::base $errM" + error "punk::mix::cli error: $errM" + } } diff --git a/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm b/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm index af186f2..a492615 100644 --- a/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/doc-999999.0a1.0.tm @@ -33,6 +33,7 @@ namespace eval punk::mix::commandset::doc { puts "documentation subsystem" puts "commands: doc.build" puts " build documentation from src/doc to src/embedded using the kettle build tool" + puts "commands: doc.status" } proc build {} { diff --git a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm index 4f9655d..0428c74 100644 --- a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm @@ -354,10 +354,10 @@ namespace eval punk::mix::commandset::module { #it is nevertheless useful information - and not the only way developer-machine/build-machine paths can leak #for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern - #Don't put litera %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens + #Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version] set strmap [list] - dict for {tag val} $tagnames { + foreach {tag val} $tagnames { lappend strmap %$tag% $val } set template_filedata [string map $strmap $template_filedata] diff --git a/src/modules/punk/mix/commandset/project-999999.0a1.0.tm b/src/modules/punk/mix/commandset/project-999999.0a1.0.tm index cdbc934..430149c 100644 --- a/src/modules/punk/mix/commandset/project-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/project-999999.0a1.0.tm @@ -390,7 +390,7 @@ namespace eval punk::mix::commandset::project { set tagmap [list [lib::template_tag project] $projectname] if {[llength $templatefiles]} { puts stdout "Filling template file placeholders with the following tag map:" - dict for {placeholder value} $tagmap { + foreach {placeholder value} $tagmap { puts stdout " $placeholder -> $value" } } @@ -586,25 +586,39 @@ namespace eval punk::mix::commandset::project { set col6_dupids [list] set col7_pdescs [list] set codes [dict create] + set file_idx 0 foreach dbfile $col1_dbfiles { set project_name "" set project_code "" set project_desc "" - sqlite3 dbp $dbfile - dbp eval {select name,value from config where name like 'project-%';} r { - if {$r(name) eq "project-name"} { - set project_name $r(value) - } elseif {$r(name) eq "project-code"} { - set project_code $r(value) - } elseif {$r(name) eq "project-description"} { - set project_desc $r(value) + set db_error "" + if {[file exists $dbfile]} { + if {[catch { + sqlite3 dbp $dbfile + dbp eval {select name,value from config where name like 'project-%';} r { + if {$r(name) eq "project-name"} { + set project_name $r(value) + } elseif {$r(name) eq "project-code"} { + set project_code $r(value) + } elseif {$r(name) eq "project-description"} { + set project_desc $r(value) + } + } + } errM]} { + set db_error $errM } + catch {dbp close} + } else { + set db_error "fossil file $dbfile missing" } - dbp close lappend col4_pnames $project_name lappend col5_pcodes $project_code dict lappend codes $project_code $dbfile lappend col7_pdescs $project_desc + if {$db_error ne ""} { + lset col1_dbfiles $file_idx "[a+ web-red]$dbfile[a]" + } + incr file_idx } set setid 1 diff --git a/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm b/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm index 0e76174..47b95ab 100644 --- a/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm @@ -117,18 +117,21 @@ namespace eval punk::mix::commandset::scriptwrap { } set crlf_lf_replacements [list \uFFFF \uFFFE] ;#defaults - if already exist in file - error out with message # -ignore_rems 1 allows testing of alignment state if rems were stripped - todo - lf/crlf-preserving rem strip function - set defaults [dict create\ + set opts [dict create\ -ignore_rems 0\ -substitutionmap {}\ -crlf_lf_replacements $crlf_lf_replacements\ ] - set known_opts [dict keys $defaults] foreach {k v} $args { - if {$k ni $known_opts} { - error "checkfile error - unknown option '$k'. Known options: $known_opts" + switch -- $k { + -ignore_rems - -substitutionmap - -crlf_lf_replacements { + dict set opts $k $v + } + default { + error "checkfile error - unknown option '$k'. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- set opt_ignore_rems [dict get $opts -ignore_rems] set opt_substitutionmap [dict get $opts -substitutionmap] @@ -756,20 +759,25 @@ namespace eval punk::mix::commandset::scriptwrap { #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf proc multishell {filepath_or_scriptset args} { - set defaults [dict create\ + set opts [dict create\ -askme 1\ -outputfolder "\uFFFF"\ -template "\uFFFF"\ -returnextra 0\ -force 0\ ] - set known_opts [dict keys $defaults] - dict for {k v} $args { - if {$k ni $known_opts} { - - error "punk::mix::commandset::scriptwrap error. Unrecognized option '$k'. Known-options: $known_opts" + #set known_opts [dict keys $defaults] + foreach {k v} $args { + switch -- $k { + -askme - -outputfolder - -template - -returnextra - -force { + dict set opts $k $v + } + default { + error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" + } } } + set usage "" append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n @@ -779,7 +787,6 @@ namespace eval punk::mix::commandset::scriptwrap { puts stderr $usage return false } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- set opt_askme [dict get $opts -askme] set opt_template [dict get $opts -template] @@ -1190,11 +1197,22 @@ namespace eval punk::mix::commandset::scriptwrap { proc get_wrapper_folders {args} { - set opts [dict get [punk::get_leading_opts_and_values { - -scriptpath "" - } $args -maxvalues 0] opts] + set argd [punk::args::get_dict { + #*** !doctools + #[call [fun get_wrapper_folders] [arg args] ] + #[para] Return list of dicts representing wrapper folders. keys: basefolder sourceinfo + #[para] Arguments: + # [list_begin arguments] + # [arg_def string args] name-value pairs -scriptpath + # [list_end] + *proc -name get_wrapper_folders + *opts -anyopts 0 + -scriptpath -default "" + *values -minvalues 0 -maxvalues 0 + } $args] + # -- --- --- --- --- --- --- --- --- - set opt_scriptpath [dict get $opts -scriptpath] + set opt_scriptpath [dict get $argd opts -scriptpath] # -- --- --- --- --- --- --- --- --- set wrapper_template_bases [list] diff --git a/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm b/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm index 1be8c16..462ab89 100644 --- a/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm +++ b/src/modules/punk/mix/templates/modules/template_module-0.0.1.tm @@ -97,7 +97,7 @@ namespace eval %pkg%::class { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval %pkg% { - namespace export * + namespace export {[a-z]*}; # Convention: export all lowercase #variable xyz #*** !doctools @@ -127,7 +127,7 @@ namespace eval %pkg% { # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval %pkg%::lib { - namespace export * + namespace export {[a-z]*}; # Convention: export all lowercase namespace path [namespace parent] #*** !doctools #[subsection {Namespace %pkg%::lib}] diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index f42f3ed..48f0998 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -591,7 +591,7 @@ namespace eval punk::ns { #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects] + set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ -types $known_types\ @@ -605,9 +605,9 @@ namespace eval punk::ns { set types $requested_types if {"all" in $requested_types} { - foreach t $known_types { - if {$t ni $types} { - lappend types $t + foreach known $known_types { + if {$known ni $types} { + lappend types $known } } } @@ -618,13 +618,20 @@ namespace eval punk::ns { if {"ooobjects" ni $types} { lappend types "ooobjects" } + if {"ooprivateobjects" ni $types} { + lappend types "ooprivateobjects" + } + if {"ooprivateclasses" ni $types} { + lappend types "ooprivateclasses" + } } foreach t $types { - if {$t in [list "oo" "all"]} { - continue - } - if {$t ni $known_types} { - error "Unrecognised namespace member type: $t known types: $known_types" + switch -- $t { + oo - all - + children - commands - exported - imported - aliases - procs - ensembles - ooclasses - ooobjects - ooprivateobjects - ooprivateclasses - native - coroutines - interps - zlibstreams {} + default { + error "Unrecognised namespace member type: $t known types: $known_types oo all" + } } } @@ -636,15 +643,21 @@ namespace eval punk::ns { #NOTE aliases may not be commands in current namespace - but we want to show them (marked red and with R) # - set children [list] - set commands [list] - set exported [list] - set imported [list] - set aliases [list] - set procs [list] - set ensembles [list] - set ooclasses [list] - set ooobjects [list] + set children [list] + set commands [list] + set exported [list] + set imported [list] + set aliases [list] + set procs [list] + set ensembles [list] + set ooclasses [list] + set ooobjects [list] + set ooprivateobjects [list] + set ooprivateclasses [list] + set native [list] + set interps [list] + set coroutines [list] + set zlibstreams [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -678,26 +691,48 @@ namespace eval punk::ns { } if {"commands" in $types} { set commands [dict get $contents commands] - if {"exported" in $types} { - set exported [dict get $contents exported] - } - if {"imported" in $types} { - set imported [dict get $contents imported] - } - if {"aliases" in $types} { - set aliases [dict get $contents aliases] - } - if {"procs" in $types} { - set procs [dict get $contents procs] - } - if {"ensembles" in $types} { - set ensembles [dict get $contents ensembles] - } - if {"ooclasses" in $types} { - set ooclasses [dict get $contents ooclasses] - } - if {"ooobjects" in $types} { - set ooobjects [dict get $contents ooobjects] + foreach t $types { + switch -- $t { + exported { + set exported [dict get $contents exported] + } + imported { + set imported [dict get $contents imported] + } + aliases { + set aliases [dict get $contents aliases] + } + procs { + set procs [dict get $contents procs] + } + ensembles { + set ensembles [dict get $contents ensembles] + } + ooclasses { + set ooclasses [dict get $contents ooclasses] + } + ooobjects { + set ooobjects [dict get $contents ooobjects] + } + ooprivateobjects { + set ooprivateobjects [dict get $contents ooprivateobjects] + } + ooprivateclasses { + set ooprivateclasses [dict get $contents ooprivateclasses] + } + native { + set native [dict get $contents native] + } + interps { + set interps [dict get $contents interps] + } + coroutines { + set coroutines [dict get $contents coroutines] + } + zlibstreams { + set zlibstreams [dict get $contents zlibstreams] + } + } } } @@ -719,11 +754,12 @@ namespace eval punk::ns { set seencmds [list] set masked [list] ;# + set cmdsets [concat $procs $ensembles $ooclasses $ooobjects $ooprivateobjects $ooprivateclasses $native $interps $coroutines $zlibstreams] foreach a $aliases { if {[list c $a] in $elements} { #possibly an ordinary alias - or a renamed alias that is masked by a proc/ensemble/oo #we can detect masking by proc/ensemble/oo - but not by a binary extension loaded after the rename: REVIEW - if {$a in [concat $procs $ensembles $ooclasses $ooobjects]} { + if {$a in $cmdsets} { #we have an alias that is also a known other command-type lappend elements [list c $a] ;#add in twice so we can display both. lappend masked $a @@ -776,10 +812,17 @@ namespace eval punk::ns { set col3 [string repeat " " [expr {$cmdwidest1 + 8}]] set col4 [string repeat " " [expr {$cmdwidest2 + 8}]] set col5 [string repeat " " [expr {$cmdwidest3 + 8}]] - set a [a+ purple bold] - set e [a+ yellow bold] - set o [a+ cyan bold] - set p [a+ white bold] + set a [a+ bold purple] + set e [a+ bold yellow] + set p [a+ bold white] + set c_nat [a+ web-gray] ;#native + set c_int [a+ web-orange] ;#interps + set c_cor [a+ web-hotpink] ;#coroutines + set c_ooo [a+ bold cyan] ;#object + set c_ooc [a+ web-aquamarine] ;#class + set c_ooO [a+ web-dodgerblue] ;#privateObject + set c_ooC [a+ web-lightskyblue] ;#privateClass + set c_zst [a+ web-yellow] ;#zlibstreams set a1 [a][a+ cyan] foreach ch1 $children1 ch2 $children2 cmd1 $elements1 cmd2 $elements2 cmd3 $elements3 cmd4 $elements4 { @@ -804,6 +847,7 @@ namespace eval punk::ns { if {$cmd in $exported} { set c [a+ green bold] } + #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias #assertion member of masked - but we use seencmds instead to detect. @@ -812,14 +856,26 @@ namespace eval punk::ns { set prefix [overtype::right $prefix "-R"] } elseif {$cmd in $procs} { set prefix "${p}prc " + } elseif {$cmd in $native} { + set prefix "${c_nat}nat " } elseif {$cmd in $ensembles} { set prefix "${e}ens " } elseif {$cmd in $ooclasses} { - set prefix "${o}ooc " + set prefix "${c_ooc}ooc " + } elseif {$cmd in $ooprivateobjects} { + set prefix "${c_ooO}ooO " + } elseif {$cmd in $ooprivateclasses} { + set prefix "${c_ooC}ooC " } elseif {$cmd in $ooobjects} { - set prefix "${o}ooo " + set prefix "${c_ooo}ooo " } elseif {$cmd in $aliases} { set prefix "${a}als " + } elseif {$cmd in $interps} { + set prefix "${c_int}int " + } elseif {$cmd in $coroutines} { + set prefix "${c_cor}cor " + } elseif {$cmd in $zlibstreams} { + set prefix "${c_zst}zst " } else { } if {$cmd in $imported} { @@ -937,6 +993,14 @@ namespace eval punk::ns { return [get_ns_dicts $ns_absolute {*}$args] } + #info cmdtype available in 8.7+ + proc cmdtype {cmd} { + if {[info commands ::tcl::info::cmdtype] ne ""} { + tailcall info cmdtype $cmd + } + #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + return na + } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob #returns a list of dicts even if only one ns matched #glob chars at last segment match contents/children of namespaces @@ -1042,9 +1106,15 @@ namespace eval punk::ns { #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] + set allnative [list] set allensembles [list] + set allinterps [list] + set allcoroutines [list] + set allzlibstreams [list] set allooobjects [list] set allooclasses [list] + set allooprivateobjects [list] + set allooprivateclasses [list] set allimported [list] set allundetermined [list] set interp_aliases [interp aliases ""] @@ -1070,32 +1140,93 @@ namespace eval punk::ns { # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} + set ctype [cmdtype ${location}::$cmd] + switch -- $ctype { + na { + #tcl 8.6 (info cmdtype unavailable) + #todo - use catch tcl::unsupported::corotype to see if coroutine + if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { + lappend allensembles $cmd + } elseif {[info object isa object ${location}::$cmd]} { + lappend allooobjects $cmd + if {[info object isa class ${location}::$cmd]} { + lappend allooclasses $cmd + } + } + if {[catch { + if {$cmd eq ""} { + #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. + set nsorigin [namespace origin ${location}::] + } elseif {[string match :* $cmd]} { + set nsorigin [nseval $location "::namespace origin $cmd"] + } else { + set nsorigin [namespace origin [nsjoin $location $cmd]] + } + } errM]} { + puts stderr "get_ns_dicts failed to determine origin of command '$cmd' adding to 'undetermined'" + puts stderr "error message: $errM" + lappend allundetermined $cmd + } else { + if {[nsprefix $nsorigin] ne $location} { + lappend allimported $cmd + } + } + } + default { + if {$ctype eq "imported"} { + set cmdorigin [namespace origin [nsjoin $location $cmd]] + #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source + #ie we don't need to follow a chain of 'imported' results. + set mixedtype i-[info cmdtype $cmdorigin] + } else { + set mixedtype $ctype + } + #assert ctype != imported + #review - we don't have a way to mark as both native and ensemble + switch -- $ctype { + i-native - native { + lappend allnative $cmd + } + i-ensemble - ensemble { + lappend allensembles $cmd + } + i-alias - alias { + #review + lappend allaliases $cmd + } + i-object - object { + if {[info object isa object ${location}::$cmd]} { + lappend allooobjects $cmd + if {[info object isa class ${location}::$cmd]} { + lappend allooclasses $cmd + } + } + } + i-privateObject - privateObject { + lappend allooobjects $cmd + lappend allooprivateobjects $cmd + } + i-privateClass - privateClass { + lappend allooobjects $cmd + lappend allooprivateclasses $cmd + } + i-interp - interp { + lappend allinterps $cmd + } + i-coroutine - coroutine { + lappend allcoroutines $cmd + } + i-zlibStream - zlibStream { + lappend allzlibstreams $cmd + } + default { + #there may be other registered types + #(extensible with Tcl_RegisterCommandTypeName) + lappend allothers $cmd + } - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd - } - } + } - if {[catch { - if {$cmd eq ""} { - #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. - set nsorigin [namespace origin ${location}::] - } elseif {[string match :* $cmd]} { - set nsorigin [nseval $location "::namespace origin $cmd"] - } else { - set nsorigin [namespace origin [nsjoin $location $cmd]] - } - } errM]} { - puts stderr "get_ns_dicts failed to determine origin of command '$cmd' adding to 'undetermined'" - puts stderr "error message: $errM" - lappend allundetermined $cmd - } else { - if {[nsprefix $nsorigin] ne $location} { - lappend allimported $cmd } } } @@ -1107,6 +1238,12 @@ namespace eval punk::ns { set procs [lsearch -all -inline $allprocs $glob] #set aliases [lsearch -all -inline $allaliases $glob] set ensembles [lsearch -all -inline $allensembles $glob] + set native [lsearch -all -inline $allnative $glob] + set coroutines [lsearch -all -inline $allcoroutines $glob] + set interps [lsearch -all -inline $allinterps $glob] + set zlibstreams [lsearch -all -inline $allzlibstreams $glob] + set ooprivateobjects [lsearch -all -inline $allooprivateobjects $glob] + set ooprivateclasses [lsearch -all -inline $allooprivateclasses $glob] set ooobjects [lsearch -all -inline $allooobjects $glob] set ooclasses [lsearch -all -inline $allooclasses $glob] set imported [lsearch -all -inline $allimported $glob] @@ -1118,8 +1255,14 @@ namespace eval punk::ns { set procs $allprocs #set aliases $allaliases set ensembles $allensembles + set native $allnative + set coroutines $allcoroutines + set interps $allinterps + set zlibstreams $allzlibstreams set ooobjects $allooobjects set ooclasses $allooclasses + set ooprivateobjects $allooprivateobjects + set ooprivateclasses $allooprivateclasses set imported $allimported set undetermined $allundetermined } @@ -1150,8 +1293,14 @@ namespace eval punk::ns { imported $imported\ aliases $aliases\ ensembles $ensembles\ + native $native\ + coroutines $coroutines\ + interps $interps\ + zlibstreams $zlibstreams\ ooobjects $ooobjects\ ooclasses $ooclasses\ + ooprivateobjects $ooprivateobjects\ + ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ namespacepath $nspathdict\ @@ -1644,9 +1793,10 @@ namespace eval punk::ns { set argspecs { -targetnamespace -default "" -optional 1 -prefix -default "" -optional 1 + *values -min 1 -max 1 sourcepattern -type string -optional 0 } - lassign [punk::args::opts_values $argspecs $args -minvalues 1 -maxvalues 1] _o opts _v values + lassign [dict values [punk::args::get_dict $argspecs $args]] opts values set sourcepattern [dict get $values sourcepattern] set source_ns [namespace qualifiers $sourcepattern] diff --git a/src/modules/punk/path-999999.0a1.0.tm b/src/modules/punk/path-999999.0a1.0.tm index e111967..3996d1c 100644 --- a/src/modules/punk/path-999999.0a1.0.tm +++ b/src/modules/punk/path-999999.0a1.0.tm @@ -156,14 +156,17 @@ namespace eval punk::path { #[para] ie - the driveletter alone in paths such as c:/etc will still be case insensitive. (ie c:/ETC/* will match C:/ETC/blah but not C:/etc/blah) #[para] Explicitly specifying -nocase 0 will require the entire case to match including the driveletter. - set defaults [dict create\ + set opts [dict create\ -nocase \uFFFF\ ] - set known_opts [dict keys $defaults] - set opts [dict merge $defaults $args] - dict for {k v} $args { - if {$k ni $known_opts} { - error "Unrecognised options $k - known options: $known_opts" + foreach {k v} $args { + switch -- $k { + -nocase { + dict set opts $k $v + } + default { + error "Unrecognised option '$k'. Known-options: [dict keys $opts]" + } } } # -- --- --- --- --- --- diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 6cb25e0..9841fa3 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -25,11 +25,14 @@ set tcl_interactive 1 - package require Thread package require shellfilter -package require shellrun -package require punk +#package require shellrun +#package require punk +package require punk::lib +package require punk::aliascore +punk::aliascore::init +package require punk::config package require punk::ns package require punk::ansi package require punk::console @@ -56,11 +59,17 @@ if {![info exists ::env(TERM)]} { #todo - move to less generic namespace ie punk::repl namespace eval repl { + variable codethread + if {![info exists codethread]} { + set codethread "" + } + variable codethread_cond + variable screen_last_chars "" ;#a small sliding append buffer for last char of any screen output to detect \n vs string variable screen_last_char_list [list] - variable last_unknown "" - variable prompt_reset_flag 0 ;#trigger repl to re-retrieve prompt settings + #variable last_unknown "" + tsv::set repl last_unknown "" variable output "" #important not to initialize - as it can be preset by cooperating package before app-punk has been package required #(this is an example of a deaddrop) @@ -68,9 +77,14 @@ namespace eval repl { } namespace eval punk::repl { + tsv::set repl runid 0 + tsv::set repl runchunks-0 [list] ;#last_run_display + + variable debug_repl 0 variable signal_control_c 0 variable signal_control_c_msg "" + variable prompt_reset_flag 0 ;#trigger repl to re-retrieve prompt settings proc todo {} { puts "tcl History" @@ -78,25 +92,6 @@ namespace eval punk::repl { puts "deaddrop package for a consistent way for modules to leave small notes to others that may come later." } - proc has_script_var_bug {} { - set script {set j [list spud] ; list} - append script \n - uplevel #0 $script - set rep1 [tcl::unsupported::representation $::j] - set script "" - set rep2 [tcl::unsupported::representation $::j] - - set nostring1 [string match "*no string" $rep1] - set nostring2 [string match "*no string" $rep2] - - #we assume it should have no string rep in either case - #Review: check Tcl versions for behaviour/consistency - if {!$nostring2} { - return true - } else { - return false - } - } #since we are targeting Tcl 8.6+ - we should be using 'interp bgerror .' #todo - make optional/configurable? proc bgerror2 {args} { @@ -134,104 +129,153 @@ namespace eval repl { } +proc ::punk::repl::init_signal_handlers {} { + if {$::tcl_platform(platform) eq "windows"} { + #puts stdout "===============repl loading twapi===========" + if {![catch {package require twapi}]} { + + #If script launched with windows batch file - we have to be careful to stop a ctrl-c from eventually reaching the batch file when the program terminates, even if fully handled here. + #This is done from within the launching batch file + proc ::punk::repl::handler_console_control {args} { + variable signal_control_c + flush stderr + variable signal_control_c_msg + switch -- [lindex $args 0] { + ctrl-c { + #puts stderr "->event $args" + flush stderr + incr signal_control_c + #rputs stderr "* console_control: $args" + if {$::punk::console::is_raw} { + if {[lindex $::errorCode 0] eq "CHILDKILLED"} { + #rputs stderr "\n|repl> ctrl-c errorCode: $::errorCode" + #avoid spurious triggers after interrupting a command.. + #review - dodgy.. we just want to interrupt child processes but then still be able to interrupt repl + set ::punk::repl::signal_control_c 0 + set preverr [string map [list "child killed" "child_killed"] $::errorInfo] + catch {error $preverr} ;#for errorInfo display + return 42 + } else { + #how to let rawmode loop handle it? It doesn't seem to get through if we return 0 + #puts stderr "signal ctrl-c while in raw mode" + #flush stderr + set signal_control_c_msg "signal ctrl-c $signal_control_c rawmode" + if {[catch { + lassign [punk::console::get_size] _w console_width _h console_height + } errM]} { + puts stderr "signal ctrl-c error get_size error:$errM" + } + + if {$signal_control_c < 3} { + set remaining [expr {3 - $signal_control_c}] + if {[catch { + punk::repl::console_controlnotification "[a+ web-orange]ctrl-c ($remaining more to quit, enter to continue)[a]" $console_width $console_height + } errM]} { + puts stderr "signal ctrl-c error console_controlnotification error:$errM" + } + } elseif {$signal_control_c == 3} { + #puts stderr "signal ctrl-c x3 received - quitting." + if {[catch { + punk::repl::console_controlnotification "ctrl-c x3 received - quitting punk shell" $console_width $console_height + } errM]} { + puts stderr "signal ctrl-c error console_controlnotification error:$errM" + } + flush stderr + after 25 + quit + return 1 + } elseif {$signal_control_c > 5} { + #fallback if quit didn't work + #puts stderr "signal ctrl-c $signal_control_c received - sending to default handler" + if {[catch { + punk::repl::console_controlnotification "ctrl-c $signal_control_c received - sending to default handler" $console_width $console_height + } errM]} { + puts stderr "signal ctrl-c error console_controlnotification error:$errM" + } + flush stderr + punk::console::mode line + return 0 + } + + return 1 + #after 200 {exit 42} ;#temp + #return 42 + } + } + -if {$::tcl_platform(platform) eq "windows"} { - #puts stdout "===============repl loading twapi===========" - if {![catch {package require twapi}]} { - - #If script launched with windows batch file - we have to be careful to stop a ctrl-c from eventually reaching the batch file when the program terminates, even if fully handled here. - #This is done from within the launching batch file - proc ::punk::repl::handler_console_control {args} { - variable signal_control_c - variable signal_control_c_msg - switch -- [lindex $args 0] { - ctrl-c { - #puts stderr "->event $args" - flush stderr - incr signal_control_c - #rputs stderr "* console_control: $args" - if {$::punk::console::is_raw} { if {[lindex $::errorCode 0] eq "CHILDKILLED"} { - #rputs stderr "\n|repl> ctrl-c errorCode: $::errorCode" - #avoid spurious triggers after interrupting a command.. - #review - dodgy.. we just want to interrupt child processes but then still be able to interrupt repl - set ::punk::repl::signal_control_c 0 + set signal_control_c 0 set preverr [string map [list "child killed" "child_killed"] $::errorInfo] catch {error $preverr} ;#for errorInfo display - return 42 - } else { - #how to let rawmode loop handle it? It doesn't seem to get through if we return 0 - #puts stderr "signal ctrl-c while in raw mode" + return 42 + } + if {[catch { + lassign [punk::console::get_size] _w console_width _h console_height + } errM]} { + puts stderr "signal ctrl-c error get_size error:$errM" + } + + #note - returning 0 means pass event to other handlers including OS default handler + if {$signal_control_c <= 2} { + set remaining [expr {3 - $signal_control_c}] + #puts stderr "signal ctrl-c (perform $remaining more to quit, enter to return to repl)" #flush stderr - set signal_control_c_msg "signal ctrl-c while in raw mode" - if {$signal_control_c > 5} { - puts stderr "signal ctrl-c $signal_control_c received - sending to default handler" - flush stderr - punk::mode line - return 0 + if {[catch { + punk::repl::console_controlnotification "ctrl-c ($remaining more to quit, enter to continue)" $console_width $console_height + } errM]} { + puts stderr "signal ctrl-c error console_controlnotification error:$errM" } - - return 1 - #after 200 {exit 42} ;#temp - #return 42 + return 1 + } elseif {$signal_control_c == 3} { + #puts stderr "signal ctrl-c x3 received - quitting." + if {[catch { + punk::repl::console_controlnotification "ctrl-c x3 received - quitting punk shell" $console_width $console_height + } errM]} { + puts stderr "signal ctrl-c error console_controlnotification error:$errM" + } + flush stderr + after 25 + quit + return 1 + } elseif {$signal_control_c == 4} { + puts stderr "signal ctrl-c x4 received - one more to hard exit" + flush stderr + return 1 + } elseif {$signal_control_c >= 5} { + #a script that allows events to be processed could still be running + puts stderr "signal ctrl-c x5 received - hard exit" + flush stderr + after 25 + exit 499 ;# HTTP 'client closed request' - just for the hell of it. + } else { + puts stderr "signal ctrl-c $signal_control_c received" + flush stderr + #return 0 to fall through to default handler + return 0 } - } - - if {[lindex $::errorCode 0] eq "CHILDKILLED"} { - set signal_control_c 0 - set preverr [string map [list "child killed" "child_killed"] $::errorInfo] - catch {error $preverr} ;#for errorInfo display - return 42 - } - #note - returning 0 means pass event to other handlers including OS default handler - if {$signal_control_c <= 2} { - set remaining [expr {3 - $signal_control_c}] - puts stderr "signal ctrl-c (perform $remaining more to quit, enter to return to repl)" - flush stderr - return 1 - } elseif {$signal_control_c == 3} { - puts stderr "signal ctrl-c x3 received - quitting." - flush stderr - after 25 - quit - return 1 - } elseif {$signal_control_c == 4} { - puts stderr "signal ctrl-c x4 received - one more to hard exit" - flush stderr + } + default { + puts stderr "unhandled console signal $args" return 1 - } elseif {$signal_control_c >= 5} { - #a script that allows events to be processed could still be running - puts stderr "signal ctrl-c x5 received - hard exit" - flush stderr - after 25 - exit 499 ;# HTTP 'client closed request' - just for the hell of it. - } else { - puts stderr "signal ctrl-c $signal_control_c received" - flush stderr - #return 0 to fall through to default handler - return 0 } - - } - default { - puts stderr "unhandled console signal $args" - return 1 } } + twapi::set_console_control_handler ::punk::repl::handler_console_control + #we can't yet emit from an event with proper prompt handling - + #repl::rputs stdout "twapi loaded" + } else { + #repl::rputs stderr " Failed to load twapi" } - twapi::set_console_control_handler ::punk::repl::handler_console_control - #we can't yet emit from an event with proper prompt handling - - #repl::rputs stdout "twapi loaded" } else { - #repl::rputs stderr " Failed to load twapi" + #TODO } -} else { - #TODO } -interp alias {} smcup {} ::punk::console::enable_alt_screen -interp alias {} rmcup {} ::punk::console::disable_alt_screen +#console handler may already be set, but in another thread/interp - so we can't use existence of proc to test +#we're ok with an existing handler - just catch for now. REVIEW we should make sure it didn't fail the first time +catch {punk::repl::init_signal_handlers} # moved to punk package.. @@ -248,302 +292,6 @@ interp alias {} rmcup {} ::punk::console::disable_alt_screen -# unknown -- -# This procedure is called when a Tcl command is invoked that doesn't -# exist in the interpreter. It takes the following steps to make the -# command available: -# -# 1. See if the autoload facility can locate the command in a -# Tcl script file. If so, load it and execute it. -# 2. If the command was invoked interactively at top-level: -# (a) see if the command exists as an executable UNIX program. -# If so, "exec" the command. -# (b) see if the command requests csh-like history substitution -# in one of the common forms !!, !, or ^old^new. If -# so, emulate csh's history substitution. -# (c) see if the command is a unique abbreviation for another -# command. If so, invoke the command. -# -# Arguments: -# args - A list whose elements are the words of the original -# command, including the command name. - -#review - we shouldn't really be doing this -#We need to work out if we can live with the real default unknown and just inject some special cases at the beginning before falling-back to the normal one - -proc ::unknown args { - #puts stderr "unk>$args" - variable ::tcl::UnknownPending - global auto_noexec auto_noload env tcl_interactive errorInfo errorCode - - if {[info exists errorInfo]} { - set savedErrorInfo $errorInfo - } - if {[info exists errorCode]} { - set savedErrorCode $errorCode - } - - set name [lindex $args 0] - if {![info exists auto_noload]} { - # - # Make sure we're not trying to load the same proc twice. - # - if {[info exists UnknownPending($name)]} { - return -code error "self-referential recursion\ - in \"unknown\" for command \"$name\"" - } - set UnknownPending($name) pending - set ret [catch { - auto_load $name [uplevel 1 {::namespace current}] - } msg opts] - unset UnknownPending($name) - if {$ret != 0} { - dict append opts -errorinfo "\n (autoloading \"$name\")" - return -options $opts $msg - } - if {![array size UnknownPending]} { - unset UnknownPending - } - if {$msg} { - if {[info exists savedErrorCode]} { - set ::errorCode $savedErrorCode - } else { - unset -nocomplain ::errorCode - } - if {[info exists savedErrorInfo]} { - set errorInfo $savedErrorInfo - } else { - unset -nocomplain errorInfo - } - set code [catch {uplevel 1 $args} msg opts] - if {$code == 1} { - # - # Compute stack trace contribution from the [uplevel]. - # Note the dependence on how Tcl_AddErrorInfo, etc. - # construct the stack trace. - # - set errInfo [dict get $opts -errorinfo] - set errCode [dict get $opts -errorcode] - set cinfo $args - if {[string length [encoding convertto utf-8 $cinfo]] > 150} { - set cinfo [string range $cinfo 0 150] - while {[string length [encoding convertto utf-8 $cinfo]] > 150} { - set cinfo [string range $cinfo 0 end-1] - } - append cinfo ... - } - set tail "\n (\"uplevel\" body line 1)\n invoked\ - from within\n\"uplevel 1 \$args\"" - set expect "$msg\n while executing\n\"$cinfo\"$tail" - if {$errInfo eq $expect} { - # - # The stack has only the eval from the expanded command - # Do not generate any stack trace here. - # - dict unset opts -errorinfo - dict incr opts -level - return -options $opts $msg - } - # - # Stack trace is nested, trim off just the contribution - # from the extra "eval" of $args due to the "catch" above. - # - set last [string last $tail $errInfo] - if {$last + [string length $tail] != [string length $errInfo]} { - # Very likely cannot happen - return -options $opts $msg - } - set errInfo [string range $errInfo 0 $last-1] - set tail "\"$cinfo\"" - set last [string last $tail $errInfo] - if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo $errInfo $msg - } - set errInfo [string range $errInfo 0 $last-1] - set tail "\n invoked from within\n" - set last [string last $tail $errInfo] - if {$last + [string length $tail] == [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo [string range $errInfo 0 $last-1] $msg - } - set tail "\n while executing\n" - set last [string last $tail $errInfo] - if {$last + [string length $tail] == [string length $errInfo]} { - return -code error -errorcode $errCode \ - -errorinfo [string range $errInfo 0 $last-1] $msg - } - return -options $opts $msg - } else { - dict incr opts -level - return -options $opts $msg - } - } - } - #set isrepl [expr {[file tail [file rootname [info script]]] eq "repl"}] - set isrepl $::repl::running ;#may not be reading though - if {$isrepl} { - #set ::tcl_interactive 1 - } - if {$isrepl || (([info level] == 1) && (([info script] eq "" ) ) - && ([info exists tcl_interactive] && $tcl_interactive))} { - if {![info exists auto_noexec]} { - set new [auto_execok $name] - if {$new ne ""} { - set redir "" - if {[namespace which -command console] eq ""} { - set redir ">&@stdout <@stdin" - } - - - #windows experiment todo - use twapi and named pipes - #twapi::namedpipe_server {\\.\pipe\something} - #Then override tcl 'exec' and replace all stdout/stderr/stdin with our fake ones - #These can be stacked with shellfilter and operate as OS handles - which we can't do with fifo2 etc - # - - if {[string first " " $new] > 0} { - set c1 $name - } else { - set c1 $new - } - - # -- --- --- --- --- - set idlist_stdout [list] - set idlist_stderr [list] - set shellrun::runout "" - #when using exec with >&@stdout (to ensure process is connected to console) - the output unfortunately doesn't go via the shellfilter stacks - #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 exec_unknown]} { - #This runs external executables in a context in which they are not attached to a terminal - #VIM for example won't run, and various programs can't detect terminal dimensions etc and/or will default to ansi-free output - #ctrl-c propagation also needs to be considered - - set teehandle punksh - uplevel 1 [list ::catch \ - [list ::shellfilter::run [concat [list $new] [lrange $args 1 end]] -teehandle $teehandle -inbuffering line -outbuffering none ] \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - - if {[string trim $::tcl::UnknownResult] ne "exitcode 0"} { - dict set ::tcl::UnknownOptions -code error - set ::tcl::UnknownResult "Non-zero exit code from command '$args' $::tcl::UnknownResult" - } else { - #no point returning "exitcode 0" if that's the only non-error return. - #It is misleading. Better to return empty string. - set ::tcl::UnknownResult "" - } - } else { - set ::punk::last_run_display [list] - - set redir ">&@stdout <@stdin" - uplevel 1 [list ::catch [concat exec $redir $new [lrange $args 1 end]] ::tcl::UnknownResult ::tcl::UnknownOptions] - #we can't detect stdout/stderr output from the exec - #for now emit an extra \n on stderr - #todo - there is probably no way around this but to somehow exec in the context of a completely separate console - #This is probably a tricky problem - especially to do cross-platform - # - # - use [dict get $::tcl::UnknownOptions -code] (0|1) exit - if {[dict get $::tcl::UnknownOptions -code] == 0} { - set c green - set m "ok" - } else { - set c yellow - set m "errorCode $::errorCode" - } - set chunklist [list] - lappend chunklist [list "info" "[a $c]$m[a] " ] - set ::punk::last_run_display $chunklist - - } - - foreach id $idlist_stdout { - shellfilter::stack::remove stdout $id - } - foreach id $idlist_stderr { - shellfilter::stack::remove stderr $id - } - # -- --- --- --- --- - - - #uplevel 1 [list ::catch \ - # [concat exec $redir $new [lrange $args 1 end]] \ - # ::tcl::UnknownResult ::tcl::UnknownOptions] - - #puts "===exec with redir:$redir $::tcl::UnknownResult ==" - dict incr ::tcl::UnknownOptions -level - return -options $::tcl::UnknownOptions $::tcl::UnknownResult - } - } - if {$name eq "!!"} { - set newcmd [history event] - } elseif {[regexp {^!(.+)$} $name -> event]} { - set newcmd [history event $event] - } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} { - set newcmd [history event -1] - catch {regsub -all -- $old $newcmd $new newcmd} - } - if {[info exists newcmd]} { - tclLog $newcmd - history change $newcmd 0 - uplevel 1 [list ::catch $newcmd \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - dict incr ::tcl::UnknownOptions -level - return -options $::tcl::UnknownOptions $::tcl::UnknownResult - } - - set ret [catch {set candidates [info commands $name*]} msg] - if {$name eq "::"} { - set name "" - } - if {$ret != 0} { - dict append opts -errorinfo \ - "\n (expanding command prefix \"$name\" in unknown)" - return -options $opts $msg - } - # Filter out bogus matches when $name contained - # a glob-special char [Bug 946952] - if {$name eq ""} { - # Handle empty $name separately due to strangeness - # in [string first] (See RFE 1243354) - set cmds $candidates - } else { - set cmds [list] - foreach x $candidates { - if {[string first $name $x] == 0} { - lappend cmds $x - } - } - } - - #punk - disable prefix match search - set default_cmd_search 0 - if {$default_cmd_search} { - if {[llength $cmds] == 1} { - uplevel 1 [list ::catch [lreplace $args 0 0 [lindex $cmds 0]] \ - ::tcl::UnknownResult ::tcl::UnknownOptions] - dict incr ::tcl::UnknownOptions -level - return -options $::tcl::UnknownOptions $::tcl::UnknownResult - } - if {[llength $cmds]} { - return -code error "ambiguous command name \"$name\": [lsort $cmds]" - } - } else { - #punk hacked version - report matches but don't run - if {[llength $cmds]} { - return -code error "unknown command name \"$name\": possible match(es) [lsort $cmds]" - } - - } - - - } - return -code error -errorcode [list TCL LOOKUP COMMAND $name] \ - "invalid command name \"$name\"" -} -punk::configure_unknown ;#must be called because we hacked the tcl 'unknown' proc - proc punk::repl::reset_prompt {} { @@ -558,7 +306,7 @@ proc punk::repl::reset_terminal {} { puts -nonewline stdout [::punk::ansi::reset] } -proc repl::get_prompt_config {} { +proc punk::repl::get_prompt_config {} { if {$::tcl_interactive} { set RST [a] set resultprompt "[a green bold]-$RST " @@ -573,10 +321,15 @@ proc repl::get_prompt_config {} { } return [list resultprompt $resultprompt nlprompt $nlprompt infoprompt $infoprompt debugprompt $debugprompt] } + proc repl::start {inchan args} { - #puts stderr "-->repl::start $inchan $args" + puts stderr "-->repl::start $inchan $args" + variable codethread + #review + if {$codethread eq ""} { + error "start - no codethread. call init first. (options -safe 0|1)" + } variable commandstr - variable readingchunk # --- variable editbuf @@ -585,7 +338,6 @@ proc repl::start {inchan args} { variable editbuf_active_index # --- - variable running variable reading variable done set done 0 @@ -599,9 +351,20 @@ proc repl::start {inchan args} { } incr startinstance set loopinstance 0 - set running 1 + thread::send $codethread { + #set ::punk::repl::codethread::running 1 + + #the interp in which commands such as d/ run + #we need to namespace eval for the -safe interp which may not have the packages loaded (or be able to) but still needs default values + #punk::repl::codethread::running is required whether safe or not. + interp eval code { + namespace eval ::punk::repl::codethread {} + set ::punk::repl::codethread::running 1 + namespace eval ::punk::ns::ns_current {} + set ::punk::ns::ns_current :: + } + } set commandstr "" - set readingchunk "" # --- set editbuf [punk::repl::class::class_editbuf new {}] @@ -617,7 +380,7 @@ proc repl::start {inchan args} { set ::punk::console::ansi_wanted -1 } } - set prompt_config [get_prompt_config] + set prompt_config [punk::repl::get_prompt_config] doprompt "P% " fileevent $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] set reading 1 @@ -626,6 +389,9 @@ proc repl::start {inchan args} { #set punk::console::tabwidth [punk::console::get_tabstop_apparent_width] } vwait [namespace current]::done + fileevent $inchan readable {} + + #puts stderr "-->start done = $::repl::done" #todo - override exit? #after 0 ::repl::post_operations @@ -644,7 +410,16 @@ proc repl::start {inchan args} { return $temp } } - punk::mode line + + + variable codethread_cond + tsv::unset codethread_$codethread + thread::cancel $codethread + thread::cond destroy $codethread_cond ;#race if we destroy cond before child thread has exited - as it can send a -async quit + set codethread "" + set codethread_cond "" + punk::console::mode line ;#review - revert to line mode on final exit - but we may be exiting a nested repl + puts "end repl::start" return 0 } proc repl::post_operations {} { @@ -691,8 +466,8 @@ proc repl::reopen_stdin {} { #todo - avoid putting this in gobal namespace? #collisions with other libraries apps? -proc quit {} { - set ::repl::done "quit" +proc punk::repl::quit {args} { + set ::repl::done "quit {*}$args" #puts stderr "quit called" return "" ;#make sure to return nothing so "quit" doesn't land on stdout } @@ -976,10 +751,8 @@ proc repl::screen_needs_clearance {} { namespace eval repl { variable startinstance 0 variable loopinstance 0 - variable loopcomplete 0 - - variable in_repl_handler [list] + variable last_controlc_count 0 } namespace eval punk::repl::class { @@ -987,7 +760,6 @@ namespace eval punk::repl::class { } - #multiline editing buffer oo::class create class_editbuf { variable o_context @@ -1270,9 +1042,9 @@ namespace eval punk::repl::class { #todo - index base??? method lines_numbered {args} { #build a paired list so we don't have to do various calcs on end+ end- etc checking llength - #punk::range will use lseq if available - else use it's own slower code + #punk::lib::range will use lseq if available - else use it's own slower code set max [llength $o_rendered_lines] ;#assume >=1 - set nums [punk::range 1 $max] + set nums [punk::lib::range 1 $max] set numline_list [list] foreach n $nums ln $o_rendered_lines { lappend numline_list [list $n $ln] @@ -1437,6 +1209,9 @@ proc ::punk::repl::repl_handler_checkcontrolsignal_linemode {inputchan} { } } } + +#This is not called from the signal handler - so we can't affect the signal handling with return +# proc ::punk::repl::repl_handler_checkcontrolsignal_rawmode {inputchan} { variable signal_control_c variable signal_control_c_msg @@ -1444,50 +1219,19 @@ proc ::punk::repl::repl_handler_checkcontrolsignal_rawmode {inputchan} { #if {$::tcl_interactive} { # ::repl::rputs stderr "\n|repl> repl_handler_checkcontrolsignal_rawmode ctrl-c errorCode 0: [lindex $::errorCode 0]" #} + set msg $signal_control_c_msg set signal_control_c_msg "" - if {$signal_control_c <= 2} { - set remaining [expr {3 - $signal_control_c}] - if {$::tcl_interactive} { - puts stderr "rawmode signal ctrl-c (perform $remaining more to quit, enter to return to repl)" - flush stderr - } - return 1 - } elseif {$signal_control_c == 3} { - if {$::tcl_interactive} { - puts stderr "rawmode signal ctrl-c x3 received - quitting" - flush stderr - } - after 25 - quit - return 1 - } elseif {$signal_control_c == 4} { - if {$::tcl_interactive} { - puts stderr "rawmode signal ctrl-c x4 received - one more to hard exit" - flush stderr - } - return 1 - } elseif {$signal_control_c >= 5} { - #a script that allows events to be processed could still be running - if {$::tcl_interactive} { - puts stderr "rawmode signal ctrl-c x5 received - hard exit" - flush stderr - } - punk::mode line - after 25 - exit 499 ;# HTTP 'client closed request' - just for the hell of it. - } else { - #shouldn't get here.. if we do somehow - let the default handler have a go - puts stderr "rawmode signal ctrl-c $signal_control_c received" - flush stderr - #return 0 to fall through to default handler - punk::mode line - return 0 - } + } else { + set msg "" } + return [list count $signal_control_c msg $msg] } -proc repl::repl_handler_restorechannel {inputchan previous_input_state} { +proc punk::repl::repl_handler_restorechannel_if_not_eof {inputchan previous_input_state} { + if {$inputchan ni [chan names] || [eof $inputchan]} { + return + } if {[chan conf $inputchan] ne $previous_input_state} { set restore_input_conf [dict remove $previous_input_state -inputmode] ;#Attempting to set input mode often gives permission denied on windows - why? if {[catch { @@ -1506,18 +1250,20 @@ proc repl::repl_handler {inputchan prompt_config} { variable in_repl_handler set in_repl_handler [list $inputchan $prompt_config] # -- + variable last_controlc_count - variable prompt_reset_flag + upvar ::punk::repl::prompt_reset_flag prompt_reset_flag if {$prompt_reset_flag == 1} { - set prompt_config [get_prompt_config] + set prompt_config [punk::repl::get_prompt_config] set prompt_reset_flag 0 } fileevent $inputchan readable {} upvar ::punk::console::input_chunks_waiting input_chunks_waiting #note -inputmode not available in Tcl 8.6 for chan configure! + #According to DKF - -buffering option doesn't affect input channels set rawmode 0 - set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the stdin state + set original_input_conf [chan configure $inputchan] ;#whether repl is in line or raw mode - we restore the inputchan (stdin) state if {[dict exists $original_input_conf -inputmode]} { if {[dict get $original_input_conf -inputmode] eq "raw"} { #user or script has apparently put stdin into raw mode - update punk::console::is_raw to match @@ -1536,7 +1282,7 @@ proc repl::repl_handler {inputchan prompt_config} { } if {!$rawmode} { - + #linemode #stdin with line-mode readable events (at least on windows for Tcl 8.7a6 to 9.0a) can get stuck with bytes pending when input longer than 100chars - even though there is a linefeed further on than that. #This potentially affects a reasonable number of Tcl8.7 kit/tclsh binaries out in the wild. @@ -1546,8 +1292,6 @@ proc repl::repl_handler {inputchan prompt_config} { #the readable event only gives us 200 bytes (same problem may be at 4k/8k in other versions) #This occurs whether we use gets or read - set stdinlines [list] - set linemax 5 ;#not an absolute.. - set lc 0 if {[dict get $original_input_conf -blocking] ne "0"} { chan configure $inputchan -blocking 0 } @@ -1562,7 +1306,6 @@ proc repl::repl_handler {inputchan prompt_config} { set waitinglines [split $allwaiting \n] foreach ln [lrange $waitinglines 0 end-1] { lappend stdinlines $ln - incr lc } set waitingchunk [lindex $waitinglines end] # -- @@ -1575,9 +1318,7 @@ proc repl::repl_handler {inputchan prompt_config} { lappend stdinlines $waitingchunk[string range $chunk 0 end-1] #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" - if {![chan eof $inputchan]} { - repl_handler_restorechannel $inputchan $original_input_conf - } + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] } else { set input_chunks_waiting($inputchan) [list $allwaiting] @@ -1615,10 +1356,7 @@ proc repl::repl_handler {inputchan prompt_config} { #punk::console::cursorsave_move_emitblock_return 25 30 [textblock::frame -title line "[a+ green]$waitingchunk[a][a+ red][ansistring VIEW -lf 1 $ln][a+ green]pending:[chan pending input stdin][a]"] if {[string index $ln end] eq "\n"} { lappend stdinlines [string range $ln 0 end-1] - incr lc - if {![chan eof $inputchan]} { - repl_handler_restorechannel $inputchan $original_input_conf - } + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] } else { lappend input_chunks_waiting($inputchan) $ln @@ -1627,43 +1365,41 @@ proc repl::repl_handler {inputchan prompt_config} { } } else { + #rawmode if {[info exists input_chunks_waiting($inputchan)] && [llength $input_chunks_waiting($inputchan)]} { #we could concat and process as if one chunk - but for now at least - we want to preserve the 'chunkiness' - set wchunks $input_chunks_waiting($inputchan) - set ch [lindex $wchunks 0] - set input_chunks_waiting($inputchan) [lrange $wchunks 1 end] - - uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $ch [list] $prompt_config] - + set chunkwaiting_zero [lpop input_chunks_waiting($inputchan) 0] ;#pop off lhs of wait list (tcl 8.6 is tcl imp of lpop - a little slower) + uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $chunkwaiting_zero [list] $prompt_config] } else { punk::repl::repl_handler_checkchannel $inputchan - punk::repl::repl_handler_checkcontrolsignal_rawmode $inputchan - - if {[dict get $original_input_conf -blocking] ne "0" || [dict get $original_input_conf -translation] ne "lf"} { - chan configure $inputchan -blocking 0 - chan configure $inputchan -translation lf + set signalinfo [punk::repl::repl_handler_checkcontrolsignal_rawmode $inputchan] + if {[dict get $signalinfo count] > $last_controlc_count} { + set continue 0 + set last_controlc_count [dict get $signalinfo count] + } else { + set continue 1 } - set chunk [read $inputchan] - if {![chan eof $inputchan]} { - repl_handler_restorechannel $inputchan $original_input_conf - } - uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] - while {[join $input_chunks_waiting($inputchan)] ne ""} { - #puts "...[llength $input_chunks_waiting($inputchan)]" - set wchunks $input_chunks_waiting($inputchan) - set ch [lindex $wchunks 0] - set input_chunks_waiting($inputchan) [lrange $wchunks 1 end] - uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $ch [list] $prompt_config] + if {$continue} { + if {[dict get $original_input_conf -blocking] ne "0" || [dict get $original_input_conf -translation] ne "lf"} { + chan configure $inputchan -blocking 0 + chan configure $inputchan -translation lf + } + set chunk [read $inputchan] + + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] + while {[llength $input_chunks_waiting($inputchan)]} { + set chunkzero [lpop input_chunks_waiting($inputchan) 0] + if {$chunkzero eq ""} {continue} ;#why empty waiting - and is there any point passing on? + uplevel #0 [list repl::repl_process_data $inputchan raw-waiting $chunkzero [list] $prompt_config] + } } } } - - if {![chan eof $inputchan]} { - ################################################################################## #Re-enable channel read handler only if no waiting chunks - must process in order ################################################################################## @@ -1677,7 +1413,7 @@ proc repl::repl_handler {inputchan prompt_config} { #repl_handler_checkchannel $inputchan fileevent $inputchan readable {} set reading 0 - set running 0 + thread::send -async $::repl::codethread {set ::punk::repl::codethread::running 0} if {$::tcl_interactive} { rputs stderr "\nrepl_handler EOF inputchannel:[chan conf $inputchan]" #rputs stderr "\n|repl> ctrl-c EOF on $inputchan." @@ -1698,39 +1434,149 @@ proc punk::repl::editbuf {index args} { } interp alias {} editbuf {} ::punk::repl::editbuf -proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { + +proc punk::repl::console_debugview {editbuf consolewidth args} { + package require textblock + variable debug_repl + if {$debug_repl <= 0} { + return [dict create width 0 height 0 topleft {}] + } + set defaults {-row 10 -rightmargin 2 -chunktype raw-read} + #dict for {k v} $args { + # switch -- $k { + # -row - -chunktype {} + # default { + # error "console_debugview unrecognised option '$k'. Known-options [dict keys $defaults]" + # } + # } + #} + set opts [dict merge $defaults $args] + set opt_row [dict get $opts -row] + set opt_chunktype [dict get $opts -chunktype] + set opt_rightmargin [dict get $opts -rightmargin] + + #debugview_raw frame + set RST [a] + if {[catch { + set info [$editbuf debugview_raw] + if {$opt_chunktype eq "raw-waiting"} { + set info [a+ bold yellow]$info$RST + } else { + set info [a+ green]$info$RST + } + #set lines [lines_as_list -ansireplays 1 $info] + set lines [lines_as_list -ansireplays 0 $info] + if {[llength $lines] > 20} { + set lines [lrange $lines end-19 end] + set info [::join $lines \n] + } + set debug_height [expr {[llength $lines]+2}] ;#framed height + } errM]} { + set info [textblock::frame -buildcache 0 -title "[a red]error$RST" $errM] + set debug_height [textblock::height $info] + } else { + #treat as ephemeral (unreusable) frames due to varying width & height - therefore set -buildcache 0 + set info [textblock::frame -buildcache 0 -ansiborder [a+ bold green] -title "[a cyan]debugview_raw$RST" $info] + } + + set debug_width [textblock::widthtopline $info] + set patch_height [expr {2 + $debug_height + 2}] + set spacepatch [textblock::block $debug_width $patch_height " "] + puts -nonewline [punk::ansi::cursor_off] + #use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. + set debug_offset [[expr {$consolewidth - $debug_width - $opt_rightmargin}]] + set row_clear [expr {$opt_row -2}] + punk::console::move_emitblock_return $row_clear $debug_offset $spacepatch + punk::console::move_emitblock_return $opt_row $debug_offset $info + set topleft [list $debug_offset $opt_row] ;#col,row REVIEW + puts -nonewline [punk::ansi::cursor_on] + flush stdout + + return [dict create width $debug_width height $debug_height topleft $topleft] +} +proc punk::repl::console_editbufview {editbuf consolewidth args} { + package require textblock + upvar ::repl::editbuf_list editbuf_list + + set defaults {-row 10 -rightmargin 0} + set opts [dict merge $defaults $args] + set opt_row [dict get $opts -row] + set opt_rightmargin [dict get $opts -rightmargin] + + if {[catch { + set info [$editbuf view_lines_numbered] + set lines [lines_as_list -ansireplays 1 $info] + if {[llength $lines] > 20} { + set lines [lrange $lines end-19 end] + set info [punk::lib::list_as_lines $lines] + } + } editbuf_error]} { + set info [textblock::frame -buildcache 0 -title "[a red]error[a]" "$editbuf_error\n$::errorInfo"] + } else { + set title "[a cyan]editbuf [expr {[llength $editbuf_list]-1}] lines [$editbuf linecount][a]" + append title "[a+ yellow bold] col:[format %3s [$editbuf cursor_column]] row:[$editbuf cursor_row][a]" + set row1 " lastchar:[ansistring VIEW -lf 1 [$editbuf last_char]] lastgrapheme:[ansistring VIEW -lf 1 [$editbuf last_grapheme]]" + set row2 " lastansi:[ansistring VIEW -lf 1 [$editbuf last_ansi]]" + set info [a+ green bold]$row1\n$row2[a]\n$info + set info [textblock::frame -buildcache 0 -ansiborder [a+ green bold] -title $title $info] + } + set editbuf_width [textblock::widthtopline $info] + set spacepatch [textblock::block $editbuf_width 2 " "] + + #set editbuf_offset [expr {$consolewidth - $editbuf_width - $debug_width - 2}] + set editbuf_offset [expr {$consolewidth - $editbuf_width - $opt_rightmargin}] + + set row_clear [expr {$opt_row -2}] + punk::console::cursorsave_move_emitblock_return $row_clear $editbuf_offset $spacepatch + punk::console::cursorsave_move_emitblock_return $opt_row $editbuf_offset $info + + return [dict create width $editbuf_width] +} +proc punk::repl::console_controlnotification {message consolewidth consoleheight args} { + package require textblock + set defaults {-bottommargin 0 -rightmargin 0} + set opts [dict merge $defaults $args] + set opt_bottommargin [dict get $opts -bottommargin] + set opt_rightmargin [dict get $opts -rightmargin] + set messagelines [split $message \n] + set message [lindex $messagelines 0] ;#only allow single line + set info "[a+ bold red]$message[a]" + set hlt [dict get [textblock::framedef light] hlt] + set box [textblock::frame -boxmap [list tlc $hlt trc $hlt] -title $message -height 1] + set notification_width [textblock::widthtopline $info] + set box_offset [expr {$consolewidth - $notification_width - $opt_rightmargin}] + set row [expr {$consoleheight - $opt_bottommargin}] + punk::console::cursorsave_move_emitblock_return $row $box_offset $info + return [dict create width $notification_width] +} + +proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config} { variable loopinstance - variable loopcomplete incr loopinstance - set moredata 0 upvar ::punk::console::input_chunks_waiting input_chunks_waiting + upvar ::punk::repl::prompt_reset_flag prompt_reset_flag + + variable last_repl_char "" ;#last char emitted by this handler to stdout/stderr + variable lastoutchar "" + variable lasterrchar "" + variable commandstr + # --- + variable editbuf + variable editbuf_list + variable editbuf_linenum_submitted + + # --- + variable reading + variable id_outstack + upvar ::punk::config::running running_config + try { - variable prompt_reset_flag #catch {puts stderr "xx--->[rep $::arglej]"} if {$prompt_reset_flag == 1} { - set prompt_config [get_prompt_config] + set prompt_config [punk::repl::get_prompt_config] set prompt_reset_flag 0 } - variable last_repl_char "" ;#last char emitted by this handler to stdout/stderr - variable lastoutchar "" - variable lasterrchar "" - variable cursorcolumn "" - variable commandstr - # --- - variable editbuf - variable editbuf_list - variable editbuf_linenum_submitted - - # --- - variable readingchunk - variable running - variable reading - variable post_script - variable id_outstack - upvar ::punk::last_run_display last_run_display - upvar ::punk::config::running running_config - set resultprompt [dict get $prompt_config resultprompt] set nlprompt [dict get $prompt_config nlprompt] @@ -1738,274 +1584,237 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { set debugprompt [dict get $prompt_config debugprompt] - #JMN - #fileevent $inputchan readable {} - - - #According to DKF - -buffering option doesn't affect input channels - - if {$cursorcolumn eq ""} { - set cursorcolumn 1 - } - - - # -- --- --- - #for raw mode - set chunkreadsize 1024 - set maxreads 4 - set linemax 40 ;#max number of lines received for us to read another chunk in same loop - *not a limit on number of lines in a round* - #Note - we could read for example 1024 lines if they fit in our chunk read size - and we'll have to process them all, but if 1024 > $linemax we won't read more available data in this round. - # -- --- --- - - set rawmode [set ::punk::console::is_raw] if {!$rawmode} { #puts stderr "-->got [ansistring VIEW -lf 1 $stdinlines]<--" } else { #raw - set numreads 0 - set lc 0 + set chunklen [string length $chunk] set onetime 1 + #single loop while to allow break on escape while {$onetime && [string length $chunk] >= 0 } { set onetime 0 - set chunklen [string length $chunk] #punk::console::move_emitblock_return 20 120 $chunklen-->[chan conf stdin]<-- - if {$chunklen > 0} { - set info1 "read $chunklen bytes->[ansistring VIEW -lf 1 -vt 1 $chunk]" - #consider also the terminal linefeed mode. - #https://vt100.net/docs/vt510-rm/LNM.html - # terminals (by default) generally use a lone cr to represent enter (LNM reset ie CSI 20l) - #(as per above doc: "For compatibility with Digital's software you should keep LNM reset (line feed)") - - #You can insert an lf using ctrl-j - and of course stdin could have crlf or lf - #pasting from notepad++ with mixed line endings seems to paste everything ok - #we don't really know the source of input keyboard vs paste vs pipe - and whether a read has potentially chopped a crl in half.. - #possibly no real way to determine that. We could wait a small time to see if there's more data coming.. and potentially impact performance. - #Instead we'll try to make sense of it here. - - if {$chunklen == 1} { - #presume it's a keypress from terminal + + #if {$chunklen == 0} { + # #document examples of when we expect zero-byte chunk + # #1) ctrl-z + # #review + # rputs stderr "->0byte read stdin" + # if {[chan eof $inputchan]} { + # fileevent $inputchan readable {} + # set reading 0 + # #set running 0 + # if {$::tcl_interactive} { + # rputs stderr "\n|repl> EOF on $inputchan." + # } + # set [namespace current]::done 1 + # #test + # #JMN + # #tailcall repl::reopen_stdin + # } + # break + #} + + #set info1 "read $chunklen bytes->[ansistring VIEW -lf 1 -vt 1 $chunk]" + #consider also the terminal linefeed mode. + #https://vt100.net/docs/vt510-rm/LNM.html + # terminals (by default) generally use a lone cr to represent enter (LNM reset ie CSI 20l) + #(as per above doc: "For compatibility with Digital's software you should keep LNM reset (line feed)") + + #You can insert an lf using ctrl-j - and of course stdin could have crlf or lf + #pasting from notepad++ with mixed line endings seems to paste everything ok + #we don't really know the source of input keyboard vs paste vs pipe - and whether a read has potentially chopped a crl in half.. + #possibly no real way to determine that. We could wait a small time to see if there's more data coming.. and potentially impact performance. + #Instead we'll try to make sense of it here. + + if {$chunklen == 1} { + #presume it's a keypress from terminal + set chunk [string map [list \r \n] $chunk] + } else { + #maybe a paste? (or stdin to active shell loop - possibly with no terminal ? ) + #we'd better check for crlf and/or plain lf. If found - presume any lone CR is to be left as is. + if {[string first \n $chunk] < 0} { set chunk [string map [list \r \n] $chunk] - } else { - #maybe a paste? (or stdin to active shell loop - possibly with no terminal ? ) - #we'd better check for crlf and/or plain lf. If found - presume any lone CR is to be left as is. - if {[string first \n $chunk] < 0} { - set chunk [string map [list \r \n] $chunk] - } - #else - - #has lf - but what if last char is cr? - #It may require user to hit enter - probably ok. - #could be a sequence of cr's from holding enter key } + #else - + #has lf - but what if last char is cr? + #It may require user to hit enter - probably ok. + #could be a sequence of cr's from holding enter key + } - #review - we can receive chars such as escapes or arrow inline with other data even from keyboard if keys are pushed quickly (or automated?) - # - so we probably shouldn't really rely on whether a char arrives alone in a chunk as a factor in its behaviour - #On the other hand - timing of keystrokes could be legitimate indications of intention in a cli ? - - #esc or ctrl-lb - if {$chunk eq "\x1b"} { - #return - #set readingchunk "" - set stdinlines [list "\x1b"] - set commandstr "" - set chunk "" - $editbuf clear_tail - screen_last_char_add \x1b stdin escape - break - } + #review - we can receive chars such as escapes or arrow inline with other data even from keyboard if keys are pushed quickly (or automated?) + # - so we probably shouldn't really rely on whether a char arrives alone in a chunk as a factor in its behaviour + #On the other hand - timing of keystrokes could be legitimate indications of intention in a cli ? - #if ProcessedInput is disabled - we can get ctrl-c - #e.g with punk::console::disableProcessedInput - #if we get just ctrl-c in one chunk - #ctrl-c - if {$chunk eq "\x03"} { - #::punk::repl::handler_console_control "ctrl-c_via_rawloop" - error "character 03 -> ctrl-c" - } - #for now - exit with small delay for tidyup - #ctrl-z - if {$chunk eq "\x1a"} { - #::punk::repl::handler_console_control "ctrl-z_via_rawloop" - punk::mode line - after 1000 exit - return - } - if {$chunk eq "\x7f"} { - set chunk "\b\x7f" - } - #ctrl-bslash - if {$chunk eq "\x1c"} { - #try to brutally terminate process - #attempt to leave terminal in a reasonable state - punk::mode line - after 200 {exit 42} - } + #esc or ctrl-lb + if {$chunk eq "\x1b"} { + #return + set stdinlines [list "\x1b"] + set commandstr "" + set chunk "" + $editbuf clear_tail + screen_last_char_add \x1b stdin escape + break + } - if {$chunk eq "\x1b\[D"} { - #move cursor record within our buffer - #rputs stderr "${debugprompt}arrow-left D" - #set commandstr "" - #punk::console::move_back 1 ;#terminal does it anyway? - } + #if ProcessedInput is disabled - we can get ctrl-c, but then we wouldn't be in raw mode and wouldn't be here. + #e.g with punk::console::disableProcessedInput + #if we get just ctrl-c in one chunk + #ctrl-c + if {$chunk eq "\x03"} { + #::punk::repl::handler_console_control "ctrl-c_via_rawloop" + error "character 03 -> ctrl-c" + } + - $editbuf add_chunk $chunk - - #-------------------------- - if {[set ::punk::console::ansi_available]} { - package require textblock - #experimental - use punk::console::get_size to determine current visible width. - #This should ideally be using sigwinch or some equivalent to set a value somewhere. - #testing each time is very inefficient (1+ms) - #unfortunately there isn't an easy way to get such an event on windows console based systems - REVIEW. - set do_checkwidth 1 ;#make configurable if performance hit is too severe? TODO - if {$do_checkwidth} { - set consolewidth [dict get [punk::console::get_size] columns] - } else { - set consolewidth 132 ;#todo - something better! - } - set debug_width 0 - if {$::punk::repl::debug_repl > 0} { - set lastc [string index $chunk end] - set lastc [ansistring VIEW -lf 1 -vt 1 $lastc] - if {[string length $lastc]} { - #set info [textblock::frame [textblock::block 10 10 $lastc]] - } - if {[catch { - set info [$editbuf debugview_raw] - if {$type eq "raw-waiting"} { - set info [a+ bold yellow]$info[a] - } else { - set info [a+ green]$info[a] - } - set lines [lines_as_list -ansireplays 1 $info] - if {[llength $lines] > 20} { - set lines [lrange $lines end-19 end] - set info [list_as_lines $lines] - } - } errM]} { - set info [textblock::frame -buildcache 0 -title "[a red]error[a]" $errM] - } else { - set info [textblock::frame -buildcache 0 -ansiborder [a+ green bold] -title "[a cyan]debugview_raw[a]" $info] - } - set debug_width [textblock::widthtopline $info] - set spacepatch [textblock::block $debug_width 2 " "] - puts -nonewline [punk::ansi::cursor_off] - #use non cursorsave versions - cursor save/restore will interfere with any concurrent ansi rendering that uses save/restore - because save/restore is a single item, not a stack. - set debug_offset [[expr {$consolewidth - $debug_width - 2}]] - punk::console::move_emitblock_return 8 $debug_offset $spacepatch - punk::console::move_emitblock_return 10 $debug_offset $info - puts -nonewline [punk::ansi::cursor_on] - } - if {[catch { - #set info [$editbuf view_lines] - set info [$editbuf view_lines_numbered] - set lines [lines_as_list -ansireplays 1 $info] - if {[llength $lines] > 20} { - set lines [lrange $lines end-19 end] - set info [list_as_lines $lines] - } - } editbuf_error]} { - set info [textblock::frame -buildcache 0 -title "[a red]error[a]" "$editbuf_error\n$::errorInfo"] - } else { - set title "[a cyan]editbuf [expr {[llength $editbuf_list]-1}] lines [$editbuf linecount][a]" - append title "[a+ yellow bold] col:[format %3s [$editbuf cursor_column]] row:[$editbuf cursor_row][a]" - set row1 " lastchar:[ansistring VIEW -lf 1 [$editbuf last_char]] lastgrapheme:[ansistring VIEW -lf 1 [$editbuf last_grapheme]]" - set row2 " lastansi:[ansistring VIEW -lf 1 [$editbuf last_ansi]]" - set info [a+ green bold]$row1\n$row2[a]\n$info - set info [textblock::frame -buildcache 0 -ansiborder [a+ green bold] -title $title $info] - } - set editbuf_width [textblock::widthtopline $info] - set spacepatch [textblock::block $editbuf_width 2 " "] + #review - configurable? + #translate raw del to backspace del for those terminals that send plain del + if {$chunk eq "\x7f"} { + set chunk "\b\x7f" + } + #ctrl-bslash + if {$chunk eq "\x1c"} { + #try to brutally terminate process + #attempt to leave terminal in a reasonable state + punk::mode line + after 250 {exit 42} + return + } + #for now - exit with small delay for tidyup + #ctrl-z + if {$chunk eq "\x1a"} { + #::punk::repl::handler_console_control "ctrl-z_via_rawloop" + punk::mode line + after 1000 {exit 43} + return + } - set editbuf_offset [expr {$consolewidth - $debug_width - $editbuf_width - 2}] - punk::console::cursorsave_move_emitblock_return 8 $editbuf_offset $spacepatch - punk::console::cursorsave_move_emitblock_return 10 $editbuf_offset $info + #we *could* intercept arrow keys here before they are handled in the editbuf + #but there should only be the need to do so for situations where we aren't editing a commandline + #if {$chunk eq "\x1b\[D"} { + # #rputs stderr "${debugprompt}arrow-left D" + # #set commandstr "" + # #punk::console::move_back 1 ;#terminal does it anyway? + #} + #if {$chunk eq "\x1b\[C"} { + #} + + $editbuf add_chunk $chunk + + #-------------------------- + # editbuf and debugview rhs frames + if {[set ::punk::console::ansi_available]} { + #experimental - use punk::console::get_size to determine current visible width. + #This should ideally be using sigwinch or some equivalent to set a value somewhere. + #testing each time is very inefficient (1+ms) + #unfortunately there isn't an easy way to get such an event on windows console based systems - REVIEW. + set do_checkwidth 1 ;#make configurable if performance hit is too severe? TODO + set consolewidth 132 + if {$do_checkwidth} { + if {[catch {set consolewidth [dict get [punk::console::get_size] columns]} errM]} { + puts stderr "repl_process_data failed on call to punk::console::get_size :$errM" + } } + set debug_width 0 + set rightmargin 0 + set space_occupied [punk::repl::console_debugview $editbuf $consolewidth -row 10 -chunktype $chunktype -rightmargin $rightmargin] ;#contains cursor movements + set debug_width [dict get $space_occupied width] + set clearance [expr {$debug_width + $rightmargin}] + set space_occupied [punk::repl::console_editbufview $editbuf $consolewidth -row 10 -rightmargin $clearance] + } + #-------------------------- - set lines_unsubmitted [expr {[$editbuf linecount] - $editbuf_linenum_submitted}] - #there is always one 'line' unsubmitted - although it may be the current one being built, which may be empty string - if {$lines_unsubmitted < 1} { - puts stderr "repl editbuf_linenum_submitted out of sync with editbuf" - } + set lines_unsubmitted [expr {[$editbuf linecount] - $editbuf_linenum_submitted}] + #there is always one 'line' unsubmitted - although it may be the current one being built, which may be empty string + if {$lines_unsubmitted < 1} { + puts stderr "repl editbuf_linenum_submitted out of sync with editbuf" + } - #set trailing_line_index [expr {[$editbuf linecount] -1}] - set last_line_num [$editbuf linecount] - #set nextsubmit_index [expr {$editbuf_lineindex_submitted + 1}] - set nextsubmit_line_num [expr {$editbuf_linenum_submitted + 1}] - - set cursor_row [$editbuf cursor_row] - set cursor_index [expr {$cursor_row -1}] - set lastansi [$editbuf last_ansi] - if {$lastansi eq "\x1b\[A"} { - if {$cursor_row > 1} { - puts -nonewline stdout "\x1b\[A" - } - } elseif {$lastansi eq "\x1b\[B"} { - puts -nonewline stdout "\x1b\[B" + #set trailing_line_index [expr {[$editbuf linecount] -1}] + set last_line_num [$editbuf linecount] + #set nextsubmit_index [expr {$editbuf_lineindex_submitted + 1}] + set nextsubmit_line_num [expr {$editbuf_linenum_submitted + 1}] + + set cursor_row [$editbuf cursor_row] + set cursor_index [expr {$cursor_row -1}] + set lastansi [$editbuf last_ansi] + if {$lastansi eq "\x1b\[A"} { + if {$cursor_row > 1} { + puts -nonewline stdout "\x1b\[A" } - flush stdout - + } elseif {$lastansi eq "\x1b\[B"} { + puts -nonewline stdout "\x1b\[B" + } + flush stdout + - set offset 3 - puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$offset +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$offset + [$editbuf cursor_column]}]] - #puts -nonewline stdout $chunk - flush stdout - if {[$editbuf last_char] eq "\n"} { - set linelen [punk::ansi::printing_length [$editbuf line $nextsubmit_line_num]] - puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$offset +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$offset + $linelen +1}]] - #screen_last_char_add "\n" input inputline - puts -nonewline stdout [punk::ansi::erase_eol]\n - #puts -nonewline stdout \n - screen_last_char_add "\n" input inputline - set waiting [$editbuf line end] - if {[string length $waiting] > 0} { - set waiting [a+ yellow bold]$waiting[a] - #puts stderr "waiting $waiting" - $editbuf clear_tail - lappend input_chunks_waiting($inputchan) $waiting - } + set leftmargin 3 + puts -nonewline stdout [a+ cyan][punk::ansi::move_column [expr {$leftmargin +1}]][punk::ansi::erase_eol][$editbuf line $cursor_row][a][punk::ansi::move_column [expr {$leftmargin + [$editbuf cursor_column]}]] + #puts -nonewline stdout $chunk + flush stdout + if {[$editbuf last_char] eq "\n"} { + set linelen [punk::ansi::printing_length [$editbuf line $nextsubmit_line_num]] + puts -nonewline stdout [a+ cyan bold][punk::ansi::move_column [expr {$leftmargin +1}]][$editbuf line $nextsubmit_line_num][a][punk::ansi::move_column [expr {$leftmargin + $linelen +1}]] + #screen_last_char_add "\n" input inputline + puts -nonewline stdout [punk::ansi::erase_eol]\n + #puts -nonewline stdout \n + screen_last_char_add "\n" input inputline + set waiting [$editbuf line end] + if {[string length $waiting] > 0} { + set waiting [a+ yellow bold]$waiting[a] + #puts stderr "waiting $waiting" + $editbuf clear_tail + lappend input_chunks_waiting($inputchan) $waiting } - if {$editbuf_linenum_submitted == 0} { - #(there is no line 0 - lines start at 1) - if {[$editbuf last_char] eq "\n"} { - lappend stdinlines [$editbuf line 1] - incr lc - set editbuf_linenum_submitted 1 - } - } else { - if {$nextsubmit_line_num < $last_line_num} { - foreach ln [$editbuf lines $nextsubmit_line_num end-1] { - lappend stdinlines $ln - incr lc - incr editbuf_linenum_submitted - } - } + } + if {$editbuf_linenum_submitted == 0} { + #(there is no line 0 - lines start at 1) + if {[$editbuf last_char] eq "\n"} { + lappend stdinlines [$editbuf line 1] + set editbuf_linenum_submitted 1 } - set last_cursor_column [$editbuf cursor_column] } else { - #rputs stderr "->0byte read stdin" - if {[chan eof $inputchan]} { - fileevent $inputchan readable {} - set reading 0 - set running 0 - if {$::tcl_interactive} { - rputs stderr "\n|repl> EOF on $inputchan." + if {$nextsubmit_line_num < $last_line_num} { + foreach ln [$editbuf lines $nextsubmit_line_num end-1] { + lappend stdinlines $ln + incr editbuf_linenum_submitted } - set [namespace current]::done 1 - #test - #JMN - #tailcall repl::reopen_stdin } - #break - } + set last_cursor_column [$editbuf cursor_column] } } + } trap {POSIX} {e eopts} { + rputs stderr "trap1 POSIX '$e' eopts:'$eopts" + flush stderr + } on error {repl_error erropts} { + rputs stderr "error1 in repl_handler: $repl_error" + rputs stderr "-------------" + rputs stderr "$::errorInfo" + rputs stderr "-------------" + set stdinreader [fileevent $inputchan readable] + if {![string length $stdinreader]} { + rputs stderr "*> $inputchan reader inactive" + } else { + rputs stderr "*> $inputchan reader active" + } + if {[chan eof $inputchan]} { + rputs stderr "todo - attempt restart of repl on input channel: $inputchan in next loop" + catch {set ::punk::ns::ns_current "::"} + #todo set flag to restart repl ? + } else { + rputs stderr "continuing.." + } + flush stderr + } + + try { set maxlinenum [expr {[llength $stdinlines] -1}] set linenum 0 foreach line $stdinlines { @@ -2088,7 +1897,7 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { } #puts "=============>[string length $commandstr] bytes , [string map [list \r -r- \n -n-] $commandstr] , info complete:[info complete $line]" - set ::repl::last_repl_char "\n" ;#this is actually the eol from stdin + set last_repl_char "\n" ;#this is actually the eol from stdin screen_last_char_add "\n" stdin $line @@ -2119,7 +1928,8 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { incr ::punk::repl::debug_repl } } - set commandstr "set ::punk::repl::debug_repl" + #set commandstr "set ::punk::repl::debug_repl" + set commandstr "" } if {$::punk::repl::debug_repl > 100} { proc debug_repl_emit {msg} [string map [list %p% [list $debugprompt]] { @@ -2142,8 +1952,9 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { set info "" append info "repl loopinstance: $loopinstance debugrepl remaining: [expr {[set ::punk::repl::debug_repl]-1}]\n" append info "commandstr: [punk::ansi::ansistring::VIEW $commandstr]\n" - append info "last_run_info\n" - append info "length: [llength $::punk::last_run_display]\n" + set lastrunchunks [tsv::get repl runchunks-[tsv::get repl runid]] + append info "lastrunchunks\n" + append info "chunks: [llength $lastrunchunks]\n" append info "namespace: $::punk::ns::ns_current" debug_repl_emit $info } else { @@ -2162,22 +1973,30 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { global run_command_cache #----------------------------------------- - set ::punk::last_run_display [list] - set ::repl::last_unknown "" + set repl_runid [tsv::incr repl runid] + tsv::set repl runchunks-$repl_runid [list] ;#last_run_display + + #set ::repl::last_unknown "" + tsv::set repl last_unknown "" #*********************************************************** #don't use puts,rputs or debug_repl_emit in this block #*********************************************************** - if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - lappend outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] - } + #if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { + # lappend outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + #} + #lappend outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output_stdout}] + #if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { + # lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + #} - lappend outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::repl::output_stdout}] - if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] - } + variable codethread + variable codethread_cond + variable codethread_mutex lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::repl::output_stderr}] + #thread::transfer $codethread stderr + #chan configure stdout -buffering none #JMN fileevent $inputchan readable {} @@ -2192,25 +2011,26 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { set status [catch {uplevel #0 [list runraw $commandstr]} raw_result] } else { #puts stderr "repl uplevel 0 '$run_command_string'" - set status [catch { - #uplevel 1 $run_command_string - #uplevel 1 {namespace eval $::punk::ns::ns_current $run_command_string} - set weirdns 0 - set parts [punk::ns::nsparts $::punk::ns::ns_current] - foreach p $parts { - if {[string match :* $p] || [string match *: $p]} { - set weirdns 1 - break - } - } - - if {$weirdns} { - uplevel 1 {punk::ns::nseval $::punk::ns::ns_current $run_command_string} - } else { - #puts stderr "--> [ansistring VIEW -lf 1 -vt 1 $run_command_string] <--" - uplevel 1 {namespace inscope $::punk::ns::ns_current $run_command_string} - } - } raw_result] + + tsv::set codethread_$codethread status -1 + thread::send -async $codethread [list punk::repl::codethread::runscript $run_command_string] + thread::mutex lock $codethread_mutex + while {[set status [tsv::get codethread_$codethread status]] == -1} { + thread::cond wait $codethread_cond $codethread_mutex 50 + update ;#we need a full update here to allow interrupts to be processed + #While update is often considered risky - here we know our input channel readable event has been disabled - so re-entrancy shouldn't be possible. + #however - child thread can send quit - transferring processing from here back to repl::start - which then ends - making a mess (child not yet finished when trying to tidy up) + #we should give the child a way to quit by setting a tsv we pick up here *after the while loop* - and then we can set done. + } + thread::mutex unlock $codethread_mutex + set raw_result [tsv::get codethread_$codethread result] + lassign [tsv::get codethread_$codethread info] _o lastoutchar_codethread _e lasterrchar_codethread + + #set status [catch { + # thread::send $ + # uplevel 1 {namespace inscope $::punk::ns::ns_current $run_command_string} + #} raw_result] + } #puts stderr "repl raw_result: $raw_result" #set result $raw_result @@ -2221,39 +2041,50 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { set result [string cat $raw_result ""] #puts stderr "-->>$result<--" #=============================================================================== + flush stdout flush stderr - foreach s [lreverse $outstack] { - shellfilter::stack::remove stdout $s - } - foreach s [lreverse $errstack] { - shellfilter::stack::remove stderr $s - } + #foreach s [lreverse $outstack] { + # shellfilter::stack::remove stdout $s + #} + #foreach s [lreverse $errstack] { + # shellfilter::stack::remove stderr $s + #} #----------------------------------------- #list/string-rep bug workaround part 2 - #todo - set flag based on punk::repl::has_script_var_bug + #todo - set flag based on punk::lib::system::has_script_var_bug lappend run_command_cache $run_command_string #puts stderr "run_command_string rep: [rep $run_command_string]" if {[llength $run_command_cache] > 2000} { set run_command_cache [lrange $run_command_cache 1750 end] } #----------------------------------------- - - set lastoutchar [string index [punk::ansi::stripansi $::repl::output_stdout] end] - set lasterrchar [string index [punk::ansi::stripansi $::repl::output_stderr] end] + + #screen_last_char_add [string index $lastoutchar_codethread$lasterrchar_codethread end] "stdout/stderr" + + + #set lastoutchar [string index [punk::ansi::stripansi $::repl::output_stdout] end] + #set lasterrchar [string index [punk::ansi::stripansi $::repl::output_stderr] end] #to determine whether cursor is back at col0 of newline - screen_last_char_add [string index $lastoutchar$lasterrchar end] "stdout/stderr" + #screen_last_char_add [string index $lastoutchar$lasterrchar end] "stdout/stderr" + + + #??? + #screen_last_char_add [string index $lastoutchar$lastoutchar_codethread$lasterrchar$lasterrchar_codethread end] "stdout/stderr" + screen_last_char_add [string index $lastoutchar_codethread$lasterrchar_codethread end] "stdout/stderr" + set result_is_chunk_list 0 #------ #todo - fix. It doesn't make much sense to only detect if the unknown command occurred in first word. #e.g set x [something arg] not detected vs something arg #also - unknown commands aren't the only things that can write directly to the os handles stderr & stdout + set last_unknown [tsv::get repl last_unknown] if { - [string length $::repl::last_unknown] && \ - [string equal -length [string length $::repl::last_unknown] $::repl::last_unknown $line] + [string length $last_unknown] && \ + [string equal -length [string length $last_unknown] $last_unknown $line] } { #can't currently detect stdout/stderr writes from unknown's call to exec #add a clearance newline for direct unknown calls for now @@ -2262,9 +2093,9 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { # set unknown_clearance "\n* repl newline" screen_last_char_add "\uFFFF" clearance "clearance after direct unknown call" - if {[llength $last_run_display]} { + if {[tsv::llength repl runchunks-$repl_runid]} { if {$status == 0} { - set result $last_run_display + set result [tsv::get repl runchunks-$repl_runid] ;#last_run_display } else { } @@ -2272,7 +2103,7 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { } } #------ - #ok to use repl::screen_needs_clearance from here down.. (code smell proc only valid use in narrow context) + #ok to use repl::screen_needs_clearance from here down.. (code smell - proc only valid use in narrow context) #*********************************************************** #rputs -nonewline stderr $unknown_clearance if {$::punk::repl::debug_repl > 0} { @@ -2311,7 +2142,7 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { #puts stderr "'$::repl::output_stdout' lastoutchar:'$lastoutchar' result:'$result'" #$command is an unevaluated script at this point # so may not be a well formed list e.g 'set x [list a "b"]' - #- lindex will fail + #- lindex $command would sometimes fail #if {[lindex $command 0] eq "runx"} {} @@ -2332,8 +2163,8 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { [string equal -length [string length "sh_runerr "] "sh_runerr " $commandstr] } { - if {[llength $last_run_display]} { - set result $last_run_display + if {[tsv::llength repl runchunks-$repl_runid]} { + set result [tsv::get repl runchunks-$repl_runid] ;#last_run_display set result_is_chunk_list 1 } } @@ -2342,7 +2173,7 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { ##an attempt to preserve underlying rep ##this is not for performance - just to be less disruptive to underlying rep to aid in learning/debugging # -- --- --- --- --- --- --- --- --- --- - # JN 2023 - The lrange operation is destructive to path intrep + # JN 2023 - The lrange operation is destructive to path internal representation # The lrange operation is destructive to strings with leading/trailing newlines # -- --- --- --- --- --- --- --- --- --- #set saved_errorCode $::errorCode @@ -2440,7 +2271,8 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { } else { #tcl err if {$result_is_chunk_list} { - foreach c $last_run_display { + foreach c [tsv::get repl runchunks-$repl_runid] { + #last_run_display lassign $c termchan text if {[string length $text]} { switch -- $termchan { @@ -2525,7 +2357,6 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { #we haven't put the data following last le into commandstr - but we want to display proper completion status prior to enter being hit or more data coming in. #this could give spurious results for large pastes where buffering chunks it in odd places.? #it does however give sensible output for the common case of a small paste where the last line ending wasn't included - #set waiting [punk::lib::system::incomplete $commandstr$readingchunk] set waiting [punk::lib::system::incomplete $commandstr[$editbuf line end]] } else { set waiting [punk::lib::system::incomplete $commandstr] @@ -2550,7 +2381,6 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { #rputs stderr "repl: no complete input line: $commandstr" #screen_last_char_add "\n" empty empty - #screen_last_char_add [string index $readingchunk end] stdinchunk stdinchunk screen_last_char_add [string index [$editbuf line end] end] stdinchunk stdinchunk } @@ -2575,14 +2405,13 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} { rputs stderr "*> $inputchan reader active" } if {[chan eof $inputchan]} { - rputs stderr "will attempt restart of repl on input channel: $inputchan in next loop" + rputs stderr "todo - attempt restart of repl on input channel: $inputchan in next loop" catch {set ::punk::ns::ns_current "::"} + #todo set flag to restart repl ? } else { rputs stderr "continuing.." } flush stderr - #tailcall repl::start $inputchan - } } @@ -2590,10 +2419,301 @@ proc repl::completion {context ebuf} { } -package provide punk::repl [namespace eval punk::repl { - variable version - set version 0.1 -}] +namespace eval repl { + proc init {args} { + if {![info exists ::argv0]} { + #error out before we create a thread - punk requires this - review + error "::argv0 not set" + } + #in case -callback_interp wasn't explicitly defined - we make a guess based on how init was called as to whether this is being launched from a 'code' or root ("") interp. + if {[catch {info level -1} caller]} { + puts "repl::init from: global" + set default_callback_interp "" + } else { + #puts "repl::init from: $caller" + set default_callback_interp "code" + } + variable codethread + variable codethread_cond + variable codethread_mutex + + set opts [list -force 0 -safe 0 -safelog 0 -paths {} -callback_interp $default_callback_interp] + foreach {k v} $args { + switch -- $k { + -force - -safe - -safelog - -paths - -callback_interp { + dict set opts $k $v + } + default { + error "repl::init unknown option '$k'. Known-options: [dict keys $opts]" + } + } + } + set opt_force [dict get $opts -force] + set opt_safe [dict get $opts -safe] + set opt_safelog [dict get $opts -safelog] + if {$opt_safelog eq "0"} { + set opt_safelog "" + } + if {[string is boolean -strict $opt_safelog]} { + if {$opt_safelog} { + set opt_safelog ::repl::interpextras::safe_msg + } + } + dict set opts -safelog $opt_safelog + + #If we are launching a repl from within an interp - we need to tell the childthread how to call-back to the parent repl + set opt_callback_interp [dict get $opts -callback_interp] + + if {$codethread ne "" && !$opt_force && [thread::exists $codethread] } { + error "repl:init codethread: $codethread already exists. use -force 1 to override" + } + set codethread [thread::create -preserved] + + #review - naming of the possibly 2 cond variables parent and child thread + set codethread_cond [thread::cond create] ;#repl::codethread_cond held by parent(repl) vs punk::repl::codethread::replthread_cond held by child(codethread) + set codethread_mutex [thread::mutex create] + + thread::send $codethread [string map [list %args% [list $opts]\ + %argv0% [list $::argv0]\ + %replthread% [thread::id]\ + %replthread_cond% $codethread_cond\ + %replthread_interp% [list $opt_callback_interp]\ + %tmlist% [list [tcl::tm::list]]\ + %autopath% [list $::auto_path]\ + ] { + set ::argv0 %argv0% + tcl::tm::remove {*}[tcl::tm::list] + tcl::tm::add {*}%tmlist% + #this sets the auto_path in the thread but outside of the code interp that will be created. + #It will also need to be added in that interp + set ::auto_path %autopath% + + package require punk::console + package require punk::repl::codethread + package require shellfilter + #package require shellrun + package require textblock + + #punk::configure_unknown ;#must be called because we hacked the tcl 'unknown' proc + + #child codethread (outside of code interp) needs to know details of the calling repl + set ::punk::repl::codethread::replthread %replthread% ;#point to thread id of parent thread (repl) + set ::punk::repl::codethread::replthread_cond %replthread_cond% + set ::punk::repl::codethread::replthread_interp %replthread_interp% + + # -- --- --- --- + #procs to alias into the codethread interp + #as we are doing string substitution on the whole block anyway, and these values are contant for the life of the thread, we may as well substitute hard values for things like replthread into these procs where possible + # -- --- --- --- + namespace eval ::repl::interphelpers { + proc quit {args} { + #child codethreads run in a 'code' interp therefore if they started another repl - it is within the 'code' interp in that thread + # whereas the first repl launched in the process runs in root interp "" + thread::send -async %replthread% [list interp eval %replthread_interp% ::punk::repl::quit] + } + proc editbuf args { + thread::send %replthread% [list punk::repl::editbuf {*}$args] + } + proc escapeeval {script} { + eval $script + } + proc do_after {args} { + if {[llength $args] == 1} { + return after {*}$args + } + set scr [lindex $args 1] + after [lindex $args 0] [list punk::repl::codethread::runscript $scr] + } + proc repl_ensemble_unknown args { + puts $args + if {[llength $args] == 1} { + return [namespace ensemble configure ::repl::interphelpers::repl_ensemble] + } + } + proc colour args { + thread::send %replthread% [list punk::console::colour {*}$args] + interp eval code [list punk::console::colour {*}$args] + } + } + namespace eval ::repl::interpextras { + #install using safe::setLogCmd + proc safe_msg {msg} { + puts stderr "safebase: $msg" + } + } + + namespace eval ::repl::interphelpers::repl_ensemble { + namespace export {[a-z]*} + namespace ensemble create + namespace ensemble configure [namespace current] -unknown ::repl::interphelpers::repl_ensemble_unknown + proc thread {} { + return %replthread% + } + proc info {} { + return [dict create thread %replthread% interp %replthread_interp%] + } + proc eval {script} { + thread::send %replthread% $script + } + proc stack {} { + set iname %replthread_interp% + set tid %replthread% + lappend stack [list thread $tid interp $iname] + while {$iname eq "code"} { + set iname [thread::send $tid {set ::punk::repl::codethread::replthread_interp}] + set tid [thread::send $tid {set ::punk::repl::codethread::replthread}] + lappend stack [list thread $tid interp $iname] + } + return $stack + } + } + namespace eval ::repl::interphelpers::subrepl_ensemble { + namespace export {[a-z]*} + namespace ensemble create + proc punk {} { + interp eval code { + package require punk::repl + repl::init + repl::start stdin + } + } + proc safe {args} { + interp eval code { + package require punk::repl + } + interp eval code [list repl::init -safe 1 {*}$args] + interp eval code [list repl::start stdin] + } + proc safebase {args} { + interp eval code { + package require punk::repl + } + interp eval code [list repl::init -safe 2 {*}$args] + interp eval code [list repl::start stdin] + } + } + # -- --- --- --- --- + + puts "codethread:[thread::id] parent replthread:%replthread%" + flush stdout + + set args %args% + set safe [dict get $args -safe] + set safelog [dict get $args -safelog] + set paths [list] + if {[dict exists $args -paths]} { + set paths [dict get $args -paths] + } + + if {$safe == 1} { + interp create -safe -- code + if {[llength $paths]} { + package require punk::island + foreach p $paths { + punk::island::add code $p + } + } + interp eval code { + set ::argv0 %argv0% + set ::auto_path %autopath% + #puts stdout "safe interp" + #flush stdout + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + + code alias exit ::repl::interphelpers::quit + } elseif {$safe == 2} { + safe::interpCreate code -nested 1 + #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* + #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. + if {[llength $paths]} { + package require punk::island + foreach p $paths { + punk::island::add code $p + } + } + interp eval code { + set ::argv0 %argv0% + set ::auto_path %autopath% + #puts stdout "safe interp" + #flush stdout + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + + #code invokehidden package require punk::lib + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + #work around bug in safe base which won't load Tcl libs that have deeper nesting + #(also affects tcllib page/plugins folder) + set termversions [package versions term] + set termv [lindex $termversions end] + if {$termv ne ""} { + set path [lindex [package ifneeded term $termv] end] ;#assuming path at end of something like "source .../term.tcl" + set termbase [file dirname $path] + safe::interpAddToAccessPath code [file join $termbase ansi] + safe::interpAddToAccessPath code [file join $termbase ansi code] + } + #safe::interpAddToAccessPath code NUL + if {$safelog ne ""} { + #setting setLogCmd here gives some feedback for potentially interesting feedback regarding behaviour of things such as glob + safe::setLogCmd $safelog + } + #code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm + + code alias detok ::safe::DetokPath code + + #review - exit should do something slightly different + # see ::safe::interpDelete + code alias exit ::repl::interphelpers::quit + } else { + interp create code + interp eval code { + set ::argv0 %argv0% + set ::auto_path %autopath% + #puts "-->[chan names]" + package require punk + package require punk::ns + package require shellrun + package require textblock + } + } + code alias repl ::repl::interphelpers::repl_ensemble + code alias subrepl ::repl::interphelpers::subrepl_ensemble + code alias quit ::repl::interphelpers::quit + code alias editbuf ::repl::interphelpers::editbuf + code alias colour ::repl::interphelpers::colour + #code alias after ::repl::interphelpers::do_after + + #temporary debug aliases - deliberate violation of safety provided by safe interp + code alias escapeeval ::repl::interphelpers::escapeeval + + return [thread::id] + }] + } + #init - don't auto init - require init with possible options e.g -safe +} package provide punk::repl [namespace eval punk::repl { variable version set version 0.1 diff --git a/src/modules/punk/repl/codethread-999999.0a1.0.tm b/src/modules/punk/repl/codethread-999999.0a1.0.tm new file mode 100644 index 0000000..ebb78c0 --- /dev/null +++ b/src/modules/punk/repl/codethread-999999.0a1.0.tm @@ -0,0 +1,255 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.tm +# +# 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) 2024 +# +# @@ Meta Begin +# Application punk::repl::codethread 999999.0a1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::repl::codethread 0 999999.0a1.0] +#[copyright "2024"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::repl::codethread] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::repl::codethread +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::repl::codethread +#[list_begin itemized] + +package require Tcl 8.6- +package require punk::config +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::repl::codethread::class { + #*** !doctools + #[subsection {Namespace punk::repl::codethread::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::repl::codethread { + namespace export * + variable replthread + variable replthread_cond + variable running 0 + + variable output_stdout "" + variable output_stderr "" + + #variable xyz + + #*** !doctools + #[subsection {Namespace punk::repl::codethread}] + #[para] Core API functions for punk::repl::codethread + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + proc is_running {} { + variable running + return $running + } + proc runscript {script} { + #puts stderr "->runscript" + variable replthread_cond + variable output_stdout "" + variable output_stderr "" + #expecting to be called from a thread::send in parent repl - ie in the toplevel interp so that the sub-interp "code" is available + #if a thread::send is done from the commandline in a codethread - Tcl will + if {"code" ni [interp children] || ![info exists replthread_cond]} { + #in case someone tries calling from codethread directly - don't do anything or change any state + #(direct caller could create an interp named code at the level "" -> "code" -"code" and add a replthread_cond value to avoid this check - but it probably won't do anything useful) + #if called directly - the context will be within the first 'code' interp. + #inappropriate caller could add superfluous entries to shellfilter stack if function errors out + #inappropriate caller could affect tsv vars (if their interp allows that anyway) + puts stderr "runscript is meant to be called from the parent repl thread via a thread::send to the codethread" + return + } + upvar ::punk::config::running running_config + if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { + lappend outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + lappend outstack [shellfilter::stack::add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}] + if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { + #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] + } + lappend errstack [shellfilter::stack::add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}] + + #an experiment + #set errhandle [shellfilter::stack::item_tophandle stderr] + #interp transfer "" $errhandle code + + set scope [interp eval code [list set ::punk::ns::ns_current]] + set status [catch { + interp eval code [list namespace inscope $scope $script] + } result] + + + flush stdout + flush stderr + + #interp transfer code $errhandle "" + #flush $errhandle + set lastoutchar [string index [punk::ansi::stripansi $output_stdout] end] + set lasterrchar [string index [punk::ansi::stripansi $output_stderr] end] + #puts stderr "-->[ansistring VIEW -lf 1 $lastoutchar$lasterrchar]" + + set tid [thread::id] + tsv::set codethread_$tid info [list lastoutchar $lastoutchar lasterrchar $lasterrchar] + tsv::set codethread_$tid status $status + tsv::set codethread_$tid result $result + tsv::set codethread_$tid errorcode $::errorCode + + + foreach s [lreverse $outstack] { + shellfilter::stack::remove stdout $s + } + foreach s [lreverse $errstack] { + shellfilter::stack::remove stderr $s + } + thread::cond notify $replthread_cond + } + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::repl::codethread ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::repl::codethread::lib { + namespace export * + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace punk::repl::codethread::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::repl::codethread::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval punk::repl::codethread::system { + #*** !doctools + #[subsection {Namespace punk::repl::codethread::system}] + #[para] Internal functions that are not part of the API + + + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::repl::codethread [namespace eval punk::repl::codethread { + variable pkg punk::repl::codethread + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/repl/codethread-buildversion.txt b/src/modules/punk/repl/codethread-buildversion.txt new file mode 100644 index 0000000..f47d01c --- /dev/null +++ b/src/modules/punk/repl/codethread-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/repo-999999.0a1.0.tm b/src/modules/punk/repo-999999.0a1.0.tm index e9cb196..0e7c0a2 100644 --- a/src/modules/punk/repo-999999.0a1.0.tm +++ b/src/modules/punk/repo-999999.0a1.0.tm @@ -134,9 +134,13 @@ namespace eval punk::repo { } interp alias "" fossil "" punk::repo::fossil_proxy + #safe interps can't call auto_execok + #At least let them load the package even though much of it may be unusable depending on the safe configuration + catch { if {[auto_execok fossil] ne ""} { interp alias "" FOSSIL "" {*}[auto_execok fossil] } + } proc askuser {question} { if {![catch {package require punk::lib}]} { @@ -841,7 +845,7 @@ namespace eval punk::repo { } } proc fossil_get_repository_folder_for_project {projectname args} { - set defaults [list\ + set opts [list\ -parentfolder \uFFFF\ -extrachoices \uFFFF\ -askpath 0\ @@ -852,12 +856,16 @@ namespace eval punk::repo { if {[llength $args] % 2 != 0} { error "fossil_get_repository_folder requires args to be option-value pairs. Received '$args'" } - dict for {k v} $args { - if {$k ni [dict keys $defaults]} { - error "fossil_get_repository_folder unrecognised option $k. Known options: [dict keys $defaults]" + foreach {k v} $args { + switch -- $k { + -parentfolder - -extrachoices - -askpath - -ansi - -ansi_prompt - -ansi_warning { + dict set opts $k $v + } + default { + error "fossil_get_repository_folder unrecognised option $k. Known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- set opt_parentfolder [dict get $opts -parentfolder] if {$opt_parentfolder eq "\uFFFF"} { diff --git a/src/modules/punk/sshrun-999999.0a1.0.tm b/src/modules/punk/sshrun-999999.0a1.0.tm index 30ca5f1..2735355 100644 --- a/src/modules/punk/sshrun-999999.0a1.0.tm +++ b/src/modules/punk/sshrun-999999.0a1.0.tm @@ -65,7 +65,7 @@ #[para] packages used by punk::sshrun #[list_begin itemized] -package require Tcl 8.6 +package require Tcl 8.6- package require cmdline #*** !doctools #[item] [package {Tcl 8.6}] diff --git a/src/modules/punk/uc-999999.0a1.0.tm b/src/modules/punk/uc-999999.0a1.0.tm index 52dc678..f62ac67 100644 --- a/src/modules/punk/uc-999999.0a1.0.tm +++ b/src/modules/punk/uc-999999.0a1.0.tm @@ -45,7 +45,7 @@ #[para] packages used by punk::uc #[list_begin itemized] -package require Tcl 8.6 +package require Tcl 8.6- #*** !doctools #[item] [package {Tcl 8.6}] diff --git a/src/modules/punk/unixywindows-999999.0a1.0.tm b/src/modules/punk/unixywindows-999999.0a1.0.tm index e65b599..b53123d 100644 --- a/src/modules/punk/unixywindows-999999.0a1.0.tm +++ b/src/modules/punk/unixywindows-999999.0a1.0.tm @@ -37,7 +37,7 @@ namespace eval punk::unixywindows { set result [exec cygpath -m /] ;# -m gives result with forward-slashes - which is ok for windows paths in a Tcl context. set cachedunixyroot [punk::objclone $result] file pathtype $cachedunixyroot; #this call causes the int-rep to be path - set ::punk::last_run_display [list] ;#hack - review shouldn't really be necessary.. but because we call winpath from ./ - the repl looks for last_run_display + #set ::punk::last_run_display [list] ;#hack - review shouldn't really be necessary.. but because we call winpath from ./ - the repl looks for last_run_display } errM]} { } else { @@ -81,7 +81,7 @@ namespace eval punk::unixywindows { #REVIEW high-coupling proc cdwin {path} { set path [towinpath $path] - if {$::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[llength [info commands ::punk::console::titleset]]} { ::punk::console::titleset $path } @@ -90,7 +90,7 @@ namespace eval punk::unixywindows { } proc cdwindir {path} { set path [towinpath $path] - if {$::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { if {[llength [info commands ::punk::console::titleset]]} { ::punk::console::titleset $path } diff --git a/src/modules/punkapp-0.1.tm b/src/modules/punkapp-0.1.tm index 4db2a3e..ce46856 100644 --- a/src/modules/punkapp-0.1.tm +++ b/src/modules/punkapp-0.1.tm @@ -60,7 +60,7 @@ namespace eval punkapp { } } else { #review - if {[info exists ::repl::running] && $::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { puts stderr "punkapp::exit called without toplevel - showing console" show_console return 0 @@ -82,8 +82,7 @@ namespace eval punkapp { set controllable [get_user_controllable_toplevels] if {![llength $controllable]} { - #review - tight coupling - if {[info exists ::repl::running] && $::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { show_console } else { if {$waiting ne "no"} { @@ -126,7 +125,7 @@ namespace eval punkapp { wm protocol $t WM_DELETE_WINDOW [list punkapp::close_window $t] } } - if {[info exists ::repl::running] && $::repl::running} { + if {[package provide punk::repl::codethread] ne "" && [punk::repl::codethread::is_running]} { puts stderr "repl eventloop seems to be running - punkapp::wait not required" } else { if {$waiting eq "no"} { @@ -173,17 +172,21 @@ namespace eval punkapp { return $controllable } proc hide_console {args} { - set defaults [dict create -force 0] + set opts [dict create -force 0] if {([llength $args] % 2) != 0} { error "hide_console expects pairs of arguments. e.g -force 1" } - set known_opts [dict keys $defaults] - dict for {k v} $args { - if {$k ni $known_opts} { - error "Unrecognised options '$k' known options: $known_opts" + #set known_opts [dict keys $defaults] + foreach {k v} $args { + switch -- $k { + -force { + dict set opts $k $v + } + default { + error "Unrecognised options '$k' known options: [dict keys $opts]" + } } } - set opts [dict merge $defaults $args] set force [dict get $opts -force] if {!$force} { diff --git a/src/modules/punkcheck-0.1.0.tm b/src/modules/punkcheck-0.1.0.tm index 86b174a..8175ac0 100644 --- a/src/modules/punkcheck-0.1.0.tm +++ b/src/modules/punkcheck-0.1.0.tm @@ -1937,7 +1937,7 @@ namespace eval punkcheck { error "file_record_set_defaults bad file_record: tag not FILEINFO" } set defaults [list -keep_installrecords 3 -keep_skipped 1 -keep_inprogress 2] - dict for {k v} $defaults { + foreach {k v} $defaults { if {![dict exists $file_record $k]} { dict set file_record $k $v } diff --git a/src/modules/shellfilter-0.1.9.tm b/src/modules/shellfilter-0.1.9.tm index 888b5fd..079ce99 100644 --- a/src/modules/shellfilter-0.1.9.tm +++ b/src/modules/shellfilter-0.1.9.tm @@ -76,7 +76,9 @@ namespace eval shellfilter::log { } namespace eval shellfilter::pipe { #write channel for program. workerthread reads other end of fifo2 and writes data somewhere - proc open_out {tag_pipename {settingsdict {}}} { + proc open_out {tag_pipename {pipesettingsdict {}}} { + set defaultsettings {-buffering full} + set settingsdict [dict merge $defaultsettings $pipesettingsdict] package require shellthread #we are only using the fifo in a single direction to pipe to another thread # - so whilst wchan and rchan could theoretically each be both read & write we're only using them for one operation each @@ -132,8 +134,8 @@ namespace eval shellfilter::pipe { namespace eval shellfilter::ansi { - #maint warning - from overtype package - #stripansi is better/more comprehensive + #maint warning - + #stripansi from punk::ansi is better/more comprehensive proc stripcodes {text} { #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~). dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"] @@ -849,8 +851,63 @@ namespace eval shellfilter::stack { variable pipelines return [dict get $pipelines $pipename] } + proc item_tophandle {pipename} { + variable pipelines + set handle "" + if {[dict exists $pipelines $pipename stack]} { + set stack [dict get $pipelines $pipename stack] + set topstack [lindex $stack end] ;#last item in stack is top (for output channels anyway) review comment. input chans? + if {$topstack ne ""} { + if {[dict exists $topstack -handle]} { + set handle [dict get $topstack -handle] + } + } + } + return $handle + } proc status {{pipename *} args} { variable pipelines + set pipecount [dict size $pipelines] + set tableprefix "$pipecount pipelines active\n" + set t [textblock::class::table new $tableprefix] + $t add_column -headers [list channel-ident] + $t add_column -headers [list device-info localchan] + $t configure_column 1 -header_colspans {3} + $t add_column -headers [list "" remotechan] + $t add_column -headers [list "" tid] + $t add_column -headers [list stack-info] + foreach k [dict keys $pipelines $pipename] { + set lc [dict get $pipelines $k device localchan] + set rc [dict get $pipelines $k device remotechan] + if {[dict exists $k device workertid]} { + set tid [dict get $pipelines $k device workertid] + } else { + set tid "-" + } + set stack [dict get $pipelines $k stack] + if {![llength $stack]} { + set stackinfo "" + } else { + set tbl_inner [textblock::class::table new] + $tbl_inner configure -show_edge 0 + foreach rec $stack { + set handle [punk::lib::dict_getdef $rec -handle ""] + set id [punk::lib::dict_getdef $rec -id ""] + set transform [namespace tail [punk::lib::dict_getdef $rec -transform ""]] + set settings [punk::lib::dict_getdef $rec -settings ""] + $tbl_inner add_row [list $id $transform $handle $settings] + } + set stackinfo [$tbl_inner print] + $tbl_inner destroy + } + $t add_row [list $k $lc $rc $tid $stackinfo] + } + set result [$t print] + $t destroy + return $result + } + proc status1 {{pipename *} args} { + variable pipelines set pipecount [dict size $pipelines] set tableprefix "$pipecount pipelines active\n" @@ -1168,8 +1225,12 @@ namespace eval shellfilter::stack { #we 'add' rather than 'push' because transforms can float,sink and replace/sideline so they don't necessarily go to the top of the transform stack proc add {pipename transformname args} { variable pipelines - if {($pipename ni [chan names]) && ($pipename ni [dict keys $pipelines])} { - error "shellfilter::stack::add no existing chan or pipename matching '$pipename' use stdin/stderr/stdout or shellfilter::stack::new " + #chan names doesn't reflect available channels when transforms are in place + #e.g stdout may exist but show as something like file191f5b0dd80 + if {($pipename ni [dict keys $pipelines])} { + if {[catch {eof $pipename} is_eof]} { + error "shellfilter::stack::add no existing chan or pipename matching '$pipename' in channels:[chan names] or pipelines:$pipelines use stdin/stderr/stdout or shellfilter::stack::new " + } } set args [dict merge {-action "" -settings {}} $args] set action [dict get $args -action] @@ -1438,6 +1499,7 @@ namespace eval shellfilter { if {$itemlen <= 1} { dict set iteminfo apparentwrap "not" } else { + #todo - switch on $char_a$char_z if {($char_a eq {"}) && ($char_z eq {"})} { dict set iteminfo apparentwrap "doublequotes" } elseif {($char_a eq "'") && ($char_z eq "'")} { diff --git a/src/modules/shellrun-0.1.1.tm b/src/modules/shellrun-0.1.1.tm index 43ba499..fcf9c20 100644 --- a/src/modules/shellrun-0.1.1.tm +++ b/src/modules/shellrun-0.1.1.tm @@ -71,7 +71,7 @@ namespace eval shellrun { error "set_last_run_display expects a list. Value supplied doesn't appear to be a well formed tcl list. '$errMsg'" } #todo - - set ::punk::last_run_display $chunklist + tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist } @@ -128,7 +128,7 @@ namespace eval shellrun { #todo - investigate cause of punk86 run hanging sometimes. An 'after 500' before exit in the called script fixes the issue. punk87 doesn't seem to be affected. proc run {args} { - set_last_run_display [list] + #set_last_run_display [list] set splitargs [get_run_opts $args] set runopts [dict get $splitargs runopts] @@ -179,7 +179,7 @@ namespace eval shellrun { } proc runout {args} { - set_last_run_display [list] + #set_last_run_display [list] variable runout variable runerr set runout "" @@ -300,7 +300,8 @@ namespace eval shellrun { lappend chunklist [list result $chunk] - set_last_run_display $chunklist + #set_last_run_display $chunklist + tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist if {$nonewline} { return [string trimright $::shellrun::runout \r\n] @@ -310,7 +311,7 @@ namespace eval shellrun { } proc runerr {args} { - set_last_run_display [list] + #set_last_run_display [list] variable runout variable runerr set runout "" @@ -412,7 +413,8 @@ namespace eval shellrun { lappend chunklist [list resulterr $chunk] - set_last_run_display $chunklist + #set_last_run_display $chunklist + tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist if {$nonewline} { return [string trimright $::shellrun::runerr \r\n] @@ -422,7 +424,7 @@ namespace eval shellrun { proc runx {args} { - set_last_run_display [list] + #set_last_run_display [list] variable runout variable runerr set runout "" @@ -564,7 +566,8 @@ namespace eval shellrun { set exitdict [list exitinfo $exitinfo] } - set_last_run_display $chunklist + #set_last_run_display $chunklist + tsv::lappend repl runchunks-[tsv::get repl runid] {*}$chunklist #set ::repl::result_print 0 #return [lindex [list [list stdout $::runout stderr $::runerr {*}$exitinfo] [shellfilter::stack::remove stdout $x][puts -nonewline stdout $pretty][set ::repl::output ""]] 0] @@ -588,7 +591,7 @@ namespace eval shellrun { #we can only call runraw with a single (presumably braced) string if we want to use it from both repl and tcl scripts (why? todo with unbalanced quotes/braces?) proc runraw {commandline} { #runraw fails as intended - because we can't bypass exec/open interference quoting :/ - set_last_run_display [list] + #set_last_run_display [list] variable runout variable runerr set runout "" diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 2909add..bd6814a 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -17,7 +17,6 @@ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz -#package require punk package require punk::args package require punk::char package require punk::ansi @@ -70,6 +69,23 @@ namespace eval textblock { -minwidth ""\ -maxwidth ""\ ] + variable opts_column_defaults + set opts_column_defaults [dict create\ + -headers [list]\ + -header_colspans [list]\ + -footers [list]\ + -defaultvalue ""\ + -ansibase ""\ + -ansireset "\uFFEF"\ + -minwidth ""\ + -maxwidth ""\ + -blockalign centre\ + -textalign left\ + ] + #initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only + + + #for 'L' shaped table building pattern (tables bigger than 4x4 will be mostly 'L' patterns) #ie only vll,blc,hlb used for cells except top row and right column #top right cell uses all 'O' shape, other top cells use 'C' shape (hlt,tlc,vll,blc,hlb) @@ -216,7 +232,17 @@ namespace eval textblock { # [para] [emph {handler_classes}] # [list_begin enumerated] - oo::class create [namespace current]::table { + #this makes new table objects a little faster when multiple opts specified as well as to configure + #as tables are a heavyweight thing, but handy to nest sometimes - we'll take what we can get + set topt_keys [dict keys $::textblock::class::opts_table_defaults] + set switch_keys_valid_topts [punk::lib::lmapflat v $topt_keys {list $v -}] + set switch_keys_valid_topts [lrange $switch_keys_valid_topts 0 end-1] ;#remove last dash + + set copt_keys [dict keys $::textblock::class::opts_column_defaults] + set switch_keys_valid_copts [punk::lib::lmapflat v $copt_keys {list $v -}] + set switch_keys_valid_copts [lrange $switch_keys_valid_copts 0 end-1] + + oo::class create [namespace current]::table [string map [list %topt_keys% $topt_keys %topt_switchkeys% $switch_keys_valid_topts %copt_keys% $copt_keys %copt_switchkeys% $switch_keys_valid_copts] { #*** !doctools #[enum] CLASS [class interface_caphandler.registry] #[list_begin definitions] @@ -239,26 +265,47 @@ namespace eval textblock { variable TSUB ;#make configurable so user isn't stopped from using our default PUA-unicode char in content (nerdfonts overlap) variable o_calculated_column_widths variable o_column_width_algorithm + + constructor {args} { #*** !doctools #[call class::table [method constructor] [arg args]] - upvar ::textblock::class::opts_table_defaults tdefaults - set o_opts_table_defaults $tdefaults + set o_opts_table_defaults $::textblock::class::opts_table_defaults + set o_opts_column_defaults $::textblock::class::opts_column_defaults + + if {[llength $args] == 1} { set args [list -title [lindex $args 0]] } if {[llength $args] %2 !=0} { error "[namespace current]::table constructor - unexpected argument count. Require single value being title, or name value pairs" } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_table_defaults]} { - error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + + set o_opts_table $o_opts_table_defaults + set o_opts_table_effective $o_opts_table_defaults + + ##todo - test with punk::lib::show_jump_tables - how? + foreach {k v} $args { + switch -- $k { + %topt_switchkeys% { + dict set o_opts_table $k $v + } + default { + error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } } } + my configure {*}$o_opts_table + + #foreach {k v} $args { + # #todo - convert to literal switch using string map so we don't have to define o_opts_table_defaults here. + # if {$k ni [dict keys $o_opts_table_defaults]} { + # error "[namespace current]::table unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + # } + #} #set o_opts_table [dict merge $o_opts_table_defaults $args] - set o_opts_table $o_opts_table_defaults - set o_opts_table_effective $o_opts_table_defaults - my configure {*}[dict merge $o_opts_table_defaults $args] + #my configure {*}[dict merge $o_opts_table_defaults $args] + set o_columndefs [dict create] set o_columndata [dict create] ;#we store data by column even though it is often added row by row set o_columnstates [dict create] ;#store the maxwidthbodyseen etc as we add rows and maxwidthheaderseen etc as we add headers - it is needed often and expensive to calculate repeatedly @@ -282,7 +329,7 @@ namespace eval textblock { return $o_column_width_algorithm } if {$alg ne $o_column_width_algorithm} { - #invlidate cached widths + #invalidate cached widths set o_calculated_column_widths [list] } set o_column_width_algorithm $alg @@ -404,7 +451,7 @@ namespace eval textblock { return $o_opts_table } if {[llength $args] == 1} { - if {[lindex $args 0] in [dict keys $o_opts_table_defaults]} { + if {[lindex $args 0] in [list %topt_keys%]} { #query single option set k [lindex $args 0] set val [dict get $o_opts_table $k] @@ -428,13 +475,19 @@ namespace eval textblock { if {[llength $args] %2 != 0} { error "[namespace current]::table configure - unexpected argument count. Require name value pairs" } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_table_defaults]} { - error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + foreach {k v} $args { + switch -- $k { + %topt_switchkeys% {} + default { + error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + } } + #if {$k ni [dict keys $o_opts_table_defaults]} { + # error "[namespace current]::table configure - unrecognised option '$k'. Known values [dict keys $o_opts_table_defaults]" + #} } set checked_opts [list] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -ansibase_header - -ansibase_body - -ansiborder_header - -ansiborder-body - -ansiborder_footer { set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" @@ -557,7 +610,7 @@ namespace eval textblock { #all options checked - ok to update o_opts_table and o_opts_table_effective #set o_opts_table [dict merge $o_opts_table $checked_opts] - dict for {k v} $args { + foreach {k v} $args { switch -- $k { -framemap_header - -framemap_body { #framemaps don't require setting every key to update. @@ -583,11 +636,12 @@ namespace eval textblock { switch -- $k { -framemap_body - -framemap_header { set existing [dict get $o_opts_table_effective $k] - set updated $existing - dict for {subk subv} $v { - dict set updated $subk $subv - } - dict set o_opts_table_effective $k $updated + #set updated $existing + #dict for {subk subv} $v { + # dict set updated $subk $subv + #} + #dict set o_opts_table_effective $k $updated + dict set o_opts_table_effective $k [dict merge $existing $v] } -framelimits_body - -framelimits_header { #my Set_effective_framelimits @@ -641,33 +695,30 @@ namespace eval textblock { method add_column {args} { #*** !doctools #[call class::table [method add_column] [arg args]] - set defaults [dict create\ - -headers [list]\ - -header_colspans [list]\ - -footers [list]\ - -defaultvalue ""\ - -ansibase ""\ - -ansireset "\uFFEF"\ - -minwidth ""\ - -maxwidth ""\ - -blockalign centre\ - -textalign left\ - ] - #initialise -ansireset with replacement char so we can keep in appropriate dict position for initial configure and then treat as read-only - set o_opts_column_defaults $defaults + + if {[llength $args] %2 != 0} { - error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: [dict keys $defaults]" + error "[namespace current]::table::add_column unexpected argument count. Require name value pairs. Known options: %copt_keys%" } - dict for {k v} $args { - if {$k ni [dict keys $defaults]} { - error "[namespace current]::table::add_column unknown option '$k'. Known options: [dict keys $defaults]" + set opts $o_opts_column_defaults + foreach {k v} $args { + switch -- $k { + %copt_switchkeys% { + dict set opts $k $v + } + default { + error "[namespace current]::table::add_column unknown option '$k'. Known options: %copt_keys%" + } } } - set opts [dict merge $defaults $args] set colcount [dict size $o_columndefs] + dict set o_columndata $colcount [list] - dict set o_columndefs $colcount $defaults ;#ensure record exists + #dict set o_columndefs $colcount $defaults ;#ensure record exists + dict set o_columndefs $colcount $o_opts_column_defaults ;#ensure record exists + + dict set o_columnstates $colcount [dict create minwidthbodyseen 0 maxwidthbodyseen 0 maxwidthheaderseen 0] set prev_calculated_column_widths $o_calculated_column_widths if {[catch { @@ -707,7 +758,7 @@ namespace eval textblock { return [dict get $o_columndefs $cidx] } else { if {[llength $args] == 1} { - if {[lindex $args 0] in [dict keys $o_opts_column_defaults]} { + if {[lindex $args 0] in [list %copt_keys%]} { #query single option set k [lindex $args 0] set val [dict get $o_columndefs $cidx $k] @@ -721,23 +772,30 @@ namespace eval textblock { dict set returndict info $infodict return $returndict } else { - error "textblock::table configure_column - unrecognised option '[lindex $args 0]'. Known values [dict keys $o_opts_column_defaults]" + error "textblock::table configure_column - unrecognised option '[lindex $args 0]'. Known values %copt_keys%" } } if {[llength $args] %2 != 0} { - error "textblock::table configure_column unexpected argument count. Require name value pairs. Known options: [dict keys $o_opts_column_defaults]" + error "textblock::table configure_column unexpected argument count. Require name value pairs. Known options: %copt_keys%" } - dict for {k v} $args { - if {$k ni [dict keys $o_opts_column_defaults]} { - error "[namespace current]::table configure_column unknown option '$k'. Known options: [dict keys $o_opts_column_defaults]" + foreach {k v} $args { + switch -- $k { + %copt_switchkeys% {} + default { + error "[namespace current]::table configure_column unknown option '$k'. Known options: %copt_keys%" + } } } - set checked_opts [list] + set checked_opts [dict get $o_columndefs $cidx] ;#copy of current state + set hstates $o_headerstates ;#operate on a copy set colstate [dict get $o_columnstates $cidx] - dict for {k v} $args { + set args_got_headers 0 + set args_got_header_colspans 0 + foreach {k v} $args { switch -- $k { -headers { + set args_got_headers 1 set i 0 set maxseen 0 ;#don't compare with cached colstate maxwidthheaderseen - we have all the headers for the column right here and need to refresh the colstate maxwidthheaderseen values completely. foreach hdr $v { @@ -761,9 +819,10 @@ namespace eval textblock { dict set colstate maxwidthheaderseen $maxseen #review - we could avoid some recalcs if we check current width range compared to previous set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -header_colspans { + set args_got_header_colspans 1 #check columns to left to make sure each new colspan for this column makes sense in the overall context #user may have to adjust colspans in order left to right to avoid these check errors #note that 'all' represents span all up to the next non-zero defined colspan. @@ -835,15 +894,15 @@ namespace eval textblock { } #todo - avoid recalc if no change set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -minwidth { set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -maxwidth { set o_calculated_column_widths [list] ;#invalidate cached column widths - a recalc will be forced when needed - lappend checked_opts $k $v + dict set checked_opts $k $v } -ansibase { set parts [punk::ansi::ta::split_codes_single $v] ;#caller may have supplied separated codes eg "[a+ Yellow][a+ red]" @@ -858,11 +917,11 @@ namespace eval textblock { } } set col_ansibase [punk::ansi::codetype::sgr_merge_singles $col_ansibase_items] - lappend checked_opts $k $col_ansibase + dict set checked_opts $k $col_ansibase } -ansireset { if {$v eq "\uFFEF"} { - lappend checked_opts $k "\x1b\[m" ;# [a] + dict set checked_opts $k "\x1b\[m" ;# [a] } else { error "textblock::table::configure_column -ansireset is read-only. It is present only to prevent unwanted colourised output in configure commands" } @@ -870,26 +929,25 @@ namespace eval textblock { -blockalign - -textalign { switch -- $v { left - right { - lappend checked_opts $k $v + dict set checked_opts $k $v } centre - centre { - lappend checked_opts $k centre + dict set checked_opts $k centre } } } default { - lappend checked_opts $k $v + dict set checked_opts $k $v } } } #args checked - ok to update headerstates and columndefs and columnstates + dict set o_columndefs $cidx $checked_opts + set o_headerstates $hstates dict set o_columnstates $cidx $colstate - set current_opts [dict get $o_columndefs $cidx] - set opts [dict merge $current_opts $checked_opts] - dict set o_columndefs $cidx $opts - if {"-headers" in [dict keys $args]} { + if {$args_got_headers} { #if the headerlist length for this column has shrunk,and it was the longest - we may now have excess entries in o_headerstates set zero_heights [list] dict for {hidx _v} $o_headerstates { @@ -902,7 +960,7 @@ namespace eval textblock { dict unset o_headerstates $zidx } } - if {"-headers" in [dict keys $args] || "-header_colspans" in [dict keys $args]} { + if {$args_got_headers || $args_got_header_colspans} { #check and adjust header_colspans for all columns } @@ -1525,19 +1583,20 @@ namespace eval textblock { method get_column_by_index {index_expression args} { #puts "+++> get_column_by_index $index_expression $args [namespace current]" #index_expression may be something like end-1 or 2+2 - we can't directly use it as a lookup for dicts. - set defaults [dict create\ + set opts [dict create\ -position "inner"\ -return "string"\ ] dict for {k v} $args { switch -- $k { - -position - -return {} + -position - -return { + dict set opts $k $v + } default { - error "[namespace current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $defaults]" + error "[namespace current]::table::get_column_by_index error invalid option '$k'. Known options [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_posn [dict get $opts -position] set opt_return [dict get $opts -return] @@ -2665,7 +2724,7 @@ namespace eval textblock { } method column_datawidth {index_expression args} { - set defaults [dict create\ + set opts [dict create\ -headers 0\ -footers 0\ -colspan *\ @@ -2675,13 +2734,14 @@ namespace eval textblock { #-colspan is relevant to header/footer data only dict for {k v} $args { switch -- $k { - -headers - -footers - -colspan - -data - -cached {} + -headers - -footers - -colspan - -data - -cached { + dict set opts $k $v + } default { - error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $defaults]" + error "column_datawidth unrecognised flag '$k'. Known flags: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_colspan [dict get $opts -colspan] @@ -3017,21 +3077,22 @@ namespace eval textblock { method calculate_column_widths {args} { set column_count [dict size $o_columndefs] - set defaults [dict create\ + set opts [dict create\ -algorithm $o_column_width_algorithm\ ] dict for {k v} $args { switch -- $k { - -algorithm {} + -algorithm { + dict set opts $k $v + } default { - error "Unknown option '$k'. Known options: [dict keys $defaults]" + error "Unknown option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_algorithm [dict get $opts -algorithm] #puts stderr "--- recalculating column widths -algorithm $opt_algorithm" - set known_algorithms [list basic simplistic span] + set known_algorithms [list basic simplistic span span2] switch -- $opt_algorithm { basic { #basic column by column - This allocates extra space to first span/column as they're encountered. @@ -3062,7 +3123,7 @@ namespace eval textblock { set o_calculated_column_widths [dict get $calcresult colwidths] } default { - error "calculate_column_widths unknown algorithm $opt_algorithm" + error "calculate_column_widths unknown algorithm $opt_algorithm. Known algorithms: $known_algorithms" } } #remember the last algorithm used @@ -3191,7 +3252,7 @@ namespace eval textblock { #*** !doctools #[list_end] - } + }] #*** !doctools # [list_end] [comment {- end enumeration provider_classes }] #[list_end] [comment {- end itemized list textblock::class groupings -}] @@ -3251,20 +3312,21 @@ namespace eval textblock { #For an impressive interactive terminal app (javascript) # see: https://github.com/spirometaxas/periodic-table-cli - set defaults [dict create\ + set opts [dict create\ -return "string"\ -compact 1\ -forcecolour 0\ ] dict for {k v} $args { switch -- $k { - -return - -compact - -forcecolour {} + -return - -compact - -forcecolour { + dict set opts $k $v + } default { - "textblock::periodic unknown option '$k'. Known options: [dict keys $defaults]" + "textblock::periodic unknown option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_return [dict get $opts -return] if {[dict get $opts -forcecolour]} { set fc forcecolour @@ -3291,63 +3353,73 @@ namespace eval textblock { set ecat [dict create] set cat_alkaline_earth [list Be Mg Ca Sr Ba Ra] - set ansi [a+ {*}$fc Web-gold web-black] + set ansi [a+ {*}$fc web-black Web-gold] + set val [list ansi $ansi cat alkaline_earth] foreach e $cat_alkaline_earth { - dict set ecat $e [list ansi $ansi cat alkaline_earth] + dict set ecat $e $val } set cat_reactive_nonmetal [list H C N O F P S Cl Se Br I] - set ansi [a+ {*}$fc Web-lightgreen web-black] + set ansi [a+ {*}$fc web-black Web-lightgreen] + set val [list ansi $ansi cat reactive_nonmetal] foreach e $cat_reactive_nonmetal { - dict set ecat $e [list ansi $ansi cat reactive_nonmetal] + dict set ecat $e $val } set cat [list Li Na K Rb Cs Fr] - set ansi [a+ {*}$fc Web-Khaki web-black] + set ansi [a+ {*}$fc web-black Web-Khaki] + set val [list ansi $ansi cat alkali_metals] foreach e $cat { - dict set ecat $e [list ansi $ansi cat alkali_metals] + dict set ecat $e $val } set cat [list Sc Ti V Cr Mn Fe Co Ni Cu Zn Y Zr Nb Mo Tc Ru Rh Pd Ag Cd Hf Ta W Re Os Ir Pt Au Hg Rf Db Sg Bh Hs] - set ansi [a+ {*}$fc Web-lightsalmon web-black] + set ansi [a+ {*}$fc web-black Web-lightsalmon] + set val [list ansi $ansi cat transition_metals] foreach e $cat { - dict set ecat $e [list ansi $ansi cat transition_metals] + dict set ecat $e $val } set cat [list Al Ga In Sn Tl Pb Bi Po] - set ansi [a+ {*}$fc Web-lightskyblue web-black] + set ansi [a+ {*}$fc web-black Web-lightskyblue] + set val [list ansi $ansi cat post_transition_metals] foreach e $cat { - dict set ecat $e [list ansi $ansi cat post_transition_metals] + dict set ecat $e $val } set cat [list B Si Ge As Sb Te At] - set ansi [a+ {*}$fc Web-turquoise web-black] + set ansi [a+ {*}$fc web-black Web-turquoise] + set val [list ansi $ansi cat metalloids] foreach e $cat { - dict set ecat $e [list ansi $ansi cat metalloids] + dict set ecat $e $val } set cat [list He Ne Ar Kr Xe Rn] - set ansi [a+ {*}$fc Web-orchid web-black] + set ansi [a+ {*}$fc web-black Web-orchid] + set val [list ansi $ansi cat noble_gases] foreach e $cat { - dict set ecat $e [list ansi $ansi cat noble_gases] + dict set ecat $e $val } set cat [list Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr] - set ansi [a+ {*}$fc Web-plum web-black] + set ansi [a+ {*}$fc web-black Web-plum] + set val [list ansi $ansi cat actinoids] foreach e $cat { - dict set ecat $e [list ansi $ansi cat actinoids] + dict set ecat $e $val } set cat [list La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu] - set ansi [a+ {*}$fc Web-tan web-black] + set ansi [a+ {*}$fc web-black Web-tan] + set val [list ansi $ansi cat lanthanoids] foreach e $cat { - dict set ecat $e [list ansi $ansi cat lanthanoids] + dict set ecat $e $val } set cat [list Mt Ds Rg Cn Nh Fl Mc Lv Ts Og] - set ansi [a+ {*}$fc Web-whitesmoke web-black] + set ansi [a+ {*}$fc web-black Web-whitesmoke] + set val [list ansi $ansi cat other] foreach e $cat { - dict set ecat $e [list ansi $ansi cat other] + dict set ecat $e $val } set elements1 [list] @@ -3372,25 +3444,24 @@ namespace eval textblock { $t configure_column $c -headers [list $h] -minwidth 2 incr c } - for {set c 0} {$c < [$t column_count]} {incr c} { + set ccount [$t column_count] + for {set c 0} {$c < $ccount} {incr c} { $t configure_column $c -minwidth 3 } if {[dict get $opts -compact]} { - $t configure -show_hseps 0 - $t configure -show_header 0 - $t configure -show_edge 0 + $t configure -show_hseps 0 -show_header 0 -show_edge 0 } else { $t configure -show_header 1 } if {$opt_return eq "string"} { - $t configure -frametype_header light - $t configure -ansiborder_header [a+ {*}$fc web-white] - $t configure -ansibase_header [a+ {*}$fc Web-black] - $t configure -ansibase_body [a+ {*}$fc Web-black] - $t configure -ansiborder_body [a+ {*}$fc web-black] - $t configure -frametype block - + $t configure \ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc web-white]\ + -ansibase_header [a+ {*}$fc Web-black]\ + -ansibase_body [a+ {*}$fc Web-black]\ + -ansiborder_body [a+ {*}$fc web-black]\ + -frametype block set output [textblock::frame -ansiborder [a+ {*}$fc Web-black web-cornflowerblue] -type heavy -title "[a+ {*}$fc Web-black] Periodic Table " [$t print]] return $output @@ -3398,7 +3469,6 @@ namespace eval textblock { return $t } - proc list_as_table {table_or_colcount datalist args} { set defaults [dict create\ -return string\ @@ -3406,15 +3476,17 @@ namespace eval textblock { -show_edge \uFFEF\ -show_seps \uFFEF\ ] + set opts $defaults foreach {k v} $args { switch -- $k { - -return - -show_edge - -show_seps - -frametype {} + -return - -show_edge - -show_seps - -frametype { + dict set opts $k $v + } default { error "unrecognised option '$k'. Known options [dict keys $defaults]" } } } - set opts [dict merge $defaults $args] set count [llength $datalist] @@ -3555,7 +3627,7 @@ namespace eval textblock { - set chars [concat [punk::range 1 9] A B C D E F] + set chars [concat [punk::lib::range 1 9] A B C D E F] set charsubset [lrange $chars 0 $size-1] if {"noreset" in $colour} { set RST "" @@ -3725,7 +3797,7 @@ namespace eval textblock { #pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- |? ?-which right|left|centre? ?-width auto|? ?-within_ansi 1|0?" foreach {k v} $args { switch -- $k { - -padchar - -which - -width - -overflow - -within_ansi {} + -padchar - -which - -width - -overflow - -within_ansi { + dict set opts $k $v + } default { error "textblock::pad unrecognised option '$k'. Usage: $usage" } } } - set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- set padchar [dict get $opts -padchar] #if padchar width (screen width) > 1 - length calculations will not be correct @@ -4001,19 +4074,20 @@ namespace eval textblock { } proc pad_test_blocklist {blocklist args} { - set defaults [dict create\ + set opts [dict create\ -description ""\ -blockheaders ""\ ] foreach {k v} $args { switch -- $k { - -description - -blockheaders {} + -description - -blockheaders { + dict set opts $k $v + } default { - error "pad_test_blocklist unrecognised option '$k'. Known options: [dict keys $defaults]" + error "pad_test_blocklist unrecognised option '$k'. Known options: [dict keys $opts]" } } } - set opts [dict merge $defaults $args] set opt_blockheaders [dict get $opts -blockheaders] set bheaders [dict create] if {$opt_blockheaders ne ""} { @@ -4148,7 +4222,7 @@ namespace eval textblock { proc ::textblock::join1 {args} { - lassign [punk::args::opts_values { + lassign [punk::args::get_dict { -ansiresets -default 1 -type integer blocks -type string -multiple 1 } $args] _o opts _v values @@ -4175,10 +4249,11 @@ namespace eval textblock { #for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed #they may however still be 'ragged' ie differing line lengths proc ::textblock::join {args} { - #lassign [punk::lib::opts_values { + #set argd [punk::args::get_dict { # blocks -type string -multiple 1 - #} $args] _o opts _v values - #set blocks [dict get $values blocks] + #} $args] + #set opts [dict get $argd opts] + #set blocks [dict get $argd values blocks] #-ansireplays is always on (if ansi detected) @@ -4212,8 +4287,8 @@ namespace eval textblock { set fordata [list] set colindices [list] foreach b $blocks { - set c($idx) [string repeat " " [width $b]] set w($idx) [width $b] ;#we need the width of a rendered block for per-row renderline calls + #set c($idx) [string repeat " " [set w($idx)]] #fairly commonly a block may be a vertical list of chars e.g something like 1\n2\n3 or -\n-\n-\n- #for determining a shortcut to avoid unnecessary ta::detect - (e.g width <=1) we can't use result of textblock::width as it strips ansi. #testing of any decent size block line by line - even with max_string_length_line is slower than ta::detect anyway. @@ -4254,16 +4329,17 @@ namespace eval textblock { # >} punk::lib::list_as_lines U+F8FF - although this is commonly used for example by nerdfonts @@ -5875,13 +5953,13 @@ namespace eval textblock { #this occurs commonly in table building with colspans - review - if {$actual_contentwidth > $frame_inner_width || $actual_contentheight != $frame_inner_height} { + if {($actual_contentwidth > $frame_inner_width) || ($actual_contentheight != $frame_inner_height)} { set usecache 0 #set buildcache 0 ;#comment out for debug/analysis so we can see #puts "--->> frame_inner_width:$frame_inner_width actual_contentwidth:$actual_contentwidth contents: '$contents'" set cache_key [a+ Web-red web-white]$cache_key[a] } - if {$buildcache && $actual_contentwidth < $frame_inner_width} { + if {$buildcache && ($actual_contentwidth < $frame_inner_width)} { #colourise cache_key to warn if {$actual_contentwidth == 0} { #we can still substitute with right length @@ -5891,7 +5969,7 @@ namespace eval textblock { if {[dict exists $frame_cache $cache_key]} { set cache_patternwidth [dict get $frame_cache $cache_key patternwidth] } else { - set cache_patternwidth [$actual_contentwidth] + set cache_patternwidth $actual_contentwidth } if {$actual_contentwidth < $cache_patternwidth} { set usecache 0
    @@ -22,7 +22,7 @@
    ansi - overtype_module_overtype · punkshell_module_punk::ansi + overtype_module_overtype · overtype_module_overtype · punkshell_module_punk::ansi
    args
    filesystem - punkshell_module_punk::path + punkshell_module_punk::path · shellspy_module_punk::island
    -Keywords: L +Keywords: I
    interp + shellspy_module_punk::island +
    +Keywords: L +
    lib punkshell_module_punk::lib @@ -120,35 +128,35 @@
    Keywords: M
    module - overtype_module_overtype · punkshell_module_punk::ansi · punkshell_module_punk::args · punkshell_module_punk::cap · punkshell_module_punk::char · punkshell_module_punk::encmime · punkshell_module_punk::fileline · punkshell_module_punk::flib · punkshell_module_punk::lib · punkshell_module_punk::path · shellspy_module_punk::assertion · shellspy_module_punk::basictelnet · shellspy_module_punk::sshrun · shellspy_module_punk::uc + overtype_module_overtype · overtype_module_overtype · punkshell_module_punk::ansi · punkshell_module_punk::args · punkshell_module_punk::cap · punkshell_module_punk::char · punkshell_module_punk::encmime · punkshell_module_punk::fileline · punkshell_module_punk::flib · punkshell_module_punk::lib · punkshell_module_punk::path · shellspy_module_argparsingtest · shellspy_module_punk::aliascore · shellspy_module_punk::assertion · shellspy_module_punk::basictelnet · shellspy_module_punk::island · shellspy_module_punk::repl::codethread · shellspy_module_punk::sshrun · shellspy_module_punk::uc
    Keywords: P
    parse punkshell_module_punk::args · punkshell_module_punk::fileline
    path punkshell_module_punk::path
    plugin punkshell_module_punk::cap
    proc punkshell_module_punk::args
    punk punkshell · punkshell__project_changes · punkshell__project_intro @@ -156,7 +164,7 @@
    Keywords: R
    repl punkshell · punkshell__project_changes · punkshell__project_intro @@ -164,17 +172,17 @@
    Keywords: S
    shell punkshell · punkshell__project_changes · punkshell__project_intro
    ssh shellspy_module_punk::sshrun
    string punkshell_module_punk::ansi @@ -182,20 +190,20 @@
    Keywords: T
    terminal punkshell_module_punk::ansi
    text - overtype_module_overtype · punkshell_module_punk::fileline + overtype_module_overtype · overtype_module_overtype · punkshell_module_punk::fileline
    Keywords: U
    utility punkshell_module_punk::lib diff --git a/src/embedded/www/toc.html b/src/embedded/www/toc.html index eb3a044..885cb98 100644 --- a/src/embedded/www/toc.html +++ b/src/embedded/www/toc.html @@ -17,70 +17,90 @@ overtype text layout - ansi aware
    overtype_module_overtypeovertype text layout - ansi aware
    punkshell punkshell - Core
    punkshell__project_changes punkshell Changes
    punkshell__project_intro Introduction to punkshell
    punkshell_module_punk::ansi Ansi string functions
    punkshell_module_punk::args args parsing
    punkshell_module_punk::cap capability provider and handler plugin system
    punkshell_module_punk::char character-set and unicode utilities
    punkshell_module_punk::encmime mime encodings related subset of tcllib mime
    punkshell_module_punk::fileline file line-handling utilities
    punkshell_module_punk::flib flib experimental
    punkshell_module_punk::lib punk general utility functions
    punkshell_module_punk::mix::commandset::project dec commandset - project
    punkshell_module_punk::path Filesystem path utilities
    shellspy_module_argparsingtestModule API
    shellspy_module_punk::aliascoreModule API
    shellspy_module_punk::assertion assertion alternative to control::assert
    shellspy_module_punk::basictelnet basic telnet client - DKF/Wiki
    shellspy_module_punk::islandfilesystem islands for safe interps
    shellspy_module_punk::repl::codethreadModule API
    shellspy_module_punk::sshrun Tcl procedures to execute tcl scripts in remote hosts
    shellspy_module_punk::uc Module API