Browse Source

punk::args fixes and more tclcore documentation

master
Julian Noble 1 week ago
parent
commit
ae2acc3d5f
  1. 16
      src/bootsupport/modules/argparsingtest-0.1.0.tm
  2. 6
      src/bootsupport/modules/commandstack-0.3.tm
  3. 25
      src/bootsupport/modules/modpod-0.1.3.tm
  4. 1
      src/bootsupport/modules/punk/aliascore-0.1.0.tm
  5. 14
      src/bootsupport/modules/punk/ansi-0.1.1.tm
  6. 6400
      src/bootsupport/modules/punk/args-0.1.6.tm
  7. 6458
      src/bootsupport/modules/punk/args-0.1.7.tm
  8. 48
      src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm
  9. 17
      src/bootsupport/modules/punk/config-0.1.tm
  10. 8
      src/bootsupport/modules/punk/du-0.1.0.tm
  11. 4
      src/bootsupport/modules/punk/fileline-0.1.0.tm
  12. 1472
      src/bootsupport/modules/punk/lib-0.1.0.tm
  13. 29
      src/bootsupport/modules/punk/lib-0.1.2.tm
  14. 1061
      src/bootsupport/modules/punk/libunknown-0.1.tm
  15. 4
      src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm
  16. 8
      src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  17. 15
      src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm
  18. 7
      src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  19. 1070
      src/bootsupport/modules/punk/ns-0.1.0.tm
  20. 2
      src/bootsupport/modules/punk/packagepreference-0.1.0.tm
  21. 14
      src/bootsupport/modules/punk/repo-0.1.1.tm
  22. 107
      src/bootsupport/modules/punk/zip-0.1.1.tm
  23. 74
      src/bootsupport/modules/textblock-0.1.3.tm
  24. 16
      src/modules/argparsingtest-999999.0a1.0.tm
  25. 2
      src/modules/patternpunk-1.1.tm
  26. 6
      src/modules/punk-0.1.tm
  27. 1
      src/modules/punk/aliascore-999999.0a1.0.tm
  28. 14
      src/modules/punk/ansi-999999.0a1.0.tm
  29. 1891
      src/modules/punk/args-999999.0a1.0.tm
  30. 2
      src/modules/punk/args-buildversion.txt
  31. 1135
      src/modules/punk/args/tclcore-999999.0a1.0.tm
  32. 48
      src/modules/punk/cap/handlers/templates-999999.0a1.0.tm
  33. 17
      src/modules/punk/config-0.1.tm
  34. 8
      src/modules/punk/du-999999.0a1.0.tm
  35. 4
      src/modules/punk/fileline-999999.0a1.0.tm
  36. 23
      src/modules/punk/lib-999999.0a1.0.tm
  37. 2
      src/modules/punk/lib-buildversion.txt
  38. 4
      src/modules/punk/mix/commandset/doc-999999.0a1.0.tm
  39. 8
      src/modules/punk/mix/commandset/layout-999999.0a1.0.tm
  40. 15
      src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm
  41. 7
      src/modules/punk/nav/fs-999999.0a1.0.tm
  42. 60
      src/modules/punk/netbox-999999.0a1.0.tm
  43. 639
      src/modules/punk/netbox/man-999999.0a1.0.tm
  44. 1070
      src/modules/punk/ns-999999.0a1.0.tm
  45. 14
      src/modules/punk/repo-999999.0a1.0.tm
  46. 107
      src/modules/punk/zip-999999.0a1.0.tm
  47. 128
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test
  48. 125
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/define.test
  49. 60
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/synopsis.test
  50. 0
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/tests/args.test#..+args+args.test.fauxlink
  51. 226
      src/modules/test/punk/#modpod-args-999999.0a1.0/args-999999.0a1.0.tm
  52. 3
      src/modules/test/punk/args-buildversion.txt
  53. 74
      src/modules/textblock-999999.0a1.0.tm
  54. 4
      src/project_layouts/custom/_project/punk.basic/src/make.tcl
  55. 16
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm
  56. 6
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/commandstack-0.3.tm
  57. 25
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/modpod-0.1.3.tm
  58. 1
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm
  59. 14
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
  60. 6400
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.6.tm
  61. 6458
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.7.tm
  62. 48
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm
  63. 17
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/config-0.1.tm
  64. 8
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
  65. 4
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm
  66. 4237
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm
  67. 1061
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm
  68. 4
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm
  69. 8
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  70. 15
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm
  71. 7
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  72. 1070
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
  73. 2
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/packagepreference-0.1.0.tm
  74. 14
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm
  75. 107
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm
  76. 74
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  77. 4
      src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl
  78. 16
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm
  79. 6
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/commandstack-0.3.tm
  80. 25
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/modpod-0.1.3.tm
  81. 1
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm
  82. 14
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm
  83. 6400
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.6.tm
  84. 6458
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.7.tm
  85. 48
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm
  86. 17
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/config-0.1.tm
  87. 8
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
  88. 4
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm
  89. 4237
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm
  90. 1061
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm
  91. 4
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm
  92. 8
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  93. 15
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm
  94. 7
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  95. 1070
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm
  96. 2
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/packagepreference-0.1.0.tm
  97. 14
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm
  98. 107
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm
  99. 74
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm
  100. 4
      src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl
  101. Some files were not shown because too many files have changed in this diff Show More

16
src/bootsupport/modules/argparsingtest-0.1.0.tm

@ -278,7 +278,7 @@ namespace eval argparsingtest {
proc test1_punkargs {args} { proc test1_punkargs {args} {
set argd [punk::args::parse $args withdef { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs @id -id ::argparsingtest::test1_punkargs
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -298,7 +298,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::test1_punkargs_by_id @id -id ::test1_punkargs_by_id
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -320,7 +320,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::argparsingtest::test1_punkargs2 @id -id ::argparsingtest::test1_punkargs2
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -342,9 +342,9 @@ namespace eval argparsingtest {
proc test1_punkargs_validate_ansistripped {args} { proc test1_punkargs_validate_ansistripped {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs_validate_ansistripped @id -id ::argparsingtest::test1_punkargs_validate_ansistripped
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -choices {string object} -help "return type" -return -default string -type string -choices {string object} -help "return type"
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -358,7 +358,7 @@ namespace eval argparsingtest {
-2 -default 2 -type integer -validate_ansistripped true -2 -default 2 -type integer -validate_ansistripped true
-3 -default 3 -type integer -validate_ansistripped true -3 -default 3 -type integer -validate_ansistripped true
@values @values
} $args] }]
return [tcl::dict::get $argd opts] return [tcl::dict::get $argd opts]
} }
@ -465,7 +465,7 @@ namespace eval argparsingtest {
#multiline values use first line of each record to determine amount of indent to trim #multiline values use first line of each record to determine amount of indent to trim
proc test_multiline {args} { proc test_multiline {args} {
set t3 [textblock::frame t3] set t3 [textblock::frame t3]
set argd [punk::args::get_dict [subst { set argd [punk::args::parse $args withdef [subst {
-template1 -default { -template1 -default {
****** ******
* t1 * * t1 *
@ -491,7 +491,7 @@ namespace eval argparsingtest {
" "
-flag -default 0 -type boolean -flag -default 0 -type boolean
}] $args] }]]
return $argd return $argd
} }

6
src/bootsupport/modules/commandstack-0.3.tm

@ -99,8 +99,11 @@ namespace eval commandstack {
} }
} }
proc get_stack {command} { proc get_stack {{command ""}} {
variable all_stacks variable all_stacks
if {$command eq ""} {
return $all_stacks
}
set command [uplevel 1 [list namespace which $command]] set command [uplevel 1 [list namespace which $command]]
if {[dict exists $all_stacks $command]} { if {[dict exists $all_stacks $command]} {
return [dict get $all_stacks $command] return [dict get $all_stacks $command]
@ -116,6 +119,7 @@ namespace eval commandstack {
variable all_stacks variable all_stacks
if {[dict exists $all_stacks $command]} { if {[dict exists $all_stacks $command]} {
set stack [dict get $all_stacks $command] set stack [dict get $all_stacks $command]
#stack is a list of dicts, 1st entry is token {<cmd> <renamer> <tokenid>}
set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]] set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]]
if {$posn > -1} { if {$posn > -1} {
set record [lindex $stack $posn] set record [lindex $stack $posn]

25
src/bootsupport/modules/modpod-0.1.3.tm

@ -134,12 +134,12 @@ namespace eval modpod {
#old tar connect mechanism - review - not needed? #old tar connect mechanism - review - not needed?
proc connect {args} { proc connect {args} {
puts stderr "modpod::connect--->>$args" puts stderr "modpod::connect--->>$args"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::connect @id -id ::modpod::connect
-type -default "" -type -default ""
@values -min 1 -max 1 @values -min 1 -max 1
path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)" path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)"
} $args] }]
catch { catch {
punk::lib::showdict $argd ;#heavy dependencies punk::lib::showdict $argd ;#heavy dependencies
} }
@ -168,7 +168,7 @@ namespace eval modpod {
} else { } else {
#connect to .tm but may still be unwrapped version available #connect to .tm but may still be unwrapped version available
lassign [::split [file rootname [file tail $modpodath]] -] connected(package,$modpodpath) connected(version,$modpodpath) lassign [::split [file rootname [file tail $modpodpath]] -] connected(package,$modpodpath) connected(version,$modpodpath)
set this_pkg_tm_folder [file dirname $modpodpath] set this_pkg_tm_folder [file dirname $modpodpath]
if {$connected(type,$modpodpath) ne "unwrapped"} { if {$connected(type,$modpodpath) ne "unwrapped"} {
#Not directly connected to unwrapped version - but may still be redirected there #Not directly connected to unwrapped version - but may still be redirected there
@ -225,11 +225,15 @@ namespace eval modpod {
if {$connected(startdata,$modpodpath) >= 0} { if {$connected(startdata,$modpodpath) >= 0} {
#verify we have a valid tar header #verify we have a valid tar header
if {![catch {::modpod::system::tar::readHeader [red $fh 512]}]} { if {![catch {::modpod::system::tar::readHeader [read $fh 512]}]} {
seek $fh $connected(startdata,$modpodpath) start seek $fh $connected(startdata,$modpodpath) start
return [list ok $fh] return [list ok $fh]
} else { } else {
#error "cannot verify tar header" #error "cannot verify tar header"
#try zipfs
if {[info commands tcl::zipfs::mount] ne ""} {
}
} }
} }
lpop connected(to) end lpop connected(to) end
@ -262,11 +266,12 @@ namespace eval modpod {
return 1 return 1
} }
proc get {args} { proc get {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::get
-from -default "" -help "path to pod" -from -default "" -help "path to pod"
*values -min 1 -max 1 @values -min 1 -max 1
filename filename
} $args] }]
set frompod [dict get $argd opts -from] set frompod [dict get $argd opts -from]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
@ -329,7 +334,7 @@ namespace eval modpod::lib {
#zipfile is a pure zip at this point - ie no script/exe header #zipfile is a pure zip at this point - ie no script/exe header
proc make_zip_modpod {args} { proc make_zip_modpod {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::lib::make_zip_modpod @id -id ::modpod::lib::make_zip_modpod
-offsettype -default "archive" -choices {archive file} -help\ -offsettype -default "archive" -choices {archive file} -help\
"Whether zip offsets are relative to start of file or start of zip-data within the file. "Whether zip offsets are relative to start of file or start of zip-data within the file.
@ -340,7 +345,7 @@ namespace eval modpod::lib {
@values -min 2 -max 2 @values -min 2 -max 2
zipfile -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries" zipfile -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries"
outfile -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm" outfile -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm"
} $args] }]
set zipfile [dict get $argd values zipfile] set zipfile [dict get $argd values zipfile]
set outfile [dict get $argd values outfile] set outfile [dict get $argd values outfile]
set opt_offsettype [dict get $argd opts -offsettype] set opt_offsettype [dict get $argd opts -offsettype]
@ -359,7 +364,7 @@ namespace eval modpod::lib {
set moddir [file dirname $modfile] set moddir [file dirname $modfile]
set mod_and_ver [file rootname [file tail $modfile]] set mod_and_ver [file rootname [file tail $modfile]]
lassign [split $mod_and_ver -] moduletail version lassign [split $mod_and_ver -] moduletail version
if {[file exists $moddir/#modpod-$mod_and_ver.tm]} { if {[file exists $moddir/#modpod-$mod_and_ver]} {
source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm
} else { } else {
#determine module namespace so we can mount appropriately #determine module namespace so we can mount appropriately

1
src/bootsupport/modules/punk/aliascore-0.1.0.tm

@ -135,6 +135,7 @@ tcl::namespace::eval punk::aliascore {
smcup ::punk::console::enable_alt_screen\ smcup ::punk::console::enable_alt_screen\
rmcup ::punk::console::disable_alt_screen\ rmcup ::punk::console::disable_alt_screen\
config ::punk::config\ config ::punk::config\
s ::punk::ns::synopsis\
] ]
#*** !doctools #*** !doctools

14
src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -3465,26 +3465,26 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
foreach {pt code} $parts { foreach {pt code} $parts {
switch -- [llength $codestack] { switch -- [llength $codestack] {
0 { 0 {
append emit $base$pt$R append emit $base $pt $R
} }
1 { 1 {
if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} { if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} {
append emit $base$pt$R append emit $base $pt $R
set codestack [list] set codestack [list]
} else { } else {
#append emit [lindex $o_codestack 0]$pt #append emit [lindex $o_codestack 0]$pt
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
default { default {
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
@ -3528,7 +3528,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append emit $code append emit $code
} }
} }
return $emit$R return [append emit $R]
} else { } else {
return $base$text$R return $base$text$R
} }

6400
src/bootsupport/modules/punk/args-0.1.6.tm

File diff suppressed because it is too large Load Diff

6458
src/bootsupport/modules/punk/args-0.1.7.tm

File diff suppressed because it is too large Load Diff

48
src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@ -250,16 +250,11 @@ namespace eval punk::cap::handlers::templates {
namespace export * namespace export *
namespace eval class { namespace eval class {
variable PUNKARGS variable PUNKARGS
#set argd [punk::args::get_dict { #lappend PUNKARGS [list {
# @id -id "::punk::cap::handlers::templates::class::api folders" # @id -id "::punk::cap::handlers::templates::class::api folders"
# -startdir -default "" # -startdir -default ""
# @values -max 0 # @values -max 0
#} $args] #}]
lappend PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
-startdir -default ""
@values -max 0
}]
oo::class create api { oo::class create api {
#return a dict keyed on folder with source pkg as value #return a dict keyed on folder with source pkg as value
@ -269,9 +264,18 @@ namespace eval punk::cap::handlers::templates {
set cname [string map {. _} $capname] set cname [string map {. _} $capname]
set capabilityname $capname set capabilityname $capname
} }
set class_ns [uplevel 1 [list namespace current]]
lappend ${class_ns}::PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
@cmd -name "punk::cap::handlers::templates::class::api folders"
-startdir -default "" -help\
"Defaults to CWD if not supplied"
@values -max 0
}]
method folders {args} { method folders {args} {
#puts "--folders $args" #puts "--folders $args"
set argd [punk::args::parse $args withid "::punk::cap::handlers::templates::class::api folders"] set argd [punk::args::parse $args withid "[self class] folders"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set opt_startdir [dict get $opts -startdir] set opt_startdir [dict get $opts -startdir]
@ -488,14 +492,19 @@ namespace eval punk::cap::handlers::templates {
} }
return $folderdict return $folderdict
} }
method get_itemdict_projectlayouts {args} { lappend ${class_ns}::PUNKARGS [list {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts" @id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts"
@cmd -name "punk::cap::handlers::templates::class::api get_itemdict_projectlayouts " -help\
""
@opts -anyopts 1 @opts -anyopts 1
#peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here #peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here
-startdir -default "" -startdir -default ""
@values -maxvalues -1 @values -maxvalues -1
} $args] }]
method get_itemdict_projectlayouts {args} {
set argd [punk::args::parse $args withid "[self class] get_itemdict_projectlayouts"]
set opt_startdir [dict get $argd opts -startdir] set opt_startdir [dict get $argd opts -startdir]
if {$opt_startdir eq ""} { if {$opt_startdir eq ""} {
@ -663,12 +672,7 @@ namespace eval punk::cap::handlers::templates {
my _get_itemdict {*}$arglist my _get_itemdict {*}$arglist
} }
#shared algorithm for get_itemdict_* methods lappend ${class_ns}::PUNKARGS [list {
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api _get_itemdict" @id -id "::punk::cap::handlers::templates::class::api _get_itemdict"
@cmd -name _get_itemdict @cmd -name _get_itemdict
@opts -anyopts 0 @opts -anyopts 0
@ -679,7 +683,15 @@ namespace eval punk::cap::handlers::templates {
-not -default "" -multiple 1 -not -default "" -multiple 1
@values -maxvalues -1 @values -maxvalues -1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
} $args] }]
#shared algorithm for get_itemdict_* methods
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::parse $args withid "[self class] _get_itemdict"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results
#puts stderr "=-=============>globsearches:$globsearches" #puts stderr "=-=============>globsearches:$globsearches"

17
src/bootsupport/modules/punk/config-0.1.tm

@ -44,8 +44,11 @@ tcl::namespace::eval punk::config {
@values -min 0 -max 0 @values -min 0 -max 0
}] }]
proc dir {args} { proc dir {args} {
#set be_quiet [dict exists $received -quiet]
if {"-quiet" in $args} { if {"-quiet" in $args} {
set be_quiet [dict exists $received -quiet] set be_quiet 1
} else {
set be_quiet 0
} }
set was_noisy 0 set was_noisy 0
@ -445,6 +448,7 @@ tcl::namespace::eval punk::config {
"Get configuration values from a config. "Get configuration values from a config.
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
#todo - load more whichconfig choices?
whichconfig -type string -choices {config startup-configuration running-configuration} whichconfig -type string -choices {config startup-configuration running-configuration}
@values -min 0 -max -1 @values -min 0 -max -1
globkey -type string -default * -optional 1 -multiple 1 globkey -type string -default * -optional 1 -multiple 1
@ -526,6 +530,10 @@ tcl::namespace::eval punk::config {
error "setting value not implemented" error "setting value not implemented"
} }
namespace eval argdoc {
set DYN_GET_LEADERS {${[punk::args::resolved_def -types leaders ::punk::config::get]}}
set DYN_GET_VALUES {${[punk::args::resolved_def -types values ::punk::config::get]}}
lappend PUNKARGS [list { lappend PUNKARGS [list {
@dynamic @dynamic
@id -id ::punk::config::show @id -id ::punk::config::show
@ -534,10 +542,11 @@ tcl::namespace::eval punk::config {
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
}\ }\
{${[punk::args::resolved_def -types leaders ::punk::config::get]}}\ {${$DYN_GET_LEADERS}}\
"@values -min 0 -max -1"\ "@values -min 0 -max -1"\
{${[punk::args::resolved_def -types values ::punk::config::get]}}\ {${$DYN_GET_VALUES}}\
] ]
}
proc show {args} { proc show {args} {
#todo - tables for console #todo - tables for console
set configrecords [punk::config::get {*}$args] set configrecords [punk::config::get {*}$args]
@ -568,7 +577,7 @@ tcl::namespace::eval punk::config {
toconfig -help\ toconfig -help\
"running or startup or file name (not fully implemented)" "running or startup or file name (not fully implemented)"
} }
set argd [punk::args::get_dict $argdef $args] set argd [punk::args::parse $args withdef $argdef]
set fromconfig [dict get $argd values fromconfig] set fromconfig [dict get $argd values fromconfig]
set toconfig [dict get $argd values toconfig] set toconfig [dict get $argd values toconfig]
set fromconfig [string map {-config ""} $fromconfig] set fromconfig [string map {-config ""} $fromconfig]

8
src/bootsupport/modules/punk/du-0.1.0.tm

@ -562,13 +562,13 @@ namespace eval punk::du {
proc Get_attributes_from_iteminfo {args} { proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int variable win_reparse_tags_by_int
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::Get_attributes_from_iteminfo @id -id ::punk::du::lib::Get_attributes_from_iteminfo
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
@values -min 1 -max 1 @values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'" iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo] set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug] set opt_debug [dict get $opts -debug]
@ -621,14 +621,14 @@ namespace eval punk::du {
proc attributes_twapi {args} { proc attributes_twapi {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::attributes_twapi @id -id ::punk::du::lib::attributes_twapi
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
@values -min 1 -max 1 @values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes" path -help "path to file or folder for which to retrieve attributes"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set path [dict get $argd values path] set path [dict get $argd values path]
set opt_detail [dict get $opts -detail] set opt_detail [dict get $opts -detail]

4
src/bootsupport/modules/punk/fileline-0.1.0.tm

@ -1559,9 +1559,9 @@ namespace eval punk::fileline::lib {
} }
proc range_boundaries {start end chunksizes args} { proc range_boundaries {start end chunksizes args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
-offset -default 0 -offset -default 0
} $args] }]
lassign [dict values $argd] leaders opts remainingargs lassign [dict values $argd] leaders opts remainingargs
} }

1472
src/bootsupport/modules/punk/lib-0.1.0.tm

File diff suppressed because it is too large Load Diff

29
src/bootsupport/modules/punk/lib-0.1.1.tm → src/bootsupport/modules/punk/lib-0.1.2.tm

@ -8,7 +8,7 @@
# (C) 2024 # (C) 2024
# #
# @@ Meta Begin # @@ Meta Begin
# Application punk::lib 0.1.1 # Application punk::lib 0.1.2
# Meta platform tcl # Meta platform tcl
# Meta license BSD # Meta license BSD
# @@ Meta End # @@ Meta End
@ -18,7 +18,7 @@
# doctools header # doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools #*** !doctools
#[manpage_begin punkshell_module_punk::lib 0 0.1.1] #[manpage_begin punkshell_module_punk::lib 0 0.1.2]
#[copyright "2024"] #[copyright "2024"]
#[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}] #[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk library}] [comment {-- Description at end of page heading --}] #[moddesc {punk library}] [comment {-- Description at end of page heading --}]
@ -1105,7 +1105,7 @@ namespace eval punk::lib {
} }
}] }]
#puts stderr "$argspec" #puts stderr "$argspec"
set argd [punk::args::get_dict $argspec $args] set argd [punk::args::parse $args withdef $argspec]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set dvar [dict get $argd values dictvar] set dvar [dict get $argd values dictvar]
@ -1147,7 +1147,7 @@ namespace eval punk::lib {
#package require punk ;#we need pipeline pattern matching features #package require punk ;#we need pipeline pattern matching features
package require textblock package require textblock
set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { set argd [punk::args::parse $args withdef [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] {
@id -id ::punk::lib::showdict @id -id ::punk::lib::showdict
@cmd -name punk::lib::showdict -help "display dictionary keys and values" @cmd -name punk::lib::showdict -help "display dictionary keys and values"
#todo - table tableobject #todo - table tableobject
@ -1178,7 +1178,7 @@ namespace eval punk::lib {
"dict or list value" "dict or list value"
patterns -default "*" -type string -multiple 1 -help\ patterns -default "*" -type string -multiple 1 -help\
"key or key glob pattern" "key or key glob pattern"
}] $args] }]]
#for punk::lib - we want to reduce pkg dependencies. #for punk::lib - we want to reduce pkg dependencies.
# - so we won't even use the tcllib debug pkg here # - so we won't even use the tcllib debug pkg here
@ -2870,7 +2870,7 @@ namespace eval punk::lib {
proc list_as_lines {args} { proc list_as_lines {args} {
#*** !doctools #*** !doctools
#[call [fun list_as_lines] [opt {-joinchar char}] [arg linelist]] #[call [fun list_as_lines] [opt {-joinchar char}] [arg linelist]]
#[para]This simply joines the elements of the list with -joinchar #[para]This simply joins the elements of the list with -joinchar
#[para]It is mainly intended for use in pipelines where the primary argument comes at the end - but it can also be used as a general replacement for join $lines <le> #[para]It is mainly intended for use in pipelines where the primary argument comes at the end - but it can also be used as a general replacement for join $lines <le>
#[para]The sister function lines_as_list takes a block of text and splits it into lines - but with more options related to trimming the block and/or each line. #[para]The sister function lines_as_list takes a block of text and splits it into lines - but with more options related to trimming the block and/or each line.
if {[set eop [lsearch $args --]] == [llength $args]-2} { if {[set eop [lsearch $args --]] == [llength $args]-2} {
@ -2890,12 +2890,11 @@ namespace eval punk::lib {
} }
proc list_as_lines2 {args} { proc list_as_lines2 {args} {
#eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible? #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible?
lassign [tcl::dict::values [punk::args::get_dict { lassign [tcl::dict::values [punk::args::parse $args withdef {
-joinchar -default \n -joinchar -default \n
@values -min 1 -max 1 @values -min 1 -max 1
} $args]] leaders opts values }]] leaders opts values
puts "opts:$opts"
puts "values:$values"
return [join [tcl::dict::get $values 0] [tcl::dict::get $opts -joinchar]] return [join [tcl::dict::get $values 0] [tcl::dict::get $opts -joinchar]]
} }
@ -2932,10 +2931,10 @@ namespace eval punk::lib {
#-anyopts 1 avoids having to know what to say if odd numbers of options passed etc #-anyopts 1 avoids having to know what to say if odd numbers of options passed etc
#we don't have to decide what is an opt vs a value #we don't have to decide what is an opt vs a value
#even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block) #even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block)
lassign [tcl::dict::values [punk::args::get_dict { lassign [tcl::dict::values [punk::args::parse $args withdef {
@opts -any 1 @opts -any 1
-block -default {} -block -default {}
} $args]] leaderdict opts valuedict }]] leaderdict opts valuedict
tailcall linelist {*}$opts {*}[tcl::dict::values $valuedict] tailcall linelist {*}$opts {*}[tcl::dict::values $valuedict]
} }
@ -4198,10 +4197,10 @@ tcl::namespace::eval punk::lib::system {
#get info about punk nestindex key ie type: list,dict,undetermined #get info about punk nestindex key ie type: list,dict,undetermined
# pdict devel # pdict devel
proc nestindex_info {args} { proc nestindex_info {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
-parent -default "" -parent -default ""
nestindex nestindex
} $args] }]
set opt_parent [dict get $argd opts -parent] set opt_parent [dict get $argd opts -parent]
if {$opt_parent eq ""} { if {$opt_parent eq ""} {
set parent_type undetermined set parent_type undetermined
@ -4229,7 +4228,7 @@ namespace eval ::punk::args::register {
package provide punk::lib [tcl::namespace::eval punk::lib { package provide punk::lib [tcl::namespace::eval punk::lib {
variable pkg punk::lib variable pkg punk::lib
variable version variable version
set version 0.1.1 set version 0.1.2
}] }]
return return

1061
src/bootsupport/modules/punk/libunknown-0.1.tm

File diff suppressed because it is too large Load Diff

4
src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm

@ -167,13 +167,13 @@ namespace eval punk::mix::commandset::doc {
cd $original_wd cd $original_wd
} }
proc validate {args} { proc validate {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::mix::commandset::doc::validate @id -id ::punk::mix::commandset::doc::validate
-- -type none -optional 1 -help "end of options marker --" -- -type none -optional 1 -help "end of options marker --"
-individual -type boolean -default 1 -individual -type boolean -default 1
@values -min 0 -max -1 @values -min 0 -max -1
patterns -default {*.man} -type any -multiple 1 patterns -default {*.man} -type any -multiple 1
} $args] }]
set opt_individual [tcl::dict::get $argd opts -individual] set opt_individual [tcl::dict::get $argd opts -individual]
set patterns [tcl::dict::get $argd values patterns] set patterns [tcl::dict::get $argd values patterns]

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

@ -113,14 +113,16 @@ namespace eval punk::mix::commandset::layout {
return [join $layouts \n] return [join $layouts \n]
} }
proc _default {args} { punk::args::define {
punk::args::get_dict [subst {
@id -id ::punk::mix::commandset::layout::collection::_default @id -id ::punk::mix::commandset::layout::collection::_default
@cmd -name ::punk::mix::commandset::layout::collection::_default @cmd -name ::punk::mix::commandset::layout::collection::_default
-startdir -type string -startdir -type string
-not -type string -multiple 1 -not -type string -multiple 1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
}] $args }
proc _default {args} {
punk::args::parse $args withid ::punk::mix::commandset::layout::collection::_default
set tdict_low_to_high [as_dict {*}$args] set tdict_low_to_high [as_dict {*}$args]
#convert to screen order - with higher priority at the top #convert to screen order - with higher priority at the top

15
src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm

@ -1252,9 +1252,8 @@ namespace eval punk::mix::commandset::scriptwrap {
#[para] Library API functions for punk::mix::commandset::scriptwrap #[para] Library API functions for punk::mix::commandset::scriptwrap
#[list_begin definitions] #[list_begin definitions]
punk::args::define {
proc get_wrapper_folders {args} { @id -id ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders
set argd [punk::args::get_dict {
#*** !doctools #*** !doctools
#[call [fun get_wrapper_folders] [arg args] ] #[call [fun get_wrapper_folders] [arg args] ]
#[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo #[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo
@ -1262,16 +1261,16 @@ namespace eval punk::mix::commandset::scriptwrap {
# [list_begin arguments] # [list_begin arguments]
# [arg_def string args] name-value pairs -scriptpath <path> # [arg_def string args] name-value pairs -scriptpath <path>
# [list_end] # [list_end]
@id -id ::punk::mix::commandset::scriptwrap @cmd -name punk::mix::commandset::scriptwrap::lib::get_wrapper_folders -help\
@cmd -name punk::mix::commandset::get_wrapper_folders "Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo"
@opts -anyopts 0 @opts -anyopts 0
-scriptpath -default "" -type directory\ -scriptpath -default "" -type directory\
-help "" -help ""
#todo -help folder within a punk.templates provided area??? #todo -help folder within a punk.templates provided area???
@values -minvalues 0 -maxvalues 0 @values -minvalues 0 -maxvalues 0
} $args] }
proc get_wrapper_folders {args} {
set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders]
# -- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- ---
set opt_scriptpath [dict get $argd opts -scriptpath] set opt_scriptpath [dict get $argd opts -scriptpath]

7
src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@ -726,9 +726,9 @@ tcl::namespace::eval punk::nav::fs {
# #
#if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern. #if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern.
# -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied # -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied
proc dirfiles_dict {args} { punk::args::define {
set argspecs {
@id -id ::punk::nav::fs::dirfiles_dict @id -id ::punk::nav::fs::dirfiles_dict
@cmd -name punk::nav::fs::dirfiles_dict
@opts -any 0 @opts -any 0
-searchbase -default "" -searchbase -default ""
-tailglob -default "\uFFFF" -tailglob -default "\uFFFF"
@ -737,7 +737,8 @@ tcl::namespace::eval punk::nav::fs {
-with_times -default "\uFFFF" -type string -with_times -default "\uFFFF" -type string
@values -min 0 -max -1 -type string @values -min 0 -max -1 -type string
} }
set argd [punk::args::get_dict $argspecs $args] proc dirfiles_dict {args} {
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict]
lassign [dict values $argd] leaders opts vals lassign [dict values $argd] leaders opts vals
set searchspecs [dict values $vals] set searchspecs [dict values $vals]

1070
src/bootsupport/modules/punk/ns-0.1.0.tm

File diff suppressed because it is too large Load Diff

2
src/bootsupport/modules/punk/packagepreference-0.1.0.tm

@ -174,7 +174,7 @@ tcl::namespace::eval punk::packagepreference {
set is_exact 1 set is_exact 1
} else { } else {
set pkg [lindex $args 1] set pkg [lindex $args 1]
set vwant [lrange $args 2 end] ;#rare - but version can be a list of options set vwant [lrange $args 2 end] ;#rare - but version can be a list of requirements
if {[llength $vwant] == 1 && [string first - [lindex $vwant 0]] > 0} { if {[llength $vwant] == 1 && [string first - [lindex $vwant 0]] > 0} {
#only one version - and it has a dash #only one version - and it has a dash
lassign [split [lindex $vwant 0] -] a b lassign [split [lindex $vwant 0] -] a b

14
src/bootsupport/modules/punk/repo-0.1.1.tm

@ -100,8 +100,12 @@ namespace eval punk::repo {
subcommand -type string -choicecolumns 8 -choicegroups { subcommand -type string -choicecolumns 8 -choicegroups {
"frequently used commands" {${$maincommands}} "frequently used commands" {${$maincommands}}
"" {${$othercmds}} "" {${$othercmds}}
} } -choiceinfo {add {{doctype punkargs}} diff {{doctype punkargs}}}
}] }]
#-choiceinfo {
# add {{doctype punkargs}}
# diff {{doctype punkargs}}
#}
return $result return $result
} }
@ -112,7 +116,7 @@ namespace eval punk::repo {
# @id -id ::punk::repo::fossil_proxy # @id -id ::punk::repo::fossil_proxy
# @cmd -name fossil -help "fossil executable # @cmd -name fossil -help "fossil executable
# " # "
# @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # @formdisplay -header "fossil help" -body {${[runout -n fossil help]}}
# } ""] # } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
@ -129,7 +133,7 @@ namespace eval punk::repo {
@dynamic @dynamic
@id -id "::punk::repo::fossil_proxy diff" @id -id "::punk::repo::fossil_proxy diff"
@cmd -name "fossil diff" -help "fossil diff" @cmd -name "fossil diff" -help "fossil diff"
@argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} @formdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}}
} ""] } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
#todo - remove this comment - testing dynamic directive #todo - remove this comment - testing dynamic directive
@ -137,7 +141,7 @@ namespace eval punk::repo {
@id -id "::punk::repo::fossil_proxy add" @id -id "::punk::repo::fossil_proxy add"
@cmd -name "fossil add" -help "fossil add @cmd -name "fossil add" -help "fossil add
" "
@argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
} ""] } ""]
#TODO #TODO
#lappend PUNKARGS [list { #lappend PUNKARGS [list {
@ -145,7 +149,7 @@ namespace eval punk::repo {
# @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs}
# @cmd -name "fossil add" -help "fossil add # @cmd -name "fossil add" -help "fossil add
# " # "
# @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} # @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
# } ""] # } ""]
lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"} lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"}
lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"} lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"}

107
src/bootsupport/modules/punk/zip-0.1.1.tm

@ -168,19 +168,7 @@ tcl::namespace::eval punk::zip {
expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) expr {(($year-1980) << 25) | ($month << 21) | ($day << 16)
| ($hour << 11) | ($min << 5) | ($sec >> 1)} | ($hour << 11) | ($min << 5) | ($sec >> 1)}
} }
punk::args::define {
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::get_dict {
@id -id ::punk::zip::walk @id -id ::punk::zip::walk
@cmd -name punk::zip::walk -help\ @cmd -name punk::zip::walk -help\
"Walk the directory structure starting at base/<-subpath> "Walk the directory structure starting at base/<-subpath>
@ -206,7 +194,19 @@ tcl::namespace::eval punk::zip {
@values -min 1 -max -1 @values -min 1 -max -1
base base
fileglobs -default {*} -multiple 1 fileglobs -default {*} -multiple 1
} $args] }
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::parse $args withid ::punk::zip::walk]
set base [dict get $argd values base] set base [dict get $argd values base]
set fileglobs [dict get $argd values fileglobs] set fileglobs [dict get $argd values fileglobs]
set subpath [dict get $argd opts -subpath] set subpath [dict get $argd opts -subpath]
@ -416,19 +416,7 @@ tcl::namespace::eval punk::zip {
# Addentry - was Mkzipfile -- punk::args::define {
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::get_dict {
@id -id ::punk::zip::Addentry @id -id ::punk::zip::Addentry
@cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan' @cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan'
return a central directory file record" return a central directory file record"
@ -440,8 +428,21 @@ tcl::namespace::eval punk::zip {
path -type file -help "path of file to add" path -type file -help "path of file to add"
zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe
Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'" Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'"
} $args] }
# Addentry - was Mkzipfile --
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::parse $args withid ::punk::zip::Addentry]
set zipchan [dict get $argd values zipchan] set zipchan [dict get $argd values zipchan]
set base [dict get $argd values base] set base [dict get $argd values base]
set path [dict get $argd values path] set path [dict get $argd values path]
@ -558,30 +559,8 @@ tcl::namespace::eval punk::zip {
# we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip) # we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip)
#### ####
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::get_dict { punk::args::define {
@id -id ::punk::zip::mkzip @id -id ::punk::zip::mkzip
@cmd -name punk::zip::mkzip\ @cmd -name punk::zip::mkzip\
-help "Create a zip archive in 'filename'" -help "Create a zip archive in 'filename'"
@ -623,8 +602,32 @@ tcl::namespace::eval punk::zip {
globs -default {*} -multiple 1\ globs -default {*} -multiple 1\
-help "list of glob patterns to match. -help "list of glob patterns to match.
Only directories with matching files will be included in the archive." Only directories with matching files will be included in the archive."
} $args] }
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::parse $args withid ::punk::zip::mkzip]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
if {$filename eq ""} { if {$filename eq ""} {
error "mkzip filename cannot be empty string" error "mkzip filename cannot be empty string"

74
src/bootsupport/modules/textblock-0.1.3.tm

@ -140,7 +140,8 @@ tcl::namespace::eval textblock {
# hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\
# "algorithm choice" # "algorithm choice"
namespace eval argdoc {
set DYN_HASH_ALGORITHM_CHOICES_AND_HELP {$[::textblock::argdoc::hash_algorithm_choices_and_help]}
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::textblock::use_hash @id -id ::textblock::use_hash
@ -149,7 +150,8 @@ tcl::namespace::eval textblock {
'none' may be slightly faster but less compact 'none' may be slightly faster but less compact
when viewing textblock::framecache" when viewing textblock::framecache"
@values -min 0 -max 1 @values -min 0 -max 1
hash_algorithm -optional 1 ${[::textblock::argdoc::hash_algorithm_choices_and_help]} hash_algorithm -optional 1 ${$DYN_HASH_ALGORITHM_CHOICES_AND_HELP}
}
} }
proc use_hash {args} { proc use_hash {args} {
#set argd [punk::args::get_by_id ::textblock::use_hash $args] #set argd [punk::args::get_by_id ::textblock::use_hash $args]
@ -4667,17 +4669,19 @@ tcl::namespace::eval textblock {
-size -type integer\ -size -type integer\
-default 15\ -default 15\
-optional 1\ -optional 1\
-range {1 15} -range {1 ""}
-direction -default horizontal\ -direction -default horizontal\
-choices {horizontal vertical}\ -choices {horizontal vertical}\
-help\ -help\
"When rainbow is in the colour list, "Direction of character increments.
this also affects the direction of When rainbow is in the colour list,
colour changes" the colour stripes will be oriented
@values -min 0 -max 2 in this direction.
"
@values -min 0 -max 1
colour -type list -default {} -optional 1 -help\ colour -type list -default {} -optional 1 -help\
"List of Ansi colour names "List of Ansi colour names
e.g. testblock 10 {white Red} e.g. testblock -size 10 {white Red}
produces a block of character 10x10 produces a block of character 10x10
with white text on red bacground with white text on red bacground
@ -4725,7 +4729,16 @@ tcl::namespace::eval textblock {
set chars [list {*}[punk::lib::range 1 9] A B C D E F] set chars [list {*}[punk::lib::range 1 9] A B C D E F]
if {$size <= 15} {
set charsubset [lrange $chars 0 $size-1] set charsubset [lrange $chars 0 $size-1]
} else {
set numsets [expr {int(ceil($size / 15.0))}]
set longset [concat {*}[lrepeat $numsets $chars]]
set charsubset [lrange $longset 0 $size-1]
set longbows [concat {*}[lrepeat $numsets $rainbow_list]]
set rainbow_list [lrange $longbows 0 $size-1]
}
if {"noreset" in $colour} { if {"noreset" in $colour} {
set RST "" set RST ""
} else { } else {
@ -4760,23 +4773,34 @@ tcl::namespace::eval textblock {
append row $c append row $c
} }
append row $RST append row $RST
append block $row\n append block $row \n
} }
set block [tcl::string::trimright $block \n] set block [tcl::string::trimright $block \n]
return $block return $block
} else { } else {
if {$direction eq "vertical"} {
#row first - #row first -
set rows [list] set rows [list]
foreach ch $charsubset { foreach ch $charsubset {
lappend rows [tcl::string::repeat $ch $size] lappend rows [tcl::string::repeat $ch $size]
} }
set block [::join $rows \n] set block [::join $rows \n]
if {$colour ne ""} { if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST
}
return $block
} else {
set block ""
for {set r 0} {$r < $size} {incr r} {
append block [::join $charsubset ""] \n
}
if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST set block [a+ {*}$colour]$block$RST
} }
return $block return $block
} }
} }
}
interp alias {} testblock {} textblock::testblock interp alias {} testblock {} textblock::testblock
#todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table #todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table
@ -5500,10 +5524,11 @@ tcl::namespace::eval textblock {
proc ::textblock::join1 {args} { proc ::textblock::join1 {args} {
lassign [punk::args::get_dict { lassign [punk::args::parse $args withdef {
@id -id ::textblock::join1
-ansiresets -default 1 -type integer -ansiresets -default 1 -type integer
blocks -type string -multiple 1 blocks -type string -multiple 1
} $args] _l leaders _o opts _v values }] _l leaders _o opts _v values
set blocks [tcl::dict::get $values blocks] set blocks [tcl::dict::get $values blocks]
set idx 0 set idx 0
@ -5578,11 +5603,12 @@ tcl::namespace::eval textblock {
#@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width. #@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width.
# Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner # Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner
#" #"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::textblock::join_basic2
-- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags" -- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags"
-ansiresets -type any -default auto -ansiresets -type any -default auto
blocks -type any -multiple 1 blocks -type any -multiple 1
} $args] }]
set ansiresets [tcl::dict::get $argd opts -ansiresets] set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks] set blocks [tcl::dict::get $argd values blocks]
@ -5619,12 +5645,6 @@ tcl::namespace::eval textblock {
#for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed #for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed
#they may however still be 'ragged' ie differing line lengths #they may however still be 'ragged' ie differing line lengths
proc ::textblock::join {args} { proc ::textblock::join {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
#we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets #we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets
@ -5709,11 +5729,6 @@ tcl::namespace::eval textblock {
} }
proc ::textblock::join2 {args} { proc ::textblock::join2 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5801,11 +5816,6 @@ tcl::namespace::eval textblock {
} }
# This calls textblock::pad per cell :/ # This calls textblock::pad per cell :/
proc ::textblock::join3 {args} { proc ::textblock::join3 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5984,7 +5994,7 @@ tcl::namespace::eval textblock {
NOTE: more options available - argument definition NOTE: more options available - argument definition
is incomplete" is incomplete"
@opts @opts
-return -choices {table tableobject} -return -default table -choices {table tableobject}
-rows -type list -default "" -help\ -rows -type list -default "" -help\
"A list of lists. "A list of lists.
Each toplevel element represents a row. Each toplevel element represents a row.
@ -6213,7 +6223,7 @@ tcl::namespace::eval textblock {
-help "restrict to keys matching memberglob." -help "restrict to keys matching memberglob."
}] }]
#append spec \n "frametype -help \"A predefined \"" #append spec \n "frametype -help \"A predefined \""
punk::args::get_dict $spec $args punk::args::parse $args withdef $spec
return return
} }

16
src/modules/argparsingtest-999999.0a1.0.tm

@ -278,7 +278,7 @@ namespace eval argparsingtest {
proc test1_punkargs {args} { proc test1_punkargs {args} {
set argd [punk::args::parse $args withdef { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs @id -id ::argparsingtest::test1_punkargs
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -298,7 +298,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::test1_punkargs_by_id @id -id ::test1_punkargs_by_id
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -320,7 +320,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::argparsingtest::test1_punkargs2 @id -id ::argparsingtest::test1_punkargs2
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -342,9 +342,9 @@ namespace eval argparsingtest {
proc test1_punkargs_validate_ansistripped {args} { proc test1_punkargs_validate_ansistripped {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs_validate_ansistripped @id -id ::argparsingtest::test1_punkargs_validate_ansistripped
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -choices {string object} -help "return type" -return -default string -type string -choices {string object} -help "return type"
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -358,7 +358,7 @@ namespace eval argparsingtest {
-2 -default 2 -type integer -validate_ansistripped true -2 -default 2 -type integer -validate_ansistripped true
-3 -default 3 -type integer -validate_ansistripped true -3 -default 3 -type integer -validate_ansistripped true
@values @values
} $args] }]
return [tcl::dict::get $argd opts] return [tcl::dict::get $argd opts]
} }
@ -465,7 +465,7 @@ namespace eval argparsingtest {
#multiline values use first line of each record to determine amount of indent to trim #multiline values use first line of each record to determine amount of indent to trim
proc test_multiline {args} { proc test_multiline {args} {
set t3 [textblock::frame t3] set t3 [textblock::frame t3]
set argd [punk::args::get_dict [subst { set argd [punk::args::parse $args withdef [subst {
-template1 -default { -template1 -default {
****** ******
* t1 * * t1 *
@ -491,7 +491,7 @@ namespace eval argparsingtest {
" "
-flag -default 0 -type boolean -flag -default 0 -type boolean
}] $args] }]]
return $argd return $argd
} }

2
src/modules/patternpunk-1.1.tm

@ -346,7 +346,7 @@ _+ +_
package require punk::args package require punk::args
set standard_frame_types [textblock::frametypes] set standard_frame_types [textblock::frametypes]
set argd [punk::args::parse $args withdef [tstr -return string { set argd [punk::args::parse $args withdef [tstr -return string {
@id -id ">punk . deck" @id -id "::>punk . deck"
@cmd -name "deck" -help "Punk Deck mascot" @cmd -name "deck" -help "Punk Deck mascot"
-frame -default arc -choices "${$standard_frame_types}" -choicerestricted 0 -choiceprefix 1 -frame -default arc -choices "${$standard_frame_types}" -choicerestricted 0 -choiceprefix 1
-boxmap -default {} -type dict -boxmap -default {} -type dict

6
src/modules/punk-0.1.tm

@ -6798,7 +6798,8 @@ namespace eval punk {
return $linelist return $linelist
} }
namespace eval argdoc {
set DYN_ANTIGLOB_PATHS {${[punk::args::resolved_def -types opts ::punk::path::treefilenames -antiglob_paths]}}
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::punk::LOC @id -id ::punk::LOC
@ -6808,7 +6809,7 @@ namespace eval punk {
-return -default showdict -choices {dict showdict} -return -default showdict -choices {dict showdict}
-dir -default "\uFFFF" -dir -default "\uFFFF"
-exclude_dupfiles -default 1 -type boolean -exclude_dupfiles -default 1 -type boolean
${[punk::args::resolved_def -types opts ::punk::path::treefilenames -antiglob_paths]} ${$DYN_ANTIGLOB_PATHS}
-antiglob_files -default "" -type list -help\ -antiglob_files -default "" -type list -help\
"Exclude if file tail matches any of these patterns" "Exclude if file tail matches any of these patterns"
-exclude_punctlines -default 1 -type boolean -exclude_punctlines -default 1 -type boolean
@ -6820,6 +6821,7 @@ namespace eval punk {
#we could map away whitespace and use string is punct - but not as flexible? review #we could map away whitespace and use string is punct - but not as flexible? review
-punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] } -punctchars -default { [list \{ \} \" \\ - _ + = . > , < ' : \; ` ~ ! @ # \$ % ^ & * \[ \] ( ) | / ?] }
" "
}
#An implementation of a notoriously controversial metric. #An implementation of a notoriously controversial metric.
proc LOC {args} { proc LOC {args} {
set argd [punk::args::parse $args withid ::punk::LOC] set argd [punk::args::parse $args withid ::punk::LOC]

1
src/modules/punk/aliascore-999999.0a1.0.tm

@ -135,6 +135,7 @@ tcl::namespace::eval punk::aliascore {
smcup ::punk::console::enable_alt_screen\ smcup ::punk::console::enable_alt_screen\
rmcup ::punk::console::disable_alt_screen\ rmcup ::punk::console::disable_alt_screen\
config ::punk::config\ config ::punk::config\
s ::punk::ns::synopsis\
] ]
#*** !doctools #*** !doctools

14
src/modules/punk/ansi-999999.0a1.0.tm

@ -3465,26 +3465,26 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
foreach {pt code} $parts { foreach {pt code} $parts {
switch -- [llength $codestack] { switch -- [llength $codestack] {
0 { 0 {
append emit $base$pt$R append emit $base $pt $R
} }
1 { 1 {
if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} { if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} {
append emit $base$pt$R append emit $base $pt $R
set codestack [list] set codestack [list]
} else { } else {
#append emit [lindex $o_codestack 0]$pt #append emit [lindex $o_codestack 0]$pt
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
default { default {
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
@ -3528,7 +3528,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append emit $code append emit $code
} }
} }
return $emit$R return [append emit $R]
} else { } else {
return $base$text$R return $base$text$R
} }

1891
src/modules/punk/args-999999.0a1.0.tm

File diff suppressed because it is too large Load Diff

2
src/modules/punk/args-buildversion.txt

@ -1,3 +1,3 @@
0.1.4 0.1.7
#First line must be a semantic version number #First line must be a semantic version number
#all other lines are ignored. #all other lines are ignored.

1135
src/modules/punk/args/tclcore-999999.0a1.0.tm

File diff suppressed because it is too large Load Diff

48
src/modules/punk/cap/handlers/templates-999999.0a1.0.tm

@ -250,16 +250,11 @@ namespace eval punk::cap::handlers::templates {
namespace export * namespace export *
namespace eval class { namespace eval class {
variable PUNKARGS variable PUNKARGS
#set argd [punk::args::get_dict { #lappend PUNKARGS [list {
# @id -id "::punk::cap::handlers::templates::class::api folders" # @id -id "::punk::cap::handlers::templates::class::api folders"
# -startdir -default "" # -startdir -default ""
# @values -max 0 # @values -max 0
#} $args] #}]
lappend PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
-startdir -default ""
@values -max 0
}]
oo::class create api { oo::class create api {
#return a dict keyed on folder with source pkg as value #return a dict keyed on folder with source pkg as value
@ -269,9 +264,18 @@ namespace eval punk::cap::handlers::templates {
set cname [string map {. _} $capname] set cname [string map {. _} $capname]
set capabilityname $capname set capabilityname $capname
} }
set class_ns [uplevel 1 [list namespace current]]
lappend ${class_ns}::PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
@cmd -name "punk::cap::handlers::templates::class::api folders"
-startdir -default "" -help\
"Defaults to CWD if not supplied"
@values -max 0
}]
method folders {args} { method folders {args} {
#puts "--folders $args" #puts "--folders $args"
set argd [punk::args::parse $args withid "::punk::cap::handlers::templates::class::api folders"] set argd [punk::args::parse $args withid "[self class] folders"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set opt_startdir [dict get $opts -startdir] set opt_startdir [dict get $opts -startdir]
@ -488,14 +492,19 @@ namespace eval punk::cap::handlers::templates {
} }
return $folderdict return $folderdict
} }
method get_itemdict_projectlayouts {args} { lappend ${class_ns}::PUNKARGS [list {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts" @id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts"
@cmd -name "punk::cap::handlers::templates::class::api get_itemdict_projectlayouts " -help\
""
@opts -anyopts 1 @opts -anyopts 1
#peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here #peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here
-startdir -default "" -startdir -default ""
@values -maxvalues -1 @values -maxvalues -1
} $args] }]
method get_itemdict_projectlayouts {args} {
set argd [punk::args::parse $args withid "[self class] get_itemdict_projectlayouts"]
set opt_startdir [dict get $argd opts -startdir] set opt_startdir [dict get $argd opts -startdir]
if {$opt_startdir eq ""} { if {$opt_startdir eq ""} {
@ -663,12 +672,7 @@ namespace eval punk::cap::handlers::templates {
my _get_itemdict {*}$arglist my _get_itemdict {*}$arglist
} }
#shared algorithm for get_itemdict_* methods lappend ${class_ns}::PUNKARGS [list {
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api _get_itemdict" @id -id "::punk::cap::handlers::templates::class::api _get_itemdict"
@cmd -name _get_itemdict @cmd -name _get_itemdict
@opts -anyopts 0 @opts -anyopts 0
@ -679,7 +683,15 @@ namespace eval punk::cap::handlers::templates {
-not -default "" -multiple 1 -not -default "" -multiple 1
@values -maxvalues -1 @values -maxvalues -1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
} $args] }]
#shared algorithm for get_itemdict_* methods
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::parse $args withid "[self class] _get_itemdict"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results
#puts stderr "=-=============>globsearches:$globsearches" #puts stderr "=-=============>globsearches:$globsearches"

17
src/modules/punk/config-0.1.tm

@ -44,8 +44,11 @@ tcl::namespace::eval punk::config {
@values -min 0 -max 0 @values -min 0 -max 0
}] }]
proc dir {args} { proc dir {args} {
#set be_quiet [dict exists $received -quiet]
if {"-quiet" in $args} { if {"-quiet" in $args} {
set be_quiet [dict exists $received -quiet] set be_quiet 1
} else {
set be_quiet 0
} }
set was_noisy 0 set was_noisy 0
@ -445,6 +448,7 @@ tcl::namespace::eval punk::config {
"Get configuration values from a config. "Get configuration values from a config.
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
#todo - load more whichconfig choices?
whichconfig -type string -choices {config startup-configuration running-configuration} whichconfig -type string -choices {config startup-configuration running-configuration}
@values -min 0 -max -1 @values -min 0 -max -1
globkey -type string -default * -optional 1 -multiple 1 globkey -type string -default * -optional 1 -multiple 1
@ -526,6 +530,10 @@ tcl::namespace::eval punk::config {
error "setting value not implemented" error "setting value not implemented"
} }
namespace eval argdoc {
set DYN_GET_LEADERS {${[punk::args::resolved_def -types leaders ::punk::config::get]}}
set DYN_GET_VALUES {${[punk::args::resolved_def -types values ::punk::config::get]}}
lappend PUNKARGS [list { lappend PUNKARGS [list {
@dynamic @dynamic
@id -id ::punk::config::show @id -id ::punk::config::show
@ -534,10 +542,11 @@ tcl::namespace::eval punk::config {
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
}\ }\
{${[punk::args::resolved_def -types leaders ::punk::config::get]}}\ {${$DYN_GET_LEADERS}}\
"@values -min 0 -max -1"\ "@values -min 0 -max -1"\
{${[punk::args::resolved_def -types values ::punk::config::get]}}\ {${$DYN_GET_VALUES}}\
] ]
}
proc show {args} { proc show {args} {
#todo - tables for console #todo - tables for console
set configrecords [punk::config::get {*}$args] set configrecords [punk::config::get {*}$args]
@ -568,7 +577,7 @@ tcl::namespace::eval punk::config {
toconfig -help\ toconfig -help\
"running or startup or file name (not fully implemented)" "running or startup or file name (not fully implemented)"
} }
set argd [punk::args::get_dict $argdef $args] set argd [punk::args::parse $args withdef $argdef]
set fromconfig [dict get $argd values fromconfig] set fromconfig [dict get $argd values fromconfig]
set toconfig [dict get $argd values toconfig] set toconfig [dict get $argd values toconfig]
set fromconfig [string map {-config ""} $fromconfig] set fromconfig [string map {-config ""} $fromconfig]

8
src/modules/punk/du-999999.0a1.0.tm

@ -562,13 +562,13 @@ namespace eval punk::du {
proc Get_attributes_from_iteminfo {args} { proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int variable win_reparse_tags_by_int
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::Get_attributes_from_iteminfo @id -id ::punk::du::lib::Get_attributes_from_iteminfo
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
@values -min 1 -max 1 @values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'" iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo] set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug] set opt_debug [dict get $opts -debug]
@ -621,14 +621,14 @@ namespace eval punk::du {
proc attributes_twapi {args} { proc attributes_twapi {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::attributes_twapi @id -id ::punk::du::lib::attributes_twapi
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
@values -min 1 -max 1 @values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes" path -help "path to file or folder for which to retrieve attributes"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set path [dict get $argd values path] set path [dict get $argd values path]
set opt_detail [dict get $opts -detail] set opt_detail [dict get $opts -detail]

4
src/modules/punk/fileline-999999.0a1.0.tm

@ -1559,9 +1559,9 @@ namespace eval punk::fileline::lib {
} }
proc range_boundaries {start end chunksizes args} { proc range_boundaries {start end chunksizes args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
-offset -default 0 -offset -default 0
} $args] }]
lassign [dict values $argd] leaders opts remainingargs lassign [dict values $argd] leaders opts remainingargs
} }

23
src/modules/punk/lib-999999.0a1.0.tm

@ -1105,7 +1105,7 @@ namespace eval punk::lib {
} }
}] }]
#puts stderr "$argspec" #puts stderr "$argspec"
set argd [punk::args::get_dict $argspec $args] set argd [punk::args::parse $args withdef $argspec]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set dvar [dict get $argd values dictvar] set dvar [dict get $argd values dictvar]
@ -1147,7 +1147,7 @@ namespace eval punk::lib {
#package require punk ;#we need pipeline pattern matching features #package require punk ;#we need pipeline pattern matching features
package require textblock package require textblock
set argd [punk::args::get_dict [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] { set argd [punk::args::parse $args withdef [string map [list %sep% $sep %sep_mismatch% $sep_mismatch] {
@id -id ::punk::lib::showdict @id -id ::punk::lib::showdict
@cmd -name punk::lib::showdict -help "display dictionary keys and values" @cmd -name punk::lib::showdict -help "display dictionary keys and values"
#todo - table tableobject #todo - table tableobject
@ -1178,7 +1178,7 @@ namespace eval punk::lib {
"dict or list value" "dict or list value"
patterns -default "*" -type string -multiple 1 -help\ patterns -default "*" -type string -multiple 1 -help\
"key or key glob pattern" "key or key glob pattern"
}] $args] }]]
#for punk::lib - we want to reduce pkg dependencies. #for punk::lib - we want to reduce pkg dependencies.
# - so we won't even use the tcllib debug pkg here # - so we won't even use the tcllib debug pkg here
@ -2870,7 +2870,7 @@ namespace eval punk::lib {
proc list_as_lines {args} { proc list_as_lines {args} {
#*** !doctools #*** !doctools
#[call [fun list_as_lines] [opt {-joinchar char}] [arg linelist]] #[call [fun list_as_lines] [opt {-joinchar char}] [arg linelist]]
#[para]This simply joines the elements of the list with -joinchar #[para]This simply joins the elements of the list with -joinchar
#[para]It is mainly intended for use in pipelines where the primary argument comes at the end - but it can also be used as a general replacement for join $lines <le> #[para]It is mainly intended for use in pipelines where the primary argument comes at the end - but it can also be used as a general replacement for join $lines <le>
#[para]The sister function lines_as_list takes a block of text and splits it into lines - but with more options related to trimming the block and/or each line. #[para]The sister function lines_as_list takes a block of text and splits it into lines - but with more options related to trimming the block and/or each line.
if {[set eop [lsearch $args --]] == [llength $args]-2} { if {[set eop [lsearch $args --]] == [llength $args]-2} {
@ -2890,12 +2890,11 @@ namespace eval punk::lib {
} }
proc list_as_lines2 {args} { proc list_as_lines2 {args} {
#eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible? #eat or own dogfood version - shows the implementation is simpler - but unfortunately not suitable for a simple function like this which should be as fast as possible?
lassign [tcl::dict::values [punk::args::get_dict { lassign [tcl::dict::values [punk::args::parse $args withdef {
-joinchar -default \n -joinchar -default \n
@values -min 1 -max 1 @values -min 1 -max 1
} $args]] leaders opts values }]] leaders opts values
puts "opts:$opts"
puts "values:$values"
return [join [tcl::dict::get $values 0] [tcl::dict::get $opts -joinchar]] return [join [tcl::dict::get $values 0] [tcl::dict::get $opts -joinchar]]
} }
@ -2932,10 +2931,10 @@ namespace eval punk::lib {
#-anyopts 1 avoids having to know what to say if odd numbers of options passed etc #-anyopts 1 avoids having to know what to say if odd numbers of options passed etc
#we don't have to decide what is an opt vs a value #we don't have to decide what is an opt vs a value
#even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block) #even if the caller provides the argument -block without a value the next function's validation will report a reasonable error because there is now nothing in $values (consumed by -block)
lassign [tcl::dict::values [punk::args::get_dict { lassign [tcl::dict::values [punk::args::parse $args withdef {
@opts -any 1 @opts -any 1
-block -default {} -block -default {}
} $args]] leaderdict opts valuedict }]] leaderdict opts valuedict
tailcall linelist {*}$opts {*}[tcl::dict::values $valuedict] tailcall linelist {*}$opts {*}[tcl::dict::values $valuedict]
} }
@ -4198,10 +4197,10 @@ tcl::namespace::eval punk::lib::system {
#get info about punk nestindex key ie type: list,dict,undetermined #get info about punk nestindex key ie type: list,dict,undetermined
# pdict devel # pdict devel
proc nestindex_info {args} { proc nestindex_info {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
-parent -default "" -parent -default ""
nestindex nestindex
} $args] }]
set opt_parent [dict get $argd opts -parent] set opt_parent [dict get $argd opts -parent]
if {$opt_parent eq ""} { if {$opt_parent eq ""} {
set parent_type undetermined set parent_type undetermined

2
src/modules/punk/lib-buildversion.txt

@ -1,3 +1,3 @@
0.1.1 0.1.2
#First line must be a semantic version number #First line must be a semantic version number
#all other lines are ignored. #all other lines are ignored.

4
src/modules/punk/mix/commandset/doc-999999.0a1.0.tm

@ -167,13 +167,13 @@ namespace eval punk::mix::commandset::doc {
cd $original_wd cd $original_wd
} }
proc validate {args} { proc validate {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::mix::commandset::doc::validate @id -id ::punk::mix::commandset::doc::validate
-- -type none -optional 1 -help "end of options marker --" -- -type none -optional 1 -help "end of options marker --"
-individual -type boolean -default 1 -individual -type boolean -default 1
@values -min 0 -max -1 @values -min 0 -max -1
patterns -default {*.man} -type any -multiple 1 patterns -default {*.man} -type any -multiple 1
} $args] }]
set opt_individual [tcl::dict::get $argd opts -individual] set opt_individual [tcl::dict::get $argd opts -individual]
set patterns [tcl::dict::get $argd values patterns] set patterns [tcl::dict::get $argd values patterns]

8
src/modules/punk/mix/commandset/layout-999999.0a1.0.tm

@ -113,14 +113,16 @@ namespace eval punk::mix::commandset::layout {
return [join $layouts \n] return [join $layouts \n]
} }
proc _default {args} { punk::args::define {
punk::args::get_dict [subst {
@id -id ::punk::mix::commandset::layout::collection::_default @id -id ::punk::mix::commandset::layout::collection::_default
@cmd -name ::punk::mix::commandset::layout::collection::_default @cmd -name ::punk::mix::commandset::layout::collection::_default
-startdir -type string -startdir -type string
-not -type string -multiple 1 -not -type string -multiple 1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
}] $args }
proc _default {args} {
punk::args::parse $args withid ::punk::mix::commandset::layout::collection::_default
set tdict_low_to_high [as_dict {*}$args] set tdict_low_to_high [as_dict {*}$args]
#convert to screen order - with higher priority at the top #convert to screen order - with higher priority at the top

15
src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm

@ -1252,9 +1252,8 @@ namespace eval punk::mix::commandset::scriptwrap {
#[para] Library API functions for punk::mix::commandset::scriptwrap #[para] Library API functions for punk::mix::commandset::scriptwrap
#[list_begin definitions] #[list_begin definitions]
punk::args::define {
proc get_wrapper_folders {args} { @id -id ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders
set argd [punk::args::get_dict {
#*** !doctools #*** !doctools
#[call [fun get_wrapper_folders] [arg args] ] #[call [fun get_wrapper_folders] [arg args] ]
#[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo #[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo
@ -1262,16 +1261,16 @@ namespace eval punk::mix::commandset::scriptwrap {
# [list_begin arguments] # [list_begin arguments]
# [arg_def string args] name-value pairs -scriptpath <path> # [arg_def string args] name-value pairs -scriptpath <path>
# [list_end] # [list_end]
@id -id ::punk::mix::commandset::scriptwrap @cmd -name punk::mix::commandset::scriptwrap::lib::get_wrapper_folders -help\
@cmd -name punk::mix::commandset::get_wrapper_folders "Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo"
@opts -anyopts 0 @opts -anyopts 0
-scriptpath -default "" -type directory\ -scriptpath -default "" -type directory\
-help "" -help ""
#todo -help folder within a punk.templates provided area??? #todo -help folder within a punk.templates provided area???
@values -minvalues 0 -maxvalues 0 @values -minvalues 0 -maxvalues 0
} $args] }
proc get_wrapper_folders {args} {
set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders]
# -- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- ---
set opt_scriptpath [dict get $argd opts -scriptpath] set opt_scriptpath [dict get $argd opts -scriptpath]

7
src/modules/punk/nav/fs-999999.0a1.0.tm

@ -726,9 +726,9 @@ tcl::namespace::eval punk::nav::fs {
# #
#if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern. #if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern.
# -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied # -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied
proc dirfiles_dict {args} { punk::args::define {
set argspecs {
@id -id ::punk::nav::fs::dirfiles_dict @id -id ::punk::nav::fs::dirfiles_dict
@cmd -name punk::nav::fs::dirfiles_dict
@opts -any 0 @opts -any 0
-searchbase -default "" -searchbase -default ""
-tailglob -default "\uFFFF" -tailglob -default "\uFFFF"
@ -737,7 +737,8 @@ tcl::namespace::eval punk::nav::fs {
-with_times -default "\uFFFF" -type string -with_times -default "\uFFFF" -type string
@values -min 0 -max -1 -type string @values -min 0 -max -1 -type string
} }
set argd [punk::args::get_dict $argspecs $args] proc dirfiles_dict {args} {
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict]
lassign [dict values $argd] leaders opts vals lassign [dict values $argd] leaders opts vals
set searchspecs [dict values $vals] set searchspecs [dict values $vals]

60
src/modules/punk/netbox-999999.0a1.0.tm

@ -1425,7 +1425,6 @@ tcl::namespace::eval punk::netbox::ipam {
NOTE: This always uses next available IPs. NOTE: This always uses next available IPs.
To create a specific IP, use api/ipam/ip-addresses endpoint. To create a specific IP, use api/ipam/ip-addresses endpoint.
The returned json is just an object if one address created, The returned json is just an object if one address created,
but a list if multiple. :/ but a list if multiple. :/
@ -1434,6 +1433,65 @@ tcl::namespace::eval punk::netbox::ipam {
] ]
::punk::netbox::system::make_rest_func ::punk::netbox::ipam::prefixes_available-ips_create api/ipam/prefixes/{id}/available-ips/ -verb post -body required ::punk::netbox::system::make_rest_func ::punk::netbox::ipam::prefixes_available-ips_create api/ipam/prefixes/{id}/available-ips/ -verb post -body required
punk::args::define {*}[list\
{
@dynamic
@id -id ::punk::netbox::ipam::prefixes_available-prefixes_list
@cmd -name punk::netbox::ipam::prefixes_available-prefixes_list -help\
"ipam_prefixes_available-prefixes_list
GET request for endpoint /ipam/prefixes/{id}/available-prefixes/"
@leaders -min 1 -max 1
apicontextid -help\
"The name of the stored api context to use.
A contextid can be created in-memory using
api_context_create, or loaded from a .toml
file using api_context_load."\
-choices {${[punk::netbox::api_context_names]}}
@opts
}\
[set ::punk::netbox::argdoc::_page_options]\
[set ::punk::netbox::argdoc::_CUSTOM_PARAMS]\
[set ::punk::netbox::argdoc::_RETURN_LISTOFDICTS]\
{
@values -min 1 -max 1
id -type integer -help\
"A unique integer value identifying this prefix"
}\
]
::punk::netbox::system::make_rest_func ::punk::netbox::ipam::prefixes_available-prefixes_list api/ipam/prefixes/{id}/available-prefixes/ -verb get -body none
punk::args::define {*}[list\
{
@dynamic
@id -id ::punk::netbox::ipam::prefixes_available-prefixes_create
@cmd -name punk::netbox::ipam::prefixes_available-prefixes_create -help\
"ipam_prefixes_available-prefixes_create
POST request for endpoint /ipam/prefixes/{id}/available-prefixes/"
@leaders -min 1 -max 1
apicontextid -help\
"The name of the stored api context to use.
A contextid can be created in-memory using
api_context_create, or loaded from a .toml
file using api_context_load."\
-choices {${[punk::netbox::api_context_names]}}
@opts
}\
[set ::punk::netbox::argdoc::_CUSTOM_PARAMS]\
[set ::punk::netbox::argdoc::_RETURN_LIST]\
{
@values -min 1 -max 2
id -type integer -help\
"A unique integer value identifying this prefix"
body -type string -default "" -help\
{
{
"prefix_length": 0
}
}
}\
]
::punk::netbox::system::make_rest_func ::punk::netbox::ipam::prefixes_available-prefixes_create api/ipam/prefixes/{id}/available-prefixes/ -verb post -body required
punk::args::define {*}[list\ punk::args::define {*}[list\
{ {
@dynamic @dynamic

639
src/modules/punk/netbox/man-999999.0a1.0.tm

@ -100,23 +100,68 @@ package require rest
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::netbox::man { tcl::namespace::eval punk::netbox::man {
namespace export {[a-z]*}
variable PUNKARGS variable PUNKARGS
namespace path ::punk::netbox
#review + ? #create ensemble further down - after sub ensembles exist
proc uri_part_decode {uripart} {
set specialMap {"[" "%5B" "]" "%5D" + " "} namespace eval contextcommands {
set seqRE {%([0-9a-fA-F]{2})} variable nextid 0
set replacement {[format "%c" [scan "\1" "%2x"]]} variable commandinfo [dict create]
set modstr [regsub -all $seqRE [string map $specialMap $uripart] $replacement] namespace export {man#*}
return [encoding convertfrom utf-8 [subst -nobackslash -novariable $modstr]] proc _cleanup {id args} {
#called by trace on command deletion (trace target must accept args even though not used)
variable commandinfo
dict unset $commandinfo $id
}
proc info {id} {
variable commandinfo
punk::netbox::api_contexts [dict get $commandinfo $id context]
}
}
punk::args::define {*}[list\
{
@dynamic
@id -id ::punk::netbox::man::new
@cmd -name punk::netbox::man::new -help\
"Create a command with the apicontextid 'curried' in.
e.g
set svr1 [man tclread new]
$svr1 status
$svr1 tenancy tenants list"
@leaders -min 1 -max 1
apicontextid -help\
"The name of the stored api context to use.
A contextid can be created in-memory using
api_context_create, or loaded from a .toml
file using api_context_load."\
-choices {${[punk::netbox::api_context_names]}}
@opts
}\
]
proc new {args} {
set argd [punk::args::parse $args withid ::punk::netbox::man::new]
set apicontextid [dict get $argd leaders apicontextid]
upvar ::punk::netbox::man::contextcommands::nextid nextid
upvar ::punk::netbox::man::contextcommands::commandinfo commandinfo
set objname "::punk::netbox::man::contextcommands::man#[incr nextid]"
dict set commandinfo $nextid context $apicontextid
set map [dict create\
about [list ::punk::netbox::man::about]\
status [list ::punk::netbox::status $apicontextid]\
info [list ::punk::netbox::man::contextcommands::info $nextid]\
destroy [list ::rename $objname ""]\
]
set nslist [punk::ns::nslist_dict ::punk::netbox::man::*]
set info [lindex $nslist 0]
set subensembles [dict get $info ensembles]
foreach se $subensembles {
#e.g ip-addresses, tenancy
dict set map $se [list ::punk::netbox::man $apicontextid $se]
} }
namespace ensemble create -command $objname -map $map
proc uri_get_querystring_as_keyval_list {uri} { trace add command $objname delete [list ::punk::netbox::man::contextcommands::_cleanup $nextid]
set parts [uri::split $uri] return $objname
set query ?[dict get $parts query]
set raw_plist [rest::parameters $query] ;#not a dict - can have repeated params (important for <name>_FILTER methods)
return [lmap v $raw_plist {uri_part_decode $v}]
} }
} }
@ -131,11 +176,11 @@ tcl::namespace::eval punk::netbox::man::prefixes {
#[list_begin definitions] #[list_begin definitions]
namespace export {[a-z]*} namespace export {[a-z]*}
namespace ensemble create namespace ensemble create -parameters {apicontextid}
variable PUNKARGS variable PUNKARGS
lappend PUNKARGS [::list\ lappend PUNKARGS [::list\
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes list"}} ::punk::netbox::ipam::prefixes_list]\ [punk::args::resolved_def -antiglobs {@leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes::list"}} ::punk::netbox::ipam::prefixes_list]\
{-RETURN -default table -choices {table tableobject list}}\ {-RETURN -default table -choices {table tableobject list}}\
{-MAXRESULTS -type integer -default -1}\ {-MAXRESULTS -type integer -default -1}\
{@values -min 0 -max 0}\ {@values -min 0 -max 0}\
@ -143,12 +188,12 @@ tcl::namespace::eval punk::netbox::man::prefixes {
#caution: must use ::list to avoid loop #caution: must use ::list to avoid loop
proc list {args} { proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes list"] set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes::list"]
set token tclread ;#todo
set urlnext "" set urlnext ""
set requests_allowed 1000 ;#review set requests_allowed 1000 ;#review
set resultlist [::list] set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set vals [dict get $argd values] set vals [dict get $argd values]
set multis [dict get $argd multis] set multis [dict get $argd multis]
@ -179,7 +224,7 @@ tcl::namespace::eval punk::netbox::man::prefixes {
set to_go [expr {$maxresults - [llength $resultlist]}] set to_go [expr {$maxresults - [llength $resultlist]}]
while {$urlnext ne "null"} { while {$urlnext ne "null"} {
if {$urlnext ne ""} { if {$urlnext ne ""} {
set urlnext_params [punk::netbox::man::uri_get_querystring_as_keyval_list $urlnext] set urlnext_params [punk::netbox::man::system::uri_get_querystring_as_keyval_list $urlnext]
if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} { if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} {
punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go
} }
@ -240,6 +285,72 @@ tcl::namespace::eval punk::netbox::man::prefixes {
#return [showdict $resultd] #return [showdict $resultd]
} }
tcl::namespace::eval available-ips {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
lappend PUNKARGS [::list\
[punk::args::resolved_def\
-antiglobs {@leaders -offset}\
-override {\
@id {-id "::punk::netbox::man::prefixes::available-ips::create"}\
-RETURN {-default table -choices {list linelist showlistofdicts}}\
@values {-min 2 -max 2}\
body {-optional 0}\
}\
::punk::netbox::ipam::prefixes_available-ips_create\
]\
]
proc create {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes::available-ips::create"]
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set valuedict [dict get $argd values]
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
set resultlist [punk::netbox::ipam::prefixes_available-ips_create $token {*}$nextopts -RETURN list {*}$vals]
switch -- $outer_return {
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
showlistofdicts {
return [punk::lib::showdict $resultlist {@*/@*.@*}]
}
jsondump {
#todo
package require huddle::json
#pretty-print via huddle (inefficient review)
set h [huddle::json::json2huddle parse $resultlist]
return [huddle::jsondump $h]
}
default {
return $resultlist
}
}
}
#lappend PUNKARGS [::list\ #lappend PUNKARGS [::list\
# [punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes available-ips_list"}} ::punk::netbox::ipam::prefixes_available-ips_list]\ # [punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes available-ips_list"}} ::punk::netbox::ipam::prefixes_available-ips_list]\
@ -247,9 +358,9 @@ tcl::namespace::eval punk::netbox::man::prefixes {
# ] # ]
lappend PUNKARGS [::list\ lappend PUNKARGS [::list\
[punk::args::resolved_def\ [punk::args::resolved_def\
-antiglobs {apicontextid @leaders -offset}\ -antiglobs {@leaders -offset}\
-override {\ -override {\
@id {-id "::punk::netbox::man::prefixes available-ips_list"}\ @id {-id "::punk::netbox::man::prefixes::available-ips::list"}\
-limit {-default 254 -help "Maximum number of entries to return"}\ -limit {-default 254 -help "Maximum number of entries to return"}\
-RETURN {-default table -choices {table tableobject list linelist}}\ -RETURN {-default table -choices {table tableobject list linelist}}\
@values {-min 1 -max 1}\ @values {-min 1 -max 1}\
@ -258,11 +369,11 @@ tcl::namespace::eval punk::netbox::man::prefixes {
]\ ]\
] ]
proc available-ips_list {args} { proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes available-ips_list"] set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes::available-ips::list"]
set token tclread ;#todo
set resultlist [::list] set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set valuedict [dict get $argd values] set valuedict [dict get $argd values]
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func
@ -337,20 +448,443 @@ tcl::namespace::eval punk::netbox::man::prefixes {
} }
}
tcl::namespace::eval available-prefixes {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
lappend PUNKARGS [::list\
[punk::args::resolved_def\
-antiglobs {@leaders -offset}\
-override {\
@id {-id "::punk::netbox::man::prefixes::available-prefixes::create"}\
-RETURN {-default table -choices {list linelist showlistofdicts}}\
@values {-min 2 -max 2}\
body {-optional 0}\
}\
::punk::netbox::ipam::prefixes_available-prefixes_create\
]\
]
proc create {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes::available-prefixes::create"]
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set valuedict [dict get $argd values]
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
set resultlist [punk::netbox::ipam::prefixes_available-prefixes_create $token {*}$nextopts -RETURN list {*}$vals]
switch -- $outer_return {
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
showlistofdicts {
return [punk::lib::showdict $resultlist {@*/@*.@*}]
}
jsondump {
#todo
package require huddle::json
#pretty-print via huddle (inefficient review)
set h [huddle::json::json2huddle parse $resultlist]
return [huddle::jsondump $h]
}
default {
return $resultlist
}
}
}
#lappend PUNKARGS [::list\
# [punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes available-ips_list"}} ::punk::netbox::ipam::prefixes_available-ips_list]\
# {-RETURN -default table -choices {table tableobject list}}
# ]
lappend PUNKARGS [::list\
[punk::args::resolved_def\
-antiglobs {@leaders -offset}\
-override {\
@id {-id "::punk::netbox::man::prefixes::available-prefixes::list"}\
-limit {-default 254 -help "Maximum number of entries to return"}\
-RETURN {-default table -choices {table tableobject list linelist}}\
@values {-min 1 -max 1}\
}\
::punk::netbox::ipam::prefixes_available-prefixes_list\
]\
]
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes::available-prefixes::list"]
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set valuedict [dict get $argd values]
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
set resultlist [punk::netbox::ipam::prefixes_available-prefixes_list $token {*}$nextopts -RETURN list {*}$vals]
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {address family vrf}]
foreach pfx $resultlist {
if {[dict exists $pfx vrf id]} {
set vrfinfo "[dict get $pfx vrf id]: [dict get $pfx vrf name]"
} else {
set vrfinfo "-"
}
set r [::list\
[dict get $pfx prefix]\
[dict get $pfx family]\
$vrfinfo\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
jsondump {
#todo
package require huddle::json
#pretty-print via huddle (inefficient review)
set h [huddle::json::json2huddle parse $result]
return [huddle::jsondump $h]
}
default {
return $resultlist
}
}
#return [showdict $resultd]
}
}
#*** !doctools #*** !doctools
#[list_end] [comment {--- end definitions namespace punk::netbox::man ---}] #[list_end] [comment {--- end definitions namespace punk::netbox::man ---}]
} }
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::netbox::man::tenancy {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
tcl::namespace::eval tenants {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
#we're overriding a resolved_def which was dynamic
# - we need to ensure the new definition is also dynamic
# - todo - override rawdef instead? (convenience functions for override of rawdef is missing in punk::args)
lappend PUNKARGS [::list\
@dynamic\
[punk::args::resolved_def\
-antiglobs {@leaders @values -RETURN}\
-override {@id {-id "::punk::netbox::man::tenancy::tenants::list"} apicontextid {-choices {${[punk::netbox::api_context_names]}}}}\
::punk::netbox::tenancy::tenants_list\
]\
{-RETURN -default table -choices {table tableobject list linelist}}\
{-MAXRESULTS -type integer -default -1}\
{@values -min 0 -max 0}\
]
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::tenancy::tenants::list"]
set urlnext ""
set requests_allowed 1000 ;#Sanity check - consider making an option - review
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set vals [dict get $argd values]
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
set maxresults [dict get $opts -MAXRESULTS]
set opts [dict remove $opts -MAXRESULTS]
set initial_pagelimit [dict get $opts -limit]
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
if {$maxresults == -1} {
set maxresults $initial_pagelimit
}
if {$maxresults < $initial_pagelimit} {
punk::netbox::man::system::dupkeylist_setfirst nextopts -limit $maxresults
}
set to_go [expr {$maxresults - [llength $resultlist]}]
while {$urlnext ne "null"} {
if {$urlnext ne ""} {
set urlnext_params [punk::netbox::man::system::uri_get_querystring_as_keyval_list $urlnext]
if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} {
punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go
}
punk::netbox::man::system::optionlistvar_sync_from_urlparams nextopts $urlnext_params
}
puts "-->next:$urlnext nextopts:$nextopts vals:$vals"
set resultd [punk::netbox::tenancy::tenants_list $token {*}$nextopts -RETURN dict {*}$vals]
set urlnext [dict get $resultd next]
set batch [dict get $resultd results]
lappend resultlist {*}$batch
set to_go [expr {$maxresults - [llength $resultlist]}]
if {$to_go <= 0} {break}
incr requests_allowed -1
if {$requests_allowed < 1} {break}
}
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {id name slug description group sites racks devices vms IPs}]
foreach ten $resultlist {
if {[dict exists $ten group id]} {
set group "[dict get $ten group id]: [dict get $ten group slug]"
} else {
set group [dict get $ten group] ;#probably null
}
set r [::list\
[dict get $ten id]\
[dict get $ten name]\
[dict get $ten slug]\
[dict get $ten description]\
$group\
[dict get $ten site_count]\
[dict get $ten rack_count]\
[dict get $ten device_count]\
[dict get $ten virtualmachine_count]\
[dict get $ten ipaddress_count]\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
default {
return $resultlist
}
}
}
}
}
tcl::namespace::eval punk::netbox::man::virtualization {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
tcl::namespace::eval virtual-machines {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
lappend PUNKARGS [::list\
[punk::args::resolved_def -antiglobs {@leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::virtualization::virtual-machines::list"}} ::punk::netbox::virtualization::virtual-machines_list]\
{-RETURN -default table -choices {table tableobject list linelist}}\
{-MAXRESULTS -type integer -default -1}\
{@values -min 0 -max 0}\
]
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::virtualization::virtual-machines::list"]
set urlnext ""
set requests_allowed 1000 ;#Sanity check - consider making an option - review
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set vals [dict get $argd values]
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
set maxresults [dict get $opts -MAXRESULTS]
set opts [dict remove $opts -MAXRESULTS]
set initial_pagelimit [dict get $opts -limit]
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
if {$maxresults == -1} {
set maxresults $initial_pagelimit
}
if {$maxresults < $initial_pagelimit} {
punk::netbox::man::system::dupkeylist_setfirst nextopts -limit $maxresults
}
set to_go [expr {$maxresults - [llength $resultlist]}]
while {$urlnext ne "null"} {
if {$urlnext ne ""} {
set urlnext_params [punk::netbox::man::system::uri_get_querystring_as_keyval_list $urlnext]
if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} {
punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go
}
punk::netbox::man::system::optionlistvar_sync_from_urlparams nextopts $urlnext_params
}
puts "-->next:$urlnext nextopts:$nextopts vals:$vals"
set resultd [punk::netbox::virtualization::virtual-machines_list $token {*}$nextopts -RETURN dict {*}$vals]
set urlnext [dict get $resultd next]
set batch [dict get $resultd results]
lappend resultlist {*}$batch
set to_go [expr {$maxresults - [llength $resultlist]}]
if {$to_go <= 0} {break}
incr requests_allowed -1
if {$requests_allowed < 1} {break}
}
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {id name site primary_ip4 tags}]
foreach vm $resultlist {
if {[dict exists $vm site id]} {
set site "[dict get $vm site id]: [dict get $vm site slug]"
} else {
set site [dict get $vm site] ;#probably null
}
if {[dict exists $vm primary_ip4 id]} {
set ip4 [dict get $vm primary_ip4 address]
} else {
set ip4 ""
}
set taglist [dict get $vm tags]
set tagblock ""
foreach taginfo $taglist {
set slug [dict get $taginfo slug]
set rgb [dict get $taginfo color]
append tagblock "[a+ Rgb#$rgb rgb#$rgb-contrasting]$slug[a] "
}
set r [::list\
[dict get $vm id]\
[dict get $vm name]\
$site\
$ip4\
$tagblock\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
default {
return $resultlist
}
}
}
}
}
tcl::namespace::eval punk::netbox::man::ip-addresses { tcl::namespace::eval punk::netbox::man::ip-addresses {
namespace export {[a-z]*} namespace export {[a-z]*}
namespace ensemble create namespace ensemble create -parameters {apicontextid}
variable PUNKARGS variable PUNKARGS
lappend PUNKARGS [::list\ lappend PUNKARGS [::list\
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::ip-addresses list"}} ::punk::netbox::ipam::ip-addresses_list]\ [punk::args::resolved_def -antiglobs {@leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::ip-addresses::list"}} ::punk::netbox::ipam::ip-addresses_list]\
{-RETURN -default table -choices {table tableobject list linelist}}\ {-RETURN -default table -choices {table tableobject list linelist}}\
{-MAXRESULTS -type integer -default -1}\ {-MAXRESULTS -type integer -default -1}\
{@values -min 0 -max 0}\ {@values -min 0 -max 0}\
@ -358,12 +892,12 @@ tcl::namespace::eval punk::netbox::man::ip-addresses {
#caution: must use ::list to avoid loop #caution: must use ::list to avoid loop
proc list {args} { proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::ip-addresses list"] set argd [punk::args::parse $args withid "::punk::netbox::man::ip-addresses::list"]
set token tclread ;#todo
set urlnext "" set urlnext ""
set requests_allowed 1000 ;#Sanity check - consider making an option - review set requests_allowed 1000 ;#Sanity check - consider making an option - review
set resultlist [::list] set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set vals [dict get $argd values] set vals [dict get $argd values]
set multis [dict get $argd multis] set multis [dict get $argd multis]
@ -394,7 +928,7 @@ tcl::namespace::eval punk::netbox::man::ip-addresses {
set to_go [expr {$maxresults - [llength $resultlist]}] set to_go [expr {$maxresults - [llength $resultlist]}]
while {$urlnext ne "null"} { while {$urlnext ne "null"} {
if {$urlnext ne ""} { if {$urlnext ne ""} {
set urlnext_params [punk::netbox::man::uri_get_querystring_as_keyval_list $urlnext] set urlnext_params [punk::netbox::man::system::uri_get_querystring_as_keyval_list $urlnext]
if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} { if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} {
punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go
} }
@ -479,7 +1013,41 @@ tcl::namespace::eval punk::netbox::man::ip-addresses {
} }
#now all sub-ensembles exist - create the ensemble for punk::netbox::man
# - we use a map to exclude any exported procs within the man namespace that don't accept the apicontextid parameter (e.g about)
tcl::namespace::eval punk::netbox::man {
namespace export {[a-z]*}
set emap [dict create\
new [list ::punk::netbox::man::new]\
status [list ::punk::netbox::status]\
]
set nslist [punk::ns::nslist_dict ::punk::netbox::man::*]
set info [lindex $nslist 0]
set subensembles [dict get $info ensembles]
foreach se $subensembles {
#e.g ip-addresses, tenancy
dict set emap $se [list ::punk::netbox::man::$se]
}
namespace ensemble create -parameters apicontextid -map $emap
}
tcl::namespace::eval punk::netbox::man::system { tcl::namespace::eval punk::netbox::man::system {
#review + ?
proc uri_part_decode {uripart} {
set specialMap {"[" "%5B" "]" "%5D" + " "}
set seqRE {%([0-9a-fA-F]{2})}
set replacement {[format "%c" [scan "\1" "%2x"]]}
set modstr [regsub -all $seqRE [string map $specialMap $uripart] $replacement]
return [encoding convertfrom utf-8 [subst -nobackslash -novariable $modstr]]
}
proc uri_get_querystring_as_keyval_list {uri} {
set parts [uri::split $uri]
set query ?[dict get $parts query]
set raw_plist [rest::parameters $query] ;#not a dict - can have repeated params (important for <name>_FILTER methods)
return [lmap v $raw_plist {uri_part_decode $v}]
}
#update/add specific members of optionlistvar params in dashed -option format from urlparams in undashed format #update/add specific members of optionlistvar params in dashed -option format from urlparams in undashed format
#members: offset,limit -> -offset,-limit #members: offset,limit -> -offset,-limit
@ -584,8 +1152,7 @@ tcl::namespace::eval punk::netbox::man {
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id "(package)punk::netbox::man" @id -id "(package)punk::netbox::man"
@package -name "punk::netbox::man" -help\ @package -name "punk::netbox::man" -help\
"Package "Management wrapper over netbox rest API"
Description"
}] }]
namespace eval argdoc { namespace eval argdoc {
@ -675,7 +1242,13 @@ namespace eval ::punk::args::register {
lappend ::punk::args::register::NAMESPACES\ lappend ::punk::args::register::NAMESPACES\
::punk::netbox::man\ ::punk::netbox::man\
::punk::netbox::man::prefixes\ ::punk::netbox::man::prefixes\
::punk::netbox::man::ip-addresses ::punk::netbox::man::prefixes::available-ips\
::punk::netbox::man::prefixes::available-prefixes\
::punk::netbox::man::ip-addresses\
::punk::netbox::man::tenancy\
::punk::netbox::man::tenancy::tenants\
::punk::netbox::man::virtualization\
::punk::netbox::man::virtualization::virtual-machines\
} }
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------

1070
src/modules/punk/ns-999999.0a1.0.tm

File diff suppressed because it is too large Load Diff

14
src/modules/punk/repo-999999.0a1.0.tm

@ -100,8 +100,12 @@ namespace eval punk::repo {
subcommand -type string -choicecolumns 8 -choicegroups { subcommand -type string -choicecolumns 8 -choicegroups {
"frequently used commands" {${$maincommands}} "frequently used commands" {${$maincommands}}
"" {${$othercmds}} "" {${$othercmds}}
} } -choiceinfo {add {{doctype punkargs}} diff {{doctype punkargs}}}
}] }]
#-choiceinfo {
# add {{doctype punkargs}}
# diff {{doctype punkargs}}
#}
return $result return $result
} }
@ -112,7 +116,7 @@ namespace eval punk::repo {
# @id -id ::punk::repo::fossil_proxy # @id -id ::punk::repo::fossil_proxy
# @cmd -name fossil -help "fossil executable # @cmd -name fossil -help "fossil executable
# " # "
# @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # @formdisplay -header "fossil help" -body {${[runout -n fossil help]}}
# } ""] # } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
@ -129,7 +133,7 @@ namespace eval punk::repo {
@dynamic @dynamic
@id -id "::punk::repo::fossil_proxy diff" @id -id "::punk::repo::fossil_proxy diff"
@cmd -name "fossil diff" -help "fossil diff" @cmd -name "fossil diff" -help "fossil diff"
@argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} @formdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}}
} ""] } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
#todo - remove this comment - testing dynamic directive #todo - remove this comment - testing dynamic directive
@ -137,7 +141,7 @@ namespace eval punk::repo {
@id -id "::punk::repo::fossil_proxy add" @id -id "::punk::repo::fossil_proxy add"
@cmd -name "fossil add" -help "fossil add @cmd -name "fossil add" -help "fossil add
" "
@argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
} ""] } ""]
#TODO #TODO
#lappend PUNKARGS [list { #lappend PUNKARGS [list {
@ -145,7 +149,7 @@ namespace eval punk::repo {
# @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs}
# @cmd -name "fossil add" -help "fossil add # @cmd -name "fossil add" -help "fossil add
# " # "
# @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} # @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
# } ""] # } ""]
lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"} lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"}
lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"} lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"}

107
src/modules/punk/zip-999999.0a1.0.tm

@ -168,19 +168,7 @@ tcl::namespace::eval punk::zip {
expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) expr {(($year-1980) << 25) | ($month << 21) | ($day << 16)
| ($hour << 11) | ($min << 5) | ($sec >> 1)} | ($hour << 11) | ($min << 5) | ($sec >> 1)}
} }
punk::args::define {
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::get_dict {
@id -id ::punk::zip::walk @id -id ::punk::zip::walk
@cmd -name punk::zip::walk -help\ @cmd -name punk::zip::walk -help\
"Walk the directory structure starting at base/<-subpath> "Walk the directory structure starting at base/<-subpath>
@ -206,7 +194,19 @@ tcl::namespace::eval punk::zip {
@values -min 1 -max -1 @values -min 1 -max -1
base base
fileglobs -default {*} -multiple 1 fileglobs -default {*} -multiple 1
} $args] }
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::parse $args withid ::punk::zip::walk]
set base [dict get $argd values base] set base [dict get $argd values base]
set fileglobs [dict get $argd values fileglobs] set fileglobs [dict get $argd values fileglobs]
set subpath [dict get $argd opts -subpath] set subpath [dict get $argd opts -subpath]
@ -416,19 +416,7 @@ tcl::namespace::eval punk::zip {
# Addentry - was Mkzipfile -- punk::args::define {
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::get_dict {
@id -id ::punk::zip::Addentry @id -id ::punk::zip::Addentry
@cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan' @cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan'
return a central directory file record" return a central directory file record"
@ -440,8 +428,21 @@ tcl::namespace::eval punk::zip {
path -type file -help "path of file to add" path -type file -help "path of file to add"
zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe
Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'" Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'"
} $args] }
# Addentry - was Mkzipfile --
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::parse $args withid ::punk::zip::Addentry]
set zipchan [dict get $argd values zipchan] set zipchan [dict get $argd values zipchan]
set base [dict get $argd values base] set base [dict get $argd values base]
set path [dict get $argd values path] set path [dict get $argd values path]
@ -558,30 +559,8 @@ tcl::namespace::eval punk::zip {
# we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip) # we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip)
#### ####
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::get_dict { punk::args::define {
@id -id ::punk::zip::mkzip @id -id ::punk::zip::mkzip
@cmd -name punk::zip::mkzip\ @cmd -name punk::zip::mkzip\
-help "Create a zip archive in 'filename'" -help "Create a zip archive in 'filename'"
@ -623,8 +602,32 @@ tcl::namespace::eval punk::zip {
globs -default {*} -multiple 1\ globs -default {*} -multiple 1\
-help "list of glob patterns to match. -help "list of glob patterns to match.
Only directories with matching files will be included in the archive." Only directories with matching files will be included in the archive."
} $args] }
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::parse $args withid ::punk::zip::mkzip]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
if {$filename eq ""} { if {$filename eq ""} {
error "mkzip filename cannot be empty string" error "mkzip filename cannot be empty string"

128
src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/args.test

@ -0,0 +1,128 @@
package require tcltest
namespace eval ::testspace {
namespace import ::tcltest::*
variable common {
set result ""
}
test parse_withdef_leaders_min_max {Test anonymous leaders with @leaders -min and -max}\
-setup $common -body {
set argd [punk::args::parse {a b c d} withdef {@leaders -min 1 -max 3} ]
lappend result [dict get $argd leaders]
lappend result [dict get $argd values]
}\
-cleanup {
}\
-result [list\
{0 a 1 b 2 c} {3 d}
]
test parse_withdef_leaders_ordering_defaults {Test ordering of leaders when some have defaults}\
-setup $common -body {
set argd [punk::args::parse {a b} withdef @leaders x {y -default 1}]
set vals [dict get $argd leaders]
set result $vals
}\
-cleanup {
}\
-result [list\
x a y b
]
test parse_withdef_option_ordering_defaults {Test ordering of options when some have defaults}\
-setup $common -body {
#for consistency with leaders and values dicts - try to maintain definition order for options too
set argd [punk::args::parse {-x a -y b} withdef @opts -x {-y -default 1}]
set vals [dict get $argd opts]
set result $vals
}\
-cleanup {
}\
-result [list\
-x a -y b
]
test parse_withdef_option_ordering_defaults2 {Test ordering of options when some have defaults and -any is true}\
-setup $common -body {
#for consistency with leaders and values dicts - try to maintain definition order for options too
set argd [punk::args::parse {-blah etc -x a -y b -solo -z c} withdef {@opts -any 1} -x {-y -default 1} {-solo -type none} -z]
set vals [dict get $argd opts]
set result $vals
}\
-cleanup {
}\
-result [list\
-x a -y b -solo 1 -z c -blah etc
]
test parse_withdef_values_ordering_defaults {Test ordering of values when some have defaults}\
-setup $common -body {
set argd [punk::args::parse {a b} withdef @values x {y -default 1}]
set vals [dict get $argd values]
set result $vals
}\
-cleanup {
}\
-result [list\
x a y b
]
test parse_withdef_leader_min_max {Test unnamed leaders with -min and -max}\
-setup $common -body {
#should not error - should allocate d to values
set argd [punk::args::parse {a b c d} withdef {@leaders -min 1 -max 4} {@values -min 1 -max 1}]
lappend result [dict get $argd leaders]
lappend result [dict get $argd values]
}\
-cleanup {
}\
-result [list\
{0 a 1 b 2 c} {3 d}
]
test parse_withdef_leader_stride {Test stride leaders}\
-setup $common -body {
#see for example ::tcl::dict::create which has a stride of 2
set argd [punk::args::parse {k v e k1 v1 k2 v2} withdef {@leaders} {"key val etc" -multiple 0} {"key val" -multiple 1} {@values -min 0 -max 0}]
lappend result [dict get $argd leaders]
}\
-cleanup {
}\
-result [list\
{{key val etc} {k v e} {key val} {{k1 v1} {k2 v2}}}
]
test parse_withdef_value_stride {Test stride values}\
-setup $common -body {
#see for example ::tcl::dict::create which has a stride of 2
set argd [punk::args::parse {k v e k1 v1 k2 v2} withdef {@values} {"key val etc" -multiple 0} {"key val" -multiple 1}]
lappend result [dict get $argd values]
}\
-cleanup {
}\
-result [list\
{{key val etc} {k v e} {key val} {{k1 v1} {k2 v2}}}
]
test parse_withdef_value_stride_error {Test stride values with error due to not enough args for stride}\
-setup $common -body {
#see for example ::tcl::dict::create which has a stride of 2
if {[catch {punk::args::parse {k v} withdef {@values} {"key val etc" -multiple 0}} emsg eopts]} {
set expected [dict get $eopts -errorcode]
if {[lindex $expected 0] eq "PUNKARGS" && [lindex $expected 1] eq "VALIDATION" && [lindex $expected 2 0] eq "stridevaluecount"} {
lappend result "RECEIVED_EXPECTED_ERROR"
} else {
lappend result "WRONG_ERROR_RECEIVED - $expected (expected PUNKARGS VALIDATION {stridevaluecount ...} ..."
}
} else {
lappend result "MISSING_REQUIRED_ERROR"
}
}\
-cleanup {
}\
-result [list\
"RECEIVED_EXPECTED_ERROR"
]
}

125
src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/define.test

@ -0,0 +1,125 @@
package require tcltest
namespace eval ::testspace {
namespace import ::tcltest::*
variable common {
set result ""
}
test define_tstr_template1 {Test basic tstr substitution finds vars in namespace in which define was called}\
-setup $common -body {
namespace eval whatever {
set plus +++
set minus ---
punk::args::define {
@id -id ::testspace::test1
@values
param -type string -default "${$plus}XXX${$minus}YYY"
}
}
set argd [punk::args::parse {} withid ::testspace::test1]
set vals [dict get $argd values]
lappend result [dict get $vals param]
}\
-cleanup {
namespace delete ::testspace::whatever
}\
-result [list\
+++XXX---YYY
]
test define_tstr_template2 {Test basic tstr substitution when @dynamic}\
-setup $common -body {
namespace eval whatever {
set plus +++
set minus ---
punk::args::define {
@dynamic
@id -id ::testspace::test2
@values
param -type string -default "${$plus}XXX${$minus}YYY"
}
}
set argd [punk::args::parse {} withid ::testspace::test2]
puts ">>>>define_tstr_template2 argd:$argd"
set vals [dict get $argd values]
lappend result [dict get $vals param]
}\
-cleanup {
namespace delete ::testspace::whatever
}\
-result [list\
+++XXX---YYY
]
test define_tstr_template3 {Test double tstr substitution when @dynamic}\
-setup $common -body {
variable test_list
set test_list {A B C}
proc ::testspace::get_list {} {
variable test_list
return $test_list
}
namespace eval whatever {
set plus +++
set minus ---
set DYN_LIST {${[::testspace::get_list]}}
set DYN_CLOCKSECONDS {${[clock seconds]}}
punk::args::define {
@dynamic
@id -id ::testspace::test2
@values
param1 -type string -default "${$plus}XXX${$minus}YYY"
param2 -type list -default "${$DYN_LIST}"
param3 -type string -default "${[clock seconds]}"
param4 -type string -default "${$DYN_CLOCKSECONDS}"
}
}
set argd [punk::args::parse {} withid ::testspace::test2]
set vals [dict get $argd values]
lappend result [dict get $vals param1]
lappend result [dict get $vals param2]
set c1_at_define [dict get $vals param3]
set c1_at_resolve [dict get $vals param4]
#update test_list to ensure parse is actually dynamic
set ::testspace::test_list {X Y Z}
#update plus - should not affect output as it is resolved at define time
set ::testspace::whatever::plus "new+"
#unset minus - should not cause error
unset ::testspace::whatever::minus
after 1100 ;#ensure more than 1 sec apart
set argd [punk::args::parse {} withid ::testspace::test2]
set vals [dict get $argd values]
lappend result [dict get $vals param1]
lappend result [dict get $vals param2]
set c2_at_define [dict get $vals param3]
set c2_at_resolve [dict get $vals param4]
if {$c1_at_define == $c2_at_define} {
lappend result "OK_define_time_var_match"
} else {
lappend result "UNEXPECTED_define_time_var_mismatch"
}
if {$c1_at_resolve < $c2_at_resolve} {
lappend result "OK_resolve_time_2_greater"
} else {
lappend result "UNEXPECTED_resolve_time_2_not_greater"
}
}\
-cleanup {
namespace delete ::testspace::whatever
}\
-result [list\
+++XXX---YYY {A B C} +++XXX---YYY {X Y Z} OK_define_time_var_match OK_resolve_time_2_greater
]
}

60
src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/args/synopsis.test

@ -0,0 +1,60 @@
package require tcltest
namespace eval ::testspace {
namespace import ::tcltest::*
namespace import ::punk::ansi::a+ ::punk::ansi::a
variable common {
set result ""
}
test synopsis_basic {test basic synopsis of punkargs definition}\
-setup $common -body {
namespace eval testns {
punk::args::define {
@id -id ::testspace::testns::t1
@leaders
a1 -optional 0
@opts
-o1 -type boolean
@values
v1 -optional 1
}
}
lappend result [punk::ns::synopsis ::testspace::testns::t1]
}\
-cleanup {
namespace delete ::testspace::testns
}\
-result [list\
"::testspace::testns::t1 [a+ italic]a1[a] ?-o1 <bool>? ?[a+ italic]v1[a]?"
]
test synopsis_basic_ensemble-like {test basic synopsis of punkargs ensemble-like definition}\
-setup $common -body {
namespace eval testns {
punk::args::define {
@id -id ::testspace::testns::t1
@leaders -min 1
subcmd -default c1 -choices {c1 c2}
@values -min 0 -max 0
}
punk::args::define {
@id -id "::testspace::testns::t1 c1"
@values -min 0 -max 1
v1 -type string
}
}
lappend result [punk::ns::synopsis ::testspace::testns::t1]
lappend result [punk::ns::synopsis ::testspace::testns::t1 c1]
}\
-cleanup {
namespace delete ::testspace::testns
}\
-result [list\
"::testspace::testns::t1 [a+ italic]subcmd[a]"\
"::testspace::testns::t1 c1 [a+ italic]v1[a]"
]
}

0
src/modules/test/punk/#modpod-args-999999.0a1.0/args-0.1.5_testsuites/tests/args.test#..+args+args.test.fauxlink

226
src/modules/test/punk/#modpod-args-999999.0a1.0/args-999999.0a1.0.tm

@ -0,0 +1,226 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2025
#
# @@ Meta Begin
# Application test::punk::args 999999.0a1.0
# Meta platform tcl
# Meta license MIT
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin shellspy_module_test::punk::args 0 999999.0a1.0]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require test::punk::args]
#[keywords module]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of test::punk::args
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by test::punk::args
#[list_begin itemized]
package require Tcl 8.6-
#*** !doctools
#[item] [package {Tcl 8.6}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
tcl::namespace::eval test::punk::args {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection {Namespace test::punk::args}]
#[para] Core API functions for test::punk::args
#[list_begin definitions]
variable PUNKARGS
variable pkg test::punk::args
variable version
set version 999999.0a1.0
package require packageTest
packageTest::makeAPI test::punk::args $version punk::args; #will package provide test::punk::args $version
package forget punk::args
package require punk::args
#*** !doctools
#[list_end] [comment {--- end definitions namespace test::punk::args ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
#tcl::namespace::eval test::punk::args::system {
#*** !doctools
#[subsection {Namespace test::punk::args::system}]
#[para] Internal functions that are not part of the API
#}
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval test::punk::args {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)test::punk::args"
@package -name "test::punk::args" -help\
"Package
Description"
}]
namespace eval argdoc {
#namespace for custom argument documentation
proc package_name {} {
return test::punk::args
}
proc about_topics {} {
#info commands results are returned in an arbitrary order (like array keys)
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
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]
}
proc default_topics {} {return [list Description *]}
# -------------------------------------------------------------
# get_topic_ functions add more to auto-include in about topics
# -------------------------------------------------------------
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package test::punk::args
test suite for punk::args
} \n]
}
proc get_topic_License {} {
return "MIT"
}
proc get_topic_Version {} {
return "$::test::punk::args::version"
}
proc get_topic_Contributors {} {
set authors {{<julian@precisium.com> Julian Noble}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_custom-topic {} {
punk::args::lib::tstr -return string {
A custom
topic
etc
}
}
# -------------------------------------------------------------
}
# we re-use the argument definition from punk::args::standard_about and override some items
set overrides [dict create]
dict set overrides @id -id "::test::punk::args::about"
dict set overrides @cmd -name "test::punk::args::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About test::punk::args
}] \n]
dict set overrides topic -choices [list {*}[test::punk::args::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [test::punk::args::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
set argd [punk::args::parse $args withid ::test::punk::args::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::test::punk::args::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
# variable PUNKARGS
# variable PUNKARGS_aliases
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::test::punk::args
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide test::punk::args [tcl::namespace::eval test::punk::args {
variable pkg test::punk::args
variable version
set version 999999.0a1.0
}]
return
#*** !doctools
#[manpage_end]

3
src/modules/test/punk/args-buildversion.txt

@ -0,0 +1,3 @@
0.1.5
#First line must be a semantic version number
#all other lines are ignored.

74
src/modules/textblock-999999.0a1.0.tm

@ -140,7 +140,8 @@ tcl::namespace::eval textblock {
# hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\
# "algorithm choice" # "algorithm choice"
namespace eval argdoc {
set DYN_HASH_ALGORITHM_CHOICES_AND_HELP {$[::textblock::argdoc::hash_algorithm_choices_and_help]}
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::textblock::use_hash @id -id ::textblock::use_hash
@ -149,7 +150,8 @@ tcl::namespace::eval textblock {
'none' may be slightly faster but less compact 'none' may be slightly faster but less compact
when viewing textblock::framecache" when viewing textblock::framecache"
@values -min 0 -max 1 @values -min 0 -max 1
hash_algorithm -optional 1 ${[::textblock::argdoc::hash_algorithm_choices_and_help]} hash_algorithm -optional 1 ${$DYN_HASH_ALGORITHM_CHOICES_AND_HELP}
}
} }
proc use_hash {args} { proc use_hash {args} {
#set argd [punk::args::get_by_id ::textblock::use_hash $args] #set argd [punk::args::get_by_id ::textblock::use_hash $args]
@ -4667,17 +4669,19 @@ tcl::namespace::eval textblock {
-size -type integer\ -size -type integer\
-default 15\ -default 15\
-optional 1\ -optional 1\
-range {1 15} -range {1 ""}
-direction -default horizontal\ -direction -default horizontal\
-choices {horizontal vertical}\ -choices {horizontal vertical}\
-help\ -help\
"When rainbow is in the colour list, "Direction of character increments.
this also affects the direction of When rainbow is in the colour list,
colour changes" the colour stripes will be oriented
@values -min 0 -max 2 in this direction.
"
@values -min 0 -max 1
colour -type list -default {} -optional 1 -help\ colour -type list -default {} -optional 1 -help\
"List of Ansi colour names "List of Ansi colour names
e.g. testblock 10 {white Red} e.g. testblock -size 10 {white Red}
produces a block of character 10x10 produces a block of character 10x10
with white text on red bacground with white text on red bacground
@ -4725,7 +4729,16 @@ tcl::namespace::eval textblock {
set chars [list {*}[punk::lib::range 1 9] A B C D E F] set chars [list {*}[punk::lib::range 1 9] A B C D E F]
if {$size <= 15} {
set charsubset [lrange $chars 0 $size-1] set charsubset [lrange $chars 0 $size-1]
} else {
set numsets [expr {int(ceil($size / 15.0))}]
set longset [concat {*}[lrepeat $numsets $chars]]
set charsubset [lrange $longset 0 $size-1]
set longbows [concat {*}[lrepeat $numsets $rainbow_list]]
set rainbow_list [lrange $longbows 0 $size-1]
}
if {"noreset" in $colour} { if {"noreset" in $colour} {
set RST "" set RST ""
} else { } else {
@ -4760,23 +4773,34 @@ tcl::namespace::eval textblock {
append row $c append row $c
} }
append row $RST append row $RST
append block $row\n append block $row \n
} }
set block [tcl::string::trimright $block \n] set block [tcl::string::trimright $block \n]
return $block return $block
} else { } else {
if {$direction eq "vertical"} {
#row first - #row first -
set rows [list] set rows [list]
foreach ch $charsubset { foreach ch $charsubset {
lappend rows [tcl::string::repeat $ch $size] lappend rows [tcl::string::repeat $ch $size]
} }
set block [::join $rows \n] set block [::join $rows \n]
if {$colour ne ""} { if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST
}
return $block
} else {
set block ""
for {set r 0} {$r < $size} {incr r} {
append block [::join $charsubset ""] \n
}
if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST set block [a+ {*}$colour]$block$RST
} }
return $block return $block
} }
} }
}
interp alias {} testblock {} textblock::testblock interp alias {} testblock {} textblock::testblock
#todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table #todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table
@ -5500,10 +5524,11 @@ tcl::namespace::eval textblock {
proc ::textblock::join1 {args} { proc ::textblock::join1 {args} {
lassign [punk::args::get_dict { lassign [punk::args::parse $args withdef {
@id -id ::textblock::join1
-ansiresets -default 1 -type integer -ansiresets -default 1 -type integer
blocks -type string -multiple 1 blocks -type string -multiple 1
} $args] _l leaders _o opts _v values }] _l leaders _o opts _v values
set blocks [tcl::dict::get $values blocks] set blocks [tcl::dict::get $values blocks]
set idx 0 set idx 0
@ -5578,11 +5603,12 @@ tcl::namespace::eval textblock {
#@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width. #@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width.
# Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner # Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner
#" #"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::textblock::join_basic2
-- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags" -- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags"
-ansiresets -type any -default auto -ansiresets -type any -default auto
blocks -type any -multiple 1 blocks -type any -multiple 1
} $args] }]
set ansiresets [tcl::dict::get $argd opts -ansiresets] set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks] set blocks [tcl::dict::get $argd values blocks]
@ -5619,12 +5645,6 @@ tcl::namespace::eval textblock {
#for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed #for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed
#they may however still be 'ragged' ie differing line lengths #they may however still be 'ragged' ie differing line lengths
proc ::textblock::join {args} { proc ::textblock::join {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
#we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets #we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets
@ -5709,11 +5729,6 @@ tcl::namespace::eval textblock {
} }
proc ::textblock::join2 {args} { proc ::textblock::join2 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5801,11 +5816,6 @@ tcl::namespace::eval textblock {
} }
# This calls textblock::pad per cell :/ # This calls textblock::pad per cell :/
proc ::textblock::join3 {args} { proc ::textblock::join3 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5984,7 +5994,7 @@ tcl::namespace::eval textblock {
NOTE: more options available - argument definition NOTE: more options available - argument definition
is incomplete" is incomplete"
@opts @opts
-return -choices {table tableobject} -return -default table -choices {table tableobject}
-rows -type list -default "" -help\ -rows -type list -default "" -help\
"A list of lists. "A list of lists.
Each toplevel element represents a row. Each toplevel element represents a row.
@ -6213,7 +6223,7 @@ tcl::namespace::eval textblock {
-help "restrict to keys matching memberglob." -help "restrict to keys matching memberglob."
}] }]
#append spec \n "frametype -help \"A predefined \"" #append spec \n "frametype -help \"A predefined \""
punk::args::get_dict $spec $args punk::args::parse $args withdef $spec
return return
} }

4
src/project_layouts/custom/_project/punk.basic/src/make.tcl

@ -2044,6 +2044,10 @@ if {[file exists $mapfile]} {
} }
# -- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --" puts "-- runtime_vfs_map --"
set ver [package require punk::args]
puts "punk::args ver: $ver"
set ifneeded [package ifneeded punk::args $ver]
puts "punk::args ifneeded: $ifneeded"
punk::lib::pdict runtime_vfs_map punk::lib::pdict runtime_vfs_map
puts "---------------------" puts "---------------------"
puts "-- vfs_runtime_map--" puts "-- vfs_runtime_map--"

16
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm

@ -278,7 +278,7 @@ namespace eval argparsingtest {
proc test1_punkargs {args} { proc test1_punkargs {args} {
set argd [punk::args::parse $args withdef { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs @id -id ::argparsingtest::test1_punkargs
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -298,7 +298,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::test1_punkargs_by_id @id -id ::test1_punkargs_by_id
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -320,7 +320,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::argparsingtest::test1_punkargs2 @id -id ::argparsingtest::test1_punkargs2
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -342,9 +342,9 @@ namespace eval argparsingtest {
proc test1_punkargs_validate_ansistripped {args} { proc test1_punkargs_validate_ansistripped {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs_validate_ansistripped @id -id ::argparsingtest::test1_punkargs_validate_ansistripped
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -choices {string object} -help "return type" -return -default string -type string -choices {string object} -help "return type"
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -358,7 +358,7 @@ namespace eval argparsingtest {
-2 -default 2 -type integer -validate_ansistripped true -2 -default 2 -type integer -validate_ansistripped true
-3 -default 3 -type integer -validate_ansistripped true -3 -default 3 -type integer -validate_ansistripped true
@values @values
} $args] }]
return [tcl::dict::get $argd opts] return [tcl::dict::get $argd opts]
} }
@ -465,7 +465,7 @@ namespace eval argparsingtest {
#multiline values use first line of each record to determine amount of indent to trim #multiline values use first line of each record to determine amount of indent to trim
proc test_multiline {args} { proc test_multiline {args} {
set t3 [textblock::frame t3] set t3 [textblock::frame t3]
set argd [punk::args::get_dict [subst { set argd [punk::args::parse $args withdef [subst {
-template1 -default { -template1 -default {
****** ******
* t1 * * t1 *
@ -491,7 +491,7 @@ namespace eval argparsingtest {
" "
-flag -default 0 -type boolean -flag -default 0 -type boolean
}] $args] }]]
return $argd return $argd
} }

6
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/commandstack-0.3.tm

@ -99,8 +99,11 @@ namespace eval commandstack {
} }
} }
proc get_stack {command} { proc get_stack {{command ""}} {
variable all_stacks variable all_stacks
if {$command eq ""} {
return $all_stacks
}
set command [uplevel 1 [list namespace which $command]] set command [uplevel 1 [list namespace which $command]]
if {[dict exists $all_stacks $command]} { if {[dict exists $all_stacks $command]} {
return [dict get $all_stacks $command] return [dict get $all_stacks $command]
@ -116,6 +119,7 @@ namespace eval commandstack {
variable all_stacks variable all_stacks
if {[dict exists $all_stacks $command]} { if {[dict exists $all_stacks $command]} {
set stack [dict get $all_stacks $command] set stack [dict get $all_stacks $command]
#stack is a list of dicts, 1st entry is token {<cmd> <renamer> <tokenid>}
set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]] set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]]
if {$posn > -1} { if {$posn > -1} {
set record [lindex $stack $posn] set record [lindex $stack $posn]

25
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/modpod-0.1.3.tm

@ -134,12 +134,12 @@ namespace eval modpod {
#old tar connect mechanism - review - not needed? #old tar connect mechanism - review - not needed?
proc connect {args} { proc connect {args} {
puts stderr "modpod::connect--->>$args" puts stderr "modpod::connect--->>$args"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::connect @id -id ::modpod::connect
-type -default "" -type -default ""
@values -min 1 -max 1 @values -min 1 -max 1
path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)" path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)"
} $args] }]
catch { catch {
punk::lib::showdict $argd ;#heavy dependencies punk::lib::showdict $argd ;#heavy dependencies
} }
@ -168,7 +168,7 @@ namespace eval modpod {
} else { } else {
#connect to .tm but may still be unwrapped version available #connect to .tm but may still be unwrapped version available
lassign [::split [file rootname [file tail $modpodath]] -] connected(package,$modpodpath) connected(version,$modpodpath) lassign [::split [file rootname [file tail $modpodpath]] -] connected(package,$modpodpath) connected(version,$modpodpath)
set this_pkg_tm_folder [file dirname $modpodpath] set this_pkg_tm_folder [file dirname $modpodpath]
if {$connected(type,$modpodpath) ne "unwrapped"} { if {$connected(type,$modpodpath) ne "unwrapped"} {
#Not directly connected to unwrapped version - but may still be redirected there #Not directly connected to unwrapped version - but may still be redirected there
@ -225,11 +225,15 @@ namespace eval modpod {
if {$connected(startdata,$modpodpath) >= 0} { if {$connected(startdata,$modpodpath) >= 0} {
#verify we have a valid tar header #verify we have a valid tar header
if {![catch {::modpod::system::tar::readHeader [red $fh 512]}]} { if {![catch {::modpod::system::tar::readHeader [read $fh 512]}]} {
seek $fh $connected(startdata,$modpodpath) start seek $fh $connected(startdata,$modpodpath) start
return [list ok $fh] return [list ok $fh]
} else { } else {
#error "cannot verify tar header" #error "cannot verify tar header"
#try zipfs
if {[info commands tcl::zipfs::mount] ne ""} {
}
} }
} }
lpop connected(to) end lpop connected(to) end
@ -262,11 +266,12 @@ namespace eval modpod {
return 1 return 1
} }
proc get {args} { proc get {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::get
-from -default "" -help "path to pod" -from -default "" -help "path to pod"
*values -min 1 -max 1 @values -min 1 -max 1
filename filename
} $args] }]
set frompod [dict get $argd opts -from] set frompod [dict get $argd opts -from]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
@ -329,7 +334,7 @@ namespace eval modpod::lib {
#zipfile is a pure zip at this point - ie no script/exe header #zipfile is a pure zip at this point - ie no script/exe header
proc make_zip_modpod {args} { proc make_zip_modpod {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::lib::make_zip_modpod @id -id ::modpod::lib::make_zip_modpod
-offsettype -default "archive" -choices {archive file} -help\ -offsettype -default "archive" -choices {archive file} -help\
"Whether zip offsets are relative to start of file or start of zip-data within the file. "Whether zip offsets are relative to start of file or start of zip-data within the file.
@ -340,7 +345,7 @@ namespace eval modpod::lib {
@values -min 2 -max 2 @values -min 2 -max 2
zipfile -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries" zipfile -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries"
outfile -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm" outfile -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm"
} $args] }]
set zipfile [dict get $argd values zipfile] set zipfile [dict get $argd values zipfile]
set outfile [dict get $argd values outfile] set outfile [dict get $argd values outfile]
set opt_offsettype [dict get $argd opts -offsettype] set opt_offsettype [dict get $argd opts -offsettype]
@ -359,7 +364,7 @@ namespace eval modpod::lib {
set moddir [file dirname $modfile] set moddir [file dirname $modfile]
set mod_and_ver [file rootname [file tail $modfile]] set mod_and_ver [file rootname [file tail $modfile]]
lassign [split $mod_and_ver -] moduletail version lassign [split $mod_and_ver -] moduletail version
if {[file exists $moddir/#modpod-$mod_and_ver.tm]} { if {[file exists $moddir/#modpod-$mod_and_ver]} {
source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm
} else { } else {
#determine module namespace so we can mount appropriately #determine module namespace so we can mount appropriately

1
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm

@ -135,6 +135,7 @@ tcl::namespace::eval punk::aliascore {
smcup ::punk::console::enable_alt_screen\ smcup ::punk::console::enable_alt_screen\
rmcup ::punk::console::disable_alt_screen\ rmcup ::punk::console::disable_alt_screen\
config ::punk::config\ config ::punk::config\
s ::punk::ns::synopsis\
] ]
#*** !doctools #*** !doctools

14
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -3465,26 +3465,26 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
foreach {pt code} $parts { foreach {pt code} $parts {
switch -- [llength $codestack] { switch -- [llength $codestack] {
0 { 0 {
append emit $base$pt$R append emit $base $pt $R
} }
1 { 1 {
if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} { if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} {
append emit $base$pt$R append emit $base $pt $R
set codestack [list] set codestack [list]
} else { } else {
#append emit [lindex $o_codestack 0]$pt #append emit [lindex $o_codestack 0]$pt
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
default { default {
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
@ -3528,7 +3528,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append emit $code append emit $code
} }
} }
return $emit$R return [append emit $R]
} else { } else {
return $base$text$R return $base$text$R
} }

6400
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.6.tm

File diff suppressed because it is too large Load Diff

6458
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.7.tm

File diff suppressed because it is too large Load Diff

48
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@ -250,16 +250,11 @@ namespace eval punk::cap::handlers::templates {
namespace export * namespace export *
namespace eval class { namespace eval class {
variable PUNKARGS variable PUNKARGS
#set argd [punk::args::get_dict { #lappend PUNKARGS [list {
# @id -id "::punk::cap::handlers::templates::class::api folders" # @id -id "::punk::cap::handlers::templates::class::api folders"
# -startdir -default "" # -startdir -default ""
# @values -max 0 # @values -max 0
#} $args] #}]
lappend PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
-startdir -default ""
@values -max 0
}]
oo::class create api { oo::class create api {
#return a dict keyed on folder with source pkg as value #return a dict keyed on folder with source pkg as value
@ -269,9 +264,18 @@ namespace eval punk::cap::handlers::templates {
set cname [string map {. _} $capname] set cname [string map {. _} $capname]
set capabilityname $capname set capabilityname $capname
} }
set class_ns [uplevel 1 [list namespace current]]
lappend ${class_ns}::PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
@cmd -name "punk::cap::handlers::templates::class::api folders"
-startdir -default "" -help\
"Defaults to CWD if not supplied"
@values -max 0
}]
method folders {args} { method folders {args} {
#puts "--folders $args" #puts "--folders $args"
set argd [punk::args::parse $args withid "::punk::cap::handlers::templates::class::api folders"] set argd [punk::args::parse $args withid "[self class] folders"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set opt_startdir [dict get $opts -startdir] set opt_startdir [dict get $opts -startdir]
@ -488,14 +492,19 @@ namespace eval punk::cap::handlers::templates {
} }
return $folderdict return $folderdict
} }
method get_itemdict_projectlayouts {args} { lappend ${class_ns}::PUNKARGS [list {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts" @id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts"
@cmd -name "punk::cap::handlers::templates::class::api get_itemdict_projectlayouts " -help\
""
@opts -anyopts 1 @opts -anyopts 1
#peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here #peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here
-startdir -default "" -startdir -default ""
@values -maxvalues -1 @values -maxvalues -1
} $args] }]
method get_itemdict_projectlayouts {args} {
set argd [punk::args::parse $args withid "[self class] get_itemdict_projectlayouts"]
set opt_startdir [dict get $argd opts -startdir] set opt_startdir [dict get $argd opts -startdir]
if {$opt_startdir eq ""} { if {$opt_startdir eq ""} {
@ -663,12 +672,7 @@ namespace eval punk::cap::handlers::templates {
my _get_itemdict {*}$arglist my _get_itemdict {*}$arglist
} }
#shared algorithm for get_itemdict_* methods lappend ${class_ns}::PUNKARGS [list {
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api _get_itemdict" @id -id "::punk::cap::handlers::templates::class::api _get_itemdict"
@cmd -name _get_itemdict @cmd -name _get_itemdict
@opts -anyopts 0 @opts -anyopts 0
@ -679,7 +683,15 @@ namespace eval punk::cap::handlers::templates {
-not -default "" -multiple 1 -not -default "" -multiple 1
@values -maxvalues -1 @values -maxvalues -1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
} $args] }]
#shared algorithm for get_itemdict_* methods
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::parse $args withid "[self class] _get_itemdict"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results
#puts stderr "=-=============>globsearches:$globsearches" #puts stderr "=-=============>globsearches:$globsearches"

17
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/config-0.1.tm

@ -44,8 +44,11 @@ tcl::namespace::eval punk::config {
@values -min 0 -max 0 @values -min 0 -max 0
}] }]
proc dir {args} { proc dir {args} {
#set be_quiet [dict exists $received -quiet]
if {"-quiet" in $args} { if {"-quiet" in $args} {
set be_quiet [dict exists $received -quiet] set be_quiet 1
} else {
set be_quiet 0
} }
set was_noisy 0 set was_noisy 0
@ -445,6 +448,7 @@ tcl::namespace::eval punk::config {
"Get configuration values from a config. "Get configuration values from a config.
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
#todo - load more whichconfig choices?
whichconfig -type string -choices {config startup-configuration running-configuration} whichconfig -type string -choices {config startup-configuration running-configuration}
@values -min 0 -max -1 @values -min 0 -max -1
globkey -type string -default * -optional 1 -multiple 1 globkey -type string -default * -optional 1 -multiple 1
@ -526,6 +530,10 @@ tcl::namespace::eval punk::config {
error "setting value not implemented" error "setting value not implemented"
} }
namespace eval argdoc {
set DYN_GET_LEADERS {${[punk::args::resolved_def -types leaders ::punk::config::get]}}
set DYN_GET_VALUES {${[punk::args::resolved_def -types values ::punk::config::get]}}
lappend PUNKARGS [list { lappend PUNKARGS [list {
@dynamic @dynamic
@id -id ::punk::config::show @id -id ::punk::config::show
@ -534,10 +542,11 @@ tcl::namespace::eval punk::config {
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
}\ }\
{${[punk::args::resolved_def -types leaders ::punk::config::get]}}\ {${$DYN_GET_LEADERS}}\
"@values -min 0 -max -1"\ "@values -min 0 -max -1"\
{${[punk::args::resolved_def -types values ::punk::config::get]}}\ {${$DYN_GET_VALUES}}\
] ]
}
proc show {args} { proc show {args} {
#todo - tables for console #todo - tables for console
set configrecords [punk::config::get {*}$args] set configrecords [punk::config::get {*}$args]
@ -568,7 +577,7 @@ tcl::namespace::eval punk::config {
toconfig -help\ toconfig -help\
"running or startup or file name (not fully implemented)" "running or startup or file name (not fully implemented)"
} }
set argd [punk::args::get_dict $argdef $args] set argd [punk::args::parse $args withdef $argdef]
set fromconfig [dict get $argd values fromconfig] set fromconfig [dict get $argd values fromconfig]
set toconfig [dict get $argd values toconfig] set toconfig [dict get $argd values toconfig]
set fromconfig [string map {-config ""} $fromconfig] set fromconfig [string map {-config ""} $fromconfig]

8
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm

@ -562,13 +562,13 @@ namespace eval punk::du {
proc Get_attributes_from_iteminfo {args} { proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int variable win_reparse_tags_by_int
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::Get_attributes_from_iteminfo @id -id ::punk::du::lib::Get_attributes_from_iteminfo
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
@values -min 1 -max 1 @values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'" iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo] set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug] set opt_debug [dict get $opts -debug]
@ -621,14 +621,14 @@ namespace eval punk::du {
proc attributes_twapi {args} { proc attributes_twapi {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::attributes_twapi @id -id ::punk::du::lib::attributes_twapi
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
@values -min 1 -max 1 @values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes" path -help "path to file or folder for which to retrieve attributes"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set path [dict get $argd values path] set path [dict get $argd values path]
set opt_detail [dict get $opts -detail] set opt_detail [dict get $opts -detail]

4
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm

@ -1559,9 +1559,9 @@ namespace eval punk::fileline::lib {
} }
proc range_boundaries {start end chunksizes args} { proc range_boundaries {start end chunksizes args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
-offset -default 0 -offset -default 0
} $args] }]
lassign [dict values $argd] leaders opts remainingargs lassign [dict values $argd] leaders opts remainingargs
} }

4237
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm

File diff suppressed because it is too large Load Diff

1061
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm

File diff suppressed because it is too large Load Diff

4
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm

@ -167,13 +167,13 @@ namespace eval punk::mix::commandset::doc {
cd $original_wd cd $original_wd
} }
proc validate {args} { proc validate {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::mix::commandset::doc::validate @id -id ::punk::mix::commandset::doc::validate
-- -type none -optional 1 -help "end of options marker --" -- -type none -optional 1 -help "end of options marker --"
-individual -type boolean -default 1 -individual -type boolean -default 1
@values -min 0 -max -1 @values -min 0 -max -1
patterns -default {*.man} -type any -multiple 1 patterns -default {*.man} -type any -multiple 1
} $args] }]
set opt_individual [tcl::dict::get $argd opts -individual] set opt_individual [tcl::dict::get $argd opts -individual]
set patterns [tcl::dict::get $argd values patterns] set patterns [tcl::dict::get $argd values patterns]

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

@ -113,14 +113,16 @@ namespace eval punk::mix::commandset::layout {
return [join $layouts \n] return [join $layouts \n]
} }
proc _default {args} { punk::args::define {
punk::args::get_dict [subst {
@id -id ::punk::mix::commandset::layout::collection::_default @id -id ::punk::mix::commandset::layout::collection::_default
@cmd -name ::punk::mix::commandset::layout::collection::_default @cmd -name ::punk::mix::commandset::layout::collection::_default
-startdir -type string -startdir -type string
-not -type string -multiple 1 -not -type string -multiple 1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
}] $args }
proc _default {args} {
punk::args::parse $args withid ::punk::mix::commandset::layout::collection::_default
set tdict_low_to_high [as_dict {*}$args] set tdict_low_to_high [as_dict {*}$args]
#convert to screen order - with higher priority at the top #convert to screen order - with higher priority at the top

15
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm

@ -1252,9 +1252,8 @@ namespace eval punk::mix::commandset::scriptwrap {
#[para] Library API functions for punk::mix::commandset::scriptwrap #[para] Library API functions for punk::mix::commandset::scriptwrap
#[list_begin definitions] #[list_begin definitions]
punk::args::define {
proc get_wrapper_folders {args} { @id -id ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders
set argd [punk::args::get_dict {
#*** !doctools #*** !doctools
#[call [fun get_wrapper_folders] [arg args] ] #[call [fun get_wrapper_folders] [arg args] ]
#[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo #[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo
@ -1262,16 +1261,16 @@ namespace eval punk::mix::commandset::scriptwrap {
# [list_begin arguments] # [list_begin arguments]
# [arg_def string args] name-value pairs -scriptpath <path> # [arg_def string args] name-value pairs -scriptpath <path>
# [list_end] # [list_end]
@id -id ::punk::mix::commandset::scriptwrap @cmd -name punk::mix::commandset::scriptwrap::lib::get_wrapper_folders -help\
@cmd -name punk::mix::commandset::get_wrapper_folders "Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo"
@opts -anyopts 0 @opts -anyopts 0
-scriptpath -default "" -type directory\ -scriptpath -default "" -type directory\
-help "" -help ""
#todo -help folder within a punk.templates provided area??? #todo -help folder within a punk.templates provided area???
@values -minvalues 0 -maxvalues 0 @values -minvalues 0 -maxvalues 0
} $args] }
proc get_wrapper_folders {args} {
set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders]
# -- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- ---
set opt_scriptpath [dict get $argd opts -scriptpath] set opt_scriptpath [dict get $argd opts -scriptpath]

7
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@ -726,9 +726,9 @@ tcl::namespace::eval punk::nav::fs {
# #
#if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern. #if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern.
# -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied # -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied
proc dirfiles_dict {args} { punk::args::define {
set argspecs {
@id -id ::punk::nav::fs::dirfiles_dict @id -id ::punk::nav::fs::dirfiles_dict
@cmd -name punk::nav::fs::dirfiles_dict
@opts -any 0 @opts -any 0
-searchbase -default "" -searchbase -default ""
-tailglob -default "\uFFFF" -tailglob -default "\uFFFF"
@ -737,7 +737,8 @@ tcl::namespace::eval punk::nav::fs {
-with_times -default "\uFFFF" -type string -with_times -default "\uFFFF" -type string
@values -min 0 -max -1 -type string @values -min 0 -max -1 -type string
} }
set argd [punk::args::get_dict $argspecs $args] proc dirfiles_dict {args} {
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict]
lassign [dict values $argd] leaders opts vals lassign [dict values $argd] leaders opts vals
set searchspecs [dict values $vals] set searchspecs [dict values $vals]

1070
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm

File diff suppressed because it is too large Load Diff

2
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/packagepreference-0.1.0.tm

@ -174,7 +174,7 @@ tcl::namespace::eval punk::packagepreference {
set is_exact 1 set is_exact 1
} else { } else {
set pkg [lindex $args 1] set pkg [lindex $args 1]
set vwant [lrange $args 2 end] ;#rare - but version can be a list of options set vwant [lrange $args 2 end] ;#rare - but version can be a list of requirements
if {[llength $vwant] == 1 && [string first - [lindex $vwant 0]] > 0} { if {[llength $vwant] == 1 && [string first - [lindex $vwant 0]] > 0} {
#only one version - and it has a dash #only one version - and it has a dash
lassign [split [lindex $vwant 0] -] a b lassign [split [lindex $vwant 0] -] a b

14
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm

@ -100,8 +100,12 @@ namespace eval punk::repo {
subcommand -type string -choicecolumns 8 -choicegroups { subcommand -type string -choicecolumns 8 -choicegroups {
"frequently used commands" {${$maincommands}} "frequently used commands" {${$maincommands}}
"" {${$othercmds}} "" {${$othercmds}}
} } -choiceinfo {add {{doctype punkargs}} diff {{doctype punkargs}}}
}] }]
#-choiceinfo {
# add {{doctype punkargs}}
# diff {{doctype punkargs}}
#}
return $result return $result
} }
@ -112,7 +116,7 @@ namespace eval punk::repo {
# @id -id ::punk::repo::fossil_proxy # @id -id ::punk::repo::fossil_proxy
# @cmd -name fossil -help "fossil executable # @cmd -name fossil -help "fossil executable
# " # "
# @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # @formdisplay -header "fossil help" -body {${[runout -n fossil help]}}
# } ""] # } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
@ -129,7 +133,7 @@ namespace eval punk::repo {
@dynamic @dynamic
@id -id "::punk::repo::fossil_proxy diff" @id -id "::punk::repo::fossil_proxy diff"
@cmd -name "fossil diff" -help "fossil diff" @cmd -name "fossil diff" -help "fossil diff"
@argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} @formdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}}
} ""] } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
#todo - remove this comment - testing dynamic directive #todo - remove this comment - testing dynamic directive
@ -137,7 +141,7 @@ namespace eval punk::repo {
@id -id "::punk::repo::fossil_proxy add" @id -id "::punk::repo::fossil_proxy add"
@cmd -name "fossil add" -help "fossil add @cmd -name "fossil add" -help "fossil add
" "
@argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
} ""] } ""]
#TODO #TODO
#lappend PUNKARGS [list { #lappend PUNKARGS [list {
@ -145,7 +149,7 @@ namespace eval punk::repo {
# @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs}
# @cmd -name "fossil add" -help "fossil add # @cmd -name "fossil add" -help "fossil add
# " # "
# @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} # @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
# } ""] # } ""]
lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"} lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"}
lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"} lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"}

107
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm

@ -168,19 +168,7 @@ tcl::namespace::eval punk::zip {
expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) expr {(($year-1980) << 25) | ($month << 21) | ($day << 16)
| ($hour << 11) | ($min << 5) | ($sec >> 1)} | ($hour << 11) | ($min << 5) | ($sec >> 1)}
} }
punk::args::define {
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::get_dict {
@id -id ::punk::zip::walk @id -id ::punk::zip::walk
@cmd -name punk::zip::walk -help\ @cmd -name punk::zip::walk -help\
"Walk the directory structure starting at base/<-subpath> "Walk the directory structure starting at base/<-subpath>
@ -206,7 +194,19 @@ tcl::namespace::eval punk::zip {
@values -min 1 -max -1 @values -min 1 -max -1
base base
fileglobs -default {*} -multiple 1 fileglobs -default {*} -multiple 1
} $args] }
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::parse $args withid ::punk::zip::walk]
set base [dict get $argd values base] set base [dict get $argd values base]
set fileglobs [dict get $argd values fileglobs] set fileglobs [dict get $argd values fileglobs]
set subpath [dict get $argd opts -subpath] set subpath [dict get $argd opts -subpath]
@ -416,19 +416,7 @@ tcl::namespace::eval punk::zip {
# Addentry - was Mkzipfile -- punk::args::define {
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::get_dict {
@id -id ::punk::zip::Addentry @id -id ::punk::zip::Addentry
@cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan' @cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan'
return a central directory file record" return a central directory file record"
@ -440,8 +428,21 @@ tcl::namespace::eval punk::zip {
path -type file -help "path of file to add" path -type file -help "path of file to add"
zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe
Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'" Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'"
} $args] }
# Addentry - was Mkzipfile --
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::parse $args withid ::punk::zip::Addentry]
set zipchan [dict get $argd values zipchan] set zipchan [dict get $argd values zipchan]
set base [dict get $argd values base] set base [dict get $argd values base]
set path [dict get $argd values path] set path [dict get $argd values path]
@ -558,30 +559,8 @@ tcl::namespace::eval punk::zip {
# we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip) # we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip)
#### ####
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::get_dict { punk::args::define {
@id -id ::punk::zip::mkzip @id -id ::punk::zip::mkzip
@cmd -name punk::zip::mkzip\ @cmd -name punk::zip::mkzip\
-help "Create a zip archive in 'filename'" -help "Create a zip archive in 'filename'"
@ -623,8 +602,32 @@ tcl::namespace::eval punk::zip {
globs -default {*} -multiple 1\ globs -default {*} -multiple 1\
-help "list of glob patterns to match. -help "list of glob patterns to match.
Only directories with matching files will be included in the archive." Only directories with matching files will be included in the archive."
} $args] }
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::parse $args withid ::punk::zip::mkzip]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
if {$filename eq ""} { if {$filename eq ""} {
error "mkzip filename cannot be empty string" error "mkzip filename cannot be empty string"

74
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm

@ -140,7 +140,8 @@ tcl::namespace::eval textblock {
# hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\
# "algorithm choice" # "algorithm choice"
namespace eval argdoc {
set DYN_HASH_ALGORITHM_CHOICES_AND_HELP {$[::textblock::argdoc::hash_algorithm_choices_and_help]}
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::textblock::use_hash @id -id ::textblock::use_hash
@ -149,7 +150,8 @@ tcl::namespace::eval textblock {
'none' may be slightly faster but less compact 'none' may be slightly faster but less compact
when viewing textblock::framecache" when viewing textblock::framecache"
@values -min 0 -max 1 @values -min 0 -max 1
hash_algorithm -optional 1 ${[::textblock::argdoc::hash_algorithm_choices_and_help]} hash_algorithm -optional 1 ${$DYN_HASH_ALGORITHM_CHOICES_AND_HELP}
}
} }
proc use_hash {args} { proc use_hash {args} {
#set argd [punk::args::get_by_id ::textblock::use_hash $args] #set argd [punk::args::get_by_id ::textblock::use_hash $args]
@ -4667,17 +4669,19 @@ tcl::namespace::eval textblock {
-size -type integer\ -size -type integer\
-default 15\ -default 15\
-optional 1\ -optional 1\
-range {1 15} -range {1 ""}
-direction -default horizontal\ -direction -default horizontal\
-choices {horizontal vertical}\ -choices {horizontal vertical}\
-help\ -help\
"When rainbow is in the colour list, "Direction of character increments.
this also affects the direction of When rainbow is in the colour list,
colour changes" the colour stripes will be oriented
@values -min 0 -max 2 in this direction.
"
@values -min 0 -max 1
colour -type list -default {} -optional 1 -help\ colour -type list -default {} -optional 1 -help\
"List of Ansi colour names "List of Ansi colour names
e.g. testblock 10 {white Red} e.g. testblock -size 10 {white Red}
produces a block of character 10x10 produces a block of character 10x10
with white text on red bacground with white text on red bacground
@ -4725,7 +4729,16 @@ tcl::namespace::eval textblock {
set chars [list {*}[punk::lib::range 1 9] A B C D E F] set chars [list {*}[punk::lib::range 1 9] A B C D E F]
if {$size <= 15} {
set charsubset [lrange $chars 0 $size-1] set charsubset [lrange $chars 0 $size-1]
} else {
set numsets [expr {int(ceil($size / 15.0))}]
set longset [concat {*}[lrepeat $numsets $chars]]
set charsubset [lrange $longset 0 $size-1]
set longbows [concat {*}[lrepeat $numsets $rainbow_list]]
set rainbow_list [lrange $longbows 0 $size-1]
}
if {"noreset" in $colour} { if {"noreset" in $colour} {
set RST "" set RST ""
} else { } else {
@ -4760,23 +4773,34 @@ tcl::namespace::eval textblock {
append row $c append row $c
} }
append row $RST append row $RST
append block $row\n append block $row \n
} }
set block [tcl::string::trimright $block \n] set block [tcl::string::trimright $block \n]
return $block return $block
} else { } else {
if {$direction eq "vertical"} {
#row first - #row first -
set rows [list] set rows [list]
foreach ch $charsubset { foreach ch $charsubset {
lappend rows [tcl::string::repeat $ch $size] lappend rows [tcl::string::repeat $ch $size]
} }
set block [::join $rows \n] set block [::join $rows \n]
if {$colour ne ""} { if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST
}
return $block
} else {
set block ""
for {set r 0} {$r < $size} {incr r} {
append block [::join $charsubset ""] \n
}
if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST set block [a+ {*}$colour]$block$RST
} }
return $block return $block
} }
} }
}
interp alias {} testblock {} textblock::testblock interp alias {} testblock {} textblock::testblock
#todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table #todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table
@ -5500,10 +5524,11 @@ tcl::namespace::eval textblock {
proc ::textblock::join1 {args} { proc ::textblock::join1 {args} {
lassign [punk::args::get_dict { lassign [punk::args::parse $args withdef {
@id -id ::textblock::join1
-ansiresets -default 1 -type integer -ansiresets -default 1 -type integer
blocks -type string -multiple 1 blocks -type string -multiple 1
} $args] _l leaders _o opts _v values }] _l leaders _o opts _v values
set blocks [tcl::dict::get $values blocks] set blocks [tcl::dict::get $values blocks]
set idx 0 set idx 0
@ -5578,11 +5603,12 @@ tcl::namespace::eval textblock {
#@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width. #@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width.
# Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner # Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner
#" #"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::textblock::join_basic2
-- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags" -- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags"
-ansiresets -type any -default auto -ansiresets -type any -default auto
blocks -type any -multiple 1 blocks -type any -multiple 1
} $args] }]
set ansiresets [tcl::dict::get $argd opts -ansiresets] set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks] set blocks [tcl::dict::get $argd values blocks]
@ -5619,12 +5645,6 @@ tcl::namespace::eval textblock {
#for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed #for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed
#they may however still be 'ragged' ie differing line lengths #they may however still be 'ragged' ie differing line lengths
proc ::textblock::join {args} { proc ::textblock::join {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
#we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets #we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets
@ -5709,11 +5729,6 @@ tcl::namespace::eval textblock {
} }
proc ::textblock::join2 {args} { proc ::textblock::join2 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5801,11 +5816,6 @@ tcl::namespace::eval textblock {
} }
# This calls textblock::pad per cell :/ # This calls textblock::pad per cell :/
proc ::textblock::join3 {args} { proc ::textblock::join3 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5984,7 +5994,7 @@ tcl::namespace::eval textblock {
NOTE: more options available - argument definition NOTE: more options available - argument definition
is incomplete" is incomplete"
@opts @opts
-return -choices {table tableobject} -return -default table -choices {table tableobject}
-rows -type list -default "" -help\ -rows -type list -default "" -help\
"A list of lists. "A list of lists.
Each toplevel element represents a row. Each toplevel element represents a row.
@ -6213,7 +6223,7 @@ tcl::namespace::eval textblock {
-help "restrict to keys matching memberglob." -help "restrict to keys matching memberglob."
}] }]
#append spec \n "frametype -help \"A predefined \"" #append spec \n "frametype -help \"A predefined \""
punk::args::get_dict $spec $args punk::args::parse $args withdef $spec
return return
} }

4
src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl

@ -2044,6 +2044,10 @@ if {[file exists $mapfile]} {
} }
# -- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --" puts "-- runtime_vfs_map --"
set ver [package require punk::args]
puts "punk::args ver: $ver"
set ifneeded [package ifneeded punk::args $ver]
puts "punk::args ifneeded: $ifneeded"
punk::lib::pdict runtime_vfs_map punk::lib::pdict runtime_vfs_map
puts "---------------------" puts "---------------------"
puts "-- vfs_runtime_map--" puts "-- vfs_runtime_map--"

16
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/argparsingtest-0.1.0.tm

@ -278,7 +278,7 @@ namespace eval argparsingtest {
proc test1_punkargs {args} { proc test1_punkargs {args} {
set argd [punk::args::parse $args withdef { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs @id -id ::argparsingtest::test1_punkargs
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -298,7 +298,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::test1_punkargs_by_id @id -id ::test1_punkargs_by_id
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -320,7 +320,7 @@ namespace eval argparsingtest {
punk::args::define { punk::args::define {
@id -id ::argparsingtest::test1_punkargs2 @id -id ::argparsingtest::test1_punkargs2
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -return -default string -type string
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -342,9 +342,9 @@ namespace eval argparsingtest {
proc test1_punkargs_validate_ansistripped {args} { proc test1_punkargs_validate_ansistripped {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::test1_punkargs_validate_ansistripped @id -id ::argparsingtest::test1_punkargs_validate_ansistripped
@cmd -name argtest4 -help "test of punk::args::get_dict comparative performance" @cmd -name argtest4 -help "test of punk::args::parse comparative performance"
@opts -anyopts 0 @opts -anyopts 0
-return -default string -type string -choices {string object} -help "return type" -return -default string -type string -choices {string object} -help "return type"
-frametype -default \uFFEF -type string -frametype -default \uFFEF -type string
@ -358,7 +358,7 @@ namespace eval argparsingtest {
-2 -default 2 -type integer -validate_ansistripped true -2 -default 2 -type integer -validate_ansistripped true
-3 -default 3 -type integer -validate_ansistripped true -3 -default 3 -type integer -validate_ansistripped true
@values @values
} $args] }]
return [tcl::dict::get $argd opts] return [tcl::dict::get $argd opts]
} }
@ -465,7 +465,7 @@ namespace eval argparsingtest {
#multiline values use first line of each record to determine amount of indent to trim #multiline values use first line of each record to determine amount of indent to trim
proc test_multiline {args} { proc test_multiline {args} {
set t3 [textblock::frame t3] set t3 [textblock::frame t3]
set argd [punk::args::get_dict [subst { set argd [punk::args::parse $args withdef [subst {
-template1 -default { -template1 -default {
****** ******
* t1 * * t1 *
@ -491,7 +491,7 @@ namespace eval argparsingtest {
" "
-flag -default 0 -type boolean -flag -default 0 -type boolean
}] $args] }]]
return $argd return $argd
} }

6
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/commandstack-0.3.tm

@ -99,8 +99,11 @@ namespace eval commandstack {
} }
} }
proc get_stack {command} { proc get_stack {{command ""}} {
variable all_stacks variable all_stacks
if {$command eq ""} {
return $all_stacks
}
set command [uplevel 1 [list namespace which $command]] set command [uplevel 1 [list namespace which $command]]
if {[dict exists $all_stacks $command]} { if {[dict exists $all_stacks $command]} {
return [dict get $all_stacks $command] return [dict get $all_stacks $command]
@ -116,6 +119,7 @@ namespace eval commandstack {
variable all_stacks variable all_stacks
if {[dict exists $all_stacks $command]} { if {[dict exists $all_stacks $command]} {
set stack [dict get $all_stacks $command] set stack [dict get $all_stacks $command]
#stack is a list of dicts, 1st entry is token {<cmd> <renamer> <tokenid>}
set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]] set posn [lsearch -index 1 $stack [list $command $renamer $tokenid]]
if {$posn > -1} { if {$posn > -1} {
set record [lindex $stack $posn] set record [lindex $stack $posn]

25
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/modpod-0.1.3.tm

@ -134,12 +134,12 @@ namespace eval modpod {
#old tar connect mechanism - review - not needed? #old tar connect mechanism - review - not needed?
proc connect {args} { proc connect {args} {
puts stderr "modpod::connect--->>$args" puts stderr "modpod::connect--->>$args"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::connect @id -id ::modpod::connect
-type -default "" -type -default ""
@values -min 1 -max 1 @values -min 1 -max 1
path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)" path -type string -minsize 1 -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)"
} $args] }]
catch { catch {
punk::lib::showdict $argd ;#heavy dependencies punk::lib::showdict $argd ;#heavy dependencies
} }
@ -168,7 +168,7 @@ namespace eval modpod {
} else { } else {
#connect to .tm but may still be unwrapped version available #connect to .tm but may still be unwrapped version available
lassign [::split [file rootname [file tail $modpodath]] -] connected(package,$modpodpath) connected(version,$modpodpath) lassign [::split [file rootname [file tail $modpodpath]] -] connected(package,$modpodpath) connected(version,$modpodpath)
set this_pkg_tm_folder [file dirname $modpodpath] set this_pkg_tm_folder [file dirname $modpodpath]
if {$connected(type,$modpodpath) ne "unwrapped"} { if {$connected(type,$modpodpath) ne "unwrapped"} {
#Not directly connected to unwrapped version - but may still be redirected there #Not directly connected to unwrapped version - but may still be redirected there
@ -225,11 +225,15 @@ namespace eval modpod {
if {$connected(startdata,$modpodpath) >= 0} { if {$connected(startdata,$modpodpath) >= 0} {
#verify we have a valid tar header #verify we have a valid tar header
if {![catch {::modpod::system::tar::readHeader [red $fh 512]}]} { if {![catch {::modpod::system::tar::readHeader [read $fh 512]}]} {
seek $fh $connected(startdata,$modpodpath) start seek $fh $connected(startdata,$modpodpath) start
return [list ok $fh] return [list ok $fh]
} else { } else {
#error "cannot verify tar header" #error "cannot verify tar header"
#try zipfs
if {[info commands tcl::zipfs::mount] ne ""} {
}
} }
} }
lpop connected(to) end lpop connected(to) end
@ -262,11 +266,12 @@ namespace eval modpod {
return 1 return 1
} }
proc get {args} { proc get {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::get
-from -default "" -help "path to pod" -from -default "" -help "path to pod"
*values -min 1 -max 1 @values -min 1 -max 1
filename filename
} $args] }]
set frompod [dict get $argd opts -from] set frompod [dict get $argd opts -from]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
@ -329,7 +334,7 @@ namespace eval modpod::lib {
#zipfile is a pure zip at this point - ie no script/exe header #zipfile is a pure zip at this point - ie no script/exe header
proc make_zip_modpod {args} { proc make_zip_modpod {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::modpod::lib::make_zip_modpod @id -id ::modpod::lib::make_zip_modpod
-offsettype -default "archive" -choices {archive file} -help\ -offsettype -default "archive" -choices {archive file} -help\
"Whether zip offsets are relative to start of file or start of zip-data within the file. "Whether zip offsets are relative to start of file or start of zip-data within the file.
@ -340,7 +345,7 @@ namespace eval modpod::lib {
@values -min 2 -max 2 @values -min 2 -max 2
zipfile -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries" zipfile -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries"
outfile -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm" outfile -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm"
} $args] }]
set zipfile [dict get $argd values zipfile] set zipfile [dict get $argd values zipfile]
set outfile [dict get $argd values outfile] set outfile [dict get $argd values outfile]
set opt_offsettype [dict get $argd opts -offsettype] set opt_offsettype [dict get $argd opts -offsettype]
@ -359,7 +364,7 @@ namespace eval modpod::lib {
set moddir [file dirname $modfile] set moddir [file dirname $modfile]
set mod_and_ver [file rootname [file tail $modfile]] set mod_and_ver [file rootname [file tail $modfile]]
lassign [split $mod_and_ver -] moduletail version lassign [split $mod_and_ver -] moduletail version
if {[file exists $moddir/#modpod-$mod_and_ver.tm]} { if {[file exists $moddir/#modpod-$mod_and_ver]} {
source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm
} else { } else {
#determine module namespace so we can mount appropriately #determine module namespace so we can mount appropriately

1
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/aliascore-0.1.0.tm

@ -135,6 +135,7 @@ tcl::namespace::eval punk::aliascore {
smcup ::punk::console::enable_alt_screen\ smcup ::punk::console::enable_alt_screen\
rmcup ::punk::console::disable_alt_screen\ rmcup ::punk::console::disable_alt_screen\
config ::punk::config\ config ::punk::config\
s ::punk::ns::synopsis\
] ]
#*** !doctools #*** !doctools

14
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm

@ -3465,26 +3465,26 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
foreach {pt code} $parts { foreach {pt code} $parts {
switch -- [llength $codestack] { switch -- [llength $codestack] {
0 { 0 {
append emit $base$pt$R append emit $base $pt $R
} }
1 { 1 {
if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} { if {[punk::ansi::codetype::is_sgr_reset [lindex $codestack 0]]} {
append emit $base$pt$R append emit $base $pt $R
set codestack [list] set codestack [list]
} else { } else {
#append emit [lindex $o_codestack 0]$pt #append emit [lindex $o_codestack 0]$pt
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
default { default {
if {$fullmerge} { if {$fullmerge} {
append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge [list $base {*}$codestack {*}$overrides]] $pt $R
} else { } else {
append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]]$pt$R append emit [punk::ansi::codetype::sgr_merge_singles [list $base {*}$codestack {*}$overrides]] $pt $R
} }
} }
} }
@ -3528,7 +3528,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append emit $code append emit $code
} }
} }
return $emit$R return [append emit $R]
} else { } else {
return $base$text$R return $base$text$R
} }

6400
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.6.tm

File diff suppressed because it is too large Load Diff

6458
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.7.tm

File diff suppressed because it is too large Load Diff

48
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@ -250,16 +250,11 @@ namespace eval punk::cap::handlers::templates {
namespace export * namespace export *
namespace eval class { namespace eval class {
variable PUNKARGS variable PUNKARGS
#set argd [punk::args::get_dict { #lappend PUNKARGS [list {
# @id -id "::punk::cap::handlers::templates::class::api folders" # @id -id "::punk::cap::handlers::templates::class::api folders"
# -startdir -default "" # -startdir -default ""
# @values -max 0 # @values -max 0
#} $args] #}]
lappend PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
-startdir -default ""
@values -max 0
}]
oo::class create api { oo::class create api {
#return a dict keyed on folder with source pkg as value #return a dict keyed on folder with source pkg as value
@ -269,9 +264,18 @@ namespace eval punk::cap::handlers::templates {
set cname [string map {. _} $capname] set cname [string map {. _} $capname]
set capabilityname $capname set capabilityname $capname
} }
set class_ns [uplevel 1 [list namespace current]]
lappend ${class_ns}::PUNKARGS [list {
@id -id "::punk::cap::handlers::templates::class::api folders"
@cmd -name "punk::cap::handlers::templates::class::api folders"
-startdir -default "" -help\
"Defaults to CWD if not supplied"
@values -max 0
}]
method folders {args} { method folders {args} {
#puts "--folders $args" #puts "--folders $args"
set argd [punk::args::parse $args withid "::punk::cap::handlers::templates::class::api folders"] set argd [punk::args::parse $args withid "[self class] folders"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set opt_startdir [dict get $opts -startdir] set opt_startdir [dict get $opts -startdir]
@ -488,14 +492,19 @@ namespace eval punk::cap::handlers::templates {
} }
return $folderdict return $folderdict
} }
method get_itemdict_projectlayouts {args} { lappend ${class_ns}::PUNKARGS [list {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts" @id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts"
@cmd -name "punk::cap::handlers::templates::class::api get_itemdict_projectlayouts " -help\
""
@opts -anyopts 1 @opts -anyopts 1
#peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here #peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here
-startdir -default "" -startdir -default ""
@values -maxvalues -1 @values -maxvalues -1
} $args] }]
method get_itemdict_projectlayouts {args} {
set argd [punk::args::parse $args withid "[self class] get_itemdict_projectlayouts"]
set opt_startdir [dict get $argd opts -startdir] set opt_startdir [dict get $argd opts -startdir]
if {$opt_startdir eq ""} { if {$opt_startdir eq ""} {
@ -663,12 +672,7 @@ namespace eval punk::cap::handlers::templates {
my _get_itemdict {*}$arglist my _get_itemdict {*}$arglist
} }
#shared algorithm for get_itemdict_* methods lappend ${class_ns}::PUNKARGS [list {
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::get_dict {
@id -id "::punk::cap::handlers::templates::class::api _get_itemdict" @id -id "::punk::cap::handlers::templates::class::api _get_itemdict"
@cmd -name _get_itemdict @cmd -name _get_itemdict
@opts -anyopts 0 @opts -anyopts 0
@ -679,7 +683,15 @@ namespace eval punk::cap::handlers::templates {
-not -default "" -multiple 1 -not -default "" -multiple 1
@values -maxvalues -1 @values -maxvalues -1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
} $args] }]
#shared algorithm for get_itemdict_* methods
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search
#and a file selection mechanism command -command_get_items_from_base
#and a name determining command -command_get_item_name
method _get_itemdict {args} {
set argd [punk::args::parse $args withid "[self class] _get_itemdict"]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results
#puts stderr "=-=============>globsearches:$globsearches" #puts stderr "=-=============>globsearches:$globsearches"

17
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/config-0.1.tm

@ -44,8 +44,11 @@ tcl::namespace::eval punk::config {
@values -min 0 -max 0 @values -min 0 -max 0
}] }]
proc dir {args} { proc dir {args} {
#set be_quiet [dict exists $received -quiet]
if {"-quiet" in $args} { if {"-quiet" in $args} {
set be_quiet [dict exists $received -quiet] set be_quiet 1
} else {
set be_quiet 0
} }
set was_noisy 0 set was_noisy 0
@ -445,6 +448,7 @@ tcl::namespace::eval punk::config {
"Get configuration values from a config. "Get configuration values from a config.
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
#todo - load more whichconfig choices?
whichconfig -type string -choices {config startup-configuration running-configuration} whichconfig -type string -choices {config startup-configuration running-configuration}
@values -min 0 -max -1 @values -min 0 -max -1
globkey -type string -default * -optional 1 -multiple 1 globkey -type string -default * -optional 1 -multiple 1
@ -526,6 +530,10 @@ tcl::namespace::eval punk::config {
error "setting value not implemented" error "setting value not implemented"
} }
namespace eval argdoc {
set DYN_GET_LEADERS {${[punk::args::resolved_def -types leaders ::punk::config::get]}}
set DYN_GET_VALUES {${[punk::args::resolved_def -types values ::punk::config::get]}}
lappend PUNKARGS [list { lappend PUNKARGS [list {
@dynamic @dynamic
@id -id ::punk::config::show @id -id ::punk::config::show
@ -534,10 +542,11 @@ tcl::namespace::eval punk::config {
Accepts globs eg XDG*" Accepts globs eg XDG*"
@leaders -min 1 -max 1 @leaders -min 1 -max 1
}\ }\
{${[punk::args::resolved_def -types leaders ::punk::config::get]}}\ {${$DYN_GET_LEADERS}}\
"@values -min 0 -max -1"\ "@values -min 0 -max -1"\
{${[punk::args::resolved_def -types values ::punk::config::get]}}\ {${$DYN_GET_VALUES}}\
] ]
}
proc show {args} { proc show {args} {
#todo - tables for console #todo - tables for console
set configrecords [punk::config::get {*}$args] set configrecords [punk::config::get {*}$args]
@ -568,7 +577,7 @@ tcl::namespace::eval punk::config {
toconfig -help\ toconfig -help\
"running or startup or file name (not fully implemented)" "running or startup or file name (not fully implemented)"
} }
set argd [punk::args::get_dict $argdef $args] set argd [punk::args::parse $args withdef $argdef]
set fromconfig [dict get $argd values fromconfig] set fromconfig [dict get $argd values fromconfig]
set toconfig [dict get $argd values toconfig] set toconfig [dict get $argd values toconfig]
set fromconfig [string map {-config ""} $fromconfig] set fromconfig [string map {-config ""} $fromconfig]

8
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm

@ -562,13 +562,13 @@ namespace eval punk::du {
proc Get_attributes_from_iteminfo {args} { proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int variable win_reparse_tags_by_int
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::Get_attributes_from_iteminfo @id -id ::punk::du::lib::Get_attributes_from_iteminfo
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
@values -min 1 -max 1 @values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'" iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo] set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug] set opt_debug [dict get $opts -debug]
@ -621,14 +621,14 @@ namespace eval punk::du {
proc attributes_twapi {args} { proc attributes_twapi {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::du::lib::attributes_twapi @id -id ::punk::du::lib::attributes_twapi
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output" -debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
@values -min 1 -max 1 @values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes" path -help "path to file or folder for which to retrieve attributes"
} $args] }]
set opts [dict get $argd opts] set opts [dict get $argd opts]
set path [dict get $argd values path] set path [dict get $argd values path]
set opt_detail [dict get $opts -detail] set opt_detail [dict get $opts -detail]

4
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm

@ -1559,9 +1559,9 @@ namespace eval punk::fileline::lib {
} }
proc range_boundaries {start end chunksizes args} { proc range_boundaries {start end chunksizes args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
-offset -default 0 -offset -default 0
} $args] }]
lassign [dict values $argd] leaders opts remainingargs lassign [dict values $argd] leaders opts remainingargs
} }

4237
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.2.tm

File diff suppressed because it is too large Load Diff

1061
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm

File diff suppressed because it is too large Load Diff

4
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/doc-0.1.0.tm

@ -167,13 +167,13 @@ namespace eval punk::mix::commandset::doc {
cd $original_wd cd $original_wd
} }
proc validate {args} { proc validate {args} {
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::punk::mix::commandset::doc::validate @id -id ::punk::mix::commandset::doc::validate
-- -type none -optional 1 -help "end of options marker --" -- -type none -optional 1 -help "end of options marker --"
-individual -type boolean -default 1 -individual -type boolean -default 1
@values -min 0 -max -1 @values -min 0 -max -1
patterns -default {*.man} -type any -multiple 1 patterns -default {*.man} -type any -multiple 1
} $args] }]
set opt_individual [tcl::dict::get $argd opts -individual] set opt_individual [tcl::dict::get $argd opts -individual]
set patterns [tcl::dict::get $argd values patterns] set patterns [tcl::dict::get $argd values patterns]

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

@ -113,14 +113,16 @@ namespace eval punk::mix::commandset::layout {
return [join $layouts \n] return [join $layouts \n]
} }
proc _default {args} { punk::args::define {
punk::args::get_dict [subst {
@id -id ::punk::mix::commandset::layout::collection::_default @id -id ::punk::mix::commandset::layout::collection::_default
@cmd -name ::punk::mix::commandset::layout::collection::_default @cmd -name ::punk::mix::commandset::layout::collection::_default
-startdir -type string -startdir -type string
-not -type string -multiple 1 -not -type string -multiple 1
globsearches -default * -multiple 1 globsearches -default * -multiple 1
}] $args }
proc _default {args} {
punk::args::parse $args withid ::punk::mix::commandset::layout::collection::_default
set tdict_low_to_high [as_dict {*}$args] set tdict_low_to_high [as_dict {*}$args]
#convert to screen order - with higher priority at the top #convert to screen order - with higher priority at the top

15
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm

@ -1252,9 +1252,8 @@ namespace eval punk::mix::commandset::scriptwrap {
#[para] Library API functions for punk::mix::commandset::scriptwrap #[para] Library API functions for punk::mix::commandset::scriptwrap
#[list_begin definitions] #[list_begin definitions]
punk::args::define {
proc get_wrapper_folders {args} { @id -id ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders
set argd [punk::args::get_dict {
#*** !doctools #*** !doctools
#[call [fun get_wrapper_folders] [arg args] ] #[call [fun get_wrapper_folders] [arg args] ]
#[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo #[para] Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo
@ -1262,16 +1261,16 @@ namespace eval punk::mix::commandset::scriptwrap {
# [list_begin arguments] # [list_begin arguments]
# [arg_def string args] name-value pairs -scriptpath <path> # [arg_def string args] name-value pairs -scriptpath <path>
# [list_end] # [list_end]
@id -id ::punk::mix::commandset::scriptwrap @cmd -name punk::mix::commandset::scriptwrap::lib::get_wrapper_folders -help\
@cmd -name punk::mix::commandset::get_wrapper_folders "Return list of dicts representing wrapper folders in the project. keys: basefolder sourceinfo"
@opts -anyopts 0 @opts -anyopts 0
-scriptpath -default "" -type directory\ -scriptpath -default "" -type directory\
-help "" -help ""
#todo -help folder within a punk.templates provided area??? #todo -help folder within a punk.templates provided area???
@values -minvalues 0 -maxvalues 0 @values -minvalues 0 -maxvalues 0
} $args] }
proc get_wrapper_folders {args} {
set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::lib::get_wrapper_folders]
# -- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- ---
set opt_scriptpath [dict get $argd opts -scriptpath] set opt_scriptpath [dict get $argd opts -scriptpath]

7
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm

@ -726,9 +726,9 @@ tcl::namespace::eval punk::nav::fs {
# #
#if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern. #if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern.
# -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied # -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied
proc dirfiles_dict {args} { punk::args::define {
set argspecs {
@id -id ::punk::nav::fs::dirfiles_dict @id -id ::punk::nav::fs::dirfiles_dict
@cmd -name punk::nav::fs::dirfiles_dict
@opts -any 0 @opts -any 0
-searchbase -default "" -searchbase -default ""
-tailglob -default "\uFFFF" -tailglob -default "\uFFFF"
@ -737,7 +737,8 @@ tcl::namespace::eval punk::nav::fs {
-with_times -default "\uFFFF" -type string -with_times -default "\uFFFF" -type string
@values -min 0 -max -1 -type string @values -min 0 -max -1 -type string
} }
set argd [punk::args::get_dict $argspecs $args] proc dirfiles_dict {args} {
set argd [punk::args::parse $args withid ::punk::nav::fs::dirfiles_dict]
lassign [dict values $argd] leaders opts vals lassign [dict values $argd] leaders opts vals
set searchspecs [dict values $vals] set searchspecs [dict values $vals]

1070
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm

File diff suppressed because it is too large Load Diff

2
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/packagepreference-0.1.0.tm

@ -174,7 +174,7 @@ tcl::namespace::eval punk::packagepreference {
set is_exact 1 set is_exact 1
} else { } else {
set pkg [lindex $args 1] set pkg [lindex $args 1]
set vwant [lrange $args 2 end] ;#rare - but version can be a list of options set vwant [lrange $args 2 end] ;#rare - but version can be a list of requirements
if {[llength $vwant] == 1 && [string first - [lindex $vwant 0]] > 0} { if {[llength $vwant] == 1 && [string first - [lindex $vwant 0]] > 0} {
#only one version - and it has a dash #only one version - and it has a dash
lassign [split [lindex $vwant 0] -] a b lassign [split [lindex $vwant 0] -] a b

14
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm

@ -100,8 +100,12 @@ namespace eval punk::repo {
subcommand -type string -choicecolumns 8 -choicegroups { subcommand -type string -choicecolumns 8 -choicegroups {
"frequently used commands" {${$maincommands}} "frequently used commands" {${$maincommands}}
"" {${$othercmds}} "" {${$othercmds}}
} } -choiceinfo {add {{doctype punkargs}} diff {{doctype punkargs}}}
}] }]
#-choiceinfo {
# add {{doctype punkargs}}
# diff {{doctype punkargs}}
#}
return $result return $result
} }
@ -112,7 +116,7 @@ namespace eval punk::repo {
# @id -id ::punk::repo::fossil_proxy # @id -id ::punk::repo::fossil_proxy
# @cmd -name fossil -help "fossil executable # @cmd -name fossil -help "fossil executable
# " # "
# @argdisplay -header "fossil help" -body {${[runout -n fossil help]}} # @formdisplay -header "fossil help" -body {${[runout -n fossil help]}}
# } ""] # } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
@ -129,7 +133,7 @@ namespace eval punk::repo {
@dynamic @dynamic
@id -id "::punk::repo::fossil_proxy diff" @id -id "::punk::repo::fossil_proxy diff"
@cmd -name "fossil diff" -help "fossil diff" @cmd -name "fossil diff" -help "fossil diff"
@argdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}} @formdisplay -header "fossil help diff" -body {${[runout -n fossil help diff]}}
} ""] } ""]
lappend PUNKARGS [list { lappend PUNKARGS [list {
#todo - remove this comment - testing dynamic directive #todo - remove this comment - testing dynamic directive
@ -137,7 +141,7 @@ namespace eval punk::repo {
@id -id "::punk::repo::fossil_proxy add" @id -id "::punk::repo::fossil_proxy add"
@cmd -name "fossil add" -help "fossil add @cmd -name "fossil add" -help "fossil add
" "
@argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
} ""] } ""]
#TODO #TODO
#lappend PUNKARGS [list { #lappend PUNKARGS [list {
@ -145,7 +149,7 @@ namespace eval punk::repo {
# @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs} # @id -glob 1 -id "::punk::repo::fossil_proxy *" -aliases {fs}
# @cmd -name "fossil add" -help "fossil add # @cmd -name "fossil add" -help "fossil add
# " # "
# @argdisplay -header "fossil help add" -body {${[runout -n fossil help add]}} # @formdisplay -header "fossil help add" -body {${[runout -n fossil help add]}}
# } ""] # } ""]
lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"} lappend PUNKARGS_aliases {"::fossil" "::punk::repo::fossil_proxy"}
lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"} lappend PUNKARGS_aliases {"::fossil diff" "::punk::repo::fossil_proxy diff"}

107
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/zip-0.1.1.tm

@ -168,19 +168,7 @@ tcl::namespace::eval punk::zip {
expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) expr {(($year-1980) << 25) | ($month << 21) | ($day << 16)
| ($hour << 11) | ($min << 5) | ($sec >> 1)} | ($hour << 11) | ($min << 5) | ($sec >> 1)}
} }
punk::args::define {
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::get_dict {
@id -id ::punk::zip::walk @id -id ::punk::zip::walk
@cmd -name punk::zip::walk -help\ @cmd -name punk::zip::walk -help\
"Walk the directory structure starting at base/<-subpath> "Walk the directory structure starting at base/<-subpath>
@ -206,7 +194,19 @@ tcl::namespace::eval punk::zip {
@values -min 1 -max -1 @values -min 1 -max -1
base base
fileglobs -default {*} -multiple 1 fileglobs -default {*} -multiple 1
} $args] }
proc walk {args} {
#*** !doctools
#[call [fun walk] [arg ?options?] [arg base]]
#[para] Walk a directory tree rooted at base
#[para] the -excludes list can be a set of glob expressions to match against files and avoid
#[para] e.g
#[example {
# punk::zip::walk -exclude {CVS/* *~.#*} library
#}]
#todo: -relative 0|1 flag?
set argd [punk::args::parse $args withid ::punk::zip::walk]
set base [dict get $argd values base] set base [dict get $argd values base]
set fileglobs [dict get $argd values fileglobs] set fileglobs [dict get $argd values fileglobs]
set subpath [dict get $argd opts -subpath] set subpath [dict get $argd opts -subpath]
@ -416,19 +416,7 @@ tcl::namespace::eval punk::zip {
# Addentry - was Mkzipfile -- punk::args::define {
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::get_dict {
@id -id ::punk::zip::Addentry @id -id ::punk::zip::Addentry
@cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan' @cmd -name punk::zip::Addentry -help "Add a single file at 'path' to open channel 'zipchan'
return a central directory file record" return a central directory file record"
@ -440,8 +428,21 @@ tcl::namespace::eval punk::zip {
path -type file -help "path of file to add" path -type file -help "path of file to add"
zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe zipdataoffset -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe
Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'" Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'"
} $args] }
# Addentry - was Mkzipfile --
#
# FIX ME: should handle the current offset for non-seekable channels
#
proc Addentry {args} {
#*** !doctools
#[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
#[para] Add a single file to a zip archive
#[para] The zipchan channel should already be open and binary.
#[para] You can provide a -comment for the file.
#[para] The return value is the central directory record that will need to be used when finalizing the zip archive.
set argd [punk::args::parse $args withid ::punk::zip::Addentry]
set zipchan [dict get $argd values zipchan] set zipchan [dict get $argd values zipchan]
set base [dict get $argd values base] set base [dict get $argd values base]
set path [dict get $argd values path] set path [dict get $argd values path]
@ -558,30 +559,8 @@ tcl::namespace::eval punk::zip {
# we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip) # we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip)
#### ####
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::get_dict { punk::args::define {
@id -id ::punk::zip::mkzip @id -id ::punk::zip::mkzip
@cmd -name punk::zip::mkzip\ @cmd -name punk::zip::mkzip\
-help "Create a zip archive in 'filename'" -help "Create a zip archive in 'filename'"
@ -623,8 +602,32 @@ tcl::namespace::eval punk::zip {
globs -default {*} -multiple 1\ globs -default {*} -multiple 1\
-help "list of glob patterns to match. -help "list of glob patterns to match.
Only directories with matching files will be included in the archive." Only directories with matching files will be included in the archive."
} $args] }
# zip::mkzip --
#
# eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
#
proc mkzip {args} {
#todo - doctools - [arg ?globs...?] syntax?
#*** !doctools
#[call [fun mkzip]\
# [opt "[option -offsettype] [arg offsettype]"]\
# [opt "[option -return] [arg returntype]"]\
# [opt "[option -zipkit] [arg 0|1]"]\
# [opt "[option -runtime] [arg preamble_filename]"]\
# [opt "[option -comment] [arg zipfilecomment]"]\
# [opt "[option -directory] [arg dir_to_zip]"]\
# [opt "[option -base] [arg archive_root]"]\
# [opt "[option -exclude] [arg globlist]"]\
# [arg zipfilename]\
# [arg ?glob...?]]
#[para] Create a zip archive in 'zipfilename'
#[para] If a file already exists, an error will be raised.
#[para] Call 'punk::zip::mkzip' with no arguments for usage display.
set argd [punk::args::parse $args withid ::punk::zip::mkzip]
set filename [dict get $argd values filename] set filename [dict get $argd values filename]
if {$filename eq ""} { if {$filename eq ""} {
error "mkzip filename cannot be empty string" error "mkzip filename cannot be empty string"

74
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm

@ -140,7 +140,8 @@ tcl::namespace::eval textblock {
# hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\ # hash_algorithm -optional 1 -choices {${[::textblock::argdoc::hash_algorithm_choices]}} -help\
# "algorithm choice" # "algorithm choice"
namespace eval argdoc {
set DYN_HASH_ALGORITHM_CHOICES_AND_HELP {$[::textblock::argdoc::hash_algorithm_choices_and_help]}
punk::args::define { punk::args::define {
@dynamic @dynamic
@id -id ::textblock::use_hash @id -id ::textblock::use_hash
@ -149,7 +150,8 @@ tcl::namespace::eval textblock {
'none' may be slightly faster but less compact 'none' may be slightly faster but less compact
when viewing textblock::framecache" when viewing textblock::framecache"
@values -min 0 -max 1 @values -min 0 -max 1
hash_algorithm -optional 1 ${[::textblock::argdoc::hash_algorithm_choices_and_help]} hash_algorithm -optional 1 ${$DYN_HASH_ALGORITHM_CHOICES_AND_HELP}
}
} }
proc use_hash {args} { proc use_hash {args} {
#set argd [punk::args::get_by_id ::textblock::use_hash $args] #set argd [punk::args::get_by_id ::textblock::use_hash $args]
@ -4667,17 +4669,19 @@ tcl::namespace::eval textblock {
-size -type integer\ -size -type integer\
-default 15\ -default 15\
-optional 1\ -optional 1\
-range {1 15} -range {1 ""}
-direction -default horizontal\ -direction -default horizontal\
-choices {horizontal vertical}\ -choices {horizontal vertical}\
-help\ -help\
"When rainbow is in the colour list, "Direction of character increments.
this also affects the direction of When rainbow is in the colour list,
colour changes" the colour stripes will be oriented
@values -min 0 -max 2 in this direction.
"
@values -min 0 -max 1
colour -type list -default {} -optional 1 -help\ colour -type list -default {} -optional 1 -help\
"List of Ansi colour names "List of Ansi colour names
e.g. testblock 10 {white Red} e.g. testblock -size 10 {white Red}
produces a block of character 10x10 produces a block of character 10x10
with white text on red bacground with white text on red bacground
@ -4725,7 +4729,16 @@ tcl::namespace::eval textblock {
set chars [list {*}[punk::lib::range 1 9] A B C D E F] set chars [list {*}[punk::lib::range 1 9] A B C D E F]
if {$size <= 15} {
set charsubset [lrange $chars 0 $size-1] set charsubset [lrange $chars 0 $size-1]
} else {
set numsets [expr {int(ceil($size / 15.0))}]
set longset [concat {*}[lrepeat $numsets $chars]]
set charsubset [lrange $longset 0 $size-1]
set longbows [concat {*}[lrepeat $numsets $rainbow_list]]
set rainbow_list [lrange $longbows 0 $size-1]
}
if {"noreset" in $colour} { if {"noreset" in $colour} {
set RST "" set RST ""
} else { } else {
@ -4760,23 +4773,34 @@ tcl::namespace::eval textblock {
append row $c append row $c
} }
append row $RST append row $RST
append block $row\n append block $row \n
} }
set block [tcl::string::trimright $block \n] set block [tcl::string::trimright $block \n]
return $block return $block
} else { } else {
if {$direction eq "vertical"} {
#row first - #row first -
set rows [list] set rows [list]
foreach ch $charsubset { foreach ch $charsubset {
lappend rows [tcl::string::repeat $ch $size] lappend rows [tcl::string::repeat $ch $size]
} }
set block [::join $rows \n] set block [::join $rows \n]
if {$colour ne ""} { if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST
}
return $block
} else {
set block ""
for {set r 0} {$r < $size} {incr r} {
append block [::join $charsubset ""] \n
}
if {[llength $colour]} {
set block [a+ {*}$colour]$block$RST set block [a+ {*}$colour]$block$RST
} }
return $block return $block
} }
} }
}
interp alias {} testblock {} textblock::testblock interp alias {} testblock {} textblock::testblock
#todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table #todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table
@ -5500,10 +5524,11 @@ tcl::namespace::eval textblock {
proc ::textblock::join1 {args} { proc ::textblock::join1 {args} {
lassign [punk::args::get_dict { lassign [punk::args::parse $args withdef {
@id -id ::textblock::join1
-ansiresets -default 1 -type integer -ansiresets -default 1 -type integer
blocks -type string -multiple 1 blocks -type string -multiple 1
} $args] _l leaders _o opts _v values }] _l leaders _o opts _v values
set blocks [tcl::dict::get $values blocks] set blocks [tcl::dict::get $values blocks]
set idx 0 set idx 0
@ -5578,11 +5603,12 @@ tcl::namespace::eval textblock {
#@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width. #@cmd -name textblock::join_basic -help "Join blocks line by line but don't add padding on each line to enforce uniform width.
# Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner # Already uniform blocks will join faster than textblock::join, and ragged blocks will join in a ragged manner
#" #"
set argd [punk::args::get_dict { set argd [punk::args::parse $args withdef {
@id -id ::textblock::join_basic2
-- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags" -- -type none -optional 0 -help "end of options marker -- is mandatory because joined blocks may easily conflict with flags"
-ansiresets -type any -default auto -ansiresets -type any -default auto
blocks -type any -multiple 1 blocks -type any -multiple 1
} $args] }]
set ansiresets [tcl::dict::get $argd opts -ansiresets] set ansiresets [tcl::dict::get $argd opts -ansiresets]
set blocks [tcl::dict::get $argd values blocks] set blocks [tcl::dict::get $argd values blocks]
@ -5619,12 +5645,6 @@ tcl::namespace::eval textblock {
#for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed #for joining 'rendered' blocks of plain or ansi text. Being 'rendered' means they are without ansi movement sequences as these have been processed
#they may however still be 'ragged' ie differing line lengths #they may however still be 'ragged' ie differing line lengths
proc ::textblock::join {args} { proc ::textblock::join {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
#we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets #we will support -- at posn 0 and 2 only to allow an optional single option pair for -ansiresets
@ -5709,11 +5729,6 @@ tcl::namespace::eval textblock {
} }
proc ::textblock::join2 {args} { proc ::textblock::join2 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5801,11 +5816,6 @@ tcl::namespace::eval textblock {
} }
# This calls textblock::pad per cell :/ # This calls textblock::pad per cell :/
proc ::textblock::join3 {args} { proc ::textblock::join3 {args} {
#set argd [punk::args::get_dict {
# blocks -type string -multiple 1
#} $args]
#set opts [tcl::dict::get $argd opts]
#set blocks [tcl::dict::get $argd values blocks]
#-ansireplays is always on (if ansi detected) #-ansireplays is always on (if ansi detected)
@ -5984,7 +5994,7 @@ tcl::namespace::eval textblock {
NOTE: more options available - argument definition NOTE: more options available - argument definition
is incomplete" is incomplete"
@opts @opts
-return -choices {table tableobject} -return -default table -choices {table tableobject}
-rows -type list -default "" -help\ -rows -type list -default "" -help\
"A list of lists. "A list of lists.
Each toplevel element represents a row. Each toplevel element represents a row.
@ -6213,7 +6223,7 @@ tcl::namespace::eval textblock {
-help "restrict to keys matching memberglob." -help "restrict to keys matching memberglob."
}] }]
#append spec \n "frametype -help \"A predefined \"" #append spec \n "frametype -help \"A predefined \""
punk::args::get_dict $spec $args punk::args::parse $args withdef $spec
return return
} }

4
src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl

@ -2044,6 +2044,10 @@ if {[file exists $mapfile]} {
} }
# -- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- ---
puts "-- runtime_vfs_map --" puts "-- runtime_vfs_map --"
set ver [package require punk::args]
puts "punk::args ver: $ver"
set ifneeded [package ifneeded punk::args $ver]
puts "punk::args ifneeded: $ifneeded"
punk::lib::pdict runtime_vfs_map punk::lib::pdict runtime_vfs_map
puts "---------------------" puts "---------------------"
puts "-- vfs_runtime_map--" puts "-- vfs_runtime_map--"

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save