jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

update bootsupport,_vfscommon

master
Julian Noble 4 months ago
parent
a02735fd38
commit
51fcdbfb0c
51 changed files with 10999 additions and 2588 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 253
      src/bootsupport/modules/punk-0.1.tm
  2. 7
      src/bootsupport/modules/punk/ansi-0.1.1.tm
  3. 325
      src/bootsupport/modules/punk/args-0.2.1.tm
  4. 2682
      src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  5. 14
      src/bootsupport/modules/punk/console-0.1.1.tm
  6. 8
      src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  7. 2
      src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm
  8. 8
      src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm
  9. 4
      src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  10. 23
      src/bootsupport/modules/punk/ns-0.1.0.tm
  11. 21
      src/bootsupport/modules/textblock-0.1.3.tm
  12. 253
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm
  13. 7
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
  14. 325
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm
  15. 2682
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  16. 14
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
  17. 8
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  18. 2
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm
  19. 8
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm
  20. 4
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  21. 23
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
  22. 21
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  23. 253
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm
  24. 7
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
  25. 325
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm
  26. 2682
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  27. 14
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
  28. 8
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  29. 2
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm
  30. 8
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm
  31. 4
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  32. 23
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
  33. 21
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  34. 4
      src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm
  35. 38
      src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm
  36. 253
      src/vfs/_vfscommon.vfs/modules/punk-0.1.tm
  37. 7
      src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm
  38. 327
      src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm
  39. 2682
      src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.1.0.tm
  40. 41
      src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tkcore-0.1.1.tm
  41. 2
      src/vfs/_vfscommon.vfs/modules/punk/basictelnet-0.1.0.tm
  42. 12
      src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm
  43. 14
      src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm
  44. 98
      src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm
  45. 8
      src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm
  46. 2
      src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm
  47. 8
      src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm
  48. 4
      src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm
  49. 23
      src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm
  50. 2
      src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm
  51. 21
      src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm

253
src/bootsupport/modules/punk-0.1.tm
Unescape View File

@ -564,14 +564,15 @@ namespace eval punk {
"Grep for regex pattern in plaintext of supplied (possibly ANSI) string."\
-help\
"The grepstr command can find strings in ANSI text even if there are interspersed
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
regex can match the plaintext. (Search is performed on ansistripped text, and then
the matched sections are highlighted and overlayed on the original styled/colourd
input.
If the input string has ANSI movement codes - the resultant text may not be directly
searchable because the parts of a word may be separated by various codes and other
plain text. To search such an input string, the string should first be 'rendered' to
a form where the ANSI only represents SGR styling (and perhaps other non-movement
a form where the ANSI only represents SGR styling (and perhaps other non-movement
codes) using something like overtype::renderline or overtype::rendertext."
@leaders -min 0 -max 0
@ -589,7 +590,7 @@ namespace eval punk {
except that when instead using -returnlines all with --line-number, the *
indicator after the linenumber will only be highlighted for lines with matches,
and the following matchcount will indicate zero for non-matching lines."
}
}
-B|--before-context= -parsekey "--before-context" -default 0 -type integer -typesynopsis num
-C|--context= -parsekey "--context" -default 0 -type integer -typesynopsis num -help\
"Print num lines of leading and trailing context surrounding each match."
@ -628,7 +629,10 @@ namespace eval punk {
-- -type none
@values
pattern -type string -help\
"regex pattern to match in plaintext portion of ANSI string"
"regex pattern to match in plaintext portion of ANSI string
The pattern may contain bracketed capturing groups, which
will be highlighted (todo) in the result. If there is no capturing
group, the entire match will be highlighted."
string -type string
}
proc grepstr {args} {
@ -670,40 +674,117 @@ namespace eval punk {
}
set data [string map {\r\n \n} $data]
if {![punk::ansi::ta::detect $data]} {
if {[punk::ansi::ta::detect $data]} {
set raw_has_ansi 1
set plain [punk::ansi::ansistrip $data]
} else {
set raw_has_ansi 0
set plain $data
}
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $lines $pattern]
set result ""
set matched_line_indices [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
#matches|breaksandmatches
set returnlines $matches
set returnlines $matched_line_indices
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
#lineindex is zero based - display of linenums is 1 based
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matched_line_indices} {
set plain_ln [lindex $plainlines $lineindex]
#first test the regexp with a single match to determine number of capturing groups
set matchparts [regexp {*}$nocase -inline -- $pattern $plain_ln] ;#get fullmatch capturegroup...
set numgroups [expr {[llength $matchparts] -1}]
set allparts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
#allparts includes each full match as well as each capturing group
#early versions of tcl 8.6 still didn't support 'lsearch -stride' - avoid for now.
set matchcount [expr {[llength $allparts] / ($numgroups + 1)}]
#set matchcount [llength $allparts]
if {$matchcount == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr (shouldn't happen) regex: $pattern lineindex: $lineindex"
set matchshow "??? $ln"
dict set resultlines $lineindex $matchshow
continue
}
if {$lineindex in $matches} {
set ln [regsub -all {*}$nocase -- $pattern $ln $H&$R] ;#n
set matchcount [regexp -all {*}$nocase -- $pattern $ln]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
# ------------------------------------
if {$numgroups > 0} {
# restrict ourself to just the capture groups, excluding the full match (if there are capture groups)
set highlight_ranges [list]
set i 0
foreach range $allparts {
if {($i % ($numgroups+1)) != 0} {
lappend highlight_ranges $range
}
incr i
}
} else {
if {$do_linenums} {
append col1 "*000"
#No capture group in the regex, each index range is just a full match
set highlight_ranges $allparts
}
# ------------------------------------
#puts stderr "numgroups : $numgroups"
#puts stderr "grepstr pattern : $pattern"
#puts stderr "grepstr allparts: $allparts"
#puts stderr "highlight_ranges: $highlight_ranges"
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {$raw_has_ansi} {
set overlay ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
#set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
set rendered [overtype::renderspace -transparent $placeholder -insert_mode 0 $ln $overlay]
} else {
set rendered ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
append rendered [string range $plain_ln $i $s-1] $H [string range $plain_ln $s $e] $R
set i [expr {$e + 1}]
}
append rendered [string range $plain_ln $e+1 end]
}
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
@ -721,12 +802,7 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
if {$do_linenums} {
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
@ -742,109 +818,16 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
}
} else {
set plain [punk::ansi::ansistrip $data]
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
set returnlines $matches
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matches} {
set plain_ln [lindex $plainlines $lineindex]
set parts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
set matchcount [llength $parts]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {[llength $parts] == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr - line marked with ??? (shouldn't happen)"
set matchshow "??? $ln"
#dict set resultlines $lineindex $show
} else {
set overlay ""
set i 0
foreach prange $parts {
lassign $prange s e
set prelen [expr {$s - $i}]
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
if {$s < -1} {set s -1}
foreach p $prelines {
incr s
#append result "[format %${w1}s [expr {$s+1}]]- " " " $p \n
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
foreach p $postlines {
incr s
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
append col1 "*000"
set show "$col1 $ln"
} else {
if {$do_linenums} {
append col1 "*000"
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
set show $ln
}
dict set resultlines $lineindex $show
}
}
set ordered_resultlines [lsort -integer [dict keys $resultlines]]
set result ""
@ -7828,6 +7811,7 @@ namespace eval punk {
lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"]
lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"]
lappend cmdinfo [list s "cmd ?subcommand...?" "Show synopsis for a command or ensemble subcommand"]
lappend cmdinfo [list eg "cmd ?subcommand...?" "Show example from manpage"]
lappend cmdinfo [list ./ "?subdir?" "view/change directory"]
lappend cmdinfo [list ../ "" "go up one directory"]
lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"]
@ -7884,12 +7868,19 @@ namespace eval punk {
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/1095bf7f75]"
append warningblock [a]
}
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
if {[catch {lsearch -stride 2 {a b} b}]} {
set indent " "
append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n
append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n
append warningblock [a]
} else {
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
}
}
if {[punk::lib::check::has_tclbug_list_quoting_emptyjoin]} {
set indent " "

7
src/bootsupport/modules/punk/ansi-0.1.1.tm
Unescape View File

@ -171,7 +171,8 @@ tcl::namespace::eval punk::ansi::class {
}
default {
puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x"
punk::args::get_by_id "::punk::ansi::class::class_ansi render_to_input_line" $args
punk::args::parse $args withid "::punk::ansi::class::class_ansi render_to_input_line"
return
}
}
}
@ -2763,7 +2764,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
@values -min 0 -max 0
}]
proc sgr_cache {args} {
set argd [punk::args::get_by_id ::punk::ansi::sgr_cache $args]
set argd [punk::args::parse $args withid ::punk::ansi::sgr_cache]
set action [dict get $argd opts -action]
set pretty [dict get $argd opts -pretty]
@ -3943,7 +3944,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
lappend codestack $code
} else {
#jjtest
apend emit $code
append emit $code
}
}
7GFX {

325
src/bootsupport/modules/punk/args-0.2.1.tm
Unescape View File

@ -270,6 +270,190 @@ tcl::namespace::eval punk::args::register {
tcl::namespace::eval ::punk::args {}
tcl::namespace::eval ::punk::args::helpers {
variable PUNKARGS
namespace export *
#proc B {} {return \x1b\[1m} ;#a+ bold
#proc N {} {return \x1b\[22m} ;#a+ normal
#proc I {} {return \x1b\[3m} ;#a+ italic
#proc NI {} {return \x1b\[23m} ;#a+ noitalic
proc I {} {punk::ansi::a+ italic}
proc B {} {punk::ansi::a+ bold}
proc N {} {punk::ansi::a+ normal}
proc NI {} {punk::ansi::a+ italic}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::example
@cmd -name punk::args::helpers::example\
-summary\
{Display formatting for argdoc example text}\
-help\
{Wrap }
@opts
-padright -type integer -default 2 -help\
{Number of padding spaces to add on RHS of text block}
-syntax -type string -default tcl -choices {none tcl} -choicelabels {
tcl\
" Very basic tcl syntax highlighting
of braces,square brackets and comments."
-title -type string -default ""
-titlealign -type string -choices {left centre right}
}
text -type string
}]
proc example {args} {
#only use punk::args::parse on the unhappy path
if {[llength $args] == 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set str [lindex $args end]
set optlist [lrange $args 0 end-1]
if {[llength $optlist] %2 != 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set defaults [dict create\
-padright 2\
-syntax tcl\
-title ""\
-titlealign left\
]
dict for {o v} $optlist {
switch -- $o {
-padright - -syntax - -title - -titlealign {}
default {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
}
}
set opts [dict merge $defaults $optlist]
set opt_padright [dict get $opts -padright]
set opt_syntax [dict get $opts -syntax]
set opt_title [dict get $opts -title]
set opt_titlealign [dict get $opts -titlealign]
if {[string index $str 0] eq "\n"} {
set str [string range $str 1 end]
}
if {[string index $str end] eq "\n"} {
set str [string range $str 0 end-1]
}
#example is intended to run from a source doc that has already been dedented appropriately based on context
# - we don't want to further undent, hence -undent 0
set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
if {$opt_padright > 0} {
set str [textblock::join -- $str [string repeat " " $opt_padright]]
}
if {$opt_title ne ""} {
set title "[a+ term-black Term-silver]$opt_title[a]"
} else {
set title ""
}
set str [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey white] -ansiborder [a+ term-black Term-silver] -titlealign $opt_titlealign -title $title -boxlimits {hl} -type block $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
#rudimentary colourising (not full tcl syntax parsing)
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
switch -- $opt_syntax {
tcl {
#result lines often indicated in examples by \u2192 →
#however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str]
#TODO - fix grepstr highlighting (bg issues - why?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkblue} {\{|\}} $str]
set str [punk::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
}
}
set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"]
return $result
}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::strip_nodisplay_lines
@cmd -name punk::args::helpers::strip_nodisplay_lines\
-summary\
"strip #<nodisplay> lines."\
-help\
"Strip lines beginning with #<nodisplay> from the supplied text.
Whitespace prior to #<nodisplay> is ignored, and ANSI is stripped
prior to examining each line for the #<nodisplay> tag."
@values -min 1 -max 1
text -optional 0 -help\
{punk::args::define scripts must have properly balanced braces etc
as per Tcl rules.
Sometimes it is desired to display help text or examples demonstrating
unbalanced braces etc, but without escaping it in a way that shows the
escaping backslash in the help text. This balancing requirement includes
curly braces in comments. eg
${[punk::args::helpers::example -title " Example 1a " {
proc bad_syntax {args} {
#eg this is an unbalanced left curly brace {
#<nodisplay> balancing right curly brace }
return $args
}
}]}
There is a second comment line in the above proc which begins
with #<nodisplay> and contains the balancing right curly brace.
This shouldn't show in the example above.
The actual text is in a placeholder call to punk::args::helpers::example
to provide basic syntax highlighting and box background, and looks like
the following, but without the left-hand side pipe symbols.
${[punk::args::helpers::example -syntax none -title " Example 1b " {
| proc bad_syntax {args} {
| #eg this is an unbalanced left curly brace {
| #<nodisplay> balancing right curly brace }
| return $args
| }
}]}
Technically a proc body can exist with an unbalanced brace in a comment
like that and would still run without issue. However, such a definition
couldn't be placed in a tcl file to be sourced, nor directly evaluated
with eval.
A #<nodisplay> comment can also be used just for commenting the help
source inline.
Note that an opening square bracket can't be balanced by a line beginning
with the # character.
The non-comment form @#<nodisplay> is available so help lines beginning
with this token will also be stripped. This can be used to 'close' a
section of text that happens to look like a command block. This should
only be used if there is some reason the opening square bracket can't
be rewritten in the help doc to be escaped with a backslash.
The ${[B]}strip_nodisplay_lines${[N]} function is called automatically
by the help text generators in punk::args, and generally shouldn't need
to be used directly, but nevertheless resides in in punk::args::helpers
alongside the ${[B]}example${[N]} function which is intended for writers
of punk::args::define scripts (command documentors) to use.
}
}]
proc strip_nodisplay_lines {text} {
set display ""
foreach ln [split $text \n] {
set stripped [string trimleft [punk::ansi::ansistrip $ln]]
if {![string match "#<nodisplay>*" $stripped] && ![string match "@#<nodisplay>*" $stripped]} {
append display $ln \n
}
}
if {[string index $display end] eq "\n"} {
set display [string range $display 0 end-1]
}
return $display
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -419,6 +603,7 @@ tcl::namespace::eval punk::args {
directive-options: -help <str>
%B%@seealso%N% ?opt val...?
directive-options: -name <str> -url <str> (for footer - unimplemented)
%B%@instance%N% ?opt val...?
Some other options normally present on custom arguments are available
to use with the @leaders @opts @values directives to set defaults
@ -624,8 +809,21 @@ tcl::namespace::eval punk::args {
-maxsize (type dependant)
-range (type dependant - only valid if -type is a single item)
-typeranges (list with same number of elements as -type)
-help <string>
for the @cmd directive - this is the main multiline description.
For an argument is the multi-line help that displays in the Help
column.
For the @examples directive this is the text for examples as
displayed with 'eg <commandname>'
The -help string can be delimited with double quotes or with
curly braces, the choice will affect what inner chars require
backslash escaping - but neither type of help block is
automatically subject to variable or command substitution aside
from those specifically wrapped in placeholders.
For cases where unbalanced braces, double quotes are to
be displayed to the user without visible backslash escapes,
see 'i ::punk::args::helpers::strip_nodisplay_lines'
"
-dynamic -type boolean -default 0 -help\
"If -dynamic is true, tstr interpolations of the form \$\{\$var\}
@ -649,7 +847,7 @@ tcl::namespace::eval punk::args {
from existing definitions (by id) for re-use of argument specifications and help text)
e.g the following definition passes 2 blocks as text arguments
${[punk::args::moduledoc::tclcore::argdoc::example {
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc -help\
@ -955,6 +1153,8 @@ tcl::namespace::eval punk::args {
set LVL 2
if {!$is_dynamic} {
#todo - don't use cached version if 'colour off' vs 'colour on' different to when last resolved!
#(e.g example blocks will still have colour if previously resolved)
if {[tcl::dict::exists $argdata_cache $cache_key]} {
return [tcl::dict::get $argdata_cache $cache_key]
}
@ -1082,6 +1282,19 @@ tcl::namespace::eval punk::args {
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
@ -1174,17 +1387,23 @@ tcl::namespace::eval punk::args {
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {}
set package_info {}
set id_info {} ;#e.g -children <list> ??
set doc_info {}
#set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table
set seealso_info {}
#set credits_info {} ;#e.g see interp man CREDITS section todo - where to display?
set instance_info {}
set keywords_info {}
set examples_info {}
###set leader_min 0
@ -1212,6 +1431,14 @@ tcl::namespace::eval punk::args {
"" - # {continue}
}
incr record_number
if {[catch {lassign $trimrec firstword}]} {
puts stdout "----------------------------------------------"
puts stderr "rec: $rec"
set ::testrecord $rec
puts stdout "----------------------------------------------"
puts "records: $records"
puts stdout "=============================================="
}
set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict
if {[llength $record_values] % 2 != 0} {
#todo - avoid raising an error - store invalid defs keyed on id
@ -1854,6 +2081,10 @@ tcl::namespace::eval punk::args {
#like @doc, except displays in footer, multiple - sub-table?
set seealso_info [dict merge $seealso_info $at_specs]
}
instance {
#todo!
set instance_info [dict merge $instance_info $at_specs]
}
keywords {
#review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ??
set keywords_info [dict merge $keywords_info $at_specs]
@ -2429,6 +2660,7 @@ tcl::namespace::eval punk::args {
doc_info $doc_info\
package_info $package_info\
seealso_info $seealso_info\
instance_info $instance_info\
keywords_info $keywords_info\
examples_info $examples_info\
id_info $id_info\
@ -2461,9 +2693,9 @@ tcl::namespace::eval punk::args {
namespace eval argdoc {
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @instance @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICEGROUPS {
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso}
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso @instance}
argumenttypes {leaders opts values}
remaining_defaults {@leaders @opts @values}
}
@ -2680,7 +2912,7 @@ tcl::namespace::eval punk::args {
dict set resultdict @id [list -id [dict get $specdict id]]
}
}
foreach directive {@package @cmd @doc @examples @seealso} {
foreach directive {@package @cmd @doc @examples @seealso @instance} {
set dshort [string range $directive 1 end]
if {"$directive" in $included_directives} {
if {[dict exists $opt_override $directive]} {
@ -2747,7 +2979,7 @@ tcl::namespace::eval punk::args {
}
}
}
@package - @cmd - @doc - @examples - @seealso {
@package - @cmd - @doc - @examples - @seealso - @instance {
if {"$type" in $included_directives} {
set tp [string range $type 1 end] ;# @package -> package
if {[dict exists $opt_override $type]} {
@ -3671,6 +3903,7 @@ tcl::namespace::eval punk::args {
lappend blank_header_col ""
#set cmdhelp_display [a+ brightwhite]$cmdhelp[a]
#set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)]
set cmdhelp [punk::args::helpers::strip_nodisplay_lines $cmdhelp]
set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp]
} else {
set cmdhelp_display ""
@ -4055,6 +4288,7 @@ tcl::namespace::eval punk::args {
}
set unindentedfields [Dict_getdef $arginfo -unindentedfields {}]
set help [Dict_getdef $arginfo -help ""]
set help [punk::args::helpers::strip_nodisplay_lines $help]
set allchoices_originalcase [list]
set choices [Dict_getdef $arginfo -choices {}]
set choicegroups [Dict_getdef $arginfo -choicegroups {}]
@ -4610,7 +4844,6 @@ tcl::namespace::eval punk::args {
Will usually match the command name"
}]
proc usage {args} {
#lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received
set id [dict get $values id]
set real_id [real_id $id]
@ -4656,7 +4889,7 @@ tcl::namespace::eval punk::args {
lappend PUNKARGS [list {
@id -id ::punk::args::parse
@cmd -name punk::args::parse -help\
"parse and validate command arguments based on a definition.
{parse and validate command arguments based on a definition.
In the 'withid' form the definition is a pre-existing record that has been
created with ::punk::args::define, or indirectly by adding a definition to
@ -4673,23 +4906,25 @@ tcl::namespace::eval punk::args {
Returns a dict of information regarding the parsed arguments
example of basic usage for single option only:
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts \"have option for existing file [dict get $opts -configfile]\"
}
}
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts "have option for existing file [dict get $opts -configfile]"
}
}
}]}
The leaders, opts, values keys in the parse result dict are proper dicts.
The received key is dict-like but can have repeated keys for arguments than can
accept multiples. The value for each received element is the ordinal position.
@ -4698,7 +4933,7 @@ tcl::namespace::eval punk::args {
to another procedure which also requires solos, because the opts dict contains
solo flags with a 1 value or a list of 1's if it was a solo with -multiple true
specified.
"
}
@form -form {withid withdef}
@leaders -min 1 -max 1
arglist -type list -optional 0 -help\
@ -4713,6 +4948,12 @@ tcl::namespace::eval punk::args {
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
-cache -type boolean -default 0 -help\
{Use sparingly.
This uses a cache for same arguments being parsed against
the same definition.
It is a minor speedup suitable for when a small set of similar
(and generally small) arguments are repeatedly used by a function.}
@values -min 2
@ -4738,6 +4979,7 @@ tcl::namespace::eval punk::args {
how to process the definition."
}]
variable parse_cache [dict create]
proc parse {args} {
#puts "punk::args::parse --> '$args'"
set tailtype "" ;#withid|withdef
@ -4802,6 +5044,7 @@ tcl::namespace::eval punk::args {
set defaultopts [dict create\
-form {*}\
-errorstyle standard\
-cache 0\
]
#todo - load override_errorstyle from configuration
@ -4810,7 +5053,7 @@ tcl::namespace::eval punk::args {
set opts [dict merge $defaultopts $opts]
dict for {k v} $opts {
switch -- $k {
-form - -errorstyle {
-form - -errorstyle - -cache {
}
default {
#punk::args::usage $args withid ::punk::args::parse ??
@ -4847,7 +5090,19 @@ tcl::namespace::eval punk::args {
}
try {
#puts stdout "parse --> get_dict <deflist> $parseargs -form [dict get $opts -form]"
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
if {![dict get $opts -cache]} {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
} else {
variable parse_cache
set key [list $parseargs $deflist [dict get $opts -form]]
if {[dict exists $parse_cache $key]} {
set result [dict get $parse_cache $key]
} else {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
dict set parse_cache $key $result
}
return $result
}
} trap {PUNKARGS VALIDATION} {msg erroropts} {
set opt_errorstyle [dict get $opts -errorstyle]
@ -7201,7 +7456,7 @@ tcl::namespace::eval punk::args {
# -----------------------------------------------
# Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc)
tcl::dict::with argspecs {} ;#turn keys into vars
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info,id_info,form_names
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names
# -----------------------------------------------
set opt_form [dict get $proc_opts -form]
if {$opt_form eq "*"} {
@ -9152,7 +9407,8 @@ tcl::namespace::eval punk::args {
return
}
if {[dict exists $spec examples_info -help]} {
return [dict get $spec examples_info -help]
set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata]
} else {
return "no @examples defined for $id"
}
@ -9177,7 +9433,8 @@ tcl::namespace::eval punk::args {
cmditem -multiple 1 -optional 0
}]
proc synopsis {args} {
set argd [punk::args::parse $args withid ::punk::args::synopsis]
#synopsis potentially called repeatedly with same args? use -cache 1
set argd [punk::args::parse $args -cache 1 withid ::punk::args::synopsis]
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
@ -10807,7 +11064,7 @@ tcl::namespace::eval punk::args::package {
# set PUNKARGS ""
#}
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package ::punk::args::helpers
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools

2682
src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
View File

File diff suppressed because it is too large Load Diff

14
src/bootsupport/modules/punk/console-0.1.1.tm
Unescape View File

@ -669,21 +669,21 @@ namespace eval punk::console {
prudent."
@values -min 2 -max 2
query -type string -help\
"ANSI sequence such as \x1b\[?6n which
{ANSI sequence such as \x1b\[?6n which
should elicit a response by the terminal
on stdin"
on stdin}
capturingendregex -type string -help\
"capturingendregex should capture ANY prefix, whole escape match - and a subcapture
{capturingendregex should capture ANY prefix, whole escape match - and a subcapture
of the data we're interested in; and match at end of string.
ie {(.*)(ESC(info)end)$}
e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$}
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)"
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)}
}]
#todo - check capturingendregex value supplied has appropriate captures and tail-anchor
proc get_ansi_response_payload {args} {
#we pay a few 10s of microseconds to use punk::args::parse (on the happy path)
#seems reasonable for the flexibility in this case.
set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::internal::get_ansi_response_payload]
lassign [dict values $argd] leaders opts values received
set inoutchannels [dict get $opts -terminal]
@ -1507,7 +1507,7 @@ namespace eval punk::console {
or omit to query cell size."
}
proc cell_size {args} {
set argd [punk::args::get_by_id ::punk::console::cell_size $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::cell_size]
set inoutchannels [dict get $argd opts -inoutchannels]
set newsize [dict get $argd values newsize]
@ -1551,7 +1551,7 @@ namespace eval punk::console {
#only works in raw mode for windows terminal - (esc in output stripped?) why?
# works in line mode for alacrity and wezterm
proc test_is_vt52 {args} {
set argd [punk::args::get_by_id ::punk::console::test_is_vt52 $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::test_is_vt52]
set inoutchannels [dict get $argd opts -inoutchannels]
#ESC / K VT52 without printer
#ESC / M VT52 with printer

8
src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
Unescape View File

@ -44,14 +44,18 @@ namespace eval punk::mix::commandset::layout {
#per layout functions
punk::args::define {
@dynamic
@id -id ::punk::mix::commandset::layout::files
@id -id ::punk::mix::commandset::layout::files
@cmd -name punk::mix::commandset::layout::files -synopsis\
"list files in project layout"\
-help\
""
-datetime -default "%Y-%m-%dT%H:%M:%S" -help\
"Datetime format for mtime. Use empty string for no datetime output"
@values -min 1 -max 1
layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}}
}
proc files {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::layout::files]
set layout [dict get $argd values layout]
set dtformat [dict get $argd opts -datetime]

2
src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm
Unescape View File

@ -44,7 +44,7 @@ namespace eval punk::mix::commandset::loadedlib {
If search is not prefixed with '=' the search is case insensitive."
}
proc search {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::loadedlib::search $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::loadedlib::search]
set searchstrings [dict get $argd values searchstring]
set opts [dict get $argd opts]
set opt_return [dict get $opts -return]

8
src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm
Unescape View File

@ -132,7 +132,6 @@ namespace eval punk::mix::commandset::module {
globsearches -default * -multiple 1
}
proc templates_dict {args} {
#set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::templates_dict]
package require punk::cap
if {[punk::cap::capability_has_handler punk.templates]} {
@ -146,7 +145,10 @@ namespace eval punk::mix::commandset::module {
set moduletypes [punk::mix::cli::lib::module_types]
punk::args::define [subst {
@id -id ::punk::mix::commandset::module::new
@cmd -name "punk::mix::commandset::module::new" -help\
@cmd -name "punk::mix::commandset::module::new"\
-synopsis\
"create .tm module file from template"\
-help\
"Create a new module file in the appropriate folder within src/modules.
If the name given in the module argument is namespaced,
the necessary subfolder(s) will be used or created."
@ -173,7 +175,7 @@ namespace eval punk::mix::commandset::module {
proc new {args} {
set year [clock format [clock seconds] -format %Y]
# use \uFFFD because unicode replacement char should consistently render as 1 wide
set argd [punk::args::get_by_id ::punk::mix::commandset::module::new $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::new]
lassign [dict values $argd] leaders opts values received
set module [dict get $values module]

4
src/bootsupport/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -644,7 +644,7 @@ tcl::namespace::eval punk::nav::fs {
@values -min 0 -max -1 -unnamed true
}
proc dirfiles {args} {
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles]
lassign [dict values $argd] leaders opts values_dict
set opt_stripbase [dict get $opts -stripbase]
@ -1005,7 +1005,7 @@ tcl::namespace::eval punk::nav::fs {
#todo - color key via repl-telemetry? help command? documentation? or add tag columns as done in namespace listing?
proc dirfiles_dict_as_lines {args} {
package require overtype
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles_dict_as_lines $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict_as_lines]
lassign [dict values $argd] leaders opts vals
set list_of_dicts [dict values $vals]

23
src/bootsupport/modules/punk/ns-0.1.0.tm
Unescape View File

@ -2447,7 +2447,8 @@ tcl::namespace::eval punk::ns {
"Name of ensemble command for which subcommand info is gathered."
}
proc ensemble_subcommands {args} {
set argd [punk::args::get_by_id ::punk::ns::ensemble_subcommands $args]
#puts stderr "---> punk::ns::ensemble_subcommands $args"
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::ensemble_subcommands]
set opts [dict get $argd opts]
set origin [dict get $argd values origin]
@ -3087,6 +3088,7 @@ tcl::namespace::eval punk::ns {
}]
append argdef \n $vline
append argdef \n "@values -unnamed true"
append argdef \n "@instance -help {instance info derived from id (instance)::$origin ?}"
punk::args::define $argdef
}
@ -3331,7 +3333,7 @@ tcl::namespace::eval punk::ns {
}
variable cmdinfo_reducerid 0
proc cmdinfo {args} {
set argd [punk::args::parse $args withid ::punk::ns::cmdinfo]
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdinfo]
lassign [dict values $argd] leaders opts values received
set cmdlist [dict get $values cmditem]
@ -5256,7 +5258,8 @@ tcl::namespace::eval punk::ns {
basic {
#rudimentary colourising only
set argl [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $argl]
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {;\s*(#.*)} $body] ;#treat as tail comment only if preceeded by semicolon
set body [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $body]
set body [punk::grepstr -return all -highlight tk-orange {\[|\]} $body]
#ansi colourised items in list format may not always have desired string representation (list escaping can occur)
@ -5669,7 +5672,7 @@ tcl::namespace::eval punk::ns {
e.g ::mynamespace::a* ::mynamespace::j*"
}
proc nsimport_noclobber {args} {
lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::ns::nsimport_noclobber]] leaders opts values received
set sourcepatterns [dict get $values sourcepattern]
set nscaller [uplevel 1 {namespace current}]
@ -5827,12 +5830,12 @@ tcl::namespace::eval punk::ns {
"Command names for which to show help info"
}
interp alias {} i+ {}\
.=args> punk::args::get_by_id ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=args>1 punk::args::parse withid ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=tables>* textblock::join -- <args|
}

21
src/bootsupport/modules/textblock-0.1.3.tm
Unescape View File

@ -149,13 +149,14 @@ tcl::namespace::eval textblock {
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
#proc example {str} {
# set str [string trimleft $str \n]
# set block [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
# set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
# #puts $result
# return $result
#}
namespace import ::punk::args::helpers::*
}
@ -4196,7 +4197,7 @@ tcl::namespace::eval textblock {
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
set opts [dict get [punk::args::parse $args withid ::textblock::periodic] opts]
set opts [dict get [punk::args::parse $args -cache 1 withid ::textblock::periodic] opts]
set opt_return [tcl::dict::get $opts -return]
if {[tcl::dict::get $opts -forcecolour]} {
set fc forcecolour
@ -5601,7 +5602,7 @@ tcl::namespace::eval textblock {
set rows [concat $r0 $r1 $r2 $r3]
set column_ansi [a+ web-white Web-Gray]
set column_ansi [a+ term-white Term-grey]
set t [textblock::list_as_table -columns [expr {1 + (2 * [tcl::dict::size $blockinfo])}] -return tableobject $rows]
$t configure_column 0 -headers [list [tcl::dict::get $opts -description] "within_ansi"] -ansibase $column_ansi
@ -5723,7 +5724,7 @@ tcl::namespace::eval textblock {
#join without regard to each line length in a block (no padding added to make each block uniform)
proc ::textblock::join_basic {args} {
set argd [punk::args::parse $args withid ::textblock::join_basic]
set argd [punk::args::parse $args -cache 1 withid ::textblock::join_basic]
set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks]

253
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm
Unescape View File

@ -564,14 +564,15 @@ namespace eval punk {
"Grep for regex pattern in plaintext of supplied (possibly ANSI) string."\
-help\
"The grepstr command can find strings in ANSI text even if there are interspersed
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
regex can match the plaintext. (Search is performed on ansistripped text, and then
the matched sections are highlighted and overlayed on the original styled/colourd
input.
If the input string has ANSI movement codes - the resultant text may not be directly
searchable because the parts of a word may be separated by various codes and other
plain text. To search such an input string, the string should first be 'rendered' to
a form where the ANSI only represents SGR styling (and perhaps other non-movement
a form where the ANSI only represents SGR styling (and perhaps other non-movement
codes) using something like overtype::renderline or overtype::rendertext."
@leaders -min 0 -max 0
@ -589,7 +590,7 @@ namespace eval punk {
except that when instead using -returnlines all with --line-number, the *
indicator after the linenumber will only be highlighted for lines with matches,
and the following matchcount will indicate zero for non-matching lines."
}
}
-B|--before-context= -parsekey "--before-context" -default 0 -type integer -typesynopsis num
-C|--context= -parsekey "--context" -default 0 -type integer -typesynopsis num -help\
"Print num lines of leading and trailing context surrounding each match."
@ -628,7 +629,10 @@ namespace eval punk {
-- -type none
@values
pattern -type string -help\
"regex pattern to match in plaintext portion of ANSI string"
"regex pattern to match in plaintext portion of ANSI string
The pattern may contain bracketed capturing groups, which
will be highlighted (todo) in the result. If there is no capturing
group, the entire match will be highlighted."
string -type string
}
proc grepstr {args} {
@ -670,40 +674,117 @@ namespace eval punk {
}
set data [string map {\r\n \n} $data]
if {![punk::ansi::ta::detect $data]} {
if {[punk::ansi::ta::detect $data]} {
set raw_has_ansi 1
set plain [punk::ansi::ansistrip $data]
} else {
set raw_has_ansi 0
set plain $data
}
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $lines $pattern]
set result ""
set matched_line_indices [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
#matches|breaksandmatches
set returnlines $matches
set returnlines $matched_line_indices
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
#lineindex is zero based - display of linenums is 1 based
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matched_line_indices} {
set plain_ln [lindex $plainlines $lineindex]
#first test the regexp with a single match to determine number of capturing groups
set matchparts [regexp {*}$nocase -inline -- $pattern $plain_ln] ;#get fullmatch capturegroup...
set numgroups [expr {[llength $matchparts] -1}]
set allparts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
#allparts includes each full match as well as each capturing group
#early versions of tcl 8.6 still didn't support 'lsearch -stride' - avoid for now.
set matchcount [expr {[llength $allparts] / ($numgroups + 1)}]
#set matchcount [llength $allparts]
if {$matchcount == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr (shouldn't happen) regex: $pattern lineindex: $lineindex"
set matchshow "??? $ln"
dict set resultlines $lineindex $matchshow
continue
}
if {$lineindex in $matches} {
set ln [regsub -all {*}$nocase -- $pattern $ln $H&$R] ;#n
set matchcount [regexp -all {*}$nocase -- $pattern $ln]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
# ------------------------------------
if {$numgroups > 0} {
# restrict ourself to just the capture groups, excluding the full match (if there are capture groups)
set highlight_ranges [list]
set i 0
foreach range $allparts {
if {($i % ($numgroups+1)) != 0} {
lappend highlight_ranges $range
}
incr i
}
} else {
if {$do_linenums} {
append col1 "*000"
#No capture group in the regex, each index range is just a full match
set highlight_ranges $allparts
}
# ------------------------------------
#puts stderr "numgroups : $numgroups"
#puts stderr "grepstr pattern : $pattern"
#puts stderr "grepstr allparts: $allparts"
#puts stderr "highlight_ranges: $highlight_ranges"
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {$raw_has_ansi} {
set overlay ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
#set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
set rendered [overtype::renderspace -transparent $placeholder -insert_mode 0 $ln $overlay]
} else {
set rendered ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
append rendered [string range $plain_ln $i $s-1] $H [string range $plain_ln $s $e] $R
set i [expr {$e + 1}]
}
append rendered [string range $plain_ln $e+1 end]
}
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
@ -721,12 +802,7 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
if {$do_linenums} {
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
@ -742,109 +818,16 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
}
} else {
set plain [punk::ansi::ansistrip $data]
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
set returnlines $matches
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matches} {
set plain_ln [lindex $plainlines $lineindex]
set parts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
set matchcount [llength $parts]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {[llength $parts] == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr - line marked with ??? (shouldn't happen)"
set matchshow "??? $ln"
#dict set resultlines $lineindex $show
} else {
set overlay ""
set i 0
foreach prange $parts {
lassign $prange s e
set prelen [expr {$s - $i}]
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
if {$s < -1} {set s -1}
foreach p $prelines {
incr s
#append result "[format %${w1}s [expr {$s+1}]]- " " " $p \n
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
foreach p $postlines {
incr s
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
append col1 "*000"
set show "$col1 $ln"
} else {
if {$do_linenums} {
append col1 "*000"
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
set show $ln
}
dict set resultlines $lineindex $show
}
}
set ordered_resultlines [lsort -integer [dict keys $resultlines]]
set result ""
@ -7828,6 +7811,7 @@ namespace eval punk {
lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"]
lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"]
lappend cmdinfo [list s "cmd ?subcommand...?" "Show synopsis for a command or ensemble subcommand"]
lappend cmdinfo [list eg "cmd ?subcommand...?" "Show example from manpage"]
lappend cmdinfo [list ./ "?subdir?" "view/change directory"]
lappend cmdinfo [list ../ "" "go up one directory"]
lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"]
@ -7884,12 +7868,19 @@ namespace eval punk {
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/1095bf7f75]"
append warningblock [a]
}
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
if {[catch {lsearch -stride 2 {a b} b}]} {
set indent " "
append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n
append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n
append warningblock [a]
} else {
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
}
}
if {[punk::lib::check::has_tclbug_list_quoting_emptyjoin]} {
set indent " "

7
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
Unescape View File

@ -171,7 +171,8 @@ tcl::namespace::eval punk::ansi::class {
}
default {
puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x"
punk::args::get_by_id "::punk::ansi::class::class_ansi render_to_input_line" $args
punk::args::parse $args withid "::punk::ansi::class::class_ansi render_to_input_line"
return
}
}
}
@ -2763,7 +2764,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
@values -min 0 -max 0
}]
proc sgr_cache {args} {
set argd [punk::args::get_by_id ::punk::ansi::sgr_cache $args]
set argd [punk::args::parse $args withid ::punk::ansi::sgr_cache]
set action [dict get $argd opts -action]
set pretty [dict get $argd opts -pretty]
@ -3943,7 +3944,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
lappend codestack $code
} else {
#jjtest
apend emit $code
append emit $code
}
}
7GFX {

325
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.2.1.tm
Unescape View File

@ -270,6 +270,190 @@ tcl::namespace::eval punk::args::register {
tcl::namespace::eval ::punk::args {}
tcl::namespace::eval ::punk::args::helpers {
variable PUNKARGS
namespace export *
#proc B {} {return \x1b\[1m} ;#a+ bold
#proc N {} {return \x1b\[22m} ;#a+ normal
#proc I {} {return \x1b\[3m} ;#a+ italic
#proc NI {} {return \x1b\[23m} ;#a+ noitalic
proc I {} {punk::ansi::a+ italic}
proc B {} {punk::ansi::a+ bold}
proc N {} {punk::ansi::a+ normal}
proc NI {} {punk::ansi::a+ italic}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::example
@cmd -name punk::args::helpers::example\
-summary\
{Display formatting for argdoc example text}\
-help\
{Wrap }
@opts
-padright -type integer -default 2 -help\
{Number of padding spaces to add on RHS of text block}
-syntax -type string -default tcl -choices {none tcl} -choicelabels {
tcl\
" Very basic tcl syntax highlighting
of braces,square brackets and comments."
-title -type string -default ""
-titlealign -type string -choices {left centre right}
}
text -type string
}]
proc example {args} {
#only use punk::args::parse on the unhappy path
if {[llength $args] == 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set str [lindex $args end]
set optlist [lrange $args 0 end-1]
if {[llength $optlist] %2 != 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set defaults [dict create\
-padright 2\
-syntax tcl\
-title ""\
-titlealign left\
]
dict for {o v} $optlist {
switch -- $o {
-padright - -syntax - -title - -titlealign {}
default {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
}
}
set opts [dict merge $defaults $optlist]
set opt_padright [dict get $opts -padright]
set opt_syntax [dict get $opts -syntax]
set opt_title [dict get $opts -title]
set opt_titlealign [dict get $opts -titlealign]
if {[string index $str 0] eq "\n"} {
set str [string range $str 1 end]
}
if {[string index $str end] eq "\n"} {
set str [string range $str 0 end-1]
}
#example is intended to run from a source doc that has already been dedented appropriately based on context
# - we don't want to further undent, hence -undent 0
set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
if {$opt_padright > 0} {
set str [textblock::join -- $str [string repeat " " $opt_padright]]
}
if {$opt_title ne ""} {
set title "[a+ term-black Term-silver]$opt_title[a]"
} else {
set title ""
}
set str [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey white] -ansiborder [a+ term-black Term-silver] -titlealign $opt_titlealign -title $title -boxlimits {hl} -type block $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
#rudimentary colourising (not full tcl syntax parsing)
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
switch -- $opt_syntax {
tcl {
#result lines often indicated in examples by \u2192 →
#however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str]
#TODO - fix grepstr highlighting (bg issues - why?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkblue} {\{|\}} $str]
set str [punk::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
}
}
set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"]
return $result
}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::strip_nodisplay_lines
@cmd -name punk::args::helpers::strip_nodisplay_lines\
-summary\
"strip #<nodisplay> lines."\
-help\
"Strip lines beginning with #<nodisplay> from the supplied text.
Whitespace prior to #<nodisplay> is ignored, and ANSI is stripped
prior to examining each line for the #<nodisplay> tag."
@values -min 1 -max 1
text -optional 0 -help\
{punk::args::define scripts must have properly balanced braces etc
as per Tcl rules.
Sometimes it is desired to display help text or examples demonstrating
unbalanced braces etc, but without escaping it in a way that shows the
escaping backslash in the help text. This balancing requirement includes
curly braces in comments. eg
${[punk::args::helpers::example -title " Example 1a " {
proc bad_syntax {args} {
#eg this is an unbalanced left curly brace {
#<nodisplay> balancing right curly brace }
return $args
}
}]}
There is a second comment line in the above proc which begins
with #<nodisplay> and contains the balancing right curly brace.
This shouldn't show in the example above.
The actual text is in a placeholder call to punk::args::helpers::example
to provide basic syntax highlighting and box background, and looks like
the following, but without the left-hand side pipe symbols.
${[punk::args::helpers::example -syntax none -title " Example 1b " {
| proc bad_syntax {args} {
| #eg this is an unbalanced left curly brace {
| #<nodisplay> balancing right curly brace }
| return $args
| }
}]}
Technically a proc body can exist with an unbalanced brace in a comment
like that and would still run without issue. However, such a definition
couldn't be placed in a tcl file to be sourced, nor directly evaluated
with eval.
A #<nodisplay> comment can also be used just for commenting the help
source inline.
Note that an opening square bracket can't be balanced by a line beginning
with the # character.
The non-comment form @#<nodisplay> is available so help lines beginning
with this token will also be stripped. This can be used to 'close' a
section of text that happens to look like a command block. This should
only be used if there is some reason the opening square bracket can't
be rewritten in the help doc to be escaped with a backslash.
The ${[B]}strip_nodisplay_lines${[N]} function is called automatically
by the help text generators in punk::args, and generally shouldn't need
to be used directly, but nevertheless resides in in punk::args::helpers
alongside the ${[B]}example${[N]} function which is intended for writers
of punk::args::define scripts (command documentors) to use.
}
}]
proc strip_nodisplay_lines {text} {
set display ""
foreach ln [split $text \n] {
set stripped [string trimleft [punk::ansi::ansistrip $ln]]
if {![string match "#<nodisplay>*" $stripped] && ![string match "@#<nodisplay>*" $stripped]} {
append display $ln \n
}
}
if {[string index $display end] eq "\n"} {
set display [string range $display 0 end-1]
}
return $display
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -419,6 +603,7 @@ tcl::namespace::eval punk::args {
directive-options: -help <str>
%B%@seealso%N% ?opt val...?
directive-options: -name <str> -url <str> (for footer - unimplemented)
%B%@instance%N% ?opt val...?
Some other options normally present on custom arguments are available
to use with the @leaders @opts @values directives to set defaults
@ -624,8 +809,21 @@ tcl::namespace::eval punk::args {
-maxsize (type dependant)
-range (type dependant - only valid if -type is a single item)
-typeranges (list with same number of elements as -type)
-help <string>
for the @cmd directive - this is the main multiline description.
For an argument is the multi-line help that displays in the Help
column.
For the @examples directive this is the text for examples as
displayed with 'eg <commandname>'
The -help string can be delimited with double quotes or with
curly braces, the choice will affect what inner chars require
backslash escaping - but neither type of help block is
automatically subject to variable or command substitution aside
from those specifically wrapped in placeholders.
For cases where unbalanced braces, double quotes are to
be displayed to the user without visible backslash escapes,
see 'i ::punk::args::helpers::strip_nodisplay_lines'
"
-dynamic -type boolean -default 0 -help\
"If -dynamic is true, tstr interpolations of the form \$\{\$var\}
@ -649,7 +847,7 @@ tcl::namespace::eval punk::args {
from existing definitions (by id) for re-use of argument specifications and help text)
e.g the following definition passes 2 blocks as text arguments
${[punk::args::moduledoc::tclcore::argdoc::example {
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc -help\
@ -955,6 +1153,8 @@ tcl::namespace::eval punk::args {
set LVL 2
if {!$is_dynamic} {
#todo - don't use cached version if 'colour off' vs 'colour on' different to when last resolved!
#(e.g example blocks will still have colour if previously resolved)
if {[tcl::dict::exists $argdata_cache $cache_key]} {
return [tcl::dict::get $argdata_cache $cache_key]
}
@ -1082,6 +1282,19 @@ tcl::namespace::eval punk::args {
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
@ -1174,17 +1387,23 @@ tcl::namespace::eval punk::args {
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {}
set package_info {}
set id_info {} ;#e.g -children <list> ??
set doc_info {}
#set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table
set seealso_info {}
#set credits_info {} ;#e.g see interp man CREDITS section todo - where to display?
set instance_info {}
set keywords_info {}
set examples_info {}
###set leader_min 0
@ -1212,6 +1431,14 @@ tcl::namespace::eval punk::args {
"" - # {continue}
}
incr record_number
if {[catch {lassign $trimrec firstword}]} {
puts stdout "----------------------------------------------"
puts stderr "rec: $rec"
set ::testrecord $rec
puts stdout "----------------------------------------------"
puts "records: $records"
puts stdout "=============================================="
}
set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict
if {[llength $record_values] % 2 != 0} {
#todo - avoid raising an error - store invalid defs keyed on id
@ -1854,6 +2081,10 @@ tcl::namespace::eval punk::args {
#like @doc, except displays in footer, multiple - sub-table?
set seealso_info [dict merge $seealso_info $at_specs]
}
instance {
#todo!
set instance_info [dict merge $instance_info $at_specs]
}
keywords {
#review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ??
set keywords_info [dict merge $keywords_info $at_specs]
@ -2429,6 +2660,7 @@ tcl::namespace::eval punk::args {
doc_info $doc_info\
package_info $package_info\
seealso_info $seealso_info\
instance_info $instance_info\
keywords_info $keywords_info\
examples_info $examples_info\
id_info $id_info\
@ -2461,9 +2693,9 @@ tcl::namespace::eval punk::args {
namespace eval argdoc {
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @instance @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICEGROUPS {
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso}
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso @instance}
argumenttypes {leaders opts values}
remaining_defaults {@leaders @opts @values}
}
@ -2680,7 +2912,7 @@ tcl::namespace::eval punk::args {
dict set resultdict @id [list -id [dict get $specdict id]]
}
}
foreach directive {@package @cmd @doc @examples @seealso} {
foreach directive {@package @cmd @doc @examples @seealso @instance} {
set dshort [string range $directive 1 end]
if {"$directive" in $included_directives} {
if {[dict exists $opt_override $directive]} {
@ -2747,7 +2979,7 @@ tcl::namespace::eval punk::args {
}
}
}
@package - @cmd - @doc - @examples - @seealso {
@package - @cmd - @doc - @examples - @seealso - @instance {
if {"$type" in $included_directives} {
set tp [string range $type 1 end] ;# @package -> package
if {[dict exists $opt_override $type]} {
@ -3671,6 +3903,7 @@ tcl::namespace::eval punk::args {
lappend blank_header_col ""
#set cmdhelp_display [a+ brightwhite]$cmdhelp[a]
#set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)]
set cmdhelp [punk::args::helpers::strip_nodisplay_lines $cmdhelp]
set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp]
} else {
set cmdhelp_display ""
@ -4055,6 +4288,7 @@ tcl::namespace::eval punk::args {
}
set unindentedfields [Dict_getdef $arginfo -unindentedfields {}]
set help [Dict_getdef $arginfo -help ""]
set help [punk::args::helpers::strip_nodisplay_lines $help]
set allchoices_originalcase [list]
set choices [Dict_getdef $arginfo -choices {}]
set choicegroups [Dict_getdef $arginfo -choicegroups {}]
@ -4610,7 +4844,6 @@ tcl::namespace::eval punk::args {
Will usually match the command name"
}]
proc usage {args} {
#lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received
set id [dict get $values id]
set real_id [real_id $id]
@ -4656,7 +4889,7 @@ tcl::namespace::eval punk::args {
lappend PUNKARGS [list {
@id -id ::punk::args::parse
@cmd -name punk::args::parse -help\
"parse and validate command arguments based on a definition.
{parse and validate command arguments based on a definition.
In the 'withid' form the definition is a pre-existing record that has been
created with ::punk::args::define, or indirectly by adding a definition to
@ -4673,23 +4906,25 @@ tcl::namespace::eval punk::args {
Returns a dict of information regarding the parsed arguments
example of basic usage for single option only:
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts \"have option for existing file [dict get $opts -configfile]\"
}
}
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts "have option for existing file [dict get $opts -configfile]"
}
}
}]}
The leaders, opts, values keys in the parse result dict are proper dicts.
The received key is dict-like but can have repeated keys for arguments than can
accept multiples. The value for each received element is the ordinal position.
@ -4698,7 +4933,7 @@ tcl::namespace::eval punk::args {
to another procedure which also requires solos, because the opts dict contains
solo flags with a 1 value or a list of 1's if it was a solo with -multiple true
specified.
"
}
@form -form {withid withdef}
@leaders -min 1 -max 1
arglist -type list -optional 0 -help\
@ -4713,6 +4948,12 @@ tcl::namespace::eval punk::args {
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
-cache -type boolean -default 0 -help\
{Use sparingly.
This uses a cache for same arguments being parsed against
the same definition.
It is a minor speedup suitable for when a small set of similar
(and generally small) arguments are repeatedly used by a function.}
@values -min 2
@ -4738,6 +4979,7 @@ tcl::namespace::eval punk::args {
how to process the definition."
}]
variable parse_cache [dict create]
proc parse {args} {
#puts "punk::args::parse --> '$args'"
set tailtype "" ;#withid|withdef
@ -4802,6 +5044,7 @@ tcl::namespace::eval punk::args {
set defaultopts [dict create\
-form {*}\
-errorstyle standard\
-cache 0\
]
#todo - load override_errorstyle from configuration
@ -4810,7 +5053,7 @@ tcl::namespace::eval punk::args {
set opts [dict merge $defaultopts $opts]
dict for {k v} $opts {
switch -- $k {
-form - -errorstyle {
-form - -errorstyle - -cache {
}
default {
#punk::args::usage $args withid ::punk::args::parse ??
@ -4847,7 +5090,19 @@ tcl::namespace::eval punk::args {
}
try {
#puts stdout "parse --> get_dict <deflist> $parseargs -form [dict get $opts -form]"
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
if {![dict get $opts -cache]} {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
} else {
variable parse_cache
set key [list $parseargs $deflist [dict get $opts -form]]
if {[dict exists $parse_cache $key]} {
set result [dict get $parse_cache $key]
} else {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
dict set parse_cache $key $result
}
return $result
}
} trap {PUNKARGS VALIDATION} {msg erroropts} {
set opt_errorstyle [dict get $opts -errorstyle]
@ -7201,7 +7456,7 @@ tcl::namespace::eval punk::args {
# -----------------------------------------------
# Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc)
tcl::dict::with argspecs {} ;#turn keys into vars
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info,id_info,form_names
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names
# -----------------------------------------------
set opt_form [dict get $proc_opts -form]
if {$opt_form eq "*"} {
@ -9152,7 +9407,8 @@ tcl::namespace::eval punk::args {
return
}
if {[dict exists $spec examples_info -help]} {
return [dict get $spec examples_info -help]
set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata]
} else {
return "no @examples defined for $id"
}
@ -9177,7 +9433,8 @@ tcl::namespace::eval punk::args {
cmditem -multiple 1 -optional 0
}]
proc synopsis {args} {
set argd [punk::args::parse $args withid ::punk::args::synopsis]
#synopsis potentially called repeatedly with same args? use -cache 1
set argd [punk::args::parse $args -cache 1 withid ::punk::args::synopsis]
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
@ -10807,7 +11064,7 @@ tcl::namespace::eval punk::args::package {
# set PUNKARGS ""
#}
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package ::punk::args::helpers
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools

2682
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
View File

File diff suppressed because it is too large Load Diff

14
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
Unescape View File

@ -669,21 +669,21 @@ namespace eval punk::console {
prudent."
@values -min 2 -max 2
query -type string -help\
"ANSI sequence such as \x1b\[?6n which
{ANSI sequence such as \x1b\[?6n which
should elicit a response by the terminal
on stdin"
on stdin}
capturingendregex -type string -help\
"capturingendregex should capture ANY prefix, whole escape match - and a subcapture
{capturingendregex should capture ANY prefix, whole escape match - and a subcapture
of the data we're interested in; and match at end of string.
ie {(.*)(ESC(info)end)$}
e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$}
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)"
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)}
}]
#todo - check capturingendregex value supplied has appropriate captures and tail-anchor
proc get_ansi_response_payload {args} {
#we pay a few 10s of microseconds to use punk::args::parse (on the happy path)
#seems reasonable for the flexibility in this case.
set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::internal::get_ansi_response_payload]
lassign [dict values $argd] leaders opts values received
set inoutchannels [dict get $opts -terminal]
@ -1507,7 +1507,7 @@ namespace eval punk::console {
or omit to query cell size."
}
proc cell_size {args} {
set argd [punk::args::get_by_id ::punk::console::cell_size $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::cell_size]
set inoutchannels [dict get $argd opts -inoutchannels]
set newsize [dict get $argd values newsize]
@ -1551,7 +1551,7 @@ namespace eval punk::console {
#only works in raw mode for windows terminal - (esc in output stripped?) why?
# works in line mode for alacrity and wezterm
proc test_is_vt52 {args} {
set argd [punk::args::get_by_id ::punk::console::test_is_vt52 $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::test_is_vt52]
set inoutchannels [dict get $argd opts -inoutchannels]
#ESC / K VT52 without printer
#ESC / M VT52 with printer

8
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
Unescape View File

@ -44,14 +44,18 @@ namespace eval punk::mix::commandset::layout {
#per layout functions
punk::args::define {
@dynamic
@id -id ::punk::mix::commandset::layout::files
@id -id ::punk::mix::commandset::layout::files
@cmd -name punk::mix::commandset::layout::files -synopsis\
"list files in project layout"\
-help\
""
-datetime -default "%Y-%m-%dT%H:%M:%S" -help\
"Datetime format for mtime. Use empty string for no datetime output"
@values -min 1 -max 1
layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}}
}
proc files {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::layout::files]
set layout [dict get $argd values layout]
set dtformat [dict get $argd opts -datetime]

2
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm
Unescape View File

@ -44,7 +44,7 @@ namespace eval punk::mix::commandset::loadedlib {
If search is not prefixed with '=' the search is case insensitive."
}
proc search {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::loadedlib::search $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::loadedlib::search]
set searchstrings [dict get $argd values searchstring]
set opts [dict get $argd opts]
set opt_return [dict get $opts -return]

8
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm
Unescape View File

@ -132,7 +132,6 @@ namespace eval punk::mix::commandset::module {
globsearches -default * -multiple 1
}
proc templates_dict {args} {
#set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::templates_dict]
package require punk::cap
if {[punk::cap::capability_has_handler punk.templates]} {
@ -146,7 +145,10 @@ namespace eval punk::mix::commandset::module {
set moduletypes [punk::mix::cli::lib::module_types]
punk::args::define [subst {
@id -id ::punk::mix::commandset::module::new
@cmd -name "punk::mix::commandset::module::new" -help\
@cmd -name "punk::mix::commandset::module::new"\
-synopsis\
"create .tm module file from template"\
-help\
"Create a new module file in the appropriate folder within src/modules.
If the name given in the module argument is namespaced,
the necessary subfolder(s) will be used or created."
@ -173,7 +175,7 @@ namespace eval punk::mix::commandset::module {
proc new {args} {
set year [clock format [clock seconds] -format %Y]
# use \uFFFD because unicode replacement char should consistently render as 1 wide
set argd [punk::args::get_by_id ::punk::mix::commandset::module::new $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::new]
lassign [dict values $argd] leaders opts values received
set module [dict get $values module]

4
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -644,7 +644,7 @@ tcl::namespace::eval punk::nav::fs {
@values -min 0 -max -1 -unnamed true
}
proc dirfiles {args} {
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles]
lassign [dict values $argd] leaders opts values_dict
set opt_stripbase [dict get $opts -stripbase]
@ -1005,7 +1005,7 @@ tcl::namespace::eval punk::nav::fs {
#todo - color key via repl-telemetry? help command? documentation? or add tag columns as done in namespace listing?
proc dirfiles_dict_as_lines {args} {
package require overtype
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles_dict_as_lines $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict_as_lines]
lassign [dict values $argd] leaders opts vals
set list_of_dicts [dict values $vals]

23
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
Unescape View File

@ -2447,7 +2447,8 @@ tcl::namespace::eval punk::ns {
"Name of ensemble command for which subcommand info is gathered."
}
proc ensemble_subcommands {args} {
set argd [punk::args::get_by_id ::punk::ns::ensemble_subcommands $args]
#puts stderr "---> punk::ns::ensemble_subcommands $args"
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::ensemble_subcommands]
set opts [dict get $argd opts]
set origin [dict get $argd values origin]
@ -3087,6 +3088,7 @@ tcl::namespace::eval punk::ns {
}]
append argdef \n $vline
append argdef \n "@values -unnamed true"
append argdef \n "@instance -help {instance info derived from id (instance)::$origin ?}"
punk::args::define $argdef
}
@ -3331,7 +3333,7 @@ tcl::namespace::eval punk::ns {
}
variable cmdinfo_reducerid 0
proc cmdinfo {args} {
set argd [punk::args::parse $args withid ::punk::ns::cmdinfo]
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdinfo]
lassign [dict values $argd] leaders opts values received
set cmdlist [dict get $values cmditem]
@ -5256,7 +5258,8 @@ tcl::namespace::eval punk::ns {
basic {
#rudimentary colourising only
set argl [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $argl]
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {;\s*(#.*)} $body] ;#treat as tail comment only if preceeded by semicolon
set body [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $body]
set body [punk::grepstr -return all -highlight tk-orange {\[|\]} $body]
#ansi colourised items in list format may not always have desired string representation (list escaping can occur)
@ -5669,7 +5672,7 @@ tcl::namespace::eval punk::ns {
e.g ::mynamespace::a* ::mynamespace::j*"
}
proc nsimport_noclobber {args} {
lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::ns::nsimport_noclobber]] leaders opts values received
set sourcepatterns [dict get $values sourcepattern]
set nscaller [uplevel 1 {namespace current}]
@ -5827,12 +5830,12 @@ tcl::namespace::eval punk::ns {
"Command names for which to show help info"
}
interp alias {} i+ {}\
.=args> punk::args::get_by_id ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=args>1 punk::args::parse withid ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=tables>* textblock::join -- <args|
}

21
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm
Unescape View File

@ -149,13 +149,14 @@ tcl::namespace::eval textblock {
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
#proc example {str} {
# set str [string trimleft $str \n]
# set block [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
# set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
# #puts $result
# return $result
#}
namespace import ::punk::args::helpers::*
}
@ -4196,7 +4197,7 @@ tcl::namespace::eval textblock {
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
set opts [dict get [punk::args::parse $args withid ::textblock::periodic] opts]
set opts [dict get [punk::args::parse $args -cache 1 withid ::textblock::periodic] opts]
set opt_return [tcl::dict::get $opts -return]
if {[tcl::dict::get $opts -forcecolour]} {
set fc forcecolour
@ -5601,7 +5602,7 @@ tcl::namespace::eval textblock {
set rows [concat $r0 $r1 $r2 $r3]
set column_ansi [a+ web-white Web-Gray]
set column_ansi [a+ term-white Term-grey]
set t [textblock::list_as_table -columns [expr {1 + (2 * [tcl::dict::size $blockinfo])}] -return tableobject $rows]
$t configure_column 0 -headers [list [tcl::dict::get $opts -description] "within_ansi"] -ansibase $column_ansi
@ -5723,7 +5724,7 @@ tcl::namespace::eval textblock {
#join without regard to each line length in a block (no padding added to make each block uniform)
proc ::textblock::join_basic {args} {
set argd [punk::args::parse $args withid ::textblock::join_basic]
set argd [punk::args::parse $args -cache 1 withid ::textblock::join_basic]
set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks]

253
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm
Unescape View File

@ -564,14 +564,15 @@ namespace eval punk {
"Grep for regex pattern in plaintext of supplied (possibly ANSI) string."\
-help\
"The grepstr command can find strings in ANSI text even if there are interspersed
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
regex can match the plaintext. (Search is performed on ansistripped text, and then
the matched sections are highlighted and overlayed on the original styled/colourd
input.
If the input string has ANSI movement codes - the resultant text may not be directly
searchable because the parts of a word may be separated by various codes and other
plain text. To search such an input string, the string should first be 'rendered' to
a form where the ANSI only represents SGR styling (and perhaps other non-movement
a form where the ANSI only represents SGR styling (and perhaps other non-movement
codes) using something like overtype::renderline or overtype::rendertext."
@leaders -min 0 -max 0
@ -589,7 +590,7 @@ namespace eval punk {
except that when instead using -returnlines all with --line-number, the *
indicator after the linenumber will only be highlighted for lines with matches,
and the following matchcount will indicate zero for non-matching lines."
}
}
-B|--before-context= -parsekey "--before-context" -default 0 -type integer -typesynopsis num
-C|--context= -parsekey "--context" -default 0 -type integer -typesynopsis num -help\
"Print num lines of leading and trailing context surrounding each match."
@ -628,7 +629,10 @@ namespace eval punk {
-- -type none
@values
pattern -type string -help\
"regex pattern to match in plaintext portion of ANSI string"
"regex pattern to match in plaintext portion of ANSI string
The pattern may contain bracketed capturing groups, which
will be highlighted (todo) in the result. If there is no capturing
group, the entire match will be highlighted."
string -type string
}
proc grepstr {args} {
@ -670,40 +674,117 @@ namespace eval punk {
}
set data [string map {\r\n \n} $data]
if {![punk::ansi::ta::detect $data]} {
if {[punk::ansi::ta::detect $data]} {
set raw_has_ansi 1
set plain [punk::ansi::ansistrip $data]
} else {
set raw_has_ansi 0
set plain $data
}
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $lines $pattern]
set result ""
set matched_line_indices [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
#matches|breaksandmatches
set returnlines $matches
set returnlines $matched_line_indices
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
#lineindex is zero based - display of linenums is 1 based
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matched_line_indices} {
set plain_ln [lindex $plainlines $lineindex]
#first test the regexp with a single match to determine number of capturing groups
set matchparts [regexp {*}$nocase -inline -- $pattern $plain_ln] ;#get fullmatch capturegroup...
set numgroups [expr {[llength $matchparts] -1}]
set allparts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
#allparts includes each full match as well as each capturing group
#early versions of tcl 8.6 still didn't support 'lsearch -stride' - avoid for now.
set matchcount [expr {[llength $allparts] / ($numgroups + 1)}]
#set matchcount [llength $allparts]
if {$matchcount == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr (shouldn't happen) regex: $pattern lineindex: $lineindex"
set matchshow "??? $ln"
dict set resultlines $lineindex $matchshow
continue
}
if {$lineindex in $matches} {
set ln [regsub -all {*}$nocase -- $pattern $ln $H&$R] ;#n
set matchcount [regexp -all {*}$nocase -- $pattern $ln]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
# ------------------------------------
if {$numgroups > 0} {
# restrict ourself to just the capture groups, excluding the full match (if there are capture groups)
set highlight_ranges [list]
set i 0
foreach range $allparts {
if {($i % ($numgroups+1)) != 0} {
lappend highlight_ranges $range
}
incr i
}
} else {
if {$do_linenums} {
append col1 "*000"
#No capture group in the regex, each index range is just a full match
set highlight_ranges $allparts
}
# ------------------------------------
#puts stderr "numgroups : $numgroups"
#puts stderr "grepstr pattern : $pattern"
#puts stderr "grepstr allparts: $allparts"
#puts stderr "highlight_ranges: $highlight_ranges"
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {$raw_has_ansi} {
set overlay ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
#set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
set rendered [overtype::renderspace -transparent $placeholder -insert_mode 0 $ln $overlay]
} else {
set rendered ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
append rendered [string range $plain_ln $i $s-1] $H [string range $plain_ln $s $e] $R
set i [expr {$e + 1}]
}
append rendered [string range $plain_ln $e+1 end]
}
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
@ -721,12 +802,7 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
if {$do_linenums} {
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
@ -742,109 +818,16 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
}
} else {
set plain [punk::ansi::ansistrip $data]
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
set returnlines $matches
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matches} {
set plain_ln [lindex $plainlines $lineindex]
set parts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
set matchcount [llength $parts]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {[llength $parts] == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr - line marked with ??? (shouldn't happen)"
set matchshow "??? $ln"
#dict set resultlines $lineindex $show
} else {
set overlay ""
set i 0
foreach prange $parts {
lassign $prange s e
set prelen [expr {$s - $i}]
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
if {$s < -1} {set s -1}
foreach p $prelines {
incr s
#append result "[format %${w1}s [expr {$s+1}]]- " " " $p \n
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
foreach p $postlines {
incr s
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
append col1 "*000"
set show "$col1 $ln"
} else {
if {$do_linenums} {
append col1 "*000"
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
set show $ln
}
dict set resultlines $lineindex $show
}
}
set ordered_resultlines [lsort -integer [dict keys $resultlines]]
set result ""
@ -7828,6 +7811,7 @@ namespace eval punk {
lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"]
lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"]
lappend cmdinfo [list s "cmd ?subcommand...?" "Show synopsis for a command or ensemble subcommand"]
lappend cmdinfo [list eg "cmd ?subcommand...?" "Show example from manpage"]
lappend cmdinfo [list ./ "?subdir?" "view/change directory"]
lappend cmdinfo [list ../ "" "go up one directory"]
lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"]
@ -7884,12 +7868,19 @@ namespace eval punk {
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/1095bf7f75]"
append warningblock [a]
}
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
if {[catch {lsearch -stride 2 {a b} b}]} {
set indent " "
append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n
append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n
append warningblock [a]
} else {
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
}
}
if {[punk::lib::check::has_tclbug_list_quoting_emptyjoin]} {
set indent " "

7
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
Unescape View File

@ -171,7 +171,8 @@ tcl::namespace::eval punk::ansi::class {
}
default {
puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x"
punk::args::get_by_id "::punk::ansi::class::class_ansi render_to_input_line" $args
punk::args::parse $args withid "::punk::ansi::class::class_ansi render_to_input_line"
return
}
}
}
@ -2763,7 +2764,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
@values -min 0 -max 0
}]
proc sgr_cache {args} {
set argd [punk::args::get_by_id ::punk::ansi::sgr_cache $args]
set argd [punk::args::parse $args withid ::punk::ansi::sgr_cache]
set action [dict get $argd opts -action]
set pretty [dict get $argd opts -pretty]
@ -3943,7 +3944,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
lappend codestack $code
} else {
#jjtest
apend emit $code
append emit $code
}
}
7GFX {

325
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.2.1.tm
Unescape View File

@ -270,6 +270,190 @@ tcl::namespace::eval punk::args::register {
tcl::namespace::eval ::punk::args {}
tcl::namespace::eval ::punk::args::helpers {
variable PUNKARGS
namespace export *
#proc B {} {return \x1b\[1m} ;#a+ bold
#proc N {} {return \x1b\[22m} ;#a+ normal
#proc I {} {return \x1b\[3m} ;#a+ italic
#proc NI {} {return \x1b\[23m} ;#a+ noitalic
proc I {} {punk::ansi::a+ italic}
proc B {} {punk::ansi::a+ bold}
proc N {} {punk::ansi::a+ normal}
proc NI {} {punk::ansi::a+ italic}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::example
@cmd -name punk::args::helpers::example\
-summary\
{Display formatting for argdoc example text}\
-help\
{Wrap }
@opts
-padright -type integer -default 2 -help\
{Number of padding spaces to add on RHS of text block}
-syntax -type string -default tcl -choices {none tcl} -choicelabels {
tcl\
" Very basic tcl syntax highlighting
of braces,square brackets and comments."
-title -type string -default ""
-titlealign -type string -choices {left centre right}
}
text -type string
}]
proc example {args} {
#only use punk::args::parse on the unhappy path
if {[llength $args] == 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set str [lindex $args end]
set optlist [lrange $args 0 end-1]
if {[llength $optlist] %2 != 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set defaults [dict create\
-padright 2\
-syntax tcl\
-title ""\
-titlealign left\
]
dict for {o v} $optlist {
switch -- $o {
-padright - -syntax - -title - -titlealign {}
default {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
}
}
set opts [dict merge $defaults $optlist]
set opt_padright [dict get $opts -padright]
set opt_syntax [dict get $opts -syntax]
set opt_title [dict get $opts -title]
set opt_titlealign [dict get $opts -titlealign]
if {[string index $str 0] eq "\n"} {
set str [string range $str 1 end]
}
if {[string index $str end] eq "\n"} {
set str [string range $str 0 end-1]
}
#example is intended to run from a source doc that has already been dedented appropriately based on context
# - we don't want to further undent, hence -undent 0
set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
if {$opt_padright > 0} {
set str [textblock::join -- $str [string repeat " " $opt_padright]]
}
if {$opt_title ne ""} {
set title "[a+ term-black Term-silver]$opt_title[a]"
} else {
set title ""
}
set str [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey white] -ansiborder [a+ term-black Term-silver] -titlealign $opt_titlealign -title $title -boxlimits {hl} -type block $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
#rudimentary colourising (not full tcl syntax parsing)
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
switch -- $opt_syntax {
tcl {
#result lines often indicated in examples by \u2192 →
#however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str]
#TODO - fix grepstr highlighting (bg issues - why?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkblue} {\{|\}} $str]
set str [punk::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
}
}
set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"]
return $result
}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::strip_nodisplay_lines
@cmd -name punk::args::helpers::strip_nodisplay_lines\
-summary\
"strip #<nodisplay> lines."\
-help\
"Strip lines beginning with #<nodisplay> from the supplied text.
Whitespace prior to #<nodisplay> is ignored, and ANSI is stripped
prior to examining each line for the #<nodisplay> tag."
@values -min 1 -max 1
text -optional 0 -help\
{punk::args::define scripts must have properly balanced braces etc
as per Tcl rules.
Sometimes it is desired to display help text or examples demonstrating
unbalanced braces etc, but without escaping it in a way that shows the
escaping backslash in the help text. This balancing requirement includes
curly braces in comments. eg
${[punk::args::helpers::example -title " Example 1a " {
proc bad_syntax {args} {
#eg this is an unbalanced left curly brace {
#<nodisplay> balancing right curly brace }
return $args
}
}]}
There is a second comment line in the above proc which begins
with #<nodisplay> and contains the balancing right curly brace.
This shouldn't show in the example above.
The actual text is in a placeholder call to punk::args::helpers::example
to provide basic syntax highlighting and box background, and looks like
the following, but without the left-hand side pipe symbols.
${[punk::args::helpers::example -syntax none -title " Example 1b " {
| proc bad_syntax {args} {
| #eg this is an unbalanced left curly brace {
| #<nodisplay> balancing right curly brace }
| return $args
| }
}]}
Technically a proc body can exist with an unbalanced brace in a comment
like that and would still run without issue. However, such a definition
couldn't be placed in a tcl file to be sourced, nor directly evaluated
with eval.
A #<nodisplay> comment can also be used just for commenting the help
source inline.
Note that an opening square bracket can't be balanced by a line beginning
with the # character.
The non-comment form @#<nodisplay> is available so help lines beginning
with this token will also be stripped. This can be used to 'close' a
section of text that happens to look like a command block. This should
only be used if there is some reason the opening square bracket can't
be rewritten in the help doc to be escaped with a backslash.
The ${[B]}strip_nodisplay_lines${[N]} function is called automatically
by the help text generators in punk::args, and generally shouldn't need
to be used directly, but nevertheless resides in in punk::args::helpers
alongside the ${[B]}example${[N]} function which is intended for writers
of punk::args::define scripts (command documentors) to use.
}
}]
proc strip_nodisplay_lines {text} {
set display ""
foreach ln [split $text \n] {
set stripped [string trimleft [punk::ansi::ansistrip $ln]]
if {![string match "#<nodisplay>*" $stripped] && ![string match "@#<nodisplay>*" $stripped]} {
append display $ln \n
}
}
if {[string index $display end] eq "\n"} {
set display [string range $display 0 end-1]
}
return $display
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -419,6 +603,7 @@ tcl::namespace::eval punk::args {
directive-options: -help <str>
%B%@seealso%N% ?opt val...?
directive-options: -name <str> -url <str> (for footer - unimplemented)
%B%@instance%N% ?opt val...?
Some other options normally present on custom arguments are available
to use with the @leaders @opts @values directives to set defaults
@ -624,8 +809,21 @@ tcl::namespace::eval punk::args {
-maxsize (type dependant)
-range (type dependant - only valid if -type is a single item)
-typeranges (list with same number of elements as -type)
-help <string>
for the @cmd directive - this is the main multiline description.
For an argument is the multi-line help that displays in the Help
column.
For the @examples directive this is the text for examples as
displayed with 'eg <commandname>'
The -help string can be delimited with double quotes or with
curly braces, the choice will affect what inner chars require
backslash escaping - but neither type of help block is
automatically subject to variable or command substitution aside
from those specifically wrapped in placeholders.
For cases where unbalanced braces, double quotes are to
be displayed to the user without visible backslash escapes,
see 'i ::punk::args::helpers::strip_nodisplay_lines'
"
-dynamic -type boolean -default 0 -help\
"If -dynamic is true, tstr interpolations of the form \$\{\$var\}
@ -649,7 +847,7 @@ tcl::namespace::eval punk::args {
from existing definitions (by id) for re-use of argument specifications and help text)
e.g the following definition passes 2 blocks as text arguments
${[punk::args::moduledoc::tclcore::argdoc::example {
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc -help\
@ -955,6 +1153,8 @@ tcl::namespace::eval punk::args {
set LVL 2
if {!$is_dynamic} {
#todo - don't use cached version if 'colour off' vs 'colour on' different to when last resolved!
#(e.g example blocks will still have colour if previously resolved)
if {[tcl::dict::exists $argdata_cache $cache_key]} {
return [tcl::dict::get $argdata_cache $cache_key]
}
@ -1082,6 +1282,19 @@ tcl::namespace::eval punk::args {
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
@ -1174,17 +1387,23 @@ tcl::namespace::eval punk::args {
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {}
set package_info {}
set id_info {} ;#e.g -children <list> ??
set doc_info {}
#set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table
set seealso_info {}
#set credits_info {} ;#e.g see interp man CREDITS section todo - where to display?
set instance_info {}
set keywords_info {}
set examples_info {}
###set leader_min 0
@ -1212,6 +1431,14 @@ tcl::namespace::eval punk::args {
"" - # {continue}
}
incr record_number
if {[catch {lassign $trimrec firstword}]} {
puts stdout "----------------------------------------------"
puts stderr "rec: $rec"
set ::testrecord $rec
puts stdout "----------------------------------------------"
puts "records: $records"
puts stdout "=============================================="
}
set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict
if {[llength $record_values] % 2 != 0} {
#todo - avoid raising an error - store invalid defs keyed on id
@ -1854,6 +2081,10 @@ tcl::namespace::eval punk::args {
#like @doc, except displays in footer, multiple - sub-table?
set seealso_info [dict merge $seealso_info $at_specs]
}
instance {
#todo!
set instance_info [dict merge $instance_info $at_specs]
}
keywords {
#review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ??
set keywords_info [dict merge $keywords_info $at_specs]
@ -2429,6 +2660,7 @@ tcl::namespace::eval punk::args {
doc_info $doc_info\
package_info $package_info\
seealso_info $seealso_info\
instance_info $instance_info\
keywords_info $keywords_info\
examples_info $examples_info\
id_info $id_info\
@ -2461,9 +2693,9 @@ tcl::namespace::eval punk::args {
namespace eval argdoc {
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @instance @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICEGROUPS {
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso}
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso @instance}
argumenttypes {leaders opts values}
remaining_defaults {@leaders @opts @values}
}
@ -2680,7 +2912,7 @@ tcl::namespace::eval punk::args {
dict set resultdict @id [list -id [dict get $specdict id]]
}
}
foreach directive {@package @cmd @doc @examples @seealso} {
foreach directive {@package @cmd @doc @examples @seealso @instance} {
set dshort [string range $directive 1 end]
if {"$directive" in $included_directives} {
if {[dict exists $opt_override $directive]} {
@ -2747,7 +2979,7 @@ tcl::namespace::eval punk::args {
}
}
}
@package - @cmd - @doc - @examples - @seealso {
@package - @cmd - @doc - @examples - @seealso - @instance {
if {"$type" in $included_directives} {
set tp [string range $type 1 end] ;# @package -> package
if {[dict exists $opt_override $type]} {
@ -3671,6 +3903,7 @@ tcl::namespace::eval punk::args {
lappend blank_header_col ""
#set cmdhelp_display [a+ brightwhite]$cmdhelp[a]
#set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)]
set cmdhelp [punk::args::helpers::strip_nodisplay_lines $cmdhelp]
set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp]
} else {
set cmdhelp_display ""
@ -4055,6 +4288,7 @@ tcl::namespace::eval punk::args {
}
set unindentedfields [Dict_getdef $arginfo -unindentedfields {}]
set help [Dict_getdef $arginfo -help ""]
set help [punk::args::helpers::strip_nodisplay_lines $help]
set allchoices_originalcase [list]
set choices [Dict_getdef $arginfo -choices {}]
set choicegroups [Dict_getdef $arginfo -choicegroups {}]
@ -4610,7 +4844,6 @@ tcl::namespace::eval punk::args {
Will usually match the command name"
}]
proc usage {args} {
#lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received
set id [dict get $values id]
set real_id [real_id $id]
@ -4656,7 +4889,7 @@ tcl::namespace::eval punk::args {
lappend PUNKARGS [list {
@id -id ::punk::args::parse
@cmd -name punk::args::parse -help\
"parse and validate command arguments based on a definition.
{parse and validate command arguments based on a definition.
In the 'withid' form the definition is a pre-existing record that has been
created with ::punk::args::define, or indirectly by adding a definition to
@ -4673,23 +4906,25 @@ tcl::namespace::eval punk::args {
Returns a dict of information regarding the parsed arguments
example of basic usage for single option only:
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts \"have option for existing file [dict get $opts -configfile]\"
}
}
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts "have option for existing file [dict get $opts -configfile]"
}
}
}]}
The leaders, opts, values keys in the parse result dict are proper dicts.
The received key is dict-like but can have repeated keys for arguments than can
accept multiples. The value for each received element is the ordinal position.
@ -4698,7 +4933,7 @@ tcl::namespace::eval punk::args {
to another procedure which also requires solos, because the opts dict contains
solo flags with a 1 value or a list of 1's if it was a solo with -multiple true
specified.
"
}
@form -form {withid withdef}
@leaders -min 1 -max 1
arglist -type list -optional 0 -help\
@ -4713,6 +4948,12 @@ tcl::namespace::eval punk::args {
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
-cache -type boolean -default 0 -help\
{Use sparingly.
This uses a cache for same arguments being parsed against
the same definition.
It is a minor speedup suitable for when a small set of similar
(and generally small) arguments are repeatedly used by a function.}
@values -min 2
@ -4738,6 +4979,7 @@ tcl::namespace::eval punk::args {
how to process the definition."
}]
variable parse_cache [dict create]
proc parse {args} {
#puts "punk::args::parse --> '$args'"
set tailtype "" ;#withid|withdef
@ -4802,6 +5044,7 @@ tcl::namespace::eval punk::args {
set defaultopts [dict create\
-form {*}\
-errorstyle standard\
-cache 0\
]
#todo - load override_errorstyle from configuration
@ -4810,7 +5053,7 @@ tcl::namespace::eval punk::args {
set opts [dict merge $defaultopts $opts]
dict for {k v} $opts {
switch -- $k {
-form - -errorstyle {
-form - -errorstyle - -cache {
}
default {
#punk::args::usage $args withid ::punk::args::parse ??
@ -4847,7 +5090,19 @@ tcl::namespace::eval punk::args {
}
try {
#puts stdout "parse --> get_dict <deflist> $parseargs -form [dict get $opts -form]"
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
if {![dict get $opts -cache]} {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
} else {
variable parse_cache
set key [list $parseargs $deflist [dict get $opts -form]]
if {[dict exists $parse_cache $key]} {
set result [dict get $parse_cache $key]
} else {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
dict set parse_cache $key $result
}
return $result
}
} trap {PUNKARGS VALIDATION} {msg erroropts} {
set opt_errorstyle [dict get $opts -errorstyle]
@ -7201,7 +7456,7 @@ tcl::namespace::eval punk::args {
# -----------------------------------------------
# Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc)
tcl::dict::with argspecs {} ;#turn keys into vars
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info,id_info,form_names
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names
# -----------------------------------------------
set opt_form [dict get $proc_opts -form]
if {$opt_form eq "*"} {
@ -9152,7 +9407,8 @@ tcl::namespace::eval punk::args {
return
}
if {[dict exists $spec examples_info -help]} {
return [dict get $spec examples_info -help]
set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata]
} else {
return "no @examples defined for $id"
}
@ -9177,7 +9433,8 @@ tcl::namespace::eval punk::args {
cmditem -multiple 1 -optional 0
}]
proc synopsis {args} {
set argd [punk::args::parse $args withid ::punk::args::synopsis]
#synopsis potentially called repeatedly with same args? use -cache 1
set argd [punk::args::parse $args -cache 1 withid ::punk::args::synopsis]
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
@ -10807,7 +11064,7 @@ tcl::namespace::eval punk::args::package {
# set PUNKARGS ""
#}
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package ::punk::args::helpers
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools

2682
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args/moduledoc/tclcore-0.1.0.tm
View File

File diff suppressed because it is too large Load Diff

14
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm
Unescape View File

@ -669,21 +669,21 @@ namespace eval punk::console {
prudent."
@values -min 2 -max 2
query -type string -help\
"ANSI sequence such as \x1b\[?6n which
{ANSI sequence such as \x1b\[?6n which
should elicit a response by the terminal
on stdin"
on stdin}
capturingendregex -type string -help\
"capturingendregex should capture ANY prefix, whole escape match - and a subcapture
{capturingendregex should capture ANY prefix, whole escape match - and a subcapture
of the data we're interested in; and match at end of string.
ie {(.*)(ESC(info)end)$}
e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$}
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)"
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)}
}]
#todo - check capturingendregex value supplied has appropriate captures and tail-anchor
proc get_ansi_response_payload {args} {
#we pay a few 10s of microseconds to use punk::args::parse (on the happy path)
#seems reasonable for the flexibility in this case.
set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::internal::get_ansi_response_payload]
lassign [dict values $argd] leaders opts values received
set inoutchannels [dict get $opts -terminal]
@ -1507,7 +1507,7 @@ namespace eval punk::console {
or omit to query cell size."
}
proc cell_size {args} {
set argd [punk::args::get_by_id ::punk::console::cell_size $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::cell_size]
set inoutchannels [dict get $argd opts -inoutchannels]
set newsize [dict get $argd values newsize]
@ -1551,7 +1551,7 @@ namespace eval punk::console {
#only works in raw mode for windows terminal - (esc in output stripped?) why?
# works in line mode for alacrity and wezterm
proc test_is_vt52 {args} {
set argd [punk::args::get_by_id ::punk::console::test_is_vt52 $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::test_is_vt52]
set inoutchannels [dict get $argd opts -inoutchannels]
#ESC / K VT52 without printer
#ESC / M VT52 with printer

8
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
Unescape View File

@ -44,14 +44,18 @@ namespace eval punk::mix::commandset::layout {
#per layout functions
punk::args::define {
@dynamic
@id -id ::punk::mix::commandset::layout::files
@id -id ::punk::mix::commandset::layout::files
@cmd -name punk::mix::commandset::layout::files -synopsis\
"list files in project layout"\
-help\
""
-datetime -default "%Y-%m-%dT%H:%M:%S" -help\
"Datetime format for mtime. Use empty string for no datetime output"
@values -min 1 -max 1
layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}}
}
proc files {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::layout::files]
set layout [dict get $argd values layout]
set dtformat [dict get $argd opts -datetime]

2
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm
Unescape View File

@ -44,7 +44,7 @@ namespace eval punk::mix::commandset::loadedlib {
If search is not prefixed with '=' the search is case insensitive."
}
proc search {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::loadedlib::search $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::loadedlib::search]
set searchstrings [dict get $argd values searchstring]
set opts [dict get $argd opts]
set opt_return [dict get $opts -return]

8
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm
Unescape View File

@ -132,7 +132,6 @@ namespace eval punk::mix::commandset::module {
globsearches -default * -multiple 1
}
proc templates_dict {args} {
#set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::templates_dict]
package require punk::cap
if {[punk::cap::capability_has_handler punk.templates]} {
@ -146,7 +145,10 @@ namespace eval punk::mix::commandset::module {
set moduletypes [punk::mix::cli::lib::module_types]
punk::args::define [subst {
@id -id ::punk::mix::commandset::module::new
@cmd -name "punk::mix::commandset::module::new" -help\
@cmd -name "punk::mix::commandset::module::new"\
-synopsis\
"create .tm module file from template"\
-help\
"Create a new module file in the appropriate folder within src/modules.
If the name given in the module argument is namespaced,
the necessary subfolder(s) will be used or created."
@ -173,7 +175,7 @@ namespace eval punk::mix::commandset::module {
proc new {args} {
set year [clock format [clock seconds] -format %Y]
# use \uFFFD because unicode replacement char should consistently render as 1 wide
set argd [punk::args::get_by_id ::punk::mix::commandset::module::new $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::new]
lassign [dict values $argd] leaders opts values received
set module [dict get $values module]

4
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -644,7 +644,7 @@ tcl::namespace::eval punk::nav::fs {
@values -min 0 -max -1 -unnamed true
}
proc dirfiles {args} {
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles]
lassign [dict values $argd] leaders opts values_dict
set opt_stripbase [dict get $opts -stripbase]
@ -1005,7 +1005,7 @@ tcl::namespace::eval punk::nav::fs {
#todo - color key via repl-telemetry? help command? documentation? or add tag columns as done in namespace listing?
proc dirfiles_dict_as_lines {args} {
package require overtype
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles_dict_as_lines $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict_as_lines]
lassign [dict values $argd] leaders opts vals
set list_of_dicts [dict values $vals]

23
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
Unescape View File

@ -2447,7 +2447,8 @@ tcl::namespace::eval punk::ns {
"Name of ensemble command for which subcommand info is gathered."
}
proc ensemble_subcommands {args} {
set argd [punk::args::get_by_id ::punk::ns::ensemble_subcommands $args]
#puts stderr "---> punk::ns::ensemble_subcommands $args"
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::ensemble_subcommands]
set opts [dict get $argd opts]
set origin [dict get $argd values origin]
@ -3087,6 +3088,7 @@ tcl::namespace::eval punk::ns {
}]
append argdef \n $vline
append argdef \n "@values -unnamed true"
append argdef \n "@instance -help {instance info derived from id (instance)::$origin ?}"
punk::args::define $argdef
}
@ -3331,7 +3333,7 @@ tcl::namespace::eval punk::ns {
}
variable cmdinfo_reducerid 0
proc cmdinfo {args} {
set argd [punk::args::parse $args withid ::punk::ns::cmdinfo]
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdinfo]
lassign [dict values $argd] leaders opts values received
set cmdlist [dict get $values cmditem]
@ -5256,7 +5258,8 @@ tcl::namespace::eval punk::ns {
basic {
#rudimentary colourising only
set argl [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $argl]
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {;\s*(#.*)} $body] ;#treat as tail comment only if preceeded by semicolon
set body [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $body]
set body [punk::grepstr -return all -highlight tk-orange {\[|\]} $body]
#ansi colourised items in list format may not always have desired string representation (list escaping can occur)
@ -5669,7 +5672,7 @@ tcl::namespace::eval punk::ns {
e.g ::mynamespace::a* ::mynamespace::j*"
}
proc nsimport_noclobber {args} {
lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::ns::nsimport_noclobber]] leaders opts values received
set sourcepatterns [dict get $values sourcepattern]
set nscaller [uplevel 1 {namespace current}]
@ -5827,12 +5830,12 @@ tcl::namespace::eval punk::ns {
"Command names for which to show help info"
}
interp alias {} i+ {}\
.=args> punk::args::get_by_id ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=args>1 punk::args::parse withid ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=tables>* textblock::join -- <args|
}

21
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm
Unescape View File

@ -149,13 +149,14 @@ tcl::namespace::eval textblock {
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
#proc example {str} {
# set str [string trimleft $str \n]
# set block [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
# set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
# #puts $result
# return $result
#}
namespace import ::punk::args::helpers::*
}
@ -4196,7 +4197,7 @@ tcl::namespace::eval textblock {
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
set opts [dict get [punk::args::parse $args withid ::textblock::periodic] opts]
set opts [dict get [punk::args::parse $args -cache 1 withid ::textblock::periodic] opts]
set opt_return [tcl::dict::get $opts -return]
if {[tcl::dict::get $opts -forcecolour]} {
set fc forcecolour
@ -5601,7 +5602,7 @@ tcl::namespace::eval textblock {
set rows [concat $r0 $r1 $r2 $r3]
set column_ansi [a+ web-white Web-Gray]
set column_ansi [a+ term-white Term-grey]
set t [textblock::list_as_table -columns [expr {1 + (2 * [tcl::dict::size $blockinfo])}] -return tableobject $rows]
$t configure_column 0 -headers [list [tcl::dict::get $opts -description] "within_ansi"] -ansibase $column_ansi
@ -5723,7 +5724,7 @@ tcl::namespace::eval textblock {
#join without regard to each line length in a block (no padding added to make each block uniform)
proc ::textblock::join_basic {args} {
set argd [punk::args::parse $args withid ::textblock::join_basic]
set argd [punk::args::parse $args -cache 1 withid ::textblock::join_basic]
set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks]

4
src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm
Unescape View File

@ -340,6 +340,10 @@ namespace eval argparsingtest {
set argd [punk::args::parse $args withid ::argparsingtest::test1_punkargs2]
return [tcl::dict::get $argd opts]
}
proc test1_punkargs2_parsecache {args} {
set argd [punk::args::parse $args -cache 1 withid ::argparsingtest::test1_punkargs2]
return [tcl::dict::get $argd opts]
}
proc test1_punkargs_validate_ansistripped {args} {

38
src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm
Unescape View File

@ -116,10 +116,10 @@ punk::args::define {
@id -id "::>punk . poses"
@cmd -name ">punk . poses" -help "Show or list the poses for the Punk mascot"
-censored -default 1 -type boolean -help "Set true to include mild toilet humour poses"
-return -default table -choices {list table}
-return -default table -choices {names table list dict}
}
>punk .. Method poses {args} {
set argd [punk::args::get_by_id ">punk . poses" $args]
set argd [punk::args::parse $args withid "::>punk . poses"]
set censored [dict get $argd opts -censored]
set return [dict get $argd opts -return]
@ -143,14 +143,32 @@ punk::args::define {
#allow toilet humour
lappend poses piss poop
}
if {$return eq "list"} {
return $poses
}
set cells [list]
foreach pose $poses {
lappend cells "$pose\n\n[>punk . $pose]"
switch -- $return {
names {
return $poses
}
list {
set result [list]
foreach pose $poses {
lappend result [list $pose [>punk . $pose]]
}
return $result
}
dict {
set result [dict create]
foreach pose $poses {
dict set result $pose [>punk . $pose]
}
return $result
}
table {
set cells [list]
foreach pose $poses {
lappend cells "$pose\n\n[>punk . $pose]"
}
return [textblock::list_as_table -show_hseps 1 -columns 4 $cells]
}
}
textblock::list_as_table -show_hseps 1 -columns 4 $cells
}
>punk .. Property front [string trim {
@ -370,7 +388,7 @@ _+ +_
#TODO - reuse textblock::gcross arguments - but reorder for error display
>punk .. Method gcross {{size 1} args} {
package require textblock
set argd [punk::args::get_by_id ::textblock::gcross [list {*}$args $size]]
set argd [punk::args::parse [list {*}$args $size] withid ::textblock::gcross]
textblock::gcross {*}$args $size
}

253
src/vfs/_vfscommon.vfs/modules/punk-0.1.tm
Unescape View File

@ -564,14 +564,15 @@ namespace eval punk {
"Grep for regex pattern in plaintext of supplied (possibly ANSI) string."\
-help\
"The grepstr command can find strings in ANSI text even if there are interspersed
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
ANSI colour codes etc. Even if a word has different coloured/styled letters, the
regex can match the plaintext. (Search is performed on ansistripped text, and then
the matched sections are highlighted and overlayed on the original styled/colourd
input.
If the input string has ANSI movement codes - the resultant text may not be directly
searchable because the parts of a word may be separated by various codes and other
plain text. To search such an input string, the string should first be 'rendered' to
a form where the ANSI only represents SGR styling (and perhaps other non-movement
a form where the ANSI only represents SGR styling (and perhaps other non-movement
codes) using something like overtype::renderline or overtype::rendertext."
@leaders -min 0 -max 0
@ -589,7 +590,7 @@ namespace eval punk {
except that when instead using -returnlines all with --line-number, the *
indicator after the linenumber will only be highlighted for lines with matches,
and the following matchcount will indicate zero for non-matching lines."
}
}
-B|--before-context= -parsekey "--before-context" -default 0 -type integer -typesynopsis num
-C|--context= -parsekey "--context" -default 0 -type integer -typesynopsis num -help\
"Print num lines of leading and trailing context surrounding each match."
@ -628,7 +629,10 @@ namespace eval punk {
-- -type none
@values
pattern -type string -help\
"regex pattern to match in plaintext portion of ANSI string"
"regex pattern to match in plaintext portion of ANSI string
The pattern may contain bracketed capturing groups, which
will be highlighted (todo) in the result. If there is no capturing
group, the entire match will be highlighted."
string -type string
}
proc grepstr {args} {
@ -670,40 +674,117 @@ namespace eval punk {
}
set data [string map {\r\n \n} $data]
if {![punk::ansi::ta::detect $data]} {
if {[punk::ansi::ta::detect $data]} {
set raw_has_ansi 1
set plain [punk::ansi::ansistrip $data]
} else {
set raw_has_ansi 0
set plain $data
}
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $lines $pattern]
set result ""
set matched_line_indices [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
#matches|breaksandmatches
set returnlines $matches
set returnlines $matched_line_indices
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
#lineindex is zero based - display of linenums is 1 based
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matched_line_indices} {
set plain_ln [lindex $plainlines $lineindex]
#first test the regexp with a single match to determine number of capturing groups
set matchparts [regexp {*}$nocase -inline -- $pattern $plain_ln] ;#get fullmatch capturegroup...
set numgroups [expr {[llength $matchparts] -1}]
set allparts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
#allparts includes each full match as well as each capturing group
#early versions of tcl 8.6 still didn't support 'lsearch -stride' - avoid for now.
set matchcount [expr {[llength $allparts] / ($numgroups + 1)}]
#set matchcount [llength $allparts]
if {$matchcount == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr (shouldn't happen) regex: $pattern lineindex: $lineindex"
set matchshow "??? $ln"
dict set resultlines $lineindex $matchshow
continue
}
if {$lineindex in $matches} {
set ln [regsub -all {*}$nocase -- $pattern $ln $H&$R] ;#n
set matchcount [regexp -all {*}$nocase -- $pattern $ln]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
# ------------------------------------
if {$numgroups > 0} {
# restrict ourself to just the capture groups, excluding the full match (if there are capture groups)
set highlight_ranges [list]
set i 0
foreach range $allparts {
if {($i % ($numgroups+1)) != 0} {
lappend highlight_ranges $range
}
incr i
}
} else {
if {$do_linenums} {
append col1 "*000"
#No capture group in the regex, each index range is just a full match
set highlight_ranges $allparts
}
# ------------------------------------
#puts stderr "numgroups : $numgroups"
#puts stderr "grepstr pattern : $pattern"
#puts stderr "grepstr allparts: $allparts"
#puts stderr "highlight_ranges: $highlight_ranges"
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {$raw_has_ansi} {
set overlay ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
#set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
set rendered [overtype::renderspace -transparent $placeholder -insert_mode 0 $ln $overlay]
} else {
set rendered ""
set i 0
foreach hrange $highlight_ranges {
lassign $hrange s e
set prelen [expr {$s - $i}]
#append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]
append rendered [string range $plain_ln $i $s-1] $H [string range $plain_ln $s $e] $R
set i [expr {$e + 1}]
}
append rendered [string range $plain_ln $e+1 end]
}
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
@ -721,12 +802,7 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
if {$do_linenums} {
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
@ -742,109 +818,16 @@ namespace eval punk {
}
}
#---------------------------------------------------------------
}
} else {
set plain [punk::ansi::ansistrip $data]
set plainlines [split $plain \n]
set lines [split $data \n]
set matches [lsearch -all {*}$nocase -regexp $plainlines $pattern]
if {$opt_returnlines eq "all"} {
set returnlines [punk::lib::range 0 [llength $lines]-1]
} else {
set returnlines $matches
}
set max [lindex $returnlines end]
if {[string is integer -strict $max]} {
#if max index is 9 - linenum will be 10, (99->100 etc) - so add one in case we're on such a boundary.
incr max
}
set w1 [string length $max]
set result ""
set placeholder \UFFEF ;#review
set resultlines [dict create]
foreach lineindex $returnlines {
set ln [lindex $lines $lineindex]
set col1 ""
if {$do_linenums} {
set col1 [format "%${w1}s " [expr {$lineindex+1}]]
}
if {$lineindex in $matches} {
set plain_ln [lindex $plainlines $lineindex]
set parts [regexp -all {*}$nocase -indices -inline -- $pattern $plain_ln]
set matchcount [llength $parts]
if {$do_linenums} {
append col1 $H*$R[format %03s $matchcount]
}
if {[llength $parts] == 0} {
#This probably can't happen (?)
#If it does.. it's more likely to be an issue with our line index than with regexp
puts stderr "Unexpected regex mismatch in grepstr - line marked with ??? (shouldn't happen)"
set matchshow "??? $ln"
#dict set resultlines $lineindex $show
} else {
set overlay ""
set i 0
foreach prange $parts {
lassign $prange s e
set prelen [expr {$s - $i}]
append overlay [string repeat $placeholder $prelen] $H[string range $plain_ln $s $e]$R
set i [expr {$e + 1}]
}
set tail [string range $plain_ln $e+1 end]
append overlay [string repeat $placeholder [string length $tail]]
#puts "$overlay"
#puts "$ln"
set rendered [overtype::renderline -transparent $placeholder -insert_mode 0 $ln $overlay]
if {$do_linenums} {
set matchshow "$col1 $rendered"
} else {
set matchshow $rendered
}
}
#---------------------------------------------------------------
set prelines [lrange $lines $lineindex-$beforecontext $lineindex-1]
set s [expr {$lineindex-$beforecontext-1}]
if {$s < -1} {set s -1}
foreach p $prelines {
incr s
#append result "[format %${w1}s [expr {$s+1}]]- " " " $p \n
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
dict set resultlines $lineindex $matchshow
#---------------------------------------------------------------
set postlines [lrange $lines $lineindex+1 $lineindex+$aftercontext]
set s $lineindex
foreach p $postlines {
incr s
if {![dict exists $resultlines $s]} {
if {$do_linenums} {
set show "[format "%${w1}s " [expr {$s+1}]]- $p"
} else {
set show $p
}
dict set resultlines $s $show
}
}
#---------------------------------------------------------------
append col1 "*000"
set show "$col1 $ln"
} else {
if {$do_linenums} {
append col1 "*000"
set show "$col1 $ln"
} else {
set show $ln
}
dict set resultlines $lineindex $show
set show $ln
}
dict set resultlines $lineindex $show
}
}
set ordered_resultlines [lsort -integer [dict keys $resultlines]]
set result ""
@ -7828,6 +7811,7 @@ namespace eval punk {
lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"]
lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"]
lappend cmdinfo [list s "cmd ?subcommand...?" "Show synopsis for a command or ensemble subcommand"]
lappend cmdinfo [list eg "cmd ?subcommand...?" "Show example from manpage"]
lappend cmdinfo [list ./ "?subdir?" "view/change directory"]
lappend cmdinfo [list ../ "" "go up one directory"]
lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"]
@ -7884,12 +7868,19 @@ namespace eval punk {
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/1095bf7f75]"
append warningblock [a]
}
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
if {[catch {lsearch -stride 2 {a b} b}]} {
set indent " "
append warningblock \n "[a+ web-red]warning: lsearch does not seem to support -stride option" \n
append warningblock "${indent}(Consider upgrading to a late release of tcl 8.6 or tcl 9+ )" \n
append warningblock [a]
} else {
if {[punk::lib::check::has_tclbug_lsearch_strideallinline]} {
set indent " "
append warningblock \n "[a+ web-red]warning: punk::lib::check::has_tclbug_lsearch_strideallinline returned true!" \n
append warningblock "${indent}(lsearch using -stride -all -inline -subindices does not return values corresponding to subindex when a single -index value is used)" \n
append warningblock "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/5a1aaa201d]"
append warningblock [a]
}
}
if {[punk::lib::check::has_tclbug_list_quoting_emptyjoin]} {
set indent " "

7
src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm
Unescape View File

@ -171,7 +171,8 @@ tcl::namespace::eval punk::ansi::class {
}
default {
puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x"
punk::args::get_by_id "::punk::ansi::class::class_ansi render_to_input_line" $args
punk::args::parse $args withid "::punk::ansi::class::class_ansi render_to_input_line"
return
}
}
}
@ -2763,7 +2764,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
@values -min 0 -max 0
}]
proc sgr_cache {args} {
set argd [punk::args::get_by_id ::punk::ansi::sgr_cache $args]
set argd [punk::args::parse $args withid ::punk::ansi::sgr_cache]
set action [dict get $argd opts -action]
set pretty [dict get $argd opts -pretty]
@ -3943,7 +3944,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
lappend codestack $code
} else {
#jjtest
apend emit $code
append emit $code
}
}
7GFX {

327
src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm
Unescape View File

@ -270,6 +270,190 @@ tcl::namespace::eval punk::args::register {
tcl::namespace::eval ::punk::args {}
tcl::namespace::eval ::punk::args::helpers {
variable PUNKARGS
namespace export *
#proc B {} {return \x1b\[1m} ;#a+ bold
#proc N {} {return \x1b\[22m} ;#a+ normal
#proc I {} {return \x1b\[3m} ;#a+ italic
#proc NI {} {return \x1b\[23m} ;#a+ noitalic
proc I {} {punk::ansi::a+ italic}
proc B {} {punk::ansi::a+ bold}
proc N {} {punk::ansi::a+ normal}
proc NI {} {punk::ansi::a+ italic}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::example
@cmd -name punk::args::helpers::example\
-summary\
{Display formatting for argdoc example text}\
-help\
{Wrap }
@opts
-padright -type integer -default 2 -help\
{Number of padding spaces to add on RHS of text block}
-syntax -type string -default tcl -choices {none tcl} -choicelabels {
tcl\
" Very basic tcl syntax highlighting
of braces,square brackets and comments."
-title -type string -default ""
-titlealign -type string -choices {left centre right}
}
text -type string
}]
proc example {args} {
#only use punk::args::parse on the unhappy path
if {[llength $args] == 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set str [lindex $args end]
set optlist [lrange $args 0 end-1]
if {[llength $optlist] %2 != 0} {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
set defaults [dict create\
-padright 2\
-syntax tcl\
-title ""\
-titlealign left\
]
dict for {o v} $optlist {
switch -- $o {
-padright - -syntax - -title - -titlealign {}
default {
punk::args::parse $args withid ::punk::args::helpers::example
return
}
}
}
set opts [dict merge $defaults $optlist]
set opt_padright [dict get $opts -padright]
set opt_syntax [dict get $opts -syntax]
set opt_title [dict get $opts -title]
set opt_titlealign [dict get $opts -titlealign]
if {[string index $str 0] eq "\n"} {
set str [string range $str 1 end]
}
if {[string index $str end] eq "\n"} {
set str [string range $str 0 end-1]
}
#example is intended to run from a source doc that has already been dedented appropriately based on context
# - we don't want to further undent, hence -undent 0
set str [uplevel 1 [list punk::lib::tstr -undent 0 -return string -eval 1 -allowcommands $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
if {$opt_padright > 0} {
set str [textblock::join -- $str [string repeat " " $opt_padright]]
}
if {$opt_title ne ""} {
set title "[a+ term-black Term-silver]$opt_title[a]"
} else {
set title ""
}
set str [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey white] -ansiborder [a+ term-black Term-silver] -titlealign $opt_titlealign -title $title -boxlimits {hl} -type block $str]]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
#rudimentary colourising (not full tcl syntax parsing)
#highlight comments first - so that we can also highlight braces within comments to help with detecting unbalanced braces/square brackets in comments
switch -- $opt_syntax {
tcl {
#result lines often indicated in examples by \u2192 →
#however - it's not present on each line of output, instead indents are used - so we can't so easily highlight all appropriate rows(?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {^\s*#.*} $str] ;#Note, will not highlight comments at end of line - like this one
set str [punk::grepstr -return all -highlight {Term-grey term-darkgreen} {;\s*(#.*)} $str]
#TODO - fix grepstr highlighting (bg issues - why?)
set str [punk::grepstr -return all -highlight {Term-grey term-darkblue} {\{|\}} $str]
set str [punk::grepstr -return all -highlight {Term-grey term-orange1} {\[|\]} $str]
#puts stderr -------------------
#puts $str
#puts stderr -------------------
}
}
set result [textblock::bookend_lines $str [a] "[a defaultbg] [a]"]
return $result
}
lappend PUNKARGS [list {
@id -id ::punk::args::helpers::strip_nodisplay_lines
@cmd -name punk::args::helpers::strip_nodisplay_lines\
-summary\
"strip #<nodisplay> lines."\
-help\
"Strip lines beginning with #<nodisplay> from the supplied text.
Whitespace prior to #<nodisplay> is ignored, and ANSI is stripped
prior to examining each line for the #<nodisplay> tag."
@values -min 1 -max 1
text -optional 0 -help\
{punk::args::define scripts must have properly balanced braces etc
as per Tcl rules.
Sometimes it is desired to display help text or examples demonstrating
unbalanced braces etc, but without escaping it in a way that shows the
escaping backslash in the help text. This balancing requirement includes
curly braces in comments. eg
${[punk::args::helpers::example -title " Example 1a " {
proc bad_syntax {args} {
#eg this is an unbalanced left curly brace {
#<nodisplay> balancing right curly brace }
return $args
}
}]}
There is a second comment line in the above proc which begins
with #<nodisplay> and contains the balancing right curly brace.
This shouldn't show in the example above.
The actual text is in a placeholder call to punk::args::helpers::example
to provide basic syntax highlighting and box background, and looks like
the following, but without the left-hand side pipe symbols.
${[punk::args::helpers::example -syntax none -title " Example 1b " {
| proc bad_syntax {args} {
| #eg this is an unbalanced left curly brace {
| #<nodisplay> balancing right curly brace }
| return $args
| }
}]}
Technically a proc body can exist with an unbalanced brace in a comment
like that and would still run without issue. However, such a definition
couldn't be placed in a tcl file to be sourced, nor directly evaluated
with eval.
A #<nodisplay> comment can also be used just for commenting the help
source inline.
Note that an opening square bracket can't be balanced by a line beginning
with the # character.
The non-comment form @#<nodisplay> is available so help lines beginning
with this token will also be stripped. This can be used to 'close' a
section of text that happens to look like a command block. This should
only be used if there is some reason the opening square bracket can't
be rewritten in the help doc to be escaped with a backslash.
The ${[B]}strip_nodisplay_lines${[N]} function is called automatically
by the help text generators in punk::args, and generally shouldn't need
to be used directly, but nevertheless resides in in punk::args::helpers
alongside the ${[B]}example${[N]} function which is intended for writers
of punk::args::define scripts (command documentors) to use.
}
}]
proc strip_nodisplay_lines {text} {
set display ""
foreach ln [split $text \n] {
set stripped [string trimleft [punk::ansi::ansistrip $ln]]
if {![string match "#<nodisplay>*" $stripped] && ![string match "@#<nodisplay>*" $stripped]} {
append display $ln \n
}
}
if {[string index $display end] eq "\n"} {
set display [string range $display 0 end-1]
}
return $display
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
@ -419,6 +603,7 @@ tcl::namespace::eval punk::args {
directive-options: -help <str>
%B%@seealso%N% ?opt val...?
directive-options: -name <str> -url <str> (for footer - unimplemented)
%B%@instance%N% ?opt val...?
Some other options normally present on custom arguments are available
to use with the @leaders @opts @values directives to set defaults
@ -624,8 +809,21 @@ tcl::namespace::eval punk::args {
-maxsize (type dependant)
-range (type dependant - only valid if -type is a single item)
-typeranges (list with same number of elements as -type)
-help <string>
for the @cmd directive - this is the main multiline description.
For an argument is the multi-line help that displays in the Help
column.
For the @examples directive this is the text for examples as
displayed with 'eg <commandname>'
The -help string can be delimited with double quotes or with
curly braces, the choice will affect what inner chars require
backslash escaping - but neither type of help block is
automatically subject to variable or command substitution aside
from those specifically wrapped in placeholders.
For cases where unbalanced braces, double quotes are to
be displayed to the user without visible backslash escapes,
see 'i ::punk::args::helpers::strip_nodisplay_lines'
"
-dynamic -type boolean -default 0 -help\
"If -dynamic is true, tstr interpolations of the form \$\{\$var\}
@ -649,7 +847,7 @@ tcl::namespace::eval punk::args {
from existing definitions (by id) for re-use of argument specifications and help text)
e.g the following definition passes 2 blocks as text arguments
${[punk::args::moduledoc::tclcore::argdoc::example {
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc -help\
@ -955,6 +1153,8 @@ tcl::namespace::eval punk::args {
set LVL 2
if {!$is_dynamic} {
#todo - don't use cached version if 'colour off' vs 'colour on' different to when last resolved!
#(e.g example blocks will still have colour if previously resolved)
if {[tcl::dict::exists $argdata_cache $cache_key]} {
return [tcl::dict::get $argdata_cache $cache_key]
}
@ -965,7 +1165,7 @@ tcl::namespace::eval punk::args {
set optionspecs [list]
foreach block $normargs {
if {[string first \$\{ $block] > 0} {
if {[string first \$\{ $block] >= 0} {
if {$defspace ne ""} {
set block [namespace eval $defspace [list punk::args::lib::tstr -return string -eval 1 -allowcommands -undent 1 $block]]
} else {
@ -1082,6 +1282,19 @@ tcl::namespace::eval punk::args {
set record_line 0 ;#incremented at each incomplete record, set to zero after processing a complete record
foreach rawline $linelist {
#puts stderr "$record_line $rawline"
#XXX
#set rawtrimmed [string trim $rawline]
#if {$in_record_continuation && $rawtrimmed ne "" && [string index $rawtrimmed 0] ni [list "\}" {"} "#"]} {
# regexp {(\s*).*} $rawline _ rawline_indent
# if {[string length $rawline_indent] <= [string length $record_base_indent]} {
# lappend records $linebuild
# set linebuild ""
# #prep for next record
# set in_record_continuation 0
# incr record_id
# set record_line 0
# }
#}
set record_so_far [tcl::string::cat $linebuild $rawline]
#ansi colours can stop info complete from working (contain square brackets)
#review - when exactly are ansi codes allowed/expected in record lines.
@ -1174,17 +1387,23 @@ tcl::namespace::eval punk::args {
set record_line 0
}
}
if {$in_record_continuation} {
puts stderr "punk::args::resolve incomplete record:"
puts stderr "$linebuild"
}
#puts stderr 1[lindex $records 1]
#puts stderr 4[lindex $records 4]
#puts stderr 5[lindex $records 5]
#puts stderr 6[lindex $records 6]
set cmd_info {}
set package_info {}
set id_info {} ;#e.g -children <list> ??
set doc_info {}
#set argdisplay_info {} ;#optional override of autogenerated 'Arg Type Default Multi Help' table
set seealso_info {}
#set credits_info {} ;#e.g see interp man CREDITS section todo - where to display?
set instance_info {}
set keywords_info {}
set examples_info {}
###set leader_min 0
@ -1212,6 +1431,14 @@ tcl::namespace::eval punk::args {
"" - # {continue}
}
incr record_number
if {[catch {lassign $trimrec firstword}]} {
puts stdout "----------------------------------------------"
puts stderr "rec: $rec"
set ::testrecord $rec
puts stdout "----------------------------------------------"
puts "records: $records"
puts stdout "=============================================="
}
set record_values [lassign $trimrec firstword] ;#after first word, the remaining list elements up to the first newline that isn't inside a value, form a dict
if {[llength $record_values] % 2 != 0} {
#todo - avoid raising an error - store invalid defs keyed on id
@ -1854,6 +2081,10 @@ tcl::namespace::eval punk::args {
#like @doc, except displays in footer, multiple - sub-table?
set seealso_info [dict merge $seealso_info $at_specs]
}
instance {
#todo!
set instance_info [dict merge $instance_info $at_specs]
}
keywords {
#review - put as option on @cmd instead? @cmd -name xxx -keywords {blah etc hmm} ??
set keywords_info [dict merge $keywords_info $at_specs]
@ -2429,6 +2660,7 @@ tcl::namespace::eval punk::args {
doc_info $doc_info\
package_info $package_info\
seealso_info $seealso_info\
instance_info $instance_info\
keywords_info $keywords_info\
examples_info $examples_info\
id_info $id_info\
@ -2461,9 +2693,9 @@ tcl::namespace::eval punk::args {
namespace eval argdoc {
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICES {* @id @package @cmd @ref @doc @examples @formdisplay @seealso @instance @leaders @opts @values leaders opts values}
variable resolved_def_TYPE_CHOICEGROUPS {
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso}
directives {@id @package @cmd @ref @doc @examples @formdisplay @seealso @instance}
argumenttypes {leaders opts values}
remaining_defaults {@leaders @opts @values}
}
@ -2680,7 +2912,7 @@ tcl::namespace::eval punk::args {
dict set resultdict @id [list -id [dict get $specdict id]]
}
}
foreach directive {@package @cmd @doc @examples @seealso} {
foreach directive {@package @cmd @doc @examples @seealso @instance} {
set dshort [string range $directive 1 end]
if {"$directive" in $included_directives} {
if {[dict exists $opt_override $directive]} {
@ -2747,7 +2979,7 @@ tcl::namespace::eval punk::args {
}
}
}
@package - @cmd - @doc - @examples - @seealso {
@package - @cmd - @doc - @examples - @seealso - @instance {
if {"$type" in $included_directives} {
set tp [string range $type 1 end] ;# @package -> package
if {[dict exists $opt_override $type]} {
@ -3671,6 +3903,7 @@ tcl::namespace::eval punk::args {
lappend blank_header_col ""
#set cmdhelp_display [a+ brightwhite]$cmdhelp[a]
#set cmdhelp_display [textblock::ansibase_lines $cmdhelp $CLR(linebase_header)]
set cmdhelp [punk::args::helpers::strip_nodisplay_lines $cmdhelp]
set cmdhelp_display [punk::ansi::ansiwrap_raw $CLR(linebase_header) "" "" $cmdhelp]
} else {
set cmdhelp_display ""
@ -4055,6 +4288,7 @@ tcl::namespace::eval punk::args {
}
set unindentedfields [Dict_getdef $arginfo -unindentedfields {}]
set help [Dict_getdef $arginfo -help ""]
set help [punk::args::helpers::strip_nodisplay_lines $help]
set allchoices_originalcase [list]
set choices [Dict_getdef $arginfo -choices {}]
set choicegroups [Dict_getdef $arginfo -choicegroups {}]
@ -4610,7 +4844,6 @@ tcl::namespace::eval punk::args {
Will usually match the command name"
}]
proc usage {args} {
#lassign [dict values [punk::args::get_by_id ::punk::args::usage $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::args::usage]] leaders opts values received
set id [dict get $values id]
set real_id [real_id $id]
@ -4656,7 +4889,7 @@ tcl::namespace::eval punk::args {
lappend PUNKARGS [list {
@id -id ::punk::args::parse
@cmd -name punk::args::parse -help\
"parse and validate command arguments based on a definition.
{parse and validate command arguments based on a definition.
In the 'withid' form the definition is a pre-existing record that has been
created with ::punk::args::define, or indirectly by adding a definition to
@ -4673,23 +4906,25 @@ tcl::namespace::eval punk::args {
Returns a dict of information regarding the parsed arguments
example of basic usage for single option only:
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts \"have option for existing file [dict get $opts -configfile]\"
}
}
${[punk::args::helpers::example {
punk::args::define {
@id -id ::myns::myfunc
@cmd -name myns::myfunc
@leaders -min 0 -max 0
@opts
-configfile -type existingfile
#type none makes it a solo flag
-verbose -type none
@values -min 0 -max 0
}
proc myfunc {args} {
set argd [punk::args::parse $args withid ::myns::myfunc]
lassign [dict values $argd] leaders opts values received solos
if {[dict exists $received] -configfile} {
puts "have option for existing file [dict get $opts -configfile]"
}
}
}]}
The leaders, opts, values keys in the parse result dict are proper dicts.
The received key is dict-like but can have repeated keys for arguments than can
accept multiples. The value for each received element is the ordinal position.
@ -4698,7 +4933,7 @@ tcl::namespace::eval punk::args {
to another procedure which also requires solos, because the opts dict contains
solo flags with a 1 value or a list of 1's if it was a solo with -multiple true
specified.
"
}
@form -form {withid withdef}
@leaders -min 1 -max 1
arglist -type list -optional 0 -help\
@ -4713,6 +4948,12 @@ tcl::namespace::eval punk::args {
#default to enhanced errorstyle despite slow 'catch' (unhappy path) performance
#todo - configurable per interp/namespace
-errorstyle -type string -default enhanced -choices {enhanced standard basic minimal}
-cache -type boolean -default 0 -help\
{Use sparingly.
This uses a cache for same arguments being parsed against
the same definition.
It is a minor speedup suitable for when a small set of similar
(and generally small) arguments are repeatedly used by a function.}
@values -min 2
@ -4738,6 +4979,7 @@ tcl::namespace::eval punk::args {
how to process the definition."
}]
variable parse_cache [dict create]
proc parse {args} {
#puts "punk::args::parse --> '$args'"
set tailtype "" ;#withid|withdef
@ -4802,6 +5044,7 @@ tcl::namespace::eval punk::args {
set defaultopts [dict create\
-form {*}\
-errorstyle standard\
-cache 0\
]
#todo - load override_errorstyle from configuration
@ -4810,7 +5053,7 @@ tcl::namespace::eval punk::args {
set opts [dict merge $defaultopts $opts]
dict for {k v} $opts {
switch -- $k {
-form - -errorstyle {
-form - -errorstyle - -cache {
}
default {
#punk::args::usage $args withid ::punk::args::parse ??
@ -4847,7 +5090,19 @@ tcl::namespace::eval punk::args {
}
try {
#puts stdout "parse --> get_dict <deflist> $parseargs -form [dict get $opts -form]"
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
if {![dict get $opts -cache]} {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
} else {
variable parse_cache
set key [list $parseargs $deflist [dict get $opts -form]]
if {[dict exists $parse_cache $key]} {
set result [dict get $parse_cache $key]
} else {
set result [punk::args::get_dict $deflist $parseargs -form [dict get $opts -form]]
dict set parse_cache $key $result
}
return $result
}
} trap {PUNKARGS VALIDATION} {msg erroropts} {
set opt_errorstyle [dict get $opts -errorstyle]
@ -7201,7 +7456,7 @@ tcl::namespace::eval punk::args {
# -----------------------------------------------
# Warning - be aware of all vars thrown into this space (from tail end of 'definition' proc)
tcl::dict::with argspecs {} ;#turn keys into vars
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info,id_info,form_names
#e.g id,FORMS,cmd_info,doc_info,package_info,seealso_info, instance_info,id_info,form_names
# -----------------------------------------------
set opt_form [dict get $proc_opts -form]
if {$opt_form eq "*"} {
@ -9152,7 +9407,8 @@ tcl::namespace::eval punk::args {
return
}
if {[dict exists $spec examples_info -help]} {
return [dict get $spec examples_info -help]
set egdata [dict get $spec examples_info -help]
return [punk::args::helpers::strip_nodisplay_lines $egdata]
} else {
return "no @examples defined for $id"
}
@ -9177,7 +9433,8 @@ tcl::namespace::eval punk::args {
cmditem -multiple 1 -optional 0
}]
proc synopsis {args} {
set argd [punk::args::parse $args withid ::punk::args::synopsis]
#synopsis potentially called repeatedly with same args? use -cache 1
set argd [punk::args::parse $args -cache 1 withid ::punk::args::synopsis]
if {[catch {package require punk::ansi} errM]} {
set has_punkansi 0
@ -10807,7 +11064,7 @@ tcl::namespace::eval punk::args::package {
# set PUNKARGS ""
#}
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package
lappend ::punk::args::register::NAMESPACES ::punk::args::argdoc ::punk::args ::punk::args::lib ::punk::args::package ::punk::args::helpers
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools

2682
src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tclcore-0.1.0.tm
View File

File diff suppressed because it is too large Load Diff

41
src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/tkcore-0.1.1.tm
Unescape View File

@ -21,7 +21,7 @@
#[manpage_begin punkshell_module_punk::args::moduledoc::tkcore 0 0.1.1]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require punk::args::moduledoc::tkcore]
#[keywords module]
#[description]
@ -112,13 +112,15 @@ tcl::namespace::eval punk::args::moduledoc::tkcore {
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
namespace import ::punk::args::helpers::*
#proc example {str} {
# #sample override of punk::args::helpers::example (without highlighting and inner placeholder processing)
# set str [string trimleft $str \n]
# set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
# set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
# return $result
#}
}
@ -364,6 +366,7 @@ tcl::namespace::eval punk::args::moduledoc::tkcore {
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS_aliases {::button ::tk::button}
punk::args::define {
@dynamic
@id -id ::tk::button
@cmd -name "Tk Builtin: tk::button"\
-summary\
@ -388,7 +391,8 @@ tcl::namespace::eval punk::args::moduledoc::tkcore {
@opts -type string -parsekey "" -group "STANDARD OPTIONS" -grouphelp\
""
}\
{${[punk::args::resolved_def -types opts (default)::punk::args::moduledoc::tkcore::tk_standardoptions\
{
${[punk::args::resolved_def -types opts (default)::punk::args::moduledoc::tkcore::tk_standardoptions\
-activebackground\
-activeforeground\
-anchor\
@ -454,17 +458,18 @@ tcl::namespace::eval punk::args::moduledoc::tkcore {
} "@doc -name Manpage: -url [manpage button]"\
{@examples -help {
{
@examples -help {
This is the classic Tk “Hello, World!” demonstration:
${[punk::args::moduledoc::tclcore::argdoc::example {
button .b -text "Hello, World!" -command exit
${[example {
${$B}button${$N} .b -text "Hello, World!" -command exit
pack .b
}]}
This example demonstrates how to handle button accelerators:
${[punk::args::moduledoc::tclcore::argdoc::example {
button .b1 -text Hello -underline 0
button .b2 -text World -underline 0
${[example {
${$B}button${$N} .b1 -text Hello -underline 0
${$B}button .b2${$N} -text World -underline 0
bind . <Key-h> {.b1 flash; .b1 invoke}
bind . <Key-w> {.b2 flash; .b2 invoke}
pack .b1 .b2
@ -554,9 +559,9 @@ tcl::namespace::eval punk::args::moduledoc::tkcore::lib {
# == === === === === === === === === === === === === === ===
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
# == === === === === === === === === === === === === === ===
tcl::namespace::eval punk::args::moduledoc::tkcore {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
variable PUNKARGS
@ -579,7 +584,7 @@ tcl::namespace::eval punk::args::moduledoc::tkcore {
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
lappend about_topics [string range $tail [string length get_topic_] end]
}
#Adjust this function or 'default_topics' if a different order is required
return [lsort $about_topics]

2
src/vfs/_vfscommon.vfs/modules/punk/basictelnet-0.1.0.tm
Unescape View File

@ -472,7 +472,7 @@ namespace eval punk::basictelnet {
"TCP port"
}
proc telnet {args} {
set argd [punk::args::get_by_id ::punk::basictelnet::telnet $args]
set argd [punk::args::parse $args withid ::punk::basictelnet::telnet]
set server [dict get $argd values server]
set port [dict get $argd values port]
set tmode [dict get $argd opts -mode]

12
src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm
Unescape View File

@ -130,7 +130,7 @@ tcl::namespace::eval punk::blockletter {
proc logo {args} {
variable logo_letter_colours
variable default_frametype
set argd [punk::args::get_by_id ::punk::blockletter::logo $args]
set argd [punk::args::parse $args withid ::punk::blockletter::logo]
set f [dict get $argd opts -frametype]
set bd [dict get $argd opts -outlinecolour]
set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary
@ -225,11 +225,11 @@ tcl::namespace::eval punk::blockletter {
-frametype -default {${$default_frametype}}
@values -min 1 -max 1
str -help "Text to convert to blockletters
Requires terminal font to support relevant block characters"
"
}]
Requires terminal font to support relevant block characters"
"
}]
proc text {args} {
set argd [punk::args::get_by_id ::punk::blockletter::text $args]
set argd [punk::args::parse $args withid ::punk::blockletter::text]
set opts [dict get $argd opts]
set str [dict get $argd values str]
set str [string map {\r\n \n} $str]
@ -293,7 +293,7 @@ tcl::namespace::eval punk::blockletter::lib {
}]
proc block {args} {
upvar ::punk::blockletter::default_frametype ft
set argd [punk::args::get_by_id ::punk::blockletter::lib::block $args]
set argd [punk::args::parse $args withid ::punk::blockletter::lib::block]
set bg [dict get $argd opts -bgcolour]
set bd [dict get $argd opts -bordercolour]
set h [dict get $argd opts -height]

14
src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm
Unescape View File

@ -669,21 +669,21 @@ namespace eval punk::console {
prudent."
@values -min 2 -max 2
query -type string -help\
"ANSI sequence such as \x1b\[?6n which
{ANSI sequence such as \x1b\[?6n which
should elicit a response by the terminal
on stdin"
on stdin}
capturingendregex -type string -help\
"capturingendregex should capture ANY prefix, whole escape match - and a subcapture
{capturingendregex should capture ANY prefix, whole escape match - and a subcapture
of the data we're interested in; and match at end of string.
ie {(.*)(ESC(info)end)$}
e.g {(.*)(\x1bP44!~([:alnum:])\x1b\\)$}
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)"
we expect 4 results from regexp -indices -inline (overallmatch, prefix, wholeescape,info)}
}]
#todo - check capturingendregex value supplied has appropriate captures and tail-anchor
proc get_ansi_response_payload {args} {
#we pay a few 10s of microseconds to use punk::args::parse (on the happy path)
#seems reasonable for the flexibility in this case.
set argd [punk::args::parse $args withid ::punk::console::internal::get_ansi_response_payload]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::internal::get_ansi_response_payload]
lassign [dict values $argd] leaders opts values received
set inoutchannels [dict get $opts -terminal]
@ -1507,7 +1507,7 @@ namespace eval punk::console {
or omit to query cell size."
}
proc cell_size {args} {
set argd [punk::args::get_by_id ::punk::console::cell_size $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::cell_size]
set inoutchannels [dict get $argd opts -inoutchannels]
set newsize [dict get $argd values newsize]
@ -1551,7 +1551,7 @@ namespace eval punk::console {
#only works in raw mode for windows terminal - (esc in output stripped?) why?
# works in line mode for alacrity and wezterm
proc test_is_vt52 {args} {
set argd [punk::args::get_by_id ::punk::console::test_is_vt52 $args]
set argd [punk::args::parse $args -cache 1 withid ::punk::console::test_is_vt52]
set inoutchannels [dict get $argd opts -inoutchannels]
#ESC / K VT52 without printer
#ESC / M VT52 with printer

98
src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm
Unescape View File

@ -1481,53 +1481,55 @@ tcl::namespace::eval punk::imap4 {
lappend PUNKARGS [list {
@id -id ::punk::imap4::CONNECT
@cmd -name punk::imap4::CONNECT -help\
"Open a new IMAP connection and initialise the handler.
Returns the Tcl channel to use in subsequent calls to
the API. Other API commands will return zero on success.
e.g
${[punk::args::moduledoc::tclcore::argdoc::example {
% set chan [CONNECT mail.example.com]
sock123aaa456789
% AUTH_PLAIN $chan user pass
0
... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ...
% LOGOUT $chan
0}]}"
@leaders -min 0 -max 0
-debug -type boolean -default 0 -help\
"Display some of the cli/server interaction on stdout
during commands. This can be set or queried using
the 'debugchan $chan ?bool?' command."
-security -nocase 1 -choices {None TLS/SSL STARTTLS} -help\
"Connection security.
TLS/SSL is recommended (implicit TLS).
If port is 143 and -security is omitted, then it will
default to STARTTLS.
For any other port, or omitted port, the default for
-security is TLS/SSL.
ie if no channel security is wanted, then -security
should be explicitly set to None."
@values -min 1 -max 2
hostname -optional 0 -help\
"Host/IP Address of server.
port may optionally be specified at tail of hostname
after a colon, but not if the following optional port
argument to the command is also supplied and is non-zero.
e.g
server.example.com:143
[::1]::993
"
port -optional 1 -type integer -help\
"Port to connect to.
If port is omitted:
defaults to 143 when -security None or STARTTLS
defaults to 993 when -security TLS/SSL or -security is omitted."
}]
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::punk::imap4::CONNECT
@cmd -name punk::imap4::CONNECT -help\
"Open a new IMAP connection and initialise the handler.
Returns the Tcl channel to use in subsequent calls to
the API. Other API commands will return zero on success.
e.g
${[example {
% set chan [${[B]}CONNECT${[N]} mail.example.com]
sock123aaa456789
% AUTH_PLAIN $chan user pass
0
# ... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ...
% LOGOUT $chan
0
}]}"
@leaders -min 0 -max 0
-debug -type boolean -default 0 -help\
"Display some of the cli/server interaction on stdout
during commands. This can be set or queried using
the 'debugchan $chan ?bool?' command."
-security -nocase 1 -choices {None TLS/SSL STARTTLS} -help\
"Connection security.
TLS/SSL is recommended (implicit TLS).
If port is 143 and -security is omitted, then it will
default to STARTTLS.
For any other port, or omitted port, the default for
-security is TLS/SSL.
ie if no channel security is wanted, then -security
should be explicitly set to None."
@values -min 1 -max 2
hostname -optional 0 -help\
"Host/IP Address of server.
port may optionally be specified at tail of hostname
after a colon, but not if the following optional port
argument to the command is also supplied and is non-zero.
e.g
server.example.com:143
[::1]::993
"
port -optional 1 -type integer -help\
"Port to connect to.
If port is omitted:
defaults to 143 when -security None or STARTTLS
defaults to 993 when -security TLS/SSL or -security is omitted."
}]
}
proc CONNECT {args} {
set argd [punk::args::parse $args withid ::punk::imap4::CONNECT]
lassign [dict values $argd] leaders opts values received
@ -4231,6 +4233,8 @@ tcl::namespace::eval punk::imap4 {
namespace eval argdoc {
#namespace for custom argument documentation
namespace import ::punk::args::helpers::*
proc package_name {} {
return punk::imap4
}

8
src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm
Unescape View File

@ -44,14 +44,18 @@ namespace eval punk::mix::commandset::layout {
#per layout functions
punk::args::define {
@dynamic
@id -id ::punk::mix::commandset::layout::files
@id -id ::punk::mix::commandset::layout::files
@cmd -name punk::mix::commandset::layout::files -synopsis\
"list files in project layout"\
-help\
""
-datetime -default "%Y-%m-%dT%H:%M:%S" -help\
"Datetime format for mtime. Use empty string for no datetime output"
@values -min 1 -max 1
layout -type string -choices {${[punk::mix::commandset::layout::argdoc::layout_names]}}
}
proc files {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::layout::files $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::layout::files]
set layout [dict get $argd values layout]
set dtformat [dict get $argd opts -datetime]

2
src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm
Unescape View File

@ -44,7 +44,7 @@ namespace eval punk::mix::commandset::loadedlib {
If search is not prefixed with '=' the search is case insensitive."
}
proc search {args} {
set argd [punk::args::get_by_id ::punk::mix::commandset::loadedlib::search $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::loadedlib::search]
set searchstrings [dict get $argd values searchstring]
set opts [dict get $argd opts]
set opt_return [dict get $opts -return]

8
src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm
Unescape View File

@ -132,7 +132,6 @@ namespace eval punk::mix::commandset::module {
globsearches -default * -multiple 1
}
proc templates_dict {args} {
#set argd [punk::args::get_by_id ::punk::mix::commandset::module::templates_dict $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::templates_dict]
package require punk::cap
if {[punk::cap::capability_has_handler punk.templates]} {
@ -146,7 +145,10 @@ namespace eval punk::mix::commandset::module {
set moduletypes [punk::mix::cli::lib::module_types]
punk::args::define [subst {
@id -id ::punk::mix::commandset::module::new
@cmd -name "punk::mix::commandset::module::new" -help\
@cmd -name "punk::mix::commandset::module::new"\
-synopsis\
"create .tm module file from template"\
-help\
"Create a new module file in the appropriate folder within src/modules.
If the name given in the module argument is namespaced,
the necessary subfolder(s) will be used or created."
@ -173,7 +175,7 @@ namespace eval punk::mix::commandset::module {
proc new {args} {
set year [clock format [clock seconds] -format %Y]
# use \uFFFD because unicode replacement char should consistently render as 1 wide
set argd [punk::args::get_by_id ::punk::mix::commandset::module::new $args]
set argd [punk::args::parse $args withid ::punk::mix::commandset::module::new]
lassign [dict values $argd] leaders opts values received
set module [dict get $values module]

4
src/vfs/_vfscommon.vfs/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -644,7 +644,7 @@ tcl::namespace::eval punk::nav::fs {
@values -min 0 -max -1 -unnamed true
}
proc dirfiles {args} {
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles]
lassign [dict values $argd] leaders opts values_dict
set opt_stripbase [dict get $opts -stripbase]
@ -1005,7 +1005,7 @@ tcl::namespace::eval punk::nav::fs {
#todo - color key via repl-telemetry? help command? documentation? or add tag columns as done in namespace listing?
proc dirfiles_dict_as_lines {args} {
package require overtype
set argd [punk::args::get_by_id ::punk::nav::fs::dirfiles_dict_as_lines $args]
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict_as_lines]
lassign [dict values $argd] leaders opts vals
set list_of_dicts [dict values $vals]

23
src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm
Unescape View File

@ -2447,7 +2447,8 @@ tcl::namespace::eval punk::ns {
"Name of ensemble command for which subcommand info is gathered."
}
proc ensemble_subcommands {args} {
set argd [punk::args::get_by_id ::punk::ns::ensemble_subcommands $args]
#puts stderr "---> punk::ns::ensemble_subcommands $args"
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::ensemble_subcommands]
set opts [dict get $argd opts]
set origin [dict get $argd values origin]
@ -3087,6 +3088,7 @@ tcl::namespace::eval punk::ns {
}]
append argdef \n $vline
append argdef \n "@values -unnamed true"
append argdef \n "@instance -help {instance info derived from id (instance)::$origin ?}"
punk::args::define $argdef
}
@ -3331,7 +3333,7 @@ tcl::namespace::eval punk::ns {
}
variable cmdinfo_reducerid 0
proc cmdinfo {args} {
set argd [punk::args::parse $args withid ::punk::ns::cmdinfo]
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdinfo]
lassign [dict values $argd] leaders opts values received
set cmdlist [dict get $values cmditem]
@ -5256,7 +5258,8 @@ tcl::namespace::eval punk::ns {
basic {
#rudimentary colourising only
set argl [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $argl]
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {^\s*#.*} $body] ;#Note, will not highlight comments at end of line - like this one.
set body [punk::grepstr -return all -highlight green {;\s*(#.*)} $body] ;#treat as tail comment only if preceeded by semicolon
set body [punk::grepstr -return all -highlight tk-darkcyan {\{|\}} $body]
set body [punk::grepstr -return all -highlight tk-orange {\[|\]} $body]
#ansi colourised items in list format may not always have desired string representation (list escaping can occur)
@ -5669,7 +5672,7 @@ tcl::namespace::eval punk::ns {
e.g ::mynamespace::a* ::mynamespace::j*"
}
proc nsimport_noclobber {args} {
lassign [dict values [punk::args::get_by_id ::punk::ns::nsimport_noclobber $args]] leaders opts values received
lassign [dict values [punk::args::parse $args withid ::punk::ns::nsimport_noclobber]] leaders opts values received
set sourcepatterns [dict get $values sourcepattern]
set nscaller [uplevel 1 {namespace current}]
@ -5827,12 +5830,12 @@ tcl::namespace::eval punk::ns {
"Command names for which to show help info"
}
interp alias {} i+ {}\
.=args> punk::args::get_by_id ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=args>1 punk::args::parse withid ::i+ |argd>\
.=>2 dict get values cmd |cmds>\
.=cmds>2 lmap c {i -return tableobject {*}$c} |objs>\
.=objs>2 lmap t {$t configure -show_vseps 0 -show_edge 1} |>\
.=objs>2 lmap t {$t print} |tables>\
.=objs>2 lmap t {$t destroy} |>\
.=tables>* textblock::join -- <args|
}

2
src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm
Unescape View File

@ -110,7 +110,7 @@ tcl::namespace::eval punk::sixel {
variable sixelinfo_cache
set sixelinfo_cache [dict create]
proc get_info {args} {
set argd [punk::args::get_by_id ::punk::sixel::get_info $args]
set argd [punk::args::parse $args withid ::punk::sixel::get_info]
set sixelstring [dict get $argd values sixelstring]
set do_cache [dict get $argd opts -cache]
set cell_size_override [dict get $argd opts -cell_size]

21
src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm
Unescape View File

@ -149,13 +149,14 @@ tcl::namespace::eval textblock {
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
#proc example {str} {
# set str [string trimleft $str \n]
# set block [punk::ansi::ansiwrap Term-grey [textblock::frame -ansibase [a+ Term-grey bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
# set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
# #puts $result
# return $result
#}
namespace import ::punk::args::helpers::*
}
@ -4196,7 +4197,7 @@ tcl::namespace::eval textblock {
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
set opts [dict get [punk::args::parse $args withid ::textblock::periodic] opts]
set opts [dict get [punk::args::parse $args -cache 1 withid ::textblock::periodic] opts]
set opt_return [tcl::dict::get $opts -return]
if {[tcl::dict::get $opts -forcecolour]} {
set fc forcecolour
@ -5601,7 +5602,7 @@ tcl::namespace::eval textblock {
set rows [concat $r0 $r1 $r2 $r3]
set column_ansi [a+ web-white Web-Gray]
set column_ansi [a+ term-white Term-grey]
set t [textblock::list_as_table -columns [expr {1 + (2 * [tcl::dict::size $blockinfo])}] -return tableobject $rows]
$t configure_column 0 -headers [list [tcl::dict::get $opts -description] "within_ansi"] -ansibase $column_ansi
@ -5723,7 +5724,7 @@ tcl::namespace::eval textblock {
#join without regard to each line length in a block (no padding added to make each block uniform)
proc ::textblock::join_basic {args} {
set argd [punk::args::parse $args withid ::textblock::join_basic]
set argd [punk::args::parse $args -cache 1 withid ::textblock::join_basic]
set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks]

Write Preview
Loading…
Cancel
Save