From de8c5ff7ada898dd556c8bb99396ecba6972b61f Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Wed, 15 Jan 2025 04:38:29 +1100 Subject: [PATCH] punk::args and punk::ns improvements, command help with 'i' --- src/bootsupport/modules/punk-0.1.tm | 76 +- src/bootsupport/modules/punk/ansi-0.1.1.tm | 140 +- src/bootsupport/modules/punk/args-0.1.0.tm | 1684 ++++++++++++----- src/bootsupport/modules/punk/config-0.1.tm | 35 +- src/bootsupport/modules/punk/console-0.1.1.tm | 5 +- .../modules/punk/fileline-0.1.0.tm | 19 +- src/bootsupport/modules/punk/lib-0.1.1.tm | 194 +- .../punk/mix/commandset/layout-0.1.0.tm | 2 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 37 +- .../punk/mix/commandset/module-0.1.0.tm | 70 +- src/bootsupport/modules/punk/ns-0.1.0.tm | 1016 +++++++++- src/bootsupport/modules/punk/path-0.1.0.tm | 31 +- .../modules/punk/repl/codethread-0.1.1.tm | 23 +- src/bootsupport/modules/shellfilter-0.1.9.tm | 4 +- src/bootsupport/modules/textblock-0.1.2.tm | 507 ++--- .../man/files/_module_termscheme-0.1.0.tm.n | 323 ++++ .../man/files/punk/_module_ansi-0.1.1.tm.n | 4 +- .../man/files/punk/_module_args-0.1.0.tm.n | 20 +- .../man/files/punk/_module_console-0.1.1.tm.n | 4 + .../man/files/punk/_module_lib-0.1.1.tm.n | 2 + .../man/files/punk/_module_safe-0.1.0.tm.n | 328 ++++ .../man/files/punk/_module_sixel-0.1.0.tm.n | 326 ++++ .../punk/args/_module_tclcore-0.1.0.tm.n | 325 ++++ .../man/files/punk/nav/_module_fs-0.1.0.tm.n | 4 +- .../punk/repl/_module_codethread-0.1.0.tm.n | 8 +- .../punk/repl/_module_codethread-0.1.1.tm.n | 318 ++++ src/embedded/man/index.n | 47 +- src/embedded/man/toc.n | 27 +- src/embedded/md/.doc/tocdoc | 9 +- src/embedded/md/.idx | 2 +- src/embedded/md/.toc | 2 +- src/embedded/md/.xrf | 2 +- .../doc/files/_module_termscheme-0.1.0.tm.md | 87 + .../doc/files/punk/_module_ansi-0.1.1.tm.md | 4 +- .../doc/files/punk/_module_args-0.1.0.tm.md | 26 +- .../files/punk/_module_console-0.1.1.tm.md | 4 + .../md/doc/files/punk/_module_lib-0.1.1.tm.md | 2 + .../doc/files/punk/_module_safe-0.1.0.tm.md | 95 + .../doc/files/punk/_module_sixel-0.1.0.tm.md | 89 + .../punk/args/_module_tclcore-0.1.0.tm.md | 90 + .../doc/files/punk/nav/_module_fs-0.1.0.tm.md | 6 +- .../punk/repl/_module_codethread-0.1.0.tm.md | 8 +- .../punk/repl/_module_codethread-0.1.1.tm.md | 87 + src/embedded/md/doc/toc.md | 18 +- src/embedded/md/index.md | 10 +- src/embedded/md/toc.md | 18 +- src/embedded/www/.doc/tocdoc | 9 +- src/embedded/www/.idx | 2 +- src/embedded/www/.toc | 2 +- src/embedded/www/.xrf | 2 +- .../files/_module_termscheme-0.1.0.tm.html | 192 ++ .../doc/files/punk/_module_ansi-0.1.1.tm.html | 4 +- .../doc/files/punk/_module_args-0.1.0.tm.html | 24 +- .../files/punk/_module_console-0.1.1.tm.html | 2 + .../doc/files/punk/_module_lib-0.1.1.tm.html | 1 + .../doc/files/punk/_module_safe-0.1.0.tm.html | 197 ++ .../files/punk/_module_sixel-0.1.0.tm.html | 185 ++ .../punk/args/_module_tclcore-0.1.0.tm.html | 193 ++ .../files/punk/nav/_module_fs-0.1.0.tm.html | 8 +- .../repl/_module_codethread-0.1.0.tm.html | 14 +- .../repl/_module_codethread-0.1.1.tm.html | 187 ++ src/embedded/www/doc/toc.html | 60 +- src/embedded/www/index.html | 10 +- src/embedded/www/toc.html | 60 +- src/modules/argparsingtest-999999.0a1.0.tm | 32 +- src/modules/patternpunk-1.1.tm | 4 +- src/modules/poshinfo-999999.0a1.0.tm | 26 +- src/modules/punk-0.1.tm | 76 +- src/modules/punk/ansi-999999.0a1.0.tm | 140 +- src/modules/punk/args-999999.0a1.0.tm | 1684 ++++++++++++----- src/modules/punk/args/tclcore-999999.0a1.0.tm | 700 +++++++ .../punk/args/tclcore-buildversion.txt | 3 + src/modules/punk/blockletter-999999.0a1.0.tm | 57 +- src/modules/punk/config-0.1.tm | 35 +- src/modules/punk/console-999999.0a1.0.tm | 5 +- src/modules/punk/fileline-999999.0a1.0.tm | 19 +- src/modules/punk/lib-999999.0a1.0.tm | 194 +- .../mix/commandset/layout-999999.0a1.0.tm | 2 +- .../mix/commandset/loadedlib-999999.0a1.0.tm | 26 +- .../mix/commandset/module-999999.0a1.0.tm | 70 +- src/modules/punk/ns-999999.0a1.0.tm | 1016 +++++++++- src/modules/punk/path-999999.0a1.0.tm | 31 +- src/modules/punk/repl-0.1.tm | 424 +++-- .../punk/repl/codethread-999999.0a1.0.tm | 23 +- src/modules/punk/safe-999999.0a1.0.tm | 116 +- src/modules/punk/sixel-999999.0a1.0.tm | 2 + src/modules/shellfilter-0.1.9.tm | 4 +- src/modules/textblock-999999.0a1.0.tm | 507 ++--- .../src/bootsupport/modules/punk-0.1.tm | 76 +- .../bootsupport/modules/punk/ansi-0.1.1.tm | 140 +- .../bootsupport/modules/punk/args-0.1.0.tm | 1684 ++++++++++++----- .../bootsupport/modules/punk/config-0.1.tm | 35 +- .../bootsupport/modules/punk/console-0.1.1.tm | 5 +- .../modules/punk/fileline-0.1.0.tm | 19 +- .../src/bootsupport/modules/punk/lib-0.1.1.tm | 194 +- .../punk/mix/commandset/layout-0.1.0.tm | 2 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 37 +- .../punk/mix/commandset/module-0.1.0.tm | 70 +- .../src/bootsupport/modules/punk/ns-0.1.0.tm | 1016 +++++++++- .../bootsupport/modules/punk/path-0.1.0.tm | 31 +- .../modules/punk/repl/codethread-0.1.1.tm | 23 +- .../bootsupport/modules/shellfilter-0.1.9.tm | 4 +- .../bootsupport/modules/textblock-0.1.2.tm | 507 ++--- .../src/bootsupport/modules/punk-0.1.tm | 76 +- .../bootsupport/modules/punk/ansi-0.1.1.tm | 140 +- .../bootsupport/modules/punk/args-0.1.0.tm | 1684 ++++++++++++----- .../bootsupport/modules/punk/config-0.1.tm | 35 +- .../bootsupport/modules/punk/console-0.1.1.tm | 5 +- .../modules/punk/fileline-0.1.0.tm | 19 +- .../src/bootsupport/modules/punk/lib-0.1.1.tm | 194 +- .../punk/mix/commandset/layout-0.1.0.tm | 2 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 37 +- .../punk/mix/commandset/module-0.1.0.tm | 70 +- .../src/bootsupport/modules/punk/ns-0.1.0.tm | 1016 +++++++++- .../bootsupport/modules/punk/path-0.1.0.tm | 31 +- .../modules/punk/repl/codethread-0.1.1.tm | 23 +- .../bootsupport/modules/shellfilter-0.1.9.tm | 4 +- .../bootsupport/modules/textblock-0.1.2.tm | 507 ++--- .../modules/argparsingtest-0.1.0.tm | 32 +- .../_vfscommon.vfs/modules/patternpunk-1.1.tm | 4 +- .../_vfscommon.vfs/modules/poshinfo-0.1.0.tm | 26 +- src/vfs/_vfscommon.vfs/modules/punk-0.1.tm | 76 +- .../_vfscommon.vfs/modules/punk/ansi-0.1.1.tm | 140 +- .../_vfscommon.vfs/modules/punk/args-0.1.0.tm | 1684 ++++++++++++----- .../modules/punk/args/tclcore-0.1.0.tm | 700 +++++++ .../modules/punk/blockletter-0.1.0.tm | 57 +- .../_vfscommon.vfs/modules/punk/config-0.1.tm | 35 +- .../modules/punk/console-0.1.1.tm | 5 +- .../modules/punk/fileline-0.1.0.tm | 19 +- .../_vfscommon.vfs/modules/punk/lib-0.1.1.tm | 194 +- .../punk/mix/commandset/layout-0.1.0.tm | 2 +- .../punk/mix/commandset/loadedlib-0.1.0.tm | 37 +- .../punk/mix/commandset/module-0.1.0.tm | 70 +- .../_vfscommon.vfs/modules/punk/ns-0.1.0.tm | 1016 +++++++++- .../_vfscommon.vfs/modules/punk/path-0.1.0.tm | 31 +- .../_vfscommon.vfs/modules/punk/repl-0.1.tm | 424 +++-- .../modules/punk/repl/codethread-0.1.1.tm | 23 +- .../_vfscommon.vfs/modules/punk/safe-0.1.0.tm | 116 +- .../modules/punk/sixel-0.1.0.tm | 2 + .../modules/shellfilter-0.1.9.tm | 4 +- .../_vfscommon.vfs/modules/textblock-0.1.2.tm | 507 ++--- 141 files changed, 19574 insertions(+), 5802 deletions(-) create mode 100644 src/embedded/man/files/_module_termscheme-0.1.0.tm.n create mode 100644 src/embedded/man/files/punk/_module_safe-0.1.0.tm.n create mode 100644 src/embedded/man/files/punk/_module_sixel-0.1.0.tm.n create mode 100644 src/embedded/man/files/punk/args/_module_tclcore-0.1.0.tm.n create mode 100644 src/embedded/man/files/punk/repl/_module_codethread-0.1.1.tm.n create mode 100644 src/embedded/md/doc/files/_module_termscheme-0.1.0.tm.md create mode 100644 src/embedded/md/doc/files/punk/_module_safe-0.1.0.tm.md create mode 100644 src/embedded/md/doc/files/punk/_module_sixel-0.1.0.tm.md create mode 100644 src/embedded/md/doc/files/punk/args/_module_tclcore-0.1.0.tm.md create mode 100644 src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.1.tm.md create mode 100644 src/embedded/www/doc/files/_module_termscheme-0.1.0.tm.html create mode 100644 src/embedded/www/doc/files/punk/_module_safe-0.1.0.tm.html create mode 100644 src/embedded/www/doc/files/punk/_module_sixel-0.1.0.tm.html create mode 100644 src/embedded/www/doc/files/punk/args/_module_tclcore-0.1.0.tm.html create mode 100644 src/embedded/www/doc/files/punk/repl/_module_codethread-0.1.1.tm.html create mode 100644 src/modules/punk/args/tclcore-999999.0a1.0.tm create mode 100644 src/modules/punk/args/tclcore-buildversion.txt create mode 100644 src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm diff --git a/src/bootsupport/modules/punk-0.1.tm b/src/bootsupport/modules/punk-0.1.tm index 3d454ca8..0ca26f39 100644 --- a/src/bootsupport/modules/punk-0.1.tm +++ b/src/bootsupport/modules/punk-0.1.tm @@ -9,7 +9,7 @@ namespace eval punk { zzzload::pkg_require $pkg } } - #lazyload twapi + #lazyload twapi ? catch {package require vfs} ;#attempt load now so we can use faster 'package provide' to test existence later } @@ -3670,7 +3670,7 @@ namespace eval punk { incr i } - #JMN2 + #JMN2 - review #set returnval [lindex $assigned_values 0] if {[llength $assigned_values] == 1} { set returnval [join $assigned_values] @@ -7271,55 +7271,59 @@ namespace eval punk { catch { package require patternpunk #lappend chunks [list stderr [>punk . rhs]] - append mascotblock [textblock::frame [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] + append mascotblock [textblock::frame -checkargs 0 [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] } set topic [lindex $args end] set argopts [lrange $args 0 end-1] - set text "" - append text "Punk core navigation commands:\n" + set title "[a+ brightgreen] Punk core navigation commands: " #todo - load from source code annotation? set cmdinfo [list] - lappend cmdinfo [list help "This help. To see available subitems type: help topics"] - lappend cmdinfo [list dev "(ensemble command to make new projects/modules and to generate docs)"] - lappend cmdinfo [list a? "view ANSI colours\n e.g a? web"] - lappend cmdinfo [list ./ "view/change directory"] - lappend cmdinfo [list ../ "go up one directory"] - lappend cmdinfo [list ./new "make new directory and switch to it"] - lappend cmdinfo [list n/ "view/change namespace (accepts ns path globs e.g **::*get* to match comands at any level )"] - lappend cmdinfo [list n// "view/change namespace (with command listing)"] - lappend cmdinfo [list nn/ "go up one namespace"] - lappend cmdinfo [list n/new "make child namespace and switch to it"] - - set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] - set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] - set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] - set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] + lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] + lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"] + lappend cmdinfo [list ./ "?subdir?" "view/change directory"] + lappend cmdinfo [list ../ "" "go up one directory"] + lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] + lappend cmdinfo [list n/ "?glob...?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match comands at any level )"] + lappend cmdinfo [list n// "" "view/change namespace (with command listing)"] + lappend cmdinfo [list "nn/" "" "go up one namespace"] + lappend cmdinfo [list "n/new" "" "make child namespace and switch to it"] + lappend cmdinfo [list dev "?subcommand?" "(ensemble command to make new projects/modules and to generate docs)"] + lappend cmdinfo [list a? "?subcommand...?" "view ANSI colours\n e.g a? web"] + + #set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] + #set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] + #set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] + #set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] set t [textblock::class::table new -show_seps 0] - foreach c $cmds d $descr { - #append text " [overtype::left $col1 $c][overtype::left $col2 $d]" \n - $t add_row [list $c $d] - } - set widest1 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$widest1 + 2}] - set widest2 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$widest2 + 1}] + #foreach c $cmds d $descr { + # $t add_row [list $c $d] + #} + foreach row $cmdinfo { + $t add_row $row + } + set width_0 [$t column_datawidth 0] + $t configure_column 0 -minwidth [expr {$width_0 + 2}] + set width_1 [$t column_datawidth 1] + $t configure_column 1 -minwidth [expr {$width_1 + 1}] + $t configure -title $title + + set text "" append text [$t print] set warningblock "" + set introblock $mascotblock + append introblock \n $text - if {[catch {package require textblock} errM]} { - set introblock $mascotblock - append introblock \n $text - append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" - - } else { - set introblock [textblock::join -- " " \n$mascotblock " " $text] - } + #if {[catch {package require textblock} errM]} { + # append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" + #} else { + # set introblock [textblock::join -- " " \n$mascotblock " " $text] + #} lappend chunks [list stdout $introblock] diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index b616da59..1e52d3e9 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -132,14 +132,29 @@ tcl::namespace::eval punk::ansi::class { set rendered [overtype::renderspace -cp437 1 -expand_right 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] return $rendered } + + lappend ::punk::ansi::class::PUNKARGS [list { + *id "punk::ansi::class::class_ansi render_to_input_line" + *proc -name "punk::ansi::class::class_ansi render_to_input_line" -help\ + "render string from line 0 to line + (experimental/debug)" + -dimensions -type string -help\ + "WxH where W is integer width >= 1 and H is integer heigth >= 1" + -minus -type integer -help\ + "number of chars to exclude from end" + *values -min 1 -max 1 + line -type indexexpression + }] method render_to_input_line {args} { if {[llength $args] < 1} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set x [lindex $args end] set arglist [lrange $args 0 end-1] if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set opts [tcl::dict::create\ -dimensions 80x24\ @@ -322,6 +337,7 @@ tcl::namespace::eval punk::ansi::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ansi { + variable PUNKARGS #*** !doctools #[subsection {Namespace punk::ansi}] #[para] Core API functions for punk::ansi @@ -422,6 +438,8 @@ tcl::namespace::eval punk::ansi { erase*\ get_*\ hyperlink\ + hyperlink_open\ + hyperlink_close\ move*\ reset*\ ansistrip*\ @@ -554,21 +572,35 @@ tcl::namespace::eval punk::ansi { $obj destroy return $result } - proc example {args} { - set base [punk::repo::find_project] - set default_ansifolder [file join $base src/testansi] - set argd [punk::args::get_dict [tstr -return string { + proc Get_ansifolder {} { + if {[catch {punk::repo::find_project} base]} { + set base "" + } + if {$base eq ""} { + #pwd not avail in safe interp + if {![catch {pwd} CWD]} { + set base $CWD + } + } + return [file join $base src/testansi] + } + + lappend PUNKARGS [list -dynamic 1 { + *id punk::ansi::example *proc -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) You can specify a narrower width to truncate images on the right side" - -folder -default "${$default_ansifolder}" -help "Base folder for files if relative paths are used. + -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. Defaults to /src/testansi - where projectbase is determined from current directory. " *values -min 0 -max -1 files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" - }] $args] + } ""] + + proc example {args} { + set argd [punk::args::get_by_id punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -621,7 +653,7 @@ tcl::namespace::eval punk::ansi { set subtitle [tcl::dict::get $picinfo status] } set title [tcl::dict::get $picinfo filename] - set fr [textblock::frame -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] + set fr [textblock::frame -checkargs 0 -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] # -- --- --- --- #we need the max height of a row element to use join_basic instead of join below # -- --- --- --- @@ -2320,16 +2352,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off - proc sgr_cache {args} { - set argd [punk::args::get_dict { - *proc -name punk::ansi::sgr_cache -help "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " - -action -default "" -choices "clear" -help "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" - -pretty -default 1 -type boolean -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" + #punk::args depends on punk::ansi - REVIEW + proc sgr_cache {args} { + set argdef { + *id punk::ansi::sgr_cache + *proc -name punk::ansi::sgr_cache -help\ + "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) + " + -action -default "" -choices "clear" -help\ + "-action clear will unset the keys in the punk::ansi::sgr_cache dict + This is called automatically when setting 'colour false' in the console" + + -pretty -default 1 -type boolean -help\ + "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" *values -min 0 -max 0 - } $args] + } + set argd [punk::args::get_dict $argdef $args] set action [dict get $argd opts -action] set pretty [dict get $argd opts -pretty] @@ -2372,6 +2411,31 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return [join $lines \n] } + lappend PUNKARGS [list { + *id punk::ansi::a+ + *proc -name "punk::ansi::a+" -help\ + "Returns an ANSI sgr escape sequence based on the list of supplied codes. + " + *values -min 0 -max -1 + } [string map [list [dict keys $SGR_map]] { + code -type string -optional 1 -multiple 1 -choices {} -choiceprefix 0 -choicerestricted 0 -help\ + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- + + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web" + + }]] + proc a+ {args} { #*** !doctools #[call [fun a+] [opt {ansicode...}]] @@ -3267,17 +3331,49 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # REVIEW - osc8 replays etc for split lines? - textblock + #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda #the 'id' parameter logically connects split hyperlinks + #per interp. Rather than try to avoid collisions using something like 'info cmdcount' we will use a simple counter. + #To stop multiple hyperlinks from having ids inadvertently collide - we should do some id mangling/prefixing based on the terminal/window etc + #It is better to use a simple counter with high likelihood of collision so we are more likely to detect problems with ids than to make it more intermittent by using ids that collide only 'rarely' + variable hyperlinkcounter + set hyperlinkcounter 0 + + proc hyperlink {uri {display ""}} { + variable hyperlinkcounter if {$display eq ""} { set display $uri } - set params "" ;#todo e.g id=xyz123:foo=bar:baz=quux + set uri [punk::ansi::ansistripraw $uri] + #limit uri length we emit based on common limits in other terminals + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set params "id=punkansi-[incr hyperlinkcounter]" ;#todo e.g id=xyz123:foo=bar:baz=quux set open "\x1b\]8\;$params\;$uri\x1b\\" set close "\x1b\]8\;\;\x1b\\" return ${open}${display}${close} } + #on windows terminal at least, both uri and id of 2 separated hyperlinks need to match for the hover highlighting to act as a unit. + proc hyperlink_open {uri {id ""}} { + if {$id eq ""} { + set id punkansi-[incr hyperlinkcounter] + } + set uri [punk::ansi::ansistripraw $uri] + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set id [string map {: . {;} ,} $id] ;#avoid some likely problematic ids. TODO - review, restrict further. + set params "id=$id" + return "\x1b\]8\;$params\;$uri\x1b\\" + } + #It should be ok to close even if no currently active hyperlink (e.g can be used to cleanup if something awry) + proc hyperlink_close {} { + return "\x1b\]8\;\;\x1b\\" + } + # -- --- --- --- --- proc move {row col} { #*** !doctools @@ -3837,11 +3933,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun ansistrip] [arg text] ] #[para]Return a string with ansi codes stripped out #[para]Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs) - + if {[string length $text] < 2} {return $text} if {[punk::ansi::ta::detect_g0 $text]} { set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters } + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] + if {[llength $parts] == 1} {return [lindex $parts 0]} set out "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" # - (if/when lsearch -stride bug fixed) @@ -3871,6 +3969,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Return a string with ansi codes stripped out #[para]Alternate graphics modes will be stripped rather than converted to unicode - exposing the raw ascii characters as they appear without graphics mode. #[para]ie instead of a horizontal line you may see: qqqqqq + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] set out "" @@ -7294,6 +7393,13 @@ tcl::namespace::eval punk::ansi::internal { } } +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set NAMESPACES [list] + } +} +lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::ansi [tcl::namespace::eval punk::ansi { diff --git a/src/bootsupport/modules/punk/args-0.1.0.tm b/src/bootsupport/modules/punk/args-0.1.0.tm index b2854093..c087ae0b 100644 --- a/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/bootsupport/modules/punk/args-0.1.0.tm @@ -84,7 +84,7 @@ # *values -min 2 -max 2 # fileA -type existingfile 1 # fileB -type existingfile 1 -# } $args]] opts values +# } $args]] leaders opts values # puts "$category fileA: [dict get $values fileA]" # puts "$category fileB: [dict get $values fileB]" # } @@ -218,49 +218,45 @@ package require Tcl 8.6- #*** !doctools #[section API] -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# oo::class namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval punk::args::class { +tcl::namespace::eval punk::args::register { #*** !doctools - #[subsection {Namespace punk::args::class}] - #[para] class definitions - if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { - #*** !doctools - #[list_begin enumerated] - - # oo::class create interface_sample1 { - # #*** !doctools - # #[enum] CLASS [class interface_sample1] - # #[list_begin definitions] + #[subsection {Namespace punk::args}] + #[para] cooperative namespace punk::args::register + #[para] punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded + #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. + #[list_begin definitions] - # method test {arg1} { - # #*** !doctools - # #[call class::interface_sample1 [method test] [arg arg1]] - # #[para] test method - # puts "test: $arg1" - # } + # -- --- --- --- --- --- --- --- + #cooperative with packages that define some punk args but may need to do so lazily + #These could be loaded prior to punk::args being loaded + variable NAMESPACES + if {![info exists ::punk::args::register::NAMESPACES]} { + set NAMESPACES [list] + } + # -- --- --- --- --- --- --- --- - # #*** !doctools - # #[list_end] [comment {-- end definitions interface_sample1}] - # } - #*** !doctools - #[list_end] [comment {--- end class enumeration ---}] - } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::register ---}] } -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args { + + + variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::definition at the end. + tcl::namespace::export {[a-z]*} - variable argspec_cache - variable argspec_ids + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved variable id_counter - set argspec_cache [tcl::dict::create] - set argspec_ids [tcl::dict::create] + set argdata_cache [tcl::dict::create] + set argdefcache_by_id [tcl::dict::create] + set argdefcache_unresolved [tcl::dict::create] set id_counter 0 #*** !doctools @@ -271,72 +267,127 @@ tcl::namespace::eval punk::args { #todo - some sort of punk::args::cherrypick operation to get spec from an existing set #todo - doctools output from definition - #dict get value with default wrapper for tcl 8.6 - if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef - proc Dict_getdef {dictValue args} { - set keys [lrange $args 0 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] - } - } - } else { - #we pay a minor perf penalty for the wrap - interp alias "" ::punk::args::Dict_getdef "" ::tcl::dict::getdef - } - - #name to reflect maintenance - home is punk::lib::ldiff - proc punklib_ldiff {fromlist removeitems} { - if {[llength $removeitems] == 0} {return $fromlist} - set result {} - foreach item $fromlist { - if {$item ni $removeitems} { - lappend result $item - } - } - return $result - } - proc flatzip {l1 l2} { - concat {*}[lmap a $l1 b $l2 {list $a $b}] - } - if {[info commands lseq] ne ""} { - #tcl 8.7+ lseq significantly faster, especially for larger ranges - #The internal rep can be an 'arithseries' with no string representation - proc zero_to_n {n} { - lseq 0 $n - } - } else { - proc zero_to_n {n} { - lsearch -all [lrepeat $n 0] * - } - } #todo? -synonym/alias ? (applies to opts only not values) #e.g -background -aliases {-bg} -default White - #review - how to make work with trie prefix e.g -corner -aliases {-corners} + #review - how to make work with trie prefix + #e.g + # -corner -aliases {-corners} + # -centre -aliases {-center -middle} #We mightn't want the prefix to be longer just because of an alias + #we should get -co -ce and -m from the above as abbreviations + + lappend PUNKARGS [list { + *id punk::args::definition + *proc -name punk::args::definition -help\ + "Accepts a line-based definition of command arguments. + The definition should usually contain a line of the form: *id someid + " + -dynamic -type boolean -default 0 -help\ + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is not usually significant, perhaps on the order of a few hundred uS, + but -dynamic true might be less desirable if the command is used in inner + loops in more performance-sensitive code. + " + *values -min 1 -max -1 + text -type string -multiple 1 -help\ + "Block(s) of text representing the argument specification for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + e.g + definition { + *id myns::myfunc + *proc -name myns::myfunc -help\\ + \"Description of command\" + + #The following option defines an option-value pair + -option1 -default blah -type string + #The following option defines a flag style option (solo) + -flag1 -default 0 -type none -help\\ + \"Info about flag1\" + + *values -min 1 -max -1 + #Items that don't begin with * or - are value definitions + v1 -type integer -default 0 + thinglist -type string -multiple 1 + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + " + }] + proc definition {args} { + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved + - proc definition {optionspecs args} { - variable argspec_cache - #variable argspecs ;#REVIEW!! - variable argspec_ids #variable initial_optspec_defaults #variable initial_valspec_defaults #ideally we would use a fast hash algorithm to produce a short key with low collision probability. #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. #review - check if there is a built-into-tcl way to do this quickly #for now we will just key using the whole string - set cache_key $optionspecs - if {[tcl::dict::exists $argspec_cache $cache_key]} { - return [tcl::dict::get $argspec_cache $cache_key] + + set cache_key $args + set textargs $args + + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] + set textargs [lrange $args 2 end] } - set optionspecs [tcl::string::map [list \r\n \n] $optionspecs] + if {!$is_dynamic} { + if {[tcl::dict::exists $argdata_cache $cache_key]} { + return [tcl::dict::get $argdata_cache $cache_key] + } + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + if {[string first \$\{ $optionspecs] > 0} { + set optionspecs [uplevel 1 [list punk::args::lib::tstr -return string -eval 1 $optionspecs]] + } + } else { + if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { + set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + } else { + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + #REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?) + if {[string first \$\{ $optionspecs] > 0} { + set pt_params [punk::args::lib::tstr -return list -eval 0 $optionspecs] ;#-eval 0 - no need to uplevel + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + tcl::dict::set argdefcache_unresolved $cache_key $pt_params + } + } + if {[tcl::dict::exists $argdata_cache $optionspecs]} { + #resolved cache version exists + return [tcl::dict::get $argdata_cache $optionspecs] + } + } + + + #probably faster to inline a literal dict create in the proc than to use a namespace variable set optspec_defaults [tcl::dict::create\ -type string\ @@ -381,7 +432,7 @@ tcl::namespace::eval punk::args { #default to 1 for convenience #checks with no default - #-minlen -maxlen -range + #-minsize -maxsize -range #default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi @@ -473,14 +524,19 @@ tcl::namespace::eval punk::args { } set proc_info {} set id_info {} ;#e.g -children ?? - set leader_min 0 - set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set doc_info {} + set parser_info {} + set leader_min "" + #set leader_min 0 + #set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set leader_max "" #(common case of no leaders specified) set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit set spec_id "" set argspace "leaders" ;#leaders -> options -> values + set parser_id 0 foreach ln $records { set trimln [tcl::string::trim $ln] switch -- [tcl::string::index $trimln 0] { @@ -510,10 +566,45 @@ tcl::namespace::eval punk::args { error "punk::args::definition - bad *id line. Remaining items on line after *id must be in paired option-value format - received '$linespecs'" } } + parser { + #handle multiple parsing styles based on arities and keyword positions (and/or flags?) + #e.g see lseq manual with 3 different parsing styles. + #aim to produce a table/subtable for each + # *parser -description "start ?('..'|'to')? end ??'by'? step?"\ + # -arities { + # 2 + # {3 anykeys {1 .. 1 to}} + # {4 anykeys {3 by}} + # {5 anykeys {1 .. 1 to 3 by}} + # }\ + # -fallback 1 + # ... + # *parser -description "start 'count' count ??'by'? step?"\ + # -arities { + # {3 anykeys {1 count}} + # } + # ... + # *parser -description "count ?'by' step?"\ + # -arities { + # 1 + # {3 anykeys {1 by}} + # } + # + # see also after manual + # *parser -arities {1} + # *parser -arities { + # 1 anykeys {0 info} + # } + #todo + set parser_info $starspecs + } proc { #allow arbitrary - review set proc_info $starspecs } + doc { + set doc_info $starspecs + } opts { if {$argspace eq "values"} { error "punk::args::definition - *opts declaration must come before *values - received '$linespecs'" @@ -525,13 +616,14 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { #review - only apply to certain types? tcl::dict::set optspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels - -nocase { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels - -nocase { if {$v} { - tcl::dict::unset optspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset optspec_defaults $k2 } } -type { @@ -563,16 +655,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { #allow overriding of defaults for options that occur later tcl::dict::set optspec_defaults $k $v } default { - set known { -any -anyopts -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *opts line. Known keys: $known" } @@ -588,27 +681,28 @@ tcl::namespace::eval punk::args { -min - -minvalues { if {$v < 0} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is 0. got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is 0. got $v" } set leader_min $v - if {$leader_max == 0} { - set leader_max -1 - } + #if {$leader_max == 0} { + # set leader_max -1 + #} } -max - -maxvalues { if {$v < -1} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is -1 (indicating unlimited). got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is -1 (indicating unlimited). got $v" } set leader_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set leaderspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset leaderspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset leaderspec_defaults $k2 } } -type { @@ -640,16 +734,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set leaderspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *leaders line. Known keys: $known" } @@ -675,13 +770,14 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set valspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset valspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset valspec_defaults $k2 } } -type { @@ -713,16 +809,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set valspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *values line. Known keys: $known" } @@ -754,7 +851,7 @@ tcl::namespace::eval punk::args { if {$argspace eq "leaders"} { tcl::dict::set argspecs -ARGTYPE leader lappend leader_names $argname - if {$leader_max == 0} { + if {$leader_max >= 0} { set leader_max [llength $leader_names] } } else { @@ -819,11 +916,12 @@ tcl::namespace::eval punk::args { } } } - -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - + -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - - -regexprepass - -regexprefail + -regexprepass - -regexprefail - -regexprefailmsg { - #review -solo 1 vs -type none ? + #inverses '-noxxx' (e.g -nochoices -nominsize etc) don't apply to specific args - only to *leaders *opts *values lines + #review -solo 1 vs -type none ? conflicting values? tcl::dict::set spec_merged $spec $specval } -validationtransform { @@ -833,10 +931,10 @@ tcl::namespace::eval punk::args { } dict for {tk tv} $specval { switch -- $tk { - -function - -type - -minlen - -maxlen - -range { + -function - -type - -minsize - -maxsize - -range { } default { - set known_transform_keys [list -function -type -minlen -maxlen -range] ;#-choices etc? + set known_transform_keys [list -function -type -minsize -maxsize -range] ;#-choices etc? error "punk::args::definition - invalid subkey $tk for key '$spec' in specifications for argument '$argname' must be one of: $known_transform_keys" } } @@ -844,9 +942,9 @@ tcl::namespace::eval punk::args { } default { - set known_argspecs [list -default -type -range -choices -choiceprefix -choicerestricted\ + set known_argspecs [list -default -type -range -minsize -maxsize -choices -choiceprefix -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] error "punk::args::definition - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } @@ -854,9 +952,9 @@ tcl::namespace::eval punk::args { } set argspecs $spec_merged if {$is_opt} { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } else { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } tcl::dict::set arg_info $argname $argspecs tcl::dict::set arg_checks $argname $argchecks @@ -886,11 +984,21 @@ tcl::namespace::eval punk::args { } # REVIEW - foreach leadername [lrange $leader_names 0 end] { - if {[tcl::dict::get $arg_info $leadername -multiple]} { - error "bad key -multiple on argument spec for leader '$valname'. Only the last value argument specification can be marked -multiple" + #if {[llength $val_names] || $val_min > 0} { + # #some values are specified + # foreach leadername [lrange $leader_names 0 end] { + # if {[tcl::dict::get $arg_info $leadername -multiple]} { + # error "bad key -multiple on argument spec for leader '$leadername'. Last leader argument specification can be marked -multiple only when no values are specified" + # } + # } + #} else { + #no values specified - we can allow last leader to be multiple + foreach leadername [lrange $leader_names 0 end-1] { + if {[tcl::dict::get $arg_info $leadername -multiple]} { + error "bad key -multiple on argument spec for leader '$leadername'. Only the last leader argument specification can be marked -multiple" + } } - } + #} #confirm any valnames before last don't have -multiple key foreach valname [lrange $val_names 0 end-1] { if {[tcl::dict::get $arg_info $valname -multiple]} { @@ -906,11 +1014,11 @@ tcl::namespace::eval punk::args { #todo - do some checks for obvious bad definitions involving a mix of *leaders and *values (e.g with optional options) - set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize - set result [tcl::dict::create\ + set argdata_dict [tcl::dict::create\ id $spec_id\ arg_info $arg_info\ arg_checks $arg_checks\ @@ -936,24 +1044,31 @@ tcl::namespace::eval punk::args { valspec_defaults $valspec_defaults\ val_checks_defaults $val_checks_defaults\ proc_info $proc_info\ + doc_info $doc_info\ id_info $id_info\ ] - tcl::dict::set argspec_cache $cache_key $result - #tcl::dict::set argspecs $spec_id $optionspecs - tcl::dict::set argspec_ids $spec_id $optionspecs + tcl::dict::set argdata_cache $cache_key $argdata_dict + if {$is_dynamic} { + #also cache resolved version + tcl::dict::set argdata_cache $optionspecs $argdata_dict + } + #tcl::dict::set argdefcache_by_id $spec_id $optionspecs + tcl::dict::set argdefcache_by_id $spec_id $args #puts "xxx:$result" - return $result + return $argdata_dict } proc get_spec {id {patternlist *}} { - variable argspec_ids - if {[tcl::dict::exists $argspec_ids $id]} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { if {$patternlist eq "*"} { - return [tcl::dict::get $argspec_ids $id] + #todo? + return [tcl::dict::get $argdefcache_by_id $realid] } else { - set spec [tcl::dict::get $argspec_ids $id] + set speclist [tcl::dict::get $argdefcache_by_id $realid] set result "" - set specdict [definition $spec] + set specdict [uplevel 1 [list ::punk::args::definition {*}$speclist]] set arg_info [dict get $specdict arg_info] foreach pat $patternlist { set matches [dict keys $arg_info $pat] @@ -968,13 +1083,128 @@ tcl::namespace::eval punk::args { } return } + proc get_spec_values {id {patternlist *}} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { + set speclist [tcl::dict::get $argdefcache_by_id $realid] + set specdict [definition {*}$speclist] + set arg_info [dict get $specdict arg_info] + set valnames [dict get $specdict val_names] + set result "" + if {$patternlist eq "*"} { + foreach v $valnames { + set def [dict get $arg_info $v] + set def [dict remove $def -ARGTYPE] + append result \n "$v $def" + } + } else { + foreach pat $patternlist { + set matches [dict keys $arg_info $pat] + set matches [lsearch -all -inline -glob $valnames $pat] + foreach m $matches { + set def [dict get $arg_info $m] + set def [dict remove $def -ARGTYPE] + append result \n "$m $def" + } + } + return $result + } + } + return + } #proc get_spec_leaders ?? #proc get_spec_opts ?? - #proc get_spec_values ?? - proc get_spec_ids {{match *}} { - variable argspec_ids - return [tcl::dict::keys $argspec_ids $match] + variable aliases + set aliases [dict create] + + lappend PUNKARGS [list { + *id punk::args::get_ids + *proc -name punk::args::get_ids -help\ + "return list of ids for argument definitions" + *values -min 0 -max 1 + match -default * -help\ + "exact id or glob pattern for ids" + }] + proc get_ids {{match *}} { + variable argdefcache_by_id + variable aliases + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + } + proc id_exists {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + return 1 + } + tcl::dict::exists $argdefcache_by_id $id + } + proc set_alias {alias id} { + variable aliases + dict set aliases $alias $id + } + proc unset_alias {alias} { + variable aliases + dict unset aliases $alias + } + proc get_alias {alias} { + variable aliases + if {[dict exists $aliases $alias]} { + return [tcl::dict::get $aliases $alias] + } + } + + proc real_id {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } else { + if {![llength [update_definitions]]} { + return "" + } else { + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } + return "" + } + } + } + + variable loaded_packages + set loaded_packages [list] + + proc update_definitions {} { + variable loaded_packages + upvar ::punk::args::register::NAMESPACES pkgs + if {[llength $loaded_packages] == [llength $pkgs]} { + #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + return {} + } + set unloaded [punklib_ldiff $pkgs $loaded_packages] + set newloaded [list] + foreach pkgns $unloaded { + if {![catch { + if {[info exists ${pkgns}::PUNKARGS]} { + foreach deflist [set ${pkgns}::PUNKARGS] { + namespace eval $pkgns [list punk::args::definition {*}$deflist] + } + } + } errMsg]} { + lappend loaded_pkgs $pkgns + lappend newloaded $pkgns + } else { + puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" + } + } + return $newloaded } #for use within get_dict only @@ -1018,253 +1248,408 @@ tcl::namespace::eval punk::args { #basic recursion blocker variable arg_error_isrunning 0 - proc arg_error {msg spec_dict {badarg ""}} { + proc arg_error {msg spec_dict args} { + if {[catch {package require punk::ansi}]} { + proc punk::args::a {args} {} + proc punk::args::a+ {args} {} + } else { + namespace eval ::punk::args { + namespace import ::punk::ansi::a ::punk::ansi::a+ + } + } #limit colours to standard 16 so that themes can apply to help output variable arg_error_isrunning if {$arg_error_isrunning} { - error "arg_error already running - error in arg_error?\n triggering errmsg: $badarg" + error "arg_error already running - error in arg_error?\n triggering errmsg: $msg" } set arg_error_isrunning 1 + if {[llength $args] %2 != 0} { + error "error in arg_error processing - expected opt/val pairs after msg and spec_dict" + } + set badarg "" + set returntype error + dict for {k v} $args { + switch -- $k { + -badarg { + set badarg $v + } + -return { + if {$v ni {error string}} { + error "arg_error invalid value for option -return. Received '$v' expected one of: error string" + } + set returntype $v + } + default { + error "arg_error invalid option $k. Known_options: -badarg -return" + } + } + } + + #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error #e.g list_as_table # use basic colours here to support terminals without extended colours - #todo - add checks column (e.g -minlen -maxlen) + #todo - add checks column (e.g -minsize -maxsize) set errmsg $msg if {![catch {package require textblock}]} { - if {[catch { + set has_textblock 1 + } else { + set has_textblock 0 + #couldn't load textblock package + #just return the original errmsg without formatting + } + set errlines [list] ;#for non-textblock output + if {[catch { + if {$has_textblock} { append errmsg \n - set procname [::punk::args::Dict_getdef $spec_dict proc_info -name ""] - set prochelp [::punk::args::Dict_getdef $spec_dict proc_info -help ""] + } else { + append errmsg \n "[a+ brightred](layout package textblock is missing)[a]" \n + } + set procname [Dict_getdef $spec_dict proc_info -name ""] + set prochelp [Dict_getdef $spec_dict proc_info -help ""] - set t [textblock::class::table new [a+ brightyellow]Usage[a]] + set docname [Dict_getdef $spec_dict doc_info -name "Manual:"] + set docurl [Dict_getdef $spec_dict doc_info -url ""] - set blank_header_col [list ""] - if {$procname ne ""} { - lappend blank_header_col "" - set procname_display [a+ brightwhite]$procname[a] - } else { - set procname_display "" - } - if {$prochelp ne ""} { - lappend blank_header_col "" - set prochelp_display [a+ brightwhite]$prochelp[a] - } else { - set prochelp_display "" - } + + set blank_header_col [list ""] + if {$procname ne ""} { + lappend blank_header_col "" + set procname_display [a+ brightwhite]$procname[a] + } else { + set procname_display "" + } + if {$prochelp ne ""} { + lappend blank_header_col "" + set prochelp_display [a+ brightwhite]$prochelp[a] + } else { + set prochelp_display "" + } + if {$docurl ne ""} { + lappend blank_header_col "" + set docurl_display [a+ white]$docurl[a] + } else { + set docurl_display "" + } + if {$has_textblock} { + set t [textblock::class::table new [a+ brightyellow]Usage[a]] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col - if {"$procname$prochelp" eq ""} { - $t configure_header 0 -values {Arg Type Default Multi Help} - } elseif {$procname eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 1 -values {Arg Type Default Multi Help} - } elseif {$prochelp eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -values {Arg Type Default Multi Help} + } + set h 0 + if {$procname ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] + } else { + lappend errlines "PROC/METHOD: $procname_display" + } + incr h + } + if {$prochelp ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] } else { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 2 -values {Arg Type Default Multi Help} + lappend errlines "Description: $prochelp_display" + } + incr h + } + if {$docurl ne ""} { + if {![catch {package require punk::ansi}]} { + set docurl [punk::ansi::hyperlink $docurl] } + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list $docname $docurl_display] + } else { + lappend errlines "$docname $docurl_display" + } + incr h + } + if {$has_textblock} { + $t configure_header $h -values {Arg Type Default Multi Help} + } else { + lappend errlines " --ARGUMENTS-- " + } + + set RST [a] + #set A_DEFAULT [a+ brightwhite Brightgreen] + set A_DEFAULT "" + set A_BADARG [a+ brightred] + set greencheck [a+ brightgreen]\u2713[a] ;#green tick + set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set A_PREFIX [a+ green] ;#use a+ so colour off can apply + if {$A_PREFIX eq ""} { + set A_PREFIX [a+ underline] + set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + } else { + set A_PREFIXEND $RST + } - set RST [a] - #set A_DEFAULT [a+ brightwhite Brightgreen] - set A_DEFAULT "" - set A_BADARG [a+ brightred] - set greencheck [a+ brightgreen]\u2713[a] ;#green tick - set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) - set A_PREFIX [a+ green] ;#use a+ so colour off can apply - if {$A_PREFIX eq ""} { - set A_PREFIX [a+ underline] - set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + set opt_names [list] + set opt_names_display [list] + if {[llength [dict get $spec_dict opt_names]]} { + if {![catch {package require punk::trie}]} { + set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $spec_dict opt_names] { + set id [dict get $idents $c] + #REVIEW + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail + #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] + lappend opt_names $c + } } else { - set A_PREFIXEND $RST + set opt_names [dict get $spec_dict opt_names] + set opt_names_display $opt_names } - - set opt_names [list] - set opt_names_display [list] - if {[llength [dict get $spec_dict opt_names]]} { - if {![catch {package require punk::trie}]} { - set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy - foreach c [dict get $spec_dict opt_names] { - set id [dict get $idents $c] - #REVIEW - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] - } - lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail - #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] - lappend opt_names $c - } + } + set leading_val_names [dict get $spec_dict leader_names] + set trailing_val_names [dict get $spec_dict val_names] + + #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { + # if {![string match -* $argname]} { + # lappend leading_val_names [lpop trailing_val_names 0] + # } else { + # break + # } + #} + #if {![llength $leading_val_names] && ![llength $opt_names]} { + # #all vals were actually trailing - no opts + # set trailing_val_names $leading_val_names + # set leading_val_names {} + #} + set leading_val_names_display $leading_val_names + set trailing_val_names_display $trailing_val_names + + #display options first then values + foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { + lassign $argumentset argnames_display argnames + + foreach argshow $argnames_display arg $argnames { + set arginfo [dict get $spec_dict arg_info $arg] + if {[dict exists $arginfo -default]} { + set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" } else { - set opt_names [dict get $spec_dict opt_names] - set opt_names_display $opt_names + set default "" } - } - set leading_val_names [dict get $spec_dict leader_names] - set trailing_val_names [dict get $spec_dict val_names] - - #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { - # if {![string match -* $argname]} { - # lappend leading_val_names [lpop trailing_val_names 0] - # } else { - # break - # } - #} - #if {![llength $leading_val_names] && ![llength $opt_names]} { - # #all vals were actually trailing - no opts - # set trailing_val_names $leading_val_names - # set leading_val_names {} - #} - set leading_val_names_display $leading_val_names - set trailing_val_names_display $trailing_val_names - - #display options first then values - foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { - lassign $argumentset argnames_display argnames - - foreach argshow $argnames_display arg $argnames { - set arginfo [dict get $spec_dict arg_info $arg] - if {[dict exists $arginfo -default]} { - set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" + set help [Dict_getdef $arginfo -help ""] + if {[dict exists $arginfo -choices]} { + if {$help ne ""} {append help \n} + if {[dict get $arginfo -nocase]} { + set casemsg " (case insensitive)" } else { - set default "" + set casemsg " (case sensitive)" } - set help [::punk::args::Dict_getdef $arginfo -help ""] - if {[dict exists $arginfo -choices]} { - if {$help ne ""} {append help \n} - if {[dict get $arginfo -nocase]} { - set casemsg " (case insensitive)" - } else { - set casemsg " (case sensitive)" - } - if {[dict get $arginfo -choiceprefix]} { - set prefixmsg " (choice prefix allowed)" + if {[dict get $arginfo -choiceprefix]} { + set prefixmsg " (choice prefix allowed)" + } else { + set prefixmsg "" + } + set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] + set formattedchoices [list] + append help " Choices$prefixmsg$casemsg" + if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + #append help "\n " [join [dict get $arginfo -choices] "\n "] + if {[dict size $choicelabeldict]} { + foreach c [dict get $arginfo -choices] { + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } } else { - set prefixmsg "" + set formattedchoices [dict get $arginfo -choices] } - set formattedchoices [list] - append help " Choices$prefixmsg$casemsg" - if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + } else { + if {[catch { + set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $arginfo -choices] { + set id [dict get $idents $c] + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + set cdisplay "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } + } errM]} { + puts stderr "prefix marking failed\n$errM" #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - } else { - if {[catch { - set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy + if {[dict size $choicelabeldict]} { foreach c [dict get $arginfo -choices] { - set id [dict get $idents $c] - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] } - lappend formattedchoices "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" - } - } errM]} { - puts stderr "prefix marking failed\n$errM" - #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - - } - } - set numcols 4 - if {[llength $formattedchoices] < $numcols} { - #don't show blank cells if single line of results - set numcols [llength $formattedchoices] - } - #risk of recursing - set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] - append help \n[textblock::join -- " " $choicetable] - #review. use -type to restrict additional choices - may be different to values in the -choices - if {![dict get $arginfo -choicerestricted]} { - if {[dict get $arginfo -type] eq "string"} { - append help "\n (values not in defined choices are allowed)" + lappend formattedchoices $cdisplay + } } else { - append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + set formattedchoices [dict get $arginfo -choices] } + } } - if {[::punk::args::Dict_getdef $arginfo -multiple 0]} { - set multiple $greencheck - } else { - set multiple "" + set numcols 4 ;#todo - dynamic? + if {[llength $formattedchoices] < $numcols} { + #don't show blank cells if single line of results + set numcols [llength $formattedchoices] } - if {[::punk::args::Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { - set argshow "?${argshow}?" + if {$numcols > 0} { + if {$has_textblock} { + #risk of recursing + set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] + append help \n[textblock::join -- " " $choicetable] + } else { + append help \n [join $formattedchoices \n] + } + } else { + #we were given an empty set of choices. + #probably an error in the definition - but could happen if dynamically generated. + #(e.g ensemble where unknown mechanism is used for subcommands?) + #better to just display that there were none rather than totally break the usage output. + append help \n " " [a+ red](no choices defined)[a] } - set typeshow [dict get $arginfo -type] - if {$typeshow eq "none"} { - set typeshow "$typeshow $soloflag" + + #review. use -type to restrict additional choices - may be different to values in the -choices + if {![dict get $arginfo -choicerestricted]} { + if {[dict get $arginfo -type] eq "string"} { + append help "\n (values not in defined choices are allowed)" + } else { + append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + } } + } + if {[Dict_getdef $arginfo -multiple 0]} { + set multiple $greencheck + } else { + set multiple "" + } + if {[Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { + set argshow "?${argshow}?" + } + set typeshow [dict get $arginfo -type] + if {$typeshow eq "none"} { + set typeshow "$typeshow $soloflag" + } + if {[dict exists $arginfo -minsize]} { + append typeshow \n "-minsize [dict get $arginfo -minsize]" + } + if {[dict exists $arginfo -maxsize]} { + append typeshow \n "-maxsize [dict get $arginfo -maxsize]" + } + if {[dict exists $arginfo -range]} { + append typeshow \n "-range [dict get $arginfo -range]" + } + + if {$has_textblock} { $t add_row [list $argshow $typeshow $default $multiple $help] if {$arg eq $badarg} { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_BADARG } + } else { + #review - formatting will be all over the shop due to newlines in typesshow, help + lappend errlines "$argshow TYPE:$typeshow DEFAULT:$default MULTI:$multiple HELP:$help\n" } } + } - - #$t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ web-white] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] + if {$has_textblock} { $t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ brightwhite] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] $t configure -maxwidth 80 append errmsg [$t print] $t destroy - } errM]} { - catch {$t destroy} - append errmsg \n - append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n - append errmsg "$errM" \n - append errmsg "$::errorInfo" - + } else { + append errmsg [join $errlines \n] } - } else { - #couldn't load textblock package - #just return the original errmsg without formatting + } errM]} { + catch {$t destroy} + append errmsg \n + append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n + append errmsg "$errM" \n + append errmsg "$::errorInfo" + } set arg_error_isrunning 0 #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. #Also,we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;) - return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + if {$returntype eq "error"} { + return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + } else { + return $errmsg + } } - #todo - a version of get_dict that supports punk::lib::tstr templating - #rename get_dict - #provide ability to look up and reuse definitions from ids etc - # + lappend PUNKARGS [list { + *id punk::args::usage + *proc -name punk::args::usage -help\ + "return usage information as a string + in table form." + *values -min 0 -max 1 + id -help\ + "exact id. + Will usually match the command name" + }] + proc usage {id} { + set speclist [get_spec $id] + if {[llength $speclist] == 0} { + error "punk::args::usage - no such id: $id" + } + arg_error "" [uplevel 1 [list punk::args::definition {*}$speclist]] -return string + } + + lappend PUNKARGS [list { + *id punk::args::get_by_id + *proc -name punk::args::get_by_id + *values -min 1 + id + arglist -default "" -type list -help\ + "list containing arguments to be parsed as per the + argument specification identified by the supplied id." + }] proc get_by_id {id {arglist ""}} { - set spec [get_spec $id] - if {$spec eq ""} { + set speclist [punk::args::get_spec $id] + if {[llength $speclist] == 0} { error "punk::args::get_by_id - no such id: $id" } - return [get_dict $spec $arglist] + return [uplevel 1 [list ::punk::args::get_dict {*}$speclist $arglist]] } + #todo? - a version of get_dict that directly supports punk::lib::tstr templating + #rename get_dict + # + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. #only supports -flag val pairs, not solo options #If an option is supplied multiple times - only the last value is used. - proc get_dict {optionspecs args} { + proc get_dict {args} { #*** !doctools - #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[call [fun get_dict] [arg optionspecs] [arg rawargs]] #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values #[para]Returns a dict of the form: opts values #[para]ARGUMENTS: @@ -1297,48 +1682,53 @@ tcl::namespace::eval punk::args { # *values -multiple 1 #} $args - if {[llength $args] == 0} { - set rawargs [list] - } elseif {[llength $args] ==1} { - set rawargs [lindex $args 0] ;#default tcl style - } else { - #todo - can we support tk style vals before flags? - #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order - #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. - #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options - #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. - #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. - error "unsupported number of arguments for punk::args::get_dict" - set inopt 0 - set k "" - set i 0 - foreach a $args { - switch -- $f { - -opts { - - } - -vals { - - } - -optvals { - #tk style - - } - -valopts { - #tcl style - set rawargs [lindex $args $i+1] - incr i - } - default { - - } - } - incr i - } + #if {[llength $args] == 0} { + # set rawargs [list] + #} elseif {[llength $args] ==1} { + # set rawargs [lindex $args 0] ;#default tcl style + #} else { + # #todo - can we support tk style vals before flags? + # #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + # #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + # #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + # #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + # #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + # error "unsupported number of arguments for punk::args::get_dict" + # set inopt 0 + # set k "" + # set i 0 + # foreach a $args { + # switch -- $f { + # -opts { + + # } + # -vals { + + # } + # -optvals { + # #tk style + + # } + # -valopts { + # #tcl style + # set rawargs [lindex $args $i+1] + # incr i + # } + # default { + + # } + # } + # incr i + # } + #} + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] } + set rawargs [lindex $args end] ;# args values to be parsed + set def_args [lrange $args 0 end-1] - - set argspecs [definition $optionspecs] + set argspecs [uplevel 1 [list ::punk::args::definition {*}$def_args]] tcl::dict::with argspecs {} ;#turn keys into vars #puts "-arg_info->$arg_info" set flagsreceived [list] ;#for checking if required flags satisfied @@ -1354,52 +1744,123 @@ tcl::namespace::eval punk::args { # todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ? set opts $opt_defaults set pre_values {} - #dict for {a info} $arg_info { - # #todo - flag for possible subhandler - whether leading - or not (shellfilter concept) - # if {![string match -* $a]} { - # #lappend pre_values [lpop rawargs 0] - # if {[catch {lpop rawargs 0} val]} { - # break - # } else { - # lappend pre_values $val - # } - # } else { - # break - # } - #} - set argnames [dict keys $arg_info] + set argnames [tcl::dict::keys $arg_info] set optnames [lsearch -all -inline $argnames -*] set ridx 0 set rawargs_copy $rawargs + set leader_posn_name "" + set leader_posn_names_assigned [dict create] ;#track if the name got a value (or multiple if last one) + set is_multiple 0 ;#last leader may be multi if {$leader_max != 0} { foreach r $rawargs_copy { - if {$leader_max != -1 && $ridx > $leader_max-1} { + if {$leader_max ne "" && $leader_max != -1 && $ridx > $leader_max-1} { break } - if {[string match -* $r]} { - if {$r eq "--"} { - break + if {$ridx == [llength $leader_names]-1} { + #at last named leader + set leader_posn_name [lindex $leader_names $ridx] + if {[dict exists $arg_info $leader_posn_name -multiple] && [dict get $arg_info $leader_posn_name -multiple]} { + set is_multiple 1 } + } elseif {$ridx > [llength $leader_names]-1} { + #beyond names - retain name if -multiple was true + if {!$is_multiple} { + set leader_posn_name "" + } + } else { + set leader_posn_name [lindex $leader_names $ridx] ;#may return empty string + } + if {$r eq "--"} { + #review end of opts marker: '--' can't be a leader (but can be a value) + break + } + + #argument such as a dictionary may have leading dash - test for whitespace to exclude as possible option + if {[tcl::string::match -* $r] && !([tcl::string::first " " $r]>=0 || [tcl::string::first \t $r]>=0 || [tcl::string::last \n $r]>=0)} { set matchopt [::tcl::prefix::match -error {} $optnames $r] if {$matchopt ne ""} { #flaglike matches a known flag - don't treat as leader break } - if {![string match -* [lindex $argnames $ridx]]} { + #if {![string match -* [lindex $argnames $ridx]]} {} + if {$leader_posn_name ne ""} { #there is a named leading positional for this position + #The flaglooking value doesn't match an option - so treat as a leader lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name incr ridx continue } else { break } } - lappend pre_values [lpop rawargs 0] + + #for each branch - break or lappend + if {$leader_posn_name ne ""} { + if {$leader_posn_name ni $leader_required} { + #optional leader + + #most adhoc arg processing will allocate based on number of args rather than matching choice values first + #(because a choice value could be a legitimate data value) + + #review - option to process in this manner? + #first check if the optional leader value is a match for a choice ? + #if {[dict exists $arg_info $leader_posn_name -choices]} { + # set vmatch [tcl::prefix match -error "" [dict get $arg_info $leader_posn_name -choices] [lindex $rawargs 0]] + # if {$vmatch ne ""} { + # #If we match a choice for this named position - allocated it regardless of whether enough args for trailing values + # lappend pre_values [lpop rawargs 0] + # incr ridx + # continue + # } + #} + + #check if enough rawargs to fill any required values + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } else { + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #required + if {[dict exists $leader_posn_names_assigned $leader_posn_name]} { + #already accepted at least one value - requirement satisfied - now equivalent to optional + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } + } + #if we didn't break - requirement is not yet satisfied, or is satisfied but stil enough rawargs for required values + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #unnamed leader + if {$leader_min ne "" } { + if {$ridx > $leader_min} { + break + } else { + #haven't reached leader_min + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + break + } + } + incr ridx } } + if {$leader_min eq ""} { + set leader_min 0 + } + if {$leader_max eq ""} { + set leader_max -1 + } + #assert leader_max leader_min are numeric #assert - rawargs has been reduced by leading positionals set leaders [list] @@ -1429,7 +1890,8 @@ tcl::namespace::eval punk::args { break } - if {[tcl::string::match -* $a]} { + #exlude argument with whitespace from being a possible option e.g dict + if {[tcl::string::match -* $a] && !([tcl::string::first " " $a]>=0 || [tcl::string::first \t $a]>=0 || [tcl::string::last \n $a]>=0)} { if {$a eq "--"} { #remaining num args <= val_min already covered above if {$val_max != -1} { @@ -1467,14 +1929,12 @@ tcl::namespace::eval punk::args { } set flagval [lindex $rawargs $i+1] - if {[dict get $arg_info $fullopt -multiple]} { + if {[tcl::dict::get $arg_info $fullopt -multiple]} { #don't lappend to default - we need to replace if there is a default - #review - what if user sets first value that happens to match a default? - if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} { - #first occurrence of this flag, whilst stored value matches default + if {$fullopt ni $flagsreceived} { tcl::dict::set opts $fullopt [list $flagval] } else { - tcl::dict::lappend opts $fullopt $flagval + tcl::dict::lappend opts $fullopt $flagval } } else { tcl::dict::set opts $fullopt $flagval @@ -1482,13 +1942,13 @@ tcl::namespace::eval punk::args { #incr i to skip flagval incr vals_remaining_possible -2 if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs $fullopt + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt } } else { #solo if {[tcl::dict::get $arg_info $fullopt -multiple]} { - if {[tcl::dict::get $opts $fullopt] == 0} { - #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + if {$fullopt ni $flagsreceived} { + #override any default - don't lappend to it tcl::dict::set opts $fullopt 1 } else { tcl::dict::lappend opts $fullopt 1 @@ -1526,7 +1986,7 @@ tcl::namespace::eval punk::args { } lappend flagsreceived $a ;#adhoc flag as supplied if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs $a + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a } incr vals_remaining_possible -2 } else { @@ -1543,9 +2003,12 @@ tcl::namespace::eval punk::args { incr vals_remaining_possible -1 } } else { - #set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] - set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" - arg_error $errmsg $argspecs $fullopt + if {[llength $opt_names]} { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" + } else { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": No options defined while *opts -any 0" + } + arg_error $errmsg $argspecs -badarg $fullopt } } } @@ -1571,6 +2034,7 @@ tcl::namespace::eval punk::args { set positionalidx 0 ;#index for unnamed positionals (both leaders and values) set ldridx 0 + set in_multiple "" set leadernames_received [list] set leaders_dict $leader_defaults set num_leaders [llength $leaders] @@ -1579,13 +2043,26 @@ tcl::namespace::eval punk::args { break } if {$leadername ne ""} { - tcl::dict::set leaders_dict $leadername $ldr + if {[tcl::dict::get $arg_info $leadername -multiple]} { + if {[tcl::dict::exists $leader_defaults $leadername]} { + tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list + } else { + tcl::dict::lappend leaders_dict $leadername $ldr + } + set in_multiple $leadername + } else { + tcl::dict::set leaders_dict $leadername $ldr + } lappend leadernames_received $leadername } else { - tcl::dict::set leaders_dict $positionalidx $ldr - tcl::dict::set arg_info $positionalidx $leaderspec_defaults - tcl::dict::set arg_checks $positionalidx $leader_checks_defaults - lappend leadernames_received $positionalidx + if {$in_multiple ne ""} { + tcl::dict::lappend leaders_dict $in_multiple $ldr + } else { + tcl::dict::set leaders_dict $positionalidx $ldr + tcl::dict::set arg_info $positionalidx $leaderspec_defaults + tcl::dict::set arg_checks $positionalidx $leader_checks_defaults + lappend leadernames_received $positionalidx + } } incr ldridx incr positionalidx @@ -1602,7 +2079,7 @@ tcl::namespace::eval punk::args { } if {$valname ne ""} { if {[tcl::dict::get $arg_info $valname -multiple]} { - if {[tcl::dict::exists $val_defaults $valname] && ([tcl::dict::get $val_defaults $valname] eq [tcl::dict::get $values_dict $valname])} { + if {[tcl::dict::exists $val_defaults $valname]} { #current stored val equals defined default - don't include default in the list we build up tcl::dict::set values_dict $valname [list $val] ;#important to treat first element as a list } else { @@ -1663,12 +2140,12 @@ tcl::namespace::eval punk::args { #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW + #We SHOULD? always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - #safe interp note - cannot avoid struct::set difference ensemble as it could be c or tcl implementation and we don't have an option to call directly? + #safe interp note - struct::set difference ensemble could be c or tcl implementation and we don't have an option to call directly? #example timing difference: #struct::set difference {x} {a b} #normal interp 0.18 u2 vs safe interp 9.4us @@ -1683,7 +2160,7 @@ tcl::namespace::eval punk::args { arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs } if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} { - arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs + arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs } if {[llength [set missing [punklib_ldiff $val_required $valnames_received]]]} { arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs @@ -1714,7 +2191,7 @@ tcl::namespace::eval punk::args { set type [tcl::dict::get $thisarg -type] set has_choices [tcl::dict::exists $thisarg -choices] set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [punk::args::Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 set validationtransform [tcl::dict::get $thisarg -validationtransform] @@ -1814,7 +2291,7 @@ tcl::namespace::eval punk::args { } else { set prefixmsg "" } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } } incr idx @@ -1868,21 +2345,21 @@ tcl::namespace::eval punk::args { list { foreach e_check $vlist_check { if {![tcl::string::is list -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[llength $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -minlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[llength $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -maxlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1922,28 +2399,33 @@ tcl::namespace::eval punk::args { foreach e $remaining_e e_check $remaining_e_check { #puts "----> checking $e vs regex $regexprefail" if {[regexp $regexprefail $e]} { - arg_error "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" $argspecs $argname + if {[tcl::dict::exists $thisarg -regexprefailmsg]} { + set msg [tcl::dict::get $thisarg -regexprefailmsg] + } else { + set msg "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" + } + arg_error $msg $argspecs -badarg $argname } } } switch -- $type { ansistring { - #we need to respect -validate_ansistripped for -minlen etc, but the string must contain ansi + #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi #.. so we need to look at the original values in $vlist not $vlist_check #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - #The ansicodes only case should be covered by -minlen 0 -maxlen 0 combined with -validate_ansistripped ??? + #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? package require punk::ansi foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { - arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname } } } globstring { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { - arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname } } } @@ -1955,16 +2437,16 @@ tcl::namespace::eval punk::args { #dict for {checkopt checkval} $thisarg_checks {} tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::string::length $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::string::length $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1981,31 +2463,31 @@ tcl::namespace::eval punk::args { if {$low eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #lowside unspecified - check only high if {$e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname } } } elseif {$high eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #highside unspecified - check only low if {$e_check < $low} { - arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname } } } else { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #high and low specified if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname } } } @@ -2013,7 +2495,7 @@ tcl::namespace::eval punk::args { } else { foreach e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname } } } @@ -2033,7 +2515,7 @@ tcl::namespace::eval punk::args { #todo - empty string for low or high lassign $checkval low high if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname } } } @@ -2044,28 +2526,28 @@ tcl::namespace::eval punk::args { bool { foreach e_check $vlist_check { if {![tcl::string::is boolean -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname } } } dict { foreach e_check $vlist_check { if {[llength $e_check] %2 != 0} { - arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::dict::size $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -minlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::dict::size $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -maxlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -2089,7 +2571,7 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname } } } @@ -2101,19 +2583,19 @@ tcl::namespace::eval punk::args { #//review - we may need '?' char on windows if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} { #what about special file names e.g on windows NUL ? - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname } } if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { if {![file exists $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname } } } elseif {$type eq "existingdirectory"} { foreach e $vlist e_check $vlist_check { if {![file isdirectory $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname } } } @@ -2121,7 +2603,7 @@ tcl::namespace::eval punk::args { char { foreach e $vlist e_check $vlist_check { if {[tcl::string::length $e_check] != 1} { - arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname } } } @@ -2161,7 +2643,14 @@ tcl::namespace::eval punk::args { #maintain order of opts $opts values $values as caller may use lassign. set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received] - set received_posns [concat {*}[lmap a $receivednames b [zero_to_n [expr {[llength $receivednames]-1}]] {list $a $b}]] ;#flat zip named with overall posn including opts + if {[llength $receivednames]} { + #flat zip of names with overall posn, including opts + #set received_posns [concat {*}[lmap a $receivednames b [zero_based_posns [llength $receivednames]] {list $a $b}]] + set i -1 + set received_posns [concat {*}[lmap a $receivednames {list $a [incr i]}]] + } else { + set received_posns [list] + } return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns] } @@ -2173,7 +2662,7 @@ tcl::namespace::eval punk::args { #} - punk::args::definition { + lappend PUNKARGS [list { *id punk::args::TEST *opts -optional 0 -o1 -default 111 -help "opt 1 mandatory" @@ -2182,7 +2671,7 @@ tcl::namespace::eval punk::args { *values -min 0 -max 1 v -help\ "v1 optional" - } + }] #*** !doctools @@ -2195,8 +2684,9 @@ tcl::namespace::eval punk::args { # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args::lib { + variable PUNKARGS tcl::namespace::export * - tcl::namespace::path [tcl::namespace::parent] + tcl::namespace::path [list [tcl::namespace::parent]] #*** !doctools #[subsection {Namespace punk::args::lib}] #[para] Secondary functions that are part of the API @@ -2209,6 +2699,284 @@ tcl::namespace::eval punk::args::lib { # return 1 #} + proc flatzip {l1 l2} { + concat {*}[lmap a $l1 b $l2 {list $a $b}] + } + + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster, especially for larger ranges + #The internal rep can be an 'arithseries' with no string representation + proc zero_based_posns {count} { + if {$count < 1} {return} + lseq 0 $count-1 + } + } else { + proc zero_based_posns {count} { + if {$count < 1} {return} + lsearch -all [lrepeat $count 0] * + } + } + + + #experiment with equiv of js template literals with ${expression} in templates + #e.g tstr {This is the value of x in calling scope ${$x} !} + #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} + #e.g tstr -allowcommands {This is the value of [lindex $x -1] in calling scope ${[lindex [set x] 0]} !} + lappend PUNKARGS [list { + *id punk::args::lib::tstr + *proc -name punk::args::lib::tstr -help\ + "A rough equivalent of js template literals" + -allowcommands -default -1 -type none -help\ + "if -allowcommands is present, placeholder can contain commands e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -return -default list -choices {dict list string args}\ + -choicelabels { + dict\ + "Return a dict with keys + 'template' and 'params'" + string\ + "Return a single result + being the string with + placeholders substituted." + list\ + "Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + "Return a list where the first + element is a list of template + plaintext secions as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" + } + -eval -default 1 -type boolean -help\ + "Whether to evaluate the \$\{\} placeholders. + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced, or the variable name is likely to collide + with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + *values -min 0 -max 1 + templatestring -help\ + "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + }] + + proc tstr {args} { + #Too hard to fully eat-our-own-dogfood from within punk::args package + # - we use punk::args within the unhappy path only + #set argd [punk::args::get_by_id punk::lib::tstr $args] + #set templatestring [dict get $argd values templatestring] + #set opt_allowcommands [dict get $argd opts -allowcommands] + #set opt_return [dict get $argd opts -return] + #set opt_eval [dict get $argd opts -eval] + + set templatestring [lindex $args end] + set arglist [lrange $args 0 end-1] + set opts [dict create\ + -allowcommands 0\ + -eval 1\ + -return list\ + ] + if {"-allowcommands" in $arglist} { + set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] + dict set opts -allowcommands 1 + } + if {[llength $arglist] % 2 != 0} { + error "punk::args::lib::tstr expected option/value pairs prior to last argument" + } + dict for {k v} $arglist { + set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + switch -- $fullk { + -return - -eval { + dict set opts $fullk $v + } + default { + error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" + } + } + } + set opt_allowcommands [dict get $opts -allowcommands] + set opt_return [dict get $opts -return] + set opt_eval [dict get $opts -eval] + + + set nocommands "-nocommands" + if {$opt_allowcommands == 1} { + set nocommands "" + } + + #set parts [_tstr_split $templatestring] + if {[string first \$\{ $templatestring] < 0} { + set parts [list $templatestring] + } else { + set parts [_parse_tstr_parts $templatestring] + } + set textchunks [list] + #set expressions [list] + set params [list] + set idx 0 + foreach {pt expression} $parts { + lappend textchunks $pt + incr idx ;#pt incr + + #ignore last expression + if {$idx == [llength $parts]} { + break + } + #lappend expressions $expression + if {$opt_eval} { + lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] + } else { + lappend params $expression + } + + incr idx ;#expression incr + } + switch -- $opt_return { + dict { + return [dict create template $textchunks params $params] + } + list { + return [list $textchunks $params] + } + args { + #see example in tstr_test_one + return [list $textchunks {*}$params] + } + string { + set out "" + foreach pt $textchunks param $params { + append out $pt $param + } + return $out + } + default { + } + } + } + #test single placeholder tstr args where single placeholder must be an int + proc tstr_test_one {args} { + set argd [punk::args::get_dict { + *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. + example: + set id 2 + tstr_test_one {*}[tstr -return args {Select * from table where id = \$\{$id\} and etc... ;}] + } + + *values -min 2 -max 2 + template -type list -minsize 2 -maxsize 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - + but the tstr call in the example does this for you, and also passes in the id automatically" + + where -type int -help {Integer param for where clause. tstr mechanism above will pass the id as the second parameter} + } $args] + set template [dict get $argd values template] + set where [dict get $argd values where] + #set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] + set result [string cat [lindex $template 0] $where [lindex $template 1]] + return $result + } + proc _parse_tstr_parts {templatestring} { + if {$templatestring eq ""} { + return [list] + } + set chars [split $templatestring ""] + set in_placeholder 0 + set tchars "" + set echars "" + set parts [list] + set i 0 + foreach ch $chars { + if {!$in_placeholder} { + set nextch [lindex $chars [expr {$i+1}]] + if {"$ch$nextch" eq "\$\{"} { + set in_placeholder 2 ;#2 to signify we just entered placeholder + lappend parts $tchars + set tchars "" + } else { + append tchars $ch + } + } else { + if {$ch eq "\}"} { + if {[tcl::info::complete $echars]} { + set in_placeholder 0 + lappend parts $echars + set echars "" + } else { + append echars $ch + } + } else { + if {$in_placeholder == 2} { + #skip opening bracket + set in_placeholder 1 + } else { + append echars $ch + } + } + } + incr i + } + if {$tchars ne ""} { + lappend parts $tchars + } + if {[llength $parts] % 2 == 0} { + #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list + lappend parts "" + } + return $parts + } + #based on punk::ansi::ta::_perlish_split + proc _tstr_split {text} { + if {$text eq ""} { + return {} + } + set list [list] + set start 0 + #ideally re should allow curlies within but we will probably need a custom parser to do it + #(js allows nested string interpolation) + #set re {\$\{[^\}]*\}} + set re {\$\{(?:(?!\$\{).)*\}} + + #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + puts "e:$matchEnd < s:$matchStart" + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] + incr start + if {$start >= [tcl::string::length $text]} { + break + } + continue + } + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] + set start [expr {$matchEnd+1}] + #? + if {$start >= [tcl::string::length $text]} { + break + } + } + return [lappend list [tcl::string::range $text $start end]] + } #*** !doctools @@ -2216,7 +2984,21 @@ tcl::namespace::eval punk::args::lib { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#usually we would directly call arg definitions near the defining proc, +# so that the proc could directly use the definition in its parsing. +# +#for punk::args we need to make sure the punk::args namespace is fully loaded before calling, so we do it at the end. +#arguably it may be more processor-cache-efficient to do together like this anyway. + +#can't do this - as there is circular dependency with punk::lib +#tcl::namespace::eval punk::args { +# foreach deflist $PUNKARGS { +# punk::args::definition {*}$deflist +# } +# set PUNKARGS "" +#} +lappend ::punk::args::register::NAMESPACES ::punk::args ::punk::args::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -2226,12 +3008,40 @@ tcl::namespace::eval punk::args::system { #[subsection {Namespace punk::args::system}] #[para] Internal functions that are not part of the API + #dict get value with default wrapper for tcl 8.6 + if {[info commands ::tcl::dict::getdef] eq ""} { + #package require punk::lib + #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef + proc Dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::args::system::Dict_getdef "" ::tcl::dict::getdef + } + #name to reflect maintenance - home is punk::lib::ldiff + proc punklib_ldiff {fromlist removeitems} { + if {[llength $removeitems] == 0} {return $fromlist} + set result {} + foreach item $fromlist { + if {$item ni $removeitems} { + lappend result $item + } + } + return $result + } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { + tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version set version 0.1.0 diff --git a/src/bootsupport/modules/punk/config-0.1.tm b/src/bootsupport/modules/punk/config-0.1.tm index 1e4de9ec..493ea5aa 100644 --- a/src/bootsupport/modules/punk/config-0.1.tm +++ b/src/bootsupport/modules/punk/config-0.1.tm @@ -361,11 +361,14 @@ tcl::namespace::eval punk::config { } proc configure {args} { - set argd [punk::args::get_dict { + set argdef { + *id punk::config::configure + *proc -name punk::config::configure -help\ + "UNIMPLEMENTED" *values -min 1 -max 1 whichconfig -type string -choices {startup running stop} - } $args] - + } + set argd [punk::args::get_dict $argdef $args] return "unimplemented - $argd" } @@ -375,6 +378,8 @@ tcl::namespace::eval punk::config { return [punk::lib::showdict $configdata] } + + #e.g # copy running-config startup-config # copy startup-config test-config.cfg @@ -382,16 +387,22 @@ tcl::namespace::eval punk::config { #review - consider the merge vs overwrite feature of some routers.. where copy to running-config does a merge rather than an overwrite #This is to allow partial configs to be loaded to running, whereas a save of running to any target is always a complete configuration proc copy {args} { - set argd [punk::args::get_dict { - *proc -name punk::config::copy -help "Copy a partial or full configuration from one config to another - If a target config has additional settings, then the source config can be considered to be partial with regards to the target. - " - -type -default "" -choices {replace merge} -help "Defaults to merge when target is running-config - Defaults to replace when source is running-config" + set argdef { + *id punk::config::copy + *proc -name punk::config::copy -help\ + "Copy a partial or full configuration from one config to another + If a target config has additional settings, then the source config can be considered to be partial with regards to the target. + " + -type -default "" -choices {replace merge} -help\ + "Defaults to merge when target is running-config + Defaults to replace when source is running-config" *values -min 2 -max 2 - fromconfig -help "running or startup or file name (not fully implemented)" - toconfig -help "running or startup or file name (not fully implemented)" - } $args] + fromconfig -help\ + "running or startup or file name (not fully implemented)" + toconfig -help\ + "running or startup or file name (not fully implemented)" + } + set argd [punk::args::get_dict $argdef $args] set fromconfig [dict get $argd values fromconfig] set toconfig [dict get $argd values toconfig] set fromconfig [string map {-config ""} $fromconfig] diff --git a/src/bootsupport/modules/punk/console-0.1.1.tm b/src/bootsupport/modules/punk/console-0.1.1.tm index 74ee55fd..c4f2bfc4 100644 --- a/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/bootsupport/modules/punk/console-0.1.1.tm @@ -81,6 +81,8 @@ namespace eval punk::console { #*** !doctools #[list_begin definitions] + variable PUNKARGS + variable tabwidth 8 ;#default only - will attempt to detect and set to that configured in terminal #Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently #e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops. @@ -1187,7 +1189,8 @@ namespace eval punk::console { *id punk::console::cell_size -inoutchannels -default {stdin stdout} -type list *values -min 0 -max 1 - newsize -default "" + newsize -default "" -help\ + "character cell pixel dimensions WxH" } proc cell_size {args} { set argd [punk::args::get_by_id punk::console::cell_size $args] diff --git a/src/bootsupport/modules/punk/fileline-0.1.0.tm b/src/bootsupport/modules/punk/fileline-0.1.0.tm index 59ca4d5b..04f3487b 100644 --- a/src/bootsupport/modules/punk/fileline-0.1.0.tm +++ b/src/bootsupport/modules/punk/fileline-0.1.0.tm @@ -1251,6 +1251,16 @@ namespace eval punk::fileline { #[para] Core API functions for punk::fileline #[list_begin definitions] + punk::args::definition { + *id punk::fileline::get_textinfo + *proc -name punk::fileline::get_textinfo -help\ + "return: textinfo object instance" + -file -default {} -type existingfile + -translation -default iso8859-1 + -encoding -default "\uFFFF" + -includebom -default 0 + *values -min 0 -max 1 + } proc get_textinfo {args} { #*** !doctools #[call get_textinfo [opt {option value...}] [opt datachunk]] @@ -1266,14 +1276,7 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes. - set argument_specification { - -file -default {} -type existingfile - -translation -default iso8859-1 - -encoding -default "\uFFFF" - -includebom -default 0 - *values -min 0 -max 1 - } - lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values + lassign [dict values [punk::args::get_by_id punk::fileline::get_textinfo $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] diff --git a/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/bootsupport/modules/punk/lib-0.1.1.tm index ae0f0a67..9ebd2ca2 100644 --- a/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -48,8 +48,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -140,7 +142,7 @@ tcl::namespace::eval punk::lib::check { proc has_tclbug_lsearch_strideallinline {} { #bug only occurs with single -index value combined with -stride -all -inline -subindices #https://core.tcl-lang.org/tcl/tktview/5a1aaa201d - if {[catch {[lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *]} result]} { + if {[catch {lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *} result]} { #we aren't looking for an error result - error most likely indicates tcl too old to support -stride return 0 } @@ -320,7 +322,7 @@ tcl::namespace::eval punk::lib::compat { if {"::lmap" ne [info commands ::lmap]} { #puts stderr "Warning - no built-in lpop" - interp alias {} lpop {} ::punk::lib::compat::lmaptcl + interp alias {} lmap {} ::punk::lib::compat::lmaptcl } #lmap came in Tcl 8.6 - so probably not much need for a tcl forward compatibility version - but here it is anyway proc lmaptcl {varnames list script} { @@ -384,6 +386,7 @@ tcl::namespace::eval punk::lib::compat { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::lib { + variable PUNKARGS tcl::namespace::export * variable has_struct_list set has_struct_list [expr {![catch {package require struct::list}]}] @@ -956,172 +959,9 @@ namespace eval punk::lib { proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a] } - #experiment with equiv of js template literals with ${expression} in templates - #e.g tstr {This is the value of x in calling scope ${$x} !} - #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} - #e.g tstr -allowcommands {This is the value of [lindex $x 0] in calling scope ${[lindex [set x] 0]} !} - proc tstr {args} { - set argd [punk::args::get_dict { - *proc -name punk::lib::tstr -help "A rough equivalent of js template literals" - -allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}" - -return -default list -choices {dict list string} - *values -min 1 -max 1 - templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true" - } $args] - set templatestring [dict get $argd values templatestring] - set opt_allowcommands [dict get $argd opts -allowcommands] - set opt_return [dict get $argd opts -return] - set nocommands "-nocommands" - if {$opt_allowcommands == 1} { - set nocommands "" - } - - #set parts [_tstr_split $templatestring] - set parts [_parse_tstr_parts $templatestring] - set textchunks [list] - #set expressions [list] - set params [list] - set idx 0 - foreach {pt expression} $parts { - lappend textchunks $pt - incr idx ;#pt incr - - #ignore last expression - if {$idx == [llength $parts]} { - break - } - #lappend expressions $expression - lappend params [uplevel 1 [list subst {*}$nocommands $expression]] - - incr idx ;#expression incr - } - switch -- $opt_return { - dict { - return [dict create template $textchunks params $params] - } - list { - return [list $textchunks {*}$params] - } - string { - set out "" - foreach pt $textchunks param $params { - append out $pt $param - } - return $out - } - default { - } - } - } - #test single placeholder tstr args where single placeholder must be an int - proc tstr_test_one {args} { - set argd [punk::args::get_dict { - *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. - example: - set id 2 - tstr_test_one {*}[Tstr {Select * from table where id = ${$id} and etc... ;}] - } - - *values -min 2 -max 2 - template -type list -minlen 2 -maxlen 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - - but the Tstr method above does this for you, and also passes in the id automatically" - - where -type int -help {Integer param for where clause. Tstr mechanism above will pass the id as the second parameter} - } $args] - set template [dict get $argd values template] - set where [dict get $argd values where] - set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] - return $result - } - proc _parse_tstr_parts {templatestring} { - if {$templatestring eq ""} { - return [list] - } - set chars [split $templatestring ""] - set in_placeholder 0 - set tchars "" - set echars "" - set parts [list] - set i 0 - foreach ch $chars { - if {!$in_placeholder} { - set nextch [lindex $chars [expr {$i+1}]] - if {"$ch$nextch" eq "\$\{"} { - set in_placeholder 2 ;#2 to signify we just entered placeholder - lappend parts $tchars - set tchars "" - } else { - append tchars $ch - } - } else { - if {$ch eq "\}"} { - if {[tcl::info::complete $echars]} { - set in_placeholder 0 - lappend parts $echars - set echars "" - } else { - append echars $ch - } - } else { - if {$in_placeholder == 2} { - #skip opening bracket - set in_placeholder 1 - } else { - append echars $ch - } - } - } - incr i - } - if {$tchars ne ""} { - lappend parts $tchars - } - if {[llength $parts] % 2 == 0} { - #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list - lappend parts "" - } - return $parts - } - #based on punk::ansi::ta::_perlish_split - proc _tstr_split {text} { - if {$text eq ""} { - return {} - } - set list [list] - set start 0 - #ideally re should allow curlies within but we will probably need a custom parser to do it - #(js allows nested string interpolation) - #set re {\$\{[^\}]*\}} - set re {\$\{(?:(?!\$\{).)*\}} - - #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code - - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - puts "e:$matchEnd < s:$matchStart" - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - if {$start >= [tcl::string::length $text]} { - break - } - continue - } - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] - set start [expr {$matchEnd+1}] - #? - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } - + + namespace import ::punk::args::lib::tstr + #get info about punk nestindex key ie type: list,dict,undetermined proc nestindex_info {args} { set argd [punk::args::get_dict { @@ -1184,8 +1024,11 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=[punk::ansi::a] " } set argspec [string map [list %sep% $sep] { - *proc -name pdict -help {Print dict keys,values to channel - (see also showdict)} + *id punk::lib::pdict + *proc -name pdict -help\ + "Print dict keys,values to channel + The pdict function operates on variable names - passing the value to the showdict function which operates on values + (see also showdict)" *opts -any 1 @@ -1222,7 +1065,6 @@ namespace eval punk::lib { The second level segement in each pattern switches to a dict operation to retrieve the value by key. When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - The pdict function operates on variable names - passing the value to the showdict function which operates on values } }] #puts stderr "$argspec" @@ -1282,7 +1124,7 @@ namespace eval punk::lib { -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {${$key}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} *values -min 1 -max -1 @@ -1295,6 +1137,7 @@ namespace eval punk::lib { set opt_keysortdirection [dict get $argd opts -keysortdirection] set opt_trimright [dict get $argd opts -trimright] set opt_keytemplates [dict get $argd opts -keytemplates] + puts stderr "---> $opt_keytemplates <---" set opt_ansibase_keys [dict get $argd opts -ansibase_keys] set opt_ansibase_values [dict get $argd opts -ansibase_values] set opt_return [dict get $argd opts -return] @@ -4272,6 +4115,13 @@ tcl::namespace::eval punk::lib::system { #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::system ---}] } + +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } +} +lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm index 26bca4d5..a31da91a 100644 --- a/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm @@ -35,7 +35,7 @@ namespace eval punk::mix::commandset::layout { proc files {{layout ""}} { set argd [punk::args::get_dict { *values -min 1 -max 1 - layout -type string -minlen 1 + layout -type string -minsize 1 } [list $layout]] set allfiles [lib::layout_all_files $layout] diff --git a/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm index 08d103ee..f5a5491e 100644 --- a/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -26,19 +26,21 @@ package require punk::lib namespace eval punk::mix::commandset::loadedlib { namespace export * #search automatically wrapped in * * - can contain inner * ? globs - proc search {args} { - set argspecs { - *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" - -return -type string -default table -choices {table tableobject list lines} - -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help "(unimplemented) Display only those that are 0:absent 1:present 2:both" - -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" - -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" - searchstrings -default * -multiple 1 -help "Names to search for, may contain glob chars (* ?) e.g *lib* + punk::args::definition { + *id punk::mix::commandset::loadedlib::search + *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + -return -type string -default table -choices {table tableobject list lines} + -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ + "(unimplemented) Display only those that are 0:absent 1:present 2:both" + -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" + -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" + searchstrings -default * -multiple 1 -help\ + "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. - eg name -> *name* - " - } - set argd [punk::args::get_dict $argspecs $args] + eg name -> *name*" + } + proc search {args} { + set argd [punk::args::get_by_id punk::mix::commandset::loadedlib::search $args] set searchstrings [dict get $argd values searchstrings] set opts [dict get $argd opts] set opt_return [dict get $opts -return] @@ -179,16 +181,7 @@ namespace eval punk::mix::commandset::loadedlib { return [join $loaded_libs \n] } - proc info {args} { - set argspecs { - *values -min 1 - libname -help "library/package name" - } - set argd [punk::args::get_dict $argspecs $args] - set libname [dict get $argd values libname] - - - + proc info {libname} { if {[catch {package require natsort}]} { set has_natsort 0 } else { diff --git a/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index dd673f38..44627536 100644 --- a/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -137,23 +137,39 @@ namespace eval punk::mix::commandset::module { put stderr "get_template_basefolders WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } } + + + set moduletypes [punk::mix::cli::lib::module_types] + punk::args::definition [subst { + *id punk::mix::commandset::module::new + *proc -name "punk::mix::commandset::module::new" -help\ + "Create a new module file in the appropriate folder within src/modules. + If the name given in the module argument is namespaced, + the necessary subfolder(s) will be used or created." + -project -optional 1 + -version -default "0.1.0" -help\ + "version to use if not specified as part of the module argument. + If a version is specified in the module argument as well as in -version + the higher version number will be used. + " + -license -default + -template -default punk.module + -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} + -force -default 0 -type boolean -help\ + "If set true, will overwrite an existing .tm file if there is one. + If false (default) an error will be raised if there is a conflict." + -quiet -default 0 -type boolean -help\ + "Suppress information messages on stdout" + *values -min 1 -max 1 + module -type string -help\ + "Name of module, possibly including a namespace and/or version number + e.g mynamespace::mymodule-1.0" + }] proc new {args} { set year [clock format [clock seconds] -format %Y] - set moduletypes [punk::mix::cli::lib::module_types] # use \uFFFD because unicode replacement char should consistently render as 1 wide - set argspecs [subst { - -project -default \uFFFD - -version -default \uFFFD - -license -default - -template -default punk.module - -type -default \uFFFD -choices {$moduletypes} - -force -default 0 -type boolean - -quiet -default 0 -type boolean - *values -min 1 -max 1 - module -type string - }] - set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::mix::commandset::module::new $args] + lassign [dict values $argd] leaders opts values received set module [dict get $values module] #set opts [dict merge $defaults $args] @@ -168,13 +184,9 @@ namespace eval punk::mix::commandset::module { # we need this value before looking at the named argument # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_version_supplied [dict get $opts -version] - if {$opt_version_supplied eq "\uFFFD"} { - set opt_version "0.1.0" - } else { - set opt_version $opt_version_supplied - if {![util::is_valid_tm_version $opt_version]} { - error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" - } + set opt_version $opt_version_supplied + if {![util::is_valid_tm_version $opt_version]} { + error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #named argument @@ -194,7 +206,7 @@ namespace eval punk::mix::commandset::module { } else { set vmsg "from -version option: $opt_version_supplied" } - if {$opt_version_supplied ne "\uFFFD"} { + if {"-version" in $received} { if {$vcompare_is_mversion_bigger != 0} { #is bigger or smaller puts stderr "module.new WARNING: version supplied in module argument as well as -version option. Using the higher version number $vmsg" @@ -231,7 +243,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #options # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_project [dict get $opts -project] set testdir [pwd] if {![string length [set projectdir [punk::repo::find_project $testdir]]]} { if {![string length [set projectdir [punk::repo::find_candidate $testdir]]]} { @@ -239,9 +250,10 @@ namespace eval punk::mix::commandset::module { error "module.new unable to create module in projectdir:$projectdir - directory doesn't appear to meet basic standards $msg" } } - if {$opt_project == "\uFFFF"} { + if {![dict exists $received -project]} { set projectname [file tail $projectdir] } else { + set opt_project [dict get $opts -project] set projectname $opt_project if {$projectname ne [file tail $projectdir]} { error "module.new -project '$opt_project' doesn't match detected projectname '$projectname' at path: $projectdir" @@ -309,12 +321,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_type [dict get $opts -type] - if {$opt_type eq "\uFFFD"} { - set opt_type [lindex [punk::mix::cli::lib::module_types] 0] ;#default to plain - } - if {$opt_type ni [punk::mix::cli::lib::module_types]} { - error "module.new - error - unknown -type '$opt_type' known-types: [punk::mix::cli::lib::module_types]" - } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_quiet [dict get $opts -quiet] set opt_force [dict get $opts -force] @@ -407,7 +413,7 @@ namespace eval punk::mix::commandset::module { set podfile $modulefolder/#modpod-$moduletail-$infile_version/$moduletail-$infile_version.tm set has_tm [file exists $tmfile] set has_pod [file exists $podfile] - if {$has_tm && $has_pos} { + if {$has_tm && $has_pod} { #invalid configuration - bomb out error "module.new error: Invalid target configuration found. module folder has both a .tm file $tmfile and a modpod file $podfile. Please delete one of them before trying again." } @@ -448,7 +454,7 @@ namespace eval punk::mix::commandset::module { } set buildversionfile [file join $modulefolder ${moduletail}-buildversion.txt] set existing_build_version "" - if {[file exists $buildversionfile]} { + if {!$opt_force && [file exists $buildversionfile]} { set buildversiondata [punk::mix::util::fcat $buildversionfile] set lines [split $buildversiondata \n] set existing_build_version [string trim [lindex $lines 0]] diff --git a/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/bootsupport/modules/punk/ns-0.1.0.tm index 72691167..880dde53 100644 --- a/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -28,7 +28,7 @@ tcl::namespace::eval ::punk::ns::evaluator { tcl::namespace::eval punk::ns { variable ns_current "::" variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns - namespace export nsjoin nsprefix nstail nsparts nseval nsimport_noclobber corp + namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp catch { package require debug debug define punk.ns.compile @@ -53,6 +53,8 @@ tcl::namespace::eval punk::ns { set nspathcommands 1 } + set ns_or_glob [string map {:::: ::} $ns_or_glob] + #todo - cooperate with repl? set out "" if {$ns_or_glob eq ""} { @@ -64,7 +66,7 @@ tcl::namespace::eval punk::ns { set has_globchars [regexp {[*?]} $ns_or_glob] if {$is_absolute} { if {!$has_globchars} { - if {![tcl::namespace::exists $ns_or_glob]} { + if {![nsexists $ns_or_glob]} { error "cannot change to namespace $ns_or_glob" } set ns_current $ns_or_glob @@ -77,7 +79,7 @@ tcl::namespace::eval punk::ns { } else { if {!$has_globchars} { set nsnext [nsjoin $ns_current $ns_or_glob] - if {![tcl::namespace::exists $nsnext]} { + if {![nsexists $nsnext]} { error "cannot change to namespace $ns_or_glob" } set ns_current $nsnext @@ -157,14 +159,28 @@ tcl::namespace::eval punk::ns { } #todo - walk up each ns - testing for possibly weirdly named namespaces - #review - do we even need it. + #needed to use n/ to change to an oddly named namespace such as ":x" proc nsexists {nspath} { - error "unimplemented" + if {$nspath eq ""} {return 0} + set parts [nsparts $nspath] + if {[lindex $parts 0] ne ""} { + #relative + set ns_caller [uplevel 1 {::namespace current}] + set fq_nspath [nsjoin $ns_caller $nspath] + } else { + set fq_nspath $nspath + } + if {[catch {nseval_ifexists $fq_nspath {}}]} { + return 0 + } else { + return 1 + } } #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal tcl::namespace::eval - but still only a few microseconds.. fine for repl introspection - proc nseval_script {location} { + #WARNING: creates namespaces if they don't exist + proc nseval_getscript {location} { set parts [nsparts $location] if {[lindex $parts 0] eq ""} { lset parts 0 :: @@ -214,21 +230,88 @@ tcl::namespace::eval punk::ns { #set cmd ::punk::pipecmds::nseval_$loc set cmd ::punk::ns::evaluator::eval-$loc if {$cmd ni [info commands $cmd]} { - append body \n [nseval_script $fqns] + append body \n [nseval_getscript $fqns] proc $cmd {script} $body debug.punk.ns.compile {proc $cmd} 2 } tailcall $cmd $script } - proc nschildren {fqns} { - if {![string match ::* $fqns]} { - error "nschildren only accepts a fully qualified namespace" + proc nseval_ifexists {ns script} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set nsfq [nsjoin $nscaller $ns] + } else { + set nsfq $ns + } + set ns_script [nseval_ifexists_getscript $nsfq] + uplevel 1 [list {*}$ns_script $script] + } + proc nseval_ifexists_getscript {location} { + set parts [nsparts $location] + if {[lindex $parts 0] eq ""} { + lset parts 0 :: + } + if {[lindex $parts end] eq ""} { + set parts [lrange $parts 0 end-1] + } + + set body "apply \{{script} \{eval \[string map \[list \$script\] \{" + set i 0 + set tails [lrepeat [llength $parts] ""] + foreach ns $parts { + set cmdlist [list ::punk::ns::eval_no_create $ns] + set t "" + if {$i > 0} { + append body " " + } + append body $cmdlist + if {$i == ([llength $parts] -1)} { + append body " {}" + } + if {$i > 0} { + set t {} + } + lset tails $i $t + incr i + } + append body [join [lreverse $tails] " "] + #puts stdout "tails: $tails" + #puts stdout "i: $i" + set body [string map [list "\{" "\}"] $body] + append body " \}\]\}\}" + return $body + } + proc eval_no_create {ns script} { + uplevel 1 [string map [list $ns $script] { + if {[::tcl::namespace::exists ]} { + ::tcl::namespace::eval {} + } else { + error "no such namespace " + } + }] + } + + + proc nschildren {ns} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set fqns [nsjoin $nscaller $ns] + } else { + set fqns $ns } + #if {![string match ::* $fqns]} { + # error "nschildren only accepts a fully qualified namespace" + #} set parent [nsprefix $fqns] set tail [nstail $fqns] #puts ">>> parent $parent tail $tail" #set nslist [nseval $parent [list ::namespace children $tail]] - set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + #set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + set nslist [nseval_ifexists $parent [list ::tcl::namespace::children $tail]] return [lsort $nslist] } @@ -356,7 +439,16 @@ tcl::namespace::eval punk::ns { set searchns [nsprefix $ns_absolute] ;#the ns within which we want to searchns set searchall [nsjoin $searchns *] ;#will correctly form ::* or ::childns::* - set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + set nsparts [nsparts $searchns] + set weird_ns 0 + if {[lsearch $nsparts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set rawresult [nseval_ifexists $searchns [list info vars]] + } else { + set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + } set matched_fullpath [list] foreach r $rawresult { lappend matched_fullpath [nstail $r] @@ -595,10 +687,21 @@ tcl::namespace::eval punk::ns { return $nslist } + variable usageinfo_char \U1f6c8 + # command has usageinfo e.g from punk::args. todo cmdline, argp, tepam etc? + proc Usageinfo_mark {{ansicodes \UFFEF}} { + variable usageinfo_char + if {$ansicodes eq ""} { + return $usageinfo_char + } elseif {$ansicodes eq "\UFFEF"} { + return " [a+ brightyellow]$usageinfo_char[a]" + } else { + return " [a+ {*}$ansicodes]$usageinfo_char[a]" + } + } #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ @@ -666,6 +769,7 @@ tcl::namespace::eval punk::ns { set interps [list] set coroutines [list] set zlibstreams [list] + set usageinfo [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -742,6 +846,7 @@ tcl::namespace::eval punk::ns { } } } + set usageinfo [dict get $contents usageinfo] } set numchildren [llength $children] @@ -859,7 +964,8 @@ tcl::namespace::eval punk::ns { set cmd_display [list $cmd] ;#wrap in list so empty command is visible (and distinguishable from for example a double-curly command) if {$cmd ni $commands && $cmd in $aliases } { #ordinary un-masked commandless-alias - set c [a+ red bold] + #(original alias name that has been renamed) + set c [a+ red bold strike] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] } else { @@ -869,7 +975,7 @@ tcl::namespace::eval punk::ns { #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias - #assertion member of masked - but we use seencmds instead to detect. + #assertion: member of masked - but we use seencmds instead to detect. set c [a+ yellow bold] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] @@ -901,13 +1007,20 @@ tcl::namespace::eval punk::ns { set prefix [overtype::right $prefix "-[a+ yellow bold]I[a+]"] } } - set cmd$i "${prefix} $c$cmd_display" - set c$i $c + if {$cmd in $usageinfo} { + set u [Usageinfo_mark brightgreen] + } else { + set u "" + } + set cmd$i "${prefix} $c$cmd_display$u" + #set c$i $c + set c$i "" lappend seencmds $cmd } } - lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + #lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + lappend displaylist $a1[overtype::left $col1 $ch1][a]$a1[overtype::left $col2 $ch2][a]$c1[overtype::left $col3 $cmd1][a]$c2[overtype::left $col4 $cmd2][a]$c3[overtype::left $col5 $cmd3][a]$c4$cmd4[a] } return [list_as_lines $displaylist] @@ -917,7 +1030,7 @@ tcl::namespace::eval punk::ns { if {$path_is_absolute} { return $nspath } - set ns_caller [uplevel 1 {::namespace current}] ;#must qualify. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) + set ns_caller [uplevel 1 {::namespace current}] ;#must qualify 'namespace' command. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) if {$nspath eq "\uFFFF"} { return $ns_caller } @@ -936,6 +1049,31 @@ tcl::namespace::eval punk::ns { return [nsjoin $base $nspath] } + set has_textblock [expr {![catch {package require textblock}]}] + + if {$has_textblock} { + interp alias "" ::punk::ns::Block_width "" textblock::width + } else { + #maint - equiv of textblock::width + proc Block_width {textblock} { + if {$textblock eq ""} { return 0 } + if {[tcl::string::last \t $textblock] >=0} { + if {[tcl::info::exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::ansistripraw $textblock] + } + if {[tcl::string::last \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } + return [punk::char::ansifreestring_width $textblock] + } + } proc nslist {{glob "*"} args} { set ns_absolute [uplevel 1 [list ::punk::ns::nspath_here_absolute $glob]] if {[dict exists $args -match]} { @@ -947,7 +1085,6 @@ tcl::namespace::eval punk::ns { -nspathcommands 0\ ] - package require textblock set opts [dict merge $defaults $args] # -- --- --- set opt_nspathcommands [dict get $opts -nspathcommands] @@ -971,11 +1108,11 @@ tcl::namespace::eval punk::ns { set block [get_nslist {*}$opts] #if {[string first \n $block] < 0} { # #single line - # set width [textblock::width [list $block]] + # set width [Block_width [list $block]] #} else { - # set width [textblock::width $block] + # set width [Block_width $block] #} - set width [textblock::width $block] + set width [Block_width $block] #if multiple results or if there is only 1 result - but we are path-globbing - then we need to show location if {$count_with_results > 1 || [regexp {[*?]} [nsprefix $ns_absolute]]} { @@ -998,7 +1135,7 @@ tcl::namespace::eval punk::ns { } } append output $path_text - set path_text_width [textblock::width $path_text] + set path_text_width [Block_width $path_text] append output \n [string repeat - [expr {max($width,$path_text_width)}]] } elseif {$count_with_results > 1 && $width > 0 } { append output \n [string repeat - $width] @@ -1014,9 +1151,44 @@ tcl::namespace::eval punk::ns { #info cmdtype available in 8.7+ #safe interps also seem to have it disabled for some reason + #we need to return "na" if 'info cmdtype' not supported or not functioning due to safe interp etc + #IMPORTANT: don't detect easy types such as proc/import here - caller needs the 'na' to do the proper fallback + #it is not desirable to do a partial cmdtype support here proc cmdtype {cmd} { + #set cmd [namespace which $cmd] ;#will return empty result for empty string command or command such as :x or any command that doesn't exist + set fqcmd [namespace which $cmd] ;#will resolve for example 'namespace path' reachable commands + if {$fqcmd eq ""} { + #e.g ::ns:::x will return empty result from namespace which even if :x is a command in ::ns + set where [nsprefix $cmd] + if {$where eq ""} { + #bare command that didn't resolve using namespace which + #command probably doesn't exist (may be auto_path cmd not yet loaded) + set where :: + } + set what [nstail $cmd] + } else { + set where [nsprefix $fqcmd] + set what [nstail $fqcmd] + } + #ensure we con't call 'namespace eval' on a nonexistent ns and create cruft namespaces + set parts [nsparts $where] + if {[lsearch $parts :*] > -1} { + set weird_ns 1 + if {![nsexists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)." + return nsnotfound + } + } else { + set weird_ns 0 + if {![namespace exists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)" + return nsnotfound + } + } + if {[interp issafe]} { - if {[catch {::tcl::info::cmdtype $cmd} result]} { + #todo - weird_ns + if {[catch {namespace eval $where [list ::tcl::info::cmdtype $what]} result]} { if {[info commands ::cmdtype] ne ""} { #hack - look for an alias that may have been specifically enabled to bring this back tailcall ::cmdtype $cmd @@ -1027,9 +1199,23 @@ tcl::namespace::eval punk::ns { } } if {[info commands ::tcl::info::cmdtype] ne ""} { - tailcall info cmdtype $cmd + if {$weird_ns} { + if {[nseval_ifexists $where [list ::info commands $what]] eq ""} { + return notfound + } else { + return [nseval_ifexists $where [list ::tcl::info::cmdtype $what]] + } + } else { + if {[namespace eval $where [list ::info commands $what]] eq ""} { + #e.g parray if it hasn't yet been called (an auto_path loaded command) + return notfound + } else { + tailcall namespace eval $where [list ::tcl::info::cmdtype $what] + } + } } - #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #we could examine namespaces to determine more - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #also - we're unlikely to be able to (easily) duplicate the full info cmdtype behaviour - so don't try here! return na } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob @@ -1073,6 +1259,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } + punk::args::update_definitions set nsdict_list [list] foreach ch $report_namespaces { @@ -1103,8 +1290,18 @@ tcl::namespace::eval punk::ns { #JMN set location $ch - set exportpatterns [tcl::namespace::eval $location {::namespace export}] - set nspathlist [tcl::namespace::eval $location {::namespace path}] + set locationparts [nsparts $location] + set weird_ns 0 + if {[lsearch $locationparts :*] >= 0} { + set weird_ns 1 + } + if {$weird_ns} { + set exportpatterns [nseval_ifexists $location {::namespace export}] + set nspathlist [nseval_ifexists $location {::namespace path}] + } else { + set exportpatterns [tcl::namespace::eval $location {::namespace export}] + set nspathlist [tcl::namespace::eval $location {::namespace path}] + } set nspathdict [dict create] if {$nspathcommands} { foreach pathns $nspathlist { @@ -1123,7 +1320,25 @@ tcl::namespace::eval punk::ns { foreach p $exportpatterns { if {[regexp {[*?]} $p]} { #lappend matched {*}[nseval $location [list ::info commands [nsjoin ${location} $p]]] - lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + if {$weird_ns} { + #! info commands can't glob with a weird ns prefix + #! info commands with no arguments returns all commands (from global and any other ns in namespace path) + #lappend matched {*}[nseval_ifexists $location [list ::info commands [nsjoin ${location} $p]]] + lappend matched {*}[nseval_ifexists $location [string map [list $location $p] { + set allcommands [info commands] + set matches [list] + foreach c $allcommands { + set fq [namespace which $c] + if {[string match :: $fq]} { + lappend matches $c + } + } + return $matches + }] + + } else { + lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + } foreach m $matched { lappend allexported [nstail $m] } @@ -1133,7 +1348,11 @@ tcl::namespace::eval punk::ns { } set allexported [lsort -unique $allexported] #NOTE: info procs within tcl::namespace::eval is different to 'info commands' within tcl::namespace::eval (info procs doesn't look outside of namespace) - set allprocs [tcl::namespace::eval $location {::info procs}] + if {$weird_ns} { + set allprocs [nseval_ifexists $location {::info procs}] + } else { + set allprocs [tcl::namespace::eval $location {::info procs}] + } #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] @@ -1151,7 +1370,11 @@ tcl::namespace::eval punk::ns { set interp_aliases [interp aliases ""] #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + if {$weird_ns} { + set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } else { + set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] foreach a $raw_aliases { @@ -1165,38 +1388,91 @@ tcl::namespace::eval punk::ns { } } + #NOTE for 'info ...' 'namespace origin|(etc)..' + # - use the pattern [namespace eval $location [list $cmd]] + #This allows examination of cmds with "bad" names such as empty string or prefixed with single colon. + #while these should be rare - we want to handle such edge cases when browsing namespaces. foreach cmd $commands { #if {"${location}::$cmd" in $interp_aliases || [string trimleft "${location}::$cmd" ":"] in $interp_aliases} { - # #NOTE: doesn't cater for renamed aliases - Tcl 8.x doesn't seem to have any introspection capabilities to match command to a renamed alias + # #NOTE: doesn't cater for renamed aliases - Tcl 8.x (and 9.01) doesn't seem to have any introspection capabilities to match command to a renamed alias # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} set ctype [cmdtype ${location}::$cmd] switch -- $ctype { na { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } + if {[nsprefix $cmdorigin] ne $location} { + #import + lappend allimported $cmd + set origin_location [nsprefix $cmdorigin] + } else { + set origin_location $location + } #tcl 8.6 (info cmdtype unavailable) #todo - use catch tcl::unsupported::corotype to see if coroutine - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + if {![catch {nseval_ifexists $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[nseval_ifexists $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[nseval_ifexists $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + + } + } else { + if {![catch {namespace eval $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[namespace eval $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[namespace eval $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + } } } default { - if {$ctype eq "imported"} { - set cmdorigin [namespace origin [nsjoin $location $cmd]] + if {$ctype eq "import"} { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source #ie we don't need to follow a chain of 'imported' results. - set mixedtype i-[info cmdtype $cmdorigin] + set origin_location [nsprefix $cmdorigin] + set origin_cmd [nstail $cmdorigin] + + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + set mixedtype i-[nseval_ifexists $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } else { + set mixedtype i-[namespace eval $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } + lappend allimported $cmd } else { set mixedtype $ctype } - #assert ctype != imported + #assert mixedtype != import #review - we don't have a way to mark as both native and ensemble - switch -- $ctype { + switch -- $mixedtype { i-native - native { lappend allnative $cmd } @@ -1242,7 +1518,7 @@ tcl::namespace::eval punk::ns { } } - #JMN + #JMN TODO if {[catch { if {$cmd eq ""} { #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. @@ -1315,6 +1591,50 @@ tcl::namespace::eval punk::ns { #definitely don't count exportpatterns incr itemcount [llength $undetermined] + set usageinfo [list] + set has_punkargs [expr {[info commands ::punk::args::id_exists] ne ""}] + set has_tepam [expr {[info exists ::tepam::ProcedureList]}] + if {$has_punkargs || $has_tepam} { + foreach c $commands { + if {$c in $imported} { + set fq [namespace origin [nsjoin $location $c]] + } elseif {$c in $aliases} { + #TODO - use which_alias ? + set tgt [interp alias "" [nsjoin $location $c]] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft [nsjoin $location $c] :]] + } + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(currying) + set fq $word1 + } + } else { + set fq [nsjoin $location $c] + } + if {$has_punkargs} { + set id [string trimleft $fq :] + if {[::punk::args::id_exists $id]} { + lappend usageinfo $c + } else { + if {$has_tepam} { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } else { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } set nsdict [dict create\ location $location\ @@ -1335,6 +1655,7 @@ tcl::namespace::eval punk::ns { ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ + usageinfo $usageinfo\ namespacepath $nspathdict\ glob $glob\ itemcount $itemcount\ @@ -1480,11 +1801,33 @@ tcl::namespace::eval punk::ns { ::set what $search } } - - ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] + set weird_ns 0 + if {[string match *:::* $base]} { + set weird_ns 1 + } #important not to call tcl::namespace::eval (or punk::ns::nseval) on non-existant base - or it will be created - ::if {![::tcl::namespace::exists $base]} { - ::continue + if {$weird_ns} { + ::if {![nsexists $base]} { + ::continue + } + #info commands can't glob with weird_ns prefix + puts ">>> base: $base what: $what" + ::set all_ns_commands [nseval_ifexists $base [list apply {{loc what} { + set _all [uplevel 1 [list ::info commands]] + set _matches [list] + foreach _a $_all { + set _c [uplevel 1 [list ::namespace which $_a]] + if {[::string match ${loc}::${what} $_c]} { + ::lappend _matches $_a + } + } + return $_matches + }} $base $what ]] + } else { + ::if {![::tcl::namespace::exists $base]} { + ::continue + } + ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] } ::set all_ns_tails [::lmap v $all_ns_commands {::punk::ns::nstail $v}] foreach c $all_ns_tails { @@ -1549,6 +1892,510 @@ tcl::namespace::eval punk::ns { } } |data@@ok/result> {lmap v $data {punk::ns::nstail $v}} |> lsort |> {join $data \n} = 0} { + #use nseval_ifexists to avoid creating intermediate namespaces for bogus paths + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set origin $commandpath + set resolved $commandpath + } + } else { + #fully qualified command specified but doesn't exist + set origin $commandpath + set resolved $commandpath + } + } else { + set thispath [uplevel 1 [list ::nsthis $commandpath]] + set targetns [nsprefix $thispath] + set name [nstail $thispath] + set targetparts [nsparts $targetns] + if {[lsearch $targetparts :*] >=0} { + #weird ns + set valid_ns [nsexists $targetns] + } else { + set valid_ns [namespace exists $targetns] + } + if {$valid_ns} { + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set thiscmd [nsjoin $targetns $name] + #relative commandpath specified - but Tcl didn't find a match in namespace path + #assume global (todo - look for namespace match in auto_index first ?) + set origin ::$name + set resolved ::$name + } + } else { + #namespace doesn't seem to exist - but there still could be documentation for lazy loaded ns and command + set origin $commandpath + set resolved $commandpath + } + } + #set thiscmd [nsjoin $targetns $name] + #if {[info commands $thiscmd] eq ""} { + # set origin $thiscmd + # set resolved $thiscmd + #} else { + # set origin [nseval $targetns [list ::namespace origin $name]] + # set resolved [nseval $targetns [list ::namespace which $name]] + #} + + #ns::cmdtype only detects alias type on 8.7+? + set initial_cmdtype [punk::ns::cmdtype $origin] + switch -- $initial_cmdtype { + na - alias { + #REVIEW - alias entry doesn't necessarily match command! + #considure using which_alias (wiki) + set tgt [interp alias "" $origin] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft $origin :]] + } + if {$tgt ne ""} { + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(possible curried arguments) + #review - curried arguments could be for ensembles! + set fq $word1 + } + set origin $fq + #retest cmdtype on modified origin + set cmdtype [punk::ns::cmdtype $origin] + } else { + set cmdtype $initial_cmdtype + } + if {$cmdtype eq "na"} { + #tcl 8.6 + if {[info object isa object $origin]} { + set cmdtype "object" + } + } + } + default { + set cmdtype $initial_cmdtype + } + } + + switch -- $cmdtype { + object { + #class is also an object + #todo -mixins etc etc + set class [info object class $origin] + #the call: info object methods -all + # seems to do the right thing as far as hiding unexported methods, and showing things like destroy + # - which don't seem to be otherwise easily introspectable + set public_methods [info object methods $origin -all] + #set class_methods [info class methods $class] + #set object_methods [info object methods $origin] + + if {[llength $commandargs]} { + set c1 [lindex $commandargs 0] + if {$c1 in $public_methods} { + switch -- $c1 { + new { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} new" + *proc -name "${$origin} new" -help\ + "create object with specified command name. + Arguments are passed to the constructor." + *values + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin new"] + } + create { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} create" + *proc -name "${$origin} create" -help\ + "create object with specified command name. + Arguments following objectName are passed to the constructor." + *values -min 1 + objectName -type string -help\ + "possibly namespaced name for object instance command" + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin create"] + } + destroy { + #review - generally no doc + # but we may want notes about a specific destructor + set argspec [punk::lib::tstr -return string { + *id "${$origin} destroy" + *proc -name "destroy" -help\ + "delete object, calling destructor if any. + destroy accepts no arguments." + *values -min 0 -max 0 + }] + punk::args::definition $argspec + return [punk::args::usage "$origin destroy"] + } + default { + #use info object call to resolve callchain + #we assume the first impl is the topmost in the callchain + # and its call signature is therefore the one we are interested in - REVIEW + # we should probably ignore generaltypes filter|unknown and look for a subsequent method|private? + set implementations [::info object call $origin $c1] + #result documented as list of 4 element lists + #set callinfo [lindex $implementations 0] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + + if {$location eq "object"} { + set id "[string trimleft $origin :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info object definition $origin $c1] + } else { + set id "[string trimleft $location :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info class definition $location $c1] + } + break + } + filter { + } + unknown { + } + } + } + if {$def ne ""} { + set arglist [lindex $def 0] + set argspec [punk::lib::tstr -return string { + *id "${$location} ${$c1}" + *proc -name "${$location} ${$c1}" -help\ + "arglist:${$arglist}" + *values + }] + set i 0 + foreach a $arglist { + switch -- [llength $a] { + 1 { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } + 2 { + append argspec \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" + } + default { + error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + } + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$location $c1"] + } else { + return "unable to resolve $origin method $c1" + } + + } + } + } + } + set choicelabeldict [dict create] + foreach cmd $public_methods { + switch -- $cmd { + new - create - destroy { + #todo + } + default { + set implementations [::info object call $origin $cmd] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + if {$location eq "object"} { + set id "[string trimleft $origin :] $cmd" ;# " " + } else { + set id "[string trimleft $location :] $cmd" ;# " " + } + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]" + } + } + break + } + filter { + } + unknown { + } + } + } + } + } + } + + set vline [list method -choices $public_methods -choicelabels $choicelabeldict -choiceprefix 0] ;#methods must be specified in full always? - review + #puts stderr "--->$vline" + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -name "Object: ${$origin}" -help\ + "Instance of class: ${$class}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + privateObject { + return "Command is a privateObject - no info currently available" + } + privateClass { + return "Command is a privateClass - no info currently available" + } + interp { + #todo + } + } + + #check ensemble before testing punk::arg::id_exists + #we want to recalculate ensemble usage info in case ensemble has been modified + + if {[namespace ensemble exists $origin]} { + #review + #todo - check -unknown + #if there is a -unknown handler - we can't be sure the choices in -map or from -namespace are exhaustive. + #presumably -choiceprefix should be zero in that case?? + + set ensembleinfo [namespace ensemble configure $origin] + set prefixes [dict get $ensembleinfo -prefixes] + set map [dict get $ensembleinfo -map] + set ns [dict get $ensembleinfo -namespace] + + #review - we can have a combination of commands from -map as well as those exported from -namespace + # if and only if -subcommands is specified + + set subcommand_dict [dict create] + set commands [list] + set nscommands [list] + if {[llength [dict get $ensembleinfo -subcommands]]} { + #set exportspecs [namespace eval $ns {namespace export}] + #foreach pat $exportspecs { + # lappend nscommands {*}[info commands ${ns}::$pat] + #} + #when using -subcommands, even unexported commands are available + set nscommands [info commands ${ns}::*] + foreach sub [dict get $ensembleinfo -subcommands] { + if {[dict exists $map $sub]} { + #-map takes precence over same name exported from -namespace + dict set subcommand_dict $sub [dict get $map $sub] + } elseif {"${ns}::$sub" in $nscommands} { + dict set subcommand_dict $sub ${ns}::$sub + } else { + #subcommand probably supplied via -unknown handler? + dict set subcommand_dict $sub "" + } + } + } else { + if {[dict size $map]} { + set subcommand_dict $map + } else { + set exportspecs [namespace eval $ns {namespace export}] + foreach pat $exportspecs { + lappend nscommands {*}[info commands ${ns}::$pat] + } + foreach fqc $nscommands { + dict set subcommand_dict [namespace tail $fqc] $fqc + } + } + } + + + set subcommands [lsort [dict keys $subcommand_dict]] + if {[llength $commandargs]} { + set match [tcl::prefix::match $subcommands [lindex $commandargs 0]] + if {$match in $subcommands} { + set subcmd [dict get $subcommand_dict $match] + return [arginfo {*}$subcmd {*}[lrange $commandargs 1 end]] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") + } + } + + set namespaces [list] ;# usually only 1 or 2 namespaces - but could be any number. + dict for {sub subwhat} $subcommand_dict { + set ns [::namespace which $subwhat] + if {$ns ni $namespaces} { + lappend namespaces $ns + } + } + set have_usageinfo [list] + set is_ensemble [list] + set is_object [list] + foreach ns $namespaces { + set nsinfo [lindex [punk::ns::nslist_dict [nsjoin [nsprefix $ns] *]] 0] + lappend have_usageinfo {*}[dict get $nsinfo usageinfo] + lappend is_ensemble {*}[dict get $nsinfo ensembles] + lappend is_object {*}[dict get $nsinfo ooobjects] + } + + set choicelabeldict [dict create] + foreach sub $subcommands { + if {$sub in $have_usageinfo} { + dict set choicelabeldict $sub " [Usageinfo_mark brightgreen]" + } elseif {$sub in $is_ensemble} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } elseif {$sub in $is_object} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } + } + + set vline [list subcommand -choices $subcommands -choiceprefix $prefixes -choicelabels $choicelabeldict] + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -help "ensemble: ${$origin}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + + #check for tepam help + if {[info exists ::tepam::ProcedureList]} { + if {$origin in $::tepam::ProcedureList} { + return [tepam::ProcedureHelp $origin 1] ;#use 1 to return rather than emit to stdout + } else { + #handle any tepam functions that don't eat their own dogfood but have help variables + #e.g tepam::procedure, tepam::argument_dialogbox + #Rather than hardcode these - we'll guess that any added will use the same scheme.. + if {[namespace qualifiers $origin] eq "::tepam"} { + set func [namespace tail $origin] + #tepam XXXHelp vars don't exactly match procedure names :/ + if {[info exists ::tepam::${func}Help]} { + return [set ::tepam::${func}Help] + } else { + set f2 [string totitle $func] + if {[info exists ::tepam::${f2}Help]} { + return [set ::tepam::${f2}Help] + } + #e.g argument_dialogbox -> ArgumentDialogboxHelp + set parts [split $func _] + set uparts [lmap p $parts {string totitle $p}] + set f3 [join [list {*}$uparts Help] ""] + if {[info exists ::tepam::${f3}]} { + return [set ::tepam::${f3}] + } + } + } + } + } + + set id [string trimleft $origin :] + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set origin_ns [nsprefix $origin] + set parts [nsparts $origin_ns] + set weird_ns 0 + if {[lsearch $parts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set argl {} + set tail [nstail $origin] + foreach a [nseval_ifexists $origin_ns [list info args $tail]] { + if {[nseval_ifexists $origin_ns [list info default $tail $a def]]} { + lappend a $def + } + lappend argl $a + } + } else { + set argl {} + foreach a [info args $origin] { + if {[info default $origin $a def]} { + lappend a $def + } + lappend argl $a + } + } + + set msg "No argument processor detected" + append msg \n "function signature: $resolved $argl" + return $msg + } + #todo - package up as navns proc corp {path} { #thanks to Richard Suchenwirth for the original - wiki.tcl-lang.org/page/corp @@ -1567,6 +2414,8 @@ tcl::namespace::eval punk::ns { set body "" } + #we want to handle edge cases of commands such as "" or :x + #various builtins such as 'namespace which' won't work if {[string match ::* $path]} { set targetns [nsprefix $path] set name [nstail $path] @@ -1884,26 +2733,41 @@ tcl::namespace::eval punk::ns { } interp alias "" use "" punk::ns::pkguse + punk::args::definition { + *id punk::ns::nsimport_noclobber + *proc -name punk::ns::nsimport_noclobber -help\ + "Import exported commands from a namespace into either the current namespace, + or that specified in -targetnamespace. + Return list of imported commands, ignores failures due to name conflicts" + -targetnamespace -optional 1 -help\ + "Namespace in which to import commands. + If namespace is relative (no leading ::), + the namespace is relative to the caller'd namespace. + If not supplied, caller's namespace is used." + -prefix -optional 1 -help\ + "string prefix for command names in target namespace" + *values -min 1 -max 1 + sourcepattern -type string -optional 0 -help\ + "Glob pattern for source namespace. + Globbing only active in the tail segment. + e.g ::mynamespace::*" + } proc nsimport_noclobber {args} { - set argspecs { - -targetnamespace -default "" -optional 1 - -prefix -default "" -optional 1 - *values -min 1 -max 1 - sourcepattern -type string -optional 0 - } - lassign [dict values [punk::args::get_dict $argspecs $args]] leaders opts values + lassign [dict values [punk::args::get_by_id punk::ns::nsimport_noclobber $args]] leaders opts values received set sourcepattern [dict get $values sourcepattern] set source_ns [tcl::namespace::qualifiers $sourcepattern] if {![tcl::namespace::exists $source_ns]} { error "nsimport_noclobber error namespace $source_ns not found" } - set target_ns [dict get $opts -targetnamespace] set nscaller [uplevel 1 {namespace current}] - if {$target_ns eq ""} { + if {![dict exists $received -targetnamespace]} { set target_ns $nscaller - } elseif {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + } else { + set target_ns [dict get $opts -targetnamespace] + if {![string match ::* $target_ns]} { + set target_ns [punk::nsjoin $nscaller $target_ns] + } } set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] @@ -1918,6 +2782,34 @@ tcl::namespace::eval punk::ns { } } } + set nstemp ::punk::ns::temp_import + if {[tcl::dict:::exists $received -prefix]} { + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { + set cmd "" + if {![catch {namespace import ::}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {rename [punk::ns::nsjoin ]}]} { + set cmd + } + } + set cmd + }]] + if {$imported ne ""} { + lappend imported_commands $imported + } + } + namespace delete $nstemp + return $imported_commands + } + set imported_commands [list] foreach e $a_exported_tails { set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { @@ -1934,7 +2826,7 @@ tcl::namespace::eval punk::ns { return $imported_commands } - #todo - use ns::nsimport_noclobber instead + #todo - use ns::nsimport_noclobber instead ? interp alias {} nsthis {} punk::ns::nspath_here_absolute interp alias {} nsorigin {} apply {ns {namespace origin [uplevel 1 ::punk::ns::nspath_here_absolute $ns]} ::} @@ -1943,6 +2835,7 @@ tcl::namespace::eval punk::ns { interp alias {} nsprefix {} punk::ns::nsprefix interp alias {} nstail {} punk::ns::nstail interp alias {} nsparts {} punk::ns::nsparts + interp alias {} nschildren {} punk::ns::nschildren interp alias {} nstree {} punk::ns::nstree #namespace/command/proc query interp alias {} nslist {} punk::ns::nslist @@ -1966,6 +2859,7 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp + interp alias {} i {} punk::ns::arginfo } diff --git a/src/bootsupport/modules/punk/path-0.1.0.tm b/src/bootsupport/modules/punk/path-0.1.0.tm index 18590542..d3431188 100644 --- a/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/bootsupport/modules/punk/path-0.1.0.tm @@ -45,8 +45,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -642,6 +644,20 @@ namespace eval punk::path { return $ismatch } + punk::args::definition { + *id punk::path::treefilenames + -directory -type directory -help\ + "folder in which to begin recursive scan for files." + -call-depth-internal -default 0 -type integer + -antiglob_paths -default {} -help\ + "list of path patterns to exclude + may include * and ** path segments e.g /usr/**" + *values -min 0 -max -1 -optional 1 -type string + tailglobs -multiple 1 -help\ + "Patterns to match against filename portion (last segment) of each file path + within the directory tree being searched." + } + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) proc treefilenames {args} { @@ -655,22 +671,17 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_dict { - -directory -default "\uFFFF" - -call-depth-internal -default 0 -type integer - -antiglob_paths -default {} - *values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 - } $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::path::treefilenames $args] + lassign [dict values $argd] leaders opts values received set tailglobs [dict values $values] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - set opt_dir [dict get $opts -directory] - if {$opt_dir eq "\uFFFF"} { + if {![dict exists $received -directory]} { set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] } # -- --- --- --- --- --- --- diff --git a/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm b/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm index d8d1b249..d14b626d 100644 --- a/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm +++ b/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm @@ -166,15 +166,15 @@ tcl::namespace::eval punk::repl::codethread { set errstack [list] upvar ::punk::config::running running_config if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { - lappend outstack [interp eval code [list shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } - lappend outstack [interp eval code [list shellfilter::stack::add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { - lappend errstack [interp eval code [list shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } - lappend errstack [interp eval code [list shellfilter::stack::add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] #an experiment #set errhandle [shellfilter::stack::item_tophandle stderr] @@ -190,7 +190,16 @@ tcl::namespace::eval punk::repl::codethread { if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } - tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + if {[string first ":::" $::punk::ns::ns_current]} { + #support for browsing 'odd' (inadvisable) namespaces + #don't use 'namespace exists' - will conflate ::test::x with ::test:::x + #if {$::punk::ns::ns_current in [namespace children [punk::ns::nsprefix $::punk::ns::ns_current]} { + #} + package require punk::ns + punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript + } else { + tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + } } } result] @@ -221,10 +230,10 @@ tcl::namespace::eval punk::repl::codethread { #only remove from shellfilter::stack the items we added to stack in this function foreach s [lreverse $outstack] { - interp eval code [list shellfilter::stack::remove stdout $s] + interp eval code [list ::shellfilter::stack remove stdout $s] } foreach s [lreverse $errstack] { - interp eval code [list shellfilter::stack::remove stderr $s] + interp eval code [list ::shellfilter::stack remove stderr $s] } thread::cond notify $replthread_cond } diff --git a/src/bootsupport/modules/shellfilter-0.1.9.tm b/src/bootsupport/modules/shellfilter-0.1.9.tm index fe443ece..25ba28b1 100644 --- a/src/bootsupport/modules/shellfilter-0.1.9.tm +++ b/src/bootsupport/modules/shellfilter-0.1.9.tm @@ -1086,7 +1086,9 @@ namespace eval shellfilter::chan { ## note - whether stack is for input or output we maintain it in the same direction - which is in sync with the tcl chan pop chan push concept. ## namespace eval shellfilter::stack { - #todo - implement as oo + namespace export {[a-z]*} + namespace ensemble create + #todo - implement as oo ? variable pipelines [list] proc items {} { diff --git a/src/bootsupport/modules/textblock-0.1.2.tm b/src/bootsupport/modules/textblock-0.1.2.tm index f8b6390c..1a298b4e 100644 --- a/src/bootsupport/modules/textblock-0.1.2.tm +++ b/src/bootsupport/modules/textblock-0.1.2.tm @@ -92,29 +92,51 @@ tcl::namespace::eval textblock { #NOTE sha1, although computationally more intensive, tends to be faster than md5 on modern cpus #(more likely to be optimised for modern cpu features?) - variable use_md5 ;#framecache - set use_md5 1 - if {[catch {package require md5}]} { - set use_md5 0 - } - #todo - change use_md5 to more generic use_checksum_algorithm function. - # e.g allow md5, sha1, none, etc. - # - perhaps autodetect 32bit vs 64bit (or processortype?) to select a default (also depending on packages available and accelerator presence) - proc use_md5 {{yes_no ""}} { - variable use_md5 - if {$yes_no eq ""} { - return $use_md5 - } - if {![string is boolean -strict $yes_no]} { - error "textblock::use_md5 requires a boolean (or empty string to query)" - } - if {$yes_no} { - package require md5 - set use_md5 1 + #(This speed improvement may not apply for short strings) + + variable use_hash ;#framecache + set use_hash none ;#slightly faster but uglier layout for viewing frame_cache display + #if {![catch {package require sha1}]} { + # set use_hash sha1 + #} elseif {![catch {package require md5}]} { + # set use_hash md5 + #} else { + # set use_hash none + #} + + proc use_hash {args} { + set choices [list none] + set unavailable [list] + set pkgs [package names] + if {"md5" in $pkgs} { + lappend choices md5 } else { - set use_md5 0 + lappend unavailable md5 } - return $use_md5 + if {"sha1" in $pkgs} { + lappend choices sha1 + } else { + lappend unavailable sha1 + } + set choicemsg "" + if {[llength $unavailable]} { + set choicemsg " (unavailable packages: $unavailable)" + } + set argd [punk::args::get_dict [tstr -return string { + *id textblock::use_hash + *proc -name "textblock::use_hash" -help\ + "Hashing algorithm to use for framecache lookup. + 'none' may be slightly faster but less compact + when viewing textblock::framecache" + *values -min 0 -max 1 + hash_algorithm -choices {${$choices}} -optional 1 -help\ + "algorithm choice ${$choicemsg}" + }] $args] + variable use_hash + if {![dict exists $argd received hash_algorithm]} { + return $use_hash + } + set use_hash [dict get $argd values hash_algorithm] } tcl::namespace::eval class { variable opts_table_defaults @@ -3997,12 +4019,8 @@ tcl::namespace::eval textblock { return $t } - - - proc periodic {args} { - #For an impressive interactive terminal app (javascript) - # see: https://github.com/spirometaxas/periodic-table-cli - set opts [dict get [punk::args::get_dict { + punk::args::definition { + *id textblock::periodic *proc -name textblock::periodic -help "A rudimentary periodic table This is primarily a test of textblock::class::table" @@ -4016,8 +4034,12 @@ tcl::namespace::eval textblock { -show_edge -default "" -type boolean -forcecolour -default 0 -type boolean -help "If punk::colour is off - this enables the produced table to still be ansi coloured" *values -min 0 -max 0 - } $args] opts] + } + proc periodic {args} { + #For an impressive interactive terminal app (javascript) + # see: https://github.com/spirometaxas/periodic-table-cli + set opts [dict get [punk::args::get_by_id textblock::periodic $args] opts] set opt_return [tcl::dict::get $opts -return] if {[tcl::dict::get $opts -forcecolour]} { set fc forcecolour @@ -4156,15 +4178,16 @@ tcl::namespace::eval textblock { dict set conf $k [dict get $opts $k] } } - $t configure {*}[dict get $conf] - $t configure \ - -frametype_header light\ - -ansiborder_header [a+ {*}$fc brightwhite]\ - -ansibase_header [a+ {*}$fc Black]\ - -ansibase_body [a+ {*}$fc Black]\ - -ansiborder_body [a+ {*}$fc black]\ - -frametype block + set moreopts [dict create\ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc brightwhite]\ + -ansibase_header [a+ {*}$fc Black]\ + -ansibase_body [a+ {*}$fc Black]\ + -ansiborder_body [a+ {*}$fc black]\ + -frametype block + ] + $t configure {*}[dict merge $conf $moreopts] #-ansiborder_header [a+ {*}$fc web-white]\ @@ -4204,9 +4227,9 @@ tcl::namespace::eval textblock { -header -default "" -type list -multiple 1\ -help "Each supplied -header argument is a header row. The number of values for each must be <= number of columns" - -show_header -default ""\ + -show_header -type boolean\ -help "Whether to show a header row. - Leave as empty string for unspecified/automatic, + Omit for unspecified/automatic, in which case it will display only if -headers list was supplied." -action -default "append" -choices {append replace}\ -help "row insertion method if existing -table is supplied @@ -4294,13 +4317,13 @@ tcl::namespace::eval textblock { if {[llength $colheaders] > 0} { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 1 } else { set show_header [tcl::dict::get $opts -show_header] } } else { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 0 } else { set show_header [tcl::dict::get $opts -show_header] @@ -4529,7 +4552,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4553,7 +4576,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4614,7 +4637,7 @@ tcl::namespace::eval textblock { set textblock [textutil::tabify::untabify2 $textblock $tw] } #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { set textblock [punk::ansi::ansistripraw $textblock] } if {[tcl::string::last \n $textblock] >= 0} { @@ -7226,12 +7249,19 @@ tcl::namespace::eval textblock { variable frame_cache set frame_cache [tcl::dict::create] + + punk::args::definition { + *id textblock::frame_cache + *proc -name textblock::frame_cache -help\ + "Display or clear the frame cache." + -action -default {} -choices {clear} -help\ + "Clear the textblock::frame_cache dictionary" + -pretty -default 1 -help\ + "Use 'pdict textblock::frame_cache */*' for prettier output" + *values -min 0 -max 0 + } proc frame_cache {args} { - set argd [punk::args::get_dict { - -action -default {} -choices {clear} -help "Clear the textblock::frame_cache dictionary" - -pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output" - *values -min 0 -max 0 - } $args] + set argd [punk::args::get_by_id textblock::frame_cache $args] set action [dict get $argd opts -action] if {$action ni [list clear ""]} { @@ -7273,6 +7303,71 @@ tcl::namespace::eval textblock { } + set FRAMETYPES [textblock::frametypes] + set EG [a+ brightblack] + set RST [a] + #todo punk::args alias for centre center etc? + punk::args::definition [punk::lib::tstr -return string { + *id textblock::frame + *proc -name "textblock::frame"\ + -help "Frame a block of text with a border." + -checkargs -default 1 -type boolean\ + -help "If true do extra argument checks and + provide more comprehensive error info. + Set false for slight performance improvement." + -etabs -default 0\ + -help "expanding tabs - experimental/unimplemented." + -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ + -help "Type of border for frame." + -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. + passing an empty string will result in no box, but title/subtitle will still appear if supplied. + ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" + -boxmap -default {} -type dict + -joins -default {} -type list + -title -default "" -type string -regexprefail {\n}\ + -help "Frame title placed on topbar - no newlines. + May contain ANSI - no trailing reset required. + ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing + e.g 2: frame -title [a+ red underline]MyThing${$RST}" + -subtitle -default "" -type string -regexprefail {\n}\ + -help "Frame subtitle placed on bottombar - no newlines + May contain Ansi - no trailing reset required." + -width -default "" -type int\ + -help "Width of resulting frame including borders. + If omitted or empty-string, the width will be determined automatically based on content." + -height -default "" -type int\ + -help "Height of resulting frame including borders." + -ansiborder -default "" -type ansistring\ + -help "Ansi escape sequence to set border attributes. + ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents + e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" + -ansibase -default "" -type ansistring\ + -help "Default ANSI attributes within frame." + -blockalign -default centre -choices {left right centre}\ + -help "Alignment of the content block within the frame." + -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background + extends within the content block inside the frame. + Has no effect if no ANSI in content." + -textalign -default left -choices {left right centre}\ + -help "Alignment of text within the content block. (centre unimplemented)" + -ellipsis -default 1 -type boolean\ + -help "Whether to show elipsis for truncated content and title/subtitle." + -usecache -default 1 -type boolean + -buildcache -default 1 -type boolean + -crm_mode -default 0 -type boolean\ + -help "Show ANSI control characters within frame contents. + (Control Representation Mode) + Frame width doesn't adapt and content may be truncated + so -width may need to be manually set to display more." + + *values -min 0 -max 1 + contents -default "" -type string\ + -help "Frame contents - may be a block of text containing newlines and ANSI. + Text may be 'ragged' - ie unequal line-lengths. + No trailing ANSI reset required. + ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" + }] + #options before content argument - which is allowed to be absent #frame performance (noticeable with complex tables even of modest size) is improved somewhat by frame_cache - but is still (2024) a fairly expensive operation. # @@ -7283,7 +7378,7 @@ tcl::namespace::eval textblock { # - but we would need to maintain support for the rendered-string based operations too. proc frame {args} { variable frametypes - variable use_md5 + variable use_hash #counterintuitively - in-proc dict create each time is generally slightly faster than linked namespace var set opts [tcl::dict::create\ @@ -7311,20 +7406,19 @@ tcl::namespace::eval textblock { # for ansi art - -pad 0 is likely to be preferable set has_contents 0 - set arglist $args + set optlist $args ;#initial only - content will be removed + #no solo opts for frame if {[llength $args] %2 == 0} { if {[lindex $args end-1] eq "--"} { - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 - lpop arglist end ;#drop the end-of-opts flag + lpop optlist end ;#drop the end-of-opts flag } else { - set arglist $args + set optlist $args set contents "" } } else { - #set arglist [lrange $args 0 end-1] - #set contents [lindex $args end] - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 } @@ -7333,7 +7427,7 @@ tcl::namespace::eval textblock { #use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache set optnames [tcl::dict::keys $opts] set opts_ok 1 ;#default assumption - foreach {k v} $arglist { + foreach {k v} $optlist { set k2 [tcl::prefix::match -error "" $optnames $k] switch -- $k2 { -etabs - -type - -boxlimits - -boxmap - -joins @@ -7355,70 +7449,9 @@ tcl::namespace::eval textblock { set check_args [dict get $opts -checkargs] #only use punk::args if check_args is true or our basic checks failed - if {!$opts_ok || $check_args} { - #error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - set FRAMETYPES [textblock::frametypes] - set EG [a+ brightblack] - set RST [a] - set argd [punk::args::get_dict [punk::lib::tstr -return string { - *proc -name "textblock::frame"\ - -help "Frame a block of text with a border." - -checkargs -default 1 -type boolean\ - -help "If true do extra argument checks and - provide more comprehensive error info. - Set false for slight performance improvement." - -etabs -default 0\ - -help "expanding tabs - experimental/unimplemented." - -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ - -help "Type of border for frame." - -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. - passing an empty string will result in no box, but title/subtitle will still appear if supplied. - ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" - -boxmap -default {} -type dict - -joins -default {} -type list - -title -default "" -type string -regexprefail {\n}\ - -help "Frame title placed on topbar - no newlines. - May contain ANSI - no trailing reset required. - ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing - e.g 2: frame -title [a+ red underline]MyThing${$RST}" - -subtitle -default "" -type string -regexprefail {\n}\ - -help "Frame subtitle placed on bottombar - no newlines - May contain Ansi - no trailing reset required." - -width -default "" -type int\ - -help "Width of resulting frame including borders. - If omitted or empty-string, the width will be determined automatically based on content." - -height -default "" -type int\ - -help "Height of resulting frame including borders." - -ansiborder -default "" -type ansistring\ - -help "Ansi escape sequence to set border attributes. - ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents - e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" - -ansibase -default "" -type ansistring\ - -help "Default ANSI attributes within frame." - -blockalign -default centre -choices {left right centre}\ - -help "Alignment of the content block within the frame." - -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background - extends within the content block inside the frame. - Has no effect if no ANSI in content." - -textalign -default left -choices {left right centre}\ - -help "Alignment of text within the content block. (centre unimplemented)" - -ellipsis -default 1 -type boolean\ - -help "Whether to show elipsis for truncated content and title/subtitle." - -usecache -default 1 -type boolean - -buildcache -default 1 -type boolean - -crm_mode -default 0 -type boolean\ - -help "Show ANSI control characters within frame contents. - (Control Representation Mode) - Frame width doesn't adapt and content may be truncated - so -width may need to be manually set to display more." - - *values -min 0 -max 1 - contents -default "" -type string\ - -help "Frame contents - may be a block of text containing newlines and ANSI. - Text may be 'ragged' - ie unequal line-lengths. - No trailing ANSI reset required. - ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" - }] $args] + #never need to checkargs if only one argument supplied even if it looks like an option - as it will be treated as data to frame + if {[llength $args] != 1 && (!$opts_ok || $check_args)} { + set argd [punk::args::get_by_id textblock::frame $args] set opts [dict get $argd opts] set contents [dict get $argd values contents] } @@ -7446,7 +7479,10 @@ tcl::namespace::eval textblock { set opt_ansiborder [tcl::dict::get $opts -ansiborder] set opt_ansibase [tcl::dict::get $opts -ansibase] ;#experimental set opt_ellipsis [tcl::dict::get $opts -ellipsis] + set opt_blockalign [tcl::dict::get $opts -blockalign] + set opt_textalign [tcl::dict::get $opts -textalign] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] set known_frametypes $frametypes ;# light, heavey etc as defined in the ::textblock::frametypes variable @@ -7463,107 +7499,26 @@ tcl::namespace::eval textblock { set framedef $ftype } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - #review vllj etc? - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] - - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - tcl::dict::for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - hltj - hlbj - vllj - vlrj {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" - } + #if check_args? - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [tcl::dict::create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - tcl::dict::set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] + #REVIEW - now done in framedef? + #set join_directions [list] + ##targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + ##e.g down-light, up-heavy + #set join_targets [tcl::dict::create left "" down "" right "" up ""] + #foreach jt $opt_joins { + # lassign [split $jt -] direction target + # if {$target ne ""} { + # tcl::dict::set join_targets $direction $target + # } + # lappend join_directions $direction + #} + #set join_directions [lsort -unique $join_directions] + #set do_joins [::join $join_directions _] - #JMN - switch -- $opt_blockalign { - left - right - centre - center {} - default { - error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_textalign [tcl::dict::get $opts -textalign] - switch -- $opt_textalign { - left - right - centre - center {} - default { - error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" - } - } # -- --- --- --- --- --- @@ -7634,20 +7589,28 @@ tcl::namespace::eval textblock { # -- --- --- --- --- --- --- --- --- variable frame_cache #review - custom frame affects frame_inner_width - exclude from caching? - #set cache_key [concat $arglist $frame_inner_width $frame_inner_height] + #set cache_key [concat $optlist $frame_inner_width $frame_inner_height] #jmn - #set hashables [concat $arglist $frame_inner_width $frame_inner_height] - set hashables [list {*}$arglist $frame_inner_width $frame_inner_height] + #set hashables [concat $optlist $frame_inner_width $frame_inner_height] + set hashables [list {*}$optlist $frame_inner_width $frame_inner_height] - if {$use_md5} { - #package require md5 ;#already required at package load - if {[package vsatisfies [package present md5] 2- ] } { - set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review - } else { - set hash [md5::md5 [encoding convertto utf-8 $hashables]] + + switch -- $use_hash { + sha1 { + package require sha1 + set hash [sha1::sha1 [encoding convertto utf-8 $hashables]] + } + md5 { + package require md5 + if {[package vsatisfies [package present md5] 2- ] } { + set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review + } else { + set hash [md5::md5 [encoding convertto utf-8 $hashables]] + } + } + none { + set hash $hashables } - } else { - set hash $hashables } set cache_key "$hash-$frame_inner_width-$frame_inner_height-actualcontentwidth:$actual_contentwidth" @@ -7709,11 +7672,94 @@ tcl::namespace::eval textblock { set used [tcl::dict::get $frame_cache $cache_key used] tcl::dict::set frame_cache $cache_key used [expr {$used+1}] ;#update existing record set is_cached 1 - } + # -- --- --- --- --- --- --- --- --- if {!$is_cached} { + # -- --- --- --- --- + # -- --- --- --- --- + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + # -- --- --- --- --- --- + set is_boxmap_ok 1 + tcl::dict::for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + hltj - hlbj - vllj - vlrj {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" + } + # -- --- --- --- --- --- + #these are all valid commands for overtype:: + switch -- $opt_textalign { + left - right - centre - center {} + default { + error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" + } + } + # -- --- --- --- --- --- + switch -- $opt_blockalign { + left - right - centre - center {} + default { + error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" + } + } + # -- --- --- --- --- + # -- --- --- --- --- + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + #review vllj etc? + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + # -- --- --- --- --- --- + + set rst [a] #set column [tcl::string::repeat " " $frame_inner_width] ;#default - may need to override for custom frame set underlayline [tcl::string::repeat " " $frame_inner_width] @@ -8038,6 +8084,9 @@ tcl::namespace::eval textblock { ;#end !$is_cached } + + + #use the same mechanism to build the final frame - whether from cache or template if {$actual_contentwidth == 0} { set fs [tcl::string::map [list $FSUB " "] $template] diff --git a/src/embedded/man/files/_module_termscheme-0.1.0.tm.n b/src/embedded/man/files/_module_termscheme-0.1.0.tm.n new file mode 100644 index 00000000..c497e6fd --- /dev/null +++ b/src/embedded/man/files/_module_termscheme-0.1.0.tm.n @@ -0,0 +1,323 @@ +'\" +'\" Generated from file '_module_termscheme-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "shellspy_module_termscheme" 0 0\&.1\&.0 doc "-" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +shellspy_module_termscheme \- Module API +.SH SYNOPSIS +package require \fBtermscheme \fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of termscheme +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by termscheme +.IP \(bu +\fBTcl 8\&.6\fR +.PP +.SH API +.SS "NAMESPACE TERMSCHEME::CLASS" +.PP +class definitions +if { eq ""} { +.PP +} +} +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +.SS "NAMESPACE TERMSCHEME" +.PP +Core API functions for termscheme +.PP +.SS "NAMESPACE TERMSCHEME::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +tcl::namespace::eval termscheme::system { +.SS "NAMESPACE TERMSCHEME::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n b/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n index cb6a7c56..b327addb 100644 --- a/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n +++ b/src/embedded/man/files/punk/_module_ansi-0.1.1.tm.n @@ -362,7 +362,7 @@ package require \fBpunk::ansi \fR .sp \fBansistrip\fR \fItext\fR .sp -\fBansistrip\fR \fItext\fR +\fBansistrip2\fR \fItext\fR .sp \fBansistripraw\fR \fItext\fR .sp @@ -637,7 +637,7 @@ Return a string with ansi codes stripped out .sp Alternate graphics chars are replaced with modern unicode equivalents (e\&.g boxdrawing glyphs) .TP -\fBansistrip\fR \fItext\fR +\fBansistrip2\fR \fItext\fR .sp Return a string with ansi codes stripped out .sp diff --git a/src/embedded/man/files/punk/_module_args-0.1.0.tm.n b/src/embedded/man/files/punk/_module_args-0.1.0.tm.n index 0b33c822..5b1adb63 100644 --- a/src/embedded/man/files/punk/_module_args-0.1.0.tm.n +++ b/src/embedded/man/files/punk/_module_args-0.1.0.tm.n @@ -276,7 +276,7 @@ punkshell_module_punk::args \- args parsing .SH SYNOPSIS package require \fBpunk::args \fR .sp -\fBget_dict\fR \fIoptionspecs\fR \fIrawargs\fR ?option value\&.\&.\&.? +\fBget_dict\fR \fIoptionspecs\fR \fIrawargs\fR .sp .BE .SH DESCRIPTION @@ -325,7 +325,7 @@ The basic principle is that a call to punk::args::get_dict is made near the begi #setting -type none indicates a flag that doesn't take a value (solo flag) -nocomplain -type none *values -min 1 -max -1 - } $args]] opts values + } $args]] leaders opts values puts "translation is [dict get $opts -translation]" foreach f [dict values $values] { @@ -339,7 +339,7 @@ The lines beginning with * are optional in most cases and can be used to set def .PP - the above example would work just fine with only the - lines, but would allow zero filenames to be supplied as no -min value is set for *values .PP -valid * lines being with *proc *opts *values +valid * lines being with *proc *leaders *opts *values .PP lines beginning with a dash define options - a name can optionally be given to each trailing positional argument\&. .PP @@ -363,7 +363,7 @@ It also demonstrates an inital argument 'category' that is outside of the scope *values -min 2 -max 2 fileA -type existingfile 1 fileB -type existingfile 1 - } $args]] opts values + } $args]] leaders opts values puts "$category fileA: [dict get $values fileA]" puts "$category fileB: [dict get $values fileB]" } @@ -488,15 +488,19 @@ packages used by punk::args \fBTcl 8\&.6-\fR .PP .SH API -.SS "NAMESPACE PUNK::ARGS::CLASS" +.SS "NAMESPACE PUNK::ARGS" +.PP +cooperative namespace punk::args::register +.PP +punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded .PP -class definitions +The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to\&. .PP .SS "NAMESPACE PUNK::ARGS" .PP Core API functions for punk::args .TP -\fBget_dict\fR \fIoptionspecs\fR \fIrawargs\fR ?option value\&.\&.\&.? +\fBget_dict\fR \fIoptionspecs\fR \fIrawargs\fR .sp Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values .sp @@ -525,7 +529,7 @@ where the valid keys for each option specification are: -default -type -range -c .sp comment lines begining with # are ignored and can be placed anywhere except within a multiline value where it would become part of that value .sp -lines beginning with *proc *opts or *values also take -key val pairs and can be used to set defaults and control settings\&. +lines beginning with *proc *leaders *opts or *values also take -key val pairs and can be used to set defaults and control settings\&. .sp *opts or *values lines can appear multiple times with defaults affecting flags/values that follow\&. .TP diff --git a/src/embedded/man/files/punk/_module_console-0.1.1.tm.n b/src/embedded/man/files/punk/_module_console-0.1.1.tm.n index abc00a7f..a0be0229 100644 --- a/src/embedded/man/files/punk/_module_console-0.1.1.tm.n +++ b/src/embedded/man/files/punk/_module_console-0.1.1.tm.n @@ -298,7 +298,11 @@ packages used by punk::console .IP \(bu \fBTcl 8\&.6-\fR .IP \(bu +\fBThread\fR +.IP \(bu \fBpunk::ansi\fR +.IP \(bu +\fBpunk::args\fR .PP .SH API .SS "NAMESPACE PUNK::CONSOLE" diff --git a/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n b/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n index 8defc874..54e00d18 100644 --- a/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n +++ b/src/embedded/man/files/punk/_module_lib-0.1.1.tm.n @@ -355,6 +355,8 @@ This requirement for no strong dependencies, means that many utility functions t packages used by punk::lib .IP \(bu \fBTcl 8\&.6-\fR +.IP \(bu +\fBpunk::args\fR .PP .SH API .SS "NAMESPACE PUNK::LIB::COMPAT" diff --git a/src/embedded/man/files/punk/_module_safe-0.1.0.tm.n b/src/embedded/man/files/punk/_module_safe-0.1.0.tm.n new file mode 100644 index 00000000..5604c2ee --- /dev/null +++ b/src/embedded/man/files/punk/_module_safe-0.1.0.tm.n @@ -0,0 +1,328 @@ +'\" +'\" Generated from file '_module_safe-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "punkshell_module_punk::safe" 0 0\&.1\&.0 doc "punk::safe - safebase interpreters" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +punkshell_module_punk::safe \- Module API +.SH SYNOPSIS +package require \fBpunk::safe \fR +.sp +\fBsetSyncMode\fR \fIargs\fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of punk::safe +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::safe +.IP \(bu +\fBTcl 8\&.6\fR +.IP \(bu +\fBpunk::args\fR +.PP +.SH API +.SS "NAMESPACE PUNK::SAFE::CLASS" +.PP +class definitions +if { eq ""} { +.PP +} +} +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +.SS "NAMESPACE PUNK::SAFE::LIB" +.PP +Secondary functions that are part of the API +.PP +.SS "NAMESPACE PUNK::SAFE" +.PP +Core API functions for punk::safe +.TP +\fBsetSyncMode\fR \fIargs\fR +.PP +.SH INTERNAL +.SS "NAMESPACE PUNK::SAFE::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/punk/_module_sixel-0.1.0.tm.n b/src/embedded/man/files/punk/_module_sixel-0.1.0.tm.n new file mode 100644 index 00000000..1b753c20 --- /dev/null +++ b/src/embedded/man/files/punk/_module_sixel-0.1.0.tm.n @@ -0,0 +1,326 @@ +'\" +'\" Generated from file '_module_sixel-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "punkshell_module_punk::sixel" 0 0\&.1\&.0 doc "experimental sixel functions" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +punkshell_module_punk::sixel \- punk::sixel API +.SH SYNOPSIS +package require \fBpunk::sixel \fR +.sp +.BE +.SH DESCRIPTION +.PP +Experimental support functions for working with sixel data +.PP +For real sixel work a version written in a systems language such as c or zig may be required\&. +.SH OVERVIEW +.PP +overview of punk::sixel +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::sixel +.IP \(bu +\fBTcl 8\&.6\fR +.IP \(bu +\fBpunk::args\fR +.IP \(bu +\fBpunk::console\fR +.IP \(bu +\fBpunk::ansi\fR +.PP +.SH API +.SS "NAMESPACE PUNK::SIXEL::CLASS" +.PP +class definitions +if { eq ""} { +.PP +} +} +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +.SS "NAMESPACE PUNK::SIXEL" +.PP +Core API functions for punk::sixel +.PP +.SS "NAMESPACE PUNK::SIXEL::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH KEYWORDS +experimental, module +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/files/punk/args/_module_tclcore-0.1.0.tm.n b/src/embedded/man/files/punk/args/_module_tclcore-0.1.0.tm.n new file mode 100644 index 00000000..4b7151d8 --- /dev/null +++ b/src/embedded/man/files/punk/args/_module_tclcore-0.1.0.tm.n @@ -0,0 +1,325 @@ +'\" +'\" Generated from file '_module_tclcore-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2025 +'\" +.TH "punkshell_module_punk::args::tclcore" 0 0\&.1\&.0 doc "tcl core argument definitions" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +punkshell_module_punk::args::tclcore \- punk::args definitions for tcl core commands +.SH SYNOPSIS +package require \fBpunk::args::tclcore \fR +.sp +.BE +.SH DESCRIPTION +.PP +- +.SH OVERVIEW +.PP +overview of punk::args::tclcore +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::args::tclcore +.IP \(bu +\fBTcl 8\&.6\fR +.IP \(bu +\fBpunk::args\fR +.PP +.SH API +.SS "NAMESPACE PUNK::ARGS::TCLCORE::CLASS" +.PP +class definitions +if { eq ""} { +.PP +} +} +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +.SS "NAMESPACE PUNK::ARGS::TCLCORE" +.PP +Core API functions for punk::args::tclcore +.PP +.SS "NAMESPACE PUNK::ARGS::TCLCORE::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +tcl::namespace::eval punk::args::tclcore::system { +.SS "NAMESPACE PUNK::ARGS::TCLCORE::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module +.SH COPYRIGHT +.nf +Copyright (c) 2025 + +.fi diff --git a/src/embedded/man/files/punk/nav/_module_fs-0.1.0.tm.n b/src/embedded/man/files/punk/nav/_module_fs-0.1.0.tm.n index 9a9fcc39..1b94e39b 100644 --- a/src/embedded/man/files/punk/nav/_module_fs-0.1.0.tm.n +++ b/src/embedded/man/files/punk/nav/_module_fs-0.1.0.tm.n @@ -2,7 +2,7 @@ '\" Generated from file '_module_fs-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2024 '\" -.TH "shellspy_module_punk::nav::fs" 0 0\&.1\&.0 doc "fs nav" +.TH "punkshell_module_punk::nav::fs" 0 0\&.1\&.0 doc "fs nav" .\" The -*- nroff -*- definitions below are for supplemental macros used .\" in Tcl/Tk manual entries. .\" @@ -272,7 +272,7 @@ Database Class: \\fB\\$3\\fR .. .BS .SH NAME -shellspy_module_punk::nav::fs \- punk::nav::fs console filesystem navigation +punkshell_module_punk::nav::fs \- punk::nav::fs console filesystem navigation .SH SYNOPSIS package require \fBpunk::nav::fs \fR .sp diff --git a/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n b/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n index edd58268..d17088dc 100644 --- a/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n +++ b/src/embedded/man/files/punk/repl/_module_codethread-0.1.0.tm.n @@ -2,7 +2,7 @@ '\" Generated from file '_module_codethread-0\&.1\&.0\&.tm\&.man' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2024 '\" -.TH "shellspy_module_punk::repl::codethread" 0 0\&.1\&.0 doc "codethread for repl - root interpreter" +.TH "punkshell_module_punk::repl::codethread" 0 0\&.1\&.0 doc "codethread for repl - root interpreter" .\" The -*- nroff -*- definitions below are for supplemental macros used .\" in Tcl/Tk manual entries. .\" @@ -272,7 +272,7 @@ Database Class: \\fB\\$3\\fR .. .BS .SH NAME -shellspy_module_punk::repl::codethread \- Module repl codethread +punkshell_module_punk::repl::codethread \- Module repl codethread .SH SYNOPSIS package require \fBpunk::repl::codethread \fR .sp @@ -296,11 +296,7 @@ packages used by punk::repl::codethread .SS "NAMESPACE PUNK::REPL::CODETHREAD::CLASS" .PP class definitions -if { eq ""} { .PP -} -} -++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ .SS "NAMESPACE PUNK::REPL::CODETHREAD" .PP Core API functions for punk::repl::codethread diff --git a/src/embedded/man/files/punk/repl/_module_codethread-0.1.1.tm.n b/src/embedded/man/files/punk/repl/_module_codethread-0.1.1.tm.n new file mode 100644 index 00000000..eeb70634 --- /dev/null +++ b/src/embedded/man/files/punk/repl/_module_codethread-0.1.1.tm.n @@ -0,0 +1,318 @@ +'\" +'\" Generated from file '_module_codethread-0\&.1\&.1\&.tm\&.man' by tcllib/doctools with format 'nroff' +'\" Copyright (c) 2024 +'\" +.TH "punkshell_module_punk::repl::codethread" 0 0\&.1\&.1 doc "codethread for repl - root interpreter" +.\" The -*- nroff -*- definitions below are for supplemental macros used +.\" in Tcl/Tk manual entries. +.\" +.\" .AP type name in/out ?indent? +.\" Start paragraph describing an argument to a library procedure. +.\" type is type of argument (int, etc.), in/out is either "in", "out", +.\" or "in/out" to describe whether procedure reads or modifies arg, +.\" and indent is equivalent to second arg of .IP (shouldn't ever be +.\" needed; use .AS below instead) +.\" +.\" .AS ?type? ?name? +.\" Give maximum sizes of arguments for setting tab stops. Type and +.\" name are examples of largest possible arguments that will be passed +.\" to .AP later. If args are omitted, default tab stops are used. +.\" +.\" .BS +.\" Start box enclosure. From here until next .BE, everything will be +.\" enclosed in one large box. +.\" +.\" .BE +.\" End of box enclosure. +.\" +.\" .CS +.\" Begin code excerpt. +.\" +.\" .CE +.\" End code excerpt. +.\" +.\" .VS ?version? ?br? +.\" Begin vertical sidebar, for use in marking newly-changed parts +.\" of man pages. The first argument is ignored and used for recording +.\" the version when the .VS was added, so that the sidebars can be +.\" found and removed when they reach a certain age. If another argument +.\" is present, then a line break is forced before starting the sidebar. +.\" +.\" .VE +.\" End of vertical sidebar. +.\" +.\" .DS +.\" Begin an indented unfilled display. +.\" +.\" .DE +.\" End of indented unfilled display. +.\" +.\" .SO ?manpage? +.\" Start of list of standard options for a Tk widget. The manpage +.\" argument defines where to look up the standard options; if +.\" omitted, defaults to "options". The options follow on successive +.\" lines, in three columns separated by tabs. +.\" +.\" .SE +.\" End of list of standard options for a Tk widget. +.\" +.\" .OP cmdName dbName dbClass +.\" Start of description of a specific option. cmdName gives the +.\" option's name as specified in the class command, dbName gives +.\" the option's name in the option database, and dbClass gives +.\" the option's class in the option database. +.\" +.\" .UL arg1 arg2 +.\" Print arg1 underlined, then print arg2 normally. +.\" +.\" .QW arg1 ?arg2? +.\" Print arg1 in quotes, then arg2 normally (for trailing punctuation). +.\" +.\" .PQ arg1 ?arg2? +.\" Print an open parenthesis, arg1 in quotes, then arg2 normally +.\" (for trailing punctuation) and then a closing parenthesis. +.\" +.\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages. +.if t .wh -1.3i ^B +.nr ^l \n(.l +.ad b +.\" # Start an argument description +.de AP +.ie !"\\$4"" .TP \\$4 +.el \{\ +. ie !"\\$2"" .TP \\n()Cu +. el .TP 15 +.\} +.ta \\n()Au \\n()Bu +.ie !"\\$3"" \{\ +\&\\$1 \\fI\\$2\\fP (\\$3) +.\".b +.\} +.el \{\ +.br +.ie !"\\$2"" \{\ +\&\\$1 \\fI\\$2\\fP +.\} +.el \{\ +\&\\fI\\$1\\fP +.\} +.\} +.. +.\" # define tabbing values for .AP +.de AS +.nr )A 10n +.if !"\\$1"" .nr )A \\w'\\$1'u+3n +.nr )B \\n()Au+15n +.\" +.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n +.nr )C \\n()Bu+\\w'(in/out)'u+2n +.. +.AS Tcl_Interp Tcl_CreateInterp in/out +.\" # BS - start boxed text +.\" # ^y = starting y location +.\" # ^b = 1 +.de BS +.br +.mk ^y +.nr ^b 1u +.if n .nf +.if n .ti 0 +.if n \l'\\n(.lu\(ul' +.if n .fi +.. +.\" # BE - end boxed text (draw box now) +.de BE +.nf +.ti 0 +.mk ^t +.ie n \l'\\n(^lu\(ul' +.el \{\ +.\" Draw four-sided box normally, but don't draw top of +.\" box if the box started on an earlier page. +.ie !\\n(^b-1 \{\ +\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.el \}\ +\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul' +.\} +.\} +.fi +.br +.nr ^b 0 +.. +.\" # VS - start vertical sidebar +.\" # ^Y = starting y location +.\" # ^v = 1 (for troff; for nroff this doesn't matter) +.de VS +.if !"\\$2"" .br +.mk ^Y +.ie n 'mc \s12\(br\s0 +.el .nr ^v 1u +.. +.\" # VE - end of vertical sidebar +.de VE +.ie n 'mc +.el \{\ +.ev 2 +.nf +.ti 0 +.mk ^t +\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n' +.sp -1 +.fi +.ev +.\} +.nr ^v 0 +.. +.\" # Special macro to handle page bottom: finish off current +.\" # box/sidebar if in box/sidebar mode, then invoked standard +.\" # page bottom macro. +.de ^B +.ev 2 +'ti 0 +'nf +.mk ^t +.if \\n(^b \{\ +.\" Draw three-sided box if this is the box's first page, +.\" draw two sides but no top otherwise. +.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c +.\} +.if \\n(^v \{\ +.nr ^x \\n(^tu+1v-\\n(^Yu +\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c +.\} +.bp +'fi +.ev +.if \\n(^b \{\ +.mk ^y +.nr ^b 2 +.\} +.if \\n(^v \{\ +.mk ^Y +.\} +.. +.\" # DS - begin display +.de DS +.RS +.nf +.sp +.. +.\" # DE - end display +.de DE +.fi +.RE +.sp +.. +.\" # SO - start of list of standard options +.de SO +'ie '\\$1'' .ds So \\fBoptions\\fR +'el .ds So \\fB\\$1\\fR +.SH "STANDARD OPTIONS" +.LP +.nf +.ta 5.5c 11c +.ft B +.. +.\" # SE - end of list of standard options +.de SE +.fi +.ft R +.LP +See the \\*(So manual entry for details on the standard options. +.. +.\" # OP - start of full description for a single option +.de OP +.LP +.nf +.ta 4c +Command-Line Name: \\fB\\$1\\fR +Database Name: \\fB\\$2\\fR +Database Class: \\fB\\$3\\fR +.fi +.IP +.. +.\" # CS - begin code excerpt +.de CS +.RS +.nf +.ta .25i .5i .75i 1i +.. +.\" # CE - end code excerpt +.de CE +.fi +.RE +.. +.\" # UL - underline word +.de UL +\\$1\l'|0\(ul'\\$2 +.. +.\" # QW - apply quotation marks to word +.de QW +.ie '\\*(lq'"' ``\\$1''\\$2 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\$2 +.. +.\" # PQ - apply parens and quotation marks to word +.de PQ +.ie '\\*(lq'"' (``\\$1''\\$2)\\$3 +.\"" fix emacs highlighting +.el (\\*(lq\\$1\\*(rq\\$2)\\$3 +.. +.\" # QR - quoted range +.de QR +.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3 +.\"" fix emacs highlighting +.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3 +.. +.\" # MT - "empty" string +.de MT +.QW "" +.. +.BS +.SH NAME +punkshell_module_punk::repl::codethread \- Module repl codethread +.SH SYNOPSIS +package require \fBpunk::repl::codethread \fR +.sp +.BE +.SH DESCRIPTION +.PP +This is part of the infrastructure required for the punk::repl to operate +.SH OVERVIEW +.PP +overview of punk::repl::codethread +.SS CONCEPTS +.PP +- +.SS DEPENDENCIES +.PP +packages used by punk::repl::codethread +.IP \(bu +\fBTcl 8\&.6\fR +.PP +.SH API +.SS "NAMESPACE PUNK::REPL::CODETHREAD::CLASS" +.PP +class definitions +.PP +.SS "NAMESPACE PUNK::REPL::CODETHREAD" +.PP +Core API functions for punk::repl::codethread +.PP +.SS "NAMESPACE PUNK::REPL::CODETHREAD::LIB" +.PP +Secondary functions that are part of the API +.PP +.SH INTERNAL +.SS "NAMESPACE PUNK::REPL::CODETHREAD::SYSTEM" +.PP +Internal functions that are not part of the API +.SH KEYWORDS +module, repl +.SH COPYRIGHT +.nf +Copyright (c) 2024 + +.fi diff --git a/src/embedded/man/index.n b/src/embedded/man/index.n index a3822414..0e9af5c8 100644 --- a/src/embedded/man/index.n +++ b/src/embedded/man/index.n @@ -430,6 +430,9 @@ punkshell_module_punk::cesu .TP \fBfiles/punk/_module_flib-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::flib +.TP +\fBfiles/punk/_module_sixel-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::sixel .RE fake .RS @@ -461,11 +464,11 @@ filesystem \fBfiles/punk/_module_island-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::island .TP +\fBfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::nav::fs +.TP \fBfiles/punk/_module_path-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::path -.TP -\fBfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR -shellspy_module_punk::nav::fs .RE frame .RS @@ -539,6 +542,9 @@ punkshell_module_punk::ansi \fBfiles/punk/_module_args-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::args .TP +\fBfiles/punk/args/_module_tclcore-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::args::tclcore +.TP \fBfiles/punk/_module_assertion-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::assertion .TP @@ -575,15 +581,30 @@ punkshell_module_punk::island \fBfiles/punk/_module_lib-0\&.1\&.1\&.tm\&.n\fR punkshell_module_punk::lib .TP +\fBfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::nav::fs +.TP \fBfiles/punk/_module_packagepreference-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::packagepreference .TP \fBfiles/punk/_module_path-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::path .TP +\fBfiles/punk/repl/_module_codethread-0\&.1\&.1\&.tm\&.n\fR +punkshell_module_punk::repl::codethread +.TP +\fBfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::repl::codethread +.TP \fBfiles/punk/_module_rest-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::rest .TP +\fBfiles/punk/_module_safe-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::safe +.TP +\fBfiles/punk/_module_sixel-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::sixel +.TP \fBfiles/punk/_module_sshrun-0\&.1\&.0\&.tm\&.n\fR punkshell_module_punk::sshrun .TP @@ -608,15 +629,12 @@ punkshell_module_textblock \fBfiles/_module_textblock-0\&.1\&.2\&.tm\&.n\fR punkshell_module_textblock .TP -\fBfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR -shellspy_module_punk::nav::fs -.TP -\fBfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR -shellspy_module_punk::repl::codethread -.TP \fBfiles/punk/_module_zip-0\&.1\&.0\&.tm\&.n\fR shellspy_module_punk::zip .TP +\fBfiles/_module_termscheme-0\&.1\&.0\&.tm\&.n\fR +shellspy_module_termscheme +.TP \fBfiles/_module_tomlish-1\&.1\&.1\&.tm\&.n\fR tomlish_module_tomlish .RE @@ -704,8 +722,11 @@ punkshell__project_changes \fBfiles/project_intro\&.n\fR punkshell__project_intro .TP +\fBfiles/punk/repl/_module_codethread-0\&.1\&.1\&.tm\&.n\fR +punkshell_module_punk::repl::codethread +.TP \fBfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR -shellspy_module_punk::repl::codethread +punkshell_module_punk::repl::codethread .RE rest .RS @@ -785,11 +806,11 @@ punkshell_module_punk::ansi \fBfiles/punk/_module_console-0\&.1\&.1\&.tm\&.n\fR punkshell_module_punk::console .TP +\fBfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR +punkshell_module_punk::nav::fs +.TP \fBfiles/_module_textblock-0\&.1\&.2\&.tm\&.n\fR punkshell_module_textblock -.TP -\fBfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR -shellspy_module_punk::nav::fs .RE text .RS diff --git a/src/embedded/man/toc.n b/src/embedded/man/toc.n index 46819ef1..5dc24bd7 100644 --- a/src/embedded/man/toc.n +++ b/src/embedded/man/toc.n @@ -309,6 +309,9 @@ doc \fBpunkshell_module_punk::args\fR \fIfiles/punk/_module_args-0\&.1\&.0\&.tm\&.n\fR: args parsing .TP +\fBpunkshell_module_punk::args::tclcore\fR +\fIfiles/punk/args/_module_tclcore-0\&.1\&.0\&.tm\&.n\fR: punk::args definitions for tcl core commands +.TP \fBpunkshell_module_punk::assertion\fR \fIfiles/punk/_module_assertion-0\&.1\&.0\&.tm\&.n\fR: assertion alternative to control::assert .TP @@ -348,15 +351,30 @@ doc \fBpunkshell_module_punk::mix::commandset::project\fR \fIfiles/punk/mix/commandset/_module_project-0\&.1\&.0\&.tm\&.n\fR: dec commandset - project .TP +\fBpunkshell_module_punk::nav::fs\fR +\fIfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR: punk::nav::fs console filesystem navigation +.TP \fBpunkshell_module_punk::packagepreference\fR \fIfiles/punk/_module_packagepreference-0\&.1\&.0\&.tm\&.n\fR: punkshell package/module loading .TP \fBpunkshell_module_punk::path\fR \fIfiles/punk/_module_path-0\&.1\&.0\&.tm\&.n\fR: Filesystem path utilities .TP +\fBpunkshell_module_punk::repl::codethread\fR +\fIfiles/punk/repl/_module_codethread-0\&.1\&.1\&.tm\&.n\fR: Module repl codethread +.TP +\fBpunkshell_module_punk::repl::codethread\fR +\fIfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR: Module repl codethread +.TP \fBpunkshell_module_punk::rest\fR \fIfiles/punk/_module_rest-0\&.1\&.0\&.tm\&.n\fR: punk::rest .TP +\fBpunkshell_module_punk::safe\fR +\fIfiles/punk/_module_safe-0\&.1\&.0\&.tm\&.n\fR: Module API +.TP +\fBpunkshell_module_punk::sixel\fR +\fIfiles/punk/_module_sixel-0\&.1\&.0\&.tm\&.n\fR: punk::sixel API +.TP \fBpunkshell_module_punk::sshrun\fR \fIfiles/punk/_module_sshrun-0\&.1\&.0\&.tm\&.n\fR: Tcl procedures to execute tcl scripts in remote hosts .TP @@ -381,14 +399,11 @@ doc \fBpunkshell_module_textblock\fR \fIfiles/_module_textblock-0\&.1\&.2\&.tm\&.n\fR: punk textblock functions .TP -\fBshellspy_module_punk::nav::fs\fR -\fIfiles/punk/nav/_module_fs-0\&.1\&.0\&.tm\&.n\fR: punk::nav::fs console filesystem navigation -.TP -\fBshellspy_module_punk::repl::codethread\fR -\fIfiles/punk/repl/_module_codethread-0\&.1\&.0\&.tm\&.n\fR: Module repl codethread -.TP \fBshellspy_module_punk::zip\fR \fIfiles/punk/_module_zip-0\&.1\&.0\&.tm\&.n\fR: Module API .TP +\fBshellspy_module_termscheme\fR +\fIfiles/_module_termscheme-0\&.1\&.0\&.tm\&.n\fR: Module API +.TP \fBtomlish_module_tomlish\fR \fIfiles/_module_tomlish-1\&.1\&.1\&.tm\&.n\fR: tomlish toml parser diff --git a/src/embedded/md/.doc/tocdoc b/src/embedded/md/.doc/tocdoc index 1a9f4aba..72051a7e 100644 --- a/src/embedded/md/.doc/tocdoc +++ b/src/embedded/md/.doc/tocdoc @@ -11,6 +11,7 @@ [item doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore {punkshell command aliases}] [item doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi {Ansi string functions}] [item doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args {args parsing}] +[item doc/files/punk/args/_module_tclcore-0.1.0.tm.md punkshell_module_punk::args::tclcore {punk::args definitions for tcl core commands}] [item doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion {assertion alternative to control::assert}] [item doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter {punk::blockletter frame-based large lettering test/logo}] [item doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap {capability provider and handler plugin system}] @@ -24,9 +25,14 @@ [item doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island {filesystem islands for safe interps}] [item doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib {punk general utility functions}] [item doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md punkshell_module_punk::mix::commandset::project {dec commandset - project}] +[item doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs {punk::nav::fs console filesystem navigation}] [item doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference {punkshell package/module loading}] [item doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path {Filesystem path utilities}] +[item doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::repl::codethread {Module repl codethread}] +[item doc/files/punk/repl/_module_codethread-0.1.1.tm.md punkshell_module_punk::repl::codethread {Module repl codethread}] [item doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest punk::rest] +[item doc/files/punk/_module_safe-0.1.0.tm.md punkshell_module_punk::safe {Module API}] +[item doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::sixel {punk::sixel API}] [item doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}] [item doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie {punk::trie API}] [item doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc {Module API}] @@ -35,8 +41,7 @@ [item doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap {scriptwrap polyglot tool}] [item doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock {punk textblock functions}] [item doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock {punk textblock functions}] -[item doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs {punk::nav::fs console filesystem navigation}] -[item doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread {Module repl codethread}] [item doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip {Module API}] +[item doc/files/_module_termscheme-0.1.0.tm.md shellspy_module_termscheme {Module API}] [item doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish {tomlish toml parser}] [toc_end] diff --git a/src/embedded/md/.idx b/src/embedded/md/.idx index c707ed43..3d761d9c 100644 --- a/src/embedded/md/.idx +++ b/src/embedded/md/.idx @@ -1 +1 @@ -{assertion {{doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion}} fileformat {{doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip}} POSH {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion}} theme {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} windows {{doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} proc {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} filesystem {{doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} {doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} layout {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} fake {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} datastructure {{doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie}} utility {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock}} wcswidth {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun}} rest {{doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest}} scriptwrap {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap}} changelog {{doc/files/project_changes.md punkshell__project_changes}} prompt {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} launcher {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap}} terminal {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} {doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs}} args {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} path {{doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} crossplatform {{doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} cesu {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu}} unofficial {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} {doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu}} configuration {{doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish}} table {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} http {{doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest}} file {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} compatibility {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu}} alias {{doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore}} package {{doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference}} parsing {{doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish}} colour {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} {prompt theme} {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} experimental {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib}} shell {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} capability {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} parse {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} commandset {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap}} repl {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread} {doc/files/project_changes.md punkshell__project_changes}} console {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} frame {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} toml {{doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} {doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} telnet {{doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet}} shortcut {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} text {{doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} lnk {{doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} arguments {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} encoding {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} protocol {{doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet}} interp {{doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island}} ansi {{doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} zip {{doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip}} faux {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} trie {{doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie}} punk {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} module {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} {doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} {doc/files/_module_modpod-0.1.2.tm.md modpod_module_modpod} {doc/files/punk/_module_experiment-0.1.0.tm.md punkshell_module_punk::experiment} {doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} {doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_argparsingtest} {doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun} {doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference} {doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} {doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} {doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} {doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} {doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} {doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter} {doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} {doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread} {doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} symlink {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} unicode {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc}} lib {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} string {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}}} {{changelog doc/files/project_changes.md punkshell__project_changes} . {shell doc/files/main.md punkshell} . {text doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {crossplatform doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {module doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} . {experimental doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {string doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {filesystem doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {module doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {lib doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} . {layout doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {module doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} . {module doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread} . {datastructure doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} . {table doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {telnet doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {arguments doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {repl doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread} . {file doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {module doc/files/punk/_module_experiment-0.1.0.tm.md punkshell_module_punk::experiment} . {console doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {interp doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} . {parse doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {filesystem doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs} . {zip doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} . {module doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_argparsingtest} . {shell doc/files/project_changes.md punkshell__project_changes} . {trie doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} . {module doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun} . {module doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} . {launcher doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {repl doc/files/project_intro.md punkshell__project_intro} . {module doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {module doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} . {utility doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} . {args doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {path doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {debug doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {POSH doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {module doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {module doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {text doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {parsing doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {shortcut doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {punk doc/files/main.md punkshell} . {lnk doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {console doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {module doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {module doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {module doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {encodings doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {unicode doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {repl doc/files/project_changes.md punkshell__project_changes} . {alias doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore} . {terminal doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs} . {assert doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {rest doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} . {filesystem doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} . {utility doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {module doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {module doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {parse doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {console doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {frame doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {toml doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {shortcut doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {proc doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {terminal doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {plugin doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {theme doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {toml doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {{prompt theme} doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {shell doc/files/project_intro.md punkshell__project_intro} . {punk doc/files/project_changes.md punkshell__project_changes} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun} . {http doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} . {module doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {text doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} . {ansi doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {commandset doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {faux doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {module doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {prompt doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {colour doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} . {repl doc/files/main.md punkshell} . {experimental doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {symlink doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {windows doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {terminal doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} . {module doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {ansi doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} . {protocol doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {module doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} . {wcswidth doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {configuration doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {module doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} . {terminal doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {encoding doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {fileformat doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} . {module doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {console doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} . {scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {console doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {parse doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {module doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore} . {module doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference} . {module doc/files/_module_modpod-0.1.2.tm.md modpod_module_modpod} . {module doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter} . {lib doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {punk doc/files/project_intro.md punkshell__project_intro} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {unofficial doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {unofficial doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {cesu doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {terminal doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {fake doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {package doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference} . {compatibility doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {module doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip} . {capability doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs} .} 66 {assertion assertion fileformat fileformat assert assert POSH posh debug debug theme theme windows windows proc proc filesystem filesystem layout layout fake fake datastructure datastructure utility utility wcswidth wcswidth ssh ssh rest rest scriptwrap scriptwrap changelog changelog prompt prompt launcher launcher terminal terminal path path args args crossplatform crossplatform unofficial unofficial cesu cesu configuration configuration table table http http file file compatibility compatibility alias alias encodings encodings package package parsing parsing colour colour {prompt theme} prompt_theme experimental experimental shell shell capability capability commandset commandset parse parse repl repl console console frame frame toml toml telnet telnet shortcut shortcut text text lnk lnk BOM bom arguments arguments encoding encoding interp interp protocol protocol ansi ansi zip zip faux faux trie trie module module punk punk unicode unicode lib lib symlink symlink plugin plugin string string} \ No newline at end of file +{assertion {{doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion}} fileformat {{doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip}} POSH {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion}} theme {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} windows {{doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} proc {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} filesystem {{doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} {doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} layout {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} fake {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} datastructure {{doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie}} utility {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock}} wcswidth {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun}} rest {{doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest}} scriptwrap {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap}} changelog {{doc/files/project_changes.md punkshell__project_changes}} prompt {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} launcher {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap}} terminal {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} {doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs}} args {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} path {{doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path}} crossplatform {{doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} cesu {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu}} unofficial {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} {doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu}} configuration {{doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish}} table {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} http {{doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest}} file {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} compatibility {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu}} alias {{doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore}} package {{doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference}} parsing {{doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish}} colour {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} {prompt theme} {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo}} experimental {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} {doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::sixel} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib}} shell {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} capability {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} parse {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} commandset {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap}} repl {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::repl::codethread} {doc/files/project_changes.md punkshell__project_changes} {doc/files/punk/repl/_module_codethread-0.1.1.tm.md punkshell_module_punk::repl::codethread}} console {{doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} frame {{doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock}} toml {{doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} {doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} telnet {{doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet}} shortcut {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} text {{doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} lnk {{doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} arguments {{doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args}} encoding {{doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline}} protocol {{doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet}} interp {{doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island}} ansi {{doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}} zip {{doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip}} faux {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} trie {{doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie}} punk {{doc/files/project_intro.md punkshell__project_intro} {doc/files/main.md punkshell} {doc/files/project_changes.md punkshell__project_changes}} module {{doc/files/punk/args/_module_tclcore-0.1.0.tm.md punkshell_module_punk::args::tclcore} {doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} {doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} {doc/files/_module_modpod-0.1.2.tm.md modpod_module_modpod} {doc/files/punk/_module_experiment-0.1.0.tm.md punkshell_module_punk::experiment} {doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} {doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_argparsingtest} {doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun} {doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference} {doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} {doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} {doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} {doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::sixel} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} {doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} {doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} {doc/files/punk/_module_safe-0.1.0.tm.md punkshell_module_punk::safe} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} {doc/files/_module_termscheme-0.1.0.tm.md shellspy_module_termscheme} {doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} {doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter} {doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} {doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::repl::codethread} {doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} {doc/files/punk/repl/_module_codethread-0.1.1.tm.md punkshell_module_punk::repl::codethread} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char}} symlink {{doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink}} unicode {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc}} lib {{doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap}} string {{doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi}}} {{changelog doc/files/project_changes.md punkshell__project_changes} . {shell doc/files/main.md punkshell} . {text doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {crossplatform doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {module doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} . {experimental doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {string doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {filesystem doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {module doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {lib doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} . {layout doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {module doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} . {datastructure doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} . {table doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs} . {telnet doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {arguments doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {file doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {module doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::sixel} . {module doc/files/punk/_module_experiment-0.1.0.tm.md punkshell_module_punk::experiment} . {console doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {interp doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} . {parse doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {repl doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::repl::codethread} . {zip doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} . {module doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_argparsingtest} . {shell doc/files/project_changes.md punkshell__project_changes} . {filesystem doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs} . {trie doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} . {module doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun} . {module doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} . {launcher doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {repl doc/files/project_intro.md punkshell__project_intro} . {module doc/files/punk/repl/_module_codethread-0.1.1.tm.md punkshell_module_punk::repl::codethread} . {module doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {module doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie} . {utility doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} . {args doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {path doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {debug doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {POSH doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {module doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {module doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path} . {text doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {parsing doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {shortcut doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {punk doc/files/main.md punkshell} . {lnk doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {terminal doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs} . {console doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {module doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {module doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {module doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {encodings doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {unicode doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {repl doc/files/project_changes.md punkshell__project_changes} . {alias doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore} . {assert doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {rest doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} . {filesystem doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island} . {module doc/files/punk/args/_module_tclcore-0.1.0.tm.md punkshell_module_punk::args::tclcore} . {utility doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {module doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {module doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::repl::codethread} . {parse doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {console doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {frame doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {toml doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {shortcut doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {proc doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args} . {terminal doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {plugin doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {theme doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {toml doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {{prompt theme} doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {shell doc/files/project_intro.md punkshell__project_intro} . {punk doc/files/project_changes.md punkshell__project_changes} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun} . {http doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest} . {module doc/files/punk/_module_safe-0.1.0.tm.md punkshell_module_punk::safe} . {module doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {text doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} . {ansi doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {commandset doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {faux doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {module doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime} . {prompt doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {colour doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {module doc/files/_module_termscheme-0.1.0.tm.md shellspy_module_termscheme} . {module doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock} . {repl doc/files/main.md punkshell} . {experimental doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib} . {symlink doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {windows doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk} . {terminal doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} . {module doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {ansi doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} . {protocol doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {module doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} . {wcswidth doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {configuration doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {module doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype} . {terminal doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {encoding doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {experimental doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::sixel} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet} . {fileformat doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip} . {module doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock} . {console doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console} . {scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap} . {console doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char} . {parse doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline} . {module doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore} . {module doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference} . {module doc/files/_module_modpod-0.1.2.tm.md modpod_module_modpod} . {module doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter} . {lib doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib} . {punk doc/files/project_intro.md punkshell__project_intro} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion} . {unofficial doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc} . {unofficial doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {cesu doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {terminal doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo} . {fake doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink} . {package doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference} . {compatibility doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu} . {module doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip} . {capability doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {module doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi} . {repl doc/files/punk/repl/_module_codethread-0.1.1.tm.md punkshell_module_punk::repl::codethread} .} 66 {assertion assertion fileformat fileformat assert assert POSH posh debug debug theme theme windows windows proc proc filesystem filesystem layout layout fake fake datastructure datastructure utility utility wcswidth wcswidth ssh ssh rest rest scriptwrap scriptwrap changelog changelog prompt prompt launcher launcher terminal terminal path path args args crossplatform crossplatform unofficial unofficial cesu cesu configuration configuration table table http http file file compatibility compatibility alias alias encodings encodings package package parsing parsing colour colour {prompt theme} prompt_theme experimental experimental shell shell capability capability commandset commandset parse parse repl repl console console frame frame toml toml telnet telnet shortcut shortcut text text lnk lnk BOM bom arguments arguments encoding encoding interp interp protocol protocol ansi ansi zip zip faux faux trie trie module module punk punk unicode unicode lib lib symlink symlink plugin plugin string string} \ No newline at end of file diff --git a/src/embedded/md/.toc b/src/embedded/md/.toc index c0c0d831..26181483 100644 --- a/src/embedded/md/.toc +++ b/src/embedded/md/.toc @@ -1 +1 @@ -doc {doc/toc {{doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??}} {doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.md punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_modpod-0.1.2.tm.md modpod_module_modpod {Module API}} {doc/files/punk/_module_experiment-0.1.0.tm.md punkshell_module_punk::experiment {Module API}} {doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo {poshinfo prompt theme tool}} {doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_argparsingtest {Module API}} {doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference {punkshell package/module loading}} {doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island {filesystem islands for safe interps}} {doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore {punkshell command aliases}} {doc/files/main.md punkshell {punkshell - Core}} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console {punk console}} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock {punk textblock functions}} {doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib {flib experimental}} {doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish {tomlish toml parser}} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock {punk textblock functions}} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap {scriptwrap polyglot tool}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink {faux link application shortcuts}} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline {file line-handling utilities}} {doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip {Module API}} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk {windows shortcut .lnk library}} {doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter {punk::blockletter frame-based large lettering test/logo}} {doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip {Module API}} {doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie {punk::trie API}} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md shellspy_module_punk::repl::codethread {Module repl codethread}} {doc/files/punk/nav/_module_fs-0.1.0.tm.md shellspy_module_punk::nav::fs {punk::nav::fs console filesystem navigation}} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args {args parsing}} {doc/files/project_changes.md punkshell__project_changes {punkshell Changes}} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char {character-set and unicode utilities}}}} \ No newline at end of file +doc {doc/toc {{doc/files/punk/args/_module_tclcore-0.1.0.tm.md punkshell_module_punk::args::tclcore {punk::args definitions for tcl core commands}} {doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::cesu {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??}} {doc/files/punk/_module_assertion-0.1.0.tm.md punkshell_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.md punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_modpod-0.1.2.tm.md modpod_module_modpod {Module API}} {doc/files/punk/_module_experiment-0.1.0.tm.md punkshell_module_punk::experiment {Module API}} {doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_poshinfo {poshinfo prompt theme tool}} {doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_argparsingtest {Module API}} {doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::packagepreference {punkshell package/module loading}} {doc/files/punk/_module_island-0.1.0.tm.md punkshell_module_punk::island {filesystem islands for safe interps}} {doc/files/punk/_module_aliascore-0.1.0.tm.md punkshell_module_punk::aliascore {punkshell command aliases}} {doc/files/main.md punkshell {punkshell - Core}} {doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::console {punk console}} {doc/files/_module_textblock-0.1.1.tm.md punkshell_module_textblock {punk textblock functions}} {doc/files/_module_overtype-1.6.5.tm.md overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::sixel {punk::sixel API}} {doc/files/punk/_module_flib-0.1.0.tm.md punkshell_module_punk::flib {flib experimental}} {doc/files/_module_tomlish-1.1.1.tm.md tomlish_module_tomlish {tomlish toml parser}} {doc/files/_module_textblock-0.1.2.tm.md punkshell_module_textblock {punk textblock functions}} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md punkshell_module_scriptwrap {scriptwrap polyglot tool}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::rest punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/_module_fauxlink-0.1.1.tm.md fauxlink_module_fauxlink {faux link application shortcuts}} {doc/files/punk/_module_safe-0.1.0.tm.md punkshell_module_punk::safe {Module API}} {doc/files/punk/_module_fileline-0.1.0.tm.md punkshell_module_punk::fileline {file line-handling utilities}} {doc/files/_module_termscheme-0.1.0.tm.md shellspy_module_termscheme {Module API}} {doc/files/punk/_module_zip-0.1.0.tm.md shellspy_module_punk::zip {Module API}} {doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::winlnk {windows shortcut .lnk library}} {doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::blockletter {punk::blockletter frame-based large lettering test/logo}} {doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::zip {Module API}} {doc/files/punk/_module_trie-0.1.0.tm.md punkshell_module_punk::trie {punk::trie API}} {doc/files/punk/_module_cap-0.1.0.tm.md punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.md punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::repl::codethread {Module repl codethread}} {doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::nav::fs {punk::nav::fs console filesystem navigation}} {doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::args {args parsing}} {doc/files/project_changes.md punkshell__project_changes {punkshell Changes}} {doc/files/punk/repl/_module_codethread-0.1.1.tm.md punkshell_module_punk::repl::codethread {Module repl codethread}} {doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::char {character-set and unicode utilities}}}} \ No newline at end of file diff --git a/src/embedded/md/.xrf b/src/embedded/md/.xrf index 90b5f1c2..4d94f168 100644 --- a/src/embedded/md/.xrf +++ b/src/embedded/md/.xrf @@ -1 +1 @@ -punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md sa,fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.md sa,punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.md fileformat {index.md fileformat} punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md POSH {index.md posh} sa,punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.md sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md kw,lib {index.md lib} kw,configuration {index.md configuration} kw,table {index.md table} debug {index.md debug} punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.md kw,compatibility {index.md compatibility} {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.md windows {index.md windows} kw,wcswidth {index.md wcswidth} kw,rest {index.md rest} sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md filesystem {index.md filesystem} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md kw,interp {index.md interp} sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md kw,terminal {index.md terminal} punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.md kw,path {index.md path} utility {index.md utility} rest {index.md rest} sa,punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.md kw,assert {index.md assert} changelog {index.md changelog} sa,punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.md path {index.md path} punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.md unofficial {index.md unofficial} sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??} doc/files/punk/_module_cesu-0.1.0.tm.md sa,punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md package {index.md package} parsing {index.md parsing} sa,punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md {faux link application shortcuts} doc/files/_module_fauxlink-0.1.1.tm.md punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.md {Module API} doc/files/punk/_module_zip-0.1.1.tm.md {punk::trie API} doc/files/punk/_module_trie-0.1.0.tm.md sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md {poshinfo prompt theme tool} doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md capability {index.md capability} kw,shortcut {index.md shortcut} punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md parse {index.md parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md {punkshell - Core} doc/files/main.md punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.md sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md kw,punk {index.md punk} tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.md {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.md arguments {index.md arguments} {punkshell command aliases} doc/files/punk/_module_aliascore-0.1.0.tm.md punk::rest doc/files/punk/_module_rest-0.1.0.tm.md sa,punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md kw,colour {index.md colour} interp {index.md interp} protocol {index.md protocol} kw,lnk {index.md lnk} sa,shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.md punk {index.md punk} lib {index.md lib} sa,punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.md sa,punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.md punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md assert {index.md assert} kw,proc {index.md proc} {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md sa,punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.md kw,fake {index.md fake} kw,unicode {index.md unicode} kw,symlink {index.md symlink} sa,punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md sa,punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md sa,punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.md kw,encodings {index.md encodings} kw,alias {index.md alias} kw,telnet {index.md telnet} theme {index.md theme} sa,tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.md sa,shellspy_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.md proc {index.md proc} punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.md sa,punkshell doc/files/main.md kw,shell {index.md shell} fake {index.md fake} kw,launcher {index.md launcher} {punk console} doc/files/punk/_module_console-0.1.1.tm.md sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell__project_changes(n) doc/files/project_changes.md datastructure {index.md datastructure} kw,args {index.md args} {punk::nav::fs console filesystem navigation} doc/files/punk/nav/_module_fs-0.1.0.tm.md {punk::blockletter frame-based large lettering test/logo} doc/files/punk/_module_blockletter-0.1.0.tm.md wcswidth {index.md wcswidth} kw,cesu {index.md cesu} kw,http {index.md http} sa,punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.md scriptwrap {index.md scriptwrap} punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md kw,frame {index.md frame} punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md terminal {index.md terminal} sa,shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.md args {index.md args} punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.md cesu {index.md cesu} table {index.md table} http {index.md http} punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.md sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md punkshell__project_changes doc/files/project_changes.md sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md sa,punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.md kw,layout {index.md layout} colour {index.md colour} {prompt theme} {index.md prompt_theme} experimental {index.md experimental} sa,punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.md sa,punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.md sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md sa,shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.md kw,encoding {index.md encoding} {windows shortcut .lnk library} doc/files/punk/_module_winlnk-0.1.0.tm.md kw,prompt {index.md prompt} kw,ansi {index.md ansi} kw,trie {index.md trie} sa,punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.md console {index.md console} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md telnet {index.md telnet} shortcut {index.md shortcut} lnk {index.md lnk} sa,punkshell__project_intro doc/files/project_intro.md kw,datastructure {index.md datastructure} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md ansi {index.md ansi} trie {index.md trie} punkshell__project_intro(n) doc/files/project_intro.md punkshell__project_intro doc/files/project_intro.md kw,changelog {index.md changelog} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md sa,fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.md sa,punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.md assertion {index.md assertion} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md kw,commandset {index.md commandset} kw,zip {index.md zip} fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.md {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.md {tomlish toml parser} doc/files/_module_tomlish-1.1.1.tm.md sa,punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.md sa,punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md layout {index.md layout} punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md sa,punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.md kw,windows {index.md windows} shellspy_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.md kw,module {index.md module} punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md kw,plugin {index.md plugin} punkshell doc/files/main.md kw,fileformat {index.md fileformat} punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md sa,punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.md punkshell__project_changes(n) doc/files/project_changes.md kw,utility {index.md utility} prompt {index.md prompt} launcher {index.md launcher} kw,ssh {index.md ssh} kw,arguments {index.md arguments} {punkshell package/module loading} doc/files/punk/_module_packagepreference-0.1.0.tm.md sa,punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.md crossplatform {index.md crossplatform} punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.md alias {index.md alias} kw,filesystem {index.md filesystem} shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.md punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.md sa,overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.md shell {index.md shell} {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.md kw,package {index.md package} kw,parsing {index.md parsing} kw,toml {index.md toml} punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md kw,debug {index.md debug} punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.md {punk textblock functions} doc/files/_module_textblock-0.1.2.tm.md sa,punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.md punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.md sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md kw,faux {index.md faux} frame {index.md frame} toml {index.md toml} sa,punkshell__project_intro(n) doc/files/project_intro.md shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.md kw,unofficial {index.md unofficial} encoding {index.md encoding} punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md sa,punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.md sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.md punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.md zip {index.md zip} {Module repl codethread} doc/files/punk/repl/_module_codethread-0.1.0.tm.md kw,BOM {index.md bom} faux {index.md faux} sa,punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.md {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.md module {index.md module} sa,punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.md plugin {index.md plugin} unicode {index.md unicode} symlink {index.md symlink} sa,punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.md kw,capability {index.md capability} sa,modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.md shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.md kw,crossplatform {index.md crossplatform} punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.md {punkshell Changes} doc/files/project_changes.md fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.md modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.md punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.md {Introduction to punkshell} doc/files/project_intro.md punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell(n) doc/files/main.md sa,punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.md punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.md punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md kw,parse {index.md parse} sa,punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.md punkshell(n) doc/files/main.md kw,string {index.md string} ssh {index.md ssh} kw,file {index.md file} sa,punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.md sa,punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.md sa,punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell__project_changes doc/files/project_changes.md {kw,prompt theme} {index.md prompt_theme} kw,experimental {index.md experimental} punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.md sa,punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.md configuration {index.md configuration} file {index.md file} {args parsing} doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.md encodings {index.md encodings} compatibility {index.md compatibility} {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.md sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md sa,shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.md kw,assertion {index.md assertion} {scriptwrap polyglot tool} doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.md {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.5.tm.md punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md kw,repl {index.md repl} punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md commandset {index.md commandset} kw,text {index.md text} {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.md sa,shellspy_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.md kw,scriptwrap {index.md scriptwrap} {filesystem islands for safe interps} doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.md kw,protocol {index.md protocol} kw,theme {index.md theme} sa,modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.md repl {index.md repl} shellspy_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.md text {index.md text} BOM {index.md bom} sa,punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.md kw,POSH {index.md posh} kw,console {index.md console} {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.md string {index.md string} \ No newline at end of file +punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md sa,fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.md sa,punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.md fileformat {index.md fileformat} punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md POSH {index.md posh} sa,punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.md sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md kw,lib {index.md lib} kw,configuration {index.md configuration} kw,table {index.md table} debug {index.md debug} punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.md kw,compatibility {index.md compatibility} {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.md windows {index.md windows} kw,wcswidth {index.md wcswidth} kw,rest {index.md rest} sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md filesystem {index.md filesystem} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md kw,interp {index.md interp} sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md kw,terminal {index.md terminal} punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.md kw,path {index.md path} utility {index.md utility} rest {index.md rest} punkshell_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.1.tm.md sa,punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.md kw,assert {index.md assert} changelog {index.md changelog} punkshell_module_punk::args::tclcore(0) doc/files/punk/args/_module_tclcore-0.1.0.tm.md sa,punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.md path {index.md path} shellspy_module_termscheme(0) doc/files/_module_termscheme-0.1.0.tm.md punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.md unofficial {index.md unofficial} sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??} doc/files/punk/_module_cesu-0.1.0.tm.md sa,punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md package {index.md package} parsing {index.md parsing} sa,punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md {faux link application shortcuts} doc/files/_module_fauxlink-0.1.1.tm.md punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.md {Module API} doc/files/punk/_module_zip-0.1.1.tm.md {punk::trie API} doc/files/punk/_module_trie-0.1.0.tm.md sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md {poshinfo prompt theme tool} doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md capability {index.md capability} kw,shortcut {index.md shortcut} sa,punkshell_module_punk::safe doc/files/punk/_module_safe-0.1.0.tm.md punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md parse {index.md parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.md {punkshell - Core} doc/files/main.md punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.md {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.md sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md kw,punk {index.md punk} tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.md {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.md arguments {index.md arguments} {punkshell command aliases} doc/files/punk/_module_aliascore-0.1.0.tm.md punk::rest doc/files/punk/_module_rest-0.1.0.tm.md sa,punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md kw,colour {index.md colour} interp {index.md interp} protocol {index.md protocol} kw,lnk {index.md lnk} punk {index.md punk} lib {index.md lib} sa,punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.md sa,punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.md punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md assert {index.md assert} kw,proc {index.md proc} {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md sa,punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.md kw,fake {index.md fake} kw,unicode {index.md unicode} kw,symlink {index.md symlink} punkshell_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.md sa,punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md sa,punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md sa,punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.md punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.md kw,encodings {index.md encodings} kw,alias {index.md alias} punkshell_module_punk::sixel(0) doc/files/punk/_module_sixel-0.1.0.tm.md kw,telnet {index.md telnet} theme {index.md theme} sa,tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.md proc {index.md proc} punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.md sa,punkshell doc/files/main.md kw,shell {index.md shell} fake {index.md fake} kw,launcher {index.md launcher} {punk console} doc/files/punk/_module_console-0.1.1.tm.md sa,punkshell_module_punk::args::tclcore(0) doc/files/punk/args/_module_tclcore-0.1.0.tm.md sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell__project_changes(n) doc/files/project_changes.md datastructure {index.md datastructure} kw,args {index.md args} {punk::nav::fs console filesystem navigation} doc/files/punk/nav/_module_fs-0.1.0.tm.md {punk::blockletter frame-based large lettering test/logo} doc/files/punk/_module_blockletter-0.1.0.tm.md wcswidth {index.md wcswidth} kw,cesu {index.md cesu} kw,http {index.md http} sa,punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.md scriptwrap {index.md scriptwrap} punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.md kw,frame {index.md frame} punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md terminal {index.md terminal} args {index.md args} punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.md punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.md cesu {index.md cesu} table {index.md table} http {index.md http} punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.md sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.md punkshell__project_changes doc/files/project_changes.md sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md sa,punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.md kw,layout {index.md layout} colour {index.md colour} shellspy_module_termscheme doc/files/_module_termscheme-0.1.0.tm.md {prompt theme} {index.md prompt_theme} experimental {index.md experimental} sa,punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.md sa,punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.md sa,punkshell_module_punk::sixel doc/files/punk/_module_sixel-0.1.0.tm.md sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.md sa,shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.md kw,encoding {index.md encoding} {windows shortcut .lnk library} doc/files/punk/_module_winlnk-0.1.0.tm.md kw,prompt {index.md prompt} punkshell_module_punk::sixel doc/files/punk/_module_sixel-0.1.0.tm.md kw,ansi {index.md ansi} kw,trie {index.md trie} sa,punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.md console {index.md console} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.md telnet {index.md telnet} shortcut {index.md shortcut} lnk {index.md lnk} sa,punkshell__project_intro doc/files/project_intro.md kw,datastructure {index.md datastructure} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.md punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md ansi {index.md ansi} punkshell_module_punk::safe(0) doc/files/punk/_module_safe-0.1.0.tm.md trie {index.md trie} punkshell__project_intro(n) doc/files/project_intro.md punkshell__project_intro doc/files/project_intro.md kw,changelog {index.md changelog} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.md sa,fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.md sa,punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.md assertion {index.md assertion} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md kw,commandset {index.md commandset} kw,zip {index.md zip} sa,punkshell_module_punk::sixel(0) doc/files/punk/_module_sixel-0.1.0.tm.md punkshell_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.1.tm.md fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.md {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.md {tomlish toml parser} doc/files/_module_tomlish-1.1.1.tm.md sa,punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.md sa,punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.md punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.md punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md layout {index.md layout} punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.md sa,punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.md sa,punkshell_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.1.tm.md sa,punkshell_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.md punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.md kw,windows {index.md windows} kw,module {index.md module} punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.md kw,plugin {index.md plugin} punkshell doc/files/main.md kw,fileformat {index.md fileformat} punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.md sa,punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.md punkshell__project_changes(n) doc/files/project_changes.md kw,utility {index.md utility} prompt {index.md prompt} launcher {index.md launcher} kw,ssh {index.md ssh} kw,arguments {index.md arguments} {punkshell package/module loading} doc/files/punk/_module_packagepreference-0.1.0.tm.md sa,punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.md crossplatform {index.md crossplatform} punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.md {punk::sixel API} doc/files/punk/_module_sixel-0.1.0.tm.md alias {index.md alias} kw,filesystem {index.md filesystem} punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.md sa,overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.md shell {index.md shell} {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.md kw,package {index.md package} kw,parsing {index.md parsing} kw,toml {index.md toml} punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.md kw,debug {index.md debug} punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.md {punk textblock functions} doc/files/_module_textblock-0.1.2.tm.md sa,punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.md punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.md punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.md overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.md sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.md kw,faux {index.md faux} frame {index.md frame} toml {index.md toml} sa,punkshell__project_intro(n) doc/files/project_intro.md shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.md kw,unofficial {index.md unofficial} encoding {index.md encoding} punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.md sa,punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.md sa,punkshell_module_punk::args::tclcore doc/files/punk/args/_module_tclcore-0.1.0.tm.md sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.md sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.md modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.md punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.md zip {index.md zip} {Module repl codethread} doc/files/punk/repl/_module_codethread-0.1.1.tm.md kw,BOM {index.md bom} faux {index.md faux} sa,punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.md {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.md sa,punkshell_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.1.tm.md sa,punkshell_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.md module {index.md module} sa,punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.md plugin {index.md plugin} unicode {index.md unicode} symlink {index.md symlink} sa,punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.md kw,capability {index.md capability} punkshell_module_punk::args::tclcore doc/files/punk/args/_module_tclcore-0.1.0.tm.md sa,modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.md kw,crossplatform {index.md crossplatform} punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.md {punkshell Changes} doc/files/project_changes.md {punk::args definitions for tcl core commands} doc/files/punk/args/_module_tclcore-0.1.0.tm.md fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.md modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.md punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.md {Introduction to punkshell} doc/files/project_intro.md punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.md punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.md sa,punkshell(n) doc/files/main.md sa,punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.md punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.md {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.md punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.md kw,parse {index.md parse} sa,punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.md punkshell(n) doc/files/main.md kw,string {index.md string} sa,shellspy_module_termscheme(0) doc/files/_module_termscheme-0.1.0.tm.md ssh {index.md ssh} kw,file {index.md file} sa,punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.md punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.md punkshell_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.md sa,punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.md punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.md sa,punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.md punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.md {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,punkshell__project_changes doc/files/project_changes.md {kw,prompt theme} {index.md prompt_theme} kw,experimental {index.md experimental} sa,shellspy_module_termscheme doc/files/_module_termscheme-0.1.0.tm.md punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.md sa,punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.md configuration {index.md configuration} file {index.md file} {args parsing} doc/files/punk/_module_args-0.1.0.tm.md punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.md encodings {index.md encodings} compatibility {index.md compatibility} {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.md sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.md sa,shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.md kw,assertion {index.md assertion} {scriptwrap polyglot tool} doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.md sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.md {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.5.tm.md punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.md kw,repl {index.md repl} punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.md commandset {index.md commandset} kw,text {index.md text} {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.md punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.md sa,tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.md kw,scriptwrap {index.md scriptwrap} {filesystem islands for safe interps} doc/files/punk/_module_island-0.1.0.tm.md shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.md kw,protocol {index.md protocol} kw,theme {index.md theme} sa,modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.md punkshell_module_punk::safe doc/files/punk/_module_safe-0.1.0.tm.md repl {index.md repl} sa,punkshell_module_punk::safe(0) doc/files/punk/_module_safe-0.1.0.tm.md text {index.md text} BOM {index.md bom} sa,punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.md kw,POSH {index.md posh} kw,console {index.md console} {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.md punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.md string {index.md string} \ No newline at end of file diff --git a/src/embedded/md/doc/files/_module_termscheme-0.1.0.tm.md b/src/embedded/md/doc/files/_module_termscheme-0.1.0.tm.md new file mode 100644 index 00000000..4e5d7120 --- /dev/null +++ b/src/embedded/md/doc/files/_module_termscheme-0.1.0.tm.md @@ -0,0 +1,87 @@ + +[//000000001]: # (shellspy\_module\_termscheme \- \-) +[//000000002]: # (Generated from file '\_module\_termscheme\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (shellspy\_module\_termscheme\(0\) 0\.1\.0 doc "\-") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +shellspy\_module\_termscheme \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace termscheme::class](#subsection3) + + - [Namespace termscheme](#subsection4) + + - [Namespace termscheme::lib](#subsection5) + + - [Internal](#section4) + + - [Namespace termscheme::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require termscheme + +# DESCRIPTION + +\- + +# Overview + +overview of termscheme + +## Concepts + +\- + +## dependencies + +packages used by termscheme + + - __Tcl 8\.6__ + +# API + +## Namespace termscheme::class + +class definitions if \{ eq ""\} \{ + +## Namespace termscheme + +## Namespace termscheme::lib + +# Internal + +## Namespace termscheme::system + +# KEYWORDS + +[module](\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md b/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md index 1cfe3a05..b666aacf 100644 --- a/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md +++ b/src/embedded/md/doc/files/punk/_module_ansi-0.1.1.tm.md @@ -87,7 +87,7 @@ package require punk::ansi [__request\_tabstops__](#41) [__titleset__ *windowtitles*](#42) [__ansistrip__ *text*](#43) -[__ansistrip__ *text*](#44) +[__ansistrip2__ *text*](#44) [__ansistripraw__ *text*](#45) [__is\_sgr\_reset__ *code*](#46) [__has\_sgr\_leadingreset__ *code*](#47) @@ -384,7 +384,7 @@ Core API functions for punk::ansi Alternate graphics chars are replaced with modern unicode equivalents \(e\.g boxdrawing glyphs\) - - __ansistrip__ *text* + - __ansistrip2__ *text* Return a string with ansi codes stripped out diff --git a/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md b/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md index f6744566..619b9b4e 100644 --- a/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md +++ b/src/embedded/md/doc/files/punk/_module_args-0.1.0.tm.md @@ -30,7 +30,7 @@ punkshell\_module\_punk::args \- args parsing - [API](#section3) - - [Namespace punk::args::class](#subsection4) + - [Namespace punk::args](#subsection4) - [Namespace punk::args](#subsection5) @@ -48,7 +48,7 @@ punkshell\_module\_punk::args \- args parsing package require punk::args -[__get\_dict__ *optionspecs* *rawargs* ?option value\.\.\.?](#1) +[__get\_dict__ *optionspecs* *rawargs*](#1) # DESCRIPTION @@ -97,7 +97,7 @@ e\.g #setting -type none indicates a flag that doesn't take a value (solo flag) -nocomplain -type none *values -min 1 -max -1 - } $args]] opts values + } $args]] leaders opts values puts "translation is [dict get $opts -translation]" foreach f [dict values $values] { @@ -111,7 +111,7 @@ defaults and some extra controls \- the above example would work just fine with only the \- lines, but would allow zero filenames to be supplied as no \-min value is set for \*values -valid \* lines being with \*proc \*opts \*values +valid \* lines being with \*proc \*leaders \*opts \*values lines beginning with a dash define options \- a name can optionally be given to each trailing positional argument\. @@ -138,7 +138,7 @@ for punk::args processing \- allowing leading and trailing positional arguments *values -min 2 -max 2 fileA -type existingfile 1 fileB -type existingfile 1 - } $args]] opts values + } $args]] leaders opts values puts "$category fileA: [dict get $values fileA]" puts "$category fileB: [dict get $values fileB]" } @@ -271,13 +271,19 @@ packages used by punk::args # API -## Namespace punk::args::class +## Namespace punk::args + +cooperative namespace punk::args::register + +punk::args aware packages may add their own namespace to the public list +variable NAMESPACES before or after punk::args is loaded -class definitions +The punk::args package will then test for a public list variable +::PUNKARGS containing argument definitions when it needs to\. ## Namespace punk::args - - __get\_dict__ *optionspecs* *rawargs* ?option value\.\.\.? + - __get\_dict__ *optionspecs* *rawargs* Parse rawargs as a sequence of zero or more option\-value pairs followed by zero or more values @@ -311,8 +317,8 @@ class definitions comment lines begining with \# are ignored and can be placed anywhere except within a multiline value where it would become part of that value - lines beginning with \*proc \*opts or \*values also take \-key val pairs and - can be used to set defaults and control settings\. + lines beginning with \*proc \*leaders \*opts or \*values also take \-key val + pairs and can be used to set defaults and control settings\. \*opts or \*values lines can appear multiple times with defaults affecting flags/values that follow\. diff --git a/src/embedded/md/doc/files/punk/_module_console-0.1.1.tm.md b/src/embedded/md/doc/files/punk/_module_console-0.1.1.tm.md index 261d040b..a2f9124f 100644 --- a/src/embedded/md/doc/files/punk/_module_console-0.1.1.tm.md +++ b/src/embedded/md/doc/files/punk/_module_console-0.1.1.tm.md @@ -57,8 +57,12 @@ packages used by punk::console - __Tcl 8\.6\-__ + - __Thread__ + - __punk::ansi__ + - __punk::args__ + # API ## Namespace punk::console diff --git a/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md b/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md index e86ea644..f1755ad0 100644 --- a/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md +++ b/src/embedded/md/doc/files/punk/_module_lib-0.1.1.tm.md @@ -102,6 +102,8 @@ packages used by punk::lib - __Tcl 8\.6\-__ + - __punk::args__ + # API ## Namespace punk::lib::compat diff --git a/src/embedded/md/doc/files/punk/_module_safe-0.1.0.tm.md b/src/embedded/md/doc/files/punk/_module_safe-0.1.0.tm.md new file mode 100644 index 00000000..d98f6bfc --- /dev/null +++ b/src/embedded/md/doc/files/punk/_module_safe-0.1.0.tm.md @@ -0,0 +1,95 @@ + +[//000000001]: # (punkshell\_module\_punk::safe \- punk::safe \- safebase interpreters) +[//000000002]: # (Generated from file '\_module\_safe\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (punkshell\_module\_punk::safe\(0\) 0\.1\.0 doc "punk::safe \- safebase interpreters") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +punkshell\_module\_punk::safe \- Module API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::safe::class](#subsection3) + + - [Namespace punk::safe::lib](#subsection4) + + - [Namespace punk::safe](#subsection5) + + - [Internal](#section4) + + - [Namespace punk::safe::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::safe + +[__setSyncMode__ *args*](#1) + +# DESCRIPTION + +\- + +# Overview + +overview of punk::safe + +## Concepts + +\- + +## dependencies + +packages used by punk::safe + + - __Tcl 8\.6__ + + - __punk::args__ + +# API + +## Namespace punk::safe::class + +class definitions if \{ eq ""\} \{ + +## Namespace punk::safe::lib + +## Namespace punk::safe + + - __setSyncMode__ *args* + +# Internal + +## Namespace punk::safe::system + +Internal functions that are not part of the API + +# KEYWORDS + +[module](\.\./\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/punk/_module_sixel-0.1.0.tm.md b/src/embedded/md/doc/files/punk/_module_sixel-0.1.0.tm.md new file mode 100644 index 00000000..71f349f7 --- /dev/null +++ b/src/embedded/md/doc/files/punk/_module_sixel-0.1.0.tm.md @@ -0,0 +1,89 @@ + +[//000000001]: # (punkshell\_module\_punk::sixel \- experimental sixel functions) +[//000000002]: # (Generated from file '\_module\_sixel\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (punkshell\_module\_punk::sixel\(0\) 0\.1\.0 doc "experimental sixel functions") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +punkshell\_module\_punk::sixel \- punk::sixel API + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::sixel::class](#subsection3) + + - [Namespace punk::sixel](#subsection4) + + - [Namespace punk::sixel::lib](#subsection5) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::sixel + +# DESCRIPTION + +Experimental support functions for working with sixel data + +For real sixel work a version written in a systems language such as c or zig may +be required\. + +# Overview + +overview of punk::sixel + +## Concepts + +\- + +## dependencies + +packages used by punk::sixel + + - __Tcl 8\.6__ + + - __punk::args__ + + - __punk::console__ + + - __punk::ansi__ + +# API + +## Namespace punk::sixel::class + +class definitions if \{ eq ""\} \{ + +## Namespace punk::sixel + +## Namespace punk::sixel::lib + +# KEYWORDS + +[experimental](\.\./\.\./\.\./index\.md\#experimental), +[module](\.\./\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/files/punk/args/_module_tclcore-0.1.0.tm.md b/src/embedded/md/doc/files/punk/args/_module_tclcore-0.1.0.tm.md new file mode 100644 index 00000000..99b601e4 --- /dev/null +++ b/src/embedded/md/doc/files/punk/args/_module_tclcore-0.1.0.tm.md @@ -0,0 +1,90 @@ + +[//000000001]: # (punkshell\_module\_punk::args::tclcore \- tcl core argument definitions) +[//000000002]: # (Generated from file '\_module\_tclcore\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2025) +[//000000004]: # (punkshell\_module\_punk::args::tclcore\(0\) 0\.1\.0 doc "tcl core argument definitions") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +punkshell\_module\_punk::args::tclcore \- punk::args definitions for tcl core +commands + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::args::tclcore::class](#subsection3) + + - [Namespace punk::args::tclcore](#subsection4) + + - [Namespace punk::args::tclcore::lib](#subsection5) + + - [Internal](#section4) + + - [Namespace punk::args::tclcore::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::args::tclcore + +# DESCRIPTION + +\- + +# Overview + +overview of punk::args::tclcore + +## Concepts + +\- + +## dependencies + +packages used by punk::args::tclcore + + - __Tcl 8\.6__ + + - __punk::args__ + +# API + +## Namespace punk::args::tclcore::class + +class definitions if \{ eq ""\} \{ + +## Namespace punk::args::tclcore + +## Namespace punk::args::tclcore::lib + +# Internal + +## Namespace punk::args::tclcore::system + +# KEYWORDS + +[module](\.\./\.\./\.\./\.\./index\.md\#module) + +# COPYRIGHT + +Copyright © 2025 diff --git a/src/embedded/md/doc/files/punk/nav/_module_fs-0.1.0.tm.md b/src/embedded/md/doc/files/punk/nav/_module_fs-0.1.0.tm.md index 9eb27c5b..c668295d 100644 --- a/src/embedded/md/doc/files/punk/nav/_module_fs-0.1.0.tm.md +++ b/src/embedded/md/doc/files/punk/nav/_module_fs-0.1.0.tm.md @@ -1,8 +1,8 @@ -[//000000001]: # (shellspy\_module\_punk::nav::fs \- fs nav) +[//000000001]: # (punkshell\_module\_punk::nav::fs \- fs nav) [//000000002]: # (Generated from file '\_module\_fs\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') [//000000003]: # (Copyright © 2024) -[//000000004]: # (shellspy\_module\_punk::nav::fs\(0\) 0\.1\.0 doc "fs nav") +[//000000004]: # (punkshell\_module\_punk::nav::fs\(0\) 0\.1\.0 doc "fs nav")
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
# NAME -shellspy\_module\_punk::nav::fs \- punk::nav::fs console filesystem navigation +punkshell\_module\_punk::nav::fs \- punk::nav::fs console filesystem navigation # Table Of Contents diff --git a/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md b/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md index dab9aa2d..4e7f0d92 100644 --- a/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md +++ b/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.0.tm.md @@ -1,8 +1,8 @@ -[//000000001]: # (shellspy\_module\_punk::repl::codethread \- codethread for repl \- root interpreter) +[//000000001]: # (punkshell\_module\_punk::repl::codethread \- codethread for repl \- root interpreter) [//000000002]: # (Generated from file '\_module\_codethread\-0\.1\.0\.tm\.man' by tcllib/doctools with format 'markdown') [//000000003]: # (Copyright © 2024) -[//000000004]: # (shellspy\_module\_punk::repl::codethread\(0\) 0\.1\.0 doc "codethread for repl \- root interpreter") +[//000000004]: # (punkshell\_module\_punk::repl::codethread\(0\) 0\.1\.0 doc "codethread for repl \- root interpreter")
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
# NAME -shellspy\_module\_punk::repl::codethread \- Module repl codethread +punkshell\_module\_punk::repl::codethread \- Module repl codethread # Table Of Contents @@ -68,7 +68,7 @@ packages used by punk::repl::codethread ## Namespace punk::repl::codethread::class -class definitions if \{ eq ""\} \{ +class definitions ## Namespace punk::repl::codethread diff --git a/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.1.tm.md b/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.1.tm.md new file mode 100644 index 00000000..302e8311 --- /dev/null +++ b/src/embedded/md/doc/files/punk/repl/_module_codethread-0.1.1.tm.md @@ -0,0 +1,87 @@ + +[//000000001]: # (punkshell\_module\_punk::repl::codethread \- codethread for repl \- root interpreter) +[//000000002]: # (Generated from file '\_module\_codethread\-0\.1\.1\.tm\.man' by tcllib/doctools with format 'markdown') +[//000000003]: # (Copyright © 2024) +[//000000004]: # (punkshell\_module\_punk::repl::codethread\(0\) 0\.1\.1 doc "codethread for repl \- root interpreter") + +
[ Main Table Of Contents | Table Of Contents | Keyword Index ]
+ +# NAME + +punkshell\_module\_punk::repl::codethread \- Module repl codethread + +# Table Of Contents + + - [Table Of Contents](#toc) + + - [Synopsis](#synopsis) + + - [Description](#section1) + + - [Overview](#section2) + + - [Concepts](#subsection1) + + - [dependencies](#subsection2) + + - [API](#section3) + + - [Namespace punk::repl::codethread::class](#subsection3) + + - [Namespace punk::repl::codethread](#subsection4) + + - [Namespace punk::repl::codethread::lib](#subsection5) + + - [Internal](#section4) + + - [Namespace punk::repl::codethread::system](#subsection6) + + - [Keywords](#keywords) + + - [Copyright](#copyright) + +# SYNOPSIS + +package require punk::repl::codethread + +# DESCRIPTION + +This is part of the infrastructure required for the punk::repl to operate + +# Overview + +overview of punk::repl::codethread + +## Concepts + +\- + +## dependencies + +packages used by punk::repl::codethread + + - __Tcl 8\.6__ + +# API + +## Namespace punk::repl::codethread::class + +class definitions + +## Namespace punk::repl::codethread + +## Namespace punk::repl::codethread::lib + +# Internal + +## Namespace punk::repl::codethread::system + +# KEYWORDS + +[module](\.\./\.\./\.\./\.\./index\.md\#module), [repl](\.\./\.\./\.\./\.\./index\.md\#repl) + +# COPYRIGHT + +Copyright © 2024 diff --git a/src/embedded/md/doc/toc.md b/src/embedded/md/doc/toc.md index da725603..7976a69e 100644 --- a/src/embedded/md/doc/toc.md +++ b/src/embedded/md/doc/toc.md @@ -27,6 +27,8 @@ - [punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md) args parsing + - [punkshell\_module\_punk::args::tclcore](doc/files/punk/args/\_module\_tclcore\-0\.1\.0\.tm\.md) punk::args definitions for tcl core commands + - [punkshell\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) assertion alternative to control::assert - [punkshell\_module\_punk::blockletter](doc/files/punk/\_module\_blockletter\-0\.1\.0\.tm\.md) punk::blockletter frame\-based large lettering test/logo @@ -53,12 +55,22 @@ - [punkshell\_module\_punk::mix::commandset::project](doc/files/punk/mix/commandset/\_module\_project\-0\.1\.0\.tm\.md) dec commandset \- project + - [punkshell\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) punk::nav::fs console filesystem navigation + - [punkshell\_module\_punk::packagepreference](doc/files/punk/\_module\_packagepreference\-0\.1\.0\.tm\.md) punkshell package/module loading - [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) Filesystem path utilities + - [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) Module repl codethread + + - [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.1\.tm\.md) Module repl codethread + - [punkshell\_module\_punk::rest](doc/files/punk/\_module\_rest\-0\.1\.0\.tm\.md) punk::rest + - [punkshell\_module\_punk::safe](doc/files/punk/\_module\_safe\-0\.1\.0\.tm\.md) Module API + + - [punkshell\_module\_punk::sixel](doc/files/punk/\_module\_sixel\-0\.1\.0\.tm\.md) punk::sixel API + - [punkshell\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) Tcl procedures to execute tcl scripts in remote hosts - [punkshell\_module\_punk::trie](doc/files/punk/\_module\_trie\-0\.1\.0\.tm\.md) punk::trie API @@ -75,10 +87,8 @@ - [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md) punk textblock functions - - [shellspy\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) punk::nav::fs console filesystem navigation - - - [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) Module repl codethread - - [shellspy\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.0\.tm\.md) Module API + - [shellspy\_module\_termscheme](doc/files/\_module\_termscheme\-0\.1\.0\.tm\.md) Module API + - [tomlish\_module\_tomlish](doc/files/\_module\_tomlish\-1\.1\.1\.tm\.md) tomlish toml parser diff --git a/src/embedded/md/index.md b/src/embedded/md/index.md index 2e584619..b502a9e4 100644 --- a/src/embedded/md/index.md +++ b/src/embedded/md/index.md @@ -57,7 +57,7 @@ |---|---| |encoding|[punkshell\_module\_punk::cesu](doc/files/punk/\_module\_cesu\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md)| |encodings|[punkshell\_module\_punk::char](doc/files/punk/\_module\_char\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::encmime](doc/files/punk/\_module\_encmime\-0\.1\.0\.tm\.md)| -|experimental|[punkshell\_module\_punk::cesu](doc/files/punk/\_module\_cesu\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::flib](doc/files/punk/\_module\_flib\-0\.1\.0\.tm\.md)| +|experimental|[punkshell\_module\_punk::cesu](doc/files/punk/\_module\_cesu\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::flib](doc/files/punk/\_module\_flib\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::sixel](doc/files/punk/\_module\_sixel\-0\.1\.0\.tm\.md)| #### Keywords: F @@ -68,7 +68,7 @@ |faux|[fauxlink\_module\_fauxlink](doc/files/\_module\_fauxlink\-0\.1\.1\.tm\.md)| |file|[punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md)| |fileformat|[punkshell\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.1\.tm\.md)| -|filesystem|[punkshell\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md)| +|filesystem|[punkshell\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md)| |frame|[punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md)| @@ -100,7 +100,7 @@ ||| |---|---| -|module|[modpod\_module\_modpod](doc/files/\_module\_modpod\-0\.1\.2\.tm\.md) · [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.5\.tm\.md) · [punkshell::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) · [punkshell\_module\_argparsingtest](doc/files/\_module\_argparsingtest\-0\.1\.0\.tm\.md) · [punkshell\_module\_poshinfo](doc/files/\_module\_poshinfo\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::aliascore](doc/files/punk/\_module\_aliascore\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::blockletter](doc/files/punk/\_module\_blockletter\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::cap](doc/files/punk/\_module\_cap\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::cesu](doc/files/punk/\_module\_cesu\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::char](doc/files/punk/\_module\_char\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::console](doc/files/punk/\_module\_console\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::encmime](doc/files/punk/\_module\_encmime\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::experiment](doc/files/punk/\_module\_experiment\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::flib](doc/files/punk/\_module\_flib\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::lib](doc/files/punk/\_module\_lib\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::packagepreference](doc/files/punk/\_module\_packagepreference\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::rest](doc/files/punk/\_module\_rest\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::trie](doc/files/punk/\_module\_trie\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::uc](doc/files/punk/\_module\_uc\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::winlnk](doc/files/punk/\_module\_winlnk\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.1\.tm\.md) · [punkshell\_module\_scriptwrap](doc/files/punk/mix/commandset/\_module\_scriptwrap\-0\.1\.0\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.1\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md) · [shellspy\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) · [shellspy\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.0\.tm\.md) · [tomlish\_module\_tomlish](doc/files/\_module\_tomlish\-1\.1\.1\.tm\.md)| +|module|[modpod\_module\_modpod](doc/files/\_module\_modpod\-0\.1\.2\.tm\.md) · [overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.5\.tm\.md) · [punkshell::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) · [punkshell\_module\_argparsingtest](doc/files/\_module\_argparsingtest\-0\.1\.0\.tm\.md) · [punkshell\_module\_poshinfo](doc/files/\_module\_poshinfo\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::aliascore](doc/files/punk/\_module\_aliascore\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::args::tclcore](doc/files/punk/args/\_module\_tclcore\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::blockletter](doc/files/punk/\_module\_blockletter\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::cap](doc/files/punk/\_module\_cap\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::cesu](doc/files/punk/\_module\_cesu\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::char](doc/files/punk/\_module\_char\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::console](doc/files/punk/\_module\_console\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::encmime](doc/files/punk/\_module\_encmime\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::experiment](doc/files/punk/\_module\_experiment\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::flib](doc/files/punk/\_module\_flib\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::island](doc/files/punk/\_module\_island\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::lib](doc/files/punk/\_module\_lib\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::packagepreference](doc/files/punk/\_module\_packagepreference\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::rest](doc/files/punk/\_module\_rest\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::safe](doc/files/punk/\_module\_safe\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::sixel](doc/files/punk/\_module\_sixel\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::trie](doc/files/punk/\_module\_trie\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::uc](doc/files/punk/\_module\_uc\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::winlnk](doc/files/punk/\_module\_winlnk\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.1\.tm\.md) · [punkshell\_module\_scriptwrap](doc/files/punk/mix/commandset/\_module\_scriptwrap\-0\.1\.0\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.1\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md) · [shellspy\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.0\.tm\.md) · [shellspy\_module\_termscheme](doc/files/\_module\_termscheme\-0\.1\.0\.tm\.md) · [tomlish\_module\_tomlish](doc/files/\_module\_tomlish\-1\.1\.1\.tm\.md)| #### Keywords: P @@ -124,7 +124,7 @@ ||| |---|---| -|repl|[punkshell](doc/files/main\.md) · [punkshell\_\_project\_changes](doc/files/project\_changes\.md) · [punkshell\_\_project\_intro](doc/files/project\_intro\.md) · [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md)| +|repl|[punkshell](doc/files/main\.md) · [punkshell\_\_project\_changes](doc/files/project\_changes\.md) · [punkshell\_\_project\_intro](doc/files/project\_intro\.md) · [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.1\.tm\.md)| |rest|[punkshell\_module\_punk::rest](doc/files/punk/\_module\_rest\-0\.1\.0\.tm\.md)| @@ -146,7 +146,7 @@ |---|---| |table|[punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md)| |telnet|[punkshell::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md)| -|terminal|[punkshell::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) · [punkshell\_module\_poshinfo](doc/files/\_module\_poshinfo\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::console](doc/files/punk/\_module\_console\-0\.1\.1\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md) · [shellspy\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md)| +|terminal|[punkshell::basictelnet](doc/files/punk/\_module\_basictelnet\-0\.1\.0\.tm\.md) · [punkshell\_module\_poshinfo](doc/files/\_module\_poshinfo\-0\.1\.0\.tm\.md) · [punkshell\_module\_punk::ansi](doc/files/punk/\_module\_ansi\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::console](doc/files/punk/\_module\_console\-0\.1\.1\.tm\.md) · [punkshell\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md)| |text|[overtype\_module\_overtype](doc/files/\_module\_overtype\-1\.6\.5\.tm\.md) · [punkshell\_module\_punk::fileline](doc/files/punk/\_module\_fileline\-0\.1\.0\.tm\.md) · [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md)| |theme|[punkshell\_module\_poshinfo](doc/files/\_module\_poshinfo\-0\.1\.0\.tm\.md)| |toml|[fauxlink\_module\_fauxlink](doc/files/\_module\_fauxlink\-0\.1\.1\.tm\.md) · [tomlish\_module\_tomlish](doc/files/\_module\_tomlish\-1\.1\.1\.tm\.md)| diff --git a/src/embedded/md/toc.md b/src/embedded/md/toc.md index da725603..7976a69e 100644 --- a/src/embedded/md/toc.md +++ b/src/embedded/md/toc.md @@ -27,6 +27,8 @@ - [punkshell\_module\_punk::args](doc/files/punk/\_module\_args\-0\.1\.0\.tm\.md) args parsing + - [punkshell\_module\_punk::args::tclcore](doc/files/punk/args/\_module\_tclcore\-0\.1\.0\.tm\.md) punk::args definitions for tcl core commands + - [punkshell\_module\_punk::assertion](doc/files/punk/\_module\_assertion\-0\.1\.0\.tm\.md) assertion alternative to control::assert - [punkshell\_module\_punk::blockletter](doc/files/punk/\_module\_blockletter\-0\.1\.0\.tm\.md) punk::blockletter frame\-based large lettering test/logo @@ -53,12 +55,22 @@ - [punkshell\_module\_punk::mix::commandset::project](doc/files/punk/mix/commandset/\_module\_project\-0\.1\.0\.tm\.md) dec commandset \- project + - [punkshell\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) punk::nav::fs console filesystem navigation + - [punkshell\_module\_punk::packagepreference](doc/files/punk/\_module\_packagepreference\-0\.1\.0\.tm\.md) punkshell package/module loading - [punkshell\_module\_punk::path](doc/files/punk/\_module\_path\-0\.1\.0\.tm\.md) Filesystem path utilities + - [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) Module repl codethread + + - [punkshell\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.1\.tm\.md) Module repl codethread + - [punkshell\_module\_punk::rest](doc/files/punk/\_module\_rest\-0\.1\.0\.tm\.md) punk::rest + - [punkshell\_module\_punk::safe](doc/files/punk/\_module\_safe\-0\.1\.0\.tm\.md) Module API + + - [punkshell\_module\_punk::sixel](doc/files/punk/\_module\_sixel\-0\.1\.0\.tm\.md) punk::sixel API + - [punkshell\_module\_punk::sshrun](doc/files/punk/\_module\_sshrun\-0\.1\.0\.tm\.md) Tcl procedures to execute tcl scripts in remote hosts - [punkshell\_module\_punk::trie](doc/files/punk/\_module\_trie\-0\.1\.0\.tm\.md) punk::trie API @@ -75,10 +87,8 @@ - [punkshell\_module\_textblock](doc/files/\_module\_textblock\-0\.1\.2\.tm\.md) punk textblock functions - - [shellspy\_module\_punk::nav::fs](doc/files/punk/nav/\_module\_fs\-0\.1\.0\.tm\.md) punk::nav::fs console filesystem navigation - - - [shellspy\_module\_punk::repl::codethread](doc/files/punk/repl/\_module\_codethread\-0\.1\.0\.tm\.md) Module repl codethread - - [shellspy\_module\_punk::zip](doc/files/punk/\_module\_zip\-0\.1\.0\.tm\.md) Module API + - [shellspy\_module\_termscheme](doc/files/\_module\_termscheme\-0\.1\.0\.tm\.md) Module API + - [tomlish\_module\_tomlish](doc/files/\_module\_tomlish\-1\.1\.1\.tm\.md) tomlish toml parser diff --git a/src/embedded/www/.doc/tocdoc b/src/embedded/www/.doc/tocdoc index 539a2e53..cd092227 100644 --- a/src/embedded/www/.doc/tocdoc +++ b/src/embedded/www/.doc/tocdoc @@ -11,6 +11,7 @@ [item doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore {punkshell command aliases}] [item doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi {Ansi string functions}] [item doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args {args parsing}] +[item doc/files/punk/args/_module_tclcore-0.1.0.tm.html punkshell_module_punk::args::tclcore {punk::args definitions for tcl core commands}] [item doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion {assertion alternative to control::assert}] [item doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter {punk::blockletter frame-based large lettering test/logo}] [item doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap {capability provider and handler plugin system}] @@ -24,9 +25,14 @@ [item doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island {filesystem islands for safe interps}] [item doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib {punk general utility functions}] [item doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html punkshell_module_punk::mix::commandset::project {dec commandset - project}] +[item doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs {punk::nav::fs console filesystem navigation}] [item doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference {punkshell package/module loading}] [item doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path {Filesystem path utilities}] +[item doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::repl::codethread {Module repl codethread}] +[item doc/files/punk/repl/_module_codethread-0.1.1.tm.html punkshell_module_punk::repl::codethread {Module repl codethread}] [item doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest punk::rest] +[item doc/files/punk/_module_safe-0.1.0.tm.html punkshell_module_punk::safe {Module API}] +[item doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::sixel {punk::sixel API}] [item doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}] [item doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie {punk::trie API}] [item doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc {Module API}] @@ -35,8 +41,7 @@ [item doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap {scriptwrap polyglot tool}] [item doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock {punk textblock functions}] [item doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock {punk textblock functions}] -[item doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs {punk::nav::fs console filesystem navigation}] -[item doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread {Module repl codethread}] [item doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip {Module API}] +[item doc/files/_module_termscheme-0.1.0.tm.html shellspy_module_termscheme {Module API}] [item doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish {tomlish toml parser}] [toc_end] diff --git a/src/embedded/www/.idx b/src/embedded/www/.idx index 2cf06236..b4c9e9cc 100644 --- a/src/embedded/www/.idx +++ b/src/embedded/www/.idx @@ -1 +1 @@ -{assertion {{doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion}} fileformat {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip}} POSH {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion}} theme {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} windows {{doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} proc {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} filesystem {{doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island}} layout {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} fake {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}} datastructure {{doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie}} utility {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock}} wcswidth {{doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc}} rest {{doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun}} scriptwrap {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap}} changelog {{doc/files/project_changes.html punkshell__project_changes}} launcher {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap}} prompt {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} terminal {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} path {{doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path}} args {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} crossplatform {{doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} file {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} http {{doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest}} unofficial {{doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} {doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu}} cesu {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu}} configuration {{doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish}} table {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char}} compatibility {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu}} alias {{doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore}} package {{doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference}} parsing {{doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish}} colour {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} {prompt theme} {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} experimental {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib}} shell {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} capability {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} commandset {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap}} parse {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} frame {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} repl {{doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread} {doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} console {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} shortcut {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} telnet {{doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} toml {{doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} {doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}} text {{doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} lnk {{doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} arguments {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} encoding {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} interp {{doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island}} protocol {{doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} zip {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip}} ansi {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} trie {{doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie}} faux {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}} punk {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} module {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} {doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} {doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread} {doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} {doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} {doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} {doc/files/_module_modpod-0.1.2.tm.html modpod_module_modpod} {doc/files/punk/_module_experiment-0.1.0.tm.html punkshell_module_punk::experiment} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} {doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_argparsingtest} {doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun} {doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference} {doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} {doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} {doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} {doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} {doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} {doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} {doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter}} lib {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock}} unicode {{doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} string {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} symlink {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}}} {{repl doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread} . {module doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} . {terminal doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs} . {fake doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {parse doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {filesystem doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {module doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs} . {changelog doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {shell doc/files/main.html punkshell} . {module doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} . {terminal doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {module doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} . {utility doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} . {string doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {module doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} . {proc doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {plugin doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {path doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {args doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {module doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {punk doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {table doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {datastructure doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun} . {module doc/files/_module_modpod-0.1.2.tm.html modpod_module_modpod} . {commandset doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {module doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {module doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {repl doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_experiment-0.1.0.tm.html punkshell_module_punk::experiment} . {punk doc/files/project_intro.html punkshell__project_intro} . {arguments doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {unofficial doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {unofficial doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {cesu doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {capability doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {ansi doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} . {module doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_argparsingtest} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {utility doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {shell doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {module doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} . {wcswidth doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {console doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {frame doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {POSH doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {module doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {module doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {parsing doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {module doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {shell doc/files/project_intro.html punkshell__project_intro} . {{prompt theme} doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {console doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} . {scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {module doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} . {shortcut doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {http doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} . {console doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {lib doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {ansi doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {telnet doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {module doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {unicode doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {console doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {alias doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore} . {repl doc/files/main.html punkshell} . {file doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {terminal doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {windows doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {package doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference} . {module doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip} . {terminal doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} . {module doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {trie doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} . {protocol doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {launcher doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {text doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {terminal doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {text doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {lib doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} . {toml doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {layout doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {module doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {module doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread} . {lnk doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {text doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} . {encodings doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {module doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {prompt doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {colour doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {interp doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} . {experimental doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {symlink doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {compatibility doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {zip doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} . {assert doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {rest doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} . {module doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {filesystem doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} . {module doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun} . {module doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} . {parse doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {repl doc/files/project_intro.html punkshell__project_intro} . {configuration doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {crossplatform doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {experimental doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {toml doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {shortcut doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {encoding doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {filesystem doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {debug doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {fileformat doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} . {theme doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {module doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {console doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {punk doc/files/main.html punkshell} . {parse doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference} . {module doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore} . {module doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter} . {module doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {faux doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} .} 66 {assertion assertion fileformat fileformat assert assert POSH posh debug debug theme theme windows windows proc proc filesystem filesystem layout layout fake fake datastructure datastructure utility utility wcswidth wcswidth ssh ssh rest rest scriptwrap scriptwrap changelog changelog prompt prompt launcher launcher terminal terminal path path args args crossplatform crossplatform unofficial unofficial cesu cesu configuration configuration table table http http file file encodings encodings compatibility compatibility alias alias package package parsing parsing colour colour {prompt theme} prompt_theme experimental experimental shell shell capability capability parse parse commandset commandset console console repl repl frame frame toml toml telnet telnet shortcut shortcut text text lnk lnk arguments arguments BOM bom encoding encoding interp interp protocol protocol zip zip ansi ansi trie trie faux faux module module punk punk plugin plugin string string unicode unicode lib lib symlink symlink} \ No newline at end of file +{assertion {{doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion}} fileformat {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip}} POSH {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} assert {{doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion}} debug {{doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion}} theme {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} windows {{doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} proc {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} filesystem {{doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island}} layout {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} fake {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}} datastructure {{doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie}} utility {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock}} wcswidth {{doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc}} rest {{doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest}} ssh {{doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun}} scriptwrap {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap}} changelog {{doc/files/project_changes.html punkshell__project_changes}} launcher {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap}} prompt {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} terminal {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} path {{doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path}} args {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} crossplatform {{doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} file {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} http {{doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest}} unofficial {{doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} {doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu}} cesu {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu}} configuration {{doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish}} table {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} encodings {{doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char}} compatibility {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu}} alias {{doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore}} package {{doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference}} parsing {{doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish}} colour {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} {prompt theme} {{doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo}} experimental {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} {doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::sixel} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib}} shell {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} capability {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} commandset {{doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap}} parse {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} frame {{doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} repl {{doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::repl::codethread} {doc/files/project_changes.html punkshell__project_changes} {doc/files/punk/repl/_module_codethread-0.1.1.tm.html punkshell_module_punk::repl::codethread} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} console {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} shortcut {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} telnet {{doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} toml {{doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} {doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}} text {{doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} lnk {{doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk}} arguments {{doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args}} BOM {{doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} encoding {{doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline}} interp {{doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island}} protocol {{doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet}} zip {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip}} ansi {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock}} trie {{doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie}} faux {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}} punk {{doc/files/project_changes.html punkshell__project_changes} {doc/files/project_intro.html punkshell__project_intro} {doc/files/main.html punkshell}} module {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} {doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} {doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} {doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::repl::codethread} {doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} {doc/files/punk/repl/_module_codethread-0.1.1.tm.html punkshell_module_punk::repl::codethread} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} {doc/files/punk/args/_module_tclcore-0.1.0.tm.html punkshell_module_punk::args::tclcore} {doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} {doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} {doc/files/_module_modpod-0.1.2.tm.html modpod_module_modpod} {doc/files/punk/_module_experiment-0.1.0.tm.html punkshell_module_punk::experiment} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} {doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_argparsingtest} {doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun} {doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference} {doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} {doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} {doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} {doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::sixel} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} {doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} {doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} {doc/files/punk/_module_safe-0.1.0.tm.html punkshell_module_punk::safe} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} {doc/files/_module_termscheme-0.1.0.tm.html shellspy_module_termscheme} {doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} {doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter}} lib {{doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock}} unicode {{doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc}} plugin {{doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap}} string {{doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi}} symlink {{doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink}}} {{module doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} . {fake doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {parse doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {ansi doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {changelog doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {shell doc/files/main.html punkshell} . {module doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} . {string doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {utility doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} . {module doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} . {terminal doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {module doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} . {proc doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {encoding doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {plugin doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {path doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {args doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {module doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {punk doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {table doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {datastructure doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} . {module doc/files/punk/_module_safe-0.1.0.tm.html punkshell_module_punk::safe} . {ssh doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun} . {module doc/files/_module_modpod-0.1.2.tm.html modpod_module_modpod} . {commandset doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {module doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {module doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {repl doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_experiment-0.1.0.tm.html punkshell_module_punk::experiment} . {punk doc/files/project_intro.html punkshell__project_intro} . {arguments doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {unofficial doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {unofficial doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {cesu doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {capability doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {ansi doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} . {module doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_argparsingtest} . {terminal doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {utility doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {shell doc/files/project_changes.html punkshell__project_changes} . {module doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {module doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} . {wcswidth doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {BOM doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {frame doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {console doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {POSH doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {module doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {module doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {experimental doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::sixel} . {parsing doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {module doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {shell doc/files/project_intro.html punkshell__project_intro} . {{prompt theme} doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {console doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} . {scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {module doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} . {shortcut doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {terminal doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs} . {http doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} . {console doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {lib doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {encodings doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {ansi doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {telnet doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {module doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {unicode doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc} . {console doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {alias doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore} . {repl doc/files/main.html punkshell} . {file doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {terminal doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {windows doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {repl doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::repl::codethread} . {package doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference} . {module doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip} . {repl doc/files/punk/repl/_module_codethread-0.1.1.tm.html punkshell_module_punk::repl::codethread} . {terminal doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console} . {module doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {filesystem doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs} . {trie doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie} . {protocol doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {module doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::repl::codethread} . {launcher doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {text doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/repl/_module_codethread-0.1.1.tm.html punkshell_module_punk::repl::codethread} . {module doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap} . {terminal doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {text doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {module doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet} . {lib doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock} . {toml doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {layout doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {module doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap} . {lnk doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {module doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs} . {text doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype} . {encodings doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char} . {module doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {prompt doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {colour doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock} . {assertion doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {interp doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} . {module doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::sixel} . {experimental doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib} . {symlink doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {zip doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} . {compatibility doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {assert doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {rest doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest} . {module doc/files/punk/args/_module_tclcore-0.1.0.tm.html punkshell_module_punk::args::tclcore} . {module doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {filesystem doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} . {module doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun} . {module doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island} . {parse doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args} . {repl doc/files/project_intro.html punkshell__project_intro} . {configuration doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish} . {crossplatform doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk} . {experimental doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {toml doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {shortcut doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {filesystem doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path} . {encoding doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu} . {debug doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion} . {fileformat doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip} . {theme doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo} . {module doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime} . {console doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi} . {punk doc/files/main.html punkshell} . {parse doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline} . {module doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference} . {module doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore} . {module doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter} . {module doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib} . {faux doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink} . {module doc/files/_module_termscheme-0.1.0.tm.html shellspy_module_termscheme} .} 66 {assertion assertion fileformat fileformat assert assert POSH posh debug debug theme theme windows windows proc proc filesystem filesystem layout layout fake fake datastructure datastructure utility utility wcswidth wcswidth ssh ssh rest rest scriptwrap scriptwrap changelog changelog prompt prompt launcher launcher terminal terminal path path args args crossplatform crossplatform unofficial unofficial cesu cesu configuration configuration table table http http file file encodings encodings compatibility compatibility alias alias package package parsing parsing colour colour {prompt theme} prompt_theme experimental experimental shell shell capability capability parse parse commandset commandset console console repl repl frame frame toml toml telnet telnet shortcut shortcut text text lnk lnk arguments arguments BOM bom encoding encoding interp interp protocol protocol zip zip ansi ansi trie trie faux faux module module punk punk plugin plugin string string unicode unicode lib lib symlink symlink} \ No newline at end of file diff --git a/src/embedded/www/.toc b/src/embedded/www/.toc index 4bdba856..a451e0e3 100644 --- a/src/embedded/www/.toc +++ b/src/embedded/www/.toc @@ -1 +1 @@ -doc {doc/toc {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip {Module API}} {doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie {punk::trie API}} {doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/repl/_module_codethread-0.1.0.tm.html shellspy_module_punk::repl::codethread {Module repl codethread}} {doc/files/punk/nav/_module_fs-0.1.0.tm.html shellspy_module_punk::nav::fs {punk::nav::fs console filesystem navigation}} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args {args parsing}} {doc/files/project_changes.html punkshell__project_changes {punkshell Changes}} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char {character-set and unicode utilities}} {doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??}} {doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.html punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_modpod-0.1.2.tm.html modpod_module_modpod {Module API}} {doc/files/punk/_module_experiment-0.1.0.tm.html punkshell_module_punk::experiment {Module API}} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo {poshinfo prompt theme tool}} {doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_argparsingtest {Module API}} {doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference {punkshell package/module loading}} {doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island {filesystem islands for safe interps}} {doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore {punkshell command aliases}} {doc/files/main.html punkshell {punkshell - Core}} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console {punk console}} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock {punk textblock functions}} {doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib {flib experimental}} {doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish {tomlish toml parser}} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock {punk textblock functions}} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap {scriptwrap polyglot tool}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink {faux link application shortcuts}} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline {file line-handling utilities}} {doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip {Module API}} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk {windows shortcut .lnk library}} {doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter {punk::blockletter frame-based large lettering test/logo}}}} \ No newline at end of file +doc {doc/toc {{doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::zip {Module API}} {doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_punk::trie {punk::trie API}} {doc/files/punk/_module_cap-0.1.0.tm.html punkshell_module_punk::cap {capability provider and handler plugin system}} {doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::ansi {Ansi string functions}} {doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::repl::codethread {Module repl codethread}} {doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::nav::fs {punk::nav::fs console filesystem navigation}} {doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::path {Filesystem path utilities}} {doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::args {args parsing}} {doc/files/project_changes.html punkshell__project_changes {punkshell Changes}} {doc/files/punk/repl/_module_codethread-0.1.1.tm.html punkshell_module_punk::repl::codethread {Module repl codethread}} {doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::encmime {mime encodings related subset of tcllib mime}} {doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::char {character-set and unicode utilities}} {doc/files/punk/args/_module_tclcore-0.1.0.tm.html punkshell_module_punk::args::tclcore {punk::args definitions for tcl core commands}} {doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::uc {Module API}} {doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::lib {punk general utility functions}} {doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::cesu {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??}} {doc/files/punk/_module_assertion-0.1.0.tm.html punkshell_module_punk::assertion {assertion alternative to control::assert}} {doc/files/project_intro.html punkshell__project_intro {Introduction to punkshell}} {doc/files/_module_modpod-0.1.2.tm.html modpod_module_modpod {Module API}} {doc/files/punk/_module_experiment-0.1.0.tm.html punkshell_module_punk::experiment {Module API}} {doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_poshinfo {poshinfo prompt theme tool}} {doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_argparsingtest {Module API}} {doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::sshrun {Tcl procedures to execute tcl scripts in remote hosts}} {doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::packagepreference {punkshell package/module loading}} {doc/files/punk/_module_island-0.1.0.tm.html punkshell_module_punk::island {filesystem islands for safe interps}} {doc/files/punk/_module_aliascore-0.1.0.tm.html punkshell_module_punk::aliascore {punkshell command aliases}} {doc/files/main.html punkshell {punkshell - Core}} {doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::console {punk console}} {doc/files/_module_textblock-0.1.1.tm.html punkshell_module_textblock {punk textblock functions}} {doc/files/_module_overtype-1.6.5.tm.html overtype_module_overtype {overtype text layout - ansi aware}} {doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::sixel {punk::sixel API}} {doc/files/punk/_module_flib-0.1.0.tm.html punkshell_module_punk::flib {flib experimental}} {doc/files/_module_tomlish-1.1.1.tm.html tomlish_module_tomlish {tomlish toml parser}} {doc/files/_module_textblock-0.1.2.tm.html punkshell_module_textblock {punk textblock functions}} {doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_scriptwrap {scriptwrap polyglot tool}} {doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html punkshell_module_punk::mix::commandset::project {dec commandset - project}} {doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::rest punk::rest} {doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet {basic telnet client - DKF/Wiki}} {doc/files/_module_fauxlink-0.1.1.tm.html fauxlink_module_fauxlink {faux link application shortcuts}} {doc/files/punk/_module_safe-0.1.0.tm.html punkshell_module_punk::safe {Module API}} {doc/files/punk/_module_fileline-0.1.0.tm.html punkshell_module_punk::fileline {file line-handling utilities}} {doc/files/_module_termscheme-0.1.0.tm.html shellspy_module_termscheme {Module API}} {doc/files/punk/_module_zip-0.1.0.tm.html shellspy_module_punk::zip {Module API}} {doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::winlnk {windows shortcut .lnk library}} {doc/files/punk/_module_blockletter-0.1.0.tm.html punkshell_module_punk::blockletter {punk::blockletter frame-based large lettering test/logo}}}} \ No newline at end of file diff --git a/src/embedded/www/.xrf b/src/embedded/www/.xrf index 3d75e61f..cfa4be0a 100644 --- a/src/embedded/www/.xrf +++ b/src/embedded/www/.xrf @@ -1 +1 @@ -sa,punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html sa,fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.html fileformat {index.html fileformat} punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html POSH {index.html posh} sa,punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.html sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html kw,lib {index.html lib} kw,configuration {index.html configuration} kw,table {index.html table} debug {index.html debug} punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.html kw,compatibility {index.html compatibility} {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.html windows {index.html windows} kw,wcswidth {index.html wcswidth} kw,rest {index.html rest} sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html filesystem {index.html filesystem} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html kw,interp {index.html interp} sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html kw,terminal {index.html terminal} punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.html kw,path {index.html path} utility {index.html utility} rest {index.html rest} sa,punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.html kw,assert {index.html assert} changelog {index.html changelog} sa,punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.html path {index.html path} punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.html unofficial {index.html unofficial} sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??} doc/files/punk/_module_cesu-0.1.0.tm.html sa,punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html package {index.html package} parsing {index.html parsing} sa,punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html {faux link application shortcuts} doc/files/_module_fauxlink-0.1.1.tm.html punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.html {Module API} doc/files/punk/_module_zip-0.1.0.tm.html {punk::trie API} doc/files/punk/_module_trie-0.1.0.tm.html sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html {poshinfo prompt theme tool} doc/files/_module_poshinfo-0.1.0.tm.html capability {index.html capability} kw,shortcut {index.html shortcut} punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html parse {index.html parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html {punkshell - Core} doc/files/main.html punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.html sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html kw,punk {index.html punk} tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.html {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.html arguments {index.html arguments} {punkshell command aliases} doc/files/punk/_module_aliascore-0.1.0.tm.html punk::rest doc/files/punk/_module_rest-0.1.0.tm.html sa,punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html kw,colour {index.html colour} protocol {index.html protocol} interp {index.html interp} kw,lnk {index.html lnk} sa,shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.html punk {index.html punk} lib {index.html lib} sa,punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html sa,punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.html assert {index.html assert} kw,proc {index.html proc} {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html sa,punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.html kw,fake {index.html fake} kw,symlink {index.html symlink} kw,unicode {index.html unicode} punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.html sa,punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.html sa,punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html kw,encodings {index.html encodings} kw,alias {index.html alias} kw,telnet {index.html telnet} theme {index.html theme} sa,shellspy_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.html sa,tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.html proc {index.html proc} punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.html sa,punkshell doc/files/main.html kw,shell {index.html shell} fake {index.html fake} kw,launcher {index.html launcher} {punk console} doc/files/punk/_module_console-0.1.1.tm.html sa,punkshell__project_changes(n) doc/files/project_changes.html sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html datastructure {index.html datastructure} kw,args {index.html args} {punk::nav::fs console filesystem navigation} doc/files/punk/nav/_module_fs-0.1.0.tm.html {punk::blockletter frame-based large lettering test/logo} doc/files/punk/_module_blockletter-0.1.0.tm.html wcswidth {index.html wcswidth} kw,http {index.html http} kw,cesu {index.html cesu} sa,punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.html scriptwrap {index.html scriptwrap} punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html kw,frame {index.html frame} punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html terminal {index.html terminal} sa,shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.html args {index.html args} punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.html http {index.html http} cesu {index.html cesu} table {index.html table} sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.html punkshell__project_changes doc/files/project_changes.html sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html sa,punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.html kw,layout {index.html layout} colour {index.html colour} {prompt theme} {index.html prompt_theme} experimental {index.html experimental} sa,punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.html sa,punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.html sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html sa,shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.html kw,encoding {index.html encoding} {windows shortcut .lnk library} doc/files/punk/_module_winlnk-0.1.0.tm.html kw,prompt {index.html prompt} kw,ansi {index.html ansi} kw,trie {index.html trie} sa,punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.html console {index.html console} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html shortcut {index.html shortcut} telnet {index.html telnet} lnk {index.html lnk} sa,punkshell__project_intro doc/files/project_intro.html kw,datastructure {index.html datastructure} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html ansi {index.html ansi} trie {index.html trie} punkshell__project_intro(n) doc/files/project_intro.html punkshell__project_intro doc/files/project_intro.html kw,changelog {index.html changelog} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.html sa,fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.html assertion {index.html assertion} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html kw,commandset {index.html commandset} kw,zip {index.html zip} fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.html punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.html {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.html {tomlish toml parser} doc/files/_module_tomlish-1.1.1.tm.html sa,punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html sa,punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html layout {index.html layout} punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html sa,punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.html kw,windows {index.html windows} shellspy_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.html kw,module {index.html module} punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html kw,plugin {index.html plugin} punkshell doc/files/main.html kw,fileformat {index.html fileformat} punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html sa,punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.html punkshell__project_changes(n) doc/files/project_changes.html kw,utility {index.html utility} launcher {index.html launcher} prompt {index.html prompt} kw,ssh {index.html ssh} kw,arguments {index.html arguments} {punkshell package/module loading} doc/files/punk/_module_packagepreference-0.1.0.tm.html sa,punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.html crossplatform {index.html crossplatform} punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.html alias {index.html alias} kw,filesystem {index.html filesystem} shellspy_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.0.tm.html punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.html sa,overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.html shell {index.html shell} {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.html kw,package {index.html package} kw,parsing {index.html parsing} kw,toml {index.html toml} punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html kw,debug {index.html debug} punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.html {punk textblock functions} doc/files/_module_textblock-0.1.2.tm.html punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.html punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.html overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.html sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html kw,faux {index.html faux} frame {index.html frame} toml {index.html toml} sa,punkshell__project_intro(n) doc/files/project_intro.html shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.html kw,unofficial {index.html unofficial} encoding {index.html encoding} punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html sa,punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.html sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.html punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.html zip {index.html zip} {Module repl codethread} doc/files/punk/repl/_module_codethread-0.1.0.tm.html kw,BOM {index.html bom} faux {index.html faux} sa,punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.html {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.html module {index.html module} sa,punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.html symlink {index.html symlink} plugin {index.html plugin} unicode {index.html unicode} sa,punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.html kw,capability {index.html capability} sa,modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.html shellspy_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.0.tm.html kw,crossplatform {index.html crossplatform} punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.html {punkshell Changes} doc/files/project_changes.html fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.html modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.html punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.html {Introduction to punkshell} doc/files/project_intro.html punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell(n) doc/files/main.html {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.html punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html kw,parse {index.html parse} sa,punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.html punkshell(n) doc/files/main.html kw,string {index.html string} ssh {index.html ssh} kw,file {index.html file} sa,punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.html sa,punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.html sa,punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell__project_changes doc/files/project_changes.html {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html {kw,prompt theme} {index.html prompt_theme} kw,experimental {index.html experimental} punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.html sa,punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.html file {index.html file} configuration {index.html configuration} {args parsing} doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.html encodings {index.html encodings} compatibility {index.html compatibility} {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html sa,shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.html kw,assertion {index.html assertion} {scriptwrap polyglot tool} doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.html {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.5.tm.html kw,repl {index.html repl} punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html commandset {index.html commandset} kw,text {index.html text} {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,shellspy_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.html sa,tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.html kw,scriptwrap {index.html scriptwrap} {filesystem islands for safe interps} doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.html kw,protocol {index.html protocol} kw,theme {index.html theme} sa,modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.html repl {index.html repl} shellspy_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.html text {index.html text} BOM {index.html bom} sa,punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.html kw,POSH {index.html posh} kw,console {index.html console} {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.html string {index.html string} \ No newline at end of file +sa,punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.html punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html sa,fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.html fileformat {index.html fileformat} punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html POSH {index.html posh} sa,punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.html sa,punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html kw,lib {index.html lib} kw,configuration {index.html configuration} kw,table {index.html table} debug {index.html debug} punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.html kw,compatibility {index.html compatibility} {basic telnet client - DKF/Wiki} doc/files/punk/_module_basictelnet-0.1.0.tm.html windows {index.html windows} kw,wcswidth {index.html wcswidth} kw,rest {index.html rest} sa,punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html filesystem {index.html filesystem} sa,punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html kw,interp {index.html interp} sa,punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html kw,terminal {index.html terminal} punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.html kw,path {index.html path} utility {index.html utility} rest {index.html rest} punkshell_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.1.tm.html sa,punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.html kw,assert {index.html assert} changelog {index.html changelog} punkshell_module_punk::args::tclcore(0) doc/files/punk/args/_module_tclcore-0.1.0.tm.html sa,punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.html path {index.html path} shellspy_module_termscheme(0) doc/files/_module_termscheme-0.1.0.tm.html punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.html unofficial {index.html unofficial} sa,punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html sa,punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html {CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ??} doc/files/punk/_module_cesu-0.1.0.tm.html sa,punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html package {index.html package} parsing {index.html parsing} sa,punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html {faux link application shortcuts} doc/files/_module_fauxlink-0.1.1.tm.html punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.html {Module API} doc/files/punk/_module_zip-0.1.0.tm.html {punk::trie API} doc/files/punk/_module_trie-0.1.0.tm.html sa,punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html {poshinfo prompt theme tool} doc/files/_module_poshinfo-0.1.0.tm.html capability {index.html capability} kw,shortcut {index.html shortcut} punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::safe doc/files/punk/_module_safe-0.1.0.tm.html parse {index.html parse} sa,punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::assertion doc/files/punk/_module_assertion-0.1.0.tm.html {punkshell - Core} doc/files/main.html punkshell_module_punk::uc(0) doc/files/punk/_module_uc-0.1.0.tm.html {capability provider and handler plugin system} doc/files/punk/_module_cap-0.1.0.tm.html sa,punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html kw,punk {index.html punk} tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.html {Filesystem path utilities} doc/files/punk/_module_path-0.1.0.tm.html arguments {index.html arguments} {punkshell command aliases} doc/files/punk/_module_aliascore-0.1.0.tm.html punk::rest doc/files/punk/_module_rest-0.1.0.tm.html sa,punkshell_module_scriptwrap doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html kw,colour {index.html colour} protocol {index.html protocol} interp {index.html interp} kw,lnk {index.html lnk} punk {index.html punk} lib {index.html lib} sa,punkshell_module_punk::packagepreference(0) doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html sa,punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.html assert {index.html assert} kw,proc {index.html proc} {flib experimental} doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html sa,punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.html kw,fake {index.html fake} kw,symlink {index.html symlink} kw,unicode {index.html unicode} punkshell_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.html sa,punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.html punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.html sa,punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html kw,encodings {index.html encodings} kw,alias {index.html alias} punkshell_module_punk::sixel(0) doc/files/punk/_module_sixel-0.1.0.tm.html kw,telnet {index.html telnet} theme {index.html theme} sa,tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.html proc {index.html proc} punkshell_module_punk::experiment doc/files/punk/_module_experiment-0.1.0.tm.html sa,punkshell doc/files/main.html kw,shell {index.html shell} fake {index.html fake} kw,launcher {index.html launcher} {punk console} doc/files/punk/_module_console-0.1.1.tm.html sa,punkshell__project_changes(n) doc/files/project_changes.html sa,punkshell_module_punk::args::tclcore(0) doc/files/punk/args/_module_tclcore-0.1.0.tm.html sa,punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html datastructure {index.html datastructure} kw,args {index.html args} {punk::nav::fs console filesystem navigation} doc/files/punk/nav/_module_fs-0.1.0.tm.html {punk::blockletter frame-based large lettering test/logo} doc/files/punk/_module_blockletter-0.1.0.tm.html wcswidth {index.html wcswidth} kw,http {index.html http} kw,cesu {index.html cesu} sa,punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.html scriptwrap {index.html scriptwrap} punkshell_module_punk::cap(0) doc/files/punk/_module_cap-0.1.0.tm.html kw,frame {index.html frame} punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html terminal {index.html terminal} args {index.html args} punkshell_module_punk::packagepreference doc/files/punk/_module_packagepreference-0.1.0.tm.html punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.html http {index.html http} cesu {index.html cesu} table {index.html table} sa,punkshell_module_punk::args doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.html punkshell__project_changes doc/files/project_changes.html sa,punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html sa,punkshell_module_punk::cesu doc/files/punk/_module_cesu-0.1.0.tm.html kw,layout {index.html layout} colour {index.html colour} shellspy_module_termscheme doc/files/_module_termscheme-0.1.0.tm.html {prompt theme} {index.html prompt_theme} experimental {index.html experimental} sa,punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.html sa,punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.html sa,punkshell_module_punk::sixel doc/files/punk/_module_sixel-0.1.0.tm.html sa,punkshell_module_punk::fileline doc/files/punk/_module_fileline-0.1.0.tm.html sa,shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.html kw,encoding {index.html encoding} {windows shortcut .lnk library} doc/files/punk/_module_winlnk-0.1.0.tm.html kw,prompt {index.html prompt} punkshell_module_punk::sixel doc/files/punk/_module_sixel-0.1.0.tm.html kw,ansi {index.html ansi} kw,trie {index.html trie} sa,punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.html console {index.html console} punkshell_module_punk::lib(0) doc/files/punk/_module_lib-0.1.1.tm.html shortcut {index.html shortcut} telnet {index.html telnet} lnk {index.html lnk} sa,punkshell__project_intro doc/files/project_intro.html kw,datastructure {index.html datastructure} sa,punkshell_module_punk::path(0) doc/files/punk/_module_path-0.1.0.tm.html punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html ansi {index.html ansi} punkshell_module_punk::safe(0) doc/files/punk/_module_safe-0.1.0.tm.html trie {index.html trie} punkshell__project_intro(n) doc/files/project_intro.html punkshell__project_intro doc/files/project_intro.html kw,changelog {index.html changelog} sa,punkshell_module_punk::ansi doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::trie doc/files/punk/_module_trie-0.1.0.tm.html sa,fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.html assertion {index.html assertion} punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html kw,commandset {index.html commandset} kw,zip {index.html zip} sa,punkshell_module_punk::sixel(0) doc/files/punk/_module_sixel-0.1.0.tm.html punkshell_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.1.tm.html fauxlink_module_fauxlink doc/files/_module_fauxlink-0.1.1.tm.html punkshell_module_punk::trie(0) doc/files/punk/_module_trie-0.1.0.tm.html {punk general utility functions} doc/files/punk/_module_lib-0.1.1.tm.html {tomlish toml parser} doc/files/_module_tomlish-1.1.1.tm.html sa,punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html sa,punkshell_module_punk::rest(0) doc/files/punk/_module_rest-0.1.0.tm.html punkshell_module_punk::uc doc/files/punk/_module_uc-0.1.0.tm.html punkshell_module_punk::mix::commandset::project(0) doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html layout {index.html layout} sa,punkshell_module_punk::repl::codethread(0) doc/files/punk/repl/_module_codethread-0.1.1.tm.html sa,punkshell_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.html punkshell_module_punk::sshrun doc/files/punk/_module_sshrun-0.1.0.tm.html sa,punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.html punkshell_module_punk::zip(0) doc/files/punk/_module_zip-0.1.1.tm.html kw,windows {index.html windows} kw,module {index.html module} punkshell_module_punk::fileline(0) doc/files/punk/_module_fileline-0.1.0.tm.html kw,plugin {index.html plugin} punkshell doc/files/main.html kw,fileformat {index.html fileformat} punkshell_module_punk::cap doc/files/punk/_module_cap-0.1.0.tm.html sa,punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.html punkshell__project_changes(n) doc/files/project_changes.html kw,utility {index.html utility} launcher {index.html launcher} prompt {index.html prompt} kw,ssh {index.html ssh} kw,arguments {index.html arguments} {punkshell package/module loading} doc/files/punk/_module_packagepreference-0.1.0.tm.html sa,punkshell_module_punk::zip doc/files/punk/_module_zip-0.1.1.tm.html crossplatform {index.html crossplatform} punkshell_module_poshinfo(0) doc/files/_module_poshinfo-0.1.0.tm.html {punk::sixel API} doc/files/punk/_module_sixel-0.1.0.tm.html alias {index.html alias} kw,filesystem {index.html filesystem} punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.html sa,overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.html shell {index.html shell} {assertion alternative to control::assert} doc/files/punk/_module_assertion-0.1.0.tm.html kw,package {index.html package} kw,parsing {index.html parsing} kw,toml {index.html toml} punkshell_module_punk::lib doc/files/punk/_module_lib-0.1.1.tm.html kw,debug {index.html debug} punkshell_module_punk::island doc/files/punk/_module_island-0.1.0.tm.html {punk textblock functions} doc/files/_module_textblock-0.1.2.tm.html punkshell_module_punk::ansi(0) doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html overtype_module_overtype doc/files/_module_overtype-1.6.5.tm.html punkshell_module_punk::blockletter(0) doc/files/punk/_module_blockletter-0.1.0.tm.html overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.html sa,punkshell_module_punk::char doc/files/punk/_module_char-0.1.0.tm.html kw,faux {index.html faux} frame {index.html frame} toml {index.html toml} sa,punkshell__project_intro(n) doc/files/project_intro.html shellspy_module_punk::zip doc/files/punk/_module_zip-0.1.0.tm.html kw,unofficial {index.html unofficial} encoding {index.html encoding} punkshell_module_punk::sshrun(0) doc/files/punk/_module_sshrun-0.1.0.tm.html sa,punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.html sa,punkshell_module_punk::args::tclcore doc/files/punk/args/_module_tclcore-0.1.0.tm.html sa,punkshell_module_punk::flib doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell_module_punk::args(0) doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::encmime doc/files/punk/_module_encmime-0.1.0.tm.html modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.html punkshell_module_textblock(0) doc/files/_module_textblock-0.1.2.tm.html zip {index.html zip} {Module repl codethread} doc/files/punk/repl/_module_codethread-0.1.1.tm.html kw,BOM {index.html bom} faux {index.html faux} sa,punkshell_module_punk::repl::codethread doc/files/punk/repl/_module_codethread-0.1.1.tm.html sa,punkshell_module_punk::nav::fs doc/files/punk/nav/_module_fs-0.1.0.tm.html sa,punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.html {file line-handling utilities} doc/files/punk/_module_fileline-0.1.0.tm.html module {index.html module} sa,punkshell_module_punk::blockletter doc/files/punk/_module_blockletter-0.1.0.tm.html symlink {index.html symlink} plugin {index.html plugin} unicode {index.html unicode} sa,punkshell_module_punk::console(0) doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::winlnk(0) doc/files/punk/_module_winlnk-0.1.0.tm.html kw,capability {index.html capability} punkshell_module_punk::args::tclcore doc/files/punk/args/_module_tclcore-0.1.0.tm.html sa,modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.html kw,crossplatform {index.html crossplatform} punkshell_module_punk::experiment(0) doc/files/punk/_module_experiment-0.1.0.tm.html {punkshell Changes} doc/files/project_changes.html {punk::args definitions for tcl core commands} doc/files/punk/args/_module_tclcore-0.1.0.tm.html fauxlink_module_fauxlink(0) doc/files/_module_fauxlink-0.1.1.tm.html modpod_module_modpod doc/files/_module_modpod-0.1.2.tm.html punkshell_module_textblock doc/files/_module_textblock-0.1.2.tm.html {Introduction to punkshell} doc/files/project_intro.html punkshell_module_punk::cesu(0) doc/files/punk/_module_cesu-0.1.0.tm.html punkshell_module_punk::assertion(0) doc/files/punk/_module_assertion-0.1.0.tm.html sa,punkshell(n) doc/files/main.html {mime encodings related subset of tcllib mime} doc/files/punk/_module_encmime-0.1.0.tm.html sa,punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.html punkshell::basictelnet doc/files/punk/_module_basictelnet-0.1.0.tm.html punkshell::basictelnet(0) doc/files/punk/_module_basictelnet-0.1.0.tm.html kw,parse {index.html parse} sa,punkshell_module_scriptwrap(0) doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html tomlish_module_tomlish doc/files/_module_tomlish-1.1.1.tm.html punkshell(n) doc/files/main.html kw,string {index.html string} sa,shellspy_module_termscheme(0) doc/files/_module_termscheme-0.1.0.tm.html ssh {index.html ssh} kw,file {index.html file} punkshell_module_punk::nav::fs(0) doc/files/punk/nav/_module_fs-0.1.0.tm.html sa,punkshell_module_punk::console doc/files/punk/_module_console-0.1.1.tm.html punkshell_module_punk::winlnk doc/files/punk/_module_winlnk-0.1.0.tm.html sa,punkshell_module_poshinfo doc/files/_module_poshinfo-0.1.0.tm.html punkshell_module_punk::island(0) doc/files/punk/_module_island-0.1.0.tm.html sa,punkshell_module_argparsingtest(0) doc/files/_module_argparsingtest-0.1.0.tm.html punkshell_module_punk::flib(0) doc/files/punk/_module_flib-0.1.0.tm.html sa,punkshell__project_changes doc/files/project_changes.html {dec commandset - project} doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html {kw,prompt theme} {index.html prompt_theme} kw,experimental {index.html experimental} sa,shellspy_module_termscheme doc/files/_module_termscheme-0.1.0.tm.html punkshell_module_argparsingtest doc/files/_module_argparsingtest-0.1.0.tm.html sa,punkshell_module_punk::aliascore(0) doc/files/punk/_module_aliascore-0.1.0.tm.html file {index.html file} configuration {index.html configuration} {args parsing} doc/files/punk/_module_args-0.1.0.tm.html punkshell_module_punk::rest doc/files/punk/_module_rest-0.1.0.tm.html encodings {index.html encodings} compatibility {index.html compatibility} {Ansi string functions} doc/files/punk/_module_ansi-0.1.1.tm.html sa,punkshell_module_punk::encmime(0) doc/files/punk/_module_encmime-0.1.0.tm.html sa,shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.html kw,assertion {index.html assertion} {scriptwrap polyglot tool} doc/files/punk/mix/commandset/_module_scriptwrap-0.1.0.tm.html punkshell_module_punk::path doc/files/punk/_module_path-0.1.0.tm.html sa,overtype_module_overtype(0) doc/files/_module_overtype-1.6.5.tm.html {overtype text layout - ansi aware} doc/files/_module_overtype-1.6.5.tm.html kw,repl {index.html repl} punkshell_module_punk::char(0) doc/files/punk/_module_char-0.1.0.tm.html commandset {index.html commandset} kw,text {index.html text} {Tcl procedures to execute tcl scripts in remote hosts} doc/files/punk/_module_sshrun-0.1.0.tm.html punkshell_module_punk::mix::commandset::project doc/files/punk/mix/commandset/_module_project-0.1.0.tm.html sa,tomlish_module_tomlish(0) doc/files/_module_tomlish-1.1.1.tm.html kw,scriptwrap {index.html scriptwrap} {filesystem islands for safe interps} doc/files/punk/_module_island-0.1.0.tm.html shellspy_module_punk::zip(0) doc/files/punk/_module_zip-0.1.0.tm.html kw,protocol {index.html protocol} kw,theme {index.html theme} sa,modpod_module_modpod(0) doc/files/_module_modpod-0.1.2.tm.html punkshell_module_punk::safe doc/files/punk/_module_safe-0.1.0.tm.html repl {index.html repl} sa,punkshell_module_punk::safe(0) doc/files/punk/_module_safe-0.1.0.tm.html text {index.html text} BOM {index.html bom} sa,punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.html kw,POSH {index.html posh} kw,console {index.html console} {character-set and unicode utilities} doc/files/punk/_module_char-0.1.0.tm.html punkshell_module_punk::aliascore doc/files/punk/_module_aliascore-0.1.0.tm.html string {index.html string} \ No newline at end of file diff --git a/src/embedded/www/doc/files/_module_termscheme-0.1.0.tm.html b/src/embedded/www/doc/files/_module_termscheme-0.1.0.tm.html new file mode 100644 index 00000000..140e2f71 --- /dev/null +++ b/src/embedded/www/doc/files/_module_termscheme-0.1.0.tm.html @@ -0,0 +1,192 @@ + +shellspy_module_termscheme - - + + + + + +
[ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
+
+

shellspy_module_termscheme(0) 0.1.0 doc "-"

+

Name

+

shellspy_module_termscheme - Module API

+
+ +

Synopsis

+
+
    +
  • package require termscheme
    • +
+
+
+ +

Overview

+

overview of termscheme

+ +

dependencies

+

packages used by termscheme

+
    +

  • Tcl 8.6

    • +
+
+
+

API

+

Namespace termscheme::class

+

class definitions +if { eq ""} {

+
    +
+

} +} + ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

+
+

Namespace termscheme

+

Core API functions for termscheme

+
+
+
+

Namespace termscheme::lib

+

Secondary functions that are part of the API

+
+
+
+
+

Internal

+

tcl::namespace::eval termscheme::system {

+

Namespace termscheme::system

+

Internal functions that are not part of the API

+
+
+ + +
diff --git a/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html b/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html index 3f99f0b2..3ee13568 100644 --- a/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html +++ b/src/embedded/www/doc/files/punk/_module_ansi-0.1.1.tm.html @@ -179,7 +179,7 @@
  • request_tabstops
  • titleset windowtitles
  • ansistrip text
    • -
  • ansistrip text
    • +
  • ansistrip2 text
  • ansistripraw text
  • is_sgr_reset code
  • has_sgr_leadingreset code
    • @@ -348,7 +348,7 @@ tput rmam

    ansistrip text

    Return a string with ansi codes stripped out

    Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs)

    -
    ansistrip text
    +
    ansistrip2 text

    Return a string with ansi codes stripped out

    Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs)

    ansistripraw text
    diff --git a/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html b/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html index 0a9aa651..b4f1529f 100644 --- a/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html +++ b/src/embedded/www/doc/files/punk/_module_args-0.1.0.tm.html @@ -121,7 +121,7 @@
  • API @@ -141,7 +141,7 @@
  • package require punk::args
    • @@ -174,7 +174,7 @@ #setting -type none indicates a flag that doesn't take a value (solo flag) -nocomplain -type none *values -min 1 -max -1 - } $args]] opts values + } $args]] leaders opts values puts "translation is [dict get $opts -translation]" foreach f [dict values $values] { puts "doing stuff with file: $f" @@ -183,7 +183,7 @@

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

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

    -

    valid * lines being with *proc *opts *values

    +

    valid * lines being with *proc *leaders *opts *values

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

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

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

    @@ -199,7 +199,7 @@ *values -min 2 -max 2 fileA -type existingfile 1 fileB -type existingfile 1 - } $args]] opts values + } $args]] leaders opts values puts "$category fileA: [dict get $values fileA]" puts "$category fileB: [dict get $values fileB]" } @@ -291,15 +291,17 @@ For functions that are part of an API a package may be more suitable.

    API

    -

    Namespace punk::args::class

    -

    class definitions

    -
      -
    +

    Namespace punk::args

    +

    cooperative namespace punk::args::register

    +

    punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded

    +

    The punk::args package will then test for a public list variable <namepace>::PUNKARGS containing argument definitions when it needs to.

    +
    +

    Namespace punk::args

    Core API functions for punk::args

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

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

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

    ARGUMENTS:

    @@ -314,7 +316,7 @@ For functions that are part of an API a package may be more suitable.

    argumentname -key val -ky2 val2...

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

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

    -

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

    +

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

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

    list rawargs

    This is a list of the arguments to parse. Usually it will be the $args value from the containing proc, diff --git a/src/embedded/www/doc/files/punk/_module_console-0.1.1.tm.html b/src/embedded/www/doc/files/punk/_module_console-0.1.1.tm.html index a8c257d6..fefbe9cc 100644 --- a/src/embedded/www/doc/files/punk/_module_console-0.1.1.tm.html +++ b/src/embedded/www/doc/files/punk/_module_console-0.1.1.tm.html @@ -150,7 +150,9 @@

    packages used by punk::console

    • Tcl 8.6-

      • +

    • Thread

    • punk::ansi

      • +

    • punk::args

    diff --git a/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html b/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html index 82206994..b265f30f 100644 --- a/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html +++ b/src/embedded/www/doc/files/punk/_module_lib-0.1.1.tm.html @@ -186,6 +186,7 @@

    packages used by punk::lib

    • Tcl 8.6-

      • +

    • punk::args

    diff --git a/src/embedded/www/doc/files/punk/_module_safe-0.1.0.tm.html b/src/embedded/www/doc/files/punk/_module_safe-0.1.0.tm.html new file mode 100644 index 00000000..462653b8 --- /dev/null +++ b/src/embedded/www/doc/files/punk/_module_safe-0.1.0.tm.html @@ -0,0 +1,197 @@ + +punkshell_module_punk::safe - punk::safe - safebase interpreters + + + + + +
    [ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
    +
    +

    punkshell_module_punk::safe(0) 0.1.0 doc "punk::safe - safebase interpreters"

    +

    Name

    +

    punkshell_module_punk::safe - Module API

    +
    + +

    Synopsis

    +
    +
      +
    • package require punk::safe
      • +
    + +
    +
    + +

    Overview

    +

    overview of punk::safe

    + +

    dependencies

    +

    packages used by punk::safe

    +
      +

    • Tcl 8.6

      • +

    • punk::args

      • +
    +
    +
    +

    API

    +

    Namespace punk::safe::class

    +

    class definitions +if { eq ""} {

    +
      +
    +

    } +} + ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

    +
    +

    Namespace punk::safe::lib

    +

    Secondary functions that are part of the API

    +
    +
    +
    +

    Namespace punk::safe

    +

    Core API functions for punk::safe

    +
    +
    setSyncMode args
    +
    +
    +
    +
    +

    Internal

    +

    Namespace punk::safe::system

    +

    Internal functions that are not part of the API

    +
    +
    + + +
    diff --git a/src/embedded/www/doc/files/punk/_module_sixel-0.1.0.tm.html b/src/embedded/www/doc/files/punk/_module_sixel-0.1.0.tm.html new file mode 100644 index 00000000..56122d58 --- /dev/null +++ b/src/embedded/www/doc/files/punk/_module_sixel-0.1.0.tm.html @@ -0,0 +1,185 @@ + +punkshell_module_punk::sixel - experimental sixel functions + + + + + +
    [ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
    +
    +

    punkshell_module_punk::sixel(0) 0.1.0 doc "experimental sixel functions"

    +

    Name

    +

    punkshell_module_punk::sixel - punk::sixel API

    +
    + +

    Synopsis

    +
    +
      +
    • package require punk::sixel
      • +
    +
    +
    +

    Description

    +

    Experimental support functions for working with sixel data

    +

    For real sixel work a version written in a systems language such as c or zig may be required.

    +
    +

    Overview

    +

    overview of punk::sixel

    + +

    dependencies

    +

    packages used by punk::sixel

    +
      +

    • Tcl 8.6

      • +

    • punk::args

      • +

    • punk::console

      • +

    • punk::ansi

      • +
    +
    +
    +

    API

    +

    Namespace punk::sixel::class

    +

    class definitions +if { eq ""} {

    +
      +
    +

    } +} + ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

    +
    +

    Namespace punk::sixel

    +

    Core API functions for punk::sixel

    +
    +
    +
    +

    Namespace punk::sixel::lib

    +

    Secondary functions that are part of the API

    +
    +
    +
    +
    + + +
    diff --git a/src/embedded/www/doc/files/punk/args/_module_tclcore-0.1.0.tm.html b/src/embedded/www/doc/files/punk/args/_module_tclcore-0.1.0.tm.html new file mode 100644 index 00000000..d656c01f --- /dev/null +++ b/src/embedded/www/doc/files/punk/args/_module_tclcore-0.1.0.tm.html @@ -0,0 +1,193 @@ + +punkshell_module_punk::args::tclcore - tcl core argument definitions + + + + + +
    [ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
    +
    +

    punkshell_module_punk::args::tclcore(0) 0.1.0 doc "tcl core argument definitions"

    +

    Name

    +

    punkshell_module_punk::args::tclcore - punk::args definitions for tcl core commands

    +
    + +

    Synopsis

    +
    +
      +
    • package require punk::args::tclcore
      • +
    +
    +
    + +

    Overview

    +

    overview of punk::args::tclcore

    + +

    dependencies

    +

    packages used by punk::args::tclcore

    +
      +

    • Tcl 8.6

      • +

    • punk::args

      • +
    +
    +
    +

    API

    +

    Namespace punk::args::tclcore::class

    +

    class definitions +if { eq ""} {

    +
      +
    +

    } +} + ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

    +
    +

    Namespace punk::args::tclcore

    +

    Core API functions for punk::args::tclcore

    +
    +
    +
    +

    Namespace punk::args::tclcore::lib

    +

    Secondary functions that are part of the API

    +
    +
    +
    +
    +

    Internal

    +

    tcl::namespace::eval punk::args::tclcore::system {

    +

    Namespace punk::args::tclcore::system

    +

    Internal functions that are not part of the API

    +
    +
    + + +
    diff --git a/src/embedded/www/doc/files/punk/nav/_module_fs-0.1.0.tm.html b/src/embedded/www/doc/files/punk/nav/_module_fs-0.1.0.tm.html index 6c020e0d..0752ab45 100644 --- a/src/embedded/www/doc/files/punk/nav/_module_fs-0.1.0.tm.html +++ b/src/embedded/www/doc/files/punk/nav/_module_fs-0.1.0.tm.html @@ -1,5 +1,5 @@ -shellspy_module_punk::nav::fs - fs nav +punkshell_module_punk::nav::fs - fs nav + + + + +
    [ + Main Table Of Contents +| Table Of Contents +| Keyword Index + ]
    +
    +

    punkshell_module_punk::repl::codethread(0) 0.1.1 doc "codethread for repl - root interpreter"

    +

    Name

    +

    punkshell_module_punk::repl::codethread - Module repl codethread

    +
    + +

    Synopsis

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

    Description

    +

    This is part of the infrastructure required for the punk::repl to operate

    +
    +

    Overview

    +

    overview of punk::repl::codethread

    + +

    dependencies

    +

    packages used by punk::repl::codethread

    +
      +

    • Tcl 8.6

      • +
    +
    +
    +

    API

    + +

    Namespace punk::repl::codethread

    +

    Core API functions for punk::repl::codethread

    +
    +
    +
    +

    Namespace punk::repl::codethread::lib

    +

    Secondary functions that are part of the API

    +
    +
    +
    +
    +

    Internal

    +

    Namespace punk::repl::codethread::system

    +

    Internal functions that are not part of the API

    +
    +
    + + +
    diff --git a/src/embedded/www/doc/toc.html b/src/embedded/www/doc/toc.html index 4b4d086c..d087520b 100644 --- a/src/embedded/www/doc/toc.html +++ b/src/embedded/www/doc/toc.html @@ -61,57 +61,65 @@ args parsing +punkshell_module_punk::args::tclcore +punk::args definitions for tcl core commands + + punkshell_module_punk::assertion assertion alternative to control::assert - + punkshell_module_punk::blockletter punk::blockletter frame-based large lettering test/logo - + punkshell_module_punk::cap capability provider and handler plugin system - + punkshell_module_punk::cesu CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ?? - + punkshell_module_punk::char character-set and unicode utilities - + punkshell_module_punk::console punk console - + punkshell_module_punk::encmime mime encodings related subset of tcllib mime - + punkshell_module_punk::experiment Module API - + punkshell_module_punk::fileline file line-handling utilities - + punkshell_module_punk::flib flib experimental - + punkshell_module_punk::island filesystem islands for safe interps - + punkshell_module_punk::lib punk general utility functions - + punkshell_module_punk::mix::commandset::project dec commandset - project + +punkshell_module_punk::nav::fs +punk::nav::fs console filesystem navigation + punkshell_module_punk::packagepreference punkshell package/module loading @@ -121,10 +129,26 @@ Filesystem path utilities +punkshell_module_punk::repl::codethread +Module repl codethread + + +punkshell_module_punk::repl::codethread +Module repl codethread + + punkshell_module_punk::rest punk::rest +punkshell_module_punk::safe +Module API + + +punkshell_module_punk::sixel +punk::sixel API + + punkshell_module_punk::sshrun Tcl procedures to execute tcl scripts in remote hosts @@ -157,18 +181,14 @@ punk textblock functions -shellspy_module_punk::nav::fs -punk::nav::fs console filesystem navigation - - -shellspy_module_punk::repl::codethread -Module repl codethread - - shellspy_module_punk::zip Module API +shellspy_module_termscheme +Module API + + tomlish_module_tomlish tomlish toml parser diff --git a/src/embedded/www/index.html b/src/embedded/www/index.html index 10501082..1ff56e2f 100644 --- a/src/embedded/www/index.html +++ b/src/embedded/www/index.html @@ -134,7 +134,7 @@ experimental - punkshell_module_punk::cesu · punkshell_module_punk::flib + punkshell_module_punk::cesu · punkshell_module_punk::flib · punkshell_module_punk::sixel Keywords: F @@ -162,7 +162,7 @@ filesystem - punkshell_module_punk::island · punkshell_module_punk::path · shellspy_module_punk::nav::fs + punkshell_module_punk::island · punkshell_module_punk::nav::fs · punkshell_module_punk::path frame @@ -214,7 +214,7 @@ module - modpod_module_modpod · overtype_module_overtype · punkshell::basictelnet · punkshell_module_argparsingtest · punkshell_module_poshinfo · punkshell_module_punk::aliascore · punkshell_module_punk::ansi · punkshell_module_punk::args · punkshell_module_punk::assertion · punkshell_module_punk::blockletter · punkshell_module_punk::cap · punkshell_module_punk::cesu · punkshell_module_punk::char · punkshell_module_punk::console · punkshell_module_punk::encmime · punkshell_module_punk::experiment · punkshell_module_punk::fileline · punkshell_module_punk::flib · punkshell_module_punk::island · punkshell_module_punk::lib · punkshell_module_punk::packagepreference · punkshell_module_punk::path · punkshell_module_punk::rest · punkshell_module_punk::sshrun · punkshell_module_punk::trie · punkshell_module_punk::uc · punkshell_module_punk::winlnk · punkshell_module_punk::zip · punkshell_module_scriptwrap · punkshell_module_textblock · punkshell_module_textblock · shellspy_module_punk::nav::fs · shellspy_module_punk::repl::codethread · shellspy_module_punk::zip · tomlish_module_tomlish + modpod_module_modpod · overtype_module_overtype · punkshell::basictelnet · punkshell_module_argparsingtest · punkshell_module_poshinfo · punkshell_module_punk::aliascore · punkshell_module_punk::ansi · punkshell_module_punk::args · punkshell_module_punk::args::tclcore · punkshell_module_punk::assertion · punkshell_module_punk::blockletter · punkshell_module_punk::cap · punkshell_module_punk::cesu · punkshell_module_punk::char · punkshell_module_punk::console · punkshell_module_punk::encmime · punkshell_module_punk::experiment · punkshell_module_punk::fileline · punkshell_module_punk::flib · punkshell_module_punk::island · punkshell_module_punk::lib · punkshell_module_punk::nav::fs · punkshell_module_punk::packagepreference · punkshell_module_punk::path · punkshell_module_punk::repl::codethread · punkshell_module_punk::repl::codethread · punkshell_module_punk::rest · punkshell_module_punk::safe · punkshell_module_punk::sixel · punkshell_module_punk::sshrun · punkshell_module_punk::trie · punkshell_module_punk::uc · punkshell_module_punk::winlnk · punkshell_module_punk::zip · punkshell_module_scriptwrap · punkshell_module_textblock · punkshell_module_textblock · shellspy_module_punk::zip · shellspy_module_termscheme · tomlish_module_tomlish Keywords: P @@ -280,7 +280,7 @@ repl - punkshell · punkshell__project_changes · punkshell__project_intro · shellspy_module_punk::repl::codethread + punkshell · punkshell__project_changes · punkshell__project_intro · punkshell_module_punk::repl::codethread · punkshell_module_punk::repl::codethread rest @@ -336,7 +336,7 @@ terminal - punkshell::basictelnet · punkshell_module_poshinfo · punkshell_module_punk::ansi · punkshell_module_punk::console · punkshell_module_textblock · shellspy_module_punk::nav::fs + punkshell::basictelnet · punkshell_module_poshinfo · punkshell_module_punk::ansi · punkshell_module_punk::console · punkshell_module_punk::nav::fs · punkshell_module_textblock text diff --git a/src/embedded/www/toc.html b/src/embedded/www/toc.html index 65e0c925..7b41f837 100644 --- a/src/embedded/www/toc.html +++ b/src/embedded/www/toc.html @@ -61,57 +61,65 @@ args parsing +punkshell_module_punk::args::tclcore +punk::args definitions for tcl core commands + + punkshell_module_punk::assertion assertion alternative to control::assert - + punkshell_module_punk::blockletter punk::blockletter frame-based large lettering test/logo - + punkshell_module_punk::cap capability provider and handler plugin system - + punkshell_module_punk::cesu CESU compatibility ehcoding scheme for utf-16: 8-Bit (CESU-8) ?? - + punkshell_module_punk::char character-set and unicode utilities - + punkshell_module_punk::console punk console - + punkshell_module_punk::encmime mime encodings related subset of tcllib mime - + punkshell_module_punk::experiment Module API - + punkshell_module_punk::fileline file line-handling utilities - + punkshell_module_punk::flib flib experimental - + punkshell_module_punk::island filesystem islands for safe interps - + punkshell_module_punk::lib punk general utility functions - + punkshell_module_punk::mix::commandset::project dec commandset - project + +punkshell_module_punk::nav::fs +punk::nav::fs console filesystem navigation + punkshell_module_punk::packagepreference punkshell package/module loading @@ -121,10 +129,26 @@ Filesystem path utilities +punkshell_module_punk::repl::codethread +Module repl codethread + + +punkshell_module_punk::repl::codethread +Module repl codethread + + punkshell_module_punk::rest punk::rest +punkshell_module_punk::safe +Module API + + +punkshell_module_punk::sixel +punk::sixel API + + punkshell_module_punk::sshrun Tcl procedures to execute tcl scripts in remote hosts @@ -157,18 +181,14 @@ punk textblock functions -shellspy_module_punk::nav::fs -punk::nav::fs console filesystem navigation - - -shellspy_module_punk::repl::codethread -Module repl codethread - - shellspy_module_punk::zip Module API +shellspy_module_termscheme +Module API + + tomlish_module_tomlish tomlish toml parser diff --git a/src/modules/argparsingtest-999999.0a1.0.tm b/src/modules/argparsingtest-999999.0a1.0.tm index fcd9043c..d2849bf5 100644 --- a/src/modules/argparsingtest-999999.0a1.0.tm +++ b/src/modules/argparsingtest-999999.0a1.0.tm @@ -294,7 +294,31 @@ namespace eval argparsingtest { } $args] return [tcl::dict::get $argd opts] } - proc test1_punkargs_validate_without_ansi {args} { + + punk::args::definition { + *id argparsingtest::test1_punkargs2 + *proc -name argtest4 -help "test of punk::args::get_dict comparative performance" + *opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + *values + } + proc test1_punkargs2 {args} { + set argd [punk::args::get_by_id argparsingtest::test1_punkargs2 $args] + return [tcl::dict::get $argd opts] + } + + + proc test1_punkargs_validate_ansistripped {args} { set argd [punk::args::get_dict { *proc -name argtest4 -help "test of punk::args::get_dict comparative performance" *opts -anyopts 0 @@ -306,9 +330,9 @@ namespace eval argparsingtest { -x -default "" -type string -y -default b -type string -z -default c -type string - -1 -default 1 -type boolean -validate_without_ansi true - -2 -default 2 -type integer -validate_without_ansi true - -3 -default 3 -type integer -validate_without_ansi true + -1 -default 1 -type boolean -validate_ansistripped true + -2 -default 2 -type integer -validate_ansistripped true + -3 -default 3 -type integer -validate_ansistripped true *values } $args] return [tcl::dict::get $argd opts] diff --git a/src/modules/patternpunk-1.1.tm b/src/modules/patternpunk-1.1.tm index 98969e2c..124ce3b7 100644 --- a/src/modules/patternpunk-1.1.tm +++ b/src/modules/patternpunk-1.1.tm @@ -78,7 +78,7 @@ set ::punk::bannerTemplate [string trim { } else { lassign $cborder_ctext cborder ctext } - return [ textblock::frame -type arc -ansiborder [a+ Web-black $cborder] [a+ Web-black $ctext][$this . logo2]] + return [ textblock::frame -checkargs 0 -type arc -ansiborder [a+ Web-black $cborder] [a+ Web-black $ctext][$this . logo2]] } >punk .. Property logotk "\[TCL\\\n TK \]" proc TCL {args} { @@ -349,7 +349,7 @@ v_ /|\/ / -boxmap -default {} -type dict -boxlimits -default {hl vl tlc blc trc brc} -help "Limit the border box to listed elements." -border_colour -default ${$border_colour} -type ansistring -regexprepass {^$} -validationtransform { - -function stripansi -maxlen 0 + -function stripansi -maxsize 0 } -title -default "PATTERN" -type string -subtitle -default "PUNK" -type string diff --git a/src/modules/poshinfo-999999.0a1.0.tm b/src/modules/poshinfo-999999.0a1.0.tm index 01c71675..c38a23c7 100644 --- a/src/modules/poshinfo-999999.0a1.0.tm +++ b/src/modules/poshinfo-999999.0a1.0.tm @@ -197,19 +197,21 @@ tcl::namespace::eval poshinfo { proc set_active_theme_by_path {path} { error "unimplemented" } + + punk::args::definition { + *id poshinfo::themes + *proc -name poshinfo::themes + -format -default all -multiple 1 -choices {all yaml json}\ + -help "File format of posh theme - based on file extension" + -type -default all -multiple 1\ + -help "e.g omp" + -as -default "table" -choices {list showlist dict showdict table tableobject plaintext}\ + -help "return type of result" + *values -min 0 + globs -multiple 1 -default * -help "" + } proc themes {args} { - set argd [punk::args::get_dict { - *id poshinfo::themes - *proc -name poshinfo::themes - -format -default all -multiple 1 -choices {all yaml json}\ - -help "File format of posh theme - based on file extension" - -type -default all -multiple 1\ - -help "e.g omp" - -as -default "table" -choices {list showlist dict showdict table tableobject plaintext}\ - -help "return type of result" - *values -min 0 - globs -multiple 1 -default * -help "" - } $args] + set argd [punk::args::get_by_id poshinfo::themes $args] set return_as [dict get $argd opts -as] set formats [dict get $argd opts -format] ;#multiple if {"yaml" in $formats} { diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 3d454ca8..0ca26f39 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -9,7 +9,7 @@ namespace eval punk { zzzload::pkg_require $pkg } } - #lazyload twapi + #lazyload twapi ? catch {package require vfs} ;#attempt load now so we can use faster 'package provide' to test existence later } @@ -3670,7 +3670,7 @@ namespace eval punk { incr i } - #JMN2 + #JMN2 - review #set returnval [lindex $assigned_values 0] if {[llength $assigned_values] == 1} { set returnval [join $assigned_values] @@ -7271,55 +7271,59 @@ namespace eval punk { catch { package require patternpunk #lappend chunks [list stderr [>punk . rhs]] - append mascotblock [textblock::frame [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] + append mascotblock [textblock::frame -checkargs 0 [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] } set topic [lindex $args end] set argopts [lrange $args 0 end-1] - set text "" - append text "Punk core navigation commands:\n" + set title "[a+ brightgreen] Punk core navigation commands: " #todo - load from source code annotation? set cmdinfo [list] - lappend cmdinfo [list help "This help. To see available subitems type: help topics"] - lappend cmdinfo [list dev "(ensemble command to make new projects/modules and to generate docs)"] - lappend cmdinfo [list a? "view ANSI colours\n e.g a? web"] - lappend cmdinfo [list ./ "view/change directory"] - lappend cmdinfo [list ../ "go up one directory"] - lappend cmdinfo [list ./new "make new directory and switch to it"] - lappend cmdinfo [list n/ "view/change namespace (accepts ns path globs e.g **::*get* to match comands at any level )"] - lappend cmdinfo [list n// "view/change namespace (with command listing)"] - lappend cmdinfo [list nn/ "go up one namespace"] - lappend cmdinfo [list n/new "make child namespace and switch to it"] - - set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] - set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] - set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] - set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] + lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] + lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"] + lappend cmdinfo [list ./ "?subdir?" "view/change directory"] + lappend cmdinfo [list ../ "" "go up one directory"] + lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] + lappend cmdinfo [list n/ "?glob...?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match comands at any level )"] + lappend cmdinfo [list n// "" "view/change namespace (with command listing)"] + lappend cmdinfo [list "nn/" "" "go up one namespace"] + lappend cmdinfo [list "n/new" "" "make child namespace and switch to it"] + lappend cmdinfo [list dev "?subcommand?" "(ensemble command to make new projects/modules and to generate docs)"] + lappend cmdinfo [list a? "?subcommand...?" "view ANSI colours\n e.g a? web"] + + #set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] + #set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] + #set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] + #set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] set t [textblock::class::table new -show_seps 0] - foreach c $cmds d $descr { - #append text " [overtype::left $col1 $c][overtype::left $col2 $d]" \n - $t add_row [list $c $d] - } - set widest1 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$widest1 + 2}] - set widest2 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$widest2 + 1}] + #foreach c $cmds d $descr { + # $t add_row [list $c $d] + #} + foreach row $cmdinfo { + $t add_row $row + } + set width_0 [$t column_datawidth 0] + $t configure_column 0 -minwidth [expr {$width_0 + 2}] + set width_1 [$t column_datawidth 1] + $t configure_column 1 -minwidth [expr {$width_1 + 1}] + $t configure -title $title + + set text "" append text [$t print] set warningblock "" + set introblock $mascotblock + append introblock \n $text - if {[catch {package require textblock} errM]} { - set introblock $mascotblock - append introblock \n $text - append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" - - } else { - set introblock [textblock::join -- " " \n$mascotblock " " $text] - } + #if {[catch {package require textblock} errM]} { + # append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" + #} else { + # set introblock [textblock::join -- " " \n$mascotblock " " $text] + #} lappend chunks [list stdout $introblock] diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index c1543689..ba86ced6 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -132,14 +132,29 @@ tcl::namespace::eval punk::ansi::class { set rendered [overtype::renderspace -cp437 1 -expand_right 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] return $rendered } + + lappend ::punk::ansi::class::PUNKARGS [list { + *id "punk::ansi::class::class_ansi render_to_input_line" + *proc -name "punk::ansi::class::class_ansi render_to_input_line" -help\ + "render string from line 0 to line + (experimental/debug)" + -dimensions -type string -help\ + "WxH where W is integer width >= 1 and H is integer heigth >= 1" + -minus -type integer -help\ + "number of chars to exclude from end" + *values -min 1 -max 1 + line -type indexexpression + }] method render_to_input_line {args} { if {[llength $args] < 1} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set x [lindex $args end] set arglist [lrange $args 0 end-1] if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set opts [tcl::dict::create\ -dimensions 80x24\ @@ -322,6 +337,7 @@ tcl::namespace::eval punk::ansi::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ansi { + variable PUNKARGS #*** !doctools #[subsection {Namespace punk::ansi}] #[para] Core API functions for punk::ansi @@ -422,6 +438,8 @@ tcl::namespace::eval punk::ansi { erase*\ get_*\ hyperlink\ + hyperlink_open\ + hyperlink_close\ move*\ reset*\ ansistrip*\ @@ -554,21 +572,35 @@ tcl::namespace::eval punk::ansi { $obj destroy return $result } - proc example {args} { - set base [punk::repo::find_project] - set default_ansifolder [file join $base src/testansi] - set argd [punk::args::get_dict [tstr -return string { + proc Get_ansifolder {} { + if {[catch {punk::repo::find_project} base]} { + set base "" + } + if {$base eq ""} { + #pwd not avail in safe interp + if {![catch {pwd} CWD]} { + set base $CWD + } + } + return [file join $base src/testansi] + } + + lappend PUNKARGS [list -dynamic 1 { + *id punk::ansi::example *proc -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) You can specify a narrower width to truncate images on the right side" - -folder -default "${$default_ansifolder}" -help "Base folder for files if relative paths are used. + -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. Defaults to /src/testansi - where projectbase is determined from current directory. " *values -min 0 -max -1 files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" - }] $args] + } ""] + + proc example {args} { + set argd [punk::args::get_by_id punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -621,7 +653,7 @@ tcl::namespace::eval punk::ansi { set subtitle [tcl::dict::get $picinfo status] } set title [tcl::dict::get $picinfo filename] - set fr [textblock::frame -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] + set fr [textblock::frame -checkargs 0 -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] # -- --- --- --- #we need the max height of a row element to use join_basic instead of join below # -- --- --- --- @@ -2320,16 +2352,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off - proc sgr_cache {args} { - set argd [punk::args::get_dict { - *proc -name punk::ansi::sgr_cache -help "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " - -action -default "" -choices "clear" -help "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" - -pretty -default 1 -type boolean -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" + #punk::args depends on punk::ansi - REVIEW + proc sgr_cache {args} { + set argdef { + *id punk::ansi::sgr_cache + *proc -name punk::ansi::sgr_cache -help\ + "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) + " + -action -default "" -choices "clear" -help\ + "-action clear will unset the keys in the punk::ansi::sgr_cache dict + This is called automatically when setting 'colour false' in the console" + + -pretty -default 1 -type boolean -help\ + "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" *values -min 0 -max 0 - } $args] + } + set argd [punk::args::get_dict $argdef $args] set action [dict get $argd opts -action] set pretty [dict get $argd opts -pretty] @@ -2372,6 +2411,31 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return [join $lines \n] } + lappend PUNKARGS [list { + *id punk::ansi::a+ + *proc -name "punk::ansi::a+" -help\ + "Returns an ANSI sgr escape sequence based on the list of supplied codes. + " + *values -min 0 -max -1 + } [string map [list [dict keys $SGR_map]] { + code -type string -optional 1 -multiple 1 -choices {} -choiceprefix 0 -choicerestricted 0 -help\ + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- + + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web" + + }]] + proc a+ {args} { #*** !doctools #[call [fun a+] [opt {ansicode...}]] @@ -3267,17 +3331,49 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # REVIEW - osc8 replays etc for split lines? - textblock + #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda #the 'id' parameter logically connects split hyperlinks + #per interp. Rather than try to avoid collisions using something like 'info cmdcount' we will use a simple counter. + #To stop multiple hyperlinks from having ids inadvertently collide - we should do some id mangling/prefixing based on the terminal/window etc + #It is better to use a simple counter with high likelihood of collision so we are more likely to detect problems with ids than to make it more intermittent by using ids that collide only 'rarely' + variable hyperlinkcounter + set hyperlinkcounter 0 + + proc hyperlink {uri {display ""}} { + variable hyperlinkcounter if {$display eq ""} { set display $uri } - set params "" ;#todo e.g id=xyz123:foo=bar:baz=quux + set uri [punk::ansi::ansistripraw $uri] + #limit uri length we emit based on common limits in other terminals + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set params "id=punkansi-[incr hyperlinkcounter]" ;#todo e.g id=xyz123:foo=bar:baz=quux set open "\x1b\]8\;$params\;$uri\x1b\\" set close "\x1b\]8\;\;\x1b\\" return ${open}${display}${close} } + #on windows terminal at least, both uri and id of 2 separated hyperlinks need to match for the hover highlighting to act as a unit. + proc hyperlink_open {uri {id ""}} { + if {$id eq ""} { + set id punkansi-[incr hyperlinkcounter] + } + set uri [punk::ansi::ansistripraw $uri] + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set id [string map {: . {;} ,} $id] ;#avoid some likely problematic ids. TODO - review, restrict further. + set params "id=$id" + return "\x1b\]8\;$params\;$uri\x1b\\" + } + #It should be ok to close even if no currently active hyperlink (e.g can be used to cleanup if something awry) + proc hyperlink_close {} { + return "\x1b\]8\;\;\x1b\\" + } + # -- --- --- --- --- proc move {row col} { #*** !doctools @@ -3837,11 +3933,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun ansistrip] [arg text] ] #[para]Return a string with ansi codes stripped out #[para]Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs) - + if {[string length $text] < 2} {return $text} if {[punk::ansi::ta::detect_g0 $text]} { set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters } + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] + if {[llength $parts] == 1} {return [lindex $parts 0]} set out "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" # - (if/when lsearch -stride bug fixed) @@ -3871,6 +3969,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Return a string with ansi codes stripped out #[para]Alternate graphics modes will be stripped rather than converted to unicode - exposing the raw ascii characters as they appear without graphics mode. #[para]ie instead of a horizontal line you may see: qqqqqq + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] set out "" @@ -7294,6 +7393,13 @@ tcl::namespace::eval punk::ansi::internal { } } +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set NAMESPACES [list] + } +} +lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::ansi [tcl::namespace::eval punk::ansi { diff --git a/src/modules/punk/args-999999.0a1.0.tm b/src/modules/punk/args-999999.0a1.0.tm index 0f66fc40..d51a934b 100644 --- a/src/modules/punk/args-999999.0a1.0.tm +++ b/src/modules/punk/args-999999.0a1.0.tm @@ -84,7 +84,7 @@ # *values -min 2 -max 2 # fileA -type existingfile 1 # fileB -type existingfile 1 -# } $args]] opts values +# } $args]] leaders opts values # puts "$category fileA: [dict get $values fileA]" # puts "$category fileB: [dict get $values fileB]" # } @@ -218,49 +218,45 @@ package require Tcl 8.6- #*** !doctools #[section API] -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# oo::class namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval punk::args::class { +tcl::namespace::eval punk::args::register { #*** !doctools - #[subsection {Namespace punk::args::class}] - #[para] class definitions - if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { - #*** !doctools - #[list_begin enumerated] - - # oo::class create interface_sample1 { - # #*** !doctools - # #[enum] CLASS [class interface_sample1] - # #[list_begin definitions] + #[subsection {Namespace punk::args}] + #[para] cooperative namespace punk::args::register + #[para] punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded + #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. + #[list_begin definitions] - # method test {arg1} { - # #*** !doctools - # #[call class::interface_sample1 [method test] [arg arg1]] - # #[para] test method - # puts "test: $arg1" - # } + # -- --- --- --- --- --- --- --- + #cooperative with packages that define some punk args but may need to do so lazily + #These could be loaded prior to punk::args being loaded + variable NAMESPACES + if {![info exists ::punk::args::register::NAMESPACES]} { + set NAMESPACES [list] + } + # -- --- --- --- --- --- --- --- - # #*** !doctools - # #[list_end] [comment {-- end definitions interface_sample1}] - # } - #*** !doctools - #[list_end] [comment {--- end class enumeration ---}] - } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::register ---}] } -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args { + + + variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::definition at the end. + tcl::namespace::export {[a-z]*} - variable argspec_cache - variable argspec_ids + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved variable id_counter - set argspec_cache [tcl::dict::create] - set argspec_ids [tcl::dict::create] + set argdata_cache [tcl::dict::create] + set argdefcache_by_id [tcl::dict::create] + set argdefcache_unresolved [tcl::dict::create] set id_counter 0 #*** !doctools @@ -271,72 +267,127 @@ tcl::namespace::eval punk::args { #todo - some sort of punk::args::cherrypick operation to get spec from an existing set #todo - doctools output from definition - #dict get value with default wrapper for tcl 8.6 - if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef - proc Dict_getdef {dictValue args} { - set keys [lrange $args 0 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] - } - } - } else { - #we pay a minor perf penalty for the wrap - interp alias "" ::punk::args::Dict_getdef "" ::tcl::dict::getdef - } - - #name to reflect maintenance - home is punk::lib::ldiff - proc punklib_ldiff {fromlist removeitems} { - if {[llength $removeitems] == 0} {return $fromlist} - set result {} - foreach item $fromlist { - if {$item ni $removeitems} { - lappend result $item - } - } - return $result - } - proc flatzip {l1 l2} { - concat {*}[lmap a $l1 b $l2 {list $a $b}] - } - if {[info commands lseq] ne ""} { - #tcl 8.7+ lseq significantly faster, especially for larger ranges - #The internal rep can be an 'arithseries' with no string representation - proc zero_to_n {n} { - lseq 0 $n - } - } else { - proc zero_to_n {n} { - lsearch -all [lrepeat $n 0] * - } - } #todo? -synonym/alias ? (applies to opts only not values) #e.g -background -aliases {-bg} -default White - #review - how to make work with trie prefix e.g -corner -aliases {-corners} + #review - how to make work with trie prefix + #e.g + # -corner -aliases {-corners} + # -centre -aliases {-center -middle} #We mightn't want the prefix to be longer just because of an alias + #we should get -co -ce and -m from the above as abbreviations + + lappend PUNKARGS [list { + *id punk::args::definition + *proc -name punk::args::definition -help\ + "Accepts a line-based definition of command arguments. + The definition should usually contain a line of the form: *id someid + " + -dynamic -type boolean -default 0 -help\ + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is not usually significant, perhaps on the order of a few hundred uS, + but -dynamic true might be less desirable if the command is used in inner + loops in more performance-sensitive code. + " + *values -min 1 -max -1 + text -type string -multiple 1 -help\ + "Block(s) of text representing the argument specification for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + e.g + definition { + *id myns::myfunc + *proc -name myns::myfunc -help\\ + \"Description of command\" + + #The following option defines an option-value pair + -option1 -default blah -type string + #The following option defines a flag style option (solo) + -flag1 -default 0 -type none -help\\ + \"Info about flag1\" + + *values -min 1 -max -1 + #Items that don't begin with * or - are value definitions + v1 -type integer -default 0 + thinglist -type string -multiple 1 + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + " + }] + proc definition {args} { + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved + - proc definition {optionspecs args} { - variable argspec_cache - #variable argspecs ;#REVIEW!! - variable argspec_ids #variable initial_optspec_defaults #variable initial_valspec_defaults #ideally we would use a fast hash algorithm to produce a short key with low collision probability. #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. #review - check if there is a built-into-tcl way to do this quickly #for now we will just key using the whole string - set cache_key $optionspecs - if {[tcl::dict::exists $argspec_cache $cache_key]} { - return [tcl::dict::get $argspec_cache $cache_key] + + set cache_key $args + set textargs $args + + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] + set textargs [lrange $args 2 end] } - set optionspecs [tcl::string::map [list \r\n \n] $optionspecs] + if {!$is_dynamic} { + if {[tcl::dict::exists $argdata_cache $cache_key]} { + return [tcl::dict::get $argdata_cache $cache_key] + } + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + if {[string first \$\{ $optionspecs] > 0} { + set optionspecs [uplevel 1 [list punk::args::lib::tstr -return string -eval 1 $optionspecs]] + } + } else { + if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { + set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + } else { + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + #REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?) + if {[string first \$\{ $optionspecs] > 0} { + set pt_params [punk::args::lib::tstr -return list -eval 0 $optionspecs] ;#-eval 0 - no need to uplevel + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + tcl::dict::set argdefcache_unresolved $cache_key $pt_params + } + } + if {[tcl::dict::exists $argdata_cache $optionspecs]} { + #resolved cache version exists + return [tcl::dict::get $argdata_cache $optionspecs] + } + } + + + #probably faster to inline a literal dict create in the proc than to use a namespace variable set optspec_defaults [tcl::dict::create\ -type string\ @@ -381,7 +432,7 @@ tcl::namespace::eval punk::args { #default to 1 for convenience #checks with no default - #-minlen -maxlen -range + #-minsize -maxsize -range #default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi @@ -473,14 +524,19 @@ tcl::namespace::eval punk::args { } set proc_info {} set id_info {} ;#e.g -children ?? - set leader_min 0 - set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set doc_info {} + set parser_info {} + set leader_min "" + #set leader_min 0 + #set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set leader_max "" #(common case of no leaders specified) set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit set spec_id "" set argspace "leaders" ;#leaders -> options -> values + set parser_id 0 foreach ln $records { set trimln [tcl::string::trim $ln] switch -- [tcl::string::index $trimln 0] { @@ -510,10 +566,45 @@ tcl::namespace::eval punk::args { error "punk::args::definition - bad *id line. Remaining items on line after *id must be in paired option-value format - received '$linespecs'" } } + parser { + #handle multiple parsing styles based on arities and keyword positions (and/or flags?) + #e.g see lseq manual with 3 different parsing styles. + #aim to produce a table/subtable for each + # *parser -description "start ?('..'|'to')? end ??'by'? step?"\ + # -arities { + # 2 + # {3 anykeys {1 .. 1 to}} + # {4 anykeys {3 by}} + # {5 anykeys {1 .. 1 to 3 by}} + # }\ + # -fallback 1 + # ... + # *parser -description "start 'count' count ??'by'? step?"\ + # -arities { + # {3 anykeys {1 count}} + # } + # ... + # *parser -description "count ?'by' step?"\ + # -arities { + # 1 + # {3 anykeys {1 by}} + # } + # + # see also after manual + # *parser -arities {1} + # *parser -arities { + # 1 anykeys {0 info} + # } + #todo + set parser_info $starspecs + } proc { #allow arbitrary - review set proc_info $starspecs } + doc { + set doc_info $starspecs + } opts { if {$argspace eq "values"} { error "punk::args::definition - *opts declaration must come before *values - received '$linespecs'" @@ -525,13 +616,14 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { #review - only apply to certain types? tcl::dict::set optspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels - -nocase { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels - -nocase { if {$v} { - tcl::dict::unset optspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset optspec_defaults $k2 } } -type { @@ -563,16 +655,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { #allow overriding of defaults for options that occur later tcl::dict::set optspec_defaults $k $v } default { - set known { -any -anyopts -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *opts line. Known keys: $known" } @@ -588,27 +681,28 @@ tcl::namespace::eval punk::args { -min - -minvalues { if {$v < 0} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is 0. got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is 0. got $v" } set leader_min $v - if {$leader_max == 0} { - set leader_max -1 - } + #if {$leader_max == 0} { + # set leader_max -1 + #} } -max - -maxvalues { if {$v < -1} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is -1 (indicating unlimited). got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is -1 (indicating unlimited). got $v" } set leader_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set leaderspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset leaderspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset leaderspec_defaults $k2 } } -type { @@ -640,16 +734,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set leaderspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *leaders line. Known keys: $known" } @@ -675,13 +770,14 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set valspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset valspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset valspec_defaults $k2 } } -type { @@ -713,16 +809,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set valspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *values line. Known keys: $known" } @@ -754,7 +851,7 @@ tcl::namespace::eval punk::args { if {$argspace eq "leaders"} { tcl::dict::set argspecs -ARGTYPE leader lappend leader_names $argname - if {$leader_max == 0} { + if {$leader_max >= 0} { set leader_max [llength $leader_names] } } else { @@ -819,11 +916,12 @@ tcl::namespace::eval punk::args { } } } - -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - + -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - - -regexprepass - -regexprefail + -regexprepass - -regexprefail - -regexprefailmsg { - #review -solo 1 vs -type none ? + #inverses '-noxxx' (e.g -nochoices -nominsize etc) don't apply to specific args - only to *leaders *opts *values lines + #review -solo 1 vs -type none ? conflicting values? tcl::dict::set spec_merged $spec $specval } -validationtransform { @@ -833,10 +931,10 @@ tcl::namespace::eval punk::args { } dict for {tk tv} $specval { switch -- $tk { - -function - -type - -minlen - -maxlen - -range { + -function - -type - -minsize - -maxsize - -range { } default { - set known_transform_keys [list -function -type -minlen -maxlen -range] ;#-choices etc? + set known_transform_keys [list -function -type -minsize -maxsize -range] ;#-choices etc? error "punk::args::definition - invalid subkey $tk for key '$spec' in specifications for argument '$argname' must be one of: $known_transform_keys" } } @@ -844,9 +942,9 @@ tcl::namespace::eval punk::args { } default { - set known_argspecs [list -default -type -range -choices -choiceprefix -choicerestricted\ + set known_argspecs [list -default -type -range -minsize -maxsize -choices -choiceprefix -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] error "punk::args::definition - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } @@ -854,9 +952,9 @@ tcl::namespace::eval punk::args { } set argspecs $spec_merged if {$is_opt} { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } else { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } tcl::dict::set arg_info $argname $argspecs tcl::dict::set arg_checks $argname $argchecks @@ -886,11 +984,21 @@ tcl::namespace::eval punk::args { } # REVIEW - foreach leadername [lrange $leader_names 0 end] { - if {[tcl::dict::get $arg_info $leadername -multiple]} { - error "bad key -multiple on argument spec for leader '$valname'. Only the last value argument specification can be marked -multiple" + #if {[llength $val_names] || $val_min > 0} { + # #some values are specified + # foreach leadername [lrange $leader_names 0 end] { + # if {[tcl::dict::get $arg_info $leadername -multiple]} { + # error "bad key -multiple on argument spec for leader '$leadername'. Last leader argument specification can be marked -multiple only when no values are specified" + # } + # } + #} else { + #no values specified - we can allow last leader to be multiple + foreach leadername [lrange $leader_names 0 end-1] { + if {[tcl::dict::get $arg_info $leadername -multiple]} { + error "bad key -multiple on argument spec for leader '$leadername'. Only the last leader argument specification can be marked -multiple" + } } - } + #} #confirm any valnames before last don't have -multiple key foreach valname [lrange $val_names 0 end-1] { if {[tcl::dict::get $arg_info $valname -multiple]} { @@ -906,11 +1014,11 @@ tcl::namespace::eval punk::args { #todo - do some checks for obvious bad definitions involving a mix of *leaders and *values (e.g with optional options) - set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize - set result [tcl::dict::create\ + set argdata_dict [tcl::dict::create\ id $spec_id\ arg_info $arg_info\ arg_checks $arg_checks\ @@ -936,24 +1044,31 @@ tcl::namespace::eval punk::args { valspec_defaults $valspec_defaults\ val_checks_defaults $val_checks_defaults\ proc_info $proc_info\ + doc_info $doc_info\ id_info $id_info\ ] - tcl::dict::set argspec_cache $cache_key $result - #tcl::dict::set argspecs $spec_id $optionspecs - tcl::dict::set argspec_ids $spec_id $optionspecs + tcl::dict::set argdata_cache $cache_key $argdata_dict + if {$is_dynamic} { + #also cache resolved version + tcl::dict::set argdata_cache $optionspecs $argdata_dict + } + #tcl::dict::set argdefcache_by_id $spec_id $optionspecs + tcl::dict::set argdefcache_by_id $spec_id $args #puts "xxx:$result" - return $result + return $argdata_dict } proc get_spec {id {patternlist *}} { - variable argspec_ids - if {[tcl::dict::exists $argspec_ids $id]} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { if {$patternlist eq "*"} { - return [tcl::dict::get $argspec_ids $id] + #todo? + return [tcl::dict::get $argdefcache_by_id $realid] } else { - set spec [tcl::dict::get $argspec_ids $id] + set speclist [tcl::dict::get $argdefcache_by_id $realid] set result "" - set specdict [definition $spec] + set specdict [uplevel 1 [list ::punk::args::definition {*}$speclist]] set arg_info [dict get $specdict arg_info] foreach pat $patternlist { set matches [dict keys $arg_info $pat] @@ -968,13 +1083,128 @@ tcl::namespace::eval punk::args { } return } + proc get_spec_values {id {patternlist *}} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { + set speclist [tcl::dict::get $argdefcache_by_id $realid] + set specdict [definition {*}$speclist] + set arg_info [dict get $specdict arg_info] + set valnames [dict get $specdict val_names] + set result "" + if {$patternlist eq "*"} { + foreach v $valnames { + set def [dict get $arg_info $v] + set def [dict remove $def -ARGTYPE] + append result \n "$v $def" + } + } else { + foreach pat $patternlist { + set matches [dict keys $arg_info $pat] + set matches [lsearch -all -inline -glob $valnames $pat] + foreach m $matches { + set def [dict get $arg_info $m] + set def [dict remove $def -ARGTYPE] + append result \n "$m $def" + } + } + return $result + } + } + return + } #proc get_spec_leaders ?? #proc get_spec_opts ?? - #proc get_spec_values ?? - proc get_spec_ids {{match *}} { - variable argspec_ids - return [tcl::dict::keys $argspec_ids $match] + variable aliases + set aliases [dict create] + + lappend PUNKARGS [list { + *id punk::args::get_ids + *proc -name punk::args::get_ids -help\ + "return list of ids for argument definitions" + *values -min 0 -max 1 + match -default * -help\ + "exact id or glob pattern for ids" + }] + proc get_ids {{match *}} { + variable argdefcache_by_id + variable aliases + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + } + proc id_exists {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + return 1 + } + tcl::dict::exists $argdefcache_by_id $id + } + proc set_alias {alias id} { + variable aliases + dict set aliases $alias $id + } + proc unset_alias {alias} { + variable aliases + dict unset aliases $alias + } + proc get_alias {alias} { + variable aliases + if {[dict exists $aliases $alias]} { + return [tcl::dict::get $aliases $alias] + } + } + + proc real_id {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } else { + if {![llength [update_definitions]]} { + return "" + } else { + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } + return "" + } + } + } + + variable loaded_packages + set loaded_packages [list] + + proc update_definitions {} { + variable loaded_packages + upvar ::punk::args::register::NAMESPACES pkgs + if {[llength $loaded_packages] == [llength $pkgs]} { + #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + return {} + } + set unloaded [punklib_ldiff $pkgs $loaded_packages] + set newloaded [list] + foreach pkgns $unloaded { + if {![catch { + if {[info exists ${pkgns}::PUNKARGS]} { + foreach deflist [set ${pkgns}::PUNKARGS] { + namespace eval $pkgns [list punk::args::definition {*}$deflist] + } + } + } errMsg]} { + lappend loaded_pkgs $pkgns + lappend newloaded $pkgns + } else { + puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" + } + } + return $newloaded } #for use within get_dict only @@ -1018,253 +1248,408 @@ tcl::namespace::eval punk::args { #basic recursion blocker variable arg_error_isrunning 0 - proc arg_error {msg spec_dict {badarg ""}} { + proc arg_error {msg spec_dict args} { + if {[catch {package require punk::ansi}]} { + proc punk::args::a {args} {} + proc punk::args::a+ {args} {} + } else { + namespace eval ::punk::args { + namespace import ::punk::ansi::a ::punk::ansi::a+ + } + } #limit colours to standard 16 so that themes can apply to help output variable arg_error_isrunning if {$arg_error_isrunning} { - error "arg_error already running - error in arg_error?\n triggering errmsg: $badarg" + error "arg_error already running - error in arg_error?\n triggering errmsg: $msg" } set arg_error_isrunning 1 + if {[llength $args] %2 != 0} { + error "error in arg_error processing - expected opt/val pairs after msg and spec_dict" + } + set badarg "" + set returntype error + dict for {k v} $args { + switch -- $k { + -badarg { + set badarg $v + } + -return { + if {$v ni {error string}} { + error "arg_error invalid value for option -return. Received '$v' expected one of: error string" + } + set returntype $v + } + default { + error "arg_error invalid option $k. Known_options: -badarg -return" + } + } + } + + #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error #e.g list_as_table # use basic colours here to support terminals without extended colours - #todo - add checks column (e.g -minlen -maxlen) + #todo - add checks column (e.g -minsize -maxsize) set errmsg $msg if {![catch {package require textblock}]} { - if {[catch { + set has_textblock 1 + } else { + set has_textblock 0 + #couldn't load textblock package + #just return the original errmsg without formatting + } + set errlines [list] ;#for non-textblock output + if {[catch { + if {$has_textblock} { append errmsg \n - set procname [::punk::args::Dict_getdef $spec_dict proc_info -name ""] - set prochelp [::punk::args::Dict_getdef $spec_dict proc_info -help ""] + } else { + append errmsg \n "[a+ brightred](layout package textblock is missing)[a]" \n + } + set procname [Dict_getdef $spec_dict proc_info -name ""] + set prochelp [Dict_getdef $spec_dict proc_info -help ""] - set t [textblock::class::table new [a+ brightyellow]Usage[a]] + set docname [Dict_getdef $spec_dict doc_info -name "Manual:"] + set docurl [Dict_getdef $spec_dict doc_info -url ""] - set blank_header_col [list ""] - if {$procname ne ""} { - lappend blank_header_col "" - set procname_display [a+ brightwhite]$procname[a] - } else { - set procname_display "" - } - if {$prochelp ne ""} { - lappend blank_header_col "" - set prochelp_display [a+ brightwhite]$prochelp[a] - } else { - set prochelp_display "" - } + + set blank_header_col [list ""] + if {$procname ne ""} { + lappend blank_header_col "" + set procname_display [a+ brightwhite]$procname[a] + } else { + set procname_display "" + } + if {$prochelp ne ""} { + lappend blank_header_col "" + set prochelp_display [a+ brightwhite]$prochelp[a] + } else { + set prochelp_display "" + } + if {$docurl ne ""} { + lappend blank_header_col "" + set docurl_display [a+ white]$docurl[a] + } else { + set docurl_display "" + } + if {$has_textblock} { + set t [textblock::class::table new [a+ brightyellow]Usage[a]] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col - if {"$procname$prochelp" eq ""} { - $t configure_header 0 -values {Arg Type Default Multi Help} - } elseif {$procname eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 1 -values {Arg Type Default Multi Help} - } elseif {$prochelp eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -values {Arg Type Default Multi Help} + } + set h 0 + if {$procname ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] + } else { + lappend errlines "PROC/METHOD: $procname_display" + } + incr h + } + if {$prochelp ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] } else { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 2 -values {Arg Type Default Multi Help} + lappend errlines "Description: $prochelp_display" + } + incr h + } + if {$docurl ne ""} { + if {![catch {package require punk::ansi}]} { + set docurl [punk::ansi::hyperlink $docurl] } + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list $docname $docurl_display] + } else { + lappend errlines "$docname $docurl_display" + } + incr h + } + if {$has_textblock} { + $t configure_header $h -values {Arg Type Default Multi Help} + } else { + lappend errlines " --ARGUMENTS-- " + } + + set RST [a] + #set A_DEFAULT [a+ brightwhite Brightgreen] + set A_DEFAULT "" + set A_BADARG [a+ brightred] + set greencheck [a+ brightgreen]\u2713[a] ;#green tick + set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set A_PREFIX [a+ green] ;#use a+ so colour off can apply + if {$A_PREFIX eq ""} { + set A_PREFIX [a+ underline] + set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + } else { + set A_PREFIXEND $RST + } - set RST [a] - #set A_DEFAULT [a+ brightwhite Brightgreen] - set A_DEFAULT "" - set A_BADARG [a+ brightred] - set greencheck [a+ brightgreen]\u2713[a] ;#green tick - set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) - set A_PREFIX [a+ green] ;#use a+ so colour off can apply - if {$A_PREFIX eq ""} { - set A_PREFIX [a+ underline] - set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + set opt_names [list] + set opt_names_display [list] + if {[llength [dict get $spec_dict opt_names]]} { + if {![catch {package require punk::trie}]} { + set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $spec_dict opt_names] { + set id [dict get $idents $c] + #REVIEW + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail + #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] + lappend opt_names $c + } } else { - set A_PREFIXEND $RST + set opt_names [dict get $spec_dict opt_names] + set opt_names_display $opt_names } - - set opt_names [list] - set opt_names_display [list] - if {[llength [dict get $spec_dict opt_names]]} { - if {![catch {package require punk::trie}]} { - set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy - foreach c [dict get $spec_dict opt_names] { - set id [dict get $idents $c] - #REVIEW - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] - } - lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail - #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] - lappend opt_names $c - } + } + set leading_val_names [dict get $spec_dict leader_names] + set trailing_val_names [dict get $spec_dict val_names] + + #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { + # if {![string match -* $argname]} { + # lappend leading_val_names [lpop trailing_val_names 0] + # } else { + # break + # } + #} + #if {![llength $leading_val_names] && ![llength $opt_names]} { + # #all vals were actually trailing - no opts + # set trailing_val_names $leading_val_names + # set leading_val_names {} + #} + set leading_val_names_display $leading_val_names + set trailing_val_names_display $trailing_val_names + + #display options first then values + foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { + lassign $argumentset argnames_display argnames + + foreach argshow $argnames_display arg $argnames { + set arginfo [dict get $spec_dict arg_info $arg] + if {[dict exists $arginfo -default]} { + set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" } else { - set opt_names [dict get $spec_dict opt_names] - set opt_names_display $opt_names + set default "" } - } - set leading_val_names [dict get $spec_dict leader_names] - set trailing_val_names [dict get $spec_dict val_names] - - #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { - # if {![string match -* $argname]} { - # lappend leading_val_names [lpop trailing_val_names 0] - # } else { - # break - # } - #} - #if {![llength $leading_val_names] && ![llength $opt_names]} { - # #all vals were actually trailing - no opts - # set trailing_val_names $leading_val_names - # set leading_val_names {} - #} - set leading_val_names_display $leading_val_names - set trailing_val_names_display $trailing_val_names - - #display options first then values - foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { - lassign $argumentset argnames_display argnames - - foreach argshow $argnames_display arg $argnames { - set arginfo [dict get $spec_dict arg_info $arg] - if {[dict exists $arginfo -default]} { - set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" + set help [Dict_getdef $arginfo -help ""] + if {[dict exists $arginfo -choices]} { + if {$help ne ""} {append help \n} + if {[dict get $arginfo -nocase]} { + set casemsg " (case insensitive)" } else { - set default "" + set casemsg " (case sensitive)" } - set help [::punk::args::Dict_getdef $arginfo -help ""] - if {[dict exists $arginfo -choices]} { - if {$help ne ""} {append help \n} - if {[dict get $arginfo -nocase]} { - set casemsg " (case insensitive)" - } else { - set casemsg " (case sensitive)" - } - if {[dict get $arginfo -choiceprefix]} { - set prefixmsg " (choice prefix allowed)" + if {[dict get $arginfo -choiceprefix]} { + set prefixmsg " (choice prefix allowed)" + } else { + set prefixmsg "" + } + set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] + set formattedchoices [list] + append help " Choices$prefixmsg$casemsg" + if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + #append help "\n " [join [dict get $arginfo -choices] "\n "] + if {[dict size $choicelabeldict]} { + foreach c [dict get $arginfo -choices] { + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } } else { - set prefixmsg "" + set formattedchoices [dict get $arginfo -choices] } - set formattedchoices [list] - append help " Choices$prefixmsg$casemsg" - if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + } else { + if {[catch { + set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $arginfo -choices] { + set id [dict get $idents $c] + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + set cdisplay "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } + } errM]} { + puts stderr "prefix marking failed\n$errM" #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - } else { - if {[catch { - set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy + if {[dict size $choicelabeldict]} { foreach c [dict get $arginfo -choices] { - set id [dict get $idents $c] - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] } - lappend formattedchoices "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" - } - } errM]} { - puts stderr "prefix marking failed\n$errM" - #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - - } - } - set numcols 4 - if {[llength $formattedchoices] < $numcols} { - #don't show blank cells if single line of results - set numcols [llength $formattedchoices] - } - #risk of recursing - set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] - append help \n[textblock::join -- " " $choicetable] - #review. use -type to restrict additional choices - may be different to values in the -choices - if {![dict get $arginfo -choicerestricted]} { - if {[dict get $arginfo -type] eq "string"} { - append help "\n (values not in defined choices are allowed)" + lappend formattedchoices $cdisplay + } } else { - append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + set formattedchoices [dict get $arginfo -choices] } + } } - if {[::punk::args::Dict_getdef $arginfo -multiple 0]} { - set multiple $greencheck - } else { - set multiple "" + set numcols 4 ;#todo - dynamic? + if {[llength $formattedchoices] < $numcols} { + #don't show blank cells if single line of results + set numcols [llength $formattedchoices] } - if {[::punk::args::Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { - set argshow "?${argshow}?" + if {$numcols > 0} { + if {$has_textblock} { + #risk of recursing + set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] + append help \n[textblock::join -- " " $choicetable] + } else { + append help \n [join $formattedchoices \n] + } + } else { + #we were given an empty set of choices. + #probably an error in the definition - but could happen if dynamically generated. + #(e.g ensemble where unknown mechanism is used for subcommands?) + #better to just display that there were none rather than totally break the usage output. + append help \n " " [a+ red](no choices defined)[a] } - set typeshow [dict get $arginfo -type] - if {$typeshow eq "none"} { - set typeshow "$typeshow $soloflag" + + #review. use -type to restrict additional choices - may be different to values in the -choices + if {![dict get $arginfo -choicerestricted]} { + if {[dict get $arginfo -type] eq "string"} { + append help "\n (values not in defined choices are allowed)" + } else { + append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + } } + } + if {[Dict_getdef $arginfo -multiple 0]} { + set multiple $greencheck + } else { + set multiple "" + } + if {[Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { + set argshow "?${argshow}?" + } + set typeshow [dict get $arginfo -type] + if {$typeshow eq "none"} { + set typeshow "$typeshow $soloflag" + } + if {[dict exists $arginfo -minsize]} { + append typeshow \n "-minsize [dict get $arginfo -minsize]" + } + if {[dict exists $arginfo -maxsize]} { + append typeshow \n "-maxsize [dict get $arginfo -maxsize]" + } + if {[dict exists $arginfo -range]} { + append typeshow \n "-range [dict get $arginfo -range]" + } + + if {$has_textblock} { $t add_row [list $argshow $typeshow $default $multiple $help] if {$arg eq $badarg} { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_BADARG } + } else { + #review - formatting will be all over the shop due to newlines in typesshow, help + lappend errlines "$argshow TYPE:$typeshow DEFAULT:$default MULTI:$multiple HELP:$help\n" } } + } - - #$t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ web-white] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] + if {$has_textblock} { $t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ brightwhite] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] $t configure -maxwidth 80 append errmsg [$t print] $t destroy - } errM]} { - catch {$t destroy} - append errmsg \n - append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n - append errmsg "$errM" \n - append errmsg "$::errorInfo" - + } else { + append errmsg [join $errlines \n] } - } else { - #couldn't load textblock package - #just return the original errmsg without formatting + } errM]} { + catch {$t destroy} + append errmsg \n + append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n + append errmsg "$errM" \n + append errmsg "$::errorInfo" + } set arg_error_isrunning 0 #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. #Also,we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;) - return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + if {$returntype eq "error"} { + return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + } else { + return $errmsg + } } - #todo - a version of get_dict that supports punk::lib::tstr templating - #rename get_dict - #provide ability to look up and reuse definitions from ids etc - # + lappend PUNKARGS [list { + *id punk::args::usage + *proc -name punk::args::usage -help\ + "return usage information as a string + in table form." + *values -min 0 -max 1 + id -help\ + "exact id. + Will usually match the command name" + }] + proc usage {id} { + set speclist [get_spec $id] + if {[llength $speclist] == 0} { + error "punk::args::usage - no such id: $id" + } + arg_error "" [uplevel 1 [list punk::args::definition {*}$speclist]] -return string + } + + lappend PUNKARGS [list { + *id punk::args::get_by_id + *proc -name punk::args::get_by_id + *values -min 1 + id + arglist -default "" -type list -help\ + "list containing arguments to be parsed as per the + argument specification identified by the supplied id." + }] proc get_by_id {id {arglist ""}} { - set spec [get_spec $id] - if {$spec eq ""} { + set speclist [punk::args::get_spec $id] + if {[llength $speclist] == 0} { error "punk::args::get_by_id - no such id: $id" } - return [get_dict $spec $arglist] + return [uplevel 1 [list ::punk::args::get_dict {*}$speclist $arglist]] } + #todo? - a version of get_dict that directly supports punk::lib::tstr templating + #rename get_dict + # + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. #only supports -flag val pairs, not solo options #If an option is supplied multiple times - only the last value is used. - proc get_dict {optionspecs args} { + proc get_dict {args} { #*** !doctools - #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[call [fun get_dict] [arg optionspecs] [arg rawargs]] #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values #[para]Returns a dict of the form: opts values #[para]ARGUMENTS: @@ -1297,48 +1682,53 @@ tcl::namespace::eval punk::args { # *values -multiple 1 #} $args - if {[llength $args] == 0} { - set rawargs [list] - } elseif {[llength $args] ==1} { - set rawargs [lindex $args 0] ;#default tcl style - } else { - #todo - can we support tk style vals before flags? - #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order - #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. - #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options - #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. - #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. - error "unsupported number of arguments for punk::args::get_dict" - set inopt 0 - set k "" - set i 0 - foreach a $args { - switch -- $f { - -opts { - - } - -vals { - - } - -optvals { - #tk style - - } - -valopts { - #tcl style - set rawargs [lindex $args $i+1] - incr i - } - default { - - } - } - incr i - } + #if {[llength $args] == 0} { + # set rawargs [list] + #} elseif {[llength $args] ==1} { + # set rawargs [lindex $args 0] ;#default tcl style + #} else { + # #todo - can we support tk style vals before flags? + # #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + # #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + # #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + # #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + # #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + # error "unsupported number of arguments for punk::args::get_dict" + # set inopt 0 + # set k "" + # set i 0 + # foreach a $args { + # switch -- $f { + # -opts { + + # } + # -vals { + + # } + # -optvals { + # #tk style + + # } + # -valopts { + # #tcl style + # set rawargs [lindex $args $i+1] + # incr i + # } + # default { + + # } + # } + # incr i + # } + #} + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] } + set rawargs [lindex $args end] ;# args values to be parsed + set def_args [lrange $args 0 end-1] - - set argspecs [definition $optionspecs] + set argspecs [uplevel 1 [list ::punk::args::definition {*}$def_args]] tcl::dict::with argspecs {} ;#turn keys into vars #puts "-arg_info->$arg_info" set flagsreceived [list] ;#for checking if required flags satisfied @@ -1354,52 +1744,123 @@ tcl::namespace::eval punk::args { # todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ? set opts $opt_defaults set pre_values {} - #dict for {a info} $arg_info { - # #todo - flag for possible subhandler - whether leading - or not (shellfilter concept) - # if {![string match -* $a]} { - # #lappend pre_values [lpop rawargs 0] - # if {[catch {lpop rawargs 0} val]} { - # break - # } else { - # lappend pre_values $val - # } - # } else { - # break - # } - #} - set argnames [dict keys $arg_info] + set argnames [tcl::dict::keys $arg_info] set optnames [lsearch -all -inline $argnames -*] set ridx 0 set rawargs_copy $rawargs + set leader_posn_name "" + set leader_posn_names_assigned [dict create] ;#track if the name got a value (or multiple if last one) + set is_multiple 0 ;#last leader may be multi if {$leader_max != 0} { foreach r $rawargs_copy { - if {$leader_max != -1 && $ridx > $leader_max-1} { + if {$leader_max ne "" && $leader_max != -1 && $ridx > $leader_max-1} { break } - if {[string match -* $r]} { - if {$r eq "--"} { - break + if {$ridx == [llength $leader_names]-1} { + #at last named leader + set leader_posn_name [lindex $leader_names $ridx] + if {[dict exists $arg_info $leader_posn_name -multiple] && [dict get $arg_info $leader_posn_name -multiple]} { + set is_multiple 1 } + } elseif {$ridx > [llength $leader_names]-1} { + #beyond names - retain name if -multiple was true + if {!$is_multiple} { + set leader_posn_name "" + } + } else { + set leader_posn_name [lindex $leader_names $ridx] ;#may return empty string + } + if {$r eq "--"} { + #review end of opts marker: '--' can't be a leader (but can be a value) + break + } + + #argument such as a dictionary may have leading dash - test for whitespace to exclude as possible option + if {[tcl::string::match -* $r] && !([tcl::string::first " " $r]>=0 || [tcl::string::first \t $r]>=0 || [tcl::string::last \n $r]>=0)} { set matchopt [::tcl::prefix::match -error {} $optnames $r] if {$matchopt ne ""} { #flaglike matches a known flag - don't treat as leader break } - if {![string match -* [lindex $argnames $ridx]]} { + #if {![string match -* [lindex $argnames $ridx]]} {} + if {$leader_posn_name ne ""} { #there is a named leading positional for this position + #The flaglooking value doesn't match an option - so treat as a leader lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name incr ridx continue } else { break } } - lappend pre_values [lpop rawargs 0] + + #for each branch - break or lappend + if {$leader_posn_name ne ""} { + if {$leader_posn_name ni $leader_required} { + #optional leader + + #most adhoc arg processing will allocate based on number of args rather than matching choice values first + #(because a choice value could be a legitimate data value) + + #review - option to process in this manner? + #first check if the optional leader value is a match for a choice ? + #if {[dict exists $arg_info $leader_posn_name -choices]} { + # set vmatch [tcl::prefix match -error "" [dict get $arg_info $leader_posn_name -choices] [lindex $rawargs 0]] + # if {$vmatch ne ""} { + # #If we match a choice for this named position - allocated it regardless of whether enough args for trailing values + # lappend pre_values [lpop rawargs 0] + # incr ridx + # continue + # } + #} + + #check if enough rawargs to fill any required values + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } else { + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #required + if {[dict exists $leader_posn_names_assigned $leader_posn_name]} { + #already accepted at least one value - requirement satisfied - now equivalent to optional + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } + } + #if we didn't break - requirement is not yet satisfied, or is satisfied but stil enough rawargs for required values + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #unnamed leader + if {$leader_min ne "" } { + if {$ridx > $leader_min} { + break + } else { + #haven't reached leader_min + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + break + } + } + incr ridx } } + if {$leader_min eq ""} { + set leader_min 0 + } + if {$leader_max eq ""} { + set leader_max -1 + } + #assert leader_max leader_min are numeric #assert - rawargs has been reduced by leading positionals set leaders [list] @@ -1429,7 +1890,8 @@ tcl::namespace::eval punk::args { break } - if {[tcl::string::match -* $a]} { + #exlude argument with whitespace from being a possible option e.g dict + if {[tcl::string::match -* $a] && !([tcl::string::first " " $a]>=0 || [tcl::string::first \t $a]>=0 || [tcl::string::last \n $a]>=0)} { if {$a eq "--"} { #remaining num args <= val_min already covered above if {$val_max != -1} { @@ -1467,14 +1929,12 @@ tcl::namespace::eval punk::args { } set flagval [lindex $rawargs $i+1] - if {[dict get $arg_info $fullopt -multiple]} { + if {[tcl::dict::get $arg_info $fullopt -multiple]} { #don't lappend to default - we need to replace if there is a default - #review - what if user sets first value that happens to match a default? - if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} { - #first occurrence of this flag, whilst stored value matches default + if {$fullopt ni $flagsreceived} { tcl::dict::set opts $fullopt [list $flagval] } else { - tcl::dict::lappend opts $fullopt $flagval + tcl::dict::lappend opts $fullopt $flagval } } else { tcl::dict::set opts $fullopt $flagval @@ -1482,13 +1942,13 @@ tcl::namespace::eval punk::args { #incr i to skip flagval incr vals_remaining_possible -2 if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs $fullopt + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt } } else { #solo if {[tcl::dict::get $arg_info $fullopt -multiple]} { - if {[tcl::dict::get $opts $fullopt] == 0} { - #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + if {$fullopt ni $flagsreceived} { + #override any default - don't lappend to it tcl::dict::set opts $fullopt 1 } else { tcl::dict::lappend opts $fullopt 1 @@ -1526,7 +1986,7 @@ tcl::namespace::eval punk::args { } lappend flagsreceived $a ;#adhoc flag as supplied if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs $a + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a } incr vals_remaining_possible -2 } else { @@ -1543,9 +2003,12 @@ tcl::namespace::eval punk::args { incr vals_remaining_possible -1 } } else { - #set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] - set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" - arg_error $errmsg $argspecs $fullopt + if {[llength $opt_names]} { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" + } else { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": No options defined while *opts -any 0" + } + arg_error $errmsg $argspecs -badarg $fullopt } } } @@ -1571,6 +2034,7 @@ tcl::namespace::eval punk::args { set positionalidx 0 ;#index for unnamed positionals (both leaders and values) set ldridx 0 + set in_multiple "" set leadernames_received [list] set leaders_dict $leader_defaults set num_leaders [llength $leaders] @@ -1579,13 +2043,26 @@ tcl::namespace::eval punk::args { break } if {$leadername ne ""} { - tcl::dict::set leaders_dict $leadername $ldr + if {[tcl::dict::get $arg_info $leadername -multiple]} { + if {[tcl::dict::exists $leader_defaults $leadername]} { + tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list + } else { + tcl::dict::lappend leaders_dict $leadername $ldr + } + set in_multiple $leadername + } else { + tcl::dict::set leaders_dict $leadername $ldr + } lappend leadernames_received $leadername } else { - tcl::dict::set leaders_dict $positionalidx $ldr - tcl::dict::set arg_info $positionalidx $leaderspec_defaults - tcl::dict::set arg_checks $positionalidx $leader_checks_defaults - lappend leadernames_received $positionalidx + if {$in_multiple ne ""} { + tcl::dict::lappend leaders_dict $in_multiple $ldr + } else { + tcl::dict::set leaders_dict $positionalidx $ldr + tcl::dict::set arg_info $positionalidx $leaderspec_defaults + tcl::dict::set arg_checks $positionalidx $leader_checks_defaults + lappend leadernames_received $positionalidx + } } incr ldridx incr positionalidx @@ -1602,7 +2079,7 @@ tcl::namespace::eval punk::args { } if {$valname ne ""} { if {[tcl::dict::get $arg_info $valname -multiple]} { - if {[tcl::dict::exists $val_defaults $valname] && ([tcl::dict::get $val_defaults $valname] eq [tcl::dict::get $values_dict $valname])} { + if {[tcl::dict::exists $val_defaults $valname]} { #current stored val equals defined default - don't include default in the list we build up tcl::dict::set values_dict $valname [list $val] ;#important to treat first element as a list } else { @@ -1663,12 +2140,12 @@ tcl::namespace::eval punk::args { #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW + #We SHOULD? always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - #safe interp note - cannot avoid struct::set difference ensemble as it could be c or tcl implementation and we don't have an option to call directly? + #safe interp note - struct::set difference ensemble could be c or tcl implementation and we don't have an option to call directly? #example timing difference: #struct::set difference {x} {a b} #normal interp 0.18 u2 vs safe interp 9.4us @@ -1683,7 +2160,7 @@ tcl::namespace::eval punk::args { arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs } if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} { - arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs + arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs } if {[llength [set missing [punklib_ldiff $val_required $valnames_received]]]} { arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs @@ -1714,7 +2191,7 @@ tcl::namespace::eval punk::args { set type [tcl::dict::get $thisarg -type] set has_choices [tcl::dict::exists $thisarg -choices] set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [punk::args::Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 set validationtransform [tcl::dict::get $thisarg -validationtransform] @@ -1814,7 +2291,7 @@ tcl::namespace::eval punk::args { } else { set prefixmsg "" } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } } incr idx @@ -1868,21 +2345,21 @@ tcl::namespace::eval punk::args { list { foreach e_check $vlist_check { if {![tcl::string::is list -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[llength $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -minlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[llength $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -maxlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1922,28 +2399,33 @@ tcl::namespace::eval punk::args { foreach e $remaining_e e_check $remaining_e_check { #puts "----> checking $e vs regex $regexprefail" if {[regexp $regexprefail $e]} { - arg_error "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" $argspecs $argname + if {[tcl::dict::exists $thisarg -regexprefailmsg]} { + set msg [tcl::dict::get $thisarg -regexprefailmsg] + } else { + set msg "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" + } + arg_error $msg $argspecs -badarg $argname } } } switch -- $type { ansistring { - #we need to respect -validate_ansistripped for -minlen etc, but the string must contain ansi + #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi #.. so we need to look at the original values in $vlist not $vlist_check #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - #The ansicodes only case should be covered by -minlen 0 -maxlen 0 combined with -validate_ansistripped ??? + #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? package require punk::ansi foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { - arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname } } } globstring { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { - arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname } } } @@ -1955,16 +2437,16 @@ tcl::namespace::eval punk::args { #dict for {checkopt checkval} $thisarg_checks {} tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::string::length $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::string::length $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1981,31 +2463,31 @@ tcl::namespace::eval punk::args { if {$low eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #lowside unspecified - check only high if {$e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname } } } elseif {$high eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #highside unspecified - check only low if {$e_check < $low} { - arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname } } } else { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #high and low specified if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname } } } @@ -2013,7 +2495,7 @@ tcl::namespace::eval punk::args { } else { foreach e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname } } } @@ -2033,7 +2515,7 @@ tcl::namespace::eval punk::args { #todo - empty string for low or high lassign $checkval low high if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname } } } @@ -2044,28 +2526,28 @@ tcl::namespace::eval punk::args { bool { foreach e_check $vlist_check { if {![tcl::string::is boolean -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname } } } dict { foreach e_check $vlist_check { if {[llength $e_check] %2 != 0} { - arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::dict::size $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -minlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::dict::size $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -maxlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -2089,7 +2571,7 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname } } } @@ -2101,19 +2583,19 @@ tcl::namespace::eval punk::args { #//review - we may need '?' char on windows if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} { #what about special file names e.g on windows NUL ? - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname } } if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { if {![file exists $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname } } } elseif {$type eq "existingdirectory"} { foreach e $vlist e_check $vlist_check { if {![file isdirectory $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname } } } @@ -2121,7 +2603,7 @@ tcl::namespace::eval punk::args { char { foreach e $vlist e_check $vlist_check { if {[tcl::string::length $e_check] != 1} { - arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname } } } @@ -2161,7 +2643,14 @@ tcl::namespace::eval punk::args { #maintain order of opts $opts values $values as caller may use lassign. set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received] - set received_posns [concat {*}[lmap a $receivednames b [zero_to_n [expr {[llength $receivednames]-1}]] {list $a $b}]] ;#flat zip named with overall posn including opts + if {[llength $receivednames]} { + #flat zip of names with overall posn, including opts + #set received_posns [concat {*}[lmap a $receivednames b [zero_based_posns [llength $receivednames]] {list $a $b}]] + set i -1 + set received_posns [concat {*}[lmap a $receivednames {list $a [incr i]}]] + } else { + set received_posns [list] + } return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns] } @@ -2173,7 +2662,7 @@ tcl::namespace::eval punk::args { #} - punk::args::definition { + lappend PUNKARGS [list { *id punk::args::TEST *opts -optional 0 -o1 -default 111 -help "opt 1 mandatory" @@ -2182,7 +2671,7 @@ tcl::namespace::eval punk::args { *values -min 0 -max 1 v -help\ "v1 optional" - } + }] #*** !doctools @@ -2195,8 +2684,9 @@ tcl::namespace::eval punk::args { # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args::lib { + variable PUNKARGS tcl::namespace::export * - tcl::namespace::path [tcl::namespace::parent] + tcl::namespace::path [list [tcl::namespace::parent]] #*** !doctools #[subsection {Namespace punk::args::lib}] #[para] Secondary functions that are part of the API @@ -2209,6 +2699,284 @@ tcl::namespace::eval punk::args::lib { # return 1 #} + proc flatzip {l1 l2} { + concat {*}[lmap a $l1 b $l2 {list $a $b}] + } + + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster, especially for larger ranges + #The internal rep can be an 'arithseries' with no string representation + proc zero_based_posns {count} { + if {$count < 1} {return} + lseq 0 $count-1 + } + } else { + proc zero_based_posns {count} { + if {$count < 1} {return} + lsearch -all [lrepeat $count 0] * + } + } + + + #experiment with equiv of js template literals with ${expression} in templates + #e.g tstr {This is the value of x in calling scope ${$x} !} + #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} + #e.g tstr -allowcommands {This is the value of [lindex $x -1] in calling scope ${[lindex [set x] 0]} !} + lappend PUNKARGS [list { + *id punk::args::lib::tstr + *proc -name punk::args::lib::tstr -help\ + "A rough equivalent of js template literals" + -allowcommands -default -1 -type none -help\ + "if -allowcommands is present, placeholder can contain commands e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -return -default list -choices {dict list string args}\ + -choicelabels { + dict\ + "Return a dict with keys + 'template' and 'params'" + string\ + "Return a single result + being the string with + placeholders substituted." + list\ + "Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + "Return a list where the first + element is a list of template + plaintext secions as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" + } + -eval -default 1 -type boolean -help\ + "Whether to evaluate the \$\{\} placeholders. + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced, or the variable name is likely to collide + with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + *values -min 0 -max 1 + templatestring -help\ + "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + }] + + proc tstr {args} { + #Too hard to fully eat-our-own-dogfood from within punk::args package + # - we use punk::args within the unhappy path only + #set argd [punk::args::get_by_id punk::lib::tstr $args] + #set templatestring [dict get $argd values templatestring] + #set opt_allowcommands [dict get $argd opts -allowcommands] + #set opt_return [dict get $argd opts -return] + #set opt_eval [dict get $argd opts -eval] + + set templatestring [lindex $args end] + set arglist [lrange $args 0 end-1] + set opts [dict create\ + -allowcommands 0\ + -eval 1\ + -return list\ + ] + if {"-allowcommands" in $arglist} { + set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] + dict set opts -allowcommands 1 + } + if {[llength $arglist] % 2 != 0} { + error "punk::args::lib::tstr expected option/value pairs prior to last argument" + } + dict for {k v} $arglist { + set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + switch -- $fullk { + -return - -eval { + dict set opts $fullk $v + } + default { + error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" + } + } + } + set opt_allowcommands [dict get $opts -allowcommands] + set opt_return [dict get $opts -return] + set opt_eval [dict get $opts -eval] + + + set nocommands "-nocommands" + if {$opt_allowcommands == 1} { + set nocommands "" + } + + #set parts [_tstr_split $templatestring] + if {[string first \$\{ $templatestring] < 0} { + set parts [list $templatestring] + } else { + set parts [_parse_tstr_parts $templatestring] + } + set textchunks [list] + #set expressions [list] + set params [list] + set idx 0 + foreach {pt expression} $parts { + lappend textchunks $pt + incr idx ;#pt incr + + #ignore last expression + if {$idx == [llength $parts]} { + break + } + #lappend expressions $expression + if {$opt_eval} { + lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] + } else { + lappend params $expression + } + + incr idx ;#expression incr + } + switch -- $opt_return { + dict { + return [dict create template $textchunks params $params] + } + list { + return [list $textchunks $params] + } + args { + #see example in tstr_test_one + return [list $textchunks {*}$params] + } + string { + set out "" + foreach pt $textchunks param $params { + append out $pt $param + } + return $out + } + default { + } + } + } + #test single placeholder tstr args where single placeholder must be an int + proc tstr_test_one {args} { + set argd [punk::args::get_dict { + *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. + example: + set id 2 + tstr_test_one {*}[tstr -return args {Select * from table where id = \$\{$id\} and etc... ;}] + } + + *values -min 2 -max 2 + template -type list -minsize 2 -maxsize 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - + but the tstr call in the example does this for you, and also passes in the id automatically" + + where -type int -help {Integer param for where clause. tstr mechanism above will pass the id as the second parameter} + } $args] + set template [dict get $argd values template] + set where [dict get $argd values where] + #set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] + set result [string cat [lindex $template 0] $where [lindex $template 1]] + return $result + } + proc _parse_tstr_parts {templatestring} { + if {$templatestring eq ""} { + return [list] + } + set chars [split $templatestring ""] + set in_placeholder 0 + set tchars "" + set echars "" + set parts [list] + set i 0 + foreach ch $chars { + if {!$in_placeholder} { + set nextch [lindex $chars [expr {$i+1}]] + if {"$ch$nextch" eq "\$\{"} { + set in_placeholder 2 ;#2 to signify we just entered placeholder + lappend parts $tchars + set tchars "" + } else { + append tchars $ch + } + } else { + if {$ch eq "\}"} { + if {[tcl::info::complete $echars]} { + set in_placeholder 0 + lappend parts $echars + set echars "" + } else { + append echars $ch + } + } else { + if {$in_placeholder == 2} { + #skip opening bracket + set in_placeholder 1 + } else { + append echars $ch + } + } + } + incr i + } + if {$tchars ne ""} { + lappend parts $tchars + } + if {[llength $parts] % 2 == 0} { + #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list + lappend parts "" + } + return $parts + } + #based on punk::ansi::ta::_perlish_split + proc _tstr_split {text} { + if {$text eq ""} { + return {} + } + set list [list] + set start 0 + #ideally re should allow curlies within but we will probably need a custom parser to do it + #(js allows nested string interpolation) + #set re {\$\{[^\}]*\}} + set re {\$\{(?:(?!\$\{).)*\}} + + #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + puts "e:$matchEnd < s:$matchStart" + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] + incr start + if {$start >= [tcl::string::length $text]} { + break + } + continue + } + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] + set start [expr {$matchEnd+1}] + #? + if {$start >= [tcl::string::length $text]} { + break + } + } + return [lappend list [tcl::string::range $text $start end]] + } #*** !doctools @@ -2216,7 +2984,21 @@ tcl::namespace::eval punk::args::lib { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#usually we would directly call arg definitions near the defining proc, +# so that the proc could directly use the definition in its parsing. +# +#for punk::args we need to make sure the punk::args namespace is fully loaded before calling, so we do it at the end. +#arguably it may be more processor-cache-efficient to do together like this anyway. + +#can't do this - as there is circular dependency with punk::lib +#tcl::namespace::eval punk::args { +# foreach deflist $PUNKARGS { +# punk::args::definition {*}$deflist +# } +# set PUNKARGS "" +#} +lappend ::punk::args::register::NAMESPACES ::punk::args ::punk::args::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -2226,12 +3008,40 @@ tcl::namespace::eval punk::args::system { #[subsection {Namespace punk::args::system}] #[para] Internal functions that are not part of the API + #dict get value with default wrapper for tcl 8.6 + if {[info commands ::tcl::dict::getdef] eq ""} { + #package require punk::lib + #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef + proc Dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::args::system::Dict_getdef "" ::tcl::dict::getdef + } + #name to reflect maintenance - home is punk::lib::ldiff + proc punklib_ldiff {fromlist removeitems} { + if {[llength $removeitems] == 0} {return $fromlist} + set result {} + foreach item $fromlist { + if {$item ni $removeitems} { + lappend result $item + } + } + return $result + } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { + tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version set version 999999.0a1.0 diff --git a/src/modules/punk/args/tclcore-999999.0a1.0.tm b/src/modules/punk/args/tclcore-999999.0a1.0.tm new file mode 100644 index 00000000..7728f056 --- /dev/null +++ b/src/modules/punk/args/tclcore-999999.0a1.0.tm @@ -0,0 +1,700 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: punkshell/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 punk::args::tclcore 999999.0a1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin punkshell_module_punk::args::tclcore 0 999999.0a1.0] +#[copyright "2025"] +#[titledesc {punk::args definitions for tcl core commands}] [comment {-- Name section and table of contents description --}] +#[moddesc {tcl core argument definitions}] [comment {-- Description at end of page heading --}] +#[require punk::args::tclcore] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::args::tclcore +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::args::tclcore +#[list_begin itemized] + +package require Tcl 8.6- +package require punk::args +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::args::tclcore::class { + #*** !doctools + #[subsection {Namespace punk::args::tclcore::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::tclcore { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #for tcllib - we can potentially parse the doctools to get this info. + #for tcl core commands - the data is stored in man pages - which are not so easy to parse. + #todo - link to man pages + + + #TODO - + #if we want colour in arg definitions -we need to respect nocolor or change colour to off/ on + #If color included in a definition - it will need to be reloaded when colour toggled(?) + #if {[catch {package require punk::ansi}]} { + # set has_punkansi 0 + # set A_WARN "" + # set A_RST "" + #} else { + # set has_punkansi 1 + # set A_WARN [a+ red] + # set A_RST "\x1b\[0m" + #} + + #we can't just strip ansi as there are non colour codes such as hyperlink that should be maintained whether color is on or off. + #for now we can use reverse - (like underline, is a non-colour attribute that remains effective when color off in punk::ansi) + set A_WARN \x1b\[7m + set A_RST \x1b\[0m + + variable manbase_tcl + variable manbase_ext + set patch [info patchlevel] + lassign [split $patch .] major + if {$major < 9} { + set manbase_tcl "https://tcl.tk/man/tcl/TclCmd" + set manbase_ext .htm + } else { + set manbase_tcl "https://tcl.tk/man/tcl9.0/TclCmd" + set manbase_ext .html + } + proc manpage_tcl {cmd} { + variable manbase_tcl + variable manbase_ext + return ${manbase_tcl}/${cmd}${manbase_ext} + } + + variable PUNKARGS + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + # library commands loaded via auto_index + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + *id parray + *proc -name "Builtin: parray" -help\ + "Prints on standard output the names and values of all the elements in the + array arrayName, or just the names that match pattern (using the matching + rules of string_match) and their values if pattern is given. + ArrayName must be an array accessible to the caller of parray. It may either + be local or global. The result of this command is the empty string. + (loaded via auto_index)" + *values -min 1 -max 2 + arrayName -type string -help\ + "variable name of an array" + pattern -type string -optional 1 -help\ + "Match pattern possibly containing glob characters" + } "*doc -name Manpage: -url [manpage_tcl library]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + + lappend PUNKARGS [list { + *id time + *proc -name "Builtin: time" -help\ + "Calls the Tcl interpreter count times to evaluate script + (or once if count is not specified). It will then return + a string of the form + 503.2 microseconds per iteration + which indicates the average amount of time required per + iteration, in microseconds. Time is measured in elapsed + time, not CPU time. + (see also: timerate)" + *values -min 1 -max 2 + script -type script + count -type integer -default 1 -optional 1 + } "*doc -name Manpage: -url [manpage_tcl time]" ] + + lappend PUNKARGS [list { + *id tcl::namespace::path + *proc -name "Builtin: tcl::namespace::path" -help\ + "Returns the command resolution path of the current namespace. + If namespaceList is specified as a list of named namespaces, the current + namespace's command resolution path is set to those namespaces and returns + the empty list. The default command resolution path is always empty. + See the section NAME_RESOLUTION in the manpage for an explanation of the + rules regarding name resolution." + *values -min 0 -max 1 + namespaceList -type list -optional 1 -help\ + "List of existing namespaces" + } "*doc -name Manpage: -url [manpage_tcl namespace]" ] + + lappend PUNKARGS [list { + *id tcl::namespace::unknown + *proc -name "Builtin: tcl::namespace::unknown" -help\ + "Sets or returns the unknown command handler for the current namespace. + The handler is invoked when a command called from within the namespace cannot + be found in the current namespace, the namespace's path nor in the global + namespace. + " + *values -min 0 -max 1 + script -type script -optional 1 -help\ + "A well formed list representing a command name and " + } "*doc -name Manpage: -url [manpage_tcl namespace]" ] + + lappend PUNKARGS [list { + *id lappend + *proc -name "builtin: lappend" -help\ + "Append list elements onto a variable. + " + *values -min 1 -max -1 + varName -type string -help\ + "variable name" + value -type any -optional 1 -multiple 1 + } "*doc -name Manpage: -url [manpage_tcl lappend]"] + + punk::args::definition { + *id ledit + *proc -name "builtin: ledit" -help\ + "Replace elements of a list stored in variable + " + *values -min 3 -max -1 + listVar -type string -help\ + "Existing list variable name" + first -type indexexpression + last -type indexexpression + value -type any -optional 1 -multiple 1 + } "*doc -name Manpage: -url [manpage_tcl ledit]" + + punk::args::definition { + *id lpop + *proc -name "builtin: lpop" -help\ + "Get and remove an element in a list + " + *values -min 1 -max -1 + varName -type string -help\ + "Existing list variable name" + index -type indexexpression -default end -optional 1 -multiple 1 -help\ + "When presented with a single index, the lpop command addresses + the index'th element in it, removes it from the list and returns + the element. + If index is negative or greater or equal than the number of + elements in the list in the variable called varName, an error occurs. + If addition index arguments are supplied, then each argument is used + in turn to address an element within a sublist designated by the + previous indexing operation, allowing the script to remove elements + in sublists, similar to lindex and lset." + } "*doc -name Manpage: -url [manpage_tcl lpop]" + + punk::args::definition { + *id lrange + *proc -name "builtin: lrange" -help\ + "return one or more adjacent elements from a list. + The new list returned consists of elements first through last, inclusive. + The index values first and last are interpreted the same as index values + for the command 'string index', supporting simple index arithmetic and + indices relative to the end of the list. + e.g lrange {a b c} 0 end-1 + " + *values -min 3 -max 3 + list -type list -help\ + "tcl list as a value" + first -help\ + "index expression for first element" + last -help\ + "index expression for last element" + } "*doc -name Manpage: -url [manpage_tcl lrange]" + + + punk::args::definition { + *id tcl::string::cat + + *proc -name "builtin: tcl::string::cat" -help\ + "Concatente the given strings just like placing them directly next to each other and + return the resulting compound string. If no strings are present, the result is an + empty string. + This primitive is occasionally handier than juxtaposition of strings when mixed quoting + is wanted, or when the aim is to return the result of a concatentation without resorting + to return -level 0, and is more efficient than building a list of arguments and using + join with an empty join string." + + *values -min 0 -max -1 + string -type string -optional 1 -multiple 1 + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::compare + + *proc -name "builtin: tcl::string::compare" -help\ + "Perform a character-by-character comparison of strings string1 and string2. + Returns -1, 0, or 1, dpending on whether string1 is lexicographically + lessthan, equal to, or greater than string2" + + -nocase -type none -help\ + "If -nocase is specified, then the strings are compared in a case insensitive manner." + + -length -type integer -help\ + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." + + *values -min 2 -max 2 + string1 -type string + string2 -type string + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::equal + + *proc -name "builtin: tcl::string::equal" -help\ + "Perform a character-by-character comparison of strings string1 and string2. + Returns 1 if string1 and string2 are identical, or 0 when not." + + -nocase -type none -help\ + "If -nocase is specified, then the strings are compared in a case insensitive manner." + + -length -type integer -help\ + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." + + *values -min 2 -max 2 + string1 -type string + string2 -type string + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::first + *proc -name "builtin: tcl::string::first" -help\ + "Search haystackString for a sequence of characters that exactly match the characters + in needleString. If found, return the index of the first character in the first such + match within haystackString. If there is no match, then return -1. If startIndex is + specified (in any of the forms described in STRING_INDICES), then the search is + constrained to start with the character in haystackString specified by the index. + " + *values -min 2 -max 3 + needleString -type string + haystackString -type string + startIndex -type indexexpression -optional 1 -help\ + "integer or simple expression." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::insert + *proc -name "builtin: tcl::string::insert" -help\ + "Returns a copy of string with insertString inserted at the index'th character. + If index is start-relative, the first character inserted in the returned string will be + at the specified index. + If index is end-relative, the last character inserted in the returned string will be + at the specified index. + if index is at or before the start of string (e.g., index is 0), insertString is + prepended to the string. + If index is at or after the end of the string (e.g., index is end), insertString is + appended to string." + + *values -min 3 -max 3 + string -type string + index -type indexexpression -help\ + "The index may be specified as described in the STRING_INDICES section" + insertString -type string + } "*doc -name Manpage: -url [manpage_tcl string]" + + + punk::args::definition { + *id tcl::string::last + *proc -name "builtin: tcl::string::last" -help\ + "Search haystackString for a sequence of characters that exactly match the characters + in needleString. If found, return the index of the first character in the last such + match within haystackString. If there is no match, then return -1. If lastIndex is + specified (in any of the forms described in STRING_INDICES), then only the characters + in haystackString at or before the specified lastIndex will be considered by the search + " + *values -min 2 -max 3 + needleString -type string + haystackString -type string + lastIndex -type indexexpression -optional 1 -help\ + "integer or simple expression." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::repeat + *proc -name "builtin: tcl::string::repeat" -help\ + "Returns a string consisting of string concatenated with itself count times." + *values -min 2 -max 2 + string -type string + count -type int -help\ + "If count is 0, the empty string will be returned." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::replace + *proc -name "builtin: tcl::string::replace" -help\ + "Removes a range of consecutive characters from string, starting with the character whose + index is first and ending with the character whose index is last + (Using the forms described in STRING_INDICES). An index of 0 refers to the first + character of the string. First and last may be specified as for the index method. + If first is less than zero then it is treated as if it were zero, and if last is + greater than or equal to the length of the string then it is treated as if it were + end. The initial string is returned untouched, if first is greater than last, or if + first is equal to or greater than the length of the inital string, or last is less + than 0." + *values -min 3 -max 3 + string -type string + first -type indexexpression + last -type indexexpression + newstring -type string -optional 1 -help\ + "If newstring is specified, then it is placed in the removed character range." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::totitle + *proc -name "builtin: tcl::string::totitle" -help\ + "Returns a value equal to string except that the first character in string is converted to + it's Unicode title case variant (or upper case if there is no title case variant) and the + rest of the string is converted to lower case." + + *values -min 1 -max 1 + string -type string + first -type indexexpression -optional 1 -help\ + "If first is specified, it refers to the first char index in the string to start modifying." + last -type indexexpression -optional 1 -help\ + "If last is specified, it refers to the char index in the string to stop at (inclusive)." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::wordend + *proc -name "builtin: tcl::string::wordend" -help\ + "Returns the index of the character just after the last one in the word containing + character charIndex of string. + A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) + or underscore (Unicode connector punctuation) characters, or any single character other than these." + *values -min 2 -max 2 + string -type string + charIndex -type indexexpression -help\ + "integer or simple expresssion. + e.g end + e.g end-1 + e.g M+N" + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::wordstart + *proc -name "builtin: tcl::string::wordstart" -help\ + "Returns the index of the first character in the word containing + character charIndex of string. + A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) + or underscore (Unicode connector punctuation) characters, or any single character other than these. + " + *values -min 2 -max 2 + string -type string + charIndex -type indexexpression -help\ + "integer or simple expresssion. + e.g end + e.g end-1 + e.g M+N" + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition [punk::lib::tstr -return string { + *id tcl::string::is + *proc -name "builtin: tcl::string::is" -help\ + "Returns 1 if string is a valid member of the specified character class, otherwise returns 0. + " + *leaders -min 1 -max 1 + class -type string\ + -choices { + alnum + alpha + ascii + boolean + control + dict + digit + double + entier + false + graph + integer + list + lower + print + punct + space + true + upper + wideinteger + wordchar + xdigit + }\ + -choicelabels { + alnum\ + " Any Unicode alphabet + or digit character" + alpha\ + " Any Unicode alphabet + character" + ascii\ + " Any character with + a value less than \\u0080 + (those that are in the + 7-bit ascii range)" + boolean\ + " Any of the forms allowed + to Tcl_GetBoolean" + control\ + " Any Unicode control char" + dict\ + " Any proper dict structure, + with optional surrounding + whitespace. In case of + improper dict structure, 0 + is returned and the varname + will contain the index of + the \"element\" where the + dict parsing fails or -1 if + this cannot be determined." + digit\ + " Any Unicode digit char. + Note that this includes + chars outside of the \[0-9\] + range." + double\ + " Any of the forms allowed + to Tcl_GetDoubleFromObj. + ${$A_WARN}With optional surrounding${$A_RST} + ${$A_WARN}whitespace.${$A_RST}" + entier\ + " Synonym for integer" + false\ + " Any of the forms allowed + to Tcl_GetBoolean where the + value is false" + graph\ + " Any Unicode printing char + except space." + integer\ + " Any of the valid string + formats for an integer value + of arbitrary size in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. The formats + accepted are exactly those + accepted by the C routine + Tcl_GetBignumFromObj." + list\ + " Any proper list structure, + with optional surrounding + whitespace. In case of + improper list structure, 0 + is returned and the varname + will contain the index of + the \"element\" where list + parsing fails, or -1 if + this cannot be determined" + lower\ + " Any Unicode lower case + alphabet character" + print\ + " Any Unicode printing + character, including space" + punct\ + " Any Unicode punctuation + character." + space\ + " Any Unicode whitespace + character, mongolian vowel + separator (U+180e), + zero width space (U+200b), + word joiner (U+2060) or + zero width no-break space + (U+feff) (=BOM)" + true\ + " Any of the forms allowed + to Tcl_GetBoolean where the + value is true" + upper\ + " Any upper case alphabet + character in the Unicode + character set" + wideinteger\ + " Any of the valid forms + for a wide integer in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. In case of + overflow in the value, 0 is + returned and the varname + will contain -1." + wordchar\ + " Any Unicode word char. + That is any alphanumeric + character, and any + Unicode connector + punctuation characters + (e.g. underscore)" + xdigit\ + " Any hexadecimal digit + character, and any Unicode + connector punctuation + characters (e.g. underscore)" + + }\ + -help\ + "character class + In the case of boolean, true and false, if the function will return 0, then the + varname will always be set to 0, due to the varied nature of a valid boolean value" + + -strict -type none -help\ + "If -strictis specified, then an empty string returns 0, + otherwise an empty string will return 1 on any class" + -failindex -type variablename -help\ + "If -failindex is specified, then if the function returns 0, + the index in the string where the class was no longer valid will be stored + in the variable named." + *values -min 1 -max 1 + string -type string -optional 0 + }] "*doc -name Manpage: -url [manpage_tcl string]" + + if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } + } + lappend ::punk::args::register::NAMESPACES ::punk::args::tclcore + + #*** !doctools + #[subsection {Namespace punk::args::tclcore}] + #[para] Core API functions for punk::args::tclcore + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::tclcore ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::tclcore::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::args::tclcore::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::tclcore::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::args::tclcore::system { + #*** !doctools + #[subsection {Namespace punk::args::tclcore::system}] + #[para] Internal functions that are not part of the API + + + +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::args::tclcore [tcl::namespace::eval punk::args::tclcore { + variable pkg punk::args::tclcore + variable version + set version 999999.0a1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/modules/punk/args/tclcore-buildversion.txt b/src/modules/punk/args/tclcore-buildversion.txt new file mode 100644 index 00000000..f47d01c8 --- /dev/null +++ b/src/modules/punk/args/tclcore-buildversion.txt @@ -0,0 +1,3 @@ +0.1.0 +#First line must be a semantic version number +#all other lines are ignored. diff --git a/src/modules/punk/blockletter-999999.0a1.0.tm b/src/modules/punk/blockletter-999999.0a1.0.tm index 6f06aa8a..cf9a4f02 100644 --- a/src/modules/punk/blockletter-999999.0a1.0.tm +++ b/src/modules/punk/blockletter-999999.0a1.0.tm @@ -119,17 +119,18 @@ tcl::namespace::eval punk::blockletter { set logo_letter_colours [list Web-red Web-green Web-royalblue Web-purple Web-orange] set logo_letter_colours [list Red Green Blue Purple Yellow] - + punk::args::definition [tstr -return string { + *id punk::blockletter::logo + -frametype -default {${$default_frametype}} + -outlinecolour -default "web-white" + -backgroundcolour -default {} -help "e.g Web-white + This argument is the name as accepted by punk::ansi::a+" + *values -min 0 -max 0 + }] proc logo {args} { variable logo_letter_colours variable default_frametype - set argd [punk::args::get_dict [tstr -return string { - -frametype -default {${$default_frametype}} - -outlinecolour -default "web-white" - -backgroundcolour -default {} -help "e.g Web-white - This argument is the name as accepted by punk::ansi::a+" - *values -min 0 -max 0 - }] $args] + set argd [punk::args::get_by_id punk::blockletter::logo $args] set f [dict get $argd opts -frametype] set bd [dict get $argd opts -outlinecolour] set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary @@ -217,17 +218,18 @@ tcl::namespace::eval punk::blockletter { append out [textblock::join_basic -- $left $centre $right] } + punk::args::definition [tstr -return string { + *id punk::blockletter::text + -bgcolour -default "Web-red" + -bordercolour -default "web-white" + -frametype -default {${$default_frametype}} + *values -min 1 -max 1 + str -help "Text to convert to blockletters + Requires terminal font to support relevant block characters" + " + }] proc text {args} { - variable default_frametype - set argd [punk::args::get_dict [tstr -return string { - -bgcolour -default "Web-red" - -bordercolour -default "web-white" - -frametype -default {${$default_frametype}} - *values -min 1 -max 1 - str -help "Text to convert to blockletters - Requires terminal font to support relevant block characters" - " - }] $args] + set argd [punk::args::get_by_id punk::blockletter::text $args] set opts [dict get $argd opts] set str [dict get $argd values str] set str [string map {\r\n \n} $str] @@ -277,16 +279,19 @@ tcl::namespace::eval punk::blockletter::lib { # return 1 #} + + punk::args::definition [tstr -return string { + *id punk::blockletter::block + -height -default 2 + -width -default 4 + -frametype -default {${$::punk::blockletter::default_frametype}} + -bgcolour -default "Web-red" + -bordercolour -default "web-white" + *values -min 0 -max 0 + }] proc block {args} { upvar ::punk::blockletter::default_frametype ft - set argd [punk::args::get_dict [tstr -return string { - -height -default 2 - -width -default 4 - -frametype -default {${$ft}} - -bgcolour -default "Web-red" - -bordercolour -default "web-white" - *values -min 0 -max 0 - }] $args] + set argd [punk::args::get_by_id punk::blockletter::block $args] set bg [dict get $argd opts -bgcolour] set bd [dict get $argd opts -bordercolour] set h [dict get $argd opts -height] diff --git a/src/modules/punk/config-0.1.tm b/src/modules/punk/config-0.1.tm index 1e4de9ec..493ea5aa 100644 --- a/src/modules/punk/config-0.1.tm +++ b/src/modules/punk/config-0.1.tm @@ -361,11 +361,14 @@ tcl::namespace::eval punk::config { } proc configure {args} { - set argd [punk::args::get_dict { + set argdef { + *id punk::config::configure + *proc -name punk::config::configure -help\ + "UNIMPLEMENTED" *values -min 1 -max 1 whichconfig -type string -choices {startup running stop} - } $args] - + } + set argd [punk::args::get_dict $argdef $args] return "unimplemented - $argd" } @@ -375,6 +378,8 @@ tcl::namespace::eval punk::config { return [punk::lib::showdict $configdata] } + + #e.g # copy running-config startup-config # copy startup-config test-config.cfg @@ -382,16 +387,22 @@ tcl::namespace::eval punk::config { #review - consider the merge vs overwrite feature of some routers.. where copy to running-config does a merge rather than an overwrite #This is to allow partial configs to be loaded to running, whereas a save of running to any target is always a complete configuration proc copy {args} { - set argd [punk::args::get_dict { - *proc -name punk::config::copy -help "Copy a partial or full configuration from one config to another - If a target config has additional settings, then the source config can be considered to be partial with regards to the target. - " - -type -default "" -choices {replace merge} -help "Defaults to merge when target is running-config - Defaults to replace when source is running-config" + set argdef { + *id punk::config::copy + *proc -name punk::config::copy -help\ + "Copy a partial or full configuration from one config to another + If a target config has additional settings, then the source config can be considered to be partial with regards to the target. + " + -type -default "" -choices {replace merge} -help\ + "Defaults to merge when target is running-config + Defaults to replace when source is running-config" *values -min 2 -max 2 - fromconfig -help "running or startup or file name (not fully implemented)" - toconfig -help "running or startup or file name (not fully implemented)" - } $args] + fromconfig -help\ + "running or startup or file name (not fully implemented)" + toconfig -help\ + "running or startup or file name (not fully implemented)" + } + set argd [punk::args::get_dict $argdef $args] set fromconfig [dict get $argd values fromconfig] set toconfig [dict get $argd values toconfig] set fromconfig [string map {-config ""} $fromconfig] diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 96d7e9ac..b52f7381 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -81,6 +81,8 @@ namespace eval punk::console { #*** !doctools #[list_begin definitions] + variable PUNKARGS + variable tabwidth 8 ;#default only - will attempt to detect and set to that configured in terminal #Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently #e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops. @@ -1187,7 +1189,8 @@ namespace eval punk::console { *id punk::console::cell_size -inoutchannels -default {stdin stdout} -type list *values -min 0 -max 1 - newsize -default "" + newsize -default "" -help\ + "character cell pixel dimensions WxH" } proc cell_size {args} { set argd [punk::args::get_by_id punk::console::cell_size $args] diff --git a/src/modules/punk/fileline-999999.0a1.0.tm b/src/modules/punk/fileline-999999.0a1.0.tm index d1042cea..a1df3a31 100644 --- a/src/modules/punk/fileline-999999.0a1.0.tm +++ b/src/modules/punk/fileline-999999.0a1.0.tm @@ -1251,6 +1251,16 @@ namespace eval punk::fileline { #[para] Core API functions for punk::fileline #[list_begin definitions] + punk::args::definition { + *id punk::fileline::get_textinfo + *proc -name punk::fileline::get_textinfo -help\ + "return: textinfo object instance" + -file -default {} -type existingfile + -translation -default iso8859-1 + -encoding -default "\uFFFF" + -includebom -default 0 + *values -min 0 -max 1 + } proc get_textinfo {args} { #*** !doctools #[call get_textinfo [opt {option value...}] [opt datachunk]] @@ -1266,14 +1276,7 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes. - set argument_specification { - -file -default {} -type existingfile - -translation -default iso8859-1 - -encoding -default "\uFFFF" - -includebom -default 0 - *values -min 0 -max 1 - } - lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values + lassign [dict values [punk::args::get_by_id punk::fileline::get_textinfo $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index b5a8356d..242531c8 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -48,8 +48,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -140,7 +142,7 @@ tcl::namespace::eval punk::lib::check { proc has_tclbug_lsearch_strideallinline {} { #bug only occurs with single -index value combined with -stride -all -inline -subindices #https://core.tcl-lang.org/tcl/tktview/5a1aaa201d - if {[catch {[lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *]} result]} { + if {[catch {lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *} result]} { #we aren't looking for an error result - error most likely indicates tcl too old to support -stride return 0 } @@ -320,7 +322,7 @@ tcl::namespace::eval punk::lib::compat { if {"::lmap" ne [info commands ::lmap]} { #puts stderr "Warning - no built-in lpop" - interp alias {} lpop {} ::punk::lib::compat::lmaptcl + interp alias {} lmap {} ::punk::lib::compat::lmaptcl } #lmap came in Tcl 8.6 - so probably not much need for a tcl forward compatibility version - but here it is anyway proc lmaptcl {varnames list script} { @@ -384,6 +386,7 @@ tcl::namespace::eval punk::lib::compat { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::lib { + variable PUNKARGS tcl::namespace::export * variable has_struct_list set has_struct_list [expr {![catch {package require struct::list}]}] @@ -956,172 +959,9 @@ namespace eval punk::lib { proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a] } - #experiment with equiv of js template literals with ${expression} in templates - #e.g tstr {This is the value of x in calling scope ${$x} !} - #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} - #e.g tstr -allowcommands {This is the value of [lindex $x 0] in calling scope ${[lindex [set x] 0]} !} - proc tstr {args} { - set argd [punk::args::get_dict { - *proc -name punk::lib::tstr -help "A rough equivalent of js template literals" - -allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}" - -return -default list -choices {dict list string} - *values -min 1 -max 1 - templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true" - } $args] - set templatestring [dict get $argd values templatestring] - set opt_allowcommands [dict get $argd opts -allowcommands] - set opt_return [dict get $argd opts -return] - set nocommands "-nocommands" - if {$opt_allowcommands == 1} { - set nocommands "" - } - - #set parts [_tstr_split $templatestring] - set parts [_parse_tstr_parts $templatestring] - set textchunks [list] - #set expressions [list] - set params [list] - set idx 0 - foreach {pt expression} $parts { - lappend textchunks $pt - incr idx ;#pt incr - - #ignore last expression - if {$idx == [llength $parts]} { - break - } - #lappend expressions $expression - lappend params [uplevel 1 [list subst {*}$nocommands $expression]] - - incr idx ;#expression incr - } - switch -- $opt_return { - dict { - return [dict create template $textchunks params $params] - } - list { - return [list $textchunks {*}$params] - } - string { - set out "" - foreach pt $textchunks param $params { - append out $pt $param - } - return $out - } - default { - } - } - } - #test single placeholder tstr args where single placeholder must be an int - proc tstr_test_one {args} { - set argd [punk::args::get_dict { - *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. - example: - set id 2 - tstr_test_one {*}[Tstr {Select * from table where id = ${$id} and etc... ;}] - } - - *values -min 2 -max 2 - template -type list -minlen 2 -maxlen 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - - but the Tstr method above does this for you, and also passes in the id automatically" - - where -type int -help {Integer param for where clause. Tstr mechanism above will pass the id as the second parameter} - } $args] - set template [dict get $argd values template] - set where [dict get $argd values where] - set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] - return $result - } - proc _parse_tstr_parts {templatestring} { - if {$templatestring eq ""} { - return [list] - } - set chars [split $templatestring ""] - set in_placeholder 0 - set tchars "" - set echars "" - set parts [list] - set i 0 - foreach ch $chars { - if {!$in_placeholder} { - set nextch [lindex $chars [expr {$i+1}]] - if {"$ch$nextch" eq "\$\{"} { - set in_placeholder 2 ;#2 to signify we just entered placeholder - lappend parts $tchars - set tchars "" - } else { - append tchars $ch - } - } else { - if {$ch eq "\}"} { - if {[tcl::info::complete $echars]} { - set in_placeholder 0 - lappend parts $echars - set echars "" - } else { - append echars $ch - } - } else { - if {$in_placeholder == 2} { - #skip opening bracket - set in_placeholder 1 - } else { - append echars $ch - } - } - } - incr i - } - if {$tchars ne ""} { - lappend parts $tchars - } - if {[llength $parts] % 2 == 0} { - #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list - lappend parts "" - } - return $parts - } - #based on punk::ansi::ta::_perlish_split - proc _tstr_split {text} { - if {$text eq ""} { - return {} - } - set list [list] - set start 0 - #ideally re should allow curlies within but we will probably need a custom parser to do it - #(js allows nested string interpolation) - #set re {\$\{[^\}]*\}} - set re {\$\{(?:(?!\$\{).)*\}} - - #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code - - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - puts "e:$matchEnd < s:$matchStart" - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - if {$start >= [tcl::string::length $text]} { - break - } - continue - } - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] - set start [expr {$matchEnd+1}] - #? - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } - + + namespace import ::punk::args::lib::tstr + #get info about punk nestindex key ie type: list,dict,undetermined proc nestindex_info {args} { set argd [punk::args::get_dict { @@ -1184,8 +1024,11 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=[punk::ansi::a] " } set argspec [string map [list %sep% $sep] { - *proc -name pdict -help {Print dict keys,values to channel - (see also showdict)} + *id punk::lib::pdict + *proc -name pdict -help\ + "Print dict keys,values to channel + The pdict function operates on variable names - passing the value to the showdict function which operates on values + (see also showdict)" *opts -any 1 @@ -1222,7 +1065,6 @@ namespace eval punk::lib { The second level segement in each pattern switches to a dict operation to retrieve the value by key. When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - The pdict function operates on variable names - passing the value to the showdict function which operates on values } }] #puts stderr "$argspec" @@ -1282,7 +1124,7 @@ namespace eval punk::lib { -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {${$key}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} *values -min 1 -max -1 @@ -1295,6 +1137,7 @@ namespace eval punk::lib { set opt_keysortdirection [dict get $argd opts -keysortdirection] set opt_trimright [dict get $argd opts -trimright] set opt_keytemplates [dict get $argd opts -keytemplates] + puts stderr "---> $opt_keytemplates <---" set opt_ansibase_keys [dict get $argd opts -ansibase_keys] set opt_ansibase_values [dict get $argd opts -ansibase_values] set opt_return [dict get $argd opts -return] @@ -4272,6 +4115,13 @@ tcl::namespace::eval punk::lib::system { #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::system ---}] } + +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } +} +lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm index 718d358c..dcac02a1 100644 --- a/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/layout-999999.0a1.0.tm @@ -35,7 +35,7 @@ namespace eval punk::mix::commandset::layout { proc files {{layout ""}} { set argd [punk::args::get_dict { *values -min 1 -max 1 - layout -type string -minlen 1 + layout -type string -minsize 1 } [list $layout]] set allfiles [lib::layout_all_files $layout] diff --git a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm index 09ca2d70..56cb8f03 100644 --- a/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/loadedlib-999999.0a1.0.tm @@ -26,19 +26,21 @@ package require punk::lib namespace eval punk::mix::commandset::loadedlib { namespace export * #search automatically wrapped in * * - can contain inner * ? globs - proc search {args} { - set argspecs { - *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" - -return -type string -default table -choices {table tableobject list lines} - -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help "(unimplemented) Display only those that are 0:absent 1:present 2:both" - -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" - -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" - searchstrings -default * -multiple 1 -help "Names to search for, may contain glob chars (* ?) e.g *lib* + punk::args::definition { + *id punk::mix::commandset::loadedlib::search + *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + -return -type string -default table -choices {table tableobject list lines} + -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ + "(unimplemented) Display only those that are 0:absent 1:present 2:both" + -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" + -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" + searchstrings -default * -multiple 1 -help\ + "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. - eg name -> *name* - " - } - set argd [punk::args::get_dict $argspecs $args] + eg name -> *name*" + } + proc search {args} { + set argd [punk::args::get_by_id punk::mix::commandset::loadedlib::search $args] set searchstrings [dict get $argd values searchstrings] set opts [dict get $argd opts] set opt_return [dict get $opts -return] diff --git a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm index 66f87868..714de1e4 100644 --- a/src/modules/punk/mix/commandset/module-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/module-999999.0a1.0.tm @@ -137,23 +137,39 @@ namespace eval punk::mix::commandset::module { put stderr "get_template_basefolders WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } } + + + set moduletypes [punk::mix::cli::lib::module_types] + punk::args::definition [subst { + *id punk::mix::commandset::module::new + *proc -name "punk::mix::commandset::module::new" -help\ + "Create a new module file in the appropriate folder within src/modules. + If the name given in the module argument is namespaced, + the necessary subfolder(s) will be used or created." + -project -optional 1 + -version -default "0.1.0" -help\ + "version to use if not specified as part of the module argument. + If a version is specified in the module argument as well as in -version + the higher version number will be used. + " + -license -default + -template -default punk.module + -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} + -force -default 0 -type boolean -help\ + "If set true, will overwrite an existing .tm file if there is one. + If false (default) an error will be raised if there is a conflict." + -quiet -default 0 -type boolean -help\ + "Suppress information messages on stdout" + *values -min 1 -max 1 + module -type string -help\ + "Name of module, possibly including a namespace and/or version number + e.g mynamespace::mymodule-1.0" + }] proc new {args} { set year [clock format [clock seconds] -format %Y] - set moduletypes [punk::mix::cli::lib::module_types] # use \uFFFD because unicode replacement char should consistently render as 1 wide - set argspecs [subst { - -project -default \uFFFD - -version -default \uFFFD - -license -default - -template -default punk.module - -type -default \uFFFD -choices {$moduletypes} - -force -default 0 -type boolean - -quiet -default 0 -type boolean - *values -min 1 -max 1 - module -type string - }] - set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::mix::commandset::module::new $args] + lassign [dict values $argd] leaders opts values received set module [dict get $values module] #set opts [dict merge $defaults $args] @@ -168,13 +184,9 @@ namespace eval punk::mix::commandset::module { # we need this value before looking at the named argument # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_version_supplied [dict get $opts -version] - if {$opt_version_supplied eq "\uFFFD"} { - set opt_version "0.1.0" - } else { - set opt_version $opt_version_supplied - if {![util::is_valid_tm_version $opt_version]} { - error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" - } + set opt_version $opt_version_supplied + if {![util::is_valid_tm_version $opt_version]} { + error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #named argument @@ -194,7 +206,7 @@ namespace eval punk::mix::commandset::module { } else { set vmsg "from -version option: $opt_version_supplied" } - if {$opt_version_supplied ne "\uFFFD"} { + if {"-version" in $received} { if {$vcompare_is_mversion_bigger != 0} { #is bigger or smaller puts stderr "module.new WARNING: version supplied in module argument as well as -version option. Using the higher version number $vmsg" @@ -231,7 +243,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #options # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_project [dict get $opts -project] set testdir [pwd] if {![string length [set projectdir [punk::repo::find_project $testdir]]]} { if {![string length [set projectdir [punk::repo::find_candidate $testdir]]]} { @@ -239,9 +250,10 @@ namespace eval punk::mix::commandset::module { error "module.new unable to create module in projectdir:$projectdir - directory doesn't appear to meet basic standards $msg" } } - if {$opt_project == "\uFFFF"} { + if {![dict exists $received -project]} { set projectname [file tail $projectdir] } else { + set opt_project [dict get $opts -project] set projectname $opt_project if {$projectname ne [file tail $projectdir]} { error "module.new -project '$opt_project' doesn't match detected projectname '$projectname' at path: $projectdir" @@ -309,12 +321,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_type [dict get $opts -type] - if {$opt_type eq "\uFFFD"} { - set opt_type [lindex [punk::mix::cli::lib::module_types] 0] ;#default to plain - } - if {$opt_type ni [punk::mix::cli::lib::module_types]} { - error "module.new - error - unknown -type '$opt_type' known-types: [punk::mix::cli::lib::module_types]" - } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_quiet [dict get $opts -quiet] set opt_force [dict get $opts -force] @@ -407,7 +413,7 @@ namespace eval punk::mix::commandset::module { set podfile $modulefolder/#modpod-$moduletail-$infile_version/$moduletail-$infile_version.tm set has_tm [file exists $tmfile] set has_pod [file exists $podfile] - if {$has_tm && $has_pos} { + if {$has_tm && $has_pod} { #invalid configuration - bomb out error "module.new error: Invalid target configuration found. module folder has both a .tm file $tmfile and a modpod file $podfile. Please delete one of them before trying again." } @@ -448,7 +454,7 @@ namespace eval punk::mix::commandset::module { } set buildversionfile [file join $modulefolder ${moduletail}-buildversion.txt] set existing_build_version "" - if {[file exists $buildversionfile]} { + if {!$opt_force && [file exists $buildversionfile]} { set buildversiondata [punk::mix::util::fcat $buildversionfile] set lines [split $buildversiondata \n] set existing_build_version [string trim [lindex $lines 0]] diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 4db394dc..21b5f4ce 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -28,7 +28,7 @@ tcl::namespace::eval ::punk::ns::evaluator { tcl::namespace::eval punk::ns { variable ns_current "::" variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns - namespace export nsjoin nsprefix nstail nsparts nseval nsimport_noclobber corp + namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp catch { package require debug debug define punk.ns.compile @@ -53,6 +53,8 @@ tcl::namespace::eval punk::ns { set nspathcommands 1 } + set ns_or_glob [string map {:::: ::} $ns_or_glob] + #todo - cooperate with repl? set out "" if {$ns_or_glob eq ""} { @@ -64,7 +66,7 @@ tcl::namespace::eval punk::ns { set has_globchars [regexp {[*?]} $ns_or_glob] if {$is_absolute} { if {!$has_globchars} { - if {![tcl::namespace::exists $ns_or_glob]} { + if {![nsexists $ns_or_glob]} { error "cannot change to namespace $ns_or_glob" } set ns_current $ns_or_glob @@ -77,7 +79,7 @@ tcl::namespace::eval punk::ns { } else { if {!$has_globchars} { set nsnext [nsjoin $ns_current $ns_or_glob] - if {![tcl::namespace::exists $nsnext]} { + if {![nsexists $nsnext]} { error "cannot change to namespace $ns_or_glob" } set ns_current $nsnext @@ -157,14 +159,28 @@ tcl::namespace::eval punk::ns { } #todo - walk up each ns - testing for possibly weirdly named namespaces - #review - do we even need it. + #needed to use n/ to change to an oddly named namespace such as ":x" proc nsexists {nspath} { - error "unimplemented" + if {$nspath eq ""} {return 0} + set parts [nsparts $nspath] + if {[lindex $parts 0] ne ""} { + #relative + set ns_caller [uplevel 1 {::namespace current}] + set fq_nspath [nsjoin $ns_caller $nspath] + } else { + set fq_nspath $nspath + } + if {[catch {nseval_ifexists $fq_nspath {}}]} { + return 0 + } else { + return 1 + } } #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal tcl::namespace::eval - but still only a few microseconds.. fine for repl introspection - proc nseval_script {location} { + #WARNING: creates namespaces if they don't exist + proc nseval_getscript {location} { set parts [nsparts $location] if {[lindex $parts 0] eq ""} { lset parts 0 :: @@ -214,21 +230,88 @@ tcl::namespace::eval punk::ns { #set cmd ::punk::pipecmds::nseval_$loc set cmd ::punk::ns::evaluator::eval-$loc if {$cmd ni [info commands $cmd]} { - append body \n [nseval_script $fqns] + append body \n [nseval_getscript $fqns] proc $cmd {script} $body debug.punk.ns.compile {proc $cmd} 2 } tailcall $cmd $script } - proc nschildren {fqns} { - if {![string match ::* $fqns]} { - error "nschildren only accepts a fully qualified namespace" + proc nseval_ifexists {ns script} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set nsfq [nsjoin $nscaller $ns] + } else { + set nsfq $ns + } + set ns_script [nseval_ifexists_getscript $nsfq] + uplevel 1 [list {*}$ns_script $script] + } + proc nseval_ifexists_getscript {location} { + set parts [nsparts $location] + if {[lindex $parts 0] eq ""} { + lset parts 0 :: + } + if {[lindex $parts end] eq ""} { + set parts [lrange $parts 0 end-1] + } + + set body "apply \{{script} \{eval \[string map \[list \$script\] \{" + set i 0 + set tails [lrepeat [llength $parts] ""] + foreach ns $parts { + set cmdlist [list ::punk::ns::eval_no_create $ns] + set t "" + if {$i > 0} { + append body " " + } + append body $cmdlist + if {$i == ([llength $parts] -1)} { + append body " {}" + } + if {$i > 0} { + set t {} + } + lset tails $i $t + incr i + } + append body [join [lreverse $tails] " "] + #puts stdout "tails: $tails" + #puts stdout "i: $i" + set body [string map [list "\{" "\}"] $body] + append body " \}\]\}\}" + return $body + } + proc eval_no_create {ns script} { + uplevel 1 [string map [list $ns $script] { + if {[::tcl::namespace::exists ]} { + ::tcl::namespace::eval {} + } else { + error "no such namespace " + } + }] + } + + + proc nschildren {ns} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set fqns [nsjoin $nscaller $ns] + } else { + set fqns $ns } + #if {![string match ::* $fqns]} { + # error "nschildren only accepts a fully qualified namespace" + #} set parent [nsprefix $fqns] set tail [nstail $fqns] #puts ">>> parent $parent tail $tail" #set nslist [nseval $parent [list ::namespace children $tail]] - set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + #set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + set nslist [nseval_ifexists $parent [list ::tcl::namespace::children $tail]] return [lsort $nslist] } @@ -356,7 +439,16 @@ tcl::namespace::eval punk::ns { set searchns [nsprefix $ns_absolute] ;#the ns within which we want to searchns set searchall [nsjoin $searchns *] ;#will correctly form ::* or ::childns::* - set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + set nsparts [nsparts $searchns] + set weird_ns 0 + if {[lsearch $nsparts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set rawresult [nseval_ifexists $searchns [list info vars]] + } else { + set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + } set matched_fullpath [list] foreach r $rawresult { lappend matched_fullpath [nstail $r] @@ -595,10 +687,21 @@ tcl::namespace::eval punk::ns { return $nslist } + variable usageinfo_char \U1f6c8 + # command has usageinfo e.g from punk::args. todo cmdline, argp, tepam etc? + proc Usageinfo_mark {{ansicodes \UFFEF}} { + variable usageinfo_char + if {$ansicodes eq ""} { + return $usageinfo_char + } elseif {$ansicodes eq "\UFFEF"} { + return " [a+ brightyellow]$usageinfo_char[a]" + } else { + return " [a+ {*}$ansicodes]$usageinfo_char[a]" + } + } #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ @@ -666,6 +769,7 @@ tcl::namespace::eval punk::ns { set interps [list] set coroutines [list] set zlibstreams [list] + set usageinfo [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -742,6 +846,7 @@ tcl::namespace::eval punk::ns { } } } + set usageinfo [dict get $contents usageinfo] } set numchildren [llength $children] @@ -859,7 +964,8 @@ tcl::namespace::eval punk::ns { set cmd_display [list $cmd] ;#wrap in list so empty command is visible (and distinguishable from for example a double-curly command) if {$cmd ni $commands && $cmd in $aliases } { #ordinary un-masked commandless-alias - set c [a+ red bold] + #(original alias name that has been renamed) + set c [a+ red bold strike] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] } else { @@ -869,7 +975,7 @@ tcl::namespace::eval punk::ns { #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias - #assertion member of masked - but we use seencmds instead to detect. + #assertion: member of masked - but we use seencmds instead to detect. set c [a+ yellow bold] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] @@ -901,13 +1007,20 @@ tcl::namespace::eval punk::ns { set prefix [overtype::right $prefix "-[a+ yellow bold]I[a+]"] } } - set cmd$i "${prefix} $c$cmd_display" - set c$i $c + if {$cmd in $usageinfo} { + set u [Usageinfo_mark brightgreen] + } else { + set u "" + } + set cmd$i "${prefix} $c$cmd_display$u" + #set c$i $c + set c$i "" lappend seencmds $cmd } } - lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + #lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + lappend displaylist $a1[overtype::left $col1 $ch1][a]$a1[overtype::left $col2 $ch2][a]$c1[overtype::left $col3 $cmd1][a]$c2[overtype::left $col4 $cmd2][a]$c3[overtype::left $col5 $cmd3][a]$c4$cmd4[a] } return [list_as_lines $displaylist] @@ -917,7 +1030,7 @@ tcl::namespace::eval punk::ns { if {$path_is_absolute} { return $nspath } - set ns_caller [uplevel 1 {::namespace current}] ;#must qualify. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) + set ns_caller [uplevel 1 {::namespace current}] ;#must qualify 'namespace' command. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) if {$nspath eq "\uFFFF"} { return $ns_caller } @@ -936,6 +1049,31 @@ tcl::namespace::eval punk::ns { return [nsjoin $base $nspath] } + set has_textblock [expr {![catch {package require textblock}]}] + + if {$has_textblock} { + interp alias "" ::punk::ns::Block_width "" textblock::width + } else { + #maint - equiv of textblock::width + proc Block_width {textblock} { + if {$textblock eq ""} { return 0 } + if {[tcl::string::last \t $textblock] >=0} { + if {[tcl::info::exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::ansistripraw $textblock] + } + if {[tcl::string::last \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } + return [punk::char::ansifreestring_width $textblock] + } + } proc nslist {{glob "*"} args} { set ns_absolute [uplevel 1 [list ::punk::ns::nspath_here_absolute $glob]] if {[dict exists $args -match]} { @@ -947,7 +1085,6 @@ tcl::namespace::eval punk::ns { -nspathcommands 0\ ] - package require textblock set opts [dict merge $defaults $args] # -- --- --- set opt_nspathcommands [dict get $opts -nspathcommands] @@ -971,11 +1108,11 @@ tcl::namespace::eval punk::ns { set block [get_nslist {*}$opts] #if {[string first \n $block] < 0} { # #single line - # set width [textblock::width [list $block]] + # set width [Block_width [list $block]] #} else { - # set width [textblock::width $block] + # set width [Block_width $block] #} - set width [textblock::width $block] + set width [Block_width $block] #if multiple results or if there is only 1 result - but we are path-globbing - then we need to show location if {$count_with_results > 1 || [regexp {[*?]} [nsprefix $ns_absolute]]} { @@ -998,7 +1135,7 @@ tcl::namespace::eval punk::ns { } } append output $path_text - set path_text_width [textblock::width $path_text] + set path_text_width [Block_width $path_text] append output \n [string repeat - [expr {max($width,$path_text_width)}]] } elseif {$count_with_results > 1 && $width > 0 } { append output \n [string repeat - $width] @@ -1014,9 +1151,44 @@ tcl::namespace::eval punk::ns { #info cmdtype available in 8.7+ #safe interps also seem to have it disabled for some reason + #we need to return "na" if 'info cmdtype' not supported or not functioning due to safe interp etc + #IMPORTANT: don't detect easy types such as proc/import here - caller needs the 'na' to do the proper fallback + #it is not desirable to do a partial cmdtype support here proc cmdtype {cmd} { + #set cmd [namespace which $cmd] ;#will return empty result for empty string command or command such as :x or any command that doesn't exist + set fqcmd [namespace which $cmd] ;#will resolve for example 'namespace path' reachable commands + if {$fqcmd eq ""} { + #e.g ::ns:::x will return empty result from namespace which even if :x is a command in ::ns + set where [nsprefix $cmd] + if {$where eq ""} { + #bare command that didn't resolve using namespace which + #command probably doesn't exist (may be auto_path cmd not yet loaded) + set where :: + } + set what [nstail $cmd] + } else { + set where [nsprefix $fqcmd] + set what [nstail $fqcmd] + } + #ensure we con't call 'namespace eval' on a nonexistent ns and create cruft namespaces + set parts [nsparts $where] + if {[lsearch $parts :*] > -1} { + set weird_ns 1 + if {![nsexists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)." + return nsnotfound + } + } else { + set weird_ns 0 + if {![namespace exists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)" + return nsnotfound + } + } + if {[interp issafe]} { - if {[catch {::tcl::info::cmdtype $cmd} result]} { + #todo - weird_ns + if {[catch {namespace eval $where [list ::tcl::info::cmdtype $what]} result]} { if {[info commands ::cmdtype] ne ""} { #hack - look for an alias that may have been specifically enabled to bring this back tailcall ::cmdtype $cmd @@ -1027,9 +1199,23 @@ tcl::namespace::eval punk::ns { } } if {[info commands ::tcl::info::cmdtype] ne ""} { - tailcall info cmdtype $cmd + if {$weird_ns} { + if {[nseval_ifexists $where [list ::info commands $what]] eq ""} { + return notfound + } else { + return [nseval_ifexists $where [list ::tcl::info::cmdtype $what]] + } + } else { + if {[namespace eval $where [list ::info commands $what]] eq ""} { + #e.g parray if it hasn't yet been called (an auto_path loaded command) + return notfound + } else { + tailcall namespace eval $where [list ::tcl::info::cmdtype $what] + } + } } - #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #we could examine namespaces to determine more - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #also - we're unlikely to be able to (easily) duplicate the full info cmdtype behaviour - so don't try here! return na } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob @@ -1073,6 +1259,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } + punk::args::update_definitions set nsdict_list [list] foreach ch $report_namespaces { @@ -1103,8 +1290,18 @@ tcl::namespace::eval punk::ns { #JMN set location $ch - set exportpatterns [tcl::namespace::eval $location {::namespace export}] - set nspathlist [tcl::namespace::eval $location {::namespace path}] + set locationparts [nsparts $location] + set weird_ns 0 + if {[lsearch $locationparts :*] >= 0} { + set weird_ns 1 + } + if {$weird_ns} { + set exportpatterns [nseval_ifexists $location {::namespace export}] + set nspathlist [nseval_ifexists $location {::namespace path}] + } else { + set exportpatterns [tcl::namespace::eval $location {::namespace export}] + set nspathlist [tcl::namespace::eval $location {::namespace path}] + } set nspathdict [dict create] if {$nspathcommands} { foreach pathns $nspathlist { @@ -1123,7 +1320,25 @@ tcl::namespace::eval punk::ns { foreach p $exportpatterns { if {[regexp {[*?]} $p]} { #lappend matched {*}[nseval $location [list ::info commands [nsjoin ${location} $p]]] - lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + if {$weird_ns} { + #! info commands can't glob with a weird ns prefix + #! info commands with no arguments returns all commands (from global and any other ns in namespace path) + #lappend matched {*}[nseval_ifexists $location [list ::info commands [nsjoin ${location} $p]]] + lappend matched {*}[nseval_ifexists $location [string map [list $location $p] { + set allcommands [info commands] + set matches [list] + foreach c $allcommands { + set fq [namespace which $c] + if {[string match :: $fq]} { + lappend matches $c + } + } + return $matches + }] + + } else { + lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + } foreach m $matched { lappend allexported [nstail $m] } @@ -1133,7 +1348,11 @@ tcl::namespace::eval punk::ns { } set allexported [lsort -unique $allexported] #NOTE: info procs within tcl::namespace::eval is different to 'info commands' within tcl::namespace::eval (info procs doesn't look outside of namespace) - set allprocs [tcl::namespace::eval $location {::info procs}] + if {$weird_ns} { + set allprocs [nseval_ifexists $location {::info procs}] + } else { + set allprocs [tcl::namespace::eval $location {::info procs}] + } #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] @@ -1151,7 +1370,11 @@ tcl::namespace::eval punk::ns { set interp_aliases [interp aliases ""] #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + if {$weird_ns} { + set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } else { + set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] foreach a $raw_aliases { @@ -1165,38 +1388,91 @@ tcl::namespace::eval punk::ns { } } + #NOTE for 'info ...' 'namespace origin|(etc)..' + # - use the pattern [namespace eval $location [list $cmd]] + #This allows examination of cmds with "bad" names such as empty string or prefixed with single colon. + #while these should be rare - we want to handle such edge cases when browsing namespaces. foreach cmd $commands { #if {"${location}::$cmd" in $interp_aliases || [string trimleft "${location}::$cmd" ":"] in $interp_aliases} { - # #NOTE: doesn't cater for renamed aliases - Tcl 8.x doesn't seem to have any introspection capabilities to match command to a renamed alias + # #NOTE: doesn't cater for renamed aliases - Tcl 8.x (and 9.01) doesn't seem to have any introspection capabilities to match command to a renamed alias # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} set ctype [cmdtype ${location}::$cmd] switch -- $ctype { na { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } + if {[nsprefix $cmdorigin] ne $location} { + #import + lappend allimported $cmd + set origin_location [nsprefix $cmdorigin] + } else { + set origin_location $location + } #tcl 8.6 (info cmdtype unavailable) #todo - use catch tcl::unsupported::corotype to see if coroutine - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + if {![catch {nseval_ifexists $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[nseval_ifexists $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[nseval_ifexists $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + + } + } else { + if {![catch {namespace eval $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[namespace eval $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[namespace eval $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + } } } default { - if {$ctype eq "imported"} { - set cmdorigin [namespace origin [nsjoin $location $cmd]] + if {$ctype eq "import"} { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source #ie we don't need to follow a chain of 'imported' results. - set mixedtype i-[info cmdtype $cmdorigin] + set origin_location [nsprefix $cmdorigin] + set origin_cmd [nstail $cmdorigin] + + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + set mixedtype i-[nseval_ifexists $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } else { + set mixedtype i-[namespace eval $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } + lappend allimported $cmd } else { set mixedtype $ctype } - #assert ctype != imported + #assert mixedtype != import #review - we don't have a way to mark as both native and ensemble - switch -- $ctype { + switch -- $mixedtype { i-native - native { lappend allnative $cmd } @@ -1242,7 +1518,7 @@ tcl::namespace::eval punk::ns { } } - #JMN + #JMN TODO if {[catch { if {$cmd eq ""} { #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. @@ -1315,6 +1591,50 @@ tcl::namespace::eval punk::ns { #definitely don't count exportpatterns incr itemcount [llength $undetermined] + set usageinfo [list] + set has_punkargs [expr {[info commands ::punk::args::id_exists] ne ""}] + set has_tepam [expr {[info exists ::tepam::ProcedureList]}] + if {$has_punkargs || $has_tepam} { + foreach c $commands { + if {$c in $imported} { + set fq [namespace origin [nsjoin $location $c]] + } elseif {$c in $aliases} { + #TODO - use which_alias ? + set tgt [interp alias "" [nsjoin $location $c]] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft [nsjoin $location $c] :]] + } + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(currying) + set fq $word1 + } + } else { + set fq [nsjoin $location $c] + } + if {$has_punkargs} { + set id [string trimleft $fq :] + if {[::punk::args::id_exists $id]} { + lappend usageinfo $c + } else { + if {$has_tepam} { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } else { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } set nsdict [dict create\ location $location\ @@ -1335,6 +1655,7 @@ tcl::namespace::eval punk::ns { ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ + usageinfo $usageinfo\ namespacepath $nspathdict\ glob $glob\ itemcount $itemcount\ @@ -1480,11 +1801,33 @@ tcl::namespace::eval punk::ns { ::set what $search } } - - ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] + set weird_ns 0 + if {[string match *:::* $base]} { + set weird_ns 1 + } #important not to call tcl::namespace::eval (or punk::ns::nseval) on non-existant base - or it will be created - ::if {![::tcl::namespace::exists $base]} { - ::continue + if {$weird_ns} { + ::if {![nsexists $base]} { + ::continue + } + #info commands can't glob with weird_ns prefix + puts ">>> base: $base what: $what" + ::set all_ns_commands [nseval_ifexists $base [list apply {{loc what} { + set _all [uplevel 1 [list ::info commands]] + set _matches [list] + foreach _a $_all { + set _c [uplevel 1 [list ::namespace which $_a]] + if {[::string match ${loc}::${what} $_c]} { + ::lappend _matches $_a + } + } + return $_matches + }} $base $what ]] + } else { + ::if {![::tcl::namespace::exists $base]} { + ::continue + } + ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] } ::set all_ns_tails [::lmap v $all_ns_commands {::punk::ns::nstail $v}] foreach c $all_ns_tails { @@ -1549,6 +1892,510 @@ tcl::namespace::eval punk::ns { } } |data@@ok/result> {lmap v $data {punk::ns::nstail $v}} |> lsort |> {join $data \n} = 0} { + #use nseval_ifexists to avoid creating intermediate namespaces for bogus paths + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set origin $commandpath + set resolved $commandpath + } + } else { + #fully qualified command specified but doesn't exist + set origin $commandpath + set resolved $commandpath + } + } else { + set thispath [uplevel 1 [list ::nsthis $commandpath]] + set targetns [nsprefix $thispath] + set name [nstail $thispath] + set targetparts [nsparts $targetns] + if {[lsearch $targetparts :*] >=0} { + #weird ns + set valid_ns [nsexists $targetns] + } else { + set valid_ns [namespace exists $targetns] + } + if {$valid_ns} { + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set thiscmd [nsjoin $targetns $name] + #relative commandpath specified - but Tcl didn't find a match in namespace path + #assume global (todo - look for namespace match in auto_index first ?) + set origin ::$name + set resolved ::$name + } + } else { + #namespace doesn't seem to exist - but there still could be documentation for lazy loaded ns and command + set origin $commandpath + set resolved $commandpath + } + } + #set thiscmd [nsjoin $targetns $name] + #if {[info commands $thiscmd] eq ""} { + # set origin $thiscmd + # set resolved $thiscmd + #} else { + # set origin [nseval $targetns [list ::namespace origin $name]] + # set resolved [nseval $targetns [list ::namespace which $name]] + #} + + #ns::cmdtype only detects alias type on 8.7+? + set initial_cmdtype [punk::ns::cmdtype $origin] + switch -- $initial_cmdtype { + na - alias { + #REVIEW - alias entry doesn't necessarily match command! + #considure using which_alias (wiki) + set tgt [interp alias "" $origin] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft $origin :]] + } + if {$tgt ne ""} { + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(possible curried arguments) + #review - curried arguments could be for ensembles! + set fq $word1 + } + set origin $fq + #retest cmdtype on modified origin + set cmdtype [punk::ns::cmdtype $origin] + } else { + set cmdtype $initial_cmdtype + } + if {$cmdtype eq "na"} { + #tcl 8.6 + if {[info object isa object $origin]} { + set cmdtype "object" + } + } + } + default { + set cmdtype $initial_cmdtype + } + } + + switch -- $cmdtype { + object { + #class is also an object + #todo -mixins etc etc + set class [info object class $origin] + #the call: info object methods -all + # seems to do the right thing as far as hiding unexported methods, and showing things like destroy + # - which don't seem to be otherwise easily introspectable + set public_methods [info object methods $origin -all] + #set class_methods [info class methods $class] + #set object_methods [info object methods $origin] + + if {[llength $commandargs]} { + set c1 [lindex $commandargs 0] + if {$c1 in $public_methods} { + switch -- $c1 { + new { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} new" + *proc -name "${$origin} new" -help\ + "create object with specified command name. + Arguments are passed to the constructor." + *values + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin new"] + } + create { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} create" + *proc -name "${$origin} create" -help\ + "create object with specified command name. + Arguments following objectName are passed to the constructor." + *values -min 1 + objectName -type string -help\ + "possibly namespaced name for object instance command" + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin create"] + } + destroy { + #review - generally no doc + # but we may want notes about a specific destructor + set argspec [punk::lib::tstr -return string { + *id "${$origin} destroy" + *proc -name "destroy" -help\ + "delete object, calling destructor if any. + destroy accepts no arguments." + *values -min 0 -max 0 + }] + punk::args::definition $argspec + return [punk::args::usage "$origin destroy"] + } + default { + #use info object call to resolve callchain + #we assume the first impl is the topmost in the callchain + # and its call signature is therefore the one we are interested in - REVIEW + # we should probably ignore generaltypes filter|unknown and look for a subsequent method|private? + set implementations [::info object call $origin $c1] + #result documented as list of 4 element lists + #set callinfo [lindex $implementations 0] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + + if {$location eq "object"} { + set id "[string trimleft $origin :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info object definition $origin $c1] + } else { + set id "[string trimleft $location :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info class definition $location $c1] + } + break + } + filter { + } + unknown { + } + } + } + if {$def ne ""} { + set arglist [lindex $def 0] + set argspec [punk::lib::tstr -return string { + *id "${$location} ${$c1}" + *proc -name "${$location} ${$c1}" -help\ + "arglist:${$arglist}" + *values + }] + set i 0 + foreach a $arglist { + switch -- [llength $a] { + 1 { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } + 2 { + append argspec \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" + } + default { + error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + } + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$location $c1"] + } else { + return "unable to resolve $origin method $c1" + } + + } + } + } + } + set choicelabeldict [dict create] + foreach cmd $public_methods { + switch -- $cmd { + new - create - destroy { + #todo + } + default { + set implementations [::info object call $origin $cmd] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + if {$location eq "object"} { + set id "[string trimleft $origin :] $cmd" ;# " " + } else { + set id "[string trimleft $location :] $cmd" ;# " " + } + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]" + } + } + break + } + filter { + } + unknown { + } + } + } + } + } + } + + set vline [list method -choices $public_methods -choicelabels $choicelabeldict -choiceprefix 0] ;#methods must be specified in full always? - review + #puts stderr "--->$vline" + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -name "Object: ${$origin}" -help\ + "Instance of class: ${$class}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + privateObject { + return "Command is a privateObject - no info currently available" + } + privateClass { + return "Command is a privateClass - no info currently available" + } + interp { + #todo + } + } + + #check ensemble before testing punk::arg::id_exists + #we want to recalculate ensemble usage info in case ensemble has been modified + + if {[namespace ensemble exists $origin]} { + #review + #todo - check -unknown + #if there is a -unknown handler - we can't be sure the choices in -map or from -namespace are exhaustive. + #presumably -choiceprefix should be zero in that case?? + + set ensembleinfo [namespace ensemble configure $origin] + set prefixes [dict get $ensembleinfo -prefixes] + set map [dict get $ensembleinfo -map] + set ns [dict get $ensembleinfo -namespace] + + #review - we can have a combination of commands from -map as well as those exported from -namespace + # if and only if -subcommands is specified + + set subcommand_dict [dict create] + set commands [list] + set nscommands [list] + if {[llength [dict get $ensembleinfo -subcommands]]} { + #set exportspecs [namespace eval $ns {namespace export}] + #foreach pat $exportspecs { + # lappend nscommands {*}[info commands ${ns}::$pat] + #} + #when using -subcommands, even unexported commands are available + set nscommands [info commands ${ns}::*] + foreach sub [dict get $ensembleinfo -subcommands] { + if {[dict exists $map $sub]} { + #-map takes precence over same name exported from -namespace + dict set subcommand_dict $sub [dict get $map $sub] + } elseif {"${ns}::$sub" in $nscommands} { + dict set subcommand_dict $sub ${ns}::$sub + } else { + #subcommand probably supplied via -unknown handler? + dict set subcommand_dict $sub "" + } + } + } else { + if {[dict size $map]} { + set subcommand_dict $map + } else { + set exportspecs [namespace eval $ns {namespace export}] + foreach pat $exportspecs { + lappend nscommands {*}[info commands ${ns}::$pat] + } + foreach fqc $nscommands { + dict set subcommand_dict [namespace tail $fqc] $fqc + } + } + } + + + set subcommands [lsort [dict keys $subcommand_dict]] + if {[llength $commandargs]} { + set match [tcl::prefix::match $subcommands [lindex $commandargs 0]] + if {$match in $subcommands} { + set subcmd [dict get $subcommand_dict $match] + return [arginfo {*}$subcmd {*}[lrange $commandargs 1 end]] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") + } + } + + set namespaces [list] ;# usually only 1 or 2 namespaces - but could be any number. + dict for {sub subwhat} $subcommand_dict { + set ns [::namespace which $subwhat] + if {$ns ni $namespaces} { + lappend namespaces $ns + } + } + set have_usageinfo [list] + set is_ensemble [list] + set is_object [list] + foreach ns $namespaces { + set nsinfo [lindex [punk::ns::nslist_dict [nsjoin [nsprefix $ns] *]] 0] + lappend have_usageinfo {*}[dict get $nsinfo usageinfo] + lappend is_ensemble {*}[dict get $nsinfo ensembles] + lappend is_object {*}[dict get $nsinfo ooobjects] + } + + set choicelabeldict [dict create] + foreach sub $subcommands { + if {$sub in $have_usageinfo} { + dict set choicelabeldict $sub " [Usageinfo_mark brightgreen]" + } elseif {$sub in $is_ensemble} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } elseif {$sub in $is_object} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } + } + + set vline [list subcommand -choices $subcommands -choiceprefix $prefixes -choicelabels $choicelabeldict] + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -help "ensemble: ${$origin}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + + #check for tepam help + if {[info exists ::tepam::ProcedureList]} { + if {$origin in $::tepam::ProcedureList} { + return [tepam::ProcedureHelp $origin 1] ;#use 1 to return rather than emit to stdout + } else { + #handle any tepam functions that don't eat their own dogfood but have help variables + #e.g tepam::procedure, tepam::argument_dialogbox + #Rather than hardcode these - we'll guess that any added will use the same scheme.. + if {[namespace qualifiers $origin] eq "::tepam"} { + set func [namespace tail $origin] + #tepam XXXHelp vars don't exactly match procedure names :/ + if {[info exists ::tepam::${func}Help]} { + return [set ::tepam::${func}Help] + } else { + set f2 [string totitle $func] + if {[info exists ::tepam::${f2}Help]} { + return [set ::tepam::${f2}Help] + } + #e.g argument_dialogbox -> ArgumentDialogboxHelp + set parts [split $func _] + set uparts [lmap p $parts {string totitle $p}] + set f3 [join [list {*}$uparts Help] ""] + if {[info exists ::tepam::${f3}]} { + return [set ::tepam::${f3}] + } + } + } + } + } + + set id [string trimleft $origin :] + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set origin_ns [nsprefix $origin] + set parts [nsparts $origin_ns] + set weird_ns 0 + if {[lsearch $parts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set argl {} + set tail [nstail $origin] + foreach a [nseval_ifexists $origin_ns [list info args $tail]] { + if {[nseval_ifexists $origin_ns [list info default $tail $a def]]} { + lappend a $def + } + lappend argl $a + } + } else { + set argl {} + foreach a [info args $origin] { + if {[info default $origin $a def]} { + lappend a $def + } + lappend argl $a + } + } + + set msg "No argument processor detected" + append msg \n "function signature: $resolved $argl" + return $msg + } + #todo - package up as navns proc corp {path} { #thanks to Richard Suchenwirth for the original - wiki.tcl-lang.org/page/corp @@ -1567,6 +2414,8 @@ tcl::namespace::eval punk::ns { set body "" } + #we want to handle edge cases of commands such as "" or :x + #various builtins such as 'namespace which' won't work if {[string match ::* $path]} { set targetns [nsprefix $path] set name [nstail $path] @@ -1884,26 +2733,41 @@ tcl::namespace::eval punk::ns { } interp alias "" use "" punk::ns::pkguse + punk::args::definition { + *id punk::ns::nsimport_noclobber + *proc -name punk::ns::nsimport_noclobber -help\ + "Import exported commands from a namespace into either the current namespace, + or that specified in -targetnamespace. + Return list of imported commands, ignores failures due to name conflicts" + -targetnamespace -optional 1 -help\ + "Namespace in which to import commands. + If namespace is relative (no leading ::), + the namespace is relative to the caller'd namespace. + If not supplied, caller's namespace is used." + -prefix -optional 1 -help\ + "string prefix for command names in target namespace" + *values -min 1 -max 1 + sourcepattern -type string -optional 0 -help\ + "Glob pattern for source namespace. + Globbing only active in the tail segment. + e.g ::mynamespace::*" + } proc nsimport_noclobber {args} { - set argspecs { - -targetnamespace -default "" -optional 1 - -prefix -default "" -optional 1 - *values -min 1 -max 1 - sourcepattern -type string -optional 0 - } - lassign [dict values [punk::args::get_dict $argspecs $args]] leaders opts values + lassign [dict values [punk::args::get_by_id punk::ns::nsimport_noclobber $args]] leaders opts values received set sourcepattern [dict get $values sourcepattern] set source_ns [tcl::namespace::qualifiers $sourcepattern] if {![tcl::namespace::exists $source_ns]} { error "nsimport_noclobber error namespace $source_ns not found" } - set target_ns [dict get $opts -targetnamespace] set nscaller [uplevel 1 {namespace current}] - if {$target_ns eq ""} { + if {![dict exists $received -targetnamespace]} { set target_ns $nscaller - } elseif {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + } else { + set target_ns [dict get $opts -targetnamespace] + if {![string match ::* $target_ns]} { + set target_ns [punk::nsjoin $nscaller $target_ns] + } } set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] @@ -1918,6 +2782,34 @@ tcl::namespace::eval punk::ns { } } } + set nstemp ::punk::ns::temp_import + if {[tcl::dict:::exists $received -prefix]} { + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { + set cmd "" + if {![catch {namespace import ::}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {rename [punk::ns::nsjoin ]}]} { + set cmd + } + } + set cmd + }]] + if {$imported ne ""} { + lappend imported_commands $imported + } + } + namespace delete $nstemp + return $imported_commands + } + set imported_commands [list] foreach e $a_exported_tails { set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { @@ -1934,7 +2826,7 @@ tcl::namespace::eval punk::ns { return $imported_commands } - #todo - use ns::nsimport_noclobber instead + #todo - use ns::nsimport_noclobber instead ? interp alias {} nsthis {} punk::ns::nspath_here_absolute interp alias {} nsorigin {} apply {ns {namespace origin [uplevel 1 ::punk::ns::nspath_here_absolute $ns]} ::} @@ -1943,6 +2835,7 @@ tcl::namespace::eval punk::ns { interp alias {} nsprefix {} punk::ns::nsprefix interp alias {} nstail {} punk::ns::nstail interp alias {} nsparts {} punk::ns::nsparts + interp alias {} nschildren {} punk::ns::nschildren interp alias {} nstree {} punk::ns::nstree #namespace/command/proc query interp alias {} nslist {} punk::ns::nslist @@ -1966,6 +2859,7 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp + interp alias {} i {} punk::ns::arginfo } diff --git a/src/modules/punk/path-999999.0a1.0.tm b/src/modules/punk/path-999999.0a1.0.tm index d00430ab..e0403382 100644 --- a/src/modules/punk/path-999999.0a1.0.tm +++ b/src/modules/punk/path-999999.0a1.0.tm @@ -45,8 +45,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -642,6 +644,20 @@ namespace eval punk::path { return $ismatch } + punk::args::definition { + *id punk::path::treefilenames + -directory -type directory -help\ + "folder in which to begin recursive scan for files." + -call-depth-internal -default 0 -type integer + -antiglob_paths -default {} -help\ + "list of path patterns to exclude + may include * and ** path segments e.g /usr/**" + *values -min 0 -max -1 -optional 1 -type string + tailglobs -multiple 1 -help\ + "Patterns to match against filename portion (last segment) of each file path + within the directory tree being searched." + } + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) proc treefilenames {args} { @@ -655,22 +671,17 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_dict { - -directory -default "\uFFFF" - -call-depth-internal -default 0 -type integer - -antiglob_paths -default {} - *values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 - } $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::path::treefilenames $args] + lassign [dict values $argd] leaders opts values received set tailglobs [dict values $values] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - set opt_dir [dict get $opts -directory] - if {$opt_dir eq "\uFFFF"} { + if {![dict exists $received -directory]} { set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] } # -- --- --- --- --- --- --- diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 422fb62b..6ffc6842 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -30,6 +30,7 @@ package require shellfilter #package require shellrun #package require punk package require punk::lib +package require punk::args package require punk::aliascore if {[catch {punk::aliascore::init} errM]} { puts stderr "punk::aliascore::init error: $errM" @@ -2773,7 +2774,7 @@ namespace eval repl { proc punk {} { interp eval code { package require punk::repl - repl::init + repl::init -safe punk repl::start stdin } } @@ -2781,14 +2782,21 @@ namespace eval repl { interp eval code { package require punk::repl } - interp eval code [list repl::init -safe 1 {*}$args] + interp eval code [list repl::init -safe safe {*}$args] interp eval code [list repl::start stdin] } proc safebase {args} { interp eval code { package require punk::repl } - interp eval code [list repl::init -safe 2 {*}$args] + interp eval code [list repl::init -safe safebase {*}$args] + interp eval code [list repl::start stdin] + } + proc punksafe {args} { + interp eval code { + package require punk::repl + } + interp eval code [list repl::init -safe punksafe {*}$args] interp eval code [list repl::start stdin] } } @@ -2805,189 +2813,265 @@ namespace eval repl { set paths [dict get $args -paths] } - if {$safe == 1} { - interp create -safe -- code - if {[llength $paths]} { - package require punk::island - foreach p $paths { - punk::island::add code $p + switch -- $safe { + safe { + interp create -safe -- code + if {[llength $paths]} { + package require punk::island + foreach p $paths { + punk::island::add code $p + } } - } - #review argv0,argv,argc - interp eval code { - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} + #review argv0,argv,argc + interp eval code { + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + } + set ::argv0 %argv0% + set ::auto_path %autopath% + #puts stdout "safe interp" + #flush stdout + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code } - set ::argv0 %argv0% - set ::auto_path %autopath% - #puts stdout "safe interp" - #flush stdout - } - interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] - interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] - interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] - if {"stdout" in [chan names]} { - interp share {} stdout code - } else { - interp share {} [shellfilter::stack::item_tophandle stdout] code - } - if {"stderr" in [chan names]} { - interp share {} stderr code - } else { - interp share {} [shellfilter::stack::item_tophandle stderr] code - } - - code alias ::md5::md5 ::repl::interphelpers::md5 - code alias exit ::repl::interphelpers::quit - } elseif {$safe == 2} { - #safebase - safe::interpCreate code -nested 1 - #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* - #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. - if {[llength $paths]} { - package require punk::island - foreach p $paths { - punk::island::add code $p + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code } - } - interp eval code { - set ::argv0 %argv0% - set ::argc 0 - set ::argv {} - set ::auto_path %autopath% - #puts stdout "safebase interp" - #flush stdout - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} + + code alias ::md5::md5 ::repl::interphelpers::md5 + code alias exit ::repl::interphelpers::quit + } + safebase { + #safebase + safe::interpCreate code -nested 1 -autopath %autopath% + #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* + #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. + if {[llength $paths]} { + package require punk::island + foreach p $paths { + punk::island::add code $p + } + } + interp eval code { + set ::argv0 %argv0% + set ::argc 0 + set ::argv {} + #puts stdout "safebase interp" + #flush stdout + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + } + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + + #code invokehidden package require punk::lib + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + interp eval code { + package require punk::lib + package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) } - } - interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] - interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] - interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] - #code invokehidden package require punk::lib - if {"stdout" in [chan names]} { - interp share {} stdout code - } else { - interp share {} [shellfilter::stack::item_tophandle stdout] code - } - if {"stderr" in [chan names]} { - interp share {} stderr code - } else { - interp share {} [shellfilter::stack::item_tophandle stderr] code - } - interp eval code { - package require punk::lib - package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) - } + #JMN + interp eval code { + package require shellfilter + } - #JMN - interp eval code { - package require shellfilter - } + #work around bug in safe base which won't load Tcl libs that have deeper nesting + #(also affects tcllib page/plugins folder) + set termversions [package versions term] + set termv [lindex $termversions end] + if {$termv ne ""} { + set path [lindex [package ifneeded term $termv] end] ;#assuming path at end of something like "source .../term.tcl" + set termbase [file dirname $path] + safe::interpAddToAccessPath code [file join $termbase ansi] + safe::interpAddToAccessPath code [file join $termbase ansi code] + } + #safe::interpAddToAccessPath code NUL + if {$safelog ne ""} { + #setting setLogCmd here gives potentially interesting feedback regarding behaviour of things such as glob + safe::setLogCmd $safelog + } + #code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm + + code alias detok ::safe::DetokPath code ;#temp - this violates the point of the {$p(:X:)} paths + + #review - exit should do something slightly different + # see ::safe::interpDelete + code alias exit ::repl::interphelpers::quit + + code alias ::md5::md5 ::repl::interphelpers::md5 + code alias ::fconfigure ::fconfigure ;#needed for shellfilter + code alias ::file ::file + interp eval code [list package provide md5 $md5version] - #work around bug in safe base which won't load Tcl libs that have deeper nesting - #(also affects tcllib page/plugins folder) - set termversions [package versions term] - set termv [lindex $termversions end] - if {$termv ne ""} { - set path [lindex [package ifneeded term $termv] end] ;#assuming path at end of something like "source .../term.tcl" - set termbase [file dirname $path] - safe::interpAddToAccessPath code [file join $termbase ansi] - safe::interpAddToAccessPath code [file join $termbase ansi code] - } - #safe::interpAddToAccessPath code NUL - if {$safelog ne ""} { - #setting setLogCmd here gives some feedback for potentially interesting feedback regarding behaviour of things such as glob - safe::setLogCmd $safelog } - #code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm + punk - 0 { + interp create code + interp eval code { + #safe !=1 and safe !=2, tmlist: %tmlist% + set ::argv0 %argv0% + set ::argv %argv% + set ::argc %argc% + set ::auto_path %autopath% + tcl::tm::remove {*}[tcl::tm::list] + tcl::tm::add {*}[lreverse %tmlist%] + #puts "code interp chan names-->[chan names]" + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + variable run_command_cache + } - code alias detok ::safe::DetokPath code ;#temp - this violates the point of the {$p(:X:)} paths + # -- --- + #review + #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) + #review - can we speed that scan up? + ##catch {package require flobrudder-nonexistant} + # -- --- - #review - exit should do something slightly different - # see ::safe::interpDelete - code alias exit ::repl::interphelpers::quit + if {[catch { + package require vfs + package require vfs::zip + } errM]} { + puts stderr "repl code interp can't load vfs,vfs::zip" + } - code alias ::md5::md5 ::repl::interphelpers::md5 - code alias ::fconfigure ::fconfigure ;#needed for shellfilter - code alias ::file ::file - interp eval code [list package provide md5 $md5version] - } else { - interp create code - interp eval code { - #safe !=1 and safe !=2, tmlist: %tmlist% - set ::argv0 %argv0% - set ::argv %argv% - set ::argc %argc% - set ::auto_path %autopath% - tcl::tm::remove {*}[tcl::tm::list] - tcl::tm::add {*}[lreverse %tmlist%] - #puts "code interp chan names-->[chan names]" - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - variable run_command_cache - } + #puts stderr ----- + #puts stderr [join $::auto_path \n] + #puts stderr ----- - # -- --- - #review - #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) - #review - can we speed that scan up? - ##catch {package require flobrudder-nonexistant} - # -- --- - - if {[catch { - package require vfs - package require vfs::zip - } errM]} { - puts stderr "repl code interp can't load vfs,vfs::zip" - } + if {[catch { + package require punk::config + package require punk::ns + #puts stderr "loading natsort" + #natsort has 'application mode' which can exit. + #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions + package require natsort + #catch {package require packageTrace} + package require punk + package require punk::args + package require punk::args::tclcore + package require shellrun + package require shellfilter + #set running_config $::punk::config::running + apply {running_config { + if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { + lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + } + if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { + lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + }} $::punk::config::running - #puts stderr ----- - #puts stderr [join $::auto_path \n] - #puts stderr ----- - - if {[catch { - package require punk::config - package require punk::ns - #puts stderr "loading natsort" - #natsort has 'application mode' which can exit. - #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions - package require natsort - #catch {package require packageTrace} - package require punk - package require shellrun - package require shellfilter - #set running_config $::punk::config::running - #if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - # lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] - #} - #if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - # lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] - #} - apply {running_config { - if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + package require textblock + } errM]} { + puts stderr "========================" + puts stderr "code interp error:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + error "$errM" } - if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + } + punksafe { + package require punk::safe + punk::safe::interpCreate code -autoPath %auto_path% + interp eval code { + set ::argv0 %argv0% + set ::argc 0 + set ::argv {} + tcl::tm::remove {*}[tcl::tm::list] + tcl::tm::add {*}[lreverse %tmlist%] + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + variable run_command_cache } - }} $::punk::config::running - - package require textblock - } errM]} { - puts stderr "========================" - puts stderr "code interp error:" - puts stderr $errM - puts stderr $::errorInfo - puts stderr "========================" - error "$errM" } + + + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + + interp eval code { + package require punk::lib + package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) + } + + + interp eval code { + if {[catch { + catch { + package require packagetrace + packagetrace::init + } + package require punk::config + package require punk::ns + #puts stderr "loading natsort" + #natsort has 'application mode' which can exit. + #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions + package require natsort + package require punk + package require punk::args + package require punk::args::tclcore + package require shellrun + package require shellfilter + #set running_config $::punk::config::running + apply {running_config { + if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { + lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + } + if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { + lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + }} $::punk::config::running + + package require textblock + } errM]} { + puts stderr "========================" + puts stderr "code interp error:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + error "$errM" + } + + } + + } + default { } } code alias repl ::repl::interphelpers::repl_ensemble @@ -3006,6 +3090,10 @@ namespace eval repl { #temporary debug aliases - deliberate violation of safety provided by safe interp code alias escapeeval ::repl::interphelpers::escapeeval + + #experiment + #code alias ::shellfilter::stack ::shellfilter::stack + #puts stderr "returning threadid" #puts stderr [thread::id] diff --git a/src/modules/punk/repl/codethread-999999.0a1.0.tm b/src/modules/punk/repl/codethread-999999.0a1.0.tm index a4f5f507..07c8509b 100644 --- a/src/modules/punk/repl/codethread-999999.0a1.0.tm +++ b/src/modules/punk/repl/codethread-999999.0a1.0.tm @@ -166,15 +166,15 @@ tcl::namespace::eval punk::repl::codethread { set errstack [list] upvar ::punk::config::running running_config if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { - lappend outstack [interp eval code [list shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } - lappend outstack [interp eval code [list shellfilter::stack::add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { - lappend errstack [interp eval code [list shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } - lappend errstack [interp eval code [list shellfilter::stack::add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] #an experiment #set errhandle [shellfilter::stack::item_tophandle stderr] @@ -190,7 +190,16 @@ tcl::namespace::eval punk::repl::codethread { if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } - tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + if {[string first ":::" $::punk::ns::ns_current]} { + #support for browsing 'odd' (inadvisable) namespaces + #don't use 'namespace exists' - will conflate ::test::x with ::test:::x + #if {$::punk::ns::ns_current in [namespace children [punk::ns::nsprefix $::punk::ns::ns_current]} { + #} + package require punk::ns + punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript + } else { + tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + } } } result] @@ -221,10 +230,10 @@ tcl::namespace::eval punk::repl::codethread { #only remove from shellfilter::stack the items we added to stack in this function foreach s [lreverse $outstack] { - interp eval code [list shellfilter::stack::remove stdout $s] + interp eval code [list ::shellfilter::stack remove stdout $s] } foreach s [lreverse $errstack] { - interp eval code [list shellfilter::stack::remove stderr $s] + interp eval code [list ::shellfilter::stack remove stderr $s] } thread::cond notify $replthread_cond } diff --git a/src/modules/punk/safe-999999.0a1.0.tm b/src/modules/punk/safe-999999.0a1.0.tm index 52c01ab8..3080b998 100644 --- a/src/modules/punk/safe-999999.0a1.0.tm +++ b/src/modules/punk/safe-999999.0a1.0.tm @@ -396,7 +396,7 @@ tcl::namespace::eval punk::safe { punk::safe::lib::RejectExcessColons $child set withAutoPath [dict exists $argd received -autoPath] - do_interpInit $child\ + punk::safe::system::do_interpInit $child\ [dict get $argd opts -accessPath]\ [InterpStatics $argd]\ [InterpNested $argd]\ @@ -436,6 +436,7 @@ tcl::namespace::eval punk::safe { # the current configuration. We still call OptKeyParse though # we know that "child" is our given argument because it also # checks for the "-help" option. + #TODO! set argd [punk::args::get_by_id punk::safe::interpIC $args] set child [dict get $argd leaders child] @@ -499,7 +500,8 @@ tcl::namespace::eval punk::safe { use -nested instead" } default { - return -code error "unknown flag $name. Known options: $opt_names" + #return -code error "unknown flag $name. Known options: $opt_names" + punk::args::get_by_id punk::safe::interpIC [list $child $arg] } } } @@ -585,6 +587,109 @@ tcl::namespace::eval punk::safe { } } + # + # + # interpFindInAccessPath: + # Search for a real directory and returns its virtual Id (including the + # "$") + # + # When debugging, use TranslatePath for the inverse operation. + proc interpFindInAccessPath {child path} { + CheckInterp $child + namespace upvar ::punk::safe::system [VarName $child] state + + if {![dict exists $state(access_path,remap) $path]} { + return -code error "$path not found in access path" + } + + return [dict get $state(access_path,remap) $path] + } + + # + # addToAccessPath: + # add (if needed) a real directory to access path and return its + # virtual token (including the "$"). + proc interpAddToAccessPath {child path} { + # first check if the directory is already in there + # (inlined interpFindInAccessPath). + CheckInterp $child + namespace upvar ::punk::safe::system [VarName $child] state + + if {[dict exists $state(access_path,remap) $path]} { + return [dict get $state(access_path,remap) $path] + } + + # new one, add it: + set token [PathToken [llength $state(access_path)]] + + lappend state(access_path) $path + lappend state(access_path,child) $token + lappend state(access_path,map) $token $path + lappend state(access_path,remap) $path $token + lappend state(access_path,norm) [file normalize $path] + + SyncAccessPath $child + return $token + } + # This procedure deletes a safe interpreter managed by Safe Tcl and cleans up + # associated state. + # - The command will also delete non-Safe-Base interpreters. + # - This is regrettable, but to avoid breaking existing code this should be + # amended at the next major revision by uncommenting "CheckInterp". + + proc interpDelete {child} { + Log $child "About to delete" NOTICE + + # CheckInterp $child + namespace upvar ::punk::safe::system [VarName $child] state + + # When an interpreter is deleted with [interp delete], any sub-interpreters + # are deleted automatically, but this leaves behind their data in the Safe + # Base. To clean up properly, we call safe::interpDelete recursively on each + # Safe Base sub-interpreter, so each one is deleted cleanly and not by + # the automatic mechanism built into [interp delete]. + foreach sub [interp children $child] { + if {[info exists ::punk::safe::system::[VarName [list $child $sub]]]} { + ::punk::safe::interpDelete [list $child $sub] + } + } + + # If the child has a cleanup hook registered, call it. Check the + # existence because we might be called to delete an interp which has + # not been registered with us at all + + if {[info exists state(cleanupHook)]} { + set hook $state(cleanupHook) + if {[llength $hook]} { + # remove the hook now, otherwise if the hook calls us somehow, + # we'll loop + unset state(cleanupHook) + try { + {*}$hook $child + } on error err { + Log $child "Delete hook error ($err)" + } + } + } + + # Discard the global array of state associated with the child, and + # delete the interpreter. + + if {[info exists state]} { + unset state + } + + # if we have been called twice, the interp might have been deleted + # already + if {[::interp exists $child]} { + ::interp delete $child + Log $child "Deleted" NOTICE + } + + return + } + + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::safe ---}] } @@ -661,8 +766,11 @@ tcl::namespace::eval punk::safe::system { set INTERPCREATE { *id punk::safe::interpCreate + *proc -name punk::safe::interpCreate -help\ + "Create a safe interpreter with punk::safe specific aliases + Returns the interpreter name" *leaders - child -type string -default "" -optional 1 -help\ + child -type string -default "" -regexprefail "^-" -regexprefailmsg "" -optional 1 -help\ "name of the child (optional)" } append INTERPCREATE \n $optlines @@ -673,7 +781,7 @@ tcl::namespace::eval punk::safe::system { set INTERPIC { *id punk::safe::interpIC *leaders - child -type string -optional 0 -help\ + child -type string -optional 0 -regexprefail "^-" -regexprefailmsg "" -help\ "name of the child" } append INTERPIC \n $optlines diff --git a/src/modules/punk/sixel-999999.0a1.0.tm b/src/modules/punk/sixel-999999.0a1.0.tm index 8c630345..57eb1d00 100644 --- a/src/modules/punk/sixel-999999.0a1.0.tm +++ b/src/modules/punk/sixel-999999.0a1.0.tm @@ -143,6 +143,8 @@ tcl::namespace::eval punk::sixel { #TODO - sixel row/col info is dependent on terminal - pass in -terminalobject or -inoutchannels (for use with punk::console::cell_size) punk::args::definition { *id punk::sixel::get_info + *proc -name punk::sixel::get_info -help\ + "return a dict of information about the supplied sixelstring" -cache -default 1 -type boolean -help\ "Cached result based on sha1 hash." -cell_size -default "" -help\ diff --git a/src/modules/shellfilter-0.1.9.tm b/src/modules/shellfilter-0.1.9.tm index fe443ece..25ba28b1 100644 --- a/src/modules/shellfilter-0.1.9.tm +++ b/src/modules/shellfilter-0.1.9.tm @@ -1086,7 +1086,9 @@ namespace eval shellfilter::chan { ## note - whether stack is for input or output we maintain it in the same direction - which is in sync with the tcl chan pop chan push concept. ## namespace eval shellfilter::stack { - #todo - implement as oo + namespace export {[a-z]*} + namespace ensemble create + #todo - implement as oo ? variable pipelines [list] proc items {} { diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index af9cf41d..8dbc9644 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -92,29 +92,51 @@ tcl::namespace::eval textblock { #NOTE sha1, although computationally more intensive, tends to be faster than md5 on modern cpus #(more likely to be optimised for modern cpu features?) - variable use_md5 ;#framecache - set use_md5 1 - if {[catch {package require md5}]} { - set use_md5 0 - } - #todo - change use_md5 to more generic use_checksum_algorithm function. - # e.g allow md5, sha1, none, etc. - # - perhaps autodetect 32bit vs 64bit (or processortype?) to select a default (also depending on packages available and accelerator presence) - proc use_md5 {{yes_no ""}} { - variable use_md5 - if {$yes_no eq ""} { - return $use_md5 - } - if {![string is boolean -strict $yes_no]} { - error "textblock::use_md5 requires a boolean (or empty string to query)" - } - if {$yes_no} { - package require md5 - set use_md5 1 + #(This speed improvement may not apply for short strings) + + variable use_hash ;#framecache + set use_hash none ;#slightly faster but uglier layout for viewing frame_cache display + #if {![catch {package require sha1}]} { + # set use_hash sha1 + #} elseif {![catch {package require md5}]} { + # set use_hash md5 + #} else { + # set use_hash none + #} + + proc use_hash {args} { + set choices [list none] + set unavailable [list] + set pkgs [package names] + if {"md5" in $pkgs} { + lappend choices md5 } else { - set use_md5 0 + lappend unavailable md5 } - return $use_md5 + if {"sha1" in $pkgs} { + lappend choices sha1 + } else { + lappend unavailable sha1 + } + set choicemsg "" + if {[llength $unavailable]} { + set choicemsg " (unavailable packages: $unavailable)" + } + set argd [punk::args::get_dict [tstr -return string { + *id textblock::use_hash + *proc -name "textblock::use_hash" -help\ + "Hashing algorithm to use for framecache lookup. + 'none' may be slightly faster but less compact + when viewing textblock::framecache" + *values -min 0 -max 1 + hash_algorithm -choices {${$choices}} -optional 1 -help\ + "algorithm choice ${$choicemsg}" + }] $args] + variable use_hash + if {![dict exists $argd received hash_algorithm]} { + return $use_hash + } + set use_hash [dict get $argd values hash_algorithm] } tcl::namespace::eval class { variable opts_table_defaults @@ -3997,12 +4019,8 @@ tcl::namespace::eval textblock { return $t } - - - proc periodic {args} { - #For an impressive interactive terminal app (javascript) - # see: https://github.com/spirometaxas/periodic-table-cli - set opts [dict get [punk::args::get_dict { + punk::args::definition { + *id textblock::periodic *proc -name textblock::periodic -help "A rudimentary periodic table This is primarily a test of textblock::class::table" @@ -4016,8 +4034,12 @@ tcl::namespace::eval textblock { -show_edge -default "" -type boolean -forcecolour -default 0 -type boolean -help "If punk::colour is off - this enables the produced table to still be ansi coloured" *values -min 0 -max 0 - } $args] opts] + } + proc periodic {args} { + #For an impressive interactive terminal app (javascript) + # see: https://github.com/spirometaxas/periodic-table-cli + set opts [dict get [punk::args::get_by_id textblock::periodic $args] opts] set opt_return [tcl::dict::get $opts -return] if {[tcl::dict::get $opts -forcecolour]} { set fc forcecolour @@ -4156,15 +4178,16 @@ tcl::namespace::eval textblock { dict set conf $k [dict get $opts $k] } } - $t configure {*}[dict get $conf] - $t configure \ - -frametype_header light\ - -ansiborder_header [a+ {*}$fc brightwhite]\ - -ansibase_header [a+ {*}$fc Black]\ - -ansibase_body [a+ {*}$fc Black]\ - -ansiborder_body [a+ {*}$fc black]\ - -frametype block + set moreopts [dict create\ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc brightwhite]\ + -ansibase_header [a+ {*}$fc Black]\ + -ansibase_body [a+ {*}$fc Black]\ + -ansiborder_body [a+ {*}$fc black]\ + -frametype block + ] + $t configure {*}[dict merge $conf $moreopts] #-ansiborder_header [a+ {*}$fc web-white]\ @@ -4204,9 +4227,9 @@ tcl::namespace::eval textblock { -header -default "" -type list -multiple 1\ -help "Each supplied -header argument is a header row. The number of values for each must be <= number of columns" - -show_header -default ""\ + -show_header -type boolean\ -help "Whether to show a header row. - Leave as empty string for unspecified/automatic, + Omit for unspecified/automatic, in which case it will display only if -headers list was supplied." -action -default "append" -choices {append replace}\ -help "row insertion method if existing -table is supplied @@ -4294,13 +4317,13 @@ tcl::namespace::eval textblock { if {[llength $colheaders] > 0} { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 1 } else { set show_header [tcl::dict::get $opts -show_header] } } else { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 0 } else { set show_header [tcl::dict::get $opts -show_header] @@ -4529,7 +4552,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4553,7 +4576,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4614,7 +4637,7 @@ tcl::namespace::eval textblock { set textblock [textutil::tabify::untabify2 $textblock $tw] } #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { set textblock [punk::ansi::ansistripraw $textblock] } if {[tcl::string::last \n $textblock] >= 0} { @@ -7226,12 +7249,19 @@ tcl::namespace::eval textblock { variable frame_cache set frame_cache [tcl::dict::create] + + punk::args::definition { + *id textblock::frame_cache + *proc -name textblock::frame_cache -help\ + "Display or clear the frame cache." + -action -default {} -choices {clear} -help\ + "Clear the textblock::frame_cache dictionary" + -pretty -default 1 -help\ + "Use 'pdict textblock::frame_cache */*' for prettier output" + *values -min 0 -max 0 + } proc frame_cache {args} { - set argd [punk::args::get_dict { - -action -default {} -choices {clear} -help "Clear the textblock::frame_cache dictionary" - -pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output" - *values -min 0 -max 0 - } $args] + set argd [punk::args::get_by_id textblock::frame_cache $args] set action [dict get $argd opts -action] if {$action ni [list clear ""]} { @@ -7273,6 +7303,71 @@ tcl::namespace::eval textblock { } + set FRAMETYPES [textblock::frametypes] + set EG [a+ brightblack] + set RST [a] + #todo punk::args alias for centre center etc? + punk::args::definition [punk::lib::tstr -return string { + *id textblock::frame + *proc -name "textblock::frame"\ + -help "Frame a block of text with a border." + -checkargs -default 1 -type boolean\ + -help "If true do extra argument checks and + provide more comprehensive error info. + Set false for slight performance improvement." + -etabs -default 0\ + -help "expanding tabs - experimental/unimplemented." + -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ + -help "Type of border for frame." + -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. + passing an empty string will result in no box, but title/subtitle will still appear if supplied. + ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" + -boxmap -default {} -type dict + -joins -default {} -type list + -title -default "" -type string -regexprefail {\n}\ + -help "Frame title placed on topbar - no newlines. + May contain ANSI - no trailing reset required. + ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing + e.g 2: frame -title [a+ red underline]MyThing${$RST}" + -subtitle -default "" -type string -regexprefail {\n}\ + -help "Frame subtitle placed on bottombar - no newlines + May contain Ansi - no trailing reset required." + -width -default "" -type int\ + -help "Width of resulting frame including borders. + If omitted or empty-string, the width will be determined automatically based on content." + -height -default "" -type int\ + -help "Height of resulting frame including borders." + -ansiborder -default "" -type ansistring\ + -help "Ansi escape sequence to set border attributes. + ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents + e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" + -ansibase -default "" -type ansistring\ + -help "Default ANSI attributes within frame." + -blockalign -default centre -choices {left right centre}\ + -help "Alignment of the content block within the frame." + -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background + extends within the content block inside the frame. + Has no effect if no ANSI in content." + -textalign -default left -choices {left right centre}\ + -help "Alignment of text within the content block. (centre unimplemented)" + -ellipsis -default 1 -type boolean\ + -help "Whether to show elipsis for truncated content and title/subtitle." + -usecache -default 1 -type boolean + -buildcache -default 1 -type boolean + -crm_mode -default 0 -type boolean\ + -help "Show ANSI control characters within frame contents. + (Control Representation Mode) + Frame width doesn't adapt and content may be truncated + so -width may need to be manually set to display more." + + *values -min 0 -max 1 + contents -default "" -type string\ + -help "Frame contents - may be a block of text containing newlines and ANSI. + Text may be 'ragged' - ie unequal line-lengths. + No trailing ANSI reset required. + ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" + }] + #options before content argument - which is allowed to be absent #frame performance (noticeable with complex tables even of modest size) is improved somewhat by frame_cache - but is still (2024) a fairly expensive operation. # @@ -7283,7 +7378,7 @@ tcl::namespace::eval textblock { # - but we would need to maintain support for the rendered-string based operations too. proc frame {args} { variable frametypes - variable use_md5 + variable use_hash #counterintuitively - in-proc dict create each time is generally slightly faster than linked namespace var set opts [tcl::dict::create\ @@ -7311,20 +7406,19 @@ tcl::namespace::eval textblock { # for ansi art - -pad 0 is likely to be preferable set has_contents 0 - set arglist $args + set optlist $args ;#initial only - content will be removed + #no solo opts for frame if {[llength $args] %2 == 0} { if {[lindex $args end-1] eq "--"} { - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 - lpop arglist end ;#drop the end-of-opts flag + lpop optlist end ;#drop the end-of-opts flag } else { - set arglist $args + set optlist $args set contents "" } } else { - #set arglist [lrange $args 0 end-1] - #set contents [lindex $args end] - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 } @@ -7333,7 +7427,7 @@ tcl::namespace::eval textblock { #use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache set optnames [tcl::dict::keys $opts] set opts_ok 1 ;#default assumption - foreach {k v} $arglist { + foreach {k v} $optlist { set k2 [tcl::prefix::match -error "" $optnames $k] switch -- $k2 { -etabs - -type - -boxlimits - -boxmap - -joins @@ -7355,70 +7449,9 @@ tcl::namespace::eval textblock { set check_args [dict get $opts -checkargs] #only use punk::args if check_args is true or our basic checks failed - if {!$opts_ok || $check_args} { - #error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - set FRAMETYPES [textblock::frametypes] - set EG [a+ brightblack] - set RST [a] - set argd [punk::args::get_dict [punk::lib::tstr -return string { - *proc -name "textblock::frame"\ - -help "Frame a block of text with a border." - -checkargs -default 1 -type boolean\ - -help "If true do extra argument checks and - provide more comprehensive error info. - Set false for slight performance improvement." - -etabs -default 0\ - -help "expanding tabs - experimental/unimplemented." - -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ - -help "Type of border for frame." - -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. - passing an empty string will result in no box, but title/subtitle will still appear if supplied. - ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" - -boxmap -default {} -type dict - -joins -default {} -type list - -title -default "" -type string -regexprefail {\n}\ - -help "Frame title placed on topbar - no newlines. - May contain ANSI - no trailing reset required. - ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing - e.g 2: frame -title [a+ red underline]MyThing${$RST}" - -subtitle -default "" -type string -regexprefail {\n}\ - -help "Frame subtitle placed on bottombar - no newlines - May contain Ansi - no trailing reset required." - -width -default "" -type int\ - -help "Width of resulting frame including borders. - If omitted or empty-string, the width will be determined automatically based on content." - -height -default "" -type int\ - -help "Height of resulting frame including borders." - -ansiborder -default "" -type ansistring\ - -help "Ansi escape sequence to set border attributes. - ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents - e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" - -ansibase -default "" -type ansistring\ - -help "Default ANSI attributes within frame." - -blockalign -default centre -choices {left right centre}\ - -help "Alignment of the content block within the frame." - -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background - extends within the content block inside the frame. - Has no effect if no ANSI in content." - -textalign -default left -choices {left right centre}\ - -help "Alignment of text within the content block. (centre unimplemented)" - -ellipsis -default 1 -type boolean\ - -help "Whether to show elipsis for truncated content and title/subtitle." - -usecache -default 1 -type boolean - -buildcache -default 1 -type boolean - -crm_mode -default 0 -type boolean\ - -help "Show ANSI control characters within frame contents. - (Control Representation Mode) - Frame width doesn't adapt and content may be truncated - so -width may need to be manually set to display more." - - *values -min 0 -max 1 - contents -default "" -type string\ - -help "Frame contents - may be a block of text containing newlines and ANSI. - Text may be 'ragged' - ie unequal line-lengths. - No trailing ANSI reset required. - ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" - }] $args] + #never need to checkargs if only one argument supplied even if it looks like an option - as it will be treated as data to frame + if {[llength $args] != 1 && (!$opts_ok || $check_args)} { + set argd [punk::args::get_by_id textblock::frame $args] set opts [dict get $argd opts] set contents [dict get $argd values contents] } @@ -7446,7 +7479,10 @@ tcl::namespace::eval textblock { set opt_ansiborder [tcl::dict::get $opts -ansiborder] set opt_ansibase [tcl::dict::get $opts -ansibase] ;#experimental set opt_ellipsis [tcl::dict::get $opts -ellipsis] + set opt_blockalign [tcl::dict::get $opts -blockalign] + set opt_textalign [tcl::dict::get $opts -textalign] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] set known_frametypes $frametypes ;# light, heavey etc as defined in the ::textblock::frametypes variable @@ -7463,107 +7499,26 @@ tcl::namespace::eval textblock { set framedef $ftype } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - #review vllj etc? - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] - - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - tcl::dict::for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - hltj - hlbj - vllj - vlrj {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" - } + #if check_args? - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [tcl::dict::create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - tcl::dict::set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] + #REVIEW - now done in framedef? + #set join_directions [list] + ##targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + ##e.g down-light, up-heavy + #set join_targets [tcl::dict::create left "" down "" right "" up ""] + #foreach jt $opt_joins { + # lassign [split $jt -] direction target + # if {$target ne ""} { + # tcl::dict::set join_targets $direction $target + # } + # lappend join_directions $direction + #} + #set join_directions [lsort -unique $join_directions] + #set do_joins [::join $join_directions _] - #JMN - switch -- $opt_blockalign { - left - right - centre - center {} - default { - error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_textalign [tcl::dict::get $opts -textalign] - switch -- $opt_textalign { - left - right - centre - center {} - default { - error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" - } - } # -- --- --- --- --- --- @@ -7634,20 +7589,28 @@ tcl::namespace::eval textblock { # -- --- --- --- --- --- --- --- --- variable frame_cache #review - custom frame affects frame_inner_width - exclude from caching? - #set cache_key [concat $arglist $frame_inner_width $frame_inner_height] + #set cache_key [concat $optlist $frame_inner_width $frame_inner_height] #jmn - #set hashables [concat $arglist $frame_inner_width $frame_inner_height] - set hashables [list {*}$arglist $frame_inner_width $frame_inner_height] + #set hashables [concat $optlist $frame_inner_width $frame_inner_height] + set hashables [list {*}$optlist $frame_inner_width $frame_inner_height] - if {$use_md5} { - #package require md5 ;#already required at package load - if {[package vsatisfies [package present md5] 2- ] } { - set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review - } else { - set hash [md5::md5 [encoding convertto utf-8 $hashables]] + + switch -- $use_hash { + sha1 { + package require sha1 + set hash [sha1::sha1 [encoding convertto utf-8 $hashables]] + } + md5 { + package require md5 + if {[package vsatisfies [package present md5] 2- ] } { + set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review + } else { + set hash [md5::md5 [encoding convertto utf-8 $hashables]] + } + } + none { + set hash $hashables } - } else { - set hash $hashables } set cache_key "$hash-$frame_inner_width-$frame_inner_height-actualcontentwidth:$actual_contentwidth" @@ -7709,11 +7672,94 @@ tcl::namespace::eval textblock { set used [tcl::dict::get $frame_cache $cache_key used] tcl::dict::set frame_cache $cache_key used [expr {$used+1}] ;#update existing record set is_cached 1 - } + # -- --- --- --- --- --- --- --- --- if {!$is_cached} { + # -- --- --- --- --- + # -- --- --- --- --- + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + # -- --- --- --- --- --- + set is_boxmap_ok 1 + tcl::dict::for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + hltj - hlbj - vllj - vlrj {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" + } + # -- --- --- --- --- --- + #these are all valid commands for overtype:: + switch -- $opt_textalign { + left - right - centre - center {} + default { + error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" + } + } + # -- --- --- --- --- --- + switch -- $opt_blockalign { + left - right - centre - center {} + default { + error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" + } + } + # -- --- --- --- --- + # -- --- --- --- --- + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + #review vllj etc? + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + # -- --- --- --- --- --- + + set rst [a] #set column [tcl::string::repeat " " $frame_inner_width] ;#default - may need to override for custom frame set underlayline [tcl::string::repeat " " $frame_inner_width] @@ -8038,6 +8084,9 @@ tcl::namespace::eval textblock { ;#end !$is_cached } + + + #use the same mechanism to build the final frame - whether from cache or template if {$actual_contentwidth == 0} { set fs [tcl::string::map [list $FSUB " "] $template] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm index 3d454ca8..0ca26f39 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.1.tm @@ -9,7 +9,7 @@ namespace eval punk { zzzload::pkg_require $pkg } } - #lazyload twapi + #lazyload twapi ? catch {package require vfs} ;#attempt load now so we can use faster 'package provide' to test existence later } @@ -3670,7 +3670,7 @@ namespace eval punk { incr i } - #JMN2 + #JMN2 - review #set returnval [lindex $assigned_values 0] if {[llength $assigned_values] == 1} { set returnval [join $assigned_values] @@ -7271,55 +7271,59 @@ namespace eval punk { catch { package require patternpunk #lappend chunks [list stderr [>punk . rhs]] - append mascotblock [textblock::frame [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] + append mascotblock [textblock::frame -checkargs 0 [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] } set topic [lindex $args end] set argopts [lrange $args 0 end-1] - set text "" - append text "Punk core navigation commands:\n" + set title "[a+ brightgreen] Punk core navigation commands: " #todo - load from source code annotation? set cmdinfo [list] - lappend cmdinfo [list help "This help. To see available subitems type: help topics"] - lappend cmdinfo [list dev "(ensemble command to make new projects/modules and to generate docs)"] - lappend cmdinfo [list a? "view ANSI colours\n e.g a? web"] - lappend cmdinfo [list ./ "view/change directory"] - lappend cmdinfo [list ../ "go up one directory"] - lappend cmdinfo [list ./new "make new directory and switch to it"] - lappend cmdinfo [list n/ "view/change namespace (accepts ns path globs e.g **::*get* to match comands at any level )"] - lappend cmdinfo [list n// "view/change namespace (with command listing)"] - lappend cmdinfo [list nn/ "go up one namespace"] - lappend cmdinfo [list n/new "make child namespace and switch to it"] - - set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] - set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] - set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] - set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] + lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] + lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"] + lappend cmdinfo [list ./ "?subdir?" "view/change directory"] + lappend cmdinfo [list ../ "" "go up one directory"] + lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] + lappend cmdinfo [list n/ "?glob...?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match comands at any level )"] + lappend cmdinfo [list n// "" "view/change namespace (with command listing)"] + lappend cmdinfo [list "nn/" "" "go up one namespace"] + lappend cmdinfo [list "n/new" "" "make child namespace and switch to it"] + lappend cmdinfo [list dev "?subcommand?" "(ensemble command to make new projects/modules and to generate docs)"] + lappend cmdinfo [list a? "?subcommand...?" "view ANSI colours\n e.g a? web"] + + #set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] + #set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] + #set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] + #set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] set t [textblock::class::table new -show_seps 0] - foreach c $cmds d $descr { - #append text " [overtype::left $col1 $c][overtype::left $col2 $d]" \n - $t add_row [list $c $d] - } - set widest1 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$widest1 + 2}] - set widest2 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$widest2 + 1}] + #foreach c $cmds d $descr { + # $t add_row [list $c $d] + #} + foreach row $cmdinfo { + $t add_row $row + } + set width_0 [$t column_datawidth 0] + $t configure_column 0 -minwidth [expr {$width_0 + 2}] + set width_1 [$t column_datawidth 1] + $t configure_column 1 -minwidth [expr {$width_1 + 1}] + $t configure -title $title + + set text "" append text [$t print] set warningblock "" + set introblock $mascotblock + append introblock \n $text - if {[catch {package require textblock} errM]} { - set introblock $mascotblock - append introblock \n $text - append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" - - } else { - set introblock [textblock::join -- " " \n$mascotblock " " $text] - } + #if {[catch {package require textblock} errM]} { + # append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" + #} else { + # set introblock [textblock::join -- " " \n$mascotblock " " $text] + #} lappend chunks [list stdout $introblock] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index b616da59..1e52d3e9 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -132,14 +132,29 @@ tcl::namespace::eval punk::ansi::class { set rendered [overtype::renderspace -cp437 1 -expand_right 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] return $rendered } + + lappend ::punk::ansi::class::PUNKARGS [list { + *id "punk::ansi::class::class_ansi render_to_input_line" + *proc -name "punk::ansi::class::class_ansi render_to_input_line" -help\ + "render string from line 0 to line + (experimental/debug)" + -dimensions -type string -help\ + "WxH where W is integer width >= 1 and H is integer heigth >= 1" + -minus -type integer -help\ + "number of chars to exclude from end" + *values -min 1 -max 1 + line -type indexexpression + }] method render_to_input_line {args} { if {[llength $args] < 1} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set x [lindex $args end] set arglist [lrange $args 0 end-1] if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set opts [tcl::dict::create\ -dimensions 80x24\ @@ -322,6 +337,7 @@ tcl::namespace::eval punk::ansi::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ansi { + variable PUNKARGS #*** !doctools #[subsection {Namespace punk::ansi}] #[para] Core API functions for punk::ansi @@ -422,6 +438,8 @@ tcl::namespace::eval punk::ansi { erase*\ get_*\ hyperlink\ + hyperlink_open\ + hyperlink_close\ move*\ reset*\ ansistrip*\ @@ -554,21 +572,35 @@ tcl::namespace::eval punk::ansi { $obj destroy return $result } - proc example {args} { - set base [punk::repo::find_project] - set default_ansifolder [file join $base src/testansi] - set argd [punk::args::get_dict [tstr -return string { + proc Get_ansifolder {} { + if {[catch {punk::repo::find_project} base]} { + set base "" + } + if {$base eq ""} { + #pwd not avail in safe interp + if {![catch {pwd} CWD]} { + set base $CWD + } + } + return [file join $base src/testansi] + } + + lappend PUNKARGS [list -dynamic 1 { + *id punk::ansi::example *proc -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) You can specify a narrower width to truncate images on the right side" - -folder -default "${$default_ansifolder}" -help "Base folder for files if relative paths are used. + -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. Defaults to /src/testansi - where projectbase is determined from current directory. " *values -min 0 -max -1 files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" - }] $args] + } ""] + + proc example {args} { + set argd [punk::args::get_by_id punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -621,7 +653,7 @@ tcl::namespace::eval punk::ansi { set subtitle [tcl::dict::get $picinfo status] } set title [tcl::dict::get $picinfo filename] - set fr [textblock::frame -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] + set fr [textblock::frame -checkargs 0 -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] # -- --- --- --- #we need the max height of a row element to use join_basic instead of join below # -- --- --- --- @@ -2320,16 +2352,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off - proc sgr_cache {args} { - set argd [punk::args::get_dict { - *proc -name punk::ansi::sgr_cache -help "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " - -action -default "" -choices "clear" -help "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" - -pretty -default 1 -type boolean -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" + #punk::args depends on punk::ansi - REVIEW + proc sgr_cache {args} { + set argdef { + *id punk::ansi::sgr_cache + *proc -name punk::ansi::sgr_cache -help\ + "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) + " + -action -default "" -choices "clear" -help\ + "-action clear will unset the keys in the punk::ansi::sgr_cache dict + This is called automatically when setting 'colour false' in the console" + + -pretty -default 1 -type boolean -help\ + "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" *values -min 0 -max 0 - } $args] + } + set argd [punk::args::get_dict $argdef $args] set action [dict get $argd opts -action] set pretty [dict get $argd opts -pretty] @@ -2372,6 +2411,31 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return [join $lines \n] } + lappend PUNKARGS [list { + *id punk::ansi::a+ + *proc -name "punk::ansi::a+" -help\ + "Returns an ANSI sgr escape sequence based on the list of supplied codes. + " + *values -min 0 -max -1 + } [string map [list [dict keys $SGR_map]] { + code -type string -optional 1 -multiple 1 -choices {} -choiceprefix 0 -choicerestricted 0 -help\ + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- + + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web" + + }]] + proc a+ {args} { #*** !doctools #[call [fun a+] [opt {ansicode...}]] @@ -3267,17 +3331,49 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # REVIEW - osc8 replays etc for split lines? - textblock + #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda #the 'id' parameter logically connects split hyperlinks + #per interp. Rather than try to avoid collisions using something like 'info cmdcount' we will use a simple counter. + #To stop multiple hyperlinks from having ids inadvertently collide - we should do some id mangling/prefixing based on the terminal/window etc + #It is better to use a simple counter with high likelihood of collision so we are more likely to detect problems with ids than to make it more intermittent by using ids that collide only 'rarely' + variable hyperlinkcounter + set hyperlinkcounter 0 + + proc hyperlink {uri {display ""}} { + variable hyperlinkcounter if {$display eq ""} { set display $uri } - set params "" ;#todo e.g id=xyz123:foo=bar:baz=quux + set uri [punk::ansi::ansistripraw $uri] + #limit uri length we emit based on common limits in other terminals + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set params "id=punkansi-[incr hyperlinkcounter]" ;#todo e.g id=xyz123:foo=bar:baz=quux set open "\x1b\]8\;$params\;$uri\x1b\\" set close "\x1b\]8\;\;\x1b\\" return ${open}${display}${close} } + #on windows terminal at least, both uri and id of 2 separated hyperlinks need to match for the hover highlighting to act as a unit. + proc hyperlink_open {uri {id ""}} { + if {$id eq ""} { + set id punkansi-[incr hyperlinkcounter] + } + set uri [punk::ansi::ansistripraw $uri] + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set id [string map {: . {;} ,} $id] ;#avoid some likely problematic ids. TODO - review, restrict further. + set params "id=$id" + return "\x1b\]8\;$params\;$uri\x1b\\" + } + #It should be ok to close even if no currently active hyperlink (e.g can be used to cleanup if something awry) + proc hyperlink_close {} { + return "\x1b\]8\;\;\x1b\\" + } + # -- --- --- --- --- proc move {row col} { #*** !doctools @@ -3837,11 +3933,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun ansistrip] [arg text] ] #[para]Return a string with ansi codes stripped out #[para]Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs) - + if {[string length $text] < 2} {return $text} if {[punk::ansi::ta::detect_g0 $text]} { set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters } + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] + if {[llength $parts] == 1} {return [lindex $parts 0]} set out "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" # - (if/when lsearch -stride bug fixed) @@ -3871,6 +3969,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Return a string with ansi codes stripped out #[para]Alternate graphics modes will be stripped rather than converted to unicode - exposing the raw ascii characters as they appear without graphics mode. #[para]ie instead of a horizontal line you may see: qqqqqq + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] set out "" @@ -7294,6 +7393,13 @@ tcl::namespace::eval punk::ansi::internal { } } +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set NAMESPACES [list] + } +} +lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::ansi [tcl::namespace::eval punk::ansi { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm index b2854093..c087ae0b 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/args-0.1.0.tm @@ -84,7 +84,7 @@ # *values -min 2 -max 2 # fileA -type existingfile 1 # fileB -type existingfile 1 -# } $args]] opts values +# } $args]] leaders opts values # puts "$category fileA: [dict get $values fileA]" # puts "$category fileB: [dict get $values fileB]" # } @@ -218,49 +218,45 @@ package require Tcl 8.6- #*** !doctools #[section API] -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# oo::class namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval punk::args::class { +tcl::namespace::eval punk::args::register { #*** !doctools - #[subsection {Namespace punk::args::class}] - #[para] class definitions - if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { - #*** !doctools - #[list_begin enumerated] - - # oo::class create interface_sample1 { - # #*** !doctools - # #[enum] CLASS [class interface_sample1] - # #[list_begin definitions] + #[subsection {Namespace punk::args}] + #[para] cooperative namespace punk::args::register + #[para] punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded + #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. + #[list_begin definitions] - # method test {arg1} { - # #*** !doctools - # #[call class::interface_sample1 [method test] [arg arg1]] - # #[para] test method - # puts "test: $arg1" - # } + # -- --- --- --- --- --- --- --- + #cooperative with packages that define some punk args but may need to do so lazily + #These could be loaded prior to punk::args being loaded + variable NAMESPACES + if {![info exists ::punk::args::register::NAMESPACES]} { + set NAMESPACES [list] + } + # -- --- --- --- --- --- --- --- - # #*** !doctools - # #[list_end] [comment {-- end definitions interface_sample1}] - # } - #*** !doctools - #[list_end] [comment {--- end class enumeration ---}] - } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::register ---}] } -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args { + + + variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::definition at the end. + tcl::namespace::export {[a-z]*} - variable argspec_cache - variable argspec_ids + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved variable id_counter - set argspec_cache [tcl::dict::create] - set argspec_ids [tcl::dict::create] + set argdata_cache [tcl::dict::create] + set argdefcache_by_id [tcl::dict::create] + set argdefcache_unresolved [tcl::dict::create] set id_counter 0 #*** !doctools @@ -271,72 +267,127 @@ tcl::namespace::eval punk::args { #todo - some sort of punk::args::cherrypick operation to get spec from an existing set #todo - doctools output from definition - #dict get value with default wrapper for tcl 8.6 - if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef - proc Dict_getdef {dictValue args} { - set keys [lrange $args 0 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] - } - } - } else { - #we pay a minor perf penalty for the wrap - interp alias "" ::punk::args::Dict_getdef "" ::tcl::dict::getdef - } - - #name to reflect maintenance - home is punk::lib::ldiff - proc punklib_ldiff {fromlist removeitems} { - if {[llength $removeitems] == 0} {return $fromlist} - set result {} - foreach item $fromlist { - if {$item ni $removeitems} { - lappend result $item - } - } - return $result - } - proc flatzip {l1 l2} { - concat {*}[lmap a $l1 b $l2 {list $a $b}] - } - if {[info commands lseq] ne ""} { - #tcl 8.7+ lseq significantly faster, especially for larger ranges - #The internal rep can be an 'arithseries' with no string representation - proc zero_to_n {n} { - lseq 0 $n - } - } else { - proc zero_to_n {n} { - lsearch -all [lrepeat $n 0] * - } - } #todo? -synonym/alias ? (applies to opts only not values) #e.g -background -aliases {-bg} -default White - #review - how to make work with trie prefix e.g -corner -aliases {-corners} + #review - how to make work with trie prefix + #e.g + # -corner -aliases {-corners} + # -centre -aliases {-center -middle} #We mightn't want the prefix to be longer just because of an alias + #we should get -co -ce and -m from the above as abbreviations + + lappend PUNKARGS [list { + *id punk::args::definition + *proc -name punk::args::definition -help\ + "Accepts a line-based definition of command arguments. + The definition should usually contain a line of the form: *id someid + " + -dynamic -type boolean -default 0 -help\ + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is not usually significant, perhaps on the order of a few hundred uS, + but -dynamic true might be less desirable if the command is used in inner + loops in more performance-sensitive code. + " + *values -min 1 -max -1 + text -type string -multiple 1 -help\ + "Block(s) of text representing the argument specification for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + e.g + definition { + *id myns::myfunc + *proc -name myns::myfunc -help\\ + \"Description of command\" + + #The following option defines an option-value pair + -option1 -default blah -type string + #The following option defines a flag style option (solo) + -flag1 -default 0 -type none -help\\ + \"Info about flag1\" + + *values -min 1 -max -1 + #Items that don't begin with * or - are value definitions + v1 -type integer -default 0 + thinglist -type string -multiple 1 + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + " + }] + proc definition {args} { + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved + - proc definition {optionspecs args} { - variable argspec_cache - #variable argspecs ;#REVIEW!! - variable argspec_ids #variable initial_optspec_defaults #variable initial_valspec_defaults #ideally we would use a fast hash algorithm to produce a short key with low collision probability. #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. #review - check if there is a built-into-tcl way to do this quickly #for now we will just key using the whole string - set cache_key $optionspecs - if {[tcl::dict::exists $argspec_cache $cache_key]} { - return [tcl::dict::get $argspec_cache $cache_key] + + set cache_key $args + set textargs $args + + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] + set textargs [lrange $args 2 end] } - set optionspecs [tcl::string::map [list \r\n \n] $optionspecs] + if {!$is_dynamic} { + if {[tcl::dict::exists $argdata_cache $cache_key]} { + return [tcl::dict::get $argdata_cache $cache_key] + } + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + if {[string first \$\{ $optionspecs] > 0} { + set optionspecs [uplevel 1 [list punk::args::lib::tstr -return string -eval 1 $optionspecs]] + } + } else { + if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { + set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + } else { + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + #REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?) + if {[string first \$\{ $optionspecs] > 0} { + set pt_params [punk::args::lib::tstr -return list -eval 0 $optionspecs] ;#-eval 0 - no need to uplevel + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + tcl::dict::set argdefcache_unresolved $cache_key $pt_params + } + } + if {[tcl::dict::exists $argdata_cache $optionspecs]} { + #resolved cache version exists + return [tcl::dict::get $argdata_cache $optionspecs] + } + } + + + #probably faster to inline a literal dict create in the proc than to use a namespace variable set optspec_defaults [tcl::dict::create\ -type string\ @@ -381,7 +432,7 @@ tcl::namespace::eval punk::args { #default to 1 for convenience #checks with no default - #-minlen -maxlen -range + #-minsize -maxsize -range #default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi @@ -473,14 +524,19 @@ tcl::namespace::eval punk::args { } set proc_info {} set id_info {} ;#e.g -children ?? - set leader_min 0 - set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set doc_info {} + set parser_info {} + set leader_min "" + #set leader_min 0 + #set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set leader_max "" #(common case of no leaders specified) set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit set spec_id "" set argspace "leaders" ;#leaders -> options -> values + set parser_id 0 foreach ln $records { set trimln [tcl::string::trim $ln] switch -- [tcl::string::index $trimln 0] { @@ -510,10 +566,45 @@ tcl::namespace::eval punk::args { error "punk::args::definition - bad *id line. Remaining items on line after *id must be in paired option-value format - received '$linespecs'" } } + parser { + #handle multiple parsing styles based on arities and keyword positions (and/or flags?) + #e.g see lseq manual with 3 different parsing styles. + #aim to produce a table/subtable for each + # *parser -description "start ?('..'|'to')? end ??'by'? step?"\ + # -arities { + # 2 + # {3 anykeys {1 .. 1 to}} + # {4 anykeys {3 by}} + # {5 anykeys {1 .. 1 to 3 by}} + # }\ + # -fallback 1 + # ... + # *parser -description "start 'count' count ??'by'? step?"\ + # -arities { + # {3 anykeys {1 count}} + # } + # ... + # *parser -description "count ?'by' step?"\ + # -arities { + # 1 + # {3 anykeys {1 by}} + # } + # + # see also after manual + # *parser -arities {1} + # *parser -arities { + # 1 anykeys {0 info} + # } + #todo + set parser_info $starspecs + } proc { #allow arbitrary - review set proc_info $starspecs } + doc { + set doc_info $starspecs + } opts { if {$argspace eq "values"} { error "punk::args::definition - *opts declaration must come before *values - received '$linespecs'" @@ -525,13 +616,14 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { #review - only apply to certain types? tcl::dict::set optspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels - -nocase { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels - -nocase { if {$v} { - tcl::dict::unset optspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset optspec_defaults $k2 } } -type { @@ -563,16 +655,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { #allow overriding of defaults for options that occur later tcl::dict::set optspec_defaults $k $v } default { - set known { -any -anyopts -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *opts line. Known keys: $known" } @@ -588,27 +681,28 @@ tcl::namespace::eval punk::args { -min - -minvalues { if {$v < 0} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is 0. got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is 0. got $v" } set leader_min $v - if {$leader_max == 0} { - set leader_max -1 - } + #if {$leader_max == 0} { + # set leader_max -1 + #} } -max - -maxvalues { if {$v < -1} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is -1 (indicating unlimited). got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is -1 (indicating unlimited). got $v" } set leader_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set leaderspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset leaderspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset leaderspec_defaults $k2 } } -type { @@ -640,16 +734,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set leaderspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *leaders line. Known keys: $known" } @@ -675,13 +770,14 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set valspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset valspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset valspec_defaults $k2 } } -type { @@ -713,16 +809,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set valspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *values line. Known keys: $known" } @@ -754,7 +851,7 @@ tcl::namespace::eval punk::args { if {$argspace eq "leaders"} { tcl::dict::set argspecs -ARGTYPE leader lappend leader_names $argname - if {$leader_max == 0} { + if {$leader_max >= 0} { set leader_max [llength $leader_names] } } else { @@ -819,11 +916,12 @@ tcl::namespace::eval punk::args { } } } - -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - + -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - - -regexprepass - -regexprefail + -regexprepass - -regexprefail - -regexprefailmsg { - #review -solo 1 vs -type none ? + #inverses '-noxxx' (e.g -nochoices -nominsize etc) don't apply to specific args - only to *leaders *opts *values lines + #review -solo 1 vs -type none ? conflicting values? tcl::dict::set spec_merged $spec $specval } -validationtransform { @@ -833,10 +931,10 @@ tcl::namespace::eval punk::args { } dict for {tk tv} $specval { switch -- $tk { - -function - -type - -minlen - -maxlen - -range { + -function - -type - -minsize - -maxsize - -range { } default { - set known_transform_keys [list -function -type -minlen -maxlen -range] ;#-choices etc? + set known_transform_keys [list -function -type -minsize -maxsize -range] ;#-choices etc? error "punk::args::definition - invalid subkey $tk for key '$spec' in specifications for argument '$argname' must be one of: $known_transform_keys" } } @@ -844,9 +942,9 @@ tcl::namespace::eval punk::args { } default { - set known_argspecs [list -default -type -range -choices -choiceprefix -choicerestricted\ + set known_argspecs [list -default -type -range -minsize -maxsize -choices -choiceprefix -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] error "punk::args::definition - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } @@ -854,9 +952,9 @@ tcl::namespace::eval punk::args { } set argspecs $spec_merged if {$is_opt} { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } else { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } tcl::dict::set arg_info $argname $argspecs tcl::dict::set arg_checks $argname $argchecks @@ -886,11 +984,21 @@ tcl::namespace::eval punk::args { } # REVIEW - foreach leadername [lrange $leader_names 0 end] { - if {[tcl::dict::get $arg_info $leadername -multiple]} { - error "bad key -multiple on argument spec for leader '$valname'. Only the last value argument specification can be marked -multiple" + #if {[llength $val_names] || $val_min > 0} { + # #some values are specified + # foreach leadername [lrange $leader_names 0 end] { + # if {[tcl::dict::get $arg_info $leadername -multiple]} { + # error "bad key -multiple on argument spec for leader '$leadername'. Last leader argument specification can be marked -multiple only when no values are specified" + # } + # } + #} else { + #no values specified - we can allow last leader to be multiple + foreach leadername [lrange $leader_names 0 end-1] { + if {[tcl::dict::get $arg_info $leadername -multiple]} { + error "bad key -multiple on argument spec for leader '$leadername'. Only the last leader argument specification can be marked -multiple" + } } - } + #} #confirm any valnames before last don't have -multiple key foreach valname [lrange $val_names 0 end-1] { if {[tcl::dict::get $arg_info $valname -multiple]} { @@ -906,11 +1014,11 @@ tcl::namespace::eval punk::args { #todo - do some checks for obvious bad definitions involving a mix of *leaders and *values (e.g with optional options) - set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize - set result [tcl::dict::create\ + set argdata_dict [tcl::dict::create\ id $spec_id\ arg_info $arg_info\ arg_checks $arg_checks\ @@ -936,24 +1044,31 @@ tcl::namespace::eval punk::args { valspec_defaults $valspec_defaults\ val_checks_defaults $val_checks_defaults\ proc_info $proc_info\ + doc_info $doc_info\ id_info $id_info\ ] - tcl::dict::set argspec_cache $cache_key $result - #tcl::dict::set argspecs $spec_id $optionspecs - tcl::dict::set argspec_ids $spec_id $optionspecs + tcl::dict::set argdata_cache $cache_key $argdata_dict + if {$is_dynamic} { + #also cache resolved version + tcl::dict::set argdata_cache $optionspecs $argdata_dict + } + #tcl::dict::set argdefcache_by_id $spec_id $optionspecs + tcl::dict::set argdefcache_by_id $spec_id $args #puts "xxx:$result" - return $result + return $argdata_dict } proc get_spec {id {patternlist *}} { - variable argspec_ids - if {[tcl::dict::exists $argspec_ids $id]} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { if {$patternlist eq "*"} { - return [tcl::dict::get $argspec_ids $id] + #todo? + return [tcl::dict::get $argdefcache_by_id $realid] } else { - set spec [tcl::dict::get $argspec_ids $id] + set speclist [tcl::dict::get $argdefcache_by_id $realid] set result "" - set specdict [definition $spec] + set specdict [uplevel 1 [list ::punk::args::definition {*}$speclist]] set arg_info [dict get $specdict arg_info] foreach pat $patternlist { set matches [dict keys $arg_info $pat] @@ -968,13 +1083,128 @@ tcl::namespace::eval punk::args { } return } + proc get_spec_values {id {patternlist *}} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { + set speclist [tcl::dict::get $argdefcache_by_id $realid] + set specdict [definition {*}$speclist] + set arg_info [dict get $specdict arg_info] + set valnames [dict get $specdict val_names] + set result "" + if {$patternlist eq "*"} { + foreach v $valnames { + set def [dict get $arg_info $v] + set def [dict remove $def -ARGTYPE] + append result \n "$v $def" + } + } else { + foreach pat $patternlist { + set matches [dict keys $arg_info $pat] + set matches [lsearch -all -inline -glob $valnames $pat] + foreach m $matches { + set def [dict get $arg_info $m] + set def [dict remove $def -ARGTYPE] + append result \n "$m $def" + } + } + return $result + } + } + return + } #proc get_spec_leaders ?? #proc get_spec_opts ?? - #proc get_spec_values ?? - proc get_spec_ids {{match *}} { - variable argspec_ids - return [tcl::dict::keys $argspec_ids $match] + variable aliases + set aliases [dict create] + + lappend PUNKARGS [list { + *id punk::args::get_ids + *proc -name punk::args::get_ids -help\ + "return list of ids for argument definitions" + *values -min 0 -max 1 + match -default * -help\ + "exact id or glob pattern for ids" + }] + proc get_ids {{match *}} { + variable argdefcache_by_id + variable aliases + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + } + proc id_exists {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + return 1 + } + tcl::dict::exists $argdefcache_by_id $id + } + proc set_alias {alias id} { + variable aliases + dict set aliases $alias $id + } + proc unset_alias {alias} { + variable aliases + dict unset aliases $alias + } + proc get_alias {alias} { + variable aliases + if {[dict exists $aliases $alias]} { + return [tcl::dict::get $aliases $alias] + } + } + + proc real_id {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } else { + if {![llength [update_definitions]]} { + return "" + } else { + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } + return "" + } + } + } + + variable loaded_packages + set loaded_packages [list] + + proc update_definitions {} { + variable loaded_packages + upvar ::punk::args::register::NAMESPACES pkgs + if {[llength $loaded_packages] == [llength $pkgs]} { + #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + return {} + } + set unloaded [punklib_ldiff $pkgs $loaded_packages] + set newloaded [list] + foreach pkgns $unloaded { + if {![catch { + if {[info exists ${pkgns}::PUNKARGS]} { + foreach deflist [set ${pkgns}::PUNKARGS] { + namespace eval $pkgns [list punk::args::definition {*}$deflist] + } + } + } errMsg]} { + lappend loaded_pkgs $pkgns + lappend newloaded $pkgns + } else { + puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" + } + } + return $newloaded } #for use within get_dict only @@ -1018,253 +1248,408 @@ tcl::namespace::eval punk::args { #basic recursion blocker variable arg_error_isrunning 0 - proc arg_error {msg spec_dict {badarg ""}} { + proc arg_error {msg spec_dict args} { + if {[catch {package require punk::ansi}]} { + proc punk::args::a {args} {} + proc punk::args::a+ {args} {} + } else { + namespace eval ::punk::args { + namespace import ::punk::ansi::a ::punk::ansi::a+ + } + } #limit colours to standard 16 so that themes can apply to help output variable arg_error_isrunning if {$arg_error_isrunning} { - error "arg_error already running - error in arg_error?\n triggering errmsg: $badarg" + error "arg_error already running - error in arg_error?\n triggering errmsg: $msg" } set arg_error_isrunning 1 + if {[llength $args] %2 != 0} { + error "error in arg_error processing - expected opt/val pairs after msg and spec_dict" + } + set badarg "" + set returntype error + dict for {k v} $args { + switch -- $k { + -badarg { + set badarg $v + } + -return { + if {$v ni {error string}} { + error "arg_error invalid value for option -return. Received '$v' expected one of: error string" + } + set returntype $v + } + default { + error "arg_error invalid option $k. Known_options: -badarg -return" + } + } + } + + #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error #e.g list_as_table # use basic colours here to support terminals without extended colours - #todo - add checks column (e.g -minlen -maxlen) + #todo - add checks column (e.g -minsize -maxsize) set errmsg $msg if {![catch {package require textblock}]} { - if {[catch { + set has_textblock 1 + } else { + set has_textblock 0 + #couldn't load textblock package + #just return the original errmsg without formatting + } + set errlines [list] ;#for non-textblock output + if {[catch { + if {$has_textblock} { append errmsg \n - set procname [::punk::args::Dict_getdef $spec_dict proc_info -name ""] - set prochelp [::punk::args::Dict_getdef $spec_dict proc_info -help ""] + } else { + append errmsg \n "[a+ brightred](layout package textblock is missing)[a]" \n + } + set procname [Dict_getdef $spec_dict proc_info -name ""] + set prochelp [Dict_getdef $spec_dict proc_info -help ""] - set t [textblock::class::table new [a+ brightyellow]Usage[a]] + set docname [Dict_getdef $spec_dict doc_info -name "Manual:"] + set docurl [Dict_getdef $spec_dict doc_info -url ""] - set blank_header_col [list ""] - if {$procname ne ""} { - lappend blank_header_col "" - set procname_display [a+ brightwhite]$procname[a] - } else { - set procname_display "" - } - if {$prochelp ne ""} { - lappend blank_header_col "" - set prochelp_display [a+ brightwhite]$prochelp[a] - } else { - set prochelp_display "" - } + + set blank_header_col [list ""] + if {$procname ne ""} { + lappend blank_header_col "" + set procname_display [a+ brightwhite]$procname[a] + } else { + set procname_display "" + } + if {$prochelp ne ""} { + lappend blank_header_col "" + set prochelp_display [a+ brightwhite]$prochelp[a] + } else { + set prochelp_display "" + } + if {$docurl ne ""} { + lappend blank_header_col "" + set docurl_display [a+ white]$docurl[a] + } else { + set docurl_display "" + } + if {$has_textblock} { + set t [textblock::class::table new [a+ brightyellow]Usage[a]] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col - if {"$procname$prochelp" eq ""} { - $t configure_header 0 -values {Arg Type Default Multi Help} - } elseif {$procname eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 1 -values {Arg Type Default Multi Help} - } elseif {$prochelp eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -values {Arg Type Default Multi Help} + } + set h 0 + if {$procname ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] + } else { + lappend errlines "PROC/METHOD: $procname_display" + } + incr h + } + if {$prochelp ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] } else { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 2 -values {Arg Type Default Multi Help} + lappend errlines "Description: $prochelp_display" + } + incr h + } + if {$docurl ne ""} { + if {![catch {package require punk::ansi}]} { + set docurl [punk::ansi::hyperlink $docurl] } + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list $docname $docurl_display] + } else { + lappend errlines "$docname $docurl_display" + } + incr h + } + if {$has_textblock} { + $t configure_header $h -values {Arg Type Default Multi Help} + } else { + lappend errlines " --ARGUMENTS-- " + } + + set RST [a] + #set A_DEFAULT [a+ brightwhite Brightgreen] + set A_DEFAULT "" + set A_BADARG [a+ brightred] + set greencheck [a+ brightgreen]\u2713[a] ;#green tick + set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set A_PREFIX [a+ green] ;#use a+ so colour off can apply + if {$A_PREFIX eq ""} { + set A_PREFIX [a+ underline] + set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + } else { + set A_PREFIXEND $RST + } - set RST [a] - #set A_DEFAULT [a+ brightwhite Brightgreen] - set A_DEFAULT "" - set A_BADARG [a+ brightred] - set greencheck [a+ brightgreen]\u2713[a] ;#green tick - set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) - set A_PREFIX [a+ green] ;#use a+ so colour off can apply - if {$A_PREFIX eq ""} { - set A_PREFIX [a+ underline] - set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + set opt_names [list] + set opt_names_display [list] + if {[llength [dict get $spec_dict opt_names]]} { + if {![catch {package require punk::trie}]} { + set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $spec_dict opt_names] { + set id [dict get $idents $c] + #REVIEW + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail + #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] + lappend opt_names $c + } } else { - set A_PREFIXEND $RST + set opt_names [dict get $spec_dict opt_names] + set opt_names_display $opt_names } - - set opt_names [list] - set opt_names_display [list] - if {[llength [dict get $spec_dict opt_names]]} { - if {![catch {package require punk::trie}]} { - set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy - foreach c [dict get $spec_dict opt_names] { - set id [dict get $idents $c] - #REVIEW - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] - } - lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail - #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] - lappend opt_names $c - } + } + set leading_val_names [dict get $spec_dict leader_names] + set trailing_val_names [dict get $spec_dict val_names] + + #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { + # if {![string match -* $argname]} { + # lappend leading_val_names [lpop trailing_val_names 0] + # } else { + # break + # } + #} + #if {![llength $leading_val_names] && ![llength $opt_names]} { + # #all vals were actually trailing - no opts + # set trailing_val_names $leading_val_names + # set leading_val_names {} + #} + set leading_val_names_display $leading_val_names + set trailing_val_names_display $trailing_val_names + + #display options first then values + foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { + lassign $argumentset argnames_display argnames + + foreach argshow $argnames_display arg $argnames { + set arginfo [dict get $spec_dict arg_info $arg] + if {[dict exists $arginfo -default]} { + set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" } else { - set opt_names [dict get $spec_dict opt_names] - set opt_names_display $opt_names + set default "" } - } - set leading_val_names [dict get $spec_dict leader_names] - set trailing_val_names [dict get $spec_dict val_names] - - #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { - # if {![string match -* $argname]} { - # lappend leading_val_names [lpop trailing_val_names 0] - # } else { - # break - # } - #} - #if {![llength $leading_val_names] && ![llength $opt_names]} { - # #all vals were actually trailing - no opts - # set trailing_val_names $leading_val_names - # set leading_val_names {} - #} - set leading_val_names_display $leading_val_names - set trailing_val_names_display $trailing_val_names - - #display options first then values - foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { - lassign $argumentset argnames_display argnames - - foreach argshow $argnames_display arg $argnames { - set arginfo [dict get $spec_dict arg_info $arg] - if {[dict exists $arginfo -default]} { - set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" + set help [Dict_getdef $arginfo -help ""] + if {[dict exists $arginfo -choices]} { + if {$help ne ""} {append help \n} + if {[dict get $arginfo -nocase]} { + set casemsg " (case insensitive)" } else { - set default "" + set casemsg " (case sensitive)" } - set help [::punk::args::Dict_getdef $arginfo -help ""] - if {[dict exists $arginfo -choices]} { - if {$help ne ""} {append help \n} - if {[dict get $arginfo -nocase]} { - set casemsg " (case insensitive)" - } else { - set casemsg " (case sensitive)" - } - if {[dict get $arginfo -choiceprefix]} { - set prefixmsg " (choice prefix allowed)" + if {[dict get $arginfo -choiceprefix]} { + set prefixmsg " (choice prefix allowed)" + } else { + set prefixmsg "" + } + set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] + set formattedchoices [list] + append help " Choices$prefixmsg$casemsg" + if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + #append help "\n " [join [dict get $arginfo -choices] "\n "] + if {[dict size $choicelabeldict]} { + foreach c [dict get $arginfo -choices] { + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } } else { - set prefixmsg "" + set formattedchoices [dict get $arginfo -choices] } - set formattedchoices [list] - append help " Choices$prefixmsg$casemsg" - if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + } else { + if {[catch { + set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $arginfo -choices] { + set id [dict get $idents $c] + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + set cdisplay "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } + } errM]} { + puts stderr "prefix marking failed\n$errM" #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - } else { - if {[catch { - set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy + if {[dict size $choicelabeldict]} { foreach c [dict get $arginfo -choices] { - set id [dict get $idents $c] - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] } - lappend formattedchoices "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" - } - } errM]} { - puts stderr "prefix marking failed\n$errM" - #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - - } - } - set numcols 4 - if {[llength $formattedchoices] < $numcols} { - #don't show blank cells if single line of results - set numcols [llength $formattedchoices] - } - #risk of recursing - set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] - append help \n[textblock::join -- " " $choicetable] - #review. use -type to restrict additional choices - may be different to values in the -choices - if {![dict get $arginfo -choicerestricted]} { - if {[dict get $arginfo -type] eq "string"} { - append help "\n (values not in defined choices are allowed)" + lappend formattedchoices $cdisplay + } } else { - append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + set formattedchoices [dict get $arginfo -choices] } + } } - if {[::punk::args::Dict_getdef $arginfo -multiple 0]} { - set multiple $greencheck - } else { - set multiple "" + set numcols 4 ;#todo - dynamic? + if {[llength $formattedchoices] < $numcols} { + #don't show blank cells if single line of results + set numcols [llength $formattedchoices] } - if {[::punk::args::Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { - set argshow "?${argshow}?" + if {$numcols > 0} { + if {$has_textblock} { + #risk of recursing + set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] + append help \n[textblock::join -- " " $choicetable] + } else { + append help \n [join $formattedchoices \n] + } + } else { + #we were given an empty set of choices. + #probably an error in the definition - but could happen if dynamically generated. + #(e.g ensemble where unknown mechanism is used for subcommands?) + #better to just display that there were none rather than totally break the usage output. + append help \n " " [a+ red](no choices defined)[a] } - set typeshow [dict get $arginfo -type] - if {$typeshow eq "none"} { - set typeshow "$typeshow $soloflag" + + #review. use -type to restrict additional choices - may be different to values in the -choices + if {![dict get $arginfo -choicerestricted]} { + if {[dict get $arginfo -type] eq "string"} { + append help "\n (values not in defined choices are allowed)" + } else { + append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + } } + } + if {[Dict_getdef $arginfo -multiple 0]} { + set multiple $greencheck + } else { + set multiple "" + } + if {[Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { + set argshow "?${argshow}?" + } + set typeshow [dict get $arginfo -type] + if {$typeshow eq "none"} { + set typeshow "$typeshow $soloflag" + } + if {[dict exists $arginfo -minsize]} { + append typeshow \n "-minsize [dict get $arginfo -minsize]" + } + if {[dict exists $arginfo -maxsize]} { + append typeshow \n "-maxsize [dict get $arginfo -maxsize]" + } + if {[dict exists $arginfo -range]} { + append typeshow \n "-range [dict get $arginfo -range]" + } + + if {$has_textblock} { $t add_row [list $argshow $typeshow $default $multiple $help] if {$arg eq $badarg} { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_BADARG } + } else { + #review - formatting will be all over the shop due to newlines in typesshow, help + lappend errlines "$argshow TYPE:$typeshow DEFAULT:$default MULTI:$multiple HELP:$help\n" } } + } - - #$t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ web-white] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] + if {$has_textblock} { $t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ brightwhite] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] $t configure -maxwidth 80 append errmsg [$t print] $t destroy - } errM]} { - catch {$t destroy} - append errmsg \n - append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n - append errmsg "$errM" \n - append errmsg "$::errorInfo" - + } else { + append errmsg [join $errlines \n] } - } else { - #couldn't load textblock package - #just return the original errmsg without formatting + } errM]} { + catch {$t destroy} + append errmsg \n + append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n + append errmsg "$errM" \n + append errmsg "$::errorInfo" + } set arg_error_isrunning 0 #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. #Also,we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;) - return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + if {$returntype eq "error"} { + return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + } else { + return $errmsg + } } - #todo - a version of get_dict that supports punk::lib::tstr templating - #rename get_dict - #provide ability to look up and reuse definitions from ids etc - # + lappend PUNKARGS [list { + *id punk::args::usage + *proc -name punk::args::usage -help\ + "return usage information as a string + in table form." + *values -min 0 -max 1 + id -help\ + "exact id. + Will usually match the command name" + }] + proc usage {id} { + set speclist [get_spec $id] + if {[llength $speclist] == 0} { + error "punk::args::usage - no such id: $id" + } + arg_error "" [uplevel 1 [list punk::args::definition {*}$speclist]] -return string + } + + lappend PUNKARGS [list { + *id punk::args::get_by_id + *proc -name punk::args::get_by_id + *values -min 1 + id + arglist -default "" -type list -help\ + "list containing arguments to be parsed as per the + argument specification identified by the supplied id." + }] proc get_by_id {id {arglist ""}} { - set spec [get_spec $id] - if {$spec eq ""} { + set speclist [punk::args::get_spec $id] + if {[llength $speclist] == 0} { error "punk::args::get_by_id - no such id: $id" } - return [get_dict $spec $arglist] + return [uplevel 1 [list ::punk::args::get_dict {*}$speclist $arglist]] } + #todo? - a version of get_dict that directly supports punk::lib::tstr templating + #rename get_dict + # + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. #only supports -flag val pairs, not solo options #If an option is supplied multiple times - only the last value is used. - proc get_dict {optionspecs args} { + proc get_dict {args} { #*** !doctools - #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[call [fun get_dict] [arg optionspecs] [arg rawargs]] #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values #[para]Returns a dict of the form: opts values #[para]ARGUMENTS: @@ -1297,48 +1682,53 @@ tcl::namespace::eval punk::args { # *values -multiple 1 #} $args - if {[llength $args] == 0} { - set rawargs [list] - } elseif {[llength $args] ==1} { - set rawargs [lindex $args 0] ;#default tcl style - } else { - #todo - can we support tk style vals before flags? - #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order - #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. - #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options - #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. - #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. - error "unsupported number of arguments for punk::args::get_dict" - set inopt 0 - set k "" - set i 0 - foreach a $args { - switch -- $f { - -opts { - - } - -vals { - - } - -optvals { - #tk style - - } - -valopts { - #tcl style - set rawargs [lindex $args $i+1] - incr i - } - default { - - } - } - incr i - } + #if {[llength $args] == 0} { + # set rawargs [list] + #} elseif {[llength $args] ==1} { + # set rawargs [lindex $args 0] ;#default tcl style + #} else { + # #todo - can we support tk style vals before flags? + # #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + # #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + # #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + # #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + # #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + # error "unsupported number of arguments for punk::args::get_dict" + # set inopt 0 + # set k "" + # set i 0 + # foreach a $args { + # switch -- $f { + # -opts { + + # } + # -vals { + + # } + # -optvals { + # #tk style + + # } + # -valopts { + # #tcl style + # set rawargs [lindex $args $i+1] + # incr i + # } + # default { + + # } + # } + # incr i + # } + #} + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] } + set rawargs [lindex $args end] ;# args values to be parsed + set def_args [lrange $args 0 end-1] - - set argspecs [definition $optionspecs] + set argspecs [uplevel 1 [list ::punk::args::definition {*}$def_args]] tcl::dict::with argspecs {} ;#turn keys into vars #puts "-arg_info->$arg_info" set flagsreceived [list] ;#for checking if required flags satisfied @@ -1354,52 +1744,123 @@ tcl::namespace::eval punk::args { # todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ? set opts $opt_defaults set pre_values {} - #dict for {a info} $arg_info { - # #todo - flag for possible subhandler - whether leading - or not (shellfilter concept) - # if {![string match -* $a]} { - # #lappend pre_values [lpop rawargs 0] - # if {[catch {lpop rawargs 0} val]} { - # break - # } else { - # lappend pre_values $val - # } - # } else { - # break - # } - #} - set argnames [dict keys $arg_info] + set argnames [tcl::dict::keys $arg_info] set optnames [lsearch -all -inline $argnames -*] set ridx 0 set rawargs_copy $rawargs + set leader_posn_name "" + set leader_posn_names_assigned [dict create] ;#track if the name got a value (or multiple if last one) + set is_multiple 0 ;#last leader may be multi if {$leader_max != 0} { foreach r $rawargs_copy { - if {$leader_max != -1 && $ridx > $leader_max-1} { + if {$leader_max ne "" && $leader_max != -1 && $ridx > $leader_max-1} { break } - if {[string match -* $r]} { - if {$r eq "--"} { - break + if {$ridx == [llength $leader_names]-1} { + #at last named leader + set leader_posn_name [lindex $leader_names $ridx] + if {[dict exists $arg_info $leader_posn_name -multiple] && [dict get $arg_info $leader_posn_name -multiple]} { + set is_multiple 1 } + } elseif {$ridx > [llength $leader_names]-1} { + #beyond names - retain name if -multiple was true + if {!$is_multiple} { + set leader_posn_name "" + } + } else { + set leader_posn_name [lindex $leader_names $ridx] ;#may return empty string + } + if {$r eq "--"} { + #review end of opts marker: '--' can't be a leader (but can be a value) + break + } + + #argument such as a dictionary may have leading dash - test for whitespace to exclude as possible option + if {[tcl::string::match -* $r] && !([tcl::string::first " " $r]>=0 || [tcl::string::first \t $r]>=0 || [tcl::string::last \n $r]>=0)} { set matchopt [::tcl::prefix::match -error {} $optnames $r] if {$matchopt ne ""} { #flaglike matches a known flag - don't treat as leader break } - if {![string match -* [lindex $argnames $ridx]]} { + #if {![string match -* [lindex $argnames $ridx]]} {} + if {$leader_posn_name ne ""} { #there is a named leading positional for this position + #The flaglooking value doesn't match an option - so treat as a leader lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name incr ridx continue } else { break } } - lappend pre_values [lpop rawargs 0] + + #for each branch - break or lappend + if {$leader_posn_name ne ""} { + if {$leader_posn_name ni $leader_required} { + #optional leader + + #most adhoc arg processing will allocate based on number of args rather than matching choice values first + #(because a choice value could be a legitimate data value) + + #review - option to process in this manner? + #first check if the optional leader value is a match for a choice ? + #if {[dict exists $arg_info $leader_posn_name -choices]} { + # set vmatch [tcl::prefix match -error "" [dict get $arg_info $leader_posn_name -choices] [lindex $rawargs 0]] + # if {$vmatch ne ""} { + # #If we match a choice for this named position - allocated it regardless of whether enough args for trailing values + # lappend pre_values [lpop rawargs 0] + # incr ridx + # continue + # } + #} + + #check if enough rawargs to fill any required values + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } else { + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #required + if {[dict exists $leader_posn_names_assigned $leader_posn_name]} { + #already accepted at least one value - requirement satisfied - now equivalent to optional + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } + } + #if we didn't break - requirement is not yet satisfied, or is satisfied but stil enough rawargs for required values + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #unnamed leader + if {$leader_min ne "" } { + if {$ridx > $leader_min} { + break + } else { + #haven't reached leader_min + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + break + } + } + incr ridx } } + if {$leader_min eq ""} { + set leader_min 0 + } + if {$leader_max eq ""} { + set leader_max -1 + } + #assert leader_max leader_min are numeric #assert - rawargs has been reduced by leading positionals set leaders [list] @@ -1429,7 +1890,8 @@ tcl::namespace::eval punk::args { break } - if {[tcl::string::match -* $a]} { + #exlude argument with whitespace from being a possible option e.g dict + if {[tcl::string::match -* $a] && !([tcl::string::first " " $a]>=0 || [tcl::string::first \t $a]>=0 || [tcl::string::last \n $a]>=0)} { if {$a eq "--"} { #remaining num args <= val_min already covered above if {$val_max != -1} { @@ -1467,14 +1929,12 @@ tcl::namespace::eval punk::args { } set flagval [lindex $rawargs $i+1] - if {[dict get $arg_info $fullopt -multiple]} { + if {[tcl::dict::get $arg_info $fullopt -multiple]} { #don't lappend to default - we need to replace if there is a default - #review - what if user sets first value that happens to match a default? - if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} { - #first occurrence of this flag, whilst stored value matches default + if {$fullopt ni $flagsreceived} { tcl::dict::set opts $fullopt [list $flagval] } else { - tcl::dict::lappend opts $fullopt $flagval + tcl::dict::lappend opts $fullopt $flagval } } else { tcl::dict::set opts $fullopt $flagval @@ -1482,13 +1942,13 @@ tcl::namespace::eval punk::args { #incr i to skip flagval incr vals_remaining_possible -2 if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs $fullopt + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt } } else { #solo if {[tcl::dict::get $arg_info $fullopt -multiple]} { - if {[tcl::dict::get $opts $fullopt] == 0} { - #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + if {$fullopt ni $flagsreceived} { + #override any default - don't lappend to it tcl::dict::set opts $fullopt 1 } else { tcl::dict::lappend opts $fullopt 1 @@ -1526,7 +1986,7 @@ tcl::namespace::eval punk::args { } lappend flagsreceived $a ;#adhoc flag as supplied if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs $a + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a } incr vals_remaining_possible -2 } else { @@ -1543,9 +2003,12 @@ tcl::namespace::eval punk::args { incr vals_remaining_possible -1 } } else { - #set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] - set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" - arg_error $errmsg $argspecs $fullopt + if {[llength $opt_names]} { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" + } else { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": No options defined while *opts -any 0" + } + arg_error $errmsg $argspecs -badarg $fullopt } } } @@ -1571,6 +2034,7 @@ tcl::namespace::eval punk::args { set positionalidx 0 ;#index for unnamed positionals (both leaders and values) set ldridx 0 + set in_multiple "" set leadernames_received [list] set leaders_dict $leader_defaults set num_leaders [llength $leaders] @@ -1579,13 +2043,26 @@ tcl::namespace::eval punk::args { break } if {$leadername ne ""} { - tcl::dict::set leaders_dict $leadername $ldr + if {[tcl::dict::get $arg_info $leadername -multiple]} { + if {[tcl::dict::exists $leader_defaults $leadername]} { + tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list + } else { + tcl::dict::lappend leaders_dict $leadername $ldr + } + set in_multiple $leadername + } else { + tcl::dict::set leaders_dict $leadername $ldr + } lappend leadernames_received $leadername } else { - tcl::dict::set leaders_dict $positionalidx $ldr - tcl::dict::set arg_info $positionalidx $leaderspec_defaults - tcl::dict::set arg_checks $positionalidx $leader_checks_defaults - lappend leadernames_received $positionalidx + if {$in_multiple ne ""} { + tcl::dict::lappend leaders_dict $in_multiple $ldr + } else { + tcl::dict::set leaders_dict $positionalidx $ldr + tcl::dict::set arg_info $positionalidx $leaderspec_defaults + tcl::dict::set arg_checks $positionalidx $leader_checks_defaults + lappend leadernames_received $positionalidx + } } incr ldridx incr positionalidx @@ -1602,7 +2079,7 @@ tcl::namespace::eval punk::args { } if {$valname ne ""} { if {[tcl::dict::get $arg_info $valname -multiple]} { - if {[tcl::dict::exists $val_defaults $valname] && ([tcl::dict::get $val_defaults $valname] eq [tcl::dict::get $values_dict $valname])} { + if {[tcl::dict::exists $val_defaults $valname]} { #current stored val equals defined default - don't include default in the list we build up tcl::dict::set values_dict $valname [list $val] ;#important to treat first element as a list } else { @@ -1663,12 +2140,12 @@ tcl::namespace::eval punk::args { #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW + #We SHOULD? always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - #safe interp note - cannot avoid struct::set difference ensemble as it could be c or tcl implementation and we don't have an option to call directly? + #safe interp note - struct::set difference ensemble could be c or tcl implementation and we don't have an option to call directly? #example timing difference: #struct::set difference {x} {a b} #normal interp 0.18 u2 vs safe interp 9.4us @@ -1683,7 +2160,7 @@ tcl::namespace::eval punk::args { arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs } if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} { - arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs + arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs } if {[llength [set missing [punklib_ldiff $val_required $valnames_received]]]} { arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs @@ -1714,7 +2191,7 @@ tcl::namespace::eval punk::args { set type [tcl::dict::get $thisarg -type] set has_choices [tcl::dict::exists $thisarg -choices] set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [punk::args::Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 set validationtransform [tcl::dict::get $thisarg -validationtransform] @@ -1814,7 +2291,7 @@ tcl::namespace::eval punk::args { } else { set prefixmsg "" } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } } incr idx @@ -1868,21 +2345,21 @@ tcl::namespace::eval punk::args { list { foreach e_check $vlist_check { if {![tcl::string::is list -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[llength $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -minlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[llength $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -maxlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1922,28 +2399,33 @@ tcl::namespace::eval punk::args { foreach e $remaining_e e_check $remaining_e_check { #puts "----> checking $e vs regex $regexprefail" if {[regexp $regexprefail $e]} { - arg_error "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" $argspecs $argname + if {[tcl::dict::exists $thisarg -regexprefailmsg]} { + set msg [tcl::dict::get $thisarg -regexprefailmsg] + } else { + set msg "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" + } + arg_error $msg $argspecs -badarg $argname } } } switch -- $type { ansistring { - #we need to respect -validate_ansistripped for -minlen etc, but the string must contain ansi + #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi #.. so we need to look at the original values in $vlist not $vlist_check #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - #The ansicodes only case should be covered by -minlen 0 -maxlen 0 combined with -validate_ansistripped ??? + #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? package require punk::ansi foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { - arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname } } } globstring { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { - arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname } } } @@ -1955,16 +2437,16 @@ tcl::namespace::eval punk::args { #dict for {checkopt checkval} $thisarg_checks {} tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::string::length $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::string::length $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1981,31 +2463,31 @@ tcl::namespace::eval punk::args { if {$low eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #lowside unspecified - check only high if {$e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname } } } elseif {$high eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #highside unspecified - check only low if {$e_check < $low} { - arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname } } } else { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #high and low specified if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname } } } @@ -2013,7 +2495,7 @@ tcl::namespace::eval punk::args { } else { foreach e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname } } } @@ -2033,7 +2515,7 @@ tcl::namespace::eval punk::args { #todo - empty string for low or high lassign $checkval low high if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname } } } @@ -2044,28 +2526,28 @@ tcl::namespace::eval punk::args { bool { foreach e_check $vlist_check { if {![tcl::string::is boolean -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname } } } dict { foreach e_check $vlist_check { if {[llength $e_check] %2 != 0} { - arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::dict::size $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -minlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::dict::size $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -maxlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -2089,7 +2571,7 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname } } } @@ -2101,19 +2583,19 @@ tcl::namespace::eval punk::args { #//review - we may need '?' char on windows if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} { #what about special file names e.g on windows NUL ? - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname } } if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { if {![file exists $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname } } } elseif {$type eq "existingdirectory"} { foreach e $vlist e_check $vlist_check { if {![file isdirectory $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname } } } @@ -2121,7 +2603,7 @@ tcl::namespace::eval punk::args { char { foreach e $vlist e_check $vlist_check { if {[tcl::string::length $e_check] != 1} { - arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname } } } @@ -2161,7 +2643,14 @@ tcl::namespace::eval punk::args { #maintain order of opts $opts values $values as caller may use lassign. set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received] - set received_posns [concat {*}[lmap a $receivednames b [zero_to_n [expr {[llength $receivednames]-1}]] {list $a $b}]] ;#flat zip named with overall posn including opts + if {[llength $receivednames]} { + #flat zip of names with overall posn, including opts + #set received_posns [concat {*}[lmap a $receivednames b [zero_based_posns [llength $receivednames]] {list $a $b}]] + set i -1 + set received_posns [concat {*}[lmap a $receivednames {list $a [incr i]}]] + } else { + set received_posns [list] + } return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns] } @@ -2173,7 +2662,7 @@ tcl::namespace::eval punk::args { #} - punk::args::definition { + lappend PUNKARGS [list { *id punk::args::TEST *opts -optional 0 -o1 -default 111 -help "opt 1 mandatory" @@ -2182,7 +2671,7 @@ tcl::namespace::eval punk::args { *values -min 0 -max 1 v -help\ "v1 optional" - } + }] #*** !doctools @@ -2195,8 +2684,9 @@ tcl::namespace::eval punk::args { # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args::lib { + variable PUNKARGS tcl::namespace::export * - tcl::namespace::path [tcl::namespace::parent] + tcl::namespace::path [list [tcl::namespace::parent]] #*** !doctools #[subsection {Namespace punk::args::lib}] #[para] Secondary functions that are part of the API @@ -2209,6 +2699,284 @@ tcl::namespace::eval punk::args::lib { # return 1 #} + proc flatzip {l1 l2} { + concat {*}[lmap a $l1 b $l2 {list $a $b}] + } + + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster, especially for larger ranges + #The internal rep can be an 'arithseries' with no string representation + proc zero_based_posns {count} { + if {$count < 1} {return} + lseq 0 $count-1 + } + } else { + proc zero_based_posns {count} { + if {$count < 1} {return} + lsearch -all [lrepeat $count 0] * + } + } + + + #experiment with equiv of js template literals with ${expression} in templates + #e.g tstr {This is the value of x in calling scope ${$x} !} + #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} + #e.g tstr -allowcommands {This is the value of [lindex $x -1] in calling scope ${[lindex [set x] 0]} !} + lappend PUNKARGS [list { + *id punk::args::lib::tstr + *proc -name punk::args::lib::tstr -help\ + "A rough equivalent of js template literals" + -allowcommands -default -1 -type none -help\ + "if -allowcommands is present, placeholder can contain commands e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -return -default list -choices {dict list string args}\ + -choicelabels { + dict\ + "Return a dict with keys + 'template' and 'params'" + string\ + "Return a single result + being the string with + placeholders substituted." + list\ + "Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + "Return a list where the first + element is a list of template + plaintext secions as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" + } + -eval -default 1 -type boolean -help\ + "Whether to evaluate the \$\{\} placeholders. + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced, or the variable name is likely to collide + with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + *values -min 0 -max 1 + templatestring -help\ + "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + }] + + proc tstr {args} { + #Too hard to fully eat-our-own-dogfood from within punk::args package + # - we use punk::args within the unhappy path only + #set argd [punk::args::get_by_id punk::lib::tstr $args] + #set templatestring [dict get $argd values templatestring] + #set opt_allowcommands [dict get $argd opts -allowcommands] + #set opt_return [dict get $argd opts -return] + #set opt_eval [dict get $argd opts -eval] + + set templatestring [lindex $args end] + set arglist [lrange $args 0 end-1] + set opts [dict create\ + -allowcommands 0\ + -eval 1\ + -return list\ + ] + if {"-allowcommands" in $arglist} { + set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] + dict set opts -allowcommands 1 + } + if {[llength $arglist] % 2 != 0} { + error "punk::args::lib::tstr expected option/value pairs prior to last argument" + } + dict for {k v} $arglist { + set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + switch -- $fullk { + -return - -eval { + dict set opts $fullk $v + } + default { + error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" + } + } + } + set opt_allowcommands [dict get $opts -allowcommands] + set opt_return [dict get $opts -return] + set opt_eval [dict get $opts -eval] + + + set nocommands "-nocommands" + if {$opt_allowcommands == 1} { + set nocommands "" + } + + #set parts [_tstr_split $templatestring] + if {[string first \$\{ $templatestring] < 0} { + set parts [list $templatestring] + } else { + set parts [_parse_tstr_parts $templatestring] + } + set textchunks [list] + #set expressions [list] + set params [list] + set idx 0 + foreach {pt expression} $parts { + lappend textchunks $pt + incr idx ;#pt incr + + #ignore last expression + if {$idx == [llength $parts]} { + break + } + #lappend expressions $expression + if {$opt_eval} { + lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] + } else { + lappend params $expression + } + + incr idx ;#expression incr + } + switch -- $opt_return { + dict { + return [dict create template $textchunks params $params] + } + list { + return [list $textchunks $params] + } + args { + #see example in tstr_test_one + return [list $textchunks {*}$params] + } + string { + set out "" + foreach pt $textchunks param $params { + append out $pt $param + } + return $out + } + default { + } + } + } + #test single placeholder tstr args where single placeholder must be an int + proc tstr_test_one {args} { + set argd [punk::args::get_dict { + *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. + example: + set id 2 + tstr_test_one {*}[tstr -return args {Select * from table where id = \$\{$id\} and etc... ;}] + } + + *values -min 2 -max 2 + template -type list -minsize 2 -maxsize 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - + but the tstr call in the example does this for you, and also passes in the id automatically" + + where -type int -help {Integer param for where clause. tstr mechanism above will pass the id as the second parameter} + } $args] + set template [dict get $argd values template] + set where [dict get $argd values where] + #set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] + set result [string cat [lindex $template 0] $where [lindex $template 1]] + return $result + } + proc _parse_tstr_parts {templatestring} { + if {$templatestring eq ""} { + return [list] + } + set chars [split $templatestring ""] + set in_placeholder 0 + set tchars "" + set echars "" + set parts [list] + set i 0 + foreach ch $chars { + if {!$in_placeholder} { + set nextch [lindex $chars [expr {$i+1}]] + if {"$ch$nextch" eq "\$\{"} { + set in_placeholder 2 ;#2 to signify we just entered placeholder + lappend parts $tchars + set tchars "" + } else { + append tchars $ch + } + } else { + if {$ch eq "\}"} { + if {[tcl::info::complete $echars]} { + set in_placeholder 0 + lappend parts $echars + set echars "" + } else { + append echars $ch + } + } else { + if {$in_placeholder == 2} { + #skip opening bracket + set in_placeholder 1 + } else { + append echars $ch + } + } + } + incr i + } + if {$tchars ne ""} { + lappend parts $tchars + } + if {[llength $parts] % 2 == 0} { + #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list + lappend parts "" + } + return $parts + } + #based on punk::ansi::ta::_perlish_split + proc _tstr_split {text} { + if {$text eq ""} { + return {} + } + set list [list] + set start 0 + #ideally re should allow curlies within but we will probably need a custom parser to do it + #(js allows nested string interpolation) + #set re {\$\{[^\}]*\}} + set re {\$\{(?:(?!\$\{).)*\}} + + #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + puts "e:$matchEnd < s:$matchStart" + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] + incr start + if {$start >= [tcl::string::length $text]} { + break + } + continue + } + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] + set start [expr {$matchEnd+1}] + #? + if {$start >= [tcl::string::length $text]} { + break + } + } + return [lappend list [tcl::string::range $text $start end]] + } #*** !doctools @@ -2216,7 +2984,21 @@ tcl::namespace::eval punk::args::lib { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#usually we would directly call arg definitions near the defining proc, +# so that the proc could directly use the definition in its parsing. +# +#for punk::args we need to make sure the punk::args namespace is fully loaded before calling, so we do it at the end. +#arguably it may be more processor-cache-efficient to do together like this anyway. + +#can't do this - as there is circular dependency with punk::lib +#tcl::namespace::eval punk::args { +# foreach deflist $PUNKARGS { +# punk::args::definition {*}$deflist +# } +# set PUNKARGS "" +#} +lappend ::punk::args::register::NAMESPACES ::punk::args ::punk::args::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -2226,12 +3008,40 @@ tcl::namespace::eval punk::args::system { #[subsection {Namespace punk::args::system}] #[para] Internal functions that are not part of the API + #dict get value with default wrapper for tcl 8.6 + if {[info commands ::tcl::dict::getdef] eq ""} { + #package require punk::lib + #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef + proc Dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::args::system::Dict_getdef "" ::tcl::dict::getdef + } + #name to reflect maintenance - home is punk::lib::ldiff + proc punklib_ldiff {fromlist removeitems} { + if {[llength $removeitems] == 0} {return $fromlist} + set result {} + foreach item $fromlist { + if {$item ni $removeitems} { + lappend result $item + } + } + return $result + } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { + tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version set version 0.1.0 diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/config-0.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/config-0.1.tm index 1e4de9ec..493ea5aa 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/config-0.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/config-0.1.tm @@ -361,11 +361,14 @@ tcl::namespace::eval punk::config { } proc configure {args} { - set argd [punk::args::get_dict { + set argdef { + *id punk::config::configure + *proc -name punk::config::configure -help\ + "UNIMPLEMENTED" *values -min 1 -max 1 whichconfig -type string -choices {startup running stop} - } $args] - + } + set argd [punk::args::get_dict $argdef $args] return "unimplemented - $argd" } @@ -375,6 +378,8 @@ tcl::namespace::eval punk::config { return [punk::lib::showdict $configdata] } + + #e.g # copy running-config startup-config # copy startup-config test-config.cfg @@ -382,16 +387,22 @@ tcl::namespace::eval punk::config { #review - consider the merge vs overwrite feature of some routers.. where copy to running-config does a merge rather than an overwrite #This is to allow partial configs to be loaded to running, whereas a save of running to any target is always a complete configuration proc copy {args} { - set argd [punk::args::get_dict { - *proc -name punk::config::copy -help "Copy a partial or full configuration from one config to another - If a target config has additional settings, then the source config can be considered to be partial with regards to the target. - " - -type -default "" -choices {replace merge} -help "Defaults to merge when target is running-config - Defaults to replace when source is running-config" + set argdef { + *id punk::config::copy + *proc -name punk::config::copy -help\ + "Copy a partial or full configuration from one config to another + If a target config has additional settings, then the source config can be considered to be partial with regards to the target. + " + -type -default "" -choices {replace merge} -help\ + "Defaults to merge when target is running-config + Defaults to replace when source is running-config" *values -min 2 -max 2 - fromconfig -help "running or startup or file name (not fully implemented)" - toconfig -help "running or startup or file name (not fully implemented)" - } $args] + fromconfig -help\ + "running or startup or file name (not fully implemented)" + toconfig -help\ + "running or startup or file name (not fully implemented)" + } + set argd [punk::args::get_dict $argdef $args] set fromconfig [dict get $argd values fromconfig] set toconfig [dict get $argd values toconfig] set fromconfig [string map {-config ""} $fromconfig] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index 74ee55fd..c4f2bfc4 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm @@ -81,6 +81,8 @@ namespace eval punk::console { #*** !doctools #[list_begin definitions] + variable PUNKARGS + variable tabwidth 8 ;#default only - will attempt to detect and set to that configured in terminal #Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently #e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops. @@ -1187,7 +1189,8 @@ namespace eval punk::console { *id punk::console::cell_size -inoutchannels -default {stdin stdout} -type list *values -min 0 -max 1 - newsize -default "" + newsize -default "" -help\ + "character cell pixel dimensions WxH" } proc cell_size {args} { set argd [punk::args::get_by_id punk::console::cell_size $args] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm index 59ca4d5b..04f3487b 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm @@ -1251,6 +1251,16 @@ namespace eval punk::fileline { #[para] Core API functions for punk::fileline #[list_begin definitions] + punk::args::definition { + *id punk::fileline::get_textinfo + *proc -name punk::fileline::get_textinfo -help\ + "return: textinfo object instance" + -file -default {} -type existingfile + -translation -default iso8859-1 + -encoding -default "\uFFFF" + -includebom -default 0 + *values -min 0 -max 1 + } proc get_textinfo {args} { #*** !doctools #[call get_textinfo [opt {option value...}] [opt datachunk]] @@ -1266,14 +1276,7 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes. - set argument_specification { - -file -default {} -type existingfile - -translation -default iso8859-1 - -encoding -default "\uFFFF" - -includebom -default 0 - *values -min 0 -max 1 - } - lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values + lassign [dict values [punk::args::get_by_id punk::fileline::get_textinfo $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm index ae0f0a67..9ebd2ca2 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -48,8 +48,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -140,7 +142,7 @@ tcl::namespace::eval punk::lib::check { proc has_tclbug_lsearch_strideallinline {} { #bug only occurs with single -index value combined with -stride -all -inline -subindices #https://core.tcl-lang.org/tcl/tktview/5a1aaa201d - if {[catch {[lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *]} result]} { + if {[catch {lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *} result]} { #we aren't looking for an error result - error most likely indicates tcl too old to support -stride return 0 } @@ -320,7 +322,7 @@ tcl::namespace::eval punk::lib::compat { if {"::lmap" ne [info commands ::lmap]} { #puts stderr "Warning - no built-in lpop" - interp alias {} lpop {} ::punk::lib::compat::lmaptcl + interp alias {} lmap {} ::punk::lib::compat::lmaptcl } #lmap came in Tcl 8.6 - so probably not much need for a tcl forward compatibility version - but here it is anyway proc lmaptcl {varnames list script} { @@ -384,6 +386,7 @@ tcl::namespace::eval punk::lib::compat { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::lib { + variable PUNKARGS tcl::namespace::export * variable has_struct_list set has_struct_list [expr {![catch {package require struct::list}]}] @@ -956,172 +959,9 @@ namespace eval punk::lib { proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a] } - #experiment with equiv of js template literals with ${expression} in templates - #e.g tstr {This is the value of x in calling scope ${$x} !} - #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} - #e.g tstr -allowcommands {This is the value of [lindex $x 0] in calling scope ${[lindex [set x] 0]} !} - proc tstr {args} { - set argd [punk::args::get_dict { - *proc -name punk::lib::tstr -help "A rough equivalent of js template literals" - -allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}" - -return -default list -choices {dict list string} - *values -min 1 -max 1 - templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true" - } $args] - set templatestring [dict get $argd values templatestring] - set opt_allowcommands [dict get $argd opts -allowcommands] - set opt_return [dict get $argd opts -return] - set nocommands "-nocommands" - if {$opt_allowcommands == 1} { - set nocommands "" - } - - #set parts [_tstr_split $templatestring] - set parts [_parse_tstr_parts $templatestring] - set textchunks [list] - #set expressions [list] - set params [list] - set idx 0 - foreach {pt expression} $parts { - lappend textchunks $pt - incr idx ;#pt incr - - #ignore last expression - if {$idx == [llength $parts]} { - break - } - #lappend expressions $expression - lappend params [uplevel 1 [list subst {*}$nocommands $expression]] - - incr idx ;#expression incr - } - switch -- $opt_return { - dict { - return [dict create template $textchunks params $params] - } - list { - return [list $textchunks {*}$params] - } - string { - set out "" - foreach pt $textchunks param $params { - append out $pt $param - } - return $out - } - default { - } - } - } - #test single placeholder tstr args where single placeholder must be an int - proc tstr_test_one {args} { - set argd [punk::args::get_dict { - *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. - example: - set id 2 - tstr_test_one {*}[Tstr {Select * from table where id = ${$id} and etc... ;}] - } - - *values -min 2 -max 2 - template -type list -minlen 2 -maxlen 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - - but the Tstr method above does this for you, and also passes in the id automatically" - - where -type int -help {Integer param for where clause. Tstr mechanism above will pass the id as the second parameter} - } $args] - set template [dict get $argd values template] - set where [dict get $argd values where] - set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] - return $result - } - proc _parse_tstr_parts {templatestring} { - if {$templatestring eq ""} { - return [list] - } - set chars [split $templatestring ""] - set in_placeholder 0 - set tchars "" - set echars "" - set parts [list] - set i 0 - foreach ch $chars { - if {!$in_placeholder} { - set nextch [lindex $chars [expr {$i+1}]] - if {"$ch$nextch" eq "\$\{"} { - set in_placeholder 2 ;#2 to signify we just entered placeholder - lappend parts $tchars - set tchars "" - } else { - append tchars $ch - } - } else { - if {$ch eq "\}"} { - if {[tcl::info::complete $echars]} { - set in_placeholder 0 - lappend parts $echars - set echars "" - } else { - append echars $ch - } - } else { - if {$in_placeholder == 2} { - #skip opening bracket - set in_placeholder 1 - } else { - append echars $ch - } - } - } - incr i - } - if {$tchars ne ""} { - lappend parts $tchars - } - if {[llength $parts] % 2 == 0} { - #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list - lappend parts "" - } - return $parts - } - #based on punk::ansi::ta::_perlish_split - proc _tstr_split {text} { - if {$text eq ""} { - return {} - } - set list [list] - set start 0 - #ideally re should allow curlies within but we will probably need a custom parser to do it - #(js allows nested string interpolation) - #set re {\$\{[^\}]*\}} - set re {\$\{(?:(?!\$\{).)*\}} - - #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code - - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - puts "e:$matchEnd < s:$matchStart" - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - if {$start >= [tcl::string::length $text]} { - break - } - continue - } - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] - set start [expr {$matchEnd+1}] - #? - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } - + + namespace import ::punk::args::lib::tstr + #get info about punk nestindex key ie type: list,dict,undetermined proc nestindex_info {args} { set argd [punk::args::get_dict { @@ -1184,8 +1024,11 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=[punk::ansi::a] " } set argspec [string map [list %sep% $sep] { - *proc -name pdict -help {Print dict keys,values to channel - (see also showdict)} + *id punk::lib::pdict + *proc -name pdict -help\ + "Print dict keys,values to channel + The pdict function operates on variable names - passing the value to the showdict function which operates on values + (see also showdict)" *opts -any 1 @@ -1222,7 +1065,6 @@ namespace eval punk::lib { The second level segement in each pattern switches to a dict operation to retrieve the value by key. When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - The pdict function operates on variable names - passing the value to the showdict function which operates on values } }] #puts stderr "$argspec" @@ -1282,7 +1124,7 @@ namespace eval punk::lib { -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {${$key}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} *values -min 1 -max -1 @@ -1295,6 +1137,7 @@ namespace eval punk::lib { set opt_keysortdirection [dict get $argd opts -keysortdirection] set opt_trimright [dict get $argd opts -trimright] set opt_keytemplates [dict get $argd opts -keytemplates] + puts stderr "---> $opt_keytemplates <---" set opt_ansibase_keys [dict get $argd opts -ansibase_keys] set opt_ansibase_values [dict get $argd opts -ansibase_values] set opt_return [dict get $argd opts -return] @@ -4272,6 +4115,13 @@ tcl::namespace::eval punk::lib::system { #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::system ---}] } + +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } +} +lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm index 26bca4d5..a31da91a 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm @@ -35,7 +35,7 @@ namespace eval punk::mix::commandset::layout { proc files {{layout ""}} { set argd [punk::args::get_dict { *values -min 1 -max 1 - layout -type string -minlen 1 + layout -type string -minsize 1 } [list $layout]] set allfiles [lib::layout_all_files $layout] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm index 08d103ee..f5a5491e 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -26,19 +26,21 @@ package require punk::lib namespace eval punk::mix::commandset::loadedlib { namespace export * #search automatically wrapped in * * - can contain inner * ? globs - proc search {args} { - set argspecs { - *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" - -return -type string -default table -choices {table tableobject list lines} - -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help "(unimplemented) Display only those that are 0:absent 1:present 2:both" - -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" - -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" - searchstrings -default * -multiple 1 -help "Names to search for, may contain glob chars (* ?) e.g *lib* + punk::args::definition { + *id punk::mix::commandset::loadedlib::search + *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + -return -type string -default table -choices {table tableobject list lines} + -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ + "(unimplemented) Display only those that are 0:absent 1:present 2:both" + -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" + -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" + searchstrings -default * -multiple 1 -help\ + "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. - eg name -> *name* - " - } - set argd [punk::args::get_dict $argspecs $args] + eg name -> *name*" + } + proc search {args} { + set argd [punk::args::get_by_id punk::mix::commandset::loadedlib::search $args] set searchstrings [dict get $argd values searchstrings] set opts [dict get $argd opts] set opt_return [dict get $opts -return] @@ -179,16 +181,7 @@ namespace eval punk::mix::commandset::loadedlib { return [join $loaded_libs \n] } - proc info {args} { - set argspecs { - *values -min 1 - libname -help "library/package name" - } - set argd [punk::args::get_dict $argspecs $args] - set libname [dict get $argd values libname] - - - + proc info {libname} { if {[catch {package require natsort}]} { set has_natsort 0 } else { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index dd673f38..44627536 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -137,23 +137,39 @@ namespace eval punk::mix::commandset::module { put stderr "get_template_basefolders WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } } + + + set moduletypes [punk::mix::cli::lib::module_types] + punk::args::definition [subst { + *id punk::mix::commandset::module::new + *proc -name "punk::mix::commandset::module::new" -help\ + "Create a new module file in the appropriate folder within src/modules. + If the name given in the module argument is namespaced, + the necessary subfolder(s) will be used or created." + -project -optional 1 + -version -default "0.1.0" -help\ + "version to use if not specified as part of the module argument. + If a version is specified in the module argument as well as in -version + the higher version number will be used. + " + -license -default + -template -default punk.module + -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} + -force -default 0 -type boolean -help\ + "If set true, will overwrite an existing .tm file if there is one. + If false (default) an error will be raised if there is a conflict." + -quiet -default 0 -type boolean -help\ + "Suppress information messages on stdout" + *values -min 1 -max 1 + module -type string -help\ + "Name of module, possibly including a namespace and/or version number + e.g mynamespace::mymodule-1.0" + }] proc new {args} { set year [clock format [clock seconds] -format %Y] - set moduletypes [punk::mix::cli::lib::module_types] # use \uFFFD because unicode replacement char should consistently render as 1 wide - set argspecs [subst { - -project -default \uFFFD - -version -default \uFFFD - -license -default - -template -default punk.module - -type -default \uFFFD -choices {$moduletypes} - -force -default 0 -type boolean - -quiet -default 0 -type boolean - *values -min 1 -max 1 - module -type string - }] - set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::mix::commandset::module::new $args] + lassign [dict values $argd] leaders opts values received set module [dict get $values module] #set opts [dict merge $defaults $args] @@ -168,13 +184,9 @@ namespace eval punk::mix::commandset::module { # we need this value before looking at the named argument # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_version_supplied [dict get $opts -version] - if {$opt_version_supplied eq "\uFFFD"} { - set opt_version "0.1.0" - } else { - set opt_version $opt_version_supplied - if {![util::is_valid_tm_version $opt_version]} { - error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" - } + set opt_version $opt_version_supplied + if {![util::is_valid_tm_version $opt_version]} { + error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #named argument @@ -194,7 +206,7 @@ namespace eval punk::mix::commandset::module { } else { set vmsg "from -version option: $opt_version_supplied" } - if {$opt_version_supplied ne "\uFFFD"} { + if {"-version" in $received} { if {$vcompare_is_mversion_bigger != 0} { #is bigger or smaller puts stderr "module.new WARNING: version supplied in module argument as well as -version option. Using the higher version number $vmsg" @@ -231,7 +243,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #options # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_project [dict get $opts -project] set testdir [pwd] if {![string length [set projectdir [punk::repo::find_project $testdir]]]} { if {![string length [set projectdir [punk::repo::find_candidate $testdir]]]} { @@ -239,9 +250,10 @@ namespace eval punk::mix::commandset::module { error "module.new unable to create module in projectdir:$projectdir - directory doesn't appear to meet basic standards $msg" } } - if {$opt_project == "\uFFFF"} { + if {![dict exists $received -project]} { set projectname [file tail $projectdir] } else { + set opt_project [dict get $opts -project] set projectname $opt_project if {$projectname ne [file tail $projectdir]} { error "module.new -project '$opt_project' doesn't match detected projectname '$projectname' at path: $projectdir" @@ -309,12 +321,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_type [dict get $opts -type] - if {$opt_type eq "\uFFFD"} { - set opt_type [lindex [punk::mix::cli::lib::module_types] 0] ;#default to plain - } - if {$opt_type ni [punk::mix::cli::lib::module_types]} { - error "module.new - error - unknown -type '$opt_type' known-types: [punk::mix::cli::lib::module_types]" - } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_quiet [dict get $opts -quiet] set opt_force [dict get $opts -force] @@ -407,7 +413,7 @@ namespace eval punk::mix::commandset::module { set podfile $modulefolder/#modpod-$moduletail-$infile_version/$moduletail-$infile_version.tm set has_tm [file exists $tmfile] set has_pod [file exists $podfile] - if {$has_tm && $has_pos} { + if {$has_tm && $has_pod} { #invalid configuration - bomb out error "module.new error: Invalid target configuration found. module folder has both a .tm file $tmfile and a modpod file $podfile. Please delete one of them before trying again." } @@ -448,7 +454,7 @@ namespace eval punk::mix::commandset::module { } set buildversionfile [file join $modulefolder ${moduletail}-buildversion.txt] set existing_build_version "" - if {[file exists $buildversionfile]} { + if {!$opt_force && [file exists $buildversionfile]} { set buildversiondata [punk::mix::util::fcat $buildversionfile] set lines [split $buildversiondata \n] set existing_build_version [string trim [lindex $lines 0]] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm index 72691167..880dde53 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -28,7 +28,7 @@ tcl::namespace::eval ::punk::ns::evaluator { tcl::namespace::eval punk::ns { variable ns_current "::" variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns - namespace export nsjoin nsprefix nstail nsparts nseval nsimport_noclobber corp + namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp catch { package require debug debug define punk.ns.compile @@ -53,6 +53,8 @@ tcl::namespace::eval punk::ns { set nspathcommands 1 } + set ns_or_glob [string map {:::: ::} $ns_or_glob] + #todo - cooperate with repl? set out "" if {$ns_or_glob eq ""} { @@ -64,7 +66,7 @@ tcl::namespace::eval punk::ns { set has_globchars [regexp {[*?]} $ns_or_glob] if {$is_absolute} { if {!$has_globchars} { - if {![tcl::namespace::exists $ns_or_glob]} { + if {![nsexists $ns_or_glob]} { error "cannot change to namespace $ns_or_glob" } set ns_current $ns_or_glob @@ -77,7 +79,7 @@ tcl::namespace::eval punk::ns { } else { if {!$has_globchars} { set nsnext [nsjoin $ns_current $ns_or_glob] - if {![tcl::namespace::exists $nsnext]} { + if {![nsexists $nsnext]} { error "cannot change to namespace $ns_or_glob" } set ns_current $nsnext @@ -157,14 +159,28 @@ tcl::namespace::eval punk::ns { } #todo - walk up each ns - testing for possibly weirdly named namespaces - #review - do we even need it. + #needed to use n/ to change to an oddly named namespace such as ":x" proc nsexists {nspath} { - error "unimplemented" + if {$nspath eq ""} {return 0} + set parts [nsparts $nspath] + if {[lindex $parts 0] ne ""} { + #relative + set ns_caller [uplevel 1 {::namespace current}] + set fq_nspath [nsjoin $ns_caller $nspath] + } else { + set fq_nspath $nspath + } + if {[catch {nseval_ifexists $fq_nspath {}}]} { + return 0 + } else { + return 1 + } } #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal tcl::namespace::eval - but still only a few microseconds.. fine for repl introspection - proc nseval_script {location} { + #WARNING: creates namespaces if they don't exist + proc nseval_getscript {location} { set parts [nsparts $location] if {[lindex $parts 0] eq ""} { lset parts 0 :: @@ -214,21 +230,88 @@ tcl::namespace::eval punk::ns { #set cmd ::punk::pipecmds::nseval_$loc set cmd ::punk::ns::evaluator::eval-$loc if {$cmd ni [info commands $cmd]} { - append body \n [nseval_script $fqns] + append body \n [nseval_getscript $fqns] proc $cmd {script} $body debug.punk.ns.compile {proc $cmd} 2 } tailcall $cmd $script } - proc nschildren {fqns} { - if {![string match ::* $fqns]} { - error "nschildren only accepts a fully qualified namespace" + proc nseval_ifexists {ns script} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set nsfq [nsjoin $nscaller $ns] + } else { + set nsfq $ns + } + set ns_script [nseval_ifexists_getscript $nsfq] + uplevel 1 [list {*}$ns_script $script] + } + proc nseval_ifexists_getscript {location} { + set parts [nsparts $location] + if {[lindex $parts 0] eq ""} { + lset parts 0 :: + } + if {[lindex $parts end] eq ""} { + set parts [lrange $parts 0 end-1] + } + + set body "apply \{{script} \{eval \[string map \[list \$script\] \{" + set i 0 + set tails [lrepeat [llength $parts] ""] + foreach ns $parts { + set cmdlist [list ::punk::ns::eval_no_create $ns] + set t "" + if {$i > 0} { + append body " " + } + append body $cmdlist + if {$i == ([llength $parts] -1)} { + append body " {}" + } + if {$i > 0} { + set t {} + } + lset tails $i $t + incr i + } + append body [join [lreverse $tails] " "] + #puts stdout "tails: $tails" + #puts stdout "i: $i" + set body [string map [list "\{" "\}"] $body] + append body " \}\]\}\}" + return $body + } + proc eval_no_create {ns script} { + uplevel 1 [string map [list $ns $script] { + if {[::tcl::namespace::exists ]} { + ::tcl::namespace::eval {} + } else { + error "no such namespace " + } + }] + } + + + proc nschildren {ns} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set fqns [nsjoin $nscaller $ns] + } else { + set fqns $ns } + #if {![string match ::* $fqns]} { + # error "nschildren only accepts a fully qualified namespace" + #} set parent [nsprefix $fqns] set tail [nstail $fqns] #puts ">>> parent $parent tail $tail" #set nslist [nseval $parent [list ::namespace children $tail]] - set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + #set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + set nslist [nseval_ifexists $parent [list ::tcl::namespace::children $tail]] return [lsort $nslist] } @@ -356,7 +439,16 @@ tcl::namespace::eval punk::ns { set searchns [nsprefix $ns_absolute] ;#the ns within which we want to searchns set searchall [nsjoin $searchns *] ;#will correctly form ::* or ::childns::* - set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + set nsparts [nsparts $searchns] + set weird_ns 0 + if {[lsearch $nsparts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set rawresult [nseval_ifexists $searchns [list info vars]] + } else { + set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + } set matched_fullpath [list] foreach r $rawresult { lappend matched_fullpath [nstail $r] @@ -595,10 +687,21 @@ tcl::namespace::eval punk::ns { return $nslist } + variable usageinfo_char \U1f6c8 + # command has usageinfo e.g from punk::args. todo cmdline, argp, tepam etc? + proc Usageinfo_mark {{ansicodes \UFFEF}} { + variable usageinfo_char + if {$ansicodes eq ""} { + return $usageinfo_char + } elseif {$ansicodes eq "\UFFEF"} { + return " [a+ brightyellow]$usageinfo_char[a]" + } else { + return " [a+ {*}$ansicodes]$usageinfo_char[a]" + } + } #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ @@ -666,6 +769,7 @@ tcl::namespace::eval punk::ns { set interps [list] set coroutines [list] set zlibstreams [list] + set usageinfo [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -742,6 +846,7 @@ tcl::namespace::eval punk::ns { } } } + set usageinfo [dict get $contents usageinfo] } set numchildren [llength $children] @@ -859,7 +964,8 @@ tcl::namespace::eval punk::ns { set cmd_display [list $cmd] ;#wrap in list so empty command is visible (and distinguishable from for example a double-curly command) if {$cmd ni $commands && $cmd in $aliases } { #ordinary un-masked commandless-alias - set c [a+ red bold] + #(original alias name that has been renamed) + set c [a+ red bold strike] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] } else { @@ -869,7 +975,7 @@ tcl::namespace::eval punk::ns { #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias - #assertion member of masked - but we use seencmds instead to detect. + #assertion: member of masked - but we use seencmds instead to detect. set c [a+ yellow bold] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] @@ -901,13 +1007,20 @@ tcl::namespace::eval punk::ns { set prefix [overtype::right $prefix "-[a+ yellow bold]I[a+]"] } } - set cmd$i "${prefix} $c$cmd_display" - set c$i $c + if {$cmd in $usageinfo} { + set u [Usageinfo_mark brightgreen] + } else { + set u "" + } + set cmd$i "${prefix} $c$cmd_display$u" + #set c$i $c + set c$i "" lappend seencmds $cmd } } - lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + #lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + lappend displaylist $a1[overtype::left $col1 $ch1][a]$a1[overtype::left $col2 $ch2][a]$c1[overtype::left $col3 $cmd1][a]$c2[overtype::left $col4 $cmd2][a]$c3[overtype::left $col5 $cmd3][a]$c4$cmd4[a] } return [list_as_lines $displaylist] @@ -917,7 +1030,7 @@ tcl::namespace::eval punk::ns { if {$path_is_absolute} { return $nspath } - set ns_caller [uplevel 1 {::namespace current}] ;#must qualify. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) + set ns_caller [uplevel 1 {::namespace current}] ;#must qualify 'namespace' command. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) if {$nspath eq "\uFFFF"} { return $ns_caller } @@ -936,6 +1049,31 @@ tcl::namespace::eval punk::ns { return [nsjoin $base $nspath] } + set has_textblock [expr {![catch {package require textblock}]}] + + if {$has_textblock} { + interp alias "" ::punk::ns::Block_width "" textblock::width + } else { + #maint - equiv of textblock::width + proc Block_width {textblock} { + if {$textblock eq ""} { return 0 } + if {[tcl::string::last \t $textblock] >=0} { + if {[tcl::info::exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::ansistripraw $textblock] + } + if {[tcl::string::last \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } + return [punk::char::ansifreestring_width $textblock] + } + } proc nslist {{glob "*"} args} { set ns_absolute [uplevel 1 [list ::punk::ns::nspath_here_absolute $glob]] if {[dict exists $args -match]} { @@ -947,7 +1085,6 @@ tcl::namespace::eval punk::ns { -nspathcommands 0\ ] - package require textblock set opts [dict merge $defaults $args] # -- --- --- set opt_nspathcommands [dict get $opts -nspathcommands] @@ -971,11 +1108,11 @@ tcl::namespace::eval punk::ns { set block [get_nslist {*}$opts] #if {[string first \n $block] < 0} { # #single line - # set width [textblock::width [list $block]] + # set width [Block_width [list $block]] #} else { - # set width [textblock::width $block] + # set width [Block_width $block] #} - set width [textblock::width $block] + set width [Block_width $block] #if multiple results or if there is only 1 result - but we are path-globbing - then we need to show location if {$count_with_results > 1 || [regexp {[*?]} [nsprefix $ns_absolute]]} { @@ -998,7 +1135,7 @@ tcl::namespace::eval punk::ns { } } append output $path_text - set path_text_width [textblock::width $path_text] + set path_text_width [Block_width $path_text] append output \n [string repeat - [expr {max($width,$path_text_width)}]] } elseif {$count_with_results > 1 && $width > 0 } { append output \n [string repeat - $width] @@ -1014,9 +1151,44 @@ tcl::namespace::eval punk::ns { #info cmdtype available in 8.7+ #safe interps also seem to have it disabled for some reason + #we need to return "na" if 'info cmdtype' not supported or not functioning due to safe interp etc + #IMPORTANT: don't detect easy types such as proc/import here - caller needs the 'na' to do the proper fallback + #it is not desirable to do a partial cmdtype support here proc cmdtype {cmd} { + #set cmd [namespace which $cmd] ;#will return empty result for empty string command or command such as :x or any command that doesn't exist + set fqcmd [namespace which $cmd] ;#will resolve for example 'namespace path' reachable commands + if {$fqcmd eq ""} { + #e.g ::ns:::x will return empty result from namespace which even if :x is a command in ::ns + set where [nsprefix $cmd] + if {$where eq ""} { + #bare command that didn't resolve using namespace which + #command probably doesn't exist (may be auto_path cmd not yet loaded) + set where :: + } + set what [nstail $cmd] + } else { + set where [nsprefix $fqcmd] + set what [nstail $fqcmd] + } + #ensure we con't call 'namespace eval' on a nonexistent ns and create cruft namespaces + set parts [nsparts $where] + if {[lsearch $parts :*] > -1} { + set weird_ns 1 + if {![nsexists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)." + return nsnotfound + } + } else { + set weird_ns 0 + if {![namespace exists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)" + return nsnotfound + } + } + if {[interp issafe]} { - if {[catch {::tcl::info::cmdtype $cmd} result]} { + #todo - weird_ns + if {[catch {namespace eval $where [list ::tcl::info::cmdtype $what]} result]} { if {[info commands ::cmdtype] ne ""} { #hack - look for an alias that may have been specifically enabled to bring this back tailcall ::cmdtype $cmd @@ -1027,9 +1199,23 @@ tcl::namespace::eval punk::ns { } } if {[info commands ::tcl::info::cmdtype] ne ""} { - tailcall info cmdtype $cmd + if {$weird_ns} { + if {[nseval_ifexists $where [list ::info commands $what]] eq ""} { + return notfound + } else { + return [nseval_ifexists $where [list ::tcl::info::cmdtype $what]] + } + } else { + if {[namespace eval $where [list ::info commands $what]] eq ""} { + #e.g parray if it hasn't yet been called (an auto_path loaded command) + return notfound + } else { + tailcall namespace eval $where [list ::tcl::info::cmdtype $what] + } + } } - #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #we could examine namespaces to determine more - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #also - we're unlikely to be able to (easily) duplicate the full info cmdtype behaviour - so don't try here! return na } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob @@ -1073,6 +1259,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } + punk::args::update_definitions set nsdict_list [list] foreach ch $report_namespaces { @@ -1103,8 +1290,18 @@ tcl::namespace::eval punk::ns { #JMN set location $ch - set exportpatterns [tcl::namespace::eval $location {::namespace export}] - set nspathlist [tcl::namespace::eval $location {::namespace path}] + set locationparts [nsparts $location] + set weird_ns 0 + if {[lsearch $locationparts :*] >= 0} { + set weird_ns 1 + } + if {$weird_ns} { + set exportpatterns [nseval_ifexists $location {::namespace export}] + set nspathlist [nseval_ifexists $location {::namespace path}] + } else { + set exportpatterns [tcl::namespace::eval $location {::namespace export}] + set nspathlist [tcl::namespace::eval $location {::namespace path}] + } set nspathdict [dict create] if {$nspathcommands} { foreach pathns $nspathlist { @@ -1123,7 +1320,25 @@ tcl::namespace::eval punk::ns { foreach p $exportpatterns { if {[regexp {[*?]} $p]} { #lappend matched {*}[nseval $location [list ::info commands [nsjoin ${location} $p]]] - lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + if {$weird_ns} { + #! info commands can't glob with a weird ns prefix + #! info commands with no arguments returns all commands (from global and any other ns in namespace path) + #lappend matched {*}[nseval_ifexists $location [list ::info commands [nsjoin ${location} $p]]] + lappend matched {*}[nseval_ifexists $location [string map [list $location $p] { + set allcommands [info commands] + set matches [list] + foreach c $allcommands { + set fq [namespace which $c] + if {[string match :: $fq]} { + lappend matches $c + } + } + return $matches + }] + + } else { + lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + } foreach m $matched { lappend allexported [nstail $m] } @@ -1133,7 +1348,11 @@ tcl::namespace::eval punk::ns { } set allexported [lsort -unique $allexported] #NOTE: info procs within tcl::namespace::eval is different to 'info commands' within tcl::namespace::eval (info procs doesn't look outside of namespace) - set allprocs [tcl::namespace::eval $location {::info procs}] + if {$weird_ns} { + set allprocs [nseval_ifexists $location {::info procs}] + } else { + set allprocs [tcl::namespace::eval $location {::info procs}] + } #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] @@ -1151,7 +1370,11 @@ tcl::namespace::eval punk::ns { set interp_aliases [interp aliases ""] #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + if {$weird_ns} { + set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } else { + set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] foreach a $raw_aliases { @@ -1165,38 +1388,91 @@ tcl::namespace::eval punk::ns { } } + #NOTE for 'info ...' 'namespace origin|(etc)..' + # - use the pattern [namespace eval $location [list $cmd]] + #This allows examination of cmds with "bad" names such as empty string or prefixed with single colon. + #while these should be rare - we want to handle such edge cases when browsing namespaces. foreach cmd $commands { #if {"${location}::$cmd" in $interp_aliases || [string trimleft "${location}::$cmd" ":"] in $interp_aliases} { - # #NOTE: doesn't cater for renamed aliases - Tcl 8.x doesn't seem to have any introspection capabilities to match command to a renamed alias + # #NOTE: doesn't cater for renamed aliases - Tcl 8.x (and 9.01) doesn't seem to have any introspection capabilities to match command to a renamed alias # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} set ctype [cmdtype ${location}::$cmd] switch -- $ctype { na { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } + if {[nsprefix $cmdorigin] ne $location} { + #import + lappend allimported $cmd + set origin_location [nsprefix $cmdorigin] + } else { + set origin_location $location + } #tcl 8.6 (info cmdtype unavailable) #todo - use catch tcl::unsupported::corotype to see if coroutine - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + if {![catch {nseval_ifexists $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[nseval_ifexists $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[nseval_ifexists $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + + } + } else { + if {![catch {namespace eval $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[namespace eval $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[namespace eval $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + } } } default { - if {$ctype eq "imported"} { - set cmdorigin [namespace origin [nsjoin $location $cmd]] + if {$ctype eq "import"} { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source #ie we don't need to follow a chain of 'imported' results. - set mixedtype i-[info cmdtype $cmdorigin] + set origin_location [nsprefix $cmdorigin] + set origin_cmd [nstail $cmdorigin] + + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + set mixedtype i-[nseval_ifexists $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } else { + set mixedtype i-[namespace eval $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } + lappend allimported $cmd } else { set mixedtype $ctype } - #assert ctype != imported + #assert mixedtype != import #review - we don't have a way to mark as both native and ensemble - switch -- $ctype { + switch -- $mixedtype { i-native - native { lappend allnative $cmd } @@ -1242,7 +1518,7 @@ tcl::namespace::eval punk::ns { } } - #JMN + #JMN TODO if {[catch { if {$cmd eq ""} { #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. @@ -1315,6 +1591,50 @@ tcl::namespace::eval punk::ns { #definitely don't count exportpatterns incr itemcount [llength $undetermined] + set usageinfo [list] + set has_punkargs [expr {[info commands ::punk::args::id_exists] ne ""}] + set has_tepam [expr {[info exists ::tepam::ProcedureList]}] + if {$has_punkargs || $has_tepam} { + foreach c $commands { + if {$c in $imported} { + set fq [namespace origin [nsjoin $location $c]] + } elseif {$c in $aliases} { + #TODO - use which_alias ? + set tgt [interp alias "" [nsjoin $location $c]] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft [nsjoin $location $c] :]] + } + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(currying) + set fq $word1 + } + } else { + set fq [nsjoin $location $c] + } + if {$has_punkargs} { + set id [string trimleft $fq :] + if {[::punk::args::id_exists $id]} { + lappend usageinfo $c + } else { + if {$has_tepam} { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } else { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } set nsdict [dict create\ location $location\ @@ -1335,6 +1655,7 @@ tcl::namespace::eval punk::ns { ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ + usageinfo $usageinfo\ namespacepath $nspathdict\ glob $glob\ itemcount $itemcount\ @@ -1480,11 +1801,33 @@ tcl::namespace::eval punk::ns { ::set what $search } } - - ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] + set weird_ns 0 + if {[string match *:::* $base]} { + set weird_ns 1 + } #important not to call tcl::namespace::eval (or punk::ns::nseval) on non-existant base - or it will be created - ::if {![::tcl::namespace::exists $base]} { - ::continue + if {$weird_ns} { + ::if {![nsexists $base]} { + ::continue + } + #info commands can't glob with weird_ns prefix + puts ">>> base: $base what: $what" + ::set all_ns_commands [nseval_ifexists $base [list apply {{loc what} { + set _all [uplevel 1 [list ::info commands]] + set _matches [list] + foreach _a $_all { + set _c [uplevel 1 [list ::namespace which $_a]] + if {[::string match ${loc}::${what} $_c]} { + ::lappend _matches $_a + } + } + return $_matches + }} $base $what ]] + } else { + ::if {![::tcl::namespace::exists $base]} { + ::continue + } + ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] } ::set all_ns_tails [::lmap v $all_ns_commands {::punk::ns::nstail $v}] foreach c $all_ns_tails { @@ -1549,6 +1892,510 @@ tcl::namespace::eval punk::ns { } } |data@@ok/result> {lmap v $data {punk::ns::nstail $v}} |> lsort |> {join $data \n} = 0} { + #use nseval_ifexists to avoid creating intermediate namespaces for bogus paths + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set origin $commandpath + set resolved $commandpath + } + } else { + #fully qualified command specified but doesn't exist + set origin $commandpath + set resolved $commandpath + } + } else { + set thispath [uplevel 1 [list ::nsthis $commandpath]] + set targetns [nsprefix $thispath] + set name [nstail $thispath] + set targetparts [nsparts $targetns] + if {[lsearch $targetparts :*] >=0} { + #weird ns + set valid_ns [nsexists $targetns] + } else { + set valid_ns [namespace exists $targetns] + } + if {$valid_ns} { + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set thiscmd [nsjoin $targetns $name] + #relative commandpath specified - but Tcl didn't find a match in namespace path + #assume global (todo - look for namespace match in auto_index first ?) + set origin ::$name + set resolved ::$name + } + } else { + #namespace doesn't seem to exist - but there still could be documentation for lazy loaded ns and command + set origin $commandpath + set resolved $commandpath + } + } + #set thiscmd [nsjoin $targetns $name] + #if {[info commands $thiscmd] eq ""} { + # set origin $thiscmd + # set resolved $thiscmd + #} else { + # set origin [nseval $targetns [list ::namespace origin $name]] + # set resolved [nseval $targetns [list ::namespace which $name]] + #} + + #ns::cmdtype only detects alias type on 8.7+? + set initial_cmdtype [punk::ns::cmdtype $origin] + switch -- $initial_cmdtype { + na - alias { + #REVIEW - alias entry doesn't necessarily match command! + #considure using which_alias (wiki) + set tgt [interp alias "" $origin] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft $origin :]] + } + if {$tgt ne ""} { + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(possible curried arguments) + #review - curried arguments could be for ensembles! + set fq $word1 + } + set origin $fq + #retest cmdtype on modified origin + set cmdtype [punk::ns::cmdtype $origin] + } else { + set cmdtype $initial_cmdtype + } + if {$cmdtype eq "na"} { + #tcl 8.6 + if {[info object isa object $origin]} { + set cmdtype "object" + } + } + } + default { + set cmdtype $initial_cmdtype + } + } + + switch -- $cmdtype { + object { + #class is also an object + #todo -mixins etc etc + set class [info object class $origin] + #the call: info object methods -all + # seems to do the right thing as far as hiding unexported methods, and showing things like destroy + # - which don't seem to be otherwise easily introspectable + set public_methods [info object methods $origin -all] + #set class_methods [info class methods $class] + #set object_methods [info object methods $origin] + + if {[llength $commandargs]} { + set c1 [lindex $commandargs 0] + if {$c1 in $public_methods} { + switch -- $c1 { + new { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} new" + *proc -name "${$origin} new" -help\ + "create object with specified command name. + Arguments are passed to the constructor." + *values + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin new"] + } + create { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} create" + *proc -name "${$origin} create" -help\ + "create object with specified command name. + Arguments following objectName are passed to the constructor." + *values -min 1 + objectName -type string -help\ + "possibly namespaced name for object instance command" + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin create"] + } + destroy { + #review - generally no doc + # but we may want notes about a specific destructor + set argspec [punk::lib::tstr -return string { + *id "${$origin} destroy" + *proc -name "destroy" -help\ + "delete object, calling destructor if any. + destroy accepts no arguments." + *values -min 0 -max 0 + }] + punk::args::definition $argspec + return [punk::args::usage "$origin destroy"] + } + default { + #use info object call to resolve callchain + #we assume the first impl is the topmost in the callchain + # and its call signature is therefore the one we are interested in - REVIEW + # we should probably ignore generaltypes filter|unknown and look for a subsequent method|private? + set implementations [::info object call $origin $c1] + #result documented as list of 4 element lists + #set callinfo [lindex $implementations 0] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + + if {$location eq "object"} { + set id "[string trimleft $origin :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info object definition $origin $c1] + } else { + set id "[string trimleft $location :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info class definition $location $c1] + } + break + } + filter { + } + unknown { + } + } + } + if {$def ne ""} { + set arglist [lindex $def 0] + set argspec [punk::lib::tstr -return string { + *id "${$location} ${$c1}" + *proc -name "${$location} ${$c1}" -help\ + "arglist:${$arglist}" + *values + }] + set i 0 + foreach a $arglist { + switch -- [llength $a] { + 1 { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } + 2 { + append argspec \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" + } + default { + error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + } + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$location $c1"] + } else { + return "unable to resolve $origin method $c1" + } + + } + } + } + } + set choicelabeldict [dict create] + foreach cmd $public_methods { + switch -- $cmd { + new - create - destroy { + #todo + } + default { + set implementations [::info object call $origin $cmd] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + if {$location eq "object"} { + set id "[string trimleft $origin :] $cmd" ;# " " + } else { + set id "[string trimleft $location :] $cmd" ;# " " + } + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]" + } + } + break + } + filter { + } + unknown { + } + } + } + } + } + } + + set vline [list method -choices $public_methods -choicelabels $choicelabeldict -choiceprefix 0] ;#methods must be specified in full always? - review + #puts stderr "--->$vline" + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -name "Object: ${$origin}" -help\ + "Instance of class: ${$class}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + privateObject { + return "Command is a privateObject - no info currently available" + } + privateClass { + return "Command is a privateClass - no info currently available" + } + interp { + #todo + } + } + + #check ensemble before testing punk::arg::id_exists + #we want to recalculate ensemble usage info in case ensemble has been modified + + if {[namespace ensemble exists $origin]} { + #review + #todo - check -unknown + #if there is a -unknown handler - we can't be sure the choices in -map or from -namespace are exhaustive. + #presumably -choiceprefix should be zero in that case?? + + set ensembleinfo [namespace ensemble configure $origin] + set prefixes [dict get $ensembleinfo -prefixes] + set map [dict get $ensembleinfo -map] + set ns [dict get $ensembleinfo -namespace] + + #review - we can have a combination of commands from -map as well as those exported from -namespace + # if and only if -subcommands is specified + + set subcommand_dict [dict create] + set commands [list] + set nscommands [list] + if {[llength [dict get $ensembleinfo -subcommands]]} { + #set exportspecs [namespace eval $ns {namespace export}] + #foreach pat $exportspecs { + # lappend nscommands {*}[info commands ${ns}::$pat] + #} + #when using -subcommands, even unexported commands are available + set nscommands [info commands ${ns}::*] + foreach sub [dict get $ensembleinfo -subcommands] { + if {[dict exists $map $sub]} { + #-map takes precence over same name exported from -namespace + dict set subcommand_dict $sub [dict get $map $sub] + } elseif {"${ns}::$sub" in $nscommands} { + dict set subcommand_dict $sub ${ns}::$sub + } else { + #subcommand probably supplied via -unknown handler? + dict set subcommand_dict $sub "" + } + } + } else { + if {[dict size $map]} { + set subcommand_dict $map + } else { + set exportspecs [namespace eval $ns {namespace export}] + foreach pat $exportspecs { + lappend nscommands {*}[info commands ${ns}::$pat] + } + foreach fqc $nscommands { + dict set subcommand_dict [namespace tail $fqc] $fqc + } + } + } + + + set subcommands [lsort [dict keys $subcommand_dict]] + if {[llength $commandargs]} { + set match [tcl::prefix::match $subcommands [lindex $commandargs 0]] + if {$match in $subcommands} { + set subcmd [dict get $subcommand_dict $match] + return [arginfo {*}$subcmd {*}[lrange $commandargs 1 end]] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") + } + } + + set namespaces [list] ;# usually only 1 or 2 namespaces - but could be any number. + dict for {sub subwhat} $subcommand_dict { + set ns [::namespace which $subwhat] + if {$ns ni $namespaces} { + lappend namespaces $ns + } + } + set have_usageinfo [list] + set is_ensemble [list] + set is_object [list] + foreach ns $namespaces { + set nsinfo [lindex [punk::ns::nslist_dict [nsjoin [nsprefix $ns] *]] 0] + lappend have_usageinfo {*}[dict get $nsinfo usageinfo] + lappend is_ensemble {*}[dict get $nsinfo ensembles] + lappend is_object {*}[dict get $nsinfo ooobjects] + } + + set choicelabeldict [dict create] + foreach sub $subcommands { + if {$sub in $have_usageinfo} { + dict set choicelabeldict $sub " [Usageinfo_mark brightgreen]" + } elseif {$sub in $is_ensemble} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } elseif {$sub in $is_object} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } + } + + set vline [list subcommand -choices $subcommands -choiceprefix $prefixes -choicelabels $choicelabeldict] + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -help "ensemble: ${$origin}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + + #check for tepam help + if {[info exists ::tepam::ProcedureList]} { + if {$origin in $::tepam::ProcedureList} { + return [tepam::ProcedureHelp $origin 1] ;#use 1 to return rather than emit to stdout + } else { + #handle any tepam functions that don't eat their own dogfood but have help variables + #e.g tepam::procedure, tepam::argument_dialogbox + #Rather than hardcode these - we'll guess that any added will use the same scheme.. + if {[namespace qualifiers $origin] eq "::tepam"} { + set func [namespace tail $origin] + #tepam XXXHelp vars don't exactly match procedure names :/ + if {[info exists ::tepam::${func}Help]} { + return [set ::tepam::${func}Help] + } else { + set f2 [string totitle $func] + if {[info exists ::tepam::${f2}Help]} { + return [set ::tepam::${f2}Help] + } + #e.g argument_dialogbox -> ArgumentDialogboxHelp + set parts [split $func _] + set uparts [lmap p $parts {string totitle $p}] + set f3 [join [list {*}$uparts Help] ""] + if {[info exists ::tepam::${f3}]} { + return [set ::tepam::${f3}] + } + } + } + } + } + + set id [string trimleft $origin :] + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set origin_ns [nsprefix $origin] + set parts [nsparts $origin_ns] + set weird_ns 0 + if {[lsearch $parts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set argl {} + set tail [nstail $origin] + foreach a [nseval_ifexists $origin_ns [list info args $tail]] { + if {[nseval_ifexists $origin_ns [list info default $tail $a def]]} { + lappend a $def + } + lappend argl $a + } + } else { + set argl {} + foreach a [info args $origin] { + if {[info default $origin $a def]} { + lappend a $def + } + lappend argl $a + } + } + + set msg "No argument processor detected" + append msg \n "function signature: $resolved $argl" + return $msg + } + #todo - package up as navns proc corp {path} { #thanks to Richard Suchenwirth for the original - wiki.tcl-lang.org/page/corp @@ -1567,6 +2414,8 @@ tcl::namespace::eval punk::ns { set body "" } + #we want to handle edge cases of commands such as "" or :x + #various builtins such as 'namespace which' won't work if {[string match ::* $path]} { set targetns [nsprefix $path] set name [nstail $path] @@ -1884,26 +2733,41 @@ tcl::namespace::eval punk::ns { } interp alias "" use "" punk::ns::pkguse + punk::args::definition { + *id punk::ns::nsimport_noclobber + *proc -name punk::ns::nsimport_noclobber -help\ + "Import exported commands from a namespace into either the current namespace, + or that specified in -targetnamespace. + Return list of imported commands, ignores failures due to name conflicts" + -targetnamespace -optional 1 -help\ + "Namespace in which to import commands. + If namespace is relative (no leading ::), + the namespace is relative to the caller'd namespace. + If not supplied, caller's namespace is used." + -prefix -optional 1 -help\ + "string prefix for command names in target namespace" + *values -min 1 -max 1 + sourcepattern -type string -optional 0 -help\ + "Glob pattern for source namespace. + Globbing only active in the tail segment. + e.g ::mynamespace::*" + } proc nsimport_noclobber {args} { - set argspecs { - -targetnamespace -default "" -optional 1 - -prefix -default "" -optional 1 - *values -min 1 -max 1 - sourcepattern -type string -optional 0 - } - lassign [dict values [punk::args::get_dict $argspecs $args]] leaders opts values + lassign [dict values [punk::args::get_by_id punk::ns::nsimport_noclobber $args]] leaders opts values received set sourcepattern [dict get $values sourcepattern] set source_ns [tcl::namespace::qualifiers $sourcepattern] if {![tcl::namespace::exists $source_ns]} { error "nsimport_noclobber error namespace $source_ns not found" } - set target_ns [dict get $opts -targetnamespace] set nscaller [uplevel 1 {namespace current}] - if {$target_ns eq ""} { + if {![dict exists $received -targetnamespace]} { set target_ns $nscaller - } elseif {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + } else { + set target_ns [dict get $opts -targetnamespace] + if {![string match ::* $target_ns]} { + set target_ns [punk::nsjoin $nscaller $target_ns] + } } set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] @@ -1918,6 +2782,34 @@ tcl::namespace::eval punk::ns { } } } + set nstemp ::punk::ns::temp_import + if {[tcl::dict:::exists $received -prefix]} { + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { + set cmd "" + if {![catch {namespace import ::}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {rename [punk::ns::nsjoin ]}]} { + set cmd + } + } + set cmd + }]] + if {$imported ne ""} { + lappend imported_commands $imported + } + } + namespace delete $nstemp + return $imported_commands + } + set imported_commands [list] foreach e $a_exported_tails { set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { @@ -1934,7 +2826,7 @@ tcl::namespace::eval punk::ns { return $imported_commands } - #todo - use ns::nsimport_noclobber instead + #todo - use ns::nsimport_noclobber instead ? interp alias {} nsthis {} punk::ns::nspath_here_absolute interp alias {} nsorigin {} apply {ns {namespace origin [uplevel 1 ::punk::ns::nspath_here_absolute $ns]} ::} @@ -1943,6 +2835,7 @@ tcl::namespace::eval punk::ns { interp alias {} nsprefix {} punk::ns::nsprefix interp alias {} nstail {} punk::ns::nstail interp alias {} nsparts {} punk::ns::nsparts + interp alias {} nschildren {} punk::ns::nschildren interp alias {} nstree {} punk::ns::nstree #namespace/command/proc query interp alias {} nslist {} punk::ns::nslist @@ -1966,6 +2859,7 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp + interp alias {} i {} punk::ns::arginfo } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm index 18590542..d3431188 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/path-0.1.0.tm @@ -45,8 +45,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -642,6 +644,20 @@ namespace eval punk::path { return $ismatch } + punk::args::definition { + *id punk::path::treefilenames + -directory -type directory -help\ + "folder in which to begin recursive scan for files." + -call-depth-internal -default 0 -type integer + -antiglob_paths -default {} -help\ + "list of path patterns to exclude + may include * and ** path segments e.g /usr/**" + *values -min 0 -max -1 -optional 1 -type string + tailglobs -multiple 1 -help\ + "Patterns to match against filename portion (last segment) of each file path + within the directory tree being searched." + } + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) proc treefilenames {args} { @@ -655,22 +671,17 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_dict { - -directory -default "\uFFFF" - -call-depth-internal -default 0 -type integer - -antiglob_paths -default {} - *values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 - } $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::path::treefilenames $args] + lassign [dict values $argd] leaders opts values received set tailglobs [dict values $values] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - set opt_dir [dict get $opts -directory] - if {$opt_dir eq "\uFFFF"} { + if {![dict exists $received -directory]} { set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] } # -- --- --- --- --- --- --- diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm index d8d1b249..d14b626d 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm @@ -166,15 +166,15 @@ tcl::namespace::eval punk::repl::codethread { set errstack [list] upvar ::punk::config::running running_config if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { - lappend outstack [interp eval code [list shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } - lappend outstack [interp eval code [list shellfilter::stack::add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { - lappend errstack [interp eval code [list shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } - lappend errstack [interp eval code [list shellfilter::stack::add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] #an experiment #set errhandle [shellfilter::stack::item_tophandle stderr] @@ -190,7 +190,16 @@ tcl::namespace::eval punk::repl::codethread { if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } - tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + if {[string first ":::" $::punk::ns::ns_current]} { + #support for browsing 'odd' (inadvisable) namespaces + #don't use 'namespace exists' - will conflate ::test::x with ::test:::x + #if {$::punk::ns::ns_current in [namespace children [punk::ns::nsprefix $::punk::ns::ns_current]} { + #} + package require punk::ns + punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript + } else { + tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + } } } result] @@ -221,10 +230,10 @@ tcl::namespace::eval punk::repl::codethread { #only remove from shellfilter::stack the items we added to stack in this function foreach s [lreverse $outstack] { - interp eval code [list shellfilter::stack::remove stdout $s] + interp eval code [list ::shellfilter::stack remove stdout $s] } foreach s [lreverse $errstack] { - interp eval code [list shellfilter::stack::remove stderr $s] + interp eval code [list ::shellfilter::stack remove stderr $s] } thread::cond notify $replthread_cond } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm index fe443ece..25ba28b1 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm @@ -1086,7 +1086,9 @@ namespace eval shellfilter::chan { ## note - whether stack is for input or output we maintain it in the same direction - which is in sync with the tcl chan pop chan push concept. ## namespace eval shellfilter::stack { - #todo - implement as oo + namespace export {[a-z]*} + namespace ensemble create + #todo - implement as oo ? variable pipelines [list] proc items {} { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.2.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.2.tm index f8b6390c..1a298b4e 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.2.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.2.tm @@ -92,29 +92,51 @@ tcl::namespace::eval textblock { #NOTE sha1, although computationally more intensive, tends to be faster than md5 on modern cpus #(more likely to be optimised for modern cpu features?) - variable use_md5 ;#framecache - set use_md5 1 - if {[catch {package require md5}]} { - set use_md5 0 - } - #todo - change use_md5 to more generic use_checksum_algorithm function. - # e.g allow md5, sha1, none, etc. - # - perhaps autodetect 32bit vs 64bit (or processortype?) to select a default (also depending on packages available and accelerator presence) - proc use_md5 {{yes_no ""}} { - variable use_md5 - if {$yes_no eq ""} { - return $use_md5 - } - if {![string is boolean -strict $yes_no]} { - error "textblock::use_md5 requires a boolean (or empty string to query)" - } - if {$yes_no} { - package require md5 - set use_md5 1 + #(This speed improvement may not apply for short strings) + + variable use_hash ;#framecache + set use_hash none ;#slightly faster but uglier layout for viewing frame_cache display + #if {![catch {package require sha1}]} { + # set use_hash sha1 + #} elseif {![catch {package require md5}]} { + # set use_hash md5 + #} else { + # set use_hash none + #} + + proc use_hash {args} { + set choices [list none] + set unavailable [list] + set pkgs [package names] + if {"md5" in $pkgs} { + lappend choices md5 } else { - set use_md5 0 + lappend unavailable md5 } - return $use_md5 + if {"sha1" in $pkgs} { + lappend choices sha1 + } else { + lappend unavailable sha1 + } + set choicemsg "" + if {[llength $unavailable]} { + set choicemsg " (unavailable packages: $unavailable)" + } + set argd [punk::args::get_dict [tstr -return string { + *id textblock::use_hash + *proc -name "textblock::use_hash" -help\ + "Hashing algorithm to use for framecache lookup. + 'none' may be slightly faster but less compact + when viewing textblock::framecache" + *values -min 0 -max 1 + hash_algorithm -choices {${$choices}} -optional 1 -help\ + "algorithm choice ${$choicemsg}" + }] $args] + variable use_hash + if {![dict exists $argd received hash_algorithm]} { + return $use_hash + } + set use_hash [dict get $argd values hash_algorithm] } tcl::namespace::eval class { variable opts_table_defaults @@ -3997,12 +4019,8 @@ tcl::namespace::eval textblock { return $t } - - - proc periodic {args} { - #For an impressive interactive terminal app (javascript) - # see: https://github.com/spirometaxas/periodic-table-cli - set opts [dict get [punk::args::get_dict { + punk::args::definition { + *id textblock::periodic *proc -name textblock::periodic -help "A rudimentary periodic table This is primarily a test of textblock::class::table" @@ -4016,8 +4034,12 @@ tcl::namespace::eval textblock { -show_edge -default "" -type boolean -forcecolour -default 0 -type boolean -help "If punk::colour is off - this enables the produced table to still be ansi coloured" *values -min 0 -max 0 - } $args] opts] + } + proc periodic {args} { + #For an impressive interactive terminal app (javascript) + # see: https://github.com/spirometaxas/periodic-table-cli + set opts [dict get [punk::args::get_by_id textblock::periodic $args] opts] set opt_return [tcl::dict::get $opts -return] if {[tcl::dict::get $opts -forcecolour]} { set fc forcecolour @@ -4156,15 +4178,16 @@ tcl::namespace::eval textblock { dict set conf $k [dict get $opts $k] } } - $t configure {*}[dict get $conf] - $t configure \ - -frametype_header light\ - -ansiborder_header [a+ {*}$fc brightwhite]\ - -ansibase_header [a+ {*}$fc Black]\ - -ansibase_body [a+ {*}$fc Black]\ - -ansiborder_body [a+ {*}$fc black]\ - -frametype block + set moreopts [dict create\ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc brightwhite]\ + -ansibase_header [a+ {*}$fc Black]\ + -ansibase_body [a+ {*}$fc Black]\ + -ansiborder_body [a+ {*}$fc black]\ + -frametype block + ] + $t configure {*}[dict merge $conf $moreopts] #-ansiborder_header [a+ {*}$fc web-white]\ @@ -4204,9 +4227,9 @@ tcl::namespace::eval textblock { -header -default "" -type list -multiple 1\ -help "Each supplied -header argument is a header row. The number of values for each must be <= number of columns" - -show_header -default ""\ + -show_header -type boolean\ -help "Whether to show a header row. - Leave as empty string for unspecified/automatic, + Omit for unspecified/automatic, in which case it will display only if -headers list was supplied." -action -default "append" -choices {append replace}\ -help "row insertion method if existing -table is supplied @@ -4294,13 +4317,13 @@ tcl::namespace::eval textblock { if {[llength $colheaders] > 0} { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 1 } else { set show_header [tcl::dict::get $opts -show_header] } } else { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 0 } else { set show_header [tcl::dict::get $opts -show_header] @@ -4529,7 +4552,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4553,7 +4576,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4614,7 +4637,7 @@ tcl::namespace::eval textblock { set textblock [textutil::tabify::untabify2 $textblock $tw] } #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { set textblock [punk::ansi::ansistripraw $textblock] } if {[tcl::string::last \n $textblock] >= 0} { @@ -7226,12 +7249,19 @@ tcl::namespace::eval textblock { variable frame_cache set frame_cache [tcl::dict::create] + + punk::args::definition { + *id textblock::frame_cache + *proc -name textblock::frame_cache -help\ + "Display or clear the frame cache." + -action -default {} -choices {clear} -help\ + "Clear the textblock::frame_cache dictionary" + -pretty -default 1 -help\ + "Use 'pdict textblock::frame_cache */*' for prettier output" + *values -min 0 -max 0 + } proc frame_cache {args} { - set argd [punk::args::get_dict { - -action -default {} -choices {clear} -help "Clear the textblock::frame_cache dictionary" - -pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output" - *values -min 0 -max 0 - } $args] + set argd [punk::args::get_by_id textblock::frame_cache $args] set action [dict get $argd opts -action] if {$action ni [list clear ""]} { @@ -7273,6 +7303,71 @@ tcl::namespace::eval textblock { } + set FRAMETYPES [textblock::frametypes] + set EG [a+ brightblack] + set RST [a] + #todo punk::args alias for centre center etc? + punk::args::definition [punk::lib::tstr -return string { + *id textblock::frame + *proc -name "textblock::frame"\ + -help "Frame a block of text with a border." + -checkargs -default 1 -type boolean\ + -help "If true do extra argument checks and + provide more comprehensive error info. + Set false for slight performance improvement." + -etabs -default 0\ + -help "expanding tabs - experimental/unimplemented." + -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ + -help "Type of border for frame." + -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. + passing an empty string will result in no box, but title/subtitle will still appear if supplied. + ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" + -boxmap -default {} -type dict + -joins -default {} -type list + -title -default "" -type string -regexprefail {\n}\ + -help "Frame title placed on topbar - no newlines. + May contain ANSI - no trailing reset required. + ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing + e.g 2: frame -title [a+ red underline]MyThing${$RST}" + -subtitle -default "" -type string -regexprefail {\n}\ + -help "Frame subtitle placed on bottombar - no newlines + May contain Ansi - no trailing reset required." + -width -default "" -type int\ + -help "Width of resulting frame including borders. + If omitted or empty-string, the width will be determined automatically based on content." + -height -default "" -type int\ + -help "Height of resulting frame including borders." + -ansiborder -default "" -type ansistring\ + -help "Ansi escape sequence to set border attributes. + ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents + e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" + -ansibase -default "" -type ansistring\ + -help "Default ANSI attributes within frame." + -blockalign -default centre -choices {left right centre}\ + -help "Alignment of the content block within the frame." + -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background + extends within the content block inside the frame. + Has no effect if no ANSI in content." + -textalign -default left -choices {left right centre}\ + -help "Alignment of text within the content block. (centre unimplemented)" + -ellipsis -default 1 -type boolean\ + -help "Whether to show elipsis for truncated content and title/subtitle." + -usecache -default 1 -type boolean + -buildcache -default 1 -type boolean + -crm_mode -default 0 -type boolean\ + -help "Show ANSI control characters within frame contents. + (Control Representation Mode) + Frame width doesn't adapt and content may be truncated + so -width may need to be manually set to display more." + + *values -min 0 -max 1 + contents -default "" -type string\ + -help "Frame contents - may be a block of text containing newlines and ANSI. + Text may be 'ragged' - ie unequal line-lengths. + No trailing ANSI reset required. + ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" + }] + #options before content argument - which is allowed to be absent #frame performance (noticeable with complex tables even of modest size) is improved somewhat by frame_cache - but is still (2024) a fairly expensive operation. # @@ -7283,7 +7378,7 @@ tcl::namespace::eval textblock { # - but we would need to maintain support for the rendered-string based operations too. proc frame {args} { variable frametypes - variable use_md5 + variable use_hash #counterintuitively - in-proc dict create each time is generally slightly faster than linked namespace var set opts [tcl::dict::create\ @@ -7311,20 +7406,19 @@ tcl::namespace::eval textblock { # for ansi art - -pad 0 is likely to be preferable set has_contents 0 - set arglist $args + set optlist $args ;#initial only - content will be removed + #no solo opts for frame if {[llength $args] %2 == 0} { if {[lindex $args end-1] eq "--"} { - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 - lpop arglist end ;#drop the end-of-opts flag + lpop optlist end ;#drop the end-of-opts flag } else { - set arglist $args + set optlist $args set contents "" } } else { - #set arglist [lrange $args 0 end-1] - #set contents [lindex $args end] - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 } @@ -7333,7 +7427,7 @@ tcl::namespace::eval textblock { #use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache set optnames [tcl::dict::keys $opts] set opts_ok 1 ;#default assumption - foreach {k v} $arglist { + foreach {k v} $optlist { set k2 [tcl::prefix::match -error "" $optnames $k] switch -- $k2 { -etabs - -type - -boxlimits - -boxmap - -joins @@ -7355,70 +7449,9 @@ tcl::namespace::eval textblock { set check_args [dict get $opts -checkargs] #only use punk::args if check_args is true or our basic checks failed - if {!$opts_ok || $check_args} { - #error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - set FRAMETYPES [textblock::frametypes] - set EG [a+ brightblack] - set RST [a] - set argd [punk::args::get_dict [punk::lib::tstr -return string { - *proc -name "textblock::frame"\ - -help "Frame a block of text with a border." - -checkargs -default 1 -type boolean\ - -help "If true do extra argument checks and - provide more comprehensive error info. - Set false for slight performance improvement." - -etabs -default 0\ - -help "expanding tabs - experimental/unimplemented." - -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ - -help "Type of border for frame." - -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. - passing an empty string will result in no box, but title/subtitle will still appear if supplied. - ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" - -boxmap -default {} -type dict - -joins -default {} -type list - -title -default "" -type string -regexprefail {\n}\ - -help "Frame title placed on topbar - no newlines. - May contain ANSI - no trailing reset required. - ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing - e.g 2: frame -title [a+ red underline]MyThing${$RST}" - -subtitle -default "" -type string -regexprefail {\n}\ - -help "Frame subtitle placed on bottombar - no newlines - May contain Ansi - no trailing reset required." - -width -default "" -type int\ - -help "Width of resulting frame including borders. - If omitted or empty-string, the width will be determined automatically based on content." - -height -default "" -type int\ - -help "Height of resulting frame including borders." - -ansiborder -default "" -type ansistring\ - -help "Ansi escape sequence to set border attributes. - ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents - e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" - -ansibase -default "" -type ansistring\ - -help "Default ANSI attributes within frame." - -blockalign -default centre -choices {left right centre}\ - -help "Alignment of the content block within the frame." - -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background - extends within the content block inside the frame. - Has no effect if no ANSI in content." - -textalign -default left -choices {left right centre}\ - -help "Alignment of text within the content block. (centre unimplemented)" - -ellipsis -default 1 -type boolean\ - -help "Whether to show elipsis for truncated content and title/subtitle." - -usecache -default 1 -type boolean - -buildcache -default 1 -type boolean - -crm_mode -default 0 -type boolean\ - -help "Show ANSI control characters within frame contents. - (Control Representation Mode) - Frame width doesn't adapt and content may be truncated - so -width may need to be manually set to display more." - - *values -min 0 -max 1 - contents -default "" -type string\ - -help "Frame contents - may be a block of text containing newlines and ANSI. - Text may be 'ragged' - ie unequal line-lengths. - No trailing ANSI reset required. - ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" - }] $args] + #never need to checkargs if only one argument supplied even if it looks like an option - as it will be treated as data to frame + if {[llength $args] != 1 && (!$opts_ok || $check_args)} { + set argd [punk::args::get_by_id textblock::frame $args] set opts [dict get $argd opts] set contents [dict get $argd values contents] } @@ -7446,7 +7479,10 @@ tcl::namespace::eval textblock { set opt_ansiborder [tcl::dict::get $opts -ansiborder] set opt_ansibase [tcl::dict::get $opts -ansibase] ;#experimental set opt_ellipsis [tcl::dict::get $opts -ellipsis] + set opt_blockalign [tcl::dict::get $opts -blockalign] + set opt_textalign [tcl::dict::get $opts -textalign] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] set known_frametypes $frametypes ;# light, heavey etc as defined in the ::textblock::frametypes variable @@ -7463,107 +7499,26 @@ tcl::namespace::eval textblock { set framedef $ftype } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - #review vllj etc? - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] - - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - tcl::dict::for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - hltj - hlbj - vllj - vlrj {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" - } + #if check_args? - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [tcl::dict::create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - tcl::dict::set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] + #REVIEW - now done in framedef? + #set join_directions [list] + ##targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + ##e.g down-light, up-heavy + #set join_targets [tcl::dict::create left "" down "" right "" up ""] + #foreach jt $opt_joins { + # lassign [split $jt -] direction target + # if {$target ne ""} { + # tcl::dict::set join_targets $direction $target + # } + # lappend join_directions $direction + #} + #set join_directions [lsort -unique $join_directions] + #set do_joins [::join $join_directions _] - #JMN - switch -- $opt_blockalign { - left - right - centre - center {} - default { - error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_textalign [tcl::dict::get $opts -textalign] - switch -- $opt_textalign { - left - right - centre - center {} - default { - error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" - } - } # -- --- --- --- --- --- @@ -7634,20 +7589,28 @@ tcl::namespace::eval textblock { # -- --- --- --- --- --- --- --- --- variable frame_cache #review - custom frame affects frame_inner_width - exclude from caching? - #set cache_key [concat $arglist $frame_inner_width $frame_inner_height] + #set cache_key [concat $optlist $frame_inner_width $frame_inner_height] #jmn - #set hashables [concat $arglist $frame_inner_width $frame_inner_height] - set hashables [list {*}$arglist $frame_inner_width $frame_inner_height] + #set hashables [concat $optlist $frame_inner_width $frame_inner_height] + set hashables [list {*}$optlist $frame_inner_width $frame_inner_height] - if {$use_md5} { - #package require md5 ;#already required at package load - if {[package vsatisfies [package present md5] 2- ] } { - set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review - } else { - set hash [md5::md5 [encoding convertto utf-8 $hashables]] + + switch -- $use_hash { + sha1 { + package require sha1 + set hash [sha1::sha1 [encoding convertto utf-8 $hashables]] + } + md5 { + package require md5 + if {[package vsatisfies [package present md5] 2- ] } { + set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review + } else { + set hash [md5::md5 [encoding convertto utf-8 $hashables]] + } + } + none { + set hash $hashables } - } else { - set hash $hashables } set cache_key "$hash-$frame_inner_width-$frame_inner_height-actualcontentwidth:$actual_contentwidth" @@ -7709,11 +7672,94 @@ tcl::namespace::eval textblock { set used [tcl::dict::get $frame_cache $cache_key used] tcl::dict::set frame_cache $cache_key used [expr {$used+1}] ;#update existing record set is_cached 1 - } + # -- --- --- --- --- --- --- --- --- if {!$is_cached} { + # -- --- --- --- --- + # -- --- --- --- --- + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + # -- --- --- --- --- --- + set is_boxmap_ok 1 + tcl::dict::for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + hltj - hlbj - vllj - vlrj {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" + } + # -- --- --- --- --- --- + #these are all valid commands for overtype:: + switch -- $opt_textalign { + left - right - centre - center {} + default { + error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" + } + } + # -- --- --- --- --- --- + switch -- $opt_blockalign { + left - right - centre - center {} + default { + error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" + } + } + # -- --- --- --- --- + # -- --- --- --- --- + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + #review vllj etc? + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + # -- --- --- --- --- --- + + set rst [a] #set column [tcl::string::repeat " " $frame_inner_width] ;#default - may need to override for custom frame set underlayline [tcl::string::repeat " " $frame_inner_width] @@ -8038,6 +8084,9 @@ tcl::namespace::eval textblock { ;#end !$is_cached } + + + #use the same mechanism to build the final frame - whether from cache or template if {$actual_contentwidth == 0} { set fs [tcl::string::map [list $FSUB " "] $template] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm index 3d454ca8..0ca26f39 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.1.tm @@ -9,7 +9,7 @@ namespace eval punk { zzzload::pkg_require $pkg } } - #lazyload twapi + #lazyload twapi ? catch {package require vfs} ;#attempt load now so we can use faster 'package provide' to test existence later } @@ -3670,7 +3670,7 @@ namespace eval punk { incr i } - #JMN2 + #JMN2 - review #set returnval [lindex $assigned_values 0] if {[llength $assigned_values] == 1} { set returnval [join $assigned_values] @@ -7271,55 +7271,59 @@ namespace eval punk { catch { package require patternpunk #lappend chunks [list stderr [>punk . rhs]] - append mascotblock [textblock::frame [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] + append mascotblock [textblock::frame -checkargs 0 [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] } set topic [lindex $args end] set argopts [lrange $args 0 end-1] - set text "" - append text "Punk core navigation commands:\n" + set title "[a+ brightgreen] Punk core navigation commands: " #todo - load from source code annotation? set cmdinfo [list] - lappend cmdinfo [list help "This help. To see available subitems type: help topics"] - lappend cmdinfo [list dev "(ensemble command to make new projects/modules and to generate docs)"] - lappend cmdinfo [list a? "view ANSI colours\n e.g a? web"] - lappend cmdinfo [list ./ "view/change directory"] - lappend cmdinfo [list ../ "go up one directory"] - lappend cmdinfo [list ./new "make new directory and switch to it"] - lappend cmdinfo [list n/ "view/change namespace (accepts ns path globs e.g **::*get* to match comands at any level )"] - lappend cmdinfo [list n// "view/change namespace (with command listing)"] - lappend cmdinfo [list nn/ "go up one namespace"] - lappend cmdinfo [list n/new "make child namespace and switch to it"] - - set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] - set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] - set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] - set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] + lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] + lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"] + lappend cmdinfo [list ./ "?subdir?" "view/change directory"] + lappend cmdinfo [list ../ "" "go up one directory"] + lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] + lappend cmdinfo [list n/ "?glob...?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match comands at any level )"] + lappend cmdinfo [list n// "" "view/change namespace (with command listing)"] + lappend cmdinfo [list "nn/" "" "go up one namespace"] + lappend cmdinfo [list "n/new" "" "make child namespace and switch to it"] + lappend cmdinfo [list dev "?subcommand?" "(ensemble command to make new projects/modules and to generate docs)"] + lappend cmdinfo [list a? "?subcommand...?" "view ANSI colours\n e.g a? web"] + + #set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] + #set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] + #set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] + #set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] set t [textblock::class::table new -show_seps 0] - foreach c $cmds d $descr { - #append text " [overtype::left $col1 $c][overtype::left $col2 $d]" \n - $t add_row [list $c $d] - } - set widest1 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$widest1 + 2}] - set widest2 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$widest2 + 1}] + #foreach c $cmds d $descr { + # $t add_row [list $c $d] + #} + foreach row $cmdinfo { + $t add_row $row + } + set width_0 [$t column_datawidth 0] + $t configure_column 0 -minwidth [expr {$width_0 + 2}] + set width_1 [$t column_datawidth 1] + $t configure_column 1 -minwidth [expr {$width_1 + 1}] + $t configure -title $title + + set text "" append text [$t print] set warningblock "" + set introblock $mascotblock + append introblock \n $text - if {[catch {package require textblock} errM]} { - set introblock $mascotblock - append introblock \n $text - append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" - - } else { - set introblock [textblock::join -- " " \n$mascotblock " " $text] - } + #if {[catch {package require textblock} errM]} { + # append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" + #} else { + # set introblock [textblock::join -- " " \n$mascotblock " " $text] + #} lappend chunks [list stdout $introblock] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index b616da59..1e52d3e9 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -132,14 +132,29 @@ tcl::namespace::eval punk::ansi::class { set rendered [overtype::renderspace -cp437 1 -expand_right 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] return $rendered } + + lappend ::punk::ansi::class::PUNKARGS [list { + *id "punk::ansi::class::class_ansi render_to_input_line" + *proc -name "punk::ansi::class::class_ansi render_to_input_line" -help\ + "render string from line 0 to line + (experimental/debug)" + -dimensions -type string -help\ + "WxH where W is integer width >= 1 and H is integer heigth >= 1" + -minus -type integer -help\ + "number of chars to exclude from end" + *values -min 1 -max 1 + line -type indexexpression + }] method render_to_input_line {args} { if {[llength $args] < 1} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set x [lindex $args end] set arglist [lrange $args 0 end-1] if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set opts [tcl::dict::create\ -dimensions 80x24\ @@ -322,6 +337,7 @@ tcl::namespace::eval punk::ansi::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ansi { + variable PUNKARGS #*** !doctools #[subsection {Namespace punk::ansi}] #[para] Core API functions for punk::ansi @@ -422,6 +438,8 @@ tcl::namespace::eval punk::ansi { erase*\ get_*\ hyperlink\ + hyperlink_open\ + hyperlink_close\ move*\ reset*\ ansistrip*\ @@ -554,21 +572,35 @@ tcl::namespace::eval punk::ansi { $obj destroy return $result } - proc example {args} { - set base [punk::repo::find_project] - set default_ansifolder [file join $base src/testansi] - set argd [punk::args::get_dict [tstr -return string { + proc Get_ansifolder {} { + if {[catch {punk::repo::find_project} base]} { + set base "" + } + if {$base eq ""} { + #pwd not avail in safe interp + if {![catch {pwd} CWD]} { + set base $CWD + } + } + return [file join $base src/testansi] + } + + lappend PUNKARGS [list -dynamic 1 { + *id punk::ansi::example *proc -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) You can specify a narrower width to truncate images on the right side" - -folder -default "${$default_ansifolder}" -help "Base folder for files if relative paths are used. + -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. Defaults to /src/testansi - where projectbase is determined from current directory. " *values -min 0 -max -1 files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" - }] $args] + } ""] + + proc example {args} { + set argd [punk::args::get_by_id punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -621,7 +653,7 @@ tcl::namespace::eval punk::ansi { set subtitle [tcl::dict::get $picinfo status] } set title [tcl::dict::get $picinfo filename] - set fr [textblock::frame -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] + set fr [textblock::frame -checkargs 0 -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] # -- --- --- --- #we need the max height of a row element to use join_basic instead of join below # -- --- --- --- @@ -2320,16 +2352,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off - proc sgr_cache {args} { - set argd [punk::args::get_dict { - *proc -name punk::ansi::sgr_cache -help "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " - -action -default "" -choices "clear" -help "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" - -pretty -default 1 -type boolean -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" + #punk::args depends on punk::ansi - REVIEW + proc sgr_cache {args} { + set argdef { + *id punk::ansi::sgr_cache + *proc -name punk::ansi::sgr_cache -help\ + "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) + " + -action -default "" -choices "clear" -help\ + "-action clear will unset the keys in the punk::ansi::sgr_cache dict + This is called automatically when setting 'colour false' in the console" + + -pretty -default 1 -type boolean -help\ + "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" *values -min 0 -max 0 - } $args] + } + set argd [punk::args::get_dict $argdef $args] set action [dict get $argd opts -action] set pretty [dict get $argd opts -pretty] @@ -2372,6 +2411,31 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return [join $lines \n] } + lappend PUNKARGS [list { + *id punk::ansi::a+ + *proc -name "punk::ansi::a+" -help\ + "Returns an ANSI sgr escape sequence based on the list of supplied codes. + " + *values -min 0 -max -1 + } [string map [list [dict keys $SGR_map]] { + code -type string -optional 1 -multiple 1 -choices {} -choiceprefix 0 -choicerestricted 0 -help\ + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- + + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web" + + }]] + proc a+ {args} { #*** !doctools #[call [fun a+] [opt {ansicode...}]] @@ -3267,17 +3331,49 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # REVIEW - osc8 replays etc for split lines? - textblock + #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda #the 'id' parameter logically connects split hyperlinks + #per interp. Rather than try to avoid collisions using something like 'info cmdcount' we will use a simple counter. + #To stop multiple hyperlinks from having ids inadvertently collide - we should do some id mangling/prefixing based on the terminal/window etc + #It is better to use a simple counter with high likelihood of collision so we are more likely to detect problems with ids than to make it more intermittent by using ids that collide only 'rarely' + variable hyperlinkcounter + set hyperlinkcounter 0 + + proc hyperlink {uri {display ""}} { + variable hyperlinkcounter if {$display eq ""} { set display $uri } - set params "" ;#todo e.g id=xyz123:foo=bar:baz=quux + set uri [punk::ansi::ansistripraw $uri] + #limit uri length we emit based on common limits in other terminals + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set params "id=punkansi-[incr hyperlinkcounter]" ;#todo e.g id=xyz123:foo=bar:baz=quux set open "\x1b\]8\;$params\;$uri\x1b\\" set close "\x1b\]8\;\;\x1b\\" return ${open}${display}${close} } + #on windows terminal at least, both uri and id of 2 separated hyperlinks need to match for the hover highlighting to act as a unit. + proc hyperlink_open {uri {id ""}} { + if {$id eq ""} { + set id punkansi-[incr hyperlinkcounter] + } + set uri [punk::ansi::ansistripraw $uri] + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set id [string map {: . {;} ,} $id] ;#avoid some likely problematic ids. TODO - review, restrict further. + set params "id=$id" + return "\x1b\]8\;$params\;$uri\x1b\\" + } + #It should be ok to close even if no currently active hyperlink (e.g can be used to cleanup if something awry) + proc hyperlink_close {} { + return "\x1b\]8\;\;\x1b\\" + } + # -- --- --- --- --- proc move {row col} { #*** !doctools @@ -3837,11 +3933,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun ansistrip] [arg text] ] #[para]Return a string with ansi codes stripped out #[para]Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs) - + if {[string length $text] < 2} {return $text} if {[punk::ansi::ta::detect_g0 $text]} { set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters } + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] + if {[llength $parts] == 1} {return [lindex $parts 0]} set out "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" # - (if/when lsearch -stride bug fixed) @@ -3871,6 +3969,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Return a string with ansi codes stripped out #[para]Alternate graphics modes will be stripped rather than converted to unicode - exposing the raw ascii characters as they appear without graphics mode. #[para]ie instead of a horizontal line you may see: qqqqqq + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] set out "" @@ -7294,6 +7393,13 @@ tcl::namespace::eval punk::ansi::internal { } } +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set NAMESPACES [list] + } +} +lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::ansi [tcl::namespace::eval punk::ansi { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm index b2854093..c087ae0b 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/args-0.1.0.tm @@ -84,7 +84,7 @@ # *values -min 2 -max 2 # fileA -type existingfile 1 # fileB -type existingfile 1 -# } $args]] opts values +# } $args]] leaders opts values # puts "$category fileA: [dict get $values fileA]" # puts "$category fileB: [dict get $values fileB]" # } @@ -218,49 +218,45 @@ package require Tcl 8.6- #*** !doctools #[section API] -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# oo::class namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval punk::args::class { +tcl::namespace::eval punk::args::register { #*** !doctools - #[subsection {Namespace punk::args::class}] - #[para] class definitions - if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { - #*** !doctools - #[list_begin enumerated] - - # oo::class create interface_sample1 { - # #*** !doctools - # #[enum] CLASS [class interface_sample1] - # #[list_begin definitions] + #[subsection {Namespace punk::args}] + #[para] cooperative namespace punk::args::register + #[para] punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded + #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. + #[list_begin definitions] - # method test {arg1} { - # #*** !doctools - # #[call class::interface_sample1 [method test] [arg arg1]] - # #[para] test method - # puts "test: $arg1" - # } + # -- --- --- --- --- --- --- --- + #cooperative with packages that define some punk args but may need to do so lazily + #These could be loaded prior to punk::args being loaded + variable NAMESPACES + if {![info exists ::punk::args::register::NAMESPACES]} { + set NAMESPACES [list] + } + # -- --- --- --- --- --- --- --- - # #*** !doctools - # #[list_end] [comment {-- end definitions interface_sample1}] - # } - #*** !doctools - #[list_end] [comment {--- end class enumeration ---}] - } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::register ---}] } -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args { + + + variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::definition at the end. + tcl::namespace::export {[a-z]*} - variable argspec_cache - variable argspec_ids + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved variable id_counter - set argspec_cache [tcl::dict::create] - set argspec_ids [tcl::dict::create] + set argdata_cache [tcl::dict::create] + set argdefcache_by_id [tcl::dict::create] + set argdefcache_unresolved [tcl::dict::create] set id_counter 0 #*** !doctools @@ -271,72 +267,127 @@ tcl::namespace::eval punk::args { #todo - some sort of punk::args::cherrypick operation to get spec from an existing set #todo - doctools output from definition - #dict get value with default wrapper for tcl 8.6 - if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef - proc Dict_getdef {dictValue args} { - set keys [lrange $args 0 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] - } - } - } else { - #we pay a minor perf penalty for the wrap - interp alias "" ::punk::args::Dict_getdef "" ::tcl::dict::getdef - } - - #name to reflect maintenance - home is punk::lib::ldiff - proc punklib_ldiff {fromlist removeitems} { - if {[llength $removeitems] == 0} {return $fromlist} - set result {} - foreach item $fromlist { - if {$item ni $removeitems} { - lappend result $item - } - } - return $result - } - proc flatzip {l1 l2} { - concat {*}[lmap a $l1 b $l2 {list $a $b}] - } - if {[info commands lseq] ne ""} { - #tcl 8.7+ lseq significantly faster, especially for larger ranges - #The internal rep can be an 'arithseries' with no string representation - proc zero_to_n {n} { - lseq 0 $n - } - } else { - proc zero_to_n {n} { - lsearch -all [lrepeat $n 0] * - } - } #todo? -synonym/alias ? (applies to opts only not values) #e.g -background -aliases {-bg} -default White - #review - how to make work with trie prefix e.g -corner -aliases {-corners} + #review - how to make work with trie prefix + #e.g + # -corner -aliases {-corners} + # -centre -aliases {-center -middle} #We mightn't want the prefix to be longer just because of an alias + #we should get -co -ce and -m from the above as abbreviations + + lappend PUNKARGS [list { + *id punk::args::definition + *proc -name punk::args::definition -help\ + "Accepts a line-based definition of command arguments. + The definition should usually contain a line of the form: *id someid + " + -dynamic -type boolean -default 0 -help\ + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is not usually significant, perhaps on the order of a few hundred uS, + but -dynamic true might be less desirable if the command is used in inner + loops in more performance-sensitive code. + " + *values -min 1 -max -1 + text -type string -multiple 1 -help\ + "Block(s) of text representing the argument specification for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + e.g + definition { + *id myns::myfunc + *proc -name myns::myfunc -help\\ + \"Description of command\" + + #The following option defines an option-value pair + -option1 -default blah -type string + #The following option defines a flag style option (solo) + -flag1 -default 0 -type none -help\\ + \"Info about flag1\" + + *values -min 1 -max -1 + #Items that don't begin with * or - are value definitions + v1 -type integer -default 0 + thinglist -type string -multiple 1 + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + " + }] + proc definition {args} { + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved + - proc definition {optionspecs args} { - variable argspec_cache - #variable argspecs ;#REVIEW!! - variable argspec_ids #variable initial_optspec_defaults #variable initial_valspec_defaults #ideally we would use a fast hash algorithm to produce a short key with low collision probability. #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. #review - check if there is a built-into-tcl way to do this quickly #for now we will just key using the whole string - set cache_key $optionspecs - if {[tcl::dict::exists $argspec_cache $cache_key]} { - return [tcl::dict::get $argspec_cache $cache_key] + + set cache_key $args + set textargs $args + + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] + set textargs [lrange $args 2 end] } - set optionspecs [tcl::string::map [list \r\n \n] $optionspecs] + if {!$is_dynamic} { + if {[tcl::dict::exists $argdata_cache $cache_key]} { + return [tcl::dict::get $argdata_cache $cache_key] + } + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + if {[string first \$\{ $optionspecs] > 0} { + set optionspecs [uplevel 1 [list punk::args::lib::tstr -return string -eval 1 $optionspecs]] + } + } else { + if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { + set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + } else { + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + #REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?) + if {[string first \$\{ $optionspecs] > 0} { + set pt_params [punk::args::lib::tstr -return list -eval 0 $optionspecs] ;#-eval 0 - no need to uplevel + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + tcl::dict::set argdefcache_unresolved $cache_key $pt_params + } + } + if {[tcl::dict::exists $argdata_cache $optionspecs]} { + #resolved cache version exists + return [tcl::dict::get $argdata_cache $optionspecs] + } + } + + + #probably faster to inline a literal dict create in the proc than to use a namespace variable set optspec_defaults [tcl::dict::create\ -type string\ @@ -381,7 +432,7 @@ tcl::namespace::eval punk::args { #default to 1 for convenience #checks with no default - #-minlen -maxlen -range + #-minsize -maxsize -range #default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi @@ -473,14 +524,19 @@ tcl::namespace::eval punk::args { } set proc_info {} set id_info {} ;#e.g -children ?? - set leader_min 0 - set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set doc_info {} + set parser_info {} + set leader_min "" + #set leader_min 0 + #set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set leader_max "" #(common case of no leaders specified) set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit set spec_id "" set argspace "leaders" ;#leaders -> options -> values + set parser_id 0 foreach ln $records { set trimln [tcl::string::trim $ln] switch -- [tcl::string::index $trimln 0] { @@ -510,10 +566,45 @@ tcl::namespace::eval punk::args { error "punk::args::definition - bad *id line. Remaining items on line after *id must be in paired option-value format - received '$linespecs'" } } + parser { + #handle multiple parsing styles based on arities and keyword positions (and/or flags?) + #e.g see lseq manual with 3 different parsing styles. + #aim to produce a table/subtable for each + # *parser -description "start ?('..'|'to')? end ??'by'? step?"\ + # -arities { + # 2 + # {3 anykeys {1 .. 1 to}} + # {4 anykeys {3 by}} + # {5 anykeys {1 .. 1 to 3 by}} + # }\ + # -fallback 1 + # ... + # *parser -description "start 'count' count ??'by'? step?"\ + # -arities { + # {3 anykeys {1 count}} + # } + # ... + # *parser -description "count ?'by' step?"\ + # -arities { + # 1 + # {3 anykeys {1 by}} + # } + # + # see also after manual + # *parser -arities {1} + # *parser -arities { + # 1 anykeys {0 info} + # } + #todo + set parser_info $starspecs + } proc { #allow arbitrary - review set proc_info $starspecs } + doc { + set doc_info $starspecs + } opts { if {$argspace eq "values"} { error "punk::args::definition - *opts declaration must come before *values - received '$linespecs'" @@ -525,13 +616,14 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { #review - only apply to certain types? tcl::dict::set optspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels - -nocase { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels - -nocase { if {$v} { - tcl::dict::unset optspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset optspec_defaults $k2 } } -type { @@ -563,16 +655,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { #allow overriding of defaults for options that occur later tcl::dict::set optspec_defaults $k $v } default { - set known { -any -anyopts -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *opts line. Known keys: $known" } @@ -588,27 +681,28 @@ tcl::namespace::eval punk::args { -min - -minvalues { if {$v < 0} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is 0. got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is 0. got $v" } set leader_min $v - if {$leader_max == 0} { - set leader_max -1 - } + #if {$leader_max == 0} { + # set leader_max -1 + #} } -max - -maxvalues { if {$v < -1} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is -1 (indicating unlimited). got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is -1 (indicating unlimited). got $v" } set leader_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set leaderspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset leaderspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset leaderspec_defaults $k2 } } -type { @@ -640,16 +734,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set leaderspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *leaders line. Known keys: $known" } @@ -675,13 +770,14 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set valspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset valspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset valspec_defaults $k2 } } -type { @@ -713,16 +809,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set valspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *values line. Known keys: $known" } @@ -754,7 +851,7 @@ tcl::namespace::eval punk::args { if {$argspace eq "leaders"} { tcl::dict::set argspecs -ARGTYPE leader lappend leader_names $argname - if {$leader_max == 0} { + if {$leader_max >= 0} { set leader_max [llength $leader_names] } } else { @@ -819,11 +916,12 @@ tcl::namespace::eval punk::args { } } } - -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - + -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - - -regexprepass - -regexprefail + -regexprepass - -regexprefail - -regexprefailmsg { - #review -solo 1 vs -type none ? + #inverses '-noxxx' (e.g -nochoices -nominsize etc) don't apply to specific args - only to *leaders *opts *values lines + #review -solo 1 vs -type none ? conflicting values? tcl::dict::set spec_merged $spec $specval } -validationtransform { @@ -833,10 +931,10 @@ tcl::namespace::eval punk::args { } dict for {tk tv} $specval { switch -- $tk { - -function - -type - -minlen - -maxlen - -range { + -function - -type - -minsize - -maxsize - -range { } default { - set known_transform_keys [list -function -type -minlen -maxlen -range] ;#-choices etc? + set known_transform_keys [list -function -type -minsize -maxsize -range] ;#-choices etc? error "punk::args::definition - invalid subkey $tk for key '$spec' in specifications for argument '$argname' must be one of: $known_transform_keys" } } @@ -844,9 +942,9 @@ tcl::namespace::eval punk::args { } default { - set known_argspecs [list -default -type -range -choices -choiceprefix -choicerestricted\ + set known_argspecs [list -default -type -range -minsize -maxsize -choices -choiceprefix -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] error "punk::args::definition - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } @@ -854,9 +952,9 @@ tcl::namespace::eval punk::args { } set argspecs $spec_merged if {$is_opt} { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } else { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } tcl::dict::set arg_info $argname $argspecs tcl::dict::set arg_checks $argname $argchecks @@ -886,11 +984,21 @@ tcl::namespace::eval punk::args { } # REVIEW - foreach leadername [lrange $leader_names 0 end] { - if {[tcl::dict::get $arg_info $leadername -multiple]} { - error "bad key -multiple on argument spec for leader '$valname'. Only the last value argument specification can be marked -multiple" + #if {[llength $val_names] || $val_min > 0} { + # #some values are specified + # foreach leadername [lrange $leader_names 0 end] { + # if {[tcl::dict::get $arg_info $leadername -multiple]} { + # error "bad key -multiple on argument spec for leader '$leadername'. Last leader argument specification can be marked -multiple only when no values are specified" + # } + # } + #} else { + #no values specified - we can allow last leader to be multiple + foreach leadername [lrange $leader_names 0 end-1] { + if {[tcl::dict::get $arg_info $leadername -multiple]} { + error "bad key -multiple on argument spec for leader '$leadername'. Only the last leader argument specification can be marked -multiple" + } } - } + #} #confirm any valnames before last don't have -multiple key foreach valname [lrange $val_names 0 end-1] { if {[tcl::dict::get $arg_info $valname -multiple]} { @@ -906,11 +1014,11 @@ tcl::namespace::eval punk::args { #todo - do some checks for obvious bad definitions involving a mix of *leaders and *values (e.g with optional options) - set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize - set result [tcl::dict::create\ + set argdata_dict [tcl::dict::create\ id $spec_id\ arg_info $arg_info\ arg_checks $arg_checks\ @@ -936,24 +1044,31 @@ tcl::namespace::eval punk::args { valspec_defaults $valspec_defaults\ val_checks_defaults $val_checks_defaults\ proc_info $proc_info\ + doc_info $doc_info\ id_info $id_info\ ] - tcl::dict::set argspec_cache $cache_key $result - #tcl::dict::set argspecs $spec_id $optionspecs - tcl::dict::set argspec_ids $spec_id $optionspecs + tcl::dict::set argdata_cache $cache_key $argdata_dict + if {$is_dynamic} { + #also cache resolved version + tcl::dict::set argdata_cache $optionspecs $argdata_dict + } + #tcl::dict::set argdefcache_by_id $spec_id $optionspecs + tcl::dict::set argdefcache_by_id $spec_id $args #puts "xxx:$result" - return $result + return $argdata_dict } proc get_spec {id {patternlist *}} { - variable argspec_ids - if {[tcl::dict::exists $argspec_ids $id]} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { if {$patternlist eq "*"} { - return [tcl::dict::get $argspec_ids $id] + #todo? + return [tcl::dict::get $argdefcache_by_id $realid] } else { - set spec [tcl::dict::get $argspec_ids $id] + set speclist [tcl::dict::get $argdefcache_by_id $realid] set result "" - set specdict [definition $spec] + set specdict [uplevel 1 [list ::punk::args::definition {*}$speclist]] set arg_info [dict get $specdict arg_info] foreach pat $patternlist { set matches [dict keys $arg_info $pat] @@ -968,13 +1083,128 @@ tcl::namespace::eval punk::args { } return } + proc get_spec_values {id {patternlist *}} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { + set speclist [tcl::dict::get $argdefcache_by_id $realid] + set specdict [definition {*}$speclist] + set arg_info [dict get $specdict arg_info] + set valnames [dict get $specdict val_names] + set result "" + if {$patternlist eq "*"} { + foreach v $valnames { + set def [dict get $arg_info $v] + set def [dict remove $def -ARGTYPE] + append result \n "$v $def" + } + } else { + foreach pat $patternlist { + set matches [dict keys $arg_info $pat] + set matches [lsearch -all -inline -glob $valnames $pat] + foreach m $matches { + set def [dict get $arg_info $m] + set def [dict remove $def -ARGTYPE] + append result \n "$m $def" + } + } + return $result + } + } + return + } #proc get_spec_leaders ?? #proc get_spec_opts ?? - #proc get_spec_values ?? - proc get_spec_ids {{match *}} { - variable argspec_ids - return [tcl::dict::keys $argspec_ids $match] + variable aliases + set aliases [dict create] + + lappend PUNKARGS [list { + *id punk::args::get_ids + *proc -name punk::args::get_ids -help\ + "return list of ids for argument definitions" + *values -min 0 -max 1 + match -default * -help\ + "exact id or glob pattern for ids" + }] + proc get_ids {{match *}} { + variable argdefcache_by_id + variable aliases + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + } + proc id_exists {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + return 1 + } + tcl::dict::exists $argdefcache_by_id $id + } + proc set_alias {alias id} { + variable aliases + dict set aliases $alias $id + } + proc unset_alias {alias} { + variable aliases + dict unset aliases $alias + } + proc get_alias {alias} { + variable aliases + if {[dict exists $aliases $alias]} { + return [tcl::dict::get $aliases $alias] + } + } + + proc real_id {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } else { + if {![llength [update_definitions]]} { + return "" + } else { + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } + return "" + } + } + } + + variable loaded_packages + set loaded_packages [list] + + proc update_definitions {} { + variable loaded_packages + upvar ::punk::args::register::NAMESPACES pkgs + if {[llength $loaded_packages] == [llength $pkgs]} { + #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + return {} + } + set unloaded [punklib_ldiff $pkgs $loaded_packages] + set newloaded [list] + foreach pkgns $unloaded { + if {![catch { + if {[info exists ${pkgns}::PUNKARGS]} { + foreach deflist [set ${pkgns}::PUNKARGS] { + namespace eval $pkgns [list punk::args::definition {*}$deflist] + } + } + } errMsg]} { + lappend loaded_pkgs $pkgns + lappend newloaded $pkgns + } else { + puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" + } + } + return $newloaded } #for use within get_dict only @@ -1018,253 +1248,408 @@ tcl::namespace::eval punk::args { #basic recursion blocker variable arg_error_isrunning 0 - proc arg_error {msg spec_dict {badarg ""}} { + proc arg_error {msg spec_dict args} { + if {[catch {package require punk::ansi}]} { + proc punk::args::a {args} {} + proc punk::args::a+ {args} {} + } else { + namespace eval ::punk::args { + namespace import ::punk::ansi::a ::punk::ansi::a+ + } + } #limit colours to standard 16 so that themes can apply to help output variable arg_error_isrunning if {$arg_error_isrunning} { - error "arg_error already running - error in arg_error?\n triggering errmsg: $badarg" + error "arg_error already running - error in arg_error?\n triggering errmsg: $msg" } set arg_error_isrunning 1 + if {[llength $args] %2 != 0} { + error "error in arg_error processing - expected opt/val pairs after msg and spec_dict" + } + set badarg "" + set returntype error + dict for {k v} $args { + switch -- $k { + -badarg { + set badarg $v + } + -return { + if {$v ni {error string}} { + error "arg_error invalid value for option -return. Received '$v' expected one of: error string" + } + set returntype $v + } + default { + error "arg_error invalid option $k. Known_options: -badarg -return" + } + } + } + + #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error #e.g list_as_table # use basic colours here to support terminals without extended colours - #todo - add checks column (e.g -minlen -maxlen) + #todo - add checks column (e.g -minsize -maxsize) set errmsg $msg if {![catch {package require textblock}]} { - if {[catch { + set has_textblock 1 + } else { + set has_textblock 0 + #couldn't load textblock package + #just return the original errmsg without formatting + } + set errlines [list] ;#for non-textblock output + if {[catch { + if {$has_textblock} { append errmsg \n - set procname [::punk::args::Dict_getdef $spec_dict proc_info -name ""] - set prochelp [::punk::args::Dict_getdef $spec_dict proc_info -help ""] + } else { + append errmsg \n "[a+ brightred](layout package textblock is missing)[a]" \n + } + set procname [Dict_getdef $spec_dict proc_info -name ""] + set prochelp [Dict_getdef $spec_dict proc_info -help ""] - set t [textblock::class::table new [a+ brightyellow]Usage[a]] + set docname [Dict_getdef $spec_dict doc_info -name "Manual:"] + set docurl [Dict_getdef $spec_dict doc_info -url ""] - set blank_header_col [list ""] - if {$procname ne ""} { - lappend blank_header_col "" - set procname_display [a+ brightwhite]$procname[a] - } else { - set procname_display "" - } - if {$prochelp ne ""} { - lappend blank_header_col "" - set prochelp_display [a+ brightwhite]$prochelp[a] - } else { - set prochelp_display "" - } + + set blank_header_col [list ""] + if {$procname ne ""} { + lappend blank_header_col "" + set procname_display [a+ brightwhite]$procname[a] + } else { + set procname_display "" + } + if {$prochelp ne ""} { + lappend blank_header_col "" + set prochelp_display [a+ brightwhite]$prochelp[a] + } else { + set prochelp_display "" + } + if {$docurl ne ""} { + lappend blank_header_col "" + set docurl_display [a+ white]$docurl[a] + } else { + set docurl_display "" + } + if {$has_textblock} { + set t [textblock::class::table new [a+ brightyellow]Usage[a]] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col - if {"$procname$prochelp" eq ""} { - $t configure_header 0 -values {Arg Type Default Multi Help} - } elseif {$procname eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 1 -values {Arg Type Default Multi Help} - } elseif {$prochelp eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -values {Arg Type Default Multi Help} + } + set h 0 + if {$procname ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] + } else { + lappend errlines "PROC/METHOD: $procname_display" + } + incr h + } + if {$prochelp ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] } else { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 2 -values {Arg Type Default Multi Help} + lappend errlines "Description: $prochelp_display" + } + incr h + } + if {$docurl ne ""} { + if {![catch {package require punk::ansi}]} { + set docurl [punk::ansi::hyperlink $docurl] } + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list $docname $docurl_display] + } else { + lappend errlines "$docname $docurl_display" + } + incr h + } + if {$has_textblock} { + $t configure_header $h -values {Arg Type Default Multi Help} + } else { + lappend errlines " --ARGUMENTS-- " + } + + set RST [a] + #set A_DEFAULT [a+ brightwhite Brightgreen] + set A_DEFAULT "" + set A_BADARG [a+ brightred] + set greencheck [a+ brightgreen]\u2713[a] ;#green tick + set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set A_PREFIX [a+ green] ;#use a+ so colour off can apply + if {$A_PREFIX eq ""} { + set A_PREFIX [a+ underline] + set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + } else { + set A_PREFIXEND $RST + } - set RST [a] - #set A_DEFAULT [a+ brightwhite Brightgreen] - set A_DEFAULT "" - set A_BADARG [a+ brightred] - set greencheck [a+ brightgreen]\u2713[a] ;#green tick - set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) - set A_PREFIX [a+ green] ;#use a+ so colour off can apply - if {$A_PREFIX eq ""} { - set A_PREFIX [a+ underline] - set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + set opt_names [list] + set opt_names_display [list] + if {[llength [dict get $spec_dict opt_names]]} { + if {![catch {package require punk::trie}]} { + set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $spec_dict opt_names] { + set id [dict get $idents $c] + #REVIEW + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail + #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] + lappend opt_names $c + } } else { - set A_PREFIXEND $RST + set opt_names [dict get $spec_dict opt_names] + set opt_names_display $opt_names } - - set opt_names [list] - set opt_names_display [list] - if {[llength [dict get $spec_dict opt_names]]} { - if {![catch {package require punk::trie}]} { - set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy - foreach c [dict get $spec_dict opt_names] { - set id [dict get $idents $c] - #REVIEW - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] - } - lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail - #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] - lappend opt_names $c - } + } + set leading_val_names [dict get $spec_dict leader_names] + set trailing_val_names [dict get $spec_dict val_names] + + #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { + # if {![string match -* $argname]} { + # lappend leading_val_names [lpop trailing_val_names 0] + # } else { + # break + # } + #} + #if {![llength $leading_val_names] && ![llength $opt_names]} { + # #all vals were actually trailing - no opts + # set trailing_val_names $leading_val_names + # set leading_val_names {} + #} + set leading_val_names_display $leading_val_names + set trailing_val_names_display $trailing_val_names + + #display options first then values + foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { + lassign $argumentset argnames_display argnames + + foreach argshow $argnames_display arg $argnames { + set arginfo [dict get $spec_dict arg_info $arg] + if {[dict exists $arginfo -default]} { + set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" } else { - set opt_names [dict get $spec_dict opt_names] - set opt_names_display $opt_names + set default "" } - } - set leading_val_names [dict get $spec_dict leader_names] - set trailing_val_names [dict get $spec_dict val_names] - - #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { - # if {![string match -* $argname]} { - # lappend leading_val_names [lpop trailing_val_names 0] - # } else { - # break - # } - #} - #if {![llength $leading_val_names] && ![llength $opt_names]} { - # #all vals were actually trailing - no opts - # set trailing_val_names $leading_val_names - # set leading_val_names {} - #} - set leading_val_names_display $leading_val_names - set trailing_val_names_display $trailing_val_names - - #display options first then values - foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { - lassign $argumentset argnames_display argnames - - foreach argshow $argnames_display arg $argnames { - set arginfo [dict get $spec_dict arg_info $arg] - if {[dict exists $arginfo -default]} { - set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" + set help [Dict_getdef $arginfo -help ""] + if {[dict exists $arginfo -choices]} { + if {$help ne ""} {append help \n} + if {[dict get $arginfo -nocase]} { + set casemsg " (case insensitive)" } else { - set default "" + set casemsg " (case sensitive)" } - set help [::punk::args::Dict_getdef $arginfo -help ""] - if {[dict exists $arginfo -choices]} { - if {$help ne ""} {append help \n} - if {[dict get $arginfo -nocase]} { - set casemsg " (case insensitive)" - } else { - set casemsg " (case sensitive)" - } - if {[dict get $arginfo -choiceprefix]} { - set prefixmsg " (choice prefix allowed)" + if {[dict get $arginfo -choiceprefix]} { + set prefixmsg " (choice prefix allowed)" + } else { + set prefixmsg "" + } + set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] + set formattedchoices [list] + append help " Choices$prefixmsg$casemsg" + if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + #append help "\n " [join [dict get $arginfo -choices] "\n "] + if {[dict size $choicelabeldict]} { + foreach c [dict get $arginfo -choices] { + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } } else { - set prefixmsg "" + set formattedchoices [dict get $arginfo -choices] } - set formattedchoices [list] - append help " Choices$prefixmsg$casemsg" - if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + } else { + if {[catch { + set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $arginfo -choices] { + set id [dict get $idents $c] + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + set cdisplay "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } + } errM]} { + puts stderr "prefix marking failed\n$errM" #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - } else { - if {[catch { - set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy + if {[dict size $choicelabeldict]} { foreach c [dict get $arginfo -choices] { - set id [dict get $idents $c] - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] } - lappend formattedchoices "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" - } - } errM]} { - puts stderr "prefix marking failed\n$errM" - #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - - } - } - set numcols 4 - if {[llength $formattedchoices] < $numcols} { - #don't show blank cells if single line of results - set numcols [llength $formattedchoices] - } - #risk of recursing - set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] - append help \n[textblock::join -- " " $choicetable] - #review. use -type to restrict additional choices - may be different to values in the -choices - if {![dict get $arginfo -choicerestricted]} { - if {[dict get $arginfo -type] eq "string"} { - append help "\n (values not in defined choices are allowed)" + lappend formattedchoices $cdisplay + } } else { - append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + set formattedchoices [dict get $arginfo -choices] } + } } - if {[::punk::args::Dict_getdef $arginfo -multiple 0]} { - set multiple $greencheck - } else { - set multiple "" + set numcols 4 ;#todo - dynamic? + if {[llength $formattedchoices] < $numcols} { + #don't show blank cells if single line of results + set numcols [llength $formattedchoices] } - if {[::punk::args::Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { - set argshow "?${argshow}?" + if {$numcols > 0} { + if {$has_textblock} { + #risk of recursing + set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] + append help \n[textblock::join -- " " $choicetable] + } else { + append help \n [join $formattedchoices \n] + } + } else { + #we were given an empty set of choices. + #probably an error in the definition - but could happen if dynamically generated. + #(e.g ensemble where unknown mechanism is used for subcommands?) + #better to just display that there were none rather than totally break the usage output. + append help \n " " [a+ red](no choices defined)[a] } - set typeshow [dict get $arginfo -type] - if {$typeshow eq "none"} { - set typeshow "$typeshow $soloflag" + + #review. use -type to restrict additional choices - may be different to values in the -choices + if {![dict get $arginfo -choicerestricted]} { + if {[dict get $arginfo -type] eq "string"} { + append help "\n (values not in defined choices are allowed)" + } else { + append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + } } + } + if {[Dict_getdef $arginfo -multiple 0]} { + set multiple $greencheck + } else { + set multiple "" + } + if {[Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { + set argshow "?${argshow}?" + } + set typeshow [dict get $arginfo -type] + if {$typeshow eq "none"} { + set typeshow "$typeshow $soloflag" + } + if {[dict exists $arginfo -minsize]} { + append typeshow \n "-minsize [dict get $arginfo -minsize]" + } + if {[dict exists $arginfo -maxsize]} { + append typeshow \n "-maxsize [dict get $arginfo -maxsize]" + } + if {[dict exists $arginfo -range]} { + append typeshow \n "-range [dict get $arginfo -range]" + } + + if {$has_textblock} { $t add_row [list $argshow $typeshow $default $multiple $help] if {$arg eq $badarg} { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_BADARG } + } else { + #review - formatting will be all over the shop due to newlines in typesshow, help + lappend errlines "$argshow TYPE:$typeshow DEFAULT:$default MULTI:$multiple HELP:$help\n" } } + } - - #$t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ web-white] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] + if {$has_textblock} { $t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ brightwhite] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] $t configure -maxwidth 80 append errmsg [$t print] $t destroy - } errM]} { - catch {$t destroy} - append errmsg \n - append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n - append errmsg "$errM" \n - append errmsg "$::errorInfo" - + } else { + append errmsg [join $errlines \n] } - } else { - #couldn't load textblock package - #just return the original errmsg without formatting + } errM]} { + catch {$t destroy} + append errmsg \n + append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n + append errmsg "$errM" \n + append errmsg "$::errorInfo" + } set arg_error_isrunning 0 #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. #Also,we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;) - return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + if {$returntype eq "error"} { + return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + } else { + return $errmsg + } } - #todo - a version of get_dict that supports punk::lib::tstr templating - #rename get_dict - #provide ability to look up and reuse definitions from ids etc - # + lappend PUNKARGS [list { + *id punk::args::usage + *proc -name punk::args::usage -help\ + "return usage information as a string + in table form." + *values -min 0 -max 1 + id -help\ + "exact id. + Will usually match the command name" + }] + proc usage {id} { + set speclist [get_spec $id] + if {[llength $speclist] == 0} { + error "punk::args::usage - no such id: $id" + } + arg_error "" [uplevel 1 [list punk::args::definition {*}$speclist]] -return string + } + + lappend PUNKARGS [list { + *id punk::args::get_by_id + *proc -name punk::args::get_by_id + *values -min 1 + id + arglist -default "" -type list -help\ + "list containing arguments to be parsed as per the + argument specification identified by the supplied id." + }] proc get_by_id {id {arglist ""}} { - set spec [get_spec $id] - if {$spec eq ""} { + set speclist [punk::args::get_spec $id] + if {[llength $speclist] == 0} { error "punk::args::get_by_id - no such id: $id" } - return [get_dict $spec $arglist] + return [uplevel 1 [list ::punk::args::get_dict {*}$speclist $arglist]] } + #todo? - a version of get_dict that directly supports punk::lib::tstr templating + #rename get_dict + # + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. #only supports -flag val pairs, not solo options #If an option is supplied multiple times - only the last value is used. - proc get_dict {optionspecs args} { + proc get_dict {args} { #*** !doctools - #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[call [fun get_dict] [arg optionspecs] [arg rawargs]] #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values #[para]Returns a dict of the form: opts values #[para]ARGUMENTS: @@ -1297,48 +1682,53 @@ tcl::namespace::eval punk::args { # *values -multiple 1 #} $args - if {[llength $args] == 0} { - set rawargs [list] - } elseif {[llength $args] ==1} { - set rawargs [lindex $args 0] ;#default tcl style - } else { - #todo - can we support tk style vals before flags? - #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order - #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. - #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options - #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. - #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. - error "unsupported number of arguments for punk::args::get_dict" - set inopt 0 - set k "" - set i 0 - foreach a $args { - switch -- $f { - -opts { - - } - -vals { - - } - -optvals { - #tk style - - } - -valopts { - #tcl style - set rawargs [lindex $args $i+1] - incr i - } - default { - - } - } - incr i - } + #if {[llength $args] == 0} { + # set rawargs [list] + #} elseif {[llength $args] ==1} { + # set rawargs [lindex $args 0] ;#default tcl style + #} else { + # #todo - can we support tk style vals before flags? + # #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + # #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + # #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + # #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + # #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + # error "unsupported number of arguments for punk::args::get_dict" + # set inopt 0 + # set k "" + # set i 0 + # foreach a $args { + # switch -- $f { + # -opts { + + # } + # -vals { + + # } + # -optvals { + # #tk style + + # } + # -valopts { + # #tcl style + # set rawargs [lindex $args $i+1] + # incr i + # } + # default { + + # } + # } + # incr i + # } + #} + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] } + set rawargs [lindex $args end] ;# args values to be parsed + set def_args [lrange $args 0 end-1] - - set argspecs [definition $optionspecs] + set argspecs [uplevel 1 [list ::punk::args::definition {*}$def_args]] tcl::dict::with argspecs {} ;#turn keys into vars #puts "-arg_info->$arg_info" set flagsreceived [list] ;#for checking if required flags satisfied @@ -1354,52 +1744,123 @@ tcl::namespace::eval punk::args { # todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ? set opts $opt_defaults set pre_values {} - #dict for {a info} $arg_info { - # #todo - flag for possible subhandler - whether leading - or not (shellfilter concept) - # if {![string match -* $a]} { - # #lappend pre_values [lpop rawargs 0] - # if {[catch {lpop rawargs 0} val]} { - # break - # } else { - # lappend pre_values $val - # } - # } else { - # break - # } - #} - set argnames [dict keys $arg_info] + set argnames [tcl::dict::keys $arg_info] set optnames [lsearch -all -inline $argnames -*] set ridx 0 set rawargs_copy $rawargs + set leader_posn_name "" + set leader_posn_names_assigned [dict create] ;#track if the name got a value (or multiple if last one) + set is_multiple 0 ;#last leader may be multi if {$leader_max != 0} { foreach r $rawargs_copy { - if {$leader_max != -1 && $ridx > $leader_max-1} { + if {$leader_max ne "" && $leader_max != -1 && $ridx > $leader_max-1} { break } - if {[string match -* $r]} { - if {$r eq "--"} { - break + if {$ridx == [llength $leader_names]-1} { + #at last named leader + set leader_posn_name [lindex $leader_names $ridx] + if {[dict exists $arg_info $leader_posn_name -multiple] && [dict get $arg_info $leader_posn_name -multiple]} { + set is_multiple 1 } + } elseif {$ridx > [llength $leader_names]-1} { + #beyond names - retain name if -multiple was true + if {!$is_multiple} { + set leader_posn_name "" + } + } else { + set leader_posn_name [lindex $leader_names $ridx] ;#may return empty string + } + if {$r eq "--"} { + #review end of opts marker: '--' can't be a leader (but can be a value) + break + } + + #argument such as a dictionary may have leading dash - test for whitespace to exclude as possible option + if {[tcl::string::match -* $r] && !([tcl::string::first " " $r]>=0 || [tcl::string::first \t $r]>=0 || [tcl::string::last \n $r]>=0)} { set matchopt [::tcl::prefix::match -error {} $optnames $r] if {$matchopt ne ""} { #flaglike matches a known flag - don't treat as leader break } - if {![string match -* [lindex $argnames $ridx]]} { + #if {![string match -* [lindex $argnames $ridx]]} {} + if {$leader_posn_name ne ""} { #there is a named leading positional for this position + #The flaglooking value doesn't match an option - so treat as a leader lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name incr ridx continue } else { break } } - lappend pre_values [lpop rawargs 0] + + #for each branch - break or lappend + if {$leader_posn_name ne ""} { + if {$leader_posn_name ni $leader_required} { + #optional leader + + #most adhoc arg processing will allocate based on number of args rather than matching choice values first + #(because a choice value could be a legitimate data value) + + #review - option to process in this manner? + #first check if the optional leader value is a match for a choice ? + #if {[dict exists $arg_info $leader_posn_name -choices]} { + # set vmatch [tcl::prefix match -error "" [dict get $arg_info $leader_posn_name -choices] [lindex $rawargs 0]] + # if {$vmatch ne ""} { + # #If we match a choice for this named position - allocated it regardless of whether enough args for trailing values + # lappend pre_values [lpop rawargs 0] + # incr ridx + # continue + # } + #} + + #check if enough rawargs to fill any required values + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } else { + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #required + if {[dict exists $leader_posn_names_assigned $leader_posn_name]} { + #already accepted at least one value - requirement satisfied - now equivalent to optional + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } + } + #if we didn't break - requirement is not yet satisfied, or is satisfied but stil enough rawargs for required values + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #unnamed leader + if {$leader_min ne "" } { + if {$ridx > $leader_min} { + break + } else { + #haven't reached leader_min + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + break + } + } + incr ridx } } + if {$leader_min eq ""} { + set leader_min 0 + } + if {$leader_max eq ""} { + set leader_max -1 + } + #assert leader_max leader_min are numeric #assert - rawargs has been reduced by leading positionals set leaders [list] @@ -1429,7 +1890,8 @@ tcl::namespace::eval punk::args { break } - if {[tcl::string::match -* $a]} { + #exlude argument with whitespace from being a possible option e.g dict + if {[tcl::string::match -* $a] && !([tcl::string::first " " $a]>=0 || [tcl::string::first \t $a]>=0 || [tcl::string::last \n $a]>=0)} { if {$a eq "--"} { #remaining num args <= val_min already covered above if {$val_max != -1} { @@ -1467,14 +1929,12 @@ tcl::namespace::eval punk::args { } set flagval [lindex $rawargs $i+1] - if {[dict get $arg_info $fullopt -multiple]} { + if {[tcl::dict::get $arg_info $fullopt -multiple]} { #don't lappend to default - we need to replace if there is a default - #review - what if user sets first value that happens to match a default? - if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} { - #first occurrence of this flag, whilst stored value matches default + if {$fullopt ni $flagsreceived} { tcl::dict::set opts $fullopt [list $flagval] } else { - tcl::dict::lappend opts $fullopt $flagval + tcl::dict::lappend opts $fullopt $flagval } } else { tcl::dict::set opts $fullopt $flagval @@ -1482,13 +1942,13 @@ tcl::namespace::eval punk::args { #incr i to skip flagval incr vals_remaining_possible -2 if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs $fullopt + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt } } else { #solo if {[tcl::dict::get $arg_info $fullopt -multiple]} { - if {[tcl::dict::get $opts $fullopt] == 0} { - #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + if {$fullopt ni $flagsreceived} { + #override any default - don't lappend to it tcl::dict::set opts $fullopt 1 } else { tcl::dict::lappend opts $fullopt 1 @@ -1526,7 +1986,7 @@ tcl::namespace::eval punk::args { } lappend flagsreceived $a ;#adhoc flag as supplied if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs $a + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a } incr vals_remaining_possible -2 } else { @@ -1543,9 +2003,12 @@ tcl::namespace::eval punk::args { incr vals_remaining_possible -1 } } else { - #set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] - set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" - arg_error $errmsg $argspecs $fullopt + if {[llength $opt_names]} { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" + } else { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": No options defined while *opts -any 0" + } + arg_error $errmsg $argspecs -badarg $fullopt } } } @@ -1571,6 +2034,7 @@ tcl::namespace::eval punk::args { set positionalidx 0 ;#index for unnamed positionals (both leaders and values) set ldridx 0 + set in_multiple "" set leadernames_received [list] set leaders_dict $leader_defaults set num_leaders [llength $leaders] @@ -1579,13 +2043,26 @@ tcl::namespace::eval punk::args { break } if {$leadername ne ""} { - tcl::dict::set leaders_dict $leadername $ldr + if {[tcl::dict::get $arg_info $leadername -multiple]} { + if {[tcl::dict::exists $leader_defaults $leadername]} { + tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list + } else { + tcl::dict::lappend leaders_dict $leadername $ldr + } + set in_multiple $leadername + } else { + tcl::dict::set leaders_dict $leadername $ldr + } lappend leadernames_received $leadername } else { - tcl::dict::set leaders_dict $positionalidx $ldr - tcl::dict::set arg_info $positionalidx $leaderspec_defaults - tcl::dict::set arg_checks $positionalidx $leader_checks_defaults - lappend leadernames_received $positionalidx + if {$in_multiple ne ""} { + tcl::dict::lappend leaders_dict $in_multiple $ldr + } else { + tcl::dict::set leaders_dict $positionalidx $ldr + tcl::dict::set arg_info $positionalidx $leaderspec_defaults + tcl::dict::set arg_checks $positionalidx $leader_checks_defaults + lappend leadernames_received $positionalidx + } } incr ldridx incr positionalidx @@ -1602,7 +2079,7 @@ tcl::namespace::eval punk::args { } if {$valname ne ""} { if {[tcl::dict::get $arg_info $valname -multiple]} { - if {[tcl::dict::exists $val_defaults $valname] && ([tcl::dict::get $val_defaults $valname] eq [tcl::dict::get $values_dict $valname])} { + if {[tcl::dict::exists $val_defaults $valname]} { #current stored val equals defined default - don't include default in the list we build up tcl::dict::set values_dict $valname [list $val] ;#important to treat first element as a list } else { @@ -1663,12 +2140,12 @@ tcl::namespace::eval punk::args { #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW + #We SHOULD? always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - #safe interp note - cannot avoid struct::set difference ensemble as it could be c or tcl implementation and we don't have an option to call directly? + #safe interp note - struct::set difference ensemble could be c or tcl implementation and we don't have an option to call directly? #example timing difference: #struct::set difference {x} {a b} #normal interp 0.18 u2 vs safe interp 9.4us @@ -1683,7 +2160,7 @@ tcl::namespace::eval punk::args { arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs } if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} { - arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs + arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs } if {[llength [set missing [punklib_ldiff $val_required $valnames_received]]]} { arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs @@ -1714,7 +2191,7 @@ tcl::namespace::eval punk::args { set type [tcl::dict::get $thisarg -type] set has_choices [tcl::dict::exists $thisarg -choices] set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [punk::args::Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 set validationtransform [tcl::dict::get $thisarg -validationtransform] @@ -1814,7 +2291,7 @@ tcl::namespace::eval punk::args { } else { set prefixmsg "" } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } } incr idx @@ -1868,21 +2345,21 @@ tcl::namespace::eval punk::args { list { foreach e_check $vlist_check { if {![tcl::string::is list -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[llength $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -minlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[llength $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -maxlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1922,28 +2399,33 @@ tcl::namespace::eval punk::args { foreach e $remaining_e e_check $remaining_e_check { #puts "----> checking $e vs regex $regexprefail" if {[regexp $regexprefail $e]} { - arg_error "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" $argspecs $argname + if {[tcl::dict::exists $thisarg -regexprefailmsg]} { + set msg [tcl::dict::get $thisarg -regexprefailmsg] + } else { + set msg "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" + } + arg_error $msg $argspecs -badarg $argname } } } switch -- $type { ansistring { - #we need to respect -validate_ansistripped for -minlen etc, but the string must contain ansi + #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi #.. so we need to look at the original values in $vlist not $vlist_check #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - #The ansicodes only case should be covered by -minlen 0 -maxlen 0 combined with -validate_ansistripped ??? + #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? package require punk::ansi foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { - arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname } } } globstring { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { - arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname } } } @@ -1955,16 +2437,16 @@ tcl::namespace::eval punk::args { #dict for {checkopt checkval} $thisarg_checks {} tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::string::length $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::string::length $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1981,31 +2463,31 @@ tcl::namespace::eval punk::args { if {$low eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #lowside unspecified - check only high if {$e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname } } } elseif {$high eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #highside unspecified - check only low if {$e_check < $low} { - arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname } } } else { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #high and low specified if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname } } } @@ -2013,7 +2495,7 @@ tcl::namespace::eval punk::args { } else { foreach e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname } } } @@ -2033,7 +2515,7 @@ tcl::namespace::eval punk::args { #todo - empty string for low or high lassign $checkval low high if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname } } } @@ -2044,28 +2526,28 @@ tcl::namespace::eval punk::args { bool { foreach e_check $vlist_check { if {![tcl::string::is boolean -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname } } } dict { foreach e_check $vlist_check { if {[llength $e_check] %2 != 0} { - arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::dict::size $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -minlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::dict::size $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -maxlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -2089,7 +2571,7 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname } } } @@ -2101,19 +2583,19 @@ tcl::namespace::eval punk::args { #//review - we may need '?' char on windows if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} { #what about special file names e.g on windows NUL ? - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname } } if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { if {![file exists $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname } } } elseif {$type eq "existingdirectory"} { foreach e $vlist e_check $vlist_check { if {![file isdirectory $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname } } } @@ -2121,7 +2603,7 @@ tcl::namespace::eval punk::args { char { foreach e $vlist e_check $vlist_check { if {[tcl::string::length $e_check] != 1} { - arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname } } } @@ -2161,7 +2643,14 @@ tcl::namespace::eval punk::args { #maintain order of opts $opts values $values as caller may use lassign. set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received] - set received_posns [concat {*}[lmap a $receivednames b [zero_to_n [expr {[llength $receivednames]-1}]] {list $a $b}]] ;#flat zip named with overall posn including opts + if {[llength $receivednames]} { + #flat zip of names with overall posn, including opts + #set received_posns [concat {*}[lmap a $receivednames b [zero_based_posns [llength $receivednames]] {list $a $b}]] + set i -1 + set received_posns [concat {*}[lmap a $receivednames {list $a [incr i]}]] + } else { + set received_posns [list] + } return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns] } @@ -2173,7 +2662,7 @@ tcl::namespace::eval punk::args { #} - punk::args::definition { + lappend PUNKARGS [list { *id punk::args::TEST *opts -optional 0 -o1 -default 111 -help "opt 1 mandatory" @@ -2182,7 +2671,7 @@ tcl::namespace::eval punk::args { *values -min 0 -max 1 v -help\ "v1 optional" - } + }] #*** !doctools @@ -2195,8 +2684,9 @@ tcl::namespace::eval punk::args { # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args::lib { + variable PUNKARGS tcl::namespace::export * - tcl::namespace::path [tcl::namespace::parent] + tcl::namespace::path [list [tcl::namespace::parent]] #*** !doctools #[subsection {Namespace punk::args::lib}] #[para] Secondary functions that are part of the API @@ -2209,6 +2699,284 @@ tcl::namespace::eval punk::args::lib { # return 1 #} + proc flatzip {l1 l2} { + concat {*}[lmap a $l1 b $l2 {list $a $b}] + } + + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster, especially for larger ranges + #The internal rep can be an 'arithseries' with no string representation + proc zero_based_posns {count} { + if {$count < 1} {return} + lseq 0 $count-1 + } + } else { + proc zero_based_posns {count} { + if {$count < 1} {return} + lsearch -all [lrepeat $count 0] * + } + } + + + #experiment with equiv of js template literals with ${expression} in templates + #e.g tstr {This is the value of x in calling scope ${$x} !} + #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} + #e.g tstr -allowcommands {This is the value of [lindex $x -1] in calling scope ${[lindex [set x] 0]} !} + lappend PUNKARGS [list { + *id punk::args::lib::tstr + *proc -name punk::args::lib::tstr -help\ + "A rough equivalent of js template literals" + -allowcommands -default -1 -type none -help\ + "if -allowcommands is present, placeholder can contain commands e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -return -default list -choices {dict list string args}\ + -choicelabels { + dict\ + "Return a dict with keys + 'template' and 'params'" + string\ + "Return a single result + being the string with + placeholders substituted." + list\ + "Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + "Return a list where the first + element is a list of template + plaintext secions as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" + } + -eval -default 1 -type boolean -help\ + "Whether to evaluate the \$\{\} placeholders. + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced, or the variable name is likely to collide + with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + *values -min 0 -max 1 + templatestring -help\ + "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + }] + + proc tstr {args} { + #Too hard to fully eat-our-own-dogfood from within punk::args package + # - we use punk::args within the unhappy path only + #set argd [punk::args::get_by_id punk::lib::tstr $args] + #set templatestring [dict get $argd values templatestring] + #set opt_allowcommands [dict get $argd opts -allowcommands] + #set opt_return [dict get $argd opts -return] + #set opt_eval [dict get $argd opts -eval] + + set templatestring [lindex $args end] + set arglist [lrange $args 0 end-1] + set opts [dict create\ + -allowcommands 0\ + -eval 1\ + -return list\ + ] + if {"-allowcommands" in $arglist} { + set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] + dict set opts -allowcommands 1 + } + if {[llength $arglist] % 2 != 0} { + error "punk::args::lib::tstr expected option/value pairs prior to last argument" + } + dict for {k v} $arglist { + set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + switch -- $fullk { + -return - -eval { + dict set opts $fullk $v + } + default { + error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" + } + } + } + set opt_allowcommands [dict get $opts -allowcommands] + set opt_return [dict get $opts -return] + set opt_eval [dict get $opts -eval] + + + set nocommands "-nocommands" + if {$opt_allowcommands == 1} { + set nocommands "" + } + + #set parts [_tstr_split $templatestring] + if {[string first \$\{ $templatestring] < 0} { + set parts [list $templatestring] + } else { + set parts [_parse_tstr_parts $templatestring] + } + set textchunks [list] + #set expressions [list] + set params [list] + set idx 0 + foreach {pt expression} $parts { + lappend textchunks $pt + incr idx ;#pt incr + + #ignore last expression + if {$idx == [llength $parts]} { + break + } + #lappend expressions $expression + if {$opt_eval} { + lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] + } else { + lappend params $expression + } + + incr idx ;#expression incr + } + switch -- $opt_return { + dict { + return [dict create template $textchunks params $params] + } + list { + return [list $textchunks $params] + } + args { + #see example in tstr_test_one + return [list $textchunks {*}$params] + } + string { + set out "" + foreach pt $textchunks param $params { + append out $pt $param + } + return $out + } + default { + } + } + } + #test single placeholder tstr args where single placeholder must be an int + proc tstr_test_one {args} { + set argd [punk::args::get_dict { + *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. + example: + set id 2 + tstr_test_one {*}[tstr -return args {Select * from table where id = \$\{$id\} and etc... ;}] + } + + *values -min 2 -max 2 + template -type list -minsize 2 -maxsize 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - + but the tstr call in the example does this for you, and also passes in the id automatically" + + where -type int -help {Integer param for where clause. tstr mechanism above will pass the id as the second parameter} + } $args] + set template [dict get $argd values template] + set where [dict get $argd values where] + #set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] + set result [string cat [lindex $template 0] $where [lindex $template 1]] + return $result + } + proc _parse_tstr_parts {templatestring} { + if {$templatestring eq ""} { + return [list] + } + set chars [split $templatestring ""] + set in_placeholder 0 + set tchars "" + set echars "" + set parts [list] + set i 0 + foreach ch $chars { + if {!$in_placeholder} { + set nextch [lindex $chars [expr {$i+1}]] + if {"$ch$nextch" eq "\$\{"} { + set in_placeholder 2 ;#2 to signify we just entered placeholder + lappend parts $tchars + set tchars "" + } else { + append tchars $ch + } + } else { + if {$ch eq "\}"} { + if {[tcl::info::complete $echars]} { + set in_placeholder 0 + lappend parts $echars + set echars "" + } else { + append echars $ch + } + } else { + if {$in_placeholder == 2} { + #skip opening bracket + set in_placeholder 1 + } else { + append echars $ch + } + } + } + incr i + } + if {$tchars ne ""} { + lappend parts $tchars + } + if {[llength $parts] % 2 == 0} { + #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list + lappend parts "" + } + return $parts + } + #based on punk::ansi::ta::_perlish_split + proc _tstr_split {text} { + if {$text eq ""} { + return {} + } + set list [list] + set start 0 + #ideally re should allow curlies within but we will probably need a custom parser to do it + #(js allows nested string interpolation) + #set re {\$\{[^\}]*\}} + set re {\$\{(?:(?!\$\{).)*\}} + + #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + puts "e:$matchEnd < s:$matchStart" + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] + incr start + if {$start >= [tcl::string::length $text]} { + break + } + continue + } + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] + set start [expr {$matchEnd+1}] + #? + if {$start >= [tcl::string::length $text]} { + break + } + } + return [lappend list [tcl::string::range $text $start end]] + } #*** !doctools @@ -2216,7 +2984,21 @@ tcl::namespace::eval punk::args::lib { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#usually we would directly call arg definitions near the defining proc, +# so that the proc could directly use the definition in its parsing. +# +#for punk::args we need to make sure the punk::args namespace is fully loaded before calling, so we do it at the end. +#arguably it may be more processor-cache-efficient to do together like this anyway. + +#can't do this - as there is circular dependency with punk::lib +#tcl::namespace::eval punk::args { +# foreach deflist $PUNKARGS { +# punk::args::definition {*}$deflist +# } +# set PUNKARGS "" +#} +lappend ::punk::args::register::NAMESPACES ::punk::args ::punk::args::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -2226,12 +3008,40 @@ tcl::namespace::eval punk::args::system { #[subsection {Namespace punk::args::system}] #[para] Internal functions that are not part of the API + #dict get value with default wrapper for tcl 8.6 + if {[info commands ::tcl::dict::getdef] eq ""} { + #package require punk::lib + #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef + proc Dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::args::system::Dict_getdef "" ::tcl::dict::getdef + } + #name to reflect maintenance - home is punk::lib::ldiff + proc punklib_ldiff {fromlist removeitems} { + if {[llength $removeitems] == 0} {return $fromlist} + set result {} + foreach item $fromlist { + if {$item ni $removeitems} { + lappend result $item + } + } + return $result + } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { + tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version set version 0.1.0 diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/config-0.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/config-0.1.tm index 1e4de9ec..493ea5aa 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/config-0.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/config-0.1.tm @@ -361,11 +361,14 @@ tcl::namespace::eval punk::config { } proc configure {args} { - set argd [punk::args::get_dict { + set argdef { + *id punk::config::configure + *proc -name punk::config::configure -help\ + "UNIMPLEMENTED" *values -min 1 -max 1 whichconfig -type string -choices {startup running stop} - } $args] - + } + set argd [punk::args::get_dict $argdef $args] return "unimplemented - $argd" } @@ -375,6 +378,8 @@ tcl::namespace::eval punk::config { return [punk::lib::showdict $configdata] } + + #e.g # copy running-config startup-config # copy startup-config test-config.cfg @@ -382,16 +387,22 @@ tcl::namespace::eval punk::config { #review - consider the merge vs overwrite feature of some routers.. where copy to running-config does a merge rather than an overwrite #This is to allow partial configs to be loaded to running, whereas a save of running to any target is always a complete configuration proc copy {args} { - set argd [punk::args::get_dict { - *proc -name punk::config::copy -help "Copy a partial or full configuration from one config to another - If a target config has additional settings, then the source config can be considered to be partial with regards to the target. - " - -type -default "" -choices {replace merge} -help "Defaults to merge when target is running-config - Defaults to replace when source is running-config" + set argdef { + *id punk::config::copy + *proc -name punk::config::copy -help\ + "Copy a partial or full configuration from one config to another + If a target config has additional settings, then the source config can be considered to be partial with regards to the target. + " + -type -default "" -choices {replace merge} -help\ + "Defaults to merge when target is running-config + Defaults to replace when source is running-config" *values -min 2 -max 2 - fromconfig -help "running or startup or file name (not fully implemented)" - toconfig -help "running or startup or file name (not fully implemented)" - } $args] + fromconfig -help\ + "running or startup or file name (not fully implemented)" + toconfig -help\ + "running or startup or file name (not fully implemented)" + } + set argd [punk::args::get_dict $argdef $args] set fromconfig [dict get $argd values fromconfig] set toconfig [dict get $argd values toconfig] set fromconfig [string map {-config ""} $fromconfig] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index 74ee55fd..c4f2bfc4 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm @@ -81,6 +81,8 @@ namespace eval punk::console { #*** !doctools #[list_begin definitions] + variable PUNKARGS + variable tabwidth 8 ;#default only - will attempt to detect and set to that configured in terminal #Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently #e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops. @@ -1187,7 +1189,8 @@ namespace eval punk::console { *id punk::console::cell_size -inoutchannels -default {stdin stdout} -type list *values -min 0 -max 1 - newsize -default "" + newsize -default "" -help\ + "character cell pixel dimensions WxH" } proc cell_size {args} { set argd [punk::args::get_by_id punk::console::cell_size $args] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm index 59ca4d5b..04f3487b 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/fileline-0.1.0.tm @@ -1251,6 +1251,16 @@ namespace eval punk::fileline { #[para] Core API functions for punk::fileline #[list_begin definitions] + punk::args::definition { + *id punk::fileline::get_textinfo + *proc -name punk::fileline::get_textinfo -help\ + "return: textinfo object instance" + -file -default {} -type existingfile + -translation -default iso8859-1 + -encoding -default "\uFFFF" + -includebom -default 0 + *values -min 0 -max 1 + } proc get_textinfo {args} { #*** !doctools #[call get_textinfo [opt {option value...}] [opt datachunk]] @@ -1266,14 +1276,7 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes. - set argument_specification { - -file -default {} -type existingfile - -translation -default iso8859-1 - -encoding -default "\uFFFF" - -includebom -default 0 - *values -min 0 -max 1 - } - lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values + lassign [dict values [punk::args::get_by_id punk::fileline::get_textinfo $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm index ae0f0a67..9ebd2ca2 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -48,8 +48,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -140,7 +142,7 @@ tcl::namespace::eval punk::lib::check { proc has_tclbug_lsearch_strideallinline {} { #bug only occurs with single -index value combined with -stride -all -inline -subindices #https://core.tcl-lang.org/tcl/tktview/5a1aaa201d - if {[catch {[lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *]} result]} { + if {[catch {lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *} result]} { #we aren't looking for an error result - error most likely indicates tcl too old to support -stride return 0 } @@ -320,7 +322,7 @@ tcl::namespace::eval punk::lib::compat { if {"::lmap" ne [info commands ::lmap]} { #puts stderr "Warning - no built-in lpop" - interp alias {} lpop {} ::punk::lib::compat::lmaptcl + interp alias {} lmap {} ::punk::lib::compat::lmaptcl } #lmap came in Tcl 8.6 - so probably not much need for a tcl forward compatibility version - but here it is anyway proc lmaptcl {varnames list script} { @@ -384,6 +386,7 @@ tcl::namespace::eval punk::lib::compat { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::lib { + variable PUNKARGS tcl::namespace::export * variable has_struct_list set has_struct_list [expr {![catch {package require struct::list}]}] @@ -956,172 +959,9 @@ namespace eval punk::lib { proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a] } - #experiment with equiv of js template literals with ${expression} in templates - #e.g tstr {This is the value of x in calling scope ${$x} !} - #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} - #e.g tstr -allowcommands {This is the value of [lindex $x 0] in calling scope ${[lindex [set x] 0]} !} - proc tstr {args} { - set argd [punk::args::get_dict { - *proc -name punk::lib::tstr -help "A rough equivalent of js template literals" - -allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}" - -return -default list -choices {dict list string} - *values -min 1 -max 1 - templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true" - } $args] - set templatestring [dict get $argd values templatestring] - set opt_allowcommands [dict get $argd opts -allowcommands] - set opt_return [dict get $argd opts -return] - set nocommands "-nocommands" - if {$opt_allowcommands == 1} { - set nocommands "" - } - - #set parts [_tstr_split $templatestring] - set parts [_parse_tstr_parts $templatestring] - set textchunks [list] - #set expressions [list] - set params [list] - set idx 0 - foreach {pt expression} $parts { - lappend textchunks $pt - incr idx ;#pt incr - - #ignore last expression - if {$idx == [llength $parts]} { - break - } - #lappend expressions $expression - lappend params [uplevel 1 [list subst {*}$nocommands $expression]] - - incr idx ;#expression incr - } - switch -- $opt_return { - dict { - return [dict create template $textchunks params $params] - } - list { - return [list $textchunks {*}$params] - } - string { - set out "" - foreach pt $textchunks param $params { - append out $pt $param - } - return $out - } - default { - } - } - } - #test single placeholder tstr args where single placeholder must be an int - proc tstr_test_one {args} { - set argd [punk::args::get_dict { - *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. - example: - set id 2 - tstr_test_one {*}[Tstr {Select * from table where id = ${$id} and etc... ;}] - } - - *values -min 2 -max 2 - template -type list -minlen 2 -maxlen 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - - but the Tstr method above does this for you, and also passes in the id automatically" - - where -type int -help {Integer param for where clause. Tstr mechanism above will pass the id as the second parameter} - } $args] - set template [dict get $argd values template] - set where [dict get $argd values where] - set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] - return $result - } - proc _parse_tstr_parts {templatestring} { - if {$templatestring eq ""} { - return [list] - } - set chars [split $templatestring ""] - set in_placeholder 0 - set tchars "" - set echars "" - set parts [list] - set i 0 - foreach ch $chars { - if {!$in_placeholder} { - set nextch [lindex $chars [expr {$i+1}]] - if {"$ch$nextch" eq "\$\{"} { - set in_placeholder 2 ;#2 to signify we just entered placeholder - lappend parts $tchars - set tchars "" - } else { - append tchars $ch - } - } else { - if {$ch eq "\}"} { - if {[tcl::info::complete $echars]} { - set in_placeholder 0 - lappend parts $echars - set echars "" - } else { - append echars $ch - } - } else { - if {$in_placeholder == 2} { - #skip opening bracket - set in_placeholder 1 - } else { - append echars $ch - } - } - } - incr i - } - if {$tchars ne ""} { - lappend parts $tchars - } - if {[llength $parts] % 2 == 0} { - #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list - lappend parts "" - } - return $parts - } - #based on punk::ansi::ta::_perlish_split - proc _tstr_split {text} { - if {$text eq ""} { - return {} - } - set list [list] - set start 0 - #ideally re should allow curlies within but we will probably need a custom parser to do it - #(js allows nested string interpolation) - #set re {\$\{[^\}]*\}} - set re {\$\{(?:(?!\$\{).)*\}} - - #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code - - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - puts "e:$matchEnd < s:$matchStart" - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - if {$start >= [tcl::string::length $text]} { - break - } - continue - } - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] - set start [expr {$matchEnd+1}] - #? - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } - + + namespace import ::punk::args::lib::tstr + #get info about punk nestindex key ie type: list,dict,undetermined proc nestindex_info {args} { set argd [punk::args::get_dict { @@ -1184,8 +1024,11 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=[punk::ansi::a] " } set argspec [string map [list %sep% $sep] { - *proc -name pdict -help {Print dict keys,values to channel - (see also showdict)} + *id punk::lib::pdict + *proc -name pdict -help\ + "Print dict keys,values to channel + The pdict function operates on variable names - passing the value to the showdict function which operates on values + (see also showdict)" *opts -any 1 @@ -1222,7 +1065,6 @@ namespace eval punk::lib { The second level segement in each pattern switches to a dict operation to retrieve the value by key. When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - The pdict function operates on variable names - passing the value to the showdict function which operates on values } }] #puts stderr "$argspec" @@ -1282,7 +1124,7 @@ namespace eval punk::lib { -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {${$key}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} *values -min 1 -max -1 @@ -1295,6 +1137,7 @@ namespace eval punk::lib { set opt_keysortdirection [dict get $argd opts -keysortdirection] set opt_trimright [dict get $argd opts -trimright] set opt_keytemplates [dict get $argd opts -keytemplates] + puts stderr "---> $opt_keytemplates <---" set opt_ansibase_keys [dict get $argd opts -ansibase_keys] set opt_ansibase_values [dict get $argd opts -ansibase_values] set opt_return [dict get $argd opts -return] @@ -4272,6 +4115,13 @@ tcl::namespace::eval punk::lib::system { #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::system ---}] } + +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } +} +lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm index 26bca4d5..a31da91a 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm @@ -35,7 +35,7 @@ namespace eval punk::mix::commandset::layout { proc files {{layout ""}} { set argd [punk::args::get_dict { *values -min 1 -max 1 - layout -type string -minlen 1 + layout -type string -minsize 1 } [list $layout]] set allfiles [lib::layout_all_files $layout] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm index 08d103ee..f5a5491e 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -26,19 +26,21 @@ package require punk::lib namespace eval punk::mix::commandset::loadedlib { namespace export * #search automatically wrapped in * * - can contain inner * ? globs - proc search {args} { - set argspecs { - *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" - -return -type string -default table -choices {table tableobject list lines} - -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help "(unimplemented) Display only those that are 0:absent 1:present 2:both" - -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" - -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" - searchstrings -default * -multiple 1 -help "Names to search for, may contain glob chars (* ?) e.g *lib* + punk::args::definition { + *id punk::mix::commandset::loadedlib::search + *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + -return -type string -default table -choices {table tableobject list lines} + -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ + "(unimplemented) Display only those that are 0:absent 1:present 2:both" + -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" + -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" + searchstrings -default * -multiple 1 -help\ + "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. - eg name -> *name* - " - } - set argd [punk::args::get_dict $argspecs $args] + eg name -> *name*" + } + proc search {args} { + set argd [punk::args::get_by_id punk::mix::commandset::loadedlib::search $args] set searchstrings [dict get $argd values searchstrings] set opts [dict get $argd opts] set opt_return [dict get $opts -return] @@ -179,16 +181,7 @@ namespace eval punk::mix::commandset::loadedlib { return [join $loaded_libs \n] } - proc info {args} { - set argspecs { - *values -min 1 - libname -help "library/package name" - } - set argd [punk::args::get_dict $argspecs $args] - set libname [dict get $argd values libname] - - - + proc info {libname} { if {[catch {package require natsort}]} { set has_natsort 0 } else { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm index dd673f38..44627536 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/module-0.1.0.tm @@ -137,23 +137,39 @@ namespace eval punk::mix::commandset::module { put stderr "get_template_basefolders WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } } + + + set moduletypes [punk::mix::cli::lib::module_types] + punk::args::definition [subst { + *id punk::mix::commandset::module::new + *proc -name "punk::mix::commandset::module::new" -help\ + "Create a new module file in the appropriate folder within src/modules. + If the name given in the module argument is namespaced, + the necessary subfolder(s) will be used or created." + -project -optional 1 + -version -default "0.1.0" -help\ + "version to use if not specified as part of the module argument. + If a version is specified in the module argument as well as in -version + the higher version number will be used. + " + -license -default + -template -default punk.module + -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} + -force -default 0 -type boolean -help\ + "If set true, will overwrite an existing .tm file if there is one. + If false (default) an error will be raised if there is a conflict." + -quiet -default 0 -type boolean -help\ + "Suppress information messages on stdout" + *values -min 1 -max 1 + module -type string -help\ + "Name of module, possibly including a namespace and/or version number + e.g mynamespace::mymodule-1.0" + }] proc new {args} { set year [clock format [clock seconds] -format %Y] - set moduletypes [punk::mix::cli::lib::module_types] # use \uFFFD because unicode replacement char should consistently render as 1 wide - set argspecs [subst { - -project -default \uFFFD - -version -default \uFFFD - -license -default - -template -default punk.module - -type -default \uFFFD -choices {$moduletypes} - -force -default 0 -type boolean - -quiet -default 0 -type boolean - *values -min 1 -max 1 - module -type string - }] - set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::mix::commandset::module::new $args] + lassign [dict values $argd] leaders opts values received set module [dict get $values module] #set opts [dict merge $defaults $args] @@ -168,13 +184,9 @@ namespace eval punk::mix::commandset::module { # we need this value before looking at the named argument # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_version_supplied [dict get $opts -version] - if {$opt_version_supplied eq "\uFFFD"} { - set opt_version "0.1.0" - } else { - set opt_version $opt_version_supplied - if {![util::is_valid_tm_version $opt_version]} { - error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" - } + set opt_version $opt_version_supplied + if {![util::is_valid_tm_version $opt_version]} { + error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #named argument @@ -194,7 +206,7 @@ namespace eval punk::mix::commandset::module { } else { set vmsg "from -version option: $opt_version_supplied" } - if {$opt_version_supplied ne "\uFFFD"} { + if {"-version" in $received} { if {$vcompare_is_mversion_bigger != 0} { #is bigger or smaller puts stderr "module.new WARNING: version supplied in module argument as well as -version option. Using the higher version number $vmsg" @@ -231,7 +243,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #options # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_project [dict get $opts -project] set testdir [pwd] if {![string length [set projectdir [punk::repo::find_project $testdir]]]} { if {![string length [set projectdir [punk::repo::find_candidate $testdir]]]} { @@ -239,9 +250,10 @@ namespace eval punk::mix::commandset::module { error "module.new unable to create module in projectdir:$projectdir - directory doesn't appear to meet basic standards $msg" } } - if {$opt_project == "\uFFFF"} { + if {![dict exists $received -project]} { set projectname [file tail $projectdir] } else { + set opt_project [dict get $opts -project] set projectname $opt_project if {$projectname ne [file tail $projectdir]} { error "module.new -project '$opt_project' doesn't match detected projectname '$projectname' at path: $projectdir" @@ -309,12 +321,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_type [dict get $opts -type] - if {$opt_type eq "\uFFFD"} { - set opt_type [lindex [punk::mix::cli::lib::module_types] 0] ;#default to plain - } - if {$opt_type ni [punk::mix::cli::lib::module_types]} { - error "module.new - error - unknown -type '$opt_type' known-types: [punk::mix::cli::lib::module_types]" - } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_quiet [dict get $opts -quiet] set opt_force [dict get $opts -force] @@ -407,7 +413,7 @@ namespace eval punk::mix::commandset::module { set podfile $modulefolder/#modpod-$moduletail-$infile_version/$moduletail-$infile_version.tm set has_tm [file exists $tmfile] set has_pod [file exists $podfile] - if {$has_tm && $has_pos} { + if {$has_tm && $has_pod} { #invalid configuration - bomb out error "module.new error: Invalid target configuration found. module folder has both a .tm file $tmfile and a modpod file $podfile. Please delete one of them before trying again." } @@ -448,7 +454,7 @@ namespace eval punk::mix::commandset::module { } set buildversionfile [file join $modulefolder ${moduletail}-buildversion.txt] set existing_build_version "" - if {[file exists $buildversionfile]} { + if {!$opt_force && [file exists $buildversionfile]} { set buildversiondata [punk::mix::util::fcat $buildversionfile] set lines [split $buildversiondata \n] set existing_build_version [string trim [lindex $lines 0]] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm index 72691167..880dde53 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -28,7 +28,7 @@ tcl::namespace::eval ::punk::ns::evaluator { tcl::namespace::eval punk::ns { variable ns_current "::" variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns - namespace export nsjoin nsprefix nstail nsparts nseval nsimport_noclobber corp + namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp catch { package require debug debug define punk.ns.compile @@ -53,6 +53,8 @@ tcl::namespace::eval punk::ns { set nspathcommands 1 } + set ns_or_glob [string map {:::: ::} $ns_or_glob] + #todo - cooperate with repl? set out "" if {$ns_or_glob eq ""} { @@ -64,7 +66,7 @@ tcl::namespace::eval punk::ns { set has_globchars [regexp {[*?]} $ns_or_glob] if {$is_absolute} { if {!$has_globchars} { - if {![tcl::namespace::exists $ns_or_glob]} { + if {![nsexists $ns_or_glob]} { error "cannot change to namespace $ns_or_glob" } set ns_current $ns_or_glob @@ -77,7 +79,7 @@ tcl::namespace::eval punk::ns { } else { if {!$has_globchars} { set nsnext [nsjoin $ns_current $ns_or_glob] - if {![tcl::namespace::exists $nsnext]} { + if {![nsexists $nsnext]} { error "cannot change to namespace $ns_or_glob" } set ns_current $nsnext @@ -157,14 +159,28 @@ tcl::namespace::eval punk::ns { } #todo - walk up each ns - testing for possibly weirdly named namespaces - #review - do we even need it. + #needed to use n/ to change to an oddly named namespace such as ":x" proc nsexists {nspath} { - error "unimplemented" + if {$nspath eq ""} {return 0} + set parts [nsparts $nspath] + if {[lindex $parts 0] ne ""} { + #relative + set ns_caller [uplevel 1 {::namespace current}] + set fq_nspath [nsjoin $ns_caller $nspath] + } else { + set fq_nspath $nspath + } + if {[catch {nseval_ifexists $fq_nspath {}}]} { + return 0 + } else { + return 1 + } } #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal tcl::namespace::eval - but still only a few microseconds.. fine for repl introspection - proc nseval_script {location} { + #WARNING: creates namespaces if they don't exist + proc nseval_getscript {location} { set parts [nsparts $location] if {[lindex $parts 0] eq ""} { lset parts 0 :: @@ -214,21 +230,88 @@ tcl::namespace::eval punk::ns { #set cmd ::punk::pipecmds::nseval_$loc set cmd ::punk::ns::evaluator::eval-$loc if {$cmd ni [info commands $cmd]} { - append body \n [nseval_script $fqns] + append body \n [nseval_getscript $fqns] proc $cmd {script} $body debug.punk.ns.compile {proc $cmd} 2 } tailcall $cmd $script } - proc nschildren {fqns} { - if {![string match ::* $fqns]} { - error "nschildren only accepts a fully qualified namespace" + proc nseval_ifexists {ns script} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set nsfq [nsjoin $nscaller $ns] + } else { + set nsfq $ns + } + set ns_script [nseval_ifexists_getscript $nsfq] + uplevel 1 [list {*}$ns_script $script] + } + proc nseval_ifexists_getscript {location} { + set parts [nsparts $location] + if {[lindex $parts 0] eq ""} { + lset parts 0 :: + } + if {[lindex $parts end] eq ""} { + set parts [lrange $parts 0 end-1] + } + + set body "apply \{{script} \{eval \[string map \[list \$script\] \{" + set i 0 + set tails [lrepeat [llength $parts] ""] + foreach ns $parts { + set cmdlist [list ::punk::ns::eval_no_create $ns] + set t "" + if {$i > 0} { + append body " " + } + append body $cmdlist + if {$i == ([llength $parts] -1)} { + append body " {}" + } + if {$i > 0} { + set t {} + } + lset tails $i $t + incr i + } + append body [join [lreverse $tails] " "] + #puts stdout "tails: $tails" + #puts stdout "i: $i" + set body [string map [list "\{" "\}"] $body] + append body " \}\]\}\}" + return $body + } + proc eval_no_create {ns script} { + uplevel 1 [string map [list $ns $script] { + if {[::tcl::namespace::exists ]} { + ::tcl::namespace::eval {} + } else { + error "no such namespace " + } + }] + } + + + proc nschildren {ns} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set fqns [nsjoin $nscaller $ns] + } else { + set fqns $ns } + #if {![string match ::* $fqns]} { + # error "nschildren only accepts a fully qualified namespace" + #} set parent [nsprefix $fqns] set tail [nstail $fqns] #puts ">>> parent $parent tail $tail" #set nslist [nseval $parent [list ::namespace children $tail]] - set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + #set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + set nslist [nseval_ifexists $parent [list ::tcl::namespace::children $tail]] return [lsort $nslist] } @@ -356,7 +439,16 @@ tcl::namespace::eval punk::ns { set searchns [nsprefix $ns_absolute] ;#the ns within which we want to searchns set searchall [nsjoin $searchns *] ;#will correctly form ::* or ::childns::* - set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + set nsparts [nsparts $searchns] + set weird_ns 0 + if {[lsearch $nsparts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set rawresult [nseval_ifexists $searchns [list info vars]] + } else { + set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + } set matched_fullpath [list] foreach r $rawresult { lappend matched_fullpath [nstail $r] @@ -595,10 +687,21 @@ tcl::namespace::eval punk::ns { return $nslist } + variable usageinfo_char \U1f6c8 + # command has usageinfo e.g from punk::args. todo cmdline, argp, tepam etc? + proc Usageinfo_mark {{ansicodes \UFFEF}} { + variable usageinfo_char + if {$ansicodes eq ""} { + return $usageinfo_char + } elseif {$ansicodes eq "\UFFEF"} { + return " [a+ brightyellow]$usageinfo_char[a]" + } else { + return " [a+ {*}$ansicodes]$usageinfo_char[a]" + } + } #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ @@ -666,6 +769,7 @@ tcl::namespace::eval punk::ns { set interps [list] set coroutines [list] set zlibstreams [list] + set usageinfo [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -742,6 +846,7 @@ tcl::namespace::eval punk::ns { } } } + set usageinfo [dict get $contents usageinfo] } set numchildren [llength $children] @@ -859,7 +964,8 @@ tcl::namespace::eval punk::ns { set cmd_display [list $cmd] ;#wrap in list so empty command is visible (and distinguishable from for example a double-curly command) if {$cmd ni $commands && $cmd in $aliases } { #ordinary un-masked commandless-alias - set c [a+ red bold] + #(original alias name that has been renamed) + set c [a+ red bold strike] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] } else { @@ -869,7 +975,7 @@ tcl::namespace::eval punk::ns { #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias - #assertion member of masked - but we use seencmds instead to detect. + #assertion: member of masked - but we use seencmds instead to detect. set c [a+ yellow bold] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] @@ -901,13 +1007,20 @@ tcl::namespace::eval punk::ns { set prefix [overtype::right $prefix "-[a+ yellow bold]I[a+]"] } } - set cmd$i "${prefix} $c$cmd_display" - set c$i $c + if {$cmd in $usageinfo} { + set u [Usageinfo_mark brightgreen] + } else { + set u "" + } + set cmd$i "${prefix} $c$cmd_display$u" + #set c$i $c + set c$i "" lappend seencmds $cmd } } - lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + #lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + lappend displaylist $a1[overtype::left $col1 $ch1][a]$a1[overtype::left $col2 $ch2][a]$c1[overtype::left $col3 $cmd1][a]$c2[overtype::left $col4 $cmd2][a]$c3[overtype::left $col5 $cmd3][a]$c4$cmd4[a] } return [list_as_lines $displaylist] @@ -917,7 +1030,7 @@ tcl::namespace::eval punk::ns { if {$path_is_absolute} { return $nspath } - set ns_caller [uplevel 1 {::namespace current}] ;#must qualify. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) + set ns_caller [uplevel 1 {::namespace current}] ;#must qualify 'namespace' command. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) if {$nspath eq "\uFFFF"} { return $ns_caller } @@ -936,6 +1049,31 @@ tcl::namespace::eval punk::ns { return [nsjoin $base $nspath] } + set has_textblock [expr {![catch {package require textblock}]}] + + if {$has_textblock} { + interp alias "" ::punk::ns::Block_width "" textblock::width + } else { + #maint - equiv of textblock::width + proc Block_width {textblock} { + if {$textblock eq ""} { return 0 } + if {[tcl::string::last \t $textblock] >=0} { + if {[tcl::info::exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::ansistripraw $textblock] + } + if {[tcl::string::last \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } + return [punk::char::ansifreestring_width $textblock] + } + } proc nslist {{glob "*"} args} { set ns_absolute [uplevel 1 [list ::punk::ns::nspath_here_absolute $glob]] if {[dict exists $args -match]} { @@ -947,7 +1085,6 @@ tcl::namespace::eval punk::ns { -nspathcommands 0\ ] - package require textblock set opts [dict merge $defaults $args] # -- --- --- set opt_nspathcommands [dict get $opts -nspathcommands] @@ -971,11 +1108,11 @@ tcl::namespace::eval punk::ns { set block [get_nslist {*}$opts] #if {[string first \n $block] < 0} { # #single line - # set width [textblock::width [list $block]] + # set width [Block_width [list $block]] #} else { - # set width [textblock::width $block] + # set width [Block_width $block] #} - set width [textblock::width $block] + set width [Block_width $block] #if multiple results or if there is only 1 result - but we are path-globbing - then we need to show location if {$count_with_results > 1 || [regexp {[*?]} [nsprefix $ns_absolute]]} { @@ -998,7 +1135,7 @@ tcl::namespace::eval punk::ns { } } append output $path_text - set path_text_width [textblock::width $path_text] + set path_text_width [Block_width $path_text] append output \n [string repeat - [expr {max($width,$path_text_width)}]] } elseif {$count_with_results > 1 && $width > 0 } { append output \n [string repeat - $width] @@ -1014,9 +1151,44 @@ tcl::namespace::eval punk::ns { #info cmdtype available in 8.7+ #safe interps also seem to have it disabled for some reason + #we need to return "na" if 'info cmdtype' not supported or not functioning due to safe interp etc + #IMPORTANT: don't detect easy types such as proc/import here - caller needs the 'na' to do the proper fallback + #it is not desirable to do a partial cmdtype support here proc cmdtype {cmd} { + #set cmd [namespace which $cmd] ;#will return empty result for empty string command or command such as :x or any command that doesn't exist + set fqcmd [namespace which $cmd] ;#will resolve for example 'namespace path' reachable commands + if {$fqcmd eq ""} { + #e.g ::ns:::x will return empty result from namespace which even if :x is a command in ::ns + set where [nsprefix $cmd] + if {$where eq ""} { + #bare command that didn't resolve using namespace which + #command probably doesn't exist (may be auto_path cmd not yet loaded) + set where :: + } + set what [nstail $cmd] + } else { + set where [nsprefix $fqcmd] + set what [nstail $fqcmd] + } + #ensure we con't call 'namespace eval' on a nonexistent ns and create cruft namespaces + set parts [nsparts $where] + if {[lsearch $parts :*] > -1} { + set weird_ns 1 + if {![nsexists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)." + return nsnotfound + } + } else { + set weird_ns 0 + if {![namespace exists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)" + return nsnotfound + } + } + if {[interp issafe]} { - if {[catch {::tcl::info::cmdtype $cmd} result]} { + #todo - weird_ns + if {[catch {namespace eval $where [list ::tcl::info::cmdtype $what]} result]} { if {[info commands ::cmdtype] ne ""} { #hack - look for an alias that may have been specifically enabled to bring this back tailcall ::cmdtype $cmd @@ -1027,9 +1199,23 @@ tcl::namespace::eval punk::ns { } } if {[info commands ::tcl::info::cmdtype] ne ""} { - tailcall info cmdtype $cmd + if {$weird_ns} { + if {[nseval_ifexists $where [list ::info commands $what]] eq ""} { + return notfound + } else { + return [nseval_ifexists $where [list ::tcl::info::cmdtype $what]] + } + } else { + if {[namespace eval $where [list ::info commands $what]] eq ""} { + #e.g parray if it hasn't yet been called (an auto_path loaded command) + return notfound + } else { + tailcall namespace eval $where [list ::tcl::info::cmdtype $what] + } + } } - #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #we could examine namespaces to determine more - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #also - we're unlikely to be able to (easily) duplicate the full info cmdtype behaviour - so don't try here! return na } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob @@ -1073,6 +1259,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } + punk::args::update_definitions set nsdict_list [list] foreach ch $report_namespaces { @@ -1103,8 +1290,18 @@ tcl::namespace::eval punk::ns { #JMN set location $ch - set exportpatterns [tcl::namespace::eval $location {::namespace export}] - set nspathlist [tcl::namespace::eval $location {::namespace path}] + set locationparts [nsparts $location] + set weird_ns 0 + if {[lsearch $locationparts :*] >= 0} { + set weird_ns 1 + } + if {$weird_ns} { + set exportpatterns [nseval_ifexists $location {::namespace export}] + set nspathlist [nseval_ifexists $location {::namespace path}] + } else { + set exportpatterns [tcl::namespace::eval $location {::namespace export}] + set nspathlist [tcl::namespace::eval $location {::namespace path}] + } set nspathdict [dict create] if {$nspathcommands} { foreach pathns $nspathlist { @@ -1123,7 +1320,25 @@ tcl::namespace::eval punk::ns { foreach p $exportpatterns { if {[regexp {[*?]} $p]} { #lappend matched {*}[nseval $location [list ::info commands [nsjoin ${location} $p]]] - lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + if {$weird_ns} { + #! info commands can't glob with a weird ns prefix + #! info commands with no arguments returns all commands (from global and any other ns in namespace path) + #lappend matched {*}[nseval_ifexists $location [list ::info commands [nsjoin ${location} $p]]] + lappend matched {*}[nseval_ifexists $location [string map [list $location $p] { + set allcommands [info commands] + set matches [list] + foreach c $allcommands { + set fq [namespace which $c] + if {[string match :: $fq]} { + lappend matches $c + } + } + return $matches + }] + + } else { + lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + } foreach m $matched { lappend allexported [nstail $m] } @@ -1133,7 +1348,11 @@ tcl::namespace::eval punk::ns { } set allexported [lsort -unique $allexported] #NOTE: info procs within tcl::namespace::eval is different to 'info commands' within tcl::namespace::eval (info procs doesn't look outside of namespace) - set allprocs [tcl::namespace::eval $location {::info procs}] + if {$weird_ns} { + set allprocs [nseval_ifexists $location {::info procs}] + } else { + set allprocs [tcl::namespace::eval $location {::info procs}] + } #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] @@ -1151,7 +1370,11 @@ tcl::namespace::eval punk::ns { set interp_aliases [interp aliases ""] #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + if {$weird_ns} { + set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } else { + set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] foreach a $raw_aliases { @@ -1165,38 +1388,91 @@ tcl::namespace::eval punk::ns { } } + #NOTE for 'info ...' 'namespace origin|(etc)..' + # - use the pattern [namespace eval $location [list $cmd]] + #This allows examination of cmds with "bad" names such as empty string or prefixed with single colon. + #while these should be rare - we want to handle such edge cases when browsing namespaces. foreach cmd $commands { #if {"${location}::$cmd" in $interp_aliases || [string trimleft "${location}::$cmd" ":"] in $interp_aliases} { - # #NOTE: doesn't cater for renamed aliases - Tcl 8.x doesn't seem to have any introspection capabilities to match command to a renamed alias + # #NOTE: doesn't cater for renamed aliases - Tcl 8.x (and 9.01) doesn't seem to have any introspection capabilities to match command to a renamed alias # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} set ctype [cmdtype ${location}::$cmd] switch -- $ctype { na { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } + if {[nsprefix $cmdorigin] ne $location} { + #import + lappend allimported $cmd + set origin_location [nsprefix $cmdorigin] + } else { + set origin_location $location + } #tcl 8.6 (info cmdtype unavailable) #todo - use catch tcl::unsupported::corotype to see if coroutine - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + if {![catch {nseval_ifexists $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[nseval_ifexists $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[nseval_ifexists $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + + } + } else { + if {![catch {namespace eval $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[namespace eval $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[namespace eval $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + } } } default { - if {$ctype eq "imported"} { - set cmdorigin [namespace origin [nsjoin $location $cmd]] + if {$ctype eq "import"} { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source #ie we don't need to follow a chain of 'imported' results. - set mixedtype i-[info cmdtype $cmdorigin] + set origin_location [nsprefix $cmdorigin] + set origin_cmd [nstail $cmdorigin] + + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + set mixedtype i-[nseval_ifexists $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } else { + set mixedtype i-[namespace eval $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } + lappend allimported $cmd } else { set mixedtype $ctype } - #assert ctype != imported + #assert mixedtype != import #review - we don't have a way to mark as both native and ensemble - switch -- $ctype { + switch -- $mixedtype { i-native - native { lappend allnative $cmd } @@ -1242,7 +1518,7 @@ tcl::namespace::eval punk::ns { } } - #JMN + #JMN TODO if {[catch { if {$cmd eq ""} { #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. @@ -1315,6 +1591,50 @@ tcl::namespace::eval punk::ns { #definitely don't count exportpatterns incr itemcount [llength $undetermined] + set usageinfo [list] + set has_punkargs [expr {[info commands ::punk::args::id_exists] ne ""}] + set has_tepam [expr {[info exists ::tepam::ProcedureList]}] + if {$has_punkargs || $has_tepam} { + foreach c $commands { + if {$c in $imported} { + set fq [namespace origin [nsjoin $location $c]] + } elseif {$c in $aliases} { + #TODO - use which_alias ? + set tgt [interp alias "" [nsjoin $location $c]] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft [nsjoin $location $c] :]] + } + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(currying) + set fq $word1 + } + } else { + set fq [nsjoin $location $c] + } + if {$has_punkargs} { + set id [string trimleft $fq :] + if {[::punk::args::id_exists $id]} { + lappend usageinfo $c + } else { + if {$has_tepam} { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } else { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } set nsdict [dict create\ location $location\ @@ -1335,6 +1655,7 @@ tcl::namespace::eval punk::ns { ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ + usageinfo $usageinfo\ namespacepath $nspathdict\ glob $glob\ itemcount $itemcount\ @@ -1480,11 +1801,33 @@ tcl::namespace::eval punk::ns { ::set what $search } } - - ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] + set weird_ns 0 + if {[string match *:::* $base]} { + set weird_ns 1 + } #important not to call tcl::namespace::eval (or punk::ns::nseval) on non-existant base - or it will be created - ::if {![::tcl::namespace::exists $base]} { - ::continue + if {$weird_ns} { + ::if {![nsexists $base]} { + ::continue + } + #info commands can't glob with weird_ns prefix + puts ">>> base: $base what: $what" + ::set all_ns_commands [nseval_ifexists $base [list apply {{loc what} { + set _all [uplevel 1 [list ::info commands]] + set _matches [list] + foreach _a $_all { + set _c [uplevel 1 [list ::namespace which $_a]] + if {[::string match ${loc}::${what} $_c]} { + ::lappend _matches $_a + } + } + return $_matches + }} $base $what ]] + } else { + ::if {![::tcl::namespace::exists $base]} { + ::continue + } + ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] } ::set all_ns_tails [::lmap v $all_ns_commands {::punk::ns::nstail $v}] foreach c $all_ns_tails { @@ -1549,6 +1892,510 @@ tcl::namespace::eval punk::ns { } } |data@@ok/result> {lmap v $data {punk::ns::nstail $v}} |> lsort |> {join $data \n} = 0} { + #use nseval_ifexists to avoid creating intermediate namespaces for bogus paths + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set origin $commandpath + set resolved $commandpath + } + } else { + #fully qualified command specified but doesn't exist + set origin $commandpath + set resolved $commandpath + } + } else { + set thispath [uplevel 1 [list ::nsthis $commandpath]] + set targetns [nsprefix $thispath] + set name [nstail $thispath] + set targetparts [nsparts $targetns] + if {[lsearch $targetparts :*] >=0} { + #weird ns + set valid_ns [nsexists $targetns] + } else { + set valid_ns [namespace exists $targetns] + } + if {$valid_ns} { + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set thiscmd [nsjoin $targetns $name] + #relative commandpath specified - but Tcl didn't find a match in namespace path + #assume global (todo - look for namespace match in auto_index first ?) + set origin ::$name + set resolved ::$name + } + } else { + #namespace doesn't seem to exist - but there still could be documentation for lazy loaded ns and command + set origin $commandpath + set resolved $commandpath + } + } + #set thiscmd [nsjoin $targetns $name] + #if {[info commands $thiscmd] eq ""} { + # set origin $thiscmd + # set resolved $thiscmd + #} else { + # set origin [nseval $targetns [list ::namespace origin $name]] + # set resolved [nseval $targetns [list ::namespace which $name]] + #} + + #ns::cmdtype only detects alias type on 8.7+? + set initial_cmdtype [punk::ns::cmdtype $origin] + switch -- $initial_cmdtype { + na - alias { + #REVIEW - alias entry doesn't necessarily match command! + #considure using which_alias (wiki) + set tgt [interp alias "" $origin] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft $origin :]] + } + if {$tgt ne ""} { + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(possible curried arguments) + #review - curried arguments could be for ensembles! + set fq $word1 + } + set origin $fq + #retest cmdtype on modified origin + set cmdtype [punk::ns::cmdtype $origin] + } else { + set cmdtype $initial_cmdtype + } + if {$cmdtype eq "na"} { + #tcl 8.6 + if {[info object isa object $origin]} { + set cmdtype "object" + } + } + } + default { + set cmdtype $initial_cmdtype + } + } + + switch -- $cmdtype { + object { + #class is also an object + #todo -mixins etc etc + set class [info object class $origin] + #the call: info object methods -all + # seems to do the right thing as far as hiding unexported methods, and showing things like destroy + # - which don't seem to be otherwise easily introspectable + set public_methods [info object methods $origin -all] + #set class_methods [info class methods $class] + #set object_methods [info object methods $origin] + + if {[llength $commandargs]} { + set c1 [lindex $commandargs 0] + if {$c1 in $public_methods} { + switch -- $c1 { + new { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} new" + *proc -name "${$origin} new" -help\ + "create object with specified command name. + Arguments are passed to the constructor." + *values + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin new"] + } + create { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} create" + *proc -name "${$origin} create" -help\ + "create object with specified command name. + Arguments following objectName are passed to the constructor." + *values -min 1 + objectName -type string -help\ + "possibly namespaced name for object instance command" + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin create"] + } + destroy { + #review - generally no doc + # but we may want notes about a specific destructor + set argspec [punk::lib::tstr -return string { + *id "${$origin} destroy" + *proc -name "destroy" -help\ + "delete object, calling destructor if any. + destroy accepts no arguments." + *values -min 0 -max 0 + }] + punk::args::definition $argspec + return [punk::args::usage "$origin destroy"] + } + default { + #use info object call to resolve callchain + #we assume the first impl is the topmost in the callchain + # and its call signature is therefore the one we are interested in - REVIEW + # we should probably ignore generaltypes filter|unknown and look for a subsequent method|private? + set implementations [::info object call $origin $c1] + #result documented as list of 4 element lists + #set callinfo [lindex $implementations 0] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + + if {$location eq "object"} { + set id "[string trimleft $origin :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info object definition $origin $c1] + } else { + set id "[string trimleft $location :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info class definition $location $c1] + } + break + } + filter { + } + unknown { + } + } + } + if {$def ne ""} { + set arglist [lindex $def 0] + set argspec [punk::lib::tstr -return string { + *id "${$location} ${$c1}" + *proc -name "${$location} ${$c1}" -help\ + "arglist:${$arglist}" + *values + }] + set i 0 + foreach a $arglist { + switch -- [llength $a] { + 1 { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } + 2 { + append argspec \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" + } + default { + error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + } + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$location $c1"] + } else { + return "unable to resolve $origin method $c1" + } + + } + } + } + } + set choicelabeldict [dict create] + foreach cmd $public_methods { + switch -- $cmd { + new - create - destroy { + #todo + } + default { + set implementations [::info object call $origin $cmd] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + if {$location eq "object"} { + set id "[string trimleft $origin :] $cmd" ;# " " + } else { + set id "[string trimleft $location :] $cmd" ;# " " + } + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]" + } + } + break + } + filter { + } + unknown { + } + } + } + } + } + } + + set vline [list method -choices $public_methods -choicelabels $choicelabeldict -choiceprefix 0] ;#methods must be specified in full always? - review + #puts stderr "--->$vline" + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -name "Object: ${$origin}" -help\ + "Instance of class: ${$class}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + privateObject { + return "Command is a privateObject - no info currently available" + } + privateClass { + return "Command is a privateClass - no info currently available" + } + interp { + #todo + } + } + + #check ensemble before testing punk::arg::id_exists + #we want to recalculate ensemble usage info in case ensemble has been modified + + if {[namespace ensemble exists $origin]} { + #review + #todo - check -unknown + #if there is a -unknown handler - we can't be sure the choices in -map or from -namespace are exhaustive. + #presumably -choiceprefix should be zero in that case?? + + set ensembleinfo [namespace ensemble configure $origin] + set prefixes [dict get $ensembleinfo -prefixes] + set map [dict get $ensembleinfo -map] + set ns [dict get $ensembleinfo -namespace] + + #review - we can have a combination of commands from -map as well as those exported from -namespace + # if and only if -subcommands is specified + + set subcommand_dict [dict create] + set commands [list] + set nscommands [list] + if {[llength [dict get $ensembleinfo -subcommands]]} { + #set exportspecs [namespace eval $ns {namespace export}] + #foreach pat $exportspecs { + # lappend nscommands {*}[info commands ${ns}::$pat] + #} + #when using -subcommands, even unexported commands are available + set nscommands [info commands ${ns}::*] + foreach sub [dict get $ensembleinfo -subcommands] { + if {[dict exists $map $sub]} { + #-map takes precence over same name exported from -namespace + dict set subcommand_dict $sub [dict get $map $sub] + } elseif {"${ns}::$sub" in $nscommands} { + dict set subcommand_dict $sub ${ns}::$sub + } else { + #subcommand probably supplied via -unknown handler? + dict set subcommand_dict $sub "" + } + } + } else { + if {[dict size $map]} { + set subcommand_dict $map + } else { + set exportspecs [namespace eval $ns {namespace export}] + foreach pat $exportspecs { + lappend nscommands {*}[info commands ${ns}::$pat] + } + foreach fqc $nscommands { + dict set subcommand_dict [namespace tail $fqc] $fqc + } + } + } + + + set subcommands [lsort [dict keys $subcommand_dict]] + if {[llength $commandargs]} { + set match [tcl::prefix::match $subcommands [lindex $commandargs 0]] + if {$match in $subcommands} { + set subcmd [dict get $subcommand_dict $match] + return [arginfo {*}$subcmd {*}[lrange $commandargs 1 end]] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") + } + } + + set namespaces [list] ;# usually only 1 or 2 namespaces - but could be any number. + dict for {sub subwhat} $subcommand_dict { + set ns [::namespace which $subwhat] + if {$ns ni $namespaces} { + lappend namespaces $ns + } + } + set have_usageinfo [list] + set is_ensemble [list] + set is_object [list] + foreach ns $namespaces { + set nsinfo [lindex [punk::ns::nslist_dict [nsjoin [nsprefix $ns] *]] 0] + lappend have_usageinfo {*}[dict get $nsinfo usageinfo] + lappend is_ensemble {*}[dict get $nsinfo ensembles] + lappend is_object {*}[dict get $nsinfo ooobjects] + } + + set choicelabeldict [dict create] + foreach sub $subcommands { + if {$sub in $have_usageinfo} { + dict set choicelabeldict $sub " [Usageinfo_mark brightgreen]" + } elseif {$sub in $is_ensemble} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } elseif {$sub in $is_object} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } + } + + set vline [list subcommand -choices $subcommands -choiceprefix $prefixes -choicelabels $choicelabeldict] + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -help "ensemble: ${$origin}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + + #check for tepam help + if {[info exists ::tepam::ProcedureList]} { + if {$origin in $::tepam::ProcedureList} { + return [tepam::ProcedureHelp $origin 1] ;#use 1 to return rather than emit to stdout + } else { + #handle any tepam functions that don't eat their own dogfood but have help variables + #e.g tepam::procedure, tepam::argument_dialogbox + #Rather than hardcode these - we'll guess that any added will use the same scheme.. + if {[namespace qualifiers $origin] eq "::tepam"} { + set func [namespace tail $origin] + #tepam XXXHelp vars don't exactly match procedure names :/ + if {[info exists ::tepam::${func}Help]} { + return [set ::tepam::${func}Help] + } else { + set f2 [string totitle $func] + if {[info exists ::tepam::${f2}Help]} { + return [set ::tepam::${f2}Help] + } + #e.g argument_dialogbox -> ArgumentDialogboxHelp + set parts [split $func _] + set uparts [lmap p $parts {string totitle $p}] + set f3 [join [list {*}$uparts Help] ""] + if {[info exists ::tepam::${f3}]} { + return [set ::tepam::${f3}] + } + } + } + } + } + + set id [string trimleft $origin :] + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set origin_ns [nsprefix $origin] + set parts [nsparts $origin_ns] + set weird_ns 0 + if {[lsearch $parts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set argl {} + set tail [nstail $origin] + foreach a [nseval_ifexists $origin_ns [list info args $tail]] { + if {[nseval_ifexists $origin_ns [list info default $tail $a def]]} { + lappend a $def + } + lappend argl $a + } + } else { + set argl {} + foreach a [info args $origin] { + if {[info default $origin $a def]} { + lappend a $def + } + lappend argl $a + } + } + + set msg "No argument processor detected" + append msg \n "function signature: $resolved $argl" + return $msg + } + #todo - package up as navns proc corp {path} { #thanks to Richard Suchenwirth for the original - wiki.tcl-lang.org/page/corp @@ -1567,6 +2414,8 @@ tcl::namespace::eval punk::ns { set body "" } + #we want to handle edge cases of commands such as "" or :x + #various builtins such as 'namespace which' won't work if {[string match ::* $path]} { set targetns [nsprefix $path] set name [nstail $path] @@ -1884,26 +2733,41 @@ tcl::namespace::eval punk::ns { } interp alias "" use "" punk::ns::pkguse + punk::args::definition { + *id punk::ns::nsimport_noclobber + *proc -name punk::ns::nsimport_noclobber -help\ + "Import exported commands from a namespace into either the current namespace, + or that specified in -targetnamespace. + Return list of imported commands, ignores failures due to name conflicts" + -targetnamespace -optional 1 -help\ + "Namespace in which to import commands. + If namespace is relative (no leading ::), + the namespace is relative to the caller'd namespace. + If not supplied, caller's namespace is used." + -prefix -optional 1 -help\ + "string prefix for command names in target namespace" + *values -min 1 -max 1 + sourcepattern -type string -optional 0 -help\ + "Glob pattern for source namespace. + Globbing only active in the tail segment. + e.g ::mynamespace::*" + } proc nsimport_noclobber {args} { - set argspecs { - -targetnamespace -default "" -optional 1 - -prefix -default "" -optional 1 - *values -min 1 -max 1 - sourcepattern -type string -optional 0 - } - lassign [dict values [punk::args::get_dict $argspecs $args]] leaders opts values + lassign [dict values [punk::args::get_by_id punk::ns::nsimport_noclobber $args]] leaders opts values received set sourcepattern [dict get $values sourcepattern] set source_ns [tcl::namespace::qualifiers $sourcepattern] if {![tcl::namespace::exists $source_ns]} { error "nsimport_noclobber error namespace $source_ns not found" } - set target_ns [dict get $opts -targetnamespace] set nscaller [uplevel 1 {namespace current}] - if {$target_ns eq ""} { + if {![dict exists $received -targetnamespace]} { set target_ns $nscaller - } elseif {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + } else { + set target_ns [dict get $opts -targetnamespace] + if {![string match ::* $target_ns]} { + set target_ns [punk::nsjoin $nscaller $target_ns] + } } set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] @@ -1918,6 +2782,34 @@ tcl::namespace::eval punk::ns { } } } + set nstemp ::punk::ns::temp_import + if {[tcl::dict:::exists $received -prefix]} { + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { + set cmd "" + if {![catch {namespace import ::}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {rename [punk::ns::nsjoin ]}]} { + set cmd + } + } + set cmd + }]] + if {$imported ne ""} { + lappend imported_commands $imported + } + } + namespace delete $nstemp + return $imported_commands + } + set imported_commands [list] foreach e $a_exported_tails { set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { @@ -1934,7 +2826,7 @@ tcl::namespace::eval punk::ns { return $imported_commands } - #todo - use ns::nsimport_noclobber instead + #todo - use ns::nsimport_noclobber instead ? interp alias {} nsthis {} punk::ns::nspath_here_absolute interp alias {} nsorigin {} apply {ns {namespace origin [uplevel 1 ::punk::ns::nspath_here_absolute $ns]} ::} @@ -1943,6 +2835,7 @@ tcl::namespace::eval punk::ns { interp alias {} nsprefix {} punk::ns::nsprefix interp alias {} nstail {} punk::ns::nstail interp alias {} nsparts {} punk::ns::nsparts + interp alias {} nschildren {} punk::ns::nschildren interp alias {} nstree {} punk::ns::nstree #namespace/command/proc query interp alias {} nslist {} punk::ns::nslist @@ -1966,6 +2859,7 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp + interp alias {} i {} punk::ns::arginfo } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm index 18590542..d3431188 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/path-0.1.0.tm @@ -45,8 +45,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -642,6 +644,20 @@ namespace eval punk::path { return $ismatch } + punk::args::definition { + *id punk::path::treefilenames + -directory -type directory -help\ + "folder in which to begin recursive scan for files." + -call-depth-internal -default 0 -type integer + -antiglob_paths -default {} -help\ + "list of path patterns to exclude + may include * and ** path segments e.g /usr/**" + *values -min 0 -max -1 -optional 1 -type string + tailglobs -multiple 1 -help\ + "Patterns to match against filename portion (last segment) of each file path + within the directory tree being searched." + } + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) proc treefilenames {args} { @@ -655,22 +671,17 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_dict { - -directory -default "\uFFFF" - -call-depth-internal -default 0 -type integer - -antiglob_paths -default {} - *values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 - } $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::path::treefilenames $args] + lassign [dict values $argd] leaders opts values received set tailglobs [dict values $values] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - set opt_dir [dict get $opts -directory] - if {$opt_dir eq "\uFFFF"} { + if {![dict exists $received -directory]} { set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] } # -- --- --- --- --- --- --- diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm index d8d1b249..d14b626d 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl/codethread-0.1.1.tm @@ -166,15 +166,15 @@ tcl::namespace::eval punk::repl::codethread { set errstack [list] upvar ::punk::config::running running_config if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { - lappend outstack [interp eval code [list shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } - lappend outstack [interp eval code [list shellfilter::stack::add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { - lappend errstack [interp eval code [list shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } - lappend errstack [interp eval code [list shellfilter::stack::add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] #an experiment #set errhandle [shellfilter::stack::item_tophandle stderr] @@ -190,7 +190,16 @@ tcl::namespace::eval punk::repl::codethread { if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } - tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + if {[string first ":::" $::punk::ns::ns_current]} { + #support for browsing 'odd' (inadvisable) namespaces + #don't use 'namespace exists' - will conflate ::test::x with ::test:::x + #if {$::punk::ns::ns_current in [namespace children [punk::ns::nsprefix $::punk::ns::ns_current]} { + #} + package require punk::ns + punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript + } else { + tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + } } } result] @@ -221,10 +230,10 @@ tcl::namespace::eval punk::repl::codethread { #only remove from shellfilter::stack the items we added to stack in this function foreach s [lreverse $outstack] { - interp eval code [list shellfilter::stack::remove stdout $s] + interp eval code [list ::shellfilter::stack remove stdout $s] } foreach s [lreverse $errstack] { - interp eval code [list shellfilter::stack::remove stderr $s] + interp eval code [list ::shellfilter::stack remove stderr $s] } thread::cond notify $replthread_cond } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm index fe443ece..25ba28b1 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/shellfilter-0.1.9.tm @@ -1086,7 +1086,9 @@ namespace eval shellfilter::chan { ## note - whether stack is for input or output we maintain it in the same direction - which is in sync with the tcl chan pop chan push concept. ## namespace eval shellfilter::stack { - #todo - implement as oo + namespace export {[a-z]*} + namespace ensemble create + #todo - implement as oo ? variable pipelines [list] proc items {} { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.2.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.2.tm index f8b6390c..1a298b4e 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.2.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.2.tm @@ -92,29 +92,51 @@ tcl::namespace::eval textblock { #NOTE sha1, although computationally more intensive, tends to be faster than md5 on modern cpus #(more likely to be optimised for modern cpu features?) - variable use_md5 ;#framecache - set use_md5 1 - if {[catch {package require md5}]} { - set use_md5 0 - } - #todo - change use_md5 to more generic use_checksum_algorithm function. - # e.g allow md5, sha1, none, etc. - # - perhaps autodetect 32bit vs 64bit (or processortype?) to select a default (also depending on packages available and accelerator presence) - proc use_md5 {{yes_no ""}} { - variable use_md5 - if {$yes_no eq ""} { - return $use_md5 - } - if {![string is boolean -strict $yes_no]} { - error "textblock::use_md5 requires a boolean (or empty string to query)" - } - if {$yes_no} { - package require md5 - set use_md5 1 + #(This speed improvement may not apply for short strings) + + variable use_hash ;#framecache + set use_hash none ;#slightly faster but uglier layout for viewing frame_cache display + #if {![catch {package require sha1}]} { + # set use_hash sha1 + #} elseif {![catch {package require md5}]} { + # set use_hash md5 + #} else { + # set use_hash none + #} + + proc use_hash {args} { + set choices [list none] + set unavailable [list] + set pkgs [package names] + if {"md5" in $pkgs} { + lappend choices md5 } else { - set use_md5 0 + lappend unavailable md5 } - return $use_md5 + if {"sha1" in $pkgs} { + lappend choices sha1 + } else { + lappend unavailable sha1 + } + set choicemsg "" + if {[llength $unavailable]} { + set choicemsg " (unavailable packages: $unavailable)" + } + set argd [punk::args::get_dict [tstr -return string { + *id textblock::use_hash + *proc -name "textblock::use_hash" -help\ + "Hashing algorithm to use for framecache lookup. + 'none' may be slightly faster but less compact + when viewing textblock::framecache" + *values -min 0 -max 1 + hash_algorithm -choices {${$choices}} -optional 1 -help\ + "algorithm choice ${$choicemsg}" + }] $args] + variable use_hash + if {![dict exists $argd received hash_algorithm]} { + return $use_hash + } + set use_hash [dict get $argd values hash_algorithm] } tcl::namespace::eval class { variable opts_table_defaults @@ -3997,12 +4019,8 @@ tcl::namespace::eval textblock { return $t } - - - proc periodic {args} { - #For an impressive interactive terminal app (javascript) - # see: https://github.com/spirometaxas/periodic-table-cli - set opts [dict get [punk::args::get_dict { + punk::args::definition { + *id textblock::periodic *proc -name textblock::periodic -help "A rudimentary periodic table This is primarily a test of textblock::class::table" @@ -4016,8 +4034,12 @@ tcl::namespace::eval textblock { -show_edge -default "" -type boolean -forcecolour -default 0 -type boolean -help "If punk::colour is off - this enables the produced table to still be ansi coloured" *values -min 0 -max 0 - } $args] opts] + } + proc periodic {args} { + #For an impressive interactive terminal app (javascript) + # see: https://github.com/spirometaxas/periodic-table-cli + set opts [dict get [punk::args::get_by_id textblock::periodic $args] opts] set opt_return [tcl::dict::get $opts -return] if {[tcl::dict::get $opts -forcecolour]} { set fc forcecolour @@ -4156,15 +4178,16 @@ tcl::namespace::eval textblock { dict set conf $k [dict get $opts $k] } } - $t configure {*}[dict get $conf] - $t configure \ - -frametype_header light\ - -ansiborder_header [a+ {*}$fc brightwhite]\ - -ansibase_header [a+ {*}$fc Black]\ - -ansibase_body [a+ {*}$fc Black]\ - -ansiborder_body [a+ {*}$fc black]\ - -frametype block + set moreopts [dict create\ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc brightwhite]\ + -ansibase_header [a+ {*}$fc Black]\ + -ansibase_body [a+ {*}$fc Black]\ + -ansiborder_body [a+ {*}$fc black]\ + -frametype block + ] + $t configure {*}[dict merge $conf $moreopts] #-ansiborder_header [a+ {*}$fc web-white]\ @@ -4204,9 +4227,9 @@ tcl::namespace::eval textblock { -header -default "" -type list -multiple 1\ -help "Each supplied -header argument is a header row. The number of values for each must be <= number of columns" - -show_header -default ""\ + -show_header -type boolean\ -help "Whether to show a header row. - Leave as empty string for unspecified/automatic, + Omit for unspecified/automatic, in which case it will display only if -headers list was supplied." -action -default "append" -choices {append replace}\ -help "row insertion method if existing -table is supplied @@ -4294,13 +4317,13 @@ tcl::namespace::eval textblock { if {[llength $colheaders] > 0} { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 1 } else { set show_header [tcl::dict::get $opts -show_header] } } else { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 0 } else { set show_header [tcl::dict::get $opts -show_header] @@ -4529,7 +4552,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4553,7 +4576,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4614,7 +4637,7 @@ tcl::namespace::eval textblock { set textblock [textutil::tabify::untabify2 $textblock $tw] } #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { set textblock [punk::ansi::ansistripraw $textblock] } if {[tcl::string::last \n $textblock] >= 0} { @@ -7226,12 +7249,19 @@ tcl::namespace::eval textblock { variable frame_cache set frame_cache [tcl::dict::create] + + punk::args::definition { + *id textblock::frame_cache + *proc -name textblock::frame_cache -help\ + "Display or clear the frame cache." + -action -default {} -choices {clear} -help\ + "Clear the textblock::frame_cache dictionary" + -pretty -default 1 -help\ + "Use 'pdict textblock::frame_cache */*' for prettier output" + *values -min 0 -max 0 + } proc frame_cache {args} { - set argd [punk::args::get_dict { - -action -default {} -choices {clear} -help "Clear the textblock::frame_cache dictionary" - -pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output" - *values -min 0 -max 0 - } $args] + set argd [punk::args::get_by_id textblock::frame_cache $args] set action [dict get $argd opts -action] if {$action ni [list clear ""]} { @@ -7273,6 +7303,71 @@ tcl::namespace::eval textblock { } + set FRAMETYPES [textblock::frametypes] + set EG [a+ brightblack] + set RST [a] + #todo punk::args alias for centre center etc? + punk::args::definition [punk::lib::tstr -return string { + *id textblock::frame + *proc -name "textblock::frame"\ + -help "Frame a block of text with a border." + -checkargs -default 1 -type boolean\ + -help "If true do extra argument checks and + provide more comprehensive error info. + Set false for slight performance improvement." + -etabs -default 0\ + -help "expanding tabs - experimental/unimplemented." + -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ + -help "Type of border for frame." + -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. + passing an empty string will result in no box, but title/subtitle will still appear if supplied. + ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" + -boxmap -default {} -type dict + -joins -default {} -type list + -title -default "" -type string -regexprefail {\n}\ + -help "Frame title placed on topbar - no newlines. + May contain ANSI - no trailing reset required. + ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing + e.g 2: frame -title [a+ red underline]MyThing${$RST}" + -subtitle -default "" -type string -regexprefail {\n}\ + -help "Frame subtitle placed on bottombar - no newlines + May contain Ansi - no trailing reset required." + -width -default "" -type int\ + -help "Width of resulting frame including borders. + If omitted or empty-string, the width will be determined automatically based on content." + -height -default "" -type int\ + -help "Height of resulting frame including borders." + -ansiborder -default "" -type ansistring\ + -help "Ansi escape sequence to set border attributes. + ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents + e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" + -ansibase -default "" -type ansistring\ + -help "Default ANSI attributes within frame." + -blockalign -default centre -choices {left right centre}\ + -help "Alignment of the content block within the frame." + -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background + extends within the content block inside the frame. + Has no effect if no ANSI in content." + -textalign -default left -choices {left right centre}\ + -help "Alignment of text within the content block. (centre unimplemented)" + -ellipsis -default 1 -type boolean\ + -help "Whether to show elipsis for truncated content and title/subtitle." + -usecache -default 1 -type boolean + -buildcache -default 1 -type boolean + -crm_mode -default 0 -type boolean\ + -help "Show ANSI control characters within frame contents. + (Control Representation Mode) + Frame width doesn't adapt and content may be truncated + so -width may need to be manually set to display more." + + *values -min 0 -max 1 + contents -default "" -type string\ + -help "Frame contents - may be a block of text containing newlines and ANSI. + Text may be 'ragged' - ie unequal line-lengths. + No trailing ANSI reset required. + ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" + }] + #options before content argument - which is allowed to be absent #frame performance (noticeable with complex tables even of modest size) is improved somewhat by frame_cache - but is still (2024) a fairly expensive operation. # @@ -7283,7 +7378,7 @@ tcl::namespace::eval textblock { # - but we would need to maintain support for the rendered-string based operations too. proc frame {args} { variable frametypes - variable use_md5 + variable use_hash #counterintuitively - in-proc dict create each time is generally slightly faster than linked namespace var set opts [tcl::dict::create\ @@ -7311,20 +7406,19 @@ tcl::namespace::eval textblock { # for ansi art - -pad 0 is likely to be preferable set has_contents 0 - set arglist $args + set optlist $args ;#initial only - content will be removed + #no solo opts for frame if {[llength $args] %2 == 0} { if {[lindex $args end-1] eq "--"} { - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 - lpop arglist end ;#drop the end-of-opts flag + lpop optlist end ;#drop the end-of-opts flag } else { - set arglist $args + set optlist $args set contents "" } } else { - #set arglist [lrange $args 0 end-1] - #set contents [lindex $args end] - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 } @@ -7333,7 +7427,7 @@ tcl::namespace::eval textblock { #use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache set optnames [tcl::dict::keys $opts] set opts_ok 1 ;#default assumption - foreach {k v} $arglist { + foreach {k v} $optlist { set k2 [tcl::prefix::match -error "" $optnames $k] switch -- $k2 { -etabs - -type - -boxlimits - -boxmap - -joins @@ -7355,70 +7449,9 @@ tcl::namespace::eval textblock { set check_args [dict get $opts -checkargs] #only use punk::args if check_args is true or our basic checks failed - if {!$opts_ok || $check_args} { - #error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - set FRAMETYPES [textblock::frametypes] - set EG [a+ brightblack] - set RST [a] - set argd [punk::args::get_dict [punk::lib::tstr -return string { - *proc -name "textblock::frame"\ - -help "Frame a block of text with a border." - -checkargs -default 1 -type boolean\ - -help "If true do extra argument checks and - provide more comprehensive error info. - Set false for slight performance improvement." - -etabs -default 0\ - -help "expanding tabs - experimental/unimplemented." - -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ - -help "Type of border for frame." - -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. - passing an empty string will result in no box, but title/subtitle will still appear if supplied. - ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" - -boxmap -default {} -type dict - -joins -default {} -type list - -title -default "" -type string -regexprefail {\n}\ - -help "Frame title placed on topbar - no newlines. - May contain ANSI - no trailing reset required. - ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing - e.g 2: frame -title [a+ red underline]MyThing${$RST}" - -subtitle -default "" -type string -regexprefail {\n}\ - -help "Frame subtitle placed on bottombar - no newlines - May contain Ansi - no trailing reset required." - -width -default "" -type int\ - -help "Width of resulting frame including borders. - If omitted or empty-string, the width will be determined automatically based on content." - -height -default "" -type int\ - -help "Height of resulting frame including borders." - -ansiborder -default "" -type ansistring\ - -help "Ansi escape sequence to set border attributes. - ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents - e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" - -ansibase -default "" -type ansistring\ - -help "Default ANSI attributes within frame." - -blockalign -default centre -choices {left right centre}\ - -help "Alignment of the content block within the frame." - -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background - extends within the content block inside the frame. - Has no effect if no ANSI in content." - -textalign -default left -choices {left right centre}\ - -help "Alignment of text within the content block. (centre unimplemented)" - -ellipsis -default 1 -type boolean\ - -help "Whether to show elipsis for truncated content and title/subtitle." - -usecache -default 1 -type boolean - -buildcache -default 1 -type boolean - -crm_mode -default 0 -type boolean\ - -help "Show ANSI control characters within frame contents. - (Control Representation Mode) - Frame width doesn't adapt and content may be truncated - so -width may need to be manually set to display more." - - *values -min 0 -max 1 - contents -default "" -type string\ - -help "Frame contents - may be a block of text containing newlines and ANSI. - Text may be 'ragged' - ie unequal line-lengths. - No trailing ANSI reset required. - ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" - }] $args] + #never need to checkargs if only one argument supplied even if it looks like an option - as it will be treated as data to frame + if {[llength $args] != 1 && (!$opts_ok || $check_args)} { + set argd [punk::args::get_by_id textblock::frame $args] set opts [dict get $argd opts] set contents [dict get $argd values contents] } @@ -7446,7 +7479,10 @@ tcl::namespace::eval textblock { set opt_ansiborder [tcl::dict::get $opts -ansiborder] set opt_ansibase [tcl::dict::get $opts -ansibase] ;#experimental set opt_ellipsis [tcl::dict::get $opts -ellipsis] + set opt_blockalign [tcl::dict::get $opts -blockalign] + set opt_textalign [tcl::dict::get $opts -textalign] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] set known_frametypes $frametypes ;# light, heavey etc as defined in the ::textblock::frametypes variable @@ -7463,107 +7499,26 @@ tcl::namespace::eval textblock { set framedef $ftype } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - #review vllj etc? - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] - - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - tcl::dict::for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - hltj - hlbj - vllj - vlrj {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" - } + #if check_args? - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [tcl::dict::create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - tcl::dict::set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] + #REVIEW - now done in framedef? + #set join_directions [list] + ##targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + ##e.g down-light, up-heavy + #set join_targets [tcl::dict::create left "" down "" right "" up ""] + #foreach jt $opt_joins { + # lassign [split $jt -] direction target + # if {$target ne ""} { + # tcl::dict::set join_targets $direction $target + # } + # lappend join_directions $direction + #} + #set join_directions [lsort -unique $join_directions] + #set do_joins [::join $join_directions _] - #JMN - switch -- $opt_blockalign { - left - right - centre - center {} - default { - error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_textalign [tcl::dict::get $opts -textalign] - switch -- $opt_textalign { - left - right - centre - center {} - default { - error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" - } - } # -- --- --- --- --- --- @@ -7634,20 +7589,28 @@ tcl::namespace::eval textblock { # -- --- --- --- --- --- --- --- --- variable frame_cache #review - custom frame affects frame_inner_width - exclude from caching? - #set cache_key [concat $arglist $frame_inner_width $frame_inner_height] + #set cache_key [concat $optlist $frame_inner_width $frame_inner_height] #jmn - #set hashables [concat $arglist $frame_inner_width $frame_inner_height] - set hashables [list {*}$arglist $frame_inner_width $frame_inner_height] + #set hashables [concat $optlist $frame_inner_width $frame_inner_height] + set hashables [list {*}$optlist $frame_inner_width $frame_inner_height] - if {$use_md5} { - #package require md5 ;#already required at package load - if {[package vsatisfies [package present md5] 2- ] } { - set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review - } else { - set hash [md5::md5 [encoding convertto utf-8 $hashables]] + + switch -- $use_hash { + sha1 { + package require sha1 + set hash [sha1::sha1 [encoding convertto utf-8 $hashables]] + } + md5 { + package require md5 + if {[package vsatisfies [package present md5] 2- ] } { + set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review + } else { + set hash [md5::md5 [encoding convertto utf-8 $hashables]] + } + } + none { + set hash $hashables } - } else { - set hash $hashables } set cache_key "$hash-$frame_inner_width-$frame_inner_height-actualcontentwidth:$actual_contentwidth" @@ -7709,11 +7672,94 @@ tcl::namespace::eval textblock { set used [tcl::dict::get $frame_cache $cache_key used] tcl::dict::set frame_cache $cache_key used [expr {$used+1}] ;#update existing record set is_cached 1 - } + # -- --- --- --- --- --- --- --- --- if {!$is_cached} { + # -- --- --- --- --- + # -- --- --- --- --- + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + # -- --- --- --- --- --- + set is_boxmap_ok 1 + tcl::dict::for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + hltj - hlbj - vllj - vlrj {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" + } + # -- --- --- --- --- --- + #these are all valid commands for overtype:: + switch -- $opt_textalign { + left - right - centre - center {} + default { + error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" + } + } + # -- --- --- --- --- --- + switch -- $opt_blockalign { + left - right - centre - center {} + default { + error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" + } + } + # -- --- --- --- --- + # -- --- --- --- --- + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + #review vllj etc? + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + # -- --- --- --- --- --- + + set rst [a] #set column [tcl::string::repeat " " $frame_inner_width] ;#default - may need to override for custom frame set underlayline [tcl::string::repeat " " $frame_inner_width] @@ -8038,6 +8084,9 @@ tcl::namespace::eval textblock { ;#end !$is_cached } + + + #use the same mechanism to build the final frame - whether from cache or template if {$actual_contentwidth == 0} { set fs [tcl::string::map [list $FSUB " "] $template] diff --git a/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm index f57b4317..b9081528 100644 --- a/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/argparsingtest-0.1.0.tm @@ -294,7 +294,31 @@ namespace eval argparsingtest { } $args] return [tcl::dict::get $argd opts] } - proc test1_punkargs_validate_without_ansi {args} { + + punk::args::definition { + *id argparsingtest::test1_punkargs2 + *proc -name argtest4 -help "test of punk::args::get_dict comparative performance" + *opts -anyopts 0 + -return -default string -type string + -frametype -default \uFFEF -type string + -show_edge -default \uFFEF -type string + -show_seps -default \uFFEF -type string + -join -type none -multiple 1 + -x -default "" -type string + -y -default b -type string + -z -default c -type string + -1 -default 1 -type boolean + -2 -default 2 -type integer + -3 -default 3 -type integer + *values + } + proc test1_punkargs2 {args} { + set argd [punk::args::get_by_id argparsingtest::test1_punkargs2 $args] + return [tcl::dict::get $argd opts] + } + + + proc test1_punkargs_validate_ansistripped {args} { set argd [punk::args::get_dict { *proc -name argtest4 -help "test of punk::args::get_dict comparative performance" *opts -anyopts 0 @@ -306,9 +330,9 @@ namespace eval argparsingtest { -x -default "" -type string -y -default b -type string -z -default c -type string - -1 -default 1 -type boolean -validate_without_ansi true - -2 -default 2 -type integer -validate_without_ansi true - -3 -default 3 -type integer -validate_without_ansi true + -1 -default 1 -type boolean -validate_ansistripped true + -2 -default 2 -type integer -validate_ansistripped true + -3 -default 3 -type integer -validate_ansistripped true *values } $args] return [tcl::dict::get $argd opts] diff --git a/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm b/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm index 98969e2c..124ce3b7 100644 --- a/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/patternpunk-1.1.tm @@ -78,7 +78,7 @@ set ::punk::bannerTemplate [string trim { } else { lassign $cborder_ctext cborder ctext } - return [ textblock::frame -type arc -ansiborder [a+ Web-black $cborder] [a+ Web-black $ctext][$this . logo2]] + return [ textblock::frame -checkargs 0 -type arc -ansiborder [a+ Web-black $cborder] [a+ Web-black $ctext][$this . logo2]] } >punk .. Property logotk "\[TCL\\\n TK \]" proc TCL {args} { @@ -349,7 +349,7 @@ v_ /|\/ / -boxmap -default {} -type dict -boxlimits -default {hl vl tlc blc trc brc} -help "Limit the border box to listed elements." -border_colour -default ${$border_colour} -type ansistring -regexprepass {^$} -validationtransform { - -function stripansi -maxlen 0 + -function stripansi -maxsize 0 } -title -default "PATTERN" -type string -subtitle -default "PUNK" -type string diff --git a/src/vfs/_vfscommon.vfs/modules/poshinfo-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/poshinfo-0.1.0.tm index 1765fc20..149f18fc 100644 --- a/src/vfs/_vfscommon.vfs/modules/poshinfo-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/poshinfo-0.1.0.tm @@ -197,19 +197,21 @@ tcl::namespace::eval poshinfo { proc set_active_theme_by_path {path} { error "unimplemented" } + + punk::args::definition { + *id poshinfo::themes + *proc -name poshinfo::themes + -format -default all -multiple 1 -choices {all yaml json}\ + -help "File format of posh theme - based on file extension" + -type -default all -multiple 1\ + -help "e.g omp" + -as -default "table" -choices {list showlist dict showdict table tableobject plaintext}\ + -help "return type of result" + *values -min 0 + globs -multiple 1 -default * -help "" + } proc themes {args} { - set argd [punk::args::get_dict { - *id poshinfo::themes - *proc -name poshinfo::themes - -format -default all -multiple 1 -choices {all yaml json}\ - -help "File format of posh theme - based on file extension" - -type -default all -multiple 1\ - -help "e.g omp" - -as -default "table" -choices {list showlist dict showdict table tableobject plaintext}\ - -help "return type of result" - *values -min 0 - globs -multiple 1 -default * -help "" - } $args] + set argd [punk::args::get_by_id poshinfo::themes $args] set return_as [dict get $argd opts -as] set formats [dict get $argd opts -format] ;#multiple if {"yaml" in $formats} { diff --git a/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm index 3d454ca8..0ca26f39 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk-0.1.tm @@ -9,7 +9,7 @@ namespace eval punk { zzzload::pkg_require $pkg } } - #lazyload twapi + #lazyload twapi ? catch {package require vfs} ;#attempt load now so we can use faster 'package provide' to test existence later } @@ -3670,7 +3670,7 @@ namespace eval punk { incr i } - #JMN2 + #JMN2 - review #set returnval [lindex $assigned_values 0] if {[llength $assigned_values] == 1} { set returnval [join $assigned_values] @@ -7271,55 +7271,59 @@ namespace eval punk { catch { package require patternpunk #lappend chunks [list stderr [>punk . rhs]] - append mascotblock [textblock::frame [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] + append mascotblock [textblock::frame -checkargs 0 [>punk . banner -title "Punk Shell" -left Tcl -right [package provide Tcl]]] } set topic [lindex $args end] set argopts [lrange $args 0 end-1] - set text "" - append text "Punk core navigation commands:\n" + set title "[a+ brightgreen] Punk core navigation commands: " #todo - load from source code annotation? set cmdinfo [list] - lappend cmdinfo [list help "This help. To see available subitems type: help topics"] - lappend cmdinfo [list dev "(ensemble command to make new projects/modules and to generate docs)"] - lappend cmdinfo [list a? "view ANSI colours\n e.g a? web"] - lappend cmdinfo [list ./ "view/change directory"] - lappend cmdinfo [list ../ "go up one directory"] - lappend cmdinfo [list ./new "make new directory and switch to it"] - lappend cmdinfo [list n/ "view/change namespace (accepts ns path globs e.g **::*get* to match comands at any level )"] - lappend cmdinfo [list n// "view/change namespace (with command listing)"] - lappend cmdinfo [list nn/ "go up one namespace"] - lappend cmdinfo [list n/new "make child namespace and switch to it"] - - set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] - set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] - set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] - set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] + lappend cmdinfo [list help "?topics?" "This help. To see available subitems type: help topics"] + lappend cmdinfo [list i "cmd ?subcommand...?" "Show usage for a command or ensemble subcommand"] + lappend cmdinfo [list ./ "?subdir?" "view/change directory"] + lappend cmdinfo [list ../ "" "go up one directory"] + lappend cmdinfo [list ./new "subdir" "make new directory and switch to it"] + lappend cmdinfo [list n/ "?glob...?" "view/change namespace\n (accepts ns path globs e.g **::*get* to match comands at any level )"] + lappend cmdinfo [list n// "" "view/change namespace (with command listing)"] + lappend cmdinfo [list "nn/" "" "go up one namespace"] + lappend cmdinfo [list "n/new" "" "make child namespace and switch to it"] + lappend cmdinfo [list dev "?subcommand?" "(ensemble command to make new projects/modules and to generate docs)"] + lappend cmdinfo [list a? "?subcommand...?" "view ANSI colours\n e.g a? web"] + + #set cmds [lsearch -all -inline -index 0 -subindices $cmdinfo *] + #set descr [lsearch -all -inline -index 1 -subindices $cmdinfo *] + #set widest1 [tcl::mathfunc::max {*}[lmap v $cmds {string length $v}]] + #set widest2 [tcl::mathfunc::max {*}[lmap v $descr {string length $v}]] set t [textblock::class::table new -show_seps 0] - foreach c $cmds d $descr { - #append text " [overtype::left $col1 $c][overtype::left $col2 $d]" \n - $t add_row [list $c $d] - } - set widest1 [$t column_datawidth 0] - $t configure_column 0 -minwidth [expr {$widest1 + 2}] - set widest2 [$t column_datawidth 1] - $t configure_column 1 -minwidth [expr {$widest2 + 1}] + #foreach c $cmds d $descr { + # $t add_row [list $c $d] + #} + foreach row $cmdinfo { + $t add_row $row + } + set width_0 [$t column_datawidth 0] + $t configure_column 0 -minwidth [expr {$width_0 + 2}] + set width_1 [$t column_datawidth 1] + $t configure_column 1 -minwidth [expr {$width_1 + 1}] + $t configure -title $title + + set text "" append text [$t print] set warningblock "" + set introblock $mascotblock + append introblock \n $text - if {[catch {package require textblock} errM]} { - set introblock $mascotblock - append introblock \n $text - append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" - - } else { - set introblock [textblock::join -- " " \n$mascotblock " " $text] - } + #if {[catch {package require textblock} errM]} { + # append warningblock \n "WARNING: textblock package couldn't be loaded. Side-by-side display not available" + #} else { + # set introblock [textblock::join -- " " \n$mascotblock " " $text] + #} lappend chunks [list stdout $introblock] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm index b616da59..1e52d3e9 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm @@ -132,14 +132,29 @@ tcl::namespace::eval punk::ansi::class { set rendered [overtype::renderspace -cp437 1 -expand_right 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] return $rendered } + + lappend ::punk::ansi::class::PUNKARGS [list { + *id "punk::ansi::class::class_ansi render_to_input_line" + *proc -name "punk::ansi::class::class_ansi render_to_input_line" -help\ + "render string from line 0 to line + (experimental/debug)" + -dimensions -type string -help\ + "WxH where W is integer width >= 1 and H is integer heigth >= 1" + -minus -type integer -help\ + "number of chars to exclude from end" + *values -min 1 -max 1 + line -type indexexpression + }] method render_to_input_line {args} { if {[llength $args] < 1} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set x [lindex $args end] set arglist [lrange $args 0 end-1] if {[llength $arglist] %2 != 0} { puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + punk::args::get_by_id "punk::ansi::class::class_ansi render_to_input_line" $args } set opts [tcl::dict::create\ -dimensions 80x24\ @@ -322,6 +337,7 @@ tcl::namespace::eval punk::ansi::class { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::ansi { + variable PUNKARGS #*** !doctools #[subsection {Namespace punk::ansi}] #[para] Core API functions for punk::ansi @@ -422,6 +438,8 @@ tcl::namespace::eval punk::ansi { erase*\ get_*\ hyperlink\ + hyperlink_open\ + hyperlink_close\ move*\ reset*\ ansistrip*\ @@ -554,21 +572,35 @@ tcl::namespace::eval punk::ansi { $obj destroy return $result } - proc example {args} { - set base [punk::repo::find_project] - set default_ansifolder [file join $base src/testansi] - set argd [punk::args::get_dict [tstr -return string { + proc Get_ansifolder {} { + if {[catch {punk::repo::find_project} base]} { + set base "" + } + if {$base eq ""} { + #pwd not avail in safe interp + if {![catch {pwd} CWD]} { + set base $CWD + } + } + return [file join $base src/testansi] + } + + lappend PUNKARGS [list -dynamic 1 { + *id punk::ansi::example *proc -name punk::ansi::example -help "Display .ans image files in a grid that will fit in console " -colwidth -default 82 -help "Width of each column - default of 82 will fit a standard 80wide ansi image (when framed) You can specify a narrower width to truncate images on the right side" - -folder -default "${$default_ansifolder}" -help "Base folder for files if relative paths are used. + -folder -default "${[punk::ansi::Get_ansifolder]}" -help "Base folder for files if relative paths are used. Defaults to /src/testansi - where projectbase is determined from current directory. " *values -min 0 -max -1 files -default {belinda.ans bot.ans flower.ans fish.ans} -multiple true -help "List of filenames - leave empty to display 4 defaults" - }] $args] + } ""] + + proc example {args} { + set argd [punk::args::get_by_id punk::ansi::example $args] set colwidth [dict get $argd opts -colwidth] set ansifolder [file normalize [dict get $argd opts -folder]] set fnames [dict get $argd values files] @@ -621,7 +653,7 @@ tcl::namespace::eval punk::ansi { set subtitle [tcl::dict::get $picinfo status] } set title [tcl::dict::get $picinfo filename] - set fr [textblock::frame -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] + set fr [textblock::frame -checkargs 0 -width $colwidth -subtitle $subtitle -title $title [tcl::dict::get $picinfo pic]] # -- --- --- --- #we need the max height of a row element to use join_basic instead of join below # -- --- --- --- @@ -2320,16 +2352,23 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu set sgr_cache [tcl::dict::create] #sgr_cache clear called by punk::console::ansi when set to off - proc sgr_cache {args} { - set argd [punk::args::get_dict { - *proc -name punk::ansi::sgr_cache -help "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) - " - -action -default "" -choices "clear" -help "-action clear will unset the keys in the punk::ansi::sgr_cache dict - This is called automatically when setting 'colour false' in the console" - -pretty -default 1 -type boolean -help "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" + #punk::args depends on punk::ansi - REVIEW + proc sgr_cache {args} { + set argdef { + *id punk::ansi::sgr_cache + *proc -name punk::ansi::sgr_cache -help\ + "Convenience function to view and optionally clear the ansi character attribute cache (ansi SGR codes) + " + -action -default "" -choices "clear" -help\ + "-action clear will unset the keys in the punk::ansi::sgr_cache dict + This is called automatically when setting 'colour false' in the console" + + -pretty -default 1 -type boolean -help\ + "use 'pdict punk::ansi::sgr_cache */%str,%ansiview' output" *values -min 0 -max 0 - } $args] + } + set argd [punk::args::get_dict $argdef $args] set action [dict get $argd opts -action] set pretty [dict get $argd opts -pretty] @@ -2372,6 +2411,31 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu return [join $lines \n] } + lappend PUNKARGS [list { + *id punk::ansi::a+ + *proc -name "punk::ansi::a+" -help\ + "Returns an ANSI sgr escape sequence based on the list of supplied codes. + " + *values -min 0 -max -1 + } [string map [list [dict keys $SGR_map]] { + code -type string -optional 1 -multiple 1 -choices {} -choiceprefix 0 -choicerestricted 0 -help\ + "SGR code from the list below, or an integer corresponding to the code e.g 31 = red. + A leading capital letter indicates a codename applies to the background colour. + Other accepted codes are: + term- Term- foreground/background where int is 0-255 terminal color + term- Term- foreground/background + rgb--- Rgb--- foreground/background where are the + 0-255 int values for red, green and blue. + rgb# Rgb# where is a 6 char hex colour e.g rgb#C71585 + web- Web- + + The acceptable values for and can be queried using + punk::ansi::a? term + and + punk::ansi::a? web" + + }]] + proc a+ {args} { #*** !doctools #[call [fun a+] [opt {ansicode...}]] @@ -3267,17 +3331,49 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu } # REVIEW - osc8 replays etc for split lines? - textblock + #Hyperlinks (a.k.a. HTML-like anchors) in terminal emulators https://gist.github.com/egmontkob/eb114294efbcd5adb1944c9f3cb5feda #the 'id' parameter logically connects split hyperlinks + #per interp. Rather than try to avoid collisions using something like 'info cmdcount' we will use a simple counter. + #To stop multiple hyperlinks from having ids inadvertently collide - we should do some id mangling/prefixing based on the terminal/window etc + #It is better to use a simple counter with high likelihood of collision so we are more likely to detect problems with ids than to make it more intermittent by using ids that collide only 'rarely' + variable hyperlinkcounter + set hyperlinkcounter 0 + + proc hyperlink {uri {display ""}} { + variable hyperlinkcounter if {$display eq ""} { set display $uri } - set params "" ;#todo e.g id=xyz123:foo=bar:baz=quux + set uri [punk::ansi::ansistripraw $uri] + #limit uri length we emit based on common limits in other terminals + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set params "id=punkansi-[incr hyperlinkcounter]" ;#todo e.g id=xyz123:foo=bar:baz=quux set open "\x1b\]8\;$params\;$uri\x1b\\" set close "\x1b\]8\;\;\x1b\\" return ${open}${display}${close} } + #on windows terminal at least, both uri and id of 2 separated hyperlinks need to match for the hover highlighting to act as a unit. + proc hyperlink_open {uri {id ""}} { + if {$id eq ""} { + set id punkansi-[incr hyperlinkcounter] + } + set uri [punk::ansi::ansistripraw $uri] + if {[string length $uri] > 2083} { + error "punk::ansi::hyperlink uri too long: limit 2083" + } + set id [string map {: . {;} ,} $id] ;#avoid some likely problematic ids. TODO - review, restrict further. + set params "id=$id" + return "\x1b\]8\;$params\;$uri\x1b\\" + } + #It should be ok to close even if no currently active hyperlink (e.g can be used to cleanup if something awry) + proc hyperlink_close {} { + return "\x1b\]8\;\;\x1b\\" + } + # -- --- --- --- --- proc move {row col} { #*** !doctools @@ -3837,11 +3933,13 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[call [fun ansistrip] [arg text] ] #[para]Return a string with ansi codes stripped out #[para]Alternate graphics chars are replaced with modern unicode equivalents (e.g boxdrawing glyphs) - + if {[string length $text] < 2} {return $text} if {[punk::ansi::ta::detect_g0 $text]} { set text [convert_g0 $text];#Convert ansi borders to unicode line drawing instead of ascii letters } + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] + if {[llength $parts] == 1} {return [lindex $parts 0]} set out "" #todo - try: join [lsearch -stride 2 -index 0 -subindices -all -inline $parts *] "" # - (if/when lsearch -stride bug fixed) @@ -3871,6 +3969,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu #[para]Return a string with ansi codes stripped out #[para]Alternate graphics modes will be stripped rather than converted to unicode - exposing the raw ascii characters as they appear without graphics mode. #[para]ie instead of a horizontal line you may see: qqqqqq + if {[string length $text] < 2} {return $text} set parts [punk::ansi::ta::split_codes $text] set out "" @@ -7294,6 +7393,13 @@ tcl::namespace::eval punk::ansi::internal { } } +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set NAMESPACES [list] + } +} +lappend ::punk::args::register::NAMESPACES ::punk::ansi ::punk::ansi::class + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::ansi [tcl::namespace::eval punk::ansi { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm index b2854093..c087ae0b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm @@ -84,7 +84,7 @@ # *values -min 2 -max 2 # fileA -type existingfile 1 # fileB -type existingfile 1 -# } $args]] opts values +# } $args]] leaders opts values # puts "$category fileA: [dict get $values fileA]" # puts "$category fileB: [dict get $values fileB]" # } @@ -218,49 +218,45 @@ package require Tcl 8.6- #*** !doctools #[section API] -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -# oo::class namespace -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -tcl::namespace::eval punk::args::class { +tcl::namespace::eval punk::args::register { #*** !doctools - #[subsection {Namespace punk::args::class}] - #[para] class definitions - if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { - #*** !doctools - #[list_begin enumerated] - - # oo::class create interface_sample1 { - # #*** !doctools - # #[enum] CLASS [class interface_sample1] - # #[list_begin definitions] + #[subsection {Namespace punk::args}] + #[para] cooperative namespace punk::args::register + #[para] punk::args aware packages may add their own namespace to the public list variable NAMESPACES before or after punk::args is loaded + #[para] The punk::args package will then test for a public list variable ::PUNKARGS containing argument definitions when it needs to. + #[list_begin definitions] - # method test {arg1} { - # #*** !doctools - # #[call class::interface_sample1 [method test] [arg arg1]] - # #[para] test method - # puts "test: $arg1" - # } + # -- --- --- --- --- --- --- --- + #cooperative with packages that define some punk args but may need to do so lazily + #These could be loaded prior to punk::args being loaded + variable NAMESPACES + if {![info exists ::punk::args::register::NAMESPACES]} { + set NAMESPACES [list] + } + # -- --- --- --- --- --- --- --- - # #*** !doctools - # #[list_end] [comment {-- end definitions interface_sample1}] - # } - #*** !doctools - #[list_end] [comment {--- end class enumeration ---}] - } + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::register ---}] } -# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args { + + + variable PUNKARGS ;#list of our own punk::args function argument definitions - loaded with punk::args::definition at the end. + tcl::namespace::export {[a-z]*} - variable argspec_cache - variable argspec_ids + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved variable id_counter - set argspec_cache [tcl::dict::create] - set argspec_ids [tcl::dict::create] + set argdata_cache [tcl::dict::create] + set argdefcache_by_id [tcl::dict::create] + set argdefcache_unresolved [tcl::dict::create] set id_counter 0 #*** !doctools @@ -271,72 +267,127 @@ tcl::namespace::eval punk::args { #todo - some sort of punk::args::cherrypick operation to get spec from an existing set #todo - doctools output from definition - #dict get value with default wrapper for tcl 8.6 - if {[info commands ::tcl::dict::getdef] eq ""} { - #package require punk::lib - #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef - proc Dict_getdef {dictValue args} { - set keys [lrange $args 0 end-1] - if {[tcl::dict::exists $dictValue {*}$keys]} { - return [tcl::dict::get $dictValue {*}$keys] - } else { - return [lindex $args end] - } - } - } else { - #we pay a minor perf penalty for the wrap - interp alias "" ::punk::args::Dict_getdef "" ::tcl::dict::getdef - } - - #name to reflect maintenance - home is punk::lib::ldiff - proc punklib_ldiff {fromlist removeitems} { - if {[llength $removeitems] == 0} {return $fromlist} - set result {} - foreach item $fromlist { - if {$item ni $removeitems} { - lappend result $item - } - } - return $result - } - proc flatzip {l1 l2} { - concat {*}[lmap a $l1 b $l2 {list $a $b}] - } - if {[info commands lseq] ne ""} { - #tcl 8.7+ lseq significantly faster, especially for larger ranges - #The internal rep can be an 'arithseries' with no string representation - proc zero_to_n {n} { - lseq 0 $n - } - } else { - proc zero_to_n {n} { - lsearch -all [lrepeat $n 0] * - } - } #todo? -synonym/alias ? (applies to opts only not values) #e.g -background -aliases {-bg} -default White - #review - how to make work with trie prefix e.g -corner -aliases {-corners} + #review - how to make work with trie prefix + #e.g + # -corner -aliases {-corners} + # -centre -aliases {-center -middle} #We mightn't want the prefix to be longer just because of an alias + #we should get -co -ce and -m from the above as abbreviations + + lappend PUNKARGS [list { + *id punk::args::definition + *proc -name punk::args::definition -help\ + "Accepts a line-based definition of command arguments. + The definition should usually contain a line of the form: *id someid + " + -dynamic -type boolean -default 0 -help\ + "If -dynamic is true, tstr interpolations of the form \$\{\$var\} + are re-evaluated on each call. + If the definition is being used not just as documentation, but is also + used within the function to parse args, e.g using punk::args::get_by_id, + then it should be noted that there is a slight performance penalty for the + dynamic case. + It is not usually significant, perhaps on the order of a few hundred uS, + but -dynamic true might be less desirable if the command is used in inner + loops in more performance-sensitive code. + " + *values -min 1 -max -1 + text -type string -multiple 1 -help\ + "Block(s) of text representing the argument specification for a command. + At least one must be supplied. If multiple, they are joined together with \\n. + Using multiple text arguments may be useful to mix curly-braced and double-quoted + strings to have finer control over interpolation when defining arguments. + e.g + definition { + *id myns::myfunc + *proc -name myns::myfunc -help\\ + \"Description of command\" + + #The following option defines an option-value pair + -option1 -default blah -type string + #The following option defines a flag style option (solo) + -flag1 -default 0 -type none -help\\ + \"Info about flag1\" + + *values -min 1 -max -1 + #Items that don't begin with * or - are value definitions + v1 -type integer -default 0 + thinglist -type string -multiple 1 + } \"*doc -name Manpage: -url \[myfunc_manpage_geturl myns::myfunc]\" + " + }] + proc definition {args} { + variable argdata_cache + variable argdefcache_by_id + variable argdefcache_unresolved + - proc definition {optionspecs args} { - variable argspec_cache - #variable argspecs ;#REVIEW!! - variable argspec_ids #variable initial_optspec_defaults #variable initial_valspec_defaults #ideally we would use a fast hash algorithm to produce a short key with low collision probability. #something like md5 would be ok (this is non cryptographic) - but md5 uses open and isn't usable by default in a safe interp. #review - check if there is a built-into-tcl way to do this quickly #for now we will just key using the whole string - set cache_key $optionspecs - if {[tcl::dict::exists $argspec_cache $cache_key]} { - return [tcl::dict::get $argspec_cache $cache_key] + + set cache_key $args + set textargs $args + + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] + set textargs [lrange $args 2 end] } - set optionspecs [tcl::string::map [list \r\n \n] $optionspecs] + if {!$is_dynamic} { + if {[tcl::dict::exists $argdata_cache $cache_key]} { + return [tcl::dict::get $argdata_cache $cache_key] + } + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + if {[string first \$\{ $optionspecs] > 0} { + set optionspecs [uplevel 1 [list punk::args::lib::tstr -return string -eval 1 $optionspecs]] + } + } else { + if {[tcl::dict::exists $argdefcache_unresolved $cache_key]} { + set pt_params [tcl::dict::get $argdefcache_unresolved $cache_key] + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + } else { + set normargs [list] + foreach a $textargs { + lappend normargs [tcl::string::map {\r\n \n} $a] + } + set optionspecs [join $normargs \n] + #REVIEW - join also serves to unescape things such as \$\{$x\} \$\{[cmd]\} without subst'ing or evaling (?) + if {[string first \$\{ $optionspecs] > 0} { + set pt_params [punk::args::lib::tstr -return list -eval 0 $optionspecs] ;#-eval 0 - no need to uplevel + lassign $pt_params ptlist paramlist + set optionspecs "" + foreach pt $ptlist param $paramlist { + append optionspecs $pt [uplevel 1 [list ::subst $param]] + } + tcl::dict::set argdefcache_unresolved $cache_key $pt_params + } + } + if {[tcl::dict::exists $argdata_cache $optionspecs]} { + #resolved cache version exists + return [tcl::dict::get $argdata_cache $optionspecs] + } + } + + + #probably faster to inline a literal dict create in the proc than to use a namespace variable set optspec_defaults [tcl::dict::create\ -type string\ @@ -381,7 +432,7 @@ tcl::namespace::eval punk::args { #default to 1 for convenience #checks with no default - #-minlen -maxlen -range + #-minsize -maxsize -range #default -allow_ansi to 1 and -validate_ansistripped to 0 and -strip_ansi 0 - it takes time to strip ansi @@ -473,14 +524,19 @@ tcl::namespace::eval punk::args { } set proc_info {} set id_info {} ;#e.g -children ?? - set leader_min 0 - set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set doc_info {} + set parser_info {} + set leader_min "" + #set leader_min 0 + #set leader_max 0 ;#default 0 but if leader_min is set switches to -1 for no limit + set leader_max "" #(common case of no leaders specified) set opt_any 0 set val_min 0 set val_max -1 ;#-1 for no limit set spec_id "" set argspace "leaders" ;#leaders -> options -> values + set parser_id 0 foreach ln $records { set trimln [tcl::string::trim $ln] switch -- [tcl::string::index $trimln 0] { @@ -510,10 +566,45 @@ tcl::namespace::eval punk::args { error "punk::args::definition - bad *id line. Remaining items on line after *id must be in paired option-value format - received '$linespecs'" } } + parser { + #handle multiple parsing styles based on arities and keyword positions (and/or flags?) + #e.g see lseq manual with 3 different parsing styles. + #aim to produce a table/subtable for each + # *parser -description "start ?('..'|'to')? end ??'by'? step?"\ + # -arities { + # 2 + # {3 anykeys {1 .. 1 to}} + # {4 anykeys {3 by}} + # {5 anykeys {1 .. 1 to 3 by}} + # }\ + # -fallback 1 + # ... + # *parser -description "start 'count' count ??'by'? step?"\ + # -arities { + # {3 anykeys {1 count}} + # } + # ... + # *parser -description "count ?'by' step?"\ + # -arities { + # 1 + # {3 anykeys {1 by}} + # } + # + # see also after manual + # *parser -arities {1} + # *parser -arities { + # 1 anykeys {0 info} + # } + #todo + set parser_info $starspecs + } proc { #allow arbitrary - review set proc_info $starspecs } + doc { + set doc_info $starspecs + } opts { if {$argspace eq "values"} { error "punk::args::definition - *opts declaration must come before *values - received '$linespecs'" @@ -525,13 +616,14 @@ tcl::namespace::eval punk::args { -anyopts { set opt_any $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted { #review - only apply to certain types? tcl::dict::set optspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels - -nocase { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels - -nocase { if {$v} { - tcl::dict::unset optspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset optspec_defaults $k2 } } -type { @@ -563,16 +655,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { #allow overriding of defaults for options that occur later tcl::dict::set optspec_defaults $k $v } default { - set known { -any -anyopts -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + set known { -any -anyopts -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *opts line. Known keys: $known" } @@ -588,27 +681,28 @@ tcl::namespace::eval punk::args { -min - -minvalues { if {$v < 0} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is 0. got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is 0. got $v" } set leader_min $v - if {$leader_max == 0} { - set leader_max -1 - } + #if {$leader_max == 0} { + # set leader_max -1 + #} } -max - -maxvalues { if {$v < -1} { - error "punk::args::definition - minimum acceptable value for key '$k' in *opts line is -1 (indicating unlimited). got $v" + error "punk::args::definition - minimum acceptable value for key '$k' in *leaders line is -1 (indicating unlimited). got $v" } set leader_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set leaderspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset leaderspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset leaderspec_defaults $k2 } } -type { @@ -640,16 +734,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set leaderspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *leaders line. Known keys: $known" } @@ -675,13 +770,14 @@ tcl::namespace::eval punk::args { } set val_max $v } - -minlen - -maxlen - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { + -minsize - -maxsize - -range - -choices - -choicelabels - -choiceprefix - -choicerestricted - -nocase { #review - only apply to certain types? tcl::dict::set valspec_defaults $k $v } - -nominlen - -nomaxlen - -norange - -nochoices - -nochoicelabels { + -nominsize - -nomaxsize - -norange - -nochoices - -nochoicelabels { if {$v} { - tcl::dict::unset valspec_defaults $k + set k2 -[string range $k 3 end] ;#strip 'no' + tcl::dict::unset valspec_defaults $k2 } } -type { @@ -713,16 +809,17 @@ tcl::namespace::eval punk::args { -strip_ansi - -regexprepass - -regexprefail - + -regexprefailmsg - -validationtransform - -multiple { tcl::dict::set valspec_defaults $k $v } default { set known { -min -minvalues -max -maxvalues\ - -minlen -maxlen -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ - -nominlen -nomaxlen -norange -nochoices -nochoicelabels\ + -minsize -maxsize -range -choices -choicelabels -choiceprefix -choicerestricted -nocase\ + -nominsize -nomaxsize -norange -nochoices -nochoicelabels\ -type -optional -allow_ansi -validate_ansistripped -strip_ansi -multiple\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ } error "punk::args::definition - unrecognised key '$k' in *values line. Known keys: $known" } @@ -754,7 +851,7 @@ tcl::namespace::eval punk::args { if {$argspace eq "leaders"} { tcl::dict::set argspecs -ARGTYPE leader lappend leader_names $argname - if {$leader_max == 0} { + if {$leader_max >= 0} { set leader_max [llength $leader_names] } } else { @@ -819,11 +916,12 @@ tcl::namespace::eval punk::args { } } } - -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minlen - -maxlen - -nocase - -optional - -multiple - + -default - -solo - -range - -choices - -choiceprefix - -choicerestricted - -choicelabels - -minsize - -maxsize - -nocase - -optional - -multiple - -validate_ansistripped - -allow_ansi - -strip_ansi - -help - -ARGTYPE - - -regexprepass - -regexprefail + -regexprepass - -regexprefail - -regexprefailmsg { - #review -solo 1 vs -type none ? + #inverses '-noxxx' (e.g -nochoices -nominsize etc) don't apply to specific args - only to *leaders *opts *values lines + #review -solo 1 vs -type none ? conflicting values? tcl::dict::set spec_merged $spec $specval } -validationtransform { @@ -833,10 +931,10 @@ tcl::namespace::eval punk::args { } dict for {tk tv} $specval { switch -- $tk { - -function - -type - -minlen - -maxlen - -range { + -function - -type - -minsize - -maxsize - -range { } default { - set known_transform_keys [list -function -type -minlen -maxlen -range] ;#-choices etc? + set known_transform_keys [list -function -type -minsize -maxsize -range] ;#-choices etc? error "punk::args::definition - invalid subkey $tk for key '$spec' in specifications for argument '$argname' must be one of: $known_transform_keys" } } @@ -844,9 +942,9 @@ tcl::namespace::eval punk::args { } default { - set known_argspecs [list -default -type -range -choices -choiceprefix -choicerestricted\ + set known_argspecs [list -default -type -range -minsize -maxsize -choices -choiceprefix -choicerestricted\ -nocase -optional -multiple -validate_ansistripped -allow_ansi -strip_ansi -help\ - -regexprepass -regexprefail -validationtransform\ + -regexprepass -regexprefail -regexprefailmsg -validationtransform\ ] error "punk::args::definition - unrecognised key '$spec' in specifications for argument '$argname' Known option specification keys: $known_argspecs" } @@ -854,9 +952,9 @@ tcl::namespace::eval punk::args { } set argspecs $spec_merged if {$is_opt} { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } else { - set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set argchecks [tcl::dict::remove $argspecs -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize } tcl::dict::set arg_info $argname $argspecs tcl::dict::set arg_checks $argname $argchecks @@ -886,11 +984,21 @@ tcl::namespace::eval punk::args { } # REVIEW - foreach leadername [lrange $leader_names 0 end] { - if {[tcl::dict::get $arg_info $leadername -multiple]} { - error "bad key -multiple on argument spec for leader '$valname'. Only the last value argument specification can be marked -multiple" + #if {[llength $val_names] || $val_min > 0} { + # #some values are specified + # foreach leadername [lrange $leader_names 0 end] { + # if {[tcl::dict::get $arg_info $leadername -multiple]} { + # error "bad key -multiple on argument spec for leader '$leadername'. Last leader argument specification can be marked -multiple only when no values are specified" + # } + # } + #} else { + #no values specified - we can allow last leader to be multiple + foreach leadername [lrange $leader_names 0 end-1] { + if {[tcl::dict::get $arg_info $leadername -multiple]} { + error "bad key -multiple on argument spec for leader '$leadername'. Only the last leader argument specification can be marked -multiple" + } } - } + #} #confirm any valnames before last don't have -multiple key foreach valname [lrange $val_names 0 end-1] { if {[tcl::dict::get $arg_info $valname -multiple]} { @@ -906,11 +1014,11 @@ tcl::namespace::eval punk::args { #todo - do some checks for obvious bad definitions involving a mix of *leaders and *values (e.g with optional options) - set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen - set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minlen + set leader_checks_defaults [tcl::dict::remove $leaderspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set opt_checks_defaults [tcl::dict::remove $optspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize + set val_checks_defaults [tcl::dict::remove $valspec_defaults -type -default -multiple -strip_ansi -validate_ansistripped -allow_ansi] ;#leave things like -range -minsize - set result [tcl::dict::create\ + set argdata_dict [tcl::dict::create\ id $spec_id\ arg_info $arg_info\ arg_checks $arg_checks\ @@ -936,24 +1044,31 @@ tcl::namespace::eval punk::args { valspec_defaults $valspec_defaults\ val_checks_defaults $val_checks_defaults\ proc_info $proc_info\ + doc_info $doc_info\ id_info $id_info\ ] - tcl::dict::set argspec_cache $cache_key $result - #tcl::dict::set argspecs $spec_id $optionspecs - tcl::dict::set argspec_ids $spec_id $optionspecs + tcl::dict::set argdata_cache $cache_key $argdata_dict + if {$is_dynamic} { + #also cache resolved version + tcl::dict::set argdata_cache $optionspecs $argdata_dict + } + #tcl::dict::set argdefcache_by_id $spec_id $optionspecs + tcl::dict::set argdefcache_by_id $spec_id $args #puts "xxx:$result" - return $result + return $argdata_dict } proc get_spec {id {patternlist *}} { - variable argspec_ids - if {[tcl::dict::exists $argspec_ids $id]} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { if {$patternlist eq "*"} { - return [tcl::dict::get $argspec_ids $id] + #todo? + return [tcl::dict::get $argdefcache_by_id $realid] } else { - set spec [tcl::dict::get $argspec_ids $id] + set speclist [tcl::dict::get $argdefcache_by_id $realid] set result "" - set specdict [definition $spec] + set specdict [uplevel 1 [list ::punk::args::definition {*}$speclist]] set arg_info [dict get $specdict arg_info] foreach pat $patternlist { set matches [dict keys $arg_info $pat] @@ -968,13 +1083,128 @@ tcl::namespace::eval punk::args { } return } + proc get_spec_values {id {patternlist *}} { + variable argdefcache_by_id + set realid [real_id $id] + if {$realid ne ""} { + set speclist [tcl::dict::get $argdefcache_by_id $realid] + set specdict [definition {*}$speclist] + set arg_info [dict get $specdict arg_info] + set valnames [dict get $specdict val_names] + set result "" + if {$patternlist eq "*"} { + foreach v $valnames { + set def [dict get $arg_info $v] + set def [dict remove $def -ARGTYPE] + append result \n "$v $def" + } + } else { + foreach pat $patternlist { + set matches [dict keys $arg_info $pat] + set matches [lsearch -all -inline -glob $valnames $pat] + foreach m $matches { + set def [dict get $arg_info $m] + set def [dict remove $def -ARGTYPE] + append result \n "$m $def" + } + } + return $result + } + } + return + } #proc get_spec_leaders ?? #proc get_spec_opts ?? - #proc get_spec_values ?? - proc get_spec_ids {{match *}} { - variable argspec_ids - return [tcl::dict::keys $argspec_ids $match] + variable aliases + set aliases [dict create] + + lappend PUNKARGS [list { + *id punk::args::get_ids + *proc -name punk::args::get_ids -help\ + "return list of ids for argument definitions" + *values -min 0 -max 1 + match -default * -help\ + "exact id or glob pattern for ids" + }] + proc get_ids {{match *}} { + variable argdefcache_by_id + variable aliases + return [list {*}[tcl::dict::keys $aliases $match] {*}[tcl::dict::keys $argdefcache_by_id $match]] + } + proc id_exists {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + return 1 + } + tcl::dict::exists $argdefcache_by_id $id + } + proc set_alias {alias id} { + variable aliases + dict set aliases $alias $id + } + proc unset_alias {alias} { + variable aliases + dict unset aliases $alias + } + proc get_alias {alias} { + variable aliases + if {[dict exists $aliases $alias]} { + return [tcl::dict::get $aliases $alias] + } + } + + proc real_id {id} { + variable argdefcache_by_id + variable aliases + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } else { + if {![llength [update_definitions]]} { + return "" + } else { + if {[tcl::dict::exists $aliases $id]} { + set id [tcl::dict::get $aliases $id] + } + if {[tcl::dict::exists $argdefcache_by_id $id]} { + return $id + } + return "" + } + } + } + + variable loaded_packages + set loaded_packages [list] + + proc update_definitions {} { + variable loaded_packages + upvar ::punk::args::register::NAMESPACES pkgs + if {[llength $loaded_packages] == [llength $pkgs]} { + #the only valid mechanism to add to 'loaded_packages' is with this function - so if lengths are equal, nothing to do. + return {} + } + set unloaded [punklib_ldiff $pkgs $loaded_packages] + set newloaded [list] + foreach pkgns $unloaded { + if {![catch { + if {[info exists ${pkgns}::PUNKARGS]} { + foreach deflist [set ${pkgns}::PUNKARGS] { + namespace eval $pkgns [list punk::args::definition {*}$deflist] + } + } + } errMsg]} { + lappend loaded_pkgs $pkgns + lappend newloaded $pkgns + } else { + puts stderr "punk::args::update_definitions error - failed to load PUNKARGS definitions for $pkgns\nerr:$errMsg" + } + } + return $newloaded } #for use within get_dict only @@ -1018,253 +1248,408 @@ tcl::namespace::eval punk::args { #basic recursion blocker variable arg_error_isrunning 0 - proc arg_error {msg spec_dict {badarg ""}} { + proc arg_error {msg spec_dict args} { + if {[catch {package require punk::ansi}]} { + proc punk::args::a {args} {} + proc punk::args::a+ {args} {} + } else { + namespace eval ::punk::args { + namespace import ::punk::ansi::a ::punk::ansi::a+ + } + } #limit colours to standard 16 so that themes can apply to help output variable arg_error_isrunning if {$arg_error_isrunning} { - error "arg_error already running - error in arg_error?\n triggering errmsg: $badarg" + error "arg_error already running - error in arg_error?\n triggering errmsg: $msg" } set arg_error_isrunning 1 + if {[llength $args] %2 != 0} { + error "error in arg_error processing - expected opt/val pairs after msg and spec_dict" + } + set badarg "" + set returntype error + dict for {k v} $args { + switch -- $k { + -badarg { + set badarg $v + } + -return { + if {$v ni {error string}} { + error "arg_error invalid value for option -return. Received '$v' expected one of: error string" + } + set returntype $v + } + default { + error "arg_error invalid option $k. Known_options: -badarg -return" + } + } + } + + #REVIEW - risk of accidental indefinite recursion if functions used here also use punk::args::get_dict and there is an argument error #e.g list_as_table # use basic colours here to support terminals without extended colours - #todo - add checks column (e.g -minlen -maxlen) + #todo - add checks column (e.g -minsize -maxsize) set errmsg $msg if {![catch {package require textblock}]} { - if {[catch { + set has_textblock 1 + } else { + set has_textblock 0 + #couldn't load textblock package + #just return the original errmsg without formatting + } + set errlines [list] ;#for non-textblock output + if {[catch { + if {$has_textblock} { append errmsg \n - set procname [::punk::args::Dict_getdef $spec_dict proc_info -name ""] - set prochelp [::punk::args::Dict_getdef $spec_dict proc_info -help ""] + } else { + append errmsg \n "[a+ brightred](layout package textblock is missing)[a]" \n + } + set procname [Dict_getdef $spec_dict proc_info -name ""] + set prochelp [Dict_getdef $spec_dict proc_info -help ""] - set t [textblock::class::table new [a+ brightyellow]Usage[a]] + set docname [Dict_getdef $spec_dict doc_info -name "Manual:"] + set docurl [Dict_getdef $spec_dict doc_info -url ""] - set blank_header_col [list ""] - if {$procname ne ""} { - lappend blank_header_col "" - set procname_display [a+ brightwhite]$procname[a] - } else { - set procname_display "" - } - if {$prochelp ne ""} { - lappend blank_header_col "" - set prochelp_display [a+ brightwhite]$prochelp[a] - } else { - set prochelp_display "" - } + + set blank_header_col [list ""] + if {$procname ne ""} { + lappend blank_header_col "" + set procname_display [a+ brightwhite]$procname[a] + } else { + set procname_display "" + } + if {$prochelp ne ""} { + lappend blank_header_col "" + set prochelp_display [a+ brightwhite]$prochelp[a] + } else { + set prochelp_display "" + } + if {$docurl ne ""} { + lappend blank_header_col "" + set docurl_display [a+ white]$docurl[a] + } else { + set docurl_display "" + } + if {$has_textblock} { + set t [textblock::class::table new [a+ brightyellow]Usage[a]] $t add_column -headers $blank_header_col -minwidth 3 $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col $t add_column -headers $blank_header_col - if {"$procname$prochelp" eq ""} { - $t configure_header 0 -values {Arg Type Default Multi Help} - } elseif {$procname eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 1 -values {Arg Type Default Multi Help} - } elseif {$prochelp eq ""} { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -values {Arg Type Default Multi Help} + } + set h 0 + if {$procname ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] + } else { + lappend errlines "PROC/METHOD: $procname_display" + } + incr h + } + if {$prochelp ne ""} { + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] } else { - $t configure_header 0 -colspans {1 4 0 0 0} -values [list PROC/METHOD: $procname_display] - $t configure_header 1 -colspans {1 4 0 0 0} -values [list Description: $prochelp_display] - $t configure_header 2 -values {Arg Type Default Multi Help} + lappend errlines "Description: $prochelp_display" + } + incr h + } + if {$docurl ne ""} { + if {![catch {package require punk::ansi}]} { + set docurl [punk::ansi::hyperlink $docurl] } + if {$has_textblock} { + $t configure_header $h -colspans {1 4 0 0 0} -values [list $docname $docurl_display] + } else { + lappend errlines "$docname $docurl_display" + } + incr h + } + if {$has_textblock} { + $t configure_header $h -values {Arg Type Default Multi Help} + } else { + lappend errlines " --ARGUMENTS-- " + } + + set RST [a] + #set A_DEFAULT [a+ brightwhite Brightgreen] + set A_DEFAULT "" + set A_BADARG [a+ brightred] + set greencheck [a+ brightgreen]\u2713[a] ;#green tick + set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) + set A_PREFIX [a+ green] ;#use a+ so colour off can apply + if {$A_PREFIX eq ""} { + set A_PREFIX [a+ underline] + set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + } else { + set A_PREFIXEND $RST + } - set RST [a] - #set A_DEFAULT [a+ brightwhite Brightgreen] - set A_DEFAULT "" - set A_BADARG [a+ brightred] - set greencheck [a+ brightgreen]\u2713[a] ;#green tick - set soloflag [a+ brightcyan]\u2690[a] ;#flag - may be replacement char in old dos prompt (?) - set A_PREFIX [a+ green] ;#use a+ so colour off can apply - if {$A_PREFIX eq ""} { - set A_PREFIX [a+ underline] - set A_PREFIXEND [a+ nounderline]\u200B ;#padding will take ANSI from last char - so add a zero width space + set opt_names [list] + set opt_names_display [list] + if {[llength [dict get $spec_dict opt_names]]} { + if {![catch {package require punk::trie}]} { + set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $spec_dict opt_names] { + set id [dict get $idents $c] + #REVIEW + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail + #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] + lappend opt_names $c + } } else { - set A_PREFIXEND $RST + set opt_names [dict get $spec_dict opt_names] + set opt_names_display $opt_names } - - set opt_names [list] - set opt_names_display [list] - if {[llength [dict get $spec_dict opt_names]]} { - if {![catch {package require punk::trie}]} { - set trie [punk::trie::trieclass new {*}[dict get $spec_dict opt_names]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy - foreach c [dict get $spec_dict opt_names] { - set id [dict get $idents $c] - #REVIEW - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] - } - lappend opt_names_display $A_PREFIX$prefix$A_PREFIXEND$tail - #lappend opt_names_display $M[ansistring VIEW $prefix]$RST[ansistring VIEW $tail] - lappend opt_names $c - } + } + set leading_val_names [dict get $spec_dict leader_names] + set trailing_val_names [dict get $spec_dict val_names] + + #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { + # if {![string match -* $argname]} { + # lappend leading_val_names [lpop trailing_val_names 0] + # } else { + # break + # } + #} + #if {![llength $leading_val_names] && ![llength $opt_names]} { + # #all vals were actually trailing - no opts + # set trailing_val_names $leading_val_names + # set leading_val_names {} + #} + set leading_val_names_display $leading_val_names + set trailing_val_names_display $trailing_val_names + + #display options first then values + foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { + lassign $argumentset argnames_display argnames + + foreach argshow $argnames_display arg $argnames { + set arginfo [dict get $spec_dict arg_info $arg] + if {[dict exists $arginfo -default]} { + set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" } else { - set opt_names [dict get $spec_dict opt_names] - set opt_names_display $opt_names + set default "" } - } - set leading_val_names [dict get $spec_dict leader_names] - set trailing_val_names [dict get $spec_dict val_names] - - #dict for {argname info} [tcl::dict::get $spec_dict arg_info] { - # if {![string match -* $argname]} { - # lappend leading_val_names [lpop trailing_val_names 0] - # } else { - # break - # } - #} - #if {![llength $leading_val_names] && ![llength $opt_names]} { - # #all vals were actually trailing - no opts - # set trailing_val_names $leading_val_names - # set leading_val_names {} - #} - set leading_val_names_display $leading_val_names - set trailing_val_names_display $trailing_val_names - - #display options first then values - foreach argumentset [list [list $leading_val_names_display $leading_val_names] [list $opt_names_display $opt_names] [list $trailing_val_names_display $trailing_val_names]] { - lassign $argumentset argnames_display argnames - - foreach argshow $argnames_display arg $argnames { - set arginfo [dict get $spec_dict arg_info $arg] - if {[dict exists $arginfo -default]} { - set default "'$A_DEFAULT[dict get $arginfo -default]$RST'" + set help [Dict_getdef $arginfo -help ""] + if {[dict exists $arginfo -choices]} { + if {$help ne ""} {append help \n} + if {[dict get $arginfo -nocase]} { + set casemsg " (case insensitive)" } else { - set default "" + set casemsg " (case sensitive)" } - set help [::punk::args::Dict_getdef $arginfo -help ""] - if {[dict exists $arginfo -choices]} { - if {$help ne ""} {append help \n} - if {[dict get $arginfo -nocase]} { - set casemsg " (case insensitive)" - } else { - set casemsg " (case sensitive)" - } - if {[dict get $arginfo -choiceprefix]} { - set prefixmsg " (choice prefix allowed)" + if {[dict get $arginfo -choiceprefix]} { + set prefixmsg " (choice prefix allowed)" + } else { + set prefixmsg "" + } + set choicelabeldict [Dict_getdef $arginfo -choicelabels {}] + set formattedchoices [list] + append help " Choices$prefixmsg$casemsg" + if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + #append help "\n " [join [dict get $arginfo -choices] "\n "] + if {[dict size $choicelabeldict]} { + foreach c [dict get $arginfo -choices] { + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } } else { - set prefixmsg "" + set formattedchoices [dict get $arginfo -choices] } - set formattedchoices [list] - append help " Choices$prefixmsg$casemsg" - if {![dict get $arginfo -choiceprefix] || [catch {package require punk::trie}]} { + } else { + if {[catch { + set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] + set idents [dict get [$trie shortest_idents ""] scanned] + $trie destroy + foreach c [dict get $arginfo -choices] { + set id [dict get $idents $c] + if {$id eq $c} { + set prefix $c + set tail "" + } else { + set idlen [string length $id] + set prefix [string range $c 0 $idlen-1] + set tail [string range $c $idlen end] + } + set cdisplay "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] + } + lappend formattedchoices $cdisplay + } + } errM]} { + puts stderr "prefix marking failed\n$errM" #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - } else { - if {[catch { - set trie [punk::trie::trieclass new {*}[dict get $arginfo -choices]] - set idents [dict get [$trie shortest_idents ""] scanned] - $trie destroy + if {[dict size $choicelabeldict]} { foreach c [dict get $arginfo -choices] { - set id [dict get $idents $c] - if {$id eq $c} { - set prefix $c - set tail "" - } else { - set idlen [string length $id] - set prefix [string range $c 0 $idlen-1] - set tail [string range $c $idlen end] + set cdisplay $c + if {[dict exists $choicelabeldict $c]} { + append cdisplay \n [dict get $choicelabeldict $c] } - lappend formattedchoices "$A_PREFIX[ansistring VIEW $prefix]$A_PREFIXEND[ansistring VIEW $tail]" - } - } errM]} { - puts stderr "prefix marking failed\n$errM" - #append help "\n " [join [dict get $arginfo -choices] "\n "] - set formattedchoices [dict get $arginfo -choices] - - } - } - set numcols 4 - if {[llength $formattedchoices] < $numcols} { - #don't show blank cells if single line of results - set numcols [llength $formattedchoices] - } - #risk of recursing - set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] - append help \n[textblock::join -- " " $choicetable] - #review. use -type to restrict additional choices - may be different to values in the -choices - if {![dict get $arginfo -choicerestricted]} { - if {[dict get $arginfo -type] eq "string"} { - append help "\n (values not in defined choices are allowed)" + lappend formattedchoices $cdisplay + } } else { - append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + set formattedchoices [dict get $arginfo -choices] } + } } - if {[::punk::args::Dict_getdef $arginfo -multiple 0]} { - set multiple $greencheck - } else { - set multiple "" + set numcols 4 ;#todo - dynamic? + if {[llength $formattedchoices] < $numcols} { + #don't show blank cells if single line of results + set numcols [llength $formattedchoices] } - if {[::punk::args::Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { - set argshow "?${argshow}?" + if {$numcols > 0} { + if {$has_textblock} { + #risk of recursing + set choicetable [textblock::list_as_table -show_hseps 1 -show_edge 1 -columns $numcols $formattedchoices] + append help \n[textblock::join -- " " $choicetable] + } else { + append help \n [join $formattedchoices \n] + } + } else { + #we were given an empty set of choices. + #probably an error in the definition - but could happen if dynamically generated. + #(e.g ensemble where unknown mechanism is used for subcommands?) + #better to just display that there were none rather than totally break the usage output. + append help \n " " [a+ red](no choices defined)[a] } - set typeshow [dict get $arginfo -type] - if {$typeshow eq "none"} { - set typeshow "$typeshow $soloflag" + + #review. use -type to restrict additional choices - may be different to values in the -choices + if {![dict get $arginfo -choicerestricted]} { + if {[dict get $arginfo -type] eq "string"} { + append help "\n (values not in defined choices are allowed)" + } else { + append help "\n (values not in defined choices are allowed but must by of type: [dict get $arginfo -type])" + } } + } + if {[Dict_getdef $arginfo -multiple 0]} { + set multiple $greencheck + } else { + set multiple "" + } + if {[Dict_getdef $arginfo -optional 0] == 1 || [dict exists $arginfo -default]} { + set argshow "?${argshow}?" + } + set typeshow [dict get $arginfo -type] + if {$typeshow eq "none"} { + set typeshow "$typeshow $soloflag" + } + if {[dict exists $arginfo -minsize]} { + append typeshow \n "-minsize [dict get $arginfo -minsize]" + } + if {[dict exists $arginfo -maxsize]} { + append typeshow \n "-maxsize [dict get $arginfo -maxsize]" + } + if {[dict exists $arginfo -range]} { + append typeshow \n "-range [dict get $arginfo -range]" + } + + if {$has_textblock} { $t add_row [list $argshow $typeshow $default $multiple $help] if {$arg eq $badarg} { $t configure_row [expr {[$t row_count]-1}] -ansibase $A_BADARG } + } else { + #review - formatting will be all over the shop due to newlines in typesshow, help + lappend errlines "$argshow TYPE:$typeshow DEFAULT:$default MULTI:$multiple HELP:$help\n" } } + } - - #$t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ web-white] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] + if {$has_textblock} { $t configure -show_hseps 0 -show_header 1 -ansibase_body [a+ brightwhite] -ansibase_header [a+ brightyellow] -ansiborder_header [a+ brightyellow] -ansiborder_body [a+ brightyellow] $t configure -maxwidth 80 append errmsg [$t print] $t destroy - } errM]} { - catch {$t destroy} - append errmsg \n - append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n - append errmsg "$errM" \n - append errmsg "$::errorInfo" - + } else { + append errmsg [join $errlines \n] } - } else { - #couldn't load textblock package - #just return the original errmsg without formatting + } errM]} { + catch {$t destroy} + append errmsg \n + append errmsg "(additional error in punk::args::arg_error when attempting to display usage)" \n + append errmsg "$errM" \n + append errmsg "$::errorInfo" + } set arg_error_isrunning 0 #add PUNK to the tail end of the more usual -errorcode {TCL WRONGARGS} so we maintain reasonable compat with things looking for TCL WRONGARGS - but also differentiate it. #Also,we're polite enough in the errorInfo, nothing wrong with a Clint Eastwood style errorCode ;) - return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + if {$returntype eq "error"} { + return -code error -errorcode {TCL WRONGARGS PUNK} $errmsg + } else { + return $errmsg + } } - #todo - a version of get_dict that supports punk::lib::tstr templating - #rename get_dict - #provide ability to look up and reuse definitions from ids etc - # + lappend PUNKARGS [list { + *id punk::args::usage + *proc -name punk::args::usage -help\ + "return usage information as a string + in table form." + *values -min 0 -max 1 + id -help\ + "exact id. + Will usually match the command name" + }] + proc usage {id} { + set speclist [get_spec $id] + if {[llength $speclist] == 0} { + error "punk::args::usage - no such id: $id" + } + arg_error "" [uplevel 1 [list punk::args::definition {*}$speclist]] -return string + } + + lappend PUNKARGS [list { + *id punk::args::get_by_id + *proc -name punk::args::get_by_id + *values -min 1 + id + arglist -default "" -type list -help\ + "list containing arguments to be parsed as per the + argument specification identified by the supplied id." + }] proc get_by_id {id {arglist ""}} { - set spec [get_spec $id] - if {$spec eq ""} { + set speclist [punk::args::get_spec $id] + if {[llength $speclist] == 0} { error "punk::args::get_by_id - no such id: $id" } - return [get_dict $spec $arglist] + return [uplevel 1 [list ::punk::args::get_dict {*}$speclist $arglist]] } + #todo? - a version of get_dict that directly supports punk::lib::tstr templating + #rename get_dict + # + #generally we expect values to contain leading dashes only if -- specified. Otherwise no reliable way determine difference between bad flags and values #If no eopts (--) specified we stop looking for opts at the first nondash encountered in a position we'd expect a dash - so without eopt, values could contain dashes - but not in first position after flags. #only supports -flag val pairs, not solo options #If an option is supplied multiple times - only the last value is used. - proc get_dict {optionspecs args} { + proc get_dict {args} { #*** !doctools - #[call [fun get_dict] [arg optionspecs] [arg rawargs] [opt {option value...}]] + #[call [fun get_dict] [arg optionspecs] [arg rawargs]] #[para]Parse rawargs as a sequence of zero or more option-value pairs followed by zero or more values #[para]Returns a dict of the form: opts values #[para]ARGUMENTS: @@ -1297,48 +1682,53 @@ tcl::namespace::eval punk::args { # *values -multiple 1 #} $args - if {[llength $args] == 0} { - set rawargs [list] - } elseif {[llength $args] ==1} { - set rawargs [lindex $args 0] ;#default tcl style - } else { - #todo - can we support tk style vals before flags? - #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order - #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. - #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options - #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. - #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. - error "unsupported number of arguments for punk::args::get_dict" - set inopt 0 - set k "" - set i 0 - foreach a $args { - switch -- $f { - -opts { - - } - -vals { - - } - -optvals { - #tk style - - } - -valopts { - #tcl style - set rawargs [lindex $args $i+1] - incr i - } - default { - - } - } - incr i - } + #if {[llength $args] == 0} { + # set rawargs [list] + #} elseif {[llength $args] ==1} { + # set rawargs [lindex $args 0] ;#default tcl style + #} else { + # #todo - can we support tk style vals before flags? + # #the aim is to allow a single call to validate standard leading proc positional args along with the $args val which may have flags in tk or tcl order + # #by allowing all to be in a single call - we could use a -help (or similar erroring call) to trigger the spec-parsing from a wrapper function. + # #this would be important in the case where the function to be wrapped has never been called - but the wrapper needs info about the downstream options + # #we would like to avoid the ugliness of trying to parse a proc body to scrape the specification. + # #we may still need to do a basic scan of the proc body to determine if it at least contains the string punk::args::get_dict - but that is slightly less odious. + # error "unsupported number of arguments for punk::args::get_dict" + # set inopt 0 + # set k "" + # set i 0 + # foreach a $args { + # switch -- $f { + # -opts { + + # } + # -vals { + + # } + # -optvals { + # #tk style + + # } + # -valopts { + # #tcl style + # set rawargs [lindex $args $i+1] + # incr i + # } + # default { + + # } + # } + # incr i + # } + #} + set is_dynamic 0 + if {[lindex $args 0] eq "-dynamic"} { + set is_dynamic [lindex $args 1] } + set rawargs [lindex $args end] ;# args values to be parsed + set def_args [lrange $args 0 end-1] - - set argspecs [definition $optionspecs] + set argspecs [uplevel 1 [list ::punk::args::definition {*}$def_args]] tcl::dict::with argspecs {} ;#turn keys into vars #puts "-arg_info->$arg_info" set flagsreceived [list] ;#for checking if required flags satisfied @@ -1354,52 +1744,123 @@ tcl::namespace::eval punk::args { # todo - consider allowing last leading positional to have -multiple 1 but only if there exists an eopts marker later (--) ? set opts $opt_defaults set pre_values {} - #dict for {a info} $arg_info { - # #todo - flag for possible subhandler - whether leading - or not (shellfilter concept) - # if {![string match -* $a]} { - # #lappend pre_values [lpop rawargs 0] - # if {[catch {lpop rawargs 0} val]} { - # break - # } else { - # lappend pre_values $val - # } - # } else { - # break - # } - #} - set argnames [dict keys $arg_info] + set argnames [tcl::dict::keys $arg_info] set optnames [lsearch -all -inline $argnames -*] set ridx 0 set rawargs_copy $rawargs + set leader_posn_name "" + set leader_posn_names_assigned [dict create] ;#track if the name got a value (or multiple if last one) + set is_multiple 0 ;#last leader may be multi if {$leader_max != 0} { foreach r $rawargs_copy { - if {$leader_max != -1 && $ridx > $leader_max-1} { + if {$leader_max ne "" && $leader_max != -1 && $ridx > $leader_max-1} { break } - if {[string match -* $r]} { - if {$r eq "--"} { - break + if {$ridx == [llength $leader_names]-1} { + #at last named leader + set leader_posn_name [lindex $leader_names $ridx] + if {[dict exists $arg_info $leader_posn_name -multiple] && [dict get $arg_info $leader_posn_name -multiple]} { + set is_multiple 1 } + } elseif {$ridx > [llength $leader_names]-1} { + #beyond names - retain name if -multiple was true + if {!$is_multiple} { + set leader_posn_name "" + } + } else { + set leader_posn_name [lindex $leader_names $ridx] ;#may return empty string + } + if {$r eq "--"} { + #review end of opts marker: '--' can't be a leader (but can be a value) + break + } + + #argument such as a dictionary may have leading dash - test for whitespace to exclude as possible option + if {[tcl::string::match -* $r] && !([tcl::string::first " " $r]>=0 || [tcl::string::first \t $r]>=0 || [tcl::string::last \n $r]>=0)} { set matchopt [::tcl::prefix::match -error {} $optnames $r] if {$matchopt ne ""} { #flaglike matches a known flag - don't treat as leader break } - if {![string match -* [lindex $argnames $ridx]]} { + #if {![string match -* [lindex $argnames $ridx]]} {} + if {$leader_posn_name ne ""} { #there is a named leading positional for this position + #The flaglooking value doesn't match an option - so treat as a leader lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name incr ridx continue } else { break } } - lappend pre_values [lpop rawargs 0] + + #for each branch - break or lappend + if {$leader_posn_name ne ""} { + if {$leader_posn_name ni $leader_required} { + #optional leader + + #most adhoc arg processing will allocate based on number of args rather than matching choice values first + #(because a choice value could be a legitimate data value) + + #review - option to process in this manner? + #first check if the optional leader value is a match for a choice ? + #if {[dict exists $arg_info $leader_posn_name -choices]} { + # set vmatch [tcl::prefix match -error "" [dict get $arg_info $leader_posn_name -choices] [lindex $rawargs 0]] + # if {$vmatch ne ""} { + # #If we match a choice for this named position - allocated it regardless of whether enough args for trailing values + # lappend pre_values [lpop rawargs 0] + # incr ridx + # continue + # } + #} + + #check if enough rawargs to fill any required values + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } else { + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #required + if {[dict exists $leader_posn_names_assigned $leader_posn_name]} { + #already accepted at least one value - requirement satisfied - now equivalent to optional + if {$val_min > 0 && [llength $rawargs] <= $val_min || [llength $rawargs] <= [llength $val_required]} { + break + } + } + #if we didn't break - requirement is not yet satisfied, or is satisfied but stil enough rawargs for required values + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + #unnamed leader + if {$leader_min ne "" } { + if {$ridx > $leader_min} { + break + } else { + #haven't reached leader_min + lappend pre_values [lpop rawargs 0] + dict incr leader_posn_names_assigned $leader_posn_name + } + } else { + break + } + } + incr ridx } } + if {$leader_min eq ""} { + set leader_min 0 + } + if {$leader_max eq ""} { + set leader_max -1 + } + #assert leader_max leader_min are numeric #assert - rawargs has been reduced by leading positionals set leaders [list] @@ -1429,7 +1890,8 @@ tcl::namespace::eval punk::args { break } - if {[tcl::string::match -* $a]} { + #exlude argument with whitespace from being a possible option e.g dict + if {[tcl::string::match -* $a] && !([tcl::string::first " " $a]>=0 || [tcl::string::first \t $a]>=0 || [tcl::string::last \n $a]>=0)} { if {$a eq "--"} { #remaining num args <= val_min already covered above if {$val_max != -1} { @@ -1467,14 +1929,12 @@ tcl::namespace::eval punk::args { } set flagval [lindex $rawargs $i+1] - if {[dict get $arg_info $fullopt -multiple]} { + if {[tcl::dict::get $arg_info $fullopt -multiple]} { #don't lappend to default - we need to replace if there is a default - #review - what if user sets first value that happens to match a default? - if {$fullopt ni $flagsreceived && [tcl::dict::exists $opt_defaults $fullopt] && ([tcl::dict::get $opt_defaults $fullopt] eq [tcl::dict::get $opts $fullopt])} { - #first occurrence of this flag, whilst stored value matches default + if {$fullopt ni $flagsreceived} { tcl::dict::set opts $fullopt [list $flagval] } else { - tcl::dict::lappend opts $fullopt $flagval + tcl::dict::lappend opts $fullopt $flagval } } else { tcl::dict::set opts $fullopt $flagval @@ -1482,13 +1942,13 @@ tcl::namespace::eval punk::args { #incr i to skip flagval incr vals_remaining_possible -2 if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs $fullopt + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last option $fullopt at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $fullopt } } else { #solo if {[tcl::dict::get $arg_info $fullopt -multiple]} { - if {[tcl::dict::get $opts $fullopt] == 0} { - #review - what if default at time opt was specified is not zero? we will end up with more items in the list than the number of times the flag was specified + if {$fullopt ni $flagsreceived} { + #override any default - don't lappend to it tcl::dict::set opts $fullopt 1 } else { tcl::dict::lappend opts $fullopt 1 @@ -1526,7 +1986,7 @@ tcl::namespace::eval punk::args { } lappend flagsreceived $a ;#adhoc flag as supplied if {[incr i] > $maxidx} { - arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs $a + arg_error "punk::args::get_dict bad options for [Get_caller]. No value supplied for last adhoc option $a at index [expr {$i-1}] which is not marked with -type none" $argspecs -badarg $a } incr vals_remaining_possible -2 } else { @@ -1543,9 +2003,12 @@ tcl::namespace::eval punk::args { incr vals_remaining_possible -1 } } else { - #set errmsg [tcl::string::map [list %caller% [Get_caller]] $fullopt] - set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" - arg_error $errmsg $argspecs $fullopt + if {[llength $opt_names]} { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": must be one of: $opt_names" + } else { + set errmsg "bad options for [Get_caller]. Unexpected option \"$a\": No options defined while *opts -any 0" + } + arg_error $errmsg $argspecs -badarg $fullopt } } } @@ -1571,6 +2034,7 @@ tcl::namespace::eval punk::args { set positionalidx 0 ;#index for unnamed positionals (both leaders and values) set ldridx 0 + set in_multiple "" set leadernames_received [list] set leaders_dict $leader_defaults set num_leaders [llength $leaders] @@ -1579,13 +2043,26 @@ tcl::namespace::eval punk::args { break } if {$leadername ne ""} { - tcl::dict::set leaders_dict $leadername $ldr + if {[tcl::dict::get $arg_info $leadername -multiple]} { + if {[tcl::dict::exists $leader_defaults $leadername]} { + tcl::dict::set leaders_dict $leadername [list $ldr] ;#important to treat first element as a list + } else { + tcl::dict::lappend leaders_dict $leadername $ldr + } + set in_multiple $leadername + } else { + tcl::dict::set leaders_dict $leadername $ldr + } lappend leadernames_received $leadername } else { - tcl::dict::set leaders_dict $positionalidx $ldr - tcl::dict::set arg_info $positionalidx $leaderspec_defaults - tcl::dict::set arg_checks $positionalidx $leader_checks_defaults - lappend leadernames_received $positionalidx + if {$in_multiple ne ""} { + tcl::dict::lappend leaders_dict $in_multiple $ldr + } else { + tcl::dict::set leaders_dict $positionalidx $ldr + tcl::dict::set arg_info $positionalidx $leaderspec_defaults + tcl::dict::set arg_checks $positionalidx $leader_checks_defaults + lappend leadernames_received $positionalidx + } } incr ldridx incr positionalidx @@ -1602,7 +2079,7 @@ tcl::namespace::eval punk::args { } if {$valname ne ""} { if {[tcl::dict::get $arg_info $valname -multiple]} { - if {[tcl::dict::exists $val_defaults $valname] && ([tcl::dict::get $val_defaults $valname] eq [tcl::dict::get $values_dict $valname])} { + if {[tcl::dict::exists $val_defaults $valname]} { #current stored val equals defined default - don't include default in the list we build up tcl::dict::set values_dict $valname [list $val] ;#important to treat first element as a list } else { @@ -1663,12 +2140,12 @@ tcl::namespace::eval punk::args { #opts explicitly marked as -optional 0 must be present - regardless of -anyopts (which allows us to ignore additional opts to pass on to next call) #however - if -anyopts is true, there is a risk we will treat a shortened option name as matching our default - when it was intended for the next call - #We will always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW + #We SHOULD? always require exact matches for all required opts to avoid this risk, even though an ultimately-called function may not require the full-length option-name REVIEW #The aim is to allow a wrapper function to specify a default value for an option (and/or other changes/restrictions to a particular option or two) - without having to re-specify all the options for the underlying function. #without full respecification in the wrapper - we can't know that a supplied prefix is unambiguous at the next level #For this reason we need to pass on full-length opts for any defined options in the wrapper even if anyopts is true - #safe interp note - cannot avoid struct::set difference ensemble as it could be c or tcl implementation and we don't have an option to call directly? + #safe interp note - struct::set difference ensemble could be c or tcl implementation and we don't have an option to call directly? #example timing difference: #struct::set difference {x} {a b} #normal interp 0.18 u2 vs safe interp 9.4us @@ -1683,7 +2160,7 @@ tcl::namespace::eval punk::args { arg_error "Required leader missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs } if {[llength [set missing [punklib_ldiff $opt_required $flagsreceived]]]} { - arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present in full-length form" $argspecs + arg_error "Required option missing for [Get_caller]. missing flags: '$missing' are marked with -optional false - so must be present " $argspecs } if {[llength [set missing [punklib_ldiff $val_required $valnames_received]]]} { arg_error "Required value missing for [Get_caller]. missing values: '$missing' marked with -optional false - so must be present" $argspecs @@ -1714,7 +2191,7 @@ tcl::namespace::eval punk::args { set type [tcl::dict::get $thisarg -type] set has_choices [tcl::dict::exists $thisarg -choices] set regexprepass [tcl::dict::get $thisarg -regexprepass] - set regexprefail [punk::args::Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 + set regexprefail [Dict_getdef $thisarg -regexprefail ""] ;#aliased to dict getdef in tcl9 set validationtransform [tcl::dict::get $thisarg -validationtransform] @@ -1814,7 +2291,7 @@ tcl::namespace::eval punk::args { } else { set prefixmsg "" } - arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be one of the listed values:\n [join $choices "\n "]\n$casemsg$prefixmsg. Received: '$e'" $argspecs -badarg $argname } } incr idx @@ -1868,21 +2345,21 @@ tcl::namespace::eval punk::args { list { foreach e_check $vlist_check { if {![tcl::string::is list -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'list'. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[llength $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -minlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -minsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[llength $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires list with -maxlen $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires list with -maxsize $checkval. Received len:[llength $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1922,28 +2399,33 @@ tcl::namespace::eval punk::args { foreach e $remaining_e e_check $remaining_e_check { #puts "----> checking $e vs regex $regexprefail" if {[regexp $regexprefail $e]} { - arg_error "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" $argspecs $argname + if {[tcl::dict::exists $thisarg -regexprefailmsg]} { + set msg [tcl::dict::get $thisarg -regexprefailmsg] + } else { + set msg "Option $argname for [Get_caller] didn't pass regexprefail regex: '$regexprefail' got '$e'" + } + arg_error $msg $argspecs -badarg $argname } } } switch -- $type { ansistring { - #we need to respect -validate_ansistripped for -minlen etc, but the string must contain ansi + #we need to respect -validate_ansistripped for -minsize etc, but the string must contain ansi #.. so we need to look at the original values in $vlist not $vlist_check #REVIEW - difference between string with mixed plaintext and ansi and one required to be ansicodes only?? - #The ansicodes only case should be covered by -minlen 0 -maxlen 0 combined with -validate_ansistripped ??? + #The ansicodes only case should be covered by -minsize 0 -maxsize 0 combined with -validate_ansistripped ??? package require punk::ansi foreach e $remaining_e { if {![punk::ansi::ta::detect $e]} { - arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires ansistring - but no ansi detected" $argspecs -badarg $argname } } } globstring { foreach e $remaining_e { if {![regexp {[*?\[\]]} $e]} { - arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires globstring - but no glob characters detected" $argspecs -badarg $argname } } } @@ -1955,16 +2437,16 @@ tcl::namespace::eval punk::args { #dict for {checkopt checkval} $thisarg_checks {} tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::string::length $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -minlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -minsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::string::length $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires string with -maxlen $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires string with -maxsize $checkval. Received len:[tcl::string::length $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -1981,31 +2463,31 @@ tcl::namespace::eval punk::args { if {$low eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #lowside unspecified - check only high if {$e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer less than or equal to $high. Received: '$e'" $argspecs -badarg $argname } } } elseif {$high eq ""} { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #highside unspecified - check only low if {$e_check < $low} { - arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer greater than or equal to $low. Received: '$e'" $argspecs -badarg $argname } } } else { foreach e $vlist e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e'" $argspecs -badarg $argname } #high and low specified if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be integer between $low and $high inclusive. Received: '$e'" $argspecs -badarg $argname } } } @@ -2013,7 +2495,7 @@ tcl::namespace::eval punk::args { } else { foreach e_check $vlist_check { if {![tcl::string::is integer -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'integer'. Received: '$e_check'" $argspecs -badarg $argname } } } @@ -2033,7 +2515,7 @@ tcl::namespace::eval punk::args { #todo - empty string for low or high lassign $checkval low high if {$e_check < $low || $e_check > $high} { - arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] must be between $low and $high. Received: '$e'" $argspecs -badarg $argname } } } @@ -2044,28 +2526,28 @@ tcl::namespace::eval punk::args { bool { foreach e_check $vlist_check { if {![tcl::string::is boolean -strict $e_check]} { - arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'boolean'. Received: '$e_check'" $argspecs -badarg $argname } } } dict { foreach e_check $vlist_check { if {[llength $e_check] %2 != 0} { - arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'dict' - must be key value pairs. Received: '$e_check'" $argspecs -badarg $argname } if {[tcl::dict::size $thisarg_checks]} { tcl::dict::for {checkopt checkval} $thisarg_checks { switch -- $checkopt { - -minlen { + -minsize { # -1 for disable is as good as zero if {[tcl::dict::size $e_check] < $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -minlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -minsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } - -maxlen { + -maxsize { if {$checkval ne "-1"} { if {[tcl::dict::size $e_check] > $checkval} { - arg_error "Option $argname for [Get_caller] requires dict with -maxlen $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires dict with -maxsize $checkval. Received dict size:[dict size $e_check] value:'$e_check'" $argspecs -badarg $argname } } } @@ -2089,7 +2571,7 @@ tcl::namespace::eval punk::args { xdigit { foreach e $vlist e_check $vlist_check { if {![tcl::string::is $type $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e'" $argspecs -badarg $argname } } } @@ -2101,19 +2583,19 @@ tcl::namespace::eval punk::args { #//review - we may need '?' char on windows if {!([tcl::string::length $e_check]>0 && ![regexp {[\"*<>\;]} $e_check])} { #what about special file names e.g on windows NUL ? - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which doesn't look like it could be a file or directory" $argspecs -badarg $argname } } if {$type eq "existingfile"} { foreach e $vlist e_check $vlist_check { if {![file exists $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing file" $argspecs -badarg $argname } } } elseif {$type eq "existingdirectory"} { foreach e $vlist e_check $vlist_check { if {![file isdirectory $e_check]} { - arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type '$type'. Received: '$e' which is not an existing directory" $argspecs -badarg $argname } } } @@ -2121,7 +2603,7 @@ tcl::namespace::eval punk::args { char { foreach e $vlist e_check $vlist_check { if {[tcl::string::length $e_check] != 1} { - arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs $argname + arg_error "Option $argname for [Get_caller] requires type 'character'. Received: '$e' which is not a single character" $argspecs -badarg $argname } } } @@ -2161,7 +2643,14 @@ tcl::namespace::eval punk::args { #maintain order of opts $opts values $values as caller may use lassign. set receivednames [list {*}$leadernames_received {*}$flagsreceived {*}$valnames_received] - set received_posns [concat {*}[lmap a $receivednames b [zero_to_n [expr {[llength $receivednames]-1}]] {list $a $b}]] ;#flat zip named with overall posn including opts + if {[llength $receivednames]} { + #flat zip of names with overall posn, including opts + #set received_posns [concat {*}[lmap a $receivednames b [zero_based_posns [llength $receivednames]] {list $a $b}]] + set i -1 + set received_posns [concat {*}[lmap a $receivednames {list $a [incr i]}]] + } else { + set received_posns [list] + } return [tcl::dict::create leaders $leaders_dict opts $opts values $values_dict received $received_posns] } @@ -2173,7 +2662,7 @@ tcl::namespace::eval punk::args { #} - punk::args::definition { + lappend PUNKARGS [list { *id punk::args::TEST *opts -optional 0 -o1 -default 111 -help "opt 1 mandatory" @@ -2182,7 +2671,7 @@ tcl::namespace::eval punk::args { *values -min 0 -max 1 v -help\ "v1 optional" - } + }] #*** !doctools @@ -2195,8 +2684,9 @@ tcl::namespace::eval punk::args { # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::args::lib { + variable PUNKARGS tcl::namespace::export * - tcl::namespace::path [tcl::namespace::parent] + tcl::namespace::path [list [tcl::namespace::parent]] #*** !doctools #[subsection {Namespace punk::args::lib}] #[para] Secondary functions that are part of the API @@ -2209,6 +2699,284 @@ tcl::namespace::eval punk::args::lib { # return 1 #} + proc flatzip {l1 l2} { + concat {*}[lmap a $l1 b $l2 {list $a $b}] + } + + if {[info commands lseq] ne ""} { + #tcl 8.7+ lseq significantly faster, especially for larger ranges + #The internal rep can be an 'arithseries' with no string representation + proc zero_based_posns {count} { + if {$count < 1} {return} + lseq 0 $count-1 + } + } else { + proc zero_based_posns {count} { + if {$count < 1} {return} + lsearch -all [lrepeat $count 0] * + } + } + + + #experiment with equiv of js template literals with ${expression} in templates + #e.g tstr {This is the value of x in calling scope ${$x} !} + #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} + #e.g tstr -allowcommands {This is the value of [lindex $x -1] in calling scope ${[lindex [set x] 0]} !} + lappend PUNKARGS [list { + *id punk::args::lib::tstr + *proc -name punk::args::lib::tstr -help\ + "A rough equivalent of js template literals" + -allowcommands -default -1 -type none -help\ + "if -allowcommands is present, placeholder can contain commands e.g {\$\{plaintext0 [lindex $var 0] plaintext2\}}" + -return -default list -choices {dict list string args}\ + -choicelabels { + dict\ + "Return a dict with keys + 'template' and 'params'" + string\ + "Return a single result + being the string with + placeholders substituted." + list\ + "Return a 2 element list. + The first is itself a list + of plaintext portions of the + template, split at each point + at which placeholders were + present. The second element + of the outer list is a list + of placeholder values if -eval + is 1, or a list of the raw + placeholder strings if -eval + is 0." + args\ + "Return a list where the first + element is a list of template + plaintext secions as per the + 'list' return mechanism, but the + placeholder items are individual + items in the returned list. + This can be useful when passing + the expanded result of a tstr + command to another function + which expects the placeholders + as individual arguments" + } + -eval -default 1 -type boolean -help\ + "Whether to evaluate the \$\{\} placeholders. + When -return is string, -eval should generally be set to 1. + For a string return, -eval 0 will result in the raw contents of \$\{\} being substituted. + contained variables in that case should be braced, or the variable name is likely to collide + with surrounding text. + e.g tstr -return string -eval 0 {plaintext\$\{\$\{var\}\}plaintext} -> plaintext\$\{var\}plaintext" + *values -min 0 -max 1 + templatestring -help\ + "This argument should be a braced string containing placeholders such as \$\{$var\} e.g {The value is \$\{$var\}.} + where $var will be substituted from the calling context + The placeholder itself can contain plaintext portions as well as variables. + It can contain commands in square brackets if -allowcommands is true + e.g tstr -return string -allowcommands {Tcl Version:\$\{[info patch]\} etc}" + }] + + proc tstr {args} { + #Too hard to fully eat-our-own-dogfood from within punk::args package + # - we use punk::args within the unhappy path only + #set argd [punk::args::get_by_id punk::lib::tstr $args] + #set templatestring [dict get $argd values templatestring] + #set opt_allowcommands [dict get $argd opts -allowcommands] + #set opt_return [dict get $argd opts -return] + #set opt_eval [dict get $argd opts -eval] + + set templatestring [lindex $args end] + set arglist [lrange $args 0 end-1] + set opts [dict create\ + -allowcommands 0\ + -eval 1\ + -return list\ + ] + if {"-allowcommands" in $arglist} { + set arglist [::punk::args::system::punklib_ldiff $arglist -allowcommands] + dict set opts -allowcommands 1 + } + if {[llength $arglist] % 2 != 0} { + error "punk::args::lib::tstr expected option/value pairs prior to last argument" + } + dict for {k v} $arglist { + set fullk [tcl::prefix::match -error "" {-allowcommands -return -eval} $k] + switch -- $fullk { + -return - -eval { + dict set opts $fullk $v + } + default { + error "punk::args::lib::tstr unknown option $k. Known options: [dict keys $opts]" + } + } + } + set opt_allowcommands [dict get $opts -allowcommands] + set opt_return [dict get $opts -return] + set opt_eval [dict get $opts -eval] + + + set nocommands "-nocommands" + if {$opt_allowcommands == 1} { + set nocommands "" + } + + #set parts [_tstr_split $templatestring] + if {[string first \$\{ $templatestring] < 0} { + set parts [list $templatestring] + } else { + set parts [_parse_tstr_parts $templatestring] + } + set textchunks [list] + #set expressions [list] + set params [list] + set idx 0 + foreach {pt expression} $parts { + lappend textchunks $pt + incr idx ;#pt incr + + #ignore last expression + if {$idx == [llength $parts]} { + break + } + #lappend expressions $expression + if {$opt_eval} { + lappend params [uplevel 1 [list ::subst {*}$nocommands $expression]] + } else { + lappend params $expression + } + + incr idx ;#expression incr + } + switch -- $opt_return { + dict { + return [dict create template $textchunks params $params] + } + list { + return [list $textchunks $params] + } + args { + #see example in tstr_test_one + return [list $textchunks {*}$params] + } + string { + set out "" + foreach pt $textchunks param $params { + append out $pt $param + } + return $out + } + default { + } + } + } + #test single placeholder tstr args where single placeholder must be an int + proc tstr_test_one {args} { + set argd [punk::args::get_dict { + *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. + example: + set id 2 + tstr_test_one {*}[tstr -return args {Select * from table where id = \$\{$id\} and etc... ;}] + } + + *values -min 2 -max 2 + template -type list -minsize 2 -maxsize 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - + but the tstr call in the example does this for you, and also passes in the id automatically" + + where -type int -help {Integer param for where clause. tstr mechanism above will pass the id as the second parameter} + } $args] + set template [dict get $argd values template] + set where [dict get $argd values where] + #set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] + set result [string cat [lindex $template 0] $where [lindex $template 1]] + return $result + } + proc _parse_tstr_parts {templatestring} { + if {$templatestring eq ""} { + return [list] + } + set chars [split $templatestring ""] + set in_placeholder 0 + set tchars "" + set echars "" + set parts [list] + set i 0 + foreach ch $chars { + if {!$in_placeholder} { + set nextch [lindex $chars [expr {$i+1}]] + if {"$ch$nextch" eq "\$\{"} { + set in_placeholder 2 ;#2 to signify we just entered placeholder + lappend parts $tchars + set tchars "" + } else { + append tchars $ch + } + } else { + if {$ch eq "\}"} { + if {[tcl::info::complete $echars]} { + set in_placeholder 0 + lappend parts $echars + set echars "" + } else { + append echars $ch + } + } else { + if {$in_placeholder == 2} { + #skip opening bracket + set in_placeholder 1 + } else { + append echars $ch + } + } + } + incr i + } + if {$tchars ne ""} { + lappend parts $tchars + } + if {[llength $parts] % 2 == 0} { + #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list + lappend parts "" + } + return $parts + } + #based on punk::ansi::ta::_perlish_split + proc _tstr_split {text} { + if {$text eq ""} { + return {} + } + set list [list] + set start 0 + #ideally re should allow curlies within but we will probably need a custom parser to do it + #(js allows nested string interpolation) + #set re {\$\{[^\}]*\}} + set re {\$\{(?:(?!\$\{).)*\}} + + #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code + + #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW + while {[regexp -start $start -indices -- $re $text match]} { + lassign $match matchStart matchEnd + #puts "->start $start ->match $matchStart $matchEnd" + if {$matchEnd < $matchStart} { + puts "e:$matchEnd < s:$matchStart" + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] + incr start + if {$start >= [tcl::string::length $text]} { + break + } + continue + } + lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] + set start [expr {$matchEnd+1}] + #? + if {$start >= [tcl::string::length $text]} { + break + } + } + return [lappend list [tcl::string::range $text $start end]] + } #*** !doctools @@ -2216,7 +2984,21 @@ tcl::namespace::eval punk::args::lib { } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#usually we would directly call arg definitions near the defining proc, +# so that the proc could directly use the definition in its parsing. +# +#for punk::args we need to make sure the punk::args namespace is fully loaded before calling, so we do it at the end. +#arguably it may be more processor-cache-efficient to do together like this anyway. + +#can't do this - as there is circular dependency with punk::lib +#tcl::namespace::eval punk::args { +# foreach deflist $PUNKARGS { +# punk::args::definition {*}$deflist +# } +# set PUNKARGS "" +#} +lappend ::punk::args::register::NAMESPACES ::punk::args ::punk::args::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools @@ -2226,12 +3008,40 @@ tcl::namespace::eval punk::args::system { #[subsection {Namespace punk::args::system}] #[para] Internal functions that are not part of the API + #dict get value with default wrapper for tcl 8.6 + if {[info commands ::tcl::dict::getdef] eq ""} { + #package require punk::lib + #interp alias "" ::punk::args::Dict_getdef "" ::punk::lib::dict_getdef + proc Dict_getdef {dictValue args} { + set keys [lrange $args 0 end-1] + if {[tcl::dict::exists $dictValue {*}$keys]} { + return [tcl::dict::get $dictValue {*}$keys] + } else { + return [lindex $args end] + } + } + } else { + #we pay a minor perf penalty for the wrap + interp alias "" ::punk::args::system::Dict_getdef "" ::tcl::dict::getdef + } + #name to reflect maintenance - home is punk::lib::ldiff + proc punklib_ldiff {fromlist removeitems} { + if {[llength $removeitems] == 0} {return $fromlist} + set result {} + foreach item $fromlist { + if {$item ni $removeitems} { + lappend result $item + } + } + return $result + } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::args [tcl::namespace::eval punk::args { + tcl::namespace::path {::punk::args::lib ::punk::args::system} variable pkg punk::args variable version set version 0.1.0 diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm new file mode 100644 index 00000000..018f1d0d --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/punk/args/tclcore-0.1.0.tm @@ -0,0 +1,700 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: punkshell/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 punk::args::tclcore 0.1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin punkshell_module_punk::args::tclcore 0 0.1.0] +#[copyright "2025"] +#[titledesc {punk::args definitions for tcl core commands}] [comment {-- Name section and table of contents description --}] +#[moddesc {tcl core argument definitions}] [comment {-- Description at end of page heading --}] +#[require punk::args::tclcore] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::args::tclcore +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::args::tclcore +#[list_begin itemized] + +package require Tcl 8.6- +package require punk::args +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package {punk::args}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::args::tclcore::class { + #*** !doctools + #[subsection {Namespace punk::args::tclcore::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::tclcore { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + #variable xyz + + #for tcllib - we can potentially parse the doctools to get this info. + #for tcl core commands - the data is stored in man pages - which are not so easy to parse. + #todo - link to man pages + + + #TODO - + #if we want colour in arg definitions -we need to respect nocolor or change colour to off/ on + #If color included in a definition - it will need to be reloaded when colour toggled(?) + #if {[catch {package require punk::ansi}]} { + # set has_punkansi 0 + # set A_WARN "" + # set A_RST "" + #} else { + # set has_punkansi 1 + # set A_WARN [a+ red] + # set A_RST "\x1b\[0m" + #} + + #we can't just strip ansi as there are non colour codes such as hyperlink that should be maintained whether color is on or off. + #for now we can use reverse - (like underline, is a non-colour attribute that remains effective when color off in punk::ansi) + set A_WARN \x1b\[7m + set A_RST \x1b\[0m + + variable manbase_tcl + variable manbase_ext + set patch [info patchlevel] + lassign [split $patch .] major + if {$major < 9} { + set manbase_tcl "https://tcl.tk/man/tcl/TclCmd" + set manbase_ext .htm + } else { + set manbase_tcl "https://tcl.tk/man/tcl9.0/TclCmd" + set manbase_ext .html + } + proc manpage_tcl {cmd} { + variable manbase_tcl + variable manbase_ext + return ${manbase_tcl}/${cmd}${manbase_ext} + } + + variable PUNKARGS + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + # library commands loaded via auto_index + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + lappend PUNKARGS [list { + *id parray + *proc -name "Builtin: parray" -help\ + "Prints on standard output the names and values of all the elements in the + array arrayName, or just the names that match pattern (using the matching + rules of string_match) and their values if pattern is given. + ArrayName must be an array accessible to the caller of parray. It may either + be local or global. The result of this command is the empty string. + (loaded via auto_index)" + *values -min 1 -max 2 + arrayName -type string -help\ + "variable name of an array" + pattern -type string -optional 1 -help\ + "Match pattern possibly containing glob characters" + } "*doc -name Manpage: -url [manpage_tcl library]" ] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + + lappend PUNKARGS [list { + *id time + *proc -name "Builtin: time" -help\ + "Calls the Tcl interpreter count times to evaluate script + (or once if count is not specified). It will then return + a string of the form + 503.2 microseconds per iteration + which indicates the average amount of time required per + iteration, in microseconds. Time is measured in elapsed + time, not CPU time. + (see also: timerate)" + *values -min 1 -max 2 + script -type script + count -type integer -default 1 -optional 1 + } "*doc -name Manpage: -url [manpage_tcl time]" ] + + lappend PUNKARGS [list { + *id tcl::namespace::path + *proc -name "Builtin: tcl::namespace::path" -help\ + "Returns the command resolution path of the current namespace. + If namespaceList is specified as a list of named namespaces, the current + namespace's command resolution path is set to those namespaces and returns + the empty list. The default command resolution path is always empty. + See the section NAME_RESOLUTION in the manpage for an explanation of the + rules regarding name resolution." + *values -min 0 -max 1 + namespaceList -type list -optional 1 -help\ + "List of existing namespaces" + } "*doc -name Manpage: -url [manpage_tcl namespace]" ] + + lappend PUNKARGS [list { + *id tcl::namespace::unknown + *proc -name "Builtin: tcl::namespace::unknown" -help\ + "Sets or returns the unknown command handler for the current namespace. + The handler is invoked when a command called from within the namespace cannot + be found in the current namespace, the namespace's path nor in the global + namespace. + " + *values -min 0 -max 1 + script -type script -optional 1 -help\ + "A well formed list representing a command name and " + } "*doc -name Manpage: -url [manpage_tcl namespace]" ] + + lappend PUNKARGS [list { + *id lappend + *proc -name "builtin: lappend" -help\ + "Append list elements onto a variable. + " + *values -min 1 -max -1 + varName -type string -help\ + "variable name" + value -type any -optional 1 -multiple 1 + } "*doc -name Manpage: -url [manpage_tcl lappend]"] + + punk::args::definition { + *id ledit + *proc -name "builtin: ledit" -help\ + "Replace elements of a list stored in variable + " + *values -min 3 -max -1 + listVar -type string -help\ + "Existing list variable name" + first -type indexexpression + last -type indexexpression + value -type any -optional 1 -multiple 1 + } "*doc -name Manpage: -url [manpage_tcl ledit]" + + punk::args::definition { + *id lpop + *proc -name "builtin: lpop" -help\ + "Get and remove an element in a list + " + *values -min 1 -max -1 + varName -type string -help\ + "Existing list variable name" + index -type indexexpression -default end -optional 1 -multiple 1 -help\ + "When presented with a single index, the lpop command addresses + the index'th element in it, removes it from the list and returns + the element. + If index is negative or greater or equal than the number of + elements in the list in the variable called varName, an error occurs. + If addition index arguments are supplied, then each argument is used + in turn to address an element within a sublist designated by the + previous indexing operation, allowing the script to remove elements + in sublists, similar to lindex and lset." + } "*doc -name Manpage: -url [manpage_tcl lpop]" + + punk::args::definition { + *id lrange + *proc -name "builtin: lrange" -help\ + "return one or more adjacent elements from a list. + The new list returned consists of elements first through last, inclusive. + The index values first and last are interpreted the same as index values + for the command 'string index', supporting simple index arithmetic and + indices relative to the end of the list. + e.g lrange {a b c} 0 end-1 + " + *values -min 3 -max 3 + list -type list -help\ + "tcl list as a value" + first -help\ + "index expression for first element" + last -help\ + "index expression for last element" + } "*doc -name Manpage: -url [manpage_tcl lrange]" + + + punk::args::definition { + *id tcl::string::cat + + *proc -name "builtin: tcl::string::cat" -help\ + "Concatente the given strings just like placing them directly next to each other and + return the resulting compound string. If no strings are present, the result is an + empty string. + This primitive is occasionally handier than juxtaposition of strings when mixed quoting + is wanted, or when the aim is to return the result of a concatentation without resorting + to return -level 0, and is more efficient than building a list of arguments and using + join with an empty join string." + + *values -min 0 -max -1 + string -type string -optional 1 -multiple 1 + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::compare + + *proc -name "builtin: tcl::string::compare" -help\ + "Perform a character-by-character comparison of strings string1 and string2. + Returns -1, 0, or 1, dpending on whether string1 is lexicographically + lessthan, equal to, or greater than string2" + + -nocase -type none -help\ + "If -nocase is specified, then the strings are compared in a case insensitive manner." + + -length -type integer -help\ + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." + + *values -min 2 -max 2 + string1 -type string + string2 -type string + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::equal + + *proc -name "builtin: tcl::string::equal" -help\ + "Perform a character-by-character comparison of strings string1 and string2. + Returns 1 if string1 and string2 are identical, or 0 when not." + + -nocase -type none -help\ + "If -nocase is specified, then the strings are compared in a case insensitive manner." + + -length -type integer -help\ + "If -length is specified, then only the first length characters are used in the comparison. + If -length is negative, it is ignored." + + *values -min 2 -max 2 + string1 -type string + string2 -type string + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::first + *proc -name "builtin: tcl::string::first" -help\ + "Search haystackString for a sequence of characters that exactly match the characters + in needleString. If found, return the index of the first character in the first such + match within haystackString. If there is no match, then return -1. If startIndex is + specified (in any of the forms described in STRING_INDICES), then the search is + constrained to start with the character in haystackString specified by the index. + " + *values -min 2 -max 3 + needleString -type string + haystackString -type string + startIndex -type indexexpression -optional 1 -help\ + "integer or simple expression." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::insert + *proc -name "builtin: tcl::string::insert" -help\ + "Returns a copy of string with insertString inserted at the index'th character. + If index is start-relative, the first character inserted in the returned string will be + at the specified index. + If index is end-relative, the last character inserted in the returned string will be + at the specified index. + if index is at or before the start of string (e.g., index is 0), insertString is + prepended to the string. + If index is at or after the end of the string (e.g., index is end), insertString is + appended to string." + + *values -min 3 -max 3 + string -type string + index -type indexexpression -help\ + "The index may be specified as described in the STRING_INDICES section" + insertString -type string + } "*doc -name Manpage: -url [manpage_tcl string]" + + + punk::args::definition { + *id tcl::string::last + *proc -name "builtin: tcl::string::last" -help\ + "Search haystackString for a sequence of characters that exactly match the characters + in needleString. If found, return the index of the first character in the last such + match within haystackString. If there is no match, then return -1. If lastIndex is + specified (in any of the forms described in STRING_INDICES), then only the characters + in haystackString at or before the specified lastIndex will be considered by the search + " + *values -min 2 -max 3 + needleString -type string + haystackString -type string + lastIndex -type indexexpression -optional 1 -help\ + "integer or simple expression." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::repeat + *proc -name "builtin: tcl::string::repeat" -help\ + "Returns a string consisting of string concatenated with itself count times." + *values -min 2 -max 2 + string -type string + count -type int -help\ + "If count is 0, the empty string will be returned." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::replace + *proc -name "builtin: tcl::string::replace" -help\ + "Removes a range of consecutive characters from string, starting with the character whose + index is first and ending with the character whose index is last + (Using the forms described in STRING_INDICES). An index of 0 refers to the first + character of the string. First and last may be specified as for the index method. + If first is less than zero then it is treated as if it were zero, and if last is + greater than or equal to the length of the string then it is treated as if it were + end. The initial string is returned untouched, if first is greater than last, or if + first is equal to or greater than the length of the inital string, or last is less + than 0." + *values -min 3 -max 3 + string -type string + first -type indexexpression + last -type indexexpression + newstring -type string -optional 1 -help\ + "If newstring is specified, then it is placed in the removed character range." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::totitle + *proc -name "builtin: tcl::string::totitle" -help\ + "Returns a value equal to string except that the first character in string is converted to + it's Unicode title case variant (or upper case if there is no title case variant) and the + rest of the string is converted to lower case." + + *values -min 1 -max 1 + string -type string + first -type indexexpression -optional 1 -help\ + "If first is specified, it refers to the first char index in the string to start modifying." + last -type indexexpression -optional 1 -help\ + "If last is specified, it refers to the char index in the string to stop at (inclusive)." + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::wordend + *proc -name "builtin: tcl::string::wordend" -help\ + "Returns the index of the character just after the last one in the word containing + character charIndex of string. + A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) + or underscore (Unicode connector punctuation) characters, or any single character other than these." + *values -min 2 -max 2 + string -type string + charIndex -type indexexpression -help\ + "integer or simple expresssion. + e.g end + e.g end-1 + e.g M+N" + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition { + *id tcl::string::wordstart + *proc -name "builtin: tcl::string::wordstart" -help\ + "Returns the index of the first character in the word containing + character charIndex of string. + A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) + or underscore (Unicode connector punctuation) characters, or any single character other than these. + " + *values -min 2 -max 2 + string -type string + charIndex -type indexexpression -help\ + "integer or simple expresssion. + e.g end + e.g end-1 + e.g M+N" + } "*doc -name Manpage: -url [manpage_tcl string]" + + punk::args::definition [punk::lib::tstr -return string { + *id tcl::string::is + *proc -name "builtin: tcl::string::is" -help\ + "Returns 1 if string is a valid member of the specified character class, otherwise returns 0. + " + *leaders -min 1 -max 1 + class -type string\ + -choices { + alnum + alpha + ascii + boolean + control + dict + digit + double + entier + false + graph + integer + list + lower + print + punct + space + true + upper + wideinteger + wordchar + xdigit + }\ + -choicelabels { + alnum\ + " Any Unicode alphabet + or digit character" + alpha\ + " Any Unicode alphabet + character" + ascii\ + " Any character with + a value less than \\u0080 + (those that are in the + 7-bit ascii range)" + boolean\ + " Any of the forms allowed + to Tcl_GetBoolean" + control\ + " Any Unicode control char" + dict\ + " Any proper dict structure, + with optional surrounding + whitespace. In case of + improper dict structure, 0 + is returned and the varname + will contain the index of + the \"element\" where the + dict parsing fails or -1 if + this cannot be determined." + digit\ + " Any Unicode digit char. + Note that this includes + chars outside of the \[0-9\] + range." + double\ + " Any of the forms allowed + to Tcl_GetDoubleFromObj. + ${$A_WARN}With optional surrounding${$A_RST} + ${$A_WARN}whitespace.${$A_RST}" + entier\ + " Synonym for integer" + false\ + " Any of the forms allowed + to Tcl_GetBoolean where the + value is false" + graph\ + " Any Unicode printing char + except space." + integer\ + " Any of the valid string + formats for an integer value + of arbitrary size in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. The formats + accepted are exactly those + accepted by the C routine + Tcl_GetBignumFromObj." + list\ + " Any proper list structure, + with optional surrounding + whitespace. In case of + improper list structure, 0 + is returned and the varname + will contain the index of + the \"element\" where list + parsing fails, or -1 if + this cannot be determined" + lower\ + " Any Unicode lower case + alphabet character" + print\ + " Any Unicode printing + character, including space" + punct\ + " Any Unicode punctuation + character." + space\ + " Any Unicode whitespace + character, mongolian vowel + separator (U+180e), + zero width space (U+200b), + word joiner (U+2060) or + zero width no-break space + (U+feff) (=BOM)" + true\ + " Any of the forms allowed + to Tcl_GetBoolean where the + value is true" + upper\ + " Any upper case alphabet + character in the Unicode + character set" + wideinteger\ + " Any of the valid forms + for a wide integer in Tcl, + ${$A_WARN}with optional surrounding${$A_RST} + ${$A_WARN}whitespace${$A_RST}. In case of + overflow in the value, 0 is + returned and the varname + will contain -1." + wordchar\ + " Any Unicode word char. + That is any alphanumeric + character, and any + Unicode connector + punctuation characters + (e.g. underscore)" + xdigit\ + " Any hexadecimal digit + character, and any Unicode + connector punctuation + characters (e.g. underscore)" + + }\ + -help\ + "character class + In the case of boolean, true and false, if the function will return 0, then the + varname will always be set to 0, due to the varied nature of a valid boolean value" + + -strict -type none -help\ + "If -strictis specified, then an empty string returns 0, + otherwise an empty string will return 1 on any class" + -failindex -type variablename -help\ + "If -failindex is specified, then if the function returns 0, + the index in the string where the class was no longer valid will be stored + in the variable named." + *values -min 1 -max 1 + string -type string -optional 0 + }] "*doc -name Manpage: -url [manpage_tcl string]" + + if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } + } + lappend ::punk::args::register::NAMESPACES ::punk::args::tclcore + + #*** !doctools + #[subsection {Namespace punk::args::tclcore}] + #[para] Core API functions for punk::args::tclcore + #[list_begin definitions] + + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::tclcore ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::args::tclcore::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::args::tclcore::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::args::tclcore::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +#tcl::namespace::eval punk::args::tclcore::system { + #*** !doctools + #[subsection {Namespace punk::args::tclcore::system}] + #[para] Internal functions that are not part of the API + + + +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::args::tclcore [tcl::namespace::eval punk::args::tclcore { + variable pkg punk::args::tclcore + variable version + set version 0.1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm index a8cdad9e..be4a5cf1 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/blockletter-0.1.0.tm @@ -119,17 +119,18 @@ tcl::namespace::eval punk::blockletter { set logo_letter_colours [list Web-red Web-green Web-royalblue Web-purple Web-orange] set logo_letter_colours [list Red Green Blue Purple Yellow] - + punk::args::definition [tstr -return string { + *id punk::blockletter::logo + -frametype -default {${$default_frametype}} + -outlinecolour -default "web-white" + -backgroundcolour -default {} -help "e.g Web-white + This argument is the name as accepted by punk::ansi::a+" + *values -min 0 -max 0 + }] proc logo {args} { variable logo_letter_colours variable default_frametype - set argd [punk::args::get_dict [tstr -return string { - -frametype -default {${$default_frametype}} - -outlinecolour -default "web-white" - -backgroundcolour -default {} -help "e.g Web-white - This argument is the name as accepted by punk::ansi::a+" - *values -min 0 -max 0 - }] $args] + set argd [punk::args::get_by_id punk::blockletter::logo $args] set f [dict get $argd opts -frametype] set bd [dict get $argd opts -outlinecolour] set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary @@ -217,17 +218,18 @@ tcl::namespace::eval punk::blockletter { append out [textblock::join_basic -- $left $centre $right] } + punk::args::definition [tstr -return string { + *id punk::blockletter::text + -bgcolour -default "Web-red" + -bordercolour -default "web-white" + -frametype -default {${$default_frametype}} + *values -min 1 -max 1 + str -help "Text to convert to blockletters + Requires terminal font to support relevant block characters" + " + }] proc text {args} { - variable default_frametype - set argd [punk::args::get_dict [tstr -return string { - -bgcolour -default "Web-red" - -bordercolour -default "web-white" - -frametype -default {${$default_frametype}} - *values -min 1 -max 1 - str -help "Text to convert to blockletters - Requires terminal font to support relevant block characters" - " - }] $args] + set argd [punk::args::get_by_id punk::blockletter::text $args] set opts [dict get $argd opts] set str [dict get $argd values str] set str [string map {\r\n \n} $str] @@ -277,16 +279,19 @@ tcl::namespace::eval punk::blockletter::lib { # return 1 #} + + punk::args::definition [tstr -return string { + *id punk::blockletter::block + -height -default 2 + -width -default 4 + -frametype -default {${$::punk::blockletter::default_frametype}} + -bgcolour -default "Web-red" + -bordercolour -default "web-white" + *values -min 0 -max 0 + }] proc block {args} { upvar ::punk::blockletter::default_frametype ft - set argd [punk::args::get_dict [tstr -return string { - -height -default 2 - -width -default 4 - -frametype -default {${$ft}} - -bgcolour -default "Web-red" - -bordercolour -default "web-white" - *values -min 0 -max 0 - }] $args] + set argd [punk::args::get_by_id punk::blockletter::block $args] set bg [dict get $argd opts -bgcolour] set bd [dict get $argd opts -bordercolour] set h [dict get $argd opts -height] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/config-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/config-0.1.tm index 1e4de9ec..493ea5aa 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/config-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/config-0.1.tm @@ -361,11 +361,14 @@ tcl::namespace::eval punk::config { } proc configure {args} { - set argd [punk::args::get_dict { + set argdef { + *id punk::config::configure + *proc -name punk::config::configure -help\ + "UNIMPLEMENTED" *values -min 1 -max 1 whichconfig -type string -choices {startup running stop} - } $args] - + } + set argd [punk::args::get_dict $argdef $args] return "unimplemented - $argd" } @@ -375,6 +378,8 @@ tcl::namespace::eval punk::config { return [punk::lib::showdict $configdata] } + + #e.g # copy running-config startup-config # copy startup-config test-config.cfg @@ -382,16 +387,22 @@ tcl::namespace::eval punk::config { #review - consider the merge vs overwrite feature of some routers.. where copy to running-config does a merge rather than an overwrite #This is to allow partial configs to be loaded to running, whereas a save of running to any target is always a complete configuration proc copy {args} { - set argd [punk::args::get_dict { - *proc -name punk::config::copy -help "Copy a partial or full configuration from one config to another - If a target config has additional settings, then the source config can be considered to be partial with regards to the target. - " - -type -default "" -choices {replace merge} -help "Defaults to merge when target is running-config - Defaults to replace when source is running-config" + set argdef { + *id punk::config::copy + *proc -name punk::config::copy -help\ + "Copy a partial or full configuration from one config to another + If a target config has additional settings, then the source config can be considered to be partial with regards to the target. + " + -type -default "" -choices {replace merge} -help\ + "Defaults to merge when target is running-config + Defaults to replace when source is running-config" *values -min 2 -max 2 - fromconfig -help "running or startup or file name (not fully implemented)" - toconfig -help "running or startup or file name (not fully implemented)" - } $args] + fromconfig -help\ + "running or startup or file name (not fully implemented)" + toconfig -help\ + "running or startup or file name (not fully implemented)" + } + set argd [punk::args::get_dict $argdef $args] set fromconfig [dict get $argd values fromconfig] set toconfig [dict get $argd values toconfig] set fromconfig [string map {-config ""} $fromconfig] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm index 74ee55fd..c4f2bfc4 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm @@ -81,6 +81,8 @@ namespace eval punk::console { #*** !doctools #[list_begin definitions] + variable PUNKARGS + variable tabwidth 8 ;#default only - will attempt to detect and set to that configured in terminal #Note that windows terminal cooked mode seems to use 8 for interactive use even if set differently #e.g typing tab characters may still be echoed 8-spaced while writing to stdout my obey the terminal's tab stops. @@ -1187,7 +1189,8 @@ namespace eval punk::console { *id punk::console::cell_size -inoutchannels -default {stdin stdout} -type list *values -min 0 -max 1 - newsize -default "" + newsize -default "" -help\ + "character cell pixel dimensions WxH" } proc cell_size {args} { set argd [punk::args::get_by_id punk::console::cell_size $args] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/fileline-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/fileline-0.1.0.tm index 59ca4d5b..04f3487b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/fileline-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/fileline-0.1.0.tm @@ -1251,6 +1251,16 @@ namespace eval punk::fileline { #[para] Core API functions for punk::fileline #[list_begin definitions] + punk::args::definition { + *id punk::fileline::get_textinfo + *proc -name punk::fileline::get_textinfo -help\ + "return: textinfo object instance" + -file -default {} -type existingfile + -translation -default iso8859-1 + -encoding -default "\uFFFF" + -includebom -default 0 + *values -min 0 -max 1 + } proc get_textinfo {args} { #*** !doctools #[call get_textinfo [opt {option value...}] [opt datachunk]] @@ -1266,14 +1276,7 @@ namespace eval punk::fileline { #[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data. #[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes. - set argument_specification { - -file -default {} -type existingfile - -translation -default iso8859-1 - -encoding -default "\uFFFF" - -includebom -default 0 - *values -min 0 -max 1 - } - lassign [dict values [punk::args::get_dict $argument_specification $args]] opts values + lassign [dict values [punk::args::get_by_id punk::fileline::get_textinfo $args]] opts values # -- --- --- --- set opt_file [dict get $opts -file] set opt_translation [dict get $opts -translation] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm index ae0f0a67..9ebd2ca2 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/lib-0.1.1.tm @@ -48,8 +48,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -140,7 +142,7 @@ tcl::namespace::eval punk::lib::check { proc has_tclbug_lsearch_strideallinline {} { #bug only occurs with single -index value combined with -stride -all -inline -subindices #https://core.tcl-lang.org/tcl/tktview/5a1aaa201d - if {[catch {[lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *]} result]} { + if {[catch {lsearch -stride 3 -all -inline -index 1 -subindices {a1 a2 a3} *} result]} { #we aren't looking for an error result - error most likely indicates tcl too old to support -stride return 0 } @@ -320,7 +322,7 @@ tcl::namespace::eval punk::lib::compat { if {"::lmap" ne [info commands ::lmap]} { #puts stderr "Warning - no built-in lpop" - interp alias {} lpop {} ::punk::lib::compat::lmaptcl + interp alias {} lmap {} ::punk::lib::compat::lmaptcl } #lmap came in Tcl 8.6 - so probably not much need for a tcl forward compatibility version - but here it is anyway proc lmaptcl {varnames list script} { @@ -384,6 +386,7 @@ tcl::namespace::eval punk::lib::compat { # Base namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::lib { + variable PUNKARGS tcl::namespace::export * variable has_struct_list set has_struct_list [expr {![catch {package require struct::list}]}] @@ -956,172 +959,9 @@ namespace eval punk::lib { proc lzipn {args} [info body ::punk::lib::lzipn_tcl9a] } - #experiment with equiv of js template literals with ${expression} in templates - #e.g tstr {This is the value of x in calling scope ${$x} !} - #e.g tstr -allowcommands {This is the value of x in calling scope ${[set x]} !} - #e.g tstr -allowcommands {This is the value of [lindex $x 0] in calling scope ${[lindex [set x] 0]} !} - proc tstr {args} { - set argd [punk::args::get_dict { - *proc -name punk::lib::tstr -help "A rough equivalent of js template literals" - -allowcommands -default 0 -type none -help "if -allowcommands is true placeholder can contain commands e.g {${plaintext1 [lindex $var 0] plaintext2}}" - -return -default list -choices {dict list string} - *values -min 1 -max 1 - templatestring -help "This argument should be a braced string containing placeholders such as ${$var} e.g {The value is ${$var}} - where $var will be substituted from the calling context - The placeholder itself can contain plaintext portions as well as variables. - It can contain commands in square brackets if -allowcommands is true" - } $args] - set templatestring [dict get $argd values templatestring] - set opt_allowcommands [dict get $argd opts -allowcommands] - set opt_return [dict get $argd opts -return] - set nocommands "-nocommands" - if {$opt_allowcommands == 1} { - set nocommands "" - } - - #set parts [_tstr_split $templatestring] - set parts [_parse_tstr_parts $templatestring] - set textchunks [list] - #set expressions [list] - set params [list] - set idx 0 - foreach {pt expression} $parts { - lappend textchunks $pt - incr idx ;#pt incr - - #ignore last expression - if {$idx == [llength $parts]} { - break - } - #lappend expressions $expression - lappend params [uplevel 1 [list subst {*}$nocommands $expression]] - - incr idx ;#expression incr - } - switch -- $opt_return { - dict { - return [dict create template $textchunks params $params] - } - list { - return [list $textchunks {*}$params] - } - string { - set out "" - foreach pt $textchunks param $params { - append out $pt $param - } - return $out - } - default { - } - } - } - #test single placeholder tstr args where single placeholder must be an int - proc tstr_test_one {args} { - set argd [punk::args::get_dict { - *proc -name tstr_test_one -help {An example/test of a function designed to be called with a js-style curly-braced Tstr. - example: - set id 2 - tstr_test_one {*}[Tstr {Select * from table where id = ${$id} and etc... ;}] - } - - *values -min 2 -max 2 - template -type list -minlen 2 -maxlen 2 -help "This could be supplied directly as a 2 element list of each half of the sql statement - - but the Tstr method above does this for you, and also passes in the id automatically" - - where -type int -help {Integer param for where clause. Tstr mechanism above will pass the id as the second parameter} - } $args] - set template [dict get $argd values template] - set where [dict get $argd values where] - set result [join [list [lindex $template 0] $where [lindex $template 1]] ""] - return $result - } - proc _parse_tstr_parts {templatestring} { - if {$templatestring eq ""} { - return [list] - } - set chars [split $templatestring ""] - set in_placeholder 0 - set tchars "" - set echars "" - set parts [list] - set i 0 - foreach ch $chars { - if {!$in_placeholder} { - set nextch [lindex $chars [expr {$i+1}]] - if {"$ch$nextch" eq "\$\{"} { - set in_placeholder 2 ;#2 to signify we just entered placeholder - lappend parts $tchars - set tchars "" - } else { - append tchars $ch - } - } else { - if {$ch eq "\}"} { - if {[tcl::info::complete $echars]} { - set in_placeholder 0 - lappend parts $echars - set echars "" - } else { - append echars $ch - } - } else { - if {$in_placeholder == 2} { - #skip opening bracket - set in_placeholder 1 - } else { - append echars $ch - } - } - } - incr i - } - if {$tchars ne ""} { - lappend parts $tchars - } - if {[llength $parts] % 2 == 0} { - #always trail with pt for consistency with _perlish_split method so we can test other mechanisms with odd-length pt/code../pt style list - lappend parts "" - } - return $parts - } - #based on punk::ansi::ta::_perlish_split - proc _tstr_split {text} { - if {$text eq ""} { - return {} - } - set list [list] - set start 0 - #ideally re should allow curlies within but we will probably need a custom parser to do it - #(js allows nested string interpolation) - #set re {\$\{[^\}]*\}} - set re {\$\{(?:(?!\$\{).)*\}} - - #eg regexp {\x1b(?:\(0(?:(?:(?!\x1b\(B).)*\x1b\(B)|\)0(?:(?:(?!\x1b\)B).)*\x1b\)B))} $code - - #We can get $matchEnd < $matchStart; we need to ensure there is an exit condition for non-greedy empty results REVIEW - while {[regexp -start $start -indices -- $re $text match]} { - lassign $match matchStart matchEnd - #puts "->start $start ->match $matchStart $matchEnd" - if {$matchEnd < $matchStart} { - puts "e:$matchEnd < s:$matchStart" - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::index $text $matchStart] - incr start - if {$start >= [tcl::string::length $text]} { - break - } - continue - } - lappend list [tcl::string::range $text $start $matchStart-1] [tcl::string::range $text $matchStart+2 $matchEnd-1] - set start [expr {$matchEnd+1}] - #? - if {$start >= [tcl::string::length $text]} { - break - } - } - return [lappend list [tcl::string::range $text $start end]] - } - + + namespace import ::punk::args::lib::tstr + #get info about punk nestindex key ie type: list,dict,undetermined proc nestindex_info {args} { set argd [punk::args::get_dict { @@ -1184,8 +1024,11 @@ namespace eval punk::lib { set sep " [punk::ansi::a+ Green]=[punk::ansi::a] " } set argspec [string map [list %sep% $sep] { - *proc -name pdict -help {Print dict keys,values to channel - (see also showdict)} + *id punk::lib::pdict + *proc -name pdict -help\ + "Print dict keys,values to channel + The pdict function operates on variable names - passing the value to the showdict function which operates on values + (see also showdict)" *opts -any 1 @@ -1222,7 +1065,6 @@ namespace eval punk::lib { The second level segement in each pattern switches to a dict operation to retrieve the value by key. When a list operation such as @* is used - integer list indexes are displayed on the left side of the = for that hierarchy level. - The pdict function operates on variable names - passing the value to the showdict function which operates on values } }] #puts stderr "$argspec" @@ -1282,7 +1124,7 @@ namespace eval punk::lib { -ansibase_keys -default "" -help "ansi list for each level in -substructure. e.g \[list \[a+ red\] \[a+ web-green\]\]" -substructure -default {} -ansibase_values -default "" - -keytemplates -default {${$key}} -type list -help "list of templates for keys at each level" + -keytemplates -default {\$\{$key\}} -type list -help "list of templates for keys at each level" -keysorttype -default "none" -choices {none dictionary ascii integer real} -keysortdirection -default increasing -choices {increasing decreasing} *values -min 1 -max -1 @@ -1295,6 +1137,7 @@ namespace eval punk::lib { set opt_keysortdirection [dict get $argd opts -keysortdirection] set opt_trimright [dict get $argd opts -trimright] set opt_keytemplates [dict get $argd opts -keytemplates] + puts stderr "---> $opt_keytemplates <---" set opt_ansibase_keys [dict get $argd opts -ansibase_keys] set opt_ansibase_values [dict get $argd opts -ansibase_values] set opt_return [dict get $argd opts -return] @@ -4272,6 +4115,13 @@ tcl::namespace::eval punk::lib::system { #*** !doctools #[list_end] [comment {--- end definitions namespace punk::lib::system ---}] } + +if {![info exists ::punk::args::register::NAMESPACES]} { + namespace eval ::punk::args::register { + set ::punk::args::register::NAMESPACES [list] ;#use fully qualified so 8.6 doesn't find existing var in global namespace + } +} +lappend ::punk::args::register::NAMESPACES ::punk::lib # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::lib [tcl::namespace::eval punk::lib { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm index 26bca4d5..a31da91a 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/layout-0.1.0.tm @@ -35,7 +35,7 @@ namespace eval punk::mix::commandset::layout { proc files {{layout ""}} { set argd [punk::args::get_dict { *values -min 1 -max 1 - layout -type string -minlen 1 + layout -type string -minsize 1 } [list $layout]] set allfiles [lib::layout_all_files $layout] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm index 08d103ee..f5a5491e 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/loadedlib-0.1.0.tm @@ -26,19 +26,21 @@ package require punk::lib namespace eval punk::mix::commandset::loadedlib { namespace export * #search automatically wrapped in * * - can contain inner * ? globs - proc search {args} { - set argspecs { - *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" - -return -type string -default table -choices {table tableobject list lines} - -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help "(unimplemented) Display only those that are 0:absent 1:present 2:both" - -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" - -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" - searchstrings -default * -multiple 1 -help "Names to search for, may contain glob chars (* ?) e.g *lib* + punk::args::definition { + *id punk::mix::commandset::loadedlib::search + *proc -name "punk::mix::commandset::loadedlib search" -help "search all Tcl libraries available to your local interpreter" + -return -type string -default table -choices {table tableobject list lines} + -present -type integer -default 2 -choices {0 1 2} -choicelabels {absent present both} -help\ + "(unimplemented) Display only those that are 0:absent 1:present 2:both" + -highlight -type boolean -default 1 -help "Highlight which version is present with ansi underline and colour" + -refresh -default 0 -type boolean -help "Re-scan the tm and library folders" + searchstrings -default * -multiple 1 -help\ + "Names to search for, may contain glob chars (* ?) e.g *lib* If no glob chars are explicitly specified, the searchstring will be wrapped with star globs. - eg name -> *name* - " - } - set argd [punk::args::get_dict $argspecs $args] + eg name -> *name*" + } + proc search {args} { + set argd [punk::args::get_by_id punk::mix::commandset::loadedlib::search $args] set searchstrings [dict get $argd values searchstrings] set opts [dict get $argd opts] set opt_return [dict get $opts -return] @@ -179,16 +181,7 @@ namespace eval punk::mix::commandset::loadedlib { return [join $loaded_libs \n] } - proc info {args} { - set argspecs { - *values -min 1 - libname -help "library/package name" - } - set argd [punk::args::get_dict $argspecs $args] - set libname [dict get $argd values libname] - - - + proc info {libname} { if {[catch {package require natsort}]} { set has_natsort 0 } else { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm index dd673f38..44627536 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/module-0.1.0.tm @@ -137,23 +137,39 @@ namespace eval punk::mix::commandset::module { put stderr "get_template_basefolders WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } } + + + set moduletypes [punk::mix::cli::lib::module_types] + punk::args::definition [subst { + *id punk::mix::commandset::module::new + *proc -name "punk::mix::commandset::module::new" -help\ + "Create a new module file in the appropriate folder within src/modules. + If the name given in the module argument is namespaced, + the necessary subfolder(s) will be used or created." + -project -optional 1 + -version -default "0.1.0" -help\ + "version to use if not specified as part of the module argument. + If a version is specified in the module argument as well as in -version + the higher version number will be used. + " + -license -default + -template -default punk.module + -type -default "[lindex $moduletypes 0]" -choices {$moduletypes} + -force -default 0 -type boolean -help\ + "If set true, will overwrite an existing .tm file if there is one. + If false (default) an error will be raised if there is a conflict." + -quiet -default 0 -type boolean -help\ + "Suppress information messages on stdout" + *values -min 1 -max 1 + module -type string -help\ + "Name of module, possibly including a namespace and/or version number + e.g mynamespace::mymodule-1.0" + }] proc new {args} { set year [clock format [clock seconds] -format %Y] - set moduletypes [punk::mix::cli::lib::module_types] # use \uFFFD because unicode replacement char should consistently render as 1 wide - set argspecs [subst { - -project -default \uFFFD - -version -default \uFFFD - -license -default - -template -default punk.module - -type -default \uFFFD -choices {$moduletypes} - -force -default 0 -type boolean - -quiet -default 0 -type boolean - *values -min 1 -max 1 - module -type string - }] - set argd [punk::args::get_dict $argspecs $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::mix::commandset::module::new $args] + lassign [dict values $argd] leaders opts values received set module [dict get $values module] #set opts [dict merge $defaults $args] @@ -168,13 +184,9 @@ namespace eval punk::mix::commandset::module { # we need this value before looking at the named argument # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_version_supplied [dict get $opts -version] - if {$opt_version_supplied eq "\uFFFD"} { - set opt_version "0.1.0" - } else { - set opt_version $opt_version_supplied - if {![util::is_valid_tm_version $opt_version]} { - error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" - } + set opt_version $opt_version_supplied + if {![util::is_valid_tm_version $opt_version]} { + error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version" } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #named argument @@ -194,7 +206,7 @@ namespace eval punk::mix::commandset::module { } else { set vmsg "from -version option: $opt_version_supplied" } - if {$opt_version_supplied ne "\uFFFD"} { + if {"-version" in $received} { if {$vcompare_is_mversion_bigger != 0} { #is bigger or smaller puts stderr "module.new WARNING: version supplied in module argument as well as -version option. Using the higher version number $vmsg" @@ -231,7 +243,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- #options # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- - set opt_project [dict get $opts -project] set testdir [pwd] if {![string length [set projectdir [punk::repo::find_project $testdir]]]} { if {![string length [set projectdir [punk::repo::find_candidate $testdir]]]} { @@ -239,9 +250,10 @@ namespace eval punk::mix::commandset::module { error "module.new unable to create module in projectdir:$projectdir - directory doesn't appear to meet basic standards $msg" } } - if {$opt_project == "\uFFFF"} { + if {![dict exists $received -project]} { set projectname [file tail $projectdir] } else { + set opt_project [dict get $opts -project] set projectname $opt_project if {$projectname ne [file tail $projectdir]} { error "module.new -project '$opt_project' doesn't match detected projectname '$projectname' at path: $projectdir" @@ -309,12 +321,6 @@ namespace eval punk::mix::commandset::module { # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_type [dict get $opts -type] - if {$opt_type eq "\uFFFD"} { - set opt_type [lindex [punk::mix::cli::lib::module_types] 0] ;#default to plain - } - if {$opt_type ni [punk::mix::cli::lib::module_types]} { - error "module.new - error - unknown -type '$opt_type' known-types: [punk::mix::cli::lib::module_types]" - } # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_quiet [dict get $opts -quiet] set opt_force [dict get $opts -force] @@ -407,7 +413,7 @@ namespace eval punk::mix::commandset::module { set podfile $modulefolder/#modpod-$moduletail-$infile_version/$moduletail-$infile_version.tm set has_tm [file exists $tmfile] set has_pod [file exists $podfile] - if {$has_tm && $has_pos} { + if {$has_tm && $has_pod} { #invalid configuration - bomb out error "module.new error: Invalid target configuration found. module folder has both a .tm file $tmfile and a modpod file $podfile. Please delete one of them before trying again." } @@ -448,7 +454,7 @@ namespace eval punk::mix::commandset::module { } set buildversionfile [file join $modulefolder ${moduletail}-buildversion.txt] set existing_build_version "" - if {[file exists $buildversionfile]} { + if {!$opt_force && [file exists $buildversionfile]} { set buildversiondata [punk::mix::util::fcat $buildversionfile] set lines [split $buildversiondata \n] set existing_build_version [string trim [lindex $lines 0]] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm index 72691167..880dde53 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm @@ -28,7 +28,7 @@ tcl::namespace::eval ::punk::ns::evaluator { tcl::namespace::eval punk::ns { variable ns_current "::" variable ns_re_cache [dict create] ;#cache regular expressions used in globmatchns - namespace export nsjoin nsprefix nstail nsparts nseval nsimport_noclobber corp + namespace export nsjoin nsprefix nstail nsparts nseval nschildren nsimport_noclobber corp catch { package require debug debug define punk.ns.compile @@ -53,6 +53,8 @@ tcl::namespace::eval punk::ns { set nspathcommands 1 } + set ns_or_glob [string map {:::: ::} $ns_or_glob] + #todo - cooperate with repl? set out "" if {$ns_or_glob eq ""} { @@ -64,7 +66,7 @@ tcl::namespace::eval punk::ns { set has_globchars [regexp {[*?]} $ns_or_glob] if {$is_absolute} { if {!$has_globchars} { - if {![tcl::namespace::exists $ns_or_glob]} { + if {![nsexists $ns_or_glob]} { error "cannot change to namespace $ns_or_glob" } set ns_current $ns_or_glob @@ -77,7 +79,7 @@ tcl::namespace::eval punk::ns { } else { if {!$has_globchars} { set nsnext [nsjoin $ns_current $ns_or_glob] - if {![tcl::namespace::exists $nsnext]} { + if {![nsexists $nsnext]} { error "cannot change to namespace $ns_or_glob" } set ns_current $nsnext @@ -157,14 +159,28 @@ tcl::namespace::eval punk::ns { } #todo - walk up each ns - testing for possibly weirdly named namespaces - #review - do we even need it. + #needed to use n/ to change to an oddly named namespace such as ":x" proc nsexists {nspath} { - error "unimplemented" + if {$nspath eq ""} {return 0} + set parts [nsparts $nspath] + if {[lindex $parts 0] ne ""} { + #relative + set ns_caller [uplevel 1 {::namespace current}] + set fq_nspath [nsjoin $ns_caller $nspath] + } else { + set fq_nspath $nspath + } + if {[catch {nseval_ifexists $fq_nspath {}}]} { + return 0 + } else { + return 1 + } } #recursive nseval - for introspection of weird namespace trees #approx 10x slower than normal tcl::namespace::eval - but still only a few microseconds.. fine for repl introspection - proc nseval_script {location} { + #WARNING: creates namespaces if they don't exist + proc nseval_getscript {location} { set parts [nsparts $location] if {[lindex $parts 0] eq ""} { lset parts 0 :: @@ -214,21 +230,88 @@ tcl::namespace::eval punk::ns { #set cmd ::punk::pipecmds::nseval_$loc set cmd ::punk::ns::evaluator::eval-$loc if {$cmd ni [info commands $cmd]} { - append body \n [nseval_script $fqns] + append body \n [nseval_getscript $fqns] proc $cmd {script} $body debug.punk.ns.compile {proc $cmd} 2 } tailcall $cmd $script } - proc nschildren {fqns} { - if {![string match ::* $fqns]} { - error "nschildren only accepts a fully qualified namespace" + proc nseval_ifexists {ns script} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set nsfq [nsjoin $nscaller $ns] + } else { + set nsfq $ns + } + set ns_script [nseval_ifexists_getscript $nsfq] + uplevel 1 [list {*}$ns_script $script] + } + proc nseval_ifexists_getscript {location} { + set parts [nsparts $location] + if {[lindex $parts 0] eq ""} { + lset parts 0 :: + } + if {[lindex $parts end] eq ""} { + set parts [lrange $parts 0 end-1] + } + + set body "apply \{{script} \{eval \[string map \[list \$script\] \{" + set i 0 + set tails [lrepeat [llength $parts] ""] + foreach ns $parts { + set cmdlist [list ::punk::ns::eval_no_create $ns] + set t "" + if {$i > 0} { + append body " " + } + append body $cmdlist + if {$i == ([llength $parts] -1)} { + append body " {}" + } + if {$i > 0} { + set t {} + } + lset tails $i $t + incr i + } + append body [join [lreverse $tails] " "] + #puts stdout "tails: $tails" + #puts stdout "i: $i" + set body [string map [list "\{" "\}"] $body] + append body " \}\]\}\}" + return $body + } + proc eval_no_create {ns script} { + uplevel 1 [string map [list $ns $script] { + if {[::tcl::namespace::exists ]} { + ::tcl::namespace::eval {} + } else { + error "no such namespace " + } + }] + } + + + proc nschildren {ns} { + set parts [nsparts $ns] + if {[lindex $parts 0] ne ""} { + #relative + set nscaller [uplevel 1 {::tcl::namespace::current}] + set fqns [nsjoin $nscaller $ns] + } else { + set fqns $ns } + #if {![string match ::* $fqns]} { + # error "nschildren only accepts a fully qualified namespace" + #} set parent [nsprefix $fqns] set tail [nstail $fqns] #puts ">>> parent $parent tail $tail" #set nslist [nseval $parent [list ::namespace children $tail]] - set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + #set nslist [tcl::namespace::eval $parent [list ::tcl::namespace::children $tail]] + set nslist [nseval_ifexists $parent [list ::tcl::namespace::children $tail]] return [lsort $nslist] } @@ -356,7 +439,16 @@ tcl::namespace::eval punk::ns { set searchns [nsprefix $ns_absolute] ;#the ns within which we want to searchns set searchall [nsjoin $searchns *] ;#will correctly form ::* or ::childns::* - set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + set nsparts [nsparts $searchns] + set weird_ns 0 + if {[lsearch $nsparts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set rawresult [nseval_ifexists $searchns [list info vars]] + } else { + set rawresult [info vars $searchall] ;#will not find vars in ::x:::y etc. - seems to be impossible in tcl 8.x + } set matched_fullpath [list] foreach r $rawresult { lappend matched_fullpath [nstail $r] @@ -595,10 +687,21 @@ tcl::namespace::eval punk::ns { return $nslist } + variable usageinfo_char \U1f6c8 + # command has usageinfo e.g from punk::args. todo cmdline, argp, tepam etc? + proc Usageinfo_mark {{ansicodes \UFFEF}} { + variable usageinfo_char + if {$ansicodes eq ""} { + return $usageinfo_char + } elseif {$ansicodes eq "\UFFEF"} { + return " [a+ brightyellow]$usageinfo_char[a]" + } else { + return " [a+ {*}$ansicodes]$usageinfo_char[a]" + } + } #REVIEW - ansi codes can be *very* confusing to the user when trying to handle lists etc.. proc get_nslist {args} { - set known_types [list children commands exported imported aliases procs ensembles ooclasses ooobjects ooprivateobjects ooprivateclasses native coroutines interps zlibstreams] set defaults [dict create\ -match ""\ @@ -666,6 +769,7 @@ tcl::namespace::eval punk::ns { set interps [list] set coroutines [list] set zlibstreams [list] + set usageinfo [list] if {$opt_nsdict eq ""} { set nsmatches [get_ns_dicts $fq_glob -allbelow 0] @@ -742,6 +846,7 @@ tcl::namespace::eval punk::ns { } } } + set usageinfo [dict get $contents usageinfo] } set numchildren [llength $children] @@ -859,7 +964,8 @@ tcl::namespace::eval punk::ns { set cmd_display [list $cmd] ;#wrap in list so empty command is visible (and distinguishable from for example a double-curly command) if {$cmd ni $commands && $cmd in $aliases } { #ordinary un-masked commandless-alias - set c [a+ red bold] + #(original alias name that has been renamed) + set c [a+ red bold strike] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] } else { @@ -869,7 +975,7 @@ tcl::namespace::eval punk::ns { #keep oooobjects below ooclasses, ooprivateclasses, ooprivateobjects if {$cmd in $aliases && $cmd in $seencmds} { #masked commandless-alias - #assertion member of masked - but we use seencmds instead to detect. + #assertion: member of masked - but we use seencmds instead to detect. set c [a+ yellow bold] set prefix "${a}als " set prefix [overtype::right $prefix "-R"] @@ -901,13 +1007,20 @@ tcl::namespace::eval punk::ns { set prefix [overtype::right $prefix "-[a+ yellow bold]I[a+]"] } } - set cmd$i "${prefix} $c$cmd_display" - set c$i $c + if {$cmd in $usageinfo} { + set u [Usageinfo_mark brightgreen] + } else { + set u "" + } + set cmd$i "${prefix} $c$cmd_display$u" + #set c$i $c + set c$i "" lappend seencmds $cmd } } - lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + #lappend displaylist $a1[overtype::left $col1 $ch1][a+]$a1[overtype::left $col2 $ch2][a+]$c1[overtype::left $col3 $cmd1][a+]$c2[overtype::left $col4 $cmd2][a+]$c3[overtype::left $col5 $cmd3][a+]$c4$cmd4[a+] + lappend displaylist $a1[overtype::left $col1 $ch1][a]$a1[overtype::left $col2 $ch2][a]$c1[overtype::left $col3 $cmd1][a]$c2[overtype::left $col4 $cmd2][a]$c3[overtype::left $col5 $cmd3][a]$c4$cmd4[a] } return [list_as_lines $displaylist] @@ -917,7 +1030,7 @@ tcl::namespace::eval punk::ns { if {$path_is_absolute} { return $nspath } - set ns_caller [uplevel 1 {::namespace current}] ;#must qualify. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) + set ns_caller [uplevel 1 {::namespace current}] ;#must qualify 'namespace' command. Needs to be called from arbitrary namespaces where 'namespace' command may exist (e.g tdom::schema) if {$nspath eq "\uFFFF"} { return $ns_caller } @@ -936,6 +1049,31 @@ tcl::namespace::eval punk::ns { return [nsjoin $base $nspath] } + set has_textblock [expr {![catch {package require textblock}]}] + + if {$has_textblock} { + interp alias "" ::punk::ns::Block_width "" textblock::width + } else { + #maint - equiv of textblock::width + proc Block_width {textblock} { + if {$textblock eq ""} { return 0 } + if {[tcl::string::last \t $textblock] >=0} { + if {[tcl::info::exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::ansistripraw $textblock] + } + if {[tcl::string::last \n $textblock] >= 0} { + return [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } + return [punk::char::ansifreestring_width $textblock] + } + } proc nslist {{glob "*"} args} { set ns_absolute [uplevel 1 [list ::punk::ns::nspath_here_absolute $glob]] if {[dict exists $args -match]} { @@ -947,7 +1085,6 @@ tcl::namespace::eval punk::ns { -nspathcommands 0\ ] - package require textblock set opts [dict merge $defaults $args] # -- --- --- set opt_nspathcommands [dict get $opts -nspathcommands] @@ -971,11 +1108,11 @@ tcl::namespace::eval punk::ns { set block [get_nslist {*}$opts] #if {[string first \n $block] < 0} { # #single line - # set width [textblock::width [list $block]] + # set width [Block_width [list $block]] #} else { - # set width [textblock::width $block] + # set width [Block_width $block] #} - set width [textblock::width $block] + set width [Block_width $block] #if multiple results or if there is only 1 result - but we are path-globbing - then we need to show location if {$count_with_results > 1 || [regexp {[*?]} [nsprefix $ns_absolute]]} { @@ -998,7 +1135,7 @@ tcl::namespace::eval punk::ns { } } append output $path_text - set path_text_width [textblock::width $path_text] + set path_text_width [Block_width $path_text] append output \n [string repeat - [expr {max($width,$path_text_width)}]] } elseif {$count_with_results > 1 && $width > 0 } { append output \n [string repeat - $width] @@ -1014,9 +1151,44 @@ tcl::namespace::eval punk::ns { #info cmdtype available in 8.7+ #safe interps also seem to have it disabled for some reason + #we need to return "na" if 'info cmdtype' not supported or not functioning due to safe interp etc + #IMPORTANT: don't detect easy types such as proc/import here - caller needs the 'na' to do the proper fallback + #it is not desirable to do a partial cmdtype support here proc cmdtype {cmd} { + #set cmd [namespace which $cmd] ;#will return empty result for empty string command or command such as :x or any command that doesn't exist + set fqcmd [namespace which $cmd] ;#will resolve for example 'namespace path' reachable commands + if {$fqcmd eq ""} { + #e.g ::ns:::x will return empty result from namespace which even if :x is a command in ::ns + set where [nsprefix $cmd] + if {$where eq ""} { + #bare command that didn't resolve using namespace which + #command probably doesn't exist (may be auto_path cmd not yet loaded) + set where :: + } + set what [nstail $cmd] + } else { + set where [nsprefix $fqcmd] + set what [nstail $fqcmd] + } + #ensure we con't call 'namespace eval' on a nonexistent ns and create cruft namespaces + set parts [nsparts $where] + if {[lsearch $parts :*] > -1} { + set weird_ns 1 + if {![nsexists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)." + return nsnotfound + } + } else { + set weird_ns 0 + if {![namespace exists $where]} { + #error "punk::ns::cmdtype could not locate command $cmd (namespace '$where' not found)" + return nsnotfound + } + } + if {[interp issafe]} { - if {[catch {::tcl::info::cmdtype $cmd} result]} { + #todo - weird_ns + if {[catch {namespace eval $where [list ::tcl::info::cmdtype $what]} result]} { if {[info commands ::cmdtype] ne ""} { #hack - look for an alias that may have been specifically enabled to bring this back tailcall ::cmdtype $cmd @@ -1027,9 +1199,23 @@ tcl::namespace::eval punk::ns { } } if {[info commands ::tcl::info::cmdtype] ne ""} { - tailcall info cmdtype $cmd + if {$weird_ns} { + if {[nseval_ifexists $where [list ::info commands $what]] eq ""} { + return notfound + } else { + return [nseval_ifexists $where [list ::tcl::info::cmdtype $what]] + } + } else { + if {[namespace eval $where [list ::info commands $what]] eq ""} { + #e.g parray if it hasn't yet been called (an auto_path loaded command) + return notfound + } else { + tailcall namespace eval $where [list ::tcl::info::cmdtype $what] + } + } } - #we could examine namespaces to determine - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #we could examine namespaces to determine more - but would be duplicating work already done/available in get_ns_dicts which is usually the caller + #also - we're unlikely to be able to (easily) duplicate the full info cmdtype behaviour - so don't try here! return na } #non-contextual - but impure due to state-retrieval from the passed-in namespace part of the fq_glob @@ -1073,6 +1259,7 @@ tcl::namespace::eval punk::ns { } else { set report_namespaces $matched_namespaces } + punk::args::update_definitions set nsdict_list [list] foreach ch $report_namespaces { @@ -1103,8 +1290,18 @@ tcl::namespace::eval punk::ns { #JMN set location $ch - set exportpatterns [tcl::namespace::eval $location {::namespace export}] - set nspathlist [tcl::namespace::eval $location {::namespace path}] + set locationparts [nsparts $location] + set weird_ns 0 + if {[lsearch $locationparts :*] >= 0} { + set weird_ns 1 + } + if {$weird_ns} { + set exportpatterns [nseval_ifexists $location {::namespace export}] + set nspathlist [nseval_ifexists $location {::namespace path}] + } else { + set exportpatterns [tcl::namespace::eval $location {::namespace export}] + set nspathlist [tcl::namespace::eval $location {::namespace path}] + } set nspathdict [dict create] if {$nspathcommands} { foreach pathns $nspathlist { @@ -1123,7 +1320,25 @@ tcl::namespace::eval punk::ns { foreach p $exportpatterns { if {[regexp {[*?]} $p]} { #lappend matched {*}[nseval $location [list ::info commands [nsjoin ${location} $p]]] - lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + if {$weird_ns} { + #! info commands can't glob with a weird ns prefix + #! info commands with no arguments returns all commands (from global and any other ns in namespace path) + #lappend matched {*}[nseval_ifexists $location [list ::info commands [nsjoin ${location} $p]]] + lappend matched {*}[nseval_ifexists $location [string map [list $location $p] { + set allcommands [info commands] + set matches [list] + foreach c $allcommands { + set fq [namespace which $c] + if {[string match :: $fq]} { + lappend matches $c + } + } + return $matches + }] + + } else { + lappend matched {*}[tcl::namespace::eval $location [list ::info commands [nsjoin ${location} $p]]] + } foreach m $matched { lappend allexported [nstail $m] } @@ -1133,7 +1348,11 @@ tcl::namespace::eval punk::ns { } set allexported [lsort -unique $allexported] #NOTE: info procs within tcl::namespace::eval is different to 'info commands' within tcl::namespace::eval (info procs doesn't look outside of namespace) - set allprocs [tcl::namespace::eval $location {::info procs}] + if {$weird_ns} { + set allprocs [nseval_ifexists $location {::info procs}] + } else { + set allprocs [tcl::namespace::eval $location {::info procs}] + } #set allprocs [nseval $location {::info procs}] set childtails [lmap v $allchildren {nstail $v}] set allaliases [list] @@ -1151,7 +1370,11 @@ tcl::namespace::eval punk::ns { set interp_aliases [interp aliases ""] #use aliases glob - because aliases can be present with or without leading :: #NOTE: alias may not have matching command in the relevant namespce (renamed alias) so we can't just start with commands and check if it's an alias if we want to show all aliases - set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + if {$weird_ns} { + set raw_aliases [nseval_ifexists $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } else { + set raw_aliases [tcl::namespace::eval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. + } #set raw_aliases [nseval $location [list ::aliases $glob]] ;#'aliases $glob' must be passed as list, not separate args to namespace eval. set aliases [list] foreach a $raw_aliases { @@ -1165,38 +1388,91 @@ tcl::namespace::eval punk::ns { } } + #NOTE for 'info ...' 'namespace origin|(etc)..' + # - use the pattern [namespace eval $location [list $cmd]] + #This allows examination of cmds with "bad" names such as empty string or prefixed with single colon. + #while these should be rare - we want to handle such edge cases when browsing namespaces. foreach cmd $commands { #if {"${location}::$cmd" in $interp_aliases || [string trimleft "${location}::$cmd" ":"] in $interp_aliases} { - # #NOTE: doesn't cater for renamed aliases - Tcl 8.x doesn't seem to have any introspection capabilities to match command to a renamed alias + # #NOTE: doesn't cater for renamed aliases - Tcl 8.x (and 9.01) doesn't seem to have any introspection capabilities to match command to a renamed alias # #which_alias hack from wiki relies on trace and executing the command - which we don't want to do. # lappend allaliases $cmd #} set ctype [cmdtype ${location}::$cmd] switch -- $ctype { na { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } + if {[nsprefix $cmdorigin] ne $location} { + #import + lappend allimported $cmd + set origin_location [nsprefix $cmdorigin] + } else { + set origin_location $location + } #tcl 8.6 (info cmdtype unavailable) #todo - use catch tcl::unsupported::corotype to see if coroutine - if {![catch {namespace ensemble configure ${location}::$cmd} ensemble_info]} { - lappend allensembles $cmd - } elseif {[info object isa object ${location}::$cmd]} { - lappend allooobjects $cmd - if {[info object isa class ${location}::$cmd]} { - lappend allooclasses $cmd + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + if {![catch {nseval_ifexists $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[nseval_ifexists $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[nseval_ifexists $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + + } + } else { + if {![catch {namespace eval $origin_location [list ::namespace ensemble configure $cmd]} ensemble_info]} { + lappend allensembles $cmd + } elseif {[namespace eval $origin_location [list ::info object isa object $cmd]]} { + lappend allooobjects $cmd + if {[namespace eval $origin_location [list ::info object isa class $cmd]]} { + lappend allooclasses $cmd + } + } else { + } } } default { - if {$ctype eq "imported"} { - set cmdorigin [namespace origin [nsjoin $location $cmd]] + if {$ctype eq "import"} { + if {$weird_ns} { + set cmdorigin [nseval_ifexists $location [list ::namespace origin $cmd]] + } else { + set cmdorigin [namespace eval $location [list ::namespace origin $cmd]] + } #even if cmd was already imported to another ns and then reimported from there, namespace origin will show the original source #ie we don't need to follow a chain of 'imported' results. - set mixedtype i-[info cmdtype $cmdorigin] + set origin_location [nsprefix $cmdorigin] + set origin_cmd [nstail $cmdorigin] + + set originlocationparts [nsparts $origin_location] + set weird_origin 0 + if {[lsearch $originlocationparts :*] >= 0} { + set weird_origin 1 + } + if {$weird_origin} { + set mixedtype i-[nseval_ifexists $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } else { + set mixedtype i-[namespace eval $origin_location [list ::tcl::info::cmdtype $origin_cmd]] + } + lappend allimported $cmd } else { set mixedtype $ctype } - #assert ctype != imported + #assert mixedtype != import #review - we don't have a way to mark as both native and ensemble - switch -- $ctype { + switch -- $mixedtype { i-native - native { lappend allnative $cmd } @@ -1242,7 +1518,7 @@ tcl::namespace::eval punk::ns { } } - #JMN + #JMN TODO if {[catch { if {$cmd eq ""} { #empty command was previously marked as "::" - too confusing - nslist updated to properly display empty string. @@ -1315,6 +1591,50 @@ tcl::namespace::eval punk::ns { #definitely don't count exportpatterns incr itemcount [llength $undetermined] + set usageinfo [list] + set has_punkargs [expr {[info commands ::punk::args::id_exists] ne ""}] + set has_tepam [expr {[info exists ::tepam::ProcedureList]}] + if {$has_punkargs || $has_tepam} { + foreach c $commands { + if {$c in $imported} { + set fq [namespace origin [nsjoin $location $c]] + } elseif {$c in $aliases} { + #TODO - use which_alias ? + set tgt [interp alias "" [nsjoin $location $c]] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft [nsjoin $location $c] :]] + } + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(currying) + set fq $word1 + } + } else { + set fq [nsjoin $location $c] + } + if {$has_punkargs} { + set id [string trimleft $fq :] + if {[::punk::args::id_exists $id]} { + lappend usageinfo $c + } else { + if {$has_tepam} { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } else { + if {$fq in $::tepam::ProcedureList} { + lappend usageinfo $c + } + } + } + } set nsdict [dict create\ location $location\ @@ -1335,6 +1655,7 @@ tcl::namespace::eval punk::ns { ooprivateclasses $ooprivateclasses\ namespacexport $exportpatterns\ undetermined $undetermined\ + usageinfo $usageinfo\ namespacepath $nspathdict\ glob $glob\ itemcount $itemcount\ @@ -1480,11 +1801,33 @@ tcl::namespace::eval punk::ns { ::set what $search } } - - ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] + set weird_ns 0 + if {[string match *:::* $base]} { + set weird_ns 1 + } #important not to call tcl::namespace::eval (or punk::ns::nseval) on non-existant base - or it will be created - ::if {![::tcl::namespace::exists $base]} { - ::continue + if {$weird_ns} { + ::if {![nsexists $base]} { + ::continue + } + #info commands can't glob with weird_ns prefix + puts ">>> base: $base what: $what" + ::set all_ns_commands [nseval_ifexists $base [list apply {{loc what} { + set _all [uplevel 1 [list ::info commands]] + set _matches [list] + foreach _a $_all { + set _c [uplevel 1 [list ::namespace which $_a]] + if {[::string match ${loc}::${what} $_c]} { + ::lappend _matches $_a + } + } + return $_matches + }} $base $what ]] + } else { + ::if {![::tcl::namespace::exists $base]} { + ::continue + } + ::set all_ns_commands [::info commands [::punk::ns::nsjoin $base $what]] } ::set all_ns_tails [::lmap v $all_ns_commands {::punk::ns::nstail $v}] foreach c $all_ns_tails { @@ -1549,6 +1892,510 @@ tcl::namespace::eval punk::ns { } } |data@@ok/result> {lmap v $data {punk::ns::nstail $v}} |> lsort |> {join $data \n} = 0} { + #use nseval_ifexists to avoid creating intermediate namespaces for bogus paths + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set origin $commandpath + set resolved $commandpath + } + } else { + #fully qualified command specified but doesn't exist + set origin $commandpath + set resolved $commandpath + } + } else { + set thispath [uplevel 1 [list ::nsthis $commandpath]] + set targetns [nsprefix $thispath] + set name [nstail $thispath] + set targetparts [nsparts $targetns] + if {[lsearch $targetparts :*] >=0} { + #weird ns + set valid_ns [nsexists $targetns] + } else { + set valid_ns [namespace exists $targetns] + } + if {$valid_ns} { + if {[catch { + set origin [nseval_ifexists $targetns [list ::namespace origin $name]] + set resolved [nseval_ifexists $targetns [list ::namespace which $name]] + }]} { + set thiscmd [nsjoin $targetns $name] + #relative commandpath specified - but Tcl didn't find a match in namespace path + #assume global (todo - look for namespace match in auto_index first ?) + set origin ::$name + set resolved ::$name + } + } else { + #namespace doesn't seem to exist - but there still could be documentation for lazy loaded ns and command + set origin $commandpath + set resolved $commandpath + } + } + #set thiscmd [nsjoin $targetns $name] + #if {[info commands $thiscmd] eq ""} { + # set origin $thiscmd + # set resolved $thiscmd + #} else { + # set origin [nseval $targetns [list ::namespace origin $name]] + # set resolved [nseval $targetns [list ::namespace which $name]] + #} + + #ns::cmdtype only detects alias type on 8.7+? + set initial_cmdtype [punk::ns::cmdtype $origin] + switch -- $initial_cmdtype { + na - alias { + #REVIEW - alias entry doesn't necessarily match command! + #considure using which_alias (wiki) + set tgt [interp alias "" $origin] + if {$tgt eq ""} { + set tgt [interp alias "" [string trimleft $origin :]] + } + if {$tgt ne ""} { + set word1 [lindex $tgt 0] + if {$word1 eq "punk::mix::base::_cli"} { + #special case for punk deck - REVIEW + #e.g punk::mix::base::_cli -extension ::punk::mix::cli + set fq [lindex $tgt end] + } else { + #todo - alias may have prefilled some leading args - so usage report should reflect that??? + #(possible curried arguments) + #review - curried arguments could be for ensembles! + set fq $word1 + } + set origin $fq + #retest cmdtype on modified origin + set cmdtype [punk::ns::cmdtype $origin] + } else { + set cmdtype $initial_cmdtype + } + if {$cmdtype eq "na"} { + #tcl 8.6 + if {[info object isa object $origin]} { + set cmdtype "object" + } + } + } + default { + set cmdtype $initial_cmdtype + } + } + + switch -- $cmdtype { + object { + #class is also an object + #todo -mixins etc etc + set class [info object class $origin] + #the call: info object methods -all + # seems to do the right thing as far as hiding unexported methods, and showing things like destroy + # - which don't seem to be otherwise easily introspectable + set public_methods [info object methods $origin -all] + #set class_methods [info class methods $class] + #set object_methods [info object methods $origin] + + if {[llength $commandargs]} { + set c1 [lindex $commandargs 0] + if {$c1 in $public_methods} { + switch -- $c1 { + new { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} new" + *proc -name "${$origin} new" -help\ + "create object with specified command name. + Arguments are passed to the constructor." + *values + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin new"] + } + create { + set constructorinfo [info class constructor $origin] + set arglist [lindex $constructorinfo 0] + set argspec [punk::lib::tstr -return string { + *id "${$origin} create" + *proc -name "${$origin} create" -help\ + "create object with specified command name. + Arguments following objectName are passed to the constructor." + *values -min 1 + objectName -type string -help\ + "possibly namespaced name for object instance command" + }] + set i 0 + foreach a $arglist { + if {[llength $a] == 1} { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } else { + append argspec \n "[lindex $a 0] -default [lindex $a 1]" + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$origin create"] + } + destroy { + #review - generally no doc + # but we may want notes about a specific destructor + set argspec [punk::lib::tstr -return string { + *id "${$origin} destroy" + *proc -name "destroy" -help\ + "delete object, calling destructor if any. + destroy accepts no arguments." + *values -min 0 -max 0 + }] + punk::args::definition $argspec + return [punk::args::usage "$origin destroy"] + } + default { + #use info object call to resolve callchain + #we assume the first impl is the topmost in the callchain + # and its call signature is therefore the one we are interested in - REVIEW + # we should probably ignore generaltypes filter|unknown and look for a subsequent method|private? + set implementations [::info object call $origin $c1] + #result documented as list of 4 element lists + #set callinfo [lindex $implementations 0] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + + if {$location eq "object"} { + set id "[string trimleft $origin :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info object definition $origin $c1] + } else { + set id "[string trimleft $location :] $c1" ;# " " + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set def [::info class definition $location $c1] + } + break + } + filter { + } + unknown { + } + } + } + if {$def ne ""} { + set arglist [lindex $def 0] + set argspec [punk::lib::tstr -return string { + *id "${$location} ${$c1}" + *proc -name "${$location} ${$c1}" -help\ + "arglist:${$arglist}" + *values + }] + set i 0 + foreach a $arglist { + switch -- [llength $a] { + 1 { + if {$i == [llength $arglist]-1 && $a eq "args"} { + #'args' is only special if last + append argspec \n "args -optional 1 -multiple 1" + } else { + append argspec \n "$a" + } + } + 2 { + append argspec \n "[lindex $a 0] -default {[lindex $a 1]} -optional 1" + } + default { + error "punk::ns::arginfo unexpected argument signature '$arglist'\ndef:$def\nimplementaions:$implementations" + } + } + incr i + } + punk::args::definition $argspec + return [punk::args::usage "$location $c1"] + } else { + return "unable to resolve $origin method $c1" + } + + } + } + } + } + set choicelabeldict [dict create] + foreach cmd $public_methods { + switch -- $cmd { + new - create - destroy { + #todo + } + default { + set implementations [::info object call $origin $cmd] + set def "" + foreach impl $implementations { + lassign $impl generaltype mname location methodtype + switch -- $generaltype { + method - private { + if {$location eq "object"} { + set id "[string trimleft $origin :] $cmd" ;# " " + } else { + set id "[string trimleft $location :] $cmd" ;# " " + } + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + dict set choicelabeldict $cmd " [Usageinfo_mark brightgreen]" + } + } + break + } + filter { + } + unknown { + } + } + } + } + } + } + + set vline [list method -choices $public_methods -choicelabels $choicelabeldict -choiceprefix 0] ;#methods must be specified in full always? - review + #puts stderr "--->$vline" + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -name "Object: ${$origin}" -help\ + "Instance of class: ${$class}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + privateObject { + return "Command is a privateObject - no info currently available" + } + privateClass { + return "Command is a privateClass - no info currently available" + } + interp { + #todo + } + } + + #check ensemble before testing punk::arg::id_exists + #we want to recalculate ensemble usage info in case ensemble has been modified + + if {[namespace ensemble exists $origin]} { + #review + #todo - check -unknown + #if there is a -unknown handler - we can't be sure the choices in -map or from -namespace are exhaustive. + #presumably -choiceprefix should be zero in that case?? + + set ensembleinfo [namespace ensemble configure $origin] + set prefixes [dict get $ensembleinfo -prefixes] + set map [dict get $ensembleinfo -map] + set ns [dict get $ensembleinfo -namespace] + + #review - we can have a combination of commands from -map as well as those exported from -namespace + # if and only if -subcommands is specified + + set subcommand_dict [dict create] + set commands [list] + set nscommands [list] + if {[llength [dict get $ensembleinfo -subcommands]]} { + #set exportspecs [namespace eval $ns {namespace export}] + #foreach pat $exportspecs { + # lappend nscommands {*}[info commands ${ns}::$pat] + #} + #when using -subcommands, even unexported commands are available + set nscommands [info commands ${ns}::*] + foreach sub [dict get $ensembleinfo -subcommands] { + if {[dict exists $map $sub]} { + #-map takes precence over same name exported from -namespace + dict set subcommand_dict $sub [dict get $map $sub] + } elseif {"${ns}::$sub" in $nscommands} { + dict set subcommand_dict $sub ${ns}::$sub + } else { + #subcommand probably supplied via -unknown handler? + dict set subcommand_dict $sub "" + } + } + } else { + if {[dict size $map]} { + set subcommand_dict $map + } else { + set exportspecs [namespace eval $ns {namespace export}] + foreach pat $exportspecs { + lappend nscommands {*}[info commands ${ns}::$pat] + } + foreach fqc $nscommands { + dict set subcommand_dict [namespace tail $fqc] $fqc + } + } + } + + + set subcommands [lsort [dict keys $subcommand_dict]] + if {[llength $commandargs]} { + set match [tcl::prefix::match $subcommands [lindex $commandargs 0]] + if {$match in $subcommands} { + set subcmd [dict get $subcommand_dict $match] + return [arginfo {*}$subcmd {*}[lrange $commandargs 1 end]] ;#subcmd is sometimes multiple words (implemented as a further ensemble subcommand) (e.g huddle string -> "Type_string string") + } + } + + set namespaces [list] ;# usually only 1 or 2 namespaces - but could be any number. + dict for {sub subwhat} $subcommand_dict { + set ns [::namespace which $subwhat] + if {$ns ni $namespaces} { + lappend namespaces $ns + } + } + set have_usageinfo [list] + set is_ensemble [list] + set is_object [list] + foreach ns $namespaces { + set nsinfo [lindex [punk::ns::nslist_dict [nsjoin [nsprefix $ns] *]] 0] + lappend have_usageinfo {*}[dict get $nsinfo usageinfo] + lappend is_ensemble {*}[dict get $nsinfo ensembles] + lappend is_object {*}[dict get $nsinfo ooobjects] + } + + set choicelabeldict [dict create] + foreach sub $subcommands { + if {$sub in $have_usageinfo} { + dict set choicelabeldict $sub " [Usageinfo_mark brightgreen]" + } elseif {$sub in $is_ensemble} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } elseif {$sub in $is_object} { + dict set choicelabeldict $sub " [Usageinfo_mark brightyellow]" + } + } + + set vline [list subcommand -choices $subcommands -choiceprefix $prefixes -choicelabels $choicelabeldict] + set argspec [punk::lib::tstr -return string { + *id ${$origin} + *proc -help "ensemble: ${$origin}" + *values -min 1 + }] + append argspec \n $vline + punk::args::definition $argspec + return [punk::args::usage $origin] + } + + #check for tepam help + if {[info exists ::tepam::ProcedureList]} { + if {$origin in $::tepam::ProcedureList} { + return [tepam::ProcedureHelp $origin 1] ;#use 1 to return rather than emit to stdout + } else { + #handle any tepam functions that don't eat their own dogfood but have help variables + #e.g tepam::procedure, tepam::argument_dialogbox + #Rather than hardcode these - we'll guess that any added will use the same scheme.. + if {[namespace qualifiers $origin] eq "::tepam"} { + set func [namespace tail $origin] + #tepam XXXHelp vars don't exactly match procedure names :/ + if {[info exists ::tepam::${func}Help]} { + return [set ::tepam::${func}Help] + } else { + set f2 [string totitle $func] + if {[info exists ::tepam::${f2}Help]} { + return [set ::tepam::${f2}Help] + } + #e.g argument_dialogbox -> ArgumentDialogboxHelp + set parts [split $func _] + set uparts [lmap p $parts {string totitle $p}] + set f3 [join [list {*}$uparts Help] ""] + if {[info exists ::tepam::${f3}]} { + return [set ::tepam::${f3}] + } + } + } + } + } + + set id [string trimleft $origin :] + if {[info commands ::punk::args::id_exists] ne ""} { + if {[punk::args::id_exists $id]} { + return [uplevel 1 [list punk::args::usage $id]] + } + } + set origin_ns [nsprefix $origin] + set parts [nsparts $origin_ns] + set weird_ns 0 + if {[lsearch $parts :*] >=0} { + set weird_ns 1 + } + if {$weird_ns} { + set argl {} + set tail [nstail $origin] + foreach a [nseval_ifexists $origin_ns [list info args $tail]] { + if {[nseval_ifexists $origin_ns [list info default $tail $a def]]} { + lappend a $def + } + lappend argl $a + } + } else { + set argl {} + foreach a [info args $origin] { + if {[info default $origin $a def]} { + lappend a $def + } + lappend argl $a + } + } + + set msg "No argument processor detected" + append msg \n "function signature: $resolved $argl" + return $msg + } + #todo - package up as navns proc corp {path} { #thanks to Richard Suchenwirth for the original - wiki.tcl-lang.org/page/corp @@ -1567,6 +2414,8 @@ tcl::namespace::eval punk::ns { set body "" } + #we want to handle edge cases of commands such as "" or :x + #various builtins such as 'namespace which' won't work if {[string match ::* $path]} { set targetns [nsprefix $path] set name [nstail $path] @@ -1884,26 +2733,41 @@ tcl::namespace::eval punk::ns { } interp alias "" use "" punk::ns::pkguse + punk::args::definition { + *id punk::ns::nsimport_noclobber + *proc -name punk::ns::nsimport_noclobber -help\ + "Import exported commands from a namespace into either the current namespace, + or that specified in -targetnamespace. + Return list of imported commands, ignores failures due to name conflicts" + -targetnamespace -optional 1 -help\ + "Namespace in which to import commands. + If namespace is relative (no leading ::), + the namespace is relative to the caller'd namespace. + If not supplied, caller's namespace is used." + -prefix -optional 1 -help\ + "string prefix for command names in target namespace" + *values -min 1 -max 1 + sourcepattern -type string -optional 0 -help\ + "Glob pattern for source namespace. + Globbing only active in the tail segment. + e.g ::mynamespace::*" + } proc nsimport_noclobber {args} { - set argspecs { - -targetnamespace -default "" -optional 1 - -prefix -default "" -optional 1 - *values -min 1 -max 1 - sourcepattern -type string -optional 0 - } - lassign [dict values [punk::args::get_dict $argspecs $args]] leaders opts values + lassign [dict values [punk::args::get_by_id punk::ns::nsimport_noclobber $args]] leaders opts values received set sourcepattern [dict get $values sourcepattern] set source_ns [tcl::namespace::qualifiers $sourcepattern] if {![tcl::namespace::exists $source_ns]} { error "nsimport_noclobber error namespace $source_ns not found" } - set target_ns [dict get $opts -targetnamespace] set nscaller [uplevel 1 {namespace current}] - if {$target_ns eq ""} { + if {![dict exists $received -targetnamespace]} { set target_ns $nscaller - } elseif {![string match ::* $target_ns]} { - set target_ns [punk::nsjoin $nscaller $target_ns] + } else { + set target_ns [dict get $opts -targetnamespace] + if {![string match ::* $target_ns]} { + set target_ns [punk::nsjoin $nscaller $target_ns] + } } set a_export_patterns [tcl::namespace::eval $source_ns {namespace export}] @@ -1918,6 +2782,34 @@ tcl::namespace::eval punk::ns { } } } + set nstemp ::punk::ns::temp_import + if {[tcl::dict:::exists $received -prefix]} { + set pfx [dict get $opts -prefix] + set imported_commands [list] + if {[namespace exists $nstemp]} { + namespace delete $nstemp + } + namespace eval $nstemp {} + foreach e $a_exported_tails { + set imported [tcl::namespace::eval $nstemp [string map [list $e $source_ns $pfx $target_ns] { + set cmd "" + if {![catch {namespace import ::}]} { + #renaming will fail if target already exists + #renaming a command into another namespace still results in a command with 'info cmdtype' = 'import' + if {![catch {rename [punk::ns::nsjoin ]}]} { + set cmd + } + } + set cmd + }]] + if {$imported ne ""} { + lappend imported_commands $imported + } + } + namespace delete $nstemp + return $imported_commands + } + set imported_commands [list] foreach e $a_exported_tails { set imported [tcl::namespace::eval $target_ns [string map [list $e $source_ns] { @@ -1934,7 +2826,7 @@ tcl::namespace::eval punk::ns { return $imported_commands } - #todo - use ns::nsimport_noclobber instead + #todo - use ns::nsimport_noclobber instead ? interp alias {} nsthis {} punk::ns::nspath_here_absolute interp alias {} nsorigin {} apply {ns {namespace origin [uplevel 1 ::punk::ns::nspath_here_absolute $ns]} ::} @@ -1943,6 +2835,7 @@ tcl::namespace::eval punk::ns { interp alias {} nsprefix {} punk::ns::nsprefix interp alias {} nstail {} punk::ns::nstail interp alias {} nsparts {} punk::ns::nsparts + interp alias {} nschildren {} punk::ns::nschildren interp alias {} nstree {} punk::ns::nstree #namespace/command/proc query interp alias {} nslist {} punk::ns::nslist @@ -1966,6 +2859,7 @@ tcl::namespace::eval punk::ns { interp alias {} corp {} punk::ns::corp + interp alias {} i {} punk::ns::arginfo } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm index 18590542..d3431188 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm @@ -45,8 +45,10 @@ #[list_begin itemized] package require Tcl 8.6- +package require punk::args #*** !doctools #[item] [package {Tcl 8.6-}] +#[item] [package {punk::args}] # #package require frobz # #*** !doctools @@ -642,6 +644,20 @@ namespace eval punk::path { return $ismatch } + punk::args::definition { + *id punk::path::treefilenames + -directory -type directory -help\ + "folder in which to begin recursive scan for files." + -call-depth-internal -default 0 -type integer + -antiglob_paths -default {} -help\ + "list of path patterns to exclude + may include * and ** path segments e.g /usr/**" + *values -min 0 -max -1 -optional 1 -type string + tailglobs -multiple 1 -help\ + "Patterns to match against filename portion (last segment) of each file path + within the directory tree being searched." + } + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) proc treefilenames {args} { @@ -655,22 +671,17 @@ namespace eval punk::path { #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem - set argd [punk::args::get_dict { - -directory -default "\uFFFF" - -call-depth-internal -default 0 -type integer - -antiglob_paths -default {} - *values -min 0 -max -1 -optional 1 -type string - tailglobs -multiple 1 - } $args] - lassign [dict values $argd] leaders opts values + set argd [punk::args::get_by_id punk::path::treefilenames $args] + lassign [dict values $argd] leaders opts values received set tailglobs [dict values $values] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] set CALLDEPTH [dict get $opts -call-depth-internal] # -- --- --- --- --- --- --- - set opt_dir [dict get $opts -directory] - if {$opt_dir eq "\uFFFF"} { + if {![dict exists $received -directory]} { set opt_dir [pwd] + } else { + set opt_dir [dict get $opts -directory] } # -- --- --- --- --- --- --- diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm index 422fb62b..6ffc6842 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.tm @@ -30,6 +30,7 @@ package require shellfilter #package require shellrun #package require punk package require punk::lib +package require punk::args package require punk::aliascore if {[catch {punk::aliascore::init} errM]} { puts stderr "punk::aliascore::init error: $errM" @@ -2773,7 +2774,7 @@ namespace eval repl { proc punk {} { interp eval code { package require punk::repl - repl::init + repl::init -safe punk repl::start stdin } } @@ -2781,14 +2782,21 @@ namespace eval repl { interp eval code { package require punk::repl } - interp eval code [list repl::init -safe 1 {*}$args] + interp eval code [list repl::init -safe safe {*}$args] interp eval code [list repl::start stdin] } proc safebase {args} { interp eval code { package require punk::repl } - interp eval code [list repl::init -safe 2 {*}$args] + interp eval code [list repl::init -safe safebase {*}$args] + interp eval code [list repl::start stdin] + } + proc punksafe {args} { + interp eval code { + package require punk::repl + } + interp eval code [list repl::init -safe punksafe {*}$args] interp eval code [list repl::start stdin] } } @@ -2805,189 +2813,265 @@ namespace eval repl { set paths [dict get $args -paths] } - if {$safe == 1} { - interp create -safe -- code - if {[llength $paths]} { - package require punk::island - foreach p $paths { - punk::island::add code $p + switch -- $safe { + safe { + interp create -safe -- code + if {[llength $paths]} { + package require punk::island + foreach p $paths { + punk::island::add code $p + } } - } - #review argv0,argv,argc - interp eval code { - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} + #review argv0,argv,argc + interp eval code { + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + } + set ::argv0 %argv0% + set ::auto_path %autopath% + #puts stdout "safe interp" + #flush stdout + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code } - set ::argv0 %argv0% - set ::auto_path %autopath% - #puts stdout "safe interp" - #flush stdout - } - interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] - interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] - interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] - if {"stdout" in [chan names]} { - interp share {} stdout code - } else { - interp share {} [shellfilter::stack::item_tophandle stdout] code - } - if {"stderr" in [chan names]} { - interp share {} stderr code - } else { - interp share {} [shellfilter::stack::item_tophandle stderr] code - } - - code alias ::md5::md5 ::repl::interphelpers::md5 - code alias exit ::repl::interphelpers::quit - } elseif {$safe == 2} { - #safebase - safe::interpCreate code -nested 1 - #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* - #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. - if {[llength $paths]} { - package require punk::island - foreach p $paths { - punk::island::add code $p + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code } - } - interp eval code { - set ::argv0 %argv0% - set ::argc 0 - set ::argv {} - set ::auto_path %autopath% - #puts stdout "safebase interp" - #flush stdout - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} + + code alias ::md5::md5 ::repl::interphelpers::md5 + code alias exit ::repl::interphelpers::quit + } + safebase { + #safebase + safe::interpCreate code -nested 1 -autopath %autopath% + #safe::setLogCmd ::repl::interpextras::safe_msg ;#using setLogcmd early will show the auto_path notice - which is *verbose* + #while it may conceivably be useful in debugging safe itself - auto_path and tcl::tm::list can be inspected to show these values in the safe interp itself anyway - so early logging is of limited utility here. + if {[llength $paths]} { + package require punk::island + foreach p $paths { + punk::island::add code $p + } + } + interp eval code { + set ::argv0 %argv0% + set ::argc 0 + set ::argv {} + #puts stdout "safebase interp" + #flush stdout + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + } + } + interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] + interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] + interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] + + #code invokehidden package require punk::lib + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + interp eval code { + package require punk::lib + package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) } - } - interp eval code [list set ::tcl_platform(os) $::tcl_platform(os)] - interp eval code [list set ::tcl_platform(osVersion) $::tcl_platform(osVersion)] - interp eval code [list set ::tcl_platform(machine) $::tcl_platform(machine)] - #code invokehidden package require punk::lib - if {"stdout" in [chan names]} { - interp share {} stdout code - } else { - interp share {} [shellfilter::stack::item_tophandle stdout] code - } - if {"stderr" in [chan names]} { - interp share {} stderr code - } else { - interp share {} [shellfilter::stack::item_tophandle stderr] code - } - interp eval code { - package require punk::lib - package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) - } + #JMN + interp eval code { + package require shellfilter + } - #JMN - interp eval code { - package require shellfilter - } + #work around bug in safe base which won't load Tcl libs that have deeper nesting + #(also affects tcllib page/plugins folder) + set termversions [package versions term] + set termv [lindex $termversions end] + if {$termv ne ""} { + set path [lindex [package ifneeded term $termv] end] ;#assuming path at end of something like "source .../term.tcl" + set termbase [file dirname $path] + safe::interpAddToAccessPath code [file join $termbase ansi] + safe::interpAddToAccessPath code [file join $termbase ansi code] + } + #safe::interpAddToAccessPath code NUL + if {$safelog ne ""} { + #setting setLogCmd here gives potentially interesting feedback regarding behaviour of things such as glob + safe::setLogCmd $safelog + } + #code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm + + code alias detok ::safe::DetokPath code ;#temp - this violates the point of the {$p(:X:)} paths + + #review - exit should do something slightly different + # see ::safe::interpDelete + code alias exit ::repl::interphelpers::quit + + code alias ::md5::md5 ::repl::interphelpers::md5 + code alias ::fconfigure ::fconfigure ;#needed for shellfilter + code alias ::file ::file + interp eval code [list package provide md5 $md5version] - #work around bug in safe base which won't load Tcl libs that have deeper nesting - #(also affects tcllib page/plugins folder) - set termversions [package versions term] - set termv [lindex $termversions end] - if {$termv ne ""} { - set path [lindex [package ifneeded term $termv] end] ;#assuming path at end of something like "source .../term.tcl" - set termbase [file dirname $path] - safe::interpAddToAccessPath code [file join $termbase ansi] - safe::interpAddToAccessPath code [file join $termbase ansi code] - } - #safe::interpAddToAccessPath code NUL - if {$safelog ne ""} { - #setting setLogCmd here gives some feedback for potentially interesting feedback regarding behaviour of things such as glob - safe::setLogCmd $safelog } - #code invokehidden source c:/repo/jn/shellspy/modules/punk/lib-0.1.1.tm + punk - 0 { + interp create code + interp eval code { + #safe !=1 and safe !=2, tmlist: %tmlist% + set ::argv0 %argv0% + set ::argv %argv% + set ::argc %argc% + set ::auto_path %autopath% + tcl::tm::remove {*}[tcl::tm::list] + tcl::tm::add {*}[lreverse %tmlist%] + #puts "code interp chan names-->[chan names]" + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + variable run_command_cache + } - code alias detok ::safe::DetokPath code ;#temp - this violates the point of the {$p(:X:)} paths + # -- --- + #review + #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) + #review - can we speed that scan up? + ##catch {package require flobrudder-nonexistant} + # -- --- - #review - exit should do something slightly different - # see ::safe::interpDelete - code alias exit ::repl::interphelpers::quit + if {[catch { + package require vfs + package require vfs::zip + } errM]} { + puts stderr "repl code interp can't load vfs,vfs::zip" + } - code alias ::md5::md5 ::repl::interphelpers::md5 - code alias ::fconfigure ::fconfigure ;#needed for shellfilter - code alias ::file ::file - interp eval code [list package provide md5 $md5version] - } else { - interp create code - interp eval code { - #safe !=1 and safe !=2, tmlist: %tmlist% - set ::argv0 %argv0% - set ::argv %argv% - set ::argc %argc% - set ::auto_path %autopath% - tcl::tm::remove {*}[tcl::tm::list] - tcl::tm::add {*}[lreverse %tmlist%] - #puts "code interp chan names-->[chan names]" - namespace eval ::codeinterp { - variable errstack {} - variable outstack {} - variable run_command_cache - } + #puts stderr ----- + #puts stderr [join $::auto_path \n] + #puts stderr ----- - # -- --- - #review - #we have to blow some time on a rescan to provide more deterministic ordering (match behaviour of initial thread regarding pkg precedence) - #review - can we speed that scan up? - ##catch {package require flobrudder-nonexistant} - # -- --- - - if {[catch { - package require vfs - package require vfs::zip - } errM]} { - puts stderr "repl code interp can't load vfs,vfs::zip" - } + if {[catch { + package require punk::config + package require punk::ns + #puts stderr "loading natsort" + #natsort has 'application mode' which can exit. + #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions + package require natsort + #catch {package require packageTrace} + package require punk + package require punk::args + package require punk::args::tclcore + package require shellrun + package require shellfilter + #set running_config $::punk::config::running + apply {running_config { + if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { + lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + } + if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { + lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + }} $::punk::config::running - #puts stderr ----- - #puts stderr [join $::auto_path \n] - #puts stderr ----- - - if {[catch { - package require punk::config - package require punk::ns - #puts stderr "loading natsort" - #natsort has 'application mode' which can exit. - #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions - package require natsort - #catch {package require packageTrace} - package require punk - package require shellrun - package require shellfilter - #set running_config $::punk::config::running - #if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - # lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] - #} - #if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - # lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] - #} - apply {running_config { - if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { - lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + package require textblock + } errM]} { + puts stderr "========================" + puts stderr "code interp error:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + error "$errM" } - if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { - lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + } + punksafe { + package require punk::safe + punk::safe::interpCreate code -autoPath %auto_path% + interp eval code { + set ::argv0 %argv0% + set ::argc 0 + set ::argv {} + tcl::tm::remove {*}[tcl::tm::list] + tcl::tm::add {*}[lreverse %tmlist%] + namespace eval ::codeinterp { + variable errstack {} + variable outstack {} + variable run_command_cache } - }} $::punk::config::running - - package require textblock - } errM]} { - puts stderr "========================" - puts stderr "code interp error:" - puts stderr $errM - puts stderr $::errorInfo - puts stderr "========================" - error "$errM" } + + + if {"stdout" in [chan names]} { + interp share {} stdout code + } else { + interp share {} [shellfilter::stack::item_tophandle stdout] code + } + if {"stderr" in [chan names]} { + interp share {} stderr code + } else { + interp share {} [shellfilter::stack::item_tophandle stderr] code + } + + interp eval code { + package require punk::lib + package require textblock ;#may fail to load term::ansi::code::macros - (only required for altg) + } + + + interp eval code { + if {[catch { + catch { + package require packagetrace + packagetrace::init + } + package require punk::config + package require punk::ns + #puts stderr "loading natsort" + #natsort has 'application mode' which can exit. + #Requiring it shouldn't trigger application - but zipfs/vfs interactions confused it in some early versions + package require natsort + package require punk + package require punk::args + package require punk::args::tclcore + package require shellrun + package require shellfilter + #set running_config $::punk::config::running + apply {running_config { + if {[string length [dict get $running_config color_stderr]] && [punk::console::colour]} { + lappend ::codeinterp::errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr]]] + } + if {[string length [dict get $running_config color_stdout]] && [punk::console::colour]} { + lappend ::codeinterp::outstack [shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout]]] + } + }} $::punk::config::running + + package require textblock + } errM]} { + puts stderr "========================" + puts stderr "code interp error:" + puts stderr $errM + puts stderr $::errorInfo + puts stderr "========================" + error "$errM" + } + + } + + } + default { } } code alias repl ::repl::interphelpers::repl_ensemble @@ -3006,6 +3090,10 @@ namespace eval repl { #temporary debug aliases - deliberate violation of safety provided by safe interp code alias escapeeval ::repl::interphelpers::escapeeval + + #experiment + #code alias ::shellfilter::stack ::shellfilter::stack + #puts stderr "returning threadid" #puts stderr [thread::id] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm index d8d1b249..d14b626d 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl/codethread-0.1.1.tm @@ -166,15 +166,15 @@ tcl::namespace::eval punk::repl::codethread { set errstack [list] upvar ::punk::config::running running_config if {[string length [dict get $running_config color_stdout_repl]] && [interp eval code punk::console::colour]} { - lappend outstack [interp eval code [list shellfilter::stack::add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout ansiwrap -settings [list -colour [dict get $running_config color_stdout_repl]]]] } - lappend outstack [interp eval code [list shellfilter::stack::add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] + lappend outstack [interp eval code [list ::shellfilter::stack add stdout tee_to_var -settings {-varname ::punk::repl::codethread::output_stdout}]] if {[string length [dict get $running_config color_stderr_repl]] && [interp eval code punk::console::colour]} { - lappend errstack [interp eval code [list shellfilter::stack::add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr ansiwrap -settings [list -colour [dict get $running_config color_stderr_repl]]]] # #lappend errstack [shellfilter::stack::add stderr ansiwrap -settings [list -colour cyan]] } - lappend errstack [interp eval code [list shellfilter::stack::add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] + lappend errstack [interp eval code [list ::shellfilter::stack add stderr tee_to_var -settings {-varname ::punk::repl::codethread::output_stderr}]] #an experiment #set errhandle [shellfilter::stack::item_tophandle stderr] @@ -190,7 +190,16 @@ tcl::namespace::eval punk::repl::codethread { if {[llength $::codeinterp::run_command_cache] > 2000} { set ::codeinterp::run_command_cache [lrange $::codeinterp::run_command_cache 1750 end][unset ::codeinterp::run_command_cache] } - tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + if {[string first ":::" $::punk::ns::ns_current]} { + #support for browsing 'odd' (inadvisable) namespaces + #don't use 'namespace exists' - will conflate ::test::x with ::test:::x + #if {$::punk::ns::ns_current in [namespace children [punk::ns::nsprefix $::punk::ns::ns_current]} { + #} + package require punk::ns + punk::ns::nseval_ifexists $::punk::ns::ns_current $::codeinterp::clonescript + } else { + tcl::namespace::inscope $::punk::ns::ns_current $::codeinterp::clonescript + } } } result] @@ -221,10 +230,10 @@ tcl::namespace::eval punk::repl::codethread { #only remove from shellfilter::stack the items we added to stack in this function foreach s [lreverse $outstack] { - interp eval code [list shellfilter::stack::remove stdout $s] + interp eval code [list ::shellfilter::stack remove stdout $s] } foreach s [lreverse $errstack] { - interp eval code [list shellfilter::stack::remove stderr $s] + interp eval code [list ::shellfilter::stack remove stderr $s] } thread::cond notify $replthread_cond } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm index 3965e3e3..38994f5c 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/safe-0.1.0.tm @@ -396,7 +396,7 @@ tcl::namespace::eval punk::safe { punk::safe::lib::RejectExcessColons $child set withAutoPath [dict exists $argd received -autoPath] - do_interpInit $child\ + punk::safe::system::do_interpInit $child\ [dict get $argd opts -accessPath]\ [InterpStatics $argd]\ [InterpNested $argd]\ @@ -436,6 +436,7 @@ tcl::namespace::eval punk::safe { # the current configuration. We still call OptKeyParse though # we know that "child" is our given argument because it also # checks for the "-help" option. + #TODO! set argd [punk::args::get_by_id punk::safe::interpIC $args] set child [dict get $argd leaders child] @@ -499,7 +500,8 @@ tcl::namespace::eval punk::safe { use -nested instead" } default { - return -code error "unknown flag $name. Known options: $opt_names" + #return -code error "unknown flag $name. Known options: $opt_names" + punk::args::get_by_id punk::safe::interpIC [list $child $arg] } } } @@ -585,6 +587,109 @@ tcl::namespace::eval punk::safe { } } + # + # + # interpFindInAccessPath: + # Search for a real directory and returns its virtual Id (including the + # "$") + # + # When debugging, use TranslatePath for the inverse operation. + proc interpFindInAccessPath {child path} { + CheckInterp $child + namespace upvar ::punk::safe::system [VarName $child] state + + if {![dict exists $state(access_path,remap) $path]} { + return -code error "$path not found in access path" + } + + return [dict get $state(access_path,remap) $path] + } + + # + # addToAccessPath: + # add (if needed) a real directory to access path and return its + # virtual token (including the "$"). + proc interpAddToAccessPath {child path} { + # first check if the directory is already in there + # (inlined interpFindInAccessPath). + CheckInterp $child + namespace upvar ::punk::safe::system [VarName $child] state + + if {[dict exists $state(access_path,remap) $path]} { + return [dict get $state(access_path,remap) $path] + } + + # new one, add it: + set token [PathToken [llength $state(access_path)]] + + lappend state(access_path) $path + lappend state(access_path,child) $token + lappend state(access_path,map) $token $path + lappend state(access_path,remap) $path $token + lappend state(access_path,norm) [file normalize $path] + + SyncAccessPath $child + return $token + } + # This procedure deletes a safe interpreter managed by Safe Tcl and cleans up + # associated state. + # - The command will also delete non-Safe-Base interpreters. + # - This is regrettable, but to avoid breaking existing code this should be + # amended at the next major revision by uncommenting "CheckInterp". + + proc interpDelete {child} { + Log $child "About to delete" NOTICE + + # CheckInterp $child + namespace upvar ::punk::safe::system [VarName $child] state + + # When an interpreter is deleted with [interp delete], any sub-interpreters + # are deleted automatically, but this leaves behind their data in the Safe + # Base. To clean up properly, we call safe::interpDelete recursively on each + # Safe Base sub-interpreter, so each one is deleted cleanly and not by + # the automatic mechanism built into [interp delete]. + foreach sub [interp children $child] { + if {[info exists ::punk::safe::system::[VarName [list $child $sub]]]} { + ::punk::safe::interpDelete [list $child $sub] + } + } + + # If the child has a cleanup hook registered, call it. Check the + # existence because we might be called to delete an interp which has + # not been registered with us at all + + if {[info exists state(cleanupHook)]} { + set hook $state(cleanupHook) + if {[llength $hook]} { + # remove the hook now, otherwise if the hook calls us somehow, + # we'll loop + unset state(cleanupHook) + try { + {*}$hook $child + } on error err { + Log $child "Delete hook error ($err)" + } + } + } + + # Discard the global array of state associated with the child, and + # delete the interpreter. + + if {[info exists state]} { + unset state + } + + # if we have been called twice, the interp might have been deleted + # already + if {[::interp exists $child]} { + ::interp delete $child + Log $child "Deleted" NOTICE + } + + return + } + + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::safe ---}] } @@ -661,8 +766,11 @@ tcl::namespace::eval punk::safe::system { set INTERPCREATE { *id punk::safe::interpCreate + *proc -name punk::safe::interpCreate -help\ + "Create a safe interpreter with punk::safe specific aliases + Returns the interpreter name" *leaders - child -type string -default "" -optional 1 -help\ + child -type string -default "" -regexprefail "^-" -regexprefailmsg "" -optional 1 -help\ "name of the child (optional)" } append INTERPCREATE \n $optlines @@ -673,7 +781,7 @@ tcl::namespace::eval punk::safe::system { set INTERPIC { *id punk::safe::interpIC *leaders - child -type string -optional 0 -help\ + child -type string -optional 0 -regexprefail "^-" -regexprefailmsg "" -help\ "name of the child" } append INTERPIC \n $optlines diff --git a/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm index 1a098e41..be42f571 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm @@ -143,6 +143,8 @@ tcl::namespace::eval punk::sixel { #TODO - sixel row/col info is dependent on terminal - pass in -terminalobject or -inoutchannels (for use with punk::console::cell_size) punk::args::definition { *id punk::sixel::get_info + *proc -name punk::sixel::get_info -help\ + "return a dict of information about the supplied sixelstring" -cache -default 1 -type boolean -help\ "Cached result based on sha1 hash." -cell_size -default "" -help\ diff --git a/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm b/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm index fe443ece..25ba28b1 100644 --- a/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm +++ b/src/vfs/_vfscommon.vfs/modules/shellfilter-0.1.9.tm @@ -1086,7 +1086,9 @@ namespace eval shellfilter::chan { ## note - whether stack is for input or output we maintain it in the same direction - which is in sync with the tcl chan pop chan push concept. ## namespace eval shellfilter::stack { - #todo - implement as oo + namespace export {[a-z]*} + namespace ensemble create + #todo - implement as oo ? variable pipelines [list] proc items {} { diff --git a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.2.tm b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.2.tm index f8b6390c..1a298b4e 100644 --- a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.2.tm +++ b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.2.tm @@ -92,29 +92,51 @@ tcl::namespace::eval textblock { #NOTE sha1, although computationally more intensive, tends to be faster than md5 on modern cpus #(more likely to be optimised for modern cpu features?) - variable use_md5 ;#framecache - set use_md5 1 - if {[catch {package require md5}]} { - set use_md5 0 - } - #todo - change use_md5 to more generic use_checksum_algorithm function. - # e.g allow md5, sha1, none, etc. - # - perhaps autodetect 32bit vs 64bit (or processortype?) to select a default (also depending on packages available and accelerator presence) - proc use_md5 {{yes_no ""}} { - variable use_md5 - if {$yes_no eq ""} { - return $use_md5 - } - if {![string is boolean -strict $yes_no]} { - error "textblock::use_md5 requires a boolean (or empty string to query)" - } - if {$yes_no} { - package require md5 - set use_md5 1 + #(This speed improvement may not apply for short strings) + + variable use_hash ;#framecache + set use_hash none ;#slightly faster but uglier layout for viewing frame_cache display + #if {![catch {package require sha1}]} { + # set use_hash sha1 + #} elseif {![catch {package require md5}]} { + # set use_hash md5 + #} else { + # set use_hash none + #} + + proc use_hash {args} { + set choices [list none] + set unavailable [list] + set pkgs [package names] + if {"md5" in $pkgs} { + lappend choices md5 } else { - set use_md5 0 + lappend unavailable md5 } - return $use_md5 + if {"sha1" in $pkgs} { + lappend choices sha1 + } else { + lappend unavailable sha1 + } + set choicemsg "" + if {[llength $unavailable]} { + set choicemsg " (unavailable packages: $unavailable)" + } + set argd [punk::args::get_dict [tstr -return string { + *id textblock::use_hash + *proc -name "textblock::use_hash" -help\ + "Hashing algorithm to use for framecache lookup. + 'none' may be slightly faster but less compact + when viewing textblock::framecache" + *values -min 0 -max 1 + hash_algorithm -choices {${$choices}} -optional 1 -help\ + "algorithm choice ${$choicemsg}" + }] $args] + variable use_hash + if {![dict exists $argd received hash_algorithm]} { + return $use_hash + } + set use_hash [dict get $argd values hash_algorithm] } tcl::namespace::eval class { variable opts_table_defaults @@ -3997,12 +4019,8 @@ tcl::namespace::eval textblock { return $t } - - - proc periodic {args} { - #For an impressive interactive terminal app (javascript) - # see: https://github.com/spirometaxas/periodic-table-cli - set opts [dict get [punk::args::get_dict { + punk::args::definition { + *id textblock::periodic *proc -name textblock::periodic -help "A rudimentary periodic table This is primarily a test of textblock::class::table" @@ -4016,8 +4034,12 @@ tcl::namespace::eval textblock { -show_edge -default "" -type boolean -forcecolour -default 0 -type boolean -help "If punk::colour is off - this enables the produced table to still be ansi coloured" *values -min 0 -max 0 - } $args] opts] + } + proc periodic {args} { + #For an impressive interactive terminal app (javascript) + # see: https://github.com/spirometaxas/periodic-table-cli + set opts [dict get [punk::args::get_by_id textblock::periodic $args] opts] set opt_return [tcl::dict::get $opts -return] if {[tcl::dict::get $opts -forcecolour]} { set fc forcecolour @@ -4156,15 +4178,16 @@ tcl::namespace::eval textblock { dict set conf $k [dict get $opts $k] } } - $t configure {*}[dict get $conf] - $t configure \ - -frametype_header light\ - -ansiborder_header [a+ {*}$fc brightwhite]\ - -ansibase_header [a+ {*}$fc Black]\ - -ansibase_body [a+ {*}$fc Black]\ - -ansiborder_body [a+ {*}$fc black]\ - -frametype block + set moreopts [dict create\ + -frametype_header light\ + -ansiborder_header [a+ {*}$fc brightwhite]\ + -ansibase_header [a+ {*}$fc Black]\ + -ansibase_body [a+ {*}$fc Black]\ + -ansiborder_body [a+ {*}$fc black]\ + -frametype block + ] + $t configure {*}[dict merge $conf $moreopts] #-ansiborder_header [a+ {*}$fc web-white]\ @@ -4204,9 +4227,9 @@ tcl::namespace::eval textblock { -header -default "" -type list -multiple 1\ -help "Each supplied -header argument is a header row. The number of values for each must be <= number of columns" - -show_header -default ""\ + -show_header -type boolean\ -help "Whether to show a header row. - Leave as empty string for unspecified/automatic, + Omit for unspecified/automatic, in which case it will display only if -headers list was supplied." -action -default "append" -choices {append replace}\ -help "row insertion method if existing -table is supplied @@ -4294,13 +4317,13 @@ tcl::namespace::eval textblock { if {[llength $colheaders] > 0} { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 1 } else { set show_header [tcl::dict::get $opts -show_header] } } else { - if {[tcl::dict::get $opts -show_header] eq ""} { + if {![tcl::dict::exists $opts received -show_header]} { set show_header 0 } else { set show_header [tcl::dict::get $opts -show_header] @@ -4529,7 +4552,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4553,7 +4576,7 @@ tcl::namespace::eval textblock { } set textblock [textutil::tabify::untabify2 $textblock $tw] } - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { #ansistripraw slightly faster than ansistrip - and won't affect width (avoid detect_g0/conversions) set textblock [punk::ansi::ansistripraw $textblock] } @@ -4614,7 +4637,7 @@ tcl::namespace::eval textblock { set textblock [textutil::tabify::untabify2 $textblock $tw] } #ansistripraw on entire block in one go rather than line by line - result should be the same - review - make tests - if {[punk::ansi::ta::detect $textblock]} { + if {[string length $textblock] > 1 && [punk::ansi::ta::detect $textblock]} { set textblock [punk::ansi::ansistripraw $textblock] } if {[tcl::string::last \n $textblock] >= 0} { @@ -7226,12 +7249,19 @@ tcl::namespace::eval textblock { variable frame_cache set frame_cache [tcl::dict::create] + + punk::args::definition { + *id textblock::frame_cache + *proc -name textblock::frame_cache -help\ + "Display or clear the frame cache." + -action -default {} -choices {clear} -help\ + "Clear the textblock::frame_cache dictionary" + -pretty -default 1 -help\ + "Use 'pdict textblock::frame_cache */*' for prettier output" + *values -min 0 -max 0 + } proc frame_cache {args} { - set argd [punk::args::get_dict { - -action -default {} -choices {clear} -help "Clear the textblock::frame_cache dictionary" - -pretty -default 1 -help "Use 'pdict textblock::frame_cache */*' for prettier output" - *values -min 0 -max 0 - } $args] + set argd [punk::args::get_by_id textblock::frame_cache $args] set action [dict get $argd opts -action] if {$action ni [list clear ""]} { @@ -7273,6 +7303,71 @@ tcl::namespace::eval textblock { } + set FRAMETYPES [textblock::frametypes] + set EG [a+ brightblack] + set RST [a] + #todo punk::args alias for centre center etc? + punk::args::definition [punk::lib::tstr -return string { + *id textblock::frame + *proc -name "textblock::frame"\ + -help "Frame a block of text with a border." + -checkargs -default 1 -type boolean\ + -help "If true do extra argument checks and + provide more comprehensive error info. + Set false for slight performance improvement." + -etabs -default 0\ + -help "expanding tabs - experimental/unimplemented." + -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ + -help "Type of border for frame." + -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. + passing an empty string will result in no box, but title/subtitle will still appear if supplied. + ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" + -boxmap -default {} -type dict + -joins -default {} -type list + -title -default "" -type string -regexprefail {\n}\ + -help "Frame title placed on topbar - no newlines. + May contain ANSI - no trailing reset required. + ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing + e.g 2: frame -title [a+ red underline]MyThing${$RST}" + -subtitle -default "" -type string -regexprefail {\n}\ + -help "Frame subtitle placed on bottombar - no newlines + May contain Ansi - no trailing reset required." + -width -default "" -type int\ + -help "Width of resulting frame including borders. + If omitted or empty-string, the width will be determined automatically based on content." + -height -default "" -type int\ + -help "Height of resulting frame including borders." + -ansiborder -default "" -type ansistring\ + -help "Ansi escape sequence to set border attributes. + ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents + e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" + -ansibase -default "" -type ansistring\ + -help "Default ANSI attributes within frame." + -blockalign -default centre -choices {left right centre}\ + -help "Alignment of the content block within the frame." + -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background + extends within the content block inside the frame. + Has no effect if no ANSI in content." + -textalign -default left -choices {left right centre}\ + -help "Alignment of text within the content block. (centre unimplemented)" + -ellipsis -default 1 -type boolean\ + -help "Whether to show elipsis for truncated content and title/subtitle." + -usecache -default 1 -type boolean + -buildcache -default 1 -type boolean + -crm_mode -default 0 -type boolean\ + -help "Show ANSI control characters within frame contents. + (Control Representation Mode) + Frame width doesn't adapt and content may be truncated + so -width may need to be manually set to display more." + + *values -min 0 -max 1 + contents -default "" -type string\ + -help "Frame contents - may be a block of text containing newlines and ANSI. + Text may be 'ragged' - ie unequal line-lengths. + No trailing ANSI reset required. + ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" + }] + #options before content argument - which is allowed to be absent #frame performance (noticeable with complex tables even of modest size) is improved somewhat by frame_cache - but is still (2024) a fairly expensive operation. # @@ -7283,7 +7378,7 @@ tcl::namespace::eval textblock { # - but we would need to maintain support for the rendered-string based operations too. proc frame {args} { variable frametypes - variable use_md5 + variable use_hash #counterintuitively - in-proc dict create each time is generally slightly faster than linked namespace var set opts [tcl::dict::create\ @@ -7311,20 +7406,19 @@ tcl::namespace::eval textblock { # for ansi art - -pad 0 is likely to be preferable set has_contents 0 - set arglist $args + set optlist $args ;#initial only - content will be removed + #no solo opts for frame if {[llength $args] %2 == 0} { if {[lindex $args end-1] eq "--"} { - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 - lpop arglist end ;#drop the end-of-opts flag + lpop optlist end ;#drop the end-of-opts flag } else { - set arglist $args + set optlist $args set contents "" } } else { - #set arglist [lrange $args 0 end-1] - #set contents [lindex $args end] - set contents [lpop arglist end] + set contents [lpop optlist end] set has_contents 1 } @@ -7333,7 +7427,7 @@ tcl::namespace::eval textblock { #use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache set optnames [tcl::dict::keys $opts] set opts_ok 1 ;#default assumption - foreach {k v} $arglist { + foreach {k v} $optlist { set k2 [tcl::prefix::match -error "" $optnames $k] switch -- $k2 { -etabs - -type - -boxlimits - -boxmap - -joins @@ -7355,70 +7449,9 @@ tcl::namespace::eval textblock { set check_args [dict get $opts -checkargs] #only use punk::args if check_args is true or our basic checks failed - if {!$opts_ok || $check_args} { - #error "Usage frame ?-type unicode|altg|ascii|? ?-title ? ?-subtitle ? ?-width ? ?-ansiborder ? ?-boxlimits hl|hlt|hlb|vl|vll|vlr|tlc|blc|brc? ?-joins left|right|up|down? " - set FRAMETYPES [textblock::frametypes] - set EG [a+ brightblack] - set RST [a] - set argd [punk::args::get_dict [punk::lib::tstr -return string { - *proc -name "textblock::frame"\ - -help "Frame a block of text with a border." - -checkargs -default 1 -type boolean\ - -help "If true do extra argument checks and - provide more comprehensive error info. - Set false for slight performance improvement." - -etabs -default 0\ - -help "expanding tabs - experimental/unimplemented." - -type -default light -choices {${$FRAMETYPES}} -choicerestricted 0 -type dict\ - -help "Type of border for frame." - -boxlimits -default {hl vl tlc blc trc brc} -type list -help "Limit the border box to listed elements. - passing an empty string will result in no box, but title/subtitle will still appear if supplied. - ${$EG}e.g: -frame -boxlimits {} -title things [a+ red White]my\\ncontent${$RST}" - -boxmap -default {} -type dict - -joins -default {} -type list - -title -default "" -type string -regexprefail {\n}\ - -help "Frame title placed on topbar - no newlines. - May contain ANSI - no trailing reset required. - ${$EG}e.g 1: frame -title My[a+ green]Green[a]Thing - e.g 2: frame -title [a+ red underline]MyThing${$RST}" - -subtitle -default "" -type string -regexprefail {\n}\ - -help "Frame subtitle placed on bottombar - no newlines - May contain Ansi - no trailing reset required." - -width -default "" -type int\ - -help "Width of resulting frame including borders. - If omitted or empty-string, the width will be determined automatically based on content." - -height -default "" -type int\ - -help "Height of resulting frame including borders." - -ansiborder -default "" -type ansistring\ - -help "Ansi escape sequence to set border attributes. - ${$EG}e.g 1: frame -ansiborder [a+ web-red] contents - e.g 2: frame -ansiborder \"\\x1b\\\[31m\" contents${$RST}" - -ansibase -default "" -type ansistring\ - -help "Default ANSI attributes within frame." - -blockalign -default centre -choices {left right centre}\ - -help "Alignment of the content block within the frame." - -pad -default 1 -type boolean -help "Whether to pad within the ANSI so content background - extends within the content block inside the frame. - Has no effect if no ANSI in content." - -textalign -default left -choices {left right centre}\ - -help "Alignment of text within the content block. (centre unimplemented)" - -ellipsis -default 1 -type boolean\ - -help "Whether to show elipsis for truncated content and title/subtitle." - -usecache -default 1 -type boolean - -buildcache -default 1 -type boolean - -crm_mode -default 0 -type boolean\ - -help "Show ANSI control characters within frame contents. - (Control Representation Mode) - Frame width doesn't adapt and content may be truncated - so -width may need to be manually set to display more." - - *values -min 0 -max 1 - contents -default "" -type string\ - -help "Frame contents - may be a block of text containing newlines and ANSI. - Text may be 'ragged' - ie unequal line-lengths. - No trailing ANSI reset required. - ${$EG}e.g: frame \"[a+ blue White] \\nMy blue foreground text on\\nwhite background\\n\"${$RST}" - }] $args] + #never need to checkargs if only one argument supplied even if it looks like an option - as it will be treated as data to frame + if {[llength $args] != 1 && (!$opts_ok || $check_args)} { + set argd [punk::args::get_by_id textblock::frame $args] set opts [dict get $argd opts] set contents [dict get $argd values contents] } @@ -7446,7 +7479,10 @@ tcl::namespace::eval textblock { set opt_ansiborder [tcl::dict::get $opts -ansiborder] set opt_ansibase [tcl::dict::get $opts -ansibase] ;#experimental set opt_ellipsis [tcl::dict::get $opts -ellipsis] + set opt_blockalign [tcl::dict::get $opts -blockalign] + set opt_textalign [tcl::dict::get $opts -textalign] + set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] set known_frametypes $frametypes ;# light, heavey etc as defined in the ::textblock::frametypes variable @@ -7463,107 +7499,26 @@ tcl::namespace::eval textblock { set framedef $ftype } - set is_boxlimits_ok 1 - set exact_boxlimits [list] - foreach v $opt_boxlimits { - switch -- $v { - hl { - lappend exact_boxlimits hlt hlb - } - vl { - lappend exact_boxlimits vll vlr - } - hlt - hlb - vll - vlr - tlc - trc - blc - brc { - lappend exact_boxlimits $v - } - default { - #k not in custom_keys - set is_boxlimits_ok 0 - break - } - } - } - #review vllj etc? - if {!$is_boxlimits_ok} { - error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" - } - set exact_boxlimits [lsort -unique $exact_boxlimits] - - set is_joins_ok 1 - foreach v $opt_joins { - lassign [split $v -] direction target - switch -- $direction { - left - right - up - down {} - default { - set is_joins_ok 0 - break - } - } - switch -- $target { - "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} - default { - set is_joins_ok 0 - break - } - } - } - if {!$is_joins_ok} { - error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" - } - set is_boxmap_ok 1 - tcl::dict::for {boxelement subst} $opt_boxmap { - switch -- $boxelement { - hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} - hltj - hlbj - vllj - vlrj {} - default { - set is_boxmap_ok 0 - break - } - } - } - if {!$is_boxmap_ok} { - error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" - } + #if check_args? - #sorted order down left right up - #1 x choose 4 - #4 x choose 3 - #6 x choose 2 - #4 x choose 1 - #15 combos - set join_directions [list] - #targets - light,heavy (double?) - seem to be some required glyphs missing from unicode - #e.g down-light, up-heavy - set join_targets [tcl::dict::create left "" down "" right "" up ""] - foreach jt $opt_joins { - lassign [split $jt -] direction target - if {$target ne ""} { - tcl::dict::set join_targets $direction $target - } - lappend join_directions $direction - } - set join_directions [lsort -unique $join_directions] - set do_joins [::join $join_directions _] + #REVIEW - now done in framedef? + #set join_directions [list] + ##targets - light,heavy (double?) - seem to be some required glyphs missing from unicode + ##e.g down-light, up-heavy + #set join_targets [tcl::dict::create left "" down "" right "" up ""] + #foreach jt $opt_joins { + # lassign [split $jt -] direction target + # if {$target ne ""} { + # tcl::dict::set join_targets $direction $target + # } + # lappend join_directions $direction + #} + #set join_directions [lsort -unique $join_directions] + #set do_joins [::join $join_directions _] - #JMN - switch -- $opt_blockalign { - left - right - centre - center {} - default { - error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" - } - } - #these are all valid commands for overtype:: - # -- --- --- --- --- --- - set opt_textalign [tcl::dict::get $opts -textalign] - switch -- $opt_textalign { - left - right - centre - center {} - default { - error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" - } - } # -- --- --- --- --- --- @@ -7634,20 +7589,28 @@ tcl::namespace::eval textblock { # -- --- --- --- --- --- --- --- --- variable frame_cache #review - custom frame affects frame_inner_width - exclude from caching? - #set cache_key [concat $arglist $frame_inner_width $frame_inner_height] + #set cache_key [concat $optlist $frame_inner_width $frame_inner_height] #jmn - #set hashables [concat $arglist $frame_inner_width $frame_inner_height] - set hashables [list {*}$arglist $frame_inner_width $frame_inner_height] + #set hashables [concat $optlist $frame_inner_width $frame_inner_height] + set hashables [list {*}$optlist $frame_inner_width $frame_inner_height] - if {$use_md5} { - #package require md5 ;#already required at package load - if {[package vsatisfies [package present md5] 2- ] } { - set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review - } else { - set hash [md5::md5 [encoding convertto utf-8 $hashables]] + + switch -- $use_hash { + sha1 { + package require sha1 + set hash [sha1::sha1 [encoding convertto utf-8 $hashables]] + } + md5 { + package require md5 + if {[package vsatisfies [package present md5] 2- ] } { + set hash [md5::md5 -hex [encoding convertto utf-8 $hashables]] ;#need fast and unique to content - not cryptographic - review + } else { + set hash [md5::md5 [encoding convertto utf-8 $hashables]] + } + } + none { + set hash $hashables } - } else { - set hash $hashables } set cache_key "$hash-$frame_inner_width-$frame_inner_height-actualcontentwidth:$actual_contentwidth" @@ -7709,11 +7672,94 @@ tcl::namespace::eval textblock { set used [tcl::dict::get $frame_cache $cache_key used] tcl::dict::set frame_cache $cache_key used [expr {$used+1}] ;#update existing record set is_cached 1 - } + # -- --- --- --- --- --- --- --- --- if {!$is_cached} { + # -- --- --- --- --- + # -- --- --- --- --- + set is_joins_ok 1 + foreach v $opt_joins { + lassign [split $v -] direction target + switch -- $direction { + left - right - up - down {} + default { + set is_joins_ok 0 + break + } + } + switch -- $target { + "" - light - light_b - light_c - heavy - heavy_b - heavy_c - ascii - altg - arc - arc_b - arc_c - double - custom - block - block1 - block2 {} + default { + set is_joins_ok 0 + break + } + } + } + if {!$is_joins_ok} { + error "frame option -joins '$opt_joins' must contain only values from the set: left,right,up,down with targets heavy,light,ascii,altg,arc,double,block,block1,custom e.g down-light" + } + # -- --- --- --- --- --- + set is_boxmap_ok 1 + tcl::dict::for {boxelement subst} $opt_boxmap { + switch -- $boxelement { + hl - hlt - hlb - vl - vll - vlr - tlc - trc - blc - brc {} + hltj - hlbj - vllj - vlrj {} + default { + set is_boxmap_ok 0 + break + } + } + } + if {!$is_boxmap_ok} { + error "frame option -boxmap '$opt_boxmap' must contain only keys from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc,hltj,hlbj,vllj,vlrj" + } + # -- --- --- --- --- --- + #these are all valid commands for overtype:: + switch -- $opt_textalign { + left - right - centre - center {} + default { + error "frame option -textalign must be left|right|centre|center - received: $opt_textalign" + } + } + # -- --- --- --- --- --- + switch -- $opt_blockalign { + left - right - centre - center {} + default { + error "frame option -blockalign must be left|right|centre|center - received: $opt_blockalign" + } + } + # -- --- --- --- --- + # -- --- --- --- --- + set is_boxlimits_ok 1 + set exact_boxlimits [list] + foreach v $opt_boxlimits { + switch -- $v { + hl { + lappend exact_boxlimits hlt hlb + } + vl { + lappend exact_boxlimits vll vlr + } + hlt - hlb - vll - vlr - tlc - trc - blc - brc { + lappend exact_boxlimits $v + } + default { + #k not in custom_keys + set is_boxlimits_ok 0 + break + } + } + } + #review vllj etc? + if {!$is_boxlimits_ok} { + error "frame option -boxlimits '$opt_boxlimits' must contain only values from the set: hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" + } + set exact_boxlimits [lsort -unique $exact_boxlimits] + # -- --- --- --- --- --- + + set rst [a] #set column [tcl::string::repeat " " $frame_inner_width] ;#default - may need to override for custom frame set underlayline [tcl::string::repeat " " $frame_inner_width] @@ -8038,6 +8084,9 @@ tcl::namespace::eval textblock { ;#end !$is_cached } + + + #use the same mechanism to build the final frame - whether from cache or template if {$actual_contentwidth == 0} { set fs [tcl::string::map [list $FSUB " "] $template]